2620 files changed, 541380 insertions, 30 deletions

diff --git a/Makefile.def b/Makefile.def
index c67eb567783..5f44190154e 100644
--- a/Makefile.def
+++ b/Makefile.def
@@ -185,6 +185,7 @@ target_modules = { module= libffi; no_install=true; };
 target_modules = { module= zlib; bootstrap=true; };
 target_modules = { module= rda; };
 target_modules = { module= libada; };
+target_modules = { module= libgm2; lib_path=.libs; };
 target_modules = { module= libgomp; bootstrap= true; lib_path=.libs; };
 target_modules = { module= libitm; lib_path=.libs; };
 target_modules = { module= libatomic; bootstrap=true; lib_path=.libs; };
@@ -307,6 +308,8 @@ flags_to_pass = { flag= GOC_FOR_TARGET ; };
 flags_to_pass = { flag= GOCFLAGS_FOR_TARGET ; };
 flags_to_pass = { flag= GDC_FOR_TARGET ; };
 flags_to_pass = { flag= GDCFLAGS_FOR_TARGET ; };
+flags_to_pass = { flag= GM2_FOR_TARGET ; };
+flags_to_pass = { flag= GM2FLAGS_FOR_TARGET ; };
 flags_to_pass = { flag= LD_FOR_TARGET ; };
 flags_to_pass = { flag= LIPO_FOR_TARGET ; };
 flags_to_pass = { flag= LDFLAGS_FOR_TARGET ; };
@@ -618,6 +621,8 @@ dependencies = { module=configure-target-libgo; on=all-target-libstdc++-v3; };
 dependencies = { module=all-target-libgo; on=all-target-libbacktrace; };
 dependencies = { module=all-target-libgo; on=all-target-libffi; };
 dependencies = { module=all-target-libgo; on=all-target-libatomic; };
+dependencies = { module=configure-target-libgm2; on=all-target-libstdc++-v3; };
+dependencies = { module=all-target-libgm2; on=all-target-libatomic; };
 dependencies = { module=configure-target-libphobos; on=configure-target-libbacktrace; };
 dependencies = { module=configure-target-libphobos; on=configure-target-zlib; };
 dependencies = { module=all-target-libphobos; on=all-target-libbacktrace; };
@@ -673,6 +678,8 @@ languages = { language=obj-c++;	gcc-check-target=check-obj-c++; };
 languages = { language=go;	gcc-check-target=check-go;
 				lib-check-target=check-target-libgo;
 				lib-check-target=check-gotools; };
+languages = { language=m2;	gcc-check-target=check-m2;
+				lib-check-target=check-target-libgm2; };
 languages = { language=d;	gcc-check-target=check-d;
 				lib-check-target=check-target-libphobos; };
 languages = { language=jit;	gcc-check-target=check-jit; };
diff --git a/Makefile.in b/Makefile.in
index fad49011e61..83e250f21a9 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -163,6 +163,8 @@ BUILD_EXPORTS = \
 	GOCFLAGS="$(GOCFLAGS_FOR_BUILD)"; export GOCFLAGS; \
 	GDC="$(GDC_FOR_BUILD)"; export GDC; \
 	GDCFLAGS="$(GDCFLAGS_FOR_BUILD)"; export GDCFLAGS; \
+	GM2="$(GM2_FOR_BUILD)"; export GM2; \
+	GM2FLAGS="$(GM2FLAGS_FOR_BUILD)"; export GM2FLAGS; \
 	DLLTOOL="$(DLLTOOL_FOR_BUILD)"; export DLLTOOL; \
 	DSYMUTIL="$(DSYMUTIL_FOR_BUILD)"; export DSYMUTIL; \
 	LD="$(LD_FOR_BUILD)"; export LD; \
@@ -201,6 +203,7 @@ HOST_EXPORTS = \
 	GFORTRAN="$(GFORTRAN)"; export GFORTRAN; \
 	GOC="$(GOC)"; export GOC; \
 	GDC="$(GDC)"; export GDC; \
+	GM2="$(GM2)"; export GM2; \
 	AR="$(AR)"; export AR; \
 	AS="$(AS)"; export AS; \
 	CC_FOR_BUILD="$(CC_FOR_BUILD)"; export CC_FOR_BUILD; \
@@ -304,6 +307,7 @@ BASE_TARGET_EXPORTS = \
 	GFORTRAN="$(GFORTRAN_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GFORTRAN; \
 	GOC="$(GOC_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GOC; \
 	GDC="$(GDC_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GDC; \
+	GM2="$(GM2_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GM2; \
 	DLLTOOL="$(DLLTOOL_FOR_TARGET)"; export DLLTOOL; \
 	DSYMUTIL="$(DSYMUTIL_FOR_TARGET)"; export DSYMUTIL; \
 	LD="$(COMPILER_LD_FOR_TARGET)"; export LD; \
@@ -370,6 +374,7 @@ DSYMUTIL_FOR_BUILD = @DSYMUTIL_FOR_BUILD@
 GFORTRAN_FOR_BUILD = @GFORTRAN_FOR_BUILD@
 GOC_FOR_BUILD = @GOC_FOR_BUILD@
 GDC_FOR_BUILD = @GDC_FOR_BUILD@
+GM2_FOR_BUILD = @GM2_FOR_BUILD@
 LDFLAGS_FOR_BUILD = @LDFLAGS_FOR_BUILD@
 LD_FOR_BUILD = @LD_FOR_BUILD@
 NM_FOR_BUILD = @NM_FOR_BUILD@
@@ -440,6 +445,7 @@ CXXFLAGS = @CXXFLAGS@
 LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates
 GOCFLAGS = $(CFLAGS)
 GDCFLAGS = $(CFLAGS)
+GM2FLAGS = $(CFLAGS)
 
 # Pass additional PGO and LTO compiler options to the PGO build.
 BUILD_CFLAGS = $(PGO_BUILD_CFLAGS) $(PGO_BUILD_LTO_CFLAGS)
@@ -655,6 +661,7 @@ RAW_CXX_FOR_TARGET=$(STAGE_CC_WRAPPER) @RAW_CXX_FOR_TARGET@
 GFORTRAN_FOR_TARGET=$(STAGE_CC_WRAPPER) @GFORTRAN_FOR_TARGET@
 GOC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GOC_FOR_TARGET@
 GDC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GDC_FOR_TARGET@
+GM2_FOR_TARGET=$(STAGE_CC_WRAPPER) @GM2_FOR_TARGET@
 DLLTOOL_FOR_TARGET=@DLLTOOL_FOR_TARGET@
 DSYMUTIL_FOR_TARGET=@DSYMUTIL_FOR_TARGET@
 LD_FOR_TARGET=@LD_FOR_TARGET@
@@ -680,6 +687,7 @@ CXXFLAGS_FOR_TARGET = @CXXFLAGS_FOR_TARGET@
 LIBCFLAGS_FOR_TARGET = $(CFLAGS_FOR_TARGET)
 LIBCXXFLAGS_FOR_TARGET = $(CXXFLAGS_FOR_TARGET) -fno-implicit-templates
 LDFLAGS_FOR_TARGET = @LDFLAGS_FOR_TARGET@
+GM2FLAGS_FOR_TARGET = -O2 -g
 GOCFLAGS_FOR_TARGET = -O2 -g
 GDCFLAGS_FOR_TARGET = -O2 -g
 
@@ -706,7 +714,7 @@ all:
 
 # This is the list of directories that may be needed in RPATH_ENVVAR
 # so that programs built for the target machine work.
-TARGET_LIB_PATH = $(TARGET_LIB_PATH_libstdc++-v3)$(TARGET_LIB_PATH_libsanitizer)$(TARGET_LIB_PATH_libvtv)$(TARGET_LIB_PATH_libssp)$(TARGET_LIB_PATH_libphobos)$(TARGET_LIB_PATH_libgomp)$(TARGET_LIB_PATH_libitm)$(TARGET_LIB_PATH_libatomic)$(HOST_LIB_PATH_gcc)
+TARGET_LIB_PATH = $(TARGET_LIB_PATH_libstdc++-v3)$(TARGET_LIB_PATH_libsanitizer)$(TARGET_LIB_PATH_libvtv)$(TARGET_LIB_PATH_libssp)$(TARGET_LIB_PATH_libphobos)$(TARGET_LIB_PATH_libgm2)$(TARGET_LIB_PATH_libgomp)$(TARGET_LIB_PATH_libitm)$(TARGET_LIB_PATH_libatomic)$(HOST_LIB_PATH_gcc)
 
 @if target-libstdc++-v3
 TARGET_LIB_PATH_libstdc++-v3 = $$r/$(TARGET_SUBDIR)/libstdc++-v3/src/.libs:
@@ -728,6 +736,10 @@ TARGET_LIB_PATH_libssp = $$r/$(TARGET_SUBDIR)/libssp/.libs:
 TARGET_LIB_PATH_libphobos = $$r/$(TARGET_SUBDIR)/libphobos/src/.libs:
 @endif target-libphobos
 
+@if target-libgm2
+TARGET_LIB_PATH_libgm2 = $$r/$(TARGET_SUBDIR)/libgm2/.libs:
+@endif target-libgm2
+
 @if target-libgomp
 TARGET_LIB_PATH_libgomp = $$r/$(TARGET_SUBDIR)/libgomp/.libs:
 @endif target-libgomp
@@ -873,6 +885,8 @@ BASE_FLAGS_TO_PASS = \
 	"GOCFLAGS_FOR_TARGET=$(GOCFLAGS_FOR_TARGET)" \
 	"GDC_FOR_TARGET=$(GDC_FOR_TARGET)" \
 	"GDCFLAGS_FOR_TARGET=$(GDCFLAGS_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"GM2FLAGS_FOR_TARGET=$(GM2FLAGS_FOR_TARGET)" \
 	"LD_FOR_TARGET=$(LD_FOR_TARGET)" \
 	"LIPO_FOR_TARGET=$(LIPO_FOR_TARGET)" \
 	"LDFLAGS_FOR_TARGET=$(LDFLAGS_FOR_TARGET)" \
@@ -946,6 +960,7 @@ EXTRA_HOST_FLAGS = \
 	'GFORTRAN=$(GFORTRAN)' \
 	'GOC=$(GOC)' \
 	'GDC=$(GDC)' \
+	'GM2=$(GM2)' \
 	'LD=$(LD)' \
 	'LIPO=$(LIPO)' \
 	'NM=$(NM)' \
@@ -972,6 +987,7 @@ POSTSTAGE1_FLAGS_TO_PASS = \
 	CC="$${CC}" CC_FOR_BUILD="$${CC_FOR_BUILD}" \
 	CXX="$${CXX}" CXX_FOR_BUILD="$${CXX_FOR_BUILD}" \
 	GDC="$${GDC}" GDC_FOR_BUILD="$${GDC_FOR_BUILD}" \
+	GM2="$${GM2}" GM2_FOR_BUILD="$${GM2_FOR_BUILD}" \
 	GNATBIND="$${GNATBIND}" \
 	LDFLAGS="$${LDFLAGS}" \
 	HOST_LIBS="$${HOST_LIBS}" \
@@ -1007,6 +1023,8 @@ EXTRA_TARGET_FLAGS = \
 	'GOCFLAGS=$$(GOCFLAGS_FOR_TARGET)' \
 	'GDC=$$(GDC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GDCFLAGS=$$(GDCFLAGS_FOR_TARGET)' \
+	'GM2=$$(GM2_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
+	'GM2FLAGS=$$(GM2FLAGS_FOR_TARGET)' \
 	'LD=$(COMPILER_LD_FOR_TARGET)' \
 	'LDFLAGS=$$(LDFLAGS_FOR_TARGET)' \
 	'LIBCFLAGS=$$(LIBCFLAGS_FOR_TARGET)' \
@@ -1033,6 +1051,7 @@ TARGET_FLAGS_TO_PASS = $(BASE_FLAGS_TO_PASS) $(EXTRA_TARGET_FLAGS)
 # cross-building scheme.
 EXTRA_GCC_FLAGS = \
 	"GCC_FOR_TARGET=$(GCC_FOR_TARGET) $$TFLAGS" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET) $$TFLAGS" \
 	"`echo 'STMP_FIXPROTO=$(STMP_FIXPROTO)' | sed -e s'/[^=][^=]*=$$/XFOO=/'`" \
 	"`echo 'LIMITS_H_TEST=$(LIMITS_H_TEST)' | sed -e s'/[^=][^=]*=$$/XFOO=/'`"
 
@@ -1120,6 +1139,7 @@ configure-target:  \
     maybe-configure-target-zlib \
     maybe-configure-target-rda \
     maybe-configure-target-libada \
+    maybe-configure-target-libgm2 \
     maybe-configure-target-libgomp \
     maybe-configure-target-libitm \
     maybe-configure-target-libatomic
@@ -1313,6 +1333,7 @@ all-target: maybe-all-target-zlib
 @endif target-zlib-no-bootstrap
 all-target: maybe-all-target-rda
 all-target: maybe-all-target-libada
+all-target: maybe-all-target-libgm2
 @if target-libgomp-no-bootstrap
 all-target: maybe-all-target-libgomp
 @endif target-libgomp-no-bootstrap
@@ -1411,6 +1432,7 @@ info-target: maybe-info-target-libffi
 info-target: maybe-info-target-zlib
 info-target: maybe-info-target-rda
 info-target: maybe-info-target-libada
+info-target: maybe-info-target-libgm2
 info-target: maybe-info-target-libgomp
 info-target: maybe-info-target-libitm
 info-target: maybe-info-target-libatomic
@@ -1500,6 +1522,7 @@ dvi-target: maybe-dvi-target-libffi
 dvi-target: maybe-dvi-target-zlib
 dvi-target: maybe-dvi-target-rda
 dvi-target: maybe-dvi-target-libada
+dvi-target: maybe-dvi-target-libgm2
 dvi-target: maybe-dvi-target-libgomp
 dvi-target: maybe-dvi-target-libitm
 dvi-target: maybe-dvi-target-libatomic
@@ -1589,6 +1612,7 @@ pdf-target: maybe-pdf-target-libffi
 pdf-target: maybe-pdf-target-zlib
 pdf-target: maybe-pdf-target-rda
 pdf-target: maybe-pdf-target-libada
+pdf-target: maybe-pdf-target-libgm2
 pdf-target: maybe-pdf-target-libgomp
 pdf-target: maybe-pdf-target-libitm
 pdf-target: maybe-pdf-target-libatomic
@@ -1678,6 +1702,7 @@ html-target: maybe-html-target-libffi
 html-target: maybe-html-target-zlib
 html-target: maybe-html-target-rda
 html-target: maybe-html-target-libada
+html-target: maybe-html-target-libgm2
 html-target: maybe-html-target-libgomp
 html-target: maybe-html-target-libitm
 html-target: maybe-html-target-libatomic
@@ -1767,6 +1792,7 @@ TAGS-target: maybe-TAGS-target-libffi
 TAGS-target: maybe-TAGS-target-zlib
 TAGS-target: maybe-TAGS-target-rda
 TAGS-target: maybe-TAGS-target-libada
+TAGS-target: maybe-TAGS-target-libgm2
 TAGS-target: maybe-TAGS-target-libgomp
 TAGS-target: maybe-TAGS-target-libitm
 TAGS-target: maybe-TAGS-target-libatomic
@@ -1856,6 +1882,7 @@ install-info-target: maybe-install-info-target-libffi
 install-info-target: maybe-install-info-target-zlib
 install-info-target: maybe-install-info-target-rda
 install-info-target: maybe-install-info-target-libada
+install-info-target: maybe-install-info-target-libgm2
 install-info-target: maybe-install-info-target-libgomp
 install-info-target: maybe-install-info-target-libitm
 install-info-target: maybe-install-info-target-libatomic
@@ -1945,6 +1972,7 @@ install-dvi-target: maybe-install-dvi-target-libffi
 install-dvi-target: maybe-install-dvi-target-zlib
 install-dvi-target: maybe-install-dvi-target-rda
 install-dvi-target: maybe-install-dvi-target-libada
+install-dvi-target: maybe-install-dvi-target-libgm2
 install-dvi-target: maybe-install-dvi-target-libgomp
 install-dvi-target: maybe-install-dvi-target-libitm
 install-dvi-target: maybe-install-dvi-target-libatomic
@@ -2034,6 +2062,7 @@ install-pdf-target: maybe-install-pdf-target-libffi
 install-pdf-target: maybe-install-pdf-target-zlib
 install-pdf-target: maybe-install-pdf-target-rda
 install-pdf-target: maybe-install-pdf-target-libada
+install-pdf-target: maybe-install-pdf-target-libgm2
 install-pdf-target: maybe-install-pdf-target-libgomp
 install-pdf-target: maybe-install-pdf-target-libitm
 install-pdf-target: maybe-install-pdf-target-libatomic
@@ -2123,6 +2152,7 @@ install-html-target: maybe-install-html-target-libffi
 install-html-target: maybe-install-html-target-zlib
 install-html-target: maybe-install-html-target-rda
 install-html-target: maybe-install-html-target-libada
+install-html-target: maybe-install-html-target-libgm2
 install-html-target: maybe-install-html-target-libgomp
 install-html-target: maybe-install-html-target-libitm
 install-html-target: maybe-install-html-target-libatomic
@@ -2212,6 +2242,7 @@ installcheck-target: maybe-installcheck-target-libffi
 installcheck-target: maybe-installcheck-target-zlib
 installcheck-target: maybe-installcheck-target-rda
 installcheck-target: maybe-installcheck-target-libada
+installcheck-target: maybe-installcheck-target-libgm2
 installcheck-target: maybe-installcheck-target-libgomp
 installcheck-target: maybe-installcheck-target-libitm
 installcheck-target: maybe-installcheck-target-libatomic
@@ -2301,6 +2332,7 @@ mostlyclean-target: maybe-mostlyclean-target-libffi
 mostlyclean-target: maybe-mostlyclean-target-zlib
 mostlyclean-target: maybe-mostlyclean-target-rda
 mostlyclean-target: maybe-mostlyclean-target-libada
+mostlyclean-target: maybe-mostlyclean-target-libgm2
 mostlyclean-target: maybe-mostlyclean-target-libgomp
 mostlyclean-target: maybe-mostlyclean-target-libitm
 mostlyclean-target: maybe-mostlyclean-target-libatomic
@@ -2390,6 +2422,7 @@ clean-target: maybe-clean-target-libffi
 clean-target: maybe-clean-target-zlib
 clean-target: maybe-clean-target-rda
 clean-target: maybe-clean-target-libada
+clean-target: maybe-clean-target-libgm2
 clean-target: maybe-clean-target-libgomp
 clean-target: maybe-clean-target-libitm
 clean-target: maybe-clean-target-libatomic
@@ -2479,6 +2512,7 @@ distclean-target: maybe-distclean-target-libffi
 distclean-target: maybe-distclean-target-zlib
 distclean-target: maybe-distclean-target-rda
 distclean-target: maybe-distclean-target-libada
+distclean-target: maybe-distclean-target-libgm2
 distclean-target: maybe-distclean-target-libgomp
 distclean-target: maybe-distclean-target-libitm
 distclean-target: maybe-distclean-target-libatomic
@@ -2568,6 +2602,7 @@ maintainer-clean-target: maybe-maintainer-clean-target-libffi
 maintainer-clean-target: maybe-maintainer-clean-target-zlib
 maintainer-clean-target: maybe-maintainer-clean-target-rda
 maintainer-clean-target: maybe-maintainer-clean-target-libada
+maintainer-clean-target: maybe-maintainer-clean-target-libgm2
 maintainer-clean-target: maybe-maintainer-clean-target-libgomp
 maintainer-clean-target: maybe-maintainer-clean-target-libitm
 maintainer-clean-target: maybe-maintainer-clean-target-libatomic
@@ -2715,6 +2750,7 @@ check-target:  \
     maybe-check-target-zlib \
     maybe-check-target-rda \
     maybe-check-target-libada \
+    maybe-check-target-libgm2 \
     maybe-check-target-libgomp \
     maybe-check-target-libitm \
     maybe-check-target-libatomic
@@ -2906,6 +2942,7 @@ install-target:  \
     maybe-install-target-zlib \
     maybe-install-target-rda \
     maybe-install-target-libada \
+    maybe-install-target-libgm2 \
     maybe-install-target-libgomp \
     maybe-install-target-libitm \
     maybe-install-target-libatomic
@@ -3015,6 +3052,7 @@ install-strip-target:  \
     maybe-install-strip-target-zlib \
     maybe-install-strip-target-rda \
     maybe-install-strip-target-libada \
+    maybe-install-strip-target-libgm2 \
     maybe-install-strip-target-libgomp \
     maybe-install-strip-target-libitm \
     maybe-install-strip-target-libatomic
@@ -58104,6 +58142,491 @@ maintainer-clean-target-libada:
 
 
 
+.PHONY: configure-target-libgm2 maybe-configure-target-libgm2
+maybe-configure-target-libgm2:
+@if gcc-bootstrap
+configure-target-libgm2: stage_current
+@endif gcc-bootstrap
+@if target-libgm2
+maybe-configure-target-libgm2: configure-target-libgm2
+configure-target-libgm2: 
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	echo "Checking multilib configuration for libgm2..."; \
+	$(SHELL) $(srcdir)/mkinstalldirs $(TARGET_SUBDIR)/libgm2; \
+	$(CC_FOR_TARGET) --print-multi-lib > $(TARGET_SUBDIR)/libgm2/multilib.tmp 2> /dev/null; \
+	if test -r $(TARGET_SUBDIR)/libgm2/multilib.out; then \
+	  if cmp -s $(TARGET_SUBDIR)/libgm2/multilib.tmp $(TARGET_SUBDIR)/libgm2/multilib.out; then \
+	    rm -f $(TARGET_SUBDIR)/libgm2/multilib.tmp; \
+	  else \
+	    rm -f $(TARGET_SUBDIR)/libgm2/Makefile; \
+	    mv $(TARGET_SUBDIR)/libgm2/multilib.tmp $(TARGET_SUBDIR)/libgm2/multilib.out; \
+	  fi; \
+	else \
+	  mv $(TARGET_SUBDIR)/libgm2/multilib.tmp $(TARGET_SUBDIR)/libgm2/multilib.out; \
+	fi; \
+	test ! -f $(TARGET_SUBDIR)/libgm2/Makefile || exit 0; \
+	$(SHELL) $(srcdir)/mkinstalldirs $(TARGET_SUBDIR)/libgm2; \
+	$(NORMAL_TARGET_EXPORTS)  \
+	echo Configuring in $(TARGET_SUBDIR)/libgm2; \
+	cd "$(TARGET_SUBDIR)/libgm2" || exit 1; \
+	case $(srcdir) in \
+	  /* | [A-Za-z]:[\\/]*) topdir=$(srcdir) ;; \
+	  *) topdir=`echo $(TARGET_SUBDIR)/libgm2/ | \
+		sed -e 's,\./,,g' -e 's,[^/]*/,../,g' `$(srcdir) ;; \
+	esac; \
+	module_srcdir=libgm2; \
+	rm -f no-such-file || : ; \
+	CONFIG_SITE=no-such-file $(SHELL) \
+	  $$s/$$module_srcdir/configure \
+	  --srcdir=$${topdir}/$$module_srcdir \
+	  $(TARGET_CONFIGARGS) --build=${build_alias} --host=${target_alias} \
+	  --target=${target_alias}  \
+	  || exit 1
+@endif target-libgm2
+
+
+
+
+
+.PHONY: all-target-libgm2 maybe-all-target-libgm2
+maybe-all-target-libgm2:
+@if gcc-bootstrap
+all-target-libgm2: stage_current
+@endif gcc-bootstrap
+@if target-libgm2
+TARGET-target-libgm2=all
+maybe-all-target-libgm2: all-target-libgm2
+all-target-libgm2: configure-target-libgm2
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS)  \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) $(EXTRA_TARGET_FLAGS)   \
+		$(TARGET-target-libgm2))
+@endif target-libgm2
+
+
+
+
+
+.PHONY: check-target-libgm2 maybe-check-target-libgm2
+maybe-check-target-libgm2:
+@if target-libgm2
+maybe-check-target-libgm2: check-target-libgm2
+
+check-target-libgm2:
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(TARGET_FLAGS_TO_PASS)   check)
+
+@endif target-libgm2
+
+.PHONY: install-target-libgm2 maybe-install-target-libgm2
+maybe-install-target-libgm2:
+@if target-libgm2
+maybe-install-target-libgm2: install-target-libgm2
+
+install-target-libgm2: installdirs
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(TARGET_FLAGS_TO_PASS)  install)
+
+@endif target-libgm2
+
+.PHONY: install-strip-target-libgm2 maybe-install-strip-target-libgm2
+maybe-install-strip-target-libgm2:
+@if target-libgm2
+maybe-install-strip-target-libgm2: install-strip-target-libgm2
+
+install-strip-target-libgm2: installdirs
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(TARGET_FLAGS_TO_PASS)  install-strip)
+
+@endif target-libgm2
+
+# Other targets (info, dvi, pdf, etc.)
+
+.PHONY: maybe-info-target-libgm2 info-target-libgm2
+maybe-info-target-libgm2:
+@if target-libgm2
+maybe-info-target-libgm2: info-target-libgm2
+
+info-target-libgm2: \
+    configure-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing info in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           info) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-dvi-target-libgm2 dvi-target-libgm2
+maybe-dvi-target-libgm2:
+@if target-libgm2
+maybe-dvi-target-libgm2: dvi-target-libgm2
+
+dvi-target-libgm2: \
+    configure-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing dvi in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           dvi) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-pdf-target-libgm2 pdf-target-libgm2
+maybe-pdf-target-libgm2:
+@if target-libgm2
+maybe-pdf-target-libgm2: pdf-target-libgm2
+
+pdf-target-libgm2: \
+    configure-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing pdf in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           pdf) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-html-target-libgm2 html-target-libgm2
+maybe-html-target-libgm2:
+@if target-libgm2
+maybe-html-target-libgm2: html-target-libgm2
+
+html-target-libgm2: \
+    configure-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing html in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           html) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-TAGS-target-libgm2 TAGS-target-libgm2
+maybe-TAGS-target-libgm2:
+@if target-libgm2
+maybe-TAGS-target-libgm2: TAGS-target-libgm2
+
+TAGS-target-libgm2: \
+    configure-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing TAGS in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           TAGS) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-install-info-target-libgm2 install-info-target-libgm2
+maybe-install-info-target-libgm2:
+@if target-libgm2
+maybe-install-info-target-libgm2: install-info-target-libgm2
+
+install-info-target-libgm2: \
+    configure-target-libgm2 \
+    info-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing install-info in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           install-info) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-install-dvi-target-libgm2 install-dvi-target-libgm2
+maybe-install-dvi-target-libgm2:
+@if target-libgm2
+maybe-install-dvi-target-libgm2: install-dvi-target-libgm2
+
+install-dvi-target-libgm2: \
+    configure-target-libgm2 \
+    dvi-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing install-dvi in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           install-dvi) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-install-pdf-target-libgm2 install-pdf-target-libgm2
+maybe-install-pdf-target-libgm2:
+@if target-libgm2
+maybe-install-pdf-target-libgm2: install-pdf-target-libgm2
+
+install-pdf-target-libgm2: \
+    configure-target-libgm2 \
+    pdf-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing install-pdf in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           install-pdf) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-install-html-target-libgm2 install-html-target-libgm2
+maybe-install-html-target-libgm2:
+@if target-libgm2
+maybe-install-html-target-libgm2: install-html-target-libgm2
+
+install-html-target-libgm2: \
+    configure-target-libgm2 \
+    html-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing install-html in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           install-html) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-installcheck-target-libgm2 installcheck-target-libgm2
+maybe-installcheck-target-libgm2:
+@if target-libgm2
+maybe-installcheck-target-libgm2: installcheck-target-libgm2
+
+installcheck-target-libgm2: \
+    configure-target-libgm2 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing installcheck in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           installcheck) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-mostlyclean-target-libgm2 mostlyclean-target-libgm2
+maybe-mostlyclean-target-libgm2:
+@if target-libgm2
+maybe-mostlyclean-target-libgm2: mostlyclean-target-libgm2
+
+mostlyclean-target-libgm2: 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing mostlyclean in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           mostlyclean) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-clean-target-libgm2 clean-target-libgm2
+maybe-clean-target-libgm2:
+@if target-libgm2
+maybe-clean-target-libgm2: clean-target-libgm2
+
+clean-target-libgm2: 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing clean in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           clean) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-distclean-target-libgm2 distclean-target-libgm2
+maybe-distclean-target-libgm2:
+@if target-libgm2
+maybe-distclean-target-libgm2: distclean-target-libgm2
+
+distclean-target-libgm2: 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing distclean in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           distclean) \
+	  || exit 1
+
+@endif target-libgm2
+
+.PHONY: maybe-maintainer-clean-target-libgm2 maintainer-clean-target-libgm2
+maybe-maintainer-clean-target-libgm2:
+@if target-libgm2
+maybe-maintainer-clean-target-libgm2: maintainer-clean-target-libgm2
+
+maintainer-clean-target-libgm2: 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libgm2/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing maintainer-clean in $(TARGET_SUBDIR)/libgm2"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libgm2 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+	          "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+	          "RANLIB=$${RANLIB}" \
+	          "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \
+	           maintainer-clean) \
+	  || exit 1
+
+@endif target-libgm2
+
+
+
+
+
 .PHONY: configure-target-libgomp maybe-configure-target-libgomp
 maybe-configure-target-libgomp:
 @if gcc-bootstrap
@@ -61221,6 +61744,14 @@ check-gcc-go:
 	(cd gcc && $(MAKE) $(GCC_FLAGS_TO_PASS) check-go);
 check-go: check-gcc-go check-target-libgo check-gotools
 
+.PHONY: check-gcc-m2 check-m2
+check-gcc-m2:
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(HOST_EXPORTS) \
+	(cd gcc && $(MAKE) $(GCC_FLAGS_TO_PASS) check-m2);
+check-m2: check-gcc-m2 check-target-libgm2
+
 .PHONY: check-gcc-d check-d
 check-gcc-d:
 	r=`${PWD_COMMAND}`; export r; \
@@ -64679,6 +65210,7 @@ configure-stageautoprofile-target-zlib: maybe-all-stageautoprofile-gcc
 configure-stageautofeedback-target-zlib: maybe-all-stageautofeedback-gcc
 configure-target-rda: stage_last
 configure-target-libada: stage_last
+configure-target-libgm2: stage_last
 configure-stage1-target-libgomp: maybe-all-stage1-gcc
 configure-stage2-target-libgomp: maybe-all-stage2-gcc
 configure-stage3-target-libgomp: maybe-all-stage3-gcc
@@ -64720,6 +65252,7 @@ configure-target-libffi: maybe-all-gcc
 configure-target-zlib: maybe-all-gcc
 configure-target-rda: maybe-all-gcc
 configure-target-libada: maybe-all-gcc
+configure-target-libgm2: maybe-all-gcc
 configure-target-libgomp: maybe-all-gcc
 configure-target-libitm: maybe-all-gcc
 configure-target-libatomic: maybe-all-gcc
@@ -66006,6 +66539,8 @@ all-target-fastjar: maybe-all-target-zlib
 configure-target-libgo: maybe-all-target-libstdc++-v3
 all-target-libgo: maybe-all-target-libbacktrace
 all-target-libgo: maybe-all-target-libatomic
+configure-target-libgm2: maybe-all-target-libstdc++-v3
+all-target-libgm2: maybe-all-target-libatomic
 configure-target-newlib: maybe-all-binutils
 configure-target-newlib: maybe-all-ld
 configure-target-libgfortran: maybe-all-target-libbacktrace
@@ -66111,6 +66646,7 @@ configure-target-libffi: maybe-all-target-libgcc
 configure-target-zlib: maybe-all-target-libgcc
 configure-target-rda: maybe-all-target-libgcc
 configure-target-libada: maybe-all-target-libgcc
+configure-target-libgm2: maybe-all-target-libgcc
 configure-target-libgomp: maybe-all-target-libgcc
 configure-target-libitm: maybe-all-target-libgcc
 configure-target-libatomic: maybe-all-target-libgcc
@@ -66153,6 +66689,8 @@ configure-target-rda: maybe-all-target-newlib maybe-all-target-libgloss
 
 configure-target-libada: maybe-all-target-newlib maybe-all-target-libgloss
 
+configure-target-libgm2: maybe-all-target-newlib maybe-all-target-libgloss
+
 configure-target-libgomp: maybe-all-target-newlib maybe-all-target-libgloss
 
 configure-target-libitm: maybe-all-target-newlib maybe-all-target-libgloss
diff --git a/Makefile.tpl b/Makefile.tpl
index c7344558429..dfbd74b68f8 100644
--- a/Makefile.tpl
+++ b/Makefile.tpl
@@ -166,6 +166,8 @@ BUILD_EXPORTS = \
 	GOCFLAGS="$(GOCFLAGS_FOR_BUILD)"; export GOCFLAGS; \
 	GDC="$(GDC_FOR_BUILD)"; export GDC; \
 	GDCFLAGS="$(GDCFLAGS_FOR_BUILD)"; export GDCFLAGS; \
+	GM2="$(GM2_FOR_BUILD)"; export GM2; \
+	GM2FLAGS="$(GM2FLAGS_FOR_BUILD)"; export GM2FLAGS; \
 	DLLTOOL="$(DLLTOOL_FOR_BUILD)"; export DLLTOOL; \
 	DSYMUTIL="$(DSYMUTIL_FOR_BUILD)"; export DSYMUTIL; \
 	LD="$(LD_FOR_BUILD)"; export LD; \
@@ -204,6 +206,7 @@ HOST_EXPORTS = \
 	GFORTRAN="$(GFORTRAN)"; export GFORTRAN; \
 	GOC="$(GOC)"; export GOC; \
 	GDC="$(GDC)"; export GDC; \
+	GM2="$(GM2)"; export GM2; \
 	AR="$(AR)"; export AR; \
 	AS="$(AS)"; export AS; \
 	CC_FOR_BUILD="$(CC_FOR_BUILD)"; export CC_FOR_BUILD; \
@@ -307,6 +310,7 @@ BASE_TARGET_EXPORTS = \
 	GFORTRAN="$(GFORTRAN_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GFORTRAN; \
 	GOC="$(GOC_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GOC; \
 	GDC="$(GDC_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GDC; \
+	GM2="$(GM2_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GM2; \
 	DLLTOOL="$(DLLTOOL_FOR_TARGET)"; export DLLTOOL; \
 	DSYMUTIL="$(DSYMUTIL_FOR_TARGET)"; export DSYMUTIL; \
 	LD="$(COMPILER_LD_FOR_TARGET)"; export LD; \
@@ -373,6 +377,7 @@ DSYMUTIL_FOR_BUILD = @DSYMUTIL_FOR_BUILD@
 GFORTRAN_FOR_BUILD = @GFORTRAN_FOR_BUILD@
 GOC_FOR_BUILD = @GOC_FOR_BUILD@
 GDC_FOR_BUILD = @GDC_FOR_BUILD@
+GM2_FOR_BUILD = @GM2_FOR_BUILD@
 LDFLAGS_FOR_BUILD = @LDFLAGS_FOR_BUILD@
 LD_FOR_BUILD = @LD_FOR_BUILD@
 NM_FOR_BUILD = @NM_FOR_BUILD@
@@ -443,6 +448,7 @@ CXXFLAGS = @CXXFLAGS@
 LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates
 GOCFLAGS = $(CFLAGS)
 GDCFLAGS = $(CFLAGS)
+GM2FLAGS = $(CFLAGS)
 
 # Pass additional PGO and LTO compiler options to the PGO build.
 BUILD_CFLAGS = $(PGO_BUILD_CFLAGS) $(PGO_BUILD_LTO_CFLAGS)
@@ -578,6 +584,7 @@ RAW_CXX_FOR_TARGET=$(STAGE_CC_WRAPPER) @RAW_CXX_FOR_TARGET@
 GFORTRAN_FOR_TARGET=$(STAGE_CC_WRAPPER) @GFORTRAN_FOR_TARGET@
 GOC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GOC_FOR_TARGET@
 GDC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GDC_FOR_TARGET@
+GM2_FOR_TARGET=$(STAGE_CC_WRAPPER) @GM2_FOR_TARGET@
 DLLTOOL_FOR_TARGET=@DLLTOOL_FOR_TARGET@
 DSYMUTIL_FOR_TARGET=@DSYMUTIL_FOR_TARGET@
 LD_FOR_TARGET=@LD_FOR_TARGET@
@@ -603,6 +610,7 @@ CXXFLAGS_FOR_TARGET = @CXXFLAGS_FOR_TARGET@
 LIBCFLAGS_FOR_TARGET = $(CFLAGS_FOR_TARGET)
 LIBCXXFLAGS_FOR_TARGET = $(CXXFLAGS_FOR_TARGET) -fno-implicit-templates
 LDFLAGS_FOR_TARGET = @LDFLAGS_FOR_TARGET@
+GM2FLAGS_FOR_TARGET = -O2 -g
 GOCFLAGS_FOR_TARGET = -O2 -g
 GDCFLAGS_FOR_TARGET = -O2 -g
 
@@ -709,6 +717,7 @@ EXTRA_HOST_FLAGS = \
 	'GFORTRAN=$(GFORTRAN)' \
 	'GOC=$(GOC)' \
 	'GDC=$(GDC)' \
+	'GM2=$(GM2)' \
 	'LD=$(LD)' \
 	'LIPO=$(LIPO)' \
 	'NM=$(NM)' \
@@ -735,6 +744,7 @@ POSTSTAGE1_FLAGS_TO_PASS = \
 	CC="$${CC}" CC_FOR_BUILD="$${CC_FOR_BUILD}" \
 	CXX="$${CXX}" CXX_FOR_BUILD="$${CXX_FOR_BUILD}" \
 	GDC="$${GDC}" GDC_FOR_BUILD="$${GDC_FOR_BUILD}" \
+	GM2="$${GM2}" GM2_FOR_BUILD="$${GM2_FOR_BUILD}" \
 	GNATBIND="$${GNATBIND}" \
 	LDFLAGS="$${LDFLAGS}" \
 	HOST_LIBS="$${HOST_LIBS}" \
@@ -770,6 +780,8 @@ EXTRA_TARGET_FLAGS = \
 	'GOCFLAGS=$$(GOCFLAGS_FOR_TARGET)' \
 	'GDC=$$(GDC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GDCFLAGS=$$(GDCFLAGS_FOR_TARGET)' \
+	'GM2=$$(GM2_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
+	'GM2FLAGS=$$(GM2FLAGS_FOR_TARGET)' \
 	'LD=$(COMPILER_LD_FOR_TARGET)' \
 	'LDFLAGS=$$(LDFLAGS_FOR_TARGET)' \
 	'LIBCFLAGS=$$(LIBCFLAGS_FOR_TARGET)' \
@@ -796,6 +808,7 @@ TARGET_FLAGS_TO_PASS = $(BASE_FLAGS_TO_PASS) $(EXTRA_TARGET_FLAGS)
 # cross-building scheme.
 EXTRA_GCC_FLAGS = \
 	"GCC_FOR_TARGET=$(GCC_FOR_TARGET) $$TFLAGS" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET) $$TFLAGS" \
 	"`echo 'STMP_FIXPROTO=$(STMP_FIXPROTO)' | sed -e s'/[^=][^=]*=$$/XFOO=/'`" \
 	"`echo 'LIMITS_H_TEST=$(LIMITS_H_TEST)' | sed -e s'/[^=][^=]*=$$/XFOO=/'`"
 
diff --git a/configure b/configure
index 6815216cf49..2b86f25656b 100755
--- a/configure
+++ b/configure
@@ -613,6 +613,7 @@ DSYMUTIL_FOR_TARGET
 DLLTOOL_FOR_TARGET
 AS_FOR_TARGET
 AR_FOR_TARGET
+GM2_FOR_TARGET
 GDC_FOR_TARGET
 GOC_FOR_TARGET
 GFORTRAN_FOR_TARGET
@@ -803,6 +804,7 @@ enable_compressed_debug_sections
 enable_libquadmath
 enable_libquadmath_support
 enable_libada
+enable_libgm2
 enable_libssp
 enable_libstdcxx
 enable_bootstrap
@@ -880,6 +882,7 @@ GCC_FOR_TARGET
 GFORTRAN_FOR_TARGET
 GOC_FOR_TARGET
 GDC_FOR_TARGET
+GM2_FOR_TARGET
 AR_FOR_TARGET
 AS_FOR_TARGET
 DLLTOOL_FOR_TARGET
@@ -1540,6 +1543,7 @@ Optional Features:
   --disable-libquadmath-support
                           disable libquadmath support for Fortran
   --enable-libada         build libada directory
+  --enable-libgm2         build libgm2 directory
   --enable-libssp         build libssp directory
   --disable-libstdcxx     do not build libstdc++-v3 directory
   --enable-bootstrap      enable bootstrapping [yes if native build]
@@ -1674,6 +1678,8 @@ Some influential environment variables:
               GOC for the target
   GDC_FOR_TARGET
               GDC for the target
+  GM2_FOR_TARGET
+              GM2 for the target
   AR_FOR_TARGET
               AR for the target
   AS_FOR_TARGET
@@ -2812,7 +2818,7 @@ host_libs="intl libiberty opcodes bfd readline tcl tk itcl libgui zlib libbacktr
 # binutils, gas and ld appear in that order because it makes sense to run
 # "make check" in that particular order.
 # If --enable-gold is used, "gold" may replace "ld".
-host_tools="texinfo flex bison binutils gas ld fixincludes gcc cgen sid sim gdb gdbserver gprof etc expect dejagnu m4 utils guile fastjar gnattools libcc1 gotools c++tools"
+host_tools="texinfo flex bison binutils gas ld fixincludes gcc cgen sid sim gdb gdbserver gprof etc expect dejagnu m4 utils guile fastjar gnattools libcc1 gm2tools gotools c++tools"
 
 # these libraries are built for the target environment, and are built after
 # the host libraries and the host tools (which may be a cross compiler)
@@ -2833,6 +2839,7 @@ target_libraries="target-libgcc \
 		target-libffi \
 		target-libobjc \
 		target-libada \
+		target-libgm2 \
 		target-libgo \
 		target-libphobos \
 		target-zlib"
@@ -3176,6 +3183,17 @@ if test "${ENABLE_LIBADA}" != "yes" ; then
   noconfigdirs="$noconfigdirs gnattools"
 fi
 
+# Check whether --enable-libgm2 was given.
+if test "${enable_libgm2+set}" = set; then :
+  enableval=$enable_libgm2; ENABLE_LIBGM2=$enableval
+else
+  ENABLE_LIBGM2=no
+fi
+
+if test "${ENABLE_LIBGM2}" != "yes" ; then
+  noconfigdirs="$noconfigdirs gm2tools"
+fi
+
 # Check whether --enable-libssp was given.
 if test "${enable_libssp+set}" = set; then :
   enableval=$enable_libssp; ENABLE_LIBSSP=$enableval
@@ -13786,6 +13804,167 @@ fi
 
 
 
+if test -n "$GM2_FOR_TARGET"; then
+  ac_cv_prog_GM2_FOR_TARGET=$GM2_FOR_TARGET
+elif test -n "$ac_cv_prog_GM2_FOR_TARGET"; then
+  GM2_FOR_TARGET=$ac_cv_prog_GM2_FOR_TARGET
+fi
+
+if test -n "$ac_cv_prog_GM2_FOR_TARGET"; then
+  for ncn_progname in gm2; do
+    # Extract the first word of "${ncn_progname}", so it can be a program name with args.
+set dummy ${ncn_progname}; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_GM2_FOR_TARGET+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$GM2_FOR_TARGET"; then
+  ac_cv_prog_GM2_FOR_TARGET="$GM2_FOR_TARGET" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_GM2_FOR_TARGET="${ncn_progname}"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+GM2_FOR_TARGET=$ac_cv_prog_GM2_FOR_TARGET
+if test -n "$GM2_FOR_TARGET"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GM2_FOR_TARGET" >&5
+$as_echo "$GM2_FOR_TARGET" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  done
+fi
+
+if test -z "$ac_cv_prog_GM2_FOR_TARGET" && test -n "$with_build_time_tools"; then
+  for ncn_progname in gm2; do
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ncn_progname} in $with_build_time_tools" >&5
+$as_echo_n "checking for ${ncn_progname} in $with_build_time_tools... " >&6; }
+    if test -x $with_build_time_tools/${ncn_progname}; then
+      ac_cv_prog_GM2_FOR_TARGET=$with_build_time_tools/${ncn_progname}
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+      break
+    else
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+    fi
+  done
+fi
+
+if test -z "$ac_cv_prog_GM2_FOR_TARGET"; then
+  for ncn_progname in gm2; do
+    if test -n "$ncn_target_tool_prefix"; then
+      # Extract the first word of "${ncn_target_tool_prefix}${ncn_progname}", so it can be a program name with args.
+set dummy ${ncn_target_tool_prefix}${ncn_progname}; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_GM2_FOR_TARGET+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$GM2_FOR_TARGET"; then
+  ac_cv_prog_GM2_FOR_TARGET="$GM2_FOR_TARGET" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_GM2_FOR_TARGET="${ncn_target_tool_prefix}${ncn_progname}"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+GM2_FOR_TARGET=$ac_cv_prog_GM2_FOR_TARGET
+if test -n "$GM2_FOR_TARGET"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GM2_FOR_TARGET" >&5
+$as_echo "$GM2_FOR_TARGET" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    fi
+    if test -z "$ac_cv_prog_GM2_FOR_TARGET" && test $build = $target ; then
+      # Extract the first word of "${ncn_progname}", so it can be a program name with args.
+set dummy ${ncn_progname}; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_GM2_FOR_TARGET+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$GM2_FOR_TARGET"; then
+  ac_cv_prog_GM2_FOR_TARGET="$GM2_FOR_TARGET" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_GM2_FOR_TARGET="${ncn_progname}"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+GM2_FOR_TARGET=$ac_cv_prog_GM2_FOR_TARGET
+if test -n "$GM2_FOR_TARGET"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GM2_FOR_TARGET" >&5
+$as_echo "$GM2_FOR_TARGET" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    fi
+    test -n "$ac_cv_prog_GM2_FOR_TARGET" && break
+  done
+fi
+
+if test -z "$ac_cv_prog_GM2_FOR_TARGET" ; then
+  set dummy gm2
+  if test $build = $target ; then
+    GM2_FOR_TARGET="$2"
+  else
+    GM2_FOR_TARGET="${ncn_target_tool_prefix}$2"
+  fi
+else
+  GM2_FOR_TARGET="$ac_cv_prog_GM2_FOR_TARGET"
+fi
+
+
+
 cat > conftest.c << \EOF
 #ifdef __GNUC__
   gcc_yay;
@@ -17718,6 +17897,51 @@ $as_echo "pre-installed" >&6; }
   fi
 fi
 
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking where to find the target gm2" >&5
+$as_echo_n "checking where to find the target gm2... " >&6; }
+if test "x${build}" != "x${host}" ; then
+  if expr "x$GM2_FOR_TARGET" : "x/" > /dev/null; then
+    # We already found the complete path
+    ac_dir=`dirname $GM2_FOR_TARGET`
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: pre-installed in $ac_dir" >&5
+$as_echo "pre-installed in $ac_dir" >&6; }
+  else
+    # Canadian cross, just use what we found
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: pre-installed" >&5
+$as_echo "pre-installed" >&6; }
+  fi
+else
+  ok=yes
+  case " ${configdirs} " in
+    *" gcc "*) ;;
+    *) ok=no ;;
+  esac
+  case ,${enable_languages}, in
+    *,m2,*) ;;
+    *) ok=no ;;
+  esac
+  if test $ok = yes; then
+    # An in-tree tool is available and we can use it
+    GM2_FOR_TARGET='$$r/$(HOST_SUBDIR)/gcc/gm2 -B$$r/$(HOST_SUBDIR)/gcc/'
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: just compiled" >&5
+$as_echo "just compiled" >&6; }
+  elif expr "x$GM2_FOR_TARGET" : "x/" > /dev/null; then
+    # We already found the complete path
+    ac_dir=`dirname $GM2_FOR_TARGET`
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: pre-installed in $ac_dir" >&5
+$as_echo "pre-installed in $ac_dir" >&6; }
+  elif test "x$target" = "x$host"; then
+    # We can use an host tool
+    GM2_FOR_TARGET='$(GM2)'
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: host tool" >&5
+$as_echo "host tool" >&6; }
+  else
+    # We need a cross tool
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: pre-installed" >&5
+$as_echo "pre-installed" >&6; }
+  fi
+fi
+
 { $as_echo "$as_me:${as_lineno-$LINENO}: checking where to find the target ld" >&5
 $as_echo_n "checking where to find the target ld... " >&6; }
 if test "x${build}" != "x${host}" ; then
@@ -18279,6 +18503,9 @@ fi
 # Specify what files to not compare during bootstrap.
 
 compare_exclusions="gcc/cc*-checksum\$(objext) | gcc/ada/*tools/*"
+compare_exclusions="$compare_exclusions | gcc/m2/gm2-compiler-boot/M2Version*"
+compare_exclusions="$compare_exclusions | gcc/m2/gm2-compiler-boot/SYSTEM*"
+compare_exclusions="$compare_exclusions | gcc/m2/gm2version*"
 case "$target" in
   hppa*64*-*-hpux*) ;;
   powerpc*-ibm-aix*) compare_exclusions="$compare_exclusions | *libgomp*\$(objext)" ;;
diff --git a/configure.ac b/configure.ac
index 83bbc4cd04d..c5191ce24ae 100644
--- a/configure.ac
+++ b/configure.ac
@@ -140,7 +140,7 @@ host_libs="intl libiberty opcodes bfd readline tcl tk itcl libgui zlib libbacktr
 # binutils, gas and ld appear in that order because it makes sense to run
 # "make check" in that particular order.
 # If --enable-gold is used, "gold" may replace "ld".
-host_tools="texinfo flex bison binutils gas ld fixincludes gcc cgen sid sim gdb gdbserver gprof etc expect dejagnu m4 utils guile fastjar gnattools libcc1 gotools c++tools"
+host_tools="texinfo flex bison binutils gas ld fixincludes gcc cgen sid sim gdb gdbserver gprof etc expect dejagnu m4 utils guile fastjar gnattools libcc1 gm2tools gotools c++tools"
 
 # these libraries are built for the target environment, and are built after
 # the host libraries and the host tools (which may be a cross compiler)
@@ -161,6 +161,7 @@ target_libraries="target-libgcc \
 		target-libffi \
 		target-libobjc \
 		target-libada \
+		target-libgm2 \
 		target-libgo \
 		target-libphobos \
 		target-zlib"
@@ -464,6 +465,14 @@ if test "${ENABLE_LIBADA}" != "yes" ; then
   noconfigdirs="$noconfigdirs gnattools"
 fi
 
+AC_ARG_ENABLE(libgm2,
+[AS_HELP_STRING([--enable-libgm2], [build libgm2 directory])],
+ENABLE_LIBGM2=$enableval,
+ENABLE_LIBGM2=no)
+if test "${ENABLE_LIBGM2}" != "yes" ; then
+  noconfigdirs="$noconfigdirs gm2tools"
+fi
+
 AC_ARG_ENABLE(libssp,
 [AS_HELP_STRING([--enable-libssp], [build libssp directory])],
 ENABLE_LIBSSP=$enableval,
@@ -3579,6 +3588,7 @@ NCN_STRICT_CHECK_TARGET_TOOLS(GCC_FOR_TARGET, gcc, ${CC_FOR_TARGET})
 NCN_STRICT_CHECK_TARGET_TOOLS(GFORTRAN_FOR_TARGET, gfortran)
 NCN_STRICT_CHECK_TARGET_TOOLS(GOC_FOR_TARGET, gccgo)
 NCN_STRICT_CHECK_TARGET_TOOLS(GDC_FOR_TARGET, gdc)
+NCN_STRICT_CHECK_TARGET_TOOLS(GM2_FOR_TARGET, gm2)
 
 ACX_CHECK_INSTALLED_TARGET_TOOL(AR_FOR_TARGET, ar)
 ACX_CHECK_INSTALLED_TARGET_TOOL(AS_FOR_TARGET, as)
@@ -3617,6 +3627,8 @@ GCC_TARGET_TOOL(gccgo, GOC_FOR_TARGET, GOC,
 		[gcc/gccgo -B$$r/$(HOST_SUBDIR)/gcc/], go)
 GCC_TARGET_TOOL(gdc, GDC_FOR_TARGET, GDC,
 		[gcc/gdc -B$$r/$(HOST_SUBDIR)/gcc/], d)
+GCC_TARGET_TOOL(gm2, GM2_FOR_TARGET, GM2,
+		[gcc/gm2 -B$$r/$(HOST_SUBDIR)/gcc/], m2)
 GCC_TARGET_TOOL(ld, LD_FOR_TARGET, LD, [ld/ld-new])
 GCC_TARGET_TOOL(lipo, LIPO_FOR_TARGET, LIPO)
 GCC_TARGET_TOOL(nm, NM_FOR_TARGET, NM, [binutils/nm-new])
@@ -3743,6 +3755,9 @@ AC_SUBST(stage2_werror_flag)
 # Specify what files to not compare during bootstrap.
 
 compare_exclusions="gcc/cc*-checksum\$(objext) | gcc/ada/*tools/*"
+compare_exclusions="$compare_exclusions | gcc/m2/gm2-compiler-boot/M2Version*"
+compare_exclusions="$compare_exclusions | gcc/m2/gm2-compiler-boot/SYSTEM*"
+compare_exclusions="$compare_exclusions | gcc/m2/gm2version*"
 case "$target" in
   hppa*64*-*-hpux*) ;;
   powerpc*-ibm-aix*) compare_exclusions="$compare_exclusions | *libgomp*\$(objext)" ;;
diff --git a/gcc/config.in b/gcc/config.in
index 38ef792bd67..4cad077bfbe 100644
--- a/gcc/config.in
+++ b/gcc/config.in
@@ -211,6 +211,12 @@
 #endif
 
 
+/* If --with-multiarch option is used */
+#ifndef USED_FOR_TARGET
+#undef ENABLE_MULTIARCH
+#endif
+
+
 /* Define to 1 if translation of program messages to the user's native
    language is requested. */
 #ifndef USED_FOR_TARGET
@@ -2324,12 +2330,6 @@
 #endif
 
 
-/* Specify if mutliarch is enabled. */
-#ifndef USED_FOR_TARGET
-#undef ENABLE_MULTIARCH
-#endif
-
-
 /* The size of `dev_t', as computed by sizeof. */
 #ifndef USED_FOR_TARGET
 #undef SIZEOF_DEV_T
diff --git a/gcc/configure b/gcc/configure
index 6af7dbd06b0..61b3cedbe69 100755
--- a/gcc/configure
+++ b/gcc/configure
@@ -805,6 +805,8 @@ am__leading_dot
 doc_build_sys
 AR
 NM
+HAVE_PYTHON
+PYTHON
 BISON
 FLEX
 GENERATED_MANPAGES
@@ -8899,6 +8901,84 @@ done
 test -n "$BISON" || BISON="$MISSING bison"
 
 
+# Python3?
+
+  # Extract the first word of "python3", so it can be a program name with args.
+set dummy python3; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_PYTHON+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$PYTHON"; then
+  ac_cv_prog_PYTHON="$PYTHON" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_PYTHON="python3"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+PYTHON=$ac_cv_prog_PYTHON
+if test -n "$PYTHON"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PYTHON" >&5
+$as_echo "$PYTHON" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  if test -n "$PYTHON"; then
+    # Found it, now check the version.
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for modern python3" >&5
+$as_echo_n "checking for modern python3... " >&6; }
+if ${gcc_cv_prog_python3_modern+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_prog_version=`eval $PYTHON --version 2>&1 |
+                                     sed -n 's/^.*Python.* \([0-9][0-9.]*\).*$/\1/p'`
+
+                    case $ac_prog_version in
+                      '')  gcc_cv_prog_python3_modern=no;;
+                      3.[4-9]*|3.[1-9][0-9]*|[4-9].*|[1-9][0-9]*)  gcc_cv_prog_python3_modern=yes;;
+                      *)   gcc_cv_prog_python3_modern=no;;
+                    esac
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gcc_cv_prog_python3_modern" >&5
+$as_echo "$gcc_cv_prog_python3_modern" >&6; }
+  else
+    gcc_cv_prog_python3_modern=no
+  fi
+  if test $gcc_cv_prog_python3_modern = no; then
+    PYTHON="${CONFIG_SHELL-/bin/sh} $ac_aux_dir/missing python3"
+  fi
+
+if test $gcc_cv_prog_python3_modern = no; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING:
+*** Python3 is missing.
+*** Documentation for modula-2 will not include the target SYSTEM module." >&5
+$as_echo "$as_me: WARNING:
+*** Python3 is missing.
+*** Documentation for modula-2 will not include the target SYSTEM module." >&2;}
+  HAVE_PYTHON=no
+else
+  HAVE_PYTHON=yes
+fi
+
+
 # Binutils are not build modules, unlike bison/flex/makeinfo.  So we
 # check for build == host before using them.
 
@@ -19712,7 +19792,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 19715 "configure"
+#line 19795 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -19818,7 +19898,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 19821 "configure"
+#line 19901 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -33909,4 +33989,3 @@ if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
 $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
 fi
 
-
diff --git a/gcc/configure.ac b/gcc/configure.ac
index 7ca08726efa..5efbf11793c 100644
--- a/gcc/configure.ac
+++ b/gcc/configure.ac
@@ -1263,6 +1263,20 @@ AC_CHECK_PROGS([FLEX], flex, [$MISSING flex])
 # Bison?
 AC_CHECK_PROGS([BISON], bison, [$MISSING bison])
 
+# Python3?
+ACX_CHECK_PROG_VER(PYTHON, python3, --version,
+  [Python.* \([0-9][0-9.]*\)],
+  [3.[4-9]*|3.[1-9][0-9]*|[4-9].*|[1-9][0-9]*])
+if test $gcc_cv_prog_python3_modern = no; then
+  AC_MSG_WARN([
+*** Python3 is missing.
+*** Documentation for modula-2 will not include the target SYSTEM module.])
+  HAVE_PYTHON=no
+else
+  HAVE_PYTHON=yes
+fi
+AC_SUBST(HAVE_PYTHON)
+
 # Binutils are not build modules, unlike bison/flex/makeinfo.  So we
 # check for build == host before using them.
 
@@ -7651,4 +7665,3 @@ done
 ], 
 [subdirs='$subdirs'])
 AC_OUTPUT
-
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
new file mode 100644
index 00000000000..513fdd3ec7f
--- /dev/null
+++ b/gcc/doc/gm2.texi
@@ -0,0 +1,2838 @@
+\input texinfo
+@c -*-texinfo-*-
+@c Copyright (C) 2001-2022 Free Software Foundation, Inc.
+@c This is part of the GM2 manual.
+
+@c User level documentation for GNU Modula-2
+@c
+@c header
+
+@setfilename gm2.info
+@settitle The GNU Modula-2 Compiler
+
+@set version-python  3.5
+
+@include gcc-common.texi
+
+@c Copyright years for this manual.
+@set copyrights-gm2 1999-2022
+
+@copying
+@c man begin COPYRIGHT
+Copyright @copyright{} @value{copyrights-gm2} Free Software Foundation, Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
+A copy of the license is included in the
+@c man end
+section entitled ``GNU Free Documentation License''.
+@ignore
+@c man begin COPYRIGHT
+man page gfdl(7).
+@c man end
+@end ignore
+@end copying
+
+@ifinfo
+@format
+@dircategory Software development
+@direntry
+* gm2: (gm2).               A GCC-based compiler for the Modula-2 language
+@end direntry
+@end format
+
+@insertcopying
+@end ifinfo
+
+@titlepage
+@title The GNU Modula-2 Compiler
+@versionsubtitle
+@author Gaius Mulley
+
+@page
+@vskip 0pt plus 1filll
+Published by the Free Software Foundation @*
+51 Franklin Street, Fifth Floor@*
+Boston, MA 02110-1301, USA@*
+@sp 1
+@insertcopying
+@end titlepage
+@contents
+@page
+
+@c `Top' Node and Master Menu
+
+@node Top, Overview, (dir), (dir)
+@top Introduction
+
+@menu
+* Overview::         What is GNU Modula-2.
+* Using::            Using GNU Modula-2.
+* License::          License of GNU Modula-2
+* Copying::          GNU Public License V3.
+* Contributing::     Contributing to GNU Modula-2
+* Internals::        GNU Modula-2 internals.
+* EBNF::             EBNF of GNU Modula-2
+* Libraries::        PIM and ISO library definitions.
+* Indices::          Document and function indices.
+@end menu
+
+@node Overview, Using, Top, Top
+@chapter Overview of GNU Modula-2
+
+@menu
+* What is GNU Modula-2::  Brief description of GNU Modula-2.
+* Why use GNU Modula-2::  Advantages of GNU Modula-2.
+* Development::           How to get source code using git.
+* Features::              GNU Modula-2 Features
+@end menu
+
+@node What is GNU Modula-2, Why use GNU Modula-2, , Using
+@section What is GNU Modula-2
+
+GNU Modula-2 is a @uref{http://gcc.gnu.org/frontends.html, front end}
+for the GNU Compiler Collection (@uref{http://gcc.gnu.org/, GCC}).
+The GNU Modula-2 compiler is compliant with the PIM2, PIM3, PIM4 and
+ISO dialects.  Also implemented are a complete set of free ISO
+libraries and PIM libraries.
+
+@footnote{The four Modula-2 dialects supported are defined in the following
+references:
+
+PIM2: 'Programming in Modula-2', 2nd Edition, Springer Verlag, 1982,
+1983 by Niklaus Wirth (PIM2).
+
+PIM3: 'Programming in Modula-2', 3rd Corrected Edition, Springer Verlag,
+1985 (PIM3).
+
+PIM4: 'Programming in Modula-2', 4th Edition, Springer Verlag, 1988
+(@uref{http://freepages.modula2.org/report4/modula-2.html, PIM4}).
+
+ISO: the ISO Modula-2 language as defined in 'ISO/IEC Information
+technology - programming languages - part 1: Modula-2 Language,
+ISO/IEC 10514-1 (1996)'
+}
+
+@node Why use GNU Modula-2, Release map, What is GNU Modula-2, Using
+@section Why use GNU Modula-2
+
+There are a number of advantages of using GNU Modula-2 rather than
+translate an existing project into another language.
+
+The first advantage is of maintainability of the original sources
+and the ability to debug the original project source code using a
+combination of gm2 and gdb.
+
+The second advantage is that gcc runs on many processors and
+platforms.  gm2 builds and runs on powerpc64le, amd64, i386, aarch64
+to name but a few processors.
+
+gm2 can produce swig interface headers to allow access from Python and
+other scripting languages.  It can also be used with C/C++ and
+generate shared libraries.
+
+The compiler provides semantic analysis and run time checking (full ISO
+Modula-2 checking is implemented) and there is a plugin which can,
+under certain conditions, detect run time errors at compile time.
+
+The compiler supports PIM2, PIM3, PIM4 and ISO dialects of Modula-2,
+work is underway to implement M2R10.  Many of the GCC builtins are
+available and access to assembly programming is achieved using the
+same syntax as that used by GCC.
+
+The gm2 driver allows third party libraries to be installed alongside
+gm2 libraries.  For example if the user specifies library @code{foo}
+using @code{-flibs=foo} the driver will check the standard GCC install
+directory for a sub directory @code{foo} containing the library
+contents.  The library module search path is altered accordingly
+for compile and link.
+
+@node Release map, Development, Why use GNU Modula-2, Using
+@section Release map
+
+GNU Modula-2 is now part of GCC and therefore will adopt the GCC
+release schedule.  It is intended that GNU Modula-2 implement more of
+the GCC builtins (vararg access) and GCC features.
+
+There is an intention to implement the ISO generics and the M2R10
+dialect of Modula-2.  It will also implement all language changes.  If
+you wish to see something different please email
+@email{gm2@@nongnu.org} with your ideas.
+
+@node Development, Features, Release map, Using
+@section How to get source code using git
+
+GNU Modula-2 is now in the @url{https://gcc.gnu.org/git.html, GCC git
+tree}.
+
+@node Features, Documentation, Development, Using
+@section GNU Modula-2 Features
+
+@itemize @bullet
+
+@item
+the compiler currently complies with Programming in Modula-2 Edition
+2, 3, 4 and ISO Modula-2.  Users can switch on specific language
+features by using: @samp{-fpim}, @samp{-fpim2}, @samp{-fpim3},
+@samp{-fpim4} or @samp{-fiso}.
+
+@item
+the option @samp{-fswig} will automatically create a swig interface
+file which corresponds to the definition module of the file being
+compiled.
+
+@item
+exception handling is compatible with C++ and swig.  Modula-2 code can
+be used with C or C++ code.
+
+@item
+Python can call GNU Modula-2 modules via swig.
+
+@item
+shared libraries can be built.
+
+@item
+fixed sized types are now available from @samp{SYSTEM}.
+
+@c @item
+@c support for dynamic @code{ARRAY}s has been added into @samp{gdb}.
+
+@item
+variables can be declared at addresses.
+
+@item
+much better dwarf-2 debugging support and when used with
+@samp{gdb} the programmer can display @code{RECORD}s,
+@code{ARRAY}s, @code{SET}s, subranges and constant char literals
+in Modula-2 syntax.
+
+@item
+supports sets of any ordinal size (memory permitting).
+
+@item
+easy interface to C, and varargs can be passed to C routines.
+
+@item
+many Logitech libraries have been implemented and can be accessed via:
+@samp{-flibs=m2log,m2pim,m2iso}.
+
+@item
+coroutines have been implemented in the PIM style and these are
+accessible from SYSTEM.  A number of supporting libraries (executive
+and file descriptor mapping to interrupt vector libraries are
+available through the @samp{-flibs=m2iso,m2pim} switch).
+
+@item
+can be built as a cross compiler (for embedded microprocessors
+such as the AVR and the ARM).
+
+@end itemize
+
+@node Documentation, Regression tests, Features, Using
+@section Documentation
+
+The GNU Modula-2 documentation is available on line
+@url{https://www.nongnu.org/gm2/homepage.html,at the gm2 homepage}
+or in the pdf, info, html file format.
+
+@node Regression tests, Limitations, Documentation, Using
+@section Regression tests for gm2 in the repository
+
+The regression testsuite can be run from the gcc build directory:
+
+@example
+$ cd build-gcc
+$ make check -j 24
+@end example
+
+which runs the complete testsuite for all compilers using 24 parallel
+invocations of the compiler.  Individual language testsuites can be
+run by specifying the language, for example the Modula-2 testsuite can
+be run using:
+
+@example
+$ cd build-gcc
+$ make check-m2 -j 24
+@end example
+
+Finally the results of the testsuite can be emailed to the
+@url{https://gcc.gnu.org/lists.html, gcc-testresults} list using the
+@file{test_summary} script found in the gcc source tree:
+
+@example
+$ @samp{directory to the sources}/contrib/test_summary
+@end example
+
+@node Limitations, Objectives, Regression tests, Using
+@section Limitations
+
+Logitech compatibility library is incomplete.  The principle modules
+for this platform exist however for a comprehensive list of completed
+modules please check the documentation
+@url{gm2.html}.
+
+@node Objectives, FAQ, , Using
+@section Objectives
+
+@itemize @bullet
+
+@item
+The intention of GNU Modula-2 is to provide a production Modula-2
+front end to GCC.
+
+@item
+It should support all Niklaus Wirth PIM Dialects [234] and also ISO
+Modula-2 including a re-implementation of all the ISO modules.
+
+@item
+There should be an easy interface to C.
+
+@item
+Exploit the features of GCC.
+
+@item
+Listen to the requests of the users.
+@end itemize
+
+@node FAQ, Community, Objectives, Using
+@section FAQ
+
+@subsection Why use the C++ exception mechanism in GCC, rather than a bespoke Modula-2 mechanism?
+
+The C++ mechanism is tried and tested, it also provides GNU Modula-2
+with the ability to link with C++ modules and via swig it can raise
+Python exceptions.
+
+@node Community, Other languages, FAQ, Using
+@section Community
+
+You can subscribe to the GNU Modula-2 mailing by sending an
+email to:
+@email{gm2-subscribe@@nongnu.org}
+or by
+@url{http://lists.nongnu.org/mailman/listinfo/gm2}.
+The mailing list contents can be viewed
+@url{http://lists.gnu.org/archive/html/gm2}.
+
+@node Other languages, , Community, Using
+@section Other languages for GCC
+
+These exist and can be found on the frontends web page on the
+@uref{http://gcc.gnu.org/frontends.html, gcc web site}.
+
+@node Using, , Community, Top
+@chapter Using GNU Modula-2
+
+@menu
+* Example usage::         Example compile and link.
+* Compiler options::      GNU Modula-2 compiler options.
+* Linking::               Linking options in more detail.
+* Elementary data types:: Data types supported by GNU Modula-2.
+* Standard procedures::   Permanently accessible base procedures.
+* Dialect::               GNU Modula-2 supported dialects.
+* Exceptions::            Exception implementation
+* Semantic checking::     How to detect run time problems at compile time.
+* Extensions::            GNU Modula-2 language extensions.
+* Type compatibility::    Data type compatibility.
+* Unbounded by reference::Explanation of a language optimization.
+* Building a shared library:: How to build a shared library.
+* Interface for Python::  How to produce swig interface files.
+* Producing a Python module::  How to produce a Python module.
+* Interface to C::        Interfacing GNU Modula-2 to C.
+* Assembly language::     Interface to assembly language.
+* Alignment::             Data type alignment.
+* Packed::                Packing data types.
+* Built-ins::             Accessing GNU Modula-2 Built-ins.
+* The PIM system module:: SYSTEM data types and procedures.
+* The ISO system module:: SYSTEM data types, procedures and run time.
+* Other languages::       Other languages for GCC.
+* What is GNU Modula-2::  Brief description of GNU Modula-2.
+* Why use GNU Modula-2::  Advantages of GNU Modula-2.
+@ifnothtml
+@c omit these nodes if generating gm2 webpage as these are hand written.
+* Release map:: Release map.
+* Development:: Development.
+* Features:: Features of the implementation.
+* Documentation:: Placeholder for how to access the documentation online.
+* Regression tests:: How to run the testsuite.
+* Limitations:: Current limitations.
+* Objectives:: Objectives of the implementation.
+* FAQ:: Frequently asked questions.
+* Community:: How to join the community.
+@end ifnothtml
+@end menu
+
+This document contains the user and design issues relevant to the
+Modula-2 front end to gcc.
+
+@node Example usage, Compiler options, Using, Using
+@section Example compile and link
+
+@ignore
+@c man begin SYNOPSIS gm2
+gm2 [@option{-c}|@option{-S}] [@option{-g}] [@option{-pg}]
+    [@option{-O}@var{level}] [@option{-W}@var{warn}@dots{}]
+    [@option{-I}@var{dir}@dots{}] [@option{-L}@var{dir}@dots{}]
+    [@option{-f}@var{option}@dots{}] [@option{-m}@var{machine-option}@dots{}]
+    [@option{-o} @var{outfile}] [@@@var{file}] @var{infile}@dots{}
+
+Only the most useful options are listed here; see below for the
+remainder.
+@c man end
+@c man begin SEEALSO
+gpl(7), gfdl(7), fsf-funding(7), gcc(1)
+and the Info entries for @file{gm2} and @file{gcc}.
+@c man end
+@end ignore
+
+@c man begin DESCRIPTION gm2
+
+The @command{gm2} command is the GNU compiler for the Modula-2 language and
+supports many of the same options as @command{gcc}.  @xref{Option Summary, ,
+Option Summary, gcc, Using the GNU Compiler Collection (GCC)}.
+This manual only documents the options specific to @command{gm2}.
+
+@c man end
+
+This section describes how to compile and link a simple hello world
+program.  It provides a few examples of using the different options
+mentioned in @pxref{Compiler options, , ,gm2}.  Assuming that you have
+a file called @file{hello.mod} in your current directory which
+contains:
+
+@example
+MODULE hello ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString ('hello world') ; WriteLn
+END hello.
+@end example
+
+You can compile and link it by: @samp{gm2 -g hello.mod}.
+The result will be an @samp{a.out} file created in your directory.
+
+You can split this command into two steps if you prefer.  The compile
+step can be achieved by: @samp{gm2 -g -c -fscaffold-main hello.mod}
+and the link via: @samp{gm2 -g hello.o}.
+
+@footnote{To see all the compile actions taken by @samp{gm2} users can also
+add the @samp{-v} flag at the command line, for example:
+
+@samp{gm2 -v -g -I. hello.mod}
+
+This displays the sub processes initiated by @samp{gm2} which can be useful
+when trouble shooting.}
+
+@node Compiler options, Elementary data types, Example usage, Using
+@section Compiler options
+
+This section describes the compiler options specific to GNU Modula-2
+for generic flags details @xref{Invoking GCC, , ,gcc}.
+
+@c man begin OPTIONS
+
+For any given input file, the file name suffix determines what kind of
+compilation is done.  The following kinds of input file names are supported:
+
+@table @gcctabopt
+@item @var{file}.mod
+Modula-2 implementation or program source files.  See the
+@samp{-fmod=} option if you wish to compile a project which uses a
+different source file extension.
+@item @var{file}.def
+Modula-2 definition module source files.  Definition modules are not
+compiled separately, in GNU Modula-2 definition modules are parsed as
+required when program or implementation modules are compiled.  See the
+@samp{-fdef=} option if you wish to compile a project which uses a
+different source file extension.
+@end table
+
+You can specify more than one input file on the @command{gm2} command line,
+
+@table @code
+
+@item -g
+create debugging information so that debuggers such as @file{gdb}
+can inspect and control executable.
+
+@item -I
+used to specify the search path for definition and implementation
+modules.  An example is:  @code{gm2 -g -c -I.:../../libs foo.mod}.
+If this option is not specified then the default path is added
+which consists of the current directory followed by the appropriate
+language dialect library directories.
+
+@c ordered list of options from here.
+
+@item -fauto-init
+turns on auto initialization of pointers to NIL.  Whenever a block is
+created all pointers declared within this scope will have their
+addresses assigned to NIL.
+
+@item -fbounds
+turns on run time subrange, array index and indirection via @code{NIL}
+pointer checking.
+
+@item -fcase
+turns on compile time checking to check whether a @code{CASE}
+statement requires an @code{ELSE} clause when on was not specified.
+
+@item -fcpp
+preprocess the source with @samp{cpp -lang-asm -traditional-cpp}
+For further details about these options @xref{Invocation, , ,cpp}.
+If @samp{-fcpp} is supplied then all definition modules and
+implementation modules which are parsed will be prepossessed by
+@samp{cpp}.
+
+@c fcpp-end
+@c Modula-2
+@c passed to the preprocessor if -fcpp is used (internal switch)
+
+@c fcpp-begin
+@c Modula-2
+@c passed to the preprocessor if -fcpp is used (internal switch)
+
+@item -fdebug-builtins
+call a real function, rather than the builtin equivalent.  This can
+be useful for debugging parameter values to a builtin function as
+it allows users to single step code into a real function.
+
+@c fd
+@c Modula-2
+@c turn on internal debugging of the compiler (internal switch)
+
+@c fdebug-trace-quad
+@c Modula-2
+@c turn on quadruple tracing (internal switch)
+
+@c fdebug-trace-api
+@c Modula-2
+@c turn on the Modula-2 api tracing (internal switch)
+
+@c fdebug-function-line-numbers
+@c Modula-2
+@c turn on the Modula-2 function line number generation (internal switch)
+
+@item -fdef=
+recognize the specified suffix as a definition module filename.
+The default implementation and module filename suffix is @file{.def}.
+If this option is used GNU Modula-2 will still fall back to this
+default if a requested definition module is not found.
+
+@item -fdump-system-exports
+display all inbuilt system items.
+This is an internal command line option.
+
+@item -fexceptions
+turn on exception handling code.  By default this option is on.
+Exception handling can be disabled by @samp{-fno-exceptions}
+and no references are made to the run time exception libraries.
+
+@item -fextended-opaque
+allows opaque types to be implemented as any type.  This is a GNU
+Modula-2 extension and it requires that the implementation module
+defining the opaque type is available so that it can be resolved when
+compiling the module which imports the opaque type.
+
+@item -ffloatvalue
+turns on run time checking to check whether a floating point number is
+about to exceed range.
+
+@item -fgen-module-list=@file{filename}
+attempt to find all modules when linking and generate a module list.
+If the @file{filename} is @samp{-} then the contents are not written
+and only used to force the linking of all module ctors.
+This option cannot be used if @samp{-fuse-list=} is enabled.
+
+@item -findex
+generate code to check whether array index values are out of bounds.
+Array index checking can be disabled via @samp{-fno-index}.
+
+@item -fiso
+turn on ISO standard features.  Currently this enables the ISO
+@code{SYSTEM} module and alters the default library search path so
+that the ISO libraries are searched before the PIM libraries.  It also
+effects the behavior of @code{DIV} and @code{MOD} operators.
+@xref{Dialect, , ,gm2}.
+
+@item -flibs=
+modifies the default library search path.  The libraries supplied are:
+m2pim, m2iso, m2min, m2log and m2cor.  These map onto the
+Programming in Modula-2 base libraries, ISO standard libraries, minimal
+library support, Logitech compatible library and Programming in
+Modula-2 with coroutines.
+Multiple libraries can be specified and are comma separated with precedence
+going to the first in the list.  It is not necessary to use -flibs=m2pim or
+-flibs=m2iso if you also specify -fpim, -fpim2, -fpim3, -fpim4 or
+-fiso.  Unless you are using -flibs=m2min you should include m2pim as
+the they provide the base modules which all other dialects utilize.
+The option @samp{-fno-libs=-} disables the @samp{gm2} driver from
+modifying the search and library paths.
+
+@c flocation=
+@c Modula-2 Joined
+@c set all location values to a specific value (internal switch)
+
+@item -fm2-g
+improve the debugging experience for new programmers at the expense
+of generating @code{nop} instructions if necessary to ensure single
+stepping precision over all code related keywords.  An example
+of this is in termination of a list of nested @code{IF} statements
+where multiple @code{END} keywords are mapped onto a sequence of
+@code{nop} instructions.
+
+@item -fm2-lower-case
+render keywords in error messages using lower case.
+
+@item -fm2-plugin
+insert plugin to identify run time errors at compile time (default on).
+
+@item -fm2-statistics
+generates quadruple information: number of quadruples generated,
+number of quadruples remaining after optimization and number of source
+lines compiled.
+
+@item -fm2-strict-type
+experimental flag to turn on the new strict type checker.
+
+@item -fm2-whole-program
+compile all implementation modules and program module at once.  Notice
+that you need to take care if you are compiling different dialect
+modules (particularly with the negative operands to modulus).  But
+this option, when coupled together with @code{-O3}, can deliver huge
+performance improvements.
+
+@item -fmod=
+recognize the specified suffix as implementation and module filenames.
+The default implementation and module filename suffix is @file{.mod}.
+If this option is used GNU Modula-2 will still fall back to this
+default if it needs to read an implementation module and the specified
+suffixed filename does not exist.
+
+@item -fnil
+generate code to detect accessing data through a @code{NIL} value
+pointer.  Dereferencing checking through a @code{NIL} pointer can be
+disabled by @samp{-fno-nil}.
+
+@item -fpim
+turn on PIM standard features.  Currently this enables the PIM
+@code{SYSTEM} module and determines which identifiers are pervasive
+(declared in the base module).  If no other @samp{-fpim[234]} switch is
+used then division and modulus operators behave as defined in PIM4.
+@xref{Dialect, , ,gm2}.
+
+@item -fpim2
+turn on PIM-2 standard features.  Currently this removes @code{SIZE}
+from being a pervasive identifier (declared in the base module).  It
+places @code{SIZE} in the @code{SYSTEM} module.  It also effects the
+behavior of @code{DIV} and @code{MOD} operators.
+@xref{Dialect, , ,gm2}.
+
+@item -fpim3
+turn on PIM-3 standard features.  Currently this only effects the
+behavior of @code{DIV} and @code{MOD} operators.
+@xref{Dialect, , ,gm2}.
+
+@item -fpim4
+turn on PIM-4 standard features.  Currently this only effects the
+behavior of @code{DIV} and @code{MOD} operators.
+@xref{Dialect, , ,gm2}.
+
+@item -fpositive-mod-floor-div
+forces the @code{DIV} and @code{MOD} operators to behave as defined by PIM4.
+All modulus results are positive and the results from the division are
+rounded to the floor.
+@xref{Dialect, , ,gm2}.
+
+@item -fpthread
+link against the pthread library.  By default this option is on.  It
+can be disabled by @samp{-fno-pthread}.  GNU Modula-2 uses the GCC
+pthread libraries to implement coroutines (see the SYSTEM
+implementation module).
+
+@c -fq
+@c -Modula-2
+@c -internal compiler debugging information, dump the list of quadruples
+
+@item -frange
+generate code to check the assignment range, return value range
+set range and constructor range.  Range checking can be disabled
+via @samp{-fno-range}.
+
+@item -freturn
+generate code to check that functions always exit with a @code{RETURN}
+and do not fall out at the end.  Return checking can be disabled
+via @samp{-fno-return}.
+
+@item -fruntime-modules=
+specify, using a comma separated list, the run time modules and their
+order.  These modules will initialized first before any other modules
+in the application dependency.  By default the run time modules list is
+set to @code{Storage,SYSTEM,M2RTS,RTExceptions,IOLink}.  Note that
+these modules will only be linked into your executable if they are
+required.  So adding a long list of dependent modules will not effect
+the size of the executable it merely states the initialization order
+should they be required.
+
+@item -fscaffold-dynamic
+the option ensures that @samp{gm2} will generate a dynamic scaffold
+infrastructure when compiling implementation and program modules.
+By default this option is on.  Use @samp{-fno-scaffold-dynamic}
+to turn it off or select @samp{-fno-scaffold-static}.
+
+@item -fscaffold-c
+generate a C source scaffold for the current module being compiled.
+
+@item -fscaffold-c++
+generate a C++ source scaffold for the current module being compiled.
+
+@item -fscaffold-main
+force the generation of the @samp{main} function.  This is not
+necessary if the @samp{-c} is omitted.
+
+@item -fscaffold-static
+the option ensures that @samp{gm2} will generate a static scaffold
+within the program module.  The static scaffold consists of sequences
+of calls to all dependent module initialization and finalization
+procedures.  The static scaffold is useful for debugging and single
+stepping the initialization blocks of implementation modules.
+
+@item -fshared
+generate a shared library from the module.
+
+@item -fsoft-check-all
+turns on all run time checks.  This is the same as invoking
+GNU Modula-2 using the command options
+@code{-fnil} @code{-frange} @code{-findex}
+@code{-fwholevalue}
+@code{-fwholediv} @code{-fcase} @code{-freturn}.
+
+@item -fsources
+displays the path to the source of each module.  This option
+can be used at compile time to check the correct definition module
+is being used.
+
+@item -fswig
+generate a swig interface file.
+
+@item -funbounded-by-reference
+enable optimization of unbounded parameters by attempting to pass non
+@code{VAR} unbounded parameters by reference.  This optimization
+avoids the implicit copy inside the callee procedure.  GNU Modula-2
+will only allow unbounded parameters to be passed by reference if,
+inside the callee procedure, they are not written to, no address is
+calculated on the array and it is not passed as a @code{VAR}
+parameter.  Note that it is possible to write code to break this
+optimization, therefore this option should be used carefully.
+For example it would be possible to take the address of an array, pass
+the address and the array to a procedure, read from the array in
+the procedure and write to the location using the address parameter.
+
+Due to the dangerous nature of this option it is not enabled
+when the @samp{-O} option is specified.
+
+@item -fuse-list=@file{filename}
+if @samp{-fscaffold-static} is enabled then use the file
+@file{filename} for the initialization order of modules.  Whereas if
+@samp{-fscaffold-dynamic} is enabled then use this file to force
+linking of all module ctors.
+This option cannot be used if @samp{-fgen-module-list=} is enabled.
+
+@item -fwholediv
+generate code to detect whole number division by zero or modulus by
+zero.
+
+@item -fwholevalue
+generate code to detect whole number overflow and underflow.
+
+@c the following warning options are complete but need to be
+@c regression tested against all other front ends
+@c to ensure the options do not conflict.
+
+@c @item -Wall
+@c turn on all Modula-2 warnings.
+
+@c @item -Wpedantic
+@c forces the compiler to reject nested @code{WITH} statements
+@c referencing the same record type.  Does not allow multiple imports of
+@c the same item from a module.  It also checks that: procedure variables
+@c are written to before being read; variables are not only written to
+@c but read from; variables are declared and used.  If the compiler
+@c encounters a variable being read before written it will terminate with
+@c a message.  It will check that @code{FOR} loop indices are not used
+@c outside the end of this loop without being reset.
+
+@c @item -Wpedantic-cast
+@c warns if the ISO system function is used and if the size of
+@c the variable is different from that of the type.  This is legal
+@c in ISO Modula-2, however it can be dangerous.  Some users may prefer
+@c to use @code{VAL} instead in these situations and use @code{CAST}
+@c exclusively for changes in type on objects which have the same size.
+
+@c @item -Wpedantic-param-names
+@c procedure parameter names are checked in the definition module
+@c against their implementation module counterpart.  This is not
+@c necessary in ISO or PIM versions of Modula-2.
+
+@c @item -Wstyle
+@c checks for poor programming style.  This option is aimed at new users of
+@c Modula-2 in that it checks for situations which might cause confusion
+@c and thus mistakes.  It checks whether variables of the same name are
+@c declared in different scopes and whether variables look like keywords.
+@c Experienced users might find this option too aggressive.
+
+@c @item -Wunused-variable
+@c warns if a variable has been declared and it not used.
+
+@c @item -Wunused-parameter
+@c warns if a parameter has been declared and it not used.
+
+@c @item -Wverbose-unbounded
+@c inform the user which non @code{VAR} unbounded parameters will be
+@c passed by reference.  This only produces output if the option
+@c @samp{-funbounded-by-reference} is also supplied on the command line.
+
+@end table
+
+@c man end
+
+@node Elementary data types, Standard procedures, Compiler options, Using
+@section Elementary data types
+
+This section describes the elementary data types supported by GNU
+Modula-2.  It also describes the relationship between these data types
+and the equivalent C data types.
+
+The following data types are supported: @code{INTEGER},
+@code{LONGINT}, @code{SHORTINT}, @code{CARDINAL}, @code{LONGCARD},
+@code{SHORTCARD}, @code{BOOLEAN}, @code{REAL}, @code{LONGREAL},
+@code{SHORTREAL}, @code{COMPLEX}, @code{LONGCOMPLEX},
+@code{SHORTCOMPLEX} and @code{CHAR}.
+
+An equivalence table is given below:
+
+@example
+GNU Modula-2              GNU C
+======================================
+INTEGER                   int
+LONGINT                   long long int
+SHORTINT                  short int
+CARDINAL                  unsigned int
+LONGCARD                  long long unsigned int
+SHORTCARD                 short unsigned int
+BOOLEAN                   int
+REAL                      double
+LONGREAL                  long double
+SHORTREAL                 float
+CHAR                      char
+SHORTCOMPLEX              complex float
+COMPLEX                   complex double
+LONGCOMPLEX               complex long double
+@end example
+
+Note that GNU Modula-2 also supports fixed sized data types which are
+exported from the @code{SYSTEM} module.
+@xref{The PIM system module, , ,gm2}.
+@xref{The ISO system module, , ,gm2}.
+
+@node Standard procedures, Dialect, Elementary data types, Using
+@section Permanently accessible base procedures.
+
+This section describes the procedures and functions which are
+always visible.
+
+@subsection Standard procedures and functions common to PIM and ISO
+
+The following procedures are implemented and conform with Programming
+in Modula-2 and ISO Modula-2: @code{NEW}, @code{DISPOSE}, @code{INC},
+@code{DEC}, @code{INCL}, @code{EXCL} and @code{HALT}.  The standard
+functions are: @code{ABS}, @code{CAP}, @code{CHR}, @code{FLOAT},
+@code{HIGH}, @code{LFLOAT}, @code{LTRUNC}, @code{MIN}, @code{MAX},
+@code{ODD}, @code{SFLOAT}, @code{STRUNC} @code{TRUNC} and
+@code{VAL}.  All these functions and procedures (except @code{HALT},
+@code{NEW}, @code{DISPOSE} and, under non constant conditions,
+@code{LENGTH}) generate in-line code for efficiency.
+
+@example
+
+(*
+   ABS - returns the positive value of i.
+*)
+
+@findex ABS
+PROCEDURE ABS (i: <any signed type>) : <any signed type> ;
+
+@end example
+
+@example
+
+(*
+   CAP - returns the capital of character ch providing
+         ch lies within the range 'a'..'z'.  Otherwise ch
+         is returned unaltered.
+*)
+
+@findex CAP
+PROCEDURE CAP (ch: CHAR) : CHAR ;
+
+@end example
+
+@example
+
+(*
+   CHR - converts a value of a <whole number type> into a CHAR.
+         CHR(x) is shorthand for VAL(CHAR, x).
+*)
+
+@findex CHR
+PROCEDURE CHR (x: <whole number type>) : CHAR ;
+
+@end example
+
+@example
+
+(*
+   DISPOSE - the procedure DISPOSE is replaced by:
+             DEALLOCATE(p, TSIZE(p^)) ;
+             The user is expected to import the procedure DEALLOCATE
+             (normally found in the module, Storage.)
+
+             In:  a variable p: of any pointer type which has been
+                  initialized by a call to NEW.
+             Out: the area of memory
+                  holding p^ is returned to the system.
+                  Note that the underlying procedure DEALLOCATE
+                  procedure in module Storage will assign p to NIL.
+*)
+
+@findex DISPOSE
+PROCEDURE DISPOSE (VAR p:<any pointer type>) ;
+@end example
+
+@example
+
+(*
+   DEC - can either take one or two parameters.  If supplied
+         with one parameter then on the completion of the call to
+         DEC, v will have its predecessor value.  If two
+         parameters are supplied then the value v will have its
+         n'th predecessor.  For these reasons the value of n
+         must be >=0.
+*)
+
+@findex DEC
+PROCEDURE DEC (VAR v: <any base type>; [n: <any base type> = 1]) ;
+@end example
+
+@example
+
+(*
+   EXCL - excludes bit element e from a set type s.
+*)
+
+@findex EXCL
+PROCEDURE EXCL (VAR s: <any set type>; e: <element of set type s>) ;
+@end example
+
+@example
+
+(*
+   FLOAT - will return a REAL number whose value is the same as o.
+*)
+
+@findex FLOAT
+PROCEDURE FLOAT (o: <any whole number type>) : REAL ;
+@end example
+
+@example
+
+(*
+   FLOATS - will return a SHORTREAL number whose value is the same as o.
+*)
+
+@findex FLOATS
+PROCEDURE FLOATS (o: <any whole number type>) : REAL ;
+@end example
+
+@example
+
+(*
+   FLOATL - will return a LONGREAL number whose value is the same as o.
+*)
+
+@findex FLOATL
+PROCEDURE FLOATL (o: <any whole number type>) : REAL ;
+@end example
+
+@example
+
+(*
+   HALT - will call the HALT procedure inside the module M2RTS.
+          Users can replace M2RTS.
+*)
+
+@findex HALT
+PROCEDURE HALT ;
+@end example
+
+@example
+
+(*
+   HIGH - returns the last accessible index of an parameter declared as
+          ARRAY OF CHAR.  Thus
+
+          PROCEDURE foo (a: ARRAY OF CHAR) ;
+          VAR
+             c: CARDINAL ;
+          BEGIN
+             c := HIGH(a)
+          END foo ;
+
+          BEGIN
+             foo('hello')
+          END
+
+          will cause the local variable c to contain the value 4
+*)
+
+@findex HIGH
+PROCEDURE HIGH (a: ARRAY OF CHAR) : CARDINAL ;
+@end example
+
+@example
+
+(*
+   INC - can either take one or two parameters.  If supplied
+         with one parameter then on the completion of the call to
+         INC, v will have its successor value.  If two
+         parameters are supplied then the value v will have its
+         n'th successor.  For these reasons the value of n
+         must be >=0.
+*)
+
+@findex INC
+PROCEDURE INC (VAR v: <any base type>; [n: <any base type> = 1]) ;
+@end example
+
+@example
+
+(*
+   INCL - includes bit element e to a set type s.
+*)
+
+@findex INCL
+PROCEDURE INCL (VAR s: <any set type>; e: <element of set type s>) ;
+@end example
+
+@example
+
+(*
+   LFLOAT - will return a LONGREAL number whose value is the same as o.
+*)
+
+@findex LFLOAT
+PROCEDURE LFLOAT (o: <any whole number type>) : LONGREAL ;
+@end example
+
+@example
+
+(*
+   LTRUNC - will return a LONG<type> number whose value is the
+            same as o.  PIM2, PIM3 and ISO Modula-2 will return
+            a LONGCARD whereas PIM4 returns LONGINT.
+*)
+
+@findex LTRUNC
+PROCEDURE LTRUNC (o: <any floating point type>) : LONG<type> ;
+@end example
+
+@example
+
+(*
+   MIN - returns the lowest legal value of an ordinal type.
+*)
+
+@findex MIN
+PROCEDURE MIN (t: <ordinal type>) : <ordinal type> ;
+
+@end example
+
+@example
+
+(*
+   MAX - returns the largest legal value of an ordinal type.
+*)
+
+@findex MAX
+PROCEDURE MAX (t: <ordinal type>) : <ordinal type> ;
+
+@end example
+
+@example
+
+(*
+   NEW - the procedure NEW is replaced by:
+         ALLOCATE(p, TSIZE(p^)) ;
+         The user is expected to import the procedure ALLOCATE
+         (normally found in the module, Storage.)
+
+         In:  a variable p: of any pointer type.
+         Out: variable p is set to some allocated memory
+              which is large enough to hold all the contents of p^.
+*)
+
+@findex NEW
+PROCEDURE NEW (VAR p:<any pointer type>) ;
+@end example
+
+@example
+
+(*
+   ODD - returns TRUE if the value is not divisible by 2.
+*)
+
+@findex ODD
+PROCEDURE ODD (x: <whole number type>) : BOOLEAN ;
+
+@end example
+
+@example
+
+(*
+   SFLOAT - will return a SHORTREAL number whose value is the same
+            as o.
+*)
+
+@findex SFLOAT
+PROCEDURE SFLOAT (o: <any whole number type>) : SHORTREAL ;
+@end example
+
+@example
+
+(*
+   STRUNC - will return a SHORT<type> number whose value is the same
+            as o.  PIM2, PIM3 and ISO Modula-2 will return a
+            SHORTCARD whereas PIM4 returns SHORTINT.
+*)
+
+@findex STRUNC
+PROCEDURE STRUNC (o: <any floating point type>) : SHORT<type> ;
+@end example
+
+@example
+
+(*
+   TRUNC - will return a <type> number whose value is the same as o.
+           PIM2, PIM3 and ISO Modula-2 will return a CARDINAL
+           whereas PIM4 returns INTEGER.
+*)
+
+@findex TRUNC
+PROCEDURE TRUNC (o: <any floating point type>) : <type> ;
+@end example
+
+@example
+
+(*
+   TRUNCS - will return a <type> number whose value is the same
+            as o.  PIM2, PIM3 and ISO Modula-2 will return a
+            SHORTCARD whereas PIM4 returns SHORTINT.
+*)
+
+@findex TRUNCS
+PROCEDURE TRUNCS (o: <any floating point type>) : <type> ;
+@end example
+
+@example
+
+(*
+   TRUNCL - will return a <type> number whose value is the same
+            as o.  PIM2, PIM3 and ISO Modula-2 will return a
+            LONGCARD whereas PIM4 returns LONGINT.
+*)
+
+@findex TRUNCL
+PROCEDURE TRUNCL (o: <any floating point type>) : <type> ;
+@end example
+
+@example
+
+(*
+   VAL - converts data i of <any simple data type 2> to
+         <any simple data type 1> and returns this value.
+         No range checking is performed during this conversion.
+*)
+
+@findex VAL
+PROCEDURE VAL (<any simple data type 1>,
+               i: <any simple data type 2>) : <any simple data type 1> ;
+
+@end example
+
+@subsection ISO specific standard procedures and functions
+
+The standard function @code{LENGTH} is specific to ISO Modula-2 and
+is defined as:
+
+@example
+
+(*
+   IM - returns the imaginary component of a complex type.
+        The return value will the same type as the imaginary field
+        within the complex type.
+*)
+
+@findex IM
+PROCEDURE IM (c: <any complex type>) : <floating point type> ;
+@end example
+
+@example
+
+(*
+   INT - returns an INTEGER value which has the same value as v.
+         This function is equivalent to: VAL(INTEGER, v).
+*)
+
+@findex INT
+PROCEDURE INT (v: <any ordinal type>) : INTEGER ;
+@end example
+
+@example
+
+(*
+   LENGTH - returns the length of string a.
+*)
+
+@findex LENGTH
+PROCEDURE LENGTH (a: ARRAY OF CHAR) : CARDINAL ;
+@end example
+
+This function is evaluated at compile time, providing that string
+@code{a} is a constant.  If @code{a} cannot be evaluated then a call is
+made to @code{M2RTS.Length}.
+
+@example
+
+(*
+   ODD - returns a BOOLEAN indicating whether the whole number
+         value, v, is odd.
+*)
+
+@findex ODD
+PROCEDURE ODD (v: <any whole number type>) : BOOLEAN ;
+@end example
+
+@example
+
+(*
+   RE - returns the real component of a complex type.
+        The return value will the same type as the real field
+        within the complex type.
+*)
+
+@findex RE
+PROCEDURE RE (c: <any complex type>) : <floating point type> ;
+@end example
+
+@node Dialect, Exceptions, Standard procedures, Using
+@section GNU Modula-2 supported dialects
+
+This section describes the dialects understood by GNU Modula-2.
+It also describes the differences between the dialects and
+any command line switches which determine dialect behaviour.
+
+The GNU Modula-2 compiler is compliant with four dialects of Modula-2.
+The language as defined in 'Programming in Modula-2' 2nd Edition,
+Springer Verlag, 1982, 1983 by Niklaus Wirth (PIM2), 'Programming in
+Modula-2', 3rd Corrected Edition, Springer Verlag, 1985 (PIM3) and
+'Programming in Modula-2', 4th Edition, Springer Verlag, 1988 (PIM4)
+@uref{http://freepages.modula2.org/report4/modula-2.html} and the ISO
+Modula-2 language as defined in ISO/IEC Information technology -
+programming languages - part 1: Modula-2 Language, ISO/IEC 10514-1
+(1996) (ISO).
+
+The command line switches @samp{-fpim2}, @samp{-fpim3}, @samp{-fpim4}
+and @samp{-fiso} can be used to force mutually exclusive
+features.  However by default the compiler will not aggressively fail
+if a non mutually exclusive feature is used from another dialect.  For
+example it is possible to specify @samp{-fpim2} and still utilize
+@samp{DEFINITION} @samp{MODULES} which have no export list.
+
+Some dialect differences will force a compile time error, for example
+in PIM2 the user must @code{IMPORT} @code{SIZE} from the module
+@code{SYSTEM}, whereas in PIM3 and PIM4 @code{SIZE} is a pervasive
+function.  Thus compiling PIM4 source code with the @samp{-fpim2}
+switch will cause a compile time error.  This can be fixed quickly
+with an additional @code{IMPORT} or alternatively by compiling with
+the @samp{-fpim4} switch.
+
+However there are some very important differences between the dialects
+which are mutually exclusive and therefore it is vital that users
+choose the dialects with care when these language features are used.
+
+@subsection Integer division, remainder and modulus
+
+The most dangerous set of mutually exclusive features found in the
+four dialects supported by GNU Modula-2 are the @code{INTEGER}
+division, remainder and modulus arithmetic operators.  It is important
+to note that the same source code can be compiled to give different
+run time results depending upon these switches!  The reference manual
+for the various dialects of Modula-2 are quite clear about this
+behavior and sadly there are three distinct definitions.
+
+The table below illustrates the problem when a negative operand is
+used.
+
+@example
+                  Pim2/3          Pim4                ISO
+               -----------    -----------    ----------------------
+lval    rval   DIV     MOD    DIV     MOD    DIV    MOD    /    REM
+ 31      10      3       1      3       1      3      1     3     1
+-31      10     -3      -1     -4       9     -4      9    -3    -1
+ 31     -10     -3       1     -3       1     Exception    -3     1
+-31     -10      3      -1      4       9     Exception     3    -1
+@end example
+
+See also P24 of PIM2, P27 of PIM3, P29 of PIM4 and P201 of the ISO
+Standard.  At present all dialect division, remainder and modulus are
+implemented as above, apart from the exception calling in the ISO
+dialect.  Instead of exception handling the results are the same as the
+PIM4 dialect.  This is a temporary implementation situation.
+
+@node Exceptions, Semantic checking, Dialect, Using
+@section Exception implementation
+
+This section describes how exceptions are implemented in GNU Modula-2
+and how command line switches affect their behavior.  The option
+@samp{-fsoft-check-all} enables all software checking of nil
+dereferences, division by zero etc.  Additional code is produced to
+check these conditions and exception handlers are invoked if the
+conditions prevail.
+
+Without @samp{-fsoft-check-all} these exceptions will be caught by
+hardware (assuming the hardware support exists) and a signal handler
+is invoked.  The signal handler will in turn @code{THROW} an exception
+which will be caught by the appropriate Modula-2 handler.  However the
+action of throwing an exception from within a signal handler is
+implementation defined (according to the C++ documentation).  For
+example on the x86_64 architecture this works whereas on the i686
+architecture it does not.  Therefore to ensure portability it is
+recommended to use @samp{-fsoft-check-all}.
+
+@footnote{@samp{-fsoft-check-all} can be effectively combined with
+@samp{-O2} to semantically analyze source code for possible run time
+errors at compile time.}
+
+@node Semantic checking, Extensions, Exceptions, Using
+@section How to detect run time problems at compile time
+
+Consider the following program:
+
+@example
+MODULE assignvalue ;  (*!m2iso+gm2*)
+
+PROCEDURE bad () : INTEGER ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := -1 ;
+   RETURN i
+END bad ;
+
+VAR
+   foo: CARDINAL ;
+BEGIN
+   (* The m2rte plugin will detect this as an error, post
+      optimization.  *)
+   foo := bad ()
+END assignvalue.
+@end example
+
+here we see that the programmer has overlooked that the return value
+from @samp{bad} will cause an overflow to @samp{foo}.  If we compile
+the code with the following options:
+
+@example
+$ gm2 -g -fsoft-check-all -O2 -c assignvalue.mod
+assignvalue.mod:16:0:inevitable that this error will occur at run time,
+assignment will result in an overflow
+@end example
+
+The gm2 semantic plugin is automatically run and will generate a
+warning message for every exception call which is known as reachable.
+It is highly advised to run the optimizer (@samp{-O2} or @samp{-O3})
+with @samp{-fsoft-check-all} so that the compiler is able to run the
+optimizer and perform variable and flow analysis before the semantic
+plugin is invoked.
+
+@node Extensions, Type compatibility, Semantic checking, Using
+@section GNU Modula-2 language extensions
+
+This section introduces the GNU Modula-2 language extensions.
+The GNU Modula-2 compiler allows abstract data types to be any type,
+not just restricted to a pointer type providing the
+@samp{-fextended-opaque} option is supplied
+@xref{Compiler options, , ,gm2}.
+
+Declarations can be made in any order, whether they are
+types, constants, procedures, nested modules or variables.
+@c (@xref{Passes, , ,}.)
+
+GNU Modula-2 also allows programmers to interface to @code{C} and
+assembly language.
+
+GNU Modula-2 provides support for the special tokens @code{__LINE__},
+@code{__FILE__}, @code{__FUNCTION__} and @code{__DATE__}.  Support for
+these tokens will occur even if the @samp{-fcpp} option is not
+supplied.  A table of these identifiers and their data type and values
+is given below:
+
+@example
+Scope       GNU Modula-2 token      Data type and example value
+
+anywhere    __LINE__                Constant Literal compatible
+                                    with CARDINAL, INTEGER and WORD.
+                                    Example 1234
+
+anywhere    __FILE__                Constant string compatible
+                                    with parameter ARRAY OF CHAR or
+                                    an ARRAY whose SIZE is >= string
+                                    length.  Example
+                                    "hello.mod"
+
+procedure   __FUNCTION__            Constant string compatible
+                                    with parameter ARRAY OF CHAR or
+                                    an ARRAY whose SIZE is >= string
+                                    length.  Example
+                                    "calc"
+
+module      __FUNCTION__            Example
+                                    "module hello initialization"
+
+anywhere    __DATE__                Constant string compatible
+                                    with parameter ARRAY OF CHAR or
+                                    an ARRAY whose SIZE is >= string
+                                    length.  Example
+                                    "Thu Apr 29 10:07:16 BST 2004"
+
+anywhere   __COLUMN__               Gives a constant literal number
+                                    determining the left hand column
+                                    where the first _ appears in
+                                    __COLUMN__.  The left most column
+                                    is 1.
+
+@end example
+
+The preprocessor @samp{cpp} can be invoked via the @samp{-fcpp}
+command line option.  This in turn invokes @samp{cpp} with the
+following arguments @samp{-traditional -lang-asm}.  These options
+preserve comments and all quotations.  @samp{gm2} treats a @samp{#}
+character in the first column as a preprocessor directive.
+
+For example here is a module which calls @code{FatalError}
+via the macro @code{ERROR}.
+
+@example
+MODULE cpp ;
+
+FROM SYSTEM IMPORT ADR, SIZE ;
+FROM libc IMPORT exit, printf, malloc ;
+
+PROCEDURE FatalError (a, file: ARRAY OF CHAR;
+                         line: CARDINAL;
+                         func: ARRAY OF CHAR) ;
+BEGIN
+   printf ("%s:%d:fatal error, %s, in %s\n",
+            ADR (file), line, ADR (a), ADR (func)) ;
+   exit (1)
+END FatalError ;
+
+#define ERROR(X)  FatalError(X, __FILE__, __LINE__, __FUNCTION__)
+
+VAR
+   pc: POINTER TO CARDINAL;
+BEGIN
+   pc := malloc (SIZE (CARDINAL)) ;
+   IF pc = NIL
+   THEN
+      ERROR ('out of memory')
+   END
+END cpp.
+@end example
+
+Another use for the C preprocessor in Modula-2 might be to turn on
+debugging code.  For example the library module
+@file{FormatStrings.mod} uses procedures from @file{DynamicStrings.mod}
+and to track down memory leaks it was useful to track the source file
+and line where each string was created.  Here is a section of
+@file{FormatStrings.mod} which shows how the debugging code was
+enabled and disabled by adding @code{-fcpp} to the command line.
+
+@example
+FROM DynamicStrings IMPORT String, InitString, InitStringChar, Mark,
+                           ConCat, Slice, Index, char,
+                           Assign, Length, Mult, Dup, ConCatChar,
+                           PushAllocation, PopAllocationExemption,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+(*
+#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__)
+*)
+
+PROCEDURE doDSdbEnter ;
+BEGIN
+   PushAllocation
+END doDSdbEnter ;
+
+PROCEDURE doDSdbExit (s: String) ;
+BEGIN
+   s := PopAllocationExemption (TRUE, s)
+END doDSdbExit ;
+
+PROCEDURE DSdbEnter ;
+BEGIN
+END DSdbEnter ;
+
+PROCEDURE DSdbExit (s: String) ;
+BEGIN
+END DSdbExit ;
+
+(*
+#define DBsbEnter doDBsbEnter
+#define DBsbExit  doDBsbExit
+*)
+
+PROCEDURE Sprintf1 (s: String; w: ARRAY OF BYTE) : String ;
+BEGIN
+   DSdbEnter ;
+   s := FormatString (HandleEscape (s), w) ;
+   DSdbExit (s) ;
+   RETURN s
+END Sprintf1 ;
+@end example
+
+It is worth noting that the overhead of this code once @code{-fcpp} is
+not present and -O2 is used will be zero since the local empty
+procedures @code{DSdbEnter} and @code{DSdbExit} will be thrown away by
+the optimization passes of the GCC backend.
+
+@subsection Optional procedure parameter
+
+GNU Modula-2 allows the last parameter to a procedure or function
+parameter to be optional.  For example in the ISO library
+@file{COROUTINES.def} the procedure @code{NEWCOROUTINE} is defined as
+having an optional fifth argument (@code{initProtection}) which, if
+absent, is automatically replaced by @code{NIL}.
+
+@example
+@findex NEWCOROUTINE
+PROCEDURE NEWCOROUTINE (procBody: PROC; workspace: SYSTEM.ADDRESS;
+                        size: CARDINAL; VAR cr: COROUTINE;
+                        [initProtection: PROTECTION = NIL]);
+
+  (* Creates a new coroutine whose body is given by procBody,
+     and returns the identity of the coroutine in cr.
+     workspace is a pointer to the work space allocated to
+     the coroutine; size specifies the size of this workspace
+     in terms of SYSTEM.LOC.
+
+     The optional fifth argument may contain a single parameter
+     which specifies the initial protection level of the coroutine.
+  *)
+@end example
+
+The implementation module @file{COROUTINES.mod} implements this
+procedure using the following syntax:
+
+@example
+PROCEDURE NEWCOROUTINE (procBody: PROC; workspace: SYSTEM.ADDRESS;
+                        size: CARDINAL; VAR cr: COROUTINE;
+                        [initProtection: PROTECTION]);
+BEGIN
+
+END NEWCOROUTINE ;
+@end example
+
+Note that it is illegal for this declaration to contain an initializer
+value for @code{initProtection}.  However it is necessary to surround
+this parameter with the brackets @code{[} and @code{]}.  This serves to
+remind the programmer that the last parameter was declared as optional
+in the definition module.
+
+Local procedures can be declared to have an optional final parameter
+in which case the initializer is mandatory in the implementation or
+program module.
+
+GNU Modula-2 also provides additional fixed sized data types which
+are all exported from the @code{SYSTEM} module.
+@xref{The PIM system module, , ,gm2}.
+@xref{The ISO system module, , ,gm2}.
+
+@node Type compatibility, Unbounded by reference, Extensions, Using
+@section Type compatibility
+
+This section discuss the issues surrounding assignment, expression
+and parameter compatibility, their effect of the additional
+fixed sized datatypes and also their effect of run time checking.
+The data types supported by the compiler are:
+
+@example
+GNU Modula-2              scope      switches
+=============================================
+INTEGER                   pervasive
+LONGINT                   pervasive
+SHORTINT                  pervasive
+CARDINAL                  pervasive
+LONGCARD                  pervasive
+SHORTCARD                 pervasive
+BOOLEAN                   pervasive
+BITSET                    pervasive
+REAL                      pervasive
+LONGREAL                  pervasive
+SHORTREAL                 pervasive
+CHAR                      pervasive
+SHORTCOMPLEX              pervasive
+COMPLEX                   pervasive
+LONGCOMPLEX               pervasive
+
+LOC                       SYSTEM     -fiso
+BYTE                      SYSTEM
+WORD                      SYSTEM
+ADDRESS                   SYSTEM
+
+The following extensions are supported for
+most architectures (please check SYSTEM.def).
+=============================================
+INTEGER8                  SYSTEM
+INTEGER16                 SYSTEM
+INTEGER32                 SYSTEM
+INTEGER64                 SYSTEM
+CARDINAL8                 SYSTEM
+CARDINAL16                SYSTEM
+CARDINAL32                SYSTEM
+CARDINAL64                SYSTEM
+BITSET8                   SYSTEM
+BITSET16                  SYSTEM
+BITSET32                  SYSTEM
+WORD16                    SYSTEM
+WORD32                    SYSTEM
+WORD64                    SYSTEM
+REAL32                    SYSTEM
+REAL64                    SYSTEM
+REAL96                    SYSTEM
+REAL128                   SYSTEM
+COMPLEX32                 SYSTEM
+COMPLEX64                 SYSTEM
+COMPLEX96                 SYSTEM
+COMPLEX128                SYSTEM
+@end example
+
+The Modula-2 language categorizes compatibility between entities of
+possibly differing types into three sub components: expressions,
+assignments, and parameters.  Parameter compatibility is further
+divided into two sections for pass by reference and pass by value
+compatibility.
+
+For more detail on the Modula-2 type compatibility see the Modula-2
+ISO standard BS ISO/IEC 10514-1:1996 page 121-125.  For detail on the
+PIM type compatibility see Programming in Modula-2 Edition 4 page 29,
+(Elementary Data Types).
+
+@subsection Expression compatibility
+
+Modula-2 restricts the types of expressions to the same type.
+Expression compatibility is a symmetric relation.
+
+For example two sub expressions of @code{INTEGER} and @code{CARDINAL}
+are not expression compatible
+(@uref{http://freepages.modula2.org/report4/modula-2.html} and ISO
+Modula-2).
+
+In GNU Modula-2 this rule is also extended across all fixed sized data
+types (imported from SYSTEM).
+
+@subsection Assignment compatibility
+
+This section discusses the assignment issues surrounding assignment
+compatibility of elementary types (@code{INTEGER}, @code{CARDINAL},
+@code{REAL} and @code{CHAR} for example).  The information here is
+found in more detail in the Modula-2 ISO standard BS ISO/IEC
+10514-1:1996 page 122.
+
+Assignment compatibility exists between the same sized elementary
+types.
+
+Same type family of different sizes are
+also compatible as long as the @code{MAX(}type@code{)} and
+@code{MIN(}type@code{)} is known.  So for example this includes the
+@code{INTEGER} family, @code{CARDINAL} family and the @code{REAL}
+family.
+
+The reason for this is that when the assignment is performed
+the compiler will check to see that the expression (on the right of
+the @code{:=}) lies within the range of the designator type (on the
+left hand side of the @code{:=}).  Thus these ordinal types can be
+assignment compatible.  However it does mean that @code{WORD32} is not
+compatible with @code{WORD16} as @code{WORD32} does not have a minimum
+or maximum value and therefore cannot be checked.  The compiler does
+not know which of the two bytes from @code{WORD32} should be copied
+into @code{WORD16} and which two should be ignored.  Currently the
+types @code{BITSET8}, @code{BITSET16} and @code{BITSET32} are
+assignment incompatible.  However this restriction maybe lifted when
+further run time checking is achieved.
+
+Modula-2 does allow @code{INTEGER} to be assignment compatible with
+@code{WORD} as they are the same size.  Likewise GNU Modula-2 allows
+@code{INTEGER16} to be compatible with @code{WORD16} and the same for
+the other fixed sized types and their sized equivalent in either
+@code{WORD}n, @code{BYTE} or @code{LOC} types.  However it prohibits
+assignment between @code{WORD} and @code{WORD32} even though on many
+systems these sizes will be the same.  The reasoning behind this rule
+is that the extended fixed sized types are meant to be used by
+applications requiring fixed sized data types and it is more portable
+to forbid the blurring of the boundaries between fixed sized and
+machine dependent sized types.
+
+Intermediate code run time checking is always generated by the front
+end.  However this intermediate code is only translated into actual
+code if the appropriate command line switches are specified.  This
+allows the compiler to perform limited range checking at compile time.
+In the future it will allow the extensive GCC optimizations to
+propagate constant values through to the range checks which if they
+are found to exceed the type range will result in a compile time
+error message.
+
+@subsection Parameter compatibility
+
+Parameter compatibility is divided into two areas, pass by value and
+pass by reference (@code{VAR}).  In the case of pass by value the
+rules are exactly the same as assignment.  However in the second case,
+pass by reference, the actual parameter and formal parameter must be
+the same size and family.  Furthermore @code{INTEGER} and
+@code{CARDINAL}s are not treated as compatible in the pass by
+reference case.
+
+The types @code{BYTE}, @code{LOC}, @code{WORD} and @code{WORD}n
+derivatives are assignment and parameter compatible with any data type
+of the same size.
+
+@node Unbounded by reference, Building a shared library, Type compatibility, Using
+@section Unbounded by reference
+
+This section documents a GNU Modula-2 compiler switch which implements
+a language optimization surrounding the implementation of unbounded
+arrays.  In GNU Modula-2 the unbounded array is implemented by
+utilizing an internal structure @code{struct @{dataType *address,
+unsigned int high@}}.  So given the Modula-2 procedure declaration:
+
+@example
+PROCEDURE foo (VAR a: ARRAY OF dataType) ;
+BEGIN
+   IF a[2]= (* etc *)
+END foo ;
+@end example
+
+it is translated into GCC @code{tree}s, which can be represented
+in their C form thus:
+
+@example
+void foo (struct @{dataType *address, unsigned int high@} a)
+@{
+   if (a.address[2] == /* etc */
+@}
+@end example
+
+Whereas if the procedure @code{foo} was declared as:
+
+@example
+PROCEDURE foo (a: ARRAY OF dataType) ;
+BEGIN
+   IF a[2]= (* etc *)
+END foo ;
+@end example
+
+then it is implemented by being translated into the following
+GCC @code{tree}s, which can be represented in their C form thus:
+
+@example
+void foo (struct @{dataType *address, unsigned int high@} a)
+@{
+   dataType *copyContents = (dataType *)alloca (a.high+1);
+   memcpy(copyContents, a.address, a.high+1);
+   a.address = copyContents;
+
+   if (a.address[2] == /* etc */
+@}
+@end example
+
+This implementation works, but it makes a copy of each non VAR
+unbounded array when a procedure is entered.  If the unbounded array
+is not changed during procedure @code{foo} then this implementation
+will be very inefficient.  In effect Modula-2 lacks the @code{REF}
+keyword of Ada.  Consequently the programmer maybe tempted to
+sacrifice semantic clarity for greater efficiency by declaring the
+parameter using the @code{VAR} keyword in place of @code{REF}.
+
+The @code{-funbounded-by-reference} switch instructs the compiler to
+check and see if the programmer is modifying the content of any
+unbounded array.  If it is modified then a copy will be made upon
+entry into the procedure.  Conversely if the content is only read and
+never modified then this non @code{VAR} unbounded array is a candidate
+for being passed by reference.  It is only a candidate as it is still
+possible that passing this parameter by reference could alter the
+meaning of the source code.  For example consider the following case:
+
+@example
+PROCEDURE StrConCat (VAR a: ARRAY OF CHAR; b, c: ARRAY OF CHAR) ;
+BEGIN
+   (* code which performs string a := b + c *)
+END StrConCat ;
+
+PROCEDURE foo ;
+VAR
+   a: ARRAY [0..3] OF CHAR ;
+BEGIN
+   a := 'q' ;
+   StrConCat(a, a, a)
+END foo ;
+@end example
+
+In the code above we see that the same parameter, @code{a}, is being
+passed three times to @code{StrConCat}.  Clearly even though parameters
+@code{b} and @code{c} are never modified it would be incorrect to
+implement them as pass by reference.  Therefore the compiler checks to
+see if any non @code{VAR} parameter is type compatible with any
+@code{VAR} parameter and if so it generates run time procedure entry
+checks to determine whether the contents of parameters @code{b} or
+@code{c} matches the contents of @code{a}.  If a match is detected
+then a copy is made and the @code{address} in the unbounded
+@code{struct}ure is modified.
+
+The compiler will check the address range of each candidate against
+the address range of any @code{VAR} parameter, providing they are type
+compatible.  For example consider:
+
+@example
+PROCEDURE foo (a: ARRAY OF BYTE; VAR f: REAL) ;
+BEGIN
+   f := 3.14 ;
+   IF a[0]=BYTE(0)
+   THEN
+      (* etc *)
+   END
+END foo ;
+
+PROCEDURE bar ;
+BEGIN
+   r := 2.0 ;
+   foo(r, r)
+END bar ;
+@end example
+
+Here we see that although parameter, @code{a}, is a candidate for the
+passing by reference, it would be incorrect to use this
+transformation.  Thus the compiler detects that parameters, @code{a}
+and @code{f} are type compatible and will produce run time checking
+code to test whether the address range of their respective contents
+intersect.
+
+@node Linking, Building a shared library, Unbounded by reference, Using
+
+This section describes the linking related options.  There are three
+linking strategies available which are dynamic scaffold, static
+scaffold and user defined.  The dynamic scaffold is enabled by default
+and each module will register itself to the run time @samp{M2RTS} via
+a constructor.  The static scaffold mechanism will invoke each modules
+@samp{_init} and @samp{_finish} function in turn via a sequence of
+calls from within @samp{main}.  Lastly the user defined strategy
+can be implemented by turning off the dynamic and static options via
+@samp{-fno-scaffold-dynamic} and @samp{-fno-scaffold-static}.
+
+In the simple test below:
+
+@example
+$ gm2 hello.mod
+@end example
+
+the driver will add the options @samp{-fscaffold-dynamic} and
+@samp{-fgen-module-list=-} which generate a list of application
+modules and also creates the @samp{main} function with calls to
+@samp{M2RTS}.  It can be useful to add the option @samp{-fsources}
+which displays the source files as they are parsed and summarizes
+whether the source file is required for compilation or linking.
+
+If you wish to split the above command line into a compile and link
+then you could use these steps:
+
+@example
+$ gm2 -c -fscaffold-main hello.mod
+$ gm2 hello.o
+@end example
+
+The @samp{-fscaffold-main} informs the compiler to generate the
+@samp{main} function and scaffold.  You can enable the environment
+variable @samp{GCC_M2LINK_RTFLAG} to trace the construction and
+destruction of the application.  The values for
+@samp{GCC_M2LINK_RTFLAG} are shown in the table below:
+
+@example
+value   | meaning
+=================
+all     | turn on all flags below
+module  | trace modules as they register themselves
+pre     | generate module list prior to dependency resolution
+dep     | trace module dependency resolution
+post    | generate module list after dependency resolution
+force   | generate a module list after dependency and forced
+        | ordering is complete
+@end example
+
+The values can be combined using a comma separated list.
+
+One of the advantages of the dynamic scaffold is that the driver
+behaves in a similar way to the other front end drivers.
+For example consider a small project consisting of 4 definition
+implementation modules (@samp{a.def}, @samp{a.mod}, @samp{b.def},
+@samp{b.mod}, @samp{c.def}, @samp{c.mod}, @samp{d.def}, @samp{d.mod})
+and a program module @samp{program.mod}.
+
+To link this project we could:
+
+@example
+$ gm2 -g -c a.mod
+$ gm2 -g -c b.mod
+$ gm2 -g -c c.mod
+$ gm2 -g -c d.mod
+$ gm2 -g program.mod a.o b.o c.o d.o
+@end example
+
+The module initialization sequence is defined by the ISO standard to
+follow the import graph traversal.  The initialization order is the
+order in which the corresponding separate modules finish the
+processing of their import lists.
+
+However, if required, you can override this using
+@samp{-fruntime-modules=a,b,c,d} for example which forces the
+initialization sequence to @samp{a}, @samp{b}, @samp{c} and @samp{d}.
+
+@node Building a shared library, Interface for Python, Unbounded by reference, Using
+@section Building a shared library
+
+This section describes building a tiny shared library implemented in
+Modula-2 and built with @file{libtool}.  Suppose a project consists of
+two definition modules and two implementation modules and a program
+module @file{a.def}, @file{a.mod}, @file{b.def}, @file{b.mod} and
+@file{c.mod}.  The first step is to compile the modules using position
+independent code.  This can be achieved by the following three
+commands:
+
+@example
+libtool --tag=CC --mode=compile gm2 -g -c a.mod -o a.lo
+libtool --tag=CC --mode=compile gm2 -g -c b.mod -o b.lo
+libtool --tag=CC --mode=compile gm2 -g -c c.mod -o c.lo
+@end example
+
+The second step is to generate the shared library initialization and
+finalization routines.  We can do this by asking gm2 to generate a
+list of dependent modules and then use this to generate the scaffold.
+We also must compile the scaffold.
+
+@example
+gm2 -c -g -fmakelist c.mod
+gm2 -c -g -fmakeinit -fshared c.mod
+libtool --tag=CC --mode=compile g++ -g -c c_m2.cpp -o c_m2.lo
+@end example
+
+The third step is to link all these @file{.lo} files.
+
+@example
+libtool --mode=link gcc -g c_m2.lo a.lo b.lo c.lo \
+        -L$(prefix)/lib64 \
+        -rpath `pwd` -lgm2 -lstdc++ -lm -o libabc.la
+@end example
+
+At this point the shared library @file{libabc.so} will have been
+created inside the directory @file{.libs}.
+
+@node Interface for Python, Producing a Python module, Building a shared library, Using
+@section How to produce swig interface files
+
+This section describes how Modula-2 implementation modules can be
+called from Python (and other scripting languages such as TCL and
+Perl).  GNU Modula-2 can be instructed to create a swig interface when
+it is compiling an implementation module.  Swig then uses the
+interface file to generate all the necessary wrapping to that the
+desired scripting language may access the implementation module.
+
+Here is an example of how you might call upon the services of the
+Modula-2 library module @code{NumberIO} from Python3.
+
+The following commands can be used to generate the Python3 module:
+
+@example
+export src=@samp{directory to the sources}
+export prefix=@samp{directory to where the compiler is installed}
+gm2 -I$@{src@} -c -g -fswig $@{src@}/../../../gm2-libs/NumberIO.mod
+gm2 -I$@{src@} -c -g -fmakelist $@{src@}/../../../gm2-libs/NumberIO.mod
+
+gm2 -I$@{src@} -c -g -fmakeinit -fshared \
+   $@{src@}/../../../gm2-libs/NumberIO.mod
+
+swig -c++ -python3 NumberIO.i
+
+libtool --mode=compile g++ -g -c -I$@{src@} NumberIO_m2.cpp \
+  -o NumberIO_m2.lo
+
+libtool --tag=CC --mode=compile gm2 -g -c \
+  -I$@{src@}../../../gm2-libs \
+  $@{src@}/../../../gm2-libs/NumberIO.mod -o NumberIO.lo
+
+libtool --tag=CC --mode=compile g++ -g -c NumberIO_wrap.cxx \
+  -I/usr/include/python3 -o NumberIO_wrap.lo
+
+libtool --mode=link gcc -g NumberIO_m2.lo NumberIO_wrap.lo \
+   -L$@{prefix@}/lib64 \
+   -rpath `pwd` -lgm2 -lstdc++ -lm -o libNumberIO.la
+
+cp .libs/libNumberIO.so _NumberIO.so
+@end example
+
+The first four commands, generate the swig interface file
+@file{NumberIO.i} and python wrap files @file{NumberIO_wrap.cxx} and
+@file{NumberIO.py}.  The next three @file{libtool} commnads compile
+the C++ and Modula-2 source code into @file{.lo} objects.  The last
+@file{libtool} command links all the @file{.lo} files into a
+@file{.la} file and includes all shared library dependencies.
+
+Now it is possible to run the following Python script
+(called @file{testnum.py}):
+
+@example
+import NumberIO
+
+print ("1234 x 2 =", NumberIO.NumberIO_StrToInt("1234")*2)
+@end example
+
+like this:
+
+@example
+$ python3 testnum.py
+1234 x 2 = 2468
+@end example
+
+@xref{Producing a Python module, , ,gm2} for another example which
+uses the @code{UNQUALIFIED} keyword to reduce the module name clutter
+from the viewport of Python3.
+
+@subsection Limitations of automatic generated of Swig files
+
+This section discusses the limitations of automatically generating
+swig files.  From the previous example we see that the module
+@code{NumberIO} had a swig interface file @file{NumberIO.i}
+automatically generated by the compiler.  If we consider three of the
+procedure definitions in @file{NumberIO.def} we can see the
+success and limitations of the automatic interface generation.
+
+@example
+PROCEDURE StrToHex (a: ARRAY OF CHAR; VAR x: CARDINAL) ;
+PROCEDURE StrToInt (a: ARRAY OF CHAR; VAR x: INTEGER) ;
+PROCEDURE ReadInt (VAR x: CARDINAL) ;
+@end example
+
+Below are the swig interface prototypes:
+
+@example
+extern void NumberIO_StrToHex (char *_m2_address_a,
+                               int _m2_high_a, unsigned int *OUTPUT);
+/*  parameters: x is known to be an OUTPUT */
+extern void NumberIO_StrToInt (char *_m2_address_a,
+                               int _m2_high_a, int *OUTPUT);
+/*  parameters: x is guessed to be an OUTPUT */
+extern void NumberIO_ReadInt (int *x);
+/*  parameters: x is unknown */
+@end example
+
+In the case of @code{StrToHex} it can be seen that the compiler
+detects that the last parameter is an output.  It explicitly tells
+swig this by using the parameter name @code{OUTPUT} and in the
+following comment it informs the user that it knows this to be an
+output parameter.  In the second procedure @code{StrToInt} it marks
+the final parameter as an output, but it tells the user that this is
+only a guess.  Finally in @code{ReadInt} it informs the user that
+it does not know whether the parameter, @code{x}, is an output, input
+or an inout parameter.
+
+The compiler decides whether to mark a parameter as either:
+@code{INPUT}, @code{OUTPUT} or @code{INOUT} if it is read before
+written or visa versa in the first basic block.  At this point
+it will write output that the parameter is known.  If it is not
+read or written in the first basic block then subsequent basic blocks
+are searched and the result is commented as a guess.  Finally if
+no read or write occurs then the parameter is commented as unknown.
+However, clearly it is possible to fool this mechanism.  Nevertheless
+automatic generation of implementation module into swig interface files
+was thought sufficiently useful despite these limitations.
+
+In conclusion it would be wise to check all parameters in any
+automatically generated swig interface file.  Furthermore you can
+force the automatic mechanism to generate correct interface files by
+reading or writing to the @code{VAR} parameter in the first basic
+block of a procedure.
+
+@node Producing a Python module, Interface to C, Interface for Python, Using
+@section How to produce a Python module
+
+This section describes how it is possible to produce a Python module
+from Modula-2 code.  There are a number of advantages to this
+approach, it ensures your code reaches a wider audience, maybe it is
+easier to initialize your application in Python.
+
+The example application here is a pedagogical two dimensional gravity
+next event simulation.  The Python module needs to have a clear API
+which should be placed in a single definition module.  Furthermore the
+API should only use fundamental pervasive data types and strings.
+Below the API is contained in the file @file{twoDsim.def}:
+
+@example
+DEFINITION MODULE twoDsim ;
+
+EXPORT UNQUALIFIED gravity, box, poly3, poly5, poly6, mass,
+                   fix, circle, pivot, velocity, accel, fps,
+                   replayRate, simulateFor ;
+(*
+   gravity - turn on gravity at: g m^2
+*)
+
+PROCEDURE gravity (g: REAL) ;
+
+
+(*
+   box - place a box in the world at (x0,y0),(x0+i,y0+j)
+*)
+
+PROCEDURE box (x0, y0, i, j: REAL) : CARDINAL ;
+
+
+(*
+   poly3 - place a triangle in the world at:
+           (x0,y0),(x1,y1),(x2,y2)
+*)
+
+PROCEDURE poly3 (x0, y0, x1, y1, x2, y2: REAL) : CARDINAL ;
+
+
+(*
+   poly5 - place a pentagon in the world at:
+           (x0,y0),(x1,y1),(x2,y2),(x3,y3),(x4,y4)
+*)
+
+PROCEDURE poly5 (x0, y0, x1, y1,
+                 x2, y2, x3, y3, x4, y4: REAL) : CARDINAL ;
+
+
+(*
+   poly6 - place a hexagon in the world at:
+           (x0,y0),(x1,y1),(x2,y2),(x3,y3),(x4,y4),(x5,y5)
+*)
+
+PROCEDURE poly6 (x0, y0, x1, y1,
+                 x2, y2, x3, y3,
+                 x4, y4, x5, y5: REAL) : CARDINAL ;
+
+
+(*
+   mass - specify the mass of an object and return the, id.
+*)
+
+PROCEDURE mass (id: CARDINAL; m: REAL) : CARDINAL ;
+
+
+(*
+   fix - fix the object to the world.
+*)
+
+PROCEDURE fix (id: CARDINAL) : CARDINAL ;
+
+
+(*
+   circle - adds a circle to the world.  Center
+            defined by: x0, y0 radius, r.
+*)
+
+PROCEDURE circle (x0, y0, r: REAL) : CARDINAL ;
+
+
+(*
+   velocity - give an object, id, a velocity, vx, vy.
+*)
+
+PROCEDURE velocity (id: CARDINAL; vx, vy: REAL) : CARDINAL ;
+
+
+(*
+   accel - give an object, id, an acceleration, ax, ay.
+*)
+
+PROCEDURE accel (id: CARDINAL; ax, ay: REAL) : CARDINAL ;
+
+
+(*
+   fps - set frames per second.
+*)
+
+PROCEDURE fps (f: REAL) ;
+
+
+(*
+   replayRate - set frames per second during replay.
+*)
+
+PROCEDURE replayRate (f: REAL) ;
+
+
+(*
+   simulateFor - render for, t, seconds.
+*)
+
+PROCEDURE simulateFor (t: REAL) ;
+
+
+END twoDsim.
+@end example
+
+The keyword @code{UNQUALIFIED} can be used to ensure that the
+compiler will provide externally accessible functions
+@code{gravity}, @code{box}, @code{poly3}, @code{poly5}, @code{poly6},
+@code{mass}, @code{fix}, @code{circle}, @code{pivot}, @code{velocity},
+@code{accel}, @code{fps}, @code{replayRate}, @code{simulateFor}
+rather than name mangled alternatives.
+Hence in our Python3 application we could write:
+
+@example
+#!/usr/bin/env python3
+
+from twoDsim import *
+
+b = box (0.0, 0.0, 1.0, 1.0)
+b = fix (b)
+c1 = circle (0.7, 0.7, 0.05)
+c1 = mass (c1, 0.01)
+c2 = circle (0.7, 0.1, 0.05)
+c2 = mass (c2, 0.01)
+c2 = fix (c2)
+gravity (-9.81)
+fps (24.0*4.0)
+replayRate (24.0)
+print ("creating frames")
+try:
+    simulateFor (1.0)
+    print ("all done")
+except:
+    print ("exception raised")
+@end example
+
+which accesses the various functions defined and implemented by the
+module @code{twoDsim}.  The Modula-2 source code is compiled via:
+
+@example
+$ gm2 -g -fiso -c -fswig twoDsim.mod
+$ gm2 -g -fiso -c -fmakelist twoDsim.mod
+$ gm2 -g -fiso -c -fmakeinit twoDsim.mod
+@end example
+
+The first command both compiles the source file creating
+@file{twoDsim.o} and produces a swig interface file @file{swig.i}.  We
+now use @code{swig} and @code{g++} to produce and compile the
+interface wrappers:
+
+@example
+$ libtool --mode=compile g++ -g -c twoDsim_m2.cpp -o twoDsim_m2.lo
+$ swig -c++ -python3 twoDsim.i
+$ libtool --mode=compile g++ -c -fPIC twoDsim_wrap.cxx \
+   -I/usr/include/python3 -o twoDsim_wrap.lo
+$ libtool --mode=compile gm2 -g -fPIC -fiso -c deviceGnuPic.mod
+$ libtool --mode=compile gm2 -g -fPIC -fiso -c roots.mod
+$ libtool --mode=compile gm2 -g -fPIC -fiso -c -fswig \
+   twoDsim.mod -o twoDsim.lo
+@end example
+
+Finally the application is linked into a shared library:
+
+@example
+$ libtool --mode=link gcc -g twoDsim_m2.lo twoDsim_wrap.lo \
+  roots.lo deviceGnuPic.lo \
+   -L$@{prefix@}/lib64 \
+   -rpath `pwd` -lgm2 -lstdc++ -lm -o libtwoDsim.la
+cp .libs/libtwoDsim.so _twoDsim.so
+@end example
+
+The library name must start with @code{_} to comply with the Python3
+module naming scheme.
+
+@node Interface to C, Assembly language, Producing a Python module, Using
+@section Interfacing GNU Modula-2 to C
+
+The GNU Modula-2 compiler tries to use the C calling convention
+wherever possible however some parameters have no C equivalent and
+thus a language specific method is used.  For example unbounded arrays
+are passed as a @code{struct @{void *address, unsigned int high@}} and
+the contents of these arrays are copied by callee functions when they
+are declared as non @code{VAR} parameters.  The @code{VAR} equivalent
+unbounded array parameters need no copy, but still use the
+@code{struct} representation.
+
+The recommended method of interfacing GNU Modula-2 to C is by telling
+the definition module that the implementation is in the C language.
+This is achieved by using the tokens @code{DEFINITION MODULE FOR "C"}.
+Here is an example @file{libprintf.def}.
+
+@example
+DEFINITION MODULE FOR "C" libprintf ;
+
+EXPORT UNQUALIFIED printf ;
+
+PROCEDURE printf (a: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+
+END libprintf.
+@end example
+
+the @code{UNQUALIFIED} keyword in the definition module informs
+GNU Modula-2 not to prefix the module name to exported references
+in the object file.
+
+The @code{printf} declaration states that the first parameter
+semantically matches @code{ARRAY OF CHAR} but since the module is for
+the C language it will be mapped onto @code{char *}.  The token
+@code{...} indicates a variable number of arguments (varargs) and all
+parameters passed here are mapped onto their C equivalents.  Arrays and
+constant strings are passed as pointers.  Lastly @code{[ INTEGER ]}
+states that the caller can ignore the function return result if desired.
+
+The hello world program can be rewritten as:
+
+@example
+MODULE hello ;
+
+FROM libprintf IMPORT printf ;
+
+BEGIN
+   printf ("hello world\n")
+END hello.
+@end example
+
+and it can be compiled by:
+
+@samp{gm2 -g hello.mod -lc}
+
+In reality the @samp{-lc} is redundant as libc is always included in the
+linking process.  It is shown here to emphasize that the C library or
+object file containing @code{printf} must be present.  The search path
+for modules can be changed by using @samp{-I}.
+
+If a procedure function is declared using varargs then some parameter
+values are converted.  The table below summarizes the default conversions
+and default types used.
+
+@example
+Actual Parameter       |  Default conversion  |   Type of actual
+                       |                      |   value passed
+===============================================================
+123                    |  none                |   long long int
+"hello world"          |  none                |   const char *
+a: ARRAY OF CHAR       |  ADR (a)             |   char *
+a: ARRAY [0..5] OF CHAR|  ADR (a)             |   char *
+3.14                   |  none                |   long double
+@end example
+
+If you wish to pass @code{int} values then you should explicitly
+convert the constants using one of the conversion mechanisms.
+For example:  @code{INTEGER(10)} or @code{VAL(INTEGER, 10)} or
+@code{CAST(INTEGER, 10)}.
+
+@node Assembly language, Alignment, Interface to C, Using
+@section Interface to assembly language
+
+The interface for GNU Modula-2 to assembly language is almost
+identical to GNU C.  The only alterations are that the keywords
+@code{asm} and @code{volatile} are in capitals, following the Modula-2
+convention.
+
+A simple, but highly non optimal, example is given below.  Here we want
+to add the two @code{CARDINAL}s @code{foo} and @code{bar} together and
+return the result.  The target processor is assumed to be executing
+the x86_64 instruction set.
+
+@example
+PROCEDURE Example (foo, bar: CARDINAL) : CARDINAL ;
+VAR
+   myout: CARDINAL ;
+BEGIN
+   ASM VOLATILE ("movq %1,%%rax; addq %2,%%rax; movq %%rax,%0"
+      : "=rm" (myout)            (* outputs *)
+      : "rm" (foo), "rm" (bar)   (* inputs  *)
+      : "rax") ;                 (* we trash *)
+   RETURN( myout )
+END Example ;
+@end example
+
+For a full description of this interface we refer the reader to the GNU C manual.
+
+@xref{Extended Asm, ,Extensions to the C Language Family,gcc}.
+
+The same example can be written using the newer extensions of naming
+the operands rather than using numbered arguments.
+
+@example
+PROCEDURE Example (foo, bar: CARDINAL) : CARDINAL ;
+VAR
+   myout: CARDINAL ;
+BEGIN
+   ASM VOLATILE (
+    "movq %[left],%%rax; addq %[right],%%rax; movq %%rax,%[output]"
+      : [output] "=rm" (myout)                  (* outputs *)
+      : [left] "rm" (foo), [right] "rm" (bar)   (* inputs  *)
+      : "rax") ;                                (* we trash *)
+   RETURN( myout )
+END Example ;
+@end example
+
+Both examples generate exactly the same code.  It is worth noting that
+the specifier ``rm'' indicates that the operand can be either a
+register or memory.  Of course you must choose an instruction which
+can take either, but this allows the compiler to take make more
+efficient choices depending upon the optimization level given to the
+compiler.
+
+@node Alignment, Packed, Assembly language, Using
+@section Data type alignment
+
+GNU Modula-2 allows you to specify alignment for types and variables.
+The syntax for alignment is to use the ISO pragma directives @code{<*}
+@code{bytealignment (} expression @code{)} and @code{*>}.  These directives
+can be used after type and variable declarations.
+
+The ebnf of the alignment production is:
+
+@example
+Alignment := [ ByteAlignment ] =:
+ByteAlignment := '<*' AttributeExpression '*>' =:
+AlignmentExpression := "(" ConstExpression ")" =:
+@end example
+
+The @code{Alignment} ebnf statement may be used during construction of
+types, records, record fields, arrays, pointers and variables.  Below
+is an example of aligning a type so that the variable @code{bar} is
+aligned on a 1024 address.
+
+@example
+MODULE align ;
+
+TYPE
+   foo = INTEGER <* bytealignment(1024) *> ;
+
+VAR
+   z  : INTEGER ;
+   bar: foo ;
+BEGIN
+END align.
+@end example
+
+The next example aligns a variable on a 1024 byte boundary.
+
+@example
+MODULE align2 ;
+
+VAR
+   x  : CHAR ;
+   z  : ARRAY [0..255] OF INTEGER <* bytealignment(1024) *> ;
+BEGIN
+END align2.
+@end example
+
+Here the example aligns a pointer on a 1024 byte boundary.
+
+@example
+MODULE align4 ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT exit ;
+
+VAR
+   x  : CHAR ;
+   z  : POINTER TO INTEGER <* bytealignment(1024) *> ;
+BEGIN
+   IF ADR(z) MOD 1024=0
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END align4.
+@end example
+
+In example @code{align5} record field @code{y} is aligned on a 1024
+byte boundary.
+
+@example
+MODULE align5 ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT exit ;
+
+TYPE
+   rec = RECORD
+            x: CHAR ;
+            y: CHAR <* bytealignment(1024) *> ;
+         END ;
+VAR
+   r: rec ;
+BEGIN
+   IF ADR(r.y) MOD 1024=0
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END align5.
+@end example
+
+In the example below module @code{align6} declares @code{foo} as an
+array of 256 @code{INTEGER}s.  The array @code{foo} is aligned on a
+1024 byte boundary.
+
+@example
+MODULE align6 ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT exit ;
+
+TYPE
+   foo = ARRAY [0..255] OF INTEGER <* bytealignment(1024) *> ;
+
+VAR
+   x  : CHAR ;
+   z  : foo ;
+BEGIN
+   IF ADR(z) MOD 1024=0
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END align6.
+@end example
+
+@node Packed, Built-ins, Alignment, Using
+@section Packing data types
+
+The pragma @code{<* bytealignment(0) *>} can be used to specify that
+the fields within a @code{RECORD} are to be packed.  Currently this
+only applies to fields which are declared as subranges, ordinal types
+and enumerated types.  Here is an example of how two subranges might
+be packed into a byte.
+
+@example
+TYPE
+   bits3c =  [0..7] ;
+   bits3i = [-4..3] ;
+
+   byte = RECORD
+              <* bytealignment(0) *>
+              x: bits3c ;
+              <* bitsunused(2) *>
+              y: bits3i ;
+          END ;
+@end example
+
+Notice that the user has specified that in between fields @code{x} and
+@code{y} there are two bits unused.
+
+Now the user wishes to create a record with byte numbers zero and one
+occupied and then an @code{INTEGER32} field which is four byte
+aligned.  In this case byte numbers two and three will be unused.  The
+pragma @code{bytealignment} can be issued at the start of the record
+indicating the default alignment for the whole record and this can be
+overridden by individual fields if necessary.
+
+@example
+   rec = RECORD
+            <* bytealignment (1) *> ;
+            a, b: byte ;
+            x: INTEGER32 <* bytealignment(4) *> ;
+         END ;
+@end example
+
+In the following example the user has specified that a record has two
+fields @code{p} and @code{q} but that there are three bytes unused between
+these fields.
+
+@example
+   header = RECORD
+               <* bytealignment(1) *>
+               p: byte ;
+               <* bytesunused(3) *>
+               q: byte ;
+            END ;
+@end example
+
+The pragma @code{<* bytesunused(x) *>} can only be used if the current
+field is on a byte boundary.  There is also a @code{SYSTEM} pseudo
+procedure function @code{TBITSIZE(T)} which returns the minimum number of
+bits necessary to represent type @code{T}.
+
+Another example of packing record bit fields is given below:
+
+@example
+MODULE align21 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   colour = (red, blue, green, purple, white, black) ;
+
+   soc = PACKEDSET OF colour ;
+
+   rec = RECORD
+            <* bytealignment(0) *>
+            x: soc ;
+            y: [-1..1] ;
+         END ;
+
+VAR
+   r: rec ;
+   v: CARDINAL ;
+BEGIN
+   v := SIZE(r) ;
+   IF SIZE(r)#1
+   THEN
+      exit(1)
+   END ;
+   r.x := soc@{blue@} ;
+   IF r.x#soc@{blue@}
+   THEN
+      exit(2)
+   END
+END align21.
+@end example
+
+Here we see that the total size of this record is one byte and consists
+of a six bit set type followed by a 2 bit integer subrange.
+
+@node Built-ins, The PIM system module, Packed, Using
+@section Accessing GNU Modula-2 Built-ins
+
+This section describes the built-in constants and functions defined in
+GNU Modula-2.  The following compiler constants can be accessed using
+the @code{__ATTRIBUTE__} @code{__BUILTIN__} keywords.  These are not
+part of the Modula-2 language and they may differ depending upon the
+target architecture but they provide a method whereby common
+libraries can interface to a different underlying architecture.
+
+The built-in constants are: @code{BITS_PER_UNIT}, @code{BITS_PER_WORD},
+@code{BITS_PER_CHAR} and @code{UNITS_PER_WORD}.  They are integrated into
+GNU Modula-2 by an extension to the @code{ConstFactor} rule:
+
+@example
+ConstFactor := ConstQualidentOrSet | Number | ConstString |
+               "(" ConstExpression ")" | "NOT" ConstFactor |
+               ConstAttribute =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" =:
+@end example
+
+Here is an example taken from the ISO library @code{SYSTEM.def}:
+
+@example
+CONST
+   BITSPERLOC    = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
+   LOCSPERWORD   = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
+@end example
+
+Built-in functions are transparent to the end user.  All built-in
+functions are declared in @code{DEFINITION MODULE}s and are imported
+as and when required.  Built-in functions are declared in definition
+modules by using the @code{__BUILTIN__} keyword.  Here is a section of
+the ISO library @code{LongMath.def} which demonstrates this feature.
+
+@example
+PROCEDURE __BUILTIN__ sqrt (x: LONGREAL): LONGREAL;
+  (* Returns the square root of x *)
+@end example
+
+This indicates that the function @code{sqrt} will be implemented using
+the gcc built-in maths library.  If gcc cannot utilize the built-in
+function (for example if the programmer requested the address of
+@code{sqrt}) then code is generated to call the alternative function
+implemented in the @code{IMPLEMENTATION} @code{MODULE}.
+
+Sometimes a function exported from the @code{DEFINITION} @code{MODULE}
+will have a different name from the built-in function within gcc.  In
+such cases the mapping between the GNU Modula-2 function name and the
+gcc name is expressed using the keywords @code{__ATTRIBUTE__}
+@code{__BUILTIN__} @code{((Ident))}.  For example the function
+@code{sqrt} in @code{LongMath.def} maps onto the gcc built-in function
+@code{sqrtl} and this is expressed as:
+
+@example
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((sqrtl)) sqrt
+                                    (x: LONGREAL) : LONGREAL;
+  (* Returns the positive square root of x *)
+@end example
+
+The following module @code{Builtins.def} enumerates the list of
+built-in functions which can be accessed in GNU Modula-2.  It also
+serves to define the parameter and return value for each function:
+
+@include m2/Builtins.texi
+
+Although this module exists and will result in the generation of
+in-line code if optimization flags are passed to GNU Modula-2, users
+are advised to utilize the same functions from more generic libraries.
+The built-in mechanism will be applied to these generic
+libraries where appropriate.  Note for the mathematical routines to
+be in-lined you need to specify the @samp{-ffast-math -O} options.
+
+@node The PIM system module, The ISO system module, Built-ins, Using
+@section The PIM system module
+
+@include m2/SYSTEM-pim.texi
+
+The different dialects of Modula-2 PIM-[234] and ISO Modula-2 declare
+the function @code{SIZE} in different places.  PIM-[34] and ISO
+Modula-2 declare @code{SIZE} as a pervasive function (declared in the
+base module).  PIM-2 defined @code{SIZE} in the @code{SYSTEM} module
+(as shown above).
+
+GNU Modula-2 allows users to specify the dialect of Modula-2 by using
+the @code{-fiso} and @code{-fpim2} command line switches.
+
+The data types @code{CSIZE_T} and @code{CSSIZE_T} are also exported from
+the @code{SYSTEM} module.  The type @code{CSIZE_T} is unsigned and is
+mapped onto the target C data type @code{size_t} whereas the type
+@code{CSSIZE_T} is mapped onto the signed C data type @code{ssize_t}.
+
+It is anticipated that these should only be used to provide cross
+platform definition modules for C libraries.
+
+There are also a variety of fixed sized @code{INTEGER} and
+@code{CARDINAL} types.  The variety of the fixed sized types will
+depend upon the target architecture.
+
+@node The ISO system module, , The PIM system module, Using
+@section The ISO system module
+
+@include m2/SYSTEM-iso.texi
+
+The data types @code{CSIZE_T} and @code{CSSIZE_T} are also exported from
+the @code{SYSTEM} module.  The type @code{CSIZE_T} is unsigned and is
+mapped onto the target C data type @code{size_t} whereas the type
+@code{CSSIZE_T} is mapped onto the signed C data type @code{ssize_t}.
+
+It is anticipated that these should only be used to provide cross
+platform definition modules for C libraries.
+
+There are also a variety of fixed sized @code{INTEGER} and
+@code{CARDINAL} types.  The variety of the fixed sized types will
+depend upon the target architecture.
+
+@node License, Copying, The ISO system module, Top
+@section License of GNU Modula-2
+
+GNU Modula-2 is free software, the compiler is held under the GPL v3
+@uref{http://www.gnu.org/licenses/gpl.txt},
+its libraries (pim, iso and Logitech compatible) are under the
+GPL v3 with the GCC run time library exception clause.
+
+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/>.
+
+More information on how these licenses work is available
+@uref{http://www.gnu.org/licenses/licenses.html} on the GNU web site.
+
+@c Copying node is inside the gpl_v3.texi
+@include gpl_v3.texi
+
+@node Contributing, Internals, Copying, Top
+@section Contributing to GNU Modula-2
+
+Please do and please read the GNU Emacs info under
+
+@example
+* Standards: (standards).       GNU coding standards.
+* Intellectual Property::       Keeping Free Software Free
+* Reading Non-Free Code::       Referring to Proprietary Programs
+* Contributions::               Accepting Contributions
+@end example
+
+You might consider joining the GM2 Mailing list before you start
+coding.  The mailing list may be subscribed via a web interface
+@uref{http://lists.nongnu.org/mailman/listinfo/gm2} or via email
+@email{gm2-subscribe@@nongnu.org}.
+
+Many thanks and enjoy your coding!
+
+@node Internals, EBNF, Contributing, Top
+
+This section is still being written.
+@c @include gm2-internals.texi
+
+@node EBNF, Libraries, Internals, Top
+@chapter EBNF of GNU Modula-2
+
+This chapter contains the EBNF of GNU Modula-2.  This grammar currently
+supports both PIM and ISO dialects.  The rules here are automatically
+extracted from the crammer files in GNU Modula-2 and serve to document
+the syntax of the extensions described earlier and how they fit in
+with the base language.
+
+Note that the first six productions are built into the lexical analysis
+phase.
+
+@include m2/gm2-ebnf.texi
+
+@node Libraries, Indices, EBNF, Top
+@chapter PIM and ISO library definitions
+
+This chapter contains M2F, PIM and ISO libraries.
+
+@include m2/gm2-libs.texi
+
+@node Indices, , Libraries, Top
+@section Indices
+
+@ifhtml
+@menu
+* Contents::    Section and subsections.
+* Functions::   Function, constants, types, ebnf indices.
+@end menu
+
+@node Contents, Functions, ,
+@section Section and subsections
+@printindex cp
+
+@node Functions, , Contents,
+@section Function, constants, types, ebnf indices.
+@end ifhtml
+
+@printindex fn
+
+@summarycontents
+@contents
+@bye
diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi
index 89ff6a6734b..6884a74936b 100644
--- a/gcc/doc/install.texi
+++ b/gcc/doc/install.texi
@@ -308,6 +308,13 @@ On some targets, @samp{libphobos} isn't enabled by default, but compiles
 and works if @option{--enable-libphobos} is used.  Specifics are
 documented for affected targets.
 
+@item @anchor{GM2-prerequisite}GM2
+
+Python3 is required if you want to build the complete Modula-2
+documentation including the target @code{SYSTEM} definition module.
+If Python3 is unavailable Modula-2 documentation will include a target
+independent version of the SYSTEM modules.
+
 @item A ``working'' POSIX compatible shell, or GNU bash
 
 Necessary when running @command{configure} because some
@@ -436,6 +443,34 @@ Necessary to build GCC with zstd compression used for LTO bytecode.
 The library is searched in your default library patch search.
 Alternatively, the @option{--with-zstd} configure option should be used.
 
+@item Python3 modules
+
+The complete list of Python3 modules broken down by GCC subcomponent
+is shown below:
+
+@table @asis
+@item internal debugging in gdbhooks
+@code{gdb}, @code{gdb.printing}, @code{gdb.types},
+@code{os.path}, @code{re}, @code{sys} and @code{tempfile},
+
+@item g++ testsuite
+@code{gcov}, @code{gzip}, @code{json}, @code{os} and @code{pytest}.
+
+@item c++ cxx api generation
+@code{csv}, @code{os}, @code{sys} and @code{time}.
+
+@item modula-2 documentation
+@code{argparse}, @code{os}, @code{pathlib}, @code{shutil} and
+@code{sys}.
+
+@item git developer tools
+@code{os} and @code{sys}.
+
+@item ada documentation
+@code{latex_elements}, @code{os}, @code{pygments}, @code{re},
+@code{sys} and @code{time}.
+@end table
+
 @end table
 
 @heading Tools/packages necessary for modifying GCC
@@ -1853,11 +1888,13 @@ grep ^language= */config-lang.in
 @end smallexample
 Currently, you can use any of the following:
 @code{all}, @code{default}, @code{ada}, @code{c}, @code{c++}, @code{d},
-@code{fortran}, @code{go}, @code{jit}, @code{lto}, @code{objc}, @code{obj-c++}.
+@code{fortran}, @code{go}, @code{jit}, @code{lto}, @code{m2},
+@code{objc}, @code{obj-c++}.
 Building the Ada compiler has special requirements, see below.
 If you do not pass this flag, or specify the option @code{default}, then the
 default languages available in the @file{gcc} sub-tree will be configured.
-Ada, D, Go, Jit, and Objective-C++ are not default languages.  LTO is not a
+Ada, D, Go, Jit, Objective-C++ and Modula-2 are not default languages.
+LTO is not a
 default language, but is built by default because @option{--enable-lto} is
 enabled by default.  The other languages are default languages.  If
 @code{all} is specified, then all available languages are built.  An
@@ -1885,6 +1922,10 @@ be built.  This can be useful for debugging, or for compatibility with
 previous Ada build procedures, when it was required to explicitly
 do a @samp{make -C gcc gnatlib_and_tools}.
 
+@item --disable-libgm2
+Specify that the run-time libraries and tools used by Modula-2 should not
+be built.  This can be useful for debugging.
+
 @item --disable-libsanitizer
 Specify that the run-time libraries for the various sanitizers should
 not be built.
@@ -3144,10 +3185,10 @@ on a simulator as described at @uref{https://gcc.gnu.org/simtest-howto.html}.
 In order to run sets of tests selectively, there are targets
 @samp{make check-gcc} and language specific @samp{make check-c},
 @samp{make check-c++}, @samp{make check-d} @samp{make check-fortran},
-@samp{make check-ada}, @samp{make check-objc}, @samp{make check-obj-c++},
-@samp{make check-lto}
-in the @file{gcc} subdirectory of the object directory.  You can also
-just run @samp{make check} in a subdirectory of the object directory.
+@samp{make check-ada}, @samp{make check-m2}, @samp{make check-objc},
+@samp{make check-obj-c++}, @samp{make check-lto} in the @file{gcc}
+subdirectory of the object directory.  You can also just run
+@samp{make check} in a subdirectory of the object directory.
 
 
 A more selective way to just run all @command{gcc} execute tests in the
diff --git a/gcc/doc/sourcebuild.texi b/gcc/doc/sourcebuild.texi
index ffe69d6fcb9..562be485ce8 100644
--- a/gcc/doc/sourcebuild.texi
+++ b/gcc/doc/sourcebuild.texi
@@ -97,6 +97,9 @@ The GCC runtime library.
 @item libgfortran
 The Fortran runtime library.
 
+@item libgm2
+The Modula-2 runtime library.
+
 @item libgo
 The Go runtime library.  The bulk of this library is mirrored from the
 @uref{https://github.com/@/golang/go, master Go repository}.
@@ -184,7 +187,8 @@ The @file{gcc} directory contains the following subdirectories:
 @item @var{language}
 Subdirectories for various languages.  Directories containing a file
 @file{config-lang.in} are language subdirectories.  The contents of
-the subdirectories @file{c} (for C), @file{cp} (for C++),
+the subdirectories @file{c} (for C), @file{cp} (for C++), @file{m2}
+(for Modula-2),
 @file{objc} (for Objective-C), @file{objcp} (for Objective-C++),
 and @file{lto} (for LTO) are documented in this
 manual (@pxref{Passes, , Passes and Files of the Compiler});
diff --git a/gcc/dwarf2out.cc b/gcc/dwarf2out.cc
index ed06707a7b4..dce3f05fce7 100644
--- a/gcc/dwarf2out.cc
+++ b/gcc/dwarf2out.cc
@@ -25221,6 +25221,8 @@ gen_compile_unit_die (const char *filename)
     }
   else if (strcmp (language_string, "GNU F77") == 0)
     language = DW_LANG_Fortran77;
+  else if (strcmp (language_string, "GNU Modula-2") == 0)
+    language = DW_LANG_Modula2;
   else if (dwarf_version >= 3 || !dwarf_strict)
     {
       if (strcmp (language_string, "GNU Ada") == 0)
diff --git a/gcc/m2/COPYING.FDL b/gcc/m2/COPYING.FDL
new file mode 100644
index 00000000000..9854856fa81
--- /dev/null
+++ b/gcc/m2/COPYING.FDL
@@ -0,0 +1,397 @@
+		GNU Free Documentation License
+		  Version 1.2, November 2002
+
+
+ Copyright (C) 2000-2022 Free Software Foundation, Inc.
+     51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+0. PREAMBLE
+
+The purpose of this License is to make a manual, textbook, or other
+functional and useful document "free" in the sense of freedom: to
+assure everyone the effective freedom to copy and redistribute it,
+with or without modifying it, either commercially or noncommercially.
+Secondarily, this License preserves for the author and publisher a way
+to get credit for their work, while not being considered responsible
+for modifications made by others.
+
+This License is a kind of "copyleft", which means that derivative
+works of the document must themselves be free in the same sense.  It
+complements the GNU General Public License, which is a copyleft
+license designed for free software.
+
+We have designed this License in order to use it for manuals for free
+software, because free software needs free documentation: a free
+program should come with manuals providing the same freedoms that the
+software does.  But this License is not limited to software manuals;
+it can be used for any textual work, regardless of subject matter or
+whether it is published as a printed book.  We recommend this License
+principally for works whose purpose is instruction or reference.
+
+
+1. APPLICABILITY AND DEFINITIONS
+
+This License applies to any manual or other work, in any medium, that
+contains a notice placed by the copyright holder saying it can be
+distributed under the terms of this License.  Such a notice grants a
+world-wide, royalty-free license, unlimited in duration, to use that
+work under the conditions stated herein.  The "Document", below,
+refers to any such manual or work.  Any member of the public is a
+licensee, and is addressed as "you".  You accept the license if you
+copy, modify or distribute the work in a way requiring permission
+under copyright law.
+
+A "Modified Version" of the Document means any work containing the
+Document or a portion of it, either copied verbatim, or with
+modifications and/or translated into another language.
+
+A "Secondary Section" is a named appendix or a front-matter section of
+the Document that deals exclusively with the relationship of the
+publishers or authors of the Document to the Document's overall subject
+(or to related matters) and contains nothing that could fall directly
+within that overall subject.  (Thus, if the Document is in part a
+textbook of mathematics, a Secondary Section may not explain any
+mathematics.)  The relationship could be a matter of historical
+connection with the subject or with related matters, or of legal,
+commercial, philosophical, ethical or political position regarding
+them.
+
+The "Invariant Sections" are certain Secondary Sections whose titles
+are designated, as being those of Invariant Sections, in the notice
+that says that the Document is released under this License.  If a
+section does not fit the above definition of Secondary then it is not
+allowed to be designated as Invariant.  The Document may contain zero
+Invariant Sections.  If the Document does not identify any Invariant
+Sections then there are none.
+
+The "Cover Texts" are certain short passages of text that are listed,
+as Front-Cover Texts or Back-Cover Texts, in the notice that says that
+the Document is released under this License.  A Front-Cover Text may
+be at most 5 words, and a Back-Cover Text may be at most 25 words.
+
+A "Transparent" copy of the Document means a machine-readable copy,
+represented in a format whose specification is available to the
+general public, that is suitable for revising the document
+straightforwardly with generic text editors or (for images composed of
+pixels) generic paint programs or (for drawings) some widely available
+drawing editor, and that is suitable for input to text formatters or
+for automatic translation to a variety of formats suitable for input
+to text formatters.  A copy made in an otherwise Transparent file
+format whose markup, or absence of markup, has been arranged to thwart
+or discourage subsequent modification by readers is not Transparent.
+An image format is not Transparent if used for any substantial amount
+of text.  A copy that is not "Transparent" is called "Opaque".
+
+Examples of suitable formats for Transparent copies include plain
+ASCII without markup, Texinfo input format, LaTeX input format, SGML
+or XML using a publicly available DTD, and standard-conforming simple
+HTML, PostScript or PDF designed for human modification.  Examples of
+transparent image formats include PNG, XCF and JPG.  Opaque formats
+include proprietary formats that can be read and edited only by
+proprietary word processors, SGML or XML for which the DTD and/or
+processing tools are not generally available, and the
+machine-generated HTML, PostScript or PDF produced by some word
+processors for output purposes only.
+
+The "Title Page" means, for a printed book, the title page itself,
+plus such following pages as are needed to hold, legibly, the material
+this License requires to appear in the title page.  For works in
+formats which do not have any title page as such, "Title Page" means
+the text near the most prominent appearance of the work's title,
+preceding the beginning of the body of the text.
+
+A section "Entitled XYZ" means a named subunit of the Document whose
+title either is precisely XYZ or contains XYZ in parentheses following
+text that translates XYZ in another language.  (Here XYZ stands for a
+specific section name mentioned below, such as "Acknowledgements",
+"Dedications", "Endorsements", or "History".)  To "Preserve the Title"
+of such a section when you modify the Document means that it remains a
+section "Entitled XYZ" according to this definition.
+
+The Document may include Warranty Disclaimers next to the notice which
+states that this License applies to the Document.  These Warranty
+Disclaimers are considered to be included by reference in this
+License, but only as regards disclaiming warranties: any other
+implication that these Warranty Disclaimers may have is void and has
+no effect on the meaning of this License.
+
+
+2. VERBATIM COPYING
+
+You may copy and distribute the Document in any medium, either
+commercially or noncommercially, provided that this License, the
+copyright notices, and the license notice saying this License applies
+to the Document are reproduced in all copies, and that you add no other
+conditions whatsoever to those of this License.  You may not use
+technical measures to obstruct or control the reading or further
+copying of the copies you make or distribute.  However, you may accept
+compensation in exchange for copies.  If you distribute a large enough
+number of copies you must also follow the conditions in section 3.
+
+You may also lend copies, under the same conditions stated above, and
+you may publicly display copies.
+
+
+3. COPYING IN QUANTITY
+
+If you publish printed copies (or copies in media that commonly have
+printed covers) of the Document, numbering more than 100, and the
+Document's license notice requires Cover Texts, you must enclose the
+copies in covers that carry, clearly and legibly, all these Cover
+Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
+the back cover.  Both covers must also clearly and legibly identify
+you as the publisher of these copies.  The front cover must present
+the full title with all words of the title equally prominent and
+visible.  You may add other material on the covers in addition.
+Copying with changes limited to the covers, as long as they preserve
+the title of the Document and satisfy these conditions, can be treated
+as verbatim copying in other respects.
+
+If the required texts for either cover are too voluminous to fit
+legibly, you should put the first ones listed (as many as fit
+reasonably) on the actual cover, and continue the rest onto adjacent
+pages.
+
+If you publish or distribute Opaque copies of the Document numbering
+more than 100, you must either include a machine-readable Transparent
+copy along with each Opaque copy, or state in or with each Opaque copy
+a computer-network location from which the general network-using
+public has access to download using public-standard network protocols
+a complete Transparent copy of the Document, free of added material.
+If you use the latter option, you must take reasonably prudent steps,
+when you begin distribution of Opaque copies in quantity, to ensure
+that this Transparent copy will remain thus accessible at the stated
+location until at least one year after the last time you distribute an
+Opaque copy (directly or through your agents or retailers) of that
+edition to the public.
+
+It is requested, but not required, that you contact the authors of the
+Document well before redistributing any large number of copies, to give
+them a chance to provide you with an updated version of the Document.
+
+
+4. MODIFICATIONS
+
+You may copy and distribute a Modified Version of the Document under
+the conditions of sections 2 and 3 above, provided that you release
+the Modified Version under precisely this License, with the Modified
+Version filling the role of the Document, thus licensing distribution
+and modification of the Modified Version to whoever possesses a copy
+of it.  In addition, you must do these things in the Modified Version:
+
+A. Use in the Title Page (and on the covers, if any) a title distinct
+   from that of the Document, and from those of previous versions
+   (which should, if there were any, be listed in the History section
+   of the Document).  You may use the same title as a previous version
+   if the original publisher of that version gives permission.
+B. List on the Title Page, as authors, one or more persons or entities
+   responsible for authorship of the modifications in the Modified
+   Version, together with at least five of the principal authors of the
+   Document (all of its principal authors, if it has fewer than five),
+   unless they release you from this requirement.
+C. State on the Title page the name of the publisher of the
+   Modified Version, as the publisher.
+D. Preserve all the copyright notices of the Document.
+E. Add an appropriate copyright notice for your modifications
+   adjacent to the other copyright notices.
+F. Include, immediately after the copyright notices, a license notice
+   giving the public permission to use the Modified Version under the
+   terms of this License, in the form shown in the Addendum below.
+G. Preserve in that license notice the full lists of Invariant Sections
+   and required Cover Texts given in the Document's license notice.
+H. Include an unaltered copy of this License.
+I. Preserve the section Entitled "History", Preserve its Title, and add
+   to it an item stating at least the title, year, new authors, and
+   publisher of the Modified Version as given on the Title Page.  If
+   there is no section Entitled "History" in the Document, create one
+   stating the title, year, authors, and publisher of the Document as
+   given on its Title Page, then add an item describing the Modified
+   Version as stated in the previous sentence.
+J. Preserve the network location, if any, given in the Document for
+   public access to a Transparent copy of the Document, and likewise
+   the network locations given in the Document for previous versions
+   it was based on.  These may be placed in the "History" section.
+   You may omit a network location for a work that was published at
+   least four years before the Document itself, or if the original
+   publisher of the version it refers to gives permission.
+K. For any section Entitled "Acknowledgements" or "Dedications",
+   Preserve the Title of the section, and preserve in the section all
+   the substance and tone of each of the contributor acknowledgements
+   and/or dedications given therein.
+L. Preserve all the Invariant Sections of the Document,
+   unaltered in their text and in their titles.  Section numbers
+   or the equivalent are not considered part of the section titles.
+M. Delete any section Entitled "Endorsements".  Such a section
+   may not be included in the Modified Version.
+N. Do not retitle any existing section to be Entitled "Endorsements"
+   or to conflict in title with any Invariant Section.
+O. Preserve any Warranty Disclaimers.
+
+If the Modified Version includes new front-matter sections or
+appendices that qualify as Secondary Sections and contain no material
+copied from the Document, you may at your option designate some or all
+of these sections as invariant.  To do this, add their titles to the
+list of Invariant Sections in the Modified Version's license notice.
+These titles must be distinct from any other section titles.
+
+You may add a section Entitled "Endorsements", provided it contains
+nothing but endorsements of your Modified Version by various
+parties--for example, statements of peer review or that the text has
+been approved by an organization as the authoritative definition of a
+standard.
+
+You may add a passage of up to five words as a Front-Cover Text, and a
+passage of up to 25 words as a Back-Cover Text, to the end of the list
+of Cover Texts in the Modified Version.  Only one passage of
+Front-Cover Text and one of Back-Cover Text may be added by (or
+through arrangements made by) any one entity.  If the Document already
+includes a cover text for the same cover, previously added by you or
+by arrangement made by the same entity you are acting on behalf of,
+you may not add another; but you may replace the old one, on explicit
+permission from the previous publisher that added the old one.
+
+The author(s) and publisher(s) of the Document do not by this License
+give permission to use their names for publicity for or to assert or
+imply endorsement of any Modified Version.
+
+
+5. COMBINING DOCUMENTS
+
+You may combine the Document with other documents released under this
+License, under the terms defined in section 4 above for modified
+versions, provided that you include in the combination all of the
+Invariant Sections of all of the original documents, unmodified, and
+list them all as Invariant Sections of your combined work in its
+license notice, and that you preserve all their Warranty Disclaimers.
+
+The combined work need only contain one copy of this License, and
+multiple identical Invariant Sections may be replaced with a single
+copy.  If there are multiple Invariant Sections with the same name but
+different contents, make the title of each such section unique by
+adding at the end of it, in parentheses, the name of the original
+author or publisher of that section if known, or else a unique number.
+Make the same adjustment to the section titles in the list of
+Invariant Sections in the license notice of the combined work.
+
+In the combination, you must combine any sections Entitled "History"
+in the various original documents, forming one section Entitled
+"History"; likewise combine any sections Entitled "Acknowledgements",
+and any sections Entitled "Dedications".  You must delete all sections
+Entitled "Endorsements".
+
+
+6. COLLECTIONS OF DOCUMENTS
+
+You may make a collection consisting of the Document and other documents
+released under this License, and replace the individual copies of this
+License in the various documents with a single copy that is included in
+the collection, provided that you follow the rules of this License for
+verbatim copying of each of the documents in all other respects.
+
+You may extract a single document from such a collection, and distribute
+it individually under this License, provided you insert a copy of this
+License into the extracted document, and follow this License in all
+other respects regarding verbatim copying of that document.
+
+
+7. AGGREGATION WITH INDEPENDENT WORKS
+
+A compilation of the Document or its derivatives with other separate
+and independent documents or works, in or on a volume of a storage or
+distribution medium, is called an "aggregate" if the copyright
+resulting from the compilation is not used to limit the legal rights
+of the compilation's users beyond what the individual works permit.
+When the Document is included in an aggregate, this License does not
+apply to the other works in the aggregate which are not themselves
+derivative works of the Document.
+
+If the Cover Text requirement of section 3 is applicable to these
+copies of the Document, then if the Document is less than one half of
+the entire aggregate, the Document's Cover Texts may be placed on
+covers that bracket the Document within the aggregate, or the
+electronic equivalent of covers if the Document is in electronic form.
+Otherwise they must appear on printed covers that bracket the whole
+aggregate.
+
+
+8. TRANSLATION
+
+Translation is considered a kind of modification, so you may
+distribute translations of the Document under the terms of section 4.
+Replacing Invariant Sections with translations requires special
+permission from their copyright holders, but you may include
+translations of some or all Invariant Sections in addition to the
+original versions of these Invariant Sections.  You may include a
+translation of this License, and all the license notices in the
+Document, and any Warranty Disclaimers, provided that you also include
+the original English version of this License and the original versions
+of those notices and disclaimers.  In case of a disagreement between
+the translation and the original version of this License or a notice
+or disclaimer, the original version will prevail.
+
+If a section in the Document is Entitled "Acknowledgements",
+"Dedications", or "History", the requirement (section 4) to Preserve
+its Title (section 1) will typically require changing the actual
+title.
+
+
+9. TERMINATION
+
+You may not copy, modify, sublicense, or distribute the Document except
+as expressly provided for under this License.  Any other attempt to
+copy, modify, sublicense or distribute the Document is void, and will
+automatically terminate your rights under this License.  However,
+parties who have received copies, or rights, from you under this
+License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+
+10. FUTURE REVISIONS OF THIS LICENSE
+
+The Free Software Foundation may publish new, revised versions
+of the GNU Free Documentation License from time to time.  Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.  See
+http://www.gnu.org/copyleft/.
+
+Each version of the License is given a distinguishing version number.
+If the Document specifies that a particular numbered version of this
+License "or any later version" applies to it, you have the option of
+following the terms and conditions either of that specified version or
+of any later version that has been published (not as a draft) by the
+Free Software Foundation.  If the Document does not specify a version
+number of this License, you may choose any version ever published (not
+as a draft) by the Free Software Foundation.
+
+
+ADDENDUM: How to use this License for your documents
+
+To use this License in a document you have written, include a copy of
+the License in the document and put the following copyright and
+license notices just after the title page:
+
+    Copyright (c)  YEAR  YOUR NAME.
+    Permission is granted to copy, distribute and/or modify this document
+    under the terms of the GNU Free Documentation License, Version 1.2
+    or any later version published by the Free Software Foundation;
+    with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
+    A copy of the license is included in the section entitled "GNU
+    Free Documentation License".
+
+If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
+replace the "with...Texts." line with this:
+
+    with the Invariant Sections being LIST THEIR TITLES, with the
+    Front-Cover Texts being LIST, and with the Back-Cover Texts being LIST.
+
+If you have Invariant Sections without Cover Texts, or some other
+combination of the three, merge those two alternatives to suit the
+situation.
+
+If your document contains nontrivial examples of program code, we
+recommend releasing these examples in parallel under your choice of
+free software license, such as the GNU General Public License,
+to permit their use in free software.
diff --git a/gcc/m2/COPYING.RUNTIME b/gcc/m2/COPYING.RUNTIME
new file mode 100644
index 00000000000..649af5e573a
--- /dev/null
+++ b/gcc/m2/COPYING.RUNTIME
@@ -0,0 +1,73 @@
+GCC RUNTIME LIBRARY EXCEPTION
+
+Version 3.1, 31 March 2009
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc. <http://fsf.org/>
+
+Everyone is permitted to copy and distribute verbatim copies of this
+license document, but changing it is not allowed.
+
+This GCC Runtime Library Exception ("Exception") is an additional
+permission under section 7 of the GNU General Public License, version
+3 ("GPLv3"). It applies to a given file (the "Runtime Library") that
+bears a notice placed by the copyright holder of the file stating that
+the file is governed by GPLv3 along with this Exception.
+
+When you use GCC to compile a program, GCC may combine portions of
+certain GCC header files and runtime libraries with the compiled
+program. The purpose of this Exception is to allow compilation of
+non-GPL (including proprietary) programs to use, in this way, the
+header files and runtime libraries covered by this Exception.
+
+0. Definitions.
+
+A file is an "Independent Module" if it either requires the Runtime
+Library for execution after a Compilation Process, or makes use of an
+interface provided by the Runtime Library, but is not otherwise based
+on the Runtime Library.
+
+"GCC" means a version of the GNU Compiler Collection, with or without
+modifications, governed by version 3 (or a specified later version) of
+the GNU General Public License (GPL) with the option of using any
+subsequent versions published by the FSF.
+
+"GPL-compatible Software" is software whose conditions of propagation,
+modification and use would permit combination with GCC in accord with
+the license of GCC.
+
+"Target Code" refers to output from any compiler for a real or virtual
+target processor architecture, in executable form or suitable for
+input to an assembler, loader, linker and/or execution
+phase. Notwithstanding that, Target Code does not include data in any
+format that is used as a compiler intermediate representation, or used
+for producing a compiler intermediate representation.
+
+The "Compilation Process" transforms code entirely represented in
+non-intermediate languages designed for human-written code, and/or in
+Java Virtual Machine byte code, into Target Code. Thus, for example,
+use of source code generators and preprocessors need not be considered
+part of the Compilation Process, since the Compilation Process can be
+understood as starting with the output of the generators or
+preprocessors.
+
+A Compilation Process is "Eligible" if it is done using GCC, alone or
+with other GPL-compatible software, or if it is done without using any
+work based on GCC. For example, using non-GPL-compatible Software to
+optimize any GCC intermediate representations would not qualify as an
+Eligible Compilation Process.
+
+1. Grant of Additional Permission.
+
+You have permission to propagate a work of Target Code formed by
+combining the Runtime Library with Independent Modules, even if such
+propagation would otherwise violate the terms of GPLv3, provided that
+all Target Code was generated by Eligible Compilation Processes. You
+may then convey such a combination under terms of your choice,
+consistent with the licensing of the Independent Modules.
+
+2. No Weakening of GCC Copyleft.
+
+The availability of this Exception does not imply any general
+presumption that third-party software is unaffected by the copyleft
+requirements of the license of GCC.
+
diff --git a/gcc/m2/COPYING3 b/gcc/m2/COPYING3
new file mode 100644
index 00000000000..10926e87f11
--- /dev/null
+++ b/gcc/m2/COPYING3
@@ -0,0 +1,675 @@
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Use with the GNU Affero General Public License.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program 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 of the License, or
+    (at your option) any later version.
+
+    This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+  The GNU General Public License does not permit incorporating your program
+into proprietary programs.  If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.  But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+
diff --git a/gcc/m2/COPYING3.LIB b/gcc/m2/COPYING3.LIB
new file mode 100644
index 00000000000..fc8a5de7edf
--- /dev/null
+++ b/gcc/m2/COPYING3.LIB
@@ -0,0 +1,165 @@
+		   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions. 
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version. 
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/gcc/m2/ChangeLog b/gcc/m2/ChangeLog
deleted file mode 100644
index d1f979eaeab..00000000000
--- a/gcc/m2/ChangeLog
+++ /dev/null
@@ -1,5 +0,0 @@
-Copyright (C) 2022 Free Software Foundation, Inc.
-
-Copying and distribution of this file, with or without modification,
-are permitted in any medium without royalty provided the copyright
-notice and this notice are preserved.
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
new file mode 100644
index 00000000000..a8bd7fe4d19
--- /dev/null
+++ b/gcc/m2/Make-lang.in
@@ -0,0 +1,1653 @@
+# Top level -*- makefile -*- fragment for GNU M2.
+
+# Copyright (C) 2000-2022 Free Software Foundation, Inc.
+
+#This file is part of GCC.
+
+#GCC 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.
+
+#GCC 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 GCC; see the file COPYING3.  If not see
+#<http://www.gnu.org/licenses/>.
+
+# Actual names to use when installing a native compiler.
+GM2_INSTALL_NAME = $(shell echo gm2|sed '$(program_transform_name)')
+GM2_TARGET_INSTALL_NAME = $(target_noncanonical)-$(shell echo gm2|sed '$(program_transform_name)')
+
+# Actual names to use when installing a cross-compiler.
+GM2_CROSS_NAME = `echo gm2|sed '$(program_transform_cross_name)'`
+
+M2_MAINTAINER = no
+
+GM2_1 = ./gm2 -B./stage1/m2 -g -fm2-g
+
+GM2_FOR_TARGET = $(STAGE_CC_WRAPPER) ./gm2 -B./ -B$(build_tooldir)/bin/ -L$(objdir)/../ld $(TFLAGS)
+
+TEXISRC = $(objdir)/m2/images/gnu.eps \
+          $(srcdir)/doc/gm2.texi \
+          m2/gm2-libs.texi \
+          m2/gm2-ebnf.texi \
+          m2/SYSTEM-pim.texi \
+          m2/SYSTEM-iso.texi \
+          m2/Builtins.texi
+
+RSTSRC = $(objdir)/m2/images/gnu.eps \
+          $(srcdir)/doc/gm2.texi \
+          m2/gm2-libs.rst \
+          m2/gm2-ebnf.rst \
+          m2/SYSTEM-pim.rst \
+          m2/SYSTEM-iso.rst \
+          m2/Builtins.rst
+
+# Define the names for selecting modula-2 in LANGUAGES.
+m2 modula-2 modula2: gm2$(exeext) xgcc$(exeext) cc1gm2$(exeext) \
+                 $(GCC_PASSES) $(GCC_PARTS)
+m2.serial = cc1gm2$(exeext)
+
+m2.srcinfo: doc/m2.info
+	-cp -p $^ $(srcdir)/doc
+
+ifeq ($(HAVE_PYTHON),yes)
+m2.srcextra: m2/SYSTEM-pim.texi m2/SYSTEM-iso.texi m2/gm2-libs.texi m2/gm2-ebnf.texi
+	-cp -p m2/SYSTEM-pim.texi $(srcdir)/m2
+	-cp -p m2/SYSTEM-iso.texi $(srcdir)/m2
+	-cp -p m2/gm2-libs.texi $(srcdir)/m2
+	-cp -p m2/gm2-ebnf.texi $(srcdir)/m2
+	find . -name '*.texi' -print
+else
+m2.srcextra:
+endif
+
+m2.srcman: doc/gm2.1
+	-cp -p $^ $(srcdir)/doc
+
+# Tell GNU make to ignore these if they exist.
+.PHONY: m2 modula-2 modula2
+
+GM2_PROG_DEP=gm2$(exeext) xgcc$(exeext) cc1gm2$(exeext)
+
+include m2/config-make
+
+LIBSTDCXX=../$(TARGET_SUBDIR)/libstdc++-v3/src/.libs/libstdc++.a
+
+PGE=m2/pge$(exeext)
+
+SRC_PREFIX=G
+
+m2/gm2spec.o: $(srcdir)/m2/gm2spec.cc $(SYSTEM_H) $(GCC_H) $(CONFIG_H) \
+               m2/gm2config.h $(TARGET_H) $(PLUGIN_HEADERS) \
+               $(generated_files) $(C_TREE_H) insn-attr-common.h
+	(SHLIB_LINK='$(SHLIB_LINK)' \
+	SHLIB_MULTILIB='$(SHLIB_MULTILIB)'; \
+	$(COMPILER) $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
+         $(DRIVER_DEFINES) \
+		-DLIBSUBDIR=\"$(libsubdir)\" \
+                -DPREFIX=\"$(prefix)\" \
+                -c $(srcdir)/m2/gm2spec.cc $(OUTPUT_OPTION))
+
+# Create the compiler driver for M2.
+CFLAGS-m2/m2/gm2spec.o += $(DRIVER_DEFINES)
+
+GM2_OBJS = $(GCC_OBJS) prefix.o intl.o m2/gm2spec.o
+
+# Create the compiler driver for gm2.
+gm2$(exeext): $(GM2_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a $(LIBDEPS) \
+    m2/gm2config.h
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \
+	  $(GM2_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a \
+	  $(EXTRA_GCC_LIBS) $(LIBS)
+
+# Create a version of the gm2 driver which calls the cross-compiler.
+gm2-cross$(exeext): gm2$(exeext)
+	-rm -f gm2-cross$(exeext)
+	cp gm2$(exeext) gm2-cross$(exeext)
+
+po-generated:
+
+# Build hooks:
+
+m2.all.cross: gm2-cross$(exeext) plugin/m2rte$(exeext).so
+
+m2.start.encap: gm2$(exeext) plugin/m2rte$(exeext).so
+m2.rest.encap:
+
+
+m2.info: doc/m2.info
+
+m2.man: doc/m2.1
+
+m2.install-man: $(DESTDIR)$(man1dir)/$(GM2_INSTALL_NAME)$(man1ext)
+
+$(DESTDIR)$(man1dir)/$(GM2_INSTALL_NAME)$(man1ext): doc/m2.1 installdirs
+	-rm -f $@
+	-$(INSTALL_DATA) $< $@
+	-chmod a-x $@
+
+m2.dvi: $(TEXISRC)
+	$(TEXI2DVI) -I $(objdir)/m2 -I $(srcdir)/doc/include $(srcdir)/doc/gm2.texi -o $@
+
+m2.ps: m2.dvi
+	dvips -o $@ $<
+
+m2.pdf: m2.ps
+	gs -q -dBATCH -dNOPAUSE -sDEVICE=pdfwrite -sOutputFile=$@ $<
+
+.INTERMEDIATE: m2.pod
+
+m2.pod: doc/gm2.texi $(TEXISRC)
+	-$(TEXI2POD) -I $(objdir)/m2 -D m2 < $< > $@
+
+doc/m2.info: $(TEXISRC)
+	if test "x$(BUILD_INFO)" = xinfo; then \
+	  rm -f doc/m2.info*; \
+          $(MAKEINFO) -I$(objdir)/m2 -I$(srcdir)/doc/include \
+                      -o $@ $(srcdir)/doc/gm2.texi ; \
+	else true; fi
+
+$(objdir)/m2/images/gnu.eps: $(srcdir)/m2/images/gnupng
+	test -d m2/images || mkdir -p m2/images
+	cp $(srcdir)/m2/images/gnu.eps $@
+
+# gm2-libs.texi
+
+m2/gm2-libs.texi: gm2-libs.texi-check; @true
+
+ifeq ($(HAVE_PYTHON),yes)
+gm2-libs.texi-check: m2/SYSTEM-pim.texi m2/SYSTEM-iso.texi m2/Builtins.texi \
+                     $(objdir)/m2/gm2-libs-coroutines/SYSTEM.def
+	$(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -t -uLibraries -s$(srcdir)/m2 -b$(objdir)/m2 -o $(objdir)/m2/gm2-libs.texi
+else
+gm2-libs.texi-check:
+	cp $(srcdir)/m2/target-independent/gm2-libs.texi $(objdir)/m2/gm2-libs.texi
+endif
+	$(STAMP) gm2-libs.texi-check
+
+# gm2-libs.rst
+
+m2/gm2-libs.rst: gm2-libs.rst-check; @true
+
+ifeq ($(HAVE_PYTHON),yes)
+gm2-libs.rst-check: m2/SYSTEM-pim.texi m2/SYSTEM-iso.texi m2/Builtins.texi \
+                     $(objdir)/m2/gm2-libs-coroutines/SYSTEM.def
+	$(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -x -uLibraries -s$(srcdir)/m2 -b$(objdir)/m2 -o $(objdir)/m2/gm2-libs.rst
+else
+gm2-libs.rst-check:
+	cp $(srcdir)/m2/target-independent/gm2-libs.rst $(objdir)/m2/gm2-libs.rst
+endif
+	$(STAMP) gm2-libs.rst-check
+
+# gm2-ebnf.texi
+
+m2/gm2-ebnf.texi: gm2-ebnf.texi-check; @true
+
+gm2-ebnf.texi-check: $(PGE) $(srcdir)/m2/gm2-compiler/P0SyntaxCheck.bnf
+	$(PGE) -c -p -t -f $(srcdir)/m2/gm2-compiler/P0SyntaxCheck.bnf -o m2/gm2-ebnf.texi
+	$(STAMP) gm2-ebnf.texi-check
+
+# gm2-ebnf.rst
+
+m2/gm2-ebnf.rst: gm2-ebnf.rst-check; @true
+
+gm2-ebnf.rst-check: $(PGE) $(srcdir)/m2/gm2-compiler/P0SyntaxCheck.bnf
+	$(PGE) -c -p -t -f $(srcdir)/m2/gm2-compiler/P0SyntaxCheck.bnf -o m2/gm2-ebnf.rst
+	$(STAMP) gm2-ebnf.rst-check
+
+# SYSTEM-pim.texi
+
+m2/SYSTEM-pim.texi: SYSTEM-pim-texi-check; @true
+
+ifeq ($(HAVE_PYTHON),yes)
+SYSTEM-pim-texi-check: $(objdir)/m2/gm2-libs/SYSTEM.def
+	$(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -t -b$(objdir)/m2 -f$(objdir)/m2/gm2-libs/SYSTEM.def -o $(objdir)/m2/SYSTEM-pim.texi
+else
+SYSTEM-pim-texi-check: $(objdir)/m2/gm2-libs/SYSTEM.def
+	cp $(srcdir)/m2/target-independent/SYSTEM-pim.texi $(objdir)/m2/SYSTEM-pim.texi
+endif
+	$(STAMP) SYSTEM-pim-texi-check
+
+# SYSTEM-pim.rst
+
+m2/SYSTEM-pim.rst: SYSTEM-pim-rst-check; @true
+
+ifeq ($(HAVE_PYTHON),yes)
+SYSTEM-pim-rst-check: $(objdir)/m2/gm2-libs/SYSTEM.def
+	$(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -x -b$(objdir)/m2 -f$(objdir)/m2/gm2-libs/SYSTEM.def -o $(objdir)/m2/SYSTEM-pim.rst
+else
+SYSTEM-pim-rst-check: $(objdir)/m2/gm2-libs/SYSTEM.def
+	cp $(srcdir)/m2/target-independent/SYSTEM-pim.rst $(objdir)/m2/SYSTEM-pim.rst
+endif
+	$(STAMP) SYSTEM-pim-rst-check
+
+# SYSTEM-pim.texi
+
+m2/SYSTEM-iso.texi:  SYSTEM-iso.texi-check; @true
+
+ifeq ($(HAVE_PYTHON),yes)
+SYSTEM-iso.texi-check:  $(objdir)/m2/gm2-libs-iso/SYSTEM.def
+	$(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -t -b$(objdir)/m2 -f$(objdir)/m2/gm2-libs-iso/SYSTEM.def -o $(objdir)/m2/SYSTEM-iso.texi
+else
+SYSTEM-iso.texi-check:  $(objdir)/m2/gm2-libs-iso/SYSTEM.def
+	cp $(srcdir)/m2/target-independent/SYSTEM-iso.texi $(objdir)/m2/SYSTEM-iso.texi
+endif
+	$(STAMP) SYSTEM-iso.texi-check
+
+# SYSTEM-pim.rst
+
+m2/SYSTEM-iso.rst:  SYSTEM-iso.rst-check; @true
+
+ifeq ($(HAVE_PYTHON),yes)
+SYSTEM-iso.rst-check:  $(objdir)/m2/gm2-libs-iso/SYSTEM.def
+	$(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -x -b$(objdir)/m2 -f$(objdir)/m2/gm2-libs-iso/SYSTEM.def -o $(objdir)/m2/SYSTEM-iso.rst
+else
+SYSTEM-iso.rst-check:  $(objdir)/m2/gm2-libs-iso/SYSTEM.def
+	cp $(srcdir)/m2/target-independent/SYSTEM-iso.rst $(objdir)/m2/SYSTEM-iso.rst
+endif
+	$(STAMP) SYSTEM-iso.rst-check
+
+
+# m2/Builtins.texi
+
+m2/Builtins.texi:  Builtins.texi-check; @true
+
+ifeq ($(HAVE_PYTHON),yes)
+Builtins.texi-check:  m2/gm2-libs/Builtins.def
+	$(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -t -b./ -f$(srcdir)/m2/gm2-libs/Builtins.def -o $(objdir)/m2/Builtins.texi
+else
+Builtins.texi-check:  m2/gm2-libs/Builtins.def
+	cp $(srcdir)/m2/target-independent/Builtins.texi $(objdir)/m2/Builtins.texi
+endif
+	$(STAMP) Builtins.texi-check
+
+# m2/Builtins.rst
+
+m2/Builtins.rst:  Builtins.rst-check; @true
+
+ifeq ($(HAVE_PYTHON),yes)
+Builtins.rst-check:  m2/gm2-libs/Builtins.def
+	$(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -x -b./ -f$(srcdir)/m2/gm2-libs/Builtins.def -o $(objdir)/m2/Builtins.rst
+else
+Builtins.rst-check:  m2/gm2-libs/Builtins.def
+	cp $(srcdir)/m2/target-independent/Builtins.rst $(objdir)/m2/Builtins.rst
+endif
+	$(STAMP) Builtins.rst-check
+
+$(objdir)/m2/gm2-compiler-boot:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-libs-boot:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-libiberty:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-gcc:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-compiler:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-libs:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-libs-iso:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-libs-min:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-compiler-paranoid:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-libs-paranoid:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-compiler-verify:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/boot-bin:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-libs-pim:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-libs-coroutines:
+	test -d $@ || mkdir $@
+
+stage1/m2:
+	-test -d $@ || mkdir -p stage1/m2
+
+stage2/m2:
+	-test -d $@ || mkdir -p stage2/m2
+
+stage3/m2:
+	-test -d $@ || mkdir -p stage3/m2
+
+stage4/m2:
+	-test -d $@ || mkdir -p stage4/m2
+
+# No gm2-specific selftests
+selftest-m2:
+
+# Install hooks:
+# cc1gm2 is installed elsewhere as part of $(COMPILERS).
+# $(COMPILERS) is defined in `config-lang.in'
+
+m2.install-common: installdirs
+	-rm -f $(DESTDIR)$(bindir)/$(GM2_INSTALL_NAME)$(exeext)
+	$(INSTALL_PROGRAM) gm2$(exeext) $(DESTDIR)$(bindir)/$(GM2_INSTALL_NAME)$(exeext)
+	-if test -f cc1gm2$(exeext); then \
+	  if test -f gm2-cross$(exeext); then \
+	    :; \
+	  else \
+	    rm -f $(DESTDIR)$(bindir)/$(GM2_TARGET_INSTALL_NAME)$(exeext); \
+	    ( cd $(DESTDIR)$(bindir) && \
+	      $(LN) $(GM2_INSTALL_NAME)$(exeext) $(GM2_TARGET_INSTALL_NAME)$(exeext) ); \
+	  fi; \
+	fi
+	-for tool in cc1gm2$(exeext); do \
+             if [ -f $$tool ]; then \
+               rm -f $(DESTDIR)$(libexecsubdir)/$$tool; \
+               $(INSTALL_PROGRAM) $$tool $(DESTDIR)$(libexecsubdir)/$$tool; \
+               chmod a+x $(DESTDIR)$(libexecsubdir)/$$tool; \
+             else \
+               echo "cannot find $$tool" ; \
+             fi ; \
+         done
+
+m2.install-info: installdirs
+	if [ -d gm2$(exeext) ] ; then \
+	  if [ -f $(objdir)/doc/gm2.info ]; then \
+	    rm -f $(DESTDIR)$(infodir)/gm2.info*; \
+	    for f in $(objdir)/doc/gm2.info*; do \
+	      realfile=`echo $$f | sed -e 's|.*/\([^/]*\)$$|\1|'`; \
+              rm -f $(DESTDIR)$(infodir)/`basename $$realfile`; \
+	      $(INSTALL_DATA) $$f $(DESTDIR)$(infodir)/`basename $$realfile`; \
+	    done; \
+	    chmod a-x $(DESTDIR)$(infodir)/gm2.info*; \
+	  else true; fi; \
+	else true; fi
+	-if [ -f gm2$(exeext) ] && [ -f $(DESTDIR)$(infodir)/gm2.info ]; then \
+	  if $(SHELL) -c 'install-info --version' >/dev/null 2>&1; then \
+	    install-info --dir-file=$(infodir)/dir $(DESTDIR)$(infodir)/gm2.info; \
+	  else true; fi; \
+	else true; fi
+
+m2.install-normal: m2.install-common m2.install-info m2.install-man
+
+# This target will install GM2 into an existing GCC installation,
+# without overwriting existing files.
+# The semicolon is to prevent the install.sh -> install default rule
+# from doing anything.  Having it run true helps avoid problems and
+# noise from versions of make which don't like to have null commands.
+m2.install: m2.install-normal; @true
+
+gm2.install-with-gcc: $(INSTALL_HEADERS) gm2.install $(INSTALL_LIBGCC)
+	for file in $(GCC_PASSES); do \
+          if [ x"$$file" != x"xgcc$(exeext)" ]; then \
+            rm -f $(DESTDIR)$(libsubdir)/$$file; \
+            $(INSTALL_PROGRAM) $$file $(DESTDIR)$(libsubdir)/$$file || exit 1; \
+          fi; \
+        done; exit 0
+
+m2.uninstall:
+	-rm -rf $(bindir)/$(GM2_INSTALL_NAME)
+	-rm -rf $(bindir)/$(GM2_CROSS_NAME)
+
+m2.install-plugin: installdirs
+	$(mkinstalldirs) $(DESTDIR)$(plugin_resourcesdir)
+	$(INSTALL_PROGRAM) plugin/m2rte$(exeext).so $(DESTDIR)$(plugin_resourcesdir)/m2rte$(exeext).so
+	chmod a+x $(DESTDIR)$(plugin_resourcesdir)/m2rte$(exeext).so
+
+plugin/m2rte$(exeext).so: $(srcdir)/m2/plugin/m2rte.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) \
+        insn-attr-common.h insn-flags.h $(generated_files)
+	test -d plugin || mkdir plugin
+	$(PLUGINCC) $(PLUGINCFLAGS) -fno-rtti -I. -I$(srcdir) -I$(srcdir)/m2 -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/../include -I$(srcdir)/../libcpp/include -Wall $(GMPINC) -Wno-literal-suffix -fPIC -c -o plugin/m2rte.o $(srcdir)/m2/plugin/m2rte.cc
+	$(PLUGINCC) $(PLUGINCFLAGS) $(PLUGINLIBS) -fno-rtti plugin/m2rte.o -shared -o $@
+
+
+# Clean hooks:
+# A lot of the ancillary files are deleted by the main makefile.
+# We just have to delete files specific to us.
+
+m2.mostlyclean:
+	-rm -f m2/*.o
+
+m2.clean:
+	-rm -f m2/*.o
+	-rm -f m2/gm2-libs/config.*
+	-rm m2/gm2-libs/gm2-libs-host.h m2/gm2config.h
+
+m2.extraclean:
+m2.realclean:
+
+# Stage hooks:
+
+m2.stage1: stage1-start
+	-mv m2/*$(objext) stage1/m2
+
+m2.stage2: stage2-start
+	-mv m2/*$(objext) stage2/m2
+
+m2.stage3: stage3-start
+	-mv m2/*$(objext) stage3/m2
+
+m2.stage4: stage4-start
+	-mv m2/*$(objext) stage4/m2
+
+quit: force
+	echo "calling exit"
+	exit 1
+
+# Rules to build the compiler, pge and mc.
+
+# MC_COPYRIGHT=--gpl-header --project="GNU Modula-2"
+MC_COPYRIGHT=
+
+MC_ARGS= --olang=c++ \
+ --h-file-prefix=$(SRC_PREFIX) \
+ -I$(srcdir)/m2/gm2-libs \
+ -I$(srcdir)/m2/gm2-compiler \
+ -I$(srcdir)/m2/gm2-libiberty \
+ -I$(srcdir)/m2/gm2-gcc \
+ --quiet \
+ $(MC_COPYRIGHT) \
+ --gcc-config-system
+
+MCDEPS=m2/boot-bin/mc$(exeext)
+
+MC=m2/boot-bin/mc$(exeext) $(MC_ARGS)
+
+MC_LIBS=m2/mc-boot-ch/Glibc.o m2/mc-boot-ch/Gmcrts.o
+
+M2LINK=m2/boot-bin/mklink$(exeext)
+GM2_O=
+GM2_O_S3=-O
+GM2_OS=-Os
+GM2_G=-g -fm2-g
+GM2_CPP=
+# GM2_DEBUG_STRMEM=-fcpp
+GM2_DEBUG_STRMEM=
+GM2_FLAGS=-Wunused-variable -fsoft-check-all $(GM2_G) $(GM2_O) \
+ -funbounded-by-reference -fpim -fextended-opaque \
+ -Wpedantic-cast -Wpedantic-param-names -ffunction-sections \
+ -fdata-sections $(GM2_CPP) # -fauto-init
+GM2_ISO_FLAGS=-fsoft-check-all $(GM2_G) $(GM2_O) \
+ -funbounded-by-reference -fiso -fextended-opaque \
+ -Wpedantic-cast -Wpedantic-param-names -ffunction-sections \
+ -fdata-sections $(GM2_CPP)
+GM2_MIN_FLAGS=$(GM2_G) $(GM2_OS) \
+ -funbounded-by-reference -fextended-opaque \
+ -Wpedantic-cast -Wpedantic-param-names -fno-exceptions \
+ -ffunction-sections -fdata-sections $(GM2_CPP)
+
+O2=-O2 -g
+SO_O2=-O2 -g -fPIC
+SO=-O0 -g -fPIC
+
+# Language-specific object files for the gm2 compiler.
+
+GM2_C_OBJS        = m2/gm2-lang.o \
+                    m2/stor-layout.o \
+                    m2/m2pp.o \
+                    m2/gm2-gcc/m2assert.o \
+                    m2/gm2-gcc/m2block.o \
+                    m2/gm2-gcc/m2builtins.o \
+                    m2/gm2-gcc/m2except.o \
+                    m2/gm2-gcc/m2color.o \
+                    m2/gm2-gcc/m2configure.o \
+                    m2/gm2-gcc/m2convert.o \
+                    m2/gm2-gcc/m2decl.o \
+                    m2/gm2-gcc/m2expr.o \
+                    m2/gm2-gcc/m2linemap.o \
+                    m2/gm2-gcc/m2statement.o \
+                    m2/gm2-gcc/m2type.o \
+                    m2/gm2-gcc/m2tree.o \
+                    m2/gm2-gcc/m2treelib.o \
+                    m2/gm2-gcc/m2top.o \
+                    m2/gm2-gcc/m2misc.o \
+                    m2/gm2-gcc/init.o
+GM2_LIBS          = m2/gm2-compiler/gm2.a \
+                    ../$(target_subdir)/libgm2/libm2pim/.libs/libm2pim.a m2/gm2-libs-boot/choosetemp.o
+
+GM2_LIBS_BOOT     = m2/gm2-compiler-boot/gm2.a \
+                    m2/gm2-libs-boot/libgm2.a \
+                    $(GM2-BOOT-O)
+
+cc1gm2$(exeext): stage1/m2/cc1gm2$(exeext) $(m2.prev)
+	cp -p $< $@
+
+stage2/m2/cc1gm2$(exeext): stage1/m2/cc1gm2$(exeext) m2/gm2-compiler/m2flex.o $(P) \
+                            $(GM2_C_OBJS) $(BACKEND) $(LIBDEPS) $(GM2_LIBS) \
+                            m2/gm2-gcc/rtegraph.o plugin/m2rte$(exeext).so m2/gm2-libs-boot/M2LINK.o
+	@$(call LINK_PROGRESS,$(INDEX.m2),start)
+	+$(LLINKER) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(GM2_C_OBJS) m2/gm2-compiler/m2flex.o \
+                            attribs.o \
+                              $(GM2_LIBS) \
+                              $(BACKEND) $(LIBS) m2/gm2-gcc/rtegraph.o m2/gm2-libs-boot/M2LINK.o \
+                              $(BACKENDLIBS) $(LIBSTDCXX) -lm
+	@$(call LINK_PROGRESS,$(INDEX.m2),end)
+
+stage1/m2/cc1gm2$(exeext): gm2$(exeext) m2/gm2-compiler-boot/m2flex.o \
+                            $(P) $(GM2_C_OBJS) $(BACKEND) $(LIBDEPS) \
+                            $(GM2_LIBS_BOOT) $(MC_LIBS) \
+                            m2/gm2-gcc/rtegraph.o plugin/m2rte$(exeext).so \
+                            m2/gm2-libs-boot/M2LINK.o \
+                            $(m2.prev)
+	@$(call LINK_PROGRESS,$(INDEX.m2),start)
+	+$(LLINKER) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(GM2_C_OBJS) m2/gm2-compiler-boot/m2flex.o \
+                            attribs.o \
+                             $(GM2_LIBS_BOOT) $(MC_LIBS) \
+                             m2/gm2-gcc/rtegraph.o m2/gm2-libs-boot/M2LINK.o \
+                             $(BACKEND) $(LIBS) $(BACKENDLIBS)
+	@$(call LINK_PROGRESS,$(INDEX.m2),end)
+
+# Compiling object files from source files.
+
+GCC_HEADER_DEPENDENCIES_FOR_M2 = $(BUILD-BOOT-H) $(TIMEVAR_H) m2/gm2config.h $(CONFIG_H) \
+        $(TREE_H) $(RTL_H) $(TARGET_H) $(PLUGIN_HEADERS) \
+        $(BCONFIG_H) $(CORETYPES_H) $(SYSTEM_H) \
+        $(srcdir)/flags.h gtype-m2.h \
+        $(generated_files) insn-attr-common.h
+
+m2/gm2-gcc/%.o: $(srcdir)/m2/gm2-gcc/%.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2)
+	$(COMPILER) -c -g $(ALL_COMPILERFLAGS) \
+             $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
+
+m2/gm2-gcc/m2configure.o: $(srcdir)/m2/gm2-gcc/m2configure.cc \
+               $(SYSTEM_H) $(GCC_H) $(CONFIG_H) \
+               m2/gm2config.h $(TARGET_H) $(PLUGIN_HEADERS) \
+               $(generated_files) $(C_TREE_H) insn-attr-common.h
+	$(COMPILER) $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
+         $(DRIVER_DEFINES) \
+		-DLIBSUBDIR=\"$(libsubdir)\" \
+                -DPREFIX=\"$(prefix)\" \
+                -c $(srcdir)/m2/gm2-gcc/m2configure.cc $(OUTPUT_OPTION)
+
+m2/gm2-lang.o: $(srcdir)/m2/gm2-lang.cc gt-m2-gm2-lang.h $(GCC_HEADER_DEPENDENCIES_FOR_M2)
+	$(COMPILER) -c -g -I$(GM2GCC) $(ALL_COMPILERFLAGS) \
+            $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
+
+m2/stor-layout.o: $(srcdir)/stor-layout.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2)
+	$(COMPILER) -c -DSET_WORD_SIZE=INT_TYPE_SIZE $(ALL_COMPILERFLAGS) \
+            $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
+
+m2/m2pp.o : $(srcdir)/m2/m2pp.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2)
+	$(COMPILER) -c -g -DGM2 $(ALL_COMPILERFLAGS) \
+            $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
+
+m2/gm2-gcc/rtegraph.o: $(srcdir)/m2/gm2-gcc/rtegraph.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) \
+                       gt-m2-rtegraph.h
+	$(COMPILER) -c -g -I$(GM2GCC) $(ALL_COMPILERFLAGS) \
+            $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
+
+c-family/m2pp.o : $(srcdir)/m2/m2pp.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2)
+	$(COMPILER) -c -g $(ALL_COMPILERFLAGS) \
+            $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
+
+m2/gm2-gcc/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-gcc/%.def $(MCDEPS)
+	$(MC) -o=$@ $(srcdir)/m2/gm2-gcc/$*.def
+
+# The following tables define the source files which are translated into C using mc
+# and defines the system interface C files.
+
+# Core library definition modules found in gm2-libs.
+
+GM2-LIBS-BOOT-DEFS = \
+   ASCII.def \
+   Args.def \
+   Assertion.def \
+   Break.def \
+   CmdArgs.def \
+   Debug.def \
+   DynamicStrings.def \
+   Environment.def \
+   FIO.def \
+   FormatStrings.def \
+   FpuIO.def \
+   IO.def \
+   Indexing.def \
+   M2Dependent.def \
+   M2EXCEPTION.def \
+   M2LINK.def \
+   M2RTS.def \
+   NumberIO.def \
+   PushBackInput.def \
+   RTExceptions.def \
+   SArgs.def \
+   SEnvironment.def \
+   SFIO.def \
+   SYSTEM.def \
+   Scan.def \
+   StdIO.def \
+   Storage.def \
+   StrCase.def \
+   StrIO.def \
+   StrLib.def \
+   StringConvert.def \
+   SysExceptions.def \
+   SysStorage.def \
+   TimeString.def \
+   UnixArgs.def \
+   dtoa.def \
+   errno.def \
+   ldtoa.def \
+   libc.def \
+   libm.def \
+   termios.def \
+   wrapc.def \
+
+# Core library implementation modules found in gm2-libs.
+
+GM2-LIBS-BOOT-MODS = \
+   ASCII.mod \
+   Args.mod \
+   Assertion.mod \
+   Break.mod \
+   CmdArgs.mod \
+   Debug.mod \
+   DynamicStrings.mod \
+   Environment.mod \
+   FIO.mod \
+   FormatStrings.mod \
+   FpuIO.mod \
+   IO.mod \
+   Indexing.mod \
+   M2Dependent.mod \
+   M2EXCEPTION.mod \
+   M2RTS.mod \
+   NumberIO.mod \
+   PushBackInput.mod \
+   RTExceptions.mod \
+   SArgs.mod \
+   SEnvironment.mod \
+   SFIO.mod \
+   Scan.mod \
+   Storage.mod \
+   StrCase.mod \
+   StrIO.mod \
+   StrLib.mod \
+   StringConvert.mod \
+   SysStorage.mod \
+   TimeString.mod \
+
+# Hand translated C files and C files for definition module for "C" modules
+# found in gm2-libs-ch.
+
+GM2-LIBS-BOOT-C = \
+   StdIO.c \
+   SysExceptions.c \
+   choosetemp.c \
+   errno.c \
+   termios.c \
+   wrapc.c \
+
+# C++ implemented modules found in gm2-libs-ch.
+
+GM2-LIBS-BOOT-CC = \
+   UnixArgs.cc \
+   dtoa.cc \
+   ldtoa.cc
+
+# Definition modules for the front end found in gm2-compiler.
+
+GM2-COMP-BOOT-DEFS = \
+   FifoQueue.def \
+   Lists.def \
+   M2ALU.def \
+   M2AsmUtil.def \
+   M2Base.def \
+   M2BasicBlock.def \
+   M2Batch.def \
+   M2Bitset.def \
+   M2CaseList.def \
+   M2Check.def \
+   M2Code.def \
+   M2ColorString.def \
+   M2Comp.def \
+   M2Const.def \
+   M2Debug.def \
+   M2DebugStack.def \
+   M2Defaults.def \
+   M2DriverOptions.def \
+   M2Emit.def \
+   M2Error.def \
+   M2EvalSym.def \
+   M2FileName.def \
+   M2GCCDeclare.def \
+   M2GenGCC.def \
+   M2Graph.def \
+   M2LexBuf.def \
+   M2MetaError.def \
+   M2Optimize.def \
+   M2Options.def \
+   M2Pass.def \
+   M2Preprocess.def \
+   M2Printf.def \
+   M2Quads.def \
+   M2Quiet.def \
+   M2Range.def \
+   M2Reserved.def \
+   M2SSA.def \
+   M2Scaffold.def \
+   M2Scope.def \
+   M2Search.def \
+   M2Size.def \
+   M2StackAddress.def \
+   M2StackWord.def \
+   M2Students.def \
+   M2Swig.def \
+   M2System.def \
+   NameKey.def \
+   ObjectFiles.def \
+   Output.def \
+   P0SymBuild.def \
+   P0SyntaxCheck.def \
+   P1Build.def \
+   P1SymBuild.def \
+   P2Build.def \
+   P2SymBuild.def \
+   P3Build.def \
+   P3SymBuild.def \
+   PCBuild.def \
+   PCSymBuild.def \
+   PHBuild.def \
+   Sets.def \
+   SymbolConversion.def \
+   SymbolKey.def \
+   SymbolTable.def \
+   bnflex.def \
+   m2flex.def \
+
+# Implementation modules for the front end found in gm2-compiler.
+
+GM2-COMP-BOOT-MODS = \
+   FifoQueue.mod \
+   Lists.mod \
+   Lists.mod \
+   M2ALU.mod \
+   M2AsmUtil.mod \
+   M2Base.mod \
+   M2BasicBlock.mod \
+   M2Batch.mod \
+   M2Bitset.mod \
+   M2CaseList.mod \
+   M2Check.mod \
+   M2Code.mod \
+   M2ColorString.mod \
+   M2Comp.mod \
+   M2Const.mod \
+   M2Debug.mod \
+   M2DebugStack.mod \
+   M2Defaults.mod \
+   M2DriverOptions.mod \
+   M2Emit.mod \
+   M2Error.mod \
+   M2FileName.mod \
+   M2GCCDeclare.mod \
+   M2GenGCC.mod \
+   M2Graph.mod \
+   M2LexBuf.mod \
+   M2MetaError.mod \
+   M2Optimize.mod \
+   M2Options.mod \
+   M2Pass.mod \
+   M2Preprocess.mod \
+   M2Printf.mod \
+   M2Quads.mod \
+   M2Quiet.mod \
+   M2Range.mod \
+   M2Reserved.mod \
+   M2SSA.mod \
+   M2Scaffold.mod \
+   M2Scope.mod \
+   M2Search.mod \
+   M2Size.mod \
+   M2StackAddress.mod \
+   M2StackWord.mod \
+   M2Students.mod \
+   M2Swig.mod \
+   M2System.mod \
+   NameKey.mod \
+   NameKey.mod \
+   ObjectFiles.mod \
+   Output.mod \
+   P0SymBuild.mod \
+   P1SymBuild.mod \
+   P2SymBuild.mod \
+   P3SymBuild.mod \
+   PCSymBuild.mod \
+   Sets.mod \
+   SymbolConversion.mod \
+   SymbolKey.mod \
+   SymbolKey.mod \
+   SymbolTable.mod \
+   bnflex.mod \
+
+# The interface between the modula-2 front end and gimple/trees found in directory gm2-gcc.
+
+GM2-GCC-DEFS = \
+   m2block.def \
+   m2builtins.def \
+   m2color.def \
+   m2configure.def \
+   m2convert.def \
+   m2decl.def \
+   m2except.def \
+   m2except.def \
+   m2expr.def \
+   m2linemap.def \
+   m2misc.def \
+   m2statement.def \
+   m2top.def \
+   m2tree.def \
+   m2treelib.def \
+   m2type.def \
+
+# The following lists define the source files used to build gm2 using Modula-2
+# sources directly.
+#
+# cc1gm2$(exeext) uses these definition modules from the core libraries.
+
+GM2-LIBS-DEFS = \
+   ASCII.def \
+   Args.def \
+   Assertion.def \
+   Break.def \
+   Builtins.def \
+   COROUTINES.def \
+   CmdArgs.def \
+   Debug.def \
+   DynamicStrings.def \
+   Environment.def \
+   FIO.def \
+   FormatStrings.def \
+   FpuIO.def \
+   GetOpt.def \
+   IO.def \
+   Indexing.def \
+   LMathLib0.def \
+   LegacyReal.def \
+   M2Dependent.def \
+   M2EXCEPTION.def \
+   M2LINK.def \
+   M2RTS.def \
+   MathLib0.def \
+   MemUtils.def \
+   NumberIO.def \
+   PushBackInput.def \
+   RTExceptions.def \
+   RTint.def \
+   SArgs.def \
+   SEnvironment.def \
+   SFIO.def \
+   SMathLib0.def \
+   SYSTEM.def \
+   Scan.def \
+   StdIO.def \
+   Storage.def \
+   StrCase.def \
+   StrIO.def \
+   StrLib.def \
+   StringConvert.def \
+   SysStorage.def \
+   TimeString.def \
+   UnixArgs.def \
+   cbuiltin.def \
+   dtoa.def \
+   ldtoa.def \
+   libc.def \
+   termios.def \
+   wrapc.def \
+
+# cc1gm2$(exeext) uses these implementation modules from the core libraries.
+
+GM2-LIBS-MODS = \
+   ASCII.mod \
+   Args.mod \
+   Assertion.mod \
+   Break.mod \
+   Builtins.mod \
+   COROUTINES.mod \
+   CmdArgs.mod \
+   Debug.mod \
+   DynamicStrings.mod \
+   Environment.mod \
+   FIO.mod \
+   FormatStrings.mod \
+   FpuIO.mod \
+   GetOpt.mod \
+   IO.mod \
+   Indexing.mod \
+   LMathLib0.mod \
+   LegacyReal.mod \
+   M2Dependent.mod \
+   M2EXCEPTION.mod \
+   M2RTS.mod \
+   MathLib0.mod \
+   MemUtils.mod \
+   NumberIO.mod \
+   PushBackInput.mod \
+   RTExceptions.mod \
+   RTint.mod \
+   SArgs.mod \
+   SEnvironment.mod \
+   SFIO.mod \
+   SMathLib0.mod \
+   SYSTEM.mod \
+   Scan.mod \
+   StdIO.mod \
+   Storage.mod \
+   StrCase.mod \
+   StrIO.mod \
+   StrLib.mod \
+   StringConvert.mod \
+   SysStorage.mod \
+   TimeString.mod \
+
+# cc1gm2$(exeext) uses these C modules from the core libraries.
+
+GM2-LIBS-C = \
+   Selective.c \
+   SysExceptions.c \
+   cgetopt.c \
+   choosetemp.c \
+   errno.c \
+   host.c \
+   termios.c \
+   wrapc.c \
+
+# cc1gm2$(exeext) uses these C++ modules from the core libraries.
+
+GM2-LIBS-CC = \
+   UnixArgs.cc \
+   dtoa.cc \
+   ldtoa.cc \
+
+# cc1gm2$(exeext) uses these definition modules found in the gm2-compiler directory.
+
+GM2-COMP-DEFS = \
+   FifoQueue.def \
+   Lists.def \
+   M2ALU.def \
+   M2AsmUtil.def   \
+   M2Base.def \
+   M2BasicBlock.def \
+   M2Batch.def \
+   M2Bitset.def \
+   M2CaseList.def \
+   M2Check.def \
+   M2Code.def \
+   M2ColorString.def \
+   M2Comp.def \
+   M2Const.def \
+   M2Debug.def \
+   M2DebugStack.def \
+   M2Defaults.def \
+   M2DriverOptions.def \
+   M2Emit.def \
+   M2Error.def \
+   M2FileName.def \
+   M2GCCDeclare.def \
+   M2GenGCC.def \
+   M2Graph.def \
+   M2LexBuf.def \
+   M2MetaError.def \
+   M2Optimize.def \
+   M2Options.def \
+   M2Pass.def \
+   M2Preprocess.def \
+   M2Printf.def \
+   M2Quads.def     \
+   M2Quiet.def \
+   M2Range.def \
+   M2Reserved.def \
+   M2SSA.def \
+   M2Scaffold.def \
+   M2Scope.def \
+   M2Search.def \
+   M2Size.def \
+   M2StackAddress.def \
+   M2StackWord.def \
+   M2Students.def \
+   M2Swig.def \
+   M2System.def \
+   NameKey.def \
+   ObjectFiles.def \
+   P0SymBuild.def \
+   P0SyntaxCheck.def \
+   P1Build.def \
+   P1SymBuild.def \
+   P2Build.def \
+   P2SymBuild.def \
+   P3Build.def \
+   P3SymBuild.def \
+   PCBuild.def \
+   PCSymBuild.def \
+   PHBuild.def \
+   Sets.def \
+   SymbolConversion.def \
+   SymbolKey.def \
+   SymbolTable.def \
+   bnflex.def \
+
+# cc1gm2$(exeext) uses these implementation modules found in the gm2-compiler directory.
+
+GM2-COMP-MODS = \
+   FifoQueue.mod \
+   Lists.mod \
+   M2ALU.mod \
+   M2AsmUtil.mod \
+   M2Base.mod \
+   M2BasicBlock.mod \
+   M2Batch.mod \
+   M2Bitset.mod \
+   M2CaseList.mod \
+   M2Check.mod \
+   M2Code.mod \
+   M2ColorString.mod \
+   M2Comp.mod \
+   M2Const.mod \
+   M2Debug.mod \
+   M2DebugStack.mod \
+   M2Defaults.mod \
+   M2DriverOptions.mod \
+   M2Emit.mod \
+   M2Error.mod \
+   M2FileName.mod \
+   M2GCCDeclare.mod \
+   M2GenGCC.mod \
+   M2Graph.mod \
+   M2LexBuf.mod \
+   M2MetaError.mod \
+   M2Optimize.mod \
+   M2Options.mod \
+   M2Pass.mod \
+   M2Preprocess.mod \
+   M2Printf.mod \
+   M2Quads.mod \
+   M2Quiet.mod \
+   M2Range.mod \
+   M2Reserved.mod \
+   M2SSA.mod \
+   M2Scaffold.mod \
+   M2Scope.mod \
+   M2Search.mod \
+   M2Size.mod \
+   M2StackAddress.mod \
+   M2StackWord.mod \
+   M2Students.mod \
+   M2Swig.mod \
+   M2System.mod \
+   NameKey.mod \
+   ObjectFiles.mod \
+   Output.mod \
+   P0SymBuild.mod \
+   P1SymBuild.mod \
+   P2SymBuild.mod  \
+   P3SymBuild.mod  \
+   PCSymBuild.mod \
+   Sets.mod \
+   SymbolConversion.mod \
+   SymbolKey.mod \
+   SymbolTable.mod \
+   bnflex.mod \
+
+# Implementation modules created by the parser generator pge from .bnf files.
+
+GM2-AUTO-MODS = \
+   P2Build.mod \
+   P3Build.mod \
+   PHBuild.mod \
+   PCBuild.mod \
+   P1Build.mod \
+   P0SyntaxCheck.mod \
+
+# LIBIBERTY interface definition modules
+
+GM2-LIBIBERTY-DEFS = \
+   choosetemp.def \
+   pexecute.def
+
+BUILD-LIBS-BOOT-H = $(GM2-LIBS-BOOT-DEFS:%.def=m2/gm2-libs-boot/$(SRC_PREFIX)%.h)
+
+BUILD-LIBS-BOOT = $(BUILD-LIBS-BOOT-H) \
+                  $(GM2-LIBS-BOOT-MODS:%.mod=m2/gm2-libs-boot/%.o) \
+                  $(GM2-LIBS-BOOT-CC:%.cc=m2/gm2-libs-boot/%.o) \
+                  $(GM2-LIBS-BOOT-C:%.c=m2/gm2-libs-boot/%.o)
+
+BUILD-COMPILER-BOOT-H = $(GM2-COMP-BOOT-DEFS:%.def=m2/gm2-compiler-boot/$(SRC_PREFIX)%.h) \
+                        $(GM2-LIBIBERTY-DEFS:%.def=m2/gm2-libiberty/$(SRC_PREFIX)%.h) \
+                        $(GM2-GCC-DEFS:%.def=m2/gm2-gcc/$(SRC_PREFIX)%.h)
+
+BUILD-COMPILER-BOOT = $(BUILD-COMPILER-BOOT-H) \
+                      $(GM2-COMP-BOOT-DEFS:%.def=m2/gm2-compiler-boot/$(SRC_PREFIX)%.h) \
+                      $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler-boot/%.o) \
+                      $(GM2-COMP-BOOT-MODS:%.mod=m2/gm2-compiler-boot/%.o) \
+                      m2/gm2-compiler-boot/m2flex.o
+
+BUILD-BOOT-H = m2/boot-bin/mc$(exeext) \
+               $(BUILD-LIBS-BOOT-H) $(BUILD-COMPILER-BOOT-H) $(TARGET_H) $(PLUGIN_HEADERS)
+
+# Core library definition modules used by the modula-2 to C++ translator.
+
+MC-LIB-DEFS = \
+   ASCII.def \
+   Args.def \
+   Assertion.def \
+   Break.def  \
+   COROUTINES.def \
+   CmdArgs.def \
+   Debug.def \
+   DynamicStrings.def \
+   Environment.def \
+   FIO.def \
+   FormatStrings.def \
+   FpuIO.def \
+   IO.def \
+   M2Dependent.def \
+   M2EXCEPTION.def \
+   M2LINK.def \
+   M2RTS.def \
+   MemUtils.def \
+   NumberIO.def \
+   PushBackInput.def \
+   RTExceptions.def \
+   RTco.def \
+   RTint.def \
+   SArgs.def \
+   SFIO.def \
+   SYSTEM.def \
+   Selective.def \
+   StdIO.def \
+   Storage.def \
+   StrCase.def \
+   StrIO.def \
+   StrLib.def \
+   StringConvert.def \
+   SysExceptions.def \
+   SysStorage.def \
+   TimeString.def \
+   UnixArgs.def \
+   dtoa.def \
+   errno.def \
+   ldtoa.def \
+   libc.def \
+   libm.def \
+   termios.def \
+   wrapc.def \
+
+# Core library implementation modules used by the modula-2 to C++ translator.
+
+MC-LIB-MODS = \
+   ASCII.mod \
+   Args.mod \
+   Assertion.mod \
+   Break.mod  \
+   CmdArgs.mod \
+   Debug.mod \
+   DynamicStrings.mod \
+   Environment.mod \
+   FIO.mod \
+   FormatStrings.mod \
+   FpuIO.mod \
+   IO.mod \
+   M2Dependent.mod \
+   M2EXCEPTION.mod \
+   M2RTS.mod \
+   MemUtils.mod \
+   NumberIO.mod \
+   PushBackInput.mod \
+   RTExceptions.mod \
+   RTint.mod \
+   SArgs.mod \
+   SFIO.mod \
+   StdIO.mod \
+   Storage.mod \
+   StrCase.mod \
+   StrIO.mod \
+   StrLib.mod \
+   StringConvert.mod \
+   SysStorage.mod \
+   TimeString.mod \
+
+MC-LIB-BOOT-C = $(MC-LIB-MODS:%.mod=%.c)
+
+# Definition modules for the modula-2 to C++ translator found in mc.
+
+MC-DEFS = \
+   Indexing.def \
+   alists.def \
+   decl.def \
+   keyc.def \
+   lists.def \
+   mcComment.def \
+   mcComp.def \
+   mcDebug.def \
+   mcError.def \
+   mcFileName.def \
+   mcLexBuf.def \
+   mcMetaError.def \
+   mcOptions.def \
+   mcPreprocess.def \
+   mcPretty.def \
+   mcPrintf.def \
+   mcQuiet.def \
+   mcReserved.def \
+   mcSearch.def \
+   mcStack.def \
+   mcStream.def \
+   mcflex.def \
+   mcp1.def \
+   mcp2.def \
+   mcp3.def \
+   mcp4.def \
+   mcp5.def  \
+   nameKey.def \
+   symbolKey.def \
+   varargs.def \
+   wlists.def \
+
+# Implementation modules for the modula-2 to C++ translator found in mc.
+
+MC-MODS = \
+   Indexing.mod \
+   alists.mod \
+   decl.mod \
+   keyc.mod \
+   lists.mod \
+   mcComment.mod \
+   mcComp.mod \
+   mcDebug.mod \
+   mcError.mod \
+   mcFileName.mod \
+   mcLexBuf.mod \
+   mcMetaError.mod \
+   mcOptions.mod \
+   mcPreprocess.mod \
+   mcPretty.mod \
+   mcPrintf.mod \
+   mcQuiet.mod \
+   mcReserved.mod \
+   mcSearch.mod \
+   mcStack.mod \
+   mcStream.mod \
+   nameKey.mod \
+   symbolKey.mod \
+   top.mod \
+   varargs.mod \
+   wlists.mod \
+
+# Parser files generated by pge from .bnf files.
+
+MC-AUTO-MODS = \
+   mcp1.mod \
+   mcp2.mod \
+   mcp3.mod \
+   mcp4.mod \
+   mcp5.mod
+
+MC-BOOT-C = $(MC-MODS:%.mod=%.c) $(MC-AUTO-MODS:%.mod=%.c)
+
+# C interface files for mc.
+
+MC-INTERFACE-C = \
+   M2LINK.c \
+   SYSTEM.c \
+   Selective.c \
+   SysExceptions.c \
+   abort.c \
+   errno.c \
+   libc.c \
+   mcrts.c \
+   termios.c \
+   wrapc.c \
+
+# C++ interface files for mc.
+
+MC-INTERFACE-CC = \
+   UnixArgs.cc \
+   dtoa.cc \
+   ldtoa.cc \
+
+BUILD-MC-BOOT-H =  $(MC-LIB-DEFS:%.def=m2/mc-boot-gen/$(SRC_PREFIX)%.h) \
+                   $(MC-DEFS:%.def=m2/mc-boot-gen/$(SRC_PREFIX)%.h)
+
+BUILD-MC-BOOT-C =  $(MC-LIB-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c) \
+                   $(MC-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c)
+
+BUILD-MC-BOOT-AUTO-C = $(MC-AUTO-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c)
+
+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-INTERFACE-O = $(MC-INTERFACE-C:%.c=m2/mc-boot-ch/$(SRC_PREFIX)%.o) \
+                       $(MC-INTERFACE-CC:%.cc=m2/mc-boot-ch/$(SRC_PREFIX)%.o)
+
+GM2GCC = -I$(srcdir)/m2 -Im2 -I$(srcdir)/m2/gm2-gcc -Im2/gm2-gcc
+
+MCINCLUDES= -I$(srcdir)/m2/mc-boot-ch
+LOCAL_INCLUDES = -I. -I$(srcdir)/../include -I$(srcdir)
+
+GCC_COLOR=m2/gm2-gcc/m2color.o diagnostic-color.o
+
+m2/boot-bin/mc$(exeext): $(BUILD-MC-BOOT-O) $(BUILD-MC-INTERFACE-O) \
+        m2/mc-boot/main.o mcflex.o m2/gm2-libs-boot/RTcodummy.o
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-MC-BOOT-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
+	$(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-ch/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -DHAVE_CONFIG_H -g -c -I. -Im2/gm2-libs -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) -Im2/gm2-libs $< -o $@
+
+m2/mc-boot-ch/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -DHAVE_CONFIG_H -g -c -I. -Im2/gm2-libs -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) -Im2/gm2-libs $< -o $@
+
+m2/mc-boot/main.o: $(M2LINK) $(srcdir)/m2/init/mcinit
+	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 $@
+
+mcflex.o: mcflex.c
+	$(CC) -I$(srcdir)/m2/mc -g -c $< -o $@   # remember that mcReserved.h is copied into m2/mc
+
+mcflex.c: $(srcdir)/m2/mc/mc.flex
+	flex -t $< > $@
+
+m2/gm2-libs-boot/%.o: $(srcdir)/m2/gm2-libs-boot/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MC) -o=m2/gm2-libs-boot/$*.c $(srcdir)/m2/gm2-libs-boot/$*.mod
+	$(COMPILER) -c -DIN_GCC $(CFLAGS) $(MCINCLUDES) m2/gm2-libs-boot/$*.c -o $@
+
+m2/gm2-libs-boot/%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MC) -o=m2/gm2-libs-boot/$*.c $(srcdir)/m2/gm2-libs/$*.mod
+	$(COMPILER) -c -DIN_GCC $(CFLAGS) -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(MCINCLUDES) $(INCLUDES) m2/gm2-libs-boot/$*.c -o $@
+
+m2/gm2-libs-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS)
+	$(MC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def
+
+m2/gm2-libs-boot/RTcodummy.o: $(srcdir)/m2/gm2-libs-ch/RTcodummy.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c -DIN_GCC $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/RTintdummy.o: $(srcdir)/m2/gm2-libs-ch/RTintdummy.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c -DIN_GCC $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/wrapc.o: $(srcdir)/m2/gm2-libs-ch/wrapc.c m2/gm2-libs-boot/$(SRC_PREFIX)wrapc.h m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c -DHAVE_CONFIG_H $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/M2LINK.o: $(srcdir)/m2/gm2-libs-ch/M2LINK.c m2/gm2-libs-boot/$(SRC_PREFIX)M2LINK.h m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c -DHAVE_CONFIG_H $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/UnixArgs.o: $(srcdir)/m2/gm2-libs-ch/UnixArgs.cc m2/gm2-libs-boot/$(SRC_PREFIX)UnixArgs.h m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c -DIN_GCC $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/choosetemp.o: m2/gm2-libs-ch/choosetemp.c m2/gm2-libiberty/Gchoosetemp.h m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libiberty -I$(srcdir)/m2/gm2-libiberty/ $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/errno.o: $(srcdir)/m2/gm2-libs-ch/errno.c m2/gm2-libs-boot/$(SRC_PREFIX)errno.h m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/dtoa.o: $(srcdir)/m2/gm2-libs-ch/dtoa.cc m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/ldtoa.o: $(srcdir)/m2/gm2-libs-ch/ldtoa.cc m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/termios.o: $(srcdir)/m2/gm2-libs-ch/termios.c $(BUILD-LIBS-BOOT-H) m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/SysExceptions.o: $(srcdir)/m2/gm2-libs-ch/SysExceptions.c \
+                                  m2/gm2-libs-boot/$(SRC_PREFIX)SysExceptions.h m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-boot/SysStorage.o: $(srcdir)/m2/gm2-libs/SysStorage.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MC) -o=m2/gm2-libs-boot/SysStorage.c $(srcdir)/m2/gm2-libs/SysStorage.mod
+	$(COMPILER) -DIN_GCC -c $(CFLAGS) \
+          -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(MCINCLUDES) $(INCLUDES) \
+          m2/gm2-libs-boot/SysStorage.c -o m2/gm2-libs-boot/SysStorage.o
+
+m2/gm2-compiler-boot/M2GCCDeclare.o: $(srcdir)/m2/gm2-compiler/M2GCCDeclare.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MC) --extended-opaque -o=m2/gm2-compiler-boot/M2GCCDeclare.c $<
+	$(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \
+            -I. -I$(srcdir)/../include -I$(srcdir) \
+            -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \
+            -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/M2GCCDeclare.c -o $@
+
+m2/gm2-compiler-boot/M2Error.o: $(srcdir)/m2/gm2-compiler/M2Error.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MC) --extended-opaque -o=m2/gm2-compiler-boot/M2Error.c $<
+	$(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \
+            -I. -I$(srcdir)/../include -I$(srcdir) \
+            -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \
+            -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/M2Error.c -o $@
+
+m2/gm2-compiler-boot/%.o: $(srcdir)/m2/gm2-compiler/%.mod $(BUILD-BOOT-H) $(MCDEPS) $(BUILD-BOOT-H)
+	$(MC) -o=m2/gm2-compiler-boot/$*.c $(srcdir)/m2/gm2-compiler/$*.mod
+	$(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \
+            -I. -I$(srcdir)/../include -I$(srcdir) \
+            -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot -Im2/gm2-libiberty \
+            -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/$*.c -o $@
+
+m2/gm2-compiler-boot/%.o: m2/gm2-compiler-boot/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MC) -o=m2/gm2-compiler-boot/$*.c m2/gm2-compiler-boot/$*.mod
+	$(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \
+            -I. -I$(srcdir)/../include -I$(srcdir) \
+            -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \
+            -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/$*.c -o $@
+
+m2/gm2-compiler-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-compiler/%.def $(MCDEPS)
+	$(MC) -o=$@ $(srcdir)/m2/gm2-compiler/$*.def
+
+m2/gm2-compiler-boot/m2flex.o: m2/gm2-compiler/m2flex.c $(BUILD-BOOT-H) $(TIMEVAR_H) \
+        $(BUILD-LIBS-BOOT-H)  m2/gm2-compiler-boot/$(SRC_PREFIX)NameKey.h \
+        $(CONFIG_H) m2/gm2config.h $(TARGET_H) $(PLUGIN_HEADERS)
+	$(COMPILER) -c -g $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
+          $(GM2GCC) $(INCLUDES) -I$(srcdir)/m2 \
+          -Im2 -Im2/gm2-compiler-boot -Im2/gm2-libs-boot $< -o $@
+
+m2/gm2-compiler/m2flex.c: $(srcdir)/m2/m2.flex $(TIMEVAR_H) insn-attr-common.h
+	flex -t $< | sed -e 's/ malloc/ xmalloc/' | sed -e 's/ realloc/ xrealloc/' > $@
+
+m2/gm2-libiberty/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libiberty/%.def $(MCDEPS)
+	$(MC) -o=$@ $(srcdir)/m2/gm2-libiberty/$*.def
+
+# The rules to build objects in gm2-compiler and gm2-libs directories.
+
+m2/gm2-compiler/%.o: $(srcdir)/m2/gm2-compiler/%.mod
+	$(GM2_1) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler/m2flex.o: m2/gm2-compiler/m2flex.c m2/gm2-libs/gm2-libs-host.h $(TIMEVAR_H)
+	$(COMPILER) -c -g $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
+          $(GM2GCC) -Im2/gm2-compiler-boot -Im2/gm2-libs-boot $< -o $@
+
+m2/gm2-compiler/%.o: m2/gm2-compiler/%.mod
+	$(GM2_1) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-libs-iso/%.o: $(srcdir)/m2/gm2-libs-iso/%.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -DBUILD_GM2_LIBS_TARGET -DBUILD_GM2_LIBS -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-iso/%.o: $(srcdir)/m2/gm2-libs-iso/%.mod
+	$(GM2_1) $(GM2_ISO_FLAGS) -c -B./ -Im2/gm2-libs-iso:$(srcdir)/m2/gm2-libs-iso -I$(srcdir)/m2/gm2-libs $< -o $@
+
+
+# We build the cc1gm2$(exeext) from the boot stage and then proceed to build it
+# again using itself.
+
+m2/gm2-libs/gm2-libs-host.h:
+	echo "Configuring to build libraries using native compiler" ; \
+        NEW_SRCDIR=`${srcdir}/m2/tools-src/calcpath ../../ ${srcdir} m2/gm2-libs` ; \
+        export NEW_SRCDIR ; \
+        cd m2/gm2-libs ; \
+        $(SHELL) -c '$${NEW_SRCDIR}/config-host \
+               --srcdir=$${NEW_SRCDIR} \
+               --target=$(target) \
+               --program-suffix=$(exeext)'
+
+# Autoconf inserts -DCROSS_DIRECTORY_STRUCTURE if we are building a
+# cross compiler and the ../Makefile.in above appends this to INTERNAL_CFLAGS.
+
+m2/gm2config.h:
+	NEW_SRCDIR=`${srcdir}/m2/tools-src/calcpath ../ ${srcdir} m2` ; \
+        export NEW_SRCDIR ; \
+	cd m2 ; \
+	if echo $(INTERNAL_CFLAGS) | grep \\-DCROSS_DIRECTORY_STRUCTURE; then \
+            AR=$(echo $(AR_FOR_TARGET) | sed -e "s/^ //") ; \
+            export AR ; \
+            RANLIB=$(echo $(RANLIB_FOR_TARGET) | sed -e "s/^ //") ; \
+            export RANLIB ; \
+            $(SHELL) -c '$${NEW_SRCDIR}/configure --srcdir=$${NEW_SRCDIR} \
+                --target=$(target) --program-suffix=$(exeext) \
+                --includedir=$(SYSTEM_HEADER_DIR) --libdir=$(libdir) \
+                --libexecdir=$(libexecdir)' ; \
+        else \
+            $(SHELL) -c '$${NEW_SRCDIR}/configure --srcdir=$(NEW_SRCDIR) \
+                --target=$(target) --program-suffix=$(exeext)' ; \
+        fi
+
+$(objdir)/m2/gm2-libs-min/SYSTEM.def: $(GM2_PROG_DEP)
+	$(SHELL) $(srcdir)/m2/tools-src/makeSystem -fpim \
+             $(srcdir)/m2/gm2-libs-min/SYSTEM.def \
+             $(srcdir)/m2/gm2-libs-min/SYSTEM.mod \
+             -I$(srcdir)/m2/gm2-libs-min:$(srcdir)/m2/gm2-libs \
+             "$(GM2_FOR_TARGET)" $@
+
+$(objdir)/m2/gm2-libs/SYSTEM.def: $(GM2_PROG_DEP)
+	echo "GM2_FOR_TARGET $(GM2_FOR_TARGET)"
+	echo "GCC_FOR_TARGET $(GCC_FOR_TARGET)"
+	$(SHELL) $(srcdir)/m2/tools-src/makeSystem -fpim \
+             $(srcdir)/m2/gm2-libs/SYSTEM.def \
+             $(srcdir)/m2/gm2-libs/SYSTEM.mod \
+             -I$(srcdir)/m2/gm2-libs \
+             "$(GM2_FOR_TARGET)" $@
+
+$(objdir)/m2/gm2-libs-iso/SYSTEM.def: $(GM2_PROG_DEP)
+	$(SHELL) $(srcdir)/m2/tools-src/makeSystem -fiso \
+             $(srcdir)/m2/gm2-libs-iso/SYSTEM.def \
+             $(srcdir)/m2/gm2-libs-iso/SYSTEM.mod \
+             -I$(srcdir)/m2/gm2-libs-iso:$(srcdir)/m2/gm2-libs \
+             "$(GM2_FOR_TARGET)" $@
+
+$(objdir)/m2/gm2-libs-coroutines/SYSTEM.def: $(GM2_PROG_DEP)
+	$(SHELL) $(srcdir)/m2/tools-src/makeSystem -fpim \
+             $(srcdir)/m2/gm2-libs-coroutines/SYSTEM.def \
+             $(srcdir)/m2/gm2-libs-coroutines/SYSTEM.mod \
+             -I$(srcdir)/m2/gm2-libs-coroutines:$(srcdir)/m2/gm2-libs-iso:$(srcdir)/m2/gm2-libs \
+             "$(GM2_FOR_TARGET)" $@
+
+build-compiler: $(GM2-COMP-MODS:%.mod=m2/gm2-compiler/%.o) \
+                $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler/%.o) \
+                m2/gm2-compiler/m2flex.o
+
+m2/gm2-compiler/gm2.a: build-compiler gm2$(exeext)
+	$(AR_FOR_TARGET) cr $@ $(GM2-COMP-MODS:%.mod=m2/gm2-compiler/%.o) \
+                    $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler/%.o)
+	$(RANLIB) $@
+
+m2/gm2-libs-boot/libgm2.a: m2/boot-bin/mc$(exeext) $(BUILD-LIBS-BOOT)
+	$(AR) cr $@ $(GM2-LIBS-BOOT-MODS:%.mod=m2/gm2-libs-boot/%.o) \
+                    $(GM2-LIBS-BOOT-CC:%.cc=m2/gm2-libs-boot/%.o) \
+                    $(GM2-LIBS-BOOT-C:%.c=m2/gm2-libs-boot/%.o)
+	$(RANLIB) $@
+
+m2/gm2-compiler-boot/gm2.a: m2/boot-bin/mc$(exeext) m2/boot-bin/mklink$(exeext) \
+                         $(BUILD-LIBS-BOOT) $(BUILD-COMPILER-BOOT)
+	$(AR) cr $@ $(GM2-COMP-BOOT-MODS:%.mod=m2/gm2-compiler-boot/%.o) \
+                    $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler-boot/%.o)
+	$(RANLIB) $@
+
+m2/gm2-compiler-boot/gm2.a: m2/boot-bin/mc$(exeext)
+
+m2/boot-bin/mklink$(exeext): $(srcdir)/m2/tools-src/mklink.c
+	$(CXX) $(CFLAGS) -I$(srcdir)/m2 -Im2/gm2-libs-boot -Im2/gm2-compiler-boot -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) $< -o $@
+
+m2/gm2-compiler-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-compiler-boot/%.def $(MCDEPS)
+	$(MC) --quiet -o=$@ $(srcdir)/m2/gm2-compiler-boot/$*.def
+
+m2/gm2-compiler/%.mod: $(srcdir)/m2/gm2-compiler/%.bnf $(PGE)
+	$(PGE) -k -l $< -o $@
+
+m2/gm2-compiler-boot/%.mod: $(srcdir)/m2/gm2-compiler/%.bnf $(PGE)
+	$(PGE) -k -l $< -o $@
+
+check-m2: check-gm2
+check_m2: check-gm2
+check_gm2: check-gm2
+check-modula2: check-gm2
+check_modula2: check-gm2
+check-modula-2: check-gm2
+check_modula-2: check-gm2
+check_modula_2: check-gm2
+
+lang_checks += check-gm2
+lang_checks_parallelized += check-gm2
+# For description see the check_$lang_parallelize comment in gcc/Makefile.in.
+check_gm2_parallelize = 10000
+
+check-gm2-local: $(GM2TESTSUITEDIR)/site.exp
+	-(rootme=`${PWD_COMMAND}`; export rootme; \
+	srcdir=`cd ${srcdir}; ${PWD_COMMAND}` ; export srcdir ; \
+	cd $(TESTSUITEDIR); \
+	EXPECT=${EXPECT} ; export EXPECT ; \
+	if [ -f $${rootme}/../expect/expect ] ; then  \
+	   TCL_LIBRARY=`cd .. ; cd ${srcdir}/../tcl/library ; ${PWD_COMMAND}` ; \
+	    export TCL_LIBRARY ; fi ; \
+	$(RUNTEST) --tool gm2 --directory testsuite/m2/pim/pass)
+
+BUILD-PGE-O = \
+   m2/pge-boot/GArgs.o \
+   m2/pge-boot/GASCII.o \
+   m2/pge-boot/GAssertion.o \
+   m2/pge-boot/Gbnflex.o \
+   m2/pge-boot/GDebug.o \
+   m2/pge-boot/GDynamicStrings.o \
+   m2/pge-boot/GFIO.o \
+   m2/pge-boot/GIndexing.o \
+   m2/pge-boot/GIO.o \
+   m2/pge-boot/GLists.o \
+   m2/pge-boot/GM2Dependent.o \
+   m2/pge-boot/GM2EXCEPTION.o \
+   m2/pge-boot/GM2RTS.o \
+   m2/pge-boot/GNameKey.o \
+   m2/pge-boot/GNumberIO.o \
+   m2/pge-boot/GOutput.o \
+   m2/pge-boot/Gpge.o \
+   m2/pge-boot/GPushBackInput.o \
+   m2/pge-boot/GRTExceptions.o \
+   m2/pge-boot/GSFIO.o \
+   m2/pge-boot/GStdIO.o \
+   m2/pge-boot/GStorage.o \
+   m2/pge-boot/GStrCase.o \
+   m2/pge-boot/GStrIO.o \
+   m2/pge-boot/GStrLib.o \
+   m2/pge-boot/GSymbolKey.o \
+   m2/pge-boot/GSysStorage.o \
+   m2/pge-boot/Glibc.o \
+   m2/pge-boot/Gerrno.o \
+   m2/pge-boot/GUnixArgs.o \
+   m2/pge-boot/GM2LINK.o \
+   m2/pge-boot/Gtermios.o \
+   m2/pge-boot/GSysExceptions.o \
+   m2/pge-boot/Gabort.o \
+   m2/pge-boot/Gmcrts.o \
+   m2/pge-boot/main.o
+
+ifeq ($(M2_MAINTAINER),yes)
+include m2/Make-maintainer
+else
+m2/pge-boot/%.o: m2/pge-boot/%.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) $(INCLUDES) -I$(srcdir)/m2/pge-boot -Im2/gm2-libs -g -c $< -o $@
+
+m2/pge-boot/%.o: m2/pge-boot/%.cc m2/gm2-libs/gm2-libs-host.h
+	$(CXX) $(INCLUDES) -I$(srcdir)/m2/pge-boot -Im2/gm2-libs -g -c $< -o $@
+
+$(PGE): $(BUILD-PGE-O)
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PGE-O) -lm
+
+endif
diff --git a/gcc/m2/Make-maintainer.in b/gcc/m2/Make-maintainer.in
new file mode 100644
index 00000000000..2460b979207
--- /dev/null
+++ b/gcc/m2/Make-maintainer.in
@@ -0,0 +1,856 @@
+# Make-maintainer.in build support tools for GNU M2.
+
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+#This file is part of GCC.
+
+#GCC 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.
+
+#GCC 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 GCC; see the file COPYING3.  If not see
+#<http://www.gnu.org/licenses/>.
+
+# QUIAT=@
+XGCC = ./xgcc -B./
+GM2_2 = ./gm2 -B./stage2/m2 -g -fm2-g
+
+# m2/ppg$(exeext)  is the recursive descent parser generator.
+
+PPG-INTERFACE-C = libc.c mcrts.c Selective.c termios.c \
+                  SysExceptions.c wrapc.c \
+                  SYSTEM.c errno.c
+
+PPG-INTERFACE-CC = UnixArgs.cc ldtoa.cc dtoa.cc
+
+# Implementation modules found in the gm2-compiler directory.
+
+PPG-MODS         = SymbolKey.mod   NameKey.mod  Lists.mod  bnflex.mod  Output.mod
+
+# Core library definition modules used by ppg found in the gm2-libs directory.
+
+PPG-LIB-DEFS     = Args.def Assertion.def ASCII.def Debug.def \
+                   DynamicStrings.def FIO.def Indexing.def IO.def \
+                   NumberIO.def PushBackInput.def \
+                   M2Dependent.def \
+                   M2EXCEPTION.def M2LINK.def M2RTS.def \
+                   RTExceptions.def \
+                   StdIO.def SFIO.def StrIO.def StrLib.def \
+                   Storage.def StrCase.def SysStorage.def
+
+# Core library implementation modules used by ppg found in the gm2-libs directory.
+
+PPG-LIB-MODS     = ASCII.mod \
+                   Args.mod \
+                   Assertion.mod \
+                   Debug.mod \
+                   DynamicStrings.mod \
+                   FIO.mod \
+                   IO.mod \
+                   Indexing.mod \
+                   M2Dependent.mod \
+                   M2EXCEPTION.mod \
+                   M2RTS.mod \
+                   NumberIO.mod \
+                   PushBackInput.mod \
+                   RTExceptions.mod \
+                   SFIO.mod \
+                   StdIO.mod \
+                   Storage.mod \
+                   StrCase.mod \
+                   StrIO.mod \
+                   StrLib.mod \
+                   SysStorage.mod
+
+# Program module ppg.mod from which pge.mod is created.  ppg.mod is
+# where changes should be made and then you should run pge-maintainer
+# to recreate the C++ version of pge.
+
+PPG-SRC          = ppg.mod
+
+BUILD-PPG-O = $(PPG-INTERFACE-C:%.c=m2/gm2-ppg-boot/$(SRC_PREFIX)%.o) \
+              $(PPG-INTERFACE-CC:%.cc=m2/gm2-ppg-boot/$(SRC_PREFIX)%.o) \
+              $(PPG-MODS:%.mod=m2/gm2-ppg-boot/$(SRC_PREFIX)%.o) \
+              $(PPG-LIB-MODS:%.mod=m2/gm2-ppg-boot/$(SRC_PREFIX)%.o) \
+              $(PPG-SRC:%.mod=m2/gm2-ppg-boot/$(SRC_PREFIX)%.o)
+
+MCC_ARGS= --olang=c++ \
+ --quiet \
+ --h-file-prefix=$(SRC_PREFIX) \
+ -I$(srcdir)/m2/gm2-libs \
+ -I$(srcdir)/m2/gm2-compiler \
+ -I$(srcdir)/m2/gm2-libiberty \
+ -I$(srcdir)/m2/gm2-gcc
+
+MCC=m2/boot-bin/mc$(exeext) $(MCC_ARGS)
+
+BUILD-PPG-LIBS-H = $(PPG-LIB-DEFS:%.def=m2/gm2-ppg-boot/$(SRC_PREFIX)%.h)
+
+BUILD-PPG-H = m2/boot-bin/mc$(exeext) $(BUILD-PPG-LIBS-H)
+
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS)
+	$(MCC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def
+
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
+
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
+
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c $(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 $@
+
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c $(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 $@
+
+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-libs-boot/M2LINK.o
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PPG-O) m2/gm2-ppg-boot/main.o \
+                 m2/gm2-libs-boot/RTcodummy.o m2/mc-boot-ch/$(SRC_PREFIX)abort.o \
+                 m2/gm2-libs-boot/M2LINK.o -lm
+
+m2/gm2-ppg-boot/main.o: $(M2LINK) $(srcdir)/m2/init/mcinit
+	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
+
+m2/gm2-auto:
+	test -d $@ || mkdir -p $@
+
+# m2/pg$(exext) is the 2nd generation parser generator built from ebnf
+# without error recovery
+
+PG-SRC = pg.mod
+
+BUILD-PG-O = $(PPG-INTERFACE-C:%.c=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
+             $(PPG-INTERFACE-CC:%.cc=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
+             $(PPG-MODS:%.mod=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
+             $(PPG-LIB-MODS:%.mod=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
+             $(PG-SRC:%.mod=m2/gm2-pg-boot/$(SRC_PREFIX)%.o)
+
+m2/gm2-pg-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS)
+	$(MCC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def
+
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
+
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
+
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/gm2-pg-boot	-I$(srcdir)/m2/mc-boot \
+               -I$(srcdir)/m2/mc-boot-ch \
+               -Im2/gm2-libs-boot $(INCLUDES) \
+              -g -c m2/gm2-pg-boot/$(SRC_PREFIX)$*.c -o $@
+
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)$*.c $(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-pg-boot/$(SRC_PREFIX)$*.c -o $@
+
+m2/gm2-pg-boot/$(SRC_PREFIX)pg.o:  m2/gm2-auto/pg.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)pg.c m2/gm2-auto/pg.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-pg-boot/$(SRC_PREFIX)pg.c -o $@
+
+m2/pg$(exeext): m2/boot-bin/mc \
+    $(BUILD-PG-O) $(GM2-PPG-MODS:%.mod=m2/gm2-pg-boot/%.o) \
+    $(BUILD-MC-INTERFACE-O) m2/gm2-pg-boot/main.o m2/gm2-libs-boot/RTcodummy.o \
+    m2/mc-boot-ch/$(SRC_PREFIX)abort.o m2/gm2-libs-boot/M2LINK.o
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PG-O) \
+         m2/gm2-pg-boot/main.o m2/gm2-libs-boot/RTcodummy.o \
+         m2/gm2-libs-boot/M2LINK.o \
+         m2/mc-boot-ch/$(SRC_PREFIX)abort.o -lm
+
+m2/gm2-auto/pginit:
+	sed -e 's/ppg/pg/' < $(srcdir)/m2/init/ppginit > $@
+
+m2/gm2-pg-boot/main.o: m2/gm2-auto/pginit $(M2LINK)
+	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
+
+m2/pg-e$(exeext): m2/pg$(exeext)
+	$(CP) m2/pg$(exeext) m2/pg-e$(exeext)
+	$(SHELL) $(srcdir)/m2/tools-src/buildpg $(srcdir)/m2/gm2-compiler/ppg.mod pg -e > m2/gm2-auto/t.bnf
+	./m2/pg-e$(exeext) -e -l m2/gm2-auto/t.bnf | sed -e 's/t\.bnf/pg\.bnf/' > m2/gm2-auto/t.mod
+	$(QUIAT)if ! diff m2/gm2-auto/t.mod m2/gm2-auto/pg.mod > /dev/null ; then \
+           echo "pg failed during self build" ; \
+           exit 1 ; \
+        fi
+	$(RM) m2/gm2-auto/t.bnf m2/gm2-auto/t.mod
+
+m2/gm2-auto/pg.mod: m2/ppg$(exeext)
+	$(SHELL) $(srcdir)/m2/tools-src/buildpg $(srcdir)/m2/gm2-compiler/ppg.mod pg -e > m2/gm2-auto/pg.bnf
+	./m2/ppg$(exeext) -e -l m2/gm2-auto/pg.bnf > m2/gm2-auto/pg.mod
+
+# pge is the recursive descent parser with first/followset error recovery.
+
+PGE-SRC = pge.mod
+
+BUILD-PGE-O = $(PPG-INTERFACE-C:%.c=m2/gm2-pge-boot/$(SRC_PREFIX)%.o) \
+              $(PPG-INTERFACE-CC:%.cc=m2/gm2-pge-boot/$(SRC_PREFIX)%.o) \
+              $(PPG-MODS:%.mod=m2/gm2-pge-boot/$(SRC_PREFIX)%.o) \
+              $(PPG-LIB-MODS:%.mod=m2/gm2-pge-boot/$(SRC_PREFIX)%.o) \
+              $(PGE-SRC:%.mod=m2/gm2-pge-boot/$(SRC_PREFIX)%.o)
+
+m2/gm2-auto/pge.mod: m2/pg$(exeext)
+	$(SHELL) $(srcdir)/m2/tools-src/buildpg $(srcdir)/m2/gm2-compiler/ppg.mod pge > m2/gm2-auto/pge.bnf
+	./m2/pg$(exeext) -l m2/gm2-auto/pge.bnf -o m2/gm2-auto/pge.mod
+
+m2/gm2-pge-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS)
+	$(MCC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def
+
+m2/gm2-pge-boot/$(SRC_PREFIX)libc.o: $(srcdir)/m2/mc-boot-ch/Glibc.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs -g -c $< -o $@
+
+m2/gm2-pge-boot/$(SRC_PREFIX)mcrts.o:  $(srcdir)/m2/mc-boot-ch/Gmcrts.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs -g -c $< -o $@
+
+m2/gm2-pge-boot/$(SRC_PREFIX)UnixArgs.o:  $(srcdir)/m2/mc-boot-ch/GUnixArgs.cc
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c $< -o $@
+
+m2/gm2-pge-boot/$(SRC_PREFIX)Selective.o:  $(srcdir)/m2/mc-boot-ch/GSelective.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -Im2/gm2-libs -g -c $< -o $@
+
+m2/gm2-pge-boot/$(SRC_PREFIX)termios.o:  $(srcdir)/m2/mc-boot-ch/Gtermios.cc m2/gm2-libs/gm2-libs-host.h
+	$(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)SysExceptions.o:  $(srcdir)/m2/mc-boot-ch/GSysExceptions.c m2/gm2-libs/gm2-libs-host.h
+	$(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
+	$(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
+	$(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)wrapc.o:  $(srcdir)/m2/mc-boot-ch/Gwrapc.c m2/gm2-libs/gm2-libs-host.h
+	$(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)SYSTEM.o:  $(srcdir)/m2/mc-boot-ch/GSYSTEM.c
+	$(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
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c $< -o $@
+
+m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod
+	$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/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 $@
+
+m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.c $(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-pge-boot/$(SRC_PREFIX)$*.c -o $@
+
+m2/gm2-pge-boot/$(SRC_PREFIX)pge.o:  m2/gm2-auto/pge.mod $(MCDEPS) $(BUILD-BOOT-H)
+	$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)pge.c m2/gm2-auto/pge.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-pge-boot/$(SRC_PREFIX)pge.c -o $@
+
+m2/pge$(exeext): m2/boot-bin/mc \
+    $(BUILD-PGE-O) $(GM2-PPG-MODS:%.mod=m2/gm2-pge-boot/%.o) \
+    $(BUILD-MC-INTERFACE-O) m2/gm2-pge-boot/main.o m2/gm2-libs-boot/RTcodummy.o \
+    m2/mc-boot-ch/$(SRC_PREFIX)abort.o m2/gm2-libs-boot/M2LINK.o
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PGE-O) \
+         m2/gm2-pge-boot/main.o m2/gm2-libs-boot/RTcodummy.o \
+         m2/mc-boot-ch/$(SRC_PREFIX)abort.o m2/gm2-libs-boot/M2LINK.o -lm
+	$(SHELL) $(srcdir)/m2/tools-src/buildpg $(srcdir)/m2/gm2-compiler/ppg.mod t > m2/gm2-auto/t.bnf
+	./m2/pge$(exeext) m2/gm2-auto/t.bnf -o m2/gm2-auto/t1.mod
+	./m2/pg$(exeext) m2/gm2-auto/t.bnf -o m2/gm2-auto/t2.mod
+	$(QUIAT)if ! diff m2/gm2-auto/t1.mod m2/gm2-auto/t2.mod > /dev/null ; then \
+           echo "failure: pg (with error recovery) failed" ; \
+           $(RM) m2/pge$(exeext) ; \
+           exit 1 ; \
+        fi
+	$(RM) m2/gm2-auto/t.mod m2/gm2-auto/t1.mod m2/gm2-auto/t2.mod
+
+m2/gm2-auto/pgeinit:
+	sed -e 's/ppg/pge/' < $(srcdir)/m2/init/ppginit > $@
+
+m2/gm2-pge-boot/main.o: m2/gm2-auto/pgeinit $(M2LINK)
+	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
+
+$(objdir)/m2/gm2-ppg-boot:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-pg-boot:
+	test -d $@ || mkdir $@
+
+$(objdir)/m2/gm2-pge-boot:
+	test -d $@ || mkdir $@
+
+m2/gm2-auto/pg.o: m2/gm2-auto/pg.mod $(MCDEPS)
+	$(MC) --quiet -o=m2/gm2-auto/pg.c m2/gm2-auto/pg.mod
+	$(COMPILER) -c $(CFLAGS) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2 -Im2/gm2-libs-boot -Im2/gm2-compiler-boot -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) m2/gm2-auto/pg.c -o $@
+
+m2/gm2-auto/pge.o: m2/gm2-auto/pge.mod $(MCDEPS)
+	$(MC) --quiet -o=m2/gm2-auto/pge.c m2/gm2-auto/pge.mod
+	$(COMPILER) -c $(CFLAGS) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2 -Im2/gm2-libs-boot -Im2/gm2-compiler-boot -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) m2/gm2-auto/pge.c -o $@
+
+pge-help: force
+	@echo "The pge maintainer commands are:"
+	@echo " "
+	@echo " make pge-maintainer"
+	@echo " make pge-verify"
+	@echo " make pge-push       # copy pge C++ sources (app and libs) into srcdir/m2/pge-boot"
+	@echo " make pge-libs-push  # copy C++ libraries which pge uses into srcdir/m2/pge-boot"
+	@echo " make pge-app-push   # copy pge C++ application modules into srcdir/m2/pge-boot"
+	@echo " make pge-clean"
+
+pge-maintainer: $(PGE)
+
+# Copy the C++ sources for ppe.mod into $(srcdir)/pge-boot.
+
+pge-push: pge-libs-push pge-app-push
+
+pge-libs-push: force
+	for i in $(cat $(srcdir)/m2/init/ppginit) ; do \
+	    if [ -f $(srcdir)/m2/gm2-libs-ch/${i}.h ] ; then \
+                cp $(srcdir)/m2/gm2-libs-ch/${i}.h $(srcdir) ; \
+            else \
+                echo "not found ${i}" ; \
+            fi ; \
+	    if [ -f $(srcdir)/m2/gm2-libs-ch/${i}.c* ] ; then \
+                cp $(srcdir)/m2/gm2-libs-ch/${i}.c* $(srcdir) ; \
+	    elif [ -f $(srcdir)/m2/gm2-pge-libs/${i}.c* ] ; then \
+                cp $(srcdir)/m2/gm2-pge-libs/${i}.c* $(srcdir) ; \
+            else \
+                echo "not found ${i}" ; \
+            fi ; \
+        done
+
+pge-app-push: force
+	cp m2/gm2-pge-boot/*.c $(srcdir)/m2/pge-boot
+
+# Perform sanity checks.
+
+pge-verify: force
+
+# Remove pge build files.
+
+pge-clean: force
+	$(RM) -f m2/gm2-pg-boot/* m2/gm2-ppg-boot/* m2/gm2-pge-boot/*
+
+
+# The rest of the Make-lang.in handles the bootstrap tool (maintained
+# mode) and also provides testing between the bootstrapped and the
+# non-bootstrapped compilers.
+
+# Rules for mc
+
+# The default rule used generate mc, eventually it will be replaced by mc-bootstrap.
+
+BOOTGM2=gm2
+
+MCOPTIONS=-g -c -fsources -fsoft-check-all -fm2-g # -fauto-init
+MCLINK=-g     # use -g -fmodules -c if you are debugging and wish to see missing modules.
+
+# This is only needed in maintainer mode by 'make mc-maintainer' when regenerating the C
+# version of mc.  We need a working Modula-2 compiler to run mc-maintainer.
+
+GM2SYS=${HOME}/opt/lib/gcc/x86_64-pc-linux-gnu/12.0.0/m2/m2pim
+GM2PATH=$(srcdir)/m2/mc:$(GM2SYS):$(srcdir)/m2:m2/gm2-auto:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-libs-iso
+
+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/*.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/*
+
+mc-maintainer: mc-clean mc-autogen mc-push mc-clean mc-bootstrap
+
+mc-clean-libs: force
+	$(RM) m2/gm2-libs-boot/*
+
+mc-continue:  mc-clean mc-bootstrap mc-clean-libs mc-fresh $(BUILD-MC-INTERFACE-O) $(BUILD-LIBS-BOOT) $(BUILD-COMPILER-BOOT)
+
+mc-fresh: force
+	$(RM) m2/gm2-auto/* m2/gm2-compiler-boot/* m2/gm2-libs-boot/*
+
+mc-help:  force
+	@echo "mc-maintainer   produces a new mc C version in the source tree (takes longer)"
+	@echo "mc-continue     builds the mc from the C version and attempts to build gm2 libraries and gm2 compiler"
+	@echo "mc-verify       builds mc from Modula-2 sources and mc from C sources and run both on all sources diffing the output"
+	@echo "mc              builds mc from Modula-2 sources, quickly"
+	@echo "m2/pge          build the parser generator (needed by mc-maintainer)"
+
+m2/mc-obj:
+	mkdir $@
+
+mc-verify:  mc-clean mc-bootstrap mc
+	mv mc m2/boot-bin/mc.m2
+	@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 ; \
+           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 \
+                 echo "[passed]" ; \
+              else \
+                 echo "[*** failed ***]" ; \
+                 diff mcout.c mcout.m2 > $$i.mc-diff ; \
+              fi \
+           fi ; \
+	   $(RM) mcout.c 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
+
+
+
+#  mc-devel - compiles mc using gm2
+
+mc-devel: m2/boot-bin/mc-devel$(exeext)
+
+m2/boot-bin/mc-devel$(exeext): m2/mc-obj/mcp1.mod \
+                               m2/mc-obj/mcp2.mod \
+                               m2/mc-obj/mcp3.mod \
+                               m2/mc-obj/mcp4.mod \
+                               m2/mc-obj/mcp5.mod \
+                               mcflex.c \
+                               m2/mc-boot-ch/Gabort.o
+	$(RM) -rf mc-obj
+	mkdir mc-obj
+	$(CC) -I$(srcdir)/m2/mc -c -g mcflex.c -o mc-obj/mcflex.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/decl.mod -o mc-obj/decl.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcStream.mod -o mc-obj/mcStream.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcPretty.mod -o mc-obj/mcPretty.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcStack.mod -o mc-obj/mcStack.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/varargs.mod -o mc-obj/varargs.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcMetaError.mod -o mc-obj/mcMetaError.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcOptions.mod -o mc-obj/mcOptions.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcComp.mod -o mc-obj/mcComp.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) m2/mc-obj/mcp1.mod -o mc-obj/mcp1.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) m2/mc-obj/mcp2.mod -o mc-obj/mcp2.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) m2/mc-obj/mcp3.mod -o mc-obj/mcp3.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) m2/mc-obj/mcp4.mod -o mc-obj/mcp4.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) m2/mc-obj/mcp5.mod -o mc-obj/mcp5.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/wlists.mod -o mc-obj/wlists.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/alists.mod -o mc-obj/alists.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/symbolKey.mod -o mc-obj/symbolKey.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcReserved.mod -o mc-obj/mcReserved.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/nameKey.mod -o mc-obj/nameKey.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcSearch.mod -o mc-obj/mcSearch.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcFileName.mod -o mc-obj/mcFileName.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcLexBuf.mod -o mc-obj/mcLexBuf.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcQuiet.mod -o mc-obj/mcQuiet.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcError.mod -o mc-obj/mcError.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcDebug.mod -o mc-obj/mcDebug.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcPrintf.mod -o mc-obj/mcPrintf.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/Indexing.mod -o mc-obj/Indexing.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcPreprocess.mod -o mc-obj/mcPreprocess.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/keyc.mod -o mc-obj/keyc.o
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) $(srcdir)/m2/mc/mcComment.mod -o mc-obj/mcComment.o
+	$(BOOTGM2) $(MCLINK) -I. -fscaffold-main -I$(GM2PATH) \
+            -fuse-list=$(srcdir)/m2/init/mcinit $(srcdir)/m2/mc/top.mod -o mc \
+            m2/gm2-libs-boot/RTcodummy.o \
+            m2/gm2-libs-boot/dtoa.o m2/gm2-libs-boot/ldtoa.o mc-obj/*o m2/mc-boot-ch/Gabort.o
+
+m2/boot-bin/mc-opt$(exeext): m2/mc-obj/mcp1.mod \
+                             m2/mc-obj/mcp2.mod \
+                             m2/mc-obj/mcp3.mod \
+                             m2/mc-obj/mcp4.mod \
+                             m2/mc-obj/mcp5.mod \
+                             mcflex.c
+	g++ -I$(srcdir)/m2/mc -c -g mcflex.c
+	$(BOOTGM2) -fsources -fm2-whole-program -g -I$(srcdir)/m2/mc:$(objdir)/m2/mc-obj:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/mc $(srcdir)/m2/mc/top.mod
+
+m2/mc/decl.o:  $(srcdir)/m2/mc/decl.mod
+	$(BOOTGM2) $(MCOPTIONS) -I$(GM2PATH) -o $@ $(srcdir)/m2/mc/decl.mod
+
+m2/mc-obj/%.mod: $(srcdir)/m2/mc/%.bnf $(PGE)
+	$(PGE) -l $< -o $@
+
+gm2-bootstrap: mc-devel
+	for i in $(srcdir)/m2/gm2-libs/*.def ; do echo $$i ; ./mc --gcc-config-system -I$(srcdir)/m2/gm2-libs $$i ; done
+	for i in $(srcdir)/m2/gm2-compiler/*.def ; do echo $$i ; ./mc --gcc-config-system -I$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-gcc $$i ; done
+	for i in $(srcdir)/m2/gm2-libs/*.mod ; do echo $$i ; ./mc --gcc-config-system -I$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-gcc $$i ; done
+
+
+$(objdir)/plugin:
+	test -d $@ || mkdir -p $@
+
+$(objdir)/m2/mc-boot:
+	test -d $@ || mkdir -p $@
+
+$(objdir)/m2/mc-boot-ch:
+	test -d $@ || mkdir -p $@
+
+$(objdir)/m2/mc-boot-gen:
+	test -d $@ || mkdir -p $@
+
+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
+	@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
+	@echo "modules"
+
+# EXTENDED_OPAQUE = --extended-opaque
+EXTENDED_OPAQUE =
+MC_OPTIONS = $(MC_COPYRIGHT) --gcc-config-system --olang=c++
+
+m2/mc-boot-gen/$(SRC_PREFIX)%.h: $(srcdir)/m2/mc/%.def
+	./mc $(MC_OPTIONS) -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/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def
+	./mc $(MC_OPTIONS) -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/$(SRC_PREFIX)decl.c: $(srcdir)/m2/mc/decl.mod
+	./mc $(MC_OPTIONS) --extended-opaque -I$(srcdir)/m2/mc:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-libs-iso --h-file-prefix=$(SRC_PREFIX) -o=$@ $<
+
+m2/mc-boot-gen/$(SRC_PREFIX)%.c: $(srcdir)/m2/mc/%.mod
+	./mc $(MC_OPTIONS) -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/$(SRC_PREFIX)%.c: $(srcdir)/m2/gm2-libs/%.mod
+	./mc $(MC_OPTIONS) -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/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs-iso/%.def
+	./mc $(MC_OPTIONS) -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/$(SRC_PREFIX)%.c: m2/mc-obj/%.mod
+	./mc $(MC_OPTIONS) -I$(srcdir)/m2/mc:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-libs-iso $(EXTENDED_OPAQUE) --h-file-prefix=$(SRC_PREFIX) -o=$@ $<
+
+# mc-bootstrap compiles mc using the C version previously generated by mc-autogen.
+# These autogenerated files will be checked into git by the maintainer.
+
+mc-bootstrap: mc-clean m2/boot-bin/mc$(exeext)
+
+gm2.maintainer-reconfigure: force
+	autoconf $(srcdir)/m2/gm2-libs/config-host.in > $(srcdir)/m2/gm2-libs/config-host
+	( cd $(srcdir)/m2/gm2-libs ; autoheader config-host.in )
+	( cd $(srcdir)/m2 ; autoconf configure.in > configure )
+
+gm2.maintainer-clean: force
+	-rm -f $(srcdir)/m2/gm2-auto/*
+	-rm -f $(srcdir)/m2/gm2-libs.texi
+	-rm -f $(srcdir)/m2/gm2-ebnf.texi
+	-rm -f $(srcdir)/m2/images/gnu.eps
+
+gm2.maintainer-help: force
+	@echo "make knows about:"
+	@echo " "
+	@echo "make gm2.maintainer-help           this command"
+	@echo "make gm2.maintainer-reconfigure    rebuild the configure scripts"
+	@echo "make gm2.maintainer-clean          clean pre-built images and texi files"
+
+
+#
+#  verify the compiler can be built across three generations of cc1gm2 diffing assembly output.
+#  stage1/m2/cc1gm2 built by translating M2 into C++.
+#  stage2/m2/cc1gm2 built from stage1/m2/cc1gm2.
+#  stage3/m2/cc1gm2 built from stage2/m2/cc1gm2.
+#
+
+# GM2-VERIFY-MODS is a list of modules which have no __DATE__ stamp inside them
+#                 and thus they can be built by the different versions of gm2.
+#                 This list is used for testing only.
+
+GM2-VERIFY-MODS    = FifoQueue.mod     M2AsmUtil.mod                   M2Optimize.mod  \
+                     M2StackWord.mod                   M2Pass.mod      M2Batch.mod     \
+                     M2Quads.mod       M2Comp.mod      M2Reserved.mod  \
+                     M2Debug.mod       M2Defaults.mod  NameKey.mod     \
+                     M2FileName.mod    P0SymBuild.mod  P1SymBuild.mod  P2SymBuild.mod  \
+                     P3SymBuild.mod  \
+                     SymbolKey.mod     SymbolTable.mod                 M2Error.mod     \
+                     M2StackAddress.mod \
+                     M2Students.mod  \
+                     M2BasicBlock.mod  M2Code.mod      M2GenGCC.mod    M2GCCDeclare.mod\
+                     M2ALU.mod         M2System.mod    M2Base.mod      Lists.mod       \
+                     M2Search.mod      bnflex.mod      ppg.mod         Output.mod      \
+                     SymbolConversion.mod \
+                     M2Preprocess.mod  M2Printf.mod    M2LexBuf.mod    M2Quiet.mod     \
+                     M2Bitset.mod      M2Size.mod      CLexBuf.mod     M2Scope.mod     \
+                     M2Range.mod       M2Swig.mod      M2MetaError.mod Sets.mod        \
+                     M2CaseList.mod    PCSymBuild.mod  M2Const.mod     \
+                     M2DebugStack.mod  ObjectFiles.mod M2ColorString.mod M2Emit.mod
+
+GM2-VERIFY-AUTO    = P1Build.mod       P2Build.mod     PCBuild.mod     P3Build.mod     \
+                     PHBuild.mod       pg.mod          P0SyntaxCheck.mod
+
+GM2_LIBS_PARANOID = m2/gm2-compiler-paranoid/gm2.a \
+                    m2/gm2-libs-paranoid/libgm2.a                       # build it again using GM2_LIBS
+
+gm2.paranoid: stage3/m2/cc1gm2$(exeext) gm2.verifyparanoid
+
+stage3/m2/cc1gm2$(exeext): stage2/m2/cc1gm2$(exeext) m2/gm2-compiler-paranoid/m2flex.o \
+                            $(P) $(GM2_C_OBJS) $(BACKEND) $(LIBDEPS) $(GM2_LIBS_PARANOID) \
+                            m2/gm2-gcc/rtegraph.o plugin/m2rte$(exeext).so m2/gm2-libs-boot/M2LINK.o
+	@$(call LINK_PROGRESS,$(INDEX.m2),start)
+	+$(LLINKER) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(GM2_C_OBJS) m2/gm2-compiler-paranoid/m2flex.o \
+                            attribs.o \
+                              $(GM2_LIBS_PARANOID) \
+                              $(BACKEND) $(LIBS) m2/gm2-gcc/rtegraph.o m2/gm2-libs-boot/M2LINK.o \
+                              $(BACKENDLIBS) $(LIBSTDCXX) -lm
+	@$(call LINK_PROGRESS,$(INDEX.m2),end)
+
+
+# gm2.verifyparanoid diffs the output of all three compilers with the compiler source code
+
+gm2.verifyparanoid: stage1/m2/cc1gm2$(exeext) stage2/m2/cc1gm2$(exeext) stage3/m2/cc1gm2$(exeext) force
+	@echo "verifying the three generations of GNU Modula-2 compilers - it may take some time.."
+	$(QUIAT)for i in $(GM2-VERIFY-MODS) ; do \
+           echo -n "$$i " ; \
+           ./gm2 -S $(GM2_FLAGS) -c -B./stage1/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty $(srcdir)/m2/gm2-compiler/$$i -o m2/gm2-compiler-verify/1.s ; \
+           echo -n "[1]" ; \
+           ./gm2 -S $(GM2_FLAGS) -c -B./stage2/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty $(srcdir)/m2/gm2-compiler/$$i -o m2/gm2-compiler-verify/2.s ; \
+           echo -n "[2]" ; \
+           ./gm2 -S $(GM2_FLAGS) -c -B./stage3/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty $(srcdir)/m2/gm2-compiler/$$i -o m2/gm2-compiler-verify/3.s ; \
+           echo -n "[3]" ; \
+           if ! diff m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/2.s > m2/gm2-compiler-verify/1_2.diff 2>&1 ; then \
+               echo -n " [stage 1 and stage 2 differ]" ; \
+               cp m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.1.lst ; \
+               cp m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.2.lst ; \
+               echo " " ; \
+               exit 1 ; \
+           fi ; \
+           if ! diff m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/3.s > m2/gm2-compiler-verify/2_3.diff 2>&1 ; then \
+               echo -n " [stage 2 and stage 3 differ]" ; \
+               cp m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.2.lst ; \
+               cp m2/gm2-compiler-verify/3.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.3.lst ; \
+           fi ; \
+           echo " " ; \
+        done
+	$(QUIAT)echo "now verifying automatically built modules"
+	$(QUIAT)for i in x $(GM2-VERIFY-AUTO) ; do \
+           if [ -f m2/gm2-auto/$$i ] ; then \
+              echo -n "$$i " ; \
+              ./gm2 -S $(GM2_FLAGS) -c -B./stage1/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty m2/gm2-auto/$$i -o m2/gm2-compiler-verify/1.s ; \
+              echo -n "[1]" ; \
+              ./gm2 -S $(GM2_FLAGS) -c -B./stage2/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty m2/gm2-auto/$$i -o m2/gm2-compiler-verify/2.s ; \
+              echo -n "[2]" ; \
+              ./gm2 -S $(GM2_FLAGS) -c -B./stage3/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty m2/gm2-auto/$$i -o m2/gm2-compiler-verify/3.s ; \
+              echo -n "[3]" ; \
+              if ! diff m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/2.s > m2/gm2-compiler-verify/1_2.diff 2>&1 ; then \
+                  echo -n " [stage 1 and stage 2 differ]" ; \
+                  cp m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.1.lst ; \
+                  cp m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.2.lst ; \
+                  echo " " ; \
+                  exit 1 ; \
+              fi ; \
+              if ! diff m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/3.s > m2/gm2-compiler-verify/2_3.diff 2>&1 ; then \
+                  echo -n " [stage 2 and stage 3 differ]" ; \
+                  cp m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.2.lst ; \
+                  cp m2/gm2-compiler-verify/3.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.3.lst ; \
+              fi ; \
+              echo " " ; \
+           fi ; \
+        done ; \
+	$(RM) -f m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/3.s m2/gm2-compiler-verify/2_3.diff m2/gm2-compiler-verify/1_2.diff
+
+
+# gm2.verifystage12 diffs the output of the stage1 and stage2 compilers with the compiler source code
+
+gm2.verifystage12: force stage1/m2/cc1gm2$(exeext) stage2/m2/cc1gm2$(exeext)
+	@echo "verifying stage1 and stage2 generations of GNU Modula-2 compilers - it may take some time.."
+	$(QUIAT)for i in $(GM2-VERIFY-MODS) ; do \
+           echo -n "$$i " ; \
+           ./gm2 -S $(GM2_FLAGS) -c -B./stage1/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty $(srcdir)/m2/gm2-compiler/$$i -o m2/gm2-compiler-verify/1.s ; \
+           echo -n "[1]" ; \
+           ./gm2 -S $(GM2_FLAGS) -c -B./stage2/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty $(srcdir)/m2/gm2-compiler/$$i -o m2/gm2-compiler-verify/2.s ; \
+           echo -n "[2]" ; \
+           if ! diff m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/2.s > m2/gm2-compiler-verify/1_2.diff 2>&1 ; then \
+               echo -n " [stage 1 and stage 2 differ]" ; \
+               cp m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.1.lst ; \
+               cp m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.2.lst ; \
+               echo " " ; \
+           fi ; \
+           echo " " ; \
+        done
+	$(QUIAT)echo "now verifying automatically built modules"
+	$(QUIAT)for i in x $(GM2-VERIFY-AUTO) ; do \
+           if [ -f m2/gm2-auto/$$i ] ; then \
+              echo -n "$$i " ; \
+              ./gm2 -S $(GM2_FLAGS) -c -B./stage1/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty m2/gm2-auto/$$i -o m2/gm2-compiler-verify/1.s ; \
+              echo -n "[1]" ; \
+              ./gm2 -S $(GM2_FLAGS) -c -B./stage2/m2 -I$(srcdir)/m2/gm2-compiler:$(srcdir)/m2/gm2-libs:$(srcdir)/m2/gm2-gcc:$(srcdir)/m2/gm2-libiberty m2/gm2-auto/$$i -o m2/gm2-compiler-verify/2.s ; \
+              echo -n "[2]" ; \
+              if ! diff m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/2.s > m2/gm2-compiler-verify/1_2.diff 2>&1 ; then \
+                  echo -n " [stage 1 and stage 2 differ]" ; \
+                  cp m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.1.lst ; \
+                  cp m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/t.s | as -ahl m2/gm2-compiler-verify/t.s > m2/gm2-compiler-verify/$$i.2.lst ; \
+                  echo " " ; \
+              fi ; \
+              echo " " ; \
+           fi ; \
+        done ; \
+	$(RM) -f m2/gm2-compiler-verify/1.s m2/gm2-compiler-verify/2.s m2/gm2-compiler-verify/3.s m2/gm2-compiler-verify/2_3.diff m2/gm2-compiler-verify/1_2.diff
+
+
+# The rules which build objects in the gm2-compiler-paranoid gm2-libs-paranoid directories.
+
+m2/gm2-libs-paranoid/%.o: m2/gm2-libs-ch/%.c
+	$(XGCC) -c -g $(GM2_O_S3) $(GM2_O) -I./ -Im2/gm2-libs -Wall $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/%.o: $(srcdir)/m2/gm2-libs/%.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler-paranoid/%.o: $(srcdir)/m2/gm2-compiler/%.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler-paranoid/%.o: m2/gm2-compiler-paranoid/%.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler-paranoid/P0SyntaxCheck.o: m2/gm2-compiler-paranoid/P0SyntaxCheck.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler-paranoid/P1Build.o: m2/gm2-compiler-paranoid/P1Build.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler-paranoid/P2Build.o: m2/gm2-compiler-paranoid/P2Build.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler-paranoid/P3Build.o: m2/gm2-compiler-paranoid/P3Build.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler-paranoid/PHBuild.o: m2/gm2-compiler-paranoid/PHBuild.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-compiler-paranoid/PCBuild.o: m2/gm2-compiler-paranoid/PCBuild.mod
+	$(GM2_2) $(GM2_O_S3) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@
+
+m2/gm2-libs-paranoid/host.o: $(srcdir)/m2/gm2-libs-ch/host.c m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(GM2_O_S3) $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/wrapc.o: $(srcdir)/m2/gm2-libs-ch/wrapc.c m2/gm2-libs-boot/$(SRC_PREFIX)wrapc.h m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c -DIN_GCC $(GM2_O_S3) $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/UnixArgs.o: $(srcdir)/m2/gm2-libs-ch/UnixArgs.cc \
+                                  m2/gm2-libs-boot/$(SRC_PREFIX)UnixArgs.h
+	$(CXX) -c -DIN_GCC $(GM2_O_S3) $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/errno.o: $(srcdir)/m2/gm2-libs-ch/errno.c \
+                                   m2/gm2-libs-boot/$(SRC_PREFIX)errno.h
+	$(CXX) -c -DIN_GCC $(GM2_O_S3) $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/Selective.o: $(srcdir)/m2/gm2-libs-ch/Selective.c \
+                                   m2/gm2-libs-boot/$(SRC_PREFIX)Selective.h
+	$(COMPILER) -c -DIN_GCC $(GM2_O_S3) $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/choosetemp.o: $(srcdir)/m2/gm2-libs-ch/choosetemp.c \
+                                    m2/gm2-libiberty/$(SRC_PREFIX)choosetemp.h
+	$(CXX) -c -DIN_GCC $(GM2_O_S3) $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libiberty $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/SysExceptions.o: $(srcdir)/m2/gm2-libs-ch/SysExceptions.c \
+                                  m2/gm2-libs-boot/$(SRC_PREFIX)SysExceptions.h
+	$(CXX) -c -DIN_GCC $(GM2_O_S3) $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+
+m2/gm2-compiler-paranoid/m2flex.o: m2/gm2-compiler/m2flex.c $(TIMEVAR_H)
+	$(COMPILER) -c $(GM2_O_S3) -g $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
+          $(GM2GCC) -Im2/gm2-compiler-boot -Im2/gm2-libs-boot $< -o $@
+
+m2/gm2-libs-paranoid/dtoa.o: $(srcdir)/m2/gm2-libs-ch/dtoa.cc \
+                              m2/gm2-libs-boot/$(SRC_PREFIX)dtoa.h \
+                              m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(GM2_O_S3) $(CFLAGS) -I$(srcdir)/m2 -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/ldtoa.o: $(srcdir)/m2/gm2-libs-ch/ldtoa.cc \
+                               m2/gm2-libs-boot/$(SRC_PREFIX)ldtoa.h \
+                               m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(GM2_O_S3) $(CFLAGS) -I$(srcdir)/m2 -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@
+
+m2/gm2-libs-paranoid/termios.o: $(srcdir)/m2/gm2-libs-ch/termios.c \
+                               m2/gm2-libs-boot/$(SRC_PREFIX)termios.h \
+                               m2/gm2-libs/gm2-libs-host.h
+	$(CXX) -c $(GM2_O_S3) $(CFLAGS) -I$(srcdir)/m2 -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@
+
+
+# The rules which build the paranoid version of gm2.
+
+BUILD-LIBS-PARANOID-H = $(GM2-LIBS-BOOT-DEFS:%.def=m2/gm2-libs-boot/$(SRC_PREFIX)%.h)
+
+BUILD-LIBS-PARANOID = $(BUILD-LIBS-PARANOID-H) \
+                      $(GM2-LIBS-MODS:%.mod=m2/gm2-libs-paranoid/%.o) \
+                      $(GM2-LIBS-CC:%.cc=m2/gm2-libs-paranoid/%.o) \
+                      $(GM2-LIBS-C:%.c=m2/gm2-libs-paranoid/%.o)
+
+m2/gm2-libs-paranoid/libgm2.a: m2/boot-bin/mc$(exeext) $(BUILD-LIBS-PARANOID)
+	$(AR) cr $@ $(GM2-LIBS-MODS:%.mod=m2/gm2-libs-paranoid/%.o) \
+                    $(GM2-LIBS-CC:%.cc=m2/gm2-libs-paranoid/%.o) \
+                    $(GM2-LIBS-C:%.c=m2/gm2-libs-paranoid/%.o)
+	$(RANLIB) $@
+
+m2/gm2-compiler-paranoid/gm2.a: \
+                             $(GM2-COMP-MODS:%.mod=m2/gm2-compiler-paranoid/%.o) \
+                             $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler-paranoid/%.o) \
+                             m2/gm2-compiler-paranoid/M2Version.o \
+                             m2/gm2-compiler-paranoid/m2flex.o
+	$(AR) cr $@ $(GM2-COMP-MODS:%.mod=m2/gm2-compiler-paranoid/%.o) \
+                    $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler-paranoid/%.o) \
+                    m2/gm2-compiler-paranoid/M2Version.o
+	$(RANLIB) $@
+
+m2/gm2-compiler-paranoid/M2Version.mod:
+	$(SHELL) $(srcdir)/m2/tools-src/makeversion -m $(srcdir) m2/gm2-compiler-paranoid
+
+m2/gm2-compiler-paranoid/M2Version.o: m2/gm2-compiler-paranoid/M2Version.mod
+	$(GM2_2) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc $< -o $@
+
+m2/gm2-compiler-paranoid/%.mod: $(srcdir)/m2/gm2-compiler/%.bnf $(PGE)
+	$(PGE) -k -l $< -o $@
+
+# Recreate the target independent copies of the documentation which is
+# used during the build if Python3 is unavailable.
+
+# m2-target-independent-doc-rst should be enabled once
+# tools-src/def2doc.py is completed (module hyperlinks need rst
+# treatment).
+
+m2-target-independent-doc: m2-target-independent-doc-texi # m2-target-independent-doc-rst
+
+m2-target-independent-doc-texi: force
+ifeq ($(HAVE_PYTHON),yes)
+	python3 $(srcdir)/m2/tools-src/def2doc.py -t -b$(srcdir)/m2 -f$(srcdir)/m2/gm2-libs-iso/SYSTEM.def -o $(srcdir)/m2/target-independent/SYSTEM-iso.texi
+	python3 $(srcdir)/m2/tools-src/def2doc.py -t -b$(srcdir)/m2 -f$(srcdir)/m2/gm2-libs/SYSTEM.def -o $(srcdir)/m2/target-independent/SYSTEM-pim.texi
+	python3 $(srcdir)/m2/tools-src/def2doc.py -t -b$(srcdir)/m2 -f$(srcdir)/m2/gm2-libs/Builtins.def -o $(srcdir)/m2/target-independent/Builtins.texi
+	python3 $(srcdir)/m2/tools-src/def2doc.py -t -uLibraries -s$(srcdir)/m2 -b$(srcdir)/m2 -o $(srcdir)/m2/target-independent/gm2-libs.texi
+else
+	echo "m2-target-independent-doc-texi will only work if Python3 was detected during configure"
+endif
+
+m2-target-independent-doc-rst: force
+ifeq ($(HAVE_PYTHON),yes)
+	python3 $(srcdir)/m2/tools-src/def2doc.py -x -b$(srcdir)/m2 -f$(srcdir)/m2/gm2-libs-iso/SYSTEM.def -o $(srcdir)/m2/target-independent/SYSTEM-iso.rst
+	python3 $(srcdir)/m2/tools-src/def2doc.py -x -b$(srcdir)/m2 -f$(srcdir)/m2/gm2-libs/SYSTEM.def -o $(srcdir)/m2/target-independent/SYSTEM-pim.rst
+	python3 $(srcdir)/m2/tools-src/def2doc.py -x -b$(srcdir)/m2 -f$(srcdir)/m2/gm2-libs/Builtins.def -o $(srcdir)/m2/target-independent/Builtins.rst
+	python3 $(srcdir)/m2/tools-src/def2doc.py -x -uLibraries -s$(srcdir)/m2 -b$(srcdir)/m2 -o $(srcdir)/m2/target-independent/gm2-libs.rst
+else
+	echo "m2-target-independent-doc-rst will only work if Python3 was detected during configure"
+endif
diff --git a/gcc/m2/NEWS b/gcc/m2/NEWS
new file mode 100644
index 00000000000..469f99f0ec9
--- /dev/null
+++ b/gcc/m2/NEWS
@@ -0,0 +1,231 @@
+This file describes recent user-visible changes in gm2.  Bug fixes are
+not described.  There are more details in the man and info pages.
+
+gm2 is now in the GCC tree and therefore these version numbers are
+historical.
+
+VERSION 1.9.5
+=============
+
+* More subexpressions tokens are created and accuracy of error positions
+  within subexpressions has been improved.
+* the GCC switch -fanalyzer can be used with Modula-2.
+
+VERSION 1.9.4
+=============
+
+* More GCC error routines utilized for error messages, erroneous
+  subexpressions are more accurately reported.
+* Complete type checking now performed.
+
+VERSION 1.9.3
+=============
+
+* GCC error routines utilized for error messages.
+* complete whole number runtime range error detection finished.
+* improved m2-plugin which analyzes the call graph and will issue
+  warnings if the compiler detects a exported procedure will cause
+  a range error.  The plugin will issue an error if the range error
+  will be called from the module constructor/deconstructor.
+
+VERSION 1.2.0
+=============
+
+* New improved more accurate source/line correlation in debugging output.
+* -fm2-g generates nops to further improve debugging single stepping.
+* -fm2-whole-program whole program optimization available.
+* works with gcc-5.2.0 under x86_64, x86_32, arm 64 bit and arm 32 bit.
+
+VERSION 1.0.4
+=============
+
+* Bug fixes to release 1.0
+
+VERSION 1.0
+===========
+
+* All ISO libraries are complete.
+* All ISO language implemented.
+* All regression tests pass on both x86_64 and x86_32 Debian GNU/Linux
+  platforms.
+
+VERSION 0.68
+============
+
+* more ISO library modules are implemented.
+* many errors are much more informative and indicate what the
+  compiler has seen and what it expects.
+
+VERSION 0.63
+============
+
+* many ISO library modules are implemented.
+* Exception handling is complete and it can coexist with swig.
+* all errors now include column information.  Also added -fxcode
+  option which issues errors in Apple Xcode format.
+* shared libraries are now implemented, to link against the shared
+  libraries use the new option -fshared.  Likewise to generate a
+  shared library use the -fshared option.
+* the keyword FINALLY is now implemented and both the initialization
+  and finalization blocks map onto GNU/Linux shared library
+  constructor and deconstructors.
+* the PIM libraries are built with -O0, -O2, -O2 -fshared, -fshared.
+* a new option -fswig automatically generates a swig interface file
+  corresponding to the definition module being compiled.
+  This allows Python and other scripting languages to call Modula-2
+  modules.
+* new options, -fobject-path, allows users to specify the path for
+  all objects whereas -I specifies the path for the library sources.
+* -fmakeinit option introduced which will generate a file
+  _m2_modulename.c in the current directory.
+* introduced fixed sized types in the SYSTEM module.
+
+VERSION 0.62
+============
+
+* all language options changed to -f.  Warning options are
+  still -W.  Introduced memmove to Builtins.def.
+* Introduced gm2/gm2-libs-pim/BlockOps.{def,mod}
+* gm2/gm2-libs-pim/BitByteOps.{def,mod}:  added.
+* -O now works on compiler and passes make gm2.paranoid.
+
+VERSION 0.61
+============
+
+* builds when grafted onto gcc-4.1.2
+
+VERSION 0.52
+============
+
+* tagged ready for branch for gcc-3.3.6 so that the head
+  can be developed with gcc-4.1.0
+
+VERSION 0.51
+============
+
+* all regression tests pass on LP64 and i386 GNU/Linux
+
+* declaration of variables at particular addresses is now implemented.
+  Now gm2 is a full PIM Modula-2 compiler and hence the formal release.
+
+VERSION 0.50
+============
+
+* all regression tests pass on LP64 and i386 GNU/Linux, i386, Mac OS X.3 G5
+
+* gm2-harness 0.7 will download, patch and build gcc, gdb, gm2 with the
+  SET and TYPE enhancements below. gm2-harness-0.7 also honours the
+   --prefix= option.
+
+* Much better dwarf-2 debugging support and when used with
+  a patched gdb-6.3 the programmer can display RECORDs,
+  ARRAYs, SETs, subranges and constant char literals in
+  Modula-2 syntax.
+
+* it currently complies with Programming in Modula-2 Edition 2, 3 and 4.
+  Users can switch on specific mutually exclusive features by using
+  -Wpim or -Wpim2.
+
+* gm2 supports full PIM Modula-2 (except variables located at
+  particular addresses).
+
+* profiling (-p) option is now available.
+
+* module priorities now implemented.
+
+* Logitech compatible libraries: Break.def, CardinalIO.def,
+  Conversions.def, DebugPMD.def, DebugTrace.def, Delay.def, Display.def,
+  ErrorCode.def, FloatingUtilities.def, InOut.def, Keyboard.def,
+  LongIO.def, Random.def, RealConversions.def, RealInOut.def,
+  Strings.def, Termbase.def, Terminal.def, TimeDate.def have been implemented.
+
+* all Ulm libraries are available.
+
+VERSION 0.49
+============
+
+* supports sets of any ordinal size (memory permitting).
+
+* implements ISO Modula-2 SYSTEM which can be switched on via: -Wiso.
+
+* easy interface to C, and varargs can be passed to C routines.
+
+* University of Ulm libraries are installed together with the compiler
+  and can be accessed via: -Wlibs=ulm
+
+* some Logitech libraries have been implemented and can be accessed via:
+  -Wlibs=logitech
+
+* coroutines have been implemented in the PIM style and these are accessible
+  from SYSTEM. A number of supporting libraries (executive and file descriptor
+  mapping to interrupt vector libraries are available through the
+  -Wlibs=pim-coroutines switch).
+
+
+VERSION 0.42
+============
+
+* MinGW cross compilation port released.
+  Please see http://floppsie.comp.glam.ac.uk/Glamorgan/gaius/web/gm2-mingw.html
+  for building details.
+
+VERSION 0.41
+============
+
+* native sparc port passes make gm2.paranoid and make check-gm2
+
+* native i386  port passes make gm2.paranoid and make check-gm2
+
+* passes all 1350 regression tests
+
+* builds with gcc-3.3.2
+
+VERSION 0.40
+============
+
+* brought GM2 up to date with gcc-3.3.1
+
+* many, many bug fixes and no patch is now required in the garbage collection
+  of gcc-3.3.1
+
+* builds under Redhat 9.0 and Suse 9.0
+
+* added the LONGCARD data type.
+
+* LENGTH is now mapped onto M2RTS.Length if the parameter is not a constant
+  at compile time.
+
+* standard procedures can be called inside constant expressions.
+
+* introduced examples/pthread
+
+* introduced a tool, h2def, to aid production of DEFINITION MODULE FOR "C" modules
+  from C header files.
+
+* added MathLib0 module, added svga example.
+
+* added access to thirty one gcc built-in functions.
+
+
+VERSION 0.33
+============
+
+* implemented large sets.
+
+* implemented ISO compliant sets.
+
+* when gm2 is invoked with -gstabs a patched gdb will
+  display set contents. This also works well with SET OF CHAR.
+
+* definition modules no longer have to explicitly export
+  identifiers.
+
+VERSION 0.32
+============
+
+* gm2 can be built as a native or as a strongarm cross compiler.
+
+* the C preprocessor can be invoked and it processes both definition and
+  implementation modules.
+
+* error reporting understands preprocessed Modula-2 source.
diff --git a/gcc/m2/README b/gcc/m2/README
new file mode 100644
index 00000000000..9de9e4fbf54
--- /dev/null
+++ b/gcc/m2/README
@@ -0,0 +1,35 @@
+
+Building GNU Modula-2
+=====================
+
+Please see the GCC documentation (gcc.texi) and section
+(Installing GCC).
+
+Regression testing GM2
+======================
+
+   cd host-build ; make check-m2
+
+runs all regression tests.
+
+Stress testing GM2
+==================
+
+   cd host-build/gcc ; make gm2.paranoid
+
+builds gm2 using itself and then compiles each module with both
+versions of gm2 comparing the emitted assembler code.
+
+Contributing to GNU Modula-2
+============================
+
+Please do. But also please read the GNU Emacs info under
+
+* Standards: (standards).       GNU coding standards.
+* Intellectual Property::       Keeping Free Software Free
+* Reading Non-Free Code::       Referring to Proprietary Programs
+* Contributions::               Accepting Contributions
+
+you might consider joining the GM2 Mailing list: see URL:
+http://lists.nongnu.org/mailman/listinfo/gm2 before you start coding.
+Many thanks and enjoy your programming!
diff --git a/gcc/m2/config-lang.in b/gcc/m2/config-lang.in
new file mode 100644
index 00000000000..68bb525355a
--- /dev/null
+++ b/gcc/m2/config-lang.in
@@ -0,0 +1,83 @@
+# Top level configure fragment for GNU Modula-2.
+# Copyright (C) 2000-2022 Free Software Foundation, Inc.
+
+# This file is part of GCC.
+
+# GCC 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.
+
+# GCC 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+#
+# language	- name of language as it would appear in $(LANGUAGES)
+# compilers	- value to add to $(COMPILERS)
+# stagestuff	- files to add to $(STAGESTUFF)
+
+language="m2"
+
+compilers="cc1gm2\$(exeext)"
+
+stagestuff="gm2\$(exeext) cc1gm2\$(exeext) cc1gm2-cross\$(exeext)"
+
+target_libs="target-libstdc++-v3 target-libgm2"
+
+# The Modula-2 frontend needs C++ compiler during stage 1.
+lang_requires_boot_languages=c++
+
+# Do not build by default.
+build_by_default="no"
+
+gtfiles="\$(srcdir)/m2/gm2-lang.cc \
+         \$(srcdir)/m2/gm2-lang.h \
+         \$(srcdir)/m2/gm2-gcc/rtegraph.cc \
+         \$(srcdir)/m2/gm2-gcc/m2block.cc \
+         \$(srcdir)/m2/gm2-gcc/m2builtins.cc \
+         \$(srcdir)/m2/gm2-gcc/m2decl.cc \
+         \$(srcdir)/m2/gm2-gcc/m2except.cc \
+         \$(srcdir)/m2/gm2-gcc/m2expr.cc \
+         \$(srcdir)/m2/gm2-gcc/m2statement.cc \
+         \$(srcdir)/m2/gm2-gcc/m2type.cc"
+
+outputs="m2/config-make \
+         m2/Make-maintainer \
+        "
+
+mkdir -p m2/gm2-compiler-boot
+mkdir -p m2/gm2-libs-boot
+mkdir -p m2/gm2-ici-boot
+mkdir -p m2/gm2-libiberty
+mkdir -p m2/gm2-gcc
+mkdir -p m2/gm2-compiler
+mkdir -p m2/gm2-libs
+mkdir -p m2/gm2-libs-iso
+mkdir -p m2/gm2-compiler-paranoid
+mkdir -p m2/gm2-libs-paranoid
+mkdir -p m2/gm2-compiler-verify
+mkdir -p m2/boot-bin
+mkdir -p m2/gm2-libs-pim
+mkdir -p m2/gm2-libs-coroutines
+mkdir -p m2/gm2-libs-min
+mkdir -p m2/pge-boot
+mkdir -p plugin
+mkdir -p stage1/m2 stage2/m2 stage3/m2 stage4/m2
+
+# directories used by Make-maintainer
+
+mkdir -p m2/gm2-auto
+mkdir -p m2/gm2-pg-boot
+mkdir -p m2/gm2-pge-boot
+mkdir -p m2/gm2-ppg-boot
+mkdir -p m2/mc-boot
+mkdir -p m2/mc-boot-ch
+mkdir -p m2/mc-boot-gen
diff --git a/gcc/m2/config-make.in b/gcc/m2/config-make.in
new file mode 100644
index 00000000000..fb25ef44c33
--- /dev/null
+++ b/gcc/m2/config-make.in
@@ -0,0 +1,6 @@
+# Target libraries are put under this directory:
+TARGET_SUBDIR = @target_subdir@
+# Python3 executable name if it exists
+PYTHON = @PYTHON@
+# Does Python3 exist?  (yes/no).
+HAVE_PYTHON = @HAVE_PYTHON@
\ No newline at end of file
diff --git a/gcc/m2/configure b/gcc/m2/configure
new file mode 100755
index 00000000000..db1ca3d1f9b
--- /dev/null
+++ b/gcc/m2/configure
@@ -0,0 +1,4718 @@
+#! /bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.69 for m2  .
+#
+#
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
+#
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+# Use a proper internal environment variable to ensure we don't fall
+  # into an infinite loop, continuously re-executing ourselves.
+  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+    _as_can_reexec=no; export _as_can_reexec;
+    # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+  *v*x* | *x*v* ) as_opts=-vx ;;
+  *v* ) as_opts=-v ;;
+  *x* ) as_opts=-x ;;
+  * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+  fi
+  # We don't want this to propagate to other subprocesses.
+          { _as_can_reexec=; unset _as_can_reexec;}
+if test "x$CONFIG_SHELL" = x; then
+  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '\${1+\"\$@\"}'='\"\$@\"'
+  setopt NO_GLOB_SUBST
+else
+  case \`(set -o) 2>/dev/null\` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+"
+  as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
+
+exitcode=0
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
+
+else
+  exitcode=1; echo positional parameters were not saved.
+fi
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
+test \$(( 1 + 1 )) = 2 || exit 1"
+  if (eval "$as_required") 2>/dev/null; then :
+  as_have_required=yes
+else
+  as_have_required=no
+fi
+  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
+
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  as_found=:
+  case $as_dir in #(
+	 /*)
+	   for as_base in sh bash ksh sh5; do
+	     # Try only shells that exist, to save several forks.
+	     as_shell=$as_dir/$as_base
+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  CONFIG_SHELL=$as_shell as_have_required=yes
+		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  break 2
+fi
+fi
+	   done;;
+       esac
+  as_found=false
+done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+  CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
+IFS=$as_save_IFS
+
+
+      if test "x$CONFIG_SHELL" != x; then :
+  export CONFIG_SHELL
+             # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+  *v*x* | *x*v* ) as_opts=-vx ;;
+  *v* ) as_opts=-v ;;
+  *x* ) as_opts=-x ;;
+  * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
+fi
+
+    if test x$as_have_required = xno; then :
+  $as_echo "$0: This script requires a shell more modern than all"
+  $as_echo "$0: the shells that I found on your system."
+  if test x${ZSH_VERSION+set} = xset ; then
+    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
+  else
+    $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
+$0: including any error possibly output before this
+$0: message. Then install a modern shell, or manually run
+$0: the script under such a shell if you do have one."
+  fi
+  exit 1
+fi
+fi
+fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
+
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+  test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$1; test $as_status -eq 0 && as_status=1
+  if test "$4"; then
+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+  fi
+  $as_echo "$as_me: error: $2" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+
+  as_lineno_1=$LINENO as_lineno_1a=$LINENO
+  as_lineno_2=$LINENO as_lineno_2a=$LINENO
+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
+  sed -n '
+    p
+    /[$]LINENO/=
+  ' <$as_myself |
+    sed '
+      s/[$]LINENO.*/&-/
+      t lineno
+      b
+      :lineno
+      N
+      :loop
+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
+      t loop
+      s/-\n.*//
+    ' >$as_me.lineno &&
+  chmod +x "$as_me.lineno" ||
+    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+
+  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+  # already done that, so ensure we don't try to do so again and fall
+  # in an infinite loop.  This has already happened in practice.
+  _as_can_reexec=no; export _as_can_reexec
+  # Don't try to exec as it changes $[0], causing all sort of problems
+  # (the dirname of $[0] is not the place where we might find the
+  # original and so on.  Autoconf is especially sensitive to this).
+  . "./$as_me.lineno"
+  # Exit status is that of the last command.
+  exit
+}
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -pR'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -pR'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -pR'
+  fi
+else
+  as_ln_s='cp -pR'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+test -n "$DJDIR" || exec 7<&0 </dev/null
+exec 6>&1
+
+# Name of the host.
+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_clean_files=
+ac_config_libobj_dir=.
+LIBOBJS=
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+
+# Identity of this package.
+PACKAGE_NAME='m2'
+PACKAGE_TARNAME='m2'
+PACKAGE_VERSION=' '
+PACKAGE_STRING='m2  '
+PACKAGE_BUGREPORT=''
+PACKAGE_URL=''
+
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#ifdef HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#ifdef HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+#  include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
+#  include <memory.h>
+# endif
+# include <string.h>
+#endif
+#ifdef HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#ifdef HAVE_INTTYPES_H
+# include <inttypes.h>
+#endif
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
+ac_subst_vars='LTLIBOBJS
+LIBOBJS
+EGREP
+GREP
+CPP
+OBJEXT
+EXEEXT
+ac_ct_CC
+CPPFLAGS
+LDFLAGS
+CFLAGS
+CC
+regex_realpath
+target_os
+target_vendor
+target_cpu
+target
+host_os
+host_vendor
+host_cpu
+host
+build_os
+build_vendor
+build_cpu
+build
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL'
+ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+'
+      ac_precious_vars='build_alias
+host_alias
+target_alias
+CC
+CFLAGS
+LDFLAGS
+LIBS
+CPPFLAGS
+CPP'
+
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
+
+ac_prev=
+ac_dashdash=
+for ac_option
+do
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval $ac_prev=\$ac_option
+    ac_prev=
+    continue
+  fi
+
+  case $ac_option in
+  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+  *=)   ac_optarg= ;;
+  *)    ac_optarg=yes ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case $ac_dashdash$ac_option in
+  --)
+    ac_dashdash=yes ;;
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir=$ac_optarg ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build_alias ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build_alias=$ac_optarg ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file=$ac_optarg ;;
+
+  --config-cache | -C)
+    cache_file=config.cache ;;
+
+  -datadir | --datadir | --datadi | --datad)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=*)
+    datadir=$ac_optarg ;;
+
+  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+  | --dataroo | --dataro | --datar)
+    ac_prev=datarootdir ;;
+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+    datarootdir=$ac_optarg ;;
+
+  -disable-* | --disable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=no ;;
+
+  -docdir | --docdir | --docdi | --doc | --do)
+    ac_prev=docdir ;;
+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+    docdir=$ac_optarg ;;
+
+  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+    ac_prev=dvidir ;;
+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+    dvidir=$ac_optarg ;;
+
+  -enable-* | --enable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=\$ac_optarg ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix=$ac_optarg ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he | -h)
+    ac_init_help=long ;;
+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+    ac_init_help=recursive ;;
+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+    ac_init_help=short ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host_alias ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host_alias=$ac_optarg ;;
+
+  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+    ac_prev=htmldir ;;
+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+  | --ht=*)
+    htmldir=$ac_optarg ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir=$ac_optarg ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir=$ac_optarg ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir=$ac_optarg ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir=$ac_optarg ;;
+
+  -localedir | --localedir | --localedi | --localed | --locale)
+    ac_prev=localedir ;;
+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+    localedir=$ac_optarg ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst | --locals)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
+    localstatedir=$ac_optarg ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir=$ac_optarg ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c | -n)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir=$ac_optarg ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix=$ac_optarg ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix=$ac_optarg ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix=$ac_optarg ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name=$ac_optarg ;;
+
+  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+    ac_prev=pdfdir ;;
+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+    pdfdir=$ac_optarg ;;
+
+  -psdir | --psdir | --psdi | --psd | --ps)
+    ac_prev=psdir ;;
+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+    psdir=$ac_optarg ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir=$ac_optarg ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir=$ac_optarg ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site=$ac_optarg ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir=$ac_optarg ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir=$ac_optarg ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target_alias ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target_alias=$ac_optarg ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers | -V)
+    ac_init_version=: ;;
+
+  -with-* | --with-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=\$ac_optarg ;;
+
+  -without-* | --without-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=no ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes=$ac_optarg ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries=$ac_optarg ;;
+
+  -*) as_fn_error $? "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information"
+    ;;
+
+  *=*)
+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+    # Reject names that are not valid shell variable names.
+    case $ac_envvar in #(
+      '' | [0-9]* | *[!_$as_cr_alnum]* )
+      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
+    esac
+    eval $ac_envvar=\$ac_optarg
+    export $ac_envvar ;;
+
+  *)
+    # FIXME: should be removed in autoconf 3.0.
+    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+  as_fn_error $? "missing argument to $ac_option"
+fi
+
+if test -n "$ac_unrecognized_opts"; then
+  case $enable_option_checking in
+    no) ;;
+    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
+    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
+  esac
+fi
+
+# Check all directory arguments for consistency.
+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
+		datadir sysconfdir sharedstatedir localstatedir includedir \
+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+		libdir localedir mandir
+do
+  eval ac_val=\$$ac_var
+  # Remove trailing slashes.
+  case $ac_val in
+    */ )
+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+      eval $ac_var=\$ac_val;;
+  esac
+  # Be sure to have absolute directory names.
+  case $ac_val in
+    [\\/$]* | ?:[\\/]* )  continue;;
+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
+  esac
+  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+  if test "x$build_alias" = x; then
+    cross_compiling=maybe
+  elif test "x$build_alias" != "x$host_alias"; then
+    cross_compiling=yes
+  fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+  as_fn_error $? "working directory cannot be determined"
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+  as_fn_error $? "pwd does not report name of working directory"
+
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then the parent directory.
+  ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_myself" : 'X\(//\)[^/]' \| \
+	 X"$as_myself" : 'X\(//\)$' \| \
+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  srcdir=$ac_confdir
+  if test ! -r "$srcdir/$ac_unique_file"; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r "$srcdir/$ac_unique_file"; then
+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
+	pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+  srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+  eval ac_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_env_${ac_var}_value=\$${ac_var}
+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+  # Omit some internal or obsolete options to make the list less imposing.
+  # This message is too long to be a string in the A/UX 3.1 sh.
+  cat <<_ACEOF
+\`configure' configures m2   to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE.  See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+  -h, --help              display this help and exit
+      --help=short        display options specific to this package
+      --help=recursive    display the short help of all the included packages
+  -V, --version           display version information and exit
+  -q, --quiet, --silent   do not print \`checking ...' messages
+      --cache-file=FILE   cache test results in FILE [disabled]
+  -C, --config-cache      alias for \`--cache-file=config.cache'
+  -n, --no-create         do not create output files
+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']
+
+Installation directories:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+  --bindir=DIR            user executables [EPREFIX/bin]
+  --sbindir=DIR           system admin executables [EPREFIX/sbin]
+  --libexecdir=DIR        program executables [EPREFIX/libexec]
+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
+  --libdir=DIR            object code libraries [EPREFIX/lib]
+  --includedir=DIR        C header files [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
+  --infodir=DIR           info documentation [DATAROOTDIR/info]
+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]
+  --mandir=DIR            man documentation [DATAROOTDIR/man]
+  --docdir=DIR            documentation root [DATAROOTDIR/doc/m2]
+  --htmldir=DIR           html documentation [DOCDIR]
+  --dvidir=DIR            dvi documentation [DOCDIR]
+  --pdfdir=DIR            pdf documentation [DOCDIR]
+  --psdir=DIR             ps documentation [DOCDIR]
+_ACEOF
+
+  cat <<\_ACEOF
+
+System types:
+  --build=BUILD     configure for building on BUILD [guessed]
+  --host=HOST       cross-compile to build programs to run on HOST [BUILD]
+  --target=TARGET   configure for building compilers for TARGET [HOST]
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+  case $ac_init_help in
+     short | recursive ) echo "Configuration of m2  :";;
+   esac
+  cat <<\_ACEOF
+
+Some influential environment variables:
+  CC          C compiler command
+  CFLAGS      C compiler flags
+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+              nonstandard directory <lib dir>
+  LIBS        libraries to pass to the linker, e.g. -l<library>
+  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if
+              you have headers in a nonstandard directory <include dir>
+  CPP         C preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to the package provider.
+_ACEOF
+ac_status=$?
+fi
+
+if test "$ac_init_help" = "recursive"; then
+  # If there are subdirs, report their specific --help.
+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+    test -d "$ac_dir" ||
+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+      continue
+    ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+    cd "$ac_dir" || { ac_status=$?; continue; }
+    # Check for guested configure.
+    if test -f "$ac_srcdir/configure.gnu"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+    elif test -f "$ac_srcdir/configure"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure" --help=recursive
+    else
+      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+    fi || ac_status=$?
+    cd "$ac_pwd" || { ac_status=$?; break; }
+  done
+fi
+
+test -n "$ac_init_help" && exit $ac_status
+if $ac_init_version; then
+  cat <<\_ACEOF
+m2 configure
+generated by GNU Autoconf 2.69
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+  exit
+fi
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+
+# ac_fn_c_try_compile LINENO
+# --------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext
+  if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_compile
+
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext conftest$ac_exeext
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext && {
+	 test "$cross_compiling" = yes ||
+	 test -x conftest$ac_exeext
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+  # interfere with the next link command; also delete a directory that is
+  # left behind by Apple's compiler.  We do this before executing the actions.
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_link
+
+# ac_fn_c_check_func LINENO FUNC VAR
+# ----------------------------------
+# Tests whether FUNC exists, setting the cache variable VAR accordingly
+ac_fn_c_check_func ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+/* Define $2 to an innocuous variant, in case <limits.h> declares $2.
+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
+#define $2 innocuous_$2
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $2 (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $2
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $2 ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined __stub_$2 || defined __stub___$2
+choke me
+#endif
+
+int
+main ()
+{
+return $2 ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_func
+
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } > conftest.i && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+    ac_retval=1
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_cpp
+
+# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists, giving a warning if it cannot be compiled using
+# the include files in INCLUDES and setting the cache variable VAR
+# accordingly.
+ac_fn_c_check_header_mongrel ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if eval \${$3+:} false; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+else
+  # Is the header compilable?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
+$as_echo_n "checking $2 usability... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_header_compiler=yes
+else
+  ac_header_compiler=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
+$as_echo "$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
+$as_echo_n "checking $2 presence... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <$2>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  ac_header_preproc=yes
+else
+  ac_header_preproc=no
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
+$as_echo "$ac_header_preproc" >&6; }
+
+# So?  What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
+  yes:no: )
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
+$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+    ;;
+  no:yes:* )
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
+$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5
+$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
+$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5
+$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+    ;;
+esac
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  eval "$3=\$ac_header_compiler"
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_mongrel
+
+# ac_fn_c_try_run LINENO
+# ----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
+# that executables *can* be run.
+ac_fn_c_try_run ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: program exited with status $ac_status" >&5
+       $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+       ac_retval=$ac_status
+fi
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_run
+
+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_c_check_header_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_compile
+cat >config.log <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by m2 $as_me  , which was
+generated by GNU Autoconf 2.69.  Invocation command line was
+
+  $ $0 $@
+
+_ACEOF
+exec 5>>config.log
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`
+
+/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    $as_echo "PATH: $as_dir"
+  done
+IFS=$as_save_IFS
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+  for ac_arg
+  do
+    case $ac_arg in
+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+    | -silent | --silent | --silen | --sile | --sil)
+      continue ;;
+    *\'*)
+      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    case $ac_pass in
+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
+    2)
+      as_fn_append ac_configure_args1 " '$ac_arg'"
+      if test $ac_must_keep_next = true; then
+	ac_must_keep_next=false # Got value, back to normal.
+      else
+	case $ac_arg in
+	  *=* | --config-cache | -C | -disable-* | --disable-* \
+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+	  | -with-* | --with-* | -without-* | --without-* | --x)
+	    case "$ac_configure_args0 " in
+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+	    esac
+	    ;;
+	  -* ) ac_must_keep_next=true ;;
+	esac
+      fi
+      as_fn_append ac_configure_args " '$ac_arg'"
+      ;;
+    esac
+  done
+done
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log.  We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
+trap 'exit_status=$?
+  # Save into config.log some information that might help in debugging.
+  {
+    echo
+
+    $as_echo "## ---------------- ##
+## Cache variables. ##
+## ---------------- ##"
+    echo
+    # The following way of writing the cache mishandles newlines in values,
+(
+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+  (set) 2>&1 |
+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      sed -n \
+	"s/'\''/'\''\\\\'\'''\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+      ;; #(
+    *)
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+)
+    echo
+
+    $as_echo "## ----------------- ##
+## Output variables. ##
+## ----------------- ##"
+    echo
+    for ac_var in $ac_subst_vars
+    do
+      eval ac_val=\$$ac_var
+      case $ac_val in
+      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+      esac
+      $as_echo "$ac_var='\''$ac_val'\''"
+    done | sort
+    echo
+
+    if test -n "$ac_subst_files"; then
+      $as_echo "## ------------------- ##
+## File substitutions. ##
+## ------------------- ##"
+      echo
+      for ac_var in $ac_subst_files
+      do
+	eval ac_val=\$$ac_var
+	case $ac_val in
+	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+	esac
+	$as_echo "$ac_var='\''$ac_val'\''"
+      done | sort
+      echo
+    fi
+
+    if test -s confdefs.h; then
+      $as_echo "## ----------- ##
+## confdefs.h. ##
+## ----------- ##"
+      echo
+      cat confdefs.h
+      echo
+    fi
+    test "$ac_signal" != 0 &&
+      $as_echo "$as_me: caught signal $ac_signal"
+    $as_echo "$as_me: exit $exit_status"
+  } >&5
+  rm -f core *.core core.conftest.* &&
+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
+    exit $exit_status
+' 0
+for ac_signal in 1 2 13 15; do
+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -f -r conftest* confdefs.h
+
+$as_echo "/* confdefs.h */" > confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
+if test -n "$CONFIG_SITE"; then
+  # We do not want a PATH search for config.site.
+  case $CONFIG_SITE in #((
+    -*)  ac_site_file1=./$CONFIG_SITE;;
+    */*) ac_site_file1=$CONFIG_SITE;;
+    *)   ac_site_file1=./$CONFIG_SITE;;
+  esac
+elif test "x$prefix" != xNONE; then
+  ac_site_file1=$prefix/share/config.site
+  ac_site_file2=$prefix/etc/config.site
+else
+  ac_site_file1=$ac_default_prefix/share/config.site
+  ac_site_file2=$ac_default_prefix/etc/config.site
+fi
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
+do
+  test "x$ac_site_file" = xNONE && continue
+  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
+    sed 's/^/| /' "$ac_site_file" >&5
+    . "$ac_site_file" \
+      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "failed to load site script $ac_site_file
+See \`config.log' for more details" "$LINENO" 5; }
+  fi
+done
+
+if test -r "$cache_file"; then
+  # Some versions of bash will fail to source /dev/null (special files
+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.
+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
+    case $cache_file in
+      [\\/]* | ?:[\\/]* ) . "$cache_file";;
+      *)                      . "./$cache_file";;
+    esac
+  fi
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
+  >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in $ac_precious_vars; do
+  eval ac_old_set=\$ac_cv_env_${ac_var}_set
+  eval ac_new_set=\$ac_env_${ac_var}_set
+  eval ac_old_val=\$ac_cv_env_${ac_var}_value
+  eval ac_new_val=\$ac_env_${ac_var}_value
+  case $ac_old_set,$ac_new_set in
+    set,)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,set)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,);;
+    *)
+      if test "x$ac_old_val" != "x$ac_new_val"; then
+	# differences in whitespace do not lead to failure.
+	ac_old_val_w=`echo x $ac_old_val`
+	ac_new_val_w=`echo x $ac_new_val`
+	if test "$ac_old_val_w" != "$ac_new_val_w"; then
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+	  ac_cache_corrupted=:
+	else
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+	  eval $ac_var=\$ac_old_val
+	fi
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
+$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}
+      fi;;
+  esac
+  # Pass precious variables to config.status.
+  if test "$ac_new_set" = set; then
+    case $ac_new_val in
+    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+    *) ac_arg=$ac_var=$ac_new_val ;;
+    esac
+    case " $ac_configure_args " in
+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;
+    esac
+  fi
+done
+if $ac_cache_corrupted; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
+fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+# Determine the host, build, and target systems
+ac_aux_dir=
+for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do
+  if test -f "$ac_dir/install-sh"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install-sh -c"
+    break
+  elif test -f "$ac_dir/install.sh"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install.sh -c"
+    break
+  elif test -f "$ac_dir/shtool"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/shtool install -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5
+fi
+
+# These three variables are undocumented and unsupported,
+# and are intended to be withdrawn in a future Autoconf release.
+# They can cause serious problems if a builder's source tree is in a directory
+# whose full name contains unusual characters.
+ac_config_guess="$SHELL $ac_aux_dir/config.guess"  # Please don't use this var.
+ac_config_sub="$SHELL $ac_aux_dir/config.sub"  # Please don't use this var.
+ac_configure="$SHELL $ac_aux_dir/configure"  # Please don't use this var.
+
+
+# Make sure we can run config.sub.
+$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 ||
+  as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5
+$as_echo_n "checking build system type... " >&6; }
+if ${ac_cv_build+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_build_alias=$build_alias
+test "x$ac_build_alias" = x &&
+  ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"`
+test "x$ac_build_alias" = x &&
+  as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5
+ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` ||
+  as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5
+$as_echo "$ac_cv_build" >&6; }
+case $ac_cv_build in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;;
+esac
+build=$ac_cv_build
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_build
+shift
+build_cpu=$1
+build_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+build_os=$*
+IFS=$ac_save_IFS
+case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5
+$as_echo_n "checking host system type... " >&6; }
+if ${ac_cv_host+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test "x$host_alias" = x; then
+  ac_cv_host=$ac_cv_build
+else
+  ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` ||
+    as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5
+$as_echo "$ac_cv_host" >&6; }
+case $ac_cv_host in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;;
+esac
+host=$ac_cv_host
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_host
+shift
+host_cpu=$1
+host_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+host_os=$*
+IFS=$ac_save_IFS
+case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking target system type" >&5
+$as_echo_n "checking target system type... " >&6; }
+if ${ac_cv_target+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test "x$target_alias" = x; then
+  ac_cv_target=$ac_cv_host
+else
+  ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` ||
+    as_fn_error $? "$SHELL $ac_aux_dir/config.sub $target_alias failed" "$LINENO" 5
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_target" >&5
+$as_echo "$ac_cv_target" >&6; }
+case $ac_cv_target in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical target" "$LINENO" 5;;
+esac
+target=$ac_cv_target
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_target
+shift
+target_cpu=$1
+target_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+target_os=$*
+IFS=$ac_save_IFS
+case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac
+
+
+# The aliases save the names the user supplied, while $host etc.
+# will get canonicalized.
+test -n "$target_alias" &&
+  test "$program_prefix$program_suffix$program_transform_name" = \
+    NONENONEs,x,x, &&
+  program_prefix=${target_alias}-
+
+for ac_prog in realpath
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_regex_realpath+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$regex_realpath"; then
+  ac_cv_prog_regex_realpath="$regex_realpath" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_regex_realpath="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+regex_realpath=$ac_cv_prog_regex_realpath
+if test -n "$regex_realpath"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $regex_realpath" >&5
+$as_echo "$regex_realpath" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$regex_realpath" && break
+done
+
+if test x$regex_realpath = "x" ; then
+    as_fn_error $? "realpath is required to build GNU Modula-2 (hint install coreutils)." "$LINENO" 5
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+  ac_ct_CC=$CC
+  # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+else
+  CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+          if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  fi
+fi
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+       ac_prog_rejected=yes
+       continue
+     fi
+    ac_cv_prog_CC="cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# != 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+  fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$CC"; then
+  if test -n "$ac_tool_prefix"; then
+  for ac_prog in cl.exe
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$CC" && break
+  done
+fi
+if test -z "$CC"; then
+  ac_ct_CC=$CC
+  for ac_prog in cl.exe
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CC" && break
+done
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+fi
+
+fi
+
+
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "no acceptable C compiler found in \$PATH
+See \`config.log' for more details" "$LINENO" 5; }
+
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+  fi
+  rm -f conftest.er1 conftest.err
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
+$as_echo_n "checking whether the C compiler works... " >&6; }
+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+
+# The possible output files:
+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
+
+ac_rmfiles=
+for ac_file in $ac_files
+do
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+  esac
+done
+rm -f $ac_rmfiles
+
+if { { ac_try="$ac_link_default"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link_default") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile.  We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
+do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
+	;;
+    [ab].out )
+	# We found the default executable, but exeext='' is most
+	# certainly right.
+	break;;
+    *.* )
+	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+	then :; else
+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	fi
+	# We set ac_cv_exeext here because the later test for it is not
+	# safe: cross compilers may not add the suffix if given an `-o'
+	# argument, so we may need to know it at that point already.
+	# Even if this section looks crufty: it has the advantage of
+	# actually working.
+	break;;
+    * )
+	break;;
+  esac
+done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
+else
+  ac_file=''
+fi
+if test -z "$ac_file"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+$as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "C compiler cannot create executables
+See \`config.log' for more details" "$LINENO" 5; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
+$as_echo_n "checking for C compiler default output file name... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
+$as_echo "$ac_file" >&6; }
+ac_exeext=$ac_cv_exeext
+
+rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
+$as_echo_n "checking for suffix of executables... " >&6; }
+if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	  break;;
+    * ) break;;
+  esac
+done
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+rm -f conftest conftest$ac_cv_exeext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
+$as_echo "$ac_cv_exeext" >&6; }
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdio.h>
+int
+main ()
+{
+FILE *f = fopen ("conftest.out", "w");
+ return ferror (f) || fclose (f) != 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files="$ac_clean_files conftest.out"
+# Check that the compiler produces executables we can run.  If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
+$as_echo_n "checking whether we are cross compiling... " >&6; }
+if test "$cross_compiling" != yes; then
+  { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+  if { ac_try='./conftest$ac_cv_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then
+    cross_compiling=no
+  else
+    if test "$cross_compiling" = maybe; then
+	cross_compiling=yes
+    else
+	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details" "$LINENO" 5; }
+    fi
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
+$as_echo "$cross_compiling" >&6; }
+
+rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
+$as_echo_n "checking for suffix of object files... " >&6; }
+if ${ac_cv_objext+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  for ac_file in conftest.o conftest.obj conftest.*; do
+  test -f "$ac_file" || continue;
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+       break;;
+  esac
+done
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of object files: cannot compile
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
+$as_echo "$ac_cv_objext" >&6; }
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if ${ac_cv_c_compiler_gnu+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if ${ac_cv_prog_cc_g+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_save_c_werror_flag=$ac_c_werror_flag
+   ac_c_werror_flag=yes
+   ac_cv_prog_cc_g=no
+   CFLAGS="-g"
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+else
+  CFLAGS=""
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  ac_c_werror_flag=$ac_save_c_werror_flag
+	 CFLAGS="-g"
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if ${ac_cv_prog_cc_c89+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdarg.h>
+#include <stdio.h>
+struct stat;
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
+   function prototypes and stuff, but not '\xHH' hex character constants.
+   These don't provoke an error unfortunately, instead are silently treated
+   as 'x'.  The following induces an error, until -std is added to get
+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
+   array size at least.  It's necessary to write '\x00'==0 to get something
+   that's true only with -std.  */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+   inside strings and character constants.  */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+  ;
+  return 0;
+}
+_ACEOF
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_c89=$ac_arg
+fi
+rm -f core conftest.err conftest.$ac_objext
+  test "x$ac_cv_prog_cc_c89" != "xno" && break
+done
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
+fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+  x)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+  xno)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
+  *)
+    CC="$CC $ac_cv_prog_cc_c89"
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
+esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+for ac_func in stpcpy
+do :
+  ac_fn_c_check_func "$LINENO" "stpcpy" "ac_cv_func_stpcpy"
+if test "x$ac_cv_func_stpcpy" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_STPCPY 1
+_ACEOF
+
+fi
+done
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+  if ${ac_cv_prog_CPP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+      # Double quotes because CPP needs to be expanded
+    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+    do
+      ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+  break
+fi
+
+    done
+    ac_cv_prog_CPP=$CPP
+
+fi
+  CPP=$ac_cv_prog_CPP
+else
+  ac_cv_prog_CPP=$CPP
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if ${ac_cv_path_GREP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$GREP"; then
+  ac_path_GREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in grep ggrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_GREP" || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+  # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'GREP' >> "conftest.nl"
+    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_GREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_GREP="$ac_path_GREP"
+      ac_path_GREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_GREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_GREP"; then
+    as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_GREP=$GREP
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if ${ac_cv_path_EGREP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+   then ac_cv_path_EGREP="$GREP -E"
+   else
+     if test -z "$EGREP"; then
+  ac_path_EGREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in egrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_EGREP" || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+  # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'EGREP' >> "conftest.nl"
+    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_EGREP="$ac_path_EGREP"
+      ac_path_EGREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_EGREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_EGREP"; then
+    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_EGREP=$EGREP
+fi
+
+   fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if ${ac_cv_header_stdc+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_stdc=yes
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "memchr" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "free" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+  if test "$cross_compiling" = yes; then :
+  :
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ctype.h>
+#include <stdlib.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+		   (('a' <= (c) && (c) <= 'i') \
+		     || ('j' <= (c) && (c) <= 'r') \
+		     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+  int i;
+  for (i = 0; i < 256; i++)
+    if (XOR (islower (i), ISLOWER (i))
+	|| toupper (i) != TOUPPER (i))
+      return 2;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+		  inttypes.h stdint.h unistd.h
+do :
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+for ac_header in sys/types.h
+do :
+  ac_fn_c_check_header_mongrel "$LINENO" "sys/types.h" "ac_cv_header_sys_types_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_types_h" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_SYS_TYPES_H 1
+_ACEOF
+
+fi
+
+done
+
+ac_header_dirent=no
+for ac_hdr in dirent.h sys/ndir.h sys/dir.h ndir.h; do
+  as_ac_Header=`$as_echo "ac_cv_header_dirent_$ac_hdr" | $as_tr_sh`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_hdr that defines DIR" >&5
+$as_echo_n "checking for $ac_hdr that defines DIR... " >&6; }
+if eval \${$as_ac_Header+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <sys/types.h>
+#include <$ac_hdr>
+
+int
+main ()
+{
+if ((DIR *) 0)
+return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  eval "$as_ac_Header=yes"
+else
+  eval "$as_ac_Header=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$as_ac_Header
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_hdr" | $as_tr_cpp` 1
+_ACEOF
+
+ac_header_dirent=$ac_hdr; break
+fi
+
+done
+# Two versions of opendir et al. are in -ldir and -lx on SCO Xenix.
+if test $ac_header_dirent = dirent.h; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing opendir" >&5
+$as_echo_n "checking for library containing opendir... " >&6; }
+if ${ac_cv_search_opendir+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char opendir ();
+int
+main ()
+{
+return opendir ();
+  ;
+  return 0;
+}
+_ACEOF
+for ac_lib in '' dir; do
+  if test -z "$ac_lib"; then
+    ac_res="none required"
+  else
+    ac_res=-l$ac_lib
+    LIBS="-l$ac_lib  $ac_func_search_save_LIBS"
+  fi
+  if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_search_opendir=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext
+  if ${ac_cv_search_opendir+:} false; then :
+  break
+fi
+done
+if ${ac_cv_search_opendir+:} false; then :
+
+else
+  ac_cv_search_opendir=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_opendir" >&5
+$as_echo "$ac_cv_search_opendir" >&6; }
+ac_res=$ac_cv_search_opendir
+if test "$ac_res" != no; then :
+  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+
+fi
+
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing opendir" >&5
+$as_echo_n "checking for library containing opendir... " >&6; }
+if ${ac_cv_search_opendir+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char opendir ();
+int
+main ()
+{
+return opendir ();
+  ;
+  return 0;
+}
+_ACEOF
+for ac_lib in '' x; do
+  if test -z "$ac_lib"; then
+    ac_res="none required"
+  else
+    ac_res=-l$ac_lib
+    LIBS="-l$ac_lib  $ac_func_search_save_LIBS"
+  fi
+  if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_search_opendir=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext
+  if ${ac_cv_search_opendir+:} false; then :
+  break
+fi
+done
+if ${ac_cv_search_opendir+:} false; then :
+
+else
+  ac_cv_search_opendir=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_opendir" >&5
+$as_echo "$ac_cv_search_opendir" >&6; }
+ac_res=$ac_cv_search_opendir
+if test "$ac_res" != no; then :
+  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+
+fi
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for opendir in -lc" >&5
+$as_echo_n "checking for opendir in -lc... " >&6; }
+if ${ac_cv_lib_c_opendir+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char opendir ();
+int
+main ()
+{
+return opendir ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_opendir=yes
+else
+  ac_cv_lib_c_opendir=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_opendir" >&5
+$as_echo "$ac_cv_lib_c_opendir" >&6; }
+if test "x$ac_cv_lib_c_opendir" = xyes; then :
+
+$as_echo "#define HAVE_OPENDIR 1" >>confdefs.h
+
+fi
+
+ac_config_headers="$ac_config_headers gm2config.h"
+
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems.  If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, we kill variables containing newlines.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(
+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+
+  (set) 2>&1 |
+    case $as_nl`(ac_space=' '; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      # `set' does not quote correctly, so add quotes: double-quote
+      # substitution turns \\\\ into \\, and sed turns \\ into \.
+      sed -n \
+	"s/'/'\\\\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+      ;; #(
+    *)
+      # `set' quotes correctly as required by POSIX, so do not add quotes.
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+) |
+  sed '
+     /^ac_cv_env_/b end
+     t clear
+     :clear
+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+     t end
+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+     :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+  if test -w "$cache_file"; then
+    if test "x$cache_file" != "x/dev/null"; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
+      if test ! -f "$cache_file" || test -h "$cache_file"; then
+	cat confcache >"$cache_file"
+      else
+        case $cache_file in #(
+        */* | ?:*)
+	  mv -f confcache "$cache_file"$$ &&
+	  mv -f "$cache_file"$$ "$cache_file" ;; #(
+        *)
+	  mv -f confcache "$cache_file" ;;
+	esac
+      fi
+    fi
+  else
+    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
+  fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+DEFS=-DHAVE_CONFIG_H
+
+ac_libobjs=
+ac_ltlibobjs=
+U=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+  # 1. Remove the extension, and $U if already installed.
+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
+  #    will be set to the directory where LIBOBJS objects are built.
+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: "${CONFIG_STATUS=./config.status}"
+ac_write_fail=0
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$1; test $as_status -eq 0 && as_status=1
+  if test "$4"; then
+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+  fi
+  $as_echo "$as_me: error: $2" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -pR'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -pR'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -pR'
+  fi
+else
+  as_ln_s='cp -pR'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+  test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+exec 6>&1
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling.
+ac_log="
+This file was extended by m2 $as_me  , which was
+generated by GNU Autoconf 2.69.  Invocation command line was
+
+  CONFIG_FILES    = $CONFIG_FILES
+  CONFIG_HEADERS  = $CONFIG_HEADERS
+  CONFIG_LINKS    = $CONFIG_LINKS
+  CONFIG_COMMANDS = $CONFIG_COMMANDS
+  $ $0 $@
+
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
+_ACEOF
+
+
+case $ac_config_headers in *"
+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;
+esac
+
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+# Files that config.status was made for.
+config_headers="$ac_config_headers"
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+ac_cs_usage="\
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration.  Unless the files
+and actions are specified as TAGs, all are instantiated by default.
+
+Usage: $0 [OPTION]... [TAG]...
+
+  -h, --help       print this help, then exit
+  -V, --version    print version number and configuration settings, then exit
+      --config     print configuration, then exit
+  -q, --quiet, --silent
+                   do not print progress messages
+  -d, --debug      don't remove temporary files
+      --recheck    update $as_me by reconfiguring in the same conditions
+      --header=FILE[:TEMPLATE]
+                   instantiate the configuration header FILE
+
+Configuration headers:
+$config_headers
+
+Report bugs to the package provider."
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
+ac_cs_version="\\
+m2 config.status
+configured by $0, generated by GNU Autoconf 2.69,
+  with options \\"\$ac_cs_config\\"
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+test -n "\$AWK" || AWK=awk
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
+ac_need_defaults=:
+while test $# != 0
+do
+  case $1 in
+  --*=?*)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
+    ac_shift=:
+    ;;
+  --*=)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=
+    ac_shift=:
+    ;;
+  *)
+    ac_option=$1
+    ac_optarg=$2
+    ac_shift=shift
+    ;;
+  esac
+
+  case $ac_option in
+  # Handling of the options.
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    ac_cs_recheck=: ;;
+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+    $as_echo "$ac_cs_version"; exit ;;
+  --config | --confi | --conf | --con | --co | --c )
+    $as_echo "$ac_cs_config"; exit ;;
+  --debug | --debu | --deb | --de | --d | -d )
+    debug=: ;;
+  --header | --heade | --head | --hea )
+    $ac_shift
+    case $ac_optarg in
+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"
+    ac_need_defaults=false;;
+  --he | --h)
+    # Conflict between --help and --header
+    as_fn_error $? "ambiguous option: \`$1'
+Try \`$0 --help' for more information.";;
+  --help | --hel | -h )
+    $as_echo "$ac_cs_usage"; exit ;;
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil | --si | --s)
+    ac_cs_silent=: ;;
+
+  # This is an error.
+  -*) as_fn_error $? "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
+
+  *) as_fn_append ac_config_targets " $1"
+     ac_need_defaults=false ;;
+
+  esac
+  shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+  exec 6>/dev/null
+  ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+if \$ac_cs_recheck; then
+  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+  shift
+  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+  CONFIG_SHELL='$SHELL'
+  export CONFIG_SHELL
+  exec "\$@"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+exec 5>>config.log
+{
+  echo
+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+  $as_echo "$ac_log"
+} >&5
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+
+# Handling of arguments.
+for ac_config_target in $ac_config_targets
+do
+  case $ac_config_target in
+    "gm2config.h") CONFIG_HEADERS="$CONFIG_HEADERS gm2config.h" ;;
+
+  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
+  esac
+done
+
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used.  Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
+fi
+
+# Have a temporary directory for convenience.  Make it in the build tree
+# simply because there is no reason against having it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
+$debug ||
+{
+  tmp= ac_tmp=
+  trap 'exit_status=$?
+  : "${ac_tmp:=$tmp}"
+  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
+' 0
+  trap 'as_fn_exit 1' 1 2 13 15
+}
+# Create a (secure) tmp directory for tmp files.
+
+{
+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+  test -d "$tmp"
+}  ||
+{
+  tmp=./conf$$-$RANDOM
+  (umask 077 && mkdir "$tmp")
+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
+ac_tmp=$tmp
+
+# Set up the scripts for CONFIG_HEADERS section.
+# No need to generate them if there are no CONFIG_HEADERS.
+# This happens for instance with `./config.status Makefile'.
+if test -n "$CONFIG_HEADERS"; then
+cat >"$ac_tmp/defines.awk" <<\_ACAWK ||
+BEGIN {
+_ACEOF
+
+# Transform confdefs.h into an awk script `defines.awk', embedded as
+# here-document in config.status, that substitutes the proper values into
+# config.h.in to produce config.h.
+
+# Create a delimiter string that does not exist in confdefs.h, to ease
+# handling of long lines.
+ac_delim='%!_!# '
+for ac_last_try in false false :; do
+  ac_tt=`sed -n "/$ac_delim/p" confdefs.h`
+  if test -z "$ac_tt"; then
+    break
+  elif $ac_last_try; then
+    as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+
+# For the awk script, D is an array of macro values keyed by name,
+# likewise P contains macro parameters if any.  Preserve backslash
+# newline sequences.
+
+ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*
+sed -n '
+s/.\{148\}/&'"$ac_delim"'/g
+t rset
+:rset
+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /
+t def
+d
+:def
+s/\\$//
+t bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3"/p
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p
+d
+:bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3\\\\\\n"\\/p
+t cont
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p
+t cont
+d
+:cont
+n
+s/.\{148\}/&'"$ac_delim"'/g
+t clear
+:clear
+s/\\$//
+t bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/"/p
+d
+:bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p
+b cont
+' <confdefs.h | sed '
+s/'"$ac_delim"'/"\\\
+"/g' >>$CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+  for (key in D) D_is_set[key] = 1
+  FS = ""
+}
+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {
+  line = \$ 0
+  split(line, arg, " ")
+  if (arg[1] == "#") {
+    defundef = arg[2]
+    mac1 = arg[3]
+  } else {
+    defundef = substr(arg[1], 2)
+    mac1 = arg[2]
+  }
+  split(mac1, mac2, "(") #)
+  macro = mac2[1]
+  prefix = substr(line, 1, index(line, defundef) - 1)
+  if (D_is_set[macro]) {
+    # Preserve the white space surrounding the "#".
+    print prefix "define", macro P[macro] D[macro]
+    next
+  } else {
+    # Replace #undef with comments.  This is necessary, for example,
+    # in the case of _POSIX_SOURCE, which is predefined and required
+    # on some systems where configure will not decide to define it.
+    if (defundef == "undef") {
+      print "/*", prefix defundef, macro, "*/"
+      next
+    }
+  }
+}
+{ print }
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+  as_fn_error $? "could not setup config headers machinery" "$LINENO" 5
+fi # test -n "$CONFIG_HEADERS"
+
+
+eval set X "    :H $CONFIG_HEADERS    "
+shift
+for ac_tag
+do
+  case $ac_tag in
+  :[FHLC]) ac_mode=$ac_tag; continue;;
+  esac
+  case $ac_mode$ac_tag in
+  :[FHL]*:*);;
+  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
+  :[FH]-) ac_tag=-:-;;
+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+  esac
+  ac_save_IFS=$IFS
+  IFS=:
+  set x $ac_tag
+  IFS=$ac_save_IFS
+  shift
+  ac_file=$1
+  shift
+
+  case $ac_mode in
+  :L) ac_source=$1;;
+  :[FH])
+    ac_file_inputs=
+    for ac_f
+    do
+      case $ac_f in
+      -) ac_f="$ac_tmp/stdin";;
+      *) # Look for the file first in the build tree, then in the source tree
+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
+	 # because $ac_f cannot contain `:'.
+	 test -f "$ac_f" ||
+	   case $ac_f in
+	   [\\/$]*) false;;
+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+	   esac ||
+	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
+      esac
+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+      as_fn_append ac_file_inputs " '$ac_f'"
+    done
+
+    # Let's still pretend it is `configure' which instantiates (i.e., don't
+    # use $as_me), people would be surprised to read:
+    #    /* config.h.  Generated by config.status.  */
+    configure_input='Generated from '`
+	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+	`' by configure.'
+    if test x"$ac_file" != x-; then
+      configure_input="$ac_file.  $configure_input"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
+    fi
+    # Neutralize special characters interpreted by sed in replacement strings.
+    case $configure_input in #(
+    *\&* | *\|* | *\\* )
+       ac_sed_conf_input=`$as_echo "$configure_input" |
+       sed 's/[\\\\&|]/\\\\&/g'`;; #(
+    *) ac_sed_conf_input=$configure_input;;
+    esac
+
+    case $ac_tag in
+    *:-:* | *:-) cat >"$ac_tmp/stdin" \
+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
+    esac
+    ;;
+  esac
+
+  ac_dir=`$as_dirname -- "$ac_file" ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$ac_file" : 'X\(//\)[^/]' \| \
+	 X"$ac_file" : 'X\(//\)$' \| \
+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$ac_file" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  as_dir="$ac_dir"; as_fn_mkdir_p
+  ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+
+  case $ac_mode in
+
+  :H)
+  #
+  # CONFIG_HEADER
+  #
+  if test x"$ac_file" != x-; then
+    {
+      $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"
+    } >"$ac_tmp/config.h" \
+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+    if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5
+$as_echo "$as_me: $ac_file is unchanged" >&6;}
+    else
+      rm -f "$ac_file"
+      mv "$ac_tmp/config.h" "$ac_file" \
+	|| as_fn_error $? "could not create $ac_file" "$LINENO" 5
+    fi
+  else
+    $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \
+      || as_fn_error $? "could not create -" "$LINENO" 5
+  fi
+ ;;
+
+
+  esac
+
+
+  case $ac_file$ac_mode in
+    "gm2config.h":H) echo timestamp > stamp-h ;;
+
+  esac
+done # for ac_tag
+
+
+as_fn_exit 0
+_ACEOF
+ac_clean_files=$ac_clean_files_save
+
+test $ac_write_fail = 0 ||
+  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded.  So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status.  When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+  ac_cs_success=:
+  ac_config_status_args=
+  test "$silent" = yes &&
+    ac_config_status_args="$ac_config_status_args --quiet"
+  exec 5>/dev/null
+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+  exec 5>>config.log
+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+  # would make configure fail if this is the last instruction.
+  $ac_cs_success || as_fn_exit 1
+fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
+fi
+
diff --git a/gcc/m2/configure.ac b/gcc/m2/configure.ac
new file mode 100644
index 00000000000..756e01c4321
--- /dev/null
+++ b/gcc/m2/configure.ac
@@ -0,0 +1,38 @@
+# configure.ac provides gm2spec.c with access to config values.
+
+# Copyright (C) 2001-2022 Free Software Foundation, Inc.
+# Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+# GCC 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.
+
+# GCC 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+AC_INIT(m2, [ ])
+
+# Determine the host, build, and target systems
+AC_CANONICAL_BUILD
+AC_CANONICAL_HOST
+AC_CANONICAL_TARGET
+
+AC_CHECK_PROGS(regex_realpath, realpath)
+if test x$regex_realpath = "x" ; then
+    AC_MSG_ERROR([realpath is required to build GNU Modula-2 (hint install coreutils).])
+fi
+
+AC_CHECK_FUNCS([stpcpy])
+
+AC_CHECK_HEADERS(sys/types.h)
+AC_HEADER_DIRENT
+AC_CHECK_LIB([c],[opendir],[AC_DEFINE([HAVE_OPENDIR],[1],[found opendir])])
+AC_CONFIG_HEADERS(gm2config.h, [echo timestamp > stamp-h])
+AC_OUTPUT
diff --git a/gcc/m2/gm2-compiler/CLexBuf.def b/gcc/m2/gm2-compiler/CLexBuf.def
new file mode 100644
index 00000000000..7718c35be09
--- /dev/null
+++ b/gcc/m2/gm2-compiler/CLexBuf.def
@@ -0,0 +1,264 @@
+(* CLexBuf.def provides a lexical buffer for clex.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+DEFINITION MODULE CLexBuf ;
+
+(*
+    Title      : CLexBuf
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu Jan 23 12:32:36 2003
+    Revision   : $Version$
+    Description: provides a lexical buffer for clex.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String ;
+FROM NameKey IMPORT Name ;
+EXPORT QUALIFIED toktype,
+                 IsMacroDefined, NoArgs, DefineMacro, UnDefineMacro,
+                 OpenSource, CloseSource, ReInitialize, GetToken, InsertToken,
+                 InsertTokenAndRewind, GetLineNo,
+                 GetTokenNo, TokenToLineNo, FindFileNameFromToken, GetFileName,
+                 ResetForNewPass,
+                 currenttoken, currentstring, currentinteger,
+                 EnableMacroSubstitutions,
+                 AddTok, AddTokCharStar, AddTokInteger,
+                 SetFile, PushFile, PopFile, FlushTokens ;
+
+TYPE
+   toktype = (eoftok, startok, arrowtok, structtok, lsbratok, rsbratok,
+              lcbratok, rcbratok, lparatok, rparatok, semicolontok,
+              longtok, inttok, chartok, enumtok, typedeftok,
+              floattok, doubletok, unsignedtok, consttok,
+              periodperiodperiodtok,
+              integertok, hexintegertok, octintegertok,
+              identtok, realtok, conststringtok, constchartok, codetok,
+              starthashtok, endhashtok, definetok, undeftok, iftok, elsetok,
+              endiftok, ifdeftok, ifndeftok, includetok,
+              nottok, commatok,
+              periodtok,
+              gretok, lesstok, ortok, andtok, bartok, ambersandtok,
+              shiftlefttok, shiftrighttok, divtok, modtok,
+              sizeoftok, definedtok, hattok, equaltok, notequaltok,
+              greequaltok, lessequaltok, plustok, minustok, tildetok,
+              externtok, statictok, autotok, registertok,
+              voidtok, shorttok, signedtok, uniontok, colontok, becomestok,
+              volatiletok, typetok) ;
+
+VAR
+   currenttoken  : toktype ;
+   currentstring : ADDRESS ;
+   currentinteger: INTEGER ;
+
+
+(*
+   EnableMacroSubstitutions -
+*)
+
+PROCEDURE EnableMacroSubstitutions (b: BOOLEAN) ;
+
+
+(*
+   IsMacroDefined - returns TRUE if macro, n, was defined.
+*)
+
+PROCEDURE IsMacroDefined (n: Name) : BOOLEAN ;
+
+
+(*
+   NoArgs - returns the number of arguments for macro, n.
+            -1 if the macro does not exist
+*)
+
+PROCEDURE NoArgs (n: Name) : INTEGER ;
+
+
+(*
+   DefineMacro - defines macro, n, as defined to start at token, t.
+*)
+
+PROCEDURE DefineMacro (n: Name; t: CARDINAL) ;
+
+
+(*
+   UnDefineMacro -
+*)
+
+PROCEDURE UnDefineMacro (n: Name) ;
+
+
+(*
+   OpenSource - Attempts to open the source file, s.
+                The success of the operation is returned.
+*)
+
+PROCEDURE OpenSource (s: String) : BOOLEAN ;
+
+
+(*
+   CloseSource - closes the current open file.
+*)
+
+PROCEDURE CloseSource ;
+
+
+(*
+   ReInitialize - re-initialize the all the data structures.
+*)
+
+PROCEDURE ReInitialize ;
+
+
+(*
+   ResetForNewPass - reset the buffer pointers to the beginning ready for
+                     a new pass
+*)
+
+PROCEDURE ResetForNewPass ;
+
+
+(*
+   GetToken - gets the next token into currenttoken.
+*)
+
+PROCEDURE GetToken ;
+
+
+(*
+   InsertToken - inserts a symbol, token, infront of the current token
+                 ready for the next pass.
+*)
+
+PROCEDURE InsertToken (token: toktype) ;
+
+
+(*
+   InsertTokenAndRewind - inserts a symbol, token, infront of the current token
+                          and then moves the token stream back onto the inserted token.
+*)
+
+PROCEDURE InsertTokenAndRewind (token: toktype) ;
+
+
+(*
+   GetLineNo - returns the current line number where the symbol occurs in
+               the source file.
+*)
+
+PROCEDURE GetLineNo () : CARDINAL ;
+
+
+(*
+   GetTokenNo - returns the number of tokens read from
+                the source file by the lexical analaysis.
+*)
+
+PROCEDURE GetTokenNo () : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE TokenToLineNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindFileNameFromToken (TokenNo: CARDINAL; depth: CARDINAL) : String ;
+
+
+(*
+   GetFileName - assigns, a, to the current file name.
+*)
+
+PROCEDURE GetFileName () : String ;
+
+
+(* ***********************************************************************
+ *
+ * These functions allow c.lex to deliver tokens into the buffer
+ *
+ ************************************************************************* *)
+
+(*
+   AddTok - adds a token to the buffer.
+*)
+
+PROCEDURE AddTok (t: toktype) ;
+
+
+(*
+   AddTokCharStar - adds a token to the buffer and an additional string, s.
+                    A copy of string, s, is made.
+*)
+
+PROCEDURE AddTokCharStar (t: toktype; s: ADDRESS) ;
+
+
+(*
+   AddTokInteger - adds a token and an integer to the buffer.
+*)
+
+PROCEDURE AddTokInteger (t: toktype; i: INTEGER) ;
+
+
+(*
+   SetFile - sets the current filename to, filename.
+*)
+
+PROCEDURE SetFile (filename: ADDRESS) ;
+
+
+(*
+   PushFile - indicates that, filename, has just been included.
+*)
+
+PROCEDURE PushFile (filename: ADDRESS) ;
+
+
+(*
+   PopFile - indicates that we are returning to, filename, having finished
+             an include.
+*)
+
+PROCEDURE PopFile (filename: ADDRESS) ;
+
+
+(*
+   FlushTokens - removes the last token.
+*)
+
+PROCEDURE FlushTokens ;
+
+
+END CLexBuf.
diff --git a/gcc/m2/gm2-compiler/CLexBuf.mod b/gcc/m2/gm2-compiler/CLexBuf.mod
new file mode 100644
index 00000000000..d3a60ed9fe9
--- /dev/null
+++ b/gcc/m2/gm2-compiler/CLexBuf.mod
@@ -0,0 +1,1029 @@
+(* CLexBuf.mod provides a lexical buffer for clex.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+IMPLEMENTATION MODULE CLexBuf ;
+
+IMPORT cflex ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM DynamicStrings IMPORT string, InitString, InitStringCharStar, Equal, Mark, KillString ;
+FROM FormatStrings IMPORT Sprintf1 ;
+FROM NameKey IMPORT Name, NulName, makekey, KeyToCharStar ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
+FROM Assertion IMPORT Assert ;
+FROM SymbolKey IMPORT NulKey, SymbolTree, InitTree, DelSymKey, PutSymKey, GetSymKey ;
+FROM Indexing IMPORT Index, InitIndex, IsIndiceInIndex, GetIndice, PutIndice ;
+
+CONST
+   MaxBucketSize = 100 ;
+   Debugging     = FALSE ;
+
+TYPE
+   SourceList = POINTER TO sourcelist ;
+   sourcelist =            RECORD
+                              left,
+                              right: SourceList ;
+                              name : String ;
+                              line : CARDINAL ;
+                           END ;
+
+   TokenDesc = RECORD
+                  token: toktype ;
+                  str  : Name ;
+                  int  : INTEGER ;
+                  line : CARDINAL ;
+                  file : SourceList ;
+               END ;
+
+   TokenBucket = POINTER TO tokenbucket ;
+   tokenbucket =            RECORD
+                               buf : ARRAY [0..MaxBucketSize] OF TokenDesc ;
+                               len : CARDINAL ;
+                               next: TokenBucket ;
+                            END ;
+
+   ListDesc = RECORD
+                 head,
+                 tail            : TokenBucket ;
+                 LastBucketOffset: CARDINAL ;
+              END ;
+
+   MacroArgs = POINTER TO macroargs ;
+   macroargs =            RECORD
+                             next: MacroArgs ;
+                             str : Name ;
+                          END ;
+
+   Macro = POINTER TO macro ;
+   macro =            RECORD
+                         str   : Name ;
+                         tokno : CARDINAL ;
+                         noArgs: CARDINAL ;
+                         args  : MacroArgs ;
+                      END ;
+
+VAR
+   CurrentSource    : SourceList ;
+   UseBufferedTokens,
+   CurrentUsed      : BOOLEAN ;
+   ListOfTokens     : ListDesc ;
+   CurrentTokNo     : CARDINAL ;
+   MacroDefinitions : SymbolTree ;
+   MacroIndex       : Index ;
+   DefineNo         : CARDINAL ;
+   EnabledMacros    : BOOLEAN ;
+
+
+(* M A C R O *)
+
+(*
+   EnableMacroSubstitutions -
+*)
+
+PROCEDURE EnableMacroSubstitutions (b: BOOLEAN) ;
+BEGIN
+   EnabledMacros := b
+END EnableMacroSubstitutions ;
+
+
+(*
+   IsMacroDefined - returns TRUE if macro, n, was defined.
+*)
+
+PROCEDURE IsMacroDefined (n: Name) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+   m: Macro ;
+BEGIN
+   i := GetSymKey(MacroDefinitions, n) ;
+   IF i=0
+   THEN
+      RETURN( FALSE )
+   ELSE
+      m := GetIndice(MacroIndex, i) ;
+      IF m=NIL
+      THEN
+         RETURN( FALSE )
+      ELSE
+         RETURN( TRUE )
+      END
+   END
+END IsMacroDefined ;
+
+
+(*
+   NoArgs - returns the number of arguments for macro, n.
+            -1 if the macro does not exist
+*)
+
+PROCEDURE NoArgs (n: Name) : INTEGER ;
+VAR
+   m: Macro ;
+   i: CARDINAL ;
+BEGIN
+   IF IsMacroDefined(n)
+   THEN
+      i := GetSymKey(MacroDefinitions, n) ;
+      m := GetIndice(MacroIndex, i) ;
+      RETURN( m^.noArgs )
+   ELSE
+      RETURN( -1 )
+   END
+END NoArgs ;
+
+
+(*
+   DefineMacro - defines macro, n, as defined to start at token, t.
+*)
+
+PROCEDURE DefineMacro (n: Name; t: CARDINAL) ;
+VAR
+   m: Macro ;
+   i: CARDINAL ;
+BEGIN
+   NEW(m) ;
+   WITH m^ DO
+      str := n ;
+      tokno := t ;
+      noArgs := 0 ;
+      args := NIL
+   END ;
+   UnDefineMacro(n) ;
+   i := GetSymKey(MacroDefinitions, n) ;
+   IF i=NulKey
+   THEN
+      PutSymKey(MacroDefinitions, n, DefineNo) ;
+      i := DefineNo ;
+      INC(DefineNo)
+   END ;
+   PutIndice(MacroIndex, i, m)
+END DefineMacro ;
+
+
+(*
+   UnDefineMacro -
+*)
+
+PROCEDURE UnDefineMacro (n: Name) ;
+VAR
+   m: Macro ;
+   i: CARDINAL ;
+BEGIN
+   IF IsMacroDefined(n)
+   THEN
+      i := GetSymKey(MacroDefinitions, n) ;
+      m := GetIndice(MacroIndex, i) ;
+      PutIndice(MacroIndex, i, NIL) ;
+      DISPOSE(m)
+   END
+END UnDefineMacro ;
+
+
+(*
+   PushMacroDefinition - pushes the macro definition, n, onto the token stream.
+                         It returns TRUE if the macro was found and pushed.
+*)
+
+PROCEDURE PushMacroDefinition (n: Name) : BOOLEAN ;
+VAR
+   m: Macro ;
+   t: CARDINAL ;
+   b: TokenBucket ;
+   i: CARDINAL ;
+BEGIN
+   IF EnabledMacros AND IsMacroDefined(n)
+   THEN
+      i := GetSymKey(MacroDefinitions, n) ;
+      m := GetIndice(MacroIndex, i) ;
+      WITH m^ DO
+         IF tokno>0
+         THEN
+            t := tokno ;
+            LOOP
+               b := FindTokenBucket(t) ;
+               WITH b^.buf[t] DO
+                  IF token=endhashtok
+                  THEN
+                     RETURN( TRUE )
+                  ELSE
+                     IF IsMacroDefined(str) AND (str#n)
+                     THEN
+                        IF PushMacroDefinition(str)
+                        THEN
+                        END
+                     ELSE
+                        AddTokToList(token, str, int, line, file)
+                     END
+                  END
+               END ;
+               INC(t)
+            END
+         END
+      END ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END PushMacroDefinition ;
+
+
+(*   e n d    o f    M A C R O    r o u t i n e s   *)
+
+PROCEDURE stop ; BEGIN END stop ;
+
+(*
+   Init - initializes the token list and source list.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   currenttoken := eoftok ;
+   CurrentTokNo := 0 ;
+   CurrentSource := NIL ;
+   ListOfTokens.head := NIL ;
+   ListOfTokens.tail := NIL ;
+   UseBufferedTokens := FALSE ;
+   InitTree(MacroDefinitions) ;
+   EnabledMacros := TRUE ;
+   DefineNo := 1 ;
+   MacroIndex := InitIndex(1)
+END Init ;
+
+
+(*
+   AddTo - adds a new element to the end of SourceList, CurrentSource.
+*)
+
+PROCEDURE AddTo (l: SourceList) ;
+BEGIN
+   l^.right := CurrentSource ;
+   l^.left  := CurrentSource^.left ;
+   CurrentSource^.left^.right := l ;
+   CurrentSource^.left := l ;
+   l^.left^.line := cflex.GetLineNo()
+END AddTo ;
+
+
+(*
+   SubFrom - subtracts, l, from the source list.
+*)
+
+PROCEDURE SubFrom (l: SourceList) ;
+BEGIN
+   l^.left^.right := l^.right ;
+   l^.right^.left := l^.left
+END SubFrom ;
+
+
+(*
+   NewElement - returns a new SourceList
+*)
+
+PROCEDURE NewElement (s: ADDRESS) : SourceList ;
+VAR
+   l: SourceList ;
+BEGIN
+   NEW(l) ;
+   IF l=NIL
+   THEN
+      HALT
+   ELSE
+      WITH l^ DO
+         name  := InitStringCharStar(s) ;
+         left  := NIL ;
+         right := NIL
+      END
+   END ;
+   RETURN( l )
+END NewElement ;
+
+
+(*
+   NewList - initializes an empty list with the classic dummy header element.
+*)
+
+PROCEDURE NewList () : SourceList ;
+VAR
+   l: SourceList ;
+BEGIN
+   NEW(l) ;
+   WITH l^ DO
+      left  := l ;
+      right := l ;
+      name  := NIL
+   END ;
+   RETURN( l )
+END NewList ;
+
+
+(*
+   CheckIfNeedToDuplicate - checks to see whether the CurrentSource has
+                            been used, if it has then duplicate the list.
+*)
+
+PROCEDURE CheckIfNeedToDuplicate ;
+VAR
+   l, h: SourceList ;
+BEGIN
+   IF CurrentUsed
+   THEN
+      l := CurrentSource^.right ;
+      h := CurrentSource ;
+      CurrentSource := NewList() ;
+      WHILE l#h DO
+         AddTo(NewElement(l^.name)) ;
+         l := l^.right
+      END
+   END
+END CheckIfNeedToDuplicate ;
+
+
+(*
+   PushFile - indicates that, filename, has just been included.
+*)
+
+PROCEDURE PushFile (filename: ADDRESS) ;
+VAR
+   l: SourceList ;
+BEGIN
+   CheckIfNeedToDuplicate ;
+   AddTo(NewElement(filename)) ;
+   IF Debugging
+   THEN
+      IF CurrentSource^.right#CurrentSource
+      THEN
+         l := CurrentSource ;
+         REPEAT
+            printf2('name = %s, line = %d\n', l^.name, l^.line) ;
+            l := l^.right
+         UNTIL l=CurrentSource
+      END
+   END
+END PushFile ;
+
+
+(*
+   PopFile - indicates that we are returning to, filename, having finished
+             an include.
+*)
+
+PROCEDURE PopFile (filename: ADDRESS) ;
+VAR
+   l: SourceList ;
+BEGIN
+   CheckIfNeedToDuplicate ;
+   IF (CurrentSource#NIL) AND (CurrentSource^.left#CurrentSource)
+   THEN
+      l := CurrentSource^.left ;  (* last element *)
+      SubFrom(l) ;
+      DISPOSE(l) ;
+      IF (CurrentSource^.left#CurrentSource) AND
+         (NOT Equal(CurrentSource^.name, Mark(InitStringCharStar(filename))))
+      THEN
+         (* mismatch in source file names after preprocessing files *)
+      END
+   ELSE
+      (* source file list is empty, cannot pop an include.. *)
+   END
+END PopFile ;
+
+
+(*
+   KillList - kills the SourceList providing that it has not been used.
+*)
+
+PROCEDURE KillList ;
+VAR
+   l, k: SourceList ;
+BEGIN
+   IF (NOT CurrentUsed) AND (CurrentSource#NIL)
+   THEN
+      l := CurrentSource ;
+      REPEAT
+         k := l ;
+         l := l^.right ;
+         DISPOSE(k)
+      UNTIL l=CurrentSource
+   END
+END KillList ;
+
+
+(*
+   ReInitialize - re-initialize the all the data structures.
+*)
+
+PROCEDURE ReInitialize ;
+VAR
+   s, t: TokenBucket ;
+BEGIN
+   IF ListOfTokens.head#NIL
+   THEN
+      t := ListOfTokens.head ;
+      REPEAT
+         s := t ;
+         t := t^.next ;
+         DISPOSE(s) ;
+      UNTIL t=NIL ;
+      CurrentUsed := FALSE ;
+      KillList
+   END ;
+   Init
+END ReInitialize ;
+
+
+(*
+   SetFile - sets the current filename to, filename.
+*)
+
+PROCEDURE SetFile (filename: ADDRESS) ;
+BEGIN
+   KillList ;
+   CurrentUsed   := FALSE ;
+   CurrentSource := NewList() ;
+   AddTo(NewElement(filename))
+END SetFile ;
+
+
+(*
+   OpenSource - Attempts to open the source file, s.
+                The success of the operation is returned.
+*)
+
+PROCEDURE OpenSource (s: String) : BOOLEAN ;
+BEGIN
+   IF UseBufferedTokens
+   THEN
+      GetToken ;
+      RETURN( TRUE )
+   ELSE
+      IF cflex.OpenSource(string(s))
+      THEN
+         SetFile(string(s)) ;
+         SyncOpenWithBuffer ;
+         GetToken ;
+         RETURN( TRUE )
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END OpenSource ;
+
+
+(*
+   CloseSource - closes the current open file.
+*)
+
+PROCEDURE CloseSource ;
+BEGIN
+   IF UseBufferedTokens
+   THEN
+      WHILE currenttoken#eoftok DO
+         GetToken
+      END
+   ELSE
+      (* a subsequent call to cflex.OpenSource will really close the file *)
+   END
+END CloseSource ;
+
+
+(*
+   ResetForNewPass - reset the buffer pointers to the beginning ready for
+                     a new pass
+*)
+
+PROCEDURE ResetForNewPass ;
+BEGIN
+   CurrentTokNo := 0 ;
+   UseBufferedTokens := TRUE
+END ResetForNewPass ;
+
+
+(*
+   DisplayToken -
+*)
+
+PROCEDURE DisplayToken ;
+VAR
+   n: Name ;
+BEGIN
+   cflex.CError(string(InitString('current token'))) ;
+   IF currenttoken=identtok
+   THEN
+      n := makekey(currentstring) ;
+      printf1('currenttoken = %a\n', n)
+   ELSE
+      CASE currenttoken OF
+
+      eoftok               : printf0('eoftok\n') |
+      startok              : printf0('*\n') |
+      arrowtok             : printf0('->\n') |
+      structtok            : printf0('struct\n') |
+      lsbratok             : printf0('[\n') |
+      rsbratok             : printf0(']\n') |
+      lcbratok             : printf0('{\n') |
+      rcbratok             : printf0('}\n') |
+      lparatok             : printf0('(\n') |
+      rparatok             : printf0(')\n') |
+      semicolontok         : printf0(';\n') |
+      longtok              : printf0('long\n') |
+      inttok               : printf0('int\n') |
+      chartok              : printf0('char\n') |
+      enumtok              : printf0('enum\n') |
+      typedeftok           : printf0('typedef\n') |
+      floattok             : printf0('float\n') |
+      doubletok            : printf0('double\n') |
+      unsignedtok          : printf0('unsigned\n') |
+      consttok             : printf0('const\n') |
+      periodperiodperiodtok: printf0('...\n') |
+      integertok           : printf0('integer number\n') |
+      hexintegertok        : printf0('hexadecimal number\n') |
+      octintegertok        : printf0('octal number\n') |
+      identtok             : printf0('identifier\n') |
+      realtok              : printf0('real number\n') |
+      conststringtok       : printf0('constant string\n') |
+      constchartok         : printf0('constant char\n') |
+      codetok              : printf0('some C code\n') |
+      starthashtok         : printf0('start#\n') |
+      endhashtok           : printf0('end#\n') |
+      definetok            : printf0('define\n') |
+      definedtok           : stop ; printf0('defined\n') |
+      undeftok             : printf0('undef\n') |
+      iftok                : printf0('if\n') |
+      elsetok              : printf0('else\n') |
+      endiftok             : printf0('endif\n') |
+      ifdeftok             : printf0('ifdef\n') |
+      ifndeftok            : printf0('ifndef\n') |
+      nottok               : printf0('not\n') |
+      includetok           : printf0('include\n') |
+      commatok             : printf0('comma\n') |
+      periodtok            : printf0('period\n') |
+      gretok               : printf0('gre\n') |
+      lesstok              : printf0('less\n') |
+      ortok                : printf0('or\n') |
+      andtok               : printf0('and\n') |
+      bartok               : printf0('bar\n') |
+      ambersandtok         : printf0('ambersand\n') |
+      shiftlefttok         : printf0('shiftleft\n') |
+      shiftrighttok        : printf0('shiftright\n') |
+      divtok               : printf0('div\n') |
+      modtok               : printf0('mod\n') |
+      sizeoftok            : printf0('sizeof\n') |
+      hattok               : printf0('hat\n') |
+      equaltok             : printf0('equal\n') |
+      notequaltok          : printf0('notequal\n') |
+      greequaltok          : printf0('greequal\n') |
+      lessequaltok         : printf0('lessequal\n') |
+      plustok              : printf0('plus\n') |
+      minustok             : printf0('minus\n') |
+      tildetok             : printf0('tilde\n') |
+      externtok            : printf0('extern\n') |
+      statictok            : printf0('static\n') |
+      autotok              : printf0('auto\n') |
+      registertok          : printf0('register\n') |
+      voidtok              : printf0('void\n') |
+      shorttok             : printf0('short\n') |
+      signedtok            : printf0('signed\n') |
+      uniontok             : printf0('union\n') |
+      colontok             : printf0('colon\n') |
+      becomestok           : printf0('becomes\n') |
+      volatiletok          : printf0('volatile\n') |
+      typetok              : printf0('type\n')
+
+      ELSE
+         cflex.CError(string(InitString('unrecognised token')))
+      END
+   END
+END DisplayToken ;
+
+
+(*
+   GetToken - gets the next token into currenttoken.
+*)
+
+PROCEDURE GetToken ;
+VAR
+   t: CARDINAL ;
+   b: TokenBucket ;
+   l: CARDINAL ;
+BEGIN
+   IF UseBufferedTokens
+   THEN
+      t := CurrentTokNo ;
+      b := FindTokenBucket(t) ;
+      WITH b^.buf[t] DO
+         currenttoken   := token ;
+         currentstring  := KeyToCharStar(str) ;
+         currentinteger := int ;
+         IF Debugging
+         THEN
+            l := line
+         END
+      END ;
+      IF Debugging
+      THEN
+         printf3('line %d (# %d  %d) ', l, t, CurrentTokNo) ;
+         DisplayToken
+      END ;
+      INC(CurrentTokNo)
+   ELSE
+      IF ListOfTokens.tail=NIL
+      THEN
+         cflex.AdvanceToken ;
+         IF ListOfTokens.tail=NIL
+         THEN
+            HALT
+         END
+      END ;
+
+      IF ListOfTokens.LastBucketOffset>CurrentTokNo
+      THEN
+         t := CurrentTokNo ;
+         b := FindTokenBucket(t) ;
+         WITH b^.buf[t] DO
+            currenttoken   := token ;
+            currentstring  := KeyToCharStar(str) ;
+            currentinteger := int ;
+            IF Debugging
+            THEN
+               l := line
+            END
+         END ;
+         INC(CurrentTokNo)
+      ELSE
+         WITH ListOfTokens.tail^ DO
+            IF CurrentTokNo-ListOfTokens.LastBucketOffset<len
+            THEN
+               WITH buf[CurrentTokNo-ListOfTokens.LastBucketOffset] DO
+                  currenttoken   := token ;
+                  currentstring  := KeyToCharStar(str) ;
+                  currentinteger := int
+               END ;
+               IF Debugging
+               THEN
+                  (* printf1('# %d ', CurrentTokNo) ; *)
+                  DisplayToken
+               END ;
+               INC(CurrentTokNo)
+            ELSE
+               cflex.AdvanceToken ;
+               GetToken ;
+               (* printf0('\n'); cflex.CError(string(InitString('current token'))) ; *)
+            END
+         END
+      END
+   END
+END GetToken ;
+
+
+(*
+   FlushTokens - removes the last token.
+*)
+
+PROCEDURE FlushTokens ;
+BEGIN
+   INC(CurrentTokNo)
+END FlushTokens ;
+
+
+(*
+   SyncOpenWithBuffer - synchronise the buffer with the start of a file.
+                        Skips all the tokens to do with the previous file.
+*)
+
+PROCEDURE SyncOpenWithBuffer ;
+BEGIN
+   IF ListOfTokens.tail#NIL
+   THEN
+      WITH ListOfTokens.tail^ DO
+         CurrentTokNo := ListOfTokens.LastBucketOffset+len
+      END
+   END
+END SyncOpenWithBuffer ;
+
+
+(*
+   InsertToken - inserts a symbol, token, infront of the current token
+                 ready for the next pass.
+*)
+
+PROCEDURE InsertToken (token: toktype) ;
+BEGIN
+   IF ListOfTokens.tail#NIL
+   THEN
+      WITH ListOfTokens.tail^ DO
+         IF len>0
+         THEN
+            buf[len-1].token := token
+         END
+      END ;
+      AddTokToList(currenttoken, NulName, 0, GetLineNo(), CurrentSource) ;
+      GetToken
+   END
+END InsertToken ;
+
+
+(*
+   InsertTokenAndRewind - inserts a symbol, token, infront of the current token
+                          and then moves the token stream back onto the inserted token.
+*)
+
+PROCEDURE InsertTokenAndRewind (token: toktype) ;
+BEGIN
+   IF ListOfTokens.tail#NIL
+   THEN
+      WITH ListOfTokens.tail^ DO
+         IF len>0
+         THEN
+            buf[len-1].token := token
+         END
+      END ;
+      AddTokToList(currenttoken, NulName, 0, GetLineNo(), CurrentSource) ;
+      currenttoken := token
+   END
+END InsertTokenAndRewind ;
+
+
+(*
+   GetLineNo - returns the current line number where the symbol occurs in
+               the source file.
+*)
+
+PROCEDURE GetLineNo () : CARDINAL ;
+BEGIN
+   IF CurrentTokNo=0
+   THEN
+      RETURN( 0 )
+   ELSE
+      RETURN( TokenToLineNo(GetTokenNo(), 0) )
+   END
+END GetLineNo ;
+
+
+(*
+   GetTokenNo - returns the current token number.
+*)
+
+PROCEDURE GetTokenNo () : CARDINAL ;
+BEGIN
+   IF CurrentTokNo=0
+   THEN
+      RETURN( 0 )
+   ELSE
+      RETURN( CurrentTokNo-1 )
+   END
+END GetTokenNo ;
+
+
+(*
+   FindTokenBucket - returns the TokenBucket corresponding to the TokenNo.
+*)
+
+PROCEDURE FindTokenBucket (VAR TokenNo: CARDINAL) : TokenBucket ;
+VAR
+   b: TokenBucket ;
+BEGIN
+   b := ListOfTokens.head ;
+   WHILE b#NIL DO
+      WITH b^ DO
+         IF TokenNo<len
+         THEN
+            RETURN( b )
+         ELSE
+            DEC(TokenNo, len)
+         END
+      END ;
+      b := b^.next
+   END ;
+   RETURN( NIL )
+END FindTokenBucket ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE TokenToLineNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+VAR
+   b: TokenBucket ;
+   l: SourceList ;
+BEGIN
+   b := FindTokenBucket(TokenNo) ;
+   IF b=NIL
+   THEN
+      RETURN( 0 )
+   ELSE
+      IF depth=0
+      THEN
+         RETURN( b^.buf[TokenNo].line )
+      ELSE
+         l := b^.buf[TokenNo].file^.left ;
+         WHILE depth>0 DO
+            l := l^.left ;
+            IF l=b^.buf[TokenNo].file^.left
+            THEN
+               RETURN( 0 )
+            END ;
+            DEC(depth)
+         END ;
+         RETURN( l^.line )
+      END
+   END
+END TokenToLineNo ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindFileNameFromToken (TokenNo: CARDINAL; depth: CARDINAL) : String ;
+VAR
+   b: TokenBucket ;
+   l: SourceList ;
+BEGIN
+   b := FindTokenBucket(TokenNo) ;
+   IF b=NIL
+   THEN
+      RETURN( NIL )
+   ELSE
+      l := b^.buf[TokenNo].file^.left ;
+      WHILE depth>0 DO
+         l := l^.left ;
+         IF l=b^.buf[TokenNo].file^.left
+         THEN
+            RETURN( NIL )
+         END ;
+         DEC(depth)
+      END ;
+      RETURN( l^.name )
+   END
+END FindFileNameFromToken ;
+
+
+(*
+   GetFileName - returns a String defining the current file.
+*)
+
+PROCEDURE GetFileName () : String ;
+BEGIN
+   RETURN( FindFileNameFromToken(GetTokenNo(), 0) )
+END GetFileName ;
+
+
+(*
+   AddTokToList - adds a token to a dynamic list.
+*)
+
+PROCEDURE AddTokToList (t: toktype; n: Name;
+                        i: INTEGER; l: CARDINAL; f: SourceList) ;
+BEGIN
+   IF ListOfTokens.head=NIL
+   THEN
+      NEW(ListOfTokens.head) ;
+      IF ListOfTokens.head=NIL
+      THEN
+         (* list error *)
+      END ;
+      ListOfTokens.tail := ListOfTokens.head ;
+      ListOfTokens.tail^.len := 0
+   ELSIF ListOfTokens.tail^.len=MaxBucketSize
+   THEN
+      Assert(ListOfTokens.tail^.next=NIL) ;
+      NEW(ListOfTokens.tail^.next) ;
+      IF ListOfTokens.tail^.next=NIL
+      THEN
+         (* list error *)
+      ELSE
+         ListOfTokens.tail := ListOfTokens.tail^.next ;
+         ListOfTokens.tail^.len := 0
+      END ;
+      INC(ListOfTokens.LastBucketOffset, MaxBucketSize)
+   END ;
+   WITH ListOfTokens.tail^ DO
+      next := NIL ;
+      WITH buf[len] DO
+         token := t ;
+         str   := n ;
+         int   := i ;
+         line  := l ;
+         file  := f
+      END ;
+      INC(len)
+   END
+END AddTokToList ;
+
+
+(*
+   IsLastTokenEof - returns TRUE if the last token was an eoftok
+*)
+
+PROCEDURE IsLastTokenEof () : BOOLEAN ;
+VAR
+   b: TokenBucket ;
+BEGIN
+   IF ListOfTokens.tail#NIL
+   THEN
+      IF ListOfTokens.tail^.len=0
+      THEN
+         b := ListOfTokens.head ;
+         IF b=ListOfTokens.tail
+         THEN
+            RETURN( FALSE )
+         END ;
+         WHILE b^.next#ListOfTokens.tail DO
+            b := b^.next
+         END ;
+      ELSE
+         b := ListOfTokens.tail
+      END ;
+      WITH b^ DO
+         RETURN( buf[len-1].token=eoftok )
+      END
+   END ;
+   RETURN( FALSE )
+END IsLastTokenEof ;
+
+
+(* ***********************************************************************
+ *
+ * These functions allow c.flex to deliver tokens into the buffer
+ *
+ ************************************************************************* *)
+
+(*
+   AddTok - adds a token to the buffer.
+*)
+
+PROCEDURE AddTok (t: toktype) ;
+BEGIN
+   IF NOT ((t=eoftok) AND IsLastTokenEof())
+   THEN
+      AddTokToList(t, NulName, 0, cflex.GetLineNo(), CurrentSource) ;
+      CurrentUsed := TRUE
+   END
+END AddTok ;
+
+
+(*
+   AddTokCharStar - adds a token to the buffer and an additional string, s.
+                    A copy of string, s, is made.
+*)
+
+PROCEDURE AddTokCharStar (t: toktype; s: ADDRESS) ;
+BEGIN
+   IF (t=identtok) AND PushMacroDefinition(makekey(s))
+   THEN
+      (* do nothing *)
+   ELSE
+      AddTokToList(t, makekey(s), 0, cflex.GetLineNo(), CurrentSource) ;
+      CurrentUsed := TRUE
+   END
+END AddTokCharStar ;
+
+
+(*
+   AddTokInteger - adds a token and an integer to the buffer.
+*)
+
+PROCEDURE AddTokInteger (t: toktype; i: INTEGER) ;
+VAR
+   s: String ;
+   lineno: CARDINAL ;
+BEGIN
+   lineno := cflex.GetLineNo() ;
+   s := Sprintf1(Mark(InitString('%d')), lineno) ;
+   AddTokToList(t, makekey(string(s)), i, lineno, CurrentSource) ;
+   s := KillString(s) ;
+   CurrentUsed := TRUE
+END AddTokInteger ;
+
+
+BEGIN
+   Init
+END CLexBuf.
diff --git a/gcc/m2/gm2-compiler/FifoQueue.def b/gcc/m2/gm2-compiler/FifoQueue.def
new file mode 100644
index 00000000000..4f6115178b1
--- /dev/null
+++ b/gcc/m2/gm2-compiler/FifoQueue.def
@@ -0,0 +1,103 @@
+(* FifoQueue.def provides a simple fifo queue.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE FifoQueue ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : FifoQueue
+   Date       : Tue Dec 12 16:23:22 GMT 1989
+   Description: FifoQueue provides a mechanism to and from which CARDINAL
+                numbers can be stored and retrieved from a FIFO queue.
+   Last update: Tue Dec 12 16:24:24 GMT 1989
+*)
+
+EXPORT QUALIFIED PutEnumerationIntoFifoQueue, GetEnumerationFromFifoQueue,
+                 PutSubrangeIntoFifoQueue, GetSubrangeFromFifoQueue,
+                 PutConstIntoFifoQueue, GetConstFromFifoQueue,
+                 PutConstructorIntoFifoQueue, GetConstructorFromFifoQueue ;
+
+
+(*
+   PutEnumerationIntoFifoQueue - places an enumeration symbol, c,
+                                 into a fifo queue.
+*)
+
+PROCEDURE PutEnumerationIntoFifoQueue (c: CARDINAL) ;
+
+
+(*
+   GetEnumerationFromFifoQueue - retrieves an enumeration symbol,
+                                 c, from a fifo queue.
+*)
+
+PROCEDURE GetEnumerationFromFifoQueue (VAR c: CARDINAL) ;
+
+
+(*
+   PutSubrangeIntoFifoQueue - places a subrange symbol into a fifo
+                              queue.
+*)
+
+PROCEDURE PutSubrangeIntoFifoQueue (c: CARDINAL) ;
+
+
+(*
+   GetSubrangeFromFifoQueue - retrieves a subrange symbol from a
+                              fifo queue.
+*)
+
+PROCEDURE GetSubrangeFromFifoQueue (VAR c: CARDINAL) ;
+
+
+(*
+   PutConstIntoFifoQueue - places a constant symbol
+                           into a fifo queue.
+*)
+
+PROCEDURE PutConstIntoFifoQueue (c: CARDINAL) ;
+
+
+(*
+   GetConstFromFifoQueue - retrieves a const symbol
+                           from a fifo queue.
+*)
+
+PROCEDURE GetConstFromFifoQueue (VAR c: CARDINAL) ;
+
+
+(*
+   PutConstructorIntoFifoQueue - places a constructor symbol
+                                 into a fifo queue.
+*)
+
+PROCEDURE PutConstructorIntoFifoQueue (c: CARDINAL) ;
+
+
+(*
+   GetConstructorFromFifoQueue - retrieves a constructor symbol
+                                 from a fifo queue.
+*)
+
+PROCEDURE GetConstructorFromFifoQueue (VAR c: CARDINAL) ;
+
+
+END FifoQueue.
diff --git a/gcc/m2/gm2-compiler/FifoQueue.mod b/gcc/m2/gm2-compiler/FifoQueue.mod
new file mode 100644
index 00000000000..31b0c7b2d8d
--- /dev/null
+++ b/gcc/m2/gm2-compiler/FifoQueue.mod
@@ -0,0 +1,170 @@
+(* FifoQueue.mod provides a simple fifo queue.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE FifoQueue ;
+
+FROM Lists IMPORT List, InitList, PutItemIntoList, GetItemFromList ;
+
+TYPE
+   Fifo = RECORD
+             Queue: List ;
+             Out  : CARDINAL ;
+          END ;
+
+VAR
+   const,
+   subrange,
+   enumeration,
+   constructor: Fifo ;
+
+
+(*
+   PutInto - places a CARDINAL number, c, into a fifo queue.
+*)
+
+PROCEDURE PutInto (VAR f: Fifo; c: CARDINAL) ;
+BEGIN
+   WITH f DO
+      PutItemIntoList(Queue, c)
+   END
+END PutInto ;
+
+
+(*
+   GetFrom - retrieves a CARDINAL number, c, from a fifo queue.
+*)
+
+PROCEDURE GetFrom (VAR f: Fifo; VAR c: CARDINAL) ;
+BEGIN
+   WITH f DO
+      INC(Out) ;
+      c := GetItemFromList(Queue, Out)
+   END
+END GetFrom ;
+
+
+(*
+   PutEnumerationIntoFifoQueue - places an enumeration symbol, c,
+                                 into a fifo queue.
+*)
+
+PROCEDURE PutEnumerationIntoFifoQueue (c: CARDINAL) ;
+BEGIN
+   PutInto(enumeration, c)
+END PutEnumerationIntoFifoQueue ;
+
+
+(*
+   GetEnumerationFromFifoQueue - retrieves an enumeration symbol,
+                                 c, from a fifo queue.
+*)
+
+PROCEDURE GetEnumerationFromFifoQueue (VAR c: CARDINAL) ;
+BEGIN
+   GetFrom(enumeration, c)
+END GetEnumerationFromFifoQueue ;
+
+
+(*
+   PutSubrangeIntoFifoQueue - places a subrange symbol into a fifo
+                              queue.
+*)
+
+PROCEDURE PutSubrangeIntoFifoQueue (c: CARDINAL) ;
+BEGIN
+   PutInto(subrange, c)
+END PutSubrangeIntoFifoQueue ;
+
+
+(*
+   GetSubrangeFromFifoQueue - retrieves a subrange symbol from a
+                              fifo queue.
+*)
+
+PROCEDURE GetSubrangeFromFifoQueue (VAR c: CARDINAL) ;
+BEGIN
+   GetFrom(subrange, c)
+END GetSubrangeFromFifoQueue ;
+
+
+(*
+   PutConstructorIntoFifoQueue - places a constructor symbol
+                                 into a fifo queue.
+*)
+
+PROCEDURE PutConstructorIntoFifoQueue (c: CARDINAL) ;
+BEGIN
+   PutInto(constructor, c)
+END PutConstructorIntoFifoQueue ;
+
+
+(*
+   GetConstructorFromFifoQueue - retrieves a constructor symbol
+                                 from a fifo queue.
+*)
+
+PROCEDURE GetConstructorFromFifoQueue (VAR c: CARDINAL) ;
+BEGIN
+   GetFrom(constructor, c)
+END GetConstructorFromFifoQueue ;
+
+
+(*
+   PutConstIntoFifoQueue - places a constant symbol
+                           into a fifo queue.
+*)
+
+PROCEDURE PutConstIntoFifoQueue (c: CARDINAL) ;
+BEGIN
+   PutInto(const, c)
+END PutConstIntoFifoQueue ;
+
+
+(*
+   GetConstFromFifoQueue - retrieves a const symbol
+                           from a fifo queue.
+*)
+
+PROCEDURE GetConstFromFifoQueue (VAR c: CARDINAL) ;
+BEGIN
+   GetFrom(const, c)
+END GetConstFromFifoQueue ;
+
+
+(*
+   Init - initialize the fifo queue.
+*)
+
+PROCEDURE Init (VAR f: Fifo) ;
+BEGIN
+   WITH f DO
+      InitList(Queue) ;
+      Out := 0
+   END
+END Init ;
+
+
+BEGIN
+   Init(const) ;
+   Init(enumeration) ;
+   Init(subrange) ;
+   Init(constructor)
+END FifoQueue.
diff --git a/gcc/m2/gm2-compiler/Lists.def b/gcc/m2/gm2-compiler/Lists.def
new file mode 100644
index 00000000000..a6022145557
--- /dev/null
+++ b/gcc/m2/gm2-compiler/Lists.def
@@ -0,0 +1,128 @@
+(* Lists.def provides an unordered list manipulation package.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE Lists ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : Lists
+   Date       : Tue Dec 12 20:53:36 EST 1989
+   SYSTEM     : UNIX (GNU Modula-2)
+   Description: Provides an unordered list manipulation package.
+   Last update: $Date: 2010/10/03 19:01:05 $
+   Version    : $Revision: 1.9 $
+*)
+
+FROM SYSTEM IMPORT WORD ;
+FROM SymbolKey IMPORT PerformOperation ;
+
+EXPORT QUALIFIED List,
+                 InitList, KillList, PutItemIntoList, GetItemFromList,
+                 GetIndexOfList,
+                 NoOfItemsInList, IsItemInList, IncludeItemIntoList,
+                 RemoveItemFromList, ForeachItemInListDo, DuplicateList ;
+
+TYPE
+   List ;
+
+
+(*
+   InitList - creates a new list, l.
+*)
+
+PROCEDURE InitList (VAR l: List) ;
+
+
+(*
+   KillList - deletes the complete list, l.
+*)
+
+PROCEDURE KillList (VAR l: List) ;
+
+
+(*
+   PutItemIntoList - places a CARDINAL, c, into list, l.
+*)
+
+PROCEDURE PutItemIntoList (l: List; c: WORD) ;
+
+
+(*
+   GetItemFromList - retrieves the nth WORD from list, l.
+*)
+
+PROCEDURE GetItemFromList (l: List; n: CARDINAL) : WORD ;
+
+
+(*
+   GetIndexOfList - returns the index for WORD, c, in list, l.
+                    If more than one CARDINAL, c, exists the index
+                    for the first is returned.
+*)
+
+PROCEDURE GetIndexOfList (l: List; c: WORD) : CARDINAL ;
+
+
+(*
+   NoOfItemsInList - returns the number of items in list, l.
+*)
+
+PROCEDURE NoOfItemsInList (l: List) : CARDINAL ;
+
+
+(*
+   IncludeItemIntoList - adds a WORD, c, into a list providing
+                         the value does not already exist.
+*)
+
+PROCEDURE IncludeItemIntoList (l: List; c: WORD) ;
+
+
+(*
+   RemoveItemFromList - removes a WORD, c, from a list.
+                        It assumes that this value only appears once.
+*)
+
+PROCEDURE RemoveItemFromList (l: List; c: WORD) ;
+
+
+(*
+   IsItemInList - returns true if a WORD, c, was found in list, l.
+*)
+
+PROCEDURE IsItemInList (l: List; c: WORD) : BOOLEAN ;
+
+
+(*
+   ForeachItemInListDo - calls procedure, P, foreach item in list, l.
+*)
+
+PROCEDURE ForeachItemInListDo (l: List; P: PerformOperation) ;
+
+
+(*
+   DuplicateList - returns a duplicate list derived from, l.
+*)
+
+PROCEDURE DuplicateList (l: List) : List ;
+
+
+END Lists.
diff --git a/gcc/m2/gm2-compiler/Lists.mod b/gcc/m2/gm2-compiler/Lists.mod
new file mode 100644
index 00000000000..c9b54b4ac61
--- /dev/null
+++ b/gcc/m2/gm2-compiler/Lists.mod
@@ -0,0 +1,341 @@
+(* Lists.mod provides an unordered list manipulation package.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE Lists ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+CONST
+   MaxNoOfElements = 5 ;
+
+TYPE
+   List = POINTER TO list ;
+   list = RECORD
+             NoOfElements: CARDINAL ;
+             Elements    : ARRAY [1..MaxNoOfElements] OF WORD ;
+             Next        : List ;
+          END ;
+
+(*
+   InitList - creates a new list, l.
+*)
+
+PROCEDURE InitList (VAR l: List) ;
+BEGIN
+   NEW (l) ;
+   WITH l^ DO
+      NoOfElements := 0 ;
+      Next := NIL
+   END
+END InitList ;
+
+
+(*
+   KillList - deletes the complete list, l.
+*)
+
+PROCEDURE KillList (VAR l: List) ;
+BEGIN
+   IF l#NIL
+   THEN
+      IF l^.Next#NIL
+      THEN
+         KillList(l^.Next)
+      END ;
+      DISPOSE(l)
+   END
+END KillList ;
+
+
+(*
+   PutItemIntoList - places a WORD, c, into list, l.
+*)
+
+PROCEDURE PutItemIntoList (l: List; c: WORD) ;
+BEGIN
+   WITH l^ DO
+      IF NoOfElements<MaxNoOfElements
+      THEN
+         INC(NoOfElements) ;
+         Elements[NoOfElements] := c
+      ELSIF Next#NIL
+      THEN
+         PutItemIntoList(Next, c)
+      ELSE
+         InitList(Next) ;
+         PutItemIntoList(Next, c)
+      END
+   END
+END PutItemIntoList ;
+
+
+(*
+   GetItemFromList - retrieves the nth WORD from list, l.
+                     (recursive solution).
+*)
+(*
+PROCEDURE GetItemFromList (l: List; n: CARDINAL) : WORD ;
+BEGIN
+   IF n>NoOfItemsInList(l)
+   THEN
+      RETURN( 0 )
+   ELSE
+      WITH l^ DO
+         IF n<=NoOfElements
+         THEN
+            RETURN( Elements[n] )
+         ELSE
+            RETURN( GetItemFromList( Next, n-NoOfElements ) )
+         END
+      END
+   END
+END GetItemFromList ;
+*)
+
+(* iterative solution *)
+PROCEDURE GetItemFromList (l: List; n: CARDINAL) : WORD ;
+BEGIN
+   WHILE l#NIL DO
+      WITH l^ DO
+         IF n<=NoOfElements
+         THEN
+            RETURN( Elements[n] )
+         ELSE
+            DEC(n, NoOfElements)
+         END
+      END ;
+      l := l^.Next
+   END ;
+   RETURN( 0 )
+END GetItemFromList ;
+
+
+(*
+   GetIndexOfList - returns the index for WORD, c, in list, l.
+                    If more than one WORD, c, exists the index
+                    for the first is returned.
+*)
+
+PROCEDURE GetIndexOfList (l: List; c: WORD) : CARDINAL ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN( 0 )
+   ELSE
+      WITH l^ DO
+         i := 1 ;
+         WHILE i<=NoOfElements DO
+            IF Elements[i]=c
+            THEN
+               RETURN( i )
+            ELSE
+               INC(i)
+            END
+         END ;
+         RETURN( NoOfElements+GetIndexOfList(Next, c) )
+      END
+   END
+END GetIndexOfList ;
+
+
+(*
+   NoOfItemsInList - returns the number of items in list, l.
+*)
+(*
+PROCEDURE NoOfItemsInList (l: List) : CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN( 0 )
+   ELSE
+      WITH l^ DO
+         RETURN( NoOfElements+NoOfItemsInList(Next) )
+      END
+   END
+END NoOfItemsInList ;
+*)
+
+
+(*
+   NoOfItemsInList - returns the number of items in list, l.
+                     (iterative algorithm of the above).
+*)
+
+PROCEDURE NoOfItemsInList (l: List) : CARDINAL ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN( 0 )
+   ELSE
+      t := 0 ;
+      REPEAT
+         WITH l^ DO
+            INC(t, NoOfElements)
+         END ;
+         l := l^.Next
+      UNTIL l=NIL;
+      RETURN( t )
+   END
+END NoOfItemsInList ;
+
+
+(*
+   IncludeItemIntoList - adds a WORD, c, into a list providing
+                         the value does not already exist.
+*)
+
+PROCEDURE IncludeItemIntoList (l: List; c: WORD) ;
+BEGIN
+   IF NOT IsItemInList(l, c)
+   THEN
+      PutItemIntoList(l, c)
+   END
+END IncludeItemIntoList ;
+
+
+(*
+   RemoveItem - remove an element at index, i, from the list data type.
+*)
+
+PROCEDURE RemoveItem (p, l: List; i: CARDINAL) ;
+BEGIN
+   WITH l^ DO
+      DEC(NoOfElements) ;
+      WHILE i<=NoOfElements DO
+         Elements[i] := Elements[i+1] ;
+         INC(i)
+      END ;
+      IF (NoOfElements=0) AND (p#NIL)
+      THEN
+         p^.Next := l^.Next ;
+         DISPOSE(l)
+      END
+   END
+END RemoveItem ;
+
+
+(*
+   RemoveItemFromList - removes a WORD, c, from a list.
+                        It assumes that this value only appears once.
+*)
+
+PROCEDURE RemoveItemFromList (l: List; c: WORD) ;
+VAR
+   p    : List ;
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   IF l#NIL
+   THEN
+      Found := FALSE ;
+      p := NIL ;
+      REPEAT
+         WITH l^ DO
+            i := 1 ;
+            WHILE (i<=NoOfElements) AND (Elements[i]#c) DO
+               INC(i)
+            END ;
+         END ;
+         IF (i<=l^.NoOfElements) AND (l^.Elements[i]=c)
+         THEN
+            Found := TRUE
+         ELSE
+            p := l ;
+            l := l^.Next
+         END
+      UNTIL (l=NIL) OR Found ;
+      IF Found
+      THEN
+         RemoveItem(p, l, i)
+      END
+   END
+END RemoveItemFromList ;
+
+
+(*
+   IsItemInList - returns true if a WORD, c, was found in list, l.
+*)
+
+PROCEDURE IsItemInList (l: List; c: WORD) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   REPEAT
+      WITH l^ DO
+         i := 1 ;
+         WHILE (i<=NoOfElements) DO
+            IF Elements[i]=c
+            THEN
+               RETURN( TRUE )
+            ELSE
+               INC(i)
+            END
+         END
+      END ;
+      l := l^.Next
+   UNTIL l=NIL ;
+   RETURN( FALSE )
+END IsItemInList ;
+
+
+(*
+   ForeachItemInListDo - calls procedure, P, foreach item in list, l.
+*)
+
+PROCEDURE ForeachItemInListDo (l: List; P: PerformOperation) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   n := NoOfItemsInList(l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      P(GetItemFromList(l, i)) ;
+      INC(i)
+   END
+END ForeachItemInListDo ;
+
+
+(*
+   DuplicateList - returns a duplicate list derived from, l.
+*)
+
+PROCEDURE DuplicateList (l: List) : List ;
+VAR
+   m   : List ;
+   n, i: CARDINAL ;
+BEGIN
+   InitList(m) ;
+   n := NoOfItemsInList(l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      PutItemIntoList(m, GetItemFromList(l, i)) ;
+      INC(i)
+   END ;
+   RETURN( m )
+END DuplicateList ;
+
+
+END Lists.
diff --git a/gcc/m2/gm2-compiler/M2ALU.def b/gcc/m2/gm2-compiler/M2ALU.def
new file mode 100644
index 00000000000..c4369e9994f
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2ALU.def
@@ -0,0 +1,989 @@
+(* M2ALU.def gcc implementation of the M2ALU module.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2ALU ;
+
+(*
+    Title      : M2ALU.def
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Tue Jul 11 09:14:28 2000
+    Description: Handles all values in the Modula-2 compiler and all
+                 manipulations of values. All values are mapped onto
+                 gcc trees.
+*)
+
+FROM NameKey IMPORT Name ;
+FROM m2tree IMPORT Tree ;
+FROM M2GCCDeclare IMPORT WalkAction, IsAction ;
+
+EXPORT QUALIFIED PtrToValue,
+                 InitValue,
+                 IsValueTypeNone,
+                 IsValueTypeInteger,
+                 IsValueTypeReal,
+                 IsValueTypeComplex,
+                 IsValueTypeSet,
+                 IsValueTypeConstructor,
+                 IsValueTypeArray,
+                 IsValueTypeRecord,
+                 PopInto, PushFrom,
+                 PushIntegerTree, PopIntegerTree,
+                 PushSetTree, PopSetTree,
+                 PushRealTree, PopRealTree,
+                 PushComplexTree, PopComplexTree,
+                 PopConstructorTree,
+                 PushCard,
+                 PushInt,
+                 PushChar,
+                 PushString,
+                 PushTypeOfTree,
+                 CoerseLongRealToCard,
+                 ConvertRealToInt,
+                 ConvertToInt,
+                 ConvertToType,
+                 GetSetValueType,
+                 IsSolved, IsValueConst,
+                 PutConstructorSolved, EvaluateValue, TryEvaluateValue,
+
+                 IsNulSet, IsGenericNulSet, PushNulSet, AddBitRange, AddBit, SubBit,
+      	       	 SetOr, SetAnd, SetIn,
+                 SetDifference, SetSymmetricDifference,
+                 SetNegate, SetShift, SetRotate,
+
+                 Addn, Multn, Sub,
+                 DivFloor, ModFloor, DivTrunc, ModTrunc,
+                 Equ, NotEqu, Less, Gre, LessEqu, GreEqu,
+                 GetValue, GetRange,  ConstructSetConstant, BuildRange,
+                 IsConstructorDependants, WalkConstructorDependants,
+                 AddField, AddElements,
+
+                 PushEmptyConstructor, PushEmptyArray, PushEmptyRecord,
+                 ChangeToConstructor,
+
+                 IsValueAndTreeKnown, CheckOrResetOverflow ;
+
+TYPE
+   PtrToValue ;
+
+
+(*
+   InitValue - initializes and returns a value container.
+*)
+
+PROCEDURE InitValue () : PtrToValue ;
+
+
+(*
+   IsValueTypeNone - returns TRUE if the value on the top stack has no value.
+*)
+
+PROCEDURE IsValueTypeNone () : BOOLEAN ;
+
+
+(*
+   IsValueTypeInteger - returns TRUE if the value on the top stack is an integer.
+*)
+
+PROCEDURE IsValueTypeInteger () : BOOLEAN ;
+
+
+(*
+   IsValueTypeReal - returns TRUE if the value on the top stack is a real.
+*)
+
+PROCEDURE IsValueTypeReal () : BOOLEAN ;
+
+
+(*
+   IsValueTypeComplex - returns TRUE if the value on the top stack is a complex.
+*)
+
+PROCEDURE IsValueTypeComplex () : BOOLEAN ;
+
+
+(*
+   IsValueTypeSet - returns TRUE if the value on the top stack is a set.
+*)
+
+PROCEDURE IsValueTypeSet () : BOOLEAN ;
+
+
+(*
+   IsValueTypeConstructor - returns TRUE if the value on the top
+                            stack is a constructor.
+*)
+
+PROCEDURE IsValueTypeConstructor () : BOOLEAN ;
+
+
+(*
+   IsValueTypeArray - returns TRUE if the value on the top
+                      stack is an array.
+*)
+
+PROCEDURE IsValueTypeArray () : BOOLEAN ;
+
+
+(*
+   IsValueTypeRecord - returns TRUE if the value on the top
+                       stack is a record.
+*)
+
+PROCEDURE IsValueTypeRecord () : BOOLEAN ;
+
+
+(*
+   GetSetValueType - returns the set type on top of the ALU stack.
+*)
+
+PROCEDURE GetSetValueType () : CARDINAL ;
+
+
+(*
+   PushIntegerTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushIntegerTree (t: Tree) ;
+
+
+(*
+   PopIntegerTree - pops a gcc tree value from the ALU stack.
+*)
+
+PROCEDURE PopIntegerTree () : Tree ;
+
+
+(*
+   PushRealTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushRealTree (t: Tree) ;
+
+
+(*
+   PopRealTree - pops a gcc tree value from the ALU stack.
+*)
+
+PROCEDURE PopRealTree () : Tree ;
+
+
+(*
+   PushComplexTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushComplexTree (t: Tree) ;
+
+
+(*
+   PopComplexTree - pops a gcc tree value from the ALU stack.
+*)
+
+PROCEDURE PopComplexTree () : Tree ;
+
+
+(*
+   PushSetTree - pushes a gcc tree onto the ALU stack.
+                 The tree, t, is expected to contain a
+                 word value. It is converted into a set
+                 type (sym). Bit 0 maps onto MIN(sym).
+*)
+
+PROCEDURE PushSetTree (tokenno: CARDINAL;
+                       t: Tree; sym: CARDINAL) ;
+
+
+(*
+   PopSetTree - pops a gcc tree from the ALU stack.
+*)
+
+PROCEDURE PopSetTree (tokenno: CARDINAL) : Tree ;
+
+
+(*
+   PopConstructorTree - returns a tree containing the compound literal.
+*)
+
+PROCEDURE PopConstructorTree (tokenno: CARDINAL) : Tree ;
+
+
+(*
+   PushFrom - pushes a copy of the contents of, v, onto stack.
+*)
+
+PROCEDURE PushFrom (v: PtrToValue) ;
+
+
+(*
+   PopInto - pops the top element from the stack and places it into, v.
+*)
+
+PROCEDURE PopInto (v: PtrToValue) ;
+
+
+(*
+   PushCard - pushes a cardinal onto the stack.
+*)
+
+PROCEDURE PushCard (c: CARDINAL) ;
+
+
+(*
+   PushInt - pushes an integer onto the stack.
+*)
+
+PROCEDURE PushInt (i: INTEGER) ;
+
+
+(*
+   PushChar - pushes a char onto the stack.
+*)
+
+PROCEDURE PushChar (c: CHAR) ;
+
+
+(*
+   PushString - pushes the numerical value of the string onto the stack.
+*)
+
+PROCEDURE PushString (tokenno: CARDINAL; s: Name) ;
+
+
+(*
+   CoerseLongRealToCard - performs a coersion between a REAL to a CARDINAL
+*)
+
+PROCEDURE CoerseLongRealToCard ;
+
+
+(*
+   ConvertRealToInt - converts a REAL into an INTEGER
+*)
+
+PROCEDURE ConvertRealToInt ;
+
+
+(*
+   ConvertToInt - converts the value into an INTEGER. This should be used
+                  if we are computing the number of elements in a char set to
+                  avoid an overflow.
+*)
+
+PROCEDURE ConvertToInt ;
+
+
+(*
+   ConvertToType - converts the top of stack to type, t.
+*)
+
+PROCEDURE ConvertToType (t: CARDINAL) ;
+
+
+(*
+   IsSolved - returns true if the memory cell indicated by v
+              has a known value.
+*)
+
+PROCEDURE IsSolved (v: PtrToValue) : BOOLEAN ;
+
+
+(*
+   PutConstructorSolved - records that this constructor is solved.
+*)
+
+PROCEDURE PutConstructorSolved (sym: CARDINAL) ;
+
+
+(*
+   EvaluateValue - attempts to evaluate the symbol, sym, value.
+*)
+
+PROCEDURE EvaluateValue (sym: CARDINAL) ;
+
+
+(*
+   TryEvaluateValue - attempts to evaluate the symbol, sym, value.
+*)
+
+PROCEDURE TryEvaluateValue (sym: CARDINAL) ;
+
+
+(*
+   Add - adds the top two elements on the stack.
+
+         The Stack:
+
+         Entry             Exit
+
+  Ptr ->
+         +------------+
+         | Op1        |                   <- Ptr
+         |------------|    +------------+
+         | Op2        |    | Op2 + Op1  |
+         |------------|    |------------|
+*)
+
+PROCEDURE Addn ;
+
+
+(*
+   Sub - subtracts the top two elements on the stack.
+
+         The Stack:
+
+         Entry             Exit
+
+  Ptr ->
+         +------------+
+         | Op1        |                   <- Ptr
+         |------------|    +------------+
+         | Op2        |    | Op2 - Op1  |
+         |------------|    |------------|
+*)
+
+PROCEDURE Sub ;
+
+
+(*
+   Mult - multiplies the top two elements on the stack.
+
+          The Stack:
+
+          Entry             Exit
+
+   Ptr ->
+          +------------+
+          | Op1        |                   <- Ptr
+          |------------|    +------------+
+          | Op2        |    | Op2 * Op1  |
+          |------------|    |------------|
+*)
+
+PROCEDURE Multn ;
+
+
+(*
+   DivFloor - divides the top two elements on the stack.
+
+              The Stack:
+
+              Entry             Exit
+
+       Ptr ->
+              +------------+
+              | Op1        |                     <- Ptr
+              |------------|    +--------------+
+              | Op2        |    | Op2 DIV Op1  |
+              |------------|    |--------------|
+*)
+
+PROCEDURE DivFloor ;
+
+
+(*
+   ModFloor - modulus of the top two elements on the stack.
+
+              The Stack:
+
+              Entry             Exit
+
+       Ptr ->
+              +------------+
+              | Op1        |                     <- Ptr
+              |------------|    +--------------+
+              | Op2        |    | Op2 MOD Op1  |
+              |------------|    |--------------|
+*)
+
+PROCEDURE ModFloor ;
+
+
+(*
+   DivTrunc - divides the top two elements on the stack.
+
+              The Stack:
+
+              Entry             Exit
+
+       Ptr ->
+              +------------+
+              | Op1        |                     <- Ptr
+              |------------|    +--------------+
+              | Op2        |    | Op2 DIV Op1  |
+              |------------|    |--------------|
+*)
+
+PROCEDURE DivTrunc ;
+
+
+(*
+   ModTrunc - modulus of the top two elements on the stack.
+
+              The Stack:
+
+              Entry             Exit
+
+       Ptr ->
+              +------------+
+              | Op1        |                     <- Ptr
+              |------------|    +--------------+
+              | Op2        |    | Op2 MOD Op1  |
+              |------------|    |--------------|
+*)
+
+PROCEDURE ModTrunc ;
+
+
+(*
+   Equ - returns true if the top two elements on the stack
+         are identical.
+
+         The Stack:
+
+         Entry             Exit
+
+  Ptr ->
+         +------------+
+         | Op1        |
+         |------------|
+         | Op2        |
+         |------------|    Empty
+
+         RETURN( Op2 = Op1 )
+*)
+
+PROCEDURE Equ (tokenno: CARDINAL) : BOOLEAN ;
+
+
+(*
+   NotEqu - returns true if the top two elements on the stack
+            are not identical.
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Op1        |
+            |------------|
+            | Op2        |
+            |------------|    Empty
+
+            RETURN( Op2 # Op1 )
+*)
+
+PROCEDURE NotEqu (tokenno: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Less - returns true if Op2 < Op1.
+
+          The Stack:
+
+          Entry             Exit
+
+   Ptr ->
+          +------------+
+          | Op1        |
+          |------------|
+          | Op2        |
+          |------------|    Empty
+
+          RETURN( Op2 < Op1 )
+*)
+
+PROCEDURE Less (tokenno: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Gre - returns true if Op2 > Op1
+
+         The Stack:
+
+         Entry             Exit
+
+  Ptr ->
+         +------------+
+         | Op1        |
+         |------------|
+         | Op2        |
+         |------------|    Empty
+
+         RETURN( Op2 > Op1 )
+*)
+
+PROCEDURE Gre (tokenno: CARDINAL) : BOOLEAN ;
+
+
+(*
+   LessEqu - returns true if Op2 <= Op1
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Op1        |
+            |------------|
+            | Op2        |
+            |------------|    Empty
+
+            RETURN( Op2 <= Op1 )
+*)
+
+PROCEDURE LessEqu (tokenno: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GreEqu - returns true if Op2 >= Op1
+            are not identical.
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Op1        |
+            |------------|
+            | Op2        |
+            |------------|    Empty
+
+            RETURN( Op2 >= Op1 )
+*)
+
+PROCEDURE GreEqu (tokenno: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsNulSet - returns TRUE if the top element is the nul set constant, {}.
+*)
+
+PROCEDURE IsNulSet () : BOOLEAN ;
+
+
+(*
+   IsGenericNulSet - returns TRUE if the top element is the generic nul set constant, {}.
+*)
+
+PROCEDURE IsGenericNulSet () : BOOLEAN ;
+
+
+(*
+   PushNulSet - pushes an empty set {} onto the ALU stack. The subrange type used
+                to construct the set is defined by, type. If this is NulSym then
+                the set is generic and compatible with all sets.
+
+                The Stack:
+
+                Entry             Exit
+
+                                                 <- Ptr
+                                  +------------+
+                                  | {}         |
+                Ptr ->            |------------|
+
+*)
+
+PROCEDURE PushNulSet (settype: CARDINAL) ;
+
+
+(*
+   AddBitRange - adds the range op1..op2 to the underlying set.
+
+                 Ptr ->
+                                                           <- Ptr
+                        +------------+      +------------+
+                        | Set        |      | Set        |
+                        |------------|      |------------|
+*)
+
+PROCEDURE AddBitRange (tokenno: CARDINAL; op1, op2: CARDINAL) ;
+
+
+(*
+   AddBit - adds the bit op1 to the underlying set. INCL(Set, op1)
+
+            Ptr ->
+                                                      <- Ptr
+                   +------------+      +------------+
+                   | Set        |      | Set        |
+                   |------------|      |------------|
+*)
+
+PROCEDURE AddBit (tokenno: CARDINAL; op1: CARDINAL) ;
+
+
+(*
+   SubBit - removes a bit op1 from the underlying set. EXCL(Set, Op1)
+
+            Ptr ->
+                   +------------+
+                   | Op1        |                     <- Ptr
+                   |------------|      +------------+
+                   | Set        |      | Set        |
+                   |------------|      |------------|
+*)
+
+PROCEDURE SubBit (tokenno: CARDINAL; op1: CARDINAL) ;
+
+
+(*
+   SetIn - returns true if the Op1 IN Set
+
+           The Stack:
+
+           Entry             Exit
+
+    Ptr ->
+           +------------+
+           | Set        |
+           |------------|
+           | Op1        |
+           |------------|    Empty
+
+           RETURN( Op1 IN Set )
+*)
+
+PROCEDURE SetIn (tokenno: CARDINAL; Op1: CARDINAL) : BOOLEAN ;
+
+
+(*
+   SetOr -  performs an inclusive OR of the top two sets on the stack.
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Op1        |                   <- Ptr
+            |------------|    +------------+
+            | Op2        |    | Op2 + Op1  |
+            |------------|    |------------|
+
+*)
+
+PROCEDURE SetOr (tokenno: CARDINAL) ;
+
+
+(*
+   SetAnd - performs a set AND the top two sets on the stack.
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Op1        |                   <- Ptr
+            |------------|    +------------+
+            | Op2        |    | Op2 * Op1  |
+            |------------|    |------------|
+*)
+
+PROCEDURE SetAnd (tokenno: CARDINAL) ;
+
+
+(*
+   SetDifference - performs a set difference of the top two elements on the stack.
+                   For each member in the set
+                      if member in Op2 and not member in Op1
+
+                   The Stack:
+
+                   Entry             Exit
+
+            Ptr ->
+                   +------------+
+                   | Op1        |                   <- Ptr
+                   |------------|    +-------------------+
+                   | Op2        |    | Op2 and (not Op1) |
+                   |------------|    |-------------------|
+*)
+
+PROCEDURE SetDifference (tokenno: CARDINAL) ;
+
+
+(*
+   SetSymmetricDifference - performs a set difference of the top two sets on the stack.
+
+                            The Stack:
+
+                            Entry             Exit
+
+                     Ptr ->
+                            +------------+
+                            | Op1        |                   <- Ptr
+                            |------------|    +------------+
+                            | Op2        |    | Op2 - Op1  |
+                            |------------|    |------------|
+*)
+
+PROCEDURE SetSymmetricDifference (tokenno: CARDINAL) ;
+
+
+(*
+   SetNegate - negates the top set on the stack.
+
+               Ptr ->                                               <- Ptr
+                      +-----------+                  +------------+
+                      | Set       |                  | Set        |
+                      |-----------|                  |------------|
+*)
+
+PROCEDURE SetNegate (tokenno: CARDINAL) ;
+
+
+(*
+   SetShift - if op1 is positive
+              then
+                 result := op2 << op1
+              else
+                 result := op2 >> op1
+              fi
+
+
+              The Stack:
+
+                     Entry             Exit
+
+              Ptr ->
+                     +------------+
+                     | Op1        |                   <- Ptr
+                     |------------|    +------------+
+                     | Op2        |    | result     |
+                     |------------|    |------------|
+
+*)
+
+PROCEDURE SetShift (tokenno: CARDINAL) ;
+
+
+(*
+   SetRotate - if op1 is positive
+               then
+                  result := ROTATERIGHT(op2, op1)
+               else
+                  result := ROTATELEFT(op2, op1)
+               fi
+
+
+               The Stack:
+
+                      Entry             Exit
+
+               Ptr ->
+                      +------------+
+                      | Op1        |                   <- Ptr
+                      |------------|    +------------+
+                      | Op2        |    | result     |
+                      |------------|    |------------|
+*)
+
+PROCEDURE SetRotate (tokenno: CARDINAL) ;
+
+
+(*
+   GetValue - returns and pops the value from the top of stack.
+*)
+
+PROCEDURE GetValue (tokenno: CARDINAL) : PtrToValue ;
+
+
+(*
+   GetRange - returns TRUE if range number, n, exists in the value, v.
+              A non empty set is defined by having 1..N ranges
+*)
+
+PROCEDURE GetRange (v: PtrToValue; n: CARDINAL; VAR low, high: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ConstructSetConstant - builds a struct of integers which represents the
+                          set const, sym.
+*)
+
+PROCEDURE ConstructSetConstant (tokenno: CARDINAL; v: PtrToValue) : Tree ;
+
+
+(*
+   BuildRange - returns a integer sized constant which represents the
+                value  {e1..e2}.
+*)
+
+PROCEDURE BuildRange (tokenno: CARDINAL; e1, e2: Tree) : Tree ;
+
+
+(*
+   IsConstructorDependants - return TRUE if returned if all
+                             q(dependants) of, sym, return TRUE.
+*)
+
+PROCEDURE IsConstructorDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+
+
+(*
+   WalkConstructorDependants - walk the constructor, sym, calling
+                               p for each dependant.
+*)
+
+PROCEDURE WalkConstructorDependants (sym: CARDINAL; p: WalkAction) ;
+
+
+(*
+   IsValueAndTreeKnown - returns TRUE if the value is known and the gcc tree
+                         is defined.
+
+                         The Stack:
+
+                                Entry             Exit
+
+                         Ptr ->
+                                +------------+
+                                | Op1        |                   <- Ptr
+                                |------------|    +------------+
+*)
+
+PROCEDURE IsValueAndTreeKnown () : BOOLEAN ;
+
+
+(*
+   CheckOrResetOverflow - tests to see whether the tree, t, has caused
+                          an overflow error and if so it generates an
+                          error message.
+*)
+
+PROCEDURE CheckOrResetOverflow (tokenno: CARDINAL; t: Tree; check: BOOLEAN) ;
+
+
+(*
+   AddElements - adds the elements, el BY, n, to the array constant.
+
+                 Ptr ->
+                                                           <- Ptr
+                        +------------+      +------------+
+                        | Array      |      | Array      |
+                        |------------|      |------------|
+
+*)
+
+PROCEDURE AddElements (tokenno: CARDINAL; el, n: CARDINAL) ;
+
+
+(*
+   AddField - adds the field op1 to the underlying constructor.
+
+              Ptr ->
+                                                        <- Ptr
+                     +------------+      +------------+
+                     | const      |      | const      |
+                     |------------|      |------------|
+
+*)
+
+PROCEDURE AddField (tokenno: CARDINAL; op1: CARDINAL) ;
+
+
+(*
+   PushEmptyConstructor - pushes an empty constructor {} onto the ALU stack.
+                          This is expected to be filled in by subsequent
+                          calls to AddElements, AddRange or AddField.
+
+                          The Stack:
+
+                          Entry             Exit
+
+                                                       <- Ptr
+                                        +------------+
+                                        | {}         |
+                   Ptr ->               |------------|
+
+*)
+
+PROCEDURE PushEmptyConstructor (constype: CARDINAL) ;
+
+
+(*
+   PushEmptyArray - pushes an empty array {} onto the ALU stack.
+                    This is expected to be filled in by subsequent
+                    calls to AddElements.
+
+                    The Stack:
+
+                    Entry             Exit
+
+                                                     <- Ptr
+                                      +------------+
+                                      | {}         |
+             Ptr ->                   |------------|
+
+*)
+
+PROCEDURE PushEmptyArray (arraytype: CARDINAL) ;
+
+
+(*
+   PushEmptyRecord - pushes an empty record {} onto the ALU stack.
+                     This is expected to be filled in by subsequent
+                     calls to AddField.
+
+                     The Stack:
+
+                     Entry             Exit
+
+                                                      <- Ptr
+                                       +------------+
+                                       | {}         |
+              Ptr ->                   |------------|
+
+*)
+
+PROCEDURE PushEmptyRecord (recordtype: CARDINAL) ;
+
+
+(*
+   ChangeToConstructor - change the top of stack value to a constructor, type.
+*)
+
+PROCEDURE ChangeToConstructor (tokenno: CARDINAL; constype: CARDINAL) ;
+
+
+(*
+   IsValueConst - returns true if the memory cell indicated by v
+                  is only defined by constants.  For example
+                  no variables are used in the constructor.
+*)
+
+PROCEDURE IsValueConst (v: PtrToValue) : BOOLEAN ;
+
+
+(*
+   PushTypeOfTree - pushes tree, gcc, to the stack and records the
+                    front end type.
+*)
+
+PROCEDURE PushTypeOfTree (sym: CARDINAL; gcc: Tree) ;
+
+
+END M2ALU.
diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod
new file mode 100644
index 00000000000..8d33b347760
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2ALU.mod
@@ -0,0 +1,5282 @@
+(* M2ALU.mod gcc implementation of the M2ALU module.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2ALU ;
+
+(*
+    Title      : M2ALU.mod
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Mon Jul 10 12:04:50 2000
+    Description: gcc implementation of the M2ALU module, this module provides an interface
+                 between some of the Modula-2 front end optimization routines and tree
+                 construction required so that efficient trees can be passed to gcc's
+                 backend. M2ALU allows constant expressions to be calculated.
+*)
+
+FROM ASCII IMPORT nul ;
+FROM SYSTEM IMPORT WORD ;
+FROM NameKey IMPORT KeyToCharStar, MakeKey, CharKey ;
+FROM M2Error IMPORT InternalError, FlushErrors ;
+FROM M2Debug IMPORT Assert ;
+FROM Storage IMPORT ALLOCATE ;
+FROM StringConvert IMPORT ostoi, bstoi, stoi, hstoi ;
+FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax, CompletelyResolved, DeclareConstant ;
+FROM M2GenGCC IMPORT DoCopyString, StringToChar ;
+FROM M2Bitset IMPORT Bitset ;
+FROM SymbolConversion IMPORT Mod2Gcc, GccKnowsAbout ;
+FROM M2Printf IMPORT printf0, printf2 ;
+FROM M2Base IMPORT MixTypes, GetBaseTypeMinMax, Char, IsRealType, IsComplexType, ZType ;
+FROM DynamicStrings IMPORT String, InitString, Mark, ConCat, Slice, InitStringCharStar, KillString, InitStringChar, string ;
+FROM M2LexBuf IMPORT TokenToLineNo, FindFileNameFromToken, TokenToLocation ;
+FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaErrorStringT0,
+                        MetaErrorT0, MetaErrorT1, MetaErrorT2,  MetaErrorT3 ;
+
+FROM SymbolTable IMPORT NulSym, IsEnumeration, IsSubrange, IsValueSolved, PushValue,
+                        ForeachFieldEnumerationDo, MakeTemporary, PutVar, PopValue, GetType,
+                        MakeConstLit, GetArraySubscript,
+                        IsSet, SkipType, IsRecord, IsArray, IsConst, IsConstructor,
+                        IsConstString, SkipTypeAndSubrange, GetDeclaredMod,
+                        GetSubrange, GetSymName, GetNth, GetString, GetStringLength,
+                        ModeOfAddr ;
+
+IMPORT DynamicStrings ;
+
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t, UnknownLocation ;
+
+FROM m2expr IMPORT BuildAdd, BuildSub, BuildMult,
+                   BuildDivTrunc, BuildModTrunc, BuildDivFloor, BuildModFloor,
+                   BuildLSL, BuildLSR,
+                   BuildLogicalOr, BuildLogicalAnd, BuildSymmetricDifference,
+                   GetWordOne, GetCardinalZero, TreeOverflow, RemoveOverflow ;
+
+FROM m2decl IMPORT GetBitsPerBitset, BuildIntegerConstant, BuildConstLiteralNumber ;
+FROM m2misc IMPORT DebugTree ;
+
+FROM m2type IMPORT RealToTree, Constructor, GetIntegerType, GetLongRealType,
+                   BuildStartSetConstructor, BuildSetConstructorElement, BuildEndSetConstructor,
+                   BuildRecordConstructorElement, BuildEndRecordConstructor, BuildStartRecordConstructor,
+                   BuildNumberOfArrayElements, BuildCharConstant, BuildCharConstantChar,
+                   BuildArrayConstructorElement, BuildStartArrayConstructor, BuildEndArrayConstructor,
+                   GetM2CharType ;
+
+FROM m2convert IMPORT ConvertConstantAndCheck, ToWord, ToInteger, ToCardinal, ToBitset ;
+FROM m2block IMPORT RememberConstant ;
+
+FROM m2expr IMPORT GetPointerZero, GetIntegerZero, GetIntegerOne,
+                   CompareTrees, FoldAndStrip, AreRealOrComplexConstantsEqual, AreConstantsEqual ;
+
+
+TYPE
+   cellType   = (none, integer, real, complex, set, constructor, array, record) ;
+
+
+CONST
+   Debugging    = FALSE ;
+   DebugGarbage =  TRUE ;
+
+TYPE
+   listOfRange = POINTER TO rList ;
+   rList       = RECORD
+                    low, high: CARDINAL ;  (* symbol table *)
+                    next     : listOfRange ;
+                 END ;
+
+   listOfFields = POINTER TO fList ;
+   fList        = RECORD
+                     field   : CARDINAL ;  (* symbol table *)
+                     next    : listOfFields ;
+                  END ;
+
+   listOfElements = POINTER TO eList ;
+   eList          = RECORD
+                       element : CARDINAL ;  (* symbol table *)
+                       by      : CARDINAL ;  (* symbol table *)
+                       next    : listOfElements ;
+                    END ;
+
+   PtrToValue = POINTER TO cell ;
+   cell       = RECORD
+                   location       : location_t ;
+                   areAllConstants,
+                   solved         : BOOLEAN ;
+                   constructorType: CARDINAL ;
+                   next           : PtrToValue ;
+                   numberValue    : Tree ;
+
+                   CASE type: cellType OF
+
+                   none,
+                   integer, real,
+                   complex      : |
+                   set          : setValue   : listOfRange |
+                   constructor,
+                   record       : fieldValues: listOfFields |
+                   array        : arrayValues: listOfElements
+
+                   END
+                END ;
+
+   DoSetProcedure = PROCEDURE (CARDINAL, listOfRange, listOfRange) : listOfRange ;
+
+
+VAR
+   ElementFreeList : listOfElements ;
+   FieldFreeList   : listOfFields ;
+   RangeFreeList   : listOfRange ;
+   FreeList,
+   TopOfStack      : PtrToValue ;
+   EnumerationValue: Tree ;
+   EnumerationField: CARDINAL ;
+   CurrentTokenNo  : CARDINAL ;
+   (* WatchedValue    : PtrToValue ;  *)
+
+
+(*
+   New - allocate a PtrToValue. Firstly check the FreeList, if empty call upon New.
+*)
+
+PROCEDURE New () : PtrToValue ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   IF FreeList=NIL
+   THEN
+      NEW (v)
+   ELSE
+      v := FreeList ;
+      FreeList := FreeList^.next
+   END ;
+   WITH v^ DO
+      numberValue := NIL
+   END ;
+   RETURN InitRecord (v)
+END New ;
+
+
+(*
+   InitRecord - initialize the non variant fields of, v.  Return v.
+*)
+
+PROCEDURE InitRecord (v: PtrToValue) : PtrToValue ;
+BEGIN
+   WITH v^ DO
+      location := UnknownLocation () ;
+      areAllConstants := FALSE ;
+      solved := FALSE ;
+      constructorType := NulSym ;
+      numberValue := NIL
+   END ;
+   RETURN v
+END InitRecord ;
+
+
+(*
+   NewRange - assigns, v, to a new area of memory.
+*)
+
+PROCEDURE NewRange (VAR v: listOfRange) ;
+BEGIN
+   IF RangeFreeList=NIL
+   THEN
+      NEW(v) ;
+      IF v=NIL
+      THEN
+         InternalError ('out of memory error')
+      END
+   ELSE
+      v := RangeFreeList ;
+      RangeFreeList := RangeFreeList^.next
+   END
+END NewRange ;
+
+
+(*
+   DisposeRange - adds the list, v, to the free list.
+*)
+
+PROCEDURE DisposeRange (VAR v: listOfRange) ;
+VAR
+   r: listOfRange ;
+BEGIN
+   IF v#NIL
+   THEN
+      r := v ;
+      WHILE (r#NIL) AND (r^.next#NIL) DO
+         r := r^.next
+      END ;
+      IF r#NIL
+      THEN
+         r^.next := RangeFreeList
+      END ;
+      RangeFreeList := v ;
+      v := NIL
+   END
+END DisposeRange ;
+
+
+(*
+   IsOnFieldFreeList - returns TRUE if, r, is on the FieldFreeList.
+*)
+
+PROCEDURE IsOnFieldFreeList (r: listOfFields) : BOOLEAN ;
+VAR
+   s: listOfFields ;
+BEGIN
+   s := FieldFreeList ;
+   WHILE s#NIL DO
+      IF s=r
+      THEN
+         RETURN( TRUE )
+      ELSE
+         s := s^.next
+      END
+   END ;
+   RETURN( FALSE )
+END IsOnFieldFreeList ;
+
+
+(*
+   IsOnElementFreeList - returns TRUE if, r, is on the ElementFreeList.
+*)
+
+PROCEDURE IsOnElementFreeList (r: listOfElements) : BOOLEAN ;
+VAR
+   s: listOfElements ;
+BEGIN
+   s := ElementFreeList ;
+   WHILE s#NIL DO
+      IF s=r
+      THEN
+         RETURN( TRUE )
+      ELSE
+         s := s^.next
+      END
+   END ;
+   RETURN( FALSE )
+END IsOnElementFreeList ;
+
+
+(*
+   DisposeFields - adds the list, v, to the free list.
+*)
+
+PROCEDURE DisposeFields (VAR v: listOfFields) ;
+VAR
+   r: listOfFields ;
+BEGIN
+   IF v#NIL
+   THEN
+      r := v ;
+      WHILE r^.next#NIL DO
+         Assert(NOT IsOnFieldFreeList(r)) ;
+         r := r^.next
+      END ;
+      r^.next := FieldFreeList ;
+      FieldFreeList := v ;
+      v := NIL
+   END
+END DisposeFields ;
+
+
+(*
+   NewField - adds the list, v, to the free list.
+*)
+
+PROCEDURE NewField (VAR v: listOfFields) ;
+BEGIN
+   IF FieldFreeList=NIL
+   THEN
+      NEW(v) ;
+      IF v=NIL
+      THEN
+         InternalError ('out of memory error')
+      END
+   ELSE
+      v := FieldFreeList ;
+      FieldFreeList := FieldFreeList^.next
+   END
+END NewField ;
+
+
+(*
+   NewElement - returns a new element record.
+*)
+
+PROCEDURE NewElement (VAR e: listOfElements) ;
+BEGIN
+   IF ElementFreeList=NIL
+   THEN
+      NEW(e) ;
+      IF e=NIL
+      THEN
+         InternalError ('out of memory error')
+      END
+   ELSE
+      e := ElementFreeList ;
+      ElementFreeList := ElementFreeList^.next
+   END
+END NewElement ;
+
+
+(*
+   DisposeElements - returns the list, e, to the free list.
+*)
+
+PROCEDURE DisposeElements (VAR e: listOfElements) ;
+VAR
+   r: listOfElements ;
+BEGIN
+   IF e#NIL
+   THEN
+      r := e ;
+      WHILE r^.next#NIL DO
+         Assert(NOT IsOnElementFreeList(r)) ;
+         r := r^.next
+      END ;
+      r^.next := ElementFreeList ;
+      ElementFreeList := e ;
+      e := NIL
+   END
+END DisposeElements ;
+
+
+(*
+   CheckNotAlreadyOnFreeList - checks to see whether, v, is already on the free list
+                               and aborts if this is the case.
+*)
+
+PROCEDURE CheckNotAlreadyOnFreeList (v: PtrToValue) ;
+VAR
+   l: PtrToValue ;
+BEGIN
+   IF DebugGarbage
+   THEN
+      l := FreeList ;
+      WHILE l#NIL DO
+         IF l=v
+         THEN
+            InternalError ('value is already on the free list')
+         END ;
+         l := l^.next
+      END
+   END
+END CheckNotAlreadyOnFreeList ;
+
+
+(*
+   CheckNotOnStack - checks to see whether, v, is already on the stack
+                     and aborts if this is the case.
+*)
+
+PROCEDURE CheckNotOnStack (v: PtrToValue) ;
+VAR
+   l: PtrToValue ;
+BEGIN
+   IF DebugGarbage
+   THEN
+      l := TopOfStack ;
+      WHILE l#NIL DO
+         IF l=v
+         THEN
+            InternalError ('value is already on the stack')
+         END ;
+         l := l^.next
+      END
+   END
+END CheckNotOnStack ;
+
+
+(*
+   Dispose - place, v, onto the FreeList.
+*)
+
+PROCEDURE Dispose (v: PtrToValue) ;
+BEGIN
+   CheckNotAlreadyOnFreeList(v) ;
+   CheckNotOnStack(v) ;
+   CASE v^.type OF
+
+   set        :  DisposeRange(v^.setValue) |
+   constructor,
+   record     :  DisposeFields(v^.fieldValues) |
+   array      :  DisposeElements(v^.arrayValues)
+
+   ELSE
+   END ;
+   v^.next := FreeList ;
+   FreeList := v
+END Dispose ;
+
+
+(*
+   AddRange - returns a ListOfRange which is prepended to the front of the current list.
+*)
+
+PROCEDURE AddRange (head: listOfRange; l, h: CARDINAL) : listOfRange ;
+VAR
+   r: listOfRange ;
+BEGIN
+   NewRange(r) ;
+   WITH r^ DO
+      low  := l ;
+      high := h ;
+      next := head
+   END ;
+   RETURN( r )
+END AddRange ;
+
+
+(*
+   DupRange - duplicates and returns the list, t.
+*)
+
+PROCEDURE DupRange (r: listOfRange) : listOfRange ;
+VAR
+   s: listOfRange ;
+BEGIN
+   s := NIL ;
+   WHILE r#NIL DO
+      s := AddRange(s, r^.low, r^.high) ;
+      r := r^.next
+   END ;
+   RETURN( s )
+END DupRange ;
+
+
+(*
+   InitValue - initializes and returns a memory cell.
+*)
+
+PROCEDURE InitValue () : PtrToValue ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   IF v=NIL
+   THEN
+      InternalError ('out of memory error')
+   ELSE
+      WITH v^ DO
+         location        := UnknownLocation () ;
+         type            := none ;
+         areAllConstants := TRUE ;
+         solved          := FALSE ;
+         next            := NIL ;
+         constructorType := NulSym
+      END ;
+      RETURN( v )
+   END
+END InitValue ;
+
+
+(*
+   IsValueTypeNone - returns TRUE if the value on the top stack has no value.
+*)
+
+PROCEDURE IsValueTypeNone () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=none
+      THEN
+         Push(v) ;
+         RETURN( TRUE )
+      ELSE
+         Push(v) ;
+         RETURN( FALSE )
+      END
+   END
+END IsValueTypeNone ;
+
+
+(*
+   IsValueTypeInteger - returns TRUE if the value on the top stack is an integer.
+*)
+
+PROCEDURE IsValueTypeInteger () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=integer
+      THEN
+         Push(v) ;
+         RETURN( TRUE )
+      ELSE
+         Push(v) ;
+         RETURN( FALSE )
+      END
+   END
+END IsValueTypeInteger ;
+
+
+(*
+   IsValueTypeReal - returns TRUE if the value on the top stack is a real.
+*)
+
+PROCEDURE IsValueTypeReal () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=real
+      THEN
+         Push(v) ;
+         RETURN( TRUE )
+      ELSE
+         Push(v) ;
+         RETURN( FALSE )
+      END
+   END
+END IsValueTypeReal ;
+
+
+(*
+   IsValueTypeComplex - returns TRUE if the value on the top stack is a complex.
+*)
+
+PROCEDURE IsValueTypeComplex () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=complex
+      THEN
+         Push(v) ;
+         RETURN( TRUE )
+      ELSE
+         Push(v) ;
+         RETURN( FALSE )
+      END
+   END
+END IsValueTypeComplex ;
+
+
+(*
+   IsValueTypeSet - returns TRUE if the value on the top stack is a set.
+*)
+
+PROCEDURE IsValueTypeSet () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=set
+      THEN
+         Push(v) ;
+         RETURN( TRUE )
+      ELSE
+         Push(v) ;
+         RETURN( FALSE )
+      END
+   END
+END IsValueTypeSet ;
+
+
+(*
+   IsValueTypeConstructor - returns TRUE if the value on the top
+                            stack is a constructor.
+*)
+
+PROCEDURE IsValueTypeConstructor () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=constructor
+      THEN
+         Push(v) ;
+         RETURN( TRUE )
+      ELSE
+         Push(v) ;
+         RETURN( FALSE )
+      END
+   END
+END IsValueTypeConstructor ;
+
+
+(*
+   IsValueTypeArray - returns TRUE if the value on the top stack is
+                      an array.
+*)
+
+PROCEDURE IsValueTypeArray () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=array
+      THEN
+         Push(v) ;
+         RETURN( TRUE )
+      ELSE
+         Push(v) ;
+         RETURN( FALSE )
+      END
+   END
+END IsValueTypeArray ;
+
+
+(*
+   IsValueTypeRecord - returns TRUE if the value on the top stack is
+                       a record.
+*)
+
+PROCEDURE IsValueTypeRecord () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=record
+      THEN
+         Push(v) ;
+         RETURN( TRUE )
+      ELSE
+         Push(v) ;
+         RETURN( FALSE )
+      END
+   END
+END IsValueTypeRecord ;
+
+
+(*
+   GetSetValueType - returns the set type on top of the ALU stack.
+*)
+
+PROCEDURE GetSetValueType () : CARDINAL ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   Push(v) ;
+   WITH v^ DO
+      IF type=set
+      THEN
+         RETURN( constructorType )
+      ELSE
+         InternalError ('expecting set type')
+      END
+   END
+END GetSetValueType ;
+
+
+(*
+   PushIntegerTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushIntegerTree (t: Tree) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := InitValue() ;
+   WITH v^ DO
+      type            := integer ;
+      numberValue     := t ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushIntegerTree ;
+
+
+(*
+   PopIntegerTree - pops a gcc tree value from the ALU stack.
+*)
+
+PROCEDURE PopIntegerTree () : Tree ;
+VAR
+   v: PtrToValue ;
+   t: Tree ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=integer
+      THEN
+         t := numberValue
+      ELSE
+         InternalError ('expecting type of constant to be a whole number')
+      END
+   END ;
+   Dispose(v) ;
+   RETURN( t )
+END PopIntegerTree ;
+
+
+(*
+   PushRealTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushRealTree (t: Tree) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   WITH v^ DO
+      type            := real ;
+      numberValue     := t ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushRealTree ;
+
+
+(*
+   PopRealTree - pops a gcc tree value from the ALU stack.
+*)
+
+PROCEDURE PopRealTree () : Tree ;
+VAR
+   v: PtrToValue ;
+   t: Tree ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=real
+      THEN
+         t := numberValue
+      ELSE
+         InternalError ('expecting type of constant to be a real number')
+      END
+   END ;
+   Dispose(v) ;
+   RETURN( t )
+END PopRealTree ;
+
+
+(*
+   PushComplexTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushComplexTree (t: Tree) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   WITH v^ DO
+      type            := complex ;
+      numberValue     := t ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushComplexTree ;
+
+
+(*
+   PopComplexTree - pops a gcc tree value from the ALU stack.
+*)
+
+PROCEDURE PopComplexTree () : Tree ;
+VAR
+   v: PtrToValue ;
+   t: Tree ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=complex
+      THEN
+         t := numberValue
+      ELSE
+         InternalError ('expecting type of constant to be a complex number')
+      END
+   END ;
+   Dispose(v) ;
+   RETURN( t )
+END PopComplexTree ;
+
+
+(*
+   PushSetTree - pushes a gcc tree onto the ALU stack.
+                 The tree, t, is expected to contain a
+                 word value. It is converted into a set
+                 type (sym). Bit 0 maps onto MIN(sym).
+*)
+
+PROCEDURE PushSetTree (tokenno: CARDINAL;
+                       t: Tree; sym: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+   c,
+   i: INTEGER ;
+   r: listOfRange ;
+   l: location_t ;
+BEGIN
+   l := TokenToLocation(tokenno) ;
+   r := NIL ;
+   i := 0 ;
+   WHILE (i<GetBitsPerBitset()) AND
+         (CompareTrees(GetIntegerZero(l), t)#0) DO
+      IF CompareTrees(GetIntegerOne(l),
+                      BuildLogicalAnd(l, t, GetIntegerOne(l), FALSE))=0
+      THEN
+         PushCard(i) ;
+         c := Val(tokenno, SkipType(sym), PopIntegerTree()) ;
+         DeclareConstant(tokenno, c) ;
+         r := AddRange(r, c, c)
+      END ;
+      t := BuildLSR(l, t, GetIntegerOne(l), FALSE) ;
+      INC(i)
+   END ;
+   SortElements(tokenno, r) ;
+   CombineElements(tokenno, r) ;
+   v := New() ;
+   WITH v^ DO
+      location        := l ;
+      type            := set ;
+      constructorType := sym ;
+      areAllConstants := FALSE ;
+      solved          := FALSE ;
+      setValue        := r
+   END ;
+   Eval(tokenno, v) ;
+   Push(v)
+END PushSetTree ;
+
+
+(*
+   PopSetTree - pops a gcc tree from the ALU stack.
+*)
+
+PROCEDURE PopSetTree (tokenno: CARDINAL) : Tree ;
+VAR
+   v: PtrToValue ;
+   t: Tree ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=set
+      THEN
+         Eval(tokenno, v) ;
+         IF NOT v^.solved
+         THEN
+            InternalError ('the set has not been resolved')
+         END ;
+         IF NOT v^.areAllConstants
+         THEN
+            InternalError ('the set must only contain constants')
+         END ;
+         t := ConstructSetConstant(tokenno, v)
+      ELSE
+         InternalError ('expecting type of constant to be a set')
+      END
+   END ;
+   Dispose(v) ;
+   RETURN( t )
+END PopSetTree ;
+
+
+(*
+   PopConstructorTree - returns a tree containing the compound literal.
+*)
+
+PROCEDURE PopConstructorTree (tokenno: CARDINAL) : Tree ;
+VAR
+   v: PtrToValue ;
+   t: Tree ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      Eval(tokenno, v) ;
+      IF NOT v^.solved
+      THEN
+         InternalError ('the constructor has not been resolved')
+      END ;
+      CASE type OF
+
+      constructor:  InternalError('expecting constructor to be resolved into specific type') |
+      array      :  t := ConstructArrayConstant(tokenno, v) |
+      record     :  t := ConstructRecordConstant(tokenno, v) |
+      set        :  t := ConstructSetConstant(tokenno, v)
+
+      ELSE
+         InternalError ('expecting type to be a constructor')
+      END
+   END ;
+   Dispose(v) ;
+   RETURN( t )
+END PopConstructorTree ;
+
+
+(*
+   Pop - pops and returns top element from the stack.
+*)
+
+PROCEDURE Pop () : PtrToValue ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   IF TopOfStack=NIL
+   THEN
+      InternalError ('stack underflow error')
+   ELSE
+      v          := TopOfStack ;
+      TopOfStack := TopOfStack^.next
+   END ;
+   CheckNotAlreadyOnFreeList(v) ;
+   RETURN( v )
+END Pop ;
+
+
+(*
+   Push - pushes the value onto the stack.
+*)
+
+PROCEDURE Push (v: PtrToValue) ;
+BEGIN
+   CheckNotAlreadyOnFreeList(v) ;
+   CheckNotOnStack(v) ;
+   v^.next    := TopOfStack ;
+   TopOfStack := v
+END Push ;
+
+
+(*
+   Reduce - remove the top element of the stack.
+*)
+
+PROCEDURE Reduce ;
+BEGIN
+   Dispose (Pop ())
+END Reduce ;
+
+
+(*
+   PrintValue - debugging procedure to display the value on the top of the stack.
+*)
+
+PROCEDURE PrintValue ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=integer
+      THEN
+         DebugTree(numberValue)
+      END
+   END ;
+   Push(v)
+END PrintValue ;
+
+
+(*
+   DupFields - duplicates the field list in order.
+*)
+
+PROCEDURE DupFields (f: listOfFields) : listOfFields ;
+VAR
+   p, q, l: listOfFields ;
+BEGIN
+   p := NIL ;
+   l := NIL ;
+   WHILE f#NIL DO
+      NewField(q) ;
+      IF p=NIL
+      THEN
+         p := q
+      END ;
+      q^.field := f^.field ;
+      q^.next := NIL ;
+      IF l#NIL
+      THEN
+         l^.next := q
+      END ;
+      l := q ;
+      f := f^.next
+   END ;
+   RETURN( p )
+END DupFields ;
+
+
+(*
+   DupElements - duplicates the array list in order.
+*)
+
+PROCEDURE DupElements (f: listOfElements) : listOfElements ;
+VAR
+   p, q, l: listOfElements ;
+BEGIN
+   p := NIL ;
+   l := NIL ;
+   WHILE f#NIL DO
+      NewElement(q) ;
+      IF p=NIL
+      THEN
+         p := q
+      END ;
+      q^.element := f^.element ;
+      q^.by := f^.by ;
+      q^.next := NIL ;
+      IF l#NIL
+      THEN
+         l^.next := q
+      END ;
+      l := q ;
+      f := f^.next
+   END ;
+   RETURN( p )
+END DupElements ;
+
+
+(*
+   PushFrom - pushes a copy of the contents of, v, onto stack.
+*)
+
+PROCEDURE PushFrom (v: PtrToValue) ;
+VAR
+   t: PtrToValue ;
+BEGIN
+   CheckNotAlreadyOnFreeList(v) ;
+   t := New() ;     (* as it is a copy *)
+   t^ := v^ ;
+   CASE v^.type OF
+
+   set        :  t^.setValue := DupRange(v^.setValue) |
+   constructor,
+   record     :  t^.fieldValues := DupFields(v^.fieldValues) |
+   array      :  t^.arrayValues := DupElements(v^.arrayValues)
+
+   ELSE
+   END ;
+   Push(t)
+END PushFrom ;
+
+
+(*
+   PopInto - pops the top element from the stack and places it into, v.
+*)
+
+PROCEDURE PopInto (v: PtrToValue) ;
+VAR
+   t: PtrToValue ;
+BEGIN
+   t := Pop() ;
+   v^ := t^ ;
+   CASE v^.type OF
+
+   set        :  t^.setValue := NIL |
+   record,
+   constructor:  t^.fieldValues := NIL |
+   array      :  t^.arrayValues := NIL |
+   none,
+   integer,
+   real,
+   complex    :  v^.numberValue := RememberConstant(FoldAndStrip(t^.numberValue))
+
+   ELSE
+      InternalError ('not expecting this value')
+   END ;
+   Dispose(t)
+END PopInto ;
+
+
+(*
+   PushCard - pushes a cardinal onto the stack.
+*)
+
+PROCEDURE PushCard (c: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   WITH v^ DO
+      type            := integer ;
+      numberValue     := BuildIntegerConstant(INTEGER(c)) ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushCard ;
+
+
+(*
+   PushInt - pushes an integer onto the stack.
+*)
+
+PROCEDURE PushInt (i: INTEGER) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   WITH v^ DO
+      type            := integer ;
+      numberValue     := BuildIntegerConstant(i) ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushInt ;
+
+
+(*
+   PushChar - pushes a char onto the stack.
+*)
+
+PROCEDURE PushChar (c: CHAR) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   WITH v^ DO
+      type            := integer ;
+      numberValue     := BuildIntegerConstant(ORD(c)) ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushChar ;
+
+
+(*
+   IsReal - returns TRUE if a is a REAL number.
+*)
+
+PROCEDURE IsReal (a: DynamicStrings.String) : BOOLEAN ;
+BEGIN
+   RETURN( DynamicStrings.Index(a, '.', 0)#-1 )
+END IsReal ;
+
+
+(*
+   PushString - pushes the numerical value of the string onto the stack.
+*)
+
+PROCEDURE PushString (tokenno: CARDINAL; s: Name) ;
+VAR
+   ch      : CHAR ;
+   a, b    : DynamicStrings.String ;
+   length  : CARDINAL ;
+   location: location_t ;
+BEGIN
+   a := DynamicStrings.InitStringCharStar (KeyToCharStar (s)) ;
+   b := NIL ;
+   length := DynamicStrings.Length (a) ;
+   IF length>0
+   THEN
+      DEC (length) ;
+      ch := DynamicStrings.char (a, length) ;
+      location := TokenToLocation (tokenno) ;
+      CASE ch OF
+
+      'H': (* hexadecimal *)
+           b := DynamicStrings.Slice (a, 0, -1) ;
+           PushIntegerTree (BuildConstLiteralNumber (location,
+                                                     DynamicStrings.string (b),
+                                                     16)) |
+      'A': (* binary *)
+           b := DynamicStrings.Slice (a, 0, -1) ;
+           PushIntegerTree (BuildConstLiteralNumber (location,
+                                                     DynamicStrings.string (b),
+                                                     2)) |
+      'C', (* --fixme-- question:
+              should we type this as a char rather than an int? *)
+      'B': (* octal *)
+           b := DynamicStrings.Slice (a, 0, -1) ;
+           PushIntegerTree (BuildConstLiteralNumber (location,
+                                                     DynamicStrings.string (b),
+                                                     8))
+
+      ELSE
+         IF IsReal (a)
+         THEN
+            PushRealTree (RealToTree (KeyToCharStar (s)))
+         ELSE
+            PushIntegerTree (BuildConstLiteralNumber (location, KeyToCharStar (s), 10))
+         END
+      END
+   ELSE
+      InternalError ('expecting constant literal')
+   END ;
+   a := DynamicStrings.KillString (a) ;
+   b := DynamicStrings.KillString (b)
+END PushString ;
+
+
+(*
+   IsSolvedGCC - returns TRUE if the value, sym, is solved.
+                 If TRUE then it also ensures this symbol is
+                 entered into the double book keeping table
+                 for GM2 <-> GCC.
+*)
+
+PROCEDURE IsSolvedGCC (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsValueSolved(sym)
+   THEN
+      IF NOT GccKnowsAbout(sym)
+      THEN
+         DeclareConstant(GetDeclaredMod(sym), sym)
+      END ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsSolvedGCC ;
+
+
+(*
+   CoerseLongRealToCard - performs a coersion between a REAL to a CARDINAL
+*)
+
+PROCEDURE CoerseLongRealToCard ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=real
+      THEN
+         numberValue     := ConvertConstantAndCheck(location, GetIntegerType(), numberValue) ;
+         type            := integer ;
+         areAllConstants := TRUE ;
+         solved          := TRUE
+      ELSE
+         InternalError ('expecting a REAL number')
+      END
+   END ;
+   Push(v)
+END CoerseLongRealToCard ;
+
+
+(*
+   ConvertRealToInt - converts a REAL into an INTEGER
+*)
+
+PROCEDURE ConvertRealToInt ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=real
+      THEN
+         numberValue     := ConvertConstantAndCheck(location, GetIntegerType(), numberValue) ;
+         type            := integer ;
+         areAllConstants := TRUE ;
+         solved          := TRUE
+      ELSE
+         InternalError ('expecting a REAL number')
+      END
+   END ;
+   Push(v)
+END ConvertRealToInt ;
+
+
+(*
+   ConvertIntToReal - converts a INTEGER into a LONGREAL
+*)
+
+PROCEDURE ConvertIntToReal ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=integer
+      THEN
+         numberValue     := ConvertConstantAndCheck(location, GetLongRealType(), numberValue) ;
+         type            := real ;
+         areAllConstants := TRUE ;
+         solved          := TRUE
+      ELSE
+         InternalError ('expecting an INTEGER number')
+      END
+   END ;
+   Push(v)
+END ConvertIntToReal ;
+
+
+(*
+   ConvertToInt - converts the value into an INTEGER. This should be used
+                  if we are computing the number of elements in a char set to
+                  avoid an overflow.
+*)
+
+PROCEDURE ConvertToInt ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      IF type=integer
+      THEN
+         numberValue     := ConvertConstantAndCheck(location, GetIntegerType(), numberValue) ;
+         solved          := TRUE ;
+         areAllConstants := TRUE
+      ELSE
+         InternalError ('expecting an INTEGER number')
+      END
+   END ;
+   Push(v)
+END ConvertToInt ;
+
+
+(*
+   ConvertToType - converts the top of stack to type, t.
+*)
+
+PROCEDURE ConvertToType (t: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   IF t#NulSym
+   THEN
+      WITH v^ DO
+         IF type=integer
+         THEN
+            numberValue     := ConvertConstantAndCheck(location, Mod2Gcc(t), numberValue) ;
+            solved          := TRUE ;
+            areAllConstants := TRUE
+         ELSE
+            InternalError ('expecting an INTEGER number')
+         END
+      END
+   END ;
+   Push(v)
+END ConvertToType ;
+
+
+
+(*
+   IsSolved - returns true if the memory cell indicated by v
+              has a known value.
+*)
+
+PROCEDURE IsSolved (v: PtrToValue) : BOOLEAN ;
+BEGIN
+   IF v=NIL
+   THEN
+      InternalError ('uninitialized value')
+   ELSE
+      RETURN( v^.solved )
+   END
+END IsSolved ;
+
+
+(*
+   IsValueConst - returns true if the memory cell indicated by v
+                  is only defined by constants.  For example
+                  no variables are used in the constructor.
+*)
+
+PROCEDURE IsValueConst (v: PtrToValue) : BOOLEAN ;
+BEGIN
+   IF v=NIL
+   THEN
+      InternalError ('uninitialized value')
+   ELSE
+      RETURN( v^.areAllConstants )
+   END
+END IsValueConst ;
+
+
+(*
+   EitherReal - returns TRUE if either, Op1, or, Op2, are Real.
+*)
+
+PROCEDURE EitherReal (Op1, Op2: PtrToValue) : BOOLEAN ;
+BEGIN
+   RETURN( (Op1^.type=real) OR (Op2^.type=real) )
+END EitherReal ;
+
+
+(*
+   EitherComplex - returns TRUE if either, Op1, or, Op2, are Real.
+*)
+
+PROCEDURE EitherComplex (Op1, Op2: PtrToValue) : BOOLEAN ;
+BEGIN
+   RETURN( (Op1^.type=complex) OR (Op2^.type=complex) )
+END EitherComplex ;
+
+
+(*
+   Add - adds the top two elements on the stack.
+
+         The Stack:
+
+         Entry             Exit
+
+  Ptr ->
+         +------------+
+         | Op1        |                   <- Ptr
+         |------------|    +------------+
+         | Op2        |    | Op2 + Op1  |
+         |------------|    |------------|
+*)
+
+PROCEDURE Addn ;
+VAR
+   Temp,
+   Op1, Op2: PtrToValue ;
+BEGIN
+   Op1 := Pop() ;
+   Op2 := Pop() ;
+   IF EitherReal(Op1, Op2)
+   THEN
+      RealAdd(Op1, Op2)
+   ELSIF EitherComplex(Op1, Op2)
+   THEN
+      ComplexAdd(Op1, Op2)
+   ELSE
+      Temp := New() ;    (* as it is a temp *)
+      WITH Temp^ DO
+         location     := Op1^.location ;
+         type         := integer ;
+         numberValue  := BuildAdd(location, Op1^.numberValue, Op2^.numberValue, FALSE) ;
+         solved       := TRUE
+      END ;
+      Push(Temp)
+   END ;
+   Dispose(Op1) ;
+   Dispose(Op2)
+END Addn ;
+
+
+(*
+   RealAdd - adds two numbers. One of which is a Real.
+*)
+
+PROCEDURE RealAdd (Op1, Op2: PtrToValue) ;
+VAR
+   Temp: PtrToValue ;
+BEGIN
+   IF Op1^.type=integer
+   THEN
+      Push(Op1) ;
+      ConvertIntToReal ;
+      Op1 := Pop()
+   END ;
+   IF Op2^.type=integer
+   THEN
+      Push(Op2) ;
+      ConvertIntToReal ;
+      Op2 := Pop()
+   END ;
+   Temp := New() ;
+   WITH Temp^ DO
+      location    := Op1^.location ;
+      numberValue := BuildAdd(location, Op1^.numberValue, Op2^.numberValue, FALSE) ;
+      type        := real ;
+      solved      := TRUE
+   END ;
+   Push(Temp)
+END RealAdd ;
+
+
+(*
+   ComplexAdd - adds two complex numbers.
+*)
+
+PROCEDURE ComplexAdd (Op1, Op2: PtrToValue) ;
+VAR
+   Temp: PtrToValue ;
+BEGIN
+   IF (Op1^.type=complex) AND (Op2^.type=complex)
+   THEN
+      Temp := New() ;
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         numberValue := BuildAdd(location, Op1^.numberValue, Op2^.numberValue, FALSE) ;
+         type        := complex ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   ELSE
+      InternalError ('expecting both operands to be of type COMPLEX')
+   END
+END ComplexAdd ;
+
+
+(*
+   Sub - subtracts the top two elements on the stack.
+
+         The Stack:
+
+         Entry             Exit
+
+  Ptr ->
+         +------------+
+         | Op1        |                   <- Ptr
+         |------------|    +------------+
+         | Op2        |    | Op2 - Op1  |
+         |------------|    |------------|
+*)
+
+PROCEDURE Sub ;
+VAR
+   Temp,
+   Op1, Op2: PtrToValue ;
+BEGIN
+   Op1 := Pop() ;
+   Op2 := Pop() ;
+   IF EitherReal(Op1, Op2)
+   THEN
+      RealSub(Op1, Op2)
+   ELSIF EitherComplex(Op1, Op2)
+   THEN
+      ComplexSub(Op1, Op2)
+   ELSE
+      Temp := New() ;      (* as it is a temp *)
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         type        := integer ;
+         numberValue := BuildSub(location, Op2^.numberValue, Op1^.numberValue, TRUE) ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   END ;
+   Dispose(Op1) ;
+   Dispose(Op2)
+END Sub ;
+
+
+(*
+   RealSub - subtracts two numbers. One of which is a Real.
+*)
+
+PROCEDURE RealSub (Op1, Op2: PtrToValue) ;
+VAR
+   Temp: PtrToValue ;
+BEGIN
+   IF Op1^.type=integer
+   THEN
+      Push(Op1) ;
+      ConvertIntToReal ;
+      Op1 := Pop()
+   END ;
+   IF Op2^.type=integer
+   THEN
+      Push(Op2) ;
+      ConvertIntToReal ;
+      Op2 := Pop()
+   END ;
+   Temp := New() ;
+   WITH Temp^ DO
+      location    := Op1^.location ;
+      numberValue := BuildSub(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+      type        := real ;
+      solved      := TRUE
+   END ;
+   Push(Temp)
+END RealSub ;
+
+
+(*
+   ComplexSub - subtracts two complex numbers.
+*)
+
+PROCEDURE ComplexSub (Op1, Op2: PtrToValue) ;
+VAR
+   Temp: PtrToValue ;
+BEGIN
+   IF (Op1^.type=complex) AND (Op2^.type=complex)
+   THEN
+      Temp := New() ;
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         numberValue := BuildSub(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+         type        := complex ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   ELSE
+      InternalError ('expecting both operands to be of type COMPLEX')
+   END
+END ComplexSub ;
+
+
+(*
+   Mult - multiplies the top two elements on the stack.
+
+          The Stack:
+
+          Entry             Exit
+
+   Ptr ->
+          +------------+
+          | Op1        |                   <- Ptr
+          |------------|    +------------+
+          | Op2        |    | Op2 * Op1  |
+          |------------|    |------------|
+*)
+
+PROCEDURE Multn ;
+VAR
+   Temp,
+   Op1, Op2: PtrToValue ;
+BEGIN
+   Op1 := Pop() ;
+   Op2 := Pop() ;
+   IF EitherReal(Op1, Op2)
+   THEN
+      RealMult(Op1, Op2)
+   ELSIF EitherComplex(Op1, Op2)
+   THEN
+      ComplexMult(Op1, Op2)
+   ELSE
+      Temp := New() ;     (* as it is a temp *)
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         type        := integer ;
+         numberValue := BuildMult(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   END ;
+   Dispose(Op1) ;
+   Dispose(Op2)
+END Multn ;
+
+
+(*
+   RealMult - multiplies two numbers. One of which is a Real.
+*)
+
+PROCEDURE RealMult (Op1, Op2: PtrToValue) ;
+VAR
+   Temp: PtrToValue ;
+BEGIN
+   IF Op1^.type=integer
+   THEN
+      Push(Op1) ;
+      ConvertIntToReal ;
+      Op1 := Pop()
+   END ;
+   IF Op2^.type=integer
+   THEN
+      Push(Op2) ;
+      ConvertIntToReal ;
+      Op2 := Pop()
+   END ;
+   Temp := New() ;     (* as it is a temp *)
+   WITH Temp^ DO
+      location    := Op1^.location ;
+      numberValue := BuildMult(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+      type        := real ;
+      solved      := TRUE
+   END ;
+   Push(Temp)
+END RealMult ;
+
+
+(*
+   ComplexMult - multiplies two complex numbers.
+*)
+
+PROCEDURE ComplexMult (Op1, Op2: PtrToValue) ;
+VAR
+   Temp: PtrToValue ;
+BEGIN
+   IF (Op1^.type=complex) AND (Op2^.type=complex)
+   THEN
+      Temp := New() ;
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         numberValue := BuildMult(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+         type        := complex ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   ELSE
+      InternalError ('expecting both operands to be of type COMPLEX')
+   END
+END ComplexMult ;
+
+
+(*
+   DivTrunc - divides the top two elements on the stack.
+
+              The Stack:
+
+              Entry             Exit
+
+       Ptr ->
+              +------------+
+              | Op1        |                     <- Ptr
+              |------------|    +--------------+
+              | Op2        |    | Op2 DIV Op1  |
+              |------------|    |--------------|
+*)
+
+PROCEDURE DivTrunc ;
+VAR
+   Temp,
+   Op1, Op2: PtrToValue ;
+BEGIN
+   Op1 := Pop() ;
+   Op2 := Pop() ;
+   IF EitherReal(Op1, Op2)
+   THEN
+      RealDiv(Op1, Op2)
+   ELSIF EitherComplex(Op1, Op2)
+   THEN
+      ComplexDiv(Op1, Op2)
+   ELSE
+      Temp := New() ;     (* as it is a temp *)
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         type        := integer ;
+         numberValue := BuildDivTrunc(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   END ;
+   Dispose(Op1) ;
+   Dispose(Op2)
+END DivTrunc ;
+
+
+(*
+   DivFloor - divides the top two elements on the stack.
+
+              The Stack:
+
+              Entry             Exit
+
+       Ptr ->
+              +------------+
+              | Op1        |                     <- Ptr
+              |------------|    +--------------+
+              | Op2        |    | Op2 DIV Op1  |
+              |------------|    |--------------|
+*)
+
+PROCEDURE DivFloor ;
+VAR
+   Temp,
+   Op1, Op2: PtrToValue ;
+BEGIN
+   Op1 := Pop() ;
+   Op2 := Pop() ;
+   IF EitherReal(Op1, Op2)
+   THEN
+      RealDiv(Op1, Op2)
+   ELSIF EitherComplex(Op1, Op2)
+   THEN
+      ComplexDiv(Op1, Op2)
+   ELSE
+      Temp := New() ;     (* as it is a temp *)
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         type        := integer ;
+         numberValue := BuildDivFloor(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   END ;
+   Dispose(Op1) ;
+   Dispose(Op2)
+END DivFloor ;
+
+
+(*
+   RealDiv - divides two numbers. One of which is a Real.
+*)
+
+PROCEDURE RealDiv (Op1, Op2: PtrToValue) ;
+VAR
+   Temp: PtrToValue ;
+BEGIN
+   IF Op1^.type=integer
+   THEN
+      Push(Op1) ;
+      ConvertIntToReal ;
+      Op1 := Pop()
+   END ;
+   IF Op2^.type=integer
+   THEN
+      Push(Op2) ;
+      ConvertIntToReal ;
+      Op2 := Pop()
+   END ;
+   Temp := New() ;     (* as it is a temp *)
+   WITH Temp^ DO
+      location    := Op1^.location ;
+      numberValue := BuildDivTrunc(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+      type        := real ;
+      solved      := TRUE
+   END ;
+   Push(Temp)
+END RealDiv ;
+
+
+(*
+   ComplexDiv - divides two complex numbers.
+*)
+
+PROCEDURE ComplexDiv (Op1, Op2: PtrToValue) ;
+VAR
+   Temp: PtrToValue ;
+BEGIN
+   IF (Op1^.type=complex) AND (Op2^.type=complex)
+   THEN
+      Temp := New() ;
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         numberValue := BuildDivTrunc(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+         type        := complex ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   ELSE
+      InternalError ('expecting both operands to be of type COMPLEX')
+   END
+END ComplexDiv ;
+
+
+(*
+   ModFloor - modulus of the top two elements on the stack.
+
+              The Stack:
+
+              Entry             Exit
+
+       Ptr ->
+              +------------+
+              | Op1        |                     <- Ptr
+              |------------|    +--------------+
+              | Op2        |    | Op2 MOD Op1  |
+              |------------|    |--------------|
+*)
+
+PROCEDURE ModFloor ;
+VAR
+   Temp,
+   Op1, Op2: PtrToValue ;
+BEGIN
+   Op1 := Pop() ;
+   Op2 := Pop() ;
+   IF EitherReal(Op1, Op2)
+   THEN
+      MetaError0 ('cannot perform {%EkMOD} on REAL types')
+   ELSIF EitherComplex(Op1, Op2)
+   THEN
+      MetaError0 ('cannot perform {%EkMOD} on COMPLEX types')
+   ELSE
+      Temp := New() ;     (* as it is a temp *)
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         type        := integer ;
+         numberValue := BuildModFloor(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   END ;
+   Dispose(Op1) ;
+   Dispose(Op2)
+END ModFloor ;
+
+
+(*
+   ModTrunc - modulus of the top two elements on the stack.
+
+              The Stack:
+
+              Entry             Exit
+
+       Ptr ->
+              +------------+
+              | Op1        |                     <- Ptr
+              |------------|    +--------------+
+              | Op2        |    | Op2 MOD Op1  |
+              |------------|    |--------------|
+*)
+
+PROCEDURE ModTrunc ;
+VAR
+   Temp,
+   Op1, Op2: PtrToValue ;
+BEGIN
+   Op1 := Pop() ;
+   Op2 := Pop() ;
+   IF EitherReal(Op1, Op2)
+   THEN
+      MetaError0 ('cannot perform {%EkMOD} on REAL types')
+   ELSIF EitherComplex(Op1, Op2)
+   THEN
+      MetaError0 ('cannot perform {%EkMOD} on COMPLEX types')
+   ELSE
+      Temp := New() ;     (* as it is a temp *)
+      WITH Temp^ DO
+         location    := Op1^.location ;
+         type        := integer ;
+         numberValue := BuildModTrunc(location, Op2^.numberValue, Op1^.numberValue, FALSE) ;
+         solved      := TRUE
+      END ;
+      Push(Temp)
+   END ;
+   Dispose(Op1) ;
+   Dispose(Op2)
+END ModTrunc ;
+
+
+(*
+   AreSetsEqual - returns TRUE if sets, op1, and, op2, contain the same
+                  members.
+*)
+
+PROCEDURE AreSetsEqual (tokenno: CARDINAL; op1, op2: PtrToValue) : BOOLEAN ;
+VAR
+   low1, low2,
+   high1, high2: CARDINAL ;
+   i           : CARDINAL ;
+BEGIN
+   i := 1 ;
+   Eval(tokenno, op1) ;
+   Eval(tokenno, op2) ;
+   IF NOT (op1^.solved AND op2^.solved)
+   THEN
+      InternalError ('can only compare set values when they are known')
+   END ;
+   LOOP
+      IF GetRange(op1, i, low1, high1)
+      THEN
+         IF GetRange(op2, i, low2, high2)
+         THEN
+            PushValue(low1) ;
+            PushValue(low2) ;
+            IF NotEqu(tokenno)
+            THEN
+               RETURN( FALSE )
+            END ;
+            PushValue(high1) ;
+            PushValue(high2) ;
+            IF NotEqu(tokenno)
+            THEN
+               RETURN( FALSE )
+            END ;
+            INC(i)
+         ELSE
+            (* op2 is out of ranges, but op1 still has >= 1 range left *)
+            RETURN( FALSE )
+         END
+      ELSE
+         IF GetRange(op2, i, low2, high2)
+         THEN
+            (* op1 is out of ranges, but op2 still has >= 1 range left *)
+            RETURN( FALSE )
+         ELSE
+            (* both out of ranges and they were the same *)
+            RETURN( TRUE )
+         END
+      END
+   END
+END AreSetsEqual ;
+
+
+(*
+   Equ - returns true if the top two elements on the stack
+         are identical.
+
+         The Stack:
+
+         Entry             Exit
+
+  Ptr ->
+         +------------+
+         | Op1        |
+         |------------|
+         | Op2        |
+         |------------|    Empty
+
+         RETURN( Op2 = Op1 )
+*)
+
+PROCEDURE Equ (tokenno: CARDINAL) : BOOLEAN ;
+VAR
+   Op1, Op2: PtrToValue ;
+   result  : BOOLEAN ;
+BEGIN
+   Op1 := Pop() ;
+   Op2 := Pop() ;
+   IF (Op1^.type=set) AND (Op2^.type=set)
+   THEN
+      result := AreSetsEqual(tokenno, Op1, Op2)
+   ELSIF (Op1^.type=set) OR (Op2^.type=set)
+   THEN
+      MetaErrorT0 (tokenno, 'cannot perform a comparison between a number and a set') ;
+      result := FALSE
+   ELSE
+      IF Op1^.type#Op2^.type
+      THEN
+         MetaErrorT0 (tokenno, 'cannot perform a comparison between a different type constants') ;
+         result := FALSE
+      ELSIF (Op1^.type=complex) OR (Op1^.type=real)
+      THEN
+         result := AreRealOrComplexConstantsEqual(Op1^.numberValue, Op2^.numberValue)
+      ELSE
+         result := AreConstantsEqual(Op1^.numberValue, Op2^.numberValue)
+      END
+   END ;
+   Dispose(Op1) ;
+   Dispose(Op2) ;
+   RETURN( result )
+END Equ ;
+
+
+(*
+   NotEqu - returns true if the top two elements on the stack
+            are not identical.
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Op1        |
+            |------------|
+            | Op2        |
+            |------------|    Empty
+
+            RETURN( Op2 # Op1 )
+*)
+
+PROCEDURE NotEqu (tokenno: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( NOT Equ(tokenno) )
+END NotEqu ;
+
+
+(*
+   Less - returns true if Op2 < Op1
+
+          The Stack:
+
+          Entry             Exit
+
+   Ptr ->
+          +------------+
+          | Op1        |
+          |------------|
+          | Op2        |
+          |------------|    Empty
+
+          RETURN( Op2 < Op1 )
+*)
+
+PROCEDURE Less (tokenno: CARDINAL) : BOOLEAN ;
+VAR
+   v1, v2: PtrToValue ;
+   result: BOOLEAN ;
+   res   : INTEGER ;
+BEGIN
+   v1 := Pop() ;
+   v2 := Pop() ;
+   IF (v1^.type=set) AND (v2^.type=set)
+   THEN
+      result := NOT IsSuperset(tokenno, v2, v1)
+   ELSIF (v1^.type=set) OR (v2^.type=set)
+   THEN
+      MetaErrorT0 (tokenno, 'cannot perform a comparison between a number and a set') ;
+      result := FALSE
+   ELSE
+      res := CompareTrees(v2^.numberValue, v1^.numberValue) ;
+      IF res=-1
+      THEN
+         result := TRUE
+      ELSE
+         result := FALSE
+      END ;
+      (* result := (CompareTrees(v2^.numberValue, v1^.numberValue)=-1) *)
+   END ;
+   Dispose(v1) ;
+   Dispose(v2) ;
+   RETURN( result )
+END Less ;
+
+
+(*
+   Gre - returns true if Op2 > Op1
+
+         The Stack:
+
+         Entry             Exit
+
+  Ptr ->
+         +------------+
+         | Op1        |
+         |------------|
+         | Op2        |
+         |------------|    Empty
+
+         RETURN( Op2 > Op1 )
+*)
+
+PROCEDURE Gre (tokenno: CARDINAL) : BOOLEAN ;
+VAR
+   v1, v2: PtrToValue ;
+   result: BOOLEAN ;
+BEGIN
+   v1 := Pop() ;
+   v2 := Pop() ;
+   IF (v1^.type=set) AND (v2^.type=set)
+   THEN
+      result := NOT IsSubset(tokenno, v2, v1)
+   ELSIF (v1^.type=set) OR (v2^.type=set)
+   THEN
+      MetaErrorT0 (tokenno, 'cannot perform a comparison between a number and a set') ;
+      FlushErrors ;
+      result := FALSE
+   ELSE
+      result := (CompareTrees(v2^.numberValue, v1^.numberValue)=1)
+   END ;
+   Dispose(v1) ;
+   Dispose(v2) ;
+   RETURN( result )
+END Gre ;
+
+
+(*
+   IsSubset - returns TRUE if the set as defined by, s1, is a subset of set, s2.
+*)
+
+PROCEDURE IsSubset (tokenno: CARDINAL; s1, s2: PtrToValue) : BOOLEAN ;
+BEGIN
+   Push(s1) ;
+   Push(s2) ;
+   SetAnd(tokenno) ;
+   Push(s1) ;
+   RETURN( Equ(tokenno) )
+END IsSubset ;
+
+
+(*
+   LessEqu - returns true if Op2<Op1
+
+             The Stack:
+
+             Entry             Exit
+
+      Ptr ->
+             +------------+
+             | Op1        |
+             |------------|
+             | Op2        |
+             |------------|    Empty
+
+             RETURN( Op2 <= Op1 )
+*)
+
+PROCEDURE LessEqu (tokenno: CARDINAL) : BOOLEAN ;
+VAR
+   v1, v2: PtrToValue ;
+   result: BOOLEAN ;
+BEGIN
+   v1 := Pop() ;
+   v2 := Pop() ;
+   IF (v1^.type=set) AND (v2^.type=set)
+   THEN
+      result := IsSubset(tokenno, v2, v1)
+   ELSIF (v1^.type=set) OR (v2^.type=set)
+   THEN
+      MetaErrorT0 (tokenno, 'cannot perform a comparison between a number and a set') ;
+      FlushErrors ;
+      result := FALSE
+   ELSE
+      result := (CompareTrees(v2^.numberValue, v1^.numberValue)<=0)
+   END ;
+   Dispose(v1) ;
+   Dispose(v2) ;
+   RETURN( result )
+END LessEqu ;
+
+
+(*
+   IsSuperset - returns TRUE if the set as defined by, s1, is a superset of set, s2.
+*)
+
+PROCEDURE IsSuperset (tokenno: CARDINAL; s1, s2: PtrToValue) : BOOLEAN ;
+BEGIN
+   PushFrom(s1) ;
+   PushFrom(s2) ;
+   SetAnd(tokenno) ;
+   PushFrom(s2) ;
+   RETURN( Equ(tokenno) )
+END IsSuperset ;
+
+
+(*
+   GreEqu - returns true if Op2 >= Op1
+            are not identical.
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Op1        |
+            |------------|
+            | Op2        |
+            |------------|    Empty
+
+            RETURN( Op2 >= Op1 )
+*)
+
+PROCEDURE GreEqu (tokenno: CARDINAL) : BOOLEAN ;
+VAR
+   v1, v2: PtrToValue ;
+   result: BOOLEAN ;
+BEGIN
+   v1 := Pop() ;
+   v2 := Pop() ;
+   IF (v1^.type=set) AND (v2^.type=set)
+   THEN
+      result := IsSuperset(tokenno, v2, v1)
+   ELSIF (v1^.type=set) OR (v2^.type=set)
+   THEN
+      MetaErrorT0 (tokenno, 'cannot perform a comparison between a number and a set') ;
+      FlushErrors ;
+      result := FALSE
+   ELSE
+      result := (CompareTrees(v2^.numberValue, v1^.numberValue)>=0)
+   END ;
+   Dispose(v1) ;
+   Dispose(v2) ;
+   RETURN( result )
+END GreEqu ;
+
+
+(*
+   IsNulSet - returns TRUE if the top element is the nul set constant, {}.
+*)
+
+PROCEDURE IsNulSet () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+   r: BOOLEAN ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      r := (type=set) AND (setValue=NIL)
+   END ;
+   Push(v) ;
+   RETURN( r )
+END IsNulSet ;
+
+
+(*
+   IsGenericNulSet - returns TRUE if the top element is the generic nul set constant, {}.
+*)
+
+PROCEDURE IsGenericNulSet () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+   r: BOOLEAN ;
+BEGIN
+   v := Pop() ;
+   WITH v^ DO
+      r := (type=set) AND (setValue=NIL) AND (constructorType=NulSym)
+   END ;
+   Push(v) ;
+   RETURN( r )
+END IsGenericNulSet ;
+
+
+(*
+   PushNulSet - pushes an empty set {} onto the ALU stack. The subrange type used
+                to construct the set is defined by, constructorType.
+                If this is NulSym then
+                the set is generic and compatible with all sets.
+
+                The Stack:
+
+                Entry             Exit
+
+                                                 <- Ptr
+                                  +------------+
+                                  | {}         |
+                Ptr ->            |------------|
+
+*)
+
+PROCEDURE PushNulSet (settype: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := InitValue() ;
+   WITH v^ DO
+      type            := set ;
+      constructorType := settype ;
+      areAllConstants := TRUE ;
+      solved          := CompletelyResolved(settype) ;
+      setValue        := NIL ;
+      next            := NIL ;
+   END ;
+   Push(v)
+END PushNulSet ;
+
+
+(*
+   PushEmptyConstructor - pushes an empty constructor {} onto the ALU stack.
+                          This is expected to be filled in by subsequent
+                          calls to AddElements, AddRange or AddField.
+
+                          The Stack:
+
+                          Entry             Exit
+
+                                                       <- Ptr
+                                        +------------+
+                                        | {}         |
+                   Ptr ->               |------------|
+
+*)
+
+PROCEDURE PushEmptyConstructor (constype: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := InitValue() ;
+   WITH v^ DO
+      type            := constructor ;
+      constructorType := constype ;
+      areAllConstants := TRUE ;
+      solved          := CompletelyResolved(constype) ;
+      fieldValues     := NIL ;
+      next            := NIL ;
+   END ;
+   Push(v)
+END PushEmptyConstructor ;
+
+
+(*
+   PushEmptyArray - pushes an empty array {} onto the ALU stack.
+                    This is expected to be filled in by subsequent
+                    calls to AddElements.
+
+                    The Stack:
+
+                    Entry             Exit
+
+                                                     <- Ptr
+                                      +------------+
+                                      | {}         |
+             Ptr ->                   |------------|
+
+*)
+
+PROCEDURE PushEmptyArray (arraytype: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := InitValue() ;
+   WITH v^ DO
+      type            := array ;
+      constructorType := arraytype ;
+      areAllConstants := TRUE ;
+      solved          := CompletelyResolved(arraytype) ;
+      arrayValues     := NIL ;
+      next            := NIL ;
+   END ;
+   Push(v)
+END PushEmptyArray ;
+
+
+(*
+   PushEmptyRecord - pushes an empty record {} onto the ALU stack.
+                     This is expected to be filled in by subsequent
+                     calls to AddField.
+
+                     The Stack:
+
+                     Entry             Exit
+
+                                                      <- Ptr
+                                       +------------+
+                                       | {}         |
+              Ptr ->                   |------------|
+
+*)
+
+PROCEDURE PushEmptyRecord (recordtype: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := InitValue() ;
+   WITH v^ DO
+      type            := record ;
+      constructorType := recordtype ;
+      areAllConstants := TRUE ;
+      solved          := CompletelyResolved(recordtype) ;
+      arrayValues     := NIL ;
+      next            := NIL ;
+   END ;
+   Push(v)
+END PushEmptyRecord ;
+
+
+(*
+   AddElements - adds the elements, el BY, n, to the array constant.
+
+                 Ptr ->
+                                                           <- Ptr
+                        +------------+      +------------+
+                        | Array      |      | Array      |
+                        |------------|      |------------|
+
+*)
+
+PROCEDURE AddElements (tokenno: CARDINAL; el, n: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+   e: listOfElements ;
+BEGIN
+   v := Pop() ;
+   v := CoerseTo(tokenno, array, v) ;
+   IF v^.type=array
+   THEN
+      NewElement(e) ;
+      WITH e^ DO
+         element := el ;
+         by      := n ;
+         next    := NIL
+      END ;
+      AddElementToEnd(v, e) ;
+      WITH v^ DO
+         solved := solved AND IsSolvedGCC(el) AND IsSolvedGCC(n)
+      END
+   ELSE
+      InternalError ('expecting array type')
+   END ;
+   Push(v)
+END AddElements ;
+
+
+(*
+   AddElement -
+
+PROCEDURE AddElement (v: listOfElements;
+                      e, b: CARDINAL) : listOfElements ;
+VAR
+   el: listOfElements ;
+BEGIN
+   NEW(el) ;
+   IF el=NIL
+   THEN
+      InternalError ('out of memory')
+   END ;
+   (* held in reverse order here *)
+   WITH el^ DO
+      element := e ;
+      by      := b ;
+      next    := v^.next
+   END ;
+   v^.next := el ;
+   RETURN( v )
+END AddElement ;
+*)
+
+
+(*
+   cellTypeString - returns a string corresponding to, s.
+*)
+
+PROCEDURE cellTypeString (s: cellType) : String ;
+BEGIN
+   CASE s OF
+
+   none       : RETURN( InitString('none') ) |
+   integer    : RETURN( InitString('integer') ) |
+   real       : RETURN( InitString('real') ) |
+   complex    : RETURN( InitString('complex') ) |
+   set        : RETURN( InitString('set') ) |
+   constructor: RETURN( InitString('constructor') ) |
+   array      : RETURN( InitString('array') ) |
+   record     : RETURN( InitString('record') )
+
+   ELSE
+      InternalError ('unexpected value of s')
+   END ;
+   RETURN( NIL )
+END cellTypeString ;
+
+
+(*
+   ToSetValue - converts a list of fields into a list of ranges.
+                In effect it turns a generic constructor into
+                a set type.
+*)
+
+PROCEDURE ToSetValue (f: listOfFields) : listOfRange ;
+VAR
+   g   : listOfFields ;
+   r, s: listOfRange ;
+BEGIN
+   g := f ;
+   r := NIL ;
+   WHILE f#NIL DO
+      NewRange(s) ;
+      WITH s^ DO
+         low  := f^.field ;
+         high := low ;
+         next := r
+      END ;
+      IF r=NIL
+      THEN
+         r := s
+      END ;
+      f := f^.next
+   END ;
+   DisposeFields(g) ;
+   RETURN( r )
+END ToSetValue ;
+
+
+(*
+   ToArrayValue - converts a list of fields into an array initialiser.
+                  In effect it turns a generic constructor into
+                  an array type.
+*)
+
+PROCEDURE ToArrayValue (tok: CARDINAL; f: listOfFields) : listOfElements ;
+VAR
+   g   : listOfFields ;
+   r, s: listOfElements ;
+BEGIN
+   g := f ;
+   r := NIL ;
+   WHILE f#NIL DO
+      NewElement(s) ;
+      WITH s^ DO
+         element := f^.field ;
+         by      := MakeConstLit (tok, MakeKey('1'), ZType) ;
+         next    := r
+      END ;
+      IF r=NIL
+      THEN
+         r := s
+      END ;
+      f := f^.next
+   END ;
+   DisposeFields(g) ;
+   RETURN( r )
+END ToArrayValue ;
+
+
+(*
+   ChangeToConstructor - change the top of stack value to a constructor, type.
+                         (Constructor, Set, Array or Record).
+*)
+
+PROCEDURE ChangeToConstructor (tokenno: CARDINAL; constype: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   IF IsValueTypeConstructor() OR IsValueTypeSet() OR
+      IsValueTypeArray() OR IsValueTypeRecord()
+   THEN
+      RETURN
+   ELSIF IsValueTypeNone()
+   THEN
+      v := Pop() ;
+      WITH v^ DO
+         type            := constructor ;
+         constructorType := constype ;
+         solved          := CompletelyResolved(constype) ;
+         fieldValues     := NIL ;
+         next            := NIL ;
+      END ;
+      IF IsSet(SkipType(constype))
+      THEN
+         v := CoerseTo(tokenno, set, v)
+      ELSIF IsRecord(SkipType(constype))
+      THEN
+         v := CoerseTo(tokenno, record, v)
+      ELSIF IsArray(SkipType(constype))
+      THEN
+         v := CoerseTo(tokenno, array, v)
+      END ;
+      Push(v)
+   ELSE
+      InternalError('cannot change constant to a constructor type')
+   END
+END ChangeToConstructor ;
+
+
+(*
+   CoerseTo - attempts to coerses a cellType, v, into, type, t.
+              Normally this will be a generic constructors converting
+              into set or array.
+*)
+
+PROCEDURE CoerseTo (tokenno: CARDINAL;
+                    t: cellType; v: PtrToValue) : PtrToValue ;
+VAR
+   s1, s2, s3: DynamicStrings.String ;
+BEGIN
+   WITH v^ DO
+      IF t=type
+      THEN
+         RETURN( v )
+      ELSIF (type=constructor) AND (t=set)
+      THEN
+         type := set ;
+         setValue := ToSetValue(fieldValues) ;
+         RETURN( v )
+      ELSIF (type=constructor) AND (t=array)
+      THEN
+         type := array ;
+         arrayValues := ToArrayValue (tokenno, fieldValues) ;
+         RETURN( v )
+      ELSIF (type=constructor) AND (t=record)
+      THEN
+         (* nothing to do other than change tag *)
+         type := record ;
+         RETURN( v )
+      ELSE
+         s1 := cellTypeString (t) ;
+         s2 := cellTypeString (type) ;
+         s3 := ConCat(InitString('cannot mix construction of a '),
+                      Mark(ConCat(Mark(s1),
+                                  Mark(ConCat(InitString(' with a '),
+                                              (Mark(s2))))))) ;
+         MetaErrorStringT0 (tokenno, s3) ;
+         RETURN( v )
+      END
+   END
+END CoerseTo ;
+
+
+(*
+   SetNegate - negates the top set on the stack.
+
+               Ptr ->                                               <- Ptr
+                      +-----------+                  +------------+
+                      | Set       |                  | Set        |
+                      |-----------|                  |------------|
+*)
+
+PROCEDURE SetNegate (tokenno: CARDINAL) ;
+VAR
+   min,
+   max : CARDINAL ;
+   r, s: listOfRange ;
+   v   : PtrToValue ;
+   i   : CARDINAL ;
+BEGIN
+   v := Pop() ;
+   Eval(tokenno, v) ;
+   IF v^.constructorType=NulSym
+   THEN
+      MetaError0 ('cannot negate a generic set, set should be prefixed by a simple type')
+   END ;
+   r := NIL ;
+   min := GetTypeMin(GetType(v^.constructorType)) ;
+   max := GetTypeMax(GetType(v^.constructorType)) ;
+   i := min ;
+   s := v^.setValue ;
+   IF Debugging
+   THEN
+      printf0('attempting to negate set\n') ;
+      DisplayElements(s)
+   END ;
+   WHILE s#NIL DO
+      PushValue(s^.low) ;
+      PushValue(min) ;
+      IF Gre(tokenno)
+      THEN
+         PushValue(i) ;
+         PushValue(max) ;
+         IF LessEqu(tokenno)
+         THEN
+            r := AddRange(r, i, DupConst(tokenno, s^.low, -1))
+         END
+      END ;
+      PushValue(s^.high) ;
+      PushValue(max) ;
+      IF Less(tokenno)
+      THEN
+         i := DupConst(tokenno, s^.high, 1) ;
+         s := s^.next
+      ELSE
+         s := NIL
+      END
+   END ;
+   IF Debugging
+   THEN
+      printf0('negated set so far\n') ;
+      DisplayElements(r)
+   END ;
+   DisposeRange(v^.setValue) ;
+   PushValue(i) ;
+   PushValue(max) ;
+   IF LessEqu(tokenno)
+   THEN
+      r := AddRange(r, i, max)
+   END ;
+   IF Debugging
+   THEN
+      printf0('final negated set value\n') ;
+      DisplayElements(r)
+   END ;
+   WITH v^ DO
+      solved := FALSE ;
+      setValue := r ;
+   END ;
+   Eval(tokenno, v) ;
+   Push(v)
+END SetNegate ;
+
+
+(*
+   AddBitRange - adds the range op1..op2 to the underlying set.
+
+                 Ptr ->
+                                                           <- Ptr
+                        +------------+      +------------+
+                        | Set        |      | Set        |
+                        |------------|      |------------|
+
+*)
+
+PROCEDURE AddBitRange (tokenno: CARDINAL; op1, op2: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   v := CoerseTo(tokenno, set, v) ;
+   IF v^.type=set
+   THEN
+      WITH v^ DO
+         setValue        := AddRange(setValue, op1, op2) ;
+         solved          := solved AND IsSolvedGCC(op1) AND IsSolvedGCC(op2) ;
+         areAllConstants := areAllConstants AND IsConst(op1) AND IsConst(op2)
+      END
+   END ;
+   Push(v)
+END AddBitRange ;
+
+
+(*
+   AddBit - adds the bit op1 to the underlying set. INCL(Set, op1)
+
+            Ptr ->
+                                                      <- Ptr
+                   +------------+      +------------+
+                   | Set        |      | Set        |
+                   |------------|      |------------|
+*)
+
+PROCEDURE AddBit (tokenno: CARDINAL; op1: CARDINAL) ;
+BEGIN
+   AddBitRange(tokenno, op1, op1)
+END AddBit ;
+
+
+(*
+   AddElementToEnd - appends, e, to the end of list, v.
+*)
+
+PROCEDURE AddElementToEnd (v: PtrToValue; e: listOfElements) ;
+VAR
+   a: listOfElements ;
+BEGIN
+   IF v^.arrayValues=NIL
+   THEN
+      v^.arrayValues := e
+   ELSE
+      a := v^.arrayValues ;
+      WHILE a^.next#NIL DO
+         a := a^.next
+      END ;
+      a^.next := e
+   END
+END AddElementToEnd ;
+
+
+(*
+   AddFieldToEnd - appends, f, to the end of list, v.
+*)
+
+PROCEDURE AddFieldToEnd (v: PtrToValue; f: listOfFields) ;
+VAR
+   a: listOfFields ;
+BEGIN
+   IF v^.fieldValues=NIL
+   THEN
+      v^.fieldValues := f
+   ELSE
+      a := v^.fieldValues ;
+      WHILE a^.next#NIL DO
+         a := a^.next
+      END ;
+      a^.next := f
+   END
+END AddFieldToEnd ;
+
+
+(*
+   AddField - adds the field op1 to the underlying constructor.
+
+                 Ptr ->
+                                                           <- Ptr
+                        +------------+      +------------+
+                        | const      |      | const      |
+                        |------------|      |------------|
+
+*)
+
+PROCEDURE AddField (tokenno: CARDINAL; op1: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+   f: listOfFields ;
+   e: listOfElements ;
+BEGIN
+   v := Pop() ;
+   CASE v^.type OF
+
+   set        : Push(v) ;
+                AddBit(tokenno, op1) ;
+                RETURN |
+   array      : WITH v^ DO
+                   solved := solved AND IsSolvedGCC(op1) ;
+                   areAllConstants := areAllConstants AND IsConst(op1)
+                END ;
+                NewElement(e) ;
+                WITH e^ DO
+                   element := op1 ;
+                   by      := MakeConstLit (tokenno, MakeKey('1'), ZType) ;
+                   next    := NIL
+                END ;
+                AddElementToEnd(v, e) |
+   constructor,
+   record     : WITH v^ DO
+                   solved := solved AND IsSolvedGCC(op1) ;
+                   areAllConstants := areAllConstants AND IsConst(op1)
+                END ;
+                NewField(f) ;
+                WITH f^ DO
+                   field := op1 ;
+                   next  := NIL
+                END ;
+                AddFieldToEnd(v, f)
+
+   ELSE
+      InternalError ('not expecting this constant type')
+   END ;
+   Push(v)
+END AddField ;
+
+
+(*
+   ElementsSolved - returns TRUE if all ranges in the set have been solved.
+*)
+
+PROCEDURE ElementsSolved (r: listOfRange) : BOOLEAN ;
+BEGIN
+   WHILE r#NIL DO
+      WITH r^ DO
+         IF NOT (IsSolvedGCC(low) AND IsSolvedGCC(high))
+         THEN
+            RETURN( FALSE )
+         END
+      END ;
+      r := r^.next
+   END ;
+   RETURN( TRUE )
+END ElementsSolved ;
+
+
+(*
+   ArrayElementsSolved - returns TRUE if all ranges in the set have been solved.
+*)
+
+PROCEDURE ArrayElementsSolved (e: listOfElements) : BOOLEAN ;
+BEGIN
+   WHILE e#NIL DO
+      WITH e^ DO
+         IF NOT (IsSolvedGCC(element) AND IsSolvedGCC(by))
+         THEN
+            RETURN( FALSE )
+         END
+      END ;
+      e := e^.next
+   END ;
+   RETURN( TRUE )
+END ArrayElementsSolved ;
+
+
+(*
+   EvalFieldValues - returns TRUE if all fields in the record have been solved.
+*)
+
+PROCEDURE EvalFieldValues (e: listOfFields) : BOOLEAN ;
+BEGIN
+   WHILE e#NIL DO
+      WITH e^ DO
+         IF IsConst(field)
+         THEN
+            IF NOT IsSolvedGCC(field)
+            THEN
+               RETURN( FALSE )
+            END
+         ELSE
+            (* RETURN( FALSE ) *)
+         END
+      END ;
+      e := e^.next
+   END ;
+   RETURN( TRUE )
+END EvalFieldValues ;
+
+
+(*
+   Swap - swaps the contents of, i, and, j.
+*)
+
+PROCEDURE Swap (i, j: listOfRange) ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := i^.low ;
+   i^.low := j^.low ;
+   j^.low := t ;
+
+   t := i^.high ;
+   i^.high := j^.high ;
+   j^.high := t
+END Swap ;
+
+
+(*
+   DisplayElements -
+*)
+
+PROCEDURE DisplayElements (i: listOfRange) ;
+BEGIN
+   WHILE i#NIL DO
+      PushValue(i^.low) ;
+      PrintValue ;
+      Reduce ;
+      PushValue(i^.high) ;
+      PrintValue ;
+      Reduce ;
+      i := i^.next
+   END
+END DisplayElements ;
+
+
+(*
+   SortElements - sorts the list as defined by, h, into ascending range order.
+                  The low element is the sort key.
+*)
+
+PROCEDURE SortElements (tokenno: CARDINAL; h: listOfRange) ;
+VAR
+   i, j, k: listOfRange ;
+BEGIN
+   i := h ;
+   WHILE i#NIL DO
+      j := i ;
+      k := i^.next ;
+      WHILE k#NIL DO
+         PushValue(k^.low) ;
+         ConvertToInt ;
+         PushValue(j^.low) ;
+         ConvertToInt ;
+         IF Less(tokenno)
+         THEN
+            j := k ;
+         END ;
+         k := k^.next
+      END ;
+      Swap(i, j) ;
+      i := i^.next
+   END
+END SortElements ;
+
+
+(*
+   CombineElements - given a sorted list determine whether there is any
+                     overlap in the low..high bounds. If overlap exists
+                     then remove it.
+*)
+
+PROCEDURE CombineElements (tokenno: CARDINAL; r: listOfRange) ;
+VAR
+   t, j: listOfRange ;
+BEGIN
+   WHILE r#NIL DO
+      j := r^.next ;
+      WHILE j#NIL DO
+         PushValue(r^.high) ;
+         ConvertToInt ;
+         PushCard(1) ;
+         Addn ;
+         PushValue(j^.low) ;
+         ConvertToInt ;
+         IF GreEqu(tokenno)
+         THEN
+            r^.high := j^.high ;
+            t := j^.next ;
+            r^.next := j^.next ;
+            j^.next := NIL ;
+            DisposeRange(j) ;
+            j := t
+         ELSE
+            j := NIL
+         END
+      END ;
+      r := r^.next
+   END
+END CombineElements ;
+
+
+(*
+   EvalSetValues - returns TRUE if all elements in this set have been resolved.
+*)
+
+PROCEDURE EvalSetValues (tokenno: CARDINAL; r: listOfRange) : BOOLEAN ;
+BEGIN
+   IF ElementsSolved(r)
+   THEN
+      SortElements(tokenno, r) ;
+      CombineElements(tokenno, r) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END EvalSetValues ;
+
+
+(*
+   Eval - attempts to solve a constructor type.
+*)
+
+PROCEDURE Eval (tokenno: CARDINAL; v: PtrToValue) ;
+BEGIN
+   CheckNotAlreadyOnFreeList(v) ;
+   WITH v^ DO
+      IF NOT solved
+      THEN
+         IF IsSet(SkipType(constructorType))
+         THEN
+            v := CoerseTo(tokenno, set, v)
+         ELSIF IsRecord(SkipType(constructorType))
+         THEN
+            v := CoerseTo(tokenno, record, v)
+         ELSIF IsArray(SkipType(constructorType))
+         THEN
+            v := CoerseTo(tokenno, array, v)
+         END ;
+         areAllConstants := DefinedByConstants(v) ;
+         CASE type OF
+
+         set   :   Assert((constructorType=NulSym) OR IsSet(SkipType(constructorType))) ;
+                   solved := CompletelyResolved(constructorType) AND EvalSetValues(tokenno, setValue) |
+         array :   Assert((constructorType=NulSym) OR IsArray(SkipType(constructorType))) ;
+                   solved := CompletelyResolved(constructorType) AND ArrayElementsSolved(arrayValues) |
+         record:   Assert((constructorType=NulSym) OR IsRecord(SkipType(constructorType))) ;
+                   solved := CompletelyResolved(constructorType) AND EvalFieldValues(fieldValues)
+
+         ELSE
+            (* do nothing *)
+         END
+      END
+   END
+END Eval ;
+
+
+(*
+   WalkSetValueDependants -
+*)
+
+PROCEDURE WalkSetValueDependants (r: listOfRange; p: WalkAction) ;
+BEGIN
+   WHILE r#NIL DO
+      WITH r^ DO
+         p(low) ;
+         p(high)
+      END ;
+      r := r^.next
+   END
+END WalkSetValueDependants ;
+
+
+(*
+   IsSetValueDependants -
+*)
+
+PROCEDURE IsSetValueDependants (r: listOfRange; q: IsAction) : BOOLEAN ;
+VAR
+   result: BOOLEAN ;
+BEGIN
+   result := TRUE ;
+   WHILE r#NIL DO
+      WITH r^ DO
+         IF NOT q(low)
+         THEN
+            result := FALSE
+         END ;
+         IF NOT q(high)
+         THEN
+            result := FALSE
+         END
+      END ;
+      r := r^.next
+   END ;
+   RETURN( result )
+END IsSetValueDependants ;
+
+
+(*
+   WalkFieldValueDependants -
+*)
+
+PROCEDURE WalkFieldValueDependants (f: listOfFields; p: WalkAction) ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         p(field)
+      END ;
+      f := f^.next
+   END
+END WalkFieldValueDependants ;
+
+
+(*
+   IsFieldValueDependants -
+*)
+
+PROCEDURE IsFieldValueDependants (f: listOfFields; q: IsAction) : BOOLEAN ;
+VAR
+   result: BOOLEAN ;
+BEGIN
+   result := TRUE ;
+   WHILE f#NIL DO
+      WITH f^ DO
+         IF NOT q(field)
+         THEN
+            result := FALSE
+         END
+      END ;
+      f := f^.next
+   END ;
+   RETURN( result )
+END IsFieldValueDependants ;
+
+
+(*
+   WalkArrayValueDependants -
+*)
+
+PROCEDURE WalkArrayValueDependants (a: listOfElements; p: WalkAction) ;
+BEGIN
+   WHILE a#NIL DO
+      WITH a^ DO
+         p(element) ;
+         p(by)
+      END ;
+      a := a^.next
+   END
+END WalkArrayValueDependants ;
+
+
+(*
+   IsArrayValueDependants -
+*)
+
+PROCEDURE IsArrayValueDependants (a: listOfElements; q: IsAction) : BOOLEAN ;
+VAR
+   result: BOOLEAN ;
+BEGIN
+   result := TRUE ;
+   WHILE a#NIL DO
+      WITH a^ DO
+         IF NOT q(element)
+         THEN
+            result := FALSE
+         END ;
+         IF NOT q(by)
+         THEN
+            result := FALSE
+         END
+      END ;
+      a := a^.next
+   END ;
+   RETURN( result )
+END IsArrayValueDependants ;
+
+
+(*
+   IsConstructorDependants - return TRUE if all q(dependants) of,
+                             sym, return TRUE.
+*)
+
+PROCEDURE IsConstructorDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   v         : PtrToValue ;
+   typeResult,
+   result    : BOOLEAN ;
+BEGIN
+   PushValue(sym) ;
+   IF IsValueTypeNone()
+   THEN
+      v := Pop() ;
+      result := FALSE
+   ELSE
+      v := Pop() ;
+      WITH v^ DO
+         typeResult := q(constructorType) ;
+         CASE type OF
+
+         none       :  result := FALSE |
+         set        :  result := IsSetValueDependants(setValue, q) |
+         constructor,
+         record     :  result := IsFieldValueDependants(fieldValues, q) |
+         array      :  result := IsArrayValueDependants(arrayValues, q)
+
+         ELSE
+            InternalError ('not expecting this type')
+         END ;
+         result := result AND typeResult
+      END
+   END ;
+   RETURN( result )
+END IsConstructorDependants ;
+
+
+(*
+   WalkConstructorDependants - walk the constructor, sym, calling
+                               p for each dependant.
+*)
+
+PROCEDURE WalkConstructorDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   PushValue(sym) ;
+   IF IsValueTypeNone()
+   THEN
+      v := Pop()
+   ELSE
+      v := Pop() ;
+      WITH v^ DO
+         p(constructorType) ;
+         CASE type OF
+
+         none       :  |
+         set        :  WalkSetValueDependants(setValue, p) |
+         constructor,
+         record     :  WalkFieldValueDependants(fieldValues, p) |
+         array      :  WalkArrayValueDependants(arrayValues, p)
+
+         ELSE
+            InternalError ('not expecting this type')
+         END
+      END
+   END
+END WalkConstructorDependants ;
+
+
+(*
+   PutConstructorSolved - records that this constructor is solved.
+*)
+
+PROCEDURE PutConstructorSolved (sym: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   PushValue(sym) ;
+   v := Pop() ;
+   v^.solved := TRUE ;
+   Push(v) ;
+   PopValue(sym)
+END PutConstructorSolved ;
+
+
+(*
+   EvaluateValue - attempts to evaluate the symbol, sym, value.
+*)
+
+PROCEDURE EvaluateValue (sym: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   PushValue(sym) ;
+   v := Pop() ;
+   Eval(GetDeclaredMod(sym), v) ;
+   Push(v) ;
+   PopValue(sym)
+END EvaluateValue ;
+
+
+(*
+   TryEvaluateValue - attempts to evaluate the symbol, sym, value.
+*)
+
+PROCEDURE TryEvaluateValue (sym: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   PushValue(sym) ;
+   v := Pop() ;
+   WITH v^ DO
+      CASE type OF
+
+      set, array, record:  IF v^.constructorType=NulSym
+                           THEN
+                              (* must wait *)
+                              RETURN
+                           ELSE
+                              Eval(GetDeclaredMod(sym), v)
+                           END
+
+      ELSE
+         (* nothing to do *)
+      END ;
+      IF solved
+      THEN
+         Push(v) ;
+         PopValue(sym)
+      END
+   END
+END TryEvaluateValue ;
+
+
+(*
+   DefinedByConstants - returns TRUE if the value, v, is defined by constants.
+                        It assigns, v^.areAllConstants, with the result.
+*)
+
+PROCEDURE DefinedByConstants (v: PtrToValue) : BOOLEAN ;
+BEGIN
+   WITH v^ DO
+      CASE type OF
+
+      none,
+      integer,
+      real,
+      complex    :  areAllConstants := TRUE |
+      set        :  areAllConstants := rangeConstant(setValue) |
+      constructor,
+      record     :  areAllConstants := fieldsConstant(fieldValues) |
+      array      :  areAllConstants := arrayConstant(arrayValues)
+
+      ELSE
+         InternalError ('unexpected type')
+      END ;
+      RETURN( areAllConstants )
+   END
+END DefinedByConstants ;
+
+
+(*
+   rangeConstant - returns TRUE if all the range entities are constant.
+*)
+
+PROCEDURE rangeConstant (r: listOfRange) : BOOLEAN ;
+BEGIN
+   WHILE r#NIL DO
+      IF (NOT IsConst(r^.low)) OR (NOT IsConst(r^.high))
+      THEN
+         RETURN( FALSE )
+      END ;
+      r := r^.next ;
+   END ;
+   RETURN( TRUE )
+END rangeConstant ;
+
+
+(*
+   fieldsConstant - returns TRUE if all the field entities are constant.
+*)
+
+PROCEDURE fieldsConstant (f: listOfFields) : BOOLEAN ;
+BEGIN
+   WHILE f#NIL DO
+      IF NOT IsConst(f^.field)
+      THEN
+         RETURN( FALSE )
+      END ;
+      f := f^.next
+   END ;
+   RETURN( TRUE )
+END fieldsConstant ;
+
+
+(*
+   arrayConstant - returns TRUE if the, element, and, by, components
+                   of an array constructor are constant.
+*)
+
+PROCEDURE arrayConstant (e: listOfElements) : BOOLEAN ;
+BEGIN
+   WHILE e#NIL DO
+      IF (NOT IsConst(e^.element)) AND (NOT IsConst(e^.by))
+      THEN
+         RETURN( FALSE )
+      END ;
+      e := e^.next
+   END ;
+   RETURN( TRUE )
+END arrayConstant ;
+
+
+(*
+   FindValueEnum -
+*)
+
+PROCEDURE FindValueEnum (field: WORD) ;
+BEGIN
+   PushValue(field) ;
+   PushIntegerTree(EnumerationValue) ;
+   IF Equ(CurrentTokenNo)
+   THEN
+      EnumerationField := field
+   END
+END FindValueEnum ;
+
+
+(*
+   Val - returns a GCC symbol enumeration or a GCC constant which has, value, and which is
+         of type, type.
+*)
+
+PROCEDURE Val (tokenno: CARDINAL; type: CARDINAL; value: Tree) : CARDINAL ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   IF IsEnumeration(type)
+   THEN
+      EnumerationField := NulSym ;
+      EnumerationValue := value ;
+      CurrentTokenNo := tokenno ;
+      ForeachFieldEnumerationDo(type, FindValueEnum) ;
+      IF EnumerationField=NulSym
+      THEN
+         InternalError ('enumeration value exceeds range')
+      END ;
+      RETURN( EnumerationField )
+   ELSE
+      sym := MakeTemporary(tokenno, ImmediateValue) ;
+      PutVar(sym, type) ;
+      CheckOverflow(tokenno, value) ;
+      PushIntegerTree(value) ;
+      PopValue(sym) ;
+      RETURN( sym )
+   END
+END Val ;
+
+
+(*
+   DupConst - duplicates and returns a constant, sym, but adds, offset to its value.
+*)
+
+PROCEDURE DupConst (tokenno: CARDINAL; sym: CARDINAL; offset: INTEGER) : CARDINAL ;
+BEGIN
+   PushValue(sym) ;
+   PushInt(offset) ;
+   Addn ;
+   RETURN( Val(tokenno, GetType(sym), PopIntegerTree()) )
+END DupConst ;
+
+
+(*
+   DupConstAndAdd - duplicates and returns a constant, sym,
+                    but adds the symbol, extra.
+*)
+
+PROCEDURE DupConstAndAdd (tokenno: CARDINAL;
+                          sym: CARDINAL; extra: Tree) : CARDINAL ;
+BEGIN
+   PushValue(sym) ;
+   PushIntegerTree(extra) ;
+   Addn ;
+   RETURN( Val(tokenno, GetType(sym), PopIntegerTree()) )
+END DupConstAndAdd ;
+
+
+(*
+   DupConstAndAddMod - duplicates and returns a constant, sym,
+                       but adds the symbol, extra, and ensures that
+                       the result in within limits: min..max using
+                       modulo arithmetic.
+*)
+
+PROCEDURE DupConstAndAddMod (tokenno: CARDINAL;
+                             sym: CARDINAL; extra: Tree;
+                             l, h: CARDINAL) : CARDINAL ;
+BEGIN
+   (* result := (((sym-l) + extra) MOD (h-l)) + l) *)
+   PushValue(sym) ;
+   PushValue(l) ;
+   Sub ;
+   PushIntegerTree(extra) ;
+   Addn ;
+   PushValue(h) ;
+   PushValue(l) ;
+   Sub ;
+   ModTrunc ;
+   PushValue(l) ;
+   Addn ;
+   RETURN( Val(tokenno, GetType(sym), PopIntegerTree()) )
+END DupConstAndAddMod ;
+
+
+(*
+   Remove - removes, v, from list, h.
+*)
+
+PROCEDURE Remove (VAR h: listOfRange; v: listOfRange) ;
+VAR
+   i: listOfRange ;
+BEGIN
+   IF h=v
+   THEN
+      h := h^.next
+   ELSE
+      i := h ;
+      WHILE (i#NIL) AND (i^.next#v) DO
+         i := i^.next
+      END ;
+      IF i=NIL
+      THEN
+         InternalError ('expecting v to be on the list')
+      ELSE
+         i := v^.next
+      END
+   END ;
+   v^.next := NIL ;
+   DisposeRange(v)
+END Remove ;
+
+
+(*
+   RemoveBit - remove bit, op1, from range, v, on list, h.
+*)
+
+PROCEDURE RemoveBit (tokenno: CARDINAL; VAR h: listOfRange; v: listOfRange; op1: CARDINAL) ;
+BEGIN
+   WITH v^ DO
+      PushValue(low) ;
+      PushValue(high) ;
+      IF Equ(tokenno)
+      THEN
+         (* single bit in this range *)
+         PushValue(low) ;
+         PushValue(op1) ;
+         IF Equ(tokenno)
+         THEN
+            (* remove entry *)
+            Remove(h, v) ;
+            RETURN
+         END
+      ELSE
+         (* is op1 equal to low? *)
+         PushValue(op1) ;
+         PushValue(low) ;
+         IF Equ(tokenno)
+         THEN
+            low := DupConst(tokenno, low, 1)
+         ELSE
+            PushValue(op1) ;
+            PushValue(high) ;
+            IF Equ(tokenno)
+            THEN
+               high := DupConst(tokenno, high, -1)
+            ELSE
+               high := DupConst(tokenno, op1, -1) ;
+               h := AddRange(h, DupConst(tokenno, op1, 1), high) ;
+               SortElements(tokenno, h)
+            END
+         END
+      END
+   END
+END RemoveBit ;
+
+
+(*
+   PerformSubBit -
+*)
+
+PROCEDURE PerformSubBit (tokenno: CARDINAL; VAR h: listOfRange; op1: CARDINAL) ;
+VAR
+   v: listOfRange ;
+BEGIN
+   v := h ;
+   WHILE v#NIL DO
+      WITH v^ DO
+         PushValue(low) ;
+         PushValue(op1) ;
+         IF LessEqu(tokenno)
+         THEN
+            PushValue(op1) ;
+            PushValue(high) ;
+            IF LessEqu(tokenno)
+            THEN
+               RemoveBit(tokenno, h, v, op1) ;
+               RETURN
+            END
+         END
+      END ;
+      v := v^.next
+   END
+END PerformSubBit ;
+
+
+(*
+   SubBit - removes a bit op1 from the underlying set. EXCL(Set, Op1)
+
+            Ptr ->
+                                                      <- Ptr
+                   +------------+      +------------+
+                   | Set        |      | Set        |
+                   |------------|      |------------|
+*)
+
+PROCEDURE SubBit (tokenno: CARDINAL; op1: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   IF v^.type=set
+   THEN
+      Eval(tokenno, v) ;
+      WITH v^ DO
+         IF solved
+         THEN
+            IF IsSolvedGCC(op1)
+            THEN
+               PerformSubBit(tokenno, setValue, op1) ;
+               solved := FALSE
+            ELSE
+               InternalError ('can only subtract a bit from a set when the bit value is known')
+            END
+         ELSE
+            InternalError ('can only subtract a bit from a set when the set value is known')
+         END
+      END ;
+      Eval(tokenno, v)
+   ELSE
+      InternalError ('expecting set type constant')
+   END ;
+   Push(v)
+END SubBit ;
+
+
+(*
+   PerformSetIn - returns TRUE if op1 is in set.
+*)
+
+PROCEDURE PerformSetIn (tokenno: CARDINAL; op1: CARDINAL; h: listOfRange) : BOOLEAN ;
+BEGIN
+   WHILE h#NIL DO
+      WITH h^ DO
+         PushValue(op1) ;
+         ConvertToInt ;
+         PushValue(low) ;
+         ConvertToInt ;
+         IF GreEqu(tokenno)
+         THEN
+            PushValue(op1) ;
+            PushValue(high) ;
+            IF LessEqu(tokenno)
+            THEN
+               RETURN( TRUE )
+            END
+         ELSE
+            (* op1 is smaller than this and all subsequent ranges *)
+            RETURN( FALSE )
+         END
+      END ;
+      h := h^.next
+   END ;
+   RETURN( FALSE )
+END PerformSetIn ;
+
+
+(*
+   SetIn - returns true if Op2 IN Op1
+
+           The Stack:
+
+           Entry             Exit
+
+    Ptr ->
+           +------------+
+           | Set        |
+           |------------|    Empty
+
+           RETURN( Op1 IN Set )
+*)
+
+PROCEDURE SetIn (tokenno: CARDINAL; Op1: CARDINAL) : BOOLEAN ;
+VAR
+   Set   : PtrToValue ;
+   result: BOOLEAN ;
+BEGIN
+   Set := Pop() ;
+   IF Set^.type#set
+   THEN
+      InternalError ('expecting ALU operand to be a set')
+   END ;
+   Eval(tokenno, Set) ;
+   IF IsSolvedGCC(Op1) AND Set^.solved
+   THEN
+      result := PerformSetIn(tokenno, Op1, Set^.setValue)
+   ELSE
+      InternalError ('one or more operands have not been resolved')
+   END ;
+   Dispose(Set) ;
+   RETURN( result )
+END SetIn ;
+
+
+(*
+   SetOp - perform the function doOp on the top two elements of the stack.
+*)
+
+PROCEDURE SetOp (tokenno: CARDINAL; doOp: DoSetProcedure) ;
+VAR
+   Result,
+   Set1, Set2: PtrToValue ;
+BEGIN
+   Set1 := Pop() ;
+   Set2 := Pop() ;
+   Eval(tokenno, Set1) ;
+   Eval(tokenno, Set2) ;
+   IF NOT (Set1^.solved AND Set2^.solved)
+   THEN
+      InternalError ('one or more operands have not been resolved')
+   END ;
+   IF Set1^.type#set
+   THEN
+      InternalError ('expecting type of constant to be a set')
+   END ;
+   IF Set2^.type#set
+   THEN
+      InternalError ('expecting type of constant to be a set')
+   END ;
+   Result := New() ;
+   WITH Result^ DO
+      type            := set ;
+      setValue        := doOp(tokenno, Set1^.setValue, Set2^.setValue) ;
+      constructorType := MixTypes(Set1^.constructorType,
+                                  Set2^.constructorType, tokenno) ;
+      solved          := FALSE
+   END ;
+   (* Set1 and Set2 have given their range lists to the Result *)
+   Set1^.setValue := NIL ;
+   Set2^.setValue := NIL ;
+   Eval(tokenno, Result) ;
+   Push(Result) ;
+   Dispose(Set1) ;
+   Dispose(Set2)
+END SetOp ;
+
+
+(*
+   PerformOr - performs a logical OR between the two ranges.
+               The ranges, r1, r2, are destroyed.
+*)
+
+PROCEDURE PerformOr (tokenno: CARDINAL; r1, r2: listOfRange) : listOfRange ;
+VAR
+   i: listOfRange ;
+BEGIN
+   i := r1 ;
+   WHILE (i#NIL) AND (i^.next#NIL) DO
+      i := i^.next
+   END ;
+   IF i=NIL
+   THEN
+      r1 := r2
+   ELSE
+      i^.next := r2
+   END ;
+   SortElements(tokenno, r1) ;
+   CombineElements(tokenno, r1) ;
+   RETURN( r1 )
+END PerformOr ;
+
+
+(*
+   SetOr -  performs an inclusive OR of the top two elements on the stack.
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Set1       |                   <- Ptr
+            |------------|    +------------+
+            | Set2       |    | Set1 + Set2|
+            |------------|    |------------|
+
+*)
+
+PROCEDURE SetOr (tokenno: CARDINAL) ;
+BEGIN
+   SetOp(tokenno, PerformOr)
+END SetOr ;
+
+
+(*
+   Min - returns the symbol which has the least value.
+*)
+
+PROCEDURE Min (tokenno: CARDINAL; a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   PushValue(a) ;
+   ConvertToInt ;
+   PushValue(b) ;
+   ConvertToInt ;
+   IF Less(tokenno)
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+(*
+   Max - returns the symbol which has the greatest value.
+*)
+
+PROCEDURE Max (tokenno: CARDINAL; a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   PushValue(a) ;
+   ConvertToInt ;
+   PushValue(b) ;
+   ConvertToInt ;
+   IF Gre(tokenno)
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Max ;
+
+
+(*
+   IsRangeIntersection - returns TRUE if ranges, r1, and, r2, intersect.
+*)
+
+PROCEDURE IsRangeIntersection (tokenno: CARDINAL; r1, r2: listOfRange) : BOOLEAN ;
+BEGIN
+   IF (r1=NIL) OR (r2=NIL)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      (* easier to prove NOT outside limits *)
+      PushValue(r1^.low) ;
+      ConvertToInt ;
+      PushValue(r2^.high) ;
+      ConvertToInt ;
+      IF Gre(tokenno)
+      THEN
+         RETURN( FALSE )
+      ELSE
+         PushValue(r1^.high) ;
+         ConvertToInt ;
+         PushValue(r2^.low) ;
+         ConvertToInt ;
+         IF Less(tokenno)
+         THEN
+            RETURN( FALSE )
+         ELSE
+            RETURN( TRUE )
+         END
+      END
+   END
+END IsRangeIntersection ;
+
+
+(*
+   IsRangeLess - returns TRUE if r1^.low is < r2^.low
+*)
+
+PROCEDURE IsRangeLess (tokenno: CARDINAL; r1, r2: listOfRange) : BOOLEAN ;
+BEGIN
+   IF (r1=NIL) OR (r2=NIL)
+   THEN
+      InternalError ('not expecting NIL ranges')
+   END ;
+   PushValue(r1^.high) ;
+   ConvertToInt ;
+   PushValue(r2^.low) ;
+   ConvertToInt ;
+   RETURN( Less(tokenno) )
+END IsRangeLess ;
+
+
+(*
+   MinTree - returns the tree symbol which has the least value.
+*)
+
+PROCEDURE MinTree (tokenno: CARDINAL; a, b: Tree) : Tree ;
+BEGIN
+   PushIntegerTree(a) ;
+   ConvertToInt ;
+   PushIntegerTree(b) ;
+   ConvertToInt ;
+   IF Less(tokenno)
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END MinTree ;
+
+
+(*
+   MaxTree - returns the symbol which has the greatest value.
+*)
+
+PROCEDURE MaxTree (tokenno: CARDINAL; a, b: Tree) : Tree ;
+BEGIN
+   PushIntegerTree(a) ;
+   ConvertToInt ;
+   PushIntegerTree(b) ;
+   ConvertToInt ;
+   IF Gre(tokenno)
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END MaxTree ;
+
+
+(*
+   IsIntersectionTree - returns TRUE if ranges, a..b, and, c..d, intersect.
+*)
+
+PROCEDURE IsIntersectionTree (tokenno: CARDINAL; a, b, c, d: Tree) : BOOLEAN ;
+BEGIN
+   (* easier to prove NOT outside limits *)
+   PushIntegerTree(a) ;
+   ConvertToInt ;
+   PushIntegerTree(d) ;
+   ConvertToInt ;
+   IF Gre(tokenno)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      PushIntegerTree(b) ;
+      ConvertToInt ;
+      PushIntegerTree(c) ;
+      ConvertToInt ;
+      IF Less(tokenno)
+      THEN
+         RETURN( FALSE )
+      ELSE
+         RETURN( TRUE )
+      END
+   END
+END IsIntersectionTree ;
+
+
+(*
+   SubTree - returns the tree value containing (a-b)
+*)
+
+PROCEDURE SubTree (a, b: Tree) : Tree ;
+BEGIN
+   PushIntegerTree(a) ;
+   PushIntegerTree(b) ;
+   Sub ;
+   RETURN( PopIntegerTree() )
+END SubTree ;
+
+
+(*
+   PerformAnd - performs a logical AND between the two ranges.
+                The ranges, r1, r2, are unaltered.
+*)
+
+PROCEDURE PerformAnd (tokenno: CARDINAL; r1, r2: listOfRange) : listOfRange ;
+VAR
+   r: listOfRange ;
+BEGIN
+   r := NIL ;
+   WHILE (r1#NIL) AND (r2#NIL) DO
+      IF IsRangeIntersection(tokenno, r1, r2)
+      THEN
+         r := AddRange(r, Max(tokenno, r1^.low, r2^.low), Min(tokenno, r1^.high, r2^.high)) ;
+         IF r^.high=r1^.high
+         THEN
+            r1 := r1^.next
+         ELSE
+            r2 := r2^.next
+         END
+      ELSIF IsRangeLess(tokenno, r1, r2)
+      THEN
+         (* move r1 onto the next range *)
+         r1 := r1^.next
+      ELSE
+         (* move r2 onto the next range *)
+         r2 := r2^.next
+      END
+   END ;
+   RETURN( r )
+END PerformAnd ;
+
+
+(*
+   SetAnd - performs a set AND the top two elements on the stack.
+
+            The Stack:
+
+            Entry             Exit
+
+     Ptr ->
+            +------------+
+            | Op1        |                   <- Ptr
+            |------------|    +------------+
+            | Op2        |    | Op2 * Op1  |
+            |------------|    |------------|
+*)
+
+PROCEDURE SetAnd (tokenno: CARDINAL) ;
+BEGIN
+   SetOp(tokenno, PerformAnd)
+END SetAnd ;
+
+
+(*
+   SetDifference - performs a set difference of the top two elements on the stack.
+                   For each member in the set
+                      if member in Op2 and not member in Op1
+
+                   The Stack:
+
+                   Entry             Exit
+
+            Ptr ->
+                   +------------+
+                   | Op1        |                   <- Ptr
+                   |------------|    +-------------------+
+                   | Op2        |    | Op2 and (not Op1) |
+                   |------------|    |-------------------|
+*)
+
+PROCEDURE SetDifference (tokenno: CARDINAL) ;
+VAR
+   Set1, Set2: PtrToValue ;
+BEGIN
+   Set1 := Pop() ;
+   Set2 := Pop() ;
+   Eval(tokenno, Set1) ;
+   Eval(tokenno, Set2) ;
+   IF NOT (Set1^.solved AND Set2^.solved)
+   THEN
+      InternalError ('one or more operands have not been resolved')
+   END ;
+   IF Set1^.setValue=NIL
+   THEN
+      (* null set, return Set2 *)
+      Push(Set1) ;
+   ELSE
+      Push(Set1) ;
+      SetNegate(tokenno) ;
+      Push(Set2) ;
+      SetAnd(tokenno)
+   END
+END SetDifference ;
+
+
+(*
+   SetSymmetricDifference - performs a set difference of the top two elements on the stack.
+
+                            The Stack:
+
+                            Entry             Exit
+
+                     Ptr ->
+                            +------------+
+                            | Op1        |                    <- Ptr
+                            |------------|    +-------------+
+                            | Op2        |    | Op2 xor Op1 |
+                            |------------|    |-------------|
+*)
+
+PROCEDURE SetSymmetricDifference (tokenno: CARDINAL) ;
+VAR
+   Set1, Set2: PtrToValue ;
+BEGIN
+   Set1 := Pop() ;
+   Set2 := Pop() ;
+   Eval(tokenno, Set1) ;
+   Eval(tokenno, Set2) ;
+   IF NOT (Set1^.solved AND Set2^.solved)
+   THEN
+      InternalError ('one or more operands have not been resolved')
+   END ;
+   IF Set1^.setValue=NIL
+   THEN
+      Dispose(Set1) ;
+      Push(Set2)
+   ELSIF Set2^.setValue=NIL
+   THEN
+      Dispose(Set2) ;
+      Push(Set1)
+   ELSE
+      (* Set1 or Set2 and (not (Set1 and Set2)) *)
+      PushFrom(Set1) ;
+      PushFrom(Set2) ;
+      SetAnd(tokenno) ;
+      SetNegate(tokenno) ;
+      Push(Set1) ;
+      Push(Set2) ;
+      SetOr(tokenno) ;
+      SetAnd(tokenno)
+   END
+END SetSymmetricDifference ;
+
+
+(*
+   SetShift - if op1 is positive
+              then
+                 result := op2 << op1
+              else
+                 result := op2 >> op1
+              fi
+
+
+              The Stack:
+
+                     Entry             Exit
+
+              Ptr ->
+                     +------------+
+                     | Op1        |                   <- Ptr
+                     |------------|    +------------+
+                     | Op2        |    | result     |
+                     |------------|    |------------|
+
+*)
+
+PROCEDURE SetShift (tokenno: CARDINAL) ;
+VAR
+   res,
+   Shift,
+   Set    : PtrToValue ;
+   n      : CARDINAL ;
+   r1, r2 : CARDINAL ;
+BEGIN
+   IF NOT IsValueTypeInteger()
+   THEN
+      InternalError ('expecting integer type')
+   END ;
+   Shift := Pop() ;
+   IF NOT IsValueTypeSet()
+   THEN
+      InternalError ('expecting set type')
+   END ;
+   Set := Pop() ;
+   Eval(tokenno, Set) ;
+   IF NOT Set^.solved
+   THEN
+      InternalError ('set has not been resolved')
+   END ;
+   IF Set^.setValue=NIL
+   THEN
+      Push(Set)
+   ELSE
+      res := New() ;
+      res^ := Set^ ;
+      WITH res^ DO
+         setValue := NIL ;
+         n := 1 ;
+         WHILE GetRange(Set, n, r1, r2) DO
+            setValue := AddRange(setValue,
+                                 DupConstAndAdd(tokenno, r1, Shift),
+                                 DupConstAndAdd(tokenno, r2, Shift)) ;
+            INC(n)
+         END ;
+         Push(res) ;
+         IF constructorType#NulSym
+         THEN
+            PushNulSet(constructorType) ;
+            SetNegate(tokenno) ;
+            SetAnd(tokenno)
+         END
+      END ;
+      Dispose(Set)
+   END
+END SetShift ;
+
+
+(*
+   SetRotate - if op1 is positive
+               then
+                  result := ROTATERIGHT(op2, op1)
+               else
+                  result := ROTATELEFT(op2, op1)
+               fi
+
+
+               The Stack:
+
+                      Entry             Exit
+
+               Ptr ->
+                      +------------+
+                      | Op1        |                   <- Ptr
+                      |------------|    +------------+
+                      | Op2        |    | result     |
+                      |------------|    |------------|
+*)
+
+PROCEDURE SetRotate (tokenno: CARDINAL) ;
+VAR
+   res,
+   Rotate,
+   Set    : PtrToValue ;
+   n      : CARDINAL ;
+   l, h,
+   type,
+   r1, r2 : CARDINAL ;
+BEGIN
+   IF NOT IsValueTypeInteger()
+   THEN
+      InternalError ('expecting integer type')
+   END ;
+   Rotate := Pop() ;
+   IF NOT IsValueTypeSet()
+   THEN
+      InternalError ('expecting set type')
+   END ;
+   Set := Pop() ;
+   Eval(tokenno, Set) ;
+   IF NOT Set^.solved
+   THEN
+      InternalError ('set has not been resolved')
+   END ;
+   IF Set^.setValue=NIL
+   THEN
+      Push(Set)
+   ELSE
+      type := Set^.constructorType ;
+      IF type=NulSym
+      THEN
+         MetaErrorT0 (tokenno, 'cannot perform a ROTATE on a generic set') ;
+         Push(Set) ;
+         RETURN
+      END ;
+      l := GetTypeMin(type) ;
+      h := GetTypeMax(type) ;
+      res := New() ;
+      res^ := Set^ ;
+      WITH res^ DO
+         setValue := NIL ;
+         n := 1 ;
+         WHILE GetRange(Set, n, r1, r2) DO
+            setValue := AddRange(setValue,
+                                 DupConstAndAddMod(tokenno, r1, Rotate, l, h),
+                                 DupConstAndAddMod(tokenno, r2, Rotate, l, h)) ;
+            INC(n)
+         END
+      END ;
+      Push(res) ;
+      Dispose(Set)
+   END
+END SetRotate ;
+
+
+(*
+   GetValue - returns and pops the value from the top of stack.
+*)
+
+PROCEDURE GetValue (tokenno: CARDINAL) : PtrToValue ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   Eval(tokenno, v) ;
+   RETURN( v )
+END GetValue ;
+
+
+(*
+   GetRange - returns TRUE if range number, n, exists in the value, v.
+              A non empty set is defined by having 1..N ranges
+*)
+
+PROCEDURE GetRange (v: PtrToValue; n: CARDINAL; VAR low, high: CARDINAL) : BOOLEAN ;
+VAR
+   l: listOfRange ;
+BEGIN
+   WITH v^ DO
+      IF type#set
+      THEN
+         InternalError ('expecting set constant')
+      END ;
+      l := setValue ;
+      WHILE n>1 DO
+         IF l=NIL
+         THEN
+            RETURN( FALSE )
+         END ;
+         l := l^.next ;
+         DEC(n)
+      END ;
+      IF l=NIL
+      THEN
+         RETURN( FALSE )
+      END ;
+      low := l^.low ;
+      high := l^.high
+   END ;
+   RETURN( TRUE )
+END GetRange ;
+
+
+(*
+   BuildStructBitset - v is the PtrToValue.
+                       low and high are the limits of the subrange.
+*)
+
+PROCEDURE BuildStructBitset (tokenno: CARDINAL; v: PtrToValue; low, high: Tree) : Tree ;
+VAR
+   BitsInSet : Tree ;
+   bpw       : CARDINAL ;
+   cons      : Constructor ;
+BEGIN
+   PushIntegerTree(low) ;
+   ConvertToInt ;
+   low := PopIntegerTree() ;
+   PushIntegerTree(high) ;
+   ConvertToInt ;
+   high := PopIntegerTree() ;
+   bpw  := GetBitsPerBitset() ;
+
+   PushIntegerTree(high) ;
+   PushIntegerTree(low) ;
+   Sub ;
+   PushCard(1) ;
+   Addn ;
+   BitsInSet := PopIntegerTree() ;
+
+   cons := BuildStartSetConstructor(Mod2Gcc(v^.constructorType)) ;
+
+   PushIntegerTree(BitsInSet) ;
+   PushCard(0) ;
+   WHILE Gre(tokenno) DO
+      PushIntegerTree(BitsInSet) ;
+      PushCard(bpw-1) ;
+      IF GreEqu(tokenno)
+      THEN
+         PushIntegerTree(low) ;
+         PushCard(bpw-1) ;
+         Addn ;
+
+         BuildSetConstructorElement(cons, BuildBitset(tokenno, v, low, PopIntegerTree())) ;
+
+         PushIntegerTree(low) ;
+         PushCard(bpw) ;
+         Addn ;
+         low := PopIntegerTree() ;
+         PushIntegerTree(BitsInSet) ;
+         PushCard(bpw) ;
+         Sub ;
+         BitsInSet := PopIntegerTree()
+      ELSE
+         (* printf2('range is %a..%a\n', GetSymName(low), GetSymName(high)) ; *)
+
+         BuildSetConstructorElement(cons, BuildBitset(tokenno, v, low, high)) ;
+
+         PushCard(0) ;
+         BitsInSet := PopIntegerTree()
+      END ;
+      PushIntegerTree(BitsInSet) ;
+      PushCard(0)
+   END ;
+   RETURN( BuildEndSetConstructor(cons) )
+END BuildStructBitset ;
+
+
+(*
+   ConstructLargeOrSmallSet - generates a constant representing the set value of the symbol, sym.
+                              We manufacture the constant by using a initialization
+                              structure of cardinals.
+
+                              { (cardinal), (cardinal) etc }
+*)
+
+PROCEDURE ConstructLargeOrSmallSet (tokenno: CARDINAL; v: PtrToValue; low, high: CARDINAL) : Tree ;
+BEGIN
+   PushValue(high) ;
+   ConvertToInt ;
+   PushValue(low) ;
+   ConvertToInt ;
+   Sub ;
+   PushCard(GetBitsPerBitset()) ;
+   IF Less(tokenno)
+   THEN
+      (* small set *)
+      RETURN( BuildBitset(tokenno, v, Mod2Gcc(low), Mod2Gcc(high)) )
+   ELSE
+      (* large set *)
+      RETURN( BuildStructBitset(tokenno, v, Mod2Gcc(low), Mod2Gcc(high)) )
+   END
+END ConstructLargeOrSmallSet ;
+
+
+(*
+   ConstructSetConstant - builds a struct of integers which represents the
+                          set const as defined by, v.
+*)
+
+PROCEDURE ConstructSetConstant (tokenno: CARDINAL; v: PtrToValue) : Tree ;
+VAR
+   n1, n2   : Name ;
+   gccsym   : Tree ;
+   baseType,
+   high, low: CARDINAL ;
+BEGIN
+   WITH v^ DO
+      IF constructorType=NulSym
+      THEN
+         InternalError ('set type must be known in order to generate a constant')
+      ELSE
+         baseType := SkipType(GetType(constructorType)) ;
+         IF Debugging
+         THEN
+            n1 := GetSymName(constructorType) ;
+            n2 := GetSymName(baseType) ;
+            printf2('ConstructSetConstant of type %a and baseType %a\n', n1, n2)
+         END ;
+         IF IsSubrange(baseType)
+         THEN
+            GetSubrange(baseType, high, low) ;
+            gccsym := ConstructLargeOrSmallSet(tokenno, v, low, high)
+         ELSE
+            gccsym := ConstructLargeOrSmallSet(tokenno, v, GetTypeMin(baseType), GetTypeMax(baseType))
+         END ;
+         RETURN( gccsym )
+      END
+   END
+END ConstructSetConstant ;
+
+
+(*
+   ConvertConstToType - returns a Tree containing an initialiser,
+                        init, ready to be assigned to a record or
+                        array constructor.
+*)
+
+PROCEDURE ConvertConstToType (tokenno: CARDINAL; field: CARDINAL; init: CARDINAL) : Tree ;
+VAR
+   initT,
+   nBytes: Tree ;
+BEGIN
+   IF IsConstString(init) AND IsArray(SkipType(GetType(field))) AND
+      (SkipTypeAndSubrange(GetType(GetType(field)))=Char)
+   THEN
+      DoCopyString(tokenno, nBytes, initT, GetType(field), init) ;
+      RETURN( initT )
+   ELSE
+      RETURN( ConvertConstantAndCheck(TokenToLocation(tokenno), Mod2Gcc(GetType(field)), Mod2Gcc(init)) )
+   END
+END ConvertConstToType ;
+
+
+(*
+   ConstructRecordConstant - builds a struct initializer, as defined by, v.
+*)
+
+PROCEDURE ConstructRecordConstant (tokenno: CARDINAL; v: PtrToValue) : Tree ;
+VAR
+   n1, n2      : Name ;
+   i,
+   Field,
+   baseType    : CARDINAL ;
+   cons        : Constructor ;
+BEGIN
+   WITH v^ DO
+      IF constructorType=NulSym
+      THEN
+         InternalError ('record type must be known in order to generate a constant')
+      ELSE
+         baseType := SkipType(constructorType) ;
+         IF Debugging
+         THEN
+            n1 := GetSymName(constructorType) ;
+            n2 := GetSymName(baseType) ;
+            printf2('ConstructRecordConstant of type %a and baseType %a\n', n1, n2)
+         END ;
+         cons := BuildStartRecordConstructor(Mod2Gcc(baseType)) ;
+         i := 1 ;
+         REPEAT
+            Field := GetNth(baseType, i) ;
+            IF Field#NulSym
+            THEN
+               IF GccKnowsAbout(GetType(Field))
+               THEN
+                  BuildRecordConstructorElement(cons, ConvertConstToType(tokenno, Field, GetConstructorField(v, i)))
+               ELSE
+                  MetaErrorT0 (tokenno, 'trying to construct a compound literal and using a record field which does not exist')
+               END
+            END ;
+            INC(i)
+         UNTIL Field=NulSym ;
+         RETURN( BuildEndRecordConstructor(cons) )
+      END
+   END
+END ConstructRecordConstant ;
+
+
+(*
+   GetConstructorField - returns a symbol containing the constructor field, i.
+*)
+
+PROCEDURE GetConstructorField (v: PtrToValue; i: CARDINAL) : CARDINAL ;
+VAR
+   j: CARDINAL ;
+   f: listOfFields ;
+BEGIN
+   WITH v^ DO
+      IF type#record
+      THEN
+         InternalError ('constructor type must be a record in order to push a field')
+      ELSE
+         IF constructorType=NulSym
+         THEN
+            InternalError ('constructor type must be a record in order to push a field')
+         ELSE
+            j := 1 ;
+            f := fieldValues ;
+            WHILE (j<i) AND (f#NIL) DO
+               f := f^.next ;
+               INC(j)
+            END ;
+            IF f=NIL
+            THEN
+               MetaError1 ('the {%1EN} element does not exist in the constant compound literal', i) ;
+               RETURN( NulSym )
+            ELSE
+               RETURN( f^.field )
+            END
+         END
+      END
+   END
+END GetConstructorField ;
+
+
+(*
+   GetConstructorElement - returns a symbol containing the array constructor element, i.
+*)
+
+PROCEDURE GetConstructorElement (tokenno: CARDINAL; v: PtrToValue; i: CARDINAL) : CARDINAL ;
+VAR
+   j: Tree ;
+   e: listOfElements ;
+BEGIN
+   WITH v^ DO
+      IF type#array
+      THEN
+         InternalError ('constructor type must be an array')
+      ELSE
+         IF constructorType=NulSym
+         THEN
+            InternalError ('constructor type must be an array')
+         ELSE
+            PushCard(i) ;
+            j := PopIntegerTree() ;
+            e := arrayValues ;
+            WHILE e#NIL DO
+               PushValue(e^.by) ;
+               PushIntegerTree(j) ;
+               IF GreEqu(tokenno)
+               THEN
+                  RETURN( e^.element )
+               END ;
+               PushIntegerTree(j) ;
+               ConvertToInt ;
+               PushValue(e^.by) ;
+               ConvertToInt ;
+               Sub ;
+               j := PopIntegerTree() ;
+               e := e^.next
+            END ;
+            IF e=NIL
+            THEN
+               IF IsArray(SkipType(constructorType)) AND (GetType(SkipType(constructorType))=Char)
+               THEN
+                  RETURN MakeConstLit (tokenno, MakeKey('0'), Char)
+               ELSE
+                  MetaErrorT2 (tokenno,
+                               'the {%1EN} element does not exist in the {%2ad} array declaration used by the compound literal', i, constructorType) ;
+                  RETURN NulSym
+               END
+            END
+         END
+      END
+   END
+END GetConstructorElement ;
+
+
+(*
+   IsString - returns TRUE if sym is an ARRAY [..] OF CHAR
+*)
+
+PROCEDURE IsString (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN (IsArray(sym) AND (SkipType(GetType(sym))=Char)) OR
+           IsConstString(sym) OR
+           (IsConst(sym) AND (SkipType(GetType(sym))=Char))
+END IsString ;
+
+
+(*
+   StringFitsArray -
+*)
+
+PROCEDURE StringFitsArray (arrayType, el: CARDINAL; tokenno: CARDINAL) : BOOLEAN ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   PushIntegerTree(BuildNumberOfArrayElements(location, Mod2Gcc(arrayType))) ;
+   IF IsConstString(el)
+   THEN
+      PushCard(GetStringLength(el))
+   ELSIF IsConst(el) AND (SkipType(GetType(el))=Char) AND IsValueSolved(el)
+   THEN
+      PushCard(1)
+   ELSE
+      PushCard(0) ;
+      MetaError1 ('cannot build a string using {%1Ead}', el)
+   END ;
+   RETURN GreEqu(tokenno)
+END StringFitsArray ;
+
+
+(*
+   GetArrayLimits -
+*)
+
+PROCEDURE GetArrayLimits (array: CARDINAL; VAR low, high: CARDINAL) ;
+VAR
+   Subscript,
+   Subrange : CARDINAL ;
+BEGIN
+   Subscript := GetArraySubscript(array) ;
+   Subrange := SkipType(GetType(Subscript)) ;
+   IF IsEnumeration(Subrange)
+   THEN
+      GetBaseTypeMinMax(Subrange, low, high)
+   ELSE
+      GetSubrange(Subrange, high, low)
+   END
+END GetArrayLimits ;
+
+
+(*
+   InitialiseArrayOfCharWithString -
+*)
+
+PROCEDURE InitialiseArrayOfCharWithString (tokenno: CARDINAL; cons: Tree;
+                                           el, baseType, arrayType: CARDINAL) : Tree ;
+VAR
+   isChar   : BOOLEAN ;
+   s, letter: String ;
+   i, l     : CARDINAL ;
+   high, low: CARDINAL ;
+   value,
+   indice   : Tree ;
+   location : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   GetArrayLimits(baseType, low, high) ;
+   l := 0 ;
+   s := NIL ;
+   IF IsConstString(el)
+   THEN
+      isChar := FALSE ;
+      s := InitStringCharStar(KeyToCharStar(GetString(el))) ;
+      l := GetStringLength(el)
+   ELSIF IsConst(el) AND (SkipType(GetType(el))=Char) AND IsValueSolved(el)
+   THEN
+      isChar := TRUE
+   ELSE
+      MetaError1 ('cannot build a string using {%1Ead}', el) ;
+      isChar := FALSE
+   END ;
+   i := 0 ;
+   REPEAT
+      PushValue(low) ;
+      PushCard(i) ;
+      Addn ;
+      indice := PopIntegerTree() ;
+      letter := NIL ;
+      IF isChar
+      THEN
+         isChar := FALSE ;
+         PushValue(el) ;
+         value := PopIntegerTree()
+      ELSIF i<l
+      THEN
+         IF i+1<l
+         THEN
+            letter := Slice(s, i, i+1)
+         ELSE
+            letter := Slice(s, i, 0)
+         END ;
+         value := BuildCharConstant(location, string(letter)) ;
+      ELSE
+         letter := InitStringChar(nul) ;
+         value := BuildCharConstant(location, string(letter))
+      END ;
+      value := ConvertConstantAndCheck(location, Mod2Gcc(arrayType), value) ;
+      letter := KillString(letter) ;
+      BuildArrayConstructorElement(cons, value, indice) ;
+      PushValue(low) ;
+      PushCard(i) ;
+      Addn ;
+      PushValue(high) ;
+      INC(i)
+   UNTIL GreEqu(tokenno) ;
+   s := KillString(s) ;
+   IF NOT StringFitsArray(baseType, el, tokenno)
+   THEN
+      MetaError2 ('string {%1Ea} is too large to fit into array {%2ad}', el, baseType)
+   END ;
+(*
+   IF v#NIL
+   THEN
+      el := GetConstructorElement(tokenno, v, 2) ;
+      IF el#NulSym
+      THEN
+         MetaError1('not allowed to have multiple strings to initialise an array of characters {%1Ua}', el)
+      END
+   END ;
+*)
+   RETURN( BuildEndArrayConstructor(cons) )
+END InitialiseArrayOfCharWithString ;
+
+
+(*
+   CheckElementString -
+*)
+
+PROCEDURE CheckElementString (el, arrayType: CARDINAL; tokenno: CARDINAL) : Tree ;
+VAR
+   cons: Tree ;
+BEGIN
+   IF IsString(arrayType) AND IsString(el)
+   THEN
+      cons := BuildStartArrayConstructor(Mod2Gcc(arrayType)) ;
+      RETURN( InitialiseArrayOfCharWithString(tokenno, cons, el, arrayType, SkipType(GetType(arrayType))) )
+   ELSE
+      RETURN( Mod2Gcc(el) )
+   END
+END CheckElementString ;
+
+
+(*
+   InitialiseArrayWith -
+*)
+
+PROCEDURE InitialiseArrayWith (tokenno: CARDINAL; cons: Tree;
+                               v: PtrToValue; el, high, low, arrayType: CARDINAL) : Tree ;
+VAR
+   location: location_t ;
+   i       : CARDINAL ;
+   indice,
+   value   : Tree ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   i := 0 ;
+   WHILE el#NulSym DO
+      PushValue (low) ;
+      ConvertToInt ;
+      PushInt (i) ;
+      Addn ;
+      indice := PopIntegerTree () ;
+      value := CheckElementString (el, arrayType, tokenno) ;
+      IF value = NIL
+      THEN
+         MetaErrorT0 (tokenno, '{%W}too few characters found when trying to construct a compound literal array') ;
+         value := GetCardinalZero (location)
+      END ;
+      value := ConvertConstantAndCheck (location, Mod2Gcc (arrayType), value) ;
+      BuildArrayConstructorElement (cons, value, indice) ;
+      PushValue (low) ;
+      ConvertToInt ;
+      PushInt (i) ;
+      Addn ;
+      PushValue (high) ;
+      ConvertToInt ;
+      IF GreEqu (tokenno)
+      THEN
+         RETURN BuildEndArrayConstructor (cons)
+      END ;
+      INC (i) ;
+      el := GetConstructorElement (tokenno, v, i+1)
+   END ;
+   RETURN BuildEndArrayConstructor (cons)
+END InitialiseArrayWith ;
+
+
+(*
+   CheckGetCharFromString - return TRUE if a char from the position arrayIndex in the list of
+                            constDecl elements can be extracted.  The character is returned
+                            in value.
+*)
+
+PROCEDURE CheckGetCharFromString (location: location_t;
+                                  tokenno: CARDINAL ;
+                                  constDecl: PtrToValue;
+                                  consType: CARDINAL ;
+                                  arrayIndex: CARDINAL;
+                                  VAR value: Tree) : BOOLEAN ;
+VAR
+   elementIndex: CARDINAL ;
+   element     : CARDINAL ;
+   offset,
+   totalLength : CARDINAL ;
+   key         : Name ;
+BEGIN
+   totalLength := 0 ;
+   elementIndex := 1 ;
+   REPEAT
+      element := GetConstructorElement (tokenno, constDecl, elementIndex) ;
+      offset := totalLength ;
+      IF IsConstString (element)
+      THEN
+         INC (totalLength, GetStringLength (element)) ;
+         IF totalLength > arrayIndex
+         THEN
+            key := GetString (element) ;
+            DEC (arrayIndex, offset) ;
+            value := BuildCharConstantChar (location, CharKey (key, arrayIndex)) ;
+            RETURN TRUE
+         END
+      ELSIF IsConst (element) AND (SkipType (GetType (element)) = Char) AND IsValueSolved (element)
+      THEN
+         INC (totalLength) ;
+         IF totalLength > arrayIndex
+         THEN
+            PushValue (element) ;
+            value := ConvertConstantAndCheck (location, GetM2CharType (), PopIntegerTree ()) ;
+            RETURN TRUE
+         END
+      ELSE
+         INC (totalLength) ;
+         IF totalLength > arrayIndex
+         THEN
+            MetaErrorT3 (tokenno,
+                         'expecting {%kCHAR} datatype and not {%1Ea} a {%1tad} in the {%2N} component of the {%3a} {%3d}',
+                         element, arrayIndex, consType) ;
+            value := GetCardinalZero (location) ;
+            RETURN FALSE
+         END
+      END ;
+      INC (elementIndex)
+   UNTIL element = NulSym ;
+   value := GetCardinalZero (location) ;
+   MetaErrorT2 (tokenno,
+                'unable to obtain a {%kCHAR} at the {%1EN} position in {%2ad}',
+                arrayIndex, consType) ;
+   RETURN FALSE
+END CheckGetCharFromString ;
+
+
+(*
+   InitialiseArrayOfCharWith -
+*)
+
+PROCEDURE InitialiseArrayOfCharWith (tokenno: CARDINAL; cons: Tree;
+                                     constDecl: PtrToValue;
+                                     el, high, low, consType, arrayType: CARDINAL) : Tree ;
+VAR
+   location  : location_t ;
+   arrayIndex: CARDINAL ;      (* arrayIndex is the char position index of the final string.  *)
+   indice,
+   value     : Tree ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   arrayIndex := 0 ;
+   WHILE el#NulSym DO
+      PushValue (low) ;
+      ConvertToInt ;
+      PushInt (arrayIndex) ;
+      Addn ;
+      indice := PopIntegerTree () ;
+      IF NOT CheckGetCharFromString (location, tokenno, constDecl, consType, arrayIndex, value)
+      THEN
+         (*
+         MetaErrorT2 (tokenno,
+                      'unable to obtain a {%kCHAR} at the {%1EN} position in {%2ad}',
+                      arrayIndex, consType) ;
+         *)
+      END ;
+      value := ConvertConstantAndCheck (location, Mod2Gcc (arrayType), value) ;
+      BuildArrayConstructorElement (cons, value, indice) ;
+      PushValue (low) ;
+      ConvertToInt ;
+      PushInt (arrayIndex) ;
+      Addn ;
+      PushValue (high) ;
+      ConvertToInt ;
+      IF GreEqu (tokenno)
+      THEN
+         RETURN BuildEndArrayConstructor (cons)
+      END ;
+      INC (arrayIndex)
+   END ;
+   RETURN BuildEndArrayConstructor (cons)
+END InitialiseArrayOfCharWith ;
+
+
+(*
+   ConstructArrayConstant - builds a struct initializer, as defined by, v.
+*)
+
+PROCEDURE ConstructArrayConstant (tokenno: CARDINAL; v: PtrToValue) : Tree ;
+VAR
+   n1, n2    : Name ;
+   el1, el2,
+   baseType,
+   arrayType,
+   high, low : CARDINAL ;
+   cons      : Constructor ;
+BEGIN
+   WITH v^ DO
+      IF constructorType=NulSym
+      THEN
+         InternalError ('array type must be known in order to generate a constant')
+      ELSE
+         baseType := SkipType(constructorType) ;
+         IF Debugging
+         THEN
+            n1 := GetSymName(constructorType) ;
+            n2 := GetSymName(baseType) ;
+            printf2 ('ConstructArrayConstant of type %a and baseType %a\n', n1, n2)
+         END ;
+         cons := BuildStartArrayConstructor(Mod2Gcc(baseType)) ;
+
+         GetArrayLimits(baseType, low, high) ;
+         arrayType := GetType(baseType) ;
+
+         el1 := GetConstructorElement(tokenno, v, 1) ;
+         el2 := GetConstructorElement(tokenno, v, 2) ;
+         IF (el2 = NulSym) AND IsString(baseType) AND IsString(el1)
+         THEN
+            (* constructorType is ARRAY [low..high] OF CHAR and using a string to initialise it *)
+            RETURN InitialiseArrayOfCharWithString (tokenno, cons, el1, baseType, arrayType)
+         ELSIF SkipType(arrayType)=Char
+         THEN
+            RETURN InitialiseArrayOfCharWith (tokenno, cons, v, el1, high, low, baseType, arrayType)
+         ELSE
+            RETURN InitialiseArrayWith (tokenno, cons, v, el1, high, low, arrayType)
+         END
+      END
+   END
+END ConstructArrayConstant ;
+
+
+(*
+   BuildRange - returns a integer sized constant which represents the
+                value  {e1..e2}.
+*)
+
+PROCEDURE BuildRange (tokenno: CARDINAL; e1, e2: Tree) : Tree ;
+VAR
+   c, i, t : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   PushIntegerTree(e1) ;
+   PushIntegerTree(e2) ;
+   IF Gre(tokenno)
+   THEN
+      c := e1 ;
+      e1 := e2 ;
+      e2 := c
+   END ;
+   t := Tree(NIL) ;
+   PushIntegerTree(e1) ;
+   i := PopIntegerTree() ;
+   REPEAT
+      IF t=Tree(NIL)
+      THEN
+         t := BuildLSL(location, GetWordOne(location), ToWord(location, i), FALSE)
+      ELSE
+         t := BuildLogicalOr(location, t, BuildLSL(location, GetWordOne(location), ToWord(location, i), FALSE), FALSE)
+      END ;
+      PushIntegerTree(i) ;
+      PushIntegerTree(GetIntegerOne(location)) ;
+      Addn ;
+      i := PopIntegerTree() ;
+      PushIntegerTree(i) ;
+      PushIntegerTree(e2) ;
+   UNTIL Gre(tokenno) ;
+   RETURN( t )
+END BuildRange ;
+
+
+(*
+   BuildBitset - given a set, v, construct the bitmask for its
+                 constant value which lie in the range low..high.
+*)
+
+PROCEDURE BuildBitset (tokenno: CARDINAL;
+                       v: PtrToValue; low, high: Tree) : Tree ;
+VAR
+   tl, th,
+   t       : Tree ;
+   n       : CARDINAL ;
+   r1, r2  : CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   low := ToInteger(location, low) ;
+   high := ToInteger(location, high) ;
+   n := 1 ;
+   t := GetCardinalZero(location) ;
+   WHILE GetRange(v, n, r1, r2) DO
+      PushValue(r1) ;
+      tl := ToInteger(location, PopIntegerTree()) ;
+      PushValue(r2) ;
+      th := ToInteger(location, PopIntegerTree()) ;
+      IF IsIntersectionTree(tokenno, tl, th, low, high)
+      THEN
+         tl := ToCardinal(location, SubTree(MaxTree(tokenno, tl, low), low)) ;
+         th := ToCardinal(location, SubTree(MinTree(tokenno, th, high), low)) ;
+         t := BuildLogicalOr(location, t, BuildRange(tokenno, tl, th), FALSE)
+      END ;
+      INC(n)
+   END ;
+   RETURN( ToBitset(location, t) )
+END BuildBitset ;
+
+
+(*
+   IsValueAndTreeKnown - returns TRUE if the value is known and the gcc tree
+                         is defined.
+
+                         The Stack:
+
+                                Entry             Exit
+
+                         Ptr ->
+                                +------------+
+                                | Op1        |                   <- Ptr
+                                |------------|    +------------+
+*)
+
+PROCEDURE IsValueAndTreeKnown () : BOOLEAN ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := Pop() ;
+   IF v#NIL
+   THEN
+      WITH v^ DO
+         IF solved
+         THEN
+            CASE type OF
+
+            integer,
+            real,
+            complex:  IF numberValue=NIL
+                      THEN
+                         Dispose(v) ;
+                         RETURN( FALSE )
+                      END
+            ELSE
+            END
+         ELSE
+            Dispose(v) ;
+            RETURN( FALSE )
+         END
+      END ;
+      Dispose(v)
+   END ;
+   RETURN( TRUE )
+END IsValueAndTreeKnown ;
+
+
+(*
+   CheckOverflow - tests to see whether the tree, t, has caused
+                   an overflow error and if so it generates an
+                   error message.
+*)
+
+PROCEDURE CheckOverflow (tokenno: CARDINAL; t: Tree) ;
+BEGIN
+   IF TreeOverflow (t)
+   THEN
+      MetaErrorT0 (tokenno, 'constant overflow error') ;
+      FlushErrors
+   END
+END CheckOverflow ;
+
+
+(*
+   CheckOrResetOverflow - tests to see whether the tree, t, has caused
+                          an overflow error and if so it generates an
+                          error message.
+*)
+
+PROCEDURE CheckOrResetOverflow (tokenno: CARDINAL; t: Tree; check: BOOLEAN) ;
+BEGIN
+   IF check
+   THEN
+      CheckOverflow (tokenno, t)
+   ELSE
+      t := RemoveOverflow (t)
+   END
+END CheckOrResetOverflow ;
+
+
+(*
+   PushGCCArrayTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushGCCArrayTree (gcc: Tree; t: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   WITH v^ DO
+      constructorType := t ;
+      type            := array ;
+      numberValue     := gcc ;
+      arrayValues     := NIL ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushGCCArrayTree ;
+
+
+(*
+   PushGCCSetTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushGCCSetTree (gcc: Tree; t: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   WITH v^ DO
+      constructorType := t ;
+      type            := set ;
+      numberValue     := gcc ;
+      setValue        := NIL ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushGCCSetTree ;
+
+
+(*
+   PushGCCRecordTree - pushes a gcc tree value onto the ALU stack.
+*)
+
+PROCEDURE PushGCCRecordTree (gcc: Tree; t: CARDINAL) ;
+VAR
+   v: PtrToValue ;
+BEGIN
+   v := New() ;
+   WITH v^ DO
+      constructorType := t ;
+      type            := record ;
+      numberValue     := gcc ;
+      fieldValues     := NIL ;
+      areAllConstants := TRUE ;
+      solved          := TRUE
+   END ;
+   Push(v)
+END PushGCCRecordTree ;
+
+
+(*
+   PushTypeOfTree - pushes tree, gcc, to the stack and records the
+                    front end type.
+*)
+
+PROCEDURE PushTypeOfTree (sym: CARDINAL; gcc: Tree) ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := SkipType(GetType(sym)) ;
+   IF t=NulSym
+   THEN
+      PushIntegerTree(gcc)
+   ELSIF IsComplexType(t)
+   THEN
+      PushComplexTree(gcc)
+   ELSIF IsArray(t)
+   THEN
+      PushGCCArrayTree(gcc, t)
+   ELSIF IsSet(t)
+   THEN
+      PushGCCSetTree(gcc, t)
+   ELSIF IsRecord(t)
+   THEN
+      PushGCCRecordTree(gcc, t)
+   ELSIF IsRealType(t)
+   THEN
+      PushRealTree(gcc)
+   ELSE
+      PushIntegerTree(gcc)
+   END
+END PushTypeOfTree ;
+
+
+(*
+   Init - initialises the stack and the free list.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   FreeList        := NIL ;
+   TopOfStack      := NIL ;
+   RangeFreeList   := NIL ;
+   FieldFreeList   := NIL ;
+   ElementFreeList := NIL
+END Init ;
+
+
+BEGIN
+   Init
+END M2ALU.
+(*
+ * Local variables:
+ *  compile-command: "gm2 -c -g -I.:../gm2-libs:../gm2-libs-ch:../gm2-libiberty/ M2ALU.mod"
+ * End:
+ *)
diff --git a/gcc/m2/gm2-compiler/M2AsmUtil.def b/gcc/m2/gm2-compiler/M2AsmUtil.def
new file mode 100644
index 00000000000..ab93f320de1
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2AsmUtil.def
@@ -0,0 +1,55 @@
+(* M2AsmUtil.def provides asm symbol name conversion.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2AsmUtil ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2AsmUtil
+   Date       : Thu Feb  1 15:34:08 GMT 1990
+   Description: Provides utilities relating symbols in the SymbolTable
+                to their equivalent representation in ASM format.
+*)
+
+FROM DynamicStrings IMPORT String ;
+FROM NameKey IMPORT Name ;
+EXPORT QUALIFIED GetFullSymName, GetFullScopeAsmName ;
+
+
+(*
+   GetFullSymName - returns the NameKey for the symbol name (which also
+                    may contain the module name). This is the same as
+                    GetAsmName except that it does not have the leading _
+*)
+
+PROCEDURE GetFullSymName (sym: CARDINAL) : Name ;
+
+
+(*
+   GetFullScopeAsmName - returns the fully qualified name for the symbol.
+                         This will take the format
+                         [DefImpModule|Module]_{InnerModule}_{Procedure}_SymbolName
+*)
+
+PROCEDURE GetFullScopeAsmName (sym: CARDINAL) : Name ;
+
+
+END M2AsmUtil.
diff --git a/gcc/m2/gm2-compiler/M2AsmUtil.mod b/gcc/m2/gm2-compiler/M2AsmUtil.mod
new file mode 100644
index 00000000000..3440b1d5dbf
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2AsmUtil.mod
@@ -0,0 +1,189 @@
+(* M2AsmUtil.mod provides utilities relating symbols in the SymbolTable.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2AsmUtil ;
+
+
+FROM SFIO IMPORT WriteS ;
+FROM FIO IMPORT StdOut ;
+FROM DynamicStrings IMPORT String, string, ConCat, KillString, InitString, Mark, InitStringCharStar, ConCatChar ;
+FROM StdIO IMPORT Write ;
+FROM StrIO IMPORT WriteString ;
+FROM NameKey IMPORT WriteKey, GetKey, MakeKey, makekey, KeyToCharStar ;
+FROM M2Options IMPORT WholeProgram ;
+
+FROM SymbolTable IMPORT NulSym,
+                        GetSymName,
+                        GetScope,
+                        GetBaseModule,
+                        IsInnerModule,
+                        IsVar,
+                        IsProcedure,
+                        IsModule,
+                        IsDefImp,
+                        IsExportQualified,
+                        IsExported, IsPublic, IsExtern, IsMonoName,
+                        IsDefinitionForC ;
+
+FROM M2Error IMPORT InternalError ;
+FROM m2configure IMPORT UseUnderscoreForC ;
+
+
+(*
+   StringToKey - returns a Name, from a string and destroys the string.
+*)
+
+PROCEDURE StringToKey (s: String) : Name ;
+VAR
+   k: Name ;
+BEGIN
+   k := makekey (string (s)) ;
+   s := KillString (s) ;
+   RETURN k
+END StringToKey ;
+
+
+(*
+   GetFullScopeAsmName - returns the fully qualified name for the symbol.
+                         This will take the format
+                         [DefImpModule|Module]_{InnerModule}_{Procedure}_SymbolName
+*)
+
+PROCEDURE GetFullScopeAsmName (sym: CARDINAL) : Name ;
+VAR
+   leader: String ;
+   scope : CARDINAL ;
+BEGIN
+   scope := GetScope (sym) ;
+   IF UseUnderscoreForC
+   THEN
+      leader := InitString ('_')
+   ELSE
+      leader := InitString ('')
+   END ;
+   IF IsProcedure (sym) AND IsMonoName (sym)
+   THEN
+      RETURN StringToKey (ConCat (leader, InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
+
+   ELSE
+      RETURN StringToKey (ConCat (GetFullScopePrefix (leader, scope, sym),
+                                  InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
+   END
+END GetFullScopeAsmName ;
+
+
+(*
+   GetFullSymName - returns the NameKey for the symbol name (which also
+                    may contain the module name).
+*)
+
+PROCEDURE GetFullSymName (sym: CARDINAL) : Name ;
+VAR
+   module: String ;
+   scope : CARDINAL ;
+BEGIN
+   IF IsProcedure (sym) AND IsMonoName (sym)
+   THEN
+      RETURN GetSymName (sym)
+   ELSE
+      scope := GetScope (sym) ;
+      module := GetModulePrefix (InitString (''), sym, scope) ;
+      RETURN StringToKey (ConCat (module, InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
+   END
+END GetFullSymName ;
+
+
+(*
+   SymNeedsModulePrefix -
+*)
+
+PROCEDURE SymNeedsModulePrefix (sym, mod: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsDefImp(mod)
+   THEN
+      IF WholeProgram
+      THEN
+         IF NOT IsDefinitionForC(mod)
+         THEN
+            RETURN( TRUE )
+         END
+      ELSIF IsExportQualified(sym)
+      THEN
+         RETURN( TRUE )
+      END
+   ELSIF IsModule(mod)
+   THEN
+      RETURN( WholeProgram )
+   END ;
+   RETURN( FALSE )
+END SymNeedsModulePrefix ;
+
+
+(*
+   GetModulePrefix - returns a String containing the module prefix
+                     for module, ModSym, providing symbol, Sym, is exported.
+                     Name is marked if it is appended onto the new string.
+*)
+
+PROCEDURE GetModulePrefix (Name: String; Sym, ModSym: CARDINAL) : String ;
+BEGIN
+   IF (ModSym#NulSym) AND (ModSym#GetBaseModule())
+   THEN
+      IF IsInnerModule(Sym) OR IsInnerModule(ModSym)
+      THEN
+         RETURN( ConCat(ConCatChar(InitStringCharStar(KeyToCharStar(GetSymName(ModSym))), '_'),
+                        GetModulePrefix(Name, ModSym, GetScope(ModSym))) )
+      ELSIF SymNeedsModulePrefix(Sym, ModSym)
+      THEN
+         RETURN( ConCatChar(ConCat(InitStringCharStar(KeyToCharStar(GetSymName(ModSym))), Mark(Name)), '_') )
+      END
+   END ;
+   RETURN( Name )
+END GetModulePrefix ;
+
+
+(*
+   GetFullScopePrefix - returns a String containing the full scope prefix
+                        for symbol, Sym.  It honours IsExportQualified.
+                        Name is marked if it is appended onto the new string.
+*)
+
+PROCEDURE GetFullScopePrefix (Name: String; Scope, Sym: CARDINAL) : String ;
+BEGIN
+   IF Sym#NulSym
+   THEN
+      IF IsInnerModule(Scope)
+      THEN
+         RETURN( ConCat(ConCatChar(InitStringCharStar(KeyToCharStar(GetSymName(Scope))), '_'),
+                        GetFullScopePrefix(Name, GetScope(Scope), Sym)) )
+      ELSIF IsDefImp(Scope) AND IsExportQualified(Sym)
+      THEN
+         RETURN( ConCatChar(ConCat(InitStringCharStar(KeyToCharStar(GetSymName(Scope))), Mark(Name)), '_') )
+      ELSIF IsProcedure(Scope)
+      THEN
+         RETURN( ConCatChar(ConCat(InitStringCharStar(KeyToCharStar(GetSymName(Scope))), Mark(Name)), '_') )
+      END
+   END ;
+   RETURN( Name )
+END GetFullScopePrefix ;
+
+
+END M2AsmUtil.
diff --git a/gcc/m2/gm2-compiler/M2Base.def b/gcc/m2/gm2-compiler/M2Base.def
new file mode 100644
index 00000000000..e15fd09a690
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Base.def
@@ -0,0 +1,415 @@
+(* M2Base.def provides a mechanism to check fundamental types.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Base ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Base
+   Date       : 22/5/87
+   Description: Implements the default Base Types and Base
+                procedures in the Modula-2 compiler.
+*)
+
+FROM NameKey IMPORT Name ;
+FROM m2linemap IMPORT location_t ;
+
+EXPORT QUALIFIED Nil,                   (* Base constants          *)
+                 Cardinal,              (* Base types              *)
+                 Integer,
+                 Boolean,
+                 True, False,
+                 Char,
+                 Proc,
+                 LongInt, LongCard,
+                 ShortInt, ShortCard,
+                 ZType, RType, CType,
+                 Real,
+                 LongReal, ShortReal,
+                 Complex,
+                 LongComplex,
+                 ShortComplex,
+                 High, IsOrd,           (* Base functions          *)
+                 LengthS,
+                 Convert,
+                 Re, Im, Cmplx,
+                 Cap, Abs, Odd,
+                 Chr, Val,
+                 IsTrunc, IsFloat,
+                 IsInt,
+                 Min, Max,
+                 New, Dispose,          (* Base procedures         *)
+                 Inc, Dec,
+                 Incl, Excl,
+                 IsPseudoBaseFunction,  (* Manipulation procedures *)
+                 IsPseudoBaseProcedure, (* Manipulation procedures *)
+                 IsBaseType,
+                 GetBaseTypeMinMax,
+                 InitBase,
+                 CannotCheckTypeInPass3,
+                 CheckExpressionCompatible,
+                 CheckAssignmentCompatible,
+                 CheckParameterCompatible,
+                 IsAssignmentCompatible,
+                 IsExpressionCompatible,
+                 IsParameterCompatible,
+                 IsComparisonCompatible,
+                 IsValidParameter,
+                 AssignmentRequiresWarning,
+                 IsMathType,
+                 IsRealType,
+                 IsOrdinalType,
+                 IsComplexType,
+                 GetCmplxReturnType,
+                 ComplexToScalar,
+                 ScalarToComplex,
+                 MixTypes, NegateType,
+                 TemplateProcedure,
+                 ActivationPointer,
+                 IsNeededAtRunTime,
+                 ExceptionAssign,
+                 ExceptionReturn,
+                 ExceptionInc,
+                 ExceptionDec,
+                 ExceptionIncl,
+                 ExceptionExcl,
+                 ExceptionShift,
+                 ExceptionRotate,
+                 ExceptionStaticArray,
+                 ExceptionDynamicArray,
+                 ExceptionForLoopBegin,
+                 ExceptionForLoopTo,
+                 ExceptionForLoopEnd,
+                 ExceptionPointerNil,
+                 ExceptionNoReturn,
+                 ExceptionCase,
+                 ExceptionNonPosDiv,
+                 ExceptionNonPosMod,
+                 ExceptionZeroDiv,
+                 ExceptionZeroRem,
+                 ExceptionWholeValue,
+                 ExceptionRealValue,
+                 ExceptionParameterBounds,
+                 ExceptionNo ;
+
+
+VAR
+   TemplateProcedure,
+   ActivationPointer,
+
+   Nil,
+   Cardinal, Integer,
+   Boolean, True, False,
+   Char, Proc,
+   LongInt, LongCard,
+   ShortInt, ShortCard,
+   ZType, RType, CType,
+   Real,
+   LongReal, ShortReal,
+   Complex, LongComplex,
+   ShortComplex,
+   Unbounded,
+   High, LengthS,
+   Cap, Abs, Odd,
+   Convert, Val,
+   Chr,
+   Re, Im, Cmplx,
+   Min, Max,
+   New, Dispose,
+   Inc, Dec,
+   Incl, Excl,
+   ExceptionAssign,
+   ExceptionReturn,
+   ExceptionInc,
+   ExceptionDec,
+   ExceptionIncl,
+   ExceptionExcl,
+   ExceptionShift,
+   ExceptionRotate,
+   ExceptionStaticArray,
+   ExceptionDynamicArray,
+   ExceptionForLoopBegin,
+   ExceptionForLoopTo,
+   ExceptionForLoopEnd,
+   ExceptionPointerNil,
+   ExceptionNoReturn,
+   ExceptionCase,
+   ExceptionNonPosDiv,
+   ExceptionNonPosMod,
+   ExceptionZeroDiv,
+   ExceptionZeroRem,
+   ExceptionWholeValue,
+   ExceptionRealValue,
+   ExceptionParameterBounds,
+   ExceptionNo             : CARDINAL ;
+
+
+(*
+   InitBase - initializes the base types and functions
+              used in the Modula-2 compiler.
+*)
+
+PROCEDURE InitBase (location: location_t; VAR sym: CARDINAL) ;
+
+
+(*
+   GetBaseTypeMinMax - returns the minimum and maximum values for a
+                       given base type.  This procedure should only
+                       be called if the type is NOT a subrange.
+*)
+
+PROCEDURE GetBaseTypeMinMax (type: CARDINAL; VAR min, max: CARDINAL) ;
+
+
+(*
+   IsPseudoBaseFunction - returns true if Sym is a Base function.
+*)
+
+PROCEDURE IsPseudoBaseFunction (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsPseudoBaseProcedure - returns true if Sym is a Base procedure.
+*)
+
+PROCEDURE IsPseudoBaseProcedure (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsNeededAtRunTime - returns TRUE if procedure, sym, is a
+                       runtime procedure. Ie a procedure which is
+                       not a pseudo procedure and which is implemented
+                       in M2RTS or SYSTEM and also exported.
+*)
+
+PROCEDURE IsNeededAtRunTime (tok: CARDINAL; sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsBaseType - returns TRUE if Sym is a Base type.
+*)
+
+PROCEDURE IsBaseType (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsOrdinalType - returns TRUE if, sym, is an ordinal type.
+                   An ordinal type is defined as:
+                   a base type which contains whole numbers or
+                   a subrange type or an enumeration type.
+*)
+
+PROCEDURE IsOrdinalType (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsOrd - returns TRUE if, sym, is ORD or its typed counterparts
+           ORDL, ORDS.
+*)
+
+PROCEDURE IsOrd (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsTrunc - returns TRUE if, sym, is TRUNC or its typed counterparts
+             TRUNCL, TRUNCS.
+*)
+
+PROCEDURE IsTrunc (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsFloat - returns TRUE if, sym, is FLOAT or its typed counterparts
+             FLOATL, FLOATS.
+*)
+
+PROCEDURE IsFloat (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsInt - returns TRUE if, sym, is INT or its typed counterparts
+           INTL, INTS.
+*)
+
+PROCEDURE IsInt (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   AssignmentRequiresWarning - returns TRUE if t1 and t2 can be used during
+                               an assignment, but should generate a warning.
+                               For example in PIM we can assign ADDRESS
+                               and WORD providing they are both the
+                               same size.
+*)
+
+PROCEDURE AssignmentRequiresWarning (t1, t2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsAssignmentCompatible - returns TRUE if t1 and t2 are assignment
+                            compatible.
+*)
+
+PROCEDURE IsAssignmentCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsExpressionCompatible - returns TRUE if t1 and t2 are expression
+                            compatible.
+*)
+
+PROCEDURE IsExpressionCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsParameterCompatible - returns TRUE if types t1 and t2 are parameter
+                           compatible.
+*)
+
+PROCEDURE IsParameterCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsComparisonCompatible - returns TRUE if t1 and t2 are comparison
+                            compatible.  PIM allows INTEGER and ADDRESS within
+                            expressions but we warn against their comparison.
+*)
+
+PROCEDURE IsComparisonCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsValidParameter - returns TRUE if an, actual, parameter can be passed
+                      to the, formal, parameter.   This differs from
+                      IsParameterCompatible as this procedure includes checks
+                      for unbounded formal parameters, var parameters and
+                      constant actual parameters.
+*)
+
+PROCEDURE IsValidParameter (formal, actual: CARDINAL) : BOOLEAN ;
+
+
+(*
+   CheckExpressionCompatible - returns if t1 and t2 are compatible types for
+                               +, -, *, DIV, >, <, =, etc.
+                               If t1 and t2 are not compatible then an error
+                               message is displayed.
+*)
+
+PROCEDURE CheckExpressionCompatible (tok: CARDINAL;
+                                     left, right: CARDINAL) ;
+
+
+(*
+   CheckAssignmentCompatible - returns if t1 and t2 are compatible types for
+                               :=, =, #.
+                               If t1 and t2 are not compatible then an error
+                               message is displayed.
+*)
+
+PROCEDURE CheckAssignmentCompatible (tok: CARDINAL;
+                                     left, right: CARDINAL) ;
+
+
+(*
+   CheckParameterCompatible - checks to see if types, t1, and, t2, are
+                              compatible for parameter passing.
+*)
+
+PROCEDURE CheckParameterCompatible (tok: CARDINAL;
+                                    t1, t2: CARDINAL) ;
+
+
+(*
+   CannotCheckTypeInPass3 - returns TRUE if we are unable to check the
+                            type of, e, in pass 3.
+*)
+
+PROCEDURE CannotCheckTypeInPass3 (e: CARDINAL) : BOOLEAN ;
+
+
+(*
+   MixTypes - returns the type symbol that corresponds to the types t1 and t2.
+              NearTok is used to identify the source position if a type
+              incompatability occurs.
+*)
+
+PROCEDURE MixTypes (t1, t2: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
+
+
+(*
+   NegateType - if the type is unsigned then returns the
+                signed equivalent.
+*)
+
+PROCEDURE NegateType (type: CARDINAL (* ; sympos: CARDINAL *) ) : CARDINAL ;
+
+
+(*
+   IsMathType - returns TRUE if the type is a mathematical type.
+                A mathematical type has a range larger than INTEGER.
+                (Typically REAL/LONGREAL/LONGINT)
+*)
+
+PROCEDURE IsMathType (type: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsRealType - returns TRUE if, t, is a real type.
+*)
+
+PROCEDURE IsRealType (t: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsComplexType - returns TRUE if, sym, is COMPLEX,
+                   LONGCOMPLEX or SHORTCOMPLEX.
+*)
+
+PROCEDURE IsComplexType (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ComplexToScalar - returns the scalar (or base type) of the complex type, sym.
+*)
+
+PROCEDURE ComplexToScalar (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   ScalarToComplex - given a real type, t, return the equivalent complex type.
+*)
+
+PROCEDURE ScalarToComplex (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetCmplxReturnType - this code implements the table given in the
+                        ISO standard Page 293 with an addition for
+                        SHORTCOMPLEX and the fixed sized COMPLEX
+                        types found in the GNU Modula-2 SYSTEM
+                        Module.
+*)
+
+PROCEDURE GetCmplxReturnType (t1, t2: CARDINAL) : CARDINAL ;
+
+
+END M2Base.
diff --git a/gcc/m2/gm2-compiler/M2Base.mod b/gcc/m2/gm2-compiler/M2Base.mod
new file mode 100644
index 00000000000..d5a0ccf8ad8
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Base.mod
@@ -0,0 +1,2761 @@
+(* M2Base.mod provides a mechanism to check fundamental types.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Base ;
+
+(*
+    Title      : M2Base
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Mon Jul 10 20:16:54 2000
+    Description: gcc version of M2Base. This module initializes the front end
+                 symbol table with the base types. We collect the size of the
+                 base types and range of values from the gcc backend.
+*)
+
+FROM DynamicStrings IMPORT InitString, String, Mark, InitStringCharStar, ConCat ;
+FROM M2LexBuf IMPORT BuiltinTokenNo, GetTokenNo ;
+FROM NameKey IMPORT MakeKey, WriteKey, KeyToCharStar ;
+FROM M2Debug IMPORT Assert ;
+FROM SYSTEM IMPORT WORD ;
+
+FROM M2Error IMPORT InternalError, FlushErrors ;
+FROM M2Pass IMPORT IsPassCodeGeneration ;
+FROM FormatStrings IMPORT Sprintf2 ;
+FROM StrLib IMPORT StrLen ;
+
+FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaErrors3,
+                        MetaErrorT1, MetaErrorT2,
+                        MetaErrorStringT2, MetaErrorStringT1 ;
+
+FROM SymbolTable IMPORT ModeOfAddr,
+                        MakeModule, MakeType, PutType,
+                        MakeEnumeration, PutFieldEnumeration,
+                        MakeProcType,
+                        MakeProcedure, PutFunction,
+                        MakeRecord, PutFieldRecord,
+                        MakeConstVar, PutConst,
+                        MakeTemporary,
+                        MakeVar, PutVar,
+                        MakeSubrange, PutSubrange, IsSubrange,
+                        PutModuleBuiltin,
+                        IsEnumeration, IsSet, IsPointer, IsType, IsUnknown,
+                        IsHiddenType, IsProcType,
+                        GetType, GetLowestType, GetDeclaredMod, SkipType,
+                        SetCurrentModule,
+                        StartScope, EndScope, PseudoScope,
+                        ForeachFieldEnumerationDo,
+                        RequestSym, GetSymName, NulSym,
+                        PutImported, GetExported,
+                        PopSize, PopValue, PushValue,
+                        FromModuleGetSym, GetSym,
+                        IsExportQualified, IsExportUnQualified,
+                        IsParameter, IsParameterVar, IsUnbounded,
+                        IsConst, IsUnboundedParam,
+                        IsParameterUnbounded,  GetSubrange,
+                        IsArray, IsProcedure, IsConstString,
+                        IsVarient, IsRecordField, IsFieldVarient,
+                        GetArraySubscript, IsRecord, NoOfParam,
+                        GetNthParam, IsVarParam, GetNth, GetDimension ;
+
+FROM M2ALU IMPORT PushIntegerTree, PushRealTree, PushCard, Equ, Gre, Less ;
+FROM M2Batch IMPORT MakeDefinitionSource ;
+FROM M2Bitset IMPORT Bitset, GetBitsetMinMax, MakeBitset ;
+FROM M2Size IMPORT Size, MakeSize ;
+
+FROM M2System IMPORT Address, Byte, Word, System, Loc, InitSystem,
+                     IntegerN, CardinalN, WordN, SetN, RealN, ComplexN,
+                     IsCardinalN, IsIntegerN, IsRealN, IsComplexN,
+                     IsGenericSystemType, IsSameSizePervasiveType ;
+
+FROM M2Options IMPORT NilChecking,
+                      WholeDivChecking, WholeValueChecking,
+                      IndexChecking, RangeChecking,
+                      ReturnChecking, CaseElseChecking, Exceptions,
+		      WholeValueChecking,
+                      DebugBuiltins,
+                      Iso, Pim, Pim2, Pim3 ;
+
+FROM m2type IMPORT GetIntegerType,
+                   GetM2IntegerType, GetM2CharType,
+                   GetMaxFrom, GetMinFrom, GetRealType,
+                   GetM2LongIntType, GetLongRealType, GetProcType,
+                   GetM2ShortRealType, GetM2RealType,
+                   GetM2LongRealType, GetM2LongCardType,
+                   GetM2ShortIntType, GetM2ShortCardType,
+                   GetM2CardinalType, GetPointerType, GetWordType,
+                   GetByteType, GetISOWordType, GetISOByteType,
+                   GetISOLocType,
+                   GetM2ComplexType, GetM2LongComplexType,
+                   GetM2ShortComplexType,
+		   GetM2Complex32, GetM2Complex64,
+		   GetM2Complex96, GetM2Complex128,
+                   GetM2RType, GetM2ZType, GetM2CType,
+                   InitBaseTypes ;
+
+FROM m2expr IMPORT GetSizeOf ;
+FROM m2linemap IMPORT location_t, BuiltinsLocation ;
+FROM m2decl IMPORT BuildIntegerConstant ;
+
+
+TYPE
+   Compatability = (expression, assignment, parameter, comparison) ;
+   MetaType      = (const, word, byte, address, chr,
+                    normint, shortint, longint,
+                    normcard, shortcard, longcard,
+                    pointer, enum,
+                    real, shortreal, longreal,
+                    set, opaque, loc, rtype, ztype,
+                    int8, int16, int32, int64,
+                    card8, card16, card32, card64,
+                    word16, word32, word64,
+                    real32, real64, real96, real128,
+                    set8, set16, set32,
+                    complex, shortcomplex, longcomplex,
+                    complex32, complex64, complex96, complex128,
+                    ctype, rec, array,
+                    procedure, unknown) ;
+   Compatible    = (uninitialized, no, warnfirst, warnsecond,
+                    first, second) ;
+
+
+TYPE
+   CompatibilityArray = ARRAY MetaType, MetaType OF Compatible ;
+
+VAR
+   Comp,
+   Expr,
+   Ass        : CompatibilityArray ;
+   Ord,
+   OrdS, OrdL,
+   Float,
+   FloatS, SFloat,
+   FloatL, LFloat,
+   Trunc,
+   TruncS,
+   TruncL,
+   Int, IntS, IntL,
+   m2rts,
+   MinReal,
+   MaxReal,
+   MinShortReal,
+   MaxShortReal,
+   MinLongReal,
+   MaxLongReal,
+   MinLongInt,
+   MaxLongInt,
+   MinLongCard,
+   MaxLongCard,
+   MinShortInt,
+   MaxShortInt,
+   MinShortCard,
+   MaxShortCard,
+   MinChar,
+   MaxChar,
+   MinCardinal,
+   MaxCardinal,
+   MinInteger,
+   MaxInteger,
+   MaxEnum,
+   MinEnum    : CARDINAL ;
+
+
+(*
+   InitBuiltins -
+*)
+
+PROCEDURE InitBuiltins ;
+VAR
+   builtins: CARDINAL ;
+BEGIN
+   IF DebugBuiltins
+   THEN
+      (* We will need to parse this module as functions alloca/memcpy will be used.  *)
+      builtins := MakeDefinitionSource (BuiltinTokenNo, MakeKey ('Builtins')) ;
+      IF builtins = NulSym
+      THEN
+         MetaError0 ('unable to find core module Builtins')
+      END
+   END
+END InitBuiltins ;
+
+
+(*
+   InitBase - initializes the base types and procedures
+              used in the Modula-2 compiler.
+*)
+
+PROCEDURE InitBase (location: location_t; VAR sym: CARDINAL) ;
+BEGIN
+   sym := MakeModule (BuiltinTokenNo, MakeKey ('_BaseTypes')) ;
+   PutModuleBuiltin (sym, TRUE) ;
+   SetCurrentModule (sym) ;
+   StartScope (sym) ;
+
+   InitBaseSimpleTypes (location) ;
+
+   (* Initialize the SYSTEM module before we ADDRESS.  *)
+   InitSystem ;
+
+   MakeBitset ;  (* We do this after SYSTEM has been created as BITSET
+                    is dependant upon WORD.  *)
+
+   InitBaseConstants ;
+   InitBaseFunctions ;
+   InitBaseProcedures ;
+
+   (*
+      Note: that we do end the Scope since we keep the symbol to the head
+            of the base scope. This head of base scope is searched
+            when all other scopes fail to deliver a symbol.
+   *)
+   EndScope ;
+   InitBuiltins ;
+   InitCompatibilityMatrices
+END InitBase ;
+
+
+(*
+   IsNeededAtRunTime - returns TRUE if procedure, sym, is a
+                       runtime procedure.  A runtime procedure is
+                       not a pseudo procedure (like NEW/DISPOSE)
+                       and it is implemented in M2RTS or SYSTEM
+                       and also exported.
+*)
+
+PROCEDURE IsNeededAtRunTime (tok: CARDINAL; sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          ((FromModuleGetSym(tok, GetSymName(sym), System)=sym) OR
+           (FromModuleGetSym(tok, GetSymName(sym), m2rts)=sym)) AND
+          (IsExportQualified(sym) OR IsExportUnQualified(sym))
+         )
+END IsNeededAtRunTime ;
+
+
+(*
+   InitBaseConstants - initialises the base constant NIL.
+*)
+
+PROCEDURE InitBaseConstants ;
+BEGIN
+   Nil := MakeConstVar (BuiltinTokenNo, MakeKey ('NIL')) ;
+   PutConst (Nil, Address)
+END InitBaseConstants ;
+
+
+(*
+   InitBaseSimpleTypes - initialises the base simple types,
+                         CARDINAL, INTEGER, CHAR, BOOLEAN.
+*)
+
+PROCEDURE InitBaseSimpleTypes (location: location_t) ;
+BEGIN
+   InitBaseTypes (location) ;
+
+   ZType := MakeType (BuiltinTokenNo, MakeKey('Modula-2 base Z')) ;
+   PutType(ZType, NulSym) ;                   (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2ZType())) ;
+   PopSize(ZType) ;
+
+   RType := MakeType(BuiltinTokenNo, MakeKey('Modula-2 base R')) ;
+   PutType(RType, NulSym) ;                   (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2RType())) ;
+   PopSize(RType) ;
+
+   CType := MakeType (BuiltinTokenNo, MakeKey('Modula-2 base C')) ;
+   PutType(CType, NulSym) ;                   (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2CType())) ;
+   PopSize(CType) ;
+
+   Integer := MakeType (BuiltinTokenNo, MakeKey('INTEGER')) ;
+   PutType(Integer, NulSym) ;                 (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2IntegerType())) ;
+   PopSize(Integer) ;
+
+   Cardinal := MakeType (BuiltinTokenNo, MakeKey('CARDINAL')) ;
+   PutType(Cardinal, NulSym) ;
+                                              (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2CardinalType())) ;
+   PopSize(Cardinal) ;
+
+   LongInt := MakeType (BuiltinTokenNo, MakeKey('LONGINT')) ;
+   PutType(LongInt, NulSym) ;                 (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2LongIntType())) ;
+   PopSize(LongInt) ;
+
+   LongCard := MakeType (BuiltinTokenNo, MakeKey('LONGCARD')) ;
+   PutType(LongCard, NulSym) ;                (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2LongCardType())) ;
+   PopSize(LongCard) ;
+
+   ShortInt := MakeType (BuiltinTokenNo, MakeKey('SHORTINT')) ;
+   PutType(ShortInt, NulSym) ;                (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2ShortIntType())) ;
+   PopSize(ShortInt) ;
+
+   ShortCard := MakeType (BuiltinTokenNo, MakeKey('SHORTCARD')) ;
+   PutType(ShortCard, NulSym) ;               (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2ShortCardType())) ;
+   PopSize(ShortCard) ;
+
+   Real := MakeType (BuiltinTokenNo, MakeKey('REAL')) ;
+   PutType(Real, NulSym) ;                    (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2RealType())) ;
+   PopSize(Real) ;
+
+   ShortReal := MakeType (BuiltinTokenNo, MakeKey('SHORTREAL')) ;
+   PutType(ShortReal, NulSym) ;               (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2ShortRealType())) ;
+   PopSize(ShortReal) ;
+
+   LongReal := MakeType (BuiltinTokenNo, MakeKey('LONGREAL')) ;
+   PutType(LongReal, NulSym) ;                (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2LongRealType())) ;
+   PopSize(LongReal) ;
+
+   Complex := MakeType (BuiltinTokenNo, MakeKey('COMPLEX')) ;
+   PutType(Complex, NulSym) ;                 (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2ComplexType())) ;
+   PopSize(Complex) ;
+
+   LongComplex := MakeType (BuiltinTokenNo, MakeKey('LONGCOMPLEX')) ;
+   PutType(LongComplex, NulSym) ;             (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2LongComplexType())) ;
+   PopSize(LongComplex) ;
+
+   ShortComplex := MakeType (BuiltinTokenNo, MakeKey('SHORTCOMPLEX')) ;
+   PutType(ShortComplex, NulSym) ;            (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2ShortComplexType())) ;
+   PopSize(ShortComplex) ;
+
+   Char := MakeType (BuiltinTokenNo, MakeKey('CHAR')) ;
+   PutType(Char, NulSym) ;                    (* Base Type       *)
+   PushIntegerTree(GetSizeOf(location, GetM2CharType())) ;
+   PopSize(Char) ;
+
+   (*
+      Boolean = (FALSE, TRUE) ;
+   *)
+   Boolean := MakeEnumeration (BuiltinTokenNo, MakeKey('BOOLEAN')) ;
+
+   PutFieldEnumeration (BuiltinTokenNo, Boolean, MakeKey('FALSE')) ;
+   PutFieldEnumeration (BuiltinTokenNo, Boolean, MakeKey('TRUE')) ;
+
+   True  := RequestSym (BuiltinTokenNo, MakeKey('TRUE')) ;
+   False := RequestSym (BuiltinTokenNo, MakeKey('FALSE')) ;
+
+   Proc := MakeProcType (BuiltinTokenNo, MakeKey('PROC')) ;
+   PushIntegerTree(GetSizeOf(location, GetProcType())) ;
+   PopSize(Proc) ;
+
+   (* MinChar *)
+   MinChar := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMinFrom(location, GetM2CharType())) ;
+   PopValue(MinChar) ;
+   PutVar(MinChar, Char) ;
+
+   (* MaxChar *)
+   MaxChar := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMaxFrom(location, GetM2CharType())) ;
+   PopValue(MaxChar) ;
+   PutVar(MaxChar, Char) ;
+
+   (* MinInteger *)
+   MinInteger := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMinFrom(location, GetM2IntegerType())) ;
+   PopValue(MinInteger) ;
+   PutVar(MinInteger, Integer) ;
+
+   (* MaxInteger *)
+   MaxInteger := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMaxFrom(location, GetM2IntegerType())) ;
+   PopValue(MaxInteger) ;
+   PutVar(MaxInteger, Integer) ;
+
+   (* MinCardinal *)
+   MinCardinal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMinFrom(BuiltinsLocation(), GetM2CardinalType())) ;
+   PopValue(MinCardinal) ;
+   PutVar(MinCardinal, Cardinal) ;
+
+   (* MaxCardinal *)
+   MaxCardinal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMaxFrom(location, GetM2CardinalType())) ;
+   PopValue(MaxCardinal) ;
+   PutVar(MaxCardinal, Cardinal) ;
+
+   (* MinLongInt *)
+   MinLongInt := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMinFrom(location, GetM2LongIntType())) ;
+   PopValue(MinLongInt) ;
+   PutVar(MinLongInt, LongInt) ;
+
+   (* MaxLongInt *)
+   MaxLongInt := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMaxFrom(location, GetM2LongIntType())) ;
+   PopValue(MaxLongInt) ;
+   PutVar(MaxLongInt, LongInt) ;
+
+   (* MinLongCard *)
+   MinLongCard := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMinFrom(location, GetM2LongCardType())) ;
+   PopValue(MinLongCard) ;
+   PutVar(MinLongCard, LongCard) ;
+
+   (* MinLongCard *)
+   MaxLongCard := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMaxFrom(BuiltinsLocation(), GetM2LongCardType())) ;
+   PopValue(MaxLongCard) ;
+   PutVar(MaxLongCard, LongCard) ;
+
+   (* MinReal *)
+   MinReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushRealTree(GetMinFrom(location, GetM2RealType())) ;
+   PopValue(MinReal) ;
+   PutVar(MinReal, Real) ;
+
+   (* MaxReal *)
+   MaxReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushRealTree(GetMaxFrom(location, GetM2RealType())) ;
+   PopValue(MaxReal) ;
+   PutVar(MaxReal, Real) ;
+
+   (* MinShortReal *)
+   MinShortReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushRealTree(GetMinFrom(location, GetM2ShortRealType())) ;
+   PopValue(MinShortReal) ;
+   PutVar(MinShortReal, ShortReal) ;
+
+   (* MaxShortReal *)
+   MaxShortReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushRealTree(GetMaxFrom(location, GetM2ShortRealType())) ;
+   PopValue(MaxShortReal) ;
+   PutVar(MaxShortReal, ShortReal) ;
+
+   (* MinLongReal *)
+   MinLongReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushRealTree(GetMinFrom(location, GetM2LongRealType())) ;
+   PopValue(MinLongReal) ;
+   PutVar(MinLongReal, LongReal) ;
+
+   (* MaxLongReal *)
+   MaxLongReal := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushRealTree(GetMaxFrom(location, GetM2LongRealType())) ;
+   PopValue(MaxLongReal) ;
+   PutVar(MaxLongReal, LongReal) ;
+
+   (* MaxShortInt *)
+   MaxShortInt := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMaxFrom(location, GetM2ShortIntType())) ;
+   PopValue(MaxShortInt) ;
+   PutVar(MaxShortInt, ShortInt) ;
+
+   (* MinShortInt *)
+   MinShortInt := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMinFrom(location, GetM2ShortIntType())) ;
+   PopValue(MinShortInt) ;
+   PutVar(MinShortInt, ShortInt) ;
+
+   (* MaxShortCard *)
+   MaxShortCard := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMaxFrom(location, GetM2ShortCardType())) ;
+   PopValue(MaxShortCard) ;
+   PutVar(MaxShortCard, ShortCard) ;
+
+   (* MinShortCard *)
+   MinShortCard := MakeTemporary(BuiltinTokenNo, ImmediateValue) ;
+   PushIntegerTree(GetMinFrom(location, GetM2ShortCardType())) ;
+   PopValue(MinShortCard) ;
+   PutVar(MinShortCard, ShortCard)
+
+END InitBaseSimpleTypes ;
+
+
+(*
+   FindMinMaxEnum - finds the minimum and maximum enumeration fields.
+*)
+
+PROCEDURE FindMinMaxEnum (field: WORD) ;
+BEGIN
+   IF MaxEnum=NulSym
+   THEN
+      MaxEnum := field
+   ELSE
+      PushValue(field) ;
+      PushValue(MaxEnum) ;
+      IF Gre(GetTokenNo())
+      THEN
+         MaxEnum := field
+      END
+   END ;
+   IF MinEnum=NulSym
+   THEN
+      MinEnum := field
+   ELSE
+      PushValue(field) ;
+      PushValue(MinEnum) ;
+      IF Less(GetTokenNo())
+      THEN
+         MinEnum := field
+      END
+   END
+END FindMinMaxEnum ;
+
+
+(*
+   GetBaseTypeMinMax - returns the minimum and maximum values for a
+                       given base type. This procedure should only
+                       be called if the type is NOT a subrange.
+*)
+
+PROCEDURE GetBaseTypeMinMax (type: CARDINAL; VAR min, max: CARDINAL) ;
+BEGIN
+   IF type=Integer
+   THEN
+      min := MinInteger ;
+      max := MaxInteger
+   ELSIF type=Cardinal
+   THEN
+      min := MinCardinal ;
+      max := MaxCardinal
+   ELSIF type=Char
+   THEN
+      min := MinChar ;
+      max := MaxChar
+   ELSIF type=Bitset
+   THEN
+      GetBitsetMinMax(min, max)
+   ELSIF (type=LongInt)
+   THEN
+      min := MinLongInt ;
+      max := MaxLongInt
+   ELSIF (type=LongCard)
+   THEN
+      min := MinLongCard ;
+      max := MaxLongCard
+   ELSIF (type=ShortInt)
+   THEN
+      min := MinShortInt ;
+      max := MaxShortInt
+   ELSIF (type=ShortCard)
+   THEN
+      min := MinShortCard ;
+      max := MaxShortCard
+   ELSIF (type=Real)
+   THEN
+      min := MinReal ;
+      max := MaxReal
+   ELSIF (type=ShortReal)
+   THEN
+      min := MinShortReal ;
+      max := MaxShortReal
+   ELSIF (type=LongReal)
+   THEN
+      min := MinLongReal ;
+      max := MaxLongReal
+   ELSIF IsEnumeration(type)
+   THEN
+      MinEnum := NulSym ;
+      MaxEnum := NulSym ;
+      ForeachFieldEnumerationDo(type, FindMinMaxEnum) ;
+      min := MinEnum ;
+      max := MaxEnum
+   ELSE
+      MetaError1 ('unable to find MIN or MAX for the base type {%1as}', type)
+   END
+END GetBaseTypeMinMax ;
+
+
+(*
+   ImportFrom - imports symbol, name, from module and returns the
+                symbol.
+*)
+
+PROCEDURE ImportFrom (tok: CARDINAL;
+                      module: CARDINAL; name: ARRAY OF CHAR) : CARDINAL ;
+BEGIN
+   PutImported(GetExported(tok, module, MakeKey(name))) ;
+   RETURN( GetSym(MakeKey(name)) )
+END ImportFrom ;
+
+
+(*
+   InitBaseProcedures - initialises the base procedures,
+                        INC, DEC, INCL, EXCL, NEW and DISPOSE.
+*)
+
+PROCEDURE InitBaseProcedures ;
+VAR
+   rtexceptions: CARDINAL ;
+BEGIN
+   (*
+      The pseudo procedures NEW and DISPOSE are in fact "macro"
+      substituted for ALLOCATE and DEALLOCATE.
+      However they both have symbols in the base module so that
+      the procedure mechanism treats all procedure calls the same.
+      "Macro" substitution occurs in M2Quads.
+   *)
+
+   New := MakeProcedure(BuiltinTokenNo, MakeKey('NEW')) ;
+   Dispose := MakeProcedure(BuiltinTokenNo, MakeKey('DISPOSE')) ;
+   Inc := MakeProcedure(BuiltinTokenNo, MakeKey('INC')) ;
+   Dec := MakeProcedure(BuiltinTokenNo, MakeKey('DEC')) ;
+   Incl := MakeProcedure(BuiltinTokenNo, MakeKey('INCL')) ;
+   Excl := MakeProcedure(BuiltinTokenNo, MakeKey('EXCL')) ;
+
+   IF NOT Pim2
+   THEN
+      MakeSize  (* SIZE is declared as a standard function in *)
+                (* ISO Modula-2 and PIM-[34] Modula-2 but not *)
+                (* PIM-2 Modula-2                             *)
+   END ;
+
+   (*
+      The procedure HALT is a real procedure which
+      is defined in M2RTS. However to remain compatible
+      with other Modula-2 implementations HALT can be used
+      without the need to import it from M2RTS. ie it is
+      within the BaseType module scope.
+   *)
+   m2rts := MakeDefinitionSource(BuiltinTokenNo, MakeKey('M2RTS')) ;
+   PutImported(GetExported(BuiltinTokenNo, m2rts, MakeKey('HALT'))) ;
+
+   ExceptionAssign          := NulSym ;
+   ExceptionReturn          := NulSym ;
+   ExceptionInc             := NulSym ;
+   ExceptionDec             := NulSym ;
+   ExceptionIncl            := NulSym ;
+   ExceptionExcl            := NulSym ;
+   ExceptionShift           := NulSym ;
+   ExceptionRotate          := NulSym ;
+   ExceptionStaticArray     := NulSym ;
+   ExceptionDynamicArray    := NulSym ;
+   ExceptionForLoopBegin    := NulSym ;
+   ExceptionForLoopTo       := NulSym ;
+   ExceptionForLoopEnd      := NulSym ;
+   ExceptionPointerNil      := NulSym ;
+   ExceptionNoReturn        := NulSym ;
+   ExceptionCase            := NulSym ;
+   ExceptionNonPosDiv       := NulSym ;
+   ExceptionNonPosMod       := NulSym ;
+   ExceptionZeroDiv         := NulSym ;
+   ExceptionZeroRem         := NulSym ;
+   ExceptionWholeValue      := NulSym ;
+   ExceptionRealValue       := NulSym ;
+   ExceptionParameterBounds := NulSym ;
+
+   ExceptionNo              := NulSym ;
+
+   IF NilChecking
+   THEN
+      ExceptionPointerNil := ImportFrom(BuiltinTokenNo, m2rts, 'PointerNilException')
+   END ;
+   IF RangeChecking
+   THEN
+      ExceptionAssign := ImportFrom(BuiltinTokenNo, m2rts, 'AssignmentException') ;
+      ExceptionReturn := ImportFrom(BuiltinTokenNo, m2rts, 'ReturnException') ;
+      ExceptionInc := ImportFrom(BuiltinTokenNo, m2rts, 'IncException') ;
+      ExceptionDec := ImportFrom(BuiltinTokenNo, m2rts, 'DecException') ;
+      ExceptionIncl := ImportFrom(BuiltinTokenNo, m2rts, 'InclException') ;
+      ExceptionExcl := ImportFrom(BuiltinTokenNo, m2rts, 'ExclException') ;
+      ExceptionShift := ImportFrom(BuiltinTokenNo, m2rts, 'ShiftException') ;
+      ExceptionRotate := ImportFrom(BuiltinTokenNo, m2rts, 'RotateException') ;
+      ExceptionForLoopBegin := ImportFrom(BuiltinTokenNo, m2rts, 'ForLoopBeginException') ;
+      ExceptionForLoopTo := ImportFrom(BuiltinTokenNo, m2rts, 'ForLoopToException') ;
+      ExceptionForLoopEnd := ImportFrom(BuiltinTokenNo, m2rts, 'ForLoopEndException') ;
+      ExceptionParameterBounds := ImportFrom(BuiltinTokenNo, m2rts, 'ParameterException') ;
+   END ;
+   IF IndexChecking
+   THEN
+      ExceptionStaticArray := ImportFrom(BuiltinTokenNo, m2rts, 'StaticArraySubscriptException') ;
+      ExceptionDynamicArray := ImportFrom(BuiltinTokenNo, m2rts, 'DynamicArraySubscriptException')
+   END ;
+   IF WholeDivChecking
+   THEN
+      ExceptionNonPosDiv := ImportFrom(BuiltinTokenNo, m2rts, 'WholeNonPosDivException') ;
+      ExceptionNonPosMod := ImportFrom(BuiltinTokenNo, m2rts, 'WholeNonPosModException') ;
+      ExceptionZeroDiv := ImportFrom(BuiltinTokenNo, m2rts, 'WholeZeroDivException') ;
+      ExceptionZeroRem := ImportFrom(BuiltinTokenNo, m2rts, 'WholeZeroRemException')
+   END ;
+   IF ReturnChecking
+   THEN
+      ExceptionNoReturn := ImportFrom(BuiltinTokenNo, m2rts, 'NoReturnException')
+   END ;
+   IF CaseElseChecking
+   THEN
+      ExceptionCase := ImportFrom(BuiltinTokenNo, m2rts, 'CaseException')
+   END ;
+   IF WholeValueChecking
+   THEN
+      ExceptionWholeValue := ImportFrom(BuiltinTokenNo, m2rts, 'WholeValueException') ;
+      ExceptionRealValue := ImportFrom(BuiltinTokenNo, m2rts, 'RealValueException')
+   END ;
+   IF Exceptions
+   THEN
+      ExceptionNo := ImportFrom(BuiltinTokenNo, m2rts, 'NoException') ;
+      (* ensure that this module is included *)
+      rtexceptions := MakeDefinitionSource(BuiltinTokenNo, MakeKey('RTExceptions')) ;
+      IF rtexceptions = NulSym
+      THEN
+         MetaError0 ('unable to find required runtime module RTExceptions')
+      END
+   END
+END InitBaseProcedures ;
+
+
+(*
+   IsOrd - returns TRUE if, sym, is ORD or its typed counterparts
+           ORDL, ORDS.
+*)
+
+PROCEDURE IsOrd (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN (sym=Ord) OR (sym=OrdS) OR (sym=OrdL)
+END IsOrd ;
+
+
+(*
+   BuildOrdFunctions - creates ORD, ORDS, ORDL.
+*)
+
+PROCEDURE BuildOrdFunctions ;
+BEGIN
+   Ord := MakeProcedure(BuiltinTokenNo, MakeKey('ORD')) ;
+   PutFunction(Ord, Cardinal) ;
+   OrdS := MakeProcedure(BuiltinTokenNo, MakeKey('ORDS')) ;
+   PutFunction(OrdS, ShortCard) ;
+   OrdL := MakeProcedure(BuiltinTokenNo, MakeKey('ORDL')) ;
+   PutFunction(OrdL, LongCard)
+END BuildOrdFunctions ;
+
+
+(*
+   IsTrunc - returns TRUE if, sym, is TRUNC or its typed counterparts
+             TRUNCL, TRUNCS.
+*)
+
+PROCEDURE IsTrunc (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN (sym=Trunc) OR (sym=TruncS) OR (sym=TruncL)
+END IsTrunc ;
+
+
+(*
+   BuildTruncFunctions - creates TRUNC, TRUNCS, TRUNCL.
+*)
+
+PROCEDURE BuildTruncFunctions ;
+BEGIN
+   IF Pim2 OR Pim3 OR Iso
+   THEN
+      Trunc := MakeProcedure(BuiltinTokenNo, MakeKey('TRUNC')) ;
+      PutFunction(Trunc, Cardinal) ;
+      TruncS := MakeProcedure(BuiltinTokenNo, MakeKey('STRUNC')) ;
+      PutFunction(TruncS, ShortCard) ;
+      TruncL := MakeProcedure(BuiltinTokenNo, MakeKey('LTRUNC')) ;
+      PutFunction(TruncL, LongCard)
+   ELSE
+      Trunc := MakeProcedure(BuiltinTokenNo, MakeKey('TRUNC')) ;
+      PutFunction(Trunc, Integer) ;
+      TruncS := MakeProcedure(BuiltinTokenNo, MakeKey('STRUNC')) ;
+      PutFunction(TruncS, ShortInt) ;
+      TruncL := MakeProcedure(BuiltinTokenNo, MakeKey('LTRUNC')) ;
+      PutFunction(TruncL, LongInt)
+   END
+END BuildTruncFunctions ;
+
+
+(*
+   IsFloat - returns TRUE if, sym, is FLOAT or its typed counterparts
+             FLOATL, FLOATS.
+*)
+
+PROCEDURE IsFloat (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym=Float) OR (sym=FloatS) OR (sym=FloatL) OR
+          (sym=SFloat) OR (sym=LFloat)
+         )
+END IsFloat ;
+
+
+(*
+   BuildFloatFunctions - creates TRUNC, TRUNCS, TRUNCL.
+*)
+
+PROCEDURE BuildFloatFunctions ;
+BEGIN
+   Float := MakeProcedure(BuiltinTokenNo, MakeKey('FLOAT')) ;
+   PutFunction(Float, Real) ;
+   SFloat := MakeProcedure(BuiltinTokenNo, MakeKey('SFLOAT')) ;
+   PutFunction(SFloat, ShortReal) ;
+   LFloat := MakeProcedure(BuiltinTokenNo, MakeKey('LFLOAT')) ;
+   PutFunction(LFloat, LongReal) ;
+   FloatS := MakeProcedure(BuiltinTokenNo, MakeKey('FLOATS')) ;
+   PutFunction(FloatS, ShortReal) ;
+   FloatL := MakeProcedure(BuiltinTokenNo, MakeKey('FLOATL')) ;
+   PutFunction(FloatL, LongReal)
+END BuildFloatFunctions ;
+
+
+(*
+   IsInt - returns TRUE if, sym, is INT or its typed counterparts
+           INTL, INTS.
+*)
+
+PROCEDURE IsInt (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN (sym=Int) OR (sym=IntS) OR (sym=IntL)
+END IsInt ;
+
+
+(*
+   BuildIntFunctions - creates INT, INTS, INTL.
+*)
+
+PROCEDURE BuildIntFunctions ;
+BEGIN
+   Int := MakeProcedure(BuiltinTokenNo, MakeKey('INT')) ;
+   PutFunction(Int, Integer) ;
+   IntS := MakeProcedure(BuiltinTokenNo, MakeKey('INTS')) ;
+   PutFunction(IntS, ShortInt) ;
+   IntL := MakeProcedure(BuiltinTokenNo, MakeKey('INTL')) ;
+   PutFunction(IntL, LongInt)
+END BuildIntFunctions ;
+
+
+(*
+   InitBaseFunctions - initialises the base function, HIGH.
+*)
+
+PROCEDURE InitBaseFunctions ;
+BEGIN
+   (* Now declare the dynamic array components, HIGH *)
+   High := MakeProcedure(BuiltinTokenNo, MakeKey('HIGH')) ;  (* Pseudo Base function HIGH *)
+   PutFunction(High, Cardinal) ;
+
+   (*
+     _TemplateProcedure is a procedure which has a local variable _ActivationPointer
+      whose offset is used for all nested procedures. (The activation pointer
+      being in the same relative position for all procedures).
+   *)
+   TemplateProcedure := MakeProcedure(BuiltinTokenNo, MakeKey('_TemplateProcedure')) ;
+   StartScope(TemplateProcedure) ;
+   ActivationPointer := MakeVar(BuiltinTokenNo, MakeKey('_ActivationPointer')) ;
+   PutVar(ActivationPointer, Address) ;
+   EndScope ;
+
+   (* and the base functions *)
+
+   Convert := MakeProcedure(BuiltinTokenNo, MakeKey('CONVERT')) ;  (* Internal function CONVERT    *)
+   IF Iso
+   THEN
+      LengthS := MakeProcedure(BuiltinTokenNo, MakeKey('LENGTH')) ; (* Pseudo Base function LENGTH  *)
+      PutFunction(LengthS, ZType)
+   ELSE
+      LengthS := NulSym
+   END ;
+   Abs   := MakeProcedure(BuiltinTokenNo, MakeKey('ABS')) ;      (* Pseudo Base function ABS     *)
+   PutFunction(Abs, ZType) ;
+
+   Cap   := MakeProcedure(BuiltinTokenNo, MakeKey('CAP')) ;      (* Pseudo Base function CAP     *)
+   PutFunction(Cap, Char) ;
+
+   Odd   := MakeProcedure(BuiltinTokenNo, MakeKey('ODD')) ;      (* Pseudo Base function ODD     *)
+   PutFunction(Odd, Boolean) ;
+
+   Chr   := MakeProcedure(BuiltinTokenNo, MakeKey('CHR')) ;      (* Pseudo Base function CHR     *)
+   PutFunction(Chr, Char) ;
+
+   (* the following three procedure functions have a return type depending upon  *)
+   (* the parameters.                                                            *)
+
+   Val   := MakeProcedure(BuiltinTokenNo, MakeKey('VAL')) ;      (* Pseudo Base function VAL     *)
+   Min   := MakeProcedure(BuiltinTokenNo, MakeKey('MIN')) ;      (* Pseudo Base function MIN     *)
+   Max   := MakeProcedure(BuiltinTokenNo, MakeKey('MAX')) ;      (* Pseudo Base function MIN     *)
+
+   Re    := MakeProcedure(BuiltinTokenNo, MakeKey('RE')) ;       (* Pseudo Base function RE      *)
+   PutFunction(Re, RType) ;
+
+   Im    := MakeProcedure(BuiltinTokenNo, MakeKey('IM')) ;       (* Pseudo Base function IM      *)
+   PutFunction(Im, RType) ;
+
+   Cmplx := MakeProcedure(BuiltinTokenNo, MakeKey('CMPLX')) ;    (* Pseudo Base function CMPLX   *)
+   PutFunction(Cmplx, CType) ;
+
+   BuildFloatFunctions ;
+   BuildTruncFunctions ;
+   BuildOrdFunctions ;
+   BuildIntFunctions
+END InitBaseFunctions ;
+
+
+(*
+   IsISOPseudoBaseFunction -
+*)
+
+PROCEDURE IsISOPseudoBaseFunction (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( Iso AND (Sym#NulSym) AND
+           ((Sym=LengthS) OR (Sym=Size) OR
+            (Sym=Cmplx) OR (Sym=Re) OR (Sym=Im) OR IsInt(Sym)) )
+END IsISOPseudoBaseFunction ;
+
+
+(*
+   IsPIMPseudoBaseFunction -
+*)
+
+PROCEDURE IsPIMPseudoBaseFunction (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (NOT Iso) AND (NOT Pim2) AND (Sym#NulSym) AND (Sym=Size) )
+END IsPIMPseudoBaseFunction ;
+
+
+(*
+   IsPseudoBaseFunction - returns true if Sym is a Base pseudo function.
+*)
+
+PROCEDURE IsPseudoBaseFunction (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (Sym=High) OR (Sym=Val) OR (Sym=Convert) OR IsOrd(Sym) OR
+          (Sym=Chr) OR IsFloat(Sym) OR IsTrunc(Sym) OR (Sym=Min) OR
+          (Sym=Max) OR (Sym=Abs) OR (Sym=Odd) OR (Sym=Cap) OR
+          IsISOPseudoBaseFunction(Sym) OR IsPIMPseudoBaseFunction(Sym)
+         )
+END IsPseudoBaseFunction ;
+
+
+(*
+   IsPseudoBaseProcedure - returns true if Sym is a Base pseudo procedure.
+*)
+
+PROCEDURE IsPseudoBaseProcedure (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (Sym=New) OR (Sym=Dispose) OR (Sym=Inc) OR (Sym=Dec) OR
+          (Sym=Incl) OR (Sym=Excl)
+         )
+END IsPseudoBaseProcedure ;
+
+
+(*
+   IsBaseType - returns TRUE if Sym is a Base type.
+*)
+
+PROCEDURE IsBaseType (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (Sym=Cardinal) OR (Sym=Integer)  OR (Sym=Boolean) OR
+          (Sym=Char)     OR (Sym=Proc)     OR
+          (Sym=LongInt)  OR (Sym=LongCard) OR
+          (Sym=ShortInt) OR (Sym=ShortCard) OR
+          (Sym=Real)     OR (Sym=LongReal) OR (Sym=ShortReal) OR
+          (Sym=Complex)  OR (Sym=LongComplex) OR (Sym=ShortComplex) OR
+          (Sym=Bitset)
+         )
+END IsBaseType ;
+
+
+(*
+   IsOrdinalType - returns TRUE if, sym, is an ordinal type.
+                   An ordinal type is defined as:
+                   a base type which contains whole numbers or
+                   a subrange type or an enumeration type.
+*)
+
+PROCEDURE IsOrdinalType (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (Sym=Cardinal)  OR (Sym=Integer)   OR
+          (Sym=Char)      OR (Sym=Boolean)   OR
+          (Sym=LongInt)   OR (Sym=LongCard)  OR
+          (Sym=ShortInt)  OR (Sym=ShortCard) OR
+          (Sym=ZType)     OR
+          IsSubrange(Sym) OR IsEnumeration(Sym) OR
+          IsIntegerN(Sym) OR IsCardinalN(Sym)
+         )
+END IsOrdinalType ;
+
+
+(*
+   IsComplexType - returns TRUE if, sym, is COMPLEX,
+                   LONGCOMPLEX or SHORTCOMPLEX.
+*)
+
+PROCEDURE IsComplexType (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (sym=Complex) OR (sym=LongComplex) OR (sym=ShortComplex) OR (sym=CType) OR IsComplexN (sym) )
+END IsComplexType ;
+
+
+(*
+   ComplexToScalar - returns the scalar (or base type) of the complex type, sym.
+*)
+
+PROCEDURE ComplexToScalar (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF sym=NulSym
+   THEN
+      (* a const complex may have a NulSym type *)
+      RETURN( RType )
+   ELSIF sym=Complex
+   THEN
+      RETURN( Real )
+   ELSIF sym=LongComplex
+   THEN
+      RETURN( LongReal )
+   ELSIF sym=ShortComplex
+   THEN
+      RETURN( ShortReal )
+   ELSIF sym=CType
+   THEN
+      RETURN( RType )
+   ELSIF sym=ComplexN(32)
+   THEN
+      RETURN( RealN(32) )
+   ELSIF sym=ComplexN(64)
+   THEN
+      RETURN( RealN(64) )
+   ELSIF sym=ComplexN(96)
+   THEN
+      RETURN( RealN(96) )
+   ELSIF sym=ComplexN(128)
+   THEN
+      RETURN( RealN(128) )
+   ELSE
+      MetaError1('{%1ad} must be a COMPLEX type', sym)
+   END
+END ComplexToScalar ;
+
+
+(*
+   ScalarToComplex - given a real type, t, return the equivalent complex type.
+*)
+
+PROCEDURE ScalarToComplex (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF sym=Real
+   THEN
+      RETURN( Complex )
+   ELSIF sym=LongReal
+   THEN
+      RETURN( LongComplex )
+   ELSIF sym=ShortReal
+   THEN
+      RETURN( ShortComplex )
+   ELSIF sym=RType
+   THEN
+      RETURN( CType )
+   ELSIF sym=RealN(32)
+   THEN
+      RETURN( ComplexN(32) )
+   ELSIF sym=RealN(64)
+   THEN
+      RETURN( ComplexN(64) )
+   ELSIF sym=RealN(96)
+   THEN
+      RETURN( ComplexN(96) )
+   ELSIF sym=RealN(128)
+   THEN
+      RETURN( ComplexN(128) )
+   ELSE
+      MetaError1('{%1ad} must be a REAL type', sym) ;
+      RETURN( Complex )
+   END
+END ScalarToComplex ;
+
+
+(*
+   GetCmplxReturnType - this code implements the table given in the
+                        ISO standard Page 293 with an addition for
+                        SHORTCOMPLEX.
+*)
+
+PROCEDURE GetCmplxReturnType (t1, t2: CARDINAL) : CARDINAL ;
+VAR
+   mt1, mt2: MetaType ;
+BEGIN
+   t1 := SkipType(t1) ;
+   t2 := SkipType(t2) ;
+   IF (IsRealType(t1) OR IsRealN(t1)) AND
+      (IsRealType(t2) OR IsRealN(t2))
+   THEN
+      mt1 := FindMetaType(t1) ;
+      mt2 := FindMetaType(t2) ;
+      IF mt1=mt2
+      THEN
+         RETURN( ScalarToComplex(t1) )
+      ELSE
+         IF mt1=rtype
+         THEN
+            RETURN( ScalarToComplex(t2) )
+         ELSIF mt2=rtype
+         THEN
+            RETURN( ScalarToComplex(t1) )
+         ELSE
+            RETURN( NulSym )
+         END
+      END
+   ELSE
+      RETURN( NulSym )
+   END
+END GetCmplxReturnType ;
+
+
+(*
+   EmitTypeIncompatibleWarning - emit a type incompatibility warning.
+*)
+
+PROCEDURE EmitTypeIncompatibleWarning (tok: CARDINAL;
+                                       kind: Compatability; t1, t2: CARDINAL) ;
+BEGIN
+   CASE kind OF
+
+   expression:  MetaErrorT2 (tok,
+                             '{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in an expression, hint one of the expressions should be converted',
+                             t1, t2) |
+   assignment:  MetaErrorT2 (tok,
+                             '{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} during an assignment, hint maybe the expression should be converted',
+                             t1, t2) |
+   parameter :  MetaErrorT2 (tok,
+                            '{%1W:} type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} {%2as}}}, hint the actual parameter {%2a} should be converted',
+                            t1, t2) |
+   comparison:  MetaErrorT2 (tok,
+                            '{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in a relational expression, hint one of the expressions should be converted',
+                            t1, t2)
+
+   ELSE
+   END
+END EmitTypeIncompatibleWarning ;
+
+
+(*
+   EmitTypeIncompatibleError - emit a type incompatibility error.
+*)
+
+PROCEDURE EmitTypeIncompatibleError (tok: CARDINAL;
+                                     kind: Compatability; t1, t2: CARDINAL) ;
+BEGIN
+   CASE kind OF
+
+   expression:  MetaErrorT2 (tok,
+                            'type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in an expression, hint one of the expressions should be converted',
+                            t1, t2) |
+   assignment:  MetaErrorT2 (tok,
+                             'type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} during an assignment, hint maybe the expression should be converted',
+                             t1, t2) |
+   parameter :  MetaErrorT2 (tok,
+                             'type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} and {%2as}}}, hint the actual parameter should be converted',
+                             t1, t2) |
+   comparison:  MetaErrorT2 (tok,
+                             'type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in a relational expression, hint one of the expressions should be converted',
+                             t1, t2)
+
+   ELSE
+   END
+END EmitTypeIncompatibleError ;
+
+
+(*
+   CheckCompatible - returns if t1 and t2 are kind compatible
+*)
+
+PROCEDURE CheckCompatible (tok: CARDINAL;
+                           t1, t2: CARDINAL; kind: Compatability) ;
+VAR
+   s: String ;
+   r: Compatible ;
+BEGIN
+   r := IsCompatible (t1, t2, kind) ;
+   IF (r#first) AND (r#second)
+   THEN
+      IF (r=warnfirst) OR (r=warnsecond)
+      THEN
+         s := InitString('{%1W}')
+      ELSE
+         s := InitString('')
+      END ;
+      IF IsUnknown(t1) AND IsUnknown(t2)
+      THEN
+         s := ConCat(s, InitString('two different unknown types {%1a:{%2a:{%1a} and {%2a}}} must either be declared or imported)')) ;
+         MetaErrorStringT2 (tok, s, t1, t2)
+      ELSIF IsUnknown(t1)
+      THEN
+         s := ConCat(s, InitString('this type {%1a} is currently unknown, it must be declared or imported')) ;
+         MetaErrorStringT1 (tok, s, t1)
+      ELSIF IsUnknown(t2)
+      THEN
+         s := ConCat (s, InitString('this type {%1a} is currently unknown, it must be declared or imported')) ;
+         MetaErrorStringT1 (tok, s, t2)
+      ELSE
+         IF (r=warnfirst) OR (r=warnsecond)
+         THEN
+            EmitTypeIncompatibleWarning (tok, kind, t1, t2)
+         ELSE
+            EmitTypeIncompatibleError (tok, kind, t1, t2)
+         END
+      END
+   END
+END CheckCompatible ;
+
+
+(*
+   CheckExpressionCompatible - returns if t1 and t2 are compatible types for
+                               +, -, *, DIV, >, <, =, etc.
+                               If t1 and t2 are not compatible then an error
+                               message is displayed.
+*)
+
+PROCEDURE CheckExpressionCompatible (tok: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   CheckCompatible (tok, left, right, expression)
+END CheckExpressionCompatible ;
+
+
+(*
+   CheckParameterCompatible - checks to see if types, t1, and, t2, are
+                              compatible for parameter passing.
+*)
+
+PROCEDURE CheckParameterCompatible (tok: CARDINAL;
+                                    t1, t2: CARDINAL) ;
+BEGIN
+   CheckCompatible (tok, t1, t2, parameter)
+END CheckParameterCompatible ;
+
+
+(*
+   CheckAssignmentCompatible - returns if t1 and t2 are compatible types for
+                               :=, =, #.
+                               If t1 and t2 are not compatible then an error
+                               message is displayed.
+*)
+
+PROCEDURE CheckAssignmentCompatible (tok: CARDINAL;
+                                     left, right: CARDINAL) ;
+BEGIN
+   IF left # right
+   THEN
+      CheckCompatible (tok, left, right, assignment)
+   END
+END CheckAssignmentCompatible ;
+
+
+(*
+   FindMetaType - returns the MetaType associated with, sym.
+*)
+
+PROCEDURE FindMetaType (sym: CARDINAL) : MetaType ;
+BEGIN
+   IF sym=NulSym
+   THEN
+      RETURN( const )
+   ELSIF sym=Word
+   THEN
+      RETURN( word )
+   ELSIF sym=Byte
+   THEN
+      RETURN( byte )
+   ELSIF sym=Loc
+   THEN
+      RETURN( loc )
+   ELSIF sym=Address
+   THEN
+      RETURN( address )
+   ELSIF sym=Char
+   THEN
+      RETURN( chr )
+   ELSIF sym=Integer
+   THEN
+      RETURN( normint )
+   ELSIF sym=ShortInt
+   THEN
+      RETURN( shortint )
+   ELSIF sym=LongInt
+   THEN
+      RETURN( longint )
+   ELSIF sym=Cardinal
+   THEN
+      RETURN( normcard )
+   ELSIF sym=ShortCard
+   THEN
+      RETURN( shortcard )
+   ELSIF sym=LongCard
+   THEN
+      RETURN( longcard )
+   ELSIF sym=ZType
+   THEN
+      RETURN( ztype )
+   ELSIF sym=RType
+   THEN
+      RETURN( rtype )
+   ELSIF sym=Real
+   THEN
+      RETURN( real )
+   ELSIF sym=ShortReal
+   THEN
+      RETURN( shortreal )
+   ELSIF sym=LongReal
+   THEN
+      RETURN( longreal )
+   ELSIF sym=IntegerN(8)
+   THEN
+      RETURN( int8 )
+   ELSIF sym=IntegerN(16)
+   THEN
+      RETURN( int16 )
+   ELSIF sym=IntegerN(32)
+   THEN
+      RETURN( int32 )
+   ELSIF sym=IntegerN(64)
+   THEN
+      RETURN( int64 )
+   ELSIF sym=CardinalN(8)
+   THEN
+      RETURN( card8 )
+   ELSIF sym=CardinalN(16)
+   THEN
+      RETURN( card16 )
+   ELSIF sym=CardinalN(32)
+   THEN
+      RETURN( card32 )
+   ELSIF sym=CardinalN(64)
+   THEN
+      RETURN( card64 )
+   ELSIF sym=WordN(16)
+   THEN
+      RETURN( word16 )
+   ELSIF sym=WordN(32)
+   THEN
+      RETURN( word32 )
+   ELSIF sym=WordN(64)
+   THEN
+      RETURN( word64 )
+   ELSIF sym=SetN(8)
+   THEN
+      RETURN( set8 )
+   ELSIF sym=SetN(16)
+   THEN
+      RETURN( set16 )
+   ELSIF sym=SetN(32)
+   THEN
+      RETURN( set32 )
+   ELSIF sym=RealN(32)
+   THEN
+      RETURN( real32 )
+   ELSIF sym=RealN(64)
+   THEN
+      RETURN( real64 )
+   ELSIF sym=RealN(96)
+   THEN
+      RETURN( real96 )
+   ELSIF sym=RealN(128)
+   THEN
+      RETURN( real128 )
+   ELSIF sym=Complex
+   THEN
+      RETURN( complex )
+   ELSIF sym=ShortComplex
+   THEN
+      RETURN( shortcomplex )
+   ELSIF sym=LongComplex
+   THEN
+      RETURN( longcomplex )
+   ELSIF sym=ComplexN(32)
+   THEN
+      RETURN( complex32 )
+   ELSIF sym=ComplexN(64)
+   THEN
+      RETURN( complex64 )
+   ELSIF sym=ComplexN(96)
+   THEN
+      RETURN( complex96 )
+   ELSIF sym=ComplexN(128)
+   THEN
+      RETURN( complex128 )
+   ELSIF sym=CType
+   THEN
+      RETURN( ctype )
+   ELSIF IsSet(sym)
+   THEN
+      RETURN( set )
+   ELSIF IsHiddenType(sym)
+   THEN
+      RETURN( opaque )
+   ELSIF IsPointer(sym)
+   THEN
+      RETURN( pointer )
+   ELSIF IsEnumeration(sym)
+   THEN
+      RETURN( enum )
+   ELSIF IsRecord(sym)
+   THEN
+      RETURN( rec )
+   ELSIF IsArray(sym)
+   THEN
+      RETURN( array )
+   ELSIF IsType(sym)
+   THEN
+      RETURN( FindMetaType(GetType(sym)) )
+   ELSIF IsProcedure(sym) OR IsProcType(sym)
+   THEN
+      RETURN( procedure )
+   ELSE
+      RETURN( unknown )
+   END
+END FindMetaType ;
+
+
+(*
+   IsBaseCompatible - returns an enumeration field determining whether a simple base type
+                      comparison is legal.
+*)
+
+PROCEDURE IsBaseCompatible (t1, t2: CARDINAL;
+                            kind: Compatability) : Compatible ;
+VAR
+   mt1, mt2: MetaType ;
+BEGIN
+   IF (t1=t2) AND ((kind=assignment) OR (kind=parameter))
+   THEN
+      RETURN( first )
+   ELSE
+      mt1 := FindMetaType (t1) ;
+      mt2 := FindMetaType (t2) ;
+      IF (mt1=unknown) OR (mt2=unknown)
+      THEN
+         RETURN( no )
+      END ;
+
+      CASE kind OF
+
+      expression: RETURN( Expr [mt1, mt2] ) |
+      assignment: RETURN( Ass  [mt1, mt2] ) |
+      parameter : RETURN( Ass  [mt1, mt2] ) |
+      comparison: RETURN( Comp [mt1, mt2] )
+
+      ELSE
+         InternalError ('unexpected compatibility')
+      END
+   END
+END IsBaseCompatible ;
+
+
+(*
+   IsRealType - returns TRUE if, t, is a real type.
+*)
+
+PROCEDURE IsRealType (t: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (t=Real) OR (t=LongReal) OR (t=ShortReal) OR (t=RType) )
+END IsRealType ;
+
+
+(*
+   CannotCheckTypeInPass3 - returns TRUE if we are unable to check the
+                            type of, e, in pass 3.
+*)
+
+PROCEDURE CannotCheckTypeInPass3 (e: CARDINAL) : BOOLEAN ;
+VAR
+   t : CARDINAL ;
+   mt: MetaType ;
+BEGIN
+   t := SkipType(GetType(e)) ;
+   mt := FindMetaType(t) ;
+   CASE mt OF
+
+   pointer,
+   enum,
+   set,
+   set8,
+   set16,
+   set32,
+   opaque :  RETURN( TRUE )
+
+   ELSE
+      RETURN( FALSE )
+   END
+END CannotCheckTypeInPass3 ;
+
+
+(*
+   IsCompatible - returns true if the types, t1, and, t2, are compatible.
+*)
+
+PROCEDURE IsCompatible (t1, t2: CARDINAL; kind: Compatability) : Compatible ;
+BEGIN
+   t1 := SkipType (t1) ;
+   t2 := SkipType (t2) ;
+   IF t1 = t2
+   THEN
+      (* same types are always compatible.  *)
+      RETURN first
+   ELSIF IsPassCodeGeneration ()
+   THEN
+      RETURN AfterResolved (t1, t2, kind)
+   ELSE
+      RETURN BeforeResolved (t1, t2, kind)
+   END
+END IsCompatible ;
+
+
+(*
+   IsPointerSame - returns TRUE if pointers, a, and, b, are the same.
+*)
+
+PROCEDURE IsPointerSame (a, b: CARDINAL; error: BOOLEAN) : BOOLEAN ;
+BEGIN
+   RETURN( IsSameType(SkipType(GetType(a)), SkipType(GetType(b)), error) )
+END IsPointerSame ;
+
+
+(*
+   IsSubrangeSame - checks to see whether the subranges are the same.
+*)
+
+PROCEDURE IsSubrangeSame (a, b: CARDINAL) : BOOLEAN ;
+VAR
+   al, ah,
+   bl, bh: CARDINAL ;
+BEGIN
+   a := SkipType(a) ;
+   b := SkipType(b) ;
+   IF a#b
+   THEN
+      GetSubrange(a, ah, al) ;
+      GetSubrange(b, bh, bl) ;
+      PushValue(al) ;
+      PushValue(bl) ;
+      IF NOT Equ(GetDeclaredMod(a))
+      THEN
+         RETURN( FALSE )
+      END ;
+      PushValue(ah) ;
+      PushValue(bh) ;
+      IF NOT Equ(GetDeclaredMod(a))
+      THEN
+         RETURN( FALSE )
+      END
+   END ;
+   RETURN( TRUE )
+END IsSubrangeSame ;
+
+
+(*
+   IsVarientSame - returns TRUE if varient types, a, and, b, are identical.
+*)
+
+PROCEDURE IsVarientSame (a, b: CARDINAL; error: BOOLEAN) : BOOLEAN ;
+VAR
+   i, j  : CARDINAL ;
+   fa, fb,
+   ga, gb: CARDINAL ;
+BEGIN
+   i := 1 ;
+   ga := NulSym ;
+   gb := NulSym ;
+   REPEAT
+      fa := GetNth(a, i) ;
+      fb := GetNth(b, i) ;
+      IF (fa#NulSym) AND (fb#NulSym)
+      THEN
+         Assert(IsFieldVarient(fa)) ;
+         Assert(IsFieldVarient(fb)) ;
+         j := 1 ;
+         REPEAT
+            ga := GetNth(fa, j) ;
+            gb := GetNth(fb, j) ;
+            IF (ga#NulSym) AND (gb#NulSym)
+            THEN
+               IF NOT IsSameType(GetType(ga), GetType(gb), error)
+               THEN
+                  RETURN( FALSE )
+               END ;
+               INC(j)
+            END
+         UNTIL (ga=NulSym) OR (gb=NulSym) ;
+         IF ga#gb
+         THEN
+            RETURN( FALSE )
+         END
+      END ;
+      INC(i)
+   UNTIL (fa=NulSym) OR (fb=NulSym) ;
+   RETURN( ga=gb )
+END IsVarientSame ;
+
+
+(*
+   IsRecordSame -
+*)
+
+PROCEDURE IsRecordSame (a, b: CARDINAL; error: BOOLEAN) : BOOLEAN ;
+VAR
+   ta, tb,
+   fa, fb: CARDINAL ;
+   i     : CARDINAL ;
+BEGIN
+   i := 1 ;
+   REPEAT
+      fa := GetNth(a, i) ;
+      fb := GetNth(b, i) ;
+      IF (fa#NulSym) AND (fb#NulSym)
+      THEN
+         ta := GetType(fa) ;
+         tb := GetType(fb) ;
+         IF IsRecordField(fa) AND IsRecordField(fb)
+         THEN
+            IF NOT IsSameType(ta, tb, error)
+            THEN
+               RETURN( FALSE )
+            END
+         ELSIF IsVarient(fa) AND IsVarient(fb)
+         THEN
+            IF NOT IsVarientSame(ta, tb, error)
+            THEN
+               RETURN( FALSE )
+            END
+      	 ELSIF IsFieldVarient(fa) OR IsFieldVarient(fb)
+      	 THEN
+            InternalError ('should not see a field varient')
+         ELSE
+            RETURN( FALSE )
+      	 END
+      END ;
+      INC(i)
+   UNTIL (fa=NulSym) OR (fb=NulSym) ;
+   RETURN( fa=fb )
+END IsRecordSame ;
+
+
+(*
+   IsArraySame -
+*)
+
+PROCEDURE IsArraySame (t1, t2: CARDINAL; error: BOOLEAN) : BOOLEAN ;
+VAR
+   s1, s2: CARDINAL ;
+BEGIN
+   s1 := GetArraySubscript(t1) ;
+   s2 := GetArraySubscript(t2) ;
+   RETURN( IsSameType(GetType(s1), GetType(s2), error) AND
+           IsSameType(GetType(t1), GetType(t2), error) )
+END IsArraySame ;
+
+
+(*
+   IsEnumerationSame -
+*)
+
+PROCEDURE IsEnumerationSame (t1, t2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( t1=t2 )
+END IsEnumerationSame ;
+
+
+(*
+   IsSetSame -
+*)
+
+PROCEDURE IsSetSame (t1, t2: CARDINAL; error: BOOLEAN) : BOOLEAN ;
+BEGIN
+   RETURN( IsSameType(GetType(t1), GetType(t2), error) )
+END IsSetSame ;
+
+
+(*
+   IsSameType - returns TRUE if
+*)
+
+PROCEDURE IsSameType (t1, t2: CARDINAL; error: BOOLEAN) : BOOLEAN ;
+BEGIN
+   t1 := SkipType(t1) ;
+   t2 := SkipType(t2) ;
+   IF t1=t2
+   THEN
+      RETURN( TRUE )
+   ELSIF IsArray(t1) AND IsArray(t2)
+   THEN
+      RETURN( IsArraySame(t1, t2, error) )
+   ELSIF IsSubrange(t1) AND IsSubrange(t2)
+   THEN
+      RETURN( IsSubrangeSame(t1, t2) )
+   ELSIF IsProcType(t1) AND IsProcType(t2)
+   THEN
+      RETURN( IsProcTypeSame(t1, t2, error) )
+   ELSIF IsEnumeration(t1) AND IsEnumeration(t2)
+   THEN
+      RETURN( IsEnumerationSame(t1, t2 (* , error *) ) )
+   ELSIF IsRecord(t1) AND IsRecord(t2)
+   THEN
+      RETURN( IsRecordSame(t1, t2, error) )
+   ELSIF IsSet(t1) AND IsSet(t2)
+   THEN
+      RETURN( IsSetSame(t1, t2, error) )
+   ELSIF IsPointer(t1) AND IsPointer(t2)
+   THEN
+      RETURN( IsPointerSame(t1, t2, error) )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsSameType ;
+
+
+(*
+   IsProcTypeSame -
+*)
+
+PROCEDURE IsProcTypeSame (p1, p2: CARDINAL; error: BOOLEAN) : BOOLEAN ;
+VAR
+   pa, pb: CARDINAL ;
+   n, i  : CARDINAL ;
+BEGIN
+   n := NoOfParam(p1) ;
+   IF n#NoOfParam(p2)
+   THEN
+      IF error
+      THEN
+         MetaError2('parameter is incompatible as {%1Dd} was declared with {%2n} parameters', p1, NoOfParam(p1)) ;
+         MetaError2('whereas {%1Dd} was declared with {%2n} parameters', p2, NoOfParam(p2))
+      END ;
+      RETURN( FALSE )
+   END ;
+   i := 1 ;
+   WHILE i<=n DO
+      pa := GetNthParam(p1, i) ;
+      pb := GetNthParam(p2, i) ;
+      IF IsVarParam(p1, i)#IsVarParam(p2, i)
+      THEN
+         IF error
+         THEN
+            MetaErrors3('the {%1n} parameter is incompatible between {%2Dad} and {%3ad} as only one was declared as VAR',
+                        'the {%1n} parameter is incompatible between {%2ad} and {%3Dad} as only one was declared as VAR',
+                        i, p1, p2)
+         END ;
+         RETURN( FALSE )
+      END ;
+      IF NOT IsSameType(GetType(pa), GetType(pb), error)
+      THEN
+         RETURN( FALSE )
+      END ;
+      INC(i)
+   END ;
+   RETURN( IsSameType(GetType(p1), GetType(p2), error) )
+END IsProcTypeSame ;
+
+
+(*
+   doProcTypeCheck -
+*)
+
+PROCEDURE doProcTypeCheck (p1, p2: CARDINAL; error: BOOLEAN) : BOOLEAN ;
+BEGIN
+   IF (IsProcType(p1) OR IsProcedure(p1)) AND
+      (IsProcType(p2) OR IsProcedure(p2))
+   THEN
+      IF p1=p2
+      THEN
+         RETURN( TRUE )
+      ELSE
+         RETURN( IsProcTypeSame(p1, p2, error) )
+      END
+   ELSE
+      RETURN( FALSE )
+   END
+END doProcTypeCheck ;
+
+
+(*
+   AfterResolved - a thorough test for type compatibility.
+*)
+
+PROCEDURE AfterResolved (t1, t2: CARDINAL; kind: Compatability) : Compatible ;
+VAR
+   mt1, mt2: MetaType ;
+BEGIN
+   IF (t1=NulSym) OR (t2=NulSym)
+   THEN
+      RETURN( first )
+   ELSIF ((kind=parameter) OR (kind=assignment)) AND (t1=t2)
+   THEN
+      RETURN( first )
+   ELSIF IsSubrange(t1)
+   THEN
+      RETURN( IsCompatible(GetType(t1), t2, kind) )
+   ELSIF IsSubrange(t2)
+   THEN
+      RETURN( IsCompatible(t1, GetType(t2), kind) )
+   ELSE
+      mt1 := FindMetaType(t1) ;
+      mt2 := FindMetaType(t2) ;
+      IF mt1=mt2
+      THEN
+         CASE mt1 OF
+
+         set,
+         set8,
+         set16,
+         set32    :  IF IsSetSame(t1, t2, FALSE)
+                     THEN
+                        RETURN( first )
+                     ELSE
+                        RETURN( no )
+                     END |
+         enum     :  IF IsEnumerationSame(t1, t2 (* , FALSE *) )
+                     THEN
+                        RETURN( first )
+                     ELSE
+                        RETURN( no )
+                     END |
+         pointer  :  IF IsPointerSame(t1, t2, FALSE)
+                     THEN
+                        RETURN( first )
+                     ELSE
+                        RETURN( no )
+                     END |
+         opaque   :  RETURN( no ) |
+         procedure:  IF doProcTypeCheck(t1, t2, FALSE)
+                     THEN
+                        RETURN( first )
+                     ELSE
+                        RETURN( no )
+                     END
+
+         ELSE
+            (* fall through *)
+         END
+      END ;
+      RETURN( IsBaseCompatible(t1, t2, kind) )
+   END
+END AfterResolved ;
+
+
+(*
+   BeforeResolved - attempts to test for type compatibility before all types are
+                    completely resolved.  In particular set types and constructor
+                    types are not fully known before the end of pass 3.
+                    However we can test base types.
+*)
+
+PROCEDURE BeforeResolved (t1, t2: CARDINAL; kind: Compatability) : Compatible ;
+BEGIN
+   IF (t1=NulSym) OR (t2=NulSym)
+   THEN
+      RETURN( first )
+   ELSIF IsSubrange(t1)
+   THEN
+      RETURN( IsCompatible(GetType(t1), t2, kind) )
+   ELSIF IsSubrange(t2)
+   THEN
+      RETURN( IsCompatible(t1, GetType(t2), kind) )
+   ELSIF IsSet(t1) OR IsSet(t2)
+   THEN
+      (* cannot test set compatibility at this point so we do this again after pass 3 *)
+      RETURN( first )
+   ELSIF (IsProcType(t1) AND IsProcedure(t2)) OR
+         (IsProcedure(t1) AND IsProcType(t2))
+   THEN
+      (* we will perform checking during code generation *)
+      RETURN( first )
+   ELSIF IsHiddenType (t1) AND IsHiddenType (t2)
+   THEN
+      IF t1 = t2
+      THEN
+         MetaError0 ('assert about to fail as t1 = t2')
+      END ;
+      Assert (t1 # t2) ;
+      (* different opaque types are not assignment or expression compatible.  *)
+      RETURN no
+   ELSE
+(*
+   see M2Quads for the fixme comment at assignment.
+
+   PIM2 says that CARDINAL and INTEGER are compatible with subranges of CARDINAL and INTEGER,
+        however we do not know the type to our subranges yet as (GetType(SubrangeType)=NulSym).
+        So we add type checking in the range checking module which is done post pass 3,
+        when all is resolved.
+*)
+
+      RETURN IsBaseCompatible (t1, t2, kind)
+   END
+END BeforeResolved ;
+
+
+(*
+   AssignmentRequiresWarning - returns TRUE if t1 and t2 can be used during
+                               an assignment, but should generate a warning.
+                               For example in PIM we can assign ADDRESS
+                               and WORD providing they are both the
+                               same size.
+                               No warning is necessary if the types are the same.
+*)
+
+PROCEDURE AssignmentRequiresWarning (t1, t2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN ((t1 # t2) AND
+           ((IsCompatible(t1, t2, assignment)=warnfirst) OR
+            (IsCompatible(t1, t2, assignment)=warnsecond)))
+END AssignmentRequiresWarning ;
+
+
+(*
+   IsAssignmentCompatible - returns TRUE if t1 and t2 are assignment
+                            compatible.
+*)
+
+PROCEDURE IsAssignmentCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (t1=t2) OR
+          (IsCompatible(t1, t2, assignment)=first) OR
+          (IsCompatible(t1, t2, assignment)=second)
+         )
+END IsAssignmentCompatible ;
+
+
+(*
+   IsExpressionCompatible - returns TRUE if t1 and t2 are expression
+                            compatible.
+*)
+
+PROCEDURE IsExpressionCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (IsCompatible(t1, t2, expression)=first) OR
+          (IsCompatible(t1, t2, expression)=second)
+         )
+END IsExpressionCompatible ;
+
+
+(*
+   IsParameterCompatible - returns TRUE if t1 and t2 are expression
+                           compatible.
+*)
+
+PROCEDURE IsParameterCompatible (t1, t2: CARDINAL (* ; tokenNo: CARDINAL *) ) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (IsCompatible(t1, t2, parameter)=first) OR
+          (IsCompatible(t1, t2, parameter)=second)
+         )
+END IsParameterCompatible ;
+
+
+(*
+   IsComparisonCompatible - returns TRUE if t1 and t2 are comparison compatible.
+*)
+
+PROCEDURE IsComparisonCompatible (t1, t2: CARDINAL (* ; tokenNo: CARDINAL *) ) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (IsCompatible(t1, t2, comparison)=first) OR
+          (IsCompatible(t1, t2, comparison)=second)
+         )
+END IsComparisonCompatible ;
+
+
+(*
+   MixMetaTypes -
+*)
+
+PROCEDURE MixMetaTypes (t1, t2: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
+VAR
+   mt1, mt2: MetaType ;
+BEGIN
+   mt1 := FindMetaType(t1) ;
+   mt2 := FindMetaType(t2) ;
+   CASE Expr[mt1, mt2] OF
+
+   no        :  MetaErrorT2 (NearTok, 'type incompatibility between {%1as} and {%2as}', t1, t2) ;
+                FlushErrors  (* unrecoverable at present *) |
+   warnfirst,
+   first     :  RETURN( t1 ) |
+   warnsecond,
+   second    :  RETURN( t2 )
+
+   ELSE
+      InternalError ('not expecting this metatype value')
+   END
+END MixMetaTypes ;
+
+
+(*
+   MixTypes - given types, t1 and t2, returns a type symbol that
+              provides expression type compatibility.
+              NearTok is used to identify the source position if a type
+              incompatability occurs.
+*)
+
+PROCEDURE MixTypes (t1, t2: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
+BEGIN
+   IF t1=t2
+   THEN
+      RETURN( t1 )
+   ELSIF (t1=Address) AND (t2=Cardinal)
+   THEN
+      RETURN( Address )
+   ELSIF (t1=Cardinal) AND (t2=Address)
+   THEN
+      RETURN( Address )
+   ELSIF (t1=Address) AND (t2=Integer)
+   THEN
+      RETURN( Address )
+   ELSIF (t1=Integer) AND (t2=Address)
+   THEN
+      RETURN( Address )
+   ELSIF t1=NulSym
+   THEN
+      RETURN( t2 )
+   ELSIF t2=NulSym
+   THEN
+      RETURN( t1 )
+   ELSIF (t1=Bitset) AND IsSet(t2)
+   THEN
+      RETURN( t1 )
+   ELSIF IsSet(t1) AND (t2=Bitset)
+   THEN
+      RETURN( t2 )
+   ELSIF IsEnumeration(t1)
+   THEN
+      RETURN( MixTypes(Integer, t2, NearTok) )
+   ELSIF IsEnumeration(t2)
+   THEN
+      RETURN( MixTypes(t1, Integer, NearTok) )
+   ELSIF IsSubrange(t1)
+   THEN
+      RETURN( MixTypes(GetType(t1), t2, NearTok) )
+   ELSIF IsSubrange(t2)
+   THEN
+      RETURN( MixTypes(t1, GetType(t2), NearTok) )
+   ELSIF IsRealType(t1) AND IsRealType(t2)
+   THEN
+      IF t1=RType
+      THEN
+         RETURN( t2 )
+      ELSIF t2=RType
+      THEN
+         RETURN( t1 )
+      ELSE
+         RETURN( RType )
+      END
+   ELSIF IsComplexType(t1) AND IsComplexType(t2)
+   THEN
+      IF t1=CType
+      THEN
+         RETURN( t2 )
+      ELSIF t2=CType
+      THEN
+         RETURN( t1 )
+      ELSE
+         RETURN( CType )
+      END
+   ELSIF IsType(t1)
+   THEN
+      RETURN( MixTypes(GetType(t1), t2, NearTok) )
+   ELSIF IsType(t2)
+   THEN
+      RETURN( MixTypes(t1, GetType(t2), NearTok) )
+   ELSIF (t1=GetLowestType(t1)) AND (t2=GetLowestType(t2))
+   THEN
+      RETURN( MixMetaTypes(t1, t2, NearTok) )
+   ELSE
+      t1 := GetLowestType(t1) ;
+      t2 := GetLowestType(t2) ;
+      RETURN( MixTypes(t1, t2, NearTok) )
+   END
+END MixTypes ;
+
+
+(*
+   NegateType - if the type is unsigned then returns the
+                signed equivalent.
+*)
+
+PROCEDURE NegateType (type: CARDINAL (* ; sympos: CARDINAL *) ) : CARDINAL ;
+VAR
+   lowType: CARDINAL ;
+BEGIN
+   IF type#NulSym
+   THEN
+      lowType := GetLowestType (type) ;
+      IF lowType=LongCard
+      THEN
+         RETURN LongInt
+      ELSIF lowType=Cardinal
+      THEN
+         RETURN Integer
+(*      ELSE
+         MetaErrorT1 (sympos, 'the type {%1ad} does not have a negated equivalent and an unary minus cannot be used on an operand of this type', type)
+*)
+      END
+   END ;
+   RETURN type
+END NegateType ;
+
+
+(*
+   IsMathType - returns TRUE if the type is a mathematical type.
+                A mathematical type has a range larger than INTEGER.
+                (Typically SHORTREAL/REAL/LONGREAL/LONGINT/LONGCARD)
+*)
+
+PROCEDURE IsMathType (type: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (type=LongCard) OR (type=LongInt) OR (type=Real) OR
+          (type=LongReal) OR (type=ShortReal) OR
+          (type=RType) OR (type=ZType)
+         )
+END IsMathType ;
+
+
+(*
+   IsVarParamCompatible - returns TRUE if types, actual, and, formal
+                          are compatible even if formal is a VAR
+                          parameter.
+*)
+
+PROCEDURE IsVarParamCompatible (actual, formal: CARDINAL) : BOOLEAN ;
+BEGIN
+   actual := SkipType(actual) ;
+   formal := SkipType(formal) ;
+   IF IsParameter(formal) AND IsParameterUnbounded(formal)
+   THEN
+      formal := SkipType(GetType(GetType(formal))) ;   (* move over unbounded *)
+      IF IsGenericSystemType(formal)
+      THEN
+         RETURN( TRUE )
+      END ;
+      RETURN( (formal=actual) OR (IsArray(actual) AND (formal=SkipType(GetType(actual)))) )
+   ELSE
+      RETURN( (actual=formal) OR
+              (IsPointer(actual) AND (formal=Address)) OR
+              (IsPointer(formal) AND (actual=Address)) OR
+              (IsGenericSystemType(actual) AND IsSizeSame(FindMetaType(actual), FindMetaType(formal))) OR
+              (IsGenericSystemType(formal) AND IsSizeSame(FindMetaType(actual), FindMetaType(formal))) OR
+              IsSameSizePervasiveType(formal, actual) )
+   END
+END IsVarParamCompatible ;
+
+
+(*
+   IsArrayUnboundedCompatible - returns TRUE if unbounded or array types, t1, and, t2,
+                                are compatible.
+*)
+
+PROCEDURE IsArrayUnboundedCompatible (t1, t2: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF (t1=NulSym) OR (t2=NulSym)
+   THEN
+      RETURN( FALSE)
+   ELSIF (IsUnbounded(t1) OR IsArray(t1)) AND
+         (IsUnbounded(t2) OR IsArray(t2))
+   THEN
+      RETURN( SkipType(GetType(t1))=SkipType(GetType(t2)) )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsArrayUnboundedCompatible ;
+
+
+(*
+   IsValidUnboundedParameter -
+*)
+
+PROCEDURE IsValidUnboundedParameter (formal, actual: CARDINAL) : BOOLEAN ;
+VAR
+   ft, at : CARDINAL ;
+   n, m, o: CARDINAL ;
+BEGIN
+   Assert(IsParameterUnbounded(formal)) ;
+   ft := SkipType(GetType(GetType(formal))) ;    (* ARRAY OF ft *)
+   IF IsGenericSystemType(ft) OR IsArrayUnboundedCompatible(GetType(formal), GetType(actual))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      IF IsParameter(actual) AND IsParameterUnbounded(actual)
+      THEN
+         n := GetDimension(actual) ;
+         m := GetDimension(formal) ;
+         IF n#m
+         THEN
+            RETURN( IsGenericSystemType(ft) AND (n<m) )
+         ELSE
+            RETURN( (GetDimension(actual)=GetDimension(formal)) AND
+                    IsParameterCompatible(GetType(GetType(actual)), ft) )
+         END
+      ELSE
+         IF IsConstString(actual)
+         THEN
+            RETURN( IsParameterCompatible(Char, ft) )
+         ELSE
+            at := SkipType(GetType(actual)) ;
+            IF IsArray(at)
+            THEN
+               m := GetDimension(formal) ;
+               n := GetDimension(at) ;
+               o := 0 ;
+               WHILE IsArray(at) DO
+                  INC(o) ;
+                  at := SkipType(GetType(at)) ;
+                  IF (m=o) AND (at=ft)
+                  THEN
+                     RETURN( TRUE )
+                  END
+               END ;
+               IF n#m
+               THEN
+                  RETURN( IsGenericSystemType(ft) AND (n<m) )
+               ELSIF IsParameterVar(formal)
+               THEN
+                  RETURN( IsVarParamCompatible(at, formal) )
+               ELSE
+                  RETURN( IsParameterCompatible(at, ft) )
+               END
+            ELSE
+               IF IsParameterVar(formal)
+               THEN
+                  RETURN( IsVarParamCompatible(at, formal) )
+               ELSE
+                  RETURN( IsParameterCompatible(at, ft) )
+               END
+            END
+         END
+      END
+   END
+END IsValidUnboundedParameter ;
+
+
+(*
+   IsValidParameter - returns TRUE if an, actual, parameter can be passed
+                      to the, formal, parameter.  This differs from
+                      IsParameterCompatible as this procedure includes checks
+                      for unbounded formal parameters, var parameters and
+                      constant actual parameters.
+*)
+
+PROCEDURE IsValidParameter (formal, actual: CARDINAL (* ; tokenNo: CARDINAL *) ) : BOOLEAN ;
+VAR
+   at, ft: CARDINAL ;
+BEGIN
+   Assert(IsParameter(formal)) ;
+   Assert(IsPassCodeGeneration()) ;
+   IF IsConst(actual) AND IsParameterVar(formal)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      IF IsParameterUnbounded(formal)
+      THEN
+         RETURN( IsValidUnboundedParameter(formal, actual) )
+      ELSE
+         ft := SkipType(GetType(formal))
+      END ;
+      IF IsConst(actual) AND (SkipType(GetType(actual))=Char) AND IsArray(ft) AND (SkipType(GetType(ft))=Char)
+      THEN
+         (* a constant char can be either a char or a string *)
+         RETURN( TRUE )
+      END ;
+      IF IsProcType(ft)
+      THEN
+         IF IsProcedure(actual)
+         THEN
+            (* we check this by calling IsValidProcedure for each and every
+               parameter of actual and formal *)
+            RETURN( TRUE )
+         ELSE
+            at := SkipType(GetType(actual)) ;
+            RETURN( doProcTypeCheck(at, ft, TRUE) )
+         END
+      ELSIF IsParameterVar(formal)
+      THEN
+         RETURN( IsVarParamCompatible(GetType(actual), ft) )
+      ELSE
+         RETURN( IsParameterCompatible(GetType(actual), ft) )
+      END
+   END
+END IsValidParameter ;
+
+
+(*
+   PushSizeOf - pushes the size of a meta type.
+*)
+
+PROCEDURE PushSizeOf (t: MetaType) ;
+BEGIN
+   CASE t OF
+
+   const    :   InternalError ('do not know the size of a constant') |
+   word     :   IF Iso
+                THEN
+                   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetISOWordType()))
+                ELSE
+                   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetWordType()))
+                END |
+   byte     :   IF Iso
+                THEN
+                   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetISOByteType()))
+                ELSE
+                   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetByteType()))
+                END |
+   address  :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetPointerType())) |
+   chr      :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2CharType())) |
+   normint  :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2IntegerType())) |
+   shortint :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ShortIntType())) |
+   longint  :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2LongIntType())) |
+   normcard :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2CardinalType())) |
+   shortcard:   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ShortCardType())) |
+   longcard :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2LongCardType())) |
+   pointer  :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetPointerType())) |
+   enum     :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetIntegerType())) |
+   real     :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2RealType())) |
+   shortreal:   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ShortRealType())) |
+   longreal :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2LongRealType())) |
+   set      :   InternalError ('do not know the size of a set') |
+   opaque   :   InternalError ('do not know the size of an opaque') |
+   loc      :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetISOLocType())) |
+   rtype    :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2RType())) |
+   ztype    :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ZType())) |
+   int8,
+   card8,
+   set8     :   PushIntegerTree(BuildIntegerConstant(1)) |
+   word16,
+   set16,
+   card16,
+   int16    :   PushIntegerTree(BuildIntegerConstant(2)) |
+   real32,
+   word32,
+   set32,
+   card32,
+   int32    :   PushIntegerTree(BuildIntegerConstant(4)) |
+   real64,
+   word64,
+   card64,
+   int64    :   PushIntegerTree(BuildIntegerConstant(8)) |
+   real96   :   PushIntegerTree(BuildIntegerConstant(12)) |
+   real128  :   PushIntegerTree(BuildIntegerConstant(16)) |
+   complex  :   PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ComplexType())) |
+   shortcomplex: PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2ShortComplexType())) |
+   longcomplex:  PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2LongComplexType())) |
+   complex32:  PushIntegerTree(BuildIntegerConstant(4*2)) |
+   complex64:  PushIntegerTree(BuildIntegerConstant(8*2)) |
+   complex96:  PushIntegerTree(BuildIntegerConstant(12*2)) |
+   complex128:  PushIntegerTree(BuildIntegerConstant(16*2)) |
+   ctype     :  PushIntegerTree(GetSizeOf(BuiltinsLocation(), GetM2CType())) |
+
+   unknown  :   InternalError ('should not get here')
+
+   ELSE
+      InternalError ('should not get here')
+   END
+END PushSizeOf ;
+
+
+(*
+   IsSizeSame -
+*)
+
+PROCEDURE IsSizeSame (t1, t2: MetaType) : BOOLEAN ;
+BEGIN
+   PushSizeOf(t1) ;
+   PushSizeOf(t2) ;
+   RETURN( Equ(0) )
+END IsSizeSame ;
+
+
+(*
+   InitArray -
+*)
+
+PROCEDURE InitArray (VAR c: CompatibilityArray;
+                     y: MetaType; a: ARRAY OF CHAR) ;
+VAR
+   x   : MetaType ;
+   h, i: CARDINAL ;
+BEGIN
+   h := StrLen(a) ;
+   i := 0 ;
+   x := MIN(MetaType) ;
+   WHILE i<h DO
+      IF (c[x, y]#uninitialized) AND (x#unknown) AND (y#unknown)
+      THEN
+         InternalError('expecting array element to be uninitialized')
+      END ;
+      CASE a[i] OF
+
+      ' ':  |
+      '.':  CASE c[y, x] OF
+
+            uninitialized:  InternalError('cannot reflect value as it is unknown') |
+            first        :  c[x, y] := second |
+            second       :  c[x, y] := first |
+            warnfirst    :  c[x, y] := warnsecond |
+            warnsecond   :  c[x, y] := warnfirst
+
+            ELSE
+               c[x, y] := c[y, x]
+            END ;
+            INC(x) |
+      'F':  c[x, y] := no ;
+            INC(x) |
+      'T',
+      '1':  c[x, y] := first ;
+            INC(x) |
+      '2':  c[x, y] := second ;
+            INC(x) |
+      'W':  IF Pim
+            THEN
+               IF IsSizeSame(x, y)
+               THEN
+                  c[x, y] := warnsecond
+               ELSE
+                  c[x, y] := no
+               END
+            ELSE
+               c[x, y] := no
+            END ;
+            INC(x) |
+      'w':  IF Pim
+            THEN
+               IF IsSizeSame(x, y)
+               THEN
+                  c[x, y] := warnfirst
+               ELSE
+                  c[x, y] := no
+               END
+            ELSE
+               c[x, y] := no
+            END ;
+            INC(x) |
+      'P':  IF Pim
+            THEN
+               c[x, y] := second
+            ELSE
+               c[x, y] := no
+            END ;
+            INC(x) |
+      'p':  IF Pim
+            THEN
+               c[x, y] := first
+            ELSE
+               c[x, y] := no
+            END ;
+            INC(x) |
+      's':  IF IsSizeSame(x, y)
+            THEN
+               c[x, y] := first
+            ELSE
+               c[x, y] := no
+            END ;
+            INC(x) |
+      'S':  IF IsSizeSame(x, y)
+            THEN
+               c[x, y] := second
+            ELSE
+               c[x, y] := no
+            END ;
+            INC(x) |
+
+
+      ELSE
+         InternalError ('unexpected specifier')
+      END ;
+      INC(i)
+   END
+END InitArray ;
+
+
+(*
+   A - initialize the assignment array
+*)
+
+PROCEDURE A (y: MetaType; a: ARRAY OF CHAR) ;
+BEGIN
+   InitArray (Ass, y, a)
+END A ;
+
+
+(*
+   E - initialize the expression array
+*)
+
+PROCEDURE E (y: MetaType; a: ARRAY OF CHAR) ;
+BEGIN
+   InitArray (Expr, y, a)
+END E ;
+
+
+(*
+   C - initialize the comparision array
+*)
+
+PROCEDURE C (y: MetaType; a: ARRAY OF CHAR) ;
+BEGIN
+   InitArray (Comp, y, a)
+END C ;
+
+
+(*
+   InitCompatibilityMatrices - initializes the tables above.
+*)
+
+PROCEDURE InitCompatibilityMatrices ;
+VAR
+   i, j: MetaType ;
+BEGIN
+   (* initialize to a known state *)
+   FOR i := MIN(MetaType) TO MAX(MetaType) DO
+      FOR j := MIN(MetaType) TO MAX(MetaType) DO
+         Ass[i, j]  := uninitialized ;
+         Expr[i, j]  := uninitialized
+      END
+   END ;
+
+   (* all unknowns are false *)
+   FOR i := MIN(MetaType) TO MAX(MetaType) DO
+      Ass[i, unknown]  := no ;
+      Expr[unknown, i] := no
+   END ;
+
+   (*
+                                                     1 p w
+
+                    N W B A C I S L C S L P E R S L S O L R Z I I I I C C C C W W W R R R R S S S C S L C C C C C R A
+                    u o y d h n h o a h o t n e h o e p o t t n n n n a a a a o o o e e e e e e e o h o o o o o t e r
+                    l r t d a t o n r o n r u a o n t a c y y t t t t r r r r r r r a a a a t t t m o n m m m m y c r
+                    S d e r r e r g d r g   m l r g   q   p p 8 1 3 6 d d d d d d d l l l l 8 1 3 p r g p p p p p   a
+                    y     e   g t i i t c       t r   u   e e   6 2 4 8 1 3 6 1 3 6 3 6 9 1   6 2 l t C l l l l e   y
+                    m     s   e i n n c a       r e   e                 6 2 4 6 2 4 2 4 6 2       e C o e e e e
+                          s   r n t a a r       e a                                       8       x o m x x x x
+                                t   l r d       a l                                                 m p 3 6 9 1
+                                      d         l                                                   p l 2 4 6 2
+                                                                                                    l e       8
+                                                                                                    e x
+                                                                                                    x
+         ------------------------------------------------------------------------------------------------------------
+   2
+   P
+   W
+   *)
+   A(const       , 'T T T T T T T T T T T T T T T T T T T F T T T T T T T T T T T T F F F F F F F F F F F F F F F F F') ;
+   A(word        , '. T S S S 2 S S 2 S S S 2 S S S T T S S T S S S S S S S S S S S S S S S S S S S S S S S S S T T T') ;
+   A(byte        , '. . T S 2 S S S S S S S S S S S T T S S T S S S S S S S S S S S S S S S S S S S S S S S S S T T T') ;
+   A(address     , '. . . T F F F F F F F 2 F F F F F 2 2 F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   A(chr         , '. . . . T F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   A(normint     , '. . . . . T T T T T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(shortint    , '. . . . . . T T T T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(longint     , '. . . . . . . T T T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(normcard    , '. . . . . . . . T T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(shortcard   , '. . . . . . . . . T T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(longcard    , '. . . . . . . . . . T F F F F F F F F F T T T T T T T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(pointer     , '. . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   A(enum        , '. . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F T T F F F F F F F F F F F F F F F') ;
+   A(real        , '. . . . . . . . . . . . . T T T F F F 2 F F F F F F F F F F F F T T T T F F F F F F F F F F F F F') ;
+   A(shortreal   , '. . . . . . . . . . . . . . T T F F F 2 F F F F F F F F F F F F T T T T F F F F F F F F F F F F F') ;
+   A(longreal    , '. . . . . . . . . . . . . . . T F F F 2 F F F F F F F F F F F F T T T T F F F F F F F F F F F F F') ;
+   A(set         , '. . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   A(opaque      , '. . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   A(loc         , '. . . . . . . . . . . . . . . . . . T F F T F F F T F F F F F F F F F F S F F F F F F F F F F T T') ;
+   A(rtype       , '. . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F 1 1 1 1 F F F F F F F F F F F F F') ;
+   A(ztype       , '. . . . . . . . . . . . . . . . . . . . T T T T T T T T T T T T F F F F F F F F F F F F F F F F F') ;
+   A(int8        , '. . . . . . . . . . . . . . . . . . . . . T T T T T T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(int16       , '. . . . . . . . . . . . . . . . . . . . . . T T T T T T T T F F F F F F F F F F F F F F F F F F F') ;
+   A(int32       , '. . . . . . . . . . . . . . . . . . . . . . . T T T T T T F T T F F F F F F F F F F F F F F F F F') ;
+   A(int64       , '. . . . . . . . . . . . . . . . . . . . . . . . T T T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(card8       , '. . . . . . . . . . . . . . . . . . . . . . . . . T T T T T F F F F F F F F F F F F F F F F F F F') ;
+   A(card16      , '. . . . . . . . . . . . . . . . . . . . . . . . . . T T T F F F F F F F F F F F F F F F F F F F F') ;
+   A(card32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . T T F T F F F F F F F F F F F F F F F F F F') ;
+   A(card64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F F F F F F F F F F F F F F F F') ;
+   A(word16      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F') ;
+   A(word32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F F F F F F F F F F F F F F') ;
+   A(word64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F F F F F F F F F F F F F F') ;
+   A(real32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F') ;
+   A(real64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F') ;
+   A(real96      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F') ;
+   A(real128     , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F') ;
+   A(set8        , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F') ;
+   A(set16       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F') ;
+   A(set32       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F') ;
+   A(complex     , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F') ;
+   A(shortcomplex, '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F') ;
+   A(longcomplex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F') ;
+   A(complex32   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F') ;
+   A(complex64   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F') ;
+   A(complex96   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F') ;
+   A(complex128  , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F') ;
+   A(ctype       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F') ;
+   A(rec         , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F') ;
+   A(array       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T') ;
+   (* Expression compatibility *)
+
+
+   (*
+                                                     1 p w
+
+                    N W B A C I S L C S L P E R S L S O L R Z I I I I C C C C W W W R R R R S S S C S L C C C C C R A
+                    u o y d h n h o a h o t n e h o e p o t t n n n n a a a a o o o e e e e e e e o h o o o o o t e r
+                    l r t d a t o n r o n r u a o n t a c y y t t t t r r r r r r r a a a a t t t m o n m m m m y c r
+                    S d e r r e r g d r g   m l r g   q   p p 8 1 3 6 d d d d d d d l l l l 8 1 3 p r g p p p p p   a
+                    y     e   g t i i t c       t r   u   e e   6 2 4 8 1 3 6 1 3 6 3 6 9 1   6 2 l t C l l l l e   y
+                    m     s   e i n n c a       r e   e                 6 2 4 6 2 4 2 4 6 2       e C o e e e e
+                          s   r n t a a r       e a                                       8       x o m x x x x
+                                t   l r d       a l                                                 m p 3 6 9 1
+                                      d         l                                                   p l 2 4 6 2
+                                                                                                    l e       8
+                                                                                                    e x
+                                                                                                    x
+         ------------------------------------------------------------------------------------------------------------
+   2
+   P
+   W
+   *)
+
+   E(const       , 'T T T T T T T T T T T T T T T T T T F F T T T T T T T T T T T T T T T T F F F F F F F F F F F F F') ;
+   E(word        , '. T F F F F F F F F F F F F F F F F F W F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(byte        , '. . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(address     , '. . . T F P F F P F F T F F F F F F F F P F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(chr         , '. . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(normint     , '. . . . . T F F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(shortint    , '. . . . . . T F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(longint     , '. . . . . . . T F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(normcard    , '. . . . . . . . T F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(shortcard   , '. . . . . . . . . T F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(longcard    , '. . . . . . . . . . T F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(pointer     , '. . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(enum        , '. . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(real        , '. . . . . . . . . . . . . T F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(shortreal   , '. . . . . . . . . . . . . . T F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(longreal    , '. . . . . . . . . . . . . . . T F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(set         , '. . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(opaque      , '. . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(loc         , '. . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(rtype       , '. . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F 1 1 1 1 F F F F F F F F F F F F F') ;
+   E(ztype       , '. . . . . . . . . . . . . . . . . . . . T 1 1 1 1 1 1 1 1 1 1 1 F F F F F F F F F F F F F F F F F') ;
+   E(int8        , '. . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(int16       , '. . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(int32       , '. . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(int64       , '. . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(card8       , '. . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(card16      , '. . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F') ;
+   E(card32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F') ;
+   E(card64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F') ;
+   E(word16      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F') ;
+   E(word32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F') ;
+   E(word64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F') ;
+   E(real32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F') ;
+   E(real64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F') ;
+   E(real96      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F') ;
+   E(real128     , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F') ;
+   E(set8        , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F') ;
+   E(set16       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F') ;
+   E(set32       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F') ;
+   E(complex     , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F') ;
+   E(shortcomplex, '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F') ;
+   E(longcomplex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F') ;
+   E(complex32   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F') ;
+   E(complex64   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F') ;
+   E(complex96   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F') ;
+   E(complex128  , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F') ;
+   E(ctype       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F') ;
+   E(rec         , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F') ;
+   E(array       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F') ;
+
+   (* Comparison compatibility *)
+
+
+   (*
+                                                     1 p w
+
+                    N W B A C I S L C S L P E R S L S O L R Z I I I I C C C C W W W R R R R S S S C S L C C C C C R A
+                    u o y d h n h o a h o t n e h o e p o t t n n n n a a a a o o o e e e e e e e o h o o o o o t e r
+                    l r t d a t o n r o n r u a o n t a c y y t t t t r r r r r r r a a a a t t t m o n m m m m y c r
+                    S d e r r e r g d r g   m l r g   q   p p 8 1 3 6 d d d d d d d l l l l 8 1 3 p r g p p p p p   a
+                    y     e   g t i i t c       t r   u   e e   6 2 4 8 1 3 6 1 3 6 3 6 9 1   6 2 l t C l l l l e   y
+                    m     s   e i n n c a       r e   e                 6 2 4 6 2 4 2 4 6 2       e C o e e e e
+                          s   r n t a a r       e a                                       8       x o m x x x x
+                                t   l r d       a l                                                 m p 3 6 9 1
+                                      d         l                                                   p l 2 4 6 2
+                                                                                                    l e       8
+                                                                                                    e x
+                                                                                                    x
+         ------------------------------------------------------------------------------------------------------------
+   2
+   P
+   W
+   *)
+
+   C(const       , 'T T T T T T T T T T T T T T T T T T F F T T T T T T T T T T T T T T T T F F F F F F F F F F F F F') ;
+   C(word        , '. T F F F F F F F F F F F F F F F F F F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(byte        , '. . T F F F F F F F F F F F F F F F F F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(address     , '. . . T F F F F F F F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(chr         , '. . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(normint     , '. . . . . T F F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(shortint    , '. . . . . . T F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(longint     , '. . . . . . . T F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(normcard    , '. . . . . . . . T F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(shortcard   , '. . . . . . . . . T F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(longcard    , '. . . . . . . . . . T F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(pointer     , '. . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(enum        , '. . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(real        , '. . . . . . . . . . . . . T F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(shortreal   , '. . . . . . . . . . . . . . T F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(longreal    , '. . . . . . . . . . . . . . . T F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(set         , '. . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(opaque      , '. . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(loc         , '. . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(rtype       , '. . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F 1 1 1 1 F F F F F F F F F F F F F') ;
+   C(ztype       , '. . . . . . . . . . . . . . . . . . . . T 1 1 1 1 1 1 1 1 1 1 1 F F F F F F F F F F F F F F F F F') ;
+   C(int8        , '. . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(int16       , '. . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(int32       , '. . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(int64       , '. . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(card8       , '. . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(card16      , '. . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F') ;
+   C(card32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F') ;
+   C(card64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F') ;
+   C(word16      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F') ;
+   C(word32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F') ;
+   C(word64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F') ;
+   C(real32      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F') ;
+   C(real64      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F') ;
+   C(real96      , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F') ;
+   C(real128     , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F') ;
+   C(set8        , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F') ;
+   C(set16       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F') ;
+   C(set32       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F') ;
+   C(complex     , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F') ;
+   C(shortcomplex, '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F') ;
+   C(longcomplex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F') ;
+   C(complex32   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F') ;
+   C(complex64   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F') ;
+   C(complex96   , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F') ;
+   C(complex128  , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F') ;
+   C(ctype       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F') ;
+   C(rec         , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F') ;
+   C(array       , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F') ;
+
+END InitCompatibilityMatrices ;
+
+
+END M2Base.
diff --git a/gcc/m2/gm2-compiler/M2BasicBlock.def b/gcc/m2/gm2-compiler/M2BasicBlock.def
new file mode 100644
index 00000000000..e03a4886fa9
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2BasicBlock.def
@@ -0,0 +1,87 @@
+(* M2BasicBlock.def converts a scope block into a list of basic blocks.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2BasicBlock ;
+
+(*
+   Title      : M2BasicBlock
+   Author     : Gaius Mulley
+   Date       : 20/8/2003
+   System     : GNU Modula-2
+   Description: Converts a scope block into a list of basic blocks.
+                The basic blocks are either converted back into quadruples
+                or alternatively translated into GCC trees.
+*)
+
+FROM M2Scope IMPORT ScopeBlock ;
+EXPORT QUALIFIED BasicBlock, BasicBlockProc,
+                 InitBasicBlocks, InitBasicBlocksFromRange,
+		 KillBasicBlocks, FreeBasicBlocks,
+                 ForeachBasicBlockDo ;
+
+
+TYPE
+   BasicBlock ;
+   BasicBlockProc = PROCEDURE (CARDINAL, CARDINAL) ;
+
+
+(*
+   InitBasicBlocks - converts a list of quadruples as defined by
+                     scope blocks into a set of basic blocks.
+                     All quadruples within this list which are not
+                     reachable are removed.
+*)
+
+PROCEDURE InitBasicBlocks (sb: ScopeBlock) : BasicBlock ;
+
+
+(*
+   InitBasicBlocksFromRange - converts a list of quadruples as defined by
+                              start..end.
+                              All quadruples within this list which are not
+                              reachable are removed.
+*)
+
+PROCEDURE InitBasicBlocksFromRange (start, end: CARDINAL) : BasicBlock ;
+
+
+(*
+   KillBasicBlocks - destroys the list of Basic Blocks and assigns bb to NIL.
+*)
+
+PROCEDURE KillBasicBlocks (VAR bb: BasicBlock) ;
+
+
+(*
+   FreeBasicBlocks - destroys the list of Basic Blocks.
+*)
+
+PROCEDURE FreeBasicBlocks (bb: BasicBlock) ;
+
+
+(*
+   ForeachBasicBlockDo - for each basic block call procedure, p.
+*)
+
+PROCEDURE ForeachBasicBlockDo (bb: BasicBlock; p: BasicBlockProc) ;
+
+
+END M2BasicBlock.
diff --git a/gcc/m2/gm2-compiler/M2BasicBlock.mod b/gcc/m2/gm2-compiler/M2BasicBlock.mod
new file mode 100644
index 00000000000..0bc692a8ea6
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2BasicBlock.mod
@@ -0,0 +1,355 @@
+(* M2BasicBlock.mod converts a scope block into a list of basic blocks.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2BasicBlock ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM M2Debug IMPORT Assert ;
+FROM M2Options IMPORT OptimizeBasicBlock ;
+
+FROM M2Quads IMPORT IsReferenced, IsConditional, IsUnConditional, IsCall,
+                    IsReturn, IsNewLocalVar, IsKillLocalVar,
+                    IsCatchBegin, IsCatchEnd,
+                    IsInitStart, IsInitEnd, IsFinallyStart, IsFinallyEnd,
+                    IsInitialisingConst,
+                    IsPseudoQuad, IsDefOrModFile,
+                    GetNextQuad, GetQuad, QuadOperator,
+                    SubQuad ;
+
+FROM M2Scope IMPORT ScopeBlock, ForeachScopeBlockDo ;
+FROM M2GenGCC IMPORT ConvertQuadsToTree ;
+
+
+TYPE
+   BasicBlock = POINTER TO RECORD
+                   StartQuad  : CARDINAL ;  (* First Quad in Basic Block *)
+                   EndQuad    : CARDINAL ;  (* End Quad in Basic Block   *)
+                   Right      : BasicBlock ;
+                                            (* Last Basic Block in list  *)
+                   Left       : BasicBlock ;
+                END ;
+
+VAR
+   FreeList        : BasicBlock ;   (* Free list of Basic Blocks         *)
+   HeadOfBasicBlock: BasicBlock ;
+
+
+(*
+   InitBasicBlocks - converts a list of quadruples as defined by
+                     scope blocks into a set of basic blocks.
+                     All quadruples within this list which are not
+                     reachable are removed.
+*)
+
+PROCEDURE InitBasicBlocks (sb: ScopeBlock) : BasicBlock ;
+BEGIN
+   HeadOfBasicBlock := NIL ;
+   ForeachScopeBlockDo (sb, ConvertQuads2BasicBlock) ;
+   RETURN HeadOfBasicBlock
+END InitBasicBlocks ;
+
+
+(*
+   InitBasicBlocksFromRange - converts a list of quadruples as defined by
+                              start..end.
+                              All quadruples within this list which are not
+                              reachable are removed.
+*)
+
+PROCEDURE InitBasicBlocksFromRange (start, end: CARDINAL) : BasicBlock ;
+BEGIN
+   HeadOfBasicBlock := NIL ;
+   ConvertQuads2BasicBlock(start, end) ;
+   RETURN( HeadOfBasicBlock )
+END InitBasicBlocksFromRange ;
+
+
+(*
+   KillBasicBlocks - destroys the list of Basic Blocks.
+*)
+
+PROCEDURE KillBasicBlocks (VAR bb: BasicBlock) ;
+BEGIN
+   FreeBasicBlocks (bb) ;
+   bb := NIL
+END KillBasicBlocks ;
+
+
+(*
+   FreeBasicBlocks - destroys the list of Basic Blocks.
+*)
+
+PROCEDURE FreeBasicBlocks (bb: BasicBlock) ;
+VAR
+   b, c: BasicBlock ;
+BEGIN
+   IF bb#NIL
+   THEN
+      b := bb ;
+      REPEAT
+         c := bb^.Right ;
+         bb^.Right := FreeList ;
+         FreeList := bb ;
+         bb := c
+      UNTIL bb=b
+   END
+END FreeBasicBlocks ;
+
+
+(*
+   New - returns a basic block.
+*)
+
+PROCEDURE New () : BasicBlock ;
+VAR
+   b: BasicBlock ;
+BEGIN
+   IF FreeList=NIL
+   THEN
+      NEW(b)
+   ELSE
+      b := FreeList ;
+      FreeList := FreeList^.Right
+   END ;
+   Assert(b#NIL) ;
+   RETURN( b )
+END New ;
+
+
+(*
+   ConvertQuads2BasicBlock - converts a list of quadruples to a list of
+                             Basic Blocks.
+                             A Basic Block is defined as a list of quadruples
+                             which has only has one entry and exit point.
+*)
+
+PROCEDURE ConvertQuads2BasicBlock (Start, End: CARDINAL) ;
+VAR
+   LastQuadDefMod,
+   LastQuadConditional,
+   LastQuadCall,
+   LastQuadReturn     : BOOLEAN ;
+   Quad               : CARDINAL ;
+   CurrentBB          : BasicBlock ;
+   LastBB             : BasicBlock ;
+BEGIN
+   (*
+      Algorithm to perform Basic Block:
+
+      For every quadruple establish a set of leaders.
+      A Leader is defined as a quadruple which is
+      either:
+
+      (i)   The first quadruple.
+      (ii)  Any quadruple which is the target of a jump or unconditional jump.
+      (iii) Any statement which follows a conditional jump
+
+      For each leader construct a basic block.
+      A Basic Block starts with a leader quadruple and ends with either:
+
+      (i)  Another Leader
+      (ii) An unconditional Jump.
+
+      Any quadruples that do not fall into a Basic Block can be thrown away
+      since they will never be executed.
+   *)
+   LastBB := NIL ;
+   CurrentBB := NIL ;
+   Quad := Start ;
+   LastQuadConditional := TRUE ;  (* Force Rule (i) *)
+   LastQuadCall := FALSE ;
+   LastQuadReturn := FALSE ;
+   LastQuadDefMod := FALSE ;
+   (* Scan all quadruples *)
+   WHILE (Quad<=End) AND (Quad#0) DO
+      IF LastQuadConditional OR LastQuadCall OR LastQuadReturn OR
+         LastQuadDefMod OR IsReferenced(Quad)
+      THEN
+         (* Rule (ii) *)
+         CurrentBB := New() ;                      (* Get a new Basic Block *)
+                                  (* At least one quad in this Basic Block  *)
+         StartBB(CurrentBB, Quad) ;
+         EndBB(CurrentBB, Quad)
+      ELSIF CurrentBB#NIL
+      THEN
+         (* We have a Basic Block - therefore add quad to this Block  *)
+         EndBB(CurrentBB, Quad)
+      ELSIF IsPseudoQuad(Quad)
+      THEN
+         (* Add Quad to the Last BB since Pseudo Quads - compiler directives *)
+         (* must not be thrown away.                                         *)
+         EndBB(LastBB, Quad)
+      ELSIF IsReturn(Quad) OR IsKillLocalVar(Quad) OR
+            IsCatchEnd(Quad) OR IsCatchBegin(Quad) OR
+            IsInitStart(Quad) OR IsInitEnd(Quad) OR
+            IsFinallyStart(Quad) OR IsFinallyEnd(Quad)
+      THEN
+         (* we must leave these quads alone *)
+         EndBB(LastBB, Quad)
+      ELSIF IsInitialisingConst(Quad)
+      THEN
+         (* we must leave these quads alone *)
+         EndBB(LastBB, Quad)
+      ELSE
+         (* remove this Quad since it will never be reached *)
+         SubQuad(Quad)
+      END ;
+      LastQuadConditional := IsConditional(Quad) ;
+      LastQuadCall := IsCall(Quad) ;
+      LastQuadReturn := IsReturn(Quad) ;
+      LastQuadDefMod := IsDefOrModFile(Quad) ;
+      IF IsUnConditional(Quad)
+      THEN
+         LastBB := CurrentBB ;
+         CurrentBB := NIL
+      END ;
+      Quad := GetNextQuad(Quad)
+   END
+END ConvertQuads2BasicBlock ;
+
+
+(*
+   ForeachBasicBlockDo - for each basic block call procedure, p.
+*)
+
+PROCEDURE ForeachBasicBlockDo (bb: BasicBlock; p: BasicBlockProc) ;
+VAR
+   b: BasicBlock ;
+BEGIN
+   IF bb#NIL
+   THEN
+      b := bb ;
+      REPEAT
+         WITH b^ DO
+            p(StartQuad, EndQuad)
+         END ;
+         b := b^.Right
+      UNTIL b=bb
+   END
+END ForeachBasicBlockDo ;
+
+
+(*
+   StartBB - Initially fills a Basic Block, b, with a start quad Quad.
+             The Basic Block is then added to the end of Basic Block list.
+*)
+
+PROCEDURE StartBB (b: BasicBlock; Quad: CARDINAL) ;
+BEGIN
+   WITH b^ DO
+      StartQuad := Quad ;
+      EndQuad := Quad
+   END ;
+   Add(HeadOfBasicBlock, b)   (* Add b to the end of the Basic Block list *)
+END StartBB ;
+
+
+(*
+   EndBB - Fills a Basic Block, b, with an end quad Quad.
+*)
+
+PROCEDURE EndBB (b: BasicBlock; Quad: CARDINAL) ;
+BEGIN
+   b^.EndQuad := Quad
+END EndBB ;
+
+
+(*
+   Add adds a specified element to the end of a queue.
+*)
+
+PROCEDURE Add (VAR Head: BasicBlock;
+               b : BasicBlock) ;
+BEGIN
+   IF Head=NIL
+   THEN
+      Head := b ;
+      b^.Left := b ;
+      b^.Right := b
+   ELSE
+      b^.Right := Head ;
+      b^.Left := Head^.Left ;
+      Head^.Left^.Right := b ;
+      Head^.Left := b
+   END
+END Add ;
+
+
+(*
+   Sub deletes an element from the specified queue.
+*)
+
+(*
+PROCEDURE Sub (VAR Head: BasicBlock;
+               b: BasicBlock) ;
+BEGIN
+   IF (b^.Right=Head) AND (b=Head)
+   THEN
+      Head := NIL
+   ELSE
+      IF Head=b
+      THEN
+         Head := Head^.Right
+      END ;
+      b^.Left^.Right := b^.Right ;
+      b^.Right^.Left := b^.Left
+   END
+END Sub ;
+*)
+
+
+(*
+   DisplayBasicBlocks - displays the basic block data structure.
+*)
+
+(*
+PROCEDURE DisplayBasicBlocks (bb: BasicBlock) ;
+VAR
+   b: BasicBlock ;
+BEGIN
+   b := bb ;
+   WriteString('quadruples') ; WriteLn ;
+   IF b#NIL
+   THEN
+      REPEAT
+         DisplayBlock(b) ;
+         b := b^.Right
+      UNTIL b=bb
+   END
+END DisplayBasicBlocks ;
+
+
+PROCEDURE DisplayBlock (b: BasicBlock) ;
+BEGIN
+   WITH b^ DO
+      WriteString(' start ') ; WriteCard(StartQuad, 6) ;
+      WriteString(' end   ') ; WriteCard(EndQuad, 6) ;
+   END
+END DisplayBlock ;
+*)
+
+
+BEGIN
+   FreeList := NIL
+END M2BasicBlock.
diff --git a/gcc/m2/gm2-compiler/M2Batch.def b/gcc/m2/gm2-compiler/M2Batch.def
new file mode 100644
index 00000000000..ff4ae85e3d4
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Batch.def
@@ -0,0 +1,194 @@
+(* M2Batch.def implements a queue for modules pending compilation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Batch ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Batch
+   Date       : 29/5/87
+   Description: Implements a queue modules pending compilation.
+                MakeSource enters modules for later compilation.
+                GetSource collects the next module to be compiled.
+*)
+
+FROM DynamicStrings IMPORT String ;
+FROM NameKey IMPORT Name ;
+EXPORT QUALIFIED MakeDefinitionSource,
+                 MakeImplementationSource,
+                 MakeProgramSource,
+                 GetSource, GetModuleNo, IsModuleKnown,
+                 AssociateDefinition, GetDefinitionModuleFile,
+                 AssociateModule, GetModuleFile, Get,
+                 ForeachSourceModuleDo, IsSourceSeen, IsModuleSeen,
+                 LookupModule, LookupOuterModule, DisplayModules ;
+
+TYPE
+   DoProcedure = PROCEDURE (CARDINAL) ;
+
+
+(*
+   MakeDefinitionSource - is given a Name, n, which is used to create a Definition
+                          module.
+                          The Definition Module will be placed onto the
+                          compilation pending queue if it has not yet been
+                          compiled.
+                          If the module has been compiled then no action is
+                          taken. The Module Sym is returned.
+*)
+
+PROCEDURE MakeDefinitionSource (tok: CARDINAL; n: Name) : CARDINAL ;
+
+
+(*
+   MakeImplementationSource - is given a Name, n, which is used to create an
+                              implementation module.
+                              The implementation Module will be placed onto
+                              the compilation pending
+                              queue if it has not yet been compiled.
+                              If the module has been compiled then no
+                              action is taken. The Module Sym is returned.
+*)
+
+PROCEDURE MakeImplementationSource (tok: CARDINAL; n: Name) : CARDINAL ;
+
+
+(*
+   MakeProgramSource - is given a Name, n, which is used to create a program module.
+                       The program module will be placed onto the compilation
+                       pending queue if it has not yet been compiled.
+                       If the module has been compiled then no action is taken.
+                       The Module Sym is returned.
+*)
+
+PROCEDURE MakeProgramSource (tok: CARDINAL; n: Name) : CARDINAL ;
+
+
+(*
+   GetSource - returns with the symbol Sym of the next module to be compiled.
+               If Sym returns with value NulSym then no module should be
+               compiled.
+*)
+
+PROCEDURE GetSource () : CARDINAL ;
+
+
+(*
+   GetModuleNo - returns with symbol number of the module which was
+                 the nth module to be read in Pass 1.
+                 The modules are numbered from 1..n
+*)
+
+PROCEDURE GetModuleNo (nth: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsModuleKnown - returns TRUE if the Name, n, matches a module.
+*)
+
+PROCEDURE IsModuleKnown (n: Name) : BOOLEAN ;
+
+
+(*
+   AssociateDefinition - associate the source file, filename, with the definition module,
+                         Sym.
+*)
+
+PROCEDURE AssociateDefinition (filename: String; Sym: CARDINAL) : String ;
+
+
+(*
+   GetDefinitionModuleFile - returns the filename associated with the definition module, Sym.
+                             It may return a temporary preprocessed file.
+*)
+
+PROCEDURE GetDefinitionModuleFile (Sym: CARDINAL) : String ;
+
+
+(*
+   AssociateModule - associate the source file, filename, with the implementation/program
+                     module, Sym.
+*)
+
+PROCEDURE AssociateModule (filename: String; Sym: CARDINAL) : String ;
+
+
+(*
+   GetModuleFile - returns the filename associated with the implementation/program module, Sym.
+                   It may return a temporary preprocessed file.
+*)
+
+PROCEDURE GetModuleFile (Sym: CARDINAL) : String ;
+
+
+(*
+   ForeachSourceModuleDo - call each procedure, p, for which there is a known
+                           source file.
+*)
+
+PROCEDURE ForeachSourceModuleDo (p: DoProcedure) ;
+
+
+(*
+   IsSourceSeen - returns TRUE if the source for module, sym, has been seen.
+*)
+
+PROCEDURE IsSourceSeen (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsModuleSeen - returns TRUE if the source for module, name, has been seen.
+*)
+
+PROCEDURE IsModuleSeen (n: Name) : BOOLEAN ;
+
+
+(*
+   LookupModule - looks up a module in the current scope, if a module does not exist
+                  then it creates a DefImp module.
+*)
+
+PROCEDURE LookupModule (tok: CARDINAL; n: Name) : CARDINAL ;
+
+
+(*
+   LookupOuterModule - looks up a module in the order of: current scope, then outer scope, finally if a
+                       module does not exist then it creates a DefImp module.
+*)
+
+PROCEDURE LookupOuterModule (tok: CARDINAL; n: Name) : CARDINAL ;
+
+
+(*
+   Get - returns the module symbol matching name, n.
+*)
+
+PROCEDURE Get (n: Name) : CARDINAL ;
+
+
+(*
+   DisplayModules - a debugging routine to textually emit the names of modules in the DoneQ.
+*)
+
+PROCEDURE DisplayModules ;
+
+
+END M2Batch.
diff --git a/gcc/m2/gm2-compiler/M2Batch.mod b/gcc/m2/gm2-compiler/M2Batch.mod
new file mode 100644
index 00000000000..360ac57ef20
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Batch.mod
@@ -0,0 +1,470 @@
+(* M2Batch.mod implements a queue for modules pending compilation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Batch ;
+
+
+FROM M2Debug IMPORT Assert ;
+FROM SymbolTable IMPORT MakeModule, MakeDefImp, IsModule, IsDefImp, GetScope, GetLocalSym, GetCurrentScope, GetSym, NulSym ;
+FROM NameKey IMPORT GetKey, WriteKey ;
+FROM M2Printf IMPORT printf2 ;
+FROM M2Error IMPORT InternalError ;
+FROM M2MetaError IMPORT MetaError1 ;
+FROM Indexing IMPORT Index, InitIndex, GetIndice, HighIndice, RemoveIndiceFromIndex, IncludeIndiceIntoIndex, InBounds ;
+FROM Lists IMPORT List, InitList, IncludeItemIntoList, RemoveItemFromList,
+                  GetItemFromList, NoOfItemsInList ;
+FROM Storage IMPORT ALLOCATE ;
+FROM DynamicStrings IMPORT String ;
+FROM M2Pass IMPORT IsPass1, IsPass2, IsPass3, IsPassC ;
+
+
+TYPE
+   Module = POINTER TO RECORD
+                          SymNo  : CARDINAL ;
+                          Key    : Name ;
+                          DefFile,
+                          ModFile: String ;
+                       END ;
+
+VAR
+   SeenList    : Index ;
+   PendingQueue: List ;
+
+
+(*
+   MakeProgramSource - is given a Name, n, which is used to create a program module.
+                       The program module will be placed onto the compilation
+                       pending queue if it has not yet been compiled.
+                       If the module has been compiled then no action is taken.
+                       The Module Sym is returned.
+*)
+
+PROCEDURE MakeProgramSource (tok: CARDINAL; n: Name) : CARDINAL ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   Sym := Get (n) ;
+   IF Sym = NulSym
+   THEN
+      Assert ((NOT IsPass1 ()) AND (NOT IsPass2 ()) AND (NOT IsPass3 ()) AND (NOT IsPassC ())) ;
+      (* Neither been compiled or on the Pending Queue *)
+      Sym := MakeModule (tok, n) ;
+      Put (Sym, n) ;
+      Push (Sym)
+   END ;
+   RETURN Sym
+END MakeProgramSource ;
+
+
+(*
+   MakeDefinitionSource - is given a Name, n, which is used to create a Definition
+                          module.
+                          The Definition Module will be placed onto the
+                          compilation pending queue if it has not yet been
+                          compiled.
+                          If the module has been compiled then no action is
+                          taken. The Module Sym is returned.
+*)
+
+PROCEDURE MakeDefinitionSource (tok: CARDINAL; n: Name) : CARDINAL ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   Sym := Get (n) ;
+   IF Sym = NulSym
+   THEN
+      Assert ((NOT IsPass1 ()) AND (NOT IsPass2 ()) AND (NOT IsPass3 ()) AND (NOT IsPassC ())) ;
+      (* Neither been compiled or on the Pending Queue *)
+      Sym := MakeDefImp (tok, n) ;
+      Put (Sym, n) ;
+      Push (Sym)
+   END ;
+   RETURN Sym
+END MakeDefinitionSource ;
+
+
+(*
+   MakeImplementationSource - is given a Name, n, which is used to create an
+                              implementation module.
+                              The implementation Module will be placed onto
+                              the compilation pending
+                              queue if it has not yet been compiled.
+                              If the module has been compiled then no
+                              action is taken. The Module Sym is returned.
+*)
+
+PROCEDURE MakeImplementationSource (tok: CARDINAL; n: Name) : CARDINAL ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   Sym := Get (n) ;
+   IF Sym = NulSym
+   THEN
+      Assert ((NOT IsPass1 ()) AND (NOT IsPass2 ()) AND (NOT IsPass3 ()) AND (NOT IsPassC ())) ;
+      (* Neither been compiled or on the Pending Queue *)
+      Sym := MakeDefImp (tok, n) ;
+      Put (Sym, n) ;
+      Push (Sym)
+   END ;
+   RETURN Sym
+END MakeImplementationSource ;
+
+
+(*
+   GetSource - returns with the symbol Sym of the next module to be compiled.
+               If Sym returns with value 0 then no module should be compiled.
+*)
+
+PROCEDURE GetSource () : CARDINAL ;
+BEGIN
+   RETURN Pop ()
+END GetSource ;
+
+
+(*
+   GetModuleNo - returns with symbol number of the nth module read during Pass 1.
+*)
+
+PROCEDURE GetModuleNo (nth: CARDINAL) : CARDINAL ;
+VAR
+   m: Module ;
+BEGIN
+   Assert (nth#0) ;
+   IF InBounds (SeenList, nth)
+   THEN
+      m := GetIndice (SeenList, nth) ;
+      RETURN m^.SymNo
+   ELSE
+      RETURN NulSym
+   END
+END GetModuleNo ;
+
+
+(*
+   IsModuleKnown - returns TRUE if the Name n matches a module.
+*)
+
+PROCEDURE IsModuleKnown (n: Name) : BOOLEAN ;
+BEGIN
+   RETURN Get (n) # NulSym
+END IsModuleKnown ;
+
+
+(*
+   Get - returns the module symbol matching name n.
+*)
+
+PROCEDURE Get (n: Name) : CARDINAL ;
+VAR
+   i, no: CARDINAL ;
+   m    : Module ;
+BEGIN
+   i := 1 ;
+   no := HighIndice (SeenList) ;
+   WHILE i <= no DO
+      m := GetIndice (SeenList, i) ;
+      WITH m^ DO
+         IF Key = n
+         THEN
+            RETURN SymNo
+         ELSE
+            INC (i)
+         END
+      END
+   END ;
+   RETURN NulSym
+END Get ;
+
+
+PROCEDURE Put (Sym: CARDINAL; n: Name) ;
+VAR
+   m: Module ;
+BEGIN
+   NEW (m) ;
+   IncludeIndiceIntoIndex (SeenList, m) ;
+   WITH m^ DO
+      SymNo   := Sym ;
+      Key     := n ;
+      DefFile := NIL ;
+      ModFile := NIL
+   END
+END Put ;
+
+
+PROCEDURE Push (Sym: CARDINAL) ;
+BEGIN
+   IncludeItemIntoList (PendingQueue, Sym)
+END Push ;
+
+
+PROCEDURE Pop () : CARDINAL ;
+VAR
+   n  : CARDINAL ;
+   Sym: CARDINAL ;
+BEGIN
+   n := NoOfItemsInList (PendingQueue) ;
+   IF n = 0
+   THEN
+      RETURN NulSym
+   ELSE
+      Sym := GetItemFromList (PendingQueue, n) ;
+      RemoveItemFromList (PendingQueue, Sym) ;
+      RETURN Sym
+   END
+END Pop ;
+
+
+(*
+   DisplayModules - a debugging routine to textually emit the names of modules in the SeenList.
+*)
+
+PROCEDURE DisplayModules ;
+VAR
+   m   : Module ;
+   n, i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (SeenList) ;
+   WHILE i<=n DO
+      m := GetIndice (SeenList, i) ;
+      WITH m^ DO
+         printf2 ('Module %a %d\n', Key, i)
+      END ;
+      INC (i)
+   END
+END DisplayModules ;
+
+
+(*
+   AssociateDefinition - associate the source file, filename, with the definition module,
+                         Sym.
+*)
+
+PROCEDURE AssociateDefinition (filename: String; Sym: CARDINAL) : String ;
+VAR
+   no, i: CARDINAL ;
+   m    : Module ;
+BEGIN
+   i := 1 ;
+   no := HighIndice (SeenList) ;
+   WHILE i <= no DO
+      m := GetIndice (SeenList, i) ;
+      WITH m^ DO
+         IF SymNo = Sym
+         THEN
+            DefFile := filename ;
+            RETURN filename
+         ELSE
+            INC (i)
+         END
+      END
+   END ;
+   InternalError ('failed to find module sym')
+END AssociateDefinition ;
+
+
+(*
+   GetDefinitionModuleFile - returns the filename associated with the definition module, Sym.
+                             It may return a temporary preprocessed file.
+*)
+
+PROCEDURE GetDefinitionModuleFile (Sym: CARDINAL) : String ;
+VAR
+   no, i: CARDINAL ;
+   m    : Module ;
+BEGIN
+   i := 1 ;
+   no := HighIndice (SeenList) ;
+   WHILE i <= no DO
+      m := GetIndice (SeenList, i) ;
+      WITH m^ DO
+         IF SymNo = Sym
+         THEN
+            RETURN DefFile
+         ELSE
+            INC (i)
+         END
+      END
+   END ;
+   RETURN NIL
+END GetDefinitionModuleFile ;
+
+
+(*
+   AssociateModule - associate the source file, filename, with the implementation/program
+                     module, Sym.
+*)
+
+PROCEDURE AssociateModule (filename: String; Sym: CARDINAL) : String ;
+VAR
+   no, i: CARDINAL ;
+   m    : Module ;
+BEGIN
+   i := 1 ;
+   no := HighIndice (SeenList) ;
+   WHILE i<=no DO
+      m := GetIndice (SeenList, i) ;
+      WITH m^ DO
+         IF SymNo = Sym
+         THEN
+            ModFile := filename ;
+            RETURN filename
+         ELSE
+            INC (i)
+         END
+      END
+   END ;
+   InternalError ('failed to find module sym')
+END AssociateModule ;
+
+
+(*
+   GetModuleFile - returns the filename associated with the implementation/program module, Sym.
+                   It may return a temporary preprocessed file.
+*)
+
+PROCEDURE GetModuleFile (Sym: CARDINAL) : String ;
+VAR
+   no, i: CARDINAL ;
+   m    : Module ;
+BEGIN
+   i := 1 ;
+   no := HighIndice (SeenList) ;
+   WHILE i <= no DO
+      m := GetIndice (SeenList, i) ;
+      WITH m^ DO
+         IF SymNo = Sym
+         THEN
+            RETURN ModFile
+         ELSE
+            INC (i)
+         END
+      END
+   END ;
+   RETURN NIL
+END GetModuleFile ;
+
+
+(*
+   ForeachSourceModuleDo - for each source file call procedure, p.
+*)
+
+PROCEDURE ForeachSourceModuleDo (p: DoProcedure) ;
+VAR
+   i, no: CARDINAL ;
+   m    : Module ;
+BEGIN
+   i := 1 ;
+   no := HighIndice (SeenList) ;
+   WHILE i<=no DO
+      m := GetIndice (SeenList, i) ;
+      WITH m^ DO
+         IF ModFile # NIL
+         THEN
+            p (SymNo)
+         END
+      END ;
+      INC (i)
+   END
+END ForeachSourceModuleDo ;
+
+
+(*
+   IsSourceSeen - returns TRUE if the source for the program module or
+                  implementation module has been seen.
+*)
+
+PROCEDURE IsSourceSeen (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   Assert (IsModule (sym) OR IsDefImp (sym)) ;
+   RETURN GetModuleFile (sym) # NIL
+END IsSourceSeen ;
+
+
+(*
+   IsModuleSeen - returns TRUE if the source for module, name, has been seen.
+*)
+
+PROCEDURE IsModuleSeen (n: Name) : BOOLEAN ;
+BEGIN
+   RETURN Get (n) # NulSym
+END IsModuleSeen ;
+
+
+(*
+   LookupModule - looks up a module in the current scope, if a module does not exist
+                  then it creates a DefImp module.
+*)
+
+PROCEDURE LookupModule (tok: CARDINAL; n: Name) : CARDINAL ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   sym := GetSym (n) ;
+   IF sym = NulSym
+   THEN
+      RETURN MakeDefinitionSource (tok, n)
+   ELSIF IsModule (sym) OR IsDefImp (sym)
+   THEN
+      RETURN sym
+   ELSE
+      RETURN MakeDefinitionSource (tok, n)
+   END
+END LookupModule ;
+
+
+(*
+   LookupOuterModule - looks up a module in the order of: current scope, then outer scope, finally if a
+                       module does not exist then it creates a DefImp module.
+*)
+
+PROCEDURE LookupOuterModule (tok: CARDINAL; n: Name) : CARDINAL ;
+VAR
+   outer: CARDINAL ;
+   sym  : CARDINAL ;
+BEGIN
+   sym := GetSym (n) ;
+   IF sym = NulSym
+   THEN
+      outer := GetScope (GetCurrentScope ()) ;
+      IF outer # NulSym
+      THEN
+         sym := GetLocalSym (outer, n)
+      END ;
+      IF sym = NulSym
+      THEN
+         (* not a local module, so it must be refering to a definition module.  *)
+         sym := MakeDefinitionSource (tok, n)
+      END
+   END ;
+   IF IsModule (sym) OR IsDefImp (sym)
+   THEN
+      RETURN sym
+   ELSE
+      RETURN MakeDefinitionSource (tok, n)
+   END
+END LookupOuterModule ;
+
+
+BEGIN
+   InitList (PendingQueue) ;
+   SeenList := InitIndex (1)
+END M2Batch.
diff --git a/gcc/m2/gm2-compiler/M2Bitset.def b/gcc/m2/gm2-compiler/M2Bitset.def
new file mode 100644
index 00000000000..faf14ac0f6d
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Bitset.def
@@ -0,0 +1,54 @@
+(* M2Bitset.def provides the BITSET type.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+DEFINITION MODULE M2Bitset ;
+
+(*
+    Title      : M2Bitset
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Wed May  7 21:21:31 2003
+    Revision   : $Version$
+    Description: provides the BITSET type.
+*)
+
+EXPORT QUALIFIED MakeBitset, GetBitsetMinMax, Bitset, Bitnum ;
+
+
+VAR
+   Bitset, Bitnum: CARDINAL ;
+
+
+(*
+   MakeBitset - creates and declares the type BITSET.
+*)
+
+PROCEDURE MakeBitset ;
+
+
+(*
+   GetBitsetMinMax - assigns min and max to the minimum and maximum values of BITSET.
+*)
+
+PROCEDURE GetBitsetMinMax (VAR min, max: CARDINAL) ;
+
+
+END M2Bitset.
diff --git a/gcc/m2/gm2-compiler/M2Bitset.mod b/gcc/m2/gm2-compiler/M2Bitset.mod
new file mode 100644
index 00000000000..71c44a3bd8e
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Bitset.mod
@@ -0,0 +1,89 @@
+(* M2Bitset.mod provides the BITSET type.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Bitset ;
+
+
+FROM M2Debug IMPORT Assert ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT BuiltinsLocation ;
+FROM m2type IMPORT GetWordType ;
+FROM m2decl IMPORT GetBitsPerBitset ;
+FROM m2expr IMPORT GetSizeOf ;
+FROM M2ALU IMPORT PushCard, PushIntegerTree ;
+FROM NameKey IMPORT MakeKey ;
+FROM M2System IMPORT Word ;
+FROM M2Base IMPORT Cardinal ;
+FROM M2LexBuf IMPORT BuiltinTokenNo ;
+
+FROM SymbolTable IMPORT NulSym,
+      	       	     	MakeConstLit,
+                        MakeConstVar,
+      	       	     	MakeSet,
+      	       	     	MakeSubrange,
+      	       	     	PutSet,
+      	       	     	PutSubrange,
+                        PopValue,
+                        PopSize ;
+
+
+VAR
+   MinBitset, MaxBitset : CARDINAL ;
+
+
+(*
+   MakeBitset - creates and declares the type BITSET.
+*)
+
+PROCEDURE MakeBitset ;
+BEGIN
+   Bitset := MakeSet (BuiltinTokenNo, MakeKey('BITSET')) ;     (* Base Type       *)
+
+   (* MinBitset *)
+   MinBitset := MakeConstLit (BuiltinTokenNo, MakeKey('0'), Cardinal) ;
+
+   (* MaxBitset *)
+   MaxBitset := MakeConstVar (BuiltinTokenNo, MakeKey('MaxBitset')) ;
+   PushCard (GetBitsPerBitset()-1) ;
+   PopValue (MaxBitset) ;
+
+   Assert (Word#NulSym) ;
+   Bitnum := MakeSubrange (BuiltinTokenNo, MakeKey('BITNUM')) ;
+   PutSubrange (Bitnum, MinBitset, MaxBitset, Cardinal) ;
+   PutSet (Bitset, Bitnum, FALSE) ;
+
+   PushIntegerTree (GetSizeOf(BuiltinsLocation(), GetWordType())) ;
+   PopSize (Bitset)
+END MakeBitset ;
+
+
+(*
+   GetBitsetMinMax - assigns min and max to the minimum and maximum values of BITSET.
+*)
+
+PROCEDURE GetBitsetMinMax (VAR min, max: CARDINAL) ;
+BEGIN
+   min := MinBitset ;
+   max := MaxBitset
+END GetBitsetMinMax ;
+
+
+END M2Bitset.
diff --git a/gcc/m2/gm2-compiler/M2CaseList.def b/gcc/m2/gm2-compiler/M2CaseList.def
new file mode 100644
index 00000000000..3033ca58d53
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2CaseList.def
@@ -0,0 +1,123 @@
+(* M2CaseList.def implement ISO case label lists.
+
+Copyright (C) 2009-2022 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/>.  *)
+
+DEFINITION MODULE M2CaseList ;
+
+(*
+    Title      : M2CaseList
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Jul 24 09:53:48 2009
+    Revision   : $Version$
+    Description:
+*)
+
+FROM DynamicStrings IMPORT String ;
+FROM Lists IMPORT List ;
+
+
+(*
+   PushCase - create a case entity and push it to an internal stack.
+              Return the case id.
+*)
+
+PROCEDURE PushCase (r: CARDINAL; v: CARDINAL) : CARDINAL ;
+
+
+(*
+   PopCase - pop the top element of the case entity from the internal
+             stack.
+*)
+
+PROCEDURE PopCase ;
+
+
+(*
+   ElseCase - indicates that this case varient does have an else clause.
+*)
+
+PROCEDURE ElseCase (f: CARDINAL) ;
+
+
+(*
+   BeginCaseList - create a new label list.
+*)
+
+PROCEDURE BeginCaseList (v: CARDINAL) ;
+
+
+(*
+   EndCaseList - terminate the current label list.
+*)
+
+PROCEDURE EndCaseList ;
+
+
+(*
+   AddRange - add a range to the current label list.
+*)
+
+PROCEDURE AddRange (r1, r2: CARDINAL; tok: CARDINAL) ;
+
+
+(*
+   CaseBoundsResolved - returns TRUE if all constants in the case list, c,
+                        are known to GCC.
+*)
+
+PROCEDURE CaseBoundsResolved (tokenno: CARDINAL; c: CARDINAL) : BOOLEAN ;
+
+
+(*
+   TypeCaseBounds - returns TRUE if all bounds in case list, c, are
+                    compatible with the tagged type.
+*)
+
+PROCEDURE TypeCaseBounds (c: CARDINAL) : BOOLEAN ;
+
+
+(*
+   OverlappingCaseBounds - returns TRUE if there were any overlapping bounds
+                           in the case list, c.  It will generate an error
+                           messages for each overlapping bound found.
+*)
+
+PROCEDURE OverlappingCaseBounds (c: CARDINAL) : BOOLEAN ;
+
+
+(*
+   MissingCaseBounds - returns TRUE if there were any missing bounds
+                       in the varient record case list, c.  It will
+                       generate an error message for each missing
+                       bounds found.
+*)
+
+PROCEDURE MissingCaseBounds (tokenno: CARDINAL; c: CARDINAL) : BOOLEAN ;
+
+
+(*
+   WriteCase - displays the case list.
+*)
+
+PROCEDURE WriteCase (c: CARDINAL) ;
+
+
+END M2CaseList.
diff --git a/gcc/m2/gm2-compiler/M2CaseList.mod b/gcc/m2/gm2-compiler/M2CaseList.mod
new file mode 100644
index 00000000000..060d16c3cd3
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2CaseList.mod
@@ -0,0 +1,933 @@
+(* M2CaseList.mod implement ISO case label lists.
+
+Copyright (C) 2009-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2CaseList ;
+
+
+FROM M2Debug IMPORT Assert ;
+FROM M2GCCDeclare IMPORT TryDeclareConstant, GetTypeMin, GetTypeMax ;
+FROM M2MetaError IMPORT MetaError1, MetaError2, MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3, MetaErrorT4, MetaErrorString1 ;
+FROM M2Error IMPORT InternalError ;
+FROM M2Range IMPORT OverlapsRange, IsEqual, IsGreater ;
+FROM M2ALU IMPORT PushIntegerTree, PopIntegerTree, Addn, Sub, PushInt ;
+FROM Indexing IMPORT Index, InitIndex, PutIndice, GetIndice, ForeachIndiceInIndexDo, HighIndice ;
+FROM Lists IMPORT InitList, IncludeItemIntoList ;
+FROM NameKey IMPORT KeyToCharStar ;
+FROM SymbolConversion IMPORT GccKnowsAbout, Mod2Gcc, AddModGcc ;
+FROM DynamicStrings IMPORT InitString, InitStringCharStar, ConCat, Mark, KillString ;
+FROM m2tree IMPORT Tree ;
+FROM m2block IMPORT RememberType ;
+FROM m2type IMPORT GetMinFrom ;
+FROM Storage IMPORT ALLOCATE ;
+FROM M2Base IMPORT IsExpressionCompatible ;
+FROM M2Printf IMPORT printf1 ;
+
+FROM SymbolTable IMPORT NulSym, IsConst, IsFieldVarient, IsRecord, IsRecordField, GetVarientTag, GetType,
+                        ForeachLocalSymDo, GetSymName, IsEnumeration, SkipType ;
+
+TYPE
+   RangePair = POINTER TO RECORD
+                  low, high: CARDINAL ;
+                  tokenno  : CARDINAL ;
+               END ;
+
+   ConflictingPair = POINTER TO RECORD
+                        a, b: RangePair ;
+                     END ;
+
+   CaseList = POINTER TO RECORD
+                 maxRangeId  : CARDINAL ;
+                 rangeArray  : Index ;
+                 currentRange: RangePair ;
+                 varientField: CARDINAL ;
+              END ;
+
+   CaseDescriptor = POINTER TO RECORD
+                       elseClause   : BOOLEAN ;
+                       elseField    : CARDINAL ;
+                       record       : CARDINAL ;
+                       varient      : CARDINAL ;
+                       maxCaseId    : CARDINAL ;
+                       caseListArray: Index ;
+                       currentCase  : CaseList ;
+                       next         : CaseDescriptor ;
+                    END ;
+
+   SetRange = POINTER TO RECORD
+                 low, high: Tree ;
+                 next     : SetRange ;
+              END ;
+
+VAR
+   caseStack    : CaseDescriptor ;
+   caseId       : CARDINAL ;
+   caseArray    : Index ;
+   conflictArray: Index ;
+   FreeRangeList: SetRange ;
+
+
+
+(*
+   PushCase - create a case entity and push it to an internal stack.
+              r, is NulSym if this is a CASE statement.
+              If, r, is a record then it indicates it includes one
+              or more varients reside in the record.  The particular
+              varient is, v.
+              Return the case id.
+*)
+
+PROCEDURE PushCase (r: CARDINAL; v: CARDINAL) : CARDINAL ;
+VAR
+   c: CaseDescriptor ;
+BEGIN
+   INC(caseId) ;
+   NEW(c) ;
+   IF c=NIL
+   THEN
+      InternalError ('out of memory error')
+   ELSE
+      WITH c^ DO
+         elseClause := FALSE ;
+         elseField := NulSym ;
+         record := r ;
+         varient := v ;
+         maxCaseId := 0 ;
+         caseListArray := InitIndex(1) ;
+         next := caseStack ;
+         currentCase := NIL
+      END ;
+      caseStack := c ;
+      PutIndice(caseArray, caseId, c)
+   END ;
+   RETURN( caseId )
+END PushCase ;
+
+
+(*
+   PopCase - pop the top element of the case entity from the internal
+             stack.
+*)
+
+PROCEDURE PopCase ;
+BEGIN
+   IF caseStack=NIL
+   THEN
+      InternalError ('case stack is empty')
+   END ;
+   caseStack := caseStack^.next
+END PopCase ;
+
+
+(*
+   ElseCase - indicates that this case varient does have an else clause.
+*)
+
+PROCEDURE ElseCase (f: CARDINAL) ;
+BEGIN
+   WITH caseStack^ DO
+      elseClause := TRUE ;
+      elseField := f
+   END
+END ElseCase ;
+
+
+(*
+   BeginCaseList - create a new label list.
+*)
+
+PROCEDURE BeginCaseList (v: CARDINAL) ;
+VAR
+   l: CaseList ;
+BEGIN
+   NEW(l) ;
+   IF l=NIL
+   THEN
+      InternalError ('out of memory error')
+   END ;
+   WITH l^ DO
+      maxRangeId   := 0 ;
+      rangeArray   := InitIndex(1) ;
+      currentRange := NIL ;
+      varientField := v
+   END ;
+   WITH caseStack^ DO
+      INC(maxCaseId) ;
+      PutIndice(caseListArray, maxCaseId, l) ;
+      currentCase := l
+   END
+END BeginCaseList ;
+
+
+(*
+   EndCaseList - terminate the current label list.
+*)
+
+PROCEDURE EndCaseList ;
+BEGIN
+   caseStack^.currentCase := NIL
+END EndCaseList ;
+
+
+(*
+   AddRange - add a range to the current label list.
+*)
+
+PROCEDURE AddRange (r1, r2: CARDINAL; tok: CARDINAL) ;
+VAR
+   r: RangePair ;
+BEGIN
+   NEW(r) ;
+   IF r=NIL
+   THEN
+      InternalError ('out of memory error')
+   ELSE
+      WITH r^ DO
+         low := r1 ;
+         high := r2 ;
+         tokenno := tok
+      END ;
+      WITH caseStack^.currentCase^ DO
+         INC(maxRangeId) ;
+         PutIndice(rangeArray, maxRangeId, r) ;
+         currentRange := r
+      END
+   END
+END AddRange ;
+
+
+(*
+   GetVariantTagType - returns the type associated with, variant.
+*)
+
+PROCEDURE GetVariantTagType (variant: CARDINAL) : CARDINAL ;
+VAR
+   tag: CARDINAL ;
+BEGIN
+   tag := GetVarientTag(variant) ;
+   IF IsFieldVarient(tag) OR IsRecordField(tag)
+   THEN
+      RETURN( GetType(tag) )
+   ELSE
+      RETURN( tag )
+   END
+END GetVariantTagType ;
+
+
+(*
+   CaseBoundsResolved - returns TRUE if all constants in the case list, c,
+                        are known to GCC.
+*)
+
+PROCEDURE CaseBoundsResolved (tokenno: CARDINAL; c: CARDINAL) : BOOLEAN ;
+VAR
+   resolved: BOOLEAN ;
+   p       : CaseDescriptor ;
+   q       : CaseList ;
+   r       : RangePair ;
+   min,
+   max,
+   type,
+   i, j    : CARDINAL ;
+BEGIN
+   p := GetIndice(caseArray, c) ;
+   WITH p^ DO
+      IF varient#NulSym
+      THEN
+         (* not a CASE statement, but a varient record containing without an ELSE clause *)
+         type := GetVariantTagType(varient) ;
+         resolved := TRUE ;
+         IF NOT GccKnowsAbout(type)
+         THEN
+            (* do we need to add, type, to the list of types required to be resolved? *)
+            resolved := FALSE
+         END ;
+         min := GetTypeMin(type) ;
+         IF NOT GccKnowsAbout(min)
+         THEN
+            TryDeclareConstant(tokenno, min) ;
+            resolved := FALSE
+         END ;
+         max := GetTypeMax(type) ;
+         IF NOT GccKnowsAbout(max)
+         THEN
+            TryDeclareConstant(tokenno, max) ;
+            resolved := FALSE
+         END ;
+         IF NOT resolved
+         THEN
+            RETURN( FALSE )
+         END
+      END ;
+      i := 1 ;
+      WHILE i<=maxCaseId DO
+         q := GetIndice(caseListArray, i) ;
+         j := 1 ;
+         WHILE j<=q^.maxRangeId DO
+            r := GetIndice(q^.rangeArray, j) ;
+            IF r^.low#NulSym
+            THEN
+               IF IsConst(r^.low)
+               THEN
+                  TryDeclareConstant(tokenno, r^.low) ;
+                  IF NOT GccKnowsAbout(r^.low)
+                  THEN
+                     RETURN( FALSE )
+                  END
+               ELSE
+                  IF r^.high=NulSym
+                  THEN
+                     MetaError1('the CASE statement variant must be defined by a constant {%1Da:is a {%1d}}', r^.low)
+                  ELSE
+                     MetaError1('the CASE statement variant low value in a range must be defined by a constant {%1Da:is a {%1d}}',
+                                r^.low)
+                  END
+               END
+            END ;
+            IF r^.high#NulSym
+            THEN
+               IF IsConst(r^.high)
+               THEN
+                  TryDeclareConstant(tokenno, r^.high) ;
+                  IF NOT GccKnowsAbout(r^.high)
+                  THEN
+                     RETURN( FALSE )
+                  END
+               ELSE
+                  MetaError1('the CASE statement variant high value in a range must be defined by a constant {%1Da:is a {%1d}}',
+                             r^.high)
+               END
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( TRUE )
+END CaseBoundsResolved ;
+
+
+(*
+   IsSame - return TRUE if r, s, are in, e.
+*)
+
+PROCEDURE IsSame (e: ConflictingPair; r, s: RangePair) : BOOLEAN ;
+BEGIN
+   WITH e^ DO
+      RETURN( ((a=r) AND (b=s)) OR ((a=s) AND (b=r)) )
+   END
+END IsSame ;
+
+
+(*
+   SeenBefore -
+*)
+
+PROCEDURE SeenBefore (r, s: RangePair) : BOOLEAN ;
+VAR
+   i, h: CARDINAL ;
+   e   : ConflictingPair ;
+BEGIN
+   h := HighIndice(conflictArray) ;
+   i := 1 ;
+   WHILE i<=h DO
+      e := GetIndice(conflictArray, i) ;
+      IF IsSame(e, r, s)
+      THEN
+         RETURN( TRUE )
+      END ;
+      INC(i)
+   END ;
+   NEW(e) ;
+   WITH e^ DO
+      a := r ;
+      b := s
+   END ;
+   PutIndice(conflictArray, h+1, e) ;
+   RETURN( FALSE )
+END SeenBefore ;
+
+
+(*
+   Overlaps -
+*)
+
+PROCEDURE Overlaps (r, s: RangePair) : BOOLEAN ;
+VAR
+   a, b, c, d: CARDINAL ;
+BEGIN
+   a := r^.low ;
+   c := s^.low ;
+   IF r^.high=NulSym
+   THEN
+      b := a ;
+      IF s^.high=NulSym
+      THEN
+         d := c ;
+         IF OverlapsRange(Mod2Gcc(a), Mod2Gcc(b), Mod2Gcc(c), Mod2Gcc(d))
+         THEN
+            IF NOT SeenBefore(r, s)
+            THEN
+               MetaErrorT2 (r^.tokenno, 'case label {%1ad} is a duplicate with {%2ad}', a, c) ;
+               MetaErrorT2 (s^.tokenno, 'case label {%1ad} is a duplicate with {%2ad}', c, a)
+            END ;
+            RETURN( TRUE )
+         END
+      ELSE
+         d := s^.high ;
+         IF OverlapsRange(Mod2Gcc(a), Mod2Gcc(b), Mod2Gcc(c), Mod2Gcc(d))
+         THEN
+            IF NOT SeenBefore (r, s)
+            THEN
+               MetaErrorT3 (r^.tokenno, 'case label {%1ad} is a duplicate in the range {%2ad}..{%3ad}', a, c, d) ;
+               MetaErrorT3 (s^.tokenno, 'case range {%2ad}..{%3ad} is a duplicate of case label {%1ad}', c, d, a)
+            END ;
+            RETURN( TRUE )
+         END
+      END
+   ELSE
+      b := r^.high ;
+      IF s^.high=NulSym
+      THEN
+         d := c ;
+         IF OverlapsRange (Mod2Gcc(a), Mod2Gcc(b), Mod2Gcc(c), Mod2Gcc(d))
+         THEN
+            IF NOT SeenBefore(r, s)
+            THEN
+               MetaErrorT3 (r^.tokenno, 'case range {%1ad}..{%2ad} is a duplicate with case label {%3ad}', a, b, c) ;
+               MetaErrorT3 (s^.tokenno, 'case label {%1ad} is a duplicate with case range %{2ad}..{%3ad}', c, a, b)
+            END ;
+            RETURN( TRUE )
+         END
+      ELSE
+         d := s^.high ;
+         IF OverlapsRange(Mod2Gcc(a), Mod2Gcc(b), Mod2Gcc(c), Mod2Gcc(d))
+         THEN
+            IF NOT SeenBefore(r, s)
+            THEN
+               MetaErrorT4 (r^.tokenno, 'case range {%1ad}..{%2ad} overlaps case range {%3ad}..{%4ad}', a, b, c, d) ;
+               MetaErrorT4 (s^.tokenno, 'case range {%1ad}..{%2ad} overlaps case range {%3ad}..{%4ad}', c, d, a, b)
+            END ;
+            RETURN( TRUE )
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END Overlaps ;
+
+
+(*
+   OverlappingCaseBound - returns TRUE if, r, overlaps any case bound in the
+                          case statement, c.
+*)
+
+PROCEDURE OverlappingCaseBound (r: RangePair; c: CARDINAL) : BOOLEAN ;
+VAR
+   p      : CaseDescriptor ;
+   q      : CaseList ;
+   s      : RangePair ;
+   i, j   : CARDINAL ;
+   overlap: BOOLEAN ;
+BEGIN
+   p := GetIndice (caseArray, c) ;
+   overlap := FALSE ;
+   WITH p^ DO
+      i := 1 ;
+      WHILE i<=maxCaseId DO
+         q := GetIndice (caseListArray, i) ;
+         j := 1 ;
+         WHILE j<=q^.maxRangeId DO
+            s := GetIndice (q^.rangeArray, j) ;
+            IF (s#r) AND Overlaps (r, s)
+            THEN
+               overlap := TRUE
+            END ;
+            INC (j)
+         END ;
+         INC (i)
+      END
+   END ;
+   RETURN( overlap )
+END OverlappingCaseBound ;
+
+
+(*
+   OverlappingCaseBounds - returns TRUE if there were any overlapping bounds
+                           in the case list, c.  It will generate an error
+                           messages for each overlapping bound found.
+*)
+
+PROCEDURE OverlappingCaseBounds (c: CARDINAL) : BOOLEAN ;
+VAR
+   p      : CaseDescriptor ;
+   q      : CaseList ;
+   r      : RangePair ;
+   i, j   : CARDINAL ;
+   overlap: BOOLEAN ;
+BEGIN
+   p := GetIndice(caseArray, c) ;
+   overlap := FALSE ;
+   WITH p^ DO
+      i := 1 ;
+      WHILE i<=maxCaseId DO
+         q := GetIndice(caseListArray, i) ;
+         j := 1 ;
+         WHILE j<=q^.maxRangeId DO
+            r := GetIndice(q^.rangeArray, j) ;
+            IF OverlappingCaseBound (r, c)
+            THEN
+               overlap := TRUE
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( overlap )
+END OverlappingCaseBounds ;
+
+
+(*
+   NewRanges -
+*)
+
+PROCEDURE NewRanges () : SetRange ;
+VAR
+   s: SetRange ;
+BEGIN
+   IF FreeRangeList=NIL
+   THEN
+      NEW(s)
+   ELSE
+      s := FreeRangeList ;
+      FreeRangeList := FreeRangeList^.next
+   END ;
+   s^.next := NIL ;
+   RETURN( s )
+END NewRanges ;
+
+
+(*
+   NewSet -
+*)
+
+PROCEDURE NewSet (type: CARDINAL) : SetRange ;
+VAR
+   s: SetRange ;
+BEGIN
+   s := NewRanges() ;
+   WITH s^ DO
+      low := Mod2Gcc(GetTypeMin(type)) ;
+      high := Mod2Gcc(GetTypeMax(type)) ;
+      next := NIL
+   END ;
+   RETURN( s )
+END NewSet ;
+
+
+(*
+   DisposeRanges -
+*)
+
+PROCEDURE DisposeRanges (set: SetRange) : SetRange ;
+VAR
+   t: SetRange ;
+BEGIN
+   IF set#NIL
+   THEN
+      IF FreeRangeList=NIL
+      THEN
+         FreeRangeList := set
+      ELSE
+         t := set ;
+         WHILE t^.next#NIL DO
+            t := t^.next
+         END ;
+         t^.next := FreeRangeList ;
+         FreeRangeList := set
+      END
+   END ;
+   RETURN( NIL )
+END DisposeRanges ;
+
+
+(*
+   SubBitRange - subtracts bits, lo..hi, from, set.
+*)
+
+PROCEDURE SubBitRange (set: SetRange; lo, hi: Tree; tokenno: CARDINAL) : SetRange ;
+VAR
+   h, i : SetRange ;
+BEGIN
+   h := set ;
+   WHILE h#NIL DO
+      IF (h^.high=NIL) OR IsEqual(h^.high, h^.low)
+      THEN
+         IF IsEqual(h^.low, lo) OR OverlapsRange(lo, hi, h^.low, h^.low)
+         THEN
+            IF h=set
+            THEN
+               set := set^.next ;
+               h^.next := NIL ;
+               h := DisposeRanges(h) ;
+               h := set
+            ELSE
+               i := set ;
+               WHILE i^.next#h DO
+                  i := i^.next
+               END ;
+               i^.next := h^.next ;
+               i := h ;
+               h := h^.next ;
+               i^.next := NIL ;
+               i := DisposeRanges(i)
+            END
+         ELSE
+            h := h^.next
+         END
+      ELSE
+         IF OverlapsRange(lo, hi, h^.low, h^.high)
+         THEN
+            IF IsGreater(h^.low, lo) OR IsGreater(hi, h^.high)
+            THEN
+               MetaErrorT0 (tokenno, 'variant case range lies outside tag value')
+            ELSE
+               IF IsEqual(h^.low, lo)
+               THEN
+                  PushIntegerTree(hi) ;
+                  PushInt(1) ;
+                  Addn ;
+                  h^.low := PopIntegerTree()
+               ELSIF IsEqual(h^.high, hi)
+               THEN
+                  PushIntegerTree(lo) ;
+                  PushInt(1) ;
+                  Sub ;
+                  h^.high := PopIntegerTree()
+               ELSE
+                  (* lo..hi  exist inside range h^.low..h^.high *)
+                  i := NewRanges() ;
+                  i^.next := h^.next ;
+                  h^.next := i ;
+                  i^.high := h^.high ;
+                  PushIntegerTree(lo) ;
+                  PushInt(1) ;
+                  Sub ;
+                  h^.high := PopIntegerTree() ;
+                  PushIntegerTree(hi) ;
+                  PushInt(1) ;
+                  Addn ;
+                  i^.low := PopIntegerTree()
+               END
+            END
+         ELSE
+            h := h^.next
+         END
+      END
+   END ;
+   RETURN( set )
+END SubBitRange ;
+
+
+(*
+   ExcludeCaseRanges - excludes all case ranges found in, p, from, set
+*)
+
+PROCEDURE ExcludeCaseRanges (set: SetRange; p: CaseDescriptor) : SetRange ;
+VAR
+   i, j: CARDINAL ;
+   q   : CaseList ;
+   r   : RangePair ;
+BEGIN
+   WITH p^ DO
+      i := 1 ;
+      WHILE i<=maxCaseId DO
+         q := GetIndice(caseListArray, i) ;
+         j := 1 ;
+         WHILE j<=q^.maxRangeId DO
+            r := GetIndice(q^.rangeArray, j) ;
+            IF r^.high=NulSym
+            THEN
+               set := SubBitRange(set, Mod2Gcc(r^.low), Mod2Gcc(r^.low), r^.tokenno)
+            ELSE
+               set := SubBitRange(set, Mod2Gcc(r^.low), Mod2Gcc(r^.high), r^.tokenno)
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( set )
+END ExcludeCaseRanges ;
+
+
+VAR
+   High, Low  : Tree ;
+   errorString: String ;
+
+
+(*
+   DoEnumValues -
+*)
+
+PROCEDURE DoEnumValues (sym: CARDINAL) ;
+BEGIN
+   IF (Low#NIL) AND IsEqual(Mod2Gcc(sym), Low)
+   THEN
+      errorString := ConCat(errorString, InitStringCharStar(KeyToCharStar(GetSymName(sym)))) ;
+      Low := NIL
+   END ;
+   IF (High#NIL) AND IsEqual(Mod2Gcc(sym), High)
+   THEN
+      errorString := ConCat(errorString, Mark(InitString('..'))) ;
+      errorString := ConCat(errorString, Mark(InitStringCharStar(KeyToCharStar(GetSymName(sym))))) ;
+      High := NIL
+   END
+END DoEnumValues ;
+
+
+(*
+   ErrorRange -
+*)
+
+PROCEDURE ErrorRange (p: CaseDescriptor; type: CARDINAL; set: SetRange) ;
+BEGIN
+   type := SkipType(type) ;
+   IF IsEnumeration(type)
+   THEN
+      Low := set^.low ;
+      High := set^.high ;
+      IF IsEqual(Low, High)
+      THEN
+         High := NIL ;
+         errorString := InitString('enumeration value ') ;
+         ForeachLocalSymDo(type, DoEnumValues) ;
+         errorString := ConCat(errorString, InitString(' is ignored by the CASE variant record {%1D}'))
+      ELSE
+         errorString := InitString('enumeration values ') ;
+         ForeachLocalSymDo(type, DoEnumValues) ;
+         errorString := ConCat(errorString, InitString(' are ignored by the CASE variant record {%1D}'))
+      END ;
+      MetaErrorString1(errorString, p^.varient)
+   END
+END ErrorRange ;
+
+
+(*
+   ErrorRanges -
+*)
+
+PROCEDURE ErrorRanges (p: CaseDescriptor; type: CARDINAL; set: SetRange) ;
+BEGIN
+   WHILE set#NIL DO
+      ErrorRange(p, type, set) ;
+      set := set^.next
+   END
+END ErrorRanges ;
+
+
+(*
+   MissingCaseBounds - returns TRUE if there were any missing bounds
+                       in the varient record case list, c.  It will
+                       generate an error message for each missing
+                       bounds found.
+*)
+
+PROCEDURE MissingCaseBounds (tokenno: CARDINAL; c: CARDINAL) : BOOLEAN ;
+VAR
+   p      : CaseDescriptor ;
+   type   : CARDINAL ;
+   missing: BOOLEAN ;
+   set    : SetRange ;
+BEGIN
+   p := GetIndice(caseArray, c) ;
+   missing := FALSE ;
+   WITH p^ DO
+      IF (record#NulSym) AND (varient#NulSym) AND (NOT elseClause)
+      THEN
+         (* not a CASE statement, but a varient record containing without an ELSE clause *)
+         type := GetVariantTagType(varient) ;
+         set := NewSet(type) ;
+         set := ExcludeCaseRanges(set, p) ;
+         IF set#NIL
+         THEN
+            missing := TRUE ;
+            MetaErrorT2 (tokenno,
+                         'not all variant record alternatives in the {%kCASE} clause are specified, hint you either need to specify each value of {%2ad} or use an {%kELSE} clause',
+                         varient, type) ;
+            ErrorRanges(p, type, set)
+         END ;
+         set := DisposeRanges(set)
+      END
+   END ;
+   RETURN( missing )
+END MissingCaseBounds ;
+
+
+(*
+   InRangeList - returns TRUE if the value, tag, is defined in the case list.
+
+PROCEDURE InRangeList (cl: CaseList; tag: CARDINAL) : BOOLEAN ;
+VAR
+   i, h: CARDINAL ;
+   r   : RangePair ;
+   a   : Tree ;
+BEGIN
+   WITH cl^ DO
+      i := 1 ;
+      h := HighIndice(rangeArray) ;
+      WHILE i<=h DO
+         r := GetIndice(rangeArray, i) ;
+         WITH r^ DO
+            IF high=NulSym
+            THEN
+               a := Mod2Gcc(low)
+            ELSE
+               a := Mod2Gcc(high)
+            END ;
+            IF OverlapsRange(Mod2Gcc(low), a, Mod2Gcc(tag), Mod2Gcc(tag))
+            THEN
+               RETURN( TRUE )
+            END
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( FALSE )
+END InRangeList ;
+*)
+
+
+(*
+   WriteCase - dump out the case list (internal debugging).
+*)
+
+PROCEDURE WriteCase (c: CARDINAL) ;
+BEGIN
+   (* this debugging procedure should be finished.  *)
+   printf1 ("%d", c)
+END WriteCase ;
+
+
+(*
+   checkTypes - checks to see that, constant, and, type, are compatible.
+*)
+
+PROCEDURE checkTypes (constant, type: CARDINAL) : BOOLEAN ;
+VAR
+   consttype: CARDINAL ;
+BEGIN
+   IF (constant#NulSym) AND IsConst(constant)
+   THEN
+      consttype := GetType(constant) ;
+      IF NOT IsExpressionCompatible(consttype, type)
+      THEN
+         MetaError2('the CASE statement variant tag {%1ad} must be type compatible with the constant {%2Da:is a {%2d}}',
+                    type, constant) ;
+         RETURN( FALSE )
+      END
+   END ;
+   RETURN( TRUE )
+END checkTypes ;
+
+
+(*
+   inRange - returns TRUE if, min <= i <= max.
+*)
+
+PROCEDURE inRange (i, min, max: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( OverlapsRange(Mod2Gcc(i), Mod2Gcc(i), Mod2Gcc(min), Mod2Gcc(max)) )
+END inRange ;
+
+
+(*
+   TypeCaseBounds - returns TRUE if all bounds in case list, c, are
+                    compatible with the tagged type.
+*)
+
+PROCEDURE TypeCaseBounds (c: CARDINAL) : BOOLEAN ;
+VAR
+   p         : CaseDescriptor ;
+   q         : CaseList ;
+   r         : RangePair ;
+   min, max,
+   type,
+   i, j      : CARDINAL ;
+   compatible: BOOLEAN ;
+BEGIN
+   p := GetIndice(caseArray, c) ;
+   type := NulSym ;
+   WITH p^ DO
+      type := NulSym ;
+      IF varient#NulSym
+      THEN
+         (* not a CASE statement, but a varient record containing without an ELSE clause *)
+         type := GetVariantTagType(varient) ;
+         min := GetTypeMin(type) ;
+         max := GetTypeMax(type)
+      END ;
+      IF type=NulSym
+      THEN
+         RETURN( TRUE )
+      END ;
+      compatible := TRUE ;
+      i := 1 ;
+      WHILE i<=maxCaseId DO
+         q := GetIndice(caseListArray, i) ;
+         j := 1 ;
+         WHILE j<=q^.maxRangeId DO
+            r := GetIndice(q^.rangeArray, j) ;
+            IF (r^.low#NulSym) AND (NOT inRange(r^.low, min, max))
+            THEN
+               MetaError2('the CASE statement variant range {%1ad} exceeds that of the tag type {%2ad}',
+                          r^.low, type) ;
+               compatible := FALSE
+            END ;
+            IF NOT checkTypes(r^.low, type)
+            THEN
+               compatible := FALSE
+            END ;
+            IF (r^.high#NulSym) AND (NOT inRange(r^.high, min, max))
+            THEN
+               MetaError2('the CASE statement variant range {%1ad} exceeds that of the tag type {%2ad}',
+                          r^.high, type) ;
+               compatible := FALSE
+            END ;
+            IF NOT checkTypes(r^.high, type)
+            THEN
+               compatible := FALSE
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END ;
+      RETURN( compatible )
+   END
+END TypeCaseBounds ;
+
+
+BEGIN
+   caseStack := NIL ;
+   caseId := 0 ;
+   caseArray := InitIndex(1) ;
+   conflictArray := InitIndex(1) ;
+   FreeRangeList := NIL
+END M2CaseList.
diff --git a/gcc/m2/gm2-compiler/M2Check.def b/gcc/m2/gm2-compiler/M2Check.def
new file mode 100644
index 00000000000..5222e32b079
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Check.def
@@ -0,0 +1,67 @@
+(* M2Check.def perform rigerous type checking for fully declared symbols.
+
+Copyright (C) 2020-2022 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/>.  *)
+
+DEFINITION MODULE M2Check ;
+
+(*
+    Title      : M2Check
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Mar  6 15:32:10 2020
+    Revision   : $Version$
+    Description: provides a module to check the symbol type compatibility.
+                 It assumes that the declaration of all dependants
+                 is complete.
+*)
+
+
+(*
+   ParameterTypeCompatible - returns TRUE if the nth procedure parameter formal
+                             is compatible with actual.  If the string is empty then
+                             no error is issued.
+*)
+
+PROCEDURE ParameterTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+                                   procedure, formal, actual, nth: CARDINAL;
+                                   isvar: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   AssignmentTypeCompatible - returns TRUE if the des and the expr are assignment compatible.
+                              If the string is empty then no error is issued.
+*)
+
+PROCEDURE AssignmentTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+                                    des, expr: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ExpressionTypeCompatible - returns TRUE if the expressions, left and right,
+                              are expression compatible.
+                              If the string is empty then no error is issued.
+*)
+
+PROCEDURE ExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+                                    left, right: CARDINAL;
+                                    strict, isin: BOOLEAN) : BOOLEAN ;
+
+
+END M2Check.
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
new file mode 100644
index 00000000000..a2ce7260586
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -0,0 +1,1549 @@
+(* M2Check.mod perform rigerous type checking for fully declared symbols.
+
+Copyright (C) 2020-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Check ;
+
+(*
+    Title      : M2Check
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Mar  6 15:32:10 2020
+    Revision   : $Version$
+    Description: provides a module to check the symbol type compatibility.
+                 It assumes that the declaration of all dependants
+                 is complete.
+*)
+
+FROM M2System IMPORT IsSystemType, IsGenericSystemType, IsSameSize, IsComplexN ;
+FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType ;
+FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex ;
+FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ;
+FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4 ;
+FROM StrLib IMPORT StrEqual ;
+FROM M2Debug IMPORT Assert ;
+FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType, SkipType, IsProcedure, NoOfParam, IsVarParam, GetNth, GetNthParam, IsProcType, IsVar, IsEnumeration, IsArray, GetDeclaredMod, IsSubrange, GetArraySubscript, IsConst, IsReallyPointer, IsPointer, IsParameter, ModeOfAddr, GetMode, GetType, IsUnbounded, IsComposite, IsConstructor, IsParameter ;
+FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
+FROM M2System IMPORT Address ;
+FROM M2ALU IMPORT Equ, PushIntegerTree ;
+FROM m2expr IMPORT AreConstantsEqual ;
+FROM SymbolConversion IMPORT Mod2Gcc ;
+FROM DynamicStrings IMPORT String, InitString, KillString ;
+FROM M2LexBuf IMPORT GetTokenNo ;
+FROM Storage IMPORT ALLOCATE ;
+FROM libc IMPORT printf ;
+
+
+CONST
+   debugging = FALSE ;
+
+TYPE
+   errorSig = POINTER TO RECORD
+                            token:  CARDINAL ;
+                            left,
+                            right:  CARDINAL ;
+                         END ;
+
+   pair = POINTER TO RECORD
+                        left, right: CARDINAL ;
+                        pairStatus : status ;
+                        next       : pair ;
+                     END ;
+
+   typeCheckFunction = PROCEDURE (status, tInfo, CARDINAL, CARDINAL) : status ;
+
+   checkType = (parameter, assignment, expression) ;
+
+   tInfo = POINTER TO RECORD
+                         format    : String ;
+                         kind      : checkType ;
+                         token,
+                         actual,
+                         formal,
+                         left,
+                         right,
+                         procedure,
+                         nth       : CARDINAL ;
+                         isvar     : BOOLEAN ;
+                         strict    : BOOLEAN ;  (* Comparison expression.  *)
+                         isin      : BOOLEAN ;  (* Expression created by IN?  *)
+                         error     : Error ;
+                         checkFunc : typeCheckFunction ;
+                         visited,
+                         resolved,
+                         unresolved: Index ;
+                         next      : tInfo ;
+                      END ;
+
+   status = (true, false, unknown, visited, unused) ;
+
+
+VAR
+   pairFreeList : pair ;
+   tinfoFreeList: tInfo ;
+   errors       : Index ;
+
+
+(*
+   isKnown - returns BOOLEAN:TRUE if result is status:true or status:false.
+*)
+
+PROCEDURE isKnown (result: status) : BOOLEAN ;
+BEGIN
+   RETURN (result = true) OR (result = false) OR (result = visited)
+END isKnown ;
+
+
+(*
+   isTrue - returns BOOLEAN:TRUE if result is status:true
+
+PROCEDURE isTrue (result: status) : BOOLEAN ;
+BEGIN
+   RETURN result = true
+END isTrue ;
+*)
+
+
+(*
+   isFalse - returns BOOLEAN:TRUE if result is status:false
+*)
+
+PROCEDURE isFalse (result: status) : BOOLEAN ;
+BEGIN
+   RETURN result = false
+END isFalse ;
+
+
+(*
+   checkTypeEquivalence - returns TRUE if left and right can be skipped and found to be equal.
+*)
+
+PROCEDURE checkTypeEquivalence (result: status; left, right: CARDINAL) : status ;
+VAR
+   leftT, rightT: CARDINAL ;
+BEGIN
+   (* firstly check to see if we already have resolved this as false.  *)
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSE
+      (* check to see if we dont care about left or right.  *)
+      IF (left = NulSym) OR (right = NulSym)
+      THEN
+         RETURN true
+      ELSE
+         leftT := SkipType (left) ;
+         rightT := SkipType (right) ;
+         IF leftT = rightT
+         THEN
+            RETURN true
+         ELSIF IsType (leftT) AND IsType (rightT)
+         THEN
+            (* the fundamental types are definitely different.  *)
+            RETURN false
+         END
+      END
+   END ;
+   RETURN result
+END checkTypeEquivalence ;
+
+
+(*
+   checkSubrange - check to see if subrange types left and right have the same limits.
+*)
+
+PROCEDURE checkSubrange (result: status; tinfo: tInfo; left, right: CARDINAL) : status ;
+VAR
+   lLow,  rLow,
+   lHigh, rHigh: CARDINAL ;
+BEGIN
+   (* firstly check to see if we already have resolved this as false.  *)
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSE
+      Assert (IsSubrange (left)) ;
+      Assert (IsSubrange (right)) ;
+      lLow := GetTypeMin (left) ;
+      lHigh := GetTypeMax (left) ;
+      rLow := GetTypeMin (right) ;
+      rHigh := GetTypeMax (right) ;
+      PushIntegerTree (Mod2Gcc (lLow)) ;
+      PushIntegerTree (Mod2Gcc (rLow)) ;
+      IF NOT Equ (tinfo^.token)
+      THEN
+         RETURN false
+      END ;
+      PushIntegerTree (Mod2Gcc (lHigh)) ;
+      PushIntegerTree (Mod2Gcc (rHigh)) ;
+      IF NOT Equ (tinfo^.token)
+      THEN
+         RETURN false
+      END
+   END ;
+   RETURN true
+END checkSubrange ;
+
+
+(*
+   checkArrayTypeEquivalence -
+*)
+
+PROCEDURE checkArrayTypeEquivalence (result: status; tinfo: tInfo;
+                                     left, right: CARDINAL) : status ;
+VAR
+   lSub , rSub: CARDINAL ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF IsArray (left) AND IsArray (right)
+   THEN
+      lSub := GetArraySubscript (left) ;
+      rSub := GetArraySubscript (right) ;
+      result := checkPair (result, tinfo, GetType (left), GetType (right)) ;
+      IF (lSub # NulSym) AND (rSub # NulSym)
+      THEN
+         result := checkSubrange (result, tinfo, GetSType (lSub), GetSType (rSub))
+      END
+   ELSIF IsUnbounded (left) AND (IsArray (right) OR IsUnbounded (right))
+   THEN
+      IF IsGenericSystemType (GetSType (left)) OR IsGenericSystemType (GetSType (right))
+      THEN
+         RETURN true
+      ELSE
+         result := checkPair (result, tinfo, GetType (left), GetType (right))
+      END
+   END ;
+   RETURN result
+END checkArrayTypeEquivalence ;
+
+
+(*
+   checkGenericTypeEquivalence - check left and right for generic equivalence.
+*)
+
+PROCEDURE checkGenericTypeEquivalence (result: status; left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF left = right
+   THEN
+      RETURN true
+   ELSE
+      RETURN result
+   END
+END checkGenericTypeEquivalence ;
+
+
+(*
+   firstTime - returns TRUE if the triple (token, left, right) has not been seen before.
+*)
+
+PROCEDURE firstTime (token: CARDINAL; left, right: CARDINAL) : BOOLEAN ;
+VAR
+   p   : errorSig ;
+   i, n: CARDINAL ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (errors) ;
+   WHILE i <= n DO
+      p := GetIndice (errors, i) ;
+      IF (p^.token = token) AND (p^.left = left) AND (p^.right = right)
+      THEN
+         RETURN FALSE
+      END ;
+      INC (i)
+   END ;
+   NEW (p) ;
+   p^.token := token ;
+   p^.left := left ;
+   p^.right := right ;
+   IncludeIndiceIntoIndex (errors, p) ;
+   RETURN TRUE
+END firstTime ;
+
+
+(*
+   buildError4 -
+*)
+
+PROCEDURE buildError4 (tinfo: tInfo; left, right: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   IF firstTime (tinfo^.token, left, right)
+   THEN
+      IF tinfo^.error = NIL
+      THEN
+         (* need to create top level error message first.  *)
+         tinfo^.error := NewError (tinfo^.token) ;
+         s := MetaString4 (tinfo^.format,
+                           tinfo^.left, tinfo^.right,
+                           tinfo^.procedure, tinfo^.nth) ;
+         ErrorString (tinfo^.error, s)
+      END ;
+      (* and also generate a sub error containing detail.  *)
+      IF (left # tinfo^.left) OR (right # tinfo^.right)
+      THEN
+         tinfo^.error := ChainError (tinfo^.token, tinfo^.error) ;
+         s := MetaString2 (InitString ("{%1Ead} and {%2ad} are incompatible in this context"), left, right) ;
+         ErrorString (tinfo^.error, s)
+      END
+   END
+END buildError4 ;
+
+
+(*
+   buildError2 -
+*)
+
+PROCEDURE buildError2 (tinfo: tInfo; left, right: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   IF firstTime (tinfo^.token, left, right)
+   THEN
+      IF tinfo^.error = NIL
+      THEN
+         (* need to create top level error message first.  *)
+         tinfo^.error := NewError (tinfo^.token) ;
+         s := MetaString2 (tinfo^.format,
+                           tinfo^.left, tinfo^.right) ;
+         ErrorString (tinfo^.error, s)
+      END ;
+      (* and also generate a sub error containing detail.  *)
+      IF (left # tinfo^.left) OR (right # tinfo^.right)
+      THEN
+         tinfo^.error := ChainError (tinfo^.token, tinfo^.error) ;
+         s := MetaString2 (InitString ("{%1Ead} and {%2ad} are incompatible in this context"), left, right) ;
+         ErrorString (tinfo^.error, s)
+      END
+   END
+END buildError2 ;
+
+
+(*
+   issueError -
+*)
+
+PROCEDURE issueError (result: BOOLEAN; tinfo: tInfo; left, right: CARDINAL) : status ;
+BEGIN
+   IF result
+   THEN
+      RETURN true
+   ELSE
+      (* check whether errors are required.  *)
+      IF tinfo^.format # NIL
+      THEN
+         CASE tinfo^.kind OF
+
+         parameter :  buildError4 (tinfo, left, right) |
+         assignment:  buildError2 (tinfo, left, right) |
+         expression:  buildError2 (tinfo, left, right)
+
+         END ;
+         tinfo^.format := NIL    (* string is used by MetaError now.  *)
+      END ;
+      RETURN false
+   END
+END issueError ;
+
+
+(*
+   checkBaseEquivalence - the catch all check for types not specifically
+                          handled by this module.
+*)
+
+PROCEDURE checkBaseEquivalence (result: status; tinfo: tInfo;
+                                left, right: CARDINAL) : status ;
+BEGIN
+   IF isKnown (result)
+   THEN
+      RETURN result
+   ELSE
+      CASE tinfo^.kind OF
+
+      parameter :  IF tinfo^.isvar
+                   THEN
+                      RETURN issueError (IsExpressionCompatible (left, right),
+                                         tinfo, left, right)
+                   ELSE
+                      RETURN issueError (IsAssignmentCompatible (left, right),
+                                         tinfo, left, right)
+                   END |
+      assignment:  RETURN issueError (IsAssignmentCompatible (left, right),
+                                      tinfo, left, right) |
+      expression:  IF tinfo^.isin
+                   THEN
+                      IF IsVar (right) OR IsConst (right)
+                      THEN
+                         right := GetSType (right)
+                      END
+                   END ;
+                   IF tinfo^.strict
+                   THEN
+                      RETURN issueError (IsComparisonCompatible (left, right),
+                                         tinfo, left, right)
+                   ELSE
+                      RETURN issueError (IsExpressionCompatible (left, right),
+                                         tinfo, left, right)
+                   END
+
+      ELSE
+         InternalError ('unexpected kind value')
+      END
+   END
+   (* should never reach here.  *)
+END checkBaseEquivalence ;
+
+
+(*
+   checkPair -
+*)
+
+PROCEDURE checkPair (result: status; tinfo: tInfo;
+                     left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      exclude (tinfo^.visited, left, right) ;
+      RETURN result
+   ELSE
+      IF in (tinfo^.resolved, left, right)
+      THEN
+         exclude (tinfo^.visited, left, right) ;
+         RETURN getStatus (tinfo^.resolved, left, right)
+      ELSIF in (tinfo^.visited, left, right)
+      THEN
+         RETURN visited
+      ELSE
+         IF debugging
+         THEN
+            printf ("   marked as visited (%d, %d)\n", left, right)
+         END ;
+         include (tinfo^.visited, left, right, unknown) ;
+         include (tinfo^.unresolved, left, right, unknown)
+      END ;
+      RETURN doCheckPair (result, tinfo, left, right)
+   END
+END checkPair ;
+
+
+(*
+   useBaseCheck -
+*)
+
+PROCEDURE useBaseCheck (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN IsBaseType (sym) OR IsSystemType (sym) OR IsMathType (sym) OR IsComplexType (sym)
+END useBaseCheck ;
+
+
+(*
+   checkBaseTypeEquivalence -
+*)
+
+PROCEDURE checkBaseTypeEquivalence (result: status; tinfo: tInfo;
+                                     left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF useBaseCheck (left) AND useBaseCheck (right)
+   THEN
+      RETURN checkBaseEquivalence (result, tinfo, left, right)
+   ELSE
+      RETURN result
+   END
+END checkBaseTypeEquivalence ;
+
+
+(*
+   IsTyped -
+*)
+
+PROCEDURE IsTyped (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN IsVar (sym) OR IsVar (sym) OR IsParameter (sym) OR
+          (IsConst (sym) AND IsConstructor (sym)) OR IsParameter (sym) OR
+          (IsConst (sym) AND (GetType (sym) # NulSym))
+END IsTyped ;
+
+
+(*
+   isLValue -
+*)
+
+PROCEDURE isLValue (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN IsVar (sym) AND (GetMode (sym) = LeftValue)
+END isLValue ;
+
+
+(*
+   checkVarEquivalence - this test must be done first as it checks the symbol mode.
+                         An LValue is treated as a pointer during assignment and the
+                         LValue is attached to a variable.  This function skips the variable
+                         and checks the types - after it has considered a possible LValue.
+*)
+
+PROCEDURE checkVarEquivalence (result: status; tinfo: tInfo;
+                               left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF IsTyped (left) OR IsTyped (right)
+   THEN
+      IF tinfo^.kind = assignment
+      THEN
+         (* LValues are only relevant during assignment.  *)
+         IF isLValue (left) AND (NOT isLValue (right))
+         THEN
+            IF SkipType (getType (right)) = Address
+            THEN
+               RETURN true
+            ELSIF IsPointer (SkipType (getType (right)))
+            THEN
+               right := GetDType (SkipType (getType (right)))
+            END
+         ELSIF isLValue (right) AND (NOT isLValue (left))
+         THEN
+            IF SkipType (getType (left)) = Address
+            THEN
+               RETURN true
+            ELSIF IsPointer (SkipType (getType (left)))
+            THEN
+               left := GetDType (SkipType (getType (left)))
+            END
+         END
+      END ;
+      RETURN doCheckPair (result, tinfo, getType (left), getType (right))
+   ELSE
+      RETURN result
+   END
+END checkVarEquivalence ;
+
+
+(*
+   checkSubrangeTypeEquivalence -
+*)
+
+PROCEDURE checkSubrangeTypeEquivalence (result: status; tinfo: tInfo;
+                                        left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSE
+      IF IsSubrange (left)
+      THEN
+         RETURN doCheckPair (result, tinfo, GetDType (left), right)
+      END ;
+      IF IsSubrange (right)
+      THEN
+         RETURN doCheckPair (result, tinfo, left, GetDType (right))
+      END ;
+      IF left = right
+      THEN
+         RETURN true
+      ELSE
+         RETURN result
+      END
+   END
+END checkSubrangeTypeEquivalence ;
+
+
+(*
+   isZRC -
+*)
+
+PROCEDURE isZRC (zrc, sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsConst (sym)
+   THEN
+      sym := SkipType (GetType (sym))
+   END ;
+   IF (zrc = CType) AND (IsComplexN (sym) OR IsComplexType (sym))
+   THEN
+      RETURN TRUE
+   END ;
+   RETURN (zrc = sym) OR ((zrc = ZType) OR (zrc = RType) AND (NOT IsComposite (sym)))
+END isZRC ;
+
+
+(*
+   isSameSizeConst -
+
+*)
+
+PROCEDURE isSameSizeConst (a, b: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsConst (a)
+   THEN
+      a := SkipType (GetType (a)) ;
+      RETURN isZRC (a, b) OR (a = b) OR ((a # NulSym) AND isSameSize (a, b))
+   ELSIF IsConst (b)
+   THEN
+      b := SkipType (GetType (b)) ;
+      RETURN isZRC (b, a) OR (a = b) OR ((b # NulSym) AND isSameSize (a, b))
+   END ;
+   RETURN FALSE
+END isSameSizeConst ;
+
+
+(*
+   isSameSize - should only be called if either a or b are WORD, BYTE, etc.
+*)
+
+PROCEDURE isSameSize (a, b: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN isSameSizeConst (a, b) OR IsSameSize (a, b)
+END isSameSize ;
+
+
+(*
+   checkSystemEquivalence - check whether left and right are system types and whether they have the same size.
+*)
+
+PROCEDURE checkSystemEquivalence (result: status; left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result) OR (result = visited)
+   THEN
+      RETURN result
+   ELSE
+      IF (IsGenericSystemType (left) OR IsGenericSystemType (right)) AND
+         isSameSize (left, right)
+      THEN
+         RETURN true
+      END
+   END ;
+   RETURN result
+END checkSystemEquivalence ;
+
+
+(*
+   doCheckPair -
+*)
+
+PROCEDURE doCheckPair (result: status; tinfo: tInfo;
+                       left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result) OR (result = visited)
+   THEN
+      RETURN return (result, tinfo, left, right)
+   ELSIF left = right
+   THEN
+      RETURN return (true, tinfo, left, right)
+   ELSE
+      result := checkVarEquivalence (unknown, tinfo, left, right) ;
+      IF NOT isKnown (result)
+      THEN
+         result := checkSystemEquivalence (unknown, left, right) ;
+         IF NOT isKnown (result)
+         THEN
+            result := checkSubrangeTypeEquivalence (unknown, tinfo, left, right) ;
+            IF NOT isKnown (result)
+            THEN
+               result := checkBaseTypeEquivalence (unknown, tinfo, left, right) ;
+               IF NOT isKnown (result)
+               THEN
+                  result := checkTypeEquivalence (unknown, left, right) ;
+                  IF NOT isKnown (result)
+                  THEN
+                     result := checkArrayTypeEquivalence (result, tinfo, left, right) ;
+                     IF NOT isKnown (result)
+                     THEN
+                        result := checkGenericTypeEquivalence (result, left, right) ;
+                        IF NOT isKnown (result)
+                        THEN
+                           result := checkTypeKindEquivalence (result, tinfo, left, right)
+                        END
+                     END
+                  END
+               END
+            END
+         END
+      END
+   END ;
+   RETURN return (result, tinfo, left, right)
+END doCheckPair ;
+
+
+(*
+   checkProcType -
+*)
+
+PROCEDURE checkProcType (result: status; tinfo: tInfo;
+                         left, right: CARDINAL) : status ;
+VAR
+   i, n  : CARDINAL ;
+   lt, rt: CARDINAL ;
+BEGIN
+   Assert (IsProcType (right)) ;
+   Assert (IsProcType (left)) ;
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSE
+      lt := GetDType (left) ;
+      rt := GetDType (right) ;
+      IF (lt = NulSym) AND (rt = NulSym)
+      THEN
+         result := unknown
+      ELSIF lt = NulSym
+      THEN
+         IF tinfo^.format # NIL
+         THEN
+            MetaErrorStringT3 (tinfo^.token, InitString ("procedure type {%1a} does not have a {%kRETURN} type whereas procedure type {%2ad} has a {%kRETURN} type {%3ad}"), left, right, rt)
+         END ;
+         RETURN return (false, tinfo, left, right)
+      ELSIF rt = NulSym
+      THEN
+         IF tinfo^.format # NIL
+         THEN
+            MetaErrorStringT3 (tinfo^.token, InitString ("procedure type {%1a} does not have a {%kRETURN} type whereas procedure type {%2ad} has a {%kRETURN} type {%3ad}"), right, left, lt)
+         END ;
+         RETURN return (false, tinfo, left, right)
+      ELSE
+         (* two return type seen so we check them.  *)
+         result := checkPair (unknown, tinfo, lt, rt)
+      END ;
+
+      IF NoOfParam (left) # NoOfParam (right)
+      THEN
+         IF tinfo^.format # NIL
+         THEN
+            MetaErrorStringT2 (tinfo^.token, InitString ("procedure type {%1a} has a different number of parameters from procedure type {%2ad}"), right, left)
+         END ;
+         RETURN return (false, tinfo, left, right)
+      END ;
+      i := 1 ;
+      n := NoOfParam (left) ;
+      WHILE i <= n DO
+         IF IsVarParam (left, i) # IsVarParam (right, i)
+         THEN
+            IF IsVarParam (left, i)
+            THEN
+               IF tinfo^.format # NIL
+               THEN
+                  MetaErrorStringT3 (tinfo^.token, InitString ("procedure type {%2a} {%3n} parameter was declared as a {%kVAR} whereas procedure type {%1ad} {%3n} parameter was not"), right, left, i)
+               END
+            ELSE
+               IF tinfo^.format # NIL
+               THEN
+                  MetaErrorStringT3 (tinfo^.token, InitString ("procedure type {%1a} {%3n} parameter was declared as a {%kVAR} whereas procedure type {%2ad} {%3n} parameter was not"), right, left, i)
+               END
+            END ;
+            RETURN return (false, tinfo, left, right)
+         END ;
+         result := checkPair (result, tinfo, GetDType (GetNthParam (left, i)), GetDType (GetNthParam (right, i))) ;
+         INC (i)
+      END
+   END ;
+   RETURN return (result, tinfo, left, right)
+END checkProcType ;
+
+
+(*
+   checkProcedureProcType -
+*)
+
+PROCEDURE checkProcedureProcType (result: status; tinfo: tInfo;
+                                  left, right: CARDINAL) : status ;
+VAR
+   i, n  : CARDINAL ;
+   lt, rt: CARDINAL ;
+BEGIN
+   Assert (IsProcedure (right)) ;
+   Assert (IsProcType (left)) ;
+   IF NOT isFalse (result)
+   THEN
+      lt := GetDType (left) ;
+      rt := GetDType (right) ;
+      IF (lt = NulSym) AND (rt = NulSym)
+      THEN
+         (* nothing.  *)
+      ELSIF lt = NulSym
+      THEN
+         IF tinfo^.format # NIL
+         THEN
+            MetaErrorStringT3 (tinfo^.token, InitString ("procedure type {%1a} does not have a {%kRETURN} type whereas procedure {%2ad} has a {%kRETURN} type {%3ad}"), left, right, rt)
+         END ;
+         RETURN return (false, tinfo, left, right)
+      ELSIF rt = NulSym
+      THEN
+         IF tinfo^.format # NIL
+         THEN
+            MetaErrorStringT3 (tinfo^.token, InitString ("procedure {%1a} does not have a {%kRETURN} type whereas procedure type {%2ad} has a {%kRETURN} type {%3ad}"), right, left, lt)
+         END ;
+         RETURN return (false, tinfo, left, right)
+      ELSE
+         (* two return type seen so we check them.  *)
+         result := checkPair (result, tinfo, lt, rt)
+      END ;
+
+      IF NoOfParam (left) # NoOfParam (right)
+      THEN
+         IF tinfo^.format # NIL
+         THEN
+            MetaErrorStringT2 (tinfo^.token, InitString ("procedure {%1a} has a different number of parameters from procedure type {%2ad}"), right, left)
+         END ;
+         RETURN return (false, tinfo, left, right)
+      END ;
+      i := 1 ;
+      n := NoOfParam (left) ;
+      WHILE i <= n DO
+         IF IsVarParam (left, i) # IsVarParam (right, i)
+         THEN
+            IF IsVarParam (left, i)
+            THEN
+               IF tinfo^.format # NIL
+               THEN
+                  MetaErrorStringT3 (tinfo^.token, InitString ("procedure type {%2a} {%3n} parameter was declared as a {%kVAR} whereas procedure {%1ad} {%3n} parameter was not"), right, left, i)
+               END
+            ELSE
+               IF tinfo^.format # NIL
+               THEN
+                  MetaErrorStringT3 (tinfo^.token, InitString ("procedure {%1a} {%3n} parameter was declared as a {%kVAR} whereas procedure type {%2ad} {%3n} parameter was not"), right, left, i)
+               END
+            END ;
+            RETURN return (false, tinfo, left, right)
+         END ;
+         result := checkPair (result, tinfo, GetDType (GetNthParam (left, i)), GetDType (GetNthParam (right, i))) ;
+         INC (i)
+      END
+   END ;
+   RETURN return (result, tinfo, left, right)
+END checkProcedureProcType ;
+
+
+(*
+   checkProcedure -
+*)
+
+PROCEDURE checkProcedure (result: status; tinfo: tInfo;
+                          left, right: CARDINAL) : status ;
+BEGIN
+   Assert (IsProcedure (right)) ;
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF IsVar (left)
+   THEN
+      RETURN checkProcedure (result, tinfo,
+                             GetDType (left), right)
+   ELSIF left = Address
+   THEN
+      RETURN true
+   ELSIF IsProcType (left)
+   THEN
+      RETURN checkProcedureProcType (result, tinfo, left, right)
+   ELSE
+      RETURN result
+   END
+END checkProcedure ;
+
+
+(*
+   checkEnumerationEquivalence -
+*)
+
+PROCEDURE checkEnumerationEquivalence (result: status;
+                                       left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF left = right
+   THEN
+      RETURN true
+   ELSE
+      RETURN false
+   END
+END checkEnumerationEquivalence ;
+
+
+(*
+   checkPointerType - check whether left and right are equal or are of type ADDRESS.
+*)
+
+PROCEDURE checkPointerType (result: status; left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF (left = right) OR (left = Address) OR (right = Address)
+   THEN
+      RETURN true
+   ELSE
+      RETURN false
+   END
+END checkPointerType ;
+
+
+(*
+   checkTypeKindEquivalence -
+*)
+
+PROCEDURE checkTypeKindEquivalence (result: status; tinfo: tInfo;
+                                    left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF (left = NulSym) OR (right = NulSym)
+   THEN
+      RETURN true
+   ELSE
+      (* long cascade of all type kinds.  *)
+      IF IsSet (left) AND IsSet (right)
+      THEN
+         RETURN checkSetEquivalent (result, tinfo, left, right)
+      ELSIF IsArray (left) AND IsArray (right)
+      THEN
+         RETURN checkArrayTypeEquivalence (result, tinfo, left, right)
+      ELSIF IsRecord (left) AND IsRecord (right)
+      THEN
+         RETURN checkRecordEquivalence (result, left, right)
+      ELSIF IsEnumeration (left) AND IsEnumeration (right)
+      THEN
+         RETURN checkEnumerationEquivalence (result, left, right)
+      ELSIF IsProcedure (left) AND IsProcType (right)
+      THEN
+         RETURN checkProcedure (result, tinfo, right, left)
+      ELSIF IsProcType (left) AND IsProcedure (right)
+      THEN
+         RETURN checkProcedure (result, tinfo, left, right)
+      ELSIF IsProcType (left) OR IsProcType (right)
+      THEN
+         RETURN checkProcType (result, tinfo, left, right)
+      ELSIF IsReallyPointer (left) AND IsReallyPointer (right)
+      THEN
+         RETURN checkPointerType (result, left, right)
+      ELSE
+         RETURN result
+      END
+   END
+END checkTypeKindEquivalence ;
+
+
+(*
+   isSkipEquivalence -
+*)
+
+PROCEDURE isSkipEquivalence (left, right: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN SkipType (left) = SkipType (right)
+END isSkipEquivalence ;
+
+
+(*
+   checkValueEquivalence - check to see if left and right values are the same.
+*)
+
+PROCEDURE checkValueEquivalence (result: status; left, right: CARDINAL) : status ;
+BEGIN
+   IF isKnown (result)
+   THEN
+      RETURN result
+   ELSIF left = right
+   THEN
+      RETURN true
+   ELSE
+      IF AreConstantsEqual (Mod2Gcc (left), Mod2Gcc (right))
+      THEN
+         RETURN true
+      ELSE
+         RETURN false
+      END
+   END
+END checkValueEquivalence ;
+
+
+(*
+   and -
+*)
+
+PROCEDURE and (left, right: status) : status ;
+BEGIN
+   IF (left = true) AND (right = true)
+   THEN
+      RETURN true
+   ELSE
+      RETURN false
+   END
+END and ;
+
+
+(*
+   checkTypeRangeEquivalence -
+*)
+
+PROCEDURE checkTypeRangeEquivalence (result: status; tinfo: tInfo;
+                                     left, right: CARDINAL) : status ;
+VAR
+   result2, result3: status ;
+BEGIN
+   result := checkSkipEquivalence (result, left, right) ;
+   result2 := checkValueEquivalence (result, GetTypeMin (left), GetTypeMin (right)) ;
+   result3 := checkValueEquivalence (result, GetTypeMax (left), GetTypeMax (right)) ;
+   RETURN return (and (result2, result3), tinfo, left, right)
+END checkTypeRangeEquivalence ;
+
+
+(*
+   include - include pair left:right into pairs with status, s.
+*)
+
+PROCEDURE include (pairs: Index; left, right: CARDINAL; s: status) ;
+VAR
+   p: pair ;
+BEGIN
+   p := newPair () ;
+   p^.left := left ;
+   p^.right := right ;
+   p^.pairStatus := s ;
+   p^.next := NIL ;
+   IncludeIndiceIntoIndex (pairs, p)
+END include ;
+
+
+(*
+   exclude - exclude pair left:right from pairs.
+*)
+
+PROCEDURE exclude (pairs: Index; left, right: CARDINAL) ;
+VAR
+   p   : pair ;
+   i, n: CARDINAL ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (pairs) ;
+   WHILE i <= n DO
+      p := GetIndice (pairs, i) ;
+      IF (p # NIL) AND (p^.left = left) AND (p^.right = right)
+      THEN
+         PutIndice (pairs, i, NIL) ;
+         disposePair (p) ;
+         RETURN
+      END ;
+      INC (i)
+   END
+END exclude ;
+
+
+(*
+   getStatus -
+*)
+
+PROCEDURE getStatus (pairs: Index; left, right: CARDINAL) : status ;
+VAR
+   p   : pair ;
+   i, n: CARDINAL ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (pairs) ;
+   WHILE i <= n DO
+      p := GetIndice (pairs, i) ;
+      IF (p # NIL) AND (p^.left = left) AND (p^.right = right)
+      THEN
+         RETURN p^.pairStatus
+      END ;
+      INC (i)
+   END ;
+   RETURN unknown
+END getStatus ;
+
+
+(*
+   return -
+*)
+
+PROCEDURE return (result: status; tinfo: tInfo; left, right: CARDINAL) : status ;
+BEGIN
+   IF result # unknown
+   THEN
+      IF isKnown (result)
+      THEN
+         include (tinfo^.resolved, left, right, result) ;
+         exclude (tinfo^.unresolved, left, right) ;
+         exclude (tinfo^.visited, left, right)   (* no longer visiting as it is resolved.  *)
+      END
+   END ;
+   IF result = false
+   THEN
+      RETURN issueError (FALSE, tinfo, left, right)
+   END ;
+   RETURN result
+END return ;
+
+
+(*
+   checkSkipEquivalence - return true if left right are equivalent.
+*)
+
+PROCEDURE checkSkipEquivalence (result: status; left, right: CARDINAL) : status ;
+BEGIN
+   IF isKnown (result)
+   THEN
+      RETURN result
+   ELSIF isSkipEquivalence (left, right)
+   THEN
+      RETURN true
+   ELSE
+      RETURN result
+   END
+END checkSkipEquivalence ;
+
+
+(*
+   checkSetEquivalent - compares set types, left and right.
+*)
+
+PROCEDURE checkSetEquivalent (result: status; tinfo: tInfo;
+                              left, right: CARDINAL) : status ;
+BEGIN
+   result := checkSkipEquivalence (result, left, right) ;
+   result := checkTypeKindEquivalence (result, tinfo, GetDType (left), GetDType (right)) ;
+   result := checkTypeRangeEquivalence (result, tinfo, GetDType (left), GetDType (right)) ;
+   RETURN return (result, tinfo, left, right)
+END checkSetEquivalent ;
+
+
+(*
+   checkRecordEquivalence - compares record types, left and right.
+*)
+
+PROCEDURE checkRecordEquivalence (result: status; left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF left = right
+   THEN
+      RETURN true
+   ELSE
+      RETURN false
+   END
+END checkRecordEquivalence ;
+
+
+(*
+   getType - only returns the type of symbol providing it is not a procedure.
+*)
+
+PROCEDURE getType (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF IsTyped (sym)
+   THEN
+      RETURN GetDType (sym)
+   ELSE
+      RETURN sym
+   END
+END getType ;
+
+
+(*
+   determineCompatible - check for compatibility by checking
+                         equivalence, array, generic and type kind.
+*)
+
+PROCEDURE determineCompatible (result: status; tinfo: tInfo; left, right: CARDINAL) : status ;
+BEGIN
+   result := checkPair (result, tinfo, left, right) ;
+   RETURN return (result, tinfo, left, right)
+END determineCompatible ;
+
+
+(*
+   get -
+*)
+
+PROCEDURE get (pairs: Index; VAR left, right: CARDINAL; s: status) : BOOLEAN ;
+VAR
+   i, n: CARDINAL ;
+   p   : pair ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (pairs) ;
+   WHILE i <= n DO
+      p := GetIndice (pairs, i) ;
+      IF (p # NIL) AND (p^.pairStatus = s)
+      THEN
+         left := p^.left ;
+         right := p^.right ;
+         RETURN TRUE
+      END ;
+      INC (i)
+   END ;
+   RETURN FALSE
+END get ;
+
+
+(*
+   doCheck - keep obtaining an unresolved pair and check for the
+             type compatibility.  This is the main check routine used by
+             parameter, assignment and expression compatibility.
+             It tests all unknown pairs and calls the appropriate
+             check function
+*)
+
+PROCEDURE doCheck (tinfo: tInfo) : BOOLEAN ;
+VAR
+   result     : status ;
+   left, right: CARDINAL ;
+BEGIN
+   WHILE get (tinfo^.unresolved, left, right, unknown) DO
+      IF debugging
+      THEN
+         printf ("doCheck (%d, %d)\n", left, right)
+      END ;
+      (*
+      IF in (tinfo^.visited, left, right)
+      THEN
+         IF debugging
+         THEN
+            printf ("   already visited (%d, %d)\n", left, right)
+         END ;
+      ELSE
+         IF debugging
+         THEN
+            printf ("   not visited (%d, %d)\n", left, right)
+         END ;
+      *)
+      result := tinfo^.checkFunc (unknown, tinfo, left, right) ;
+      IF isKnown (result)
+      THEN
+         (* remove this pair from the unresolved list.  *)
+         exclude (tinfo^.unresolved, left, right) ;
+         (* add it to the resolved list.  *)
+         include (tinfo^.resolved, left, right, result) ;
+         IF result = false
+         THEN
+            IF debugging
+            THEN
+               printf ("   known (%d, %d)  false\n", left, right)
+            END ;
+            RETURN FALSE
+         ELSE
+            IF debugging
+            THEN
+               printf ("   known (%d, %d)  true\n", left, right)
+            END
+         END
+      END
+   END ;
+   RETURN TRUE
+END doCheck ;
+
+
+(*
+   in - returns TRUE if the pair is in the list.
+*)
+
+PROCEDURE in (pairs: Index; left, right: CARDINAL) : BOOLEAN ;
+VAR
+   i, n: CARDINAL ;
+   p   : pair ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (pairs) ;
+   WHILE i <= n DO
+      p := GetIndice (pairs, i) ;
+      IF (p # NIL) AND (p^.left = left) AND (p^.right = right)
+      THEN
+         RETURN TRUE
+      END ;
+      INC (i)
+   END ;
+   RETURN FALSE
+END in ;
+
+
+(*
+   newPair -
+*)
+
+PROCEDURE newPair () : pair ;
+VAR
+   p: pair ;
+BEGIN
+   IF pairFreeList = NIL
+   THEN
+      NEW (p)
+   ELSE
+      p := pairFreeList ;
+      pairFreeList := p^.next
+   END ;
+   Assert (p # NIL) ;
+   RETURN p
+END newPair ;
+
+
+(*
+   disposePair - adds pair, p, to the free list.
+*)
+
+PROCEDURE disposePair (p: pair) ;
+BEGIN
+   p^.next := pairFreeList ;
+   pairFreeList := p
+END disposePair ;
+
+
+(*
+   deconstructIndex -
+*)
+
+PROCEDURE deconstructIndex (pairs: Index) : Index ;
+VAR
+   p   : pair ;
+   i, n: CARDINAL ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (pairs) ;
+   WHILE i <= n DO
+      p := GetIndice (pairs, i) ;
+      IF p # NIL
+      THEN
+         disposePair (p)
+      END ;
+      INC (i)
+   END ;
+   RETURN KillIndex (pairs)
+END deconstructIndex ;
+
+
+(*
+   deconstruct - deallocate the List data structure.
+*)
+
+PROCEDURE deconstruct (tinfo: tInfo) ;
+BEGIN
+   tinfo^.format := KillString (tinfo^.format) ;
+   tinfo^.visited := deconstructIndex (tinfo^.visited) ;
+   tinfo^.resolved := deconstructIndex (tinfo^.resolved) ;
+   tinfo^.unresolved := deconstructIndex (tinfo^.unresolved)
+END deconstruct ;
+
+
+(*
+   newtInfo -
+*)
+
+PROCEDURE newtInfo () : tInfo ;
+VAR
+   tinfo: tInfo ;
+BEGIN
+   IF tinfoFreeList = NIL
+   THEN
+      NEW (tinfo)
+   ELSE
+      tinfo := tinfoFreeList ;
+      tinfoFreeList := tinfoFreeList^.next
+   END ;
+   RETURN tinfo
+END newtInfo ;
+
+
+(*
+   collapseString - if the string, a, is "" then return NIL otherwise create
+                    and return a dynamic string.
+*)
+
+PROCEDURE collapseString (a: ARRAY OF CHAR) : String ;
+BEGIN
+   IF StrEqual (a, "")
+   THEN
+      RETURN NIL
+   ELSE
+      RETURN InitString (a)
+   END
+END collapseString ;
+
+
+(*
+   AssignmentTypeCompatible - returns TRUE if the des and the expr are assignment compatible.
+*)
+
+PROCEDURE AssignmentTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+                                    des, expr: CARDINAL) : BOOLEAN ;
+VAR
+   tinfo: tInfo ;
+BEGIN
+   tinfo := newtInfo () ;
+   tinfo^.format := collapseString (format) ;
+   tinfo^.token := token ;
+   tinfo^.kind := assignment ;
+   tinfo^.actual := NulSym ;
+   tinfo^.formal := NulSym ;
+   tinfo^.procedure := NulSym ;
+   tinfo^.nth := 0 ;
+   tinfo^.isvar := FALSE ;
+   tinfo^.error := NIL ;
+   tinfo^.left := des ;
+   tinfo^.right := expr ;
+   tinfo^.checkFunc := determineCompatible ;
+   tinfo^.visited := InitIndex (1) ;
+   tinfo^.resolved := InitIndex (1) ;
+   tinfo^.unresolved := InitIndex (1) ;
+   include (tinfo^.unresolved, des, expr, unknown) ;
+   tinfo^.strict := FALSE ;
+   tinfo^.isin := FALSE ;
+   IF doCheck (tinfo)
+   THEN
+      deconstruct (tinfo) ;
+      RETURN TRUE
+   ELSE
+      deconstruct (tinfo) ;
+      RETURN FALSE
+   END
+END AssignmentTypeCompatible ;
+
+
+(*
+   ParameterTypeCompatible - returns TRUE if the nth procedure parameter formal
+                             is compatible with actual.
+*)
+
+PROCEDURE ParameterTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+                                   procedure, formal, actual, nth: CARDINAL;
+                                   isvar: BOOLEAN) : BOOLEAN ;
+VAR
+   formalT, actualT: CARDINAL ;
+   tinfo           : tInfo ;
+BEGIN
+   tinfo := newtInfo () ;
+   formalT := GetSType (formal) ;
+   actualT := GetSType (actual) ;
+   tinfo^.format := collapseString (format) ;
+   tinfo^.token := token ;
+   tinfo^.kind := parameter ;
+   tinfo^.actual := actual ;
+   tinfo^.formal := formal ;
+   tinfo^.procedure := procedure ;
+   tinfo^.nth := nth ;
+   tinfo^.isvar := isvar ;
+   tinfo^.error := NIL ;
+   tinfo^.left := formalT ;
+   tinfo^.right := actualT ;
+   tinfo^.checkFunc := determineCompatible ;
+   tinfo^.visited := InitIndex (1) ;
+   tinfo^.resolved := InitIndex (1) ;
+   tinfo^.unresolved := InitIndex (1) ;
+   tinfo^.strict := FALSE ;
+   tinfo^.isin := FALSE ;
+   include (tinfo^.unresolved, actual, formal, unknown) ;
+   IF doCheck (tinfo)
+   THEN
+      deconstruct (tinfo) ;
+      RETURN TRUE
+   ELSE
+      deconstruct (tinfo) ;
+      RETURN FALSE
+   END
+END ParameterTypeCompatible ;
+
+
+(*
+   doExpressionTypeCompatible -
+*)
+
+PROCEDURE doExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+                                      left, right: CARDINAL;
+                                      strict: BOOLEAN) : BOOLEAN ;
+VAR
+   tinfo: tInfo ;
+BEGIN
+   tinfo := newtInfo () ;
+   tinfo^.format := collapseString (format) ;
+   tinfo^.token := token ;
+   tinfo^.kind := expression ;
+   tinfo^.actual := NulSym ;
+   tinfo^.formal := NulSym ;
+   tinfo^.procedure := NulSym ;
+   tinfo^.nth := 0 ;
+   tinfo^.isvar := FALSE ;
+   tinfo^.error := NIL ;
+   tinfo^.left := left ;
+   tinfo^.right := right ;
+   tinfo^.checkFunc := determineCompatible ;
+   tinfo^.visited := InitIndex (1) ;
+   tinfo^.resolved := InitIndex (1) ;
+   tinfo^.unresolved := InitIndex (1) ;
+   tinfo^.strict := strict ;
+   tinfo^.isin := FALSE ;
+   include (tinfo^.unresolved, left, right, unknown) ;
+   IF doCheck (tinfo)
+   THEN
+      deconstruct (tinfo) ;
+      RETURN TRUE
+   ELSE
+      deconstruct (tinfo) ;
+      RETURN FALSE
+   END
+END doExpressionTypeCompatible ;
+
+
+(*
+   ExpressionTypeCompatible - returns TRUE if the expressions, left and right,
+                              are expression compatible.
+*)
+
+PROCEDURE ExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR;
+                                    left, right: CARDINAL;
+                                    strict, isin: BOOLEAN) : BOOLEAN ;
+BEGIN
+   IF (left#NulSym) AND (right#NulSym)
+   THEN
+      IF isin
+      THEN
+         IF IsConst (right) OR IsVar (right)
+         THEN
+            right := GetSType (right)
+         END ;
+         IF IsSet (right)
+         THEN
+            right := GetSType (right)
+         END
+      END
+   END ;
+   RETURN doExpressionTypeCompatible (token, format, left, right, strict)
+END ExpressionTypeCompatible ;
+
+
+(*
+   init - initialise all global data structures for this module.
+*)
+
+PROCEDURE init ;
+BEGIN
+   pairFreeList  := NIL ;
+   tinfoFreeList := NIL ;
+   errors        := InitIndex (1)
+END init ;
+
+
+BEGIN
+   init
+END M2Check.
diff --git a/gcc/m2/gm2-compiler/M2Code.def b/gcc/m2/gm2-compiler/M2Code.def
new file mode 100644
index 00000000000..caf0cf5898e
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Code.def
@@ -0,0 +1,54 @@
+(* M2Code.def coordinate the activity of the front end.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Code ;
+
+(*
+   Title      : M2Code
+   Author     : Gaius Mulley
+   Date       : 6/8/87
+   System     : UNIX (GNU Modula-2)
+   Description: M2Code provides a module which coordinates the activity of the front
+                end optimization routines and the gcc tree generation.
+*)
+
+FROM SYSTEM IMPORT WORD ;
+EXPORT QUALIFIED Code, CodeBlock ;
+
+
+(*
+   Code - calls procedures to generates trees from the quadruples.
+          All front end quadruple optimization is performed via this call.
+*)
+
+PROCEDURE Code ;
+
+
+(*
+   CodeBlock - generates all code for this block and also declares all types
+               and procedures for this block. It will also optimize quadruples
+               within this scope.
+*)
+
+PROCEDURE CodeBlock (scope: WORD) ;
+
+
+END M2Code.
diff --git a/gcc/m2/gm2-compiler/M2Code.mod b/gcc/m2/gm2-compiler/M2Code.mod
new file mode 100644
index 00000000000..1d0c3304d7f
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Code.mod
@@ -0,0 +1,528 @@
+(* M2Code.mod coordinate the activity of the front end.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Code ;
+
+
+FROM SYSTEM IMPORT WORD ;
+FROM M2Options IMPORT Statistics, DisplayQuadruples, OptimizeUncalledProcedures,
+                      (* OptimizeDynamic, *) OptimizeCommonSubExpressions,
+                      StyleChecking, Optimizing, WholeProgram ;
+
+FROM M2Error IMPORT InternalError ;
+FROM M2Students IMPORT StudentVariableCheck ;
+
+FROM SymbolTable IMPORT GetMainModule, IsProcedure,
+                        IsModuleWithinProcedure,
+                        CheckHiddenTypeAreAddress, IsModule, IsDefImp,
+			DebugLineNumbers,
+                        ForeachProcedureDo,
+                        ForeachInnerModuleDo, GetSymName ;
+
+FROM M2Printf IMPORT printf2, printf1, printf0 ;
+FROM NameKey IMPORT Name ;
+FROM M2Batch IMPORT ForeachSourceModuleDo ;
+
+FROM M2Quads IMPORT CountQuads, GetFirstQuad, DisplayQuadList, DisplayQuadRange,
+                    BackPatchSubrangesAndOptParam, VariableAnalysis,
+                    LoopAnalysis, ForLoopAnalysis, GetQuad, QuadOperator ;
+
+FROM M2Pass IMPORT SetPassToNoPass, SetPassToCodeGeneration ;
+
+FROM M2BasicBlock IMPORT BasicBlock,
+                         InitBasicBlocks, InitBasicBlocksFromRange,
+			 KillBasicBlocks, FreeBasicBlocks,
+                         ForeachBasicBlockDo ;
+
+FROM M2Optimize IMPORT FoldBranches, RemoveProcedures ;
+FROM M2GenGCC IMPORT ConvertQuadsToTree ;
+
+FROM M2GCCDeclare IMPORT FoldConstants, StartDeclareScope,
+                         DeclareProcedure, InitDeclarations,
+                         DeclareModuleVariables, MarkExported ;
+
+FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock, ForeachScopeBlockDo ;
+FROM m2top IMPORT StartGlobalContext, EndGlobalContext, SetFlagUnitAtATime ;
+FROM M2Error IMPORT FlushErrors, FlushWarnings ;
+FROM M2Swig IMPORT GenerateSwigFile ;
+FROM m2flex IMPORT GetTotalLines ;
+FROM FIO IMPORT FlushBuffer, StdOut ;
+FROM M2Quiet IMPORT qprintf0 ;
+FROM M2SSA IMPORT DiscoverSSA ;
+
+
+CONST
+   MaxOptimTimes = 10 ;   (* upper limit of no of times we run through all optimization *)
+   Debugging     = TRUE ;
+
+
+VAR
+   Total,
+   Count,
+   OptimTimes,
+   DeltaProc,
+   Proc,
+   DeltaConst,
+   Const,
+   DeltaJump,
+   Jump,
+   DeltaBasicB,
+   BasicB     : CARDINAL ;
+
+
+(*
+   Percent - calculates the percentage from numerator and divisor
+*)
+
+PROCEDURE Percent (numerator, divisor: CARDINAL) ;
+VAR
+   value: CARDINAL ;
+BEGIN
+   printf0 ('  (') ;
+   IF divisor=0
+   THEN
+      printf0 ('overflow error')
+   ELSE
+      value := numerator*100 DIV divisor ;
+      printf1 ('%3d', value)
+   END ;
+   printf0 ('\%)')
+END Percent ;
+
+
+(*
+   OptimizationAnalysis - displays some simple front end optimization statistics.
+*)
+
+PROCEDURE OptimizationAnalysis ;
+VAR
+   value: CARDINAL ;
+BEGIN
+   IF Statistics
+   THEN
+      Count := CountQuads() ;
+
+      printf1 ('M2 initial number of quadruples: %6d', Total) ;
+      Percent (Total, Total) ; printf0 ('\n');
+      printf1 ('M2 constant folding achieved   : %6d', Const) ;
+      Percent (Const, Total) ; printf0 ('\n');
+      printf1 ('M2 branch folding achieved     : %6d', Jump) ;
+      Percent (Jump, Total) ; printf0 ('\n');
+      value := Const+Jump+Proc ;
+      printf1 ('Front end optimization removed : %6d', value) ;
+      Percent (value, Total) ; printf0 ('\n') ;
+      printf1 ('Front end final                : %6d', Count) ;
+      Percent (Count, Total) ; printf0 ('\n') ;
+      Count := GetTotalLines () ;
+      printf1 ('Total source lines compiled    : %6d\n', Count) ;
+      FlushBuffer (StdOut)
+   END ;
+   IF DisplayQuadruples
+   THEN
+      printf0 ('after all front end optimization\n') ;
+      DisplayQuadList
+   END
+END OptimizationAnalysis ;
+
+
+(*
+   RemoveUnreachableCode -
+*)
+
+PROCEDURE RemoveUnreachableCode ;
+BEGIN
+   IF WholeProgram
+   THEN
+      ForeachSourceModuleDo(RemoveProcedures)
+   ELSE
+      RemoveProcedures(GetMainModule())
+   END
+END RemoveUnreachableCode ;
+
+
+(*
+   DoModuleDeclare - declare all constants, types, variables, procedures for the
+                     main module or all modules.
+*)
+
+PROCEDURE DoModuleDeclare ;
+BEGIN
+   IF WholeProgram
+   THEN
+      ForeachSourceModuleDo (StartDeclareScope)
+   ELSE
+      StartDeclareScope (GetMainModule ())
+   END
+END DoModuleDeclare ;
+
+
+(*
+   PrintModule -
+*)
+
+(*
+PROCEDURE PrintModule (sym: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   n := GetSymName (sym) ;
+   printf1 ('module %a\n', n)
+END PrintModule ;
+*)
+
+
+(*
+   DoCodeBlock - generate code for the main module or all modules.
+*)
+
+PROCEDURE DoCodeBlock ;
+BEGIN
+   IF WholeProgram
+   THEN
+      (* ForeachSourceModuleDo(PrintModule) ; *)
+      CodeBlock (GetMainModule ())
+   ELSE
+      CodeBlock (GetMainModule ())
+   END
+END DoCodeBlock ;
+
+
+(*
+   DetermineSubExpTemporaries -
+*)
+
+PROCEDURE DetermineSubExpTemporaries ;
+BEGIN
+   IF WholeProgram
+   THEN
+      ForeachSourceModuleDo (DiscoverSSA)
+   ELSE
+      DiscoverSSA (GetMainModule ())
+   END
+END DetermineSubExpTemporaries ;
+
+
+(*
+   Code - calls procedures to generates trees from the quadruples.
+          All front end quadruple optimization is performed via this call.
+*)
+
+PROCEDURE Code ;
+BEGIN
+   CheckHiddenTypeAreAddress ;
+   SetPassToNoPass ;
+   BackPatchSubrangesAndOptParam ;
+   Total := CountQuads () ;
+
+   ForLoopAnalysis ;   (* must be done before any optimization as the index variable increment quad might change *)
+
+   IF DisplayQuadruples
+   THEN
+      printf0 ('before any optimization\n') ;
+      DisplayQuadList
+   END ;
+
+   (* now is a suitable time to check for student errors as *)
+   (* we know all the front end symbols must be resolved.   *)
+
+   IF StyleChecking
+   THEN
+      StudentVariableCheck
+   END ;
+
+   SetPassToCodeGeneration ;
+   SetFlagUnitAtATime (Optimizing) ;
+   StartGlobalContext ;
+   InitDeclarations ;     (* default and fixed sized types are all declared from now on.  *)
+
+   RemoveUnreachableCode ;
+
+   IF DisplayQuadruples
+   THEN
+      printf0 ('after dead procedure elimination\n') ;
+      DisplayQuadList
+   END ;
+
+   DetermineSubExpTemporaries ;
+
+   IF DisplayQuadruples
+   THEN
+      printf0 ('after identifying simple subexpression temporaries\n') ;
+      DisplayQuadList
+   END ;
+
+   qprintf0 ('        symbols to gcc trees\n') ;
+   DoModuleDeclare ;
+
+   FlushWarnings ;
+   FlushErrors ;
+   qprintf0 ('        statements to gcc trees\n') ;
+   DoCodeBlock ;
+
+   MarkExported (GetMainModule ()) ;
+   GenerateSwigFile (GetMainModule ()) ;
+   DebugLineNumbers (GetMainModule ()) ;
+   qprintf0 ('        gcc trees given to the gcc backend\n') ;
+   EndGlobalContext ;
+
+   OptimizationAnalysis
+END Code ;
+
+
+(*
+   InitialDeclareAndCodeBlock - declares all objects within scope,
+*)
+
+PROCEDURE InitialDeclareAndOptimize (start, end: CARDINAL) ;
+BEGIN
+   Count := CountQuads() ;
+   FreeBasicBlocks(InitBasicBlocksFromRange(start, end)) ;
+   BasicB := Count - CountQuads() ;
+   Count := CountQuads() ;
+
+   FoldBranches(start, end) ;
+   Jump := Count - CountQuads() ;
+   Count := CountQuads()
+END InitialDeclareAndOptimize ;
+
+
+(*
+   DeclareAndCodeBlock - declares all objects within scope,
+*)
+
+PROCEDURE SecondDeclareAndOptimize (start, end: CARDINAL) ;
+BEGIN
+   REPEAT
+      FoldConstants(start, end) ;
+      DeltaConst := Count - CountQuads () ;
+      Count := CountQuads () ;
+
+      FreeBasicBlocks(InitBasicBlocksFromRange (start, end)) ;
+
+      DeltaBasicB := Count - CountQuads () ;
+      Count := CountQuads () ;
+
+      FreeBasicBlocks (InitBasicBlocksFromRange (start, end)) ;
+      FoldBranches(start, end) ;
+      DeltaJump := Count - CountQuads () ;
+      Count := CountQuads () ;
+
+      FreeBasicBlocks(InitBasicBlocksFromRange (start, end)) ;
+      INC (DeltaBasicB, Count - CountQuads ()) ;
+      Count := CountQuads () ;
+
+      (* now total the optimization components *)
+      INC (Proc, DeltaProc) ;
+      INC (Const, DeltaConst) ;
+      INC (Jump, DeltaJump) ;
+      INC (BasicB, DeltaBasicB)
+   UNTIL (OptimTimes>=MaxOptimTimes) OR
+         ((DeltaProc=0) AND (DeltaConst=0) AND (DeltaJump=0) AND (DeltaBasicB=0)) ;
+
+   IF (DeltaProc#0) OR (DeltaConst#0) OR (DeltaJump#0) OR (DeltaBasicB#0)
+   THEN
+      printf0 ('optimization finished although more reduction may be possible (increase MaxOptimTimes)\n')
+   END
+END SecondDeclareAndOptimize ;
+
+
+(*
+   InitOptimizeVariables -
+*)
+
+PROCEDURE InitOptimizeVariables ;
+BEGIN
+   Count       := CountQuads () ;
+   OptimTimes  := 0 ;
+   DeltaProc   := 0 ;
+   DeltaConst  := 0 ;
+   DeltaJump   := 0 ;
+   DeltaBasicB := 0
+END InitOptimizeVariables ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   Proc   := 0 ;
+   Const  := 0 ;
+   Jump   := 0 ;
+   BasicB := 0
+END Init ;
+
+
+(*
+   BasicBlockVariableAnalysis -
+*)
+
+PROCEDURE BasicBlockVariableAnalysis (start, end: CARDINAL) ;
+VAR
+   bb: BasicBlock ;
+BEGIN
+   bb := InitBasicBlocksFromRange(start, end) ;
+   ForeachBasicBlockDo (bb, VariableAnalysis) ;
+   KillBasicBlocks (bb)
+END BasicBlockVariableAnalysis ;
+
+
+(*
+   DisplayQuadsInScope -
+*)
+
+(*
+PROCEDURE DisplayQuadsInScope (sb: ScopeBlock) ;
+BEGIN
+   printf0 ('Quads in scope\n') ;
+   ForeachScopeBlockDo (sb, DisplayQuadRange) ;
+   printf0 ('===============\n')
+END DisplayQuadsInScope ;
+*)
+
+
+(*
+   OptimizeScopeBlock -
+*)
+
+PROCEDURE OptimizeScopeBlock (sb: ScopeBlock) ;
+VAR
+   OptimTimes,
+   Previous,
+   Current   : CARDINAL ;
+BEGIN
+   InitOptimizeVariables ;
+   OptimTimes := 1 ;
+   Current := CountQuads () ;
+   ForeachScopeBlockDo (sb, InitialDeclareAndOptimize) ;
+   ForeachScopeBlockDo (sb, BasicBlockVariableAnalysis) ;
+   REPEAT
+      ForeachScopeBlockDo (sb, SecondDeclareAndOptimize) ;
+      Previous := Current ;
+      Current := CountQuads () ;
+      INC (OptimTimes)
+   UNTIL (OptimTimes=MaxOptimTimes) OR (Current=Previous) ;
+   ForeachScopeBlockDo (sb, LoopAnalysis)
+END OptimizeScopeBlock ;
+
+
+(*
+   DisplayQuadNumbers - the range, start..end.
+*)
+
+(*
+PROCEDURE DisplayQuadNumbers (start, end: CARDINAL) ;
+BEGIN
+   IF DisplayQuadruples
+   THEN
+      printf2 ('Coding [%d..%d]\n', start, end)
+   END
+END DisplayQuadNumbers ;
+*)
+
+
+(*
+   CodeProceduresWithinBlock - codes the procedures within the module scope.
+*)
+
+PROCEDURE CodeProceduresWithinBlock (scope: CARDINAL) ;
+BEGIN
+   ForeachProcedureDo (scope, CodeBlock)
+END CodeProceduresWithinBlock ;
+
+
+(*
+   CodeProcedures -
+*)
+
+PROCEDURE CodeProcedures (scope: CARDINAL) ;
+BEGIN
+   IF IsDefImp (scope) OR IsModule (scope)
+   THEN
+      ForeachProcedureDo (scope, CodeBlock)
+   END
+END CodeProcedures ;
+
+
+(*
+   CodeBlock - generates all code for this block and also declares
+               all types and procedures for this block. It will
+               also optimize quadruples within this scope.
+*)
+
+PROCEDURE CodeBlock (scope: WORD) ;
+VAR
+   sb: ScopeBlock ;
+   n : Name ;
+BEGIN
+   IF DisplayQuadruples
+   THEN
+      n := GetSymName (scope) ;
+      printf1 ('before coding block %a\n', n)
+   END ;
+   sb := InitScopeBlock (scope) ;
+   OptimizeScopeBlock (sb) ;
+   IF IsProcedure (scope)
+   THEN
+      IF DisplayQuadruples
+      THEN
+         n := GetSymName(scope) ;
+         printf1('before coding procedure %a\n', n) ;
+         ForeachScopeBlockDo(sb, DisplayQuadRange) ;
+         printf0('===============\n')
+      END ;
+      ForeachScopeBlockDo(sb, ConvertQuadsToTree)
+   ELSIF IsModuleWithinProcedure(scope)
+   THEN
+      IF DisplayQuadruples
+      THEN
+         n := GetSymName(scope) ;
+         printf1('before coding module %a within procedure\n', n) ;
+         ForeachScopeBlockDo(sb, DisplayQuadRange) ;
+         printf0('===============\n')
+      END ;
+      ForeachScopeBlockDo(sb, ConvertQuadsToTree) ;
+      ForeachProcedureDo(scope, CodeBlock)
+   ELSE
+      IF DisplayQuadruples
+      THEN
+         n := GetSymName(scope) ;
+         printf1('before coding module %a\n', n) ;
+         ForeachScopeBlockDo(sb, DisplayQuadRange) ;
+         printf0('===============\n')
+      END ;
+      ForeachScopeBlockDo(sb, ConvertQuadsToTree) ;
+      IF WholeProgram
+      THEN
+         ForeachSourceModuleDo(CodeProcedures)
+      ELSE
+         ForeachProcedureDo(scope, CodeBlock)
+      END ;
+      ForeachInnerModuleDo(scope, CodeProceduresWithinBlock)
+   END ;
+   KillScopeBlock(sb)
+END CodeBlock ;
+
+
+BEGIN
+   Init
+END M2Code.
diff --git a/gcc/m2/gm2-compiler/M2ColorString.def b/gcc/m2/gm2-compiler/M2ColorString.def
new file mode 100644
index 00000000000..00a8978aafd
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2ColorString.def
@@ -0,0 +1,142 @@
+(* M2ColorString.def provides procedures for obtaining GCC color strings.
+
+Copyright (C) 2019-2022 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/>.  *)
+
+DEFINITION MODULE M2ColorString ;  (*!m2pim+gm2*)
+
+(*
+    Title      : M2ColorString
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Sat Apr 13 19:21:03 2019
+    Revision   : $Version$
+    Description: provides procedures for obtaining GCC color strings.
+*)
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   SetEnableColor - sets the global variable to, b, and returns
+                    the previous value.
+*)
+
+PROCEDURE SetEnableColor (b: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   quoteOpen - adds an open quote to string, s.
+*)
+
+PROCEDURE quoteOpen (s: String) : String ;
+
+
+(*
+   quoteClose - adds a close quote to string, s.
+*)
+
+PROCEDURE quoteClose (s: String) : String ;
+
+
+(*
+   endColor - stops using color.
+*)
+
+PROCEDURE endColor (s: String) : String ;
+
+
+(*
+   quoteColor - adds quote color to string, s.
+*)
+
+PROCEDURE quoteColor (s: String) : String ;
+
+
+(*
+   errorColor - adds error color to string, s.
+*)
+
+PROCEDURE errorColor (s: String) : String ;
+
+
+(*
+   warningColor - adds warning color to string, s.
+*)
+
+PROCEDURE warningColor (s: String) : String ;
+
+
+(*
+   noteColor - adds note color to string, s.
+*)
+
+PROCEDURE noteColor (s: String) : String ;
+
+
+(*
+   locusColor - adds locus color to string, s.
+*)
+
+PROCEDURE locusColor (s: String) : String ;
+
+
+(*
+   insertColor - adds fixit-insert color to string, s.
+*)
+
+PROCEDURE insertColor (s: String) : String ;
+
+
+(*
+   deleteColor - adds fixit-insert color to string, s.
+*)
+
+PROCEDURE deleteColor (s: String) : String ;
+
+
+(*
+   filenameColor - adds filename color to string, s.
+*)
+
+PROCEDURE filenameColor (s: String) : String ;
+
+
+(*
+   typeColor - adds type color to string, s.
+*)
+
+PROCEDURE typeColor (s: String) : String ;
+
+
+(*
+   range1Color - adds type color to string, s.
+*)
+
+PROCEDURE range1Color (s: String) : String ;
+
+
+(*
+   range2Color - adds type color to string, s.
+*)
+
+PROCEDURE range2Color (s: String) : String ;
+
+
+END M2ColorString.
diff --git a/gcc/m2/gm2-compiler/M2ColorString.mod b/gcc/m2/gm2-compiler/M2ColorString.mod
new file mode 100644
index 00000000000..3f1203953cd
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2ColorString.mod
@@ -0,0 +1,218 @@
+(* M2ColorString.mod provides procedures for obtaining GCC color strings.
+
+Copyright (C) 2019-2022 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 M2ColorString ;
+
+FROM m2color IMPORT colorize_start, colorize_stop, open_quote, close_quote ;
+FROM DynamicStrings IMPORT InitString, InitStringCharStar,
+                           ConCat, ConCatChar, Mark, string, KillString,
+                           Dup, char, Length, Mult ;
+FROM StrLib IMPORT StrLen ;
+FROM libc IMPORT printf ;
+
+
+VAR
+   EnableColor: BOOLEAN ;
+
+
+(*
+   SetEnableColor - sets the global variable to, b, and returns
+                    the previous value.
+*)
+
+PROCEDURE SetEnableColor (b: BOOLEAN) : BOOLEAN ;
+VAR
+   previous: BOOLEAN ;
+BEGIN
+   previous := EnableColor ;
+   EnableColor := b ;
+   RETURN previous
+END SetEnableColor ;
+
+
+(*
+   append - appends color string, name, to the end of string, s,
+            and returns, s.
+*)
+
+PROCEDURE append (s: String; name: ARRAY OF CHAR) : String ;
+VAR
+   c: String ;
+BEGIN
+   c := InitStringCharStar (colorize_start (EnableColor, name, StrLen (name))) ;
+   s := ConCat (s, c) ;
+   c := KillString (c) ;
+   RETURN s
+END append ;
+
+
+(*
+   quoteOpen - adds an open quote to string, s.
+*)
+
+PROCEDURE quoteOpen (s: String) : String ;
+BEGIN
+   RETURN ConCat (append (s, "quote"), Mark (InitStringCharStar (open_quote ())))
+END quoteOpen ;
+
+
+(*
+   quoteClose - adds a close quote to string, s.
+*)
+
+PROCEDURE quoteClose (s: String) : String ;
+BEGIN
+   s := endColor (s) ;
+   s := append (s, "quote") ;
+   s := ConCat (s, Mark (InitStringCharStar (close_quote ()))) ;
+   s := endColor (s) ;
+   RETURN s
+END quoteClose ;
+
+
+(*
+   endColor - stops using color.
+*)
+
+PROCEDURE endColor (s: String) : String ;
+VAR
+   c: String ;
+BEGIN
+   c := InitStringCharStar (colorize_stop (EnableColor)) ;
+   s := ConCat (s, c) ;
+   c := KillString (c) ;
+   RETURN s
+END endColor ;
+
+
+(*
+   quoteColor - adds quote color to string, s.
+*)
+
+PROCEDURE quoteColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "quote")
+END quoteColor ;
+
+
+(*
+   errorColor - adds error color to string, s.
+*)
+
+PROCEDURE errorColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "error")
+END errorColor ;
+
+
+(*
+   warningColor - adds warning color to string, s.
+*)
+
+PROCEDURE warningColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "warning")
+END warningColor ;
+
+
+(*
+   noteColor - adds note color to string, s.
+*)
+
+PROCEDURE noteColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "note")
+END noteColor ;
+
+
+(*
+   locusColor - adds locus color to string, s.
+*)
+
+PROCEDURE locusColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "locus")
+END locusColor ;
+
+
+(*
+   insertColor - adds fixit-insert color to string, s.
+*)
+
+PROCEDURE insertColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "fixit-insert")
+END insertColor ;
+
+
+(*
+   deleteColor - adds fixit-insert color to string, s.
+*)
+
+PROCEDURE deleteColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "fixit-delete")
+END deleteColor ;
+
+
+(*
+   filenameColor - adds filename color to string, s.
+*)
+
+PROCEDURE filenameColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "diff-filename")
+END filenameColor ;
+
+
+(*
+   typeColor - adds type color to string, s.
+*)
+
+PROCEDURE typeColor (s: String) : String ;
+BEGIN
+   RETURN append (s, "type")
+END typeColor ;
+
+
+(*
+   range1Color - adds type color to string, s.
+*)
+
+PROCEDURE range1Color (s: String) : String ;
+BEGIN
+   RETURN append (s, "range1")
+END range1Color ;
+
+
+(*
+   range2Color - adds type color to string, s.
+*)
+
+PROCEDURE range2Color (s: String) : String ;
+BEGIN
+   RETURN append (s, "range2")
+END range2Color ;
+
+
+BEGIN
+   EnableColor := TRUE
+END M2ColorString.
diff --git a/gcc/m2/gm2-compiler/M2Comp.def b/gcc/m2/gm2-compiler/M2Comp.def
new file mode 100644
index 00000000000..e343ba03774
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Comp.def
@@ -0,0 +1,70 @@
+(* M2Comp.def continually calls the compiler for every source file.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Comp ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Comp
+   Date       : 29/5/87
+   Description: Continually calls the compiler for every source file
+                referenced in the Modula-2 compiler.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED CompilingDefinitionModule,
+                 CompilingImplementationModule,
+                 CompilingProgramModule,
+                 compile ;
+
+
+(*
+   compile - compile the filename.
+*)
+
+PROCEDURE compile (filename: ADDRESS) ;
+
+
+(*
+   CompilingDefinitionModule - returns true if the current module being
+                               compiled is a definition module.
+*)
+
+PROCEDURE CompilingDefinitionModule () : BOOLEAN ;
+
+
+(*
+   CompilingImplementationModule - returns true if the current module being
+                                   compiled is an implementation module.
+*)
+
+PROCEDURE CompilingImplementationModule () : BOOLEAN ;
+
+
+(*
+   CompilingProgramModule - returns true if the current module being
+                            compiled is a program module.
+*)
+
+PROCEDURE CompilingProgramModule () : BOOLEAN ;
+
+
+END M2Comp.
diff --git a/gcc/m2/gm2-compiler/M2Comp.mod b/gcc/m2/gm2-compiler/M2Comp.mod
new file mode 100644
index 00000000000..d9840f96305
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Comp.mod
@@ -0,0 +1,652 @@
+(* M2Comp.mod continually calls the compiler for every source file.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Comp ;
+
+
+FROM M2Options IMPORT Statistics, Quiet, WholeProgram, ExtendedOpaque, GenModuleList ;
+
+FROM M2Pass IMPORT SetPassToPass0, SetPassToPass1, SetPassToPass2, SetPassToPassC, SetPassToPass3,
+                   SetPassToNoPass, SetPassToPassHidden ;
+
+FROM M2Reserved IMPORT toktype ;
+FROM M2Search IMPORT FindSourceDefFile, FindSourceModFile ;
+FROM M2Code IMPORT Code ;
+FROM M2LexBuf IMPORT OpenSource, CloseSource, ResetForNewPass, currenttoken, GetToken, ReInitialize, currentstring, GetTokenNo ;
+FROM M2FileName IMPORT CalculateFileName ;
+FROM M2Preprocess IMPORT PreprocessModule ;
+FROM libc IMPORT exit ;
+
+FROM M2Error IMPORT ErrorStringAt, ErrorStringAt2, ErrorStringsAt2,
+                    WriteFormat0, FlushErrors, FlushWarnings, ResetErrorScope ;
+
+FROM M2MetaError IMPORT MetaErrorString1, MetaError0, MetaError1 ;
+FROM FormatStrings IMPORT Sprintf1 ;
+FROM P0SymBuild IMPORT P0Init, P1Init ;
+
+IMPORT m2flex ;
+IMPORT P0SyntaxCheck ;
+IMPORT P1Build ;
+IMPORT P2Build ;
+IMPORT PCBuild ;
+IMPORT P3Build ;
+IMPORT PHBuild ;
+IMPORT PCSymBuild ;
+
+FROM M2Batch IMPORT GetSource, GetModuleNo, GetDefinitionModuleFile, GetModuleFile,
+                    AssociateModule, AssociateDefinition, MakeImplementationSource,
+                    MakeProgramSource ;
+
+FROM SymbolTable IMPORT GetSymName, IsDefImp, NulSym,
+                        IsHiddenTypeDeclared, GetFirstUsed, GetMainModule, SetMainModule,
+                        ResolveConstructorTypes, SanityCheckConstants, IsDefinitionForC,
+                        IsBuiltinInModule, PutModLink, IsDefLink, IsModLink ;
+
+FROM FIO IMPORT StdErr ;
+FROM NameKey IMPORT Name, GetKey, KeyToCharStar, makekey ;
+FROM M2Printf IMPORT fprintf1 ;
+FROM M2Quiet IMPORT qprintf0, qprintf1, qprintf2 ;
+FROM DynamicStrings IMPORT String, InitString, KillString, InitStringCharStar, Dup, Mark, string ;
+
+CONST
+   Debugging = FALSE ;
+
+VAR
+   ModuleType : (None, Definition, Implementation, Program) ;
+
+
+(*
+   CompilingDefinitionModule - returns true if the current module being
+                               compiled is a definition module.
+*)
+
+PROCEDURE CompilingDefinitionModule() : BOOLEAN ;
+BEGIN
+   RETURN( ModuleType=Definition )
+END CompilingDefinitionModule ;
+
+
+(*
+   CompilingImplementationModule - returns true if the current module being
+                                   compiled is an implementation module.
+*)
+
+PROCEDURE CompilingImplementationModule() : BOOLEAN ;
+BEGIN
+   RETURN( ModuleType=Implementation )
+END CompilingImplementationModule ;
+
+
+(*
+   CompilingProgramModule - returns true if the current module being
+                            compiled is a program module.
+*)
+
+PROCEDURE CompilingProgramModule() : BOOLEAN ;
+BEGIN
+   RETURN( ModuleType=Program )
+END CompilingProgramModule ;
+
+
+(*
+   NeedToParseImplementation -
+*)
+
+PROCEDURE NeedToParseImplementation (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN (IsDefImp(sym) AND IsHiddenTypeDeclared(sym) AND ExtendedOpaque) OR
+          (IsDefImp(sym) AND IsBuiltinInModule(sym)) OR
+          (WholeProgram AND (NOT IsDefinitionForC(sym)))
+END NeedToParseImplementation ;
+
+
+(*
+   Compile - compile file, s, using a 5 pass technique.
+*)
+
+PROCEDURE Compile (s: String) ;
+BEGIN
+   DoPass0(s) ;
+   FlushWarnings ; FlushErrors ;
+   ResetForNewPass ; ResetErrorScope ;
+   qprintf0('Pass 1: scopes, enumerated types, imports and exports\n') ;
+   DoPass1 ;
+   FlushWarnings ; FlushErrors ;
+   qprintf0('Pass 2: constants and types\n') ;
+   ResetForNewPass ; ResetErrorScope ;
+   DoPass2 ;
+   FlushWarnings ; FlushErrors ;
+   qprintf0('Pass C: aggregate constants\n') ;
+   ResetForNewPass ; ResetErrorScope ;
+   DoPassC ;
+   FlushWarnings ; FlushErrors ;
+   qprintf0('Pass 3: quadruple generation\n') ;
+   ResetForNewPass ; ResetErrorScope ;
+   DoPass3 ;
+   FlushWarnings ; FlushErrors ;
+   qprintf0('Pass 4: gcc tree generation\n') ;
+   Code ;
+   FlushWarnings ; FlushErrors
+END Compile ;
+
+
+(*
+   compile - compile the filename.
+*)
+
+PROCEDURE compile (filename: ADDRESS) ;
+VAR
+   f: String ;
+BEGIN
+   f := InitStringCharStar(filename) ;
+   Compile(f) ;
+   f := KillString(f) ;
+END compile ;
+
+
+(*
+   ExamineCompilationUnit - opens the source file to obtain the module name and kind of module.
+*)
+
+PROCEDURE ExamineCompilationUnit (VAR name: ADDRESS; VAR isdefimp: BOOLEAN) ;
+BEGIN
+   isdefimp := FALSE ;   (* default to program module *)
+   (* stop if we see eof, ';' or '[' *)
+   WHILE (currenttoken#eoftok) AND (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO
+      IF (currenttoken=implementationtok) OR (currenttoken=definitiontok)
+      THEN
+         isdefimp := TRUE ;
+         GetToken
+      END ;
+      IF currenttoken=identtok
+      THEN
+         name := currentstring ;
+         RETURN
+      END ;
+      GetToken
+   END ;
+   m2flex.M2Error(string(InitString('failed to find module name'))) ;
+   exit(1)
+END ExamineCompilationUnit ;
+
+
+(*
+   PeepInto - peeps into source, s, and initializes a definition/implementation or
+              program module accordingly.
+*)
+
+PROCEDURE PeepInto (s: String) ;
+VAR
+   name    : ADDRESS ;
+   isdefimp: BOOLEAN ;
+BEGIN
+   IF OpenSource(PreprocessModule(s))
+   THEN
+      ExamineCompilationUnit(name, isdefimp) ;
+      IF isdefimp
+      THEN
+         SetMainModule(MakeImplementationSource(GetTokenNo(), makekey(name)))
+      ELSE
+         SetMainModule(MakeProgramSource(GetTokenNo(), makekey(name)))
+      END ;
+      CloseSource ;
+      ReInitialize
+   ELSE
+      fprintf1(StdErr, 'failed to open %s\n', s) ;
+      exit(1)
+   END
+END PeepInto ;
+
+
+(*
+   DoPass0 -
+*)
+
+PROCEDURE DoPass0 (s: String) ;
+VAR
+   Main,
+   Sym     : CARDINAL ;
+   i       : CARDINAL ;
+   SymName,
+   FileName: String ;
+BEGIN
+   P0Init ;
+   SetPassToPass0 ;
+   PeepInto(s) ;
+   Main := GetMainModule() ;
+   i := 1 ;
+   Sym := GetModuleNo(i) ;
+   qprintf1('Compiling: %s\n', s) ;
+   qprintf0('Pass 0: lexical analysis, parsing, modules and associated filenames\n') ;
+   WHILE Sym#NulSym DO
+      SymName := InitStringCharStar(KeyToCharStar(GetSymName(Sym))) ;
+      IF IsDefImp(Sym)
+      THEN
+         IF FindSourceDefFile(SymName, FileName)
+         THEN
+            ModuleType := Definition ;
+            IF OpenSource(AssociateDefinition(PreprocessModule(FileName), Sym))
+            THEN
+               IF NOT P0SyntaxCheck.CompilationUnit()
+               THEN
+                  WriteFormat0('compilation failed') ;
+                  CloseSource ;
+                  RETURN
+               END ;
+               qprintf2 ('   Module %-20s : %s', SymName, FileName) ;
+               IF IsDefinitionForC (Sym)
+               THEN
+                  qprintf0 (' (for C)')
+               END ;
+               IF IsDefLink (Sym)
+               THEN
+                  qprintf0 (' (linking)')
+               END ;
+               qprintf0 ('\n') ;
+               CloseSource
+            ELSE
+               (* Unrecoverable error.  *)
+               MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUAF%s} containing module {%%1a} cannot be found'),
+                                           FileName), Sym)
+            END
+         ELSE
+            (* Unrecoverable error.  *)
+            MetaError1 ('the file containing the definition module {%1EMAa} cannot be found', Sym)
+         END ;
+         ModuleType := Implementation
+      ELSE
+         ModuleType := Program
+      END ;
+      IF (Main=Sym) OR NeedToParseImplementation(Sym)
+      THEN
+         (* only need to read implementation module if hidden types are declared or it is the main module *)
+         IF Main=Sym
+         THEN
+            FileName := Dup(s)
+         ELSE
+            IF FindSourceModFile (SymName, FileName)
+            THEN
+            END
+         END ;
+         IF FileName#NIL
+         THEN
+            IF OpenSource (AssociateModule (PreprocessModule (FileName), Sym))
+            THEN
+               IF NOT P0SyntaxCheck.CompilationUnit()
+               THEN
+                  WriteFormat0 ('compilation failed') ;
+                  CloseSource ;
+                  RETURN
+               END ;
+               qprintf2 ('   Module %-20s : %s', SymName, FileName) ;
+               IF IsModLink (Sym)
+               THEN
+                  qprintf0 (' (linking)')
+               END ;
+               qprintf0 ('\n') ;
+               CloseSource
+            ELSE
+               (* It is quite legitimate to implement a module in C (and pretend it was a M2
+                  implementation) providing that it is not the main program module and the
+                  definition module do not declare a hidden type when -fextended-opaque
+                  is used.  *)
+               IF (NOT WholeProgram) OR (Sym=Main) OR IsHiddenTypeDeclared(Sym)
+               THEN
+                  (* Unrecoverable error.  *)
+                  MetaErrorString1 (Sprintf1 (InitString ('file {%%1EUAF%s} containing module {%%1a} cannot be found'),
+                                              FileName), Sym) ;
+               END
+            END
+         END
+      ELSIF GenModuleList
+      THEN
+         IF NOT IsDefinitionForC (Sym)
+         THEN
+            (* The implementation is only useful if -fgen-module-list= is
+               used and we do not insist upon it.  *)
+            IF FindSourceModFile (SymName, FileName)
+            THEN
+               qprintf2 ('   Module %-20s : %s (linking)\n', SymName, FileName) ;
+               IF OpenSource (AssociateModule (PreprocessModule (FileName), Sym))
+               THEN
+                  PutModLink (Sym, TRUE) ;   (* This source is only used to determine link time info.  *)
+                  IF NOT P0SyntaxCheck.CompilationUnit ()
+                  THEN
+                     WriteFormat0 ('compilation failed') ;
+                     CloseSource ;
+                     RETURN
+                  END ;
+                  CloseSource
+               END
+            END
+         END
+      END ;
+      SymName := KillString (SymName) ;
+      FileName := KillString (FileName) ;
+      INC (i) ;
+      Sym := GetModuleNo (i)
+   END ;
+   SetPassToNoPass
+END DoPass0 ;
+
+
+(*
+   DoPass1 - parses the sources of all modules necessary to compile
+             the required module, Main.
+*)
+
+PROCEDURE DoPass1 ;
+VAR
+   name    : Name ;
+   Sym     : CARDINAL ;
+   i       : CARDINAL ;
+   FileName: String ;
+BEGIN
+   P1Init ;
+   SetPassToPass1 ;
+   i := 1 ;
+   Sym := GetModuleNo(i) ;
+   WHILE Sym#NulSym DO
+      FileName := GetDefinitionModuleFile(Sym) ;
+      IF FileName#NIL
+      THEN
+         IF Debugging
+         THEN
+            name := GetSymName(Sym) ;
+            qprintf1('   Module %a\n', name)
+         END ;
+         IF OpenSource(FileName)
+         THEN
+            ModuleType := Definition ;
+            IF NOT P1Build.CompilationUnit()
+            THEN
+               MetaError0('compilation failed') ;
+               CloseSource ;
+               RETURN
+            END ;
+            CloseSource
+         ELSE
+            fprintf1(StdErr, 'failed to open %s\n', FileName) ;
+            exit(1)
+         END ;
+         ModuleType := Implementation
+      ELSE
+         ModuleType := Program
+      END ;
+      FileName := GetModuleFile(Sym) ;
+      IF FileName#NIL
+      THEN
+         IF Debugging
+         THEN
+            name := GetSymName(Sym) ;
+            qprintf1('   Module %a\n', name)
+         END ;
+         IF OpenSource(FileName)
+         THEN
+            IF NOT P1Build.CompilationUnit()
+            THEN
+               MetaError0('compilation failed') ;
+               CloseSource ;
+               RETURN
+            END ;
+            CloseSource
+         ELSE
+            fprintf1(StdErr, 'failed to open %s\n', FileName) ;
+            exit(1)
+         END
+      END ;
+      INC(i) ;
+      Sym := GetModuleNo(i)
+   END ;
+   SetPassToNoPass
+END DoPass1 ;
+
+
+(*
+   DoPass2 - parses the sources of all modules necessary to compile
+             the required module, Main.
+*)
+
+PROCEDURE DoPass2 ;
+VAR
+   name    : Name ;
+   Sym     : CARDINAL ;
+   i       : CARDINAL ;
+   FileName: String ;
+BEGIN
+   SetPassToPass2 ;
+   i := 1 ;
+   Sym := GetModuleNo(i) ;
+   WHILE Sym#NulSym DO
+      FileName := GetDefinitionModuleFile(Sym) ;
+      IF FileName#NIL
+      THEN
+         IF Debugging
+         THEN
+            name := GetSymName(Sym) ;
+            qprintf1('   Module %a\n', name)
+         END ;
+         IF OpenSource(FileName)
+         THEN
+            ModuleType := Definition ;
+            IF NOT P2Build.CompilationUnit()
+            THEN
+               MetaError0('compilation failed') ;
+               CloseSource ;
+               RETURN
+            END ;
+            CloseSource
+         ELSE
+            fprintf1(StdErr, 'failed to open %s\n', FileName) ;
+            exit(1)
+         END ;
+         ModuleType := Implementation
+      ELSE
+         ModuleType := Program
+      END ;
+      FileName := GetModuleFile(Sym) ;
+      IF FileName#NIL
+      THEN
+         IF Debugging
+         THEN
+            name := GetSymName(Sym) ;
+            qprintf1('   Module %a\n', name)
+         END ;
+         IF OpenSource(FileName)
+         THEN
+            IF NOT P2Build.CompilationUnit()
+            THEN
+               MetaError0('compilation failed') ;
+               CloseSource ;
+               RETURN
+            END ;
+            CloseSource
+         ELSE
+            fprintf1(StdErr, 'failed to open %s\n', FileName) ;
+            exit(1)
+         END
+      END ;
+      INC(i) ;
+      Sym := GetModuleNo(i)
+   END ;
+   SetPassToNoPass
+END DoPass2 ;
+
+
+(*
+   DoPassC - parses the sources of all modules necessary to compile
+             the required module, Main.
+*)
+
+PROCEDURE DoPassC ;
+VAR
+   name    : Name ;
+   Sym     : CARDINAL ;
+   i       : CARDINAL ;
+   FileName: String ;
+BEGIN
+   SetPassToPassC ;
+   i := 1 ;
+   Sym := GetModuleNo(i) ;
+   WHILE Sym#NulSym DO
+      FileName := GetDefinitionModuleFile(Sym) ;
+      IF FileName#NIL
+      THEN
+         IF Debugging
+         THEN
+            name := GetSymName(Sym) ;
+            qprintf1('   Module %a\n', name)
+         END ;
+         IF OpenSource(FileName)
+         THEN
+            ModuleType := Definition ;
+            IF NOT PCBuild.CompilationUnit()
+            THEN
+               MetaError0('compilation failed') ;
+               CloseSource ;
+               RETURN
+            END ;
+            CloseSource
+         ELSE
+            fprintf1(StdErr, 'failed to open %s\n', FileName) ;
+            exit(1)
+         END ;
+         ModuleType := Implementation
+      ELSE
+         ModuleType := Program
+      END ;
+      FileName := GetModuleFile(Sym) ;
+      IF FileName#NIL
+      THEN
+         IF Debugging
+         THEN
+            name := GetSymName(Sym) ;
+            qprintf1('   Module %a\n', name)
+         END ;
+         IF OpenSource(FileName)
+         THEN
+            IF NOT PCBuild.CompilationUnit()
+            THEN
+               MetaError0('compilation failed') ;
+               CloseSource ;
+               RETURN
+            END ;
+            CloseSource
+         ELSE
+            fprintf1(StdErr, 'failed to open %s\n', FileName) ;
+            exit(1)
+         END
+      END ;
+      INC(i) ;
+      Sym := GetModuleNo(i)
+   END ;
+   PCSymBuild.ResolveConstTypes ;
+   ResolveConstructorTypes ;
+   SanityCheckConstants ;
+   SetPassToNoPass
+END DoPassC ;
+
+
+(*
+   DoPass3 - parses the sources of all modules necessary to compile
+             the required module, Main.
+*)
+
+PROCEDURE DoPass3 ;
+VAR
+   Main,
+   Sym     : CARDINAL ;
+   i       : CARDINAL ;
+   FileName: String ;
+BEGIN
+   SetPassToPass3 ;
+   Main := GetMainModule() ;
+   i := 1 ;
+   Sym := GetModuleNo(i) ;
+   WHILE Sym#NulSym DO
+      FileName := GetDefinitionModuleFile(Sym) ;
+      IF FileName#NIL
+      THEN
+         IF OpenSource(FileName)
+         THEN
+            ModuleType := Definition ;
+            IF NOT P3Build.CompilationUnit()
+            THEN
+               MetaError0('compilation failed') ;
+               CloseSource ;
+               RETURN
+            END ;
+            CloseSource
+         ELSE
+            fprintf1(StdErr, 'failed to open %s\n', FileName) ;
+            exit(1)
+         END ;
+         ModuleType := Implementation
+      ELSE
+         ModuleType := Program
+      END ;
+      FileName := GetModuleFile(Sym) ;
+      IF FileName#NIL
+      THEN
+         IF OpenSource(FileName)
+         THEN
+            IF (Main=Sym) OR WholeProgram
+            THEN
+               IF NOT P3Build.CompilationUnit()
+               THEN
+                  MetaError0('compilation failed') ;
+                  CloseSource ;
+                  RETURN
+               END
+            ELSE
+               (*
+                  not the main module .mod therefore must be implementing
+                  a hidden type - we dont want to generate any
+                  StatementSequence quadrupes but we do want to build TYPEs
+                  and ConstExpressions.
+               *)
+               SetPassToNoPass ;
+               SetPassToPassHidden ;
+               IF NOT PHBuild.CompilationUnit()
+               THEN
+                  MetaError0('compilation failed') ;
+                  CloseSource ;
+                  RETURN
+               END ;
+               SetPassToNoPass ;
+               SetPassToPass3
+            END ;
+            CloseSource
+         ELSE
+            fprintf1(StdErr, 'failed to open %s\n', FileName) ;
+            exit(1)
+         END
+      END ;
+      INC(i) ;
+      Sym := GetModuleNo(i)
+   END ;
+   SetPassToNoPass
+END DoPass3 ;
+
+
+BEGIN
+   ModuleType := None
+END M2Comp.
diff --git a/gcc/m2/gm2-compiler/M2Const.def b/gcc/m2/gm2-compiler/M2Const.def
new file mode 100644
index 00000000000..7c186af9eeb
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Const.def
@@ -0,0 +1,39 @@
+(* M2Const.def maintain and resolve the types of constants.
+
+Copyright (C) 2010-2022 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/>.  *)
+
+DEFINITION MODULE M2Const ;
+
+(*
+    Title      : M2Const
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu Dec 23 15:02:59 2010
+    Revision   : $Version$
+    Description: provides a module which maintains and resolves the types of constants.
+*)
+
+EXPORT QUALIFIED constType ;
+
+TYPE
+   constType = (unknown, set, str, constructor, array, cast, boolean, ztype, rtype, ctype, procedure, char) ;
+
+
+END M2Const.
diff --git a/gcc/m2/gm2-compiler/M2Const.mod b/gcc/m2/gm2-compiler/M2Const.mod
new file mode 100644
index 00000000000..586b2f8ed0f
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Const.mod
@@ -0,0 +1,501 @@
+(* M2Const.mod maintain and resolve the types of constants.
+
+Copyright (C) 2010-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Const ;
+
+(*
+CONST
+   Debugging   = FALSE ;
+   DebugConsts = FALSE ;
+
+TYPE
+   constList = POINTER TO cList ;
+   cList     = RECORD
+                  constsym : CARDINAL ;
+                  constmeta: constType ;
+                  expr     : CARDINAL ;
+                  type     : CARDINAL ;
+                  next     : constList ;
+               END ;
+
+
+VAR
+   headOfConsts: constList ;
+
+
+PROCEDURE stop ; BEGIN END stop ;
+
+
+(*
+   addToConstList - add a constant, sym, to the head of the constants list.
+*)
+
+PROCEDURE addToConstList (sym: CARDINAL) ;
+VAR
+   h: constList ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      IF h^.constsym=sym
+      THEN
+         InternalError ('should never see the same symbol id declared twice')
+      END ;
+      h := h^.next
+   END ;
+   NEW(h) ;
+   WITH h^ DO
+      constsym  := sym ;
+      constmeta := unknown ;
+      expr      := NulSym ;
+      type      := NulSym ;
+      next      := headOfConsts
+   END ;
+   headOfConsts := h
+END addToConstList ;
+
+
+(*
+   FixupConstAsString - fixes up a constant, sym, which will have the string type.
+*)
+
+PROCEDURE FixupConstAsString (sym: CARDINAL) ;
+BEGIN
+   fixupConstMeta(sym, str)
+END FixupConstAsString ;
+
+
+(*
+   FixupConstType - fixes up a constant, sym, which will have the type, consttype.
+*)
+
+PROCEDURE FixupConstType (sym: CARDINAL; consttype: CARDINAL) ;
+VAR
+   h: constList ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      WITH h^ DO
+         IF constsym=sym
+         THEN
+            IF constmeta=str
+            THEN
+               InternalError ('cannot fix up a constant to have a type if it is already known as a string')
+            END ;
+            type := consttype ;
+            PutConst(sym, consttype) ;
+            RETURN
+         END
+      END ;
+      h := h^.next
+   END
+END FixupConstType ;
+
+
+(*
+   FixupProcedureType - creates a proctype from a procedure.
+*)
+
+PROCEDURE FixupProcedureType (p: CARDINAL) : CARDINAL ;
+VAR
+   par,
+   t   : CARDINAL ;
+   n, i: CARDINAL ;
+BEGIN
+   IF IsProcedure(p)
+   THEN
+      t := MakeProcType(CheckAnonymous(NulName)) ;
+      i := 1 ;
+      n := NoOfParam(p) ;
+      WHILE i<=n DO
+         par := GetParam(p, i) ;
+         IF IsParameterVar(par)
+         THEN
+            PutProcTypeVarParam(t, GetType(par), IsParameterUnbounded(par))
+         ELSE
+            PutProcTypeParam(t, GetType(par), IsParameterUnbounded(par))
+         END ;
+         INC(i)
+      END ;
+      IF GetType(p)#NulSym
+      THEN
+         PutFunction(t, GetType(p))
+      END ;
+      RETURN( t )
+   ELSE
+      InternalError ('expecting a procedure')
+   END ;
+   RETURN( NulSym )
+END FixupProcedureType ;
+
+
+(*
+   FixupConstProcedure - fixes up a constant, sym, which will be equivalent to e.
+*)
+
+PROCEDURE FixupConstProcedure (sym: CARDINAL; e: CARDINAL) ;
+VAR
+   h: constList ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      WITH h^ DO
+         IF constsym=sym
+         THEN
+            expr := e ;
+            type := FixupProcedureType(e) ;
+            PutConst(sym, type) ;
+            RETURN
+         END
+      END ;
+      h := h^.next
+   END
+END FixupConstProcedure ;
+
+
+(*
+   FixupConstExpr - fixes up a constant, sym, which will be equivalent to e.
+*)
+
+PROCEDURE FixupConstExpr (sym: CARDINAL; e: CARDINAL) ;
+VAR
+   h: constList ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      WITH h^ DO
+         IF constsym=sym
+         THEN
+            expr := e ;
+            RETURN
+         END
+      END ;
+      h := h^.next
+   END
+END FixupConstExpr ;
+
+
+(*
+   fixupConstMeta - fixes up symbol, sym, to have the, meta, constType.
+*)
+
+PROCEDURE FixupConstMeta (sym: CARDINAL; meta: constType) ;
+VAR
+   h: constList ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      WITH h^ DO
+         IF constsym=sym
+         THEN
+            constmeta := meta ;
+            RETURN
+         END
+      END ;
+      h := h^.next
+   END
+END FixupConstMeta ;
+
+
+(*
+   fixupConstCast -
+*)
+
+PROCEDURE fixupConstCast (sym: CARDINAL; castType: CARDINAL) ;
+VAR
+   h: constList ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      WITH h^ DO
+         IF constsym=sym
+         THEN
+            type := castType ;
+            RETURN
+         END
+      END ;
+      h := h^.next
+   END
+END fixupConstCast ;
+
+
+(*
+   findConstType -
+*)
+
+PROCEDURE findConstType (sym: CARDINAL) : CARDINAL ;
+VAR
+   h: constList ;
+   t: CARDINAL ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      WITH h^ DO
+         IF constsym=sym
+         THEN
+            t := GetType(sym) ;
+            IF t=NulSym
+            THEN
+               RETURN( NulSym )
+            ELSE
+               RETURN( t )
+            END
+         END
+      END ;
+      h := h^.next
+   END ;
+   RETURN( NulSym )
+END findConstType ;
+
+
+(*
+   findConstMeta -
+*)
+
+PROCEDURE findConstMeta (sym: CARDINAL) : constType ;
+VAR
+   h: constList ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      WITH h^ DO
+         IF constsym=sym
+         THEN
+            RETURN( constmeta )
+         END
+      END ;
+      h := h^.next
+   END ;
+   RETURN( unknown )
+END findConstMeta ;
+
+
+(*
+   ReportUnresolvedConstTypes - emits an error message for any unresolved constant type.
+*)
+
+PROCEDURE ReportUnresolvedConstTypes ;
+VAR
+   h: constList ;
+BEGIN
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      WITH h^ DO
+         IF (constmeta#unknown) AND (constmeta#str) AND (type=NulSym)
+         THEN
+            MetaError1('unable to resolve the type of the constant {%1Dad}', h^.constsym)
+         END
+      END ;
+      h := h^.next
+   END
+END ReportUnresolvedConstTypes ;
+
+
+(*
+   DebugMeta -
+*)
+
+PROCEDURE DebugMeta (h: constList) ;
+VAR
+   n: Name ;
+BEGIN
+   IF DebugConsts
+   THEN
+      WITH h^ DO
+         n := GetSymName(constsym) ;
+         printf1('constant %a ', n) ;
+         IF type=NulSym
+         THEN
+            printf0('type is unknown\n')
+         ELSE
+            printf0('type is known\n')
+         END
+      END
+   END
+END DebugMeta ;
+
+
+(*
+   constTypeResolved -
+*)
+
+PROCEDURE constTypeResolved (h: constList) : BOOLEAN ;
+BEGIN
+   RETURN( h^.type#NulSym )
+END constTypeResolved ;
+
+
+(*
+   constExprResolved -
+*)
+
+PROCEDURE constExprResolved (h: constList) : BOOLEAN ;
+BEGIN
+   RETURN( h^.expr#NulSym )
+END constExprResolved ;
+
+
+(*
+   findConstMetaExpr -
+*)
+
+PROCEDURE findConstMetaExpr (h: constList) : constType ;
+BEGIN
+   RETURN( h^.constmeta )
+END findConstMetaExpr ;
+
+
+(*
+   constResolveViaMeta -
+*)
+
+PROCEDURE constResolveViaMeta (h: constList) : BOOLEAN ;
+VAR
+   n: Name ;
+BEGIN
+   WITH h^ DO
+      IF findConstMetaExpr(h)=str
+      THEN
+         PutConstString(constsym, MakeKey('')) ;
+         IF DebugConsts
+         THEN
+            n := GetSymName(constsym) ;
+            printf1('resolved constant %a as a string\n', n)
+         END ;
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END constResolveViaMeta ;
+
+
+(*
+   constResolvedViaType -
+*)
+
+PROCEDURE constResolvedViaType (h: constList) : BOOLEAN ;
+VAR
+   n: Name ;
+BEGIN
+   WITH h^ DO
+      type := findConstType(expr) ;
+      IF type#NulSym
+      THEN
+         PutConst(constsym, type) ;
+         IF DebugConsts
+         THEN
+            n := GetSymName(constsym) ;
+            printf1('resolved type of constant %a\n', n)
+         END ;
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END constResolvedViaType ;
+
+
+(*
+   resolveConstType -
+*)
+
+PROCEDURE resolveConstType (h: constList) : BOOLEAN ;
+BEGIN
+   WITH h^ DO
+      IF (constmeta=unknown) OR (constmeta=str)
+      THEN
+         (* do nothing *)
+      ELSE
+         DebugMeta(h) ;
+         IF constTypeResolved(h)
+         THEN
+            (* nothing to do *)
+         ELSE
+            IF constExprResolved(h)
+            THEN
+               IF constResolveViaMeta(h)
+               THEN
+                  RETURN( TRUE )
+               ELSIF constResolvedViaType(h)
+               THEN
+                  RETURN( TRUE )
+               END
+            END
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END resolveConstType ;
+
+
+(*
+   ResolveConstTypes - resolves the types of all aggegrate constants.
+*)
+
+PROCEDURE ResolveConstTypes ;
+VAR
+   h      : constList ;
+   changed: BOOLEAN ;
+BEGIN
+   REPEAT
+      changed := FALSE ;
+      h := headOfConsts ;
+      WHILE h#NIL DO
+         changed := resolveConstType(h) ;
+         h := h^.next
+      END
+   UNTIL NOT changed ;
+   ReportUnresolvedConstTypes
+END ResolveConstTypes ;
+
+
+(*
+   SkipConst - returns the symbol which is a pseudonum of, sym.
+*)
+
+PROCEDURE SkipConst (sym: CARDINAL) : CARDINAL ;
+VAR
+   init: CARDINAL ;
+   h   : constList ;
+BEGIN
+   init := sym ;
+   h := headOfConsts ;
+   WHILE h#NIL DO
+      IF (h^.constsym=sym) AND (h^.expr#NulSym)
+      THEN
+         sym := h^.expr ;
+         IF sym=init
+         THEN
+            (* circular definition found *)
+            RETURN( sym )
+         END ;
+         h := headOfConsts
+      ELSE
+         h := h^.next
+      END
+   END ;
+   RETURN( sym )
+END SkipConst ;
+
+
+BEGIN
+   headOfConsts := NIL
+*)
+BEGIN
+END M2Const.
diff --git a/gcc/m2/gm2-compiler/M2Debug.def b/gcc/m2/gm2-compiler/M2Debug.def
new file mode 100644
index 00000000000..91c16507443
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Debug.def
@@ -0,0 +1,49 @@
+(* M2Debug.def simple debugging facilities in the Modula-2 compiler.
+
+Copyright (C) 2001-2022 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/>.  *)
+DEFINITION MODULE M2Debug ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Debug
+   Date       : 30/5/87
+   Description: Implements the Debugging facilities in the Modula-2 compiler.
+   Last update: 30/5/87
+*)
+
+EXPORT QUALIFIED Assert, WriteDebug ;
+
+
+(*
+   Assert - tests the boolean, q. If false then an error is reported
+            and the execution is HALTed.
+*)
+
+PROCEDURE Assert (q: BOOLEAN) ;
+
+
+(*
+   WriteDebug - only writes a string if the debugging mode is on.
+*)
+
+PROCEDURE WriteDebug (a: ARRAY OF CHAR) ;
+
+
+END M2Debug.
diff --git a/gcc/m2/gm2-compiler/M2Debug.mod b/gcc/m2/gm2-compiler/M2Debug.mod
new file mode 100644
index 00000000000..360f389336e
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Debug.mod
@@ -0,0 +1,57 @@
+(* M2Debug.mod simple debugging facilities in the Modula-2 compiler.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Debug ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM M2Error IMPORT InternalError ;
+FROM M2Options IMPORT CompilerDebugging ;
+
+
+(*
+   Assert - tests the boolean, q. If false then an error is reported
+            and the execution is HALTed.
+*)
+
+PROCEDURE Assert (q: BOOLEAN) ;
+BEGIN
+   IF NOT q
+   THEN
+      InternalError ('assert failed')
+   END
+END Assert ;
+
+
+(*
+   WriteDebug - only writes a string if the debugging mode is on.
+*)
+
+PROCEDURE WriteDebug (a: ARRAY OF CHAR) ;
+BEGIN
+   IF CompilerDebugging
+   THEN
+      WriteString(a) ; WriteLn
+   END
+END WriteDebug ;
+
+
+END M2Debug.
diff --git a/gcc/m2/gm2-compiler/M2DebugStack.def b/gcc/m2/gm2-compiler/M2DebugStack.def
new file mode 100644
index 00000000000..26c54e6e233
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2DebugStack.def
@@ -0,0 +1,51 @@
+(* M2DebugStack.def display parameter stack.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE M2DebugStack ;
+
+(*
+    Title      : M2DebugStack
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon Dec  5 16:19:43 2011
+    Revision   : $Version$
+    Description: provides a procedure which displays the
+                 compile time stack neatly and with annotation.
+*)
+
+FROM SYSTEM IMPORT WORD ;
+FROM DynamicStrings IMPORT String ;
+
+TYPE
+   ProcedureWord    = PROCEDURE (CARDINAL) : WORD ;
+   ProcedureString  = PROCEDURE (CARDINAL) : String ;
+
+
+(*
+   DebugStack - displays the stack.
+*)
+
+PROCEDURE DebugStack (amount: CARDINAL;
+                      opt, opf, opa, opd, oprw, optk: ProcedureWord;
+                      opanno: ProcedureString) ;
+
+
+END M2DebugStack.
diff --git a/gcc/m2/gm2-compiler/M2DebugStack.mod b/gcc/m2/gm2-compiler/M2DebugStack.mod
new file mode 100644
index 00000000000..4015cf77243
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2DebugStack.mod
@@ -0,0 +1,884 @@
+(* M2DebugStack.mod display parameter stack.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2DebugStack ;
+
+FROM DynamicStrings IMPORT InitString, KillString, Dup, Index, Slice, char,
+                           ConCat, ConCatChar, InitStringCharStar, Length, Mark ;
+
+FROM SymbolTable IMPORT IsConstLit, IsConstSet, IsConstructor, IsConst,
+                        IsArray, IsVar, IsEnumeration, IsFieldEnumeration,
+                        IsUnbounded, IsProcType, IsProcedure, IsPointer, IsParameter,
+                        IsParameterVar, IsType, IsRecord, IsRecordField, IsVarient,
+                        IsModule, IsDefImp, IsSet, IsSubrange, GetSymName, NulSym ;
+
+FROM StringConvert IMPORT CardinalToString ;
+FROM NameKey IMPORT Name, KeyToCharStar ;
+FROM FIO IMPORT File, StdOut ;
+FROM SFIO IMPORT WriteS ;
+FROM M2Error IMPORT InternalError ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ;
+
+CONST
+   Debugging = FALSE ;
+
+VAR
+   OperandTok,
+   OperandT,
+   OperandF,
+   OperandA,
+   OperandD,
+   OperandRW  : ProcedureWord ;
+   OperandAnno: ProcedureString ;
+
+
+(*
+   x - checks to see that a=b.
+*)
+
+PROCEDURE x (a, b: String) : String ;
+BEGIN
+   IF a#b
+   THEN
+      InternalError ('different string returned')
+   END ;
+   RETURN( a )
+END x ;
+
+
+(*
+   IsWhite - returns TRUE if, ch, is a space.
+*)
+
+PROCEDURE IsWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( ch=' ' )
+END IsWhite ;
+
+
+(*
+   ConCatWord - joins sentances, a, b, together.
+*)
+
+PROCEDURE ConCatWord (a, b: String) : String ;
+BEGIN
+   IF (Length(a)=1) AND (char(a, 0)='a')
+   THEN
+      a := x(a, ConCatChar(a, 'n'))
+   ELSIF (Length(a)>1) AND (char(a, -1)='a') AND IsWhite(char(a, -2))
+   THEN
+      a := x(a, ConCatChar(a, 'n'))
+   END ;
+   IF (Length(a)>0) AND (NOT IsWhite(char(a, -1)))
+   THEN
+      a := x(a, ConCatChar(a, ' '))
+   END ;
+   RETURN( x(a, ConCat(a, b)) )
+END ConCatWord ;
+
+
+(*
+   symDesc -
+*)
+
+PROCEDURE symDesc (sym: CARDINAL; o: String) : String ;
+BEGIN
+   IF sym = NulSym
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('NulSym'))) )
+   ELSIF IsConstLit(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('constant literal'))) )
+   ELSIF IsConstSet(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('constant set'))) )
+   ELSIF IsConstructor(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('constructor'))) )
+   ELSIF IsConst(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('constant'))) )
+   ELSIF IsArray(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('array'))) )
+   ELSIF IsVar(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('variable'))) )
+   ELSIF IsEnumeration(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('enumeration type'))) )
+   ELSIF IsFieldEnumeration(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('enumeration field'))) )
+   ELSIF IsUnbounded(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('unbounded parameter'))) )
+   ELSIF IsProcType(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('procedure type'))) )
+   ELSIF IsProcedure(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('procedure'))) )
+   ELSIF IsPointer(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('pointer'))) )
+   ELSIF IsParameter(sym)
+   THEN
+      IF IsParameterVar(sym)
+      THEN
+         RETURN( ConCatWord(o, Mark(InitString('var parameter'))) )
+      ELSE
+         RETURN( ConCatWord(o, Mark(InitString('parameter'))) )
+      END
+   ELSIF IsType(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('type'))) )
+   ELSIF IsRecord(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('record'))) )
+   ELSIF IsRecordField(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('record field'))) )
+   ELSIF IsVarient(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('varient record'))) )
+   ELSIF IsModule(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('module'))) )
+   ELSIF IsDefImp(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('definition or implementation module'))) )
+   ELSIF IsSet(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('set'))) )
+   ELSIF IsSubrange(sym)
+   THEN
+      RETURN( ConCatWord(o, Mark(InitString('subrange'))) )
+   ELSE
+      RETURN( o )
+   END
+END symDesc ;
+
+
+(*
+   Output - output string, s, to Stdout.  It also disposes of the string, s.
+*)
+
+PROCEDURE Output (s: String) ;
+BEGIN
+   s := WriteS(StdOut, s) ;
+   s := KillString(s)
+END Output ;
+
+
+(*
+   GetComment -
+*)
+
+PROCEDURE GetComment (s: String) : INTEGER ;
+VAR
+   c: INTEGER ;
+BEGIN
+   c := Index(s, '|', 0) ;
+   WHILE c>=0 DO
+      INC(c) ;
+      IF c>=VAL(INTEGER, Length(s))
+      THEN
+         RETURN -1
+      ELSIF char(s, c)='|'
+      THEN
+         RETURN c+1
+      END ;
+      c := Index(s, '|', c)
+   END ;
+   RETURN -1
+END GetComment ;
+
+
+(*
+   doName - concatenate namekey, o, to, p.
+*)
+
+PROCEDURE doName (p: String; o: WORD) : String ;
+BEGIN
+   RETURN ConCat(p, InitStringCharStar(KeyToCharStar(o))) ;
+END doName ;
+
+
+(*
+   doSymName - concatenate symbol, o, name to, p.
+*)
+
+PROCEDURE doSymName (p: String; o: WORD) : String ;
+BEGIN
+   RETURN ConCat(p, InitStringCharStar(KeyToCharStar(GetSymName(o)))) ;
+END doSymName ;
+
+
+(*
+   doNumber - convert, o, to a cardinal and increment the length, l,
+              by the number of characters required to represent, o.
+*)
+
+PROCEDURE doNumber (p: String; o: WORD) : String ;
+BEGIN
+   RETURN ConCat(p, CardinalToString(VAL(CARDINAL, o), 0, ' ', 10, TRUE))
+END doNumber ;
+
+
+(*
+   doSymbol - handles a symbol indicated by, o.
+*)
+
+PROCEDURE doSymbol (p: String; o: WORD) : String ;
+BEGIN
+   RETURN symDesc(o, p)
+END doSymbol ;
+
+
+(*
+   doOperand -
+*)
+
+PROCEDURE doOperand (p, s: String; VAR i: INTEGER; e: INTEGER; o: WORD) : String ;
+BEGIN
+   INC(i) ;
+   IF i<e
+   THEN
+      CASE char(s, i) OF
+
+      's':  (* symbol number *)
+            INC(i) ;
+            RETURN doSymbol(p, o) |
+      'd':  (* decimal number *)
+            INC(i) ;
+            RETURN doNumber(p, o) |
+      'a':  (* symbol name key *)
+            INC(i) ;
+            RETURN doSymName(p, o) |
+      'n':  (* ascii name key *)
+            INC(i) ;
+            RETURN doName(p, o)
+
+      ELSE
+         InternalError ("incorrect format specifier expecting one of 's', 'd' or 'a'")
+      END
+   END ;
+   RETURN p
+END doOperand ;
+
+
+(*
+   doPercent -
+*)
+
+PROCEDURE doPercent (o, s: String;
+                     VAR i: INTEGER; e: INTEGER; n: CARDINAL) : String ;
+BEGIN
+   INC(i) ;
+   IF i<e
+   THEN
+      CASE char(s, i) OF
+
+      '1':  RETURN doOperand(o, s, i, e, OperandT(n)) |
+      '2':  RETURN doOperand(o, s, i, e, OperandF(n)) |
+      '3':  RETURN doOperand(o, s, i, e, OperandTok(n))
+
+      ELSE
+         InternalError ('unrecognised format specifier - expecting 1, 2 or 3 after the %')
+      END
+   END ;
+   InternalError ('end of field found before format specifier - expecting 1, 2 or 3 after the %')
+END doPercent ;
+
+
+(*
+   doNameLength - increment, l, by the ascii length of string determined by, o.
+*)
+
+PROCEDURE doNameLength (VAR l: CARDINAL; o: WORD) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar(KeyToCharStar(o)) ;
+   INC(l, Length(s)) ;
+   s := KillString(s)
+END doNameLength ;
+
+
+(*
+   doSymNameLength - increment, l, by the ascii length of symbol, o.
+*)
+
+PROCEDURE doSymNameLength (VAR l: CARDINAL; o: WORD) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar(KeyToCharStar(GetSymName(o))) ;
+   INC(l, Length(s)) ;
+   s := KillString(s)
+END doSymNameLength ;
+
+
+(*
+   doNumberLength - convert, o, to a cardinal and increment the length, l,
+                    by the number of characters required to represent, o.
+*)
+
+PROCEDURE doNumberLength (VAR l: CARDINAL; o: WORD) ;
+VAR
+   s: String ;
+BEGIN
+   s := CardinalToString(VAL(CARDINAL, o), 0, ' ', 10, TRUE) ;
+   INC(l, Length(s)) ;
+   s := KillString(s)
+END doNumberLength ;
+
+
+(*
+   doSymbolLength - handles a symbol indicated by, o.
+*)
+
+PROCEDURE doSymbolLength (VAR l: CARDINAL; o: WORD) ;
+VAR
+   s: String ;
+BEGIN
+   s := symDesc(o, InitString('')) ;
+   INC(l, Length(s)) ;
+   s := KillString(s)
+END doSymbolLength ;
+
+
+(*
+   doOperandLength -
+*)
+
+PROCEDURE doOperandLength (s: String; VAR i: INTEGER; e: INTEGER; VAR l: CARDINAL; o: WORD) ;
+BEGIN
+   INC(i) ;
+   IF i<e
+   THEN
+      CASE char(s, i) OF
+
+      's':  (* symbol number *)
+            INC(i) ;
+            doSymbolLength(l, o) |
+      'd':  (* decimal number *)
+            INC(i) ;
+            doNumberLength(l, o) |
+      'a':  (* ascii name key *)
+            INC(i) ;
+            doSymNameLength(l, o) |
+      'n':  (* ascii name key *)
+            INC(i) ;
+            doNameLength(l, o)
+
+      ELSE
+         InternalError ("incorrect format specifier expecting one of 's', 'd' or 'a'")
+      END
+   END
+END doOperandLength ;
+
+
+(*
+   doPercentLength -
+*)
+
+PROCEDURE doPercentLength (s: String; VAR i: INTEGER; e: INTEGER;
+                           VAR l: CARDINAL; n: CARDINAL) ;
+BEGIN
+   INC(i) ;
+   IF i<e
+   THEN
+      CASE char(s, i) OF
+
+      '1':  doOperandLength(s, i, e, l, OperandT(n)) |
+      '2':  doOperandLength(s, i, e, l, OperandF(n)) |
+      '3':  doOperandLength(s, i, e, l, OperandTok(n)) |
+
+      ELSE
+         InternalError ('unrecognised format specifier - expecting 1, 2 or 3 after the %')
+      END
+   END
+END doPercentLength ;
+
+
+(*
+   doFieldLength - compute the string length given in annotation
+                   at position, n, on the stack between characters
+                   b and e.
+
+                   The string description between: b..e can contain any
+                   of these patterns:
+
+                   %a           ascii name key.
+                   %s           symbol number.
+                   %d           decimal cardinal number.
+                   |            indicates the next field.
+*)
+
+PROCEDURE doFieldLength (b, e: INTEGER; n: CARDINAL) : CARDINAL ;
+VAR
+   l: CARDINAL ;
+   i: INTEGER ;
+   s: String ;
+BEGIN
+   IF b=-1
+   THEN
+      RETURN( 0 )
+   END ;
+   s := OperandAnno(n) ;
+   IF e=-1
+   THEN
+      e := Length(s)
+   END ;
+   l := 0 ;
+   i := b ;
+   WHILE i<e DO
+      CASE char(s, i) OF
+
+      '|':  RETURN l |
+      '%':  doPercentLength(s, i, e, l, n) ;
+
+      ELSE
+         INC(l)
+      END ;
+      INC(i)
+   END ;
+   RETURN l
+END doFieldLength ;
+
+
+(*
+   stop -
+*)
+
+PROCEDURE stop ;
+BEGIN
+END stop ;
+
+
+(*
+   doMaxCard - returns the maximum of two CARDINALs.
+*)
+
+PROCEDURE doMaxCard (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF (a>100) OR (b>100)
+   THEN
+      stop
+   END ;
+   IF a>b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END doMaxCard ;
+
+
+(*
+   GetAnnotationFieldLength -
+*)
+
+PROCEDURE GetAnnotationFieldLength (n: CARDINAL; f: CARDINAL) : CARDINAL ;
+VAR
+   c, e: INTEGER ;
+BEGIN
+   c := GetComment(OperandAnno(n)) ;
+   IF c>0
+   THEN
+      IF Debugging
+      THEN
+         printf0('full anno is: ') ; Output(Dup(OperandAnno(n))) ; printf0('\n') ;
+         printf0('comment field is: ') ; Output(Slice(OperandAnno(n), c, 0)) ; printf0('\n')
+      END ;
+      e := Index(OperandAnno(n), '|', c) ;
+      IF f=0
+      THEN
+         RETURN doFieldLength(c, e, n)
+      ELSE
+         IF e>=0
+         THEN
+            INC(e)
+         END ;
+         RETURN doFieldLength(e, -1, n)
+      END
+   ELSE
+      RETURN 0
+   END
+END GetAnnotationFieldLength ;
+
+
+(*
+   GetAnnotationLength -
+*)
+
+PROCEDURE GetAnnotationLength (n: CARDINAL; f: CARDINAL) : CARDINAL ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   IF OperandAnno(n)=NIL
+   THEN
+      l := 0 ;
+      IF f=0
+      THEN
+         doNumberLength(l, OperandT(n))
+      ELSE
+         doNumberLength(l, OperandF(n))
+      END ;
+      RETURN l
+   ELSE
+      RETURN GetAnnotationFieldLength(n, f)
+   END
+END GetAnnotationLength ;
+
+
+(*
+   GetFieldLength - returns the number of characters used in field, f,
+                    at position, n, on the stack.
+*)
+
+PROCEDURE GetFieldLength (n: CARDINAL; f: CARDINAL) : CARDINAL ;
+VAR
+   c, b, e: INTEGER ;
+BEGIN
+   c := GetComment(OperandAnno(n)) ;
+   IF c>1
+   THEN
+      e := c-2
+   ELSE
+      e := Length(OperandAnno(n))
+   END ;
+   IF f=0
+   THEN
+      b := 0
+   ELSE
+      b := Index(OperandAnno(n), '|', 0) ;
+      IF b=-1
+      THEN
+         RETURN 0
+      ELSE
+         INC(b)
+      END
+   END ;
+   RETURN doFieldLength(b, e, n)
+END GetFieldLength ;
+
+
+(*
+   GetMaxFieldAnno - returns the maximum number of characters required
+                     by either the annotation or field, f, at position, n,
+                     on the stack.
+*)
+
+PROCEDURE GetMaxFieldAnno (n: CARDINAL; f: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN doMaxCard(GetAnnotationLength(n, f), GetFieldLength(n, f))
+END GetMaxFieldAnno ;
+
+
+(*
+   GetStackFieldLengths - assigns, tn, and, fn, with the
+                          maximum field width values.
+*)
+
+PROCEDURE GetStackFieldLengths (VAR tn, fn, tk: CARDINAL; amount: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   tn := 0 ;
+   fn := 0 ;
+   tk := 0 ;
+   WHILE i<=amount DO
+      tn := doMaxCard(tn, GetMaxFieldAnno(i, 0)) ;
+      fn := doMaxCard(fn, GetMaxFieldAnno(i, 1)) ;
+      tk := doMaxCard(tk, GetMaxFieldAnno(i, 2)) ;
+      INC(i)
+   END
+END GetStackFieldLengths ;
+
+
+(*
+   DisplayRow -
+*)
+
+PROCEDURE DisplayRow (tn, fn, tk: CARDINAL; initOrFinal: BOOLEAN) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   printf0('+-') ;
+   FOR i := 1 TO tn DO
+      printf0('-')
+   END ;
+   IF (fn=0) AND (tk=0)
+   THEN
+      IF initOrFinal
+      THEN
+         printf0('-+-')
+      ELSE
+         printf0('-|-')
+      END
+   ELSE
+      IF initOrFinal
+      THEN
+         printf0('-+-')
+      ELSE
+         printf0('-|-')
+      END ;
+      IF fn#0
+      THEN
+         FOR i := 1 TO fn DO
+            printf0('-')
+         END
+      END ;
+      IF initOrFinal
+      THEN
+         printf0('-+-')
+      ELSE
+         printf0('-|-')
+      END ;
+      IF tk#0
+      THEN
+         FOR i := 1 TO tk DO
+            printf0('-')
+         END ;
+         printf0('-+\n')
+      END
+   END
+END DisplayRow ;
+
+
+(*
+   SkipToField -
+*)
+
+PROCEDURE SkipToField (s: String; n: CARDINAL) : INTEGER ;
+VAR
+   i, h: INTEGER ;
+BEGIN
+   i := 0 ;
+   h := Length(s) ;
+   WHILE (n>0) AND (i<h) DO
+      IF Index(s, '|', i)>0
+      THEN
+         DEC(n) ;
+         IF (i<h) AND (char(s, i+1)='|')
+         THEN
+            (* comment seen, no field available *)
+            RETURN -1
+         END ;
+         i := Index(s, '|', i)
+      ELSE
+         RETURN -1
+      END ;
+      INC(i)
+   END ;
+   IF i=h
+   THEN
+      i := -1
+   END ;
+   RETURN i
+END SkipToField ;
+
+
+(*
+   Pad - padds out string, s, to paddedLength characters.
+*)
+
+PROCEDURE Pad (o: String; paddedLength: CARDINAL) : String ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := Length(o) ;
+   IF i<paddedLength
+   THEN
+      REPEAT
+         o := ConCatChar(o, ' ') ;
+         INC(i)
+      UNTIL i=paddedLength
+   END ;
+   RETURN o
+END Pad ;
+
+
+(*
+   doField - compute the string length given in annotation
+             at position, n, on the stack between characters
+             b and e.
+
+             The string description between: b..e can contain any
+             of these patterns:
+
+             %a           ascii name key.
+             %s           symbol number.
+             %d           decimal cardinal number.
+             |            indicates the next field.
+*)
+
+PROCEDURE doField (s: String; n: CARDINAL; f: CARDINAL; l: CARDINAL) : String ;
+VAR
+   h, i, j: INTEGER ;
+   o      : String ;
+BEGIN
+   h := Length(s) ;
+   i := SkipToField(s, f) ;
+   o := InitString('') ;
+   IF i>=0
+   THEN
+      j := SkipToField(s, f+1) ;
+      IF j=-1
+      THEN
+         j := h
+      END ;
+      WHILE i<h DO
+         CASE char(s, i) OF
+
+         '|':  i := h |
+         '%':  o := doPercent(o, s, i, h, n)
+
+         ELSE
+            o := ConCatChar(o, char(s, i)) ;
+            INC(i)
+         END
+      END
+   END ;
+   o := Pad(o, l) ;
+   RETURN o
+END doField ;
+
+
+(*
+   doAnnotation -
+*)
+
+PROCEDURE doAnnotation (s: String; n: CARDINAL;
+                        field: CARDINAL; width: CARDINAL) : String ;
+VAR
+   c    : INTEGER ;
+   cf, o: String ;
+BEGIN
+   c := GetComment(s) ;
+   IF c>=0
+   THEN
+      cf := Slice(s, c, 0) ;
+      o := doField(cf, n, field, width) ;
+      cf := KillString(cf) ;
+      RETURN o
+   ELSE
+      RETURN InitString('')
+   END
+END doAnnotation ;
+
+
+(*
+   DisplayFields -
+*)
+
+PROCEDURE DisplayFields (n: CARDINAL; tn, fn, tk: CARDINAL) ;
+VAR
+   s      : String ;
+   t, f, k: CARDINAL ;
+BEGIN
+   s := OperandAnno(n) ;
+   IF s=NIL
+   THEN
+      t := OperandT(n) ;
+      f := OperandF(n) ;
+      k := OperandTok(n) ;
+      printf0('| ') ;
+      Output(Pad(CardinalToString(VAL(CARDINAL, t), 0, ' ', 10, TRUE), tn)) ;
+      printf0(' | ') ;
+      Output(Pad(CardinalToString(VAL(CARDINAL, f), 0, ' ', 10, TRUE), fn)) ;
+      printf0(' | ') ;
+      Output(Pad(CardinalToString(VAL(CARDINAL, k), 0, ' ', 10, TRUE), tk)) ;
+      printf0(' |\n')
+   ELSE
+      IF tn>0
+      THEN
+         printf0('| ') ;
+         Output(doField(s, n, 0, tn))
+      END ;
+      IF fn>0
+      THEN
+         printf0(' | ') ;
+         Output(doField(s, n, 1, fn))
+      END ;
+      IF tk>0
+      THEN
+         printf0(' | ') ;
+         Output(doField(s, n, 2, tk))
+      END ;
+      printf0(' |\n') ;
+      IF tn>0
+      THEN
+         printf0('| ') ;
+         Output(doAnnotation(s, n, 0, tn))
+      END ;
+      IF fn>0
+      THEN
+         printf0(' | ') ;
+         Output(doAnnotation(s, n, 1, fn))
+      END ;
+      IF tk>0
+      THEN
+         printf0(' | ') ;
+         Output(doAnnotation(s, n, 2, tk))
+      END ;
+      printf0(' |\n')
+   END
+END DisplayFields ;
+
+
+(*
+   DebugStack - displays the stack.
+*)
+
+PROCEDURE DebugStack (amount: CARDINAL;
+                      opt, opf, opa, opd, oprw, optk: ProcedureWord;
+                      opanno: ProcedureString) ;
+VAR
+   i         : CARDINAL ;
+   tn, fn, tk: CARDINAL ;
+BEGIN
+   OperandT := opt ;
+   OperandF := opf ;
+   OperandA := opa ;
+   OperandD := opd ;
+   OperandRW := oprw ;
+   OperandAnno := opanno ;
+   OperandTok := optk ;
+   GetStackFieldLengths(tn, fn, tk, amount) ;
+   i := 1 ;
+   WHILE i<=amount DO
+      IF i=1
+      THEN
+         DisplayRow(tn, fn, tk, TRUE)
+      END ;
+      DisplayFields(i, tn, fn, tk) ;
+      DisplayRow(tn, fn, tk, i=amount) ;
+      INC(i)
+   END
+END DebugStack ;
+
+
+END M2DebugStack.
diff --git a/gcc/m2/gm2-compiler/M2Defaults.def b/gcc/m2/gm2-compiler/M2Defaults.def
new file mode 100644
index 00000000000..7a3d477d542
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Defaults.def
@@ -0,0 +1,54 @@
+(* M2Defaults.def provides path and argument defaults.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Defaults;
+
+(*
+    Title      : M2Defaults
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Fri Dec 13 13:04:51 1991
+    Last edit  : Fri Dec 13 13:04:51 1991
+    Description: Provides mechanisms to collect the default
+                 search path and command line options.
+*)
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED GetSearchPath, GetOptions ;
+
+
+(*
+   GetSearchPath - returns a string, which is a copy of the environment variable
+      	           M2PATH.
+*)
+
+PROCEDURE GetSearchPath () : String ;
+
+
+(*
+   GetOptions - returns a string, which is a copy of the environment variable
+      	        M2OPTIONS
+*)
+
+PROCEDURE GetOptions () : String ;
+
+
+END M2Defaults.
diff --git a/gcc/m2/gm2-compiler/M2Defaults.mod b/gcc/m2/gm2-compiler/M2Defaults.mod
new file mode 100644
index 00000000000..8d03760b86a
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Defaults.mod
@@ -0,0 +1,64 @@
+(* M2Defaults.mod provides path and argument defaults.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Defaults;
+
+FROM DynamicStrings IMPORT InitString, KillString ;
+FROM SEnvironment IMPORT GetEnvironment ;
+
+
+(*
+   GetSearchPath - sets string, a, to the environment variable
+      	           M2PATH.
+*)
+
+PROCEDURE GetSearchPath () : String ;
+VAR
+   s, p: String ;
+BEGIN
+   s := InitString('M2PATH') ;
+   IF GetEnvironment(s, p)
+   THEN
+   END ;
+   s := KillString(s) ;
+   RETURN( p )
+END GetSearchPath ;
+
+
+(*
+   GetOptions - returns a string, which is a copy of the environment variable
+      	        M2OPTIONS
+*)
+
+PROCEDURE GetOptions () : String ;
+VAR
+   s, p: String ;
+BEGIN
+   s := InitString('M2OPTIONS') ;
+   IF GetEnvironment(s, p)
+   THEN
+   END ;
+   s := KillString(s) ;
+   RETURN( p )
+END GetOptions ;
+
+
+END M2Defaults.
diff --git a/gcc/m2/gm2-compiler/M2DriverOptions.def b/gcc/m2/gm2-compiler/M2DriverOptions.def
new file mode 100644
index 00000000000..9414675ba6d
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2DriverOptions.def
@@ -0,0 +1,43 @@
+(* M2DriverOptions.def provides procedures to handle driver options.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE M2DriverOptions ;
+
+(*
+    Title      : M2DriverOptions
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Tue Dec 18 13:52:08 2012
+    Revision   : $Version$
+    Description: provides procedures to handle driver options.
+*)
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   ScanCppArgs - scans the cpp arguments and builds up the cpp command line.
+*)
+
+PROCEDURE ScanCppArgs (i: CARDINAL) : CARDINAL ;
+
+
+END M2DriverOptions.
diff --git a/gcc/m2/gm2-compiler/M2DriverOptions.mod b/gcc/m2/gm2-compiler/M2DriverOptions.mod
new file mode 100644
index 00000000000..e3971e6b29e
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2DriverOptions.mod
@@ -0,0 +1,95 @@
+(* M2DriverOptions.mod provides procedures to handle driver options.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2DriverOptions ;
+
+FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
+                           InitStringCharStar, ConCatChar, ConCat, KillString,
+                           PushAllocation, PopAllocationExemption, char ;
+
+FROM SArgs IMPORT GetArg, Narg ;
+FROM M2Options IMPORT CppRemember ;
+
+
+(*
+   CppArgument - some options might have arguments, remember these as well.
+*)
+
+PROCEDURE CppArgument (i: CARDINAL; option: String) : CARDINAL ;
+VAR
+   arg: String ;
+BEGIN
+   IF GetArg (arg, i+1) AND (char (arg, 0) # '-')
+   THEN
+      (* arg exists and is not an option and might be an argument to a specific option.  *)
+      IF EqualArray (option, '-I')
+      THEN
+         INC (i) ;
+         CppRemember (arg)  (* arg will be a path for -I.  *)
+      ELSIF EqualArray (option, '-D')
+      THEN
+         INC (i) ;
+         CppRemember (arg)  (* arg will be define for -D.  *)
+      ELSIF EqualArray (option, '-isystem')
+      THEN
+         INC (i) ;
+         CppRemember (arg)  (* arg will be a path for -isystem.  *)
+      ELSIF EqualArray (option, '-imultiarch')
+      THEN
+         INC (i) ;
+         CppRemember (arg)  (* arg will be a definition for -imultiarch.  *)
+      END
+   END ;
+   RETURN i
+END CppArgument ;
+
+
+(*
+   ScanCppArgs - scans the cpp arguments and builds up the cpp command line.
+*)
+
+PROCEDURE ScanCppArgs (i: CARDINAL) : CARDINAL ;
+VAR
+   option: String ;
+BEGIN
+   IF GetArg (option, i) AND EqualArray (option, '-fcpp-begin')
+   THEN
+      INC (i) ;
+      WHILE GetArg (option, i) DO
+         IF EqualArray (option, '-fcpp-end')
+         THEN
+            RETURN i
+         ELSE
+            (* do not remember the filename.  *)
+            IF char (option, 0)='-'
+            THEN
+               CppRemember (option) ;
+               i := CppArgument (i, option)
+            END
+         END ;
+         INC (i)
+      END
+   END ;
+   RETURN i
+END ScanCppArgs ;
+
+
+END M2DriverOptions.
diff --git a/gcc/m2/gm2-compiler/M2Emit.def b/gcc/m2/gm2-compiler/M2Emit.def
new file mode 100644
index 00000000000..194de3a521c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Emit.def
@@ -0,0 +1,59 @@
+(* M2Emit.def connects Modula-2 error reporting to GCC.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Emit ;
+
+
+FROM DynamicStrings IMPORT String ;
+FROM m2linemap IMPORT location_t ;
+
+
+(*
+   EmitError - pass the error to GCC or the gm2 tools output routines.
+*)
+
+PROCEDURE EmitError (error, note: BOOLEAN; token: CARDINAL; message: String) ;
+
+
+(*
+   InternalError - issue an internal error, message.
+*)
+
+PROCEDURE InternalError (message: ARRAY OF CHAR) ;
+
+
+(*
+   UnknownLocation - return the unknown location (using GCC linemap for cc1gm2)
+                     and constants for gm2l and gm2m.
+*)
+
+PROCEDURE UnknownLocation () : location_t ;
+
+
+(*
+   BuiltinsLocation - return the builtins location (using GCC linemap for cc1gm2)
+                      and constants for gm2l and gm2m.
+*)
+
+PROCEDURE BuiltinsLocation () : location_t ;
+
+
+END M2Emit.
diff --git a/gcc/m2/gm2-compiler/M2Emit.mod b/gcc/m2/gm2-compiler/M2Emit.mod
new file mode 100644
index 00000000000..4b4026e0181
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Emit.mod
@@ -0,0 +1,82 @@
+(* M2Emit.mod issue errors to the GCC error reporting substructure.
+
+Copyright (C) 2019-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Emit ;
+
+IMPORT m2linemap ;
+
+FROM M2LexBuf IMPORT TokenToLocation ;
+FROM m2linemap IMPORT ErrorAtf, WarningAtf, NoteAtf, internal_error ;
+FROM DynamicStrings IMPORT string ;
+FROM SYSTEM IMPORT ADR ;
+
+
+(*
+   EmitError - pass the error to GCC.
+*)
+
+PROCEDURE EmitError (error, note: BOOLEAN; token: CARDINAL; message: String) ;
+BEGIN
+   IF error
+   THEN
+      ErrorAtf (TokenToLocation (token), string (message))
+   ELSIF note
+   THEN
+      NoteAtf (TokenToLocation (token), string (message))
+   ELSE
+      WarningAtf (TokenToLocation (token), string (message))
+   END
+END EmitError ;
+
+
+(*
+   InternalError - issue an internal error, message.
+*)
+
+PROCEDURE InternalError (message: ARRAY OF CHAR) ;
+BEGIN
+   internal_error (ADR (message))
+END InternalError ;
+
+
+(*
+   UnknownLocation - return the unknown location (using GCC linemap for cc1gm2)
+                     and constants for gm2l and gm2m.
+*)
+
+PROCEDURE UnknownLocation () : location_t ;
+BEGIN
+   RETURN m2linemap.UnknownLocation ()
+END UnknownLocation ;
+
+
+(*
+   BuiltinsLocation - return the builtins location (using GCC linemap for cc1gm2)
+                      and constants for gm2l and gm2m.
+*)
+
+PROCEDURE BuiltinsLocation () : location_t ;
+BEGIN
+   RETURN m2linemap.BuiltinsLocation ()
+END BuiltinsLocation ;
+
+
+END M2Emit.
diff --git a/gcc/m2/gm2-compiler/M2Error.def b/gcc/m2/gm2-compiler/M2Error.def
new file mode 100644
index 00000000000..852111382b9
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Error.def
@@ -0,0 +1,364 @@
+(* M2Error.def error reporting interface.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Error ;
+
+(*
+    Title      : M2Error
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Description: provides an interface between the string handling modules
+                 and the compiler.
+*)
+
+FROM SYSTEM IMPORT BYTE ;
+FROM DynamicStrings IMPORT String ;
+FROM NameKey IMPORT Name ;
+
+EXPORT QUALIFIED Error, ErrorScope,
+                 InternalError,
+                 WriteFormat0, WriteFormat1, WriteFormat2, WriteFormat3,
+                 NewError, ErrorFormat0, ErrorFormat1, ErrorFormat2, ErrorFormat3,
+                 ErrorString,
+                 NewWarning, NewNote, SetColor,
+                 FlushErrors, FlushWarnings, ChainError,
+                 ErrorStringAt, ErrorStringAt2, ErrorStringsAt2,
+                 WarnStringAt, WarnStringAt2, WarnStringsAt2,
+                 ErrorAbort0,
+                 WarnFormat0, WarnFormat1, MoveError,
+                 AnnounceScope, EnterImplementationScope,
+                 EnterModuleScope, EnterDefinitionScope, EnterProgramScope,
+                 EnterProcedureScope, DepthScope, GetAnnounceScope,
+                 DefaultProgramModule, DefaultImplementationModule,
+                 DefaultDefinitionModule, DefaultInnerModule, DefaultProcedure,
+                 EnterErrorScope, GetCurrentErrorScope, ResetErrorScope,
+                 LeaveErrorScope ;
+
+
+TYPE
+   Error ;
+   ErrorScope ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE InternalError (message: ARRAY OF CHAR) <* noreturn *> ;
+
+
+
+(* ***************************************************************************
+   The following routines are used for normal syntax and semantic error reporting
+   *************************************************************************** *)
+
+
+(*
+   WriteFormat0 - displays the source module and line together
+                  with the encapsulated format string.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE WriteFormat0 (a: ARRAY OF CHAR) ;
+
+
+(*
+   WriteFormat1 - displays the source module and line together
+                  with the encapsulated format string.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE WriteFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+
+
+(*
+   WriteFormat2 - displays the module and line together with the encapsulated
+                  format strings.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE WriteFormat2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+
+
+(*
+   WriteFormat3 - displays the module and line together with the encapsulated
+                  format strings.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE WriteFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+
+
+(*
+   NewError - creates and returns a new error handle.
+*)
+
+PROCEDURE NewError (AtTokenNo: CARDINAL) : Error ;
+
+
+(*
+   NewWarning - creates and returns a new error handle suitable for a warning.
+                A warning will not stop compilation.
+*)
+
+PROCEDURE NewWarning (AtTokenNo: CARDINAL) : Error ;
+
+
+(*
+   NewNote - creates and returns a new error handle suitable for a note.
+             A note will not stop compilation.
+*)
+
+PROCEDURE NewNote (AtTokenNo: CARDINAL) : Error ;
+
+
+(*
+   ChainError - creates and returns a new error handle, this new error
+                is associated with, e, and is chained onto the end of, e.
+*)
+
+PROCEDURE ChainError (AtTokenNo: CARDINAL; e: Error) : Error ;
+
+
+(*
+   MoveError - repositions an error, e, to token, AtTokenNo, and returns, e.
+*)
+
+PROCEDURE MoveError (e: Error; AtTokenNo: CARDINAL) : Error ;
+
+
+(*
+   SetColor - informs the error module that this error will have had colors
+              assigned to it.  If an error is issued without colors assigned
+              then the default colors will be assigned to the legacy error
+              messages.
+*)
+
+PROCEDURE SetColor (e: Error) : Error ;
+
+
+(*
+   ErrorFormat routines provide a printf capability for the error handle.
+*)
+
+PROCEDURE ErrorFormat0 (e: Error; a: ARRAY OF CHAR) ;
+PROCEDURE ErrorFormat1 (e: Error; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+PROCEDURE ErrorFormat2 (e: Error; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+PROCEDURE ErrorFormat3 (e: Error; a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+PROCEDURE ErrorString  (e: Error; str: String) ;
+
+
+(* ***************************************************************************
+   The following routines are useful for positioning and warnings and errors
+   at tokens. The strings are emitted later, so the caller must not destroy
+   the strings.
+   *************************************************************************** *)
+
+PROCEDURE ErrorStringAt (s: String; tok: CARDINAL) ;
+PROCEDURE ErrorStringAt2 (s: String; tok1, tok2: CARDINAL) ;
+PROCEDURE ErrorStringsAt2 (s1, s2: String; tok1, tok2: CARDINAL) ;
+PROCEDURE WarnStringAt (s: String; tok: CARDINAL) ;
+PROCEDURE WarnStringAt2 (s: String; tok1, tok2: CARDINAL) ;
+PROCEDURE WarnStringsAt2 (s1, s2: String; tok1, tok2: CARDINAL) ;
+
+
+(*
+   WarnFormat0 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*)
+
+PROCEDURE WarnFormat0 (a: ARRAY OF CHAR) ;
+
+
+(*
+   WarnFormat1 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*)
+
+PROCEDURE WarnFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+
+
+(*
+   FlushErrors - switches the output channel to the error channel
+                 and then writes out all errors.
+                 If an error is present the compilation is terminated.
+                 All warnings are ignored.
+*)
+
+PROCEDURE FlushErrors ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FlushWarnings ;
+
+
+(*
+   ErrorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
+*)
+
+PROCEDURE ErrorAbort0 (a: ARRAY OF CHAR) ;
+
+
+(*
+   AnnounceScope - return the error string message with a scope description prepended
+                   assuming that scope has changed.
+*)
+
+PROCEDURE AnnounceScope (e: Error; message: String) : String ;
+
+
+(*
+   EnterImplementationScope - signifies to the error routines that the front end
+                              has started to compile implementation module scopeName.
+*)
+
+PROCEDURE EnterImplementationScope (scopename: Name) ;
+
+
+(*
+   EnterProgramScope - signifies to the error routines that the front end
+                       has started to compile program module scopeName.
+*)
+
+PROCEDURE EnterProgramScope (scopename: Name) ;
+
+
+(*
+   EnterModuleScope - signifies to the error routines that the front end
+                      has started to compile an inner module scopeName.
+*)
+
+PROCEDURE EnterModuleScope (scopename: Name) ;
+
+
+(*
+   EnterDefinitionScope - signifies to the error routines that the front end
+                          has started to compile definition module scopeName.
+*)
+
+PROCEDURE EnterDefinitionScope (scopename: Name) ;
+
+
+(*
+   EnterProcedureScope - signifies to the error routines that the front end
+                         has started to compile definition module scopeName.
+*)
+
+PROCEDURE EnterProcedureScope (scopename: Name) ;
+
+
+(*
+   DepthScope - returns the depth of the scope stack.
+*)
+
+PROCEDURE DepthScope () : CARDINAL ;
+
+
+(*
+   GetAnnounceScope - return message with the error scope attached to message.
+                      filename and message are treated as read only by this
+                      procedure function.
+*)
+
+PROCEDURE GetAnnounceScope (filename, message: String) : String ;
+
+
+(*
+   DefaultProgramModule - sets up an unnamed program scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProgramModule ;
+
+
+(*
+   DefaultImplementationModule - sets up an unnamed implementation
+                                 scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultImplementationModule ;
+
+
+(*
+   DefaultDefinitionModule - sets up an unnamed definition
+                             scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultDefinitionModule ;
+
+
+(*
+   DefaultInnerModule - sets up an unnamed inner
+                        scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultInnerModule ;
+
+
+(*
+   DefaultProcedure - sets up an unnamed procedure
+                      scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProcedure ;
+
+
+(*
+   EnterErrorScope - pushes the currentScope and sets currentScope to scope.
+*)
+
+PROCEDURE EnterErrorScope (scope: ErrorScope) ;
+
+
+(*
+   LeaveErrorScope - leave the current scope and pop into the previous one.
+*)
+
+PROCEDURE LeaveErrorScope ;
+
+
+(*
+   GetCurrentErrorScope - returns currentScope.
+*)
+
+PROCEDURE GetCurrentErrorScope () : ErrorScope ;
+
+
+(*
+   ResetErrorScope - should be called at the start of each pass to
+                     reset the error scope index.
+*)
+
+PROCEDURE ResetErrorScope ;
+
+
+END M2Error.
diff --git a/gcc/m2/gm2-compiler/M2Error.mod b/gcc/m2/gm2-compiler/M2Error.mod
new file mode 100644
index 00000000000..6df9b665c3d
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Error.mod
@@ -0,0 +1,1181 @@
+(* M2Error.mod error reporting interface.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Error ;
+
+FROM NameKey IMPORT NulName, Name, KeyToCharStar ;
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, ConCat, ConCatChar, Mark, string, KillString, Dup ;
+FROM FIO IMPORT StdOut, WriteNBytes, Close, FlushBuffer ;
+FROM StrLib IMPORT StrLen, StrEqual ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ;
+FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToColumnNo, GetTokenNo ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
+FROM M2Options IMPORT Xcode ;
+FROM M2RTS IMPORT ExitOnHalt ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM M2Emit IMPORT EmitError ;
+FROM M2LexBuf IMPORT UnknownTokenNo ;
+FROM M2StackAddress IMPORT StackOfAddress, InitStackAddress, PushAddress, PopAddress, NoOfItemsInStackAddress ;
+FROM Indexing IMPORT Index, HighIndice, InitIndex, GetIndice, PutIndice ;
+FROM M2Debug IMPORT Assert ;
+FROM M2Pass IMPORT IsPass0, IsPass1 ;
+FROM SymbolTable IMPORT NulSym ;
+
+FROM M2ColorString IMPORT filenameColor, endColor, errorColor, warningColor, noteColor,
+                          range1Color, range2Color, quoteOpen, quoteClose ;
+
+IMPORT M2Emit ;
+
+
+CONST
+   Debugging  =  TRUE ;
+   DebugTrace = FALSE ;
+   DebugError = FALSE ;
+
+TYPE
+   Error = POINTER TO RECORD
+                         parent,
+                         child,
+                         next     : Error ;
+                         note,
+                         fatal    : BOOLEAN ;
+                         s        : String ;
+                         (* index of token causing the error *)
+                         token    : CARDINAL ;
+                         color    : BOOLEAN ;
+                         scope    : ErrorScope ;
+                      END ;
+
+   KindScope = (noscope, definition, implementation, program, module, procedure) ;
+
+   ErrorScope = POINTER TO RECORD
+                              scopeKind: KindScope ;
+                              scopeName: Name ;
+                              symbol   : CARDINAL ;   (* symbol table entry.  *)
+                           END ;
+
+
+VAR
+   head        : Error ;
+   InInternal  : BOOLEAN ;
+   lastScope   : ErrorScope ;
+   scopeIndex  : CARDINAL ;
+   scopeArray  : Index ;
+   currentScope: ErrorScope ;
+   scopeStack  : StackOfAddress ;
+
+
+(*
+   SetColor - informs the error module that this error will have had colors
+              assigned to it.  If an error is issued without colors assigned
+              then the default colors will be assigned to the legacy error
+              messages.
+*)
+
+PROCEDURE SetColor (e: Error) : Error ;
+BEGIN
+   e^.color := TRUE ;
+   RETURN e
+END SetColor ;
+
+
+(*
+   Cast - casts a := b
+*)
+
+PROCEDURE Cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF HIGH(a)=HIGH(b)
+   THEN
+      FOR i := 0 TO HIGH(a) DO
+         a[i] := b[i]
+      END
+   END
+END Cast ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE TranslateNameToCharStar (VAR a: ARRAY OF CHAR;
+                                   n: CARDINAL) : BOOLEAN ;
+VAR
+   argno,
+   i, h : CARDINAL ;
+BEGIN
+   argno := 1 ;
+   i := 0 ;
+   h := StrLen(a) ;
+   WHILE i<h DO
+      IF (a[i]='%') AND (i+1<h)
+      THEN
+         IF (a[i+1]='a') AND (argno=n)
+         THEN
+            a[i+1] := 's' ;
+            RETURN( TRUE )
+         END ;
+         INC(argno) ;
+         IF argno>n
+         THEN
+            (* all done *)
+            RETURN( FALSE )
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( FALSE )
+END TranslateNameToCharStar ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE InternalError (message: ARRAY OF CHAR) <* noreturn *> ;
+BEGIN
+   IF NOT InInternal
+   THEN
+      InInternal := TRUE ;
+      FlushErrors
+   END ;
+   M2Emit.InternalError (message) ;
+   HALT
+END InternalError ;
+
+
+(* ***************************************************************************
+   The following routines are used for normal syntax and semantic error reporting
+   *************************************************************************** *)
+
+
+(*
+   WriteFormat0 - displays the source module and line together
+                  with the encapsulated format string.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE WriteFormat0 (a: ARRAY OF CHAR) ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewError(GetTokenNo()) ;
+   WITH e^ DO
+      s := Sprintf0(Mark(InitString(a)))
+   END
+END WriteFormat0 ;
+
+
+(*
+   WarnFormat0 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*)
+
+PROCEDURE WarnFormat0 (a: ARRAY OF CHAR) ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewWarning(GetTokenNo()) ;
+   WITH e^ DO
+      s := Sprintf0(Mark(InitString(a)))
+   END
+END WarnFormat0 ;
+
+
+(*
+   DoFormat1 -
+*)
+
+PROCEDURE DoFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) : String ;
+VAR
+   s: String ;
+   n: Name ;
+BEGIN
+   n := NulName ;
+   IF TranslateNameToCharStar(a, 1)
+   THEN
+      Cast(n, w) ;
+      s := Mark(InitStringCharStar(KeyToCharStar(n))) ;
+      s := Sprintf1(Mark(InitString(a)), s)
+   ELSE
+      s := Sprintf1(Mark(InitString(a)), w)
+   END ;
+   RETURN( s )
+END DoFormat1 ;
+
+
+(*
+   WriteFormat1 - displays the source module and line together
+                  with the encapsulated format string.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE WriteFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewError(GetTokenNo()) ;
+   e^.s := DoFormat1(a, w)
+END WriteFormat1 ;
+
+
+(*
+   WarnFormat1 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*)
+
+PROCEDURE WarnFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewWarning(GetTokenNo()) ;
+   e^.s := DoFormat1(a, w)
+END WarnFormat1 ;
+
+
+(*
+   DoFormat2 -
+*)
+
+PROCEDURE DoFormat2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) : String ;
+VAR
+   n     : Name ;
+   s,
+   s1, s2: String ;
+   b     : BITSET ;
+BEGIN
+   b := {} ;
+   n := NulName ;
+   IF TranslateNameToCharStar(a, 1)
+   THEN
+      Cast(n, w1) ;
+      s1 := Mark(InitStringCharStar(KeyToCharStar(n))) ;
+      INCL(b, 1)
+   END ;
+   IF TranslateNameToCharStar(a, 2)
+   THEN
+      Cast(n, w2) ;
+      s2 := Mark(InitStringCharStar(KeyToCharStar(n))) ;
+      INCL(b, 2)
+   END ;
+   CASE b OF
+
+   {}   :  s := Sprintf2(Mark(InitString(a)), w1, w2) |
+   {1}  :  s := Sprintf2(Mark(InitString(a)), s1, w2) |
+   {2}  :  s := Sprintf2(Mark(InitString(a)), w1, s2) |
+   {1,2}:  s := Sprintf2(Mark(InitString(a)), s1, s2)
+
+   ELSE
+      HALT
+   END ;
+   RETURN( s )
+END DoFormat2 ;
+
+
+(*
+   WriteFormat2 - displays the module and line together with the encapsulated
+                  format strings.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE WriteFormat2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewError(GetTokenNo()) ;
+   e^.s := DoFormat2(a, w1, w2)
+END WriteFormat2 ;
+
+
+PROCEDURE DoFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) : String ;
+VAR
+   n            : Name ;
+   s, s1, s2, s3: String ;
+   b            : BITSET ;
+BEGIN
+   b := {} ;
+   n := NulName ;
+   IF TranslateNameToCharStar(a, 1)
+   THEN
+      Cast(n, w1) ;
+      s1 := Mark(InitStringCharStar(KeyToCharStar(n))) ;
+      INCL(b, 1)
+   END ;
+   IF TranslateNameToCharStar(a, 2)
+   THEN
+      Cast(n, w2) ;
+      s2 := Mark(InitStringCharStar(KeyToCharStar(n))) ;
+      INCL(b, 2)
+   END ;
+   IF TranslateNameToCharStar(a, 3)
+   THEN
+      Cast(n, w3) ;
+      s3 := Mark(InitStringCharStar(KeyToCharStar(n))) ;
+      INCL(b, 3)
+   END ;
+   CASE b OF
+
+   {}     :  s := Sprintf3(Mark(InitString(a)), w1, w2, w3) |
+   {1}    :  s := Sprintf3(Mark(InitString(a)), s1, w2, w3) |
+   {2}    :  s := Sprintf3(Mark(InitString(a)), w1, s2, w3) |
+   {1,2}  :  s := Sprintf3(Mark(InitString(a)), s1, s2, w3) |
+   {3}    :  s := Sprintf3(Mark(InitString(a)), w1, w2, s3) |
+   {1,3}  :  s := Sprintf3(Mark(InitString(a)), s1, w2, s3) |
+   {2,3}  :  s := Sprintf3(Mark(InitString(a)), w1, s2, s3) |
+   {1,2,3}:  s := Sprintf3(Mark(InitString(a)), s1, s2, s3)
+
+   ELSE
+      HALT
+   END ;
+   RETURN( s )
+END DoFormat3 ;
+
+
+(*
+   WriteFormat3 - displays the module and line together with the encapsulated
+                  format strings.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE WriteFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewError(GetTokenNo()) ;
+   e^.s := DoFormat3(a, w1, w2, w3)
+END WriteFormat3 ;
+
+
+(*
+   MoveError - repositions an error, e, to token, AtTokenNo, and returns, e.
+*)
+
+PROCEDURE MoveError (e: Error; AtTokenNo: CARDINAL) : Error ;
+BEGIN
+   IF e # NIL
+   THEN
+      e^.token := AtTokenNo
+   END ;
+   RETURN e
+END MoveError ;
+
+
+(*
+   NewError - creates and returns a new error handle.
+*)
+
+PROCEDURE NewError (AtTokenNo: CARDINAL) : Error ;
+VAR
+   e, f: Error ;
+BEGIN
+   IF AtTokenNo = UnknownTokenNo
+   THEN
+      (* this could be used as a useful debugging hook as the front end
+         has forgotten the token no.  This can occur if a complex record
+         structure or array is used for example.  *)
+      AtTokenNo := GetTokenNo ()
+   END ;
+   NEW(e) ;
+   WITH e^ DO
+      s      := NIL ;
+      token  := AtTokenNo ;
+      next   := NIL ;
+      parent := NIL ;
+      child  := NIL ;
+      note   := FALSE ;
+      fatal  := TRUE ;
+      color  := FALSE ;
+   END ;
+   (* Assert (scopeKind # noscope) ;  *)
+   e^.scope := currentScope ;
+   IF (head=NIL) OR (head^.token>AtTokenNo)
+   THEN
+      e^.next := head ;
+      head    := e
+   ELSE
+      f := head ;
+      WHILE (f^.next#NIL) AND (f^.next^.token<AtTokenNo) DO
+         f := f^.next
+      END ;
+      e^.next := f^.next ;
+      f^.next := e
+   END ;
+   RETURN( e )
+END NewError ;
+
+
+(*
+   NewWarning - creates and returns a new error handle suitable for a warning.
+                A warning will not stop compilation.
+*)
+
+PROCEDURE NewWarning (AtTokenNo: CARDINAL) : Error ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewError(AtTokenNo) ;
+   e^.fatal := FALSE ;
+   e^.note  := FALSE ;
+   RETURN e
+END NewWarning ;
+
+
+(*
+   NewNote - creates and returns a new error handle suitable for a note.
+             A note will not stop compilation.
+*)
+
+PROCEDURE NewNote (AtTokenNo: CARDINAL) : Error ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewError(AtTokenNo) ;
+   e^.fatal := FALSE ;
+   e^.note  := TRUE ;
+   RETURN e
+END NewNote ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ChainError (AtTokenNo: CARDINAL; e: Error) : Error ;
+VAR
+   f: Error ;
+BEGIN
+   IF e=NIL
+   THEN
+      RETURN NewError (AtTokenNo)
+   ELSE
+      NEW (f) ;
+      WITH f^ DO
+         s         := NIL ;
+         token     := AtTokenNo ;
+         next      := e^.child ;
+         parent    := e ;
+         child     := NIL ;
+         fatal     := e^.fatal ;
+         scope     := e^.scope
+      END ;
+      e^.child := f
+   END ;
+   RETURN f
+END ChainError ;
+
+
+(*
+   ErrorFormat routines provide a printf capability for the error handle.
+*)
+
+PROCEDURE ErrorFormat0 (e: Error; a: ARRAY OF CHAR) ;
+BEGIN
+   WITH e^ DO
+      IF s=NIL
+      THEN
+         s := Sprintf0(Mark(InitString(a)))
+      ELSE
+         s := ConCat(s, Mark(Sprintf0(Mark(InitString(a)))))
+      END
+   END
+END ErrorFormat0 ;
+
+
+PROCEDURE ErrorFormat1 (e: Error; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   s1: String ;
+BEGIN
+   s1 := DoFormat1(a, w) ;
+   WITH e^ DO
+      IF s=NIL
+      THEN
+         s := s1
+      ELSE
+         s := ConCat(s, Mark(s1))
+      END
+   END
+END ErrorFormat1 ;
+
+
+PROCEDURE ErrorFormat2 (e: Error; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+VAR
+   s1: String ;
+BEGIN
+   s1 := DoFormat2(a, w1, w2) ;
+   WITH e^ DO
+      IF s=NIL
+      THEN
+         s := s1
+      ELSE
+         s := ConCat(s, Mark(s1))
+      END
+   END
+END ErrorFormat2 ;
+
+
+PROCEDURE ErrorFormat3 (e: Error; a: ARRAY OF CHAR;
+                        w1, w2, w3: ARRAY OF BYTE) ;
+VAR
+   s1: String ;
+BEGIN
+   s1 := DoFormat3(a, w1, w2, w3) ;
+   WITH e^ DO
+      IF s=NIL
+      THEN
+         s := s1
+      ELSE
+         s := ConCat(s, Mark(s1))
+      END
+   END
+END ErrorFormat3 ;
+
+
+PROCEDURE ErrorString (e: Error; str: String) ;
+BEGIN
+   WITH e^ DO
+      s := str
+   END
+END ErrorString ;
+
+
+(*
+   Init - initializes the error list.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   head := NIL ;
+   InInternal := FALSE ;
+   scopeStack := InitStackAddress () ;
+   scopeArray := InitIndex (1) ;
+   currentScope := NIL ;
+   scopeIndex := 0
+END Init ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE CheckIncludes (token: CARDINAL; depth: CARDINAL) ;
+VAR
+   included: String ;
+   lineno  : CARDINAL ;
+BEGIN
+   included := FindFileNameFromToken(token, depth+1) ;
+   IF included#NIL
+   THEN
+      lineno := TokenToLineNo(token, depth+1) ;
+      IF depth=0
+      THEN
+         printf2('In file included from %s:%d', included, lineno)
+      ELSE
+         printf2('                 from %s:%d', included, lineno)
+      END ;
+      IF FindFileNameFromToken(token, depth+2)=NIL
+      THEN
+         printf0(':\n')
+      ELSE
+         printf0(',\n')
+      END ;
+      CheckIncludes(token, depth+1)
+   END
+END CheckIncludes ;
+
+
+(*
+   FlushAll - flushes all errors in list, e.
+*)
+
+PROCEDURE FlushAll (e: Error; FatalStatus: BOOLEAN) : BOOLEAN ;
+VAR
+   f      : Error ;
+   written: BOOLEAN ;
+BEGIN
+   written := FALSE ;
+   IF e#NIL
+   THEN
+      REPEAT
+         WITH e^ DO
+            IF (FatalStatus=fatal) AND (s#NIL)
+            THEN
+               currentScope := scope ;
+               CheckIncludes (token, 0) ;
+               EmitError (fatal, note, token, AnnounceScope (e, s)) ;
+               IF (child#NIL) AND FlushAll (child, FatalStatus)
+               THEN
+               END ;
+               s := NIL ;
+               written := TRUE
+            END
+         END ;
+         f := e ;
+         e := e^.next ;
+         IF NOT Debugging
+         THEN
+            WITH f^ DO
+               s := KillString (s)
+            END ;
+            DISPOSE (f)
+         END ;
+      UNTIL e=NIL
+   END ;
+   RETURN written
+END FlushAll ;
+
+
+(*
+   FlushErrors - switches the output channel to the error channel
+                 and then writes out all errors.
+*)
+
+PROCEDURE FlushErrors ;
+BEGIN
+   IF DebugTrace
+   THEN
+      printf0('\nFlushing all errors\n') ;
+      printf0('===================\n')
+   END ;
+   IF FlushAll (head, TRUE)
+   THEN
+      ExitOnHalt(1) ;
+      HALT
+   END
+END FlushErrors ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FlushWarnings ;
+BEGIN
+   IF FlushAll (head, FALSE)
+   THEN
+   END
+END FlushWarnings ;
+
+
+(*
+   ErrorStringsAt2 - given error strings, s1, and, s2, it places these
+                     strings at token positions, tok1 and tok2, respectively.
+                     Both strings are consumed.
+*)
+
+PROCEDURE ErrorStringsAt2 (s1, s2: String; tok1, tok2: CARDINAL) ;
+VAR
+   e: Error ;
+BEGIN
+   IF s1=s2
+   THEN
+      s2 := Dup(s1)
+   END ;
+   e := NewError(tok1) ;
+   ErrorString(e, s1) ;
+   ErrorString(ChainError(tok2, e), s2)
+END ErrorStringsAt2 ;
+
+
+(*
+   ErrorStringAt2 - given an error string, s, it places this
+                    string at token positions, tok1 and tok2, respectively.
+                    The string is consumed.
+*)
+
+PROCEDURE ErrorStringAt2 (s: String; tok1, tok2: CARDINAL) ;
+BEGIN
+   ErrorStringsAt2(s, s, tok1, tok2)
+END ErrorStringAt2 ;
+
+
+(*
+   ErrorStringAt - given an error string, s, it places this
+                   string at token position, tok.
+                   The string is consumed.
+*)
+
+PROCEDURE ErrorStringAt (s: String; tok: CARDINAL) ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewError(tok) ;
+   ErrorString(e, s) ;
+END ErrorStringAt ;
+
+
+(*
+   WarnStringsAt2 - given warning strings, s1, and, s2, it places these
+                    strings at token positions, tok1 and tok2, respectively.
+                    Both strings are consumed.
+*)
+
+PROCEDURE WarnStringsAt2 (s1, s2: String; tok1, tok2: CARDINAL) ;
+VAR
+   e: Error ;
+BEGIN
+   IF s1=s2
+   THEN
+      s2 := Dup(s1)
+   END ;
+   e := NewWarning(tok1) ;
+   ErrorString(e, s1) ;
+   ErrorString(ChainError(tok2, e), s2)
+END WarnStringsAt2 ;
+
+
+(*
+   WarnStringAt2 - given an warning string, s, it places this
+                   string at token positions, tok1 and tok2, respectively.
+                   The string is consumed.
+*)
+
+PROCEDURE WarnStringAt2 (s: String; tok1, tok2: CARDINAL) ;
+BEGIN
+   WarnStringsAt2(s, s, tok1, tok2)
+END WarnStringAt2 ;
+
+
+(*
+   WarnStringAt - given an error string, s, it places this
+                  string at token position, tok.
+                  The string is consumed.
+*)
+
+PROCEDURE WarnStringAt (s: String; tok: CARDINAL) ;
+VAR
+   e: Error ;
+BEGIN
+   e := NewWarning(tok) ;
+   ErrorString(e, s) ;
+END WarnStringAt ;
+
+
+(*
+   ErrorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
+*)
+
+PROCEDURE ErrorAbort0 (a: ARRAY OF CHAR) ;
+BEGIN
+   FlushWarnings ;
+   IF NOT StrEqual(a, '')
+   THEN
+      WriteFormat0(a)
+   END ;
+   IF NOT FlushAll (head, TRUE)
+   THEN
+      WriteFormat0('unidentified error') ;
+      IF FlushAll (head, TRUE)
+      THEN
+      END
+   END ;
+   ExitOnHalt(1) ;
+   HALT
+END ErrorAbort0 ;
+
+
+(*
+   IsErrorScopeNul - returns TRUE if es is NIL or it has a NulName.
+*)
+
+PROCEDURE IsErrorScopeNul (es: ErrorScope) : BOOLEAN ;
+BEGIN
+   RETURN (es = NIL) OR (es^.scopeName = NulName)
+END IsErrorScopeNul ;
+
+
+(*
+   GetAnnounceScope - return message with the error scope attached to message.
+                      filename and message are treated as read only by this
+                      procedure function.
+*)
+
+PROCEDURE GetAnnounceScope (filename, message: String) : String ;
+VAR
+   pre,
+   fmt,
+   desc,
+   quoted: String ;
+BEGIN
+   IF filename = NIL
+   THEN
+      pre := InitString ('')
+   ELSE
+      pre := Sprintf1 (Mark (InitString ("%s: ")), filename)
+   END ;
+
+   IF NOT IsErrorScopeNul (currentScope)
+   THEN
+      quoted := InitString ('') ;
+      quoted := quoteOpen (quoted) ;
+      quoted := ConCat (quoted, Mark (InitStringCharStar (KeyToCharStar (currentScope^.scopeName)))) ;
+      quoted := quoteClose (quoted)
+   END ;
+
+   IF currentScope = NIL
+   THEN
+      desc := InitString ("no scope active")
+   ELSE
+      CASE currentScope^.scopeKind OF
+
+      definition    :   desc := InitString ("In definition module") |
+      implementation:   desc := InitString ("In implementation module") |
+      program       :   desc := InitString ("In program module") |
+      module        :   desc := InitString ("In inner module") |
+      procedure     :   desc := InitString ("In procedure")
+
+      END
+   END ;
+   fmt := ConCat (pre, Mark (desc)) ;
+   IF IsErrorScopeNul (currentScope)
+   THEN
+      fmt := ConCat (fmt, Sprintf0 (Mark (InitString (": "))))
+   ELSE
+      fmt := ConCat (fmt, Sprintf1 (Mark (InitString (" %s: ")), quoted))
+   END ;
+   RETURN ConCat (fmt, message)
+END GetAnnounceScope ;
+
+
+(*
+   IsSameScope - return TRUE if a and b refer to the same scope.
+*)
+
+PROCEDURE IsSameScope (a, b: ErrorScope) : BOOLEAN ;
+BEGIN
+   IF a = b
+   THEN
+      RETURN TRUE
+   ELSIF (a = NIL) OR (b = NIL)
+   THEN
+      RETURN FALSE
+   ELSE
+      (* this does not compare the symbol field.  *)
+      RETURN (a^.scopeKind = b^.scopeKind) AND (a^.scopeName = b^.scopeName)
+   END
+END IsSameScope ;
+
+
+(*
+   AnnounceScope - return the error string s with a scope description prepended
+                   assuming that scope has changed.
+*)
+
+PROCEDURE AnnounceScope (e: Error; message: String) : String ;
+BEGIN
+   IF NOT IsSameScope (lastScope, e^.scope)
+   THEN
+      lastScope := e^.scope ;
+      IF IsErrorScopeNul (lastScope)
+      THEN
+         RETURN ConCat (InitString ("no scope active: "), message)
+      ELSE
+         Assert ((e^.scope # NIL) AND (e^.scope^.scopeKind # noscope)) ;
+         (* filename := FindFileNameFromToken (e^.token, 0) ; *)
+         message := GetAnnounceScope (NIL, message)
+      END
+   END ;
+   RETURN message
+END AnnounceScope ;
+
+
+(*
+   newErrorScope - create an ErrorScope of kindScope and return the object.
+                   It is also added the a dynamic array.
+*)
+
+PROCEDURE newErrorScope (kind: KindScope) : ErrorScope ;
+VAR
+   es: ErrorScope ;
+   c : CARDINAL ;
+BEGIN
+   IF IsPass0 ()
+   THEN
+      NEW (es) ;
+      es^.scopeKind := kind ;
+      es^.scopeName := NulName ;
+      es^.symbol := NulSym ;
+      PutIndice (scopeArray, HighIndice (scopeArray) + 1, es) ;
+      IF DebugError
+      THEN
+         c := HighIndice (scopeArray) ;
+         printf2 ("pass 0:  %d  %d\n", c, kind)
+      END
+   ELSE
+      INC (scopeIndex) ;
+      es := GetIndice (scopeArray, scopeIndex) ;
+      IF DebugError
+      THEN
+         IF IsPass1 ()
+         THEN
+            printf3 ("pass 1:  %d  %d  %d\n", scopeIndex, es^.scopeKind, kind)
+         ELSE
+            printf3 ("pass 2:  %d  %d  %d\n", scopeIndex, es^.scopeKind, kind)
+         END
+      END ;
+      Assert (es^.scopeKind = kind)
+   END ;
+   RETURN es
+END newErrorScope ;
+
+
+(*
+   DefaultProgramModule - sets up an unnamed program scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProgramModule ;
+BEGIN
+   PushAddress (scopeStack, currentScope) ;
+   currentScope := newErrorScope (program)
+END DefaultProgramModule ;
+
+
+(*
+   DefaultImplementationModule - sets up an unnamed implementation
+                                 scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultImplementationModule ;
+BEGIN
+   PushAddress (scopeStack, currentScope) ;
+   currentScope := newErrorScope (implementation)
+END DefaultImplementationModule ;
+
+
+(*
+   DefaultDefinitionModule - sets up an unnamed definition
+                             scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultDefinitionModule ;
+BEGIN
+   PushAddress (scopeStack, currentScope) ;
+   currentScope := newErrorScope (definition)
+END DefaultDefinitionModule ;
+
+
+(*
+   DefaultInnerModule - sets up an unnamed inner
+                        scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultInnerModule ;
+BEGIN
+   PushAddress (scopeStack, currentScope) ;
+   currentScope := newErrorScope (module)
+END DefaultInnerModule ;
+
+
+(*
+   DefaultProcedure - sets up an unnamed procedure
+                      scope before the Ident is seen.
+*)
+
+PROCEDURE DefaultProcedure ;
+BEGIN
+   PushAddress (scopeStack, currentScope) ;
+   currentScope := newErrorScope (procedure)
+END DefaultProcedure ;
+
+
+(*
+   EnterImplementationScope - signifies to the error routines that the front end
+                              has started to compile implementation module scopeName.
+*)
+
+PROCEDURE EnterImplementationScope (scopename: Name) ;
+BEGIN
+   Assert (currentScope # NIL) ;
+   Assert (currentScope^.scopeKind = implementation) ;
+   IF currentScope^.scopeName = NulName
+   THEN
+      IF DebugError
+      THEN
+         printf1 ("seen implementation: %a\n", scopename)
+      END ;
+      currentScope^.scopeName := scopename
+   END
+END EnterImplementationScope ;
+
+
+(*
+   EnterProgramScope - signifies to the error routines that the front end
+                       has started to compile program module scopeName.
+*)
+
+PROCEDURE EnterProgramScope (scopename: Name) ;
+BEGIN
+   Assert (currentScope # NIL) ;
+   Assert (currentScope^.scopeKind = program) ;
+   IF currentScope^.scopeName = NulName
+   THEN
+      IF DebugError
+      THEN
+         printf1 ("seen program: %a\n", scopename)
+      END ;
+      currentScope^.scopeName := scopename
+   END
+END EnterProgramScope ;
+
+
+(*
+   EnterModuleScope - signifies to the error routines that the front end
+                      has started to compile an inner module scopeName.
+*)
+
+PROCEDURE EnterModuleScope (scopename: Name) ;
+BEGIN
+   Assert (currentScope # NIL) ;
+   Assert (currentScope^.scopeKind = module) ;
+   IF currentScope^.scopeName = NulName
+   THEN
+      IF DebugError
+      THEN
+         printf1 ("seen module: %a\n", scopename)
+      END ;
+      currentScope^.scopeName := scopename
+   END
+END EnterModuleScope ;
+
+
+(*
+   EnterDefinitionScope - signifies to the error routines that the front end
+                          has started to compile definition module scopeName.
+*)
+
+PROCEDURE EnterDefinitionScope (scopename: Name) ;
+BEGIN
+   Assert (currentScope # NIL) ;
+   Assert (currentScope^.scopeKind = definition) ;
+   IF currentScope^.scopeName = NulName
+   THEN
+      IF DebugError
+      THEN
+         printf1 ("seen definition: %a\n", scopename)
+      END ;
+      currentScope^.scopeName := scopename
+   END
+END EnterDefinitionScope ;
+
+
+(*
+   EnterProcedureScope - signifies to the error routines that the front end
+                         has started to compile definition module scopeName.
+*)
+
+PROCEDURE EnterProcedureScope (scopename: Name) ;
+BEGIN
+   Assert (currentScope # NIL) ;
+   Assert (currentScope^.scopeKind = procedure) ;
+   IF currentScope^.scopeName = NulName
+   THEN
+      IF DebugError
+      THEN
+         printf1 ("seen procedure: %a\n", scopename)
+      END ;
+      currentScope^.scopeName := scopename
+   END
+END EnterProcedureScope ;
+
+
+(*
+   LeaveErrorScope - leave the current scope and pop into the previous one.
+*)
+
+PROCEDURE LeaveErrorScope ;
+BEGIN
+   currentScope := PopAddress (scopeStack)
+END LeaveErrorScope ;
+
+
+(*
+   EnterErrorScope - pushes the currentScope and sets currentScope to scope.
+*)
+
+PROCEDURE EnterErrorScope (scope: ErrorScope) ;
+BEGIN
+   PushAddress (scopeStack, currentScope) ;
+   currentScope := scope
+END EnterErrorScope ;
+
+
+(*
+   GetCurrentErrorScope - returns currentScope.
+*)
+
+PROCEDURE GetCurrentErrorScope () : ErrorScope ;
+BEGIN
+   RETURN currentScope
+END GetCurrentErrorScope ;
+
+
+(*
+   DepthScope - returns the depth of the scope stack.
+*)
+
+PROCEDURE DepthScope () : CARDINAL ;
+BEGIN
+   RETURN NoOfItemsInStackAddress (scopeStack)
+END DepthScope ;
+
+
+(*
+   ResetErrorScope - should be called at the start of each pass to
+                     reset the error scope index.
+*)
+
+PROCEDURE ResetErrorScope ;
+BEGIN
+   scopeIndex := 0
+END ResetErrorScope ;
+
+
+BEGIN
+   Init
+END M2Error.
diff --git a/gcc/m2/gm2-compiler/M2EvalSym.def b/gcc/m2/gm2-compiler/M2EvalSym.def
new file mode 100644
index 00000000000..d8b2c42ad67
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2EvalSym.def
@@ -0,0 +1,42 @@
+(* M2EvalSym.def Evaluates all the symbol values within the symbol table.
+
+Copyright (C) 2001-2022 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/>.  *)
+DEFINITION MODULE M2EvalSym ;
+
+(*
+   Title      : M2EvalSym
+   Author     : Gaius Mulley
+   Date       : 7/8/87
+   LastEdit   : 7/8/87
+   System     : UNIX (GNU Modula-2)
+   Description: Evaluates all the symbol values within the symbol table.
+*)
+
+EXPORT QUALIFIED Evaluate ;
+
+
+(*
+   Evaluate - evaluate all the symbols in the symbol table.
+*)
+
+PROCEDURE Evaluate ;
+
+
+END M2EvalSym.
diff --git a/gcc/m2/gm2-compiler/M2FileName.def b/gcc/m2/gm2-compiler/M2FileName.def
new file mode 100644
index 00000000000..31b5a08b11c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2FileName.def
@@ -0,0 +1,74 @@
+(* M2FileName.def construct file names.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2FileName ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2FileName
+   Date       : 3/4/86  [$Date: 2013/07/08 10:27:56 $]
+   SYSTEM     : UNIX (GNU Modula-2)
+   Description: construct file names.
+   Version    : $Revision: 1.11 $
+*)
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED CalculateFileName, CalculateStemName, ExtractExtension ;
+
+
+(*
+   CalculateFileName - calculates and returns a new string filename
+                       given a module and an extension. This file name
+                       length will be operating system specific.
+                       String, Extension, is concatenated onto
+                       Module and thus it is safe to `Mark' the extension
+                       for garbage collection.
+*)
+
+PROCEDURE CalculateFileName (Module, Extension: String) : String ;
+
+
+(*
+   CalculateStemName - calculates the stem name for given a module.
+                       This name length will be operating system and
+      	       	       compiler specific.
+*)
+
+PROCEDURE CalculateStemName (Module: String) : String ;
+
+
+(*
+   ExtractExtension - given a, filename, return the filename without
+                      the extension, Ext.
+*)
+
+PROCEDURE ExtractExtension (filename, ext: String) : String ;
+
+
+(*
+   ExtractModule - given a, filename, return the module name including any
+                   extension. A new string is returned.
+*)
+
+PROCEDURE ExtractModule (filename: String) : String ;
+
+
+END M2FileName.
diff --git a/gcc/m2/gm2-compiler/M2FileName.mod b/gcc/m2/gm2-compiler/M2FileName.mod
new file mode 100644
index 00000000000..0a40c681c34
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2FileName.mod
@@ -0,0 +1,106 @@
+(* M2FileName.mod construct file names.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2FileName ;
+
+
+FROM ASCII IMPORT nul ;
+FROM DynamicStrings IMPORT InitString, Mark, Slice, Dup, ConCatChar, ConCat, Length, Equal, Index ;
+
+
+CONST
+   MaxFileName = 0 ;   (* zero means no limits *)
+   MaxStemName = 0 ;
+   Directory   = '/' ;
+
+
+(*
+   currently there are no limits on filename length, this may
+   be incorrect on some systems.
+*)
+
+
+(*
+   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.
+*)
+
+PROCEDURE CalculateFileName (Module, Extension: String) : String ;
+BEGIN
+   IF MaxFileName=0
+   THEN
+      RETURN( ConCat(ConCatChar(Slice(Module, 0, MaxFileName), '.'), Extension) )
+   ELSE
+      RETURN( ConCat(ConCatChar(Slice(Module, 0, MaxFileName-Length(Extension)-1), '.'), Extension) )
+   END
+END CalculateFileName ;
+
+
+(*
+   CalculateStemName - calculates the stem name for given a module.
+                       This name length will be operating system and
+      	       	       compiler specific.
+*)
+
+PROCEDURE CalculateStemName (Module: String) : String ;
+BEGIN
+   RETURN( Slice(Module, 0, MaxStemName) )
+END CalculateStemName ;
+
+
+(*
+   ExtractExtension - given a, filename, return the filename without
+                      the extension, Ext.
+*)
+
+PROCEDURE ExtractExtension (filename, ext: String) : String ;
+BEGIN
+   IF Equal(ext, Mark(Slice(filename, -Length(ext), 0)))
+   THEN
+      RETURN( Slice(filename, 0, -Length(ext)) )
+   ELSE
+      RETURN( filename )
+   END
+END ExtractExtension ;
+
+
+(*
+   ExtractModule - given a, filename, return the module name including any
+                   extension. A new string is returned.
+*)
+
+PROCEDURE ExtractModule (filename: String) : String ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := Index(filename, Directory, 0) ;
+   IF i=-1
+   THEN
+      RETURN( Dup(filename) )
+   ELSE
+      RETURN( Slice(filename, i+1, 0) )
+   END
+END ExtractModule ;
+
+
+END M2FileName.
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.def b/gcc/m2/gm2-compiler/M2GCCDeclare.def
new file mode 100644
index 00000000000..5938410ccc6
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.def
@@ -0,0 +1,245 @@
+(* M2GCCDeclare.def declares Modula-2 types to GCC.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2GCCDeclare ;
+
+(*
+    Title      : M2GCCDeclare
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Sat Jul 17 10:28:43 1999
+    Last edit  : Sat Jul 17 10:28:43 1999
+    Description: declares Modula-2 types to GCC,
+                 only declares a type once all subcomponents are known.
+*)
+
+FROM SYSTEM IMPORT WORD ;
+FROM m2tree IMPORT Tree ;
+EXPORT QUALIFIED FoldConstants,
+                 DeclareConstant, TryDeclareConstant,
+                 DeclareConstructor, TryDeclareConstructor,
+                 DeclareLocalVariables, PromoteToString, DeclareLocalVariable,
+                 InitDeclarations, StartDeclareScope, EndDeclareScope,
+                 DeclareModuleVariables, IsProcedureGccNested,
+                 DeclareProcedure, PoisonSymbols, DeclareParameters,
+                 DeclareM2linkGlobals,
+                 CompletelyResolved, MarkExported, PrintSym,
+                 ConstantKnownAndUsed,
+                 PutToBeSolvedByQuads,
+                 GetTypeMin, GetTypeMax,
+                 WalkAction, IsAction ;
+
+TYPE
+   WalkAction = PROCEDURE (WORD) ;
+   IsAction   = PROCEDURE (WORD) : BOOLEAN ;
+
+
+(*
+   FoldConstants - a wrapper for ResolveConstantExpressions.
+*)
+
+PROCEDURE FoldConstants (start, end: CARDINAL) ;
+
+
+(*
+   StartDeclareScope - declares types, variables associated with this scope.
+*)
+
+PROCEDURE StartDeclareScope (scope: CARDINAL) ;
+
+
+(*
+   EndDeclareScope -
+*)
+
+PROCEDURE EndDeclareScope ;
+
+
+(*
+   DeclareParameters -
+*)
+
+PROCEDURE DeclareParameters (sym: CARDINAL) ;
+
+
+(*
+   DeclareConstant - if, sym, is a constant then declare it.
+                     The constant must be solvable at this point.
+*)
+
+PROCEDURE DeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ;
+
+
+(*
+   DeclareConstructor - if, sym, is a constructor then declare it.
+                        The constructor must be solvable at this point.
+*)
+
+PROCEDURE DeclareConstructor (tokenno: CARDINAL; quad: CARDINAL; sym: CARDINAL) ;
+
+
+(*
+   TryDeclareConstant - try and declare a constant.  If, sym, is a
+                        constant try and declare it, if we cannot
+                        then enter it into the to do list.
+*)
+
+PROCEDURE TryDeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ;
+
+
+(*
+   TryDeclareConstructor - try and declare a constructor.  If, sym, is a
+                           constructor try and declare it, if we cannot
+                           then enter it into the to do list.
+*)
+
+PROCEDURE TryDeclareConstructor (tokenno: CARDINAL; sym: CARDINAL) ;
+
+
+(*
+   DeclareLocalVariables - lists the Local variables for procedure
+                           together with their offset.
+*)
+
+PROCEDURE DeclareLocalVariables (procedure: CARDINAL) ;
+
+
+(*
+   DeclareLocalVariable - declare a local variable var.
+*)
+
+PROCEDURE DeclareLocalVariable (var: CARDINAL) ;
+
+
+(*
+   DeclareProcedure - declares procedure, sym, or all procedures inside
+                      module sym.
+*)
+
+PROCEDURE DeclareProcedure (sym: WORD) ;
+
+
+(*
+   DeclareModuleVariables - declares Module variables for a module
+                            which inside a procedure.
+*)
+
+PROCEDURE DeclareModuleVariables (sym: CARDINAL) ;
+
+
+(*
+   DeclareM2linkGlobals - will create M2LINK.StaticInitialization
+                          and M2LINK.ForcedModuleInitOrder providing
+                          they have not already been created.
+*)
+
+PROCEDURE DeclareM2linkGlobals (tokenno: CARDINAL) ;
+
+
+(*
+   IsProcedureGccNested - returns TRUE if procedure, sym, will be considered
+                          as nested by GCC.
+                          This will occur if either its outer defining scope
+                          is a procedure or is a module which is inside a
+                          procedure.
+*)
+
+PROCEDURE IsProcedureGccNested (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PoisonSymbols - poisons all gcc symbols from procedure, sym.
+                   A debugging aid.
+*)
+
+PROCEDURE PoisonSymbols (sym: CARDINAL) ;
+
+
+(*
+   PromoteToString - declare, sym, and then promote it to a string.
+                     Note that if sym is a single character we do
+                          *not* record it as a string
+                          but as a char however we always
+                          return a string constant.
+*)
+
+PROCEDURE PromoteToString (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
+
+
+(*
+   CompletelyResolved - returns TRUE if a symbol has been completely resolved
+                        and is not partially declared (such as a record,
+                        array or procedure type).
+*)
+
+PROCEDURE CompletelyResolved (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ConstantKnownAndUsed -
+*)
+
+PROCEDURE ConstantKnownAndUsed (sym: CARDINAL; t: Tree) ;
+
+
+(*
+   PutToBeSolvedByQuads - places, sym, in this list.
+*)
+
+PROCEDURE PutToBeSolvedByQuads (sym: CARDINAL) ;
+
+
+(*
+   MarkExported - tell GCC to mark all exported procedures in module sym.
+*)
+
+PROCEDURE MarkExported (sym: CARDINAL) ;
+
+
+(*
+   GetTypeMin - returns a symbol corresponding to MIN(type)
+*)
+
+PROCEDURE GetTypeMin (type: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetTypeMax - returns a symbol corresponding to MAX(type)
+*)
+
+PROCEDURE GetTypeMax (type: CARDINAL) : CARDINAL ;
+
+
+(*
+   PrintSym - prints limited information about a symbol.
+*)
+
+PROCEDURE PrintSym (sym: CARDINAL) ;
+
+
+(*
+   InitDeclarations - initializes default types and the source filename.
+*)
+
+PROCEDURE InitDeclarations ;
+
+
+END M2GCCDeclare.
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
new file mode 100644
index 00000000000..7e814b631ee
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -0,0 +1,6326 @@
+(* M2GCCDeclare.mod declares Modula-2 types to GCC.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2GCCDeclare ;
+
+(*
+    Title      : M2GCCDeclare
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Fri Jul 16 20:10:55 1999
+    Description: declares Modula-2 types to GCC, it attempts
+                 to only declare a type once all subcomponents are known.
+*)
+
+FROM SYSTEM IMPORT ADDRESS, ADR, WORD ;
+FROM ASCII IMPORT nul ;
+FROM Storage IMPORT ALLOCATE ;
+FROM M2Debug IMPORT Assert ;
+FROM M2Quads IMPORT DisplayQuadRange ;
+
+IMPORT FIO ;
+
+FROM M2Options IMPORT DisplayQuadruples,
+                      GenerateDebugging, GenerateLineDebug, Iso, Optimizing, WholeProgram,
+                      ScaffoldStatic, GetRuntimeModuleOverride ;
+
+FROM M2AsmUtil IMPORT GetFullSymName, GetFullScopeAsmName ;
+
+FROM M2Batch IMPORT MakeDefinitionSource ;
+FROM NameKey IMPORT Name, MakeKey, NulName, KeyToCharStar, makekey ;
+FROM M2FileName IMPORT CalculateFileName ;
+FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, Mark ;
+FROM FormatStrings IMPORT Sprintf1 ;
+FROM M2LexBuf IMPORT TokenToLineNo, FindFileNameFromToken, TokenToLocation, UnknownTokenNo, BuiltinTokenNo ;
+FROM M2MetaError IMPORT MetaError1, MetaError3 ;
+FROM M2Error IMPORT FlushErrors, InternalError ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
+
+FROM Indexing IMPORT Index, InitIndex, PutIndice, GetIndice, InBounds,
+                     IncludeIndiceIntoIndex, HighIndice,
+                     DebugIndex ;
+
+FROM Lists IMPORT List, InitList, IncludeItemIntoList,
+                  PutItemIntoList, GetItemFromList,
+                  RemoveItemFromList, ForeachItemInListDo,
+      	       	  IsItemInList, NoOfItemsInList, KillList ;
+
+FROM Sets IMPORT Set, InitSet, KillSet,
+                 IncludeElementIntoSet, ExcludeElementFromSet,
+                 NoOfElementsInSet, IsElementInSet, ForeachElementInSetDo ;
+
+FROM SymbolTable IMPORT NulSym,
+                        ModeOfAddr,
+                        GetMode,
+                        GetScope,
+                        GetNth, SkipType, GetVarBackEndType,
+			GetSType, GetLType, GetDType,
+                        MakeType, PutType, GetLowestType,
+      	       	     	GetSubrange, PutSubrange, GetArraySubscript,
+      	       	     	NoOfParam, GetNthParam,
+                        PushValue, PopValue, PopSize,
+                        IsTemporary, IsUnbounded, IsPartialUnbounded,
+                        IsEnumeration, IsVar,
+      	       	     	IsSubrange, IsPointer, IsRecord, IsArray,
+                        IsFieldEnumeration,
+                        IsProcedure, IsProcedureNested, IsModule,
+                        IsDefImp,
+      	       	     	IsSubscript, IsVarient, IsFieldVarient,
+      	       	     	IsType, IsProcType, IsSet, IsSetPacked,
+                        IsConst, IsConstSet, IsConstructor,
+                        IsFieldEnumeration,
+                        IsExported, IsImported,
+                        IsVarParam, IsRecordField, IsUnboundedParam,
+                        IsValueSolved,
+                        IsDefinitionForC, IsHiddenTypeDeclared,
+                        IsInnerModule, IsUnknown,
+                        IsProcedureReachable, IsParameter, IsConstLit,
+                        IsDummy, IsVarAParam, IsProcedureVariable,
+                        IsGnuAsm, IsGnuAsmVolatile, IsObject, IsTuple,
+                        IsError, IsHiddenType,
+                        IsComponent, IsPublic, IsExtern, IsCtor,
+      	       	     	GetMainModule, GetBaseModule, GetModule, GetLocalSym,
+                        PutModuleFinallyFunction,
+                        GetProcedureScope, GetProcedureQuads,
+                        IsRecordFieldAVarientTag, IsEmptyFieldVarient,
+                        GetVarient, GetUnbounded, PutArrayLarge,
+                        IsAModula2Type, UsesVarArgs,
+                        GetSymName, GetParent,
+                        GetDeclaredMod, GetVarBackEndType,
+                        GetProcedureBeginEnd,
+                        GetString, GetStringLength, IsConstString,
+                        IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul,
+                        GetAlignment, IsDeclaredPacked, PutDeclaredPacked,
+                        GetDefaultRecordFieldAlignment, IsDeclaredPackedResolved,
+                        GetPackedEquivalent,
+                        GetParameterShadowVar,
+                        GetUnboundedRecordType,
+                        GetModuleCtors,
+			ForeachOAFamily, GetOAFamily,
+                        IsModuleWithinProcedure, IsVariableSSA,
+                        IsVariableAtAddress, IsConstructorConstant,
+                        ForeachLocalSymDo, ForeachFieldEnumerationDo,
+      	       	     	ForeachProcedureDo, ForeachModuleDo,
+                        ForeachInnerModuleDo, ForeachImportedDo,
+                        ForeachExportedDo ;
+
+FROM M2Base IMPORT IsPseudoBaseProcedure, IsPseudoBaseFunction,
+                   GetBaseTypeMinMax, MixTypes,
+                   Cardinal, Char, Proc, Integer,
+                   LongInt, LongCard, ShortCard, ShortInt,
+                   Real, LongReal, ShortReal, ZType, RType,
+                   CType, Complex, LongComplex, ShortComplex,
+                   Boolean, True, False, Nil,
+                   IsRealType, IsNeededAtRunTime, IsComplexType ;
+
+FROM M2System IMPORT IsPseudoSystemFunction, IsSystemType,
+                     GetSystemTypeMinMax, Address, Word, Byte, Loc,
+                     System, IntegerN, CardinalN, WordN, RealN, SetN, ComplexN,
+		     CSizeT, CSSizeT ;
+
+FROM M2Bitset IMPORT Bitset, Bitnum ;
+FROM SymbolConversion IMPORT AddModGcc, Mod2Gcc, GccKnowsAbout, Poison, RemoveMod2Gcc ;
+FROM M2GenGCC IMPORT ResolveConstantExpressions ;
+FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock, ForeachScopeBlockDo ;
+
+FROM M2ALU IMPORT Addn, Sub, Equ, GreEqu, Gre, Less, PushInt, PushCard, ConvertToType,
+                  PushIntegerTree, PopIntegerTree, PopRealTree, ConvertToInt, PopSetTree,
+                  IsConstructorDependants, WalkConstructorDependants,
+                  PopConstructorTree, PopComplexTree, PutConstructorSolved,
+                  ChangeToConstructor, EvaluateValue, TryEvaluateValue ;
+
+FROM M2Batch IMPORT IsSourceSeen, GetModuleFile, IsModuleSeen, LookupModule ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t, BuiltinsLocation ;
+
+FROM m2decl IMPORT BuildIntegerConstant, BuildStringConstant, BuildCStringConstant,
+                   BuildStartFunctionDeclaration,
+                   BuildParameterDeclaration, BuildEndFunctionDeclaration,
+                   DeclareKnownVariable, GetBitsPerBitset, BuildPtrToTypeString,
+                   DeclareM2linkStaticInitialization,
+                   DeclareM2linkForcedModuleInitOrder ;
+
+FROM m2type IMPORT MarkFunctionReferenced, BuildStartRecord, BuildStartVarient, BuildStartFunctionType,
+                   BuildStartFieldVarient, BuildStartVarient, BuildStartType, BuildStartArrayType,
+                   PutArrayType, BuildPointerType, BuildEndType, BuildCharConstant,
+                   BuildTypeDeclaration, GetDefaultType, GetBooleanType, GetBooleanTrue,
+                   GetBooleanFalse, BuildSubrangeType, GetM2ZType, GetM2RType, GetM2CType,
+                   GetM2CardinalType, GetM2IntegerType, GetM2CharType, GetISOLocType, GetIntegerType,
+                   GetISOByteType, GetISOWordType, GetByteType, GetWordType, GetProcType, GetPointerType,
+                   GetM2LongIntType, GetM2LongCardType, GetM2ShortIntType, GetM2ShortCardType,
+                   GetM2LongRealType, GetM2ShortRealType, GetM2RealType, GetBitnumType, GetBitsetType,
+                   GetM2ComplexType, GetM2ComplexType, GetM2LongComplexType, GetM2ShortComplexType,
+                   GetM2Integer8, GetM2Integer16, GetM2Integer32, GetM2Integer64, GetM2Cardinal8,
+                   GetM2Cardinal16, GetM2Cardinal32, GetM2Cardinal64, GetM2Word16, GetM2Word32,
+                   GetM2Word64, GetM2Bitset8, GetM2Bitset16, GetM2Bitset32, GetM2Real32, GetM2Real64,
+                   GetM2Real96, GetM2Real128, GetM2Complex32, GetM2Complex64, GetM2Complex96,
+                   GetM2Complex128, GetCSizeTType, GetCSSizeTType,
+		   GetPackedBooleanType, BuildConstPointerType,
+                   BuildPointerType, BuildEnumerator, BuildStartEnumeration, BuildEndEnumeration,
+                   SetAlignment, SetTypePacked, SetDeclPacked, BuildSmallestTypeRange,
+                   SetRecordFieldOffset, ChainOn, BuildEndRecord, BuildFieldRecord,
+                   BuildEndFieldVarient, BuildArrayIndexType, BuildEndFunctionType,
+                   BuildSetType, BuildEndVarient, BuildEndArrayType, InitFunctionTypeParameters,
+                   BuildProcTypeParameterDeclaration,
+                   ValueOutOfTypeRange, ExceedsTypeRange ;
+
+FROM m2convert IMPORT BuildConvert ;
+
+FROM m2expr IMPORT BuildSub, BuildLSL, BuildTBitSize, BuildAdd, BuildDivTrunc, BuildModTrunc,
+                   BuildSize, TreeOverflow,
+                   GetPointerZero, GetIntegerZero, GetIntegerOne ;
+
+FROM m2block IMPORT RememberType, pushGlobalScope, popGlobalScope, pushFunctionScope, popFunctionScope,
+                    finishFunctionDecl, RememberConstant, GetGlobalContext ;
+
+
+TYPE
+   StartProcedure = PROCEDURE (location_t, ADDRESS) : Tree ;
+   ListType       = (fullydeclared, partiallydeclared, niltypedarrays,
+                     heldbyalignment, finishedalignment, todolist, tobesolvedbyquads) ;
+   doDeclareProcedure = PROCEDURE (CARDINAL, CARDINAL) ;
+
+
+
+CONST
+   Debugging = FALSE ;
+   Progress  = FALSE ;
+   EnableSSA = FALSE ;
+
+TYPE
+   M2LinkEntry = POINTER TO RECORD
+                               var    : CARDINAL ;
+                               gcc    : Tree ;
+                               varname,
+                               modname: Name ;
+                            END ;
+
+VAR
+   ToBeSolvedByQuads,               (* constants which must be solved *)
+                                    (* by processing the quadruples.  *)
+   NilTypedArrays,                  (* arrays which have NIL as their *)
+                                    (* type.                          *)
+   FullyDeclared,                   (* those symbols which have been  *)
+                                    (* fully declared.                *)
+   PartiallyDeclared,               (* those types which have need to *)
+                                    (* be finished (but already       *)
+                                    (* started: records, function,    *)
+                                    (* and array type).               *)
+   HeldByAlignment,                 (* types which have a user        *)
+                                    (* specified alignment constant.  *)
+   FinishedAlignment,               (* records for which we know      *)
+                                    (* their alignment value.         *)
+   VisitedList,
+   ChainedList,
+   ToDoList            : Set ;      (* Contains a set of all          *)
+                                    (* outstanding types that need to *)
+                                    (* be declared to GCC once        *)
+                                    (* its dependants have            *)
+                                    (* been written.                  *)
+   HaveInitDefaultTypes: BOOLEAN ;  (* have we initialized them yet?  *)
+   WatchList           : Set ;      (* Set of symbols being watched   *)
+   EnumerationIndex    : Index ;
+   action              : IsAction ;
+   enumDeps            : BOOLEAN ;
+   M2LinkIndex         : Index ;    (* Array of M2LinkEntry.          *)
+
+
+PROCEDURE mystop ; BEGIN END mystop ;
+
+(* ***************************************************
+(*
+   PrintNum -
+*)
+
+PROCEDURE PrintNum (sym: WORD) ;
+BEGIN
+   printf1 ('%d, ', sym)
+END PrintNum ;
+
+
+(*
+   DebugSet -
+*)
+
+PROCEDURE DebugSet (a: ARRAY OF CHAR; l: Set) ;
+BEGIN
+   printf0(a) ;
+   printf0(' {') ;
+   ForeachElementInSetDo (l, PrintNum) ;
+   printf0('}\n')
+END DebugSet ;
+
+
+(*
+   DebugSets -
+*)
+
+PROCEDURE DebugSets ;
+BEGIN
+   DebugSet('ToDoList', ToDoList) ;
+   DebugSet('HeldByAlignment', HeldByAlignment) ;
+   DebugSet('FinishedAlignment', FinishedAlignment) ;
+   DebugSet('PartiallyDeclared', PartiallyDeclared) ;
+   DebugSet('FullyDeclared', FullyDeclared) ;
+   DebugSet('NilTypedArrays', NilTypedArrays) ;
+   DebugSet('ToBeSolvedByQuads', ToBeSolvedByQuads)
+END DebugSets ;
+   ************************************************ *)
+
+
+(*
+   DebugNumber -
+*)
+
+PROCEDURE DebugNumber (a: ARRAY OF CHAR; s: Set) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   n := NoOfElementsInSet(s) ;
+   printf1(a, n) ;
+   FIO.FlushBuffer(FIO.StdOut)
+END DebugNumber ;
+
+
+(*
+   FindSetNumbers -
+*)
+
+PROCEDURE FindSetNumbers (VAR t, a, p, f, n, b: CARDINAL) : BOOLEAN ;
+VAR
+   t1, p1, f1, n1, b1, a1: CARDINAL ;
+   same                  : BOOLEAN ;
+BEGIN
+   t1 := NoOfElementsInSet(ToDoList) ;
+   a1 := NoOfElementsInSet(HeldByAlignment) ;
+   p1 := NoOfElementsInSet(PartiallyDeclared) ;
+   f1 := NoOfElementsInSet(FullyDeclared) ;
+   n1 := NoOfElementsInSet(NilTypedArrays) ;
+   b1 := NoOfElementsInSet(ToBeSolvedByQuads) ;
+   same := ((t=t1) AND (a=a1) AND (p=p1) AND (f=f1) AND (n=n1) AND (b=b1)) ;
+   t := t1 ;
+   a := a1 ;
+   p := p1 ;
+   f := f1 ;
+   n := n1 ;
+   b := b1 ;
+   RETURN( same )
+END FindSetNumbers ;
+
+
+(*
+   DebugSets -
+*)
+
+PROCEDURE DebugSetNumbers ;
+BEGIN
+   DebugNumber('ToDoList : %d\n', ToDoList) ;
+   DebugNumber('HeldByAlignment : %d\n', HeldByAlignment) ;
+   DebugNumber('PartiallyDeclared : %d\n', PartiallyDeclared) ;
+   DebugNumber('FullyDeclared : %d\n', FullyDeclared) ;
+   DebugNumber('NilTypedArrays : %d\n', NilTypedArrays) ;
+   DebugNumber('ToBeSolvedByQuads : %d\n', ToBeSolvedByQuads)
+END DebugSetNumbers ;
+
+
+(*
+   AddSymToWatch - adds symbol, sym, to the list of symbols
+                   to watch and annotate their movement between
+                   lists.
+*)
+
+PROCEDURE AddSymToWatch (sym: WORD) ;
+BEGIN
+   IF (sym#NulSym) AND (NOT IsElementInSet(WatchList, sym))
+   THEN
+      IncludeElementIntoSet(WatchList, sym) ;
+      WalkDependants(sym, AddSymToWatch) ;
+      printf1("watching symbol %d\n", sym) ;
+      FIO.FlushBuffer(FIO.StdOut)
+   END
+END AddSymToWatch ;
+
+
+(*
+   TryFindSymbol -
+*)
+
+(*
+PROCEDURE TryFindSymbol (module, symname: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   mn, sn: Name ;
+   mod   : CARDINAL ;
+BEGIN
+   mn := MakeKey(module) ;
+   sn := MakeKey(symname) ;
+   IF IsModuleSeen(mn)
+   THEN
+      mod := LookupModule (UnknownTokenNo, mn) ;
+      RETURN( GetLocalSym(mod, sn) )
+   ELSE
+      RETURN( NulSym )
+   END
+END TryFindSymbol ;
+*)
+
+
+(*
+   doInclude -
+*)
+
+PROCEDURE doInclude (l: Set; a: ARRAY OF CHAR; sym: CARDINAL) ;
+BEGIN
+   IF NOT IsElementInSet(l, sym)
+   THEN
+      printf0('rule: ') ;
+      WriteRule ;
+      printf0('  ') ;
+      printf1(a, sym) ;
+      FIO.FlushBuffer(FIO.StdOut) ;
+      IncludeElementIntoSet(l, sym)
+   END
+END doInclude ;
+
+
+(*
+   WatchIncludeList - include a symbol onto the set first checking
+                      whether it is already on the set and
+                      displaying a debug message if the set is
+                      changed.
+*)
+
+PROCEDURE WatchIncludeList (sym: CARDINAL; lt: ListType) ;
+BEGIN
+   IF IsElementInSet(WatchList, sym)
+   THEN
+      CASE lt OF
+
+      tobesolvedbyquads :  doInclude(ToBeSolvedByQuads, "symbol %d -> ToBeSolvedByQuads\n", sym) |
+      fullydeclared     :  doInclude(FullyDeclared, "symbol %d -> FullyDeclared\n", sym) ;
+                           IF sym=1265
+                           THEN
+                              mystop
+                           END |
+      partiallydeclared :  doInclude(PartiallyDeclared, "symbol %d -> PartiallyDeclared\n", sym) |
+      heldbyalignment   :  doInclude(HeldByAlignment, "symbol %d -> HeldByAlignment\n", sym) |
+      finishedalignment :  doInclude(FinishedAlignment, "symbol %d -> FinishedAlignment\n", sym) |
+      todolist          :  doInclude(ToDoList, "symbol %d -> ToDoList\n", sym) |
+      niltypedarrays    :  doInclude(NilTypedArrays, "symbol %d -> NilTypedArrays\n", sym)
+
+      ELSE
+         InternalError ('unknown list')
+      END
+   ELSE
+      CASE lt OF
+
+      tobesolvedbyquads :  IncludeElementIntoSet(ToBeSolvedByQuads, sym) |
+      fullydeclared     :  IncludeElementIntoSet(FullyDeclared, sym) |
+      partiallydeclared :  IncludeElementIntoSet(PartiallyDeclared, sym) |
+      heldbyalignment   :  IncludeElementIntoSet(HeldByAlignment, sym) |
+      finishedalignment :  IncludeElementIntoSet(FinishedAlignment, sym) |
+      todolist          :  IncludeElementIntoSet(ToDoList, sym) |
+      niltypedarrays    :  IncludeElementIntoSet(NilTypedArrays, sym)
+
+      ELSE
+         InternalError ('unknown list')
+      END
+   END
+END WatchIncludeList ;
+
+
+(*
+   doExclude -
+*)
+
+PROCEDURE doExclude (l: Set; a: ARRAY OF CHAR; sym: CARDINAL) ;
+BEGIN
+   IF IsElementInSet(l, sym)
+   THEN
+      printf0('rule: ') ;
+      WriteRule ;
+      printf0('  ') ;
+      printf1(a, sym) ;
+      FIO.FlushBuffer(FIO.StdOut) ;
+      ExcludeElementFromSet(l, sym)
+   END
+END doExclude ;
+
+
+(*
+   WatchRemoveList - remove a symbol onto the list first checking
+                     whether it is already on the list and
+                     displaying a debug message if the list is
+                     changed.
+*)
+
+PROCEDURE WatchRemoveList (sym: CARDINAL; lt: ListType) ;
+BEGIN
+   IF IsElementInSet(WatchList, sym)
+   THEN
+      CASE lt OF
+
+      tobesolvedbyquads :  doExclude(ToBeSolvedByQuads, "symbol %d off ToBeSolvedByQuads\n", sym) |
+      fullydeclared     :  doExclude(FullyDeclared, "symbol %d off FullyDeclared\n", sym) |
+      partiallydeclared :  doExclude(PartiallyDeclared, "symbol %d off PartiallyDeclared\n", sym) |
+      heldbyalignment   :  doExclude(HeldByAlignment, "symbol %d -> HeldByAlignment\n", sym) |
+      finishedalignment :  doExclude(FinishedAlignment, "symbol %d -> FinishedAlignment\n", sym) |
+      todolist          :  doExclude(ToDoList, "symbol %d off ToDoList\n", sym) |
+      niltypedarrays    :  doExclude(NilTypedArrays, "symbol %d off NilTypedArrays\n", sym)
+
+      ELSE
+         InternalError ('unknown list')
+      END
+   ELSE
+      CASE lt OF
+
+      tobesolvedbyquads :  ExcludeElementFromSet(ToBeSolvedByQuads, sym) |
+      fullydeclared     :  ExcludeElementFromSet(FullyDeclared, sym) |
+      partiallydeclared :  ExcludeElementFromSet(PartiallyDeclared, sym) |
+      heldbyalignment   :  ExcludeElementFromSet(HeldByAlignment, sym) |
+      finishedalignment :  ExcludeElementFromSet(FinishedAlignment, sym) |
+      todolist          :  ExcludeElementFromSet(ToDoList, sym) |
+      niltypedarrays    :  ExcludeElementFromSet(NilTypedArrays, sym)
+
+      ELSE
+         InternalError ('unknown list')
+      END
+   END
+END WatchRemoveList ;
+
+
+(*
+   GetEnumList -
+*)
+
+PROCEDURE GetEnumList (sym: CARDINAL) : Tree ;
+BEGIN
+   IF InBounds(EnumerationIndex, sym)
+   THEN
+      RETURN( GetIndice(EnumerationIndex, sym) )
+   ELSE
+      RETURN( NIL )
+   END
+END GetEnumList ;
+
+
+(*
+   PutEnumList -
+*)
+
+PROCEDURE PutEnumList (sym: CARDINAL; enumlist: Tree) ;
+BEGIN
+   PutIndice(EnumerationIndex, sym, enumlist)
+END PutEnumList ;
+
+
+(*
+   MarkExported - tell GCC to mark all exported procedures in module sym.
+*)
+
+PROCEDURE MarkExported (sym: CARDINAL) ;
+BEGIN
+   IF Optimizing
+   THEN
+      MarkFunctionReferenced(Mod2Gcc(sym)) ;
+      IF IsDefImp(sym) OR IsModule(sym)
+      THEN
+         ForeachExportedDo(sym, MarkExported)
+      END
+   END
+END MarkExported ;
+
+
+(*
+   Chained - checks to see that, sym, has not already been placed on a chain.
+             It returns the symbol, sym.
+*)
+
+PROCEDURE Chained (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF IsElementInSet(ChainedList, sym)
+   THEN
+      InternalError ('symbol has already been chained onto a previous list')
+   END ;
+   IncludeElementIntoSet(ChainedList, sym) ;
+   RETURN( sym )
+END Chained ;
+
+
+(*
+   DoStartDeclaration - returns a tree representing a symbol which has
+                        not yet been finished.  Used when declaring
+                        recursive types.
+*)
+
+PROCEDURE DoStartDeclaration (sym: CARDINAL; p: StartProcedure) : Tree ;
+VAR
+   location: location_t ;
+BEGIN
+   IF NOT GccKnowsAbout (sym)
+   THEN
+      location := TokenToLocation (GetDeclaredMod (sym)) ;
+      PreAddModGcc(sym, p (location, KeyToCharStar (GetFullSymName (sym))))
+   END ;
+   RETURN Mod2Gcc (sym)
+END DoStartDeclaration ;
+
+
+(*
+   ArrayComponentsDeclared - returns TRUE if array, sym,
+                             subscripts and type are known.
+*)
+
+PROCEDURE ArrayComponentsDeclared (sym: CARDINAL) : BOOLEAN ;
+VAR
+   Subscript      : CARDINAL ;
+   Type, High, Low: CARDINAL ;
+BEGIN
+   Subscript := GetArraySubscript(sym) ;
+   Assert(IsSubscript(Subscript)) ;
+   Type := GetDType(Subscript) ;
+   Low := GetTypeMin(Type) ;
+   High := GetTypeMax(Type) ;
+   RETURN( IsFullyDeclared(Type) AND
+           IsFullyDeclared(Low) AND
+           IsFullyDeclared(High) )
+END ArrayComponentsDeclared ;
+
+
+(*
+   GetRecordOfVarient -
+*)
+
+PROCEDURE GetRecordOfVarient (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF IsVarient(sym) OR IsFieldVarient(sym)
+   THEN
+      REPEAT
+         sym := GetParent(sym)
+      UNTIL IsRecord(sym)
+   END ;
+   RETURN( sym )
+END GetRecordOfVarient ;
+
+
+(*
+   CanDeclareRecordKind -
+*)
+
+PROCEDURE CanDeclareRecordKind (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   sym := GetRecordOfVarient(sym) ;
+   RETURN( IsRecord(sym) AND
+           ((GetDefaultRecordFieldAlignment(sym)=NulSym) OR
+            IsFullyDeclared(GetDefaultRecordFieldAlignment(sym))) )
+END CanDeclareRecordKind ;
+
+
+(*
+   DeclareRecordKind - works out whether record, sym, is packed or not.
+*)
+
+PROCEDURE DeclareRecordKind (sym: CARDINAL) ;
+BEGIN
+   IF IsRecord(sym)
+   THEN
+      DetermineIfRecordPacked(sym)
+   END ;
+   WatchIncludeList(sym, todolist) ;
+   WatchRemoveList(sym, heldbyalignment) ;
+   WatchIncludeList(sym, finishedalignment) ;
+   IF AllDependantsFullyDeclared(sym)
+   THEN
+      (* All good and ready to be solved. *)
+   END
+END DeclareRecordKind ;
+
+
+(*
+   CanDeclareRecord -
+*)
+
+PROCEDURE CanDeclareRecord (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   TraverseDependants(sym) ;
+   IF AllDependantsFullyDeclared(sym)
+   THEN
+      RETURN TRUE
+   ELSE
+      WatchIncludeList(sym, finishedalignment) ;
+      RETURN FALSE
+   END
+END CanDeclareRecord ;
+
+
+(*
+   FinishDeclareRecord -
+*)
+
+PROCEDURE FinishDeclareRecord (sym: CARDINAL) ;
+BEGIN
+   DeclareTypeConstFully(sym) ;
+   WatchRemoveList(sym, heldbyalignment) ;
+   WatchRemoveList(sym, finishedalignment) ;
+   WatchRemoveList(sym, todolist) ;
+   WatchIncludeList(sym, fullydeclared)
+END FinishDeclareRecord ;
+
+
+(*
+   CanDeclareTypePartially - return TRUE if we are able to make a
+                             gcc partially created type.
+*)
+
+PROCEDURE CanDeclareTypePartially (sym: CARDINAL) : BOOLEAN ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   IF IsElementInSet(PartiallyDeclared, sym)
+   THEN
+      RETURN( FALSE )
+   ELSIF IsProcType(sym) OR IsRecord(sym) OR IsVarient(sym) OR IsFieldVarient(sym)
+   THEN
+      RETURN( TRUE )
+   ELSIF IsType(sym)
+   THEN
+      type := GetSType(sym) ;
+      IF (type#NulSym) AND IsNilTypedArrays(type)
+      THEN
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END CanDeclareTypePartially ;
+
+
+(*
+   DeclareTypePartially - create the gcc partial type symbol from, sym.
+*)
+
+PROCEDURE DeclareTypePartially (sym: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   (* check to see if we have already partially declared the symbol *)
+   IF NOT IsElementInSet(PartiallyDeclared, sym)
+   THEN
+      IF IsRecord(sym)
+      THEN
+         Assert (NOT IsElementInSet (HeldByAlignment, sym)) ;
+         Assert (DoStartDeclaration (sym, BuildStartRecord) # NIL) ;
+         WatchIncludeList (sym, heldbyalignment)
+      ELSIF IsVarient (sym)
+      THEN
+         Assert(NOT IsElementInSet(HeldByAlignment, sym)) ;
+         Assert (DoStartDeclaration(sym, BuildStartVarient) # NIL) ;
+         WatchIncludeList(sym, heldbyalignment)
+      ELSIF IsFieldVarient(sym)
+      THEN
+         Assert(NOT IsElementInSet(HeldByAlignment, sym)) ;
+         Assert (DoStartDeclaration(sym, BuildStartFieldVarient) # NIL) ;
+         WatchIncludeList(sym, heldbyalignment)
+      ELSIF IsProcType(sym)
+      THEN
+         Assert (DoStartDeclaration(sym, BuildStartFunctionType) # NIL) ;
+      ELSIF IsType(sym)
+      THEN
+         IF NOT GccKnowsAbout(sym)
+         THEN
+            location := TokenToLocation(GetDeclaredMod(sym)) ;
+            PreAddModGcc(sym, BuildStartType(location,
+                                             KeyToCharStar(GetFullSymName(sym)),
+                                             Mod2Gcc(GetSType(sym))))
+         END
+      ELSE
+         InternalError ('do not know how to create a partial type from this symbol')
+      END ;
+      WatchIncludeList(sym, partiallydeclared) ;
+      TraverseDependants(sym)
+   END
+END DeclareTypePartially ;
+
+
+(*
+   CanDeclareArrayAsNil -
+*)
+
+PROCEDURE CanDeclareArrayAsNil (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsArray(sym) AND ArrayComponentsDeclared(sym) )
+END CanDeclareArrayAsNil ;
+
+
+(*
+   DeclareArrayAsNil -
+*)
+
+PROCEDURE DeclareArrayAsNil (sym: CARDINAL) ;
+BEGIN
+   PreAddModGcc(sym, BuildStartArrayType(BuildIndex(GetDeclaredMod(sym), sym), NIL, GetDType(sym))) ;
+   WatchIncludeList(sym, niltypedarrays)
+END DeclareArrayAsNil ;
+
+
+(*
+   CanDeclareArrayPartially -
+*)
+
+PROCEDURE CanDeclareArrayPartially (sym: CARDINAL) : BOOLEAN ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   IF IsArray(sym)
+   THEN
+      type := GetSType(sym) ;
+      IF IsPartiallyOrFullyDeclared(type) OR
+         (IsPointer(type) AND IsNilTypedArrays(type))
+      THEN
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END CanDeclareArrayPartially ;
+
+
+(*
+   DeclareArrayPartially -
+*)
+
+PROCEDURE DeclareArrayPartially (sym: CARDINAL) ;
+BEGIN
+   Assert(IsArray(sym) AND GccKnowsAbout(sym)) ;
+   PutArrayType(Mod2Gcc(sym), Mod2Gcc(GetSType(sym))) ;
+   WatchIncludeList(sym, partiallydeclared)
+END DeclareArrayPartially ;
+
+
+(*
+   CanDeclarePointerToNilArray -
+*)
+
+PROCEDURE CanDeclarePointerToNilArray (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsPointer(sym) AND IsNilTypedArrays(GetSType(sym)) )
+END CanDeclarePointerToNilArray ;
+
+
+(*
+   DeclarePointerToNilArray -
+*)
+
+PROCEDURE DeclarePointerToNilArray (sym: CARDINAL) ;
+BEGIN
+   PreAddModGcc(sym, BuildPointerType(Mod2Gcc(GetSType(sym)))) ;
+   WatchIncludeList(sym, niltypedarrays)
+END DeclarePointerToNilArray ;
+
+
+(*
+   CanPromotePointerFully -
+*)
+
+PROCEDURE CanPromotePointerFully (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsPointer(sym) AND IsPartiallyOrFullyDeclared(GetSType(sym)) )
+END CanPromotePointerFully ;
+
+
+(*
+   PromotePointerFully -
+*)
+
+PROCEDURE PromotePointerFully (sym: CARDINAL) ;
+BEGIN
+   WatchIncludeList(sym, fullydeclared)
+END PromotePointerFully ;
+
+
+(*
+   CompletelyResolved - returns TRUE if a symbols has been completely resolved
+                        and is not partically declared (such as a record).
+*)
+
+PROCEDURE CompletelyResolved (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsElementInSet(FullyDeclared, sym) )
+END CompletelyResolved ;
+
+
+(*
+   IsTypeQ - returns TRUE if all q(dependants) of, sym,
+             return TRUE.
+*)
+
+PROCEDURE IsTypeQ (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+BEGIN
+   IF IsVar(sym)
+   THEN
+      RETURN( IsVarDependants(sym, q) )
+   ELSIF IsEnumeration(sym)
+   THEN
+      RETURN( IsEnumerationDependants(sym, q) )
+   ELSIF IsFieldEnumeration(sym)
+   THEN
+      RETURN( TRUE )
+   ELSIF IsSubrange(sym)
+   THEN
+      RETURN( IsSubrangeDependants(sym, q) )
+   ELSIF IsPointer(sym)
+   THEN
+      RETURN( IsPointerDependants(sym, q) )
+   ELSIF IsRecord(sym)
+   THEN
+      RETURN( IsRecordDependants(sym, q) )
+   ELSIF IsRecordField(sym)
+   THEN
+      RETURN( IsRecordFieldDependants(sym, q) )
+   ELSIF IsVarient(sym)
+   THEN
+      RETURN( IsVarientDependants(sym, q) )
+   ELSIF IsFieldVarient(sym)
+   THEN
+      RETURN( IsVarientFieldDependants(sym, q) )
+   ELSIF IsArray(sym)
+   THEN
+      RETURN( IsArrayDependants(sym, q) )
+   ELSIF IsProcType(sym)
+   THEN
+      RETURN( IsProcTypeDependants(sym, q) )
+   ELSIF IsUnbounded(sym)
+   THEN
+      RETURN( IsUnboundedDependants(sym, q) )
+   ELSIF IsPartialUnbounded(sym)
+   THEN
+      InternalError ('should not be declaring a partial unbounded symbol')
+   ELSIF IsSet(sym)
+   THEN
+      RETURN( IsSetDependants(sym, q) )
+   ELSIF IsType(sym)
+   THEN
+      RETURN( IsTypeDependants(sym, q) )
+   ELSIF IsConst(sym)
+   THEN
+      RETURN( IsConstDependants(sym, q) )
+   ELSIF IsConstructor(sym) OR IsConstSet(sym)
+   THEN
+      (* sym can be a constructor, but at present we have not resolved whether
+         all dependants are constants.
+       *)
+      RETURN( IsConstructorDependants(sym, q) )
+   ELSIF IsProcedure(sym)
+   THEN
+      RETURN( IsProcedureDependants(sym, q) )
+   ELSE
+      RETURN( TRUE )
+   END
+END IsTypeQ ;
+
+
+(*
+   IsNilTypedArrays - returns TRUE if, sym, is dependant upon a NIL typed array
+*)
+
+PROCEDURE IsNilTypedArrays (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsElementInSet(NilTypedArrays, sym) )
+END IsNilTypedArrays ;
+
+
+(*
+   IsFullyDeclared - returns TRUE if, sym, is fully declared.
+*)
+
+PROCEDURE IsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsElementInSet(FullyDeclared, sym) )
+END IsFullyDeclared ;
+
+
+(*
+   AllDependantsFullyDeclared - returns TRUE if all dependants of,
+                                sym, are declared.
+*)
+
+PROCEDURE AllDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsTypeQ(sym, IsFullyDeclared) )
+END AllDependantsFullyDeclared ;
+
+
+(*
+   NotAllDependantsFullyDeclared - returns TRUE if any dependants of,
+                                   sym, are not declared.
+*)
+
+PROCEDURE NotAllDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( NOT IsTypeQ(sym, IsFullyDeclared) )
+END NotAllDependantsFullyDeclared ;
+
+
+(*
+   IsPartiallyDeclared - returns TRUE if, sym, is partially declared.
+*)
+
+PROCEDURE IsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsElementInSet(PartiallyDeclared, sym) )
+END IsPartiallyDeclared ;
+
+
+(*
+   AllDependantsPartiallyDeclared - returns TRUE if all dependants of,
+                                    sym, are partially declared.
+*)
+
+PROCEDURE AllDependantsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsTypeQ(sym, IsPartiallyDeclared) )
+END AllDependantsPartiallyDeclared ;
+
+
+(*
+   NotAllDependantsPartiallyDeclared - returns TRUE if any dependants of,
+                                       sym, are not partially declared.
+*)
+
+PROCEDURE NotAllDependantsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( NOT IsTypeQ(sym, IsPartiallyDeclared) )
+END NotAllDependantsPartiallyDeclared ;
+
+
+(*
+   IsPartiallyOrFullyDeclared - returns TRUE if, sym, is partially or fully declared.
+*)
+
+PROCEDURE IsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsElementInSet(PartiallyDeclared, sym) OR
+           IsElementInSet(FullyDeclared, sym) )
+END IsPartiallyOrFullyDeclared ;
+
+
+(*
+   AllDependantsPartiallyOrFullyDeclared - returns TRUE if all dependants of,
+                                           sym, are partially or fully declared.
+*)
+
+PROCEDURE AllDependantsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsTypeQ(sym, IsPartiallyOrFullyDeclared) )
+END AllDependantsPartiallyOrFullyDeclared ;
+
+
+(*
+   NotAllDependantsPartiallyOrFullyDeclared - returns TRUE if all dependants of,
+                                              sym, are not partially and not fully
+                                              declared.
+*)
+
+(*
+PROCEDURE NotAllDependantsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsTypeQ(sym, IsPartiallyOrFullyDeclared) )
+END NotAllDependantsPartiallyOrFullyDeclared ;
+*)
+
+
+(*
+   TypeConstDependantsFullyDeclared - returns TRUE if sym is a constant or
+                                      type and its dependants are fully
+                                      declared.
+*)
+
+PROCEDURE TypeConstDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (NOT IsVar(sym)) AND
+           (NOT IsRecord(sym)) AND
+           (NOT IsParameter(sym)) AND
+           AllDependantsFullyDeclared(sym) )
+END TypeConstDependantsFullyDeclared ;
+
+
+(*
+   CanBeDeclaredViaPartialDependants - returns TRUE if this symbol
+                                       can be declared by partial
+                                       dependants.  Such a symbol must
+                                       be a record, proctype or
+                                       an array.
+*)
+
+PROCEDURE CanBeDeclaredViaPartialDependants (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (IsPointer(sym) OR IsProcType(sym)) AND
+           AllDependantsPartiallyOrFullyDeclared(sym) )
+END CanBeDeclaredViaPartialDependants ;
+
+
+(*
+   DeclareConstFully - will add, sym, to the fully declared list and
+                       also remove it from the to do list.  This is
+                       called indirectly from M2GenGCC as it calculates
+                       constants during quadruple processing.
+*)
+
+PROCEDURE DeclareConstFully (sym: CARDINAL) ;
+BEGIN
+   WatchIncludeList(sym, fullydeclared) ;
+   WatchRemoveList(sym, todolist) ;
+   WatchRemoveList(sym, partiallydeclared) ;
+   WatchRemoveList(sym, tobesolvedbyquads)
+END DeclareConstFully ;
+
+
+(*
+   PutToBeSolvedByQuads - places, sym, to this list and returns,
+                          sym.
+*)
+
+PROCEDURE PutToBeSolvedByQuads (sym: CARDINAL) ;
+BEGIN
+   WatchIncludeList(sym, tobesolvedbyquads)
+END PutToBeSolvedByQuads ;
+
+
+(*
+   DeclareTypeConstFully - declare the GCC type and add the double
+                           book keeping entry.
+*)
+
+PROCEDURE DeclareTypeConstFully (sym: CARDINAL) ;
+VAR
+   t: Tree ;
+BEGIN
+   IF NOT IsElementInSet(ToBeSolvedByQuads, sym)
+   THEN
+      IF IsModule(sym) OR IsDefImp(sym)
+      THEN
+         WatchIncludeList(sym, fullydeclared) ;
+         WatchRemoveList(sym, partiallydeclared) ;
+         WatchRemoveList(sym, todolist)
+      ELSIF IsProcedure(sym)
+      THEN
+         DeclareProcedureToGcc(sym) ;
+         WatchIncludeList(sym, fullydeclared) ;
+         WatchRemoveList(sym, partiallydeclared) ;
+         WatchRemoveList(sym, todolist)
+      ELSE
+         t := TypeConstFullyDeclared(sym) ;
+         IF t#NIL
+         THEN
+            (* add relationship between gccsym and sym *)
+            PreAddModGcc(sym, t) ;
+            WatchIncludeList(sym, fullydeclared) ;
+            WatchRemoveList(sym, partiallydeclared) ;
+            WatchRemoveList(sym, heldbyalignment) ;
+            WatchRemoveList(sym, finishedalignment) ;
+            WatchRemoveList(sym, todolist)
+         END
+      END
+   END
+END DeclareTypeConstFully ;
+
+
+(*
+   DeclareTypeFromPartial - declare the full GCC type from a partial type
+                            and add the double book keeping entry.
+*)
+
+PROCEDURE DeclareTypeFromPartial (sym: CARDINAL) ;
+VAR
+   t: Tree ;
+BEGIN
+   t := CompleteDeclarationOf(sym) ;
+   IF t=NIL
+   THEN
+      InternalError ('expecting to be able to create a gcc type')
+   ELSE
+      AddModGcc(sym, t) ;
+      WatchIncludeList(sym, fullydeclared) ;
+      WatchRemoveList(sym, partiallydeclared)
+   END
+END DeclareTypeFromPartial ;
+
+
+(*
+   DeclarePointerTypeFully - if, sym, is a pointer type then
+                             declare it.
+*)
+
+(*
+PROCEDURE DeclarePointerTypeFully (sym: CARDINAL) ;
+BEGIN
+   IF IsPointer(sym)
+   THEN
+      WatchIncludeList(sym, fullydeclared) ;
+      WatchRemoveList(sym, partiallydeclared) ;
+      WatchRemoveList(sym, todolist) ;
+      PreAddModGcc(sym, DeclarePointer(sym))
+   ELSE
+      (* place sym and all dependants on the todolist
+         providing they are not already on the FullyDeclared list
+      *)
+      TraverseDependants(sym)
+   END
+END DeclarePointerTypeFully ;
+*)
+
+
+(*
+   CanBeDeclaredPartiallyViaPartialDependants - returns TRUE if, sym,
+                                                can be partially declared via
+                                                another partially declared type.
+*)
+
+PROCEDURE CanBeDeclaredPartiallyViaPartialDependants (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsType(sym) AND AllDependantsPartiallyDeclared(sym) )
+END CanBeDeclaredPartiallyViaPartialDependants ;
+
+
+(*
+   EmitCircularDependancyError - issue a dependancy error.
+*)
+
+PROCEDURE EmitCircularDependancyError (sym: CARDINAL) ;
+BEGIN
+   MetaError1('circular dependancy error found when trying to resolve {%1Uad}',
+              sym)
+END EmitCircularDependancyError ;
+
+
+TYPE
+   Rule = (norule, partialtype, arraynil, pointernilarray, arraypartial,
+           pointerfully, recordkind, recordfully, typeconstfully,
+           pointerfrompartial, typefrompartial, partialfrompartial,
+           partialtofully, circulartodo, circularpartial, circularniltyped) ;
+
+VAR
+   bodyp          : WalkAction ;
+   bodyq          : IsAction ;
+   bodyt          : ListType ;
+   bodyl          : Set ;
+   bodyr          : Rule ;
+   recursionCaught,
+   oneResolved,
+   noMoreWritten  : BOOLEAN ;
+
+
+(*
+   WriteRule - writes out the name of the rule.
+*)
+
+PROCEDURE WriteRule ;
+BEGIN
+   IF Debugging
+   THEN
+      CASE bodyr OF
+
+      norule            :  printf0('norule') |
+      partialtype       :  printf0('partialtype') |
+      arraynil          :  printf0('arraynil') |
+      pointernilarray   :  printf0('pointernilarray') |
+      arraypartial      :  printf0('arraypartial') |
+      pointerfully      :  printf0('pointerfully') |
+      recordkind        :  printf0('recordkind') |
+      recordfully       :  printf0('recordfully') |
+      typeconstfully    :  printf0('typeconstfully') |
+      pointerfrompartial:  printf0('pointerfrompartial') |
+      typefrompartial   :  printf0('typefrompartial') |
+      partialfrompartial:  printf0('partialfrompartial') |
+      partialtofully    :  printf0('partialtofully') |
+      circulartodo      :  printf0('circulartodo') |
+      circularpartial   :  printf0('circularpartial') |
+      circularniltyped  :  printf0('circularniltyped')
+
+      ELSE
+         InternalError ('unknown rule')
+      END
+   END
+END WriteRule ;
+
+
+(*
+   Body -
+*)
+
+PROCEDURE Body (sym: CARDINAL) ;
+BEGIN
+   IF bodyq(sym)
+   THEN
+      WatchRemoveList(sym, bodyt) ;
+      bodyp(sym) ;
+      (* bodyp(sym) might have replaced sym into the set *)
+      IF NOT IsElementInSet(bodyl, sym)
+      THEN
+         noMoreWritten := FALSE ;
+         oneResolved := TRUE
+      END
+   END
+END Body ;
+
+
+(*
+   ForeachTryDeclare - while q(of one sym in l) is true
+                          for each symbol in, l,
+                          if q(sym)
+                          then
+                             p(sym)
+                          end
+                       end
+*)
+
+PROCEDURE ForeachTryDeclare (t: ListType; l: Set; r: Rule;
+                             q: IsAction; p: WalkAction) : BOOLEAN ;
+BEGIN
+   IF recursionCaught
+   THEN
+      InternalError ('caught recursive cycle in ForeachTryDeclare')
+   END ;
+   bodyt := t ;
+   bodyq := q ;
+   bodyp := p ;
+   bodyl := l ;
+   bodyr := r ;
+   recursionCaught := TRUE ;
+   oneResolved := FALSE ;
+   REPEAT
+      noMoreWritten := TRUE ;
+      ForeachElementInSetDo(l, Body)
+   UNTIL noMoreWritten ;
+   bodyr := norule ;
+   recursionCaught := FALSE ;
+   RETURN( oneResolved )
+END ForeachTryDeclare ;
+
+
+(*
+   DeclaredOutandingTypes - writes out any types that have their
+                            dependants solved.  It returns TRUE if
+                            all outstanding types have been written.
+*)
+
+PROCEDURE DeclaredOutstandingTypes (ForceComplete: BOOLEAN) : BOOLEAN ;
+VAR
+   finished        : BOOLEAN ;
+   d, a, p, f, n, b: CARDINAL ;
+BEGIN
+   d := 0 ;
+   a := 0 ;
+   p := 0 ;
+   f := 0 ;
+   n := 0 ;
+   b := 0 ;
+   finished := FALSE ;
+   REPEAT
+      IF FindSetNumbers (d, a, p, f, n, b) OR Progress
+      THEN
+         DebugSetNumbers
+      END ;
+      IF ForeachTryDeclare (todolist, ToDoList,
+                            partialtype,
+                            CanDeclareTypePartially,
+                            DeclareTypePartially)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (todolist, ToDoList,
+                               arraynil,
+                               CanDeclareArrayAsNil,
+                               DeclareArrayAsNil)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (todolist, ToDoList,
+                               pointernilarray,
+                               CanDeclarePointerToNilArray,
+                               DeclarePointerToNilArray)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays,
+                               arraypartial,
+                               CanDeclareArrayPartially,
+                               DeclareArrayPartially)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays,
+                               pointerfully,
+                               CanPromotePointerFully,
+                               PromotePointerFully)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (heldbyalignment, HeldByAlignment,
+                               recordkind,
+                               CanDeclareRecordKind,
+                               DeclareRecordKind)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (finishedalignment, FinishedAlignment,
+                               recordfully,
+                               CanDeclareRecord,
+                               FinishDeclareRecord)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (todolist, ToDoList,
+                               typeconstfully,
+                               TypeConstDependantsFullyDeclared,
+                               DeclareTypeConstFully)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (todolist, ToDoList,
+                               (* partiallydeclared, PartiallyDeclared, *)
+                               typefrompartial,
+                               CanBeDeclaredViaPartialDependants,
+                               DeclareTypeFromPartial)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared,
+                               partialfrompartial,
+                               CanBeDeclaredPartiallyViaPartialDependants,
+                               DeclareTypePartially)
+      THEN
+         (* continue looping *)
+      ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared,
+                               partialtofully,
+                               TypeConstDependantsFullyDeclared,
+                               DeclareTypeConstFully)
+      THEN
+         (* continue looping *)
+      ELSE
+         (* nothing left to do (and constants are resolved elsewhere) *)
+         finished := TRUE
+      END
+   UNTIL finished ;
+   IF ForceComplete
+   THEN
+      IF ForeachTryDeclare (todolist, ToDoList,
+                            circulartodo,
+                            NotAllDependantsFullyDeclared,
+                            EmitCircularDependancyError)
+      THEN
+      ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared,
+                               circularpartial,
+                               NotAllDependantsPartiallyDeclared,
+                               EmitCircularDependancyError)
+      THEN
+      ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays,
+                               circularniltyped,
+                               NotAllDependantsPartiallyDeclared,
+                               EmitCircularDependancyError)
+      THEN
+      END
+   END ;
+   RETURN NoOfElementsInSet (ToDoList) = 0
+END DeclaredOutstandingTypes ;
+
+
+(*
+   CompleteDeclarationOf - returns the GCC Tree for, sym, if it can
+                           be created from partially or fully declared
+                           dependents.
+*)
+
+PROCEDURE CompleteDeclarationOf (sym: CARDINAL) : Tree ;
+BEGIN
+   IF IsArray(sym)
+   THEN
+      RETURN( DeclareArray(sym) )
+   ELSIF IsProcType(sym)
+   THEN
+      RETURN( DeclareProcType(sym) )
+   ELSIF IsRecordField(sym)
+   THEN
+      RETURN( DeclareRecordField(sym) )
+   ELSIF IsPointer(sym)
+   THEN
+      RETURN( DeclarePointer(sym) )
+   ELSE
+      RETURN( NIL )
+   END
+END CompleteDeclarationOf ;
+
+
+(*
+   DeclareType - here a type has been created via TYPE foo = bar,
+                 we must tell GCC about it.
+*)
+
+PROCEDURE DeclareType (sym: CARDINAL) : Tree ;
+VAR
+   t       : Tree ;
+   location: location_t ;
+BEGIN
+   IF GetSType(sym)=NulSym
+   THEN
+      MetaError1('base type {%1Ua} not understood', sym) ;
+      InternalError ('base type should have been declared')
+   ELSE
+      IF GetSymName(sym)=NulName
+      THEN
+         RETURN( Tree(Mod2Gcc(GetSType(sym))) )
+      ELSE
+         location := TokenToLocation(GetDeclaredMod(sym)) ;
+         IF GccKnowsAbout(sym)
+         THEN
+            t := Mod2Gcc(sym)
+         ELSE
+            (* not partially declared therefore start it *)
+            t := BuildStartType(location,
+                                KeyToCharStar(GetFullSymName(sym)), Mod2Gcc(GetSType(sym)))
+         END ;
+         t := BuildEndType(location, t) ;  (* now finish it *)
+         RETURN( t )
+      END
+   END
+END DeclareType ;
+
+
+(*
+   DeclareIntegerConstant - declares an integer constant.
+*)
+
+(*
+PROCEDURE DeclareIntegerConstant (sym: CARDINAL; value: INTEGER) ;
+BEGIN
+   PreAddModGcc(sym, BuildIntegerConstant(value)) ;
+   WatchRemoveList(sym, todolist) ;
+   WatchIncludeList(sym, fullydeclared)
+END DeclareIntegerConstant ;
+*)
+
+
+(*
+   DeclareIntegerFromTree - declares an integer constant from a Tree, value.
+*)
+
+PROCEDURE DeclareConstantFromTree (sym: CARDINAL; value: Tree) ;
+BEGIN
+   PreAddModGcc(sym, value) ;
+   WatchRemoveList(sym, todolist) ;
+   WatchIncludeList(sym, fullydeclared)
+END DeclareConstantFromTree ;
+
+
+(*
+   DeclareCharConstant - declares a character constant.
+*)
+
+PROCEDURE DeclareCharConstant (sym: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(sym)) ;
+   PreAddModGcc(sym, BuildCharConstant(location, KeyToCharStar(GetString(sym)))) ;
+   WatchRemoveList(sym, todolist) ;
+   WatchIncludeList(sym, fullydeclared)
+END DeclareCharConstant ;
+
+
+(*
+   DeclareStringConstant - declares a string constant.
+*)
+
+PROCEDURE DeclareStringConstant (sym: CARDINAL) ;
+VAR
+   symtree : Tree ;
+BEGIN
+   IF IsConstStringM2nul (sym) OR IsConstStringCnul (sym)
+   THEN
+      (* in either case the string needs a nul terminator.  If the string
+         is a C variant it will already have had any escape characters applied.
+         The BuildCStringConstant only adds the nul terminator.  *)
+      symtree := BuildCStringConstant (KeyToCharStar (GetString (sym)),
+                                       GetStringLength (sym))
+   ELSE
+      symtree := BuildStringConstant (KeyToCharStar (GetString (sym)),
+                                      GetStringLength (sym))
+   END ;
+   PreAddModGcc (sym, symtree) ;
+   WatchRemoveList (sym, todolist) ;
+   WatchIncludeList (sym, fullydeclared)
+END DeclareStringConstant ;
+
+
+(*
+   PromoteToString - declare, sym, and then promote it to a string.
+                     Note that if sym is a single character we do
+                          *not* record it as a string
+                          but as a char however we always
+                          return a string constant.
+*)
+
+PROCEDURE PromoteToString (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
+VAR
+   size: CARDINAL ;
+BEGIN
+   DeclareConstant (tokenno, sym) ;
+   size := GetStringLength (sym) ;
+   IF size > 1
+   THEN
+      (* will be a string anyway *)
+      RETURN Tree (Mod2Gcc (sym))
+   ELSE
+      RETURN BuildStringConstant (KeyToCharStar (GetString (sym)),
+                                  GetStringLength (sym))
+   END
+END PromoteToString ;
+
+
+(*
+   WalkConstructor - walks all dependants of, sym.
+*)
+
+PROCEDURE WalkConstructor (sym: CARDINAL; p: WalkAction) ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   type := GetSType(sym) ;
+   IF type#NulSym
+   THEN
+      WalkDependants(type, p) ;
+      WalkConstructorDependants(sym, p)
+   END
+END WalkConstructor ;
+
+
+(*
+   DeclareConstructor - declares a constructor.
+*)
+
+PROCEDURE DeclareConstructor (tokenno: CARDINAL; quad: CARDINAL; sym: CARDINAL) ;
+BEGIN
+   IF sym=NulSym
+   THEN
+      InternalError ('trying to declare the NulSym')
+   END ;
+   IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym))
+   THEN
+      WalkConstructor(sym, TraverseDependants) ;
+      DeclareTypesConstantsProceduresInRange(quad, quad) ;
+      Assert(IsConstructorDependants(sym, IsFullyDeclared)) ;
+      PushValue(sym) ;
+      DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
+   END
+END DeclareConstructor ;
+
+
+(*
+   TryDeclareConstructor - try and declare a constructor.  If, sym, is a
+                           constructor try and declare it, if we cannot
+                           then enter it into the to do list.
+*)
+
+PROCEDURE TryDeclareConstructor (tokenno: CARDINAL; sym: CARDINAL) ;
+BEGIN
+   IF sym#NulSym
+   THEN
+      IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym))
+      THEN
+         WalkConstructor(sym, TraverseDependants) ;
+         IF NOT IsElementInSet(ToBeSolvedByQuads, sym)
+         THEN
+            TryEvaluateValue(sym) ;
+            IF IsConstructorDependants(sym, IsFullyDeclared)
+            THEN
+               PushValue(sym) ;
+               DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
+            END
+         END
+      END
+   END
+END TryDeclareConstructor ;
+
+
+(*
+   WalkConst - walks all dependants of, sym.
+*)
+
+PROCEDURE WalkConst (sym: CARDINAL; p: WalkAction) ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   Assert (IsConst (sym)) ;
+   type := GetSType (sym) ;
+   IF type # NulSym
+   THEN
+      p (type)
+   END ;
+   IF IsConstSet (sym) OR IsConstructor (sym)
+   THEN
+      WalkConstructor (sym, p)
+   END
+END WalkConst ;
+
+
+(*
+   IsConstDependants - returns TRUE if the symbol, sym,
+                       q(dependants) all return TRUE.
+*)
+
+PROCEDURE IsConstDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   Assert (IsConst (sym)) ;
+   type := GetSType (sym) ;
+   IF type # NulSym
+   THEN
+      IF NOT q (type)
+      THEN
+         RETURN FALSE
+      END
+   END ;
+   IF IsConstSet (sym) OR IsConstructor (sym)
+   THEN
+      RETURN IsConstructorDependants (sym, q)
+   END ;
+   RETURN IsValueSolved (sym)
+END IsConstDependants ;
+
+
+(*
+   TryDeclareConstant - try and declare a constant.  If, sym, is a
+                        constant try and declare it, if we cannot
+                        then enter it into the to do list.
+*)
+
+PROCEDURE TryDeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   TryDeclareConstructor(tokenno, sym) ;
+   IF IsConst(sym)
+   THEN
+      TraverseDependants(sym) ;
+      type := GetSType(sym) ;
+      IF (type#NulSym) AND (NOT CompletelyResolved(type))
+      THEN
+         TraverseDependants(sym) ;
+(*
+         WatchIncludeList(sym, todolist) ;
+         WatchIncludeList(type, todolist) ;
+*)
+         RETURN
+      END ;
+      IF IsConstructor(sym) AND (NOT IsConstructorConstant(sym))
+      THEN
+         TraverseDependants(sym) ;
+(*
+         WatchIncludeList(sym, todolist) ;
+*)
+         RETURN
+      END ;
+      IF (IsConstructor(sym) OR IsConstSet(sym)) AND (type=NulSym)
+      THEN
+(*
+         WatchIncludeList(sym, todolist) ;
+*)
+         TraverseDependants(sym) ;
+         RETURN
+      END ;
+      IF IsElementInSet(ToBeSolvedByQuads, sym)
+      THEN
+         (* we allow the above rules to be executed even if it is fully declared
+            so to ensure that types of compiler builtin constants (BitsetSize
+            etc) are fully declared.
+
+            However at this point if, sym, is fully declared we return
+         *)
+         IF IsFullyDeclared(sym)
+         THEN
+            RETURN
+         END ;
+         TraverseDependants(sym) ;
+(*
+         WatchIncludeList(sym, todolist)
+*)
+      ELSE
+         TryDeclareConst(tokenno, sym)
+      END
+   END
+END TryDeclareConstant ;
+
+
+(*
+   DeclareConstant - checks to see whether, sym, is a constant and
+                     declares the constant to gcc.
+*)
+
+PROCEDURE DeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ;
+VAR
+   type: CARDINAL ;
+   t   : Tree ;
+BEGIN
+   IF IsConst(sym)
+   THEN
+      TraverseDependants(sym) ;
+      type := GetSType(sym) ;
+      Assert((type=NulSym) OR CompletelyResolved(type)) ;
+      Assert((NOT IsConstructor(sym)) OR IsConstructorConstant(sym)) ;
+      Assert((type#NulSym) OR (NOT (IsConstructor(sym) OR IsConstSet(sym)))) ;
+      t := DeclareConst(tokenno, sym) ;
+      Assert(t#NIL)
+   END
+END DeclareConstant ;
+
+
+(*
+   TryDeclareConst - try to declare a const to gcc.  If it cannot
+                     declare the symbol it places it into the
+                     todolist.
+*)
+
+PROCEDURE TryDeclareConst (tokenno: CARDINAL; sym: CARDINAL) ;
+VAR
+   type,
+   size: CARDINAL ;
+BEGIN
+   IF NOT GccKnowsAbout(sym)
+   THEN
+      IF IsConstructor(sym) OR IsConstSet(sym)
+      THEN
+         WalkConstructorDependants(sym, TraverseDependants) ;
+         TryEvaluateValue(sym) ;
+         IF NOT IsConstructorDependants(sym, IsFullyDeclared)
+         THEN
+(*
+            WatchIncludeList(sym, todolist) ;
+*)
+            TraverseDependants(sym) ;
+            RETURN
+         END ;
+         IF NOT IsConstructorConstant(sym)
+         THEN
+            RETURN
+         END
+      END ;
+      IF IsConstString(sym)
+      THEN
+         size := GetStringLength(sym) ;
+         IF size=1
+         THEN
+            DeclareCharConstant(sym)
+         ELSE
+            DeclareStringConstant (sym)
+         END
+      ELSIF IsValueSolved(sym)
+      THEN
+         PushValue(sym) ;
+         IF IsConstSet(sym)
+         THEN
+            DeclareConstantFromTree(sym, PopSetTree(tokenno))
+         ELSIF IsConstructor(sym)
+         THEN
+            DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
+         ELSIF IsRealType(GetDType(sym))
+         THEN
+            type := GetDType(sym) ;
+            DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopRealTree(), TRUE))
+         ELSIF IsComplexType(GetDType(sym))
+         THEN
+            type := GetDType(sym) ;
+            DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopComplexTree(), TRUE))
+         ELSE
+            IF GetSType(sym)=NulSym
+            THEN
+               type := ZType
+            ELSE
+               type := GetDType(sym)
+            END ;
+            DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopIntegerTree(), TRUE))
+         END
+      ELSE
+         TraverseDependants(sym)
+      END
+   END
+END TryDeclareConst ;
+
+
+(*
+   DeclareConst - declares a const to gcc and returns a Tree.
+*)
+
+PROCEDURE DeclareConst (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
+VAR
+   type: CARDINAL ;
+   size: CARDINAL ;
+BEGIN
+   IF GccKnowsAbout(sym)
+   THEN
+      RETURN( Mod2Gcc(sym) )
+   END ;
+   IF IsConstructor(sym) OR IsConstSet(sym)
+   THEN
+      EvaluateValue(sym)
+   END ;
+   IF IsConstString(sym)
+   THEN
+      size := GetStringLength(sym) ;
+      IF size=1
+      THEN
+         DeclareCharConstant(sym)
+      ELSE
+         DeclareStringConstant (sym)
+      END
+   ELSIF IsValueSolved(sym)
+   THEN
+      PushValue(sym) ;
+      IF IsConstSet(sym)
+      THEN
+         DeclareConstantFromTree(sym, PopSetTree(tokenno))
+      ELSIF IsConstructor(sym)
+      THEN
+         DeclareConstantFromTree(sym, PopConstructorTree(tokenno))
+      ELSIF IsRealType(GetDType(sym))
+      THEN
+         type := GetDType(sym) ;
+         DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopRealTree(), TRUE))
+      ELSIF IsComplexType(GetDType(sym))
+      THEN
+         type := GetDType(sym) ;
+         DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopComplexTree(), TRUE))
+      ELSE
+         IF GetSType(sym)=NulSym
+         THEN
+            type := ZType
+         ELSE
+            type := GetDType(sym)
+         END ;
+         DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopIntegerTree(), TRUE))
+      END
+   END ;
+   IF GccKnowsAbout(sym)
+   THEN
+      RETURN( Mod2Gcc(sym) )
+   ELSE
+      RETURN( NIL )
+   END
+END DeclareConst ;
+
+
+(*
+   DeclareParameters -
+*)
+
+PROCEDURE DeclareParameters (sym: CARDINAL) ;
+BEGIN
+   DeclareUnboundedProcedureParameters(sym)
+END DeclareParameters ;
+
+
+VAR
+   unboundedp: WalkAction ;
+
+
+(*
+   WalkFamilyOfUnbounded -
+*)
+
+PROCEDURE WalkFamilyOfUnbounded (oaf: CARDINAL <* unused *> ; dim: CARDINAL <* unused *> ; unbounded: CARDINAL) ;
+BEGIN
+   IF unbounded # NulSym
+   THEN
+      unboundedp (unbounded)
+   END
+END WalkFamilyOfUnbounded ;
+
+
+(*
+   WalkAssociatedUnbounded -
+*)
+
+PROCEDURE WalkAssociatedUnbounded (sym: CARDINAL; p: WalkAction) ;
+VAR
+   oaf: CARDINAL ;
+   o  : WalkAction ;
+BEGIN
+   oaf := GetOAFamily(sym) ;
+   o := unboundedp ;
+   unboundedp := p ;
+   ForeachOAFamily (oaf, WalkFamilyOfUnbounded) ;
+   unboundedp := o
+END WalkAssociatedUnbounded ;
+
+
+(*
+   WalkProcedureParameterDependants -
+*)
+
+(*
+PROCEDURE WalkProcedureParameterDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   son,
+   type,
+   n, i: CARDINAL ;
+BEGIN
+   IF IsProcedure(sym)
+   THEN
+      n := NoOfParam(sym) ;
+      i := n ;
+      WHILE i>0 DO
+         IF IsUnboundedParam(sym, i)
+         THEN
+            son := GetNthParam(sym, i)
+         ELSE
+            son := GetNth(sym, i) ;
+         END ;
+         type := GetSType(son) ;
+         p(type) ;
+         WalkDependants(type, p) ;
+         DEC(i)
+      END
+   END
+END WalkProcedureParameterDependants ;
+*)
+
+
+(*
+   WalkDependants - walks through all dependants of, Sym,
+                    calling, p, for each dependant.
+*)
+
+PROCEDURE WalkDependants (sym: CARDINAL; p: WalkAction) ;
+BEGIN
+   WalkAssociatedUnbounded(sym, p) ;
+   IF IsComponent(sym)
+   THEN
+      WalkComponentDependants(sym, p)
+   ELSIF IsEnumeration(sym)
+   THEN
+      WalkEnumerationDependants(sym, p)
+   ELSIF IsSubrange(sym)
+   THEN
+      WalkSubrangeDependants(sym, p)
+   ELSIF IsPointer(sym)
+   THEN
+      WalkPointerDependants(sym, p)
+   ELSIF IsRecord(sym)
+   THEN
+      WalkRecordDependants(sym, p)
+   ELSIF IsVarient(sym)
+   THEN
+      WalkVarientDependants(sym, p)
+   ELSIF IsRecordField(sym)
+   THEN
+      WalkRecordFieldDependants(sym, p)
+   ELSIF IsFieldVarient(sym)
+   THEN
+      WalkVarientFieldDependants(sym, p)
+   ELSIF IsArray(sym)
+   THEN
+      WalkArrayDependants(sym, p)
+   ELSIF IsProcType(sym)
+   THEN
+      WalkProcTypeDependants(sym, p)
+   ELSIF IsUnbounded(sym)
+   THEN
+      WalkUnboundedDependants(sym, p)
+   ELSIF IsSet(sym)
+   THEN
+      WalkSetDependants(sym, p)
+   ELSIF IsType(sym)
+   THEN
+      WalkTypeDependants(sym, p)
+   ELSIF IsConst(sym)
+   THEN
+      WalkConst(sym, p)
+   ELSIF IsVar(sym)
+   THEN
+      WalkVarDependants(sym, p)
+   ELSIF IsProcedure(sym)
+   THEN
+      WalkProcedureDependants(sym, p)
+   END
+END WalkDependants ;
+
+
+(*
+   TraverseDependantsInner -
+*)
+
+PROCEDURE TraverseDependantsInner (sym: WORD) ;
+BEGIN
+   IF (NOT IsElementInSet(FullyDeclared, sym)) AND
+      (NOT IsElementInSet(ToDoList, sym))
+   THEN
+      WatchIncludeList(sym, todolist)
+   END ;
+   IF NOT IsElementInSet(VisitedList, sym)
+   THEN
+      IncludeElementIntoSet(VisitedList, sym) ;
+      WalkDependants(sym, TraverseDependantsInner)
+   END
+END TraverseDependantsInner ;
+
+
+(*
+   TraverseDependants - walks, sym, dependants.  But it checks
+                        to see that, sym, is not on the
+                        FullyDeclared and not on the ToDoList.
+*)
+
+PROCEDURE TraverseDependants (sym: WORD) ;
+BEGIN
+   IF VisitedList=NIL
+   THEN
+      VisitedList := InitSet(1) ;
+      TraverseDependantsInner(sym) ;
+      VisitedList := KillSet(VisitedList)
+   ELSE
+      InternalError ('recursive call to TraverseDependants caught')
+   END
+END TraverseDependants ;
+
+
+(*
+   WalkTypeInfo - walks type, sym, and its dependants.
+*)
+
+PROCEDURE WalkTypeInfo (sym: WORD) ;
+BEGIN
+   IF IsVarient(sym)
+   THEN
+      InternalError ('why have we reached here?')
+   ELSIF IsVar(sym)
+   THEN
+      WalkTypeInfo(GetSType(sym)) ;
+      IF GetVarBackEndType(sym)#NulSym
+      THEN
+         WalkTypeInfo(GetVarBackEndType(sym))
+      END
+   ELSIF IsAModula2Type(sym)
+   THEN
+      TraverseDependants(sym)
+   END
+END WalkTypeInfo ;
+
+
+(*
+   DeclareUnboundedProcedureParameters -
+*)
+
+PROCEDURE DeclareUnboundedProcedureParameters (sym: WORD) ;
+VAR
+   son, type,
+   p, i     : CARDINAL ;
+   location : location_t ;
+BEGIN
+   IF IsProcedure(sym)
+   THEN
+      p := NoOfParam(sym) ;
+      i := p ;
+      WHILE i>0 DO
+         IF IsUnboundedParam(sym, i)
+         THEN
+            son := GetNthParam(sym, i) ;
+            type := GetSType(son) ;
+            TraverseDependants(type) ;
+            IF GccKnowsAbout(type)
+            THEN
+               location := TokenToLocation(GetDeclaredMod(type)) ;
+               BuildTypeDeclaration(location, Mod2Gcc(type))
+            END
+         ELSE
+            son := GetNth(sym, i) ;
+            type := GetSType(son) ;
+            TraverseDependants(type)
+         END ;
+         DEC(i)
+      END
+   END
+END DeclareUnboundedProcedureParameters ;
+
+
+(*
+   WalkUnboundedProcedureParameters -
+*)
+
+PROCEDURE WalkUnboundedProcedureParameters (sym: WORD) ;
+VAR
+   son,
+   type,
+   p, i: CARDINAL ;
+BEGIN
+   IF IsProcedure(sym)
+   THEN
+      p := NoOfParam(sym) ;
+      i := p ;
+      WHILE i>0 DO
+         IF IsUnboundedParam(sym, i)
+         THEN
+            son := GetNthParam(sym, i) ;
+            type := GetSType(son) ;
+            WalkTypeInfo(type) ;
+(*
+            type := GetUnboundedRecordType(type) ;
+            Assert(IsRecord(type)) ;
+            RecordNotPacked(type)      (* which is never packed.                   *)
+*)
+         ELSE
+            son := GetNth(sym, i) ;
+            type := GetSType(son) ;
+            WalkTypeInfo(type)
+         END ;
+         DEC(i)
+      END
+   END
+END WalkUnboundedProcedureParameters ;
+
+
+(*
+   WalkTypesInProcedure - walk all types in procedure, Sym.
+*)
+
+PROCEDURE WalkTypesInProcedure (sym: WORD) ;
+BEGIN
+   ForeachLocalSymDo(sym, TraverseDependants)
+END WalkTypesInProcedure ;
+
+
+(*
+   WalkTypesInModule - declare all types in module, Sym, to GCC.
+*)
+
+PROCEDURE WalkTypesInModule (sym: WORD) ;
+VAR
+   n: Name ;
+BEGIN
+   IF Debugging
+   THEN
+      n := GetSymName(sym) ;
+      printf1('Declaring types in MODULE %a\n', n)
+   END ;
+   ForeachLocalSymDo(sym, WalkTypeInfo) ;
+   ForeachLocalSymDo(sym, WalkUnboundedProcedureParameters) ;
+   ForeachInnerModuleDo(sym, WalkTypesInModule)
+END WalkTypesInModule ;
+
+
+(*
+   IsRecordFieldDependants - returns TRUE if the record field
+                             symbol, sym, p(dependants) all return TRUE.
+*)
+
+PROCEDURE IsRecordFieldDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   align: CARDINAL ;
+   final: BOOLEAN ;
+BEGIN
+   final := TRUE ;
+   IF NOT q(GetSType(sym))
+   THEN
+      final := FALSE
+   END ;
+   align := GetAlignment(sym) ;
+   IF (align#NulSym) AND (NOT q(align))
+   THEN
+      final := FALSE
+   END ;
+   RETURN( final )
+END IsRecordFieldDependants ;
+
+
+(*
+   GetModuleWhereDeclared - returns the module where, Sym, was created.
+*)
+
+PROCEDURE GetModuleWhereDeclared (sym: CARDINAL) : CARDINAL ;
+VAR
+   s: CARDINAL ;
+BEGIN
+   s := GetScope(sym) ;
+   IF (s=NulSym) OR IsDefImp(s) OR
+      (IsModule(s) AND (GetScope(s)=NulSym))
+   THEN
+      RETURN( s )
+   ELSE
+      RETURN( GetModuleWhereDeclared(s) )
+   END
+END GetModuleWhereDeclared ;
+
+
+(*
+   IsPseudoProcFunc - returns TRUE if Sym is a pseudo function or procedure.
+*)
+
+PROCEDURE IsPseudoProcFunc (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          IsPseudoBaseProcedure(Sym) OR IsPseudoBaseFunction(Sym) OR
+          IsPseudoSystemFunction(Sym)
+         )
+END IsPseudoProcFunc ;
+
+
+(*
+   IsProcedureGccNested - returns TRUE if procedure, sym, will be considered
+                          as nested by GCC.
+                          This will occur if either its outer defining scope
+                          is a procedure or is a module which is inside a
+                          procedure.
+*)
+
+PROCEDURE IsProcedureGccNested (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          IsProcedureNested(sym) OR
+          (IsModule(GetScope(sym)) AND IsModuleWithinProcedure(GetScope(sym)))
+         )
+END IsProcedureGccNested ;
+
+
+(*
+   IsExternal -
+*)
+
+PROCEDURE IsExternal (sym: CARDINAL) : BOOLEAN ;
+VAR
+   mod: CARDINAL ;
+BEGIN
+   mod := GetScope(sym) ;
+   REPEAT
+      IF mod=NulSym
+      THEN
+         RETURN( FALSE )
+      ELSIF IsDefImp(mod)
+      THEN
+         RETURN( mod#GetMainModule() )
+      END ;
+      mod := GetScope(mod)
+   UNTIL mod=NulSym ;
+   RETURN( FALSE )
+END IsExternal ;
+
+
+(*
+   IsExternalToWholeProgram - return TRUE if the symbol, sym, is external to the
+                              sources that we have parsed.
+*)
+
+PROCEDURE IsExternalToWholeProgram (sym: CARDINAL) : BOOLEAN ;
+VAR
+   mod: CARDINAL ;
+BEGIN
+   mod := GetScope(sym) ;
+   REPEAT
+      IF mod=NulSym
+      THEN
+         RETURN( FALSE )
+      ELSIF IsDefImp(mod)
+      THEN
+         (* return TRUE if we have no source file.  *)
+         RETURN( GetModuleFile(mod)=NIL )
+      END ;
+      mod := GetScope(mod)
+   UNTIL mod=NulSym ;
+   RETURN( FALSE )
+END IsExternalToWholeProgram ;
+
+
+(*
+   DeclareProcedureToGccWholeProgram -
+*)
+
+PROCEDURE DeclareProcedureToGccWholeProgram (Sym: CARDINAL) ;
+VAR
+   GccParam  : Tree ;
+   scope,
+   Son,
+   p, i      : CARDINAL ;
+   b, e      : CARDINAL ;
+   begin, end,
+   location  : location_t ;
+BEGIN
+   IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym))
+   THEN
+      BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ;
+      p := NoOfParam(Sym) ;
+      i := p ;
+      WHILE i>0 DO
+         (* note we dont use GetNthParam as we want the parameter that is seen by the procedure block
+            remember that this is treated exactly the same as a variable, just its position on
+            the activation record is special (ie a parameter)
+         *)
+         Son := GetNth(Sym, i) ;
+         location := TokenToLocation(GetDeclaredMod(Son)) ;
+         IF IsUnboundedParam(Sym, i)
+         THEN
+            GccParam := BuildParameterDeclaration(location,
+                                                  KeyToCharStar(GetSymName(Son)),
+                                                  Mod2Gcc(GetLType(Son)),
+                                                  FALSE)
+         ELSE
+            GccParam := BuildParameterDeclaration(location,
+                                                  KeyToCharStar(GetSymName(Son)),
+                                                  Mod2Gcc(GetLType(Son)),
+                                                  IsVarParam(Sym, i))
+         END ;
+         PreAddModGcc(Son, GccParam) ;
+         WatchRemoveList(Son, todolist) ;
+         WatchIncludeList(Son, fullydeclared) ;
+         DEC(i)
+      END ;
+      GetProcedureBeginEnd(Sym, b, e) ;
+      begin := TokenToLocation(b) ;
+      end := TokenToLocation(e) ;
+      scope := GetScope(Sym) ;
+      PushBinding(scope) ;
+      IF GetSType(Sym)=NulSym
+      THEN
+         PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end,
+                                                       KeyToCharStar(GetFullSymName(Sym)),
+                                                       NIL,
+                                                       IsExternalToWholeProgram(Sym),
+                                                       IsProcedureGccNested(Sym),
+                                                       IsExported(GetModuleWhereDeclared(Sym), Sym)))
+      ELSE
+         PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end,
+                                                       KeyToCharStar(GetFullSymName(Sym)),
+                                                       Mod2Gcc(GetSType(Sym)),
+                                                       IsExternalToWholeProgram(Sym),
+                                                       IsProcedureGccNested(Sym),
+                                                       IsExported(GetModuleWhereDeclared(Sym), Sym)))
+      END ;
+      PopBinding(scope) ;
+      WatchRemoveList(Sym, todolist) ;
+      WatchIncludeList(Sym, fullydeclared)
+   END
+END DeclareProcedureToGccWholeProgram ;
+
+
+(*
+   DeclareProcedureToGccSeparateProgram -
+*)
+
+PROCEDURE DeclareProcedureToGccSeparateProgram (Sym: CARDINAL) ;
+VAR
+   returnType,
+   GccParam  : Tree ;
+   scope,
+   Son,
+   p, i      : CARDINAL ;
+   b, e      : CARDINAL ;
+   begin, end,
+   location  : location_t ;
+   tok       : CARDINAL ;
+BEGIN
+   tok := GetDeclaredMod(Sym) ;
+   IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym)) AND
+      (IsEffectivelyImported(GetMainModule(), Sym) OR
+       (GetModuleWhereDeclared (Sym) = GetMainModule()) OR
+       IsNeededAtRunTime (tok, Sym) OR
+       IsImported (GetBaseModule (), Sym) OR
+       IsExported(GetModuleWhereDeclared (Sym), Sym) OR
+       IsExtern (Sym))
+   THEN
+      BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ;
+      p := NoOfParam(Sym) ;
+      i := p ;
+      WHILE i>0 DO
+         (* note we dont use GetNthParam as we want the parameter that is seen by
+            the procedure block remember that this is treated exactly the same as
+            a variable, just its position on the activation record is special (ie
+            a parameter).  *)
+         Son := GetNth(Sym, i) ;
+         location := TokenToLocation(GetDeclaredMod(Son)) ;
+         IF IsUnboundedParam(Sym, i)
+         THEN
+            GccParam := BuildParameterDeclaration(location,
+                                                  KeyToCharStar(GetSymName(Son)),
+                                                  Mod2Gcc(GetLType(Son)),
+                                                  FALSE)
+         ELSE
+            GccParam := BuildParameterDeclaration(location,
+                                                  KeyToCharStar(GetSymName(Son)),
+                                                  Mod2Gcc(GetLType(Son)),
+                                                  IsVarParam(Sym, i))
+         END ;
+         PreAddModGcc(Son, GccParam) ;
+         WatchRemoveList(Son, todolist) ;
+         WatchIncludeList(Son, fullydeclared) ;
+         DEC(i)
+      END ;
+      GetProcedureBeginEnd(Sym, b, e) ;
+      begin := TokenToLocation(b) ;
+      end := TokenToLocation(e) ;
+      scope := GetScope(Sym) ;
+      PushBinding(scope) ;
+      IF GetSType(Sym)=NulSym
+      THEN
+         returnType := NIL
+      ELSE
+         returnType := Mod2Gcc(GetSType(Sym))
+      END ;
+      PreAddModGcc (Sym, BuildEndFunctionDeclaration (begin, end,
+                                                      KeyToCharStar (GetFullSymName (Sym)),
+                                                      returnType,
+                                                      IsExternal (Sym),  (* Extern relative to the main module.  *)
+                                                      IsProcedureGccNested (Sym),
+                                                      (* Exported from the module where it was declared.  *)
+                                                      IsExported (GetModuleWhereDeclared (Sym), Sym) OR IsExtern (Sym))) ;
+      PopBinding(scope) ;
+      WatchRemoveList(Sym, todolist) ;
+      WatchIncludeList(Sym, fullydeclared)
+   END
+END DeclareProcedureToGccSeparateProgram ;
+
+
+(*
+   DeclareProcedureToGcc - traverses all parameters and interfaces to gm2gcc.
+*)
+
+PROCEDURE DeclareProcedureToGcc (sym: CARDINAL) ;
+BEGIN
+   IF sym # NulSym
+   THEN
+      IF WholeProgram
+      THEN
+         DeclareProcedureToGccWholeProgram (sym)
+      ELSE
+         DeclareProcedureToGccSeparateProgram (sym)
+      END
+   END
+END DeclareProcedureToGcc ;
+
+
+(*
+   DeclareProcedure - declares procedure, sym, or all procedures inside
+                      module sym.
+*)
+
+PROCEDURE DeclareProcedure (sym: WORD) ;
+BEGIN
+   IF IsProcedure(sym)
+   THEN
+      DeclareProcedureToGcc(sym)
+   ELSIF IsModule(sym) OR IsDefImp(sym)
+   THEN
+      ForeachProcedureDo(sym, DeclareProcedure)
+   ELSE
+      InternalError ('expecting procedure')
+   END
+END DeclareProcedure ;
+
+
+(*
+   FoldConstants - a wrapper for ResolveConstantExpressions.
+*)
+
+PROCEDURE FoldConstants (start, end: CARDINAL) ;
+BEGIN
+   IF ResolveConstantExpressions(DeclareConstFully, start, end)
+   THEN
+   END
+END FoldConstants ;
+
+
+(*
+   DeclareTypesConstantsProceduresInRange -
+*)
+
+PROCEDURE DeclareTypesConstantsProceduresInRange (start, end: CARDINAL) ;
+VAR
+   n, m: CARDINAL ;
+BEGIN
+   IF DisplayQuadruples
+   THEN
+      DisplayQuadRange(start, end)
+   END ;
+   REPEAT
+      n := NoOfElementsInSet(ToDoList) ;
+      WHILE ResolveConstantExpressions(DeclareConstFully, start, end) DO
+      END ;
+      (* we need to evaluate some constant expressions to resolve these types *)
+      IF DeclaredOutstandingTypes (FALSE)
+      THEN
+      END ;
+      m := NoOfElementsInSet(ToDoList)
+   UNTIL (NOT ResolveConstantExpressions(DeclareConstFully, start, end)) AND
+         (n=m)
+END DeclareTypesConstantsProceduresInRange ;
+
+
+(*
+   SkipModuleScope - skips all module scopes for, scope.
+                     It returns either NulSym or a procedure sym.
+*)
+
+PROCEDURE SkipModuleScope (scope: CARDINAL) : CARDINAL ;
+BEGIN
+   IF (scope=NulSym) OR IsProcedure(scope)
+   THEN
+      RETURN( scope )
+   ELSE
+      RETURN( SkipModuleScope(GetScope(scope)) )
+   END
+END SkipModuleScope ;
+
+
+(*
+   PushBinding -
+*)
+
+PROCEDURE PushBinding (scope: CARDINAL) ;
+BEGIN
+   scope := SkipModuleScope(scope) ;
+   IF scope=NulSym
+   THEN
+      pushGlobalScope
+   ELSE
+      pushFunctionScope(Mod2Gcc(scope))
+   END
+END PushBinding ;
+
+
+(*
+   PopBinding -
+*)
+
+PROCEDURE PopBinding (scope: CARDINAL) ;
+BEGIN
+   scope := SkipModuleScope(scope) ;
+   IF scope=NulSym
+   THEN
+      popGlobalScope
+   ELSE
+      Assert(IsProcedure(scope)) ;
+      finishFunctionDecl(TokenToLocation(GetDeclaredMod(scope)), Mod2Gcc(scope)) ;
+      Assert (popFunctionScope () # NIL)
+   END
+END PopBinding ;
+
+
+(*
+   DeclareTypesConstantsProcedures -
+*)
+
+PROCEDURE DeclareTypesConstantsProcedures (scope: CARDINAL) ;
+VAR
+   s, t: CARDINAL ;
+   sb  : ScopeBlock ;
+BEGIN
+   sb := InitScopeBlock(scope) ;
+   PushBinding(scope) ;
+   REPEAT
+      s := NoOfElementsInSet(ToDoList) ;
+      (* ForeachLocalSymDo(scope, DeclareTypeInfo) ; *)
+      ForeachScopeBlockDo(sb, DeclareTypesConstantsProceduresInRange) ;
+      t := NoOfElementsInSet(ToDoList) ;
+   UNTIL s=t ;
+   PopBinding(scope) ;
+   KillScopeBlock(sb)
+END DeclareTypesConstantsProcedures ;
+
+
+(*
+   AssertAllTypesDeclared - asserts that all types for variables are declared in, scope.
+*)
+
+PROCEDURE AssertAllTypesDeclared (scope: CARDINAL) ;
+VAR
+   n, Var: CARDINAL ;
+   failed: BOOLEAN ;
+BEGIN
+   failed := FALSE ;
+   n := 1 ;
+   Var := GetNth(scope, n) ;
+   WHILE Var#NulSym DO
+      IF NOT AllDependantsFullyDeclared(GetSType(Var))
+      THEN
+         mystop
+      END ;
+      IF NOT AllDependantsFullyDeclared(GetSType(Var))
+      THEN
+         EmitCircularDependancyError(GetSType(Var)) ;
+         failed := TRUE
+      END ;
+      INC(n) ;
+      Var := GetNth(scope, n)
+   END ;
+   IF failed
+   THEN
+      FlushErrors
+   END
+END AssertAllTypesDeclared ;
+
+
+(*
+   DeclareModuleInit - declare all the ctor related functions within
+                       a module.
+*)
+
+PROCEDURE DeclareModuleInit (moduleSym: WORD) ;
+VAR
+   ctor, init, fini, dep: CARDINAL ;
+BEGIN
+   GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+   DeclareProcedureToGcc (ctor) ;
+   DeclareProcedureToGcc (init) ;
+   DeclareProcedureToGcc (fini) ;
+   DeclareProcedureToGcc (dep)
+END DeclareModuleInit ;
+
+
+(*
+   StartDeclareProcedureScope -
+*)
+
+PROCEDURE StartDeclareProcedureScope (scope: CARDINAL) ;
+BEGIN
+   WalkTypesInProcedure(scope) ;
+   DeclareProcedure(scope) ;
+   ForeachInnerModuleDo(scope, WalkTypesInModule) ;
+   DeclareTypesConstantsProcedures(scope) ;
+   ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
+   DeclareLocalVariables(scope) ;
+   ForeachInnerModuleDo(scope, DeclareModuleVariables) ;
+   AssertAllTypesDeclared(scope) ;
+   ForeachProcedureDo(scope, DeclareProcedure) ;
+   ForeachInnerModuleDo(scope, StartDeclareScope)
+END StartDeclareProcedureScope ;
+
+
+(*
+   StartDeclareModuleScopeSeparate -
+*)
+
+PROCEDURE StartDeclareModuleScopeSeparate (scope: CARDINAL) ;
+BEGIN
+   IF scope=GetMainModule()
+   THEN
+      ForeachModuleDo(WalkTypesInModule) ;     (* will populate the TYPE and CONST ToDo list  *)
+      DeclareTypesConstantsProcedures(scope) ; (* will resolved TYPEs and CONSTs on the ToDo  *)
+                                               (* lists.                                      *)
+      ForeachModuleDo(DeclareProcedure) ;
+      (*
+         now that all types have been resolved it is safe to declare
+         variables
+      *)
+      AssertAllTypesDeclared(scope) ;
+      DeclareGlobalVariables(scope) ;
+      ForeachImportedDo(scope, DeclareImportedVariables) ;
+      (* now it is safe to declare all procedures *)
+      ForeachProcedureDo(scope, DeclareProcedure) ;
+      ForeachInnerModuleDo(scope, WalkTypesInModule) ;
+      ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
+      ForeachInnerModuleDo(scope, StartDeclareScope) ;
+      DeclareModuleInit(scope)
+   ELSE
+      DeclareTypesConstantsProcedures(scope) ;
+      AssertAllTypesDeclared(scope) ;
+      ForeachProcedureDo(scope, DeclareProcedure) ;
+      DeclareModuleInit(scope) ;
+      ForeachInnerModuleDo(scope, StartDeclareScope)
+   END
+END StartDeclareModuleScopeSeparate ;
+
+
+(*
+   StartDeclareModuleScopeWholeProgram -
+*)
+
+PROCEDURE StartDeclareModuleScopeWholeProgram (scope: CARDINAL) ;
+BEGIN
+   IF IsSourceSeen(scope)
+   THEN
+      ForeachModuleDo(WalkTypesInModule) ;     (* will populate the TYPE and CONST ToDo list  *)
+      DeclareTypesConstantsProcedures(scope) ; (* will resolved TYPEs and CONSTs on the ToDo  *)
+                                               (* lists.                                      *)
+      ForeachModuleDo(DeclareProcedure) ;
+      ForeachModuleDo(DeclareModuleInit) ;
+      (*
+         now that all types have been resolved it is safe to declare
+         variables
+      *)
+      AssertAllTypesDeclared(scope) ;
+      DeclareGlobalVariablesWholeProgram(scope) ;
+      ForeachImportedDo(scope, DeclareImportedVariablesWholeProgram) ;
+      (* now it is safe to declare all procedures *)
+      ForeachProcedureDo(scope, DeclareProcedure) ;
+      ForeachInnerModuleDo(scope, WalkTypesInModule) ;
+      ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
+      ForeachInnerModuleDo(scope, StartDeclareScope) ;
+      DeclareModuleInit(scope)
+   ELSE
+      DeclareTypesConstantsProcedures(scope) ;
+      AssertAllTypesDeclared(scope) ;
+      ForeachProcedureDo(scope, DeclareProcedure) ;
+      DeclareModuleInit(scope) ;
+      ForeachInnerModuleDo(scope, StartDeclareScope)
+   END
+END StartDeclareModuleScopeWholeProgram ;
+
+
+(*
+   StartDeclareModuleScope -
+*)
+
+PROCEDURE StartDeclareModuleScope (scope: CARDINAL) ;
+BEGIN
+   IF WholeProgram
+   THEN
+      StartDeclareModuleScopeWholeProgram(scope)
+   ELSE
+      StartDeclareModuleScopeSeparate(scope)
+   END
+END StartDeclareModuleScope ;
+
+
+(*
+   StartDeclareScope - declares types, variables associated with this scope.
+*)
+
+PROCEDURE StartDeclareScope (scope: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   (* AddSymToWatch (1265) ;  *)
+   (* AddSymToWatch (1157) ;  *)  (* watch goes here *)
+   (* AddSymToWatch(TryFindSymbol('IOLink', 'DeviceId')) ; *)
+   (* AddSymToWatch(819) ; *)
+   (*
+   AddSymToWatch(2125) ;  (* watch goes here *)
+   DebugSets ;
+    *)
+   (*
+   AddSymToWatch(2125) ;  (* watch goes here *)
+   *)
+   (*
+   IncludeElementIntoSet(WatchList, 369) ;
+   IncludeElementIntoSet(WatchList, 709) ;
+   *)
+   (*
+   IncludeElementIntoSet(WatchList, 1006) ;
+    *)
+   (* AddSymToWatch(8) ; *)
+   (* IncludeElementIntoSet(WatchList, 4188) ; *)
+   (* AddSymToWatch(1420) ; *)
+   (* AddSymToWatch(5889) ; *)
+   (* IncludeElementIntoSet(WatchList, 717) ; *)
+   (* IncludeElementIntoSet(WatchList, 829) ; *)
+   (* IncludeElementIntoSet(WatchList, 2714) ; *)
+   (* IncludeElementIntoSet(WatchList, 23222) ; *)
+   (* IncludeElementIntoSet(WatchList, 1104) ; *)
+   (* IncludeElementIntoSet(WatchList, 859) ; *)
+   (* IncludeElementIntoSet(WatchList, 858) ; *)
+
+   (* IncludeElementIntoSet(WatchList, 720) ; *)
+   (* IncludeElementIntoSet(WatchList, 706) ; *)
+   (* IncludeElementIntoSet(WatchList, 1948) ; *)
+   (* IncludeElementIntoSet(WatchList, 865) ; *)
+
+   IF Debugging
+   THEN
+      n := GetSymName (scope) ;
+      printf1 ('declaring symbols in BLOCK %a\n', n)
+   END ;
+   IF IsProcedure (scope)
+   THEN
+      StartDeclareProcedureScope (scope)
+   ELSE
+      StartDeclareModuleScope (scope)
+   END ;
+   IF Debugging
+   THEN
+      n := GetSymName (scope) ;
+      printf1('\nEND declaring symbols in BLOCK %a\n', n)
+   END
+END StartDeclareScope ;
+
+
+(*
+   EndDeclareScope -
+*)
+
+PROCEDURE EndDeclareScope ;
+BEGIN
+   (* no need to do anything *)
+END EndDeclareScope ;
+
+
+(*
+   PreAddModGcc - adds a relationship between sym and t.
+                  It also determines whether an unbounded
+                  for sym is required and if so this is also
+                  created.
+*)
+
+PROCEDURE PreAddModGcc (sym: CARDINAL; t: Tree) ;
+BEGIN
+   AddModGcc(sym, t)
+END PreAddModGcc ;
+
+
+(*
+   DeclareDefaultType - declares a default type, sym, with, name.
+*)
+
+PROCEDURE DeclareDefaultType (sym: CARDINAL; name: ARRAY OF CHAR; gcctype: Tree) ;
+VAR
+   t        : Tree ;
+   high, low: CARDINAL ;
+   location : location_t ;
+BEGIN
+   (* DeclareDefaultType will declare a new identifier as a type of, gcctype, if it has not already been
+      declared by gccgm2.c *)
+   location := BuiltinsLocation () ;
+   t := GetDefaultType(location, KeyToCharStar(MakeKey(name)), gcctype) ;
+   AddModGcc(sym, t) ;
+   IncludeElementIntoSet(FullyDeclared, sym) ;
+   WalkAssociatedUnbounded(sym, TraverseDependants) ;
+   (*
+      this is very simplistic and assumes that the caller only uses Subranges, Sets and GCC types.
+      We need to declare any constants with the types so that AllDependantsFullyDeclared works.
+   *)
+   IF IsSubrange(sym)
+   THEN
+      GetSubrange(sym, high, low) ;
+      DeclareConstant(GetDeclaredMod(sym), high) ;
+      DeclareConstant(GetDeclaredMod(sym), low)
+   ELSIF IsSet(sym)
+   THEN
+      IF IsSubrange(GetSType(sym))
+      THEN
+         IF NOT GccKnowsAbout(GetSType(sym))
+         THEN
+            (* only true for internal types of course *)
+            InternalError ('subrange type within the set type must be declared before the set type')
+         END ;
+         GetSubrange(GetSType(sym), high, low) ;
+         DeclareConstant(GetDeclaredMod(sym), high) ;
+         DeclareConstant(GetDeclaredMod(sym), low)
+      ELSIF IsEnumeration(GetSType(sym))
+      THEN
+         IF NOT GccKnowsAbout(GetSType(sym))
+         THEN
+            (* only true for internal types of course *)
+            InternalError ('enumeration type within the set type must be declared before the set type')
+         END
+      END
+   END
+END DeclareDefaultType ;
+
+
+(*
+   DeclareBoolean - declares the Boolean type together with true and false.
+*)
+
+PROCEDURE DeclareBoolean ;
+BEGIN
+   AddModGcc(Boolean, GetBooleanType()) ;
+   AddModGcc(True, GetBooleanTrue()) ;
+   AddModGcc(False, GetBooleanFalse()) ;
+   IncludeElementIntoSet(FullyDeclared, Boolean) ;
+   IncludeElementIntoSet(FullyDeclared, True) ;
+   IncludeElementIntoSet(FullyDeclared, False) ;
+   WalkAssociatedUnbounded(Boolean, TraverseDependants)
+END DeclareBoolean ;
+
+
+(*
+   DeclareFixedSizedType - declares the GNU Modula-2 fixed types
+                           (if the back end support such a type).
+*)
+
+PROCEDURE DeclareFixedSizedType (name: ARRAY OF CHAR; type: CARDINAL; t: Tree) ;
+VAR
+   location : location_t ;
+   typetype,
+   low, high: CARDINAL ;
+BEGIN
+   IF type#NulSym
+   THEN
+      IF IsSet(type) AND (NOT GccKnowsAbout(GetSType(type)))
+      THEN
+         typetype := GetSType(type) ;
+         GetSubrange(typetype, high, low) ;
+         DeclareConstant(GetDeclaredMod(type), high) ;
+         DeclareConstant(GetDeclaredMod(type), low) ;
+         location := TokenToLocation(GetDeclaredMod(typetype)) ;
+         PreAddModGcc(typetype, BuildSubrangeType(location,
+                                                  KeyToCharStar(GetFullSymName(typetype)),
+                                                  Mod2Gcc(GetSType(typetype)),
+                                                  Mod2Gcc(low), Mod2Gcc(high))) ;
+         IncludeElementIntoSet(FullyDeclared, typetype) ;
+         WalkAssociatedUnbounded(typetype, TraverseDependants)
+      END ;
+      (* gcc back end supports, type *)
+      DeclareDefaultType(type, name, t)
+   END
+END DeclareFixedSizedType ;
+
+
+(*
+   DeclareDefaultSimpleTypes - declares the simple types.
+*)
+
+PROCEDURE DeclareDefaultSimpleTypes ;
+BEGIN
+   AddModGcc(ZType, GetM2ZType()) ;
+   AddModGcc(RType, GetM2RType()) ;
+   AddModGcc(CType, GetM2CType()) ;
+   IncludeElementIntoSet(FullyDeclared, ZType) ;
+   IncludeElementIntoSet(FullyDeclared, RType) ;
+   IncludeElementIntoSet(FullyDeclared, CType) ;
+
+   DeclareDefaultType(Cardinal    , "CARDINAL"    , GetM2CardinalType()) ;
+   DeclareDefaultType(Integer     , "INTEGER"     , GetM2IntegerType()) ;
+   DeclareDefaultType(Char        , "CHAR"        , GetM2CharType()) ;
+   DeclareDefaultType(Loc         , "LOC"         , GetISOLocType()) ;
+
+   IF Iso
+   THEN
+      DeclareDefaultType(Byte     , "BYTE"        , GetISOByteType()) ;
+      DeclareDefaultType(Word     , "WORD"        , GetISOWordType())
+   ELSE
+      DeclareDefaultType(Byte     , "BYTE"        , GetByteType()) ;
+      DeclareDefaultType(Word     , "WORD"        , GetWordType())
+   END ;
+
+   DeclareDefaultType(Proc        , "PROC"        , GetProcType()) ;
+   DeclareDefaultType(Address     , "ADDRESS"     , GetPointerType()) ;
+   DeclareDefaultType(LongInt     , "LONGINT"     , GetM2LongIntType()) ;
+   DeclareDefaultType(LongCard    , "LONGCARD"    , GetM2LongCardType()) ;
+   DeclareDefaultType(ShortInt    , "SHORTINT"    , GetM2ShortIntType()) ;
+   DeclareDefaultType(ShortCard   , "SHORTCARD"   , GetM2ShortCardType()) ;
+   DeclareDefaultType(ShortReal   , "SHORTREAL"   , GetM2ShortRealType()) ;
+   DeclareDefaultType(Real        , "REAL"        , GetM2RealType()) ;
+   DeclareDefaultType(LongReal    , "LONGREAL"    , GetM2LongRealType()) ;
+   DeclareDefaultType(Bitnum      , "BITNUM"      , GetBitnumType()) ;
+   DeclareDefaultType(Bitset      , "BITSET"      , GetBitsetType()) ;
+   DeclareDefaultType(Complex     , "COMPLEX"     , GetM2ComplexType()) ;
+   DeclareDefaultType(LongComplex , "LONGCOMPLEX" , GetM2LongComplexType()) ;
+   DeclareDefaultType(ShortComplex, "SHORTCOMPLEX", GetM2ShortComplexType()) ;
+   DeclareDefaultType(CSizeT      , "CSIZE_T"     , GetCSizeTType()) ;
+   DeclareDefaultType(CSSizeT     , "CSSIZE_T"    , GetCSSizeTType()) ;
+
+   DeclareBoolean ;
+
+   DeclareFixedSizedType("INTEGER8"  , IntegerN(8)  , GetM2Integer8()) ;
+   DeclareFixedSizedType("INTEGER16" , IntegerN(16) , GetM2Integer16()) ;
+   DeclareFixedSizedType("INTEGER32" , IntegerN(32) , GetM2Integer32()) ;
+   DeclareFixedSizedType("INTEGER64" , IntegerN(64) , GetM2Integer64()) ;
+   DeclareFixedSizedType("CARDINAL8" , CardinalN(8) , GetM2Cardinal8()) ;
+   DeclareFixedSizedType("CARDINAL16", CardinalN(16), GetM2Cardinal16()) ;
+   DeclareFixedSizedType("CARDINAL32", CardinalN(32), GetM2Cardinal32()) ;
+   DeclareFixedSizedType("CARDINAL64", CardinalN(64), GetM2Cardinal64()) ;
+   DeclareFixedSizedType("WORD16"    , WordN(16)    , GetM2Word16()) ;
+   DeclareFixedSizedType("WORD32"    , WordN(32)    , GetM2Word32()) ;
+   DeclareFixedSizedType("WORD64"    , WordN(64)    , GetM2Word64()) ;
+   DeclareFixedSizedType("BITSET8"   , SetN(8)      , GetM2Bitset8()) ;
+   DeclareFixedSizedType("BITSET16"  , SetN(16)     , GetM2Bitset16()) ;
+   DeclareFixedSizedType("BITSET32"  , SetN(32)     , GetM2Bitset32()) ;
+   DeclareFixedSizedType("REAL32"    , RealN(32)    , GetM2Real32()) ;
+   DeclareFixedSizedType("REAL64"    , RealN(64)    , GetM2Real64()) ;
+   DeclareFixedSizedType("REAL96"    , RealN(96)    , GetM2Real96()) ;
+   DeclareFixedSizedType("REAL128"   , RealN(128)   , GetM2Real128()) ;
+   DeclareFixedSizedType("COMPLEX32" , ComplexN(32) , GetM2Complex32()) ;
+   DeclareFixedSizedType("COMPLEX64" , ComplexN(64) , GetM2Complex64()) ;
+   DeclareFixedSizedType("COMPLEX96" , ComplexN(96) , GetM2Complex96()) ;
+   DeclareFixedSizedType("COMPLEX128", ComplexN(128), GetM2Complex128())
+END DeclareDefaultSimpleTypes ;
+
+
+(*
+   DeclarePackedBoolean -
+*)
+
+PROCEDURE DeclarePackedBoolean ;
+VAR
+   e: CARDINAL ;
+BEGIN
+   e := GetPackedEquivalent(Boolean) ;
+   AddModGcc(e, GetPackedBooleanType()) ;
+   IncludeElementIntoSet(FullyDeclared, e)
+END DeclarePackedBoolean ;
+
+
+(*
+   DeclarePackedDefaultSimpleTypes -
+*)
+
+PROCEDURE DeclarePackedDefaultSimpleTypes ;
+BEGIN
+   DeclarePackedBoolean
+END DeclarePackedDefaultSimpleTypes ;
+
+
+(*
+   DeclareDefaultTypes - makes default types known to GCC
+*)
+
+PROCEDURE DeclareDefaultTypes ;
+BEGIN
+   IF NOT HaveInitDefaultTypes
+   THEN
+      HaveInitDefaultTypes := TRUE ;
+      pushGlobalScope ;
+      DeclareDefaultSimpleTypes ;
+      DeclarePackedDefaultSimpleTypes ;
+      popGlobalScope
+   END
+END DeclareDefaultTypes ;
+
+
+(*
+   DeclareDefaultConstants - make default constants known to GCC
+*)
+
+PROCEDURE DeclareDefaultConstants ;
+BEGIN
+   AddModGcc(Nil, GetPointerZero(BuiltinsLocation ())) ;
+   IncludeElementIntoSet(FullyDeclared, Nil)
+END DeclareDefaultConstants ;
+
+
+(*
+   FindContext - returns the scope where the symbol
+                 should be created.
+
+                 Symbols created in a module will
+                 return the global context tree, but symbols created
+                 in a module which is declared inside
+                 a procedure will return the procedure Tree.
+*)
+
+PROCEDURE FindContext (sym: CARDINAL) : Tree ;
+BEGIN
+   sym := GetProcedureScope(sym) ;
+   IF sym=NulSym
+   THEN
+      RETURN( GetGlobalContext() )
+   ELSE
+      RETURN( Mod2Gcc(sym) )
+   END
+END FindContext ;
+
+
+(*
+   IsEffectivelyImported - returns TRUE if symbol, Sym, was
+                           effectively imported into ModSym.
+*)
+
+PROCEDURE IsEffectivelyImported (ModSym, sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          IsImported(ModSym, sym) OR
+          (IsImported(ModSym, GetModuleWhereDeclared(sym)) AND
+           IsExported(GetModuleWhereDeclared(sym), sym))
+         )
+END IsEffectivelyImported ;
+
+
+(*
+   FindOuterModule - returns the out most module where, sym,
+                     was declared.  It returns NulSym if the
+                     symbol or the module was declared inside
+                     a procedure.
+*)
+
+PROCEDURE FindOuterModule (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   sym := GetScope(sym) ;
+   WHILE (NOT IsDefImp(sym)) DO
+      IF IsModule(sym)
+      THEN
+         IF GetScope(sym)=NulSym
+         THEN
+            RETURN( sym )
+         ELSE
+            sym := GetScope(sym)
+         END
+      ELSIF IsProcedure(sym)
+      THEN
+         sym := GetScope(sym)
+      END
+   END ;
+   RETURN( sym )
+END FindOuterModule ;
+
+
+(*
+   DoVariableDeclaration -
+*)
+
+PROCEDURE DoVariableDeclaration (var, module: CARDINAL; name: ADDRESS;
+                                 isImported, isExported,
+                                 isTemporary, isGlobal: BOOLEAN;
+                                 scope: Tree) ;
+VAR
+   type, initial: Tree ;
+   varType      : CARDINAL ;
+   location     : location_t ;
+BEGIN
+   IF IsComponent (var)
+   THEN
+      RETURN
+   END ;
+   IF GetMode (var) = LeftValue
+   THEN
+      (*
+        There are two issues to deal with:
+
+        (i)   LeftValue is really a pointer to GetSType(Son), which is built
+              here.
+        (ii)  Front end might have specified the back end use a particular
+              data type, in which case we use the specified type.
+              We do not add an extra pointer if this is the case.
+      *)
+      varType := SkipType (GetVarBackEndType (var)) ;
+      IF varType=NulSym
+      THEN
+         (* we have not explicity told back end the type, so build it *)
+         varType := GetSType (var) ;
+         IF IsVariableAtAddress (var)
+         THEN
+            type := BuildConstPointerType (Mod2Gcc (varType))
+         ELSE
+            type := BuildPointerType (Mod2Gcc (varType))
+         END
+      ELSE
+         type := Mod2Gcc (varType)
+      END ;
+      Assert (AllDependantsFullyDeclared (varType))
+   ELSE
+      type := Mod2Gcc (GetDType (var))
+   END ;
+   location := TokenToLocation (GetDeclaredMod (var)) ;
+   (* The M2LINK module global variables are a special case and have initializers.  *)
+   initial := DetectM2LinkInitial (location, var, module) ;
+   PreAddModGcc (var, DeclareKnownVariable (location,
+                                            name, type,
+                                            isExported, isImported, isTemporary,
+                                            isGlobal, scope, initial)) ;
+   IF initial # NIL
+   THEN
+      (* Remember special case has been created.  *)
+      AddEntryM2Link (var, module, Mod2Gcc (var))
+   END ;
+   WatchRemoveList (var, todolist) ;
+   WatchIncludeList (var, fullydeclared)
+END DoVariableDeclaration ;
+
+
+(*
+   AddEntryM2Link - remember module_var has been created.
+*)
+
+PROCEDURE AddEntryM2Link (var, module: CARDINAL; gcc: Tree) ;
+VAR
+   entry: M2LinkEntry ;
+BEGIN
+   IF M2LinkIndex = NIL
+   THEN
+      M2LinkIndex := InitIndex (1)
+   END ;
+   NEW (entry) ;
+   entry^.var := var ;
+   entry^.gcc := gcc ;
+   entry^.varname := GetSymName (var) ;
+   entry^.modname := GetSymName (module) ;
+   IncludeIndiceIntoIndex (M2LinkIndex, entry)
+END AddEntryM2Link ;
+
+
+(*
+   GetEntryM2Link - return the gcc tree matching varname modname.
+*)
+
+PROCEDURE GetEntryM2Link (varname, modname: Name) : Tree ;
+VAR
+   entry : M2LinkEntry ;
+   high, i: CARDINAL ;
+BEGIN
+   IF M2LinkIndex # NIL
+   THEN
+      i := 1 ;
+      high := HighIndice (M2LinkIndex) ;
+      WHILE i <= high DO
+         entry := GetIndice (M2LinkIndex, i) ;
+         IF (entry^.varname = varname) AND (entry^.modname = modname)
+         THEN
+            RETURN entry^.gcc
+         END ;
+         INC (i)
+      END
+   END ;
+   RETURN NIL
+END GetEntryM2Link ;
+
+
+(*
+   DeclareM2linkGlobals - will create M2LINK.StaticInitialization
+                          and M2LINK.ForcedModuleInitOrder providing
+                          they have not already been created.
+*)
+
+PROCEDURE DeclareM2linkGlobals (tokenno: CARDINAL) ;
+VAR
+   m2link: Name ;
+BEGIN
+   m2link := MakeKey ('M2LINK') ;
+   IF GetEntryM2Link (MakeKey ('StaticInitialization'), m2link) = NIL
+   THEN
+      Assert (DeclareM2linkStaticInitialization (TokenToLocation (tokenno),
+                                                 VAL (INTEGER, ScaffoldStatic)) # NIL)
+   END ;
+   IF GetEntryM2Link (MakeKey ('ForcedModuleInitOrder'), m2link) = NIL
+   THEN
+      Assert (DeclareM2linkForcedModuleInitOrder (TokenToLocation (tokenno),
+                                                  GetRuntimeModuleOverride ()) # NIL)
+   END ;
+END DeclareM2linkGlobals ;
+
+
+(*
+   IsGlobal - is the variable not in a procedure scope.
+*)
+
+PROCEDURE IsGlobal (sym: CARDINAL) : BOOLEAN ;
+VAR
+   s: CARDINAL ;
+BEGIN
+   s := GetScope(sym) ;
+   WHILE (s#NulSym) AND (NOT IsDefImp (s)) AND (NOT IsModule (s)) DO
+      IF IsProcedure (s)
+      THEN
+         RETURN FALSE
+      END ;
+      s := GetScope (s)
+   END ;
+   RETURN TRUE
+END IsGlobal ;
+
+
+(*
+   DeclareVariable - declares a global variable to GCC.
+*)
+
+PROCEDURE DeclareVariable (ModSym, variable: CARDINAL) ;
+VAR
+   scope: Tree ;
+   decl : CARDINAL ;
+BEGIN
+   IF NOT GccKnowsAbout (variable)
+   THEN
+      scope := FindContext (ModSym) ;
+      decl := FindOuterModule (variable) ;
+      Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
+      PushBinding (ModSym) ;
+      DoVariableDeclaration (variable, decl,
+                             KeyToCharStar (GetFullSymName (variable)),
+                             (* in Modula-2 we are allowed to import from ourselves, but we do not present this to GCC *)
+                             IsEffectivelyImported(ModSym, variable) AND (GetMainModule () # decl),
+                             IsExported(ModSym, variable),
+                             IsTemporary (variable),
+                             IsGlobal (variable),
+                             scope) ;
+      PopBinding (ModSym)
+   END
+END DeclareVariable ;
+
+
+(*
+   DetectM2LinkInitial -
+*)
+
+PROCEDURE DetectM2LinkInitial (location: location_t; variable, decl: CARDINAL) : Tree ;
+BEGIN
+   IF (decl # NulSym) AND WholeProgram AND (GetSymName (decl) = MakeKey ('M2LINK'))
+   THEN
+      IF GetSymName (variable) = MakeKey ('StaticInitialization')
+      THEN
+         RETURN BuildIntegerConstant (VAL (INTEGER, ScaffoldStatic))
+      ELSIF GetSymName (variable) = MakeKey ('ForcedModuleInitOrder')
+      THEN
+         RETURN BuildPtrToTypeString (location,
+                                      GetRuntimeModuleOverride (),
+                                      Mod2Gcc (GetSType (variable)))
+      END
+   END ;
+   RETURN NIL
+END DetectM2LinkInitial ;
+
+
+(*
+   DeclareVariableWholeProgram - declares a global variable to GCC when using -fm2-whole-program.
+*)
+
+PROCEDURE DeclareVariableWholeProgram (mainModule, variable: CARDINAL) ;
+VAR
+   scope: Tree ;
+   decl : CARDINAL ;
+BEGIN
+   IF NOT GccKnowsAbout (variable)
+   THEN
+      scope := FindContext (mainModule) ;
+      decl := FindOuterModule (variable) ;
+      Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
+      PushBinding (mainModule) ;
+      DoVariableDeclaration (variable, decl,
+                             KeyToCharStar (GetFullSymName (variable)),
+                             (NOT IsSourceSeen (decl)) AND
+                             IsEffectivelyImported (mainModule, variable) AND (GetMainModule () # decl),
+                             IsExported (mainModule, variable),
+                             IsTemporary (variable),
+                             IsGlobal (variable),
+                             scope) ;
+      PopBinding (mainModule)
+   END
+END DeclareVariableWholeProgram ;
+
+
+(*
+   DeclareGlobalVariablesWholeProgram -
+*)
+
+PROCEDURE DeclareGlobalVariablesWholeProgram (ModSym: CARDINAL) ;
+VAR
+   n, Son: CARDINAL ;
+BEGIN
+   n := 1 ;
+   Son := GetNth(ModSym, n) ;
+   WHILE Son#NulSym DO
+      DeclareVariableWholeProgram(ModSym, Son) ;
+      INC(n) ;
+      Son := GetNth(ModSym, n)
+   END ;
+   ForeachInnerModuleDo(ModSym, DeclareGlobalVariablesWholeProgram)
+END DeclareGlobalVariablesWholeProgram ;
+
+
+(*
+   DeclareGlobalVariables - lists the Global variables for
+                            Module ModSym together with their offset.
+*)
+
+PROCEDURE DeclareGlobalVariables (ModSym: CARDINAL) ;
+VAR
+   n, variable: CARDINAL ;
+BEGIN
+   n := 1 ;
+   variable := GetNth (ModSym, n) ;
+   WHILE variable # NulSym DO
+      DeclareVariable (ModSym, variable) ;
+      INC (n) ;
+      variable := GetNth (ModSym, n)
+   END ;
+   ForeachInnerModuleDo (ModSym, DeclareGlobalVariables)
+END DeclareGlobalVariables ;
+
+
+(*
+   DeclareImportedVariables - declares all imported variables to GM2.
+*)
+
+PROCEDURE DeclareImportedVariables (sym: WORD) ;
+BEGIN
+   IF IsVar (sym)
+   THEN
+      DeclareVariable (GetMainModule (), sym)
+   ELSIF IsDefImp (sym)
+   THEN
+      ForeachExportedDo (sym, DeclareImportedVariables)
+   END
+END DeclareImportedVariables ;
+
+
+(*
+   DeclareImportedVariablesWholeProgram - declares all imported variables.
+*)
+
+PROCEDURE DeclareImportedVariablesWholeProgram (sym: WORD) ;
+BEGIN
+   IF IsVar (sym)
+   THEN
+      IF NOT IsSourceSeen (FindOuterModule (sym))
+      THEN
+         (* import is necessary, even for -fm2-whole-program as we
+            cannot see the source.  *)
+         DeclareVariableWholeProgram (GetMainModule (), sym)
+      END
+   ELSIF IsDefImp (sym)
+   THEN
+      ForeachExportedDo (sym, DeclareImportedVariablesWholeProgram)
+   END
+END DeclareImportedVariablesWholeProgram ;
+
+
+(*
+   DeclareLocalVariable - declare a local variable var.
+*)
+
+PROCEDURE DeclareLocalVariable (var: CARDINAL) ;
+BEGIN
+   Assert (AllDependantsFullyDeclared (var)) ;
+   DoVariableDeclaration (var, NulSym,
+                          KeyToCharStar (GetFullSymName (var)),
+                          FALSE,  (* local variables cannot be imported *)
+                          FALSE,  (* or exported *)
+                          IsTemporary (var),
+                          FALSE,  (* and are not global *)
+                          Mod2Gcc (GetScope (var)))
+END DeclareLocalVariable ;
+
+
+(*
+   DeclareLocalVariables - declares Local variables for procedure.
+*)
+
+PROCEDURE DeclareLocalVariables (procedure: CARDINAL) ;
+VAR
+   i, var: CARDINAL ;
+BEGIN
+   i := NoOfParam (procedure) + 1 ;
+   var := GetNth (procedure, i) ;
+   WHILE var # NulSym DO
+      Assert (procedure = GetScope (var)) ;
+      DeclareLocalVariable (var) ;
+      INC (i) ;
+      var := GetNth (procedure, i)
+   END
+END DeclareLocalVariables ;
+
+
+(*
+   DeclareModuleVariables - declares Module variables for a module
+                            which was declared inside a procedure.
+*)
+
+PROCEDURE DeclareModuleVariables (sym: CARDINAL) ;
+VAR
+   scope : Tree ;
+   i, Var: CARDINAL ;
+BEGIN
+   i := 1 ;
+   scope := Mod2Gcc (GetProcedureScope (sym)) ;
+   Var := GetNth (sym, i) ;
+   WHILE Var # NulSym DO
+      Assert (AllDependantsFullyDeclared (GetSType (Var))) ;
+      DoVariableDeclaration (Var, NulSym,
+                             KeyToCharStar (GetFullSymName (Var)),
+                             FALSE,   (* inner module variables cannot be imported *)
+                             FALSE,   (* or exported (as far as GCC is concerned)  *)
+                             IsTemporary (Var),
+                             FALSE,   (* and are not global *)
+                             scope) ;
+      INC (i) ;
+      Var := GetNth (sym, i)
+   END
+END DeclareModuleVariables ;
+
+
+(*
+   DeclareFieldValue -
+*)
+
+PROCEDURE DeclareFieldValue (sym: CARDINAL; value: Tree; VAR list: Tree) : Tree ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(sym)) ;
+   IF (GetModuleWhereDeclared(sym)=NulSym) OR
+      (GetModuleWhereDeclared(sym)=GetMainModule())
+   THEN
+      RETURN( BuildEnumerator(location, KeyToCharStar(GetSymName(sym)), value, list) )
+   ELSE
+      RETURN( BuildEnumerator(location, KeyToCharStar(GetFullScopeAsmName(sym)), value, list) )
+   END
+END DeclareFieldValue ;
+
+
+(*
+   DeclareFieldEnumeration - declares an enumerator within the current enumeration type.
+*)
+
+PROCEDURE DeclareFieldEnumeration (sym: WORD) : Tree ;
+VAR
+   type    : CARDINAL ;
+   field,
+   enumlist: Tree ;
+BEGIN
+   (* add relationship between gccSym and sym *)
+   type := GetSType (sym) ;
+   enumlist := GetEnumList (type) ;
+   PushValue (sym) ;
+   field := DeclareFieldValue (sym, PopIntegerTree (), enumlist) ;
+   PutEnumList (type, enumlist) ;
+   RETURN field
+END DeclareFieldEnumeration ;
+
+
+(*
+   DeclareEnumeration - declare an enumerated type.
+*)
+
+PROCEDURE DeclareEnumeration (sym: WORD) : Tree ;
+VAR
+   enumlist,
+   gccenum : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (GetDeclaredMod (sym)) ;
+   gccenum := BuildStartEnumeration (location, KeyToCharStar (GetFullSymName (sym)), FALSE) ;
+   enumlist := GetEnumList (sym) ;
+   RETURN BuildEndEnumeration (location, gccenum, enumlist)
+END DeclareEnumeration ;
+
+
+(*
+   DeclareSubrange - declare a subrange type.
+*)
+
+PROCEDURE DeclareSubrange (sym: CARDINAL) : Tree ;
+VAR
+   type,
+   gccsym   : Tree ;
+   high, low: CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (GetDeclaredMod (sym)) ;
+   GetSubrange (sym, high, low) ;
+   (* type := BuildSmallestTypeRange (location, Mod2Gcc(low), Mod2Gcc(high)) ; *)
+   type := Mod2Gcc (GetSType (sym)) ;
+   gccsym := BuildSubrangeType (location,
+                                KeyToCharStar (GetFullSymName(sym)),
+                                type, Mod2Gcc (low), Mod2Gcc (high)) ;
+   RETURN gccsym
+END DeclareSubrange ;
+
+
+(*
+   IncludeGetNth -
+*)
+
+PROCEDURE IncludeGetNth (l: List; sym: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   printf0(' ListOfSons [') ;
+   i := 1 ;
+   WHILE GetNth(sym, i)#NulSym DO
+      IF i>1
+      THEN
+         printf0(', ') ;
+      END ;
+      IncludeItemIntoList(l, GetNth(sym, i)) ;
+      PrintTerse(GetNth(sym, i)) ;
+      INC(i)
+   END ;
+   printf0(']')
+END IncludeGetNth ;
+
+
+(*
+   IncludeType -
+*)
+
+PROCEDURE IncludeType (l: List; sym: CARDINAL) ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := GetSType(sym) ;
+   IF t#NulSym
+   THEN
+      printf0(' type [') ;
+      PrintTerse(t) ;
+      IncludeItemIntoList(l, t) ;
+      printf0(']') ;
+      t := GetVarBackEndType(sym) ;
+      IF t#NulSym
+      THEN
+         printf0(' gcc type [') ;
+         PrintTerse(t) ;
+         IncludeItemIntoList(l, t) ;
+         printf0(']')
+      END
+   END
+END IncludeType ;
+
+
+(*
+   IncludeSubscript -
+*)
+
+PROCEDURE IncludeSubscript (l: List; sym: CARDINAL) ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := GetArraySubscript(sym) ;
+   IF t#NulSym
+   THEN
+      printf0(' subrange [') ;
+      PrintTerse(t) ;
+      IncludeItemIntoList(l, t) ;
+      printf0(']') ;
+   END
+END IncludeSubscript ;
+
+
+(*
+   PrintLocalSymbol -
+*)
+
+PROCEDURE PrintLocalSymbol (sym: CARDINAL) ;
+BEGIN
+   PrintTerse(sym) ; printf0(', ')
+END PrintLocalSymbol ;
+
+
+(*
+   PrintLocalSymbols -
+*)
+
+PROCEDURE PrintLocalSymbols (sym: CARDINAL) ;
+BEGIN
+   printf0('Local Symbols {') ;
+   ForeachLocalSymDo(sym, PrintLocalSymbol) ;
+   printf0('}')
+END PrintLocalSymbols ;
+
+
+(*
+   IncludeGetVarient -
+*)
+
+PROCEDURE IncludeGetVarient (l: List; sym: CARDINAL) ;
+BEGIN
+   IF GetVarient(sym)#NulSym
+   THEN
+      printf0(' Varient [') ;
+      PrintTerse(GetVarient(sym)) ;
+      printf0(']') ;
+      IncludeItemIntoList(l, GetVarient(sym))
+   END
+END IncludeGetVarient ;
+
+
+(*
+   IncludeUnbounded - includes the record component of an unbounded type.
+*)
+
+PROCEDURE IncludeUnbounded (l: List; sym: CARDINAL) ;
+BEGIN
+   IF GetUnboundedRecordType(sym)#NulSym
+   THEN
+      IncludeItemIntoList(l, GetUnboundedRecordType(sym))
+   END
+END IncludeUnbounded ;
+
+
+(*
+   IncludePartialUnbounded - includes the type component of a partial unbounded symbol.
+*)
+
+PROCEDURE IncludePartialUnbounded (l: List; sym: CARDINAL) ;
+BEGIN
+   IF GetSType(sym)#NulSym
+   THEN
+      IncludeItemIntoList(l, GetSType(sym))
+   END
+END IncludePartialUnbounded ;
+
+
+(*
+   PrintDeclared - prints out where, sym, was declared.
+*)
+
+PROCEDURE PrintDeclared (sym: CARDINAL) ;
+VAR
+   filename: String ;
+   lineno,
+   tokenno : CARDINAL ;
+BEGIN
+   tokenno := GetDeclaredMod(sym) ;
+   filename := FindFileNameFromToken(tokenno, 0) ;
+   lineno := TokenToLineNo(tokenno, 0) ;
+   printf2(" declared in %s:%d", filename, lineno)
+END PrintDeclared ;
+
+
+(*
+   PrintAlignment -
+*)
+
+PROCEDURE PrintAlignment (sym: CARDINAL) ;
+VAR
+   align: CARDINAL ;
+BEGIN
+   IF IsRecord(sym) OR IsType(sym) OR IsRecordField(sym) OR IsPointer(sym) OR IsArray(sym)
+   THEN
+      align := GetAlignment(sym) ;
+      IF align#NulSym
+      THEN
+         printf1(" aligned [%d]", align)
+      END
+   END
+END PrintAlignment ;
+
+
+(*
+   IncludeGetParent -
+*)
+
+PROCEDURE IncludeGetParent (l: List; sym: CARDINAL) ;
+BEGIN
+   printf0(' Parent [') ;
+   IncludeItemIntoList(l, GetParent(sym)) ;
+   PrintTerse(GetParent(sym)) ;
+   printf0(']')
+END IncludeGetParent ;
+
+
+(*
+   PrintDecl -
+*)
+
+PROCEDURE PrintDecl (sym: CARDINAL) ;
+BEGIN
+   IF IsDeclaredPackedResolved(sym)
+   THEN
+      IF IsDeclaredPacked(sym)
+      THEN
+         printf0(' packed')
+      ELSE
+         printf0(' unpacked')
+      END
+   ELSE
+      printf0(' unknown if packed')
+   END
+END PrintDecl ;
+
+
+(*
+   PrintScope - displays the scope and line number of declaration of symbol, sym.
+*)
+
+PROCEDURE PrintScope (sym: CARDINAL) ;
+VAR
+   name : Name ;
+   scope,
+   line : CARDINAL ;
+BEGIN
+   line := TokenToLineNo (GetDeclaredMod (sym), 0) ;
+   scope := GetScope (sym) ;
+   name := GetSymName (scope) ;
+   printf3 (' scope %a:%d %d', name, line, scope)
+END PrintScope ;
+
+
+(*
+   PrintProcedure -
+*)
+
+PROCEDURE PrintProcedure (sym: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   n := GetSymName (sym) ;
+   printf2('sym %d IsProcedure (%a)', sym, n);
+   IF IsProcedureReachable(sym)
+   THEN
+      printf0(' IsProcedureReachable')
+   END ;
+   PrintScope (sym) ;
+   IF IsExtern (sym)
+   THEN
+      printf0 (' extern')
+   END ;
+   IF IsPublic (sym)
+   THEN
+      printf0 (' public')
+   END ;
+   IF IsCtor (sym)
+   THEN
+      printf0 (' ctor')
+   END ;
+   PrintDeclared(sym)
+END PrintProcedure ;
+
+
+(*
+   PrintVerboseFromList - prints the, i, th element in the list, l.
+*)
+
+PROCEDURE PrintVerboseFromList (l: List; i: CARDINAL) ;
+VAR
+   type,
+   low,
+   high,
+   sym   : CARDINAL ;
+   n, n2 : Name ;
+BEGIN
+   sym := GetItemFromList(l, i) ;
+   n := GetSymName(sym) ;
+   IF IsError(sym)
+   THEN
+      printf2('sym %d IsError (%a)', sym, n)
+   ELSIF IsDefImp(sym)
+   THEN
+      printf2('sym %d IsDefImp (%a)', sym, n) ;
+      IF IsDefinitionForC(sym)
+      THEN
+         printf0('and IsDefinitionForC')
+      END ;
+      IF IsHiddenTypeDeclared(sym)
+      THEN
+         printf0(' IsHiddenTypeDeclared')
+      END ;
+      ForeachProcedureDo (sym, PrintProcedure)
+   ELSIF IsModule(sym)
+   THEN
+      printf2('sym %d IsModule (%a)', sym, n) ;
+      IF IsModuleWithinProcedure(sym)
+      THEN
+         printf0(' and IsModuleWithinProcedure')
+      END
+   ELSIF IsInnerModule(sym)
+   THEN
+      printf2('sym %d IsInnerModule (%a)', sym, n)
+   ELSIF IsUnknown(sym)
+   THEN
+      printf2('sym %d IsUnknown (%a)', sym, n)
+   ELSIF IsType(sym)
+   THEN
+      printf2('sym %d IsType (%a)', sym, n) ;
+      IncludeType(l, sym) ;
+      PrintAlignment(sym)
+   ELSIF IsProcedure(sym)
+   THEN
+      PrintProcedure (sym)
+   ELSIF IsParameter(sym)
+   THEN
+      printf2('sym %d IsParameter (%a)', sym, n) ;
+      IF GetParameterShadowVar(sym)=NulSym
+      THEN
+         printf0(' no shadow local variable')
+      ELSE
+         printf0(' shadow ') ;
+         IncludeType(l, GetParameterShadowVar(sym))
+         (* PrintVerboseFromList(l, GetParameterShadowVar(sym)) *)
+      END ;
+      IncludeType(l, sym)
+   ELSIF IsPointer(sym)
+   THEN
+      printf2('sym %d IsPointer (%a)', sym, n) ;
+      IncludeType(l, sym) ;
+      PrintAlignment(sym)
+   ELSIF IsRecord(sym)
+   THEN
+      printf2('sym %d IsRecord (%a)', sym, n) ;
+      PrintLocalSymbols(sym) ;
+      IncludeGetNth(l, sym) ;
+      PrintAlignment(sym) ;
+      PrintDecl(sym)
+   ELSIF IsVarient(sym)
+   THEN
+      printf2('sym %d IsVarient (%a)', sym, n) ;
+      PrintDecl(sym) ;
+      IncludeGetNth(l, sym) ;
+      IncludeGetVarient(l, sym) ;
+      IncludeGetParent(l, sym)
+   ELSIF IsFieldVarient(sym)
+   THEN
+      printf2('sym %d IsFieldVarient (%a)', sym, n) ;
+      PrintDecl(sym) ;
+      IncludeGetNth(l, sym) ;
+      IncludeGetVarient(l, sym) ;
+      IncludeGetParent(l, sym)
+   ELSIF IsFieldEnumeration(sym)
+   THEN
+      printf2('sym %d IsFieldEnumeration (%a)', sym, n)
+   ELSIF IsArray(sym)
+   THEN
+      printf2('sym %d IsArray (%a)', sym, n) ;
+      IncludeSubscript(l, sym) ;
+      IncludeType(l, sym) ;
+      PrintAlignment(sym)
+   ELSIF IsEnumeration(sym)
+   THEN
+      printf2('sym %d IsEnumeration (%a)', sym, n)
+   ELSIF IsSet(sym)
+   THEN
+      printf2('sym %d IsSet (%a)', sym, n) ;
+      IncludeType(l, sym)
+   ELSIF IsUnbounded(sym)
+   THEN
+      printf2('sym %d IsUnbounded (%a)', sym, n) ;
+      IncludeUnbounded(l, sym)
+   ELSIF IsPartialUnbounded(sym)
+   THEN
+      printf2('sym %d IsPartialUnbounded (%a)', sym, n) ;
+      IncludePartialUnbounded(l, sym)
+   ELSIF IsRecordField(sym)
+   THEN
+      printf2('sym %d IsRecordField (%a)', sym, n) ;
+      IF IsRecordFieldAVarientTag(sym)
+      THEN
+         printf0(' variant tag')
+      END ;
+      IncludeType(l, sym) ;
+      IncludeGetVarient(l, sym) ;
+      IncludeGetParent(l, sym) ;
+      PrintAlignment(sym) ;
+      PrintDecl(sym)
+   ELSIF IsProcType(sym)
+   THEN
+      printf2('sym %d IsProcType (%a)', sym, n)
+   ELSIF IsVar(sym)
+   THEN
+      printf2('sym %d IsVar (%a) declared in ', sym, n) ;
+      PrintScope (sym) ;
+      printf0 ('mode ') ;
+      CASE GetMode(sym) OF
+
+      LeftValue     : printf0('l ') |
+      RightValue    : printf0('r ') |
+      ImmediateValue: printf0('i ') |
+      NoValue       : printf0('n ')
+
+      END ;
+      IF IsTemporary(sym)
+      THEN
+         printf0('temporary ')
+      END ;
+      IF IsComponent(sym)
+      THEN
+         printf0('component ')
+      END ;
+      IncludeType(l, sym)
+   ELSIF IsConst(sym)
+   THEN
+      printf2('sym %d IsConst (%a)', sym, n) ;
+      IF IsConstString(sym)
+      THEN
+         printf1('  also IsConstString (%a)', n) ;
+         IF IsConstStringM2 (sym)
+         THEN
+            printf0(' a Modula-2 string')
+         ELSIF IsConstStringC (sym)
+         THEN
+            printf0(' a C string')
+         ELSIF IsConstStringM2nul (sym)
+         THEN
+            printf0(' a nul terminated Modula-2 string')
+         ELSIF IsConstStringCnul (sym)
+         THEN
+            printf0(' a nul terminated C string')
+         END
+      ELSIF IsConstructor(sym)
+      THEN
+         printf0(' constant constructor ') ;
+         IncludeType(l, sym)
+      ELSIF IsConstSet(sym)
+      THEN
+         printf0(' constant constructor set ') ;
+         IncludeType(l, sym)
+      ELSE
+         IncludeType(l, sym)
+      END
+   ELSIF IsConstructor(sym)
+   THEN
+      printf2('sym %d IsConstructor (non constant) (%a)', sym, n) ;
+      IncludeType(l, sym)
+   ELSIF IsConstLit(sym)
+   THEN
+      printf2('sym %d IsConstLit (%a)', sym, n)
+   ELSIF IsDummy(sym)
+   THEN
+      printf2('sym %d IsDummy (%a)', sym, n)
+   ELSIF IsTemporary(sym)
+   THEN
+      printf2('sym %d IsTemporary (%a)', sym, n)
+   ELSIF IsVarAParam(sym)
+   THEN
+      printf2('sym %d IsVarAParam (%a)', sym, n)
+   ELSIF IsSubscript(sym)
+   THEN
+      printf2('sym %d IsSubscript (%a)', sym, n)
+   ELSIF IsSubrange(sym)
+   THEN
+      GetSubrange(sym, high, low) ;
+      printf2('sym %d IsSubrange (%a)', sym, n) ;
+      IF (low#NulSym) AND (high#NulSym)
+      THEN
+         type := GetSType(sym) ;
+         IF type#NulSym
+         THEN
+            IncludeType(l, sym) ;
+            n := GetSymName(type) ;
+            printf1(' %a', n)
+         END ;
+         n := GetSymName(low) ;
+         n2 := GetSymName(high) ;
+         printf2('[%a..%a]', n, n2)
+      END
+   ELSIF IsProcedureVariable(sym)
+   THEN
+      printf2('sym %d IsProcedureVariable (%a)', sym, n)
+   ELSIF IsProcedureNested(sym)
+   THEN
+      printf2('sym %d IsProcedureNested (%a)', sym, n)
+   ELSIF IsAModula2Type(sym)
+   THEN
+      printf2('sym %d IsAModula2Type (%a)', sym, n)
+   ELSIF IsObject(sym)
+   THEN
+      printf2('sym %d IsObject (%a)', sym, n)
+   ELSIF IsTuple(sym)
+   THEN
+      printf2('sym %d IsTuple (%a)', sym, n) ;
+      low := GetNth(sym, 1) ;
+      high := GetNth(sym, 2) ;
+      printf2('%d, %d\n', low, high)
+   ELSIF IsGnuAsm(sym)
+   THEN
+      IF IsGnuAsmVolatile(sym)
+      THEN
+         printf2('sym %d IsGnuAsmVolatile (%a)', sym, n)
+      ELSE
+         printf2('sym %d IsGnuAsm (%a)', sym, n)
+      END
+   ELSIF IsComponent(sym)
+   THEN
+      printf2('sym %d IsComponent (%a) ', sym, n) ;
+      i := 1 ;
+      REPEAT
+         type := GetNth(sym, i) ;
+         IF type#NulSym
+         THEN
+            IncludeItemIntoList(l, type) ;
+            n := GetSymName(type) ;
+            printf2("[%a %d] ", n, type) ;
+            INC(i)
+         END ;
+      UNTIL type=NulSym
+   END ;
+
+   IF IsHiddenType(sym)
+   THEN
+      printf0(' IsHiddenType')
+   END ;
+   printf0('\n')
+END PrintVerboseFromList ;
+
+
+(*
+   PrintVerbose - prints limited information about a symbol.
+*)
+
+PROCEDURE PrintVerbose (sym: CARDINAL) ;
+VAR
+   l: List ;
+   i: CARDINAL ;
+BEGIN
+   InitList (l) ;
+   IncludeItemIntoList (l, sym) ;
+   i := 1 ;
+   WHILE i<=NoOfItemsInList (l) DO
+      PrintVerboseFromList (l, i) ;
+      INC (i)
+   END ;
+   KillList (l)
+END PrintVerbose ;
+
+
+(*
+   PrintSym - prints limited information about a symbol.
+              This procedure is externally visible.
+*)
+
+PROCEDURE PrintSym (sym: CARDINAL) ;
+BEGIN
+   printf1 ('information about symbol: %d\n', sym) ;
+   printf0 ('==============================\n') ;
+   PrintVerbose (sym)
+END PrintSym ;
+
+
+(* ********************************
+(*
+   PrintSymbol - prints limited information about a symbol.
+*)
+
+PROCEDURE PrintSymbol (sym: CARDINAL) ;
+BEGIN
+   PrintTerse(sym) ;
+   printf0('\n')
+END PrintSymbol ;
+  ******************************************* *)
+
+(*
+   PrintTerse -
+*)
+
+PROCEDURE PrintTerse (sym: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   n := GetSymName(sym) ;
+   IF IsError(sym)
+   THEN
+      printf2('sym %d IsError (%a)', sym, n)
+   ELSIF IsDefImp(sym)
+   THEN
+      printf2('sym %d IsDefImp (%a)', sym, n) ;
+      IF IsDefinitionForC(sym)
+      THEN
+         printf0('and IsDefinitionForC')
+      END ;
+      IF IsHiddenTypeDeclared(sym)
+      THEN
+         printf0(' IsHiddenTypeDeclared')
+      END
+   ELSIF IsModule(sym)
+   THEN
+      printf2('sym %d IsModule (%a)', sym, n) ;
+      IF IsModuleWithinProcedure(sym)
+      THEN
+         printf0(' and IsModuleWithinProcedure')
+      END
+   ELSIF IsInnerModule(sym)
+   THEN
+      printf2('sym %d IsInnerModule (%a)', sym, n)
+   ELSIF IsUnknown(sym)
+   THEN
+      printf2('sym %d IsUnknown (%a)', sym, n)
+   ELSIF IsType(sym)
+   THEN
+      printf2('sym %d IsType (%a)', sym, n)
+   ELSIF IsProcedure(sym)
+   THEN
+      printf2('sym %d IsProcedure (%a)', sym, n);
+      IF IsProcedureReachable(sym)
+      THEN
+         printf0(' and IsProcedureReachable')
+      END
+   ELSIF IsParameter(sym)
+   THEN
+      printf2('sym %d IsParameter (%a)', sym, n)
+   ELSIF IsPointer(sym)
+   THEN
+      printf2('sym %d IsPointer (%a)', sym, n)
+   ELSIF IsRecord(sym)
+   THEN
+      printf2('sym %d IsRecord (%a)', sym, n)
+   ELSIF IsVarient(sym)
+   THEN
+      printf2('sym %d IsVarient (%a)', sym, n)
+   ELSIF IsFieldVarient(sym)
+   THEN
+      printf2('sym %d IsFieldVarient (%a)', sym, n)
+   ELSIF IsFieldEnumeration(sym)
+   THEN
+      printf2('sym %d IsFieldEnumeration (%a)', sym, n)
+   ELSIF IsArray(sym)
+   THEN
+      printf2('sym %d IsArray (%a)', sym, n)
+   ELSIF IsEnumeration(sym)
+   THEN
+      printf2('sym %d IsEnumeration (%a)', sym, n)
+   ELSIF IsSet(sym)
+   THEN
+      printf2('sym %d IsSet (%a)', sym, n)
+   ELSIF IsUnbounded(sym)
+   THEN
+      printf2('sym %d IsUnbounded (%a)', sym, n)
+   ELSIF IsRecordField(sym)
+   THEN
+      printf2('sym %d IsRecordField (%a)', sym, n)
+   ELSIF IsProcType(sym)
+   THEN
+      printf2('sym %d IsProcType (%a)', sym, n)
+   ELSIF IsVar(sym)
+   THEN
+      printf2('sym %d IsVar (%a)', sym, n)
+   ELSIF IsConstString(sym)
+   THEN
+      printf2('sym %d IsConstString (%a)', sym, n)
+   ELSIF IsConst(sym)
+   THEN
+      printf2('sym %d IsConst (%a)', sym, n)
+   ELSIF IsConstLit(sym)
+   THEN
+      printf2('sym %d IsConstLit (%a)', sym, n)
+   ELSIF IsDummy(sym)
+   THEN
+      printf2('sym %d IsDummy (%a)', sym, n)
+   ELSIF IsTemporary(sym)
+   THEN
+      printf2('sym %d IsTemporary (%a)', sym, n)
+   ELSIF IsVarAParam(sym)
+   THEN
+      printf2('sym %d IsVarAParam (%a)', sym, n)
+   ELSIF IsSubscript(sym)
+   THEN
+      printf2('sym %d IsSubscript (%a)', sym, n)
+   ELSIF IsSubrange(sym)
+   THEN
+      printf2('sym %d IsSubrange (%a)', sym, n)
+   ELSIF IsProcedureVariable(sym)
+   THEN
+      printf2('sym %d IsProcedureVariable (%a)', sym, n)
+   ELSIF IsProcedureNested(sym)
+   THEN
+      printf2('sym %d IsProcedureNested (%a)', sym, n)
+   ELSIF IsAModula2Type(sym)
+   THEN
+      printf2('sym %d IsAModula2Type (%a)', sym, n)
+   ELSIF IsGnuAsmVolatile(sym)
+   THEN
+      printf2('sym %d IsGnuAsmVolatile (%a)', sym, n)
+   END ;
+
+   IF IsHiddenType(sym)
+   THEN
+      printf0(' IsHiddenType')
+   END
+END PrintTerse ;
+
+
+(*
+   CheckAlignment -
+*)
+
+PROCEDURE CheckAlignment (type: Tree; sym: CARDINAL) : Tree ;
+VAR
+   align: CARDINAL ;
+BEGIN
+   align := GetAlignment(sym) ;
+   IF align#NulSym
+   THEN
+      PushInt(0) ;
+      PushValue(align) ;
+      IF NOT Equ(GetDeclaredMod(sym))
+      THEN
+         RETURN( SetAlignment(type, Mod2Gcc(GetAlignment(sym))) )
+      END
+   END ;
+   RETURN( type )
+END CheckAlignment ;
+
+
+(*
+   CheckPragma -
+*)
+
+PROCEDURE CheckPragma (type: Tree; sym: CARDINAL) : Tree ;
+BEGIN
+   IF IsDeclaredPacked (sym)
+   THEN
+      IF IsRecordField (sym) OR IsFieldVarient (sym)
+      THEN
+         type := SetDeclPacked (type)
+      ELSIF IsRecord (sym) OR IsVarient (sym)
+      THEN
+         type := SetTypePacked (type)
+      END
+   END ;
+   RETURN CheckAlignment (type, sym)
+END CheckPragma ;
+
+
+(*
+   IsZero - returns TRUE if symbol, sym, is zero.
+*)
+
+PROCEDURE IsZero (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   PushIntegerTree(Mod2Gcc(sym)) ;
+   PushInt(0) ;
+   RETURN( Equ(GetDeclaredMod(sym)) )
+END IsZero ;
+
+
+(*
+   SetFieldPacked - sets Varient, VarientField and RecordField symbols
+                    as packed.
+*)
+
+PROCEDURE SetFieldPacked (field: CARDINAL) ;
+BEGIN
+   IF IsVarient(field) OR IsFieldVarient(field) OR IsRecordField(field)
+   THEN
+      PutDeclaredPacked(field, TRUE)
+   END
+END SetFieldPacked ;
+
+
+(*
+   RecordPacked - indicates that record, sym, and its fields
+                  are all packed.
+*)
+
+PROCEDURE RecordPacked (sym: CARDINAL) ;
+BEGIN
+   PutDeclaredPacked(sym, TRUE) ;
+   WalkRecordDependants(sym, SetFieldPacked)
+END RecordPacked ;
+
+
+(*
+   SetFieldNotPacked - sets Varient, VarientField and RecordField symbols
+                       as not packed.
+*)
+
+PROCEDURE SetFieldNotPacked (field: CARDINAL) ;
+BEGIN
+   IF IsVarient(field) OR IsFieldVarient(field) OR IsRecordField(field)
+   THEN
+      PutDeclaredPacked(field, FALSE)
+   END
+END SetFieldNotPacked ;
+
+
+(*
+   RecordNotPacked - indicates that record, sym, and its fields
+                     are all not packed.
+*)
+
+PROCEDURE RecordNotPacked (sym: CARDINAL) ;
+BEGIN
+   PutDeclaredPacked(sym, FALSE) ;
+   WalkRecordDependants(sym, SetFieldNotPacked)
+END RecordNotPacked ;
+
+
+(*
+   DetermineIfRecordPacked -
+*)
+
+PROCEDURE DetermineIfRecordPacked (sym: CARDINAL) ;
+VAR
+   defaultAlignment: CARDINAL ;
+BEGIN
+   defaultAlignment := GetDefaultRecordFieldAlignment(sym) ;
+   IF (defaultAlignment#NulSym) AND IsZero(defaultAlignment)
+   THEN
+      RecordPacked(sym)
+   ELSE
+      RecordNotPacked(sym)
+   END
+END DetermineIfRecordPacked ;
+
+
+(*
+   DeclarePackedSubrange -
+*)
+
+PROCEDURE DeclarePackedSubrange (equiv, sym: CARDINAL) ;
+VAR
+   type,
+   gccsym   : Tree ;
+   high, low: CARDINAL ;
+   location : location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(sym)) ;
+   GetSubrange(sym, high, low) ;
+   type := BuildSmallestTypeRange(location, Mod2Gcc(low), Mod2Gcc(high)) ;
+   gccsym := BuildSubrangeType(location, KeyToCharStar(GetFullSymName(sym)),
+                               type, Mod2Gcc(low), Mod2Gcc(high)) ;
+   AddModGcc(equiv, gccsym)
+END DeclarePackedSubrange ;
+
+
+(*
+   DeclarePackedSet -
+*)
+
+PROCEDURE DeclarePackedSet (equiv, sym: CARDINAL) ;
+VAR
+   highLimit,
+   range,
+   gccsym   : Tree ;
+   type,
+   high, low: CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(sym)) ;
+   Assert(IsSet(sym)) ;
+   type := GetDType(sym) ;
+   low := GetTypeMin(type) ;
+   high := GetTypeMax(type) ;
+   highLimit := BuildSub(location, Mod2Gcc(high), Mod2Gcc(low), FALSE) ;
+   (* --fixme-- we need to check that low <= WORDLENGTH.  *)
+   highLimit := BuildLSL(location, GetIntegerOne(location), highLimit, FALSE) ;
+   range := BuildSmallestTypeRange(location, GetIntegerZero(location), highLimit) ;
+   gccsym := BuildSubrangeType(location, KeyToCharStar(GetFullSymName(sym)),
+                               range, GetIntegerZero(location), highLimit) ;
+   AddModGcc(equiv, gccsym)
+END DeclarePackedSet ;
+
+
+(*
+   DeclareFieldEnumeration - declares an enumerator within the current enumeration type.
+*)
+
+PROCEDURE DeclarePackedFieldEnumeration (sym: WORD) ;
+VAR
+   equiv,
+   type    : CARDINAL ;
+   field,
+   enumlist: Tree ;
+BEGIN
+   (* add relationship between gccSym and sym *)
+   type := GetSType (sym) ;
+   equiv := GetPackedEquivalent (type) ;
+   enumlist := GetEnumList (equiv) ;
+   PushValue (sym) ;
+   field := DeclareFieldValue (sym, PopIntegerTree(), enumlist) ;
+   Assert (field # NIL) ;
+   PutEnumList (equiv, enumlist)
+END DeclarePackedFieldEnumeration ;
+
+
+(*
+   DeclarePackedEnumeration -
+*)
+
+PROCEDURE DeclarePackedEnumeration (equiv, sym: CARDINAL) ;
+VAR
+   enumlist,
+   gccenum : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(sym)) ;
+   gccenum := BuildStartEnumeration(location, KeyToCharStar(GetFullSymName(sym)), TRUE) ;
+   ForeachLocalSymDo(sym, DeclarePackedFieldEnumeration) ;
+   enumlist := GetEnumList(equiv) ;
+   gccenum := BuildEndEnumeration(location, gccenum, enumlist) ;
+   AddModGcc(equiv, gccenum)
+END DeclarePackedEnumeration ;
+
+
+(*
+   DeclarePackedType -
+*)
+
+PROCEDURE DeclarePackedType (equiv, sym: CARDINAL) ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   type := GetSType(sym) ;
+   IF type=NulSym
+   THEN
+      IF sym=Boolean
+      THEN
+         AddModGcc(equiv, GetPackedBooleanType())
+      ELSE
+         AddModGcc(equiv, Mod2Gcc(sym))
+      END
+   ELSE
+      DeclarePackedType(GetPackedEquivalent(type), type) ;
+      AddModGcc(equiv, Mod2Gcc(GetPackedEquivalent(type)))
+   END
+END DeclarePackedType ;
+
+
+(*
+   doDeclareEquivalent -
+*)
+
+PROCEDURE doDeclareEquivalent (sym: CARDINAL; p: doDeclareProcedure) : Tree ;
+VAR
+   equiv: CARDINAL ;
+BEGIN
+   equiv := GetPackedEquivalent(sym) ;
+   IF NOT GccKnowsAbout(equiv)
+   THEN
+      p(equiv, sym) ;
+      IncludeElementIntoSet(FullyDeclared, equiv)
+   END ;
+   RETURN( Mod2Gcc(equiv) )
+END doDeclareEquivalent ;
+
+
+(*
+   PossiblyPacked -
+*)
+
+PROCEDURE PossiblyPacked (sym: CARDINAL; isPacked: BOOLEAN) : Tree ;
+BEGIN
+   IF isPacked
+   THEN
+      IF IsSubrange(sym)
+      THEN
+         RETURN( doDeclareEquivalent(sym, DeclarePackedSubrange) )
+      ELSIF IsType(sym)
+      THEN
+         RETURN( doDeclareEquivalent(sym, DeclarePackedType) )
+      ELSIF IsEnumeration(sym)
+      THEN
+         RETURN( doDeclareEquivalent(sym, DeclarePackedEnumeration) )
+      ELSIF IsSet(sym)
+      THEN
+         RETURN( doDeclareEquivalent(sym, DeclarePackedSet) )
+      END
+   END ;
+   RETURN( Mod2Gcc(sym) )
+END PossiblyPacked ;
+
+
+(*
+   GetPackedType - returns a possibly packed type for field.
+*)
+
+PROCEDURE GetPackedType (sym: CARDINAL) : Tree ;
+BEGIN
+   IF IsSubrange(sym)
+   THEN
+      RETURN( doDeclareEquivalent(sym, DeclarePackedSubrange) )
+   ELSIF IsType(sym)
+   THEN
+      RETURN( doDeclareEquivalent(sym, DeclarePackedType) )
+   ELSIF IsEnumeration(sym)
+   THEN
+      RETURN( doDeclareEquivalent(sym, DeclarePackedEnumeration) )
+   END ;
+   RETURN( Mod2Gcc(sym) )
+END GetPackedType ;
+
+
+(*
+   MaybeAlignField - checks to see whether, field, is packed or aligned and it updates
+                     the offsets if appropriate.
+*)
+
+PROCEDURE MaybeAlignField (field: CARDINAL; VAR byteOffset, bitOffset: Tree) : Tree ;
+VAR
+   f, ftype,
+   nbits   : Tree ;
+   location: location_t ;
+BEGIN
+   f := Mod2Gcc(field) ;
+   IF IsDeclaredPacked(field)
+   THEN
+      location := TokenToLocation(GetDeclaredMod(field)) ;
+      f := SetDeclPacked(f) ;
+      ftype := GetPackedType(GetSType(field)) ;
+      nbits := BuildTBitSize(location, ftype) ;
+      f := SetRecordFieldOffset(f, byteOffset, bitOffset, ftype, nbits) ;
+      bitOffset := BuildAdd(location, bitOffset, nbits, FALSE) ;
+      RETURN( f )
+   ELSE
+      RETURN( CheckAlignment(f, field) )
+   END
+END MaybeAlignField ;
+
+
+(*
+   DeclareRecord - declares a record and its fields to gcc.
+                   The final gcc record type is returned.
+*)
+
+PROCEDURE DeclareRecord (Sym: CARDINAL) : Tree ;
+VAR
+   Field     : CARDINAL ;
+   i         : CARDINAL ;
+   nbits,
+   ftype,
+   field,
+   byteOffset,
+   bitOffset,
+   FieldList,
+   RecordType: Tree ;
+   location  : location_t ;
+BEGIN
+   i := 1 ;
+   FieldList := Tree(NIL) ;
+   RecordType := DoStartDeclaration(Sym, BuildStartRecord) ;
+   location := TokenToLocation(GetDeclaredMod(Sym)) ;
+   byteOffset := GetIntegerZero(location) ;
+   bitOffset := GetIntegerZero(location) ;
+   REPEAT
+      Field := GetNth(Sym, i) ;
+      IF Field#NulSym
+      THEN
+         IF IsRecordField(Field) AND IsRecordFieldAVarientTag(Field) AND (GetSymName(Field)=NulName)
+         THEN
+            (* do not include a nameless tag into the C struct *)
+         ELSIF IsVarient(Field)
+         THEN
+            Field := Chained(Field) ;
+            field := Mod2Gcc(Field) ;
+            IF IsDeclaredPacked(Field)
+            THEN
+               location := TokenToLocation(GetDeclaredMod(Field)) ;
+               field := SetDeclPacked(field) ;
+               ftype := GetPackedType(GetSType(Field)) ;
+               nbits := BuildTBitSize(location, ftype) ;
+               field := SetRecordFieldOffset(field, byteOffset, bitOffset, ftype, nbits) ;
+               bitOffset := BuildAdd(location, bitOffset, nbits, FALSE) ;
+               byteOffset := BuildAdd(location, byteOffset,
+                                      BuildDivTrunc(location, bitOffset, BuildIntegerConstant(8), FALSE),
+                                      FALSE) ;
+               bitOffset := BuildModTrunc(location, bitOffset, BuildIntegerConstant(8), FALSE)
+            END ;
+            FieldList := ChainOn(FieldList, field)
+         ELSE
+            IF Debugging
+            THEN
+               printf0('chaining ') ; PrintTerse(Field) ; printf0('\n')
+            END ;
+            FieldList := ChainOn(FieldList, MaybeAlignField(Chained(Field), byteOffset, bitOffset))
+         END
+      END ;
+      INC(i)
+   UNTIL Field=NulSym ;
+   WatchRemoveList(Sym, partiallydeclared) ;
+   WatchRemoveList(Sym, heldbyalignment) ;
+   WatchRemoveList(Sym, finishedalignment) ;
+   location := TokenToLocation(GetDeclaredMod(Sym)) ;
+   RETURN( BuildEndRecord(location, RecordType, FieldList, IsDeclaredPacked(Sym)) )
+END DeclareRecord ;
+
+
+(*
+   DeclareRecordField -
+*)
+
+PROCEDURE DeclareRecordField (sym: CARDINAL) : Tree ;
+VAR
+   field,
+   GccFieldType: Tree ;
+   location    : location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(sym)) ;
+   GccFieldType := PossiblyPacked(GetSType(sym), IsDeclaredPacked(sym)) ;
+   field := BuildFieldRecord(location, KeyToCharStar(GetFullSymName(sym)), GccFieldType) ;
+   RETURN( field )
+END DeclareRecordField ;
+
+
+(*
+   DeclareVarient - declares a record and its fields to gcc.
+                    The final gcc record type is returned.
+*)
+
+PROCEDURE DeclareVarient (sym: CARDINAL) : Tree ;
+VAR
+   Field       : CARDINAL ;
+   i           : CARDINAL ;
+   byteOffset,
+   bitOffset,
+   FieldList,
+   VarientType : Tree ;
+   location    : location_t ;
+BEGIN
+   i := 1 ;
+   FieldList := Tree(NIL) ;
+   VarientType := DoStartDeclaration(sym, BuildStartVarient) ;
+   location := TokenToLocation(GetDeclaredMod(sym)) ;
+   byteOffset := GetIntegerZero(location) ;
+   bitOffset := GetIntegerZero(location) ;
+   WHILE GetNth(sym, i)#NulSym DO
+      Field := GetNth(sym, i) ;
+      IF IsRecordField(Field) AND IsRecordFieldAVarientTag(Field) AND (GetSymName(Field)=NulName)
+      THEN
+         (* do not include a nameless tag into the C struct *)
+      ELSE
+         IF Debugging
+         THEN
+            printf0('chaining ') ; PrintTerse(Field) ; printf0('\n')
+         END ;
+         FieldList := ChainOn(FieldList, MaybeAlignField(Chained(Field), byteOffset, bitOffset))
+      END ;
+      INC(i)
+   END ;
+   WatchRemoveList(sym, partiallydeclared) ;
+   WatchRemoveList(sym, heldbyalignment) ;
+   WatchRemoveList(sym, finishedalignment) ;
+   VarientType := BuildEndVarient(location, VarientType, FieldList, IsDeclaredPacked(sym)) ;
+   RETURN( VarientType )
+END DeclareVarient ;
+
+
+(*
+   DeclareFieldVarient -
+*)
+
+PROCEDURE DeclareFieldVarient (sym: CARDINAL) : Tree ;
+VAR
+   i, f        : CARDINAL ;
+   VarientList,
+   VarientType,
+   byteOffset,
+   bitOffset,
+   GccFieldType: Tree ;
+   location    : location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(sym)) ;
+   i := 1 ;
+   VarientList := Tree(NIL) ;
+   VarientType := DoStartDeclaration(sym, BuildStartFieldVarient) ;
+   (* no need to store the [sym, RecordType] tuple as it is stored by DeclareRecord which calls us *)
+   byteOffset := GetIntegerZero(location) ;
+   bitOffset := GetIntegerZero(location) ;
+   WHILE GetNth(sym, i)#NulSym DO
+      f := GetNth(sym, i) ;
+      IF IsFieldVarient(f) AND IsEmptyFieldVarient(f)
+      THEN
+         (* do not include empty varient fields (created via 'else end' in variant records *)
+      ELSE
+         IF Debugging
+         THEN
+            printf0('chaining ') ; PrintTerse(f) ; printf0('\n')
+         END ;
+         VarientList := ChainOn(VarientList, MaybeAlignField(Chained(f), byteOffset, bitOffset))
+      END ;
+      INC(i)
+   END ;
+   WatchRemoveList(sym, partiallydeclared) ;
+   GccFieldType := BuildEndFieldVarient(location, VarientType, VarientList, IsDeclaredPacked(sym)) ;
+   RETURN( GccFieldType )
+END DeclareFieldVarient ;
+
+
+(*
+   DeclarePointer - declares a pointer type to gcc and returns the Tree.
+*)
+
+PROCEDURE DeclarePointer (sym: CARDINAL) : Tree ;
+BEGIN
+   RETURN( BuildPointerType(Mod2Gcc(GetSType(sym))) )
+END DeclarePointer ;
+
+
+(*
+   DeclareUnbounded - builds an unbounded type and returns the gcc tree.
+*)
+
+PROCEDURE DeclareUnbounded (sym: CARDINAL) : Tree ;
+VAR
+   record: CARDINAL ;
+BEGIN
+   Assert(IsUnbounded(sym)) ;
+   IF GccKnowsAbout(sym)
+   THEN
+      RETURN( Mod2Gcc(sym) )
+   ELSE
+      record := GetUnboundedRecordType(sym) ;
+      Assert(IsRecord(record)) ;
+      Assert(AllDependantsFullyDeclared(record)) ;
+      IF (NOT GccKnowsAbout(record))
+      THEN
+         DeclareTypeConstFully(record) ;
+         WatchRemoveList(record, todolist)
+      END ;
+      RETURN( Mod2Gcc(record) )
+   END
+END DeclareUnbounded ;
+
+
+(*
+   BuildIndex -
+*)
+
+PROCEDURE BuildIndex (tokenno: CARDINAL; array: CARDINAL) : Tree ;
+VAR
+   Subscript: CARDINAL ;
+   Type,
+   High, Low: CARDINAL ;
+   n,
+   low, high: Tree ;
+   location : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   Subscript := GetArraySubscript (array) ;
+   Assert (IsSubscript (Subscript)) ;
+   Type := GetDType (Subscript) ;
+   Low := GetTypeMin (Type) ;
+   High := GetTypeMax (Type) ;
+   DeclareConstant (tokenno, Low) ;
+   DeclareConstant (tokenno, High) ;
+   low := Mod2Gcc (Low) ;
+   high := Mod2Gcc (High) ;
+   IF ExceedsTypeRange (GetIntegerType (), low, high)
+   THEN
+      location := TokenToLocation (tokenno) ;
+      n := BuildConvert (location, GetIntegerType (), BuildSub (location, high, low, FALSE), FALSE) ;
+      IF TreeOverflow(n) OR ValueOutOfTypeRange (GetIntegerType (), n)
+      THEN
+         MetaError3('implementation restriction, array is too large {%1EDM}, the range {%2ad}..{%3ad} exceeds the integer range',
+                    array, Low, High) ;
+         RETURN BuildArrayIndexType (GetIntegerZero (location), GetIntegerZero (location))
+      ELSE
+         PutArrayLarge (array) ;
+	 RETURN BuildArrayIndexType (GetIntegerZero (location), n)
+      END
+   ELSE
+      low := BuildConvert (location, GetIntegerType (), low, FALSE) ;
+      high := BuildConvert (location, GetIntegerType (), high, FALSE) ;
+      RETURN BuildArrayIndexType (low, high)
+   END
+END BuildIndex ;
+
+
+(*
+   DeclareArray - declares an array to gcc and returns the gcc tree.
+*)
+
+PROCEDURE DeclareArray (Sym: CARDINAL) : Tree ;
+VAR
+   typeOfArray: CARDINAL ;
+   ArrayType,
+   GccArray,
+   GccIndex   : Tree ;
+   Subscript  : CARDINAL ;
+   tokenno    : CARDINAL ;
+   location   : location_t ;
+BEGIN
+   Assert(IsArray(Sym)) ;
+
+   tokenno := GetDeclaredMod(Sym) ;
+   location := TokenToLocation(tokenno) ;
+
+   Subscript := GetArraySubscript(Sym) ;
+   typeOfArray := GetDType(Sym) ;
+   GccArray := Mod2Gcc(typeOfArray) ;
+   GccIndex := BuildIndex(tokenno, Sym) ;
+
+   IF GccKnowsAbout(Sym)
+   THEN
+      ArrayType := Mod2Gcc(Sym)
+   ELSE
+      ArrayType := BuildStartArrayType(GccIndex, GccArray, typeOfArray) ;
+      PreAddModGcc(Sym, ArrayType)
+   END ;
+
+   PreAddModGcc(Subscript, GccArray) ;       (* we save the type of this array as the subscript *)
+   PushIntegerTree(BuildSize(location, GccArray, FALSE)) ;  (* and the size of this array so far *)
+   PopSize(Subscript) ;
+
+   GccArray := BuildEndArrayType(ArrayType, GccArray, GccIndex, typeOfArray) ;
+   Assert(GccArray=ArrayType) ;
+
+   RETURN( GccArray )
+END DeclareArray ;
+
+
+(*
+   DeclareProcType - declares a procedure type to gcc and returns the gcc type tree.
+*)
+
+PROCEDURE DeclareProcType (Sym: CARDINAL) : Tree ;
+VAR
+   i, p, Son,
+   ReturnType: CARDINAL ;
+   func,
+   GccParam  : Tree ;
+   location  : location_t ;
+BEGIN
+   ReturnType := GetSType(Sym) ;
+   func := DoStartDeclaration(Sym, BuildStartFunctionType) ;
+   InitFunctionTypeParameters ;
+   p := NoOfParam(Sym) ;
+   i := p ;
+   WHILE i>0 DO
+      Son := GetNthParam(Sym, i) ;
+      location := TokenToLocation(GetDeclaredMod(Son)) ;
+      GccParam := BuildProcTypeParameterDeclaration(location, Mod2Gcc(GetSType(Son)), IsVarParam(Sym, i)) ;
+      PreAddModGcc(Son, GccParam) ;
+      DEC(i)
+   END ;
+   IF ReturnType=NulSym
+   THEN
+      RETURN( BuildEndFunctionType(func, NIL, UsesVarArgs(Sym)) )
+   ELSE
+      RETURN( BuildEndFunctionType(func, Mod2Gcc(ReturnType), UsesVarArgs(Sym)) )
+   END
+END DeclareProcType ;
+
+
+VAR
+   MaxEnumerationField,
+   MinEnumerationField: CARDINAL ;
+
+
+(*
+   FindMinMaxEnum - finds the minimum and maximum enumeration fields.
+*)
+
+PROCEDURE FindMinMaxEnum (field: WORD) ;
+BEGIN
+   IF MaxEnumerationField=NulSym
+   THEN
+      MaxEnumerationField := field
+   ELSE
+      PushValue(field) ;
+      PushValue(MaxEnumerationField) ;
+      IF Gre(GetDeclaredMod(field))
+      THEN
+         MaxEnumerationField := field
+      END
+   END ;
+   IF MinEnumerationField=NulSym
+   THEN
+      MinEnumerationField := field
+   ELSE
+      PushValue(field) ;
+      PushValue(MinEnumerationField) ;
+      IF Less(GetDeclaredMod(field))
+      THEN
+         MinEnumerationField := field
+      END
+   END
+END FindMinMaxEnum ;
+
+
+(*
+   GetTypeMin -
+*)
+
+PROCEDURE GetTypeMin (type: CARDINAL) : CARDINAL ;
+VAR
+   min, max: CARDINAL ;
+BEGIN
+   IF IsSubrange(type)
+   THEN
+      GetSubrange(type, max, min) ;
+      RETURN( min )
+   ELSIF IsSet(type)
+   THEN
+      RETURN( GetTypeMin(GetSType(type)) )
+   ELSIF IsEnumeration(type)
+   THEN
+      MinEnumerationField := NulSym ;
+      MaxEnumerationField := NulSym ;
+      ForeachFieldEnumerationDo(type, FindMinMaxEnum) ;
+      RETURN( MinEnumerationField )
+   ELSIF IsBaseType(type)
+   THEN
+      GetBaseTypeMinMax(type, min, max) ;
+      RETURN( min )
+   ELSIF IsSystemType(type)
+   THEN
+      GetSystemTypeMinMax(type, min, max) ;
+      RETURN( min )
+   ELSIF GetSType(type)=NulSym
+   THEN
+      MetaError1('unable to obtain the MIN value for type {%1as}', type)
+   ELSE
+      RETURN( GetTypeMin(GetSType(type)) )
+   END
+END GetTypeMin ;
+
+
+(*
+   GetTypeMax -
+*)
+
+PROCEDURE GetTypeMax (type: CARDINAL) : CARDINAL ;
+VAR
+   min, max: CARDINAL ;
+BEGIN
+   IF IsSubrange(type)
+   THEN
+      GetSubrange(type, max, min) ;
+      RETURN( max )
+   ELSIF IsSet(type)
+   THEN
+      RETURN( GetTypeMax(GetSType(type)) )
+   ELSIF IsEnumeration(type)
+   THEN
+      MinEnumerationField := NulSym ;
+      MaxEnumerationField := NulSym ;
+      ForeachFieldEnumerationDo(type, FindMinMaxEnum) ;
+      RETURN( MaxEnumerationField )
+   ELSIF IsBaseType(type)
+   THEN
+      GetBaseTypeMinMax(type, min, max) ;
+      RETURN( max )
+   ELSIF IsSystemType(type)
+   THEN
+      GetSystemTypeMinMax(type, min, max) ;
+      RETURN( max )
+   ELSIF GetSType(type)=NulSym
+   THEN
+      MetaError1('unable to obtain the MAX value for type {%1as}', type)
+   ELSE
+      RETURN( GetTypeMax(GetSType(type)) )
+   END
+END GetTypeMax ;
+
+
+(*
+   PushNoOfBits - pushes the integer value of the number of bits required
+                  to maintain a set of type.
+*)
+
+PROCEDURE PushNoOfBits (type: CARDINAL; low, high: CARDINAL) ;
+BEGIN
+   PushValue(high) ;
+   ConvertToType(type) ;
+   PushValue(low) ;
+   ConvertToType(type) ;
+   Sub ;
+   ConvertToType(Cardinal)
+END PushNoOfBits ;
+
+
+(*
+   DeclareLargeSet - n is the name of the set.
+                     type is the subrange type (or simple type)
+                     low and high are the limits of the subrange.
+*)
+
+PROCEDURE DeclareLargeSet (n: Name; type: CARDINAL; low, high: CARDINAL) : Tree ;
+VAR
+   lowtree,
+   hightree,
+   BitsInSet,
+   RecordType,
+   GccField,
+   FieldList : Tree ;
+   bpw       : CARDINAL ;
+   location  : location_t ;
+BEGIN
+   location   := TokenToLocation(GetDeclaredMod(type)) ;
+   bpw        := GetBitsPerBitset() ;
+   PushValue(low) ;
+   lowtree    := PopIntegerTree() ;
+   PushValue(high) ;
+   hightree   := PopIntegerTree() ;
+   FieldList  := Tree(NIL) ;
+   RecordType := BuildStartRecord(location, KeyToCharStar(n)) ;  (* no problem with recursive types here *)
+   PushNoOfBits(type, low, high) ;
+   PushCard(1) ;
+   Addn ;
+   BitsInSet := PopIntegerTree() ;
+   PushIntegerTree(BitsInSet) ;
+   PushCard(0) ;
+   WHILE Gre(GetDeclaredMod(type)) DO
+      PushIntegerTree(BitsInSet) ;
+      PushCard(bpw-1) ;
+      IF GreEqu(GetDeclaredMod(type))
+      THEN
+         PushIntegerTree(lowtree) ;
+         PushCard(bpw-1) ;
+         Addn ;
+         GccField := BuildFieldRecord(location, NIL, BuildSetType(location, NIL, Mod2Gcc(type), lowtree, PopIntegerTree(), FALSE)) ;
+         PushIntegerTree(lowtree) ;
+         PushCard(bpw) ;
+         Addn ;
+         lowtree := PopIntegerTree() ;
+         PushIntegerTree(BitsInSet) ;
+         PushCard(bpw) ;
+         Sub ;
+         BitsInSet := PopIntegerTree()
+      ELSE
+         (* printf2('range is %a..%a\n', GetSymName(low), GetSymName(high)) ; *)
+         GccField := BuildFieldRecord(location, NIL, BuildSetType(location, NIL, Mod2Gcc(type), lowtree, hightree, FALSE)) ;
+         PushCard(0) ;
+         BitsInSet := PopIntegerTree()
+      END ;
+      FieldList := ChainOn(FieldList, GccField) ;
+      PushIntegerTree(BitsInSet) ;
+      PushCard(0)
+   END ;
+   RETURN( BuildEndRecord(location, RecordType, FieldList, FALSE) )
+END DeclareLargeSet ;
+
+
+(*
+   DeclareLargeOrSmallSet - works out whether the set will exceed TSIZE(WORD). If it does
+                            we manufacture a set using:
+
+                            settype = RECORD
+                                         w1: SET OF [...]
+                                         w2: SET OF [...]
+                                      END
+
+                            We do this as GCC and GDB (stabs) only knows about WORD sized sets.
+                            If the set will fit into a WORD then we call gccgm2 directly.
+*)
+
+PROCEDURE DeclareLargeOrSmallSet (sym: CARDINAL;
+                                  n: Name; type: CARDINAL; low, high: CARDINAL) : Tree ;
+VAR
+   location: location_t ;
+   packed  : BOOLEAN ;
+BEGIN
+   PushNoOfBits(type, low, high) ;
+   PushCard(GetBitsPerBitset()) ;
+   packed := IsSetPacked (sym) ;
+   IF Less(GetDeclaredMod(type))
+   THEN
+      location := TokenToLocation(GetDeclaredMod(sym)) ;
+      (* small set *)
+      (* PutSetSmall(sym) ; *)
+      RETURN BuildSetType (location, KeyToCharStar(n),
+                           Mod2Gcc(type), Mod2Gcc(low), Mod2Gcc(high), packed)
+   ELSE
+      (* PutSetLarge(sym) ; *)
+      RETURN DeclareLargeSet (n, type, low, high)   (* --fixme-- finish packed here as well.  *)
+   END
+END DeclareLargeOrSmallSet ;
+
+
+(*
+   DeclareSet - declares a set type to gcc and returns a Tree.
+*)
+
+PROCEDURE DeclareSet (sym: CARDINAL) : Tree ;
+VAR
+   gccsym   : Tree ;
+   type,
+   high, low: CARDINAL ;
+BEGIN
+   type := GetDType(sym) ;
+   IF IsSubrange(type)
+   THEN
+      GetSubrange(type, high, low) ;
+      gccsym := DeclareLargeOrSmallSet(sym, GetFullSymName(sym), GetSType(type), low, high)
+   ELSE
+      gccsym := DeclareLargeOrSmallSet(sym, GetFullSymName(sym), type, GetTypeMin(type), GetTypeMax(type))
+   END ;
+   RETURN( gccsym )
+END DeclareSet ;
+
+
+(*
+   CheckResolveSubrange - checks to see whether we can determine
+                          the subrange type.  We are able to do
+                          this once low, high and the type are known.
+*)
+
+PROCEDURE CheckResolveSubrange (sym: CARDINAL) ;
+VAR
+   size, high, low, type: CARDINAL ;
+BEGIN
+   GetSubrange(sym, high, low) ;
+   type := GetSType(sym) ;
+   IF type=NulSym
+   THEN
+      IF GccKnowsAbout(low) AND GccKnowsAbout(high)
+      THEN
+         IF IsConstString(low)
+         THEN
+            size := GetStringLength(low) ;
+            IF size=1
+            THEN
+               PutSubrange(sym, low, high, Char)
+            ELSE
+               MetaError1('cannot have a subrange of a string type {%1Uad}',
+                          sym)
+            END
+         ELSIF IsFieldEnumeration(low)
+         THEN
+            IF GetSType(low)=GetSType(high)
+            THEN
+               PutSubrange(sym, low, high, GetSType(low))
+            ELSE
+               MetaError1('subrange limits must be of the same type {%1Uad}', sym)
+            END
+         ELSIF IsValueSolved(low)
+         THEN
+            IF GetSType(low)=LongReal
+            THEN
+               MetaError1('cannot have a subrange of a SHORTREAL, REAL or LONGREAL type {%1Uad}', sym)
+            ELSE
+               PutSubrange(sym, low, high, MixTypes(GetSType(low), GetSType(high), GetDeclaredMod(sym)))
+            END
+         END
+      END
+   END
+END CheckResolveSubrange ;
+
+
+(*
+   TypeConstFullyDeclared - all, sym, dependents are declared, so create and
+                            return the GCC Tree equivalent.
+*)
+
+PROCEDURE TypeConstFullyDeclared (sym: CARDINAL) : Tree ;
+VAR
+   t: Tree ;
+   n: Name ;
+BEGIN
+   IF IsEnumeration(sym)
+   THEN
+      t := DeclareEnumeration(sym)
+   ELSIF IsFieldEnumeration(sym)
+   THEN
+      t := DeclareFieldEnumeration(sym)
+   ELSIF IsSubrange(sym)
+   THEN
+      t := DeclareSubrange(sym)
+   ELSIF IsRecord(sym)
+   THEN
+      t := CheckPragma(DeclareRecord(sym), sym)
+   ELSIF IsRecordField(sym)
+   THEN
+      t := CheckPragma(DeclareRecordField(sym), sym)
+   ELSIF IsFieldVarient(sym)
+   THEN
+      t := DeclareFieldVarient(sym)
+   ELSIF IsVarient(sym)
+   THEN
+      t := DeclareVarient(sym)
+   ELSIF IsPointer(sym)
+   THEN
+      t := CheckAlignment(DeclarePointer(sym), sym)
+   ELSIF IsUnbounded(sym)
+   THEN
+      t := DeclareUnbounded(sym)
+   ELSIF IsArray(sym)
+   THEN
+      t := CheckAlignment(DeclareArray(sym), sym)
+   ELSIF IsProcType(sym)
+   THEN
+      t := DeclareProcType(sym)
+   ELSIF IsSet(sym)
+   THEN
+      t := DeclareSet(sym)
+   ELSIF IsConst(sym)
+   THEN
+      IF IsConstructor(sym)
+      THEN
+         PushValue(sym) ;
+         ChangeToConstructor(GetDeclaredMod(sym), GetSType(sym)) ;
+         PopValue(sym) ;
+         EvaluateValue(sym) ;
+         PutConstructorSolved(sym) ;
+      ELSIF IsConstSet(sym)
+      THEN
+         EvaluateValue(sym)
+      END ;
+      IF NOT IsValueSolved(sym)
+      THEN
+         RETURN( NIL )
+      END ;
+      t := DeclareConst(GetDeclaredMod(sym), sym) ;
+      Assert(t#NIL)
+   ELSIF IsConstructor(sym)
+   THEN
+      (* not yet known as a constant *)
+      RETURN( NIL )
+   ELSE
+      t := DeclareType(sym) ;
+      IF IsType(sym)
+      THEN
+         t := CheckAlignment(t, sym)
+      END
+   END ;
+   IF GetSymName(sym)#NulName
+   THEN
+      IF Debugging
+      THEN
+         n := GetSymName(sym) ;
+         printf1('declaring type %a\n', n)
+      END ;
+      t := RememberType(t)
+   END ;
+   RETURN( t )
+END TypeConstFullyDeclared ;
+
+
+(*
+   IsBaseType - returns true if a type, Sym, is a base type and
+                we use predefined GDB information to represent this
+                type.
+*)
+
+PROCEDURE IsBaseType (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (Sym=Cardinal) OR (Sym=Integer) OR
+           (Sym=Char) OR (Sym=Proc) )
+END IsBaseType ;
+
+
+(*
+   IsFieldEnumerationDependants - sets enumDeps to FALSE if action(Sym)
+                                  is also FALSE.
+*)
+
+PROCEDURE IsFieldEnumerationDependants (Sym: WORD) ;
+BEGIN
+   IF NOT action(Sym)
+   THEN
+      enumDeps := FALSE
+   END
+END IsFieldEnumerationDependants ;
+
+
+(*
+   IsEnumerationDependants - returns true if the enumeration
+                             p(dependants) all return true.
+*)
+
+PROCEDURE IsEnumerationDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+BEGIN
+   action := q ;
+   enumDeps := TRUE ;
+   ForeachFieldEnumerationDo(sym, IsFieldEnumerationDependants) ;
+   RETURN( enumDeps )
+END IsEnumerationDependants ;
+
+
+(*
+   WalkEnumerationDependants - returns walks all dependants of Sym.
+*)
+
+PROCEDURE WalkEnumerationDependants (sym: CARDINAL; p: WalkAction) ;
+BEGIN
+   ForeachFieldEnumerationDo(sym, p)
+END WalkEnumerationDependants ;
+
+
+(*
+   WalkSubrangeDependants - calls p(dependants) for each dependant of, sym.
+*)
+
+PROCEDURE WalkSubrangeDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   type,
+   high, low: CARDINAL ;
+BEGIN
+   GetSubrange(sym, high, low) ;
+   CheckResolveSubrange(sym) ;
+   type := GetSType(sym) ;
+   IF type#NulSym
+   THEN
+      p(type)
+   END ;
+   (* low and high are not types but constants and they are resolved by M2GenGCC *)
+   p(low) ;
+   p(high)
+END WalkSubrangeDependants ;
+
+
+(*
+   IsSubrangeDependants - returns TRUE if the subrange
+                          q(dependants) all return TRUE.
+*)
+
+PROCEDURE IsSubrangeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   result   : BOOLEAN ;
+   type,
+   high, low: CARDINAL ;
+BEGIN
+   GetSubrange(sym, high, low) ;
+   (* low and high are not types but constants and they are resolved by M2GenGCC *)
+   CheckResolveSubrange(sym) ;
+   result := TRUE ;
+   type := GetSType(sym) ;
+   IF (type=NulSym) OR (NOT q(type))
+   THEN
+      result := FALSE
+   END ;
+   IF NOT q(low)
+   THEN
+      result := FALSE
+   END ;
+   IF NOT q(high)
+   THEN
+      result := FALSE
+   END ;
+   RETURN( result )
+END IsSubrangeDependants ;
+
+
+(*
+   WalkComponentDependants -
+*)
+
+PROCEDURE WalkComponentDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   i   : CARDINAL ;
+   type: CARDINAL ;
+BEGIN
+   (* need to walk record and field *)
+   i := 1 ;
+   REPEAT
+      type := GetNth(sym, i) ;
+      IF type#NulSym
+      THEN
+         IF IsVar(type)
+         THEN
+            p(GetSType(type))
+         ELSE
+            p(type)
+         END ;
+         INC(i)
+      END
+   UNTIL type=NulSym
+END WalkComponentDependants ;
+
+
+(*
+   IsComponentDependants -
+*)
+
+PROCEDURE IsComponentDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   type  : CARDINAL ;
+   i     : CARDINAL ;
+   result: BOOLEAN ;
+BEGIN
+   (* need to check record is completely resolved *)
+   result := TRUE ;
+   i := 1 ;
+   REPEAT
+      type := GetNth(sym, i) ;
+      IF type#NulSym
+      THEN
+         IF IsVar(type)
+         THEN
+            type := GetSType(type)
+         END ;
+         IF NOT q(type)
+         THEN
+            result := FALSE
+         END ;
+         INC(i)
+      END
+   UNTIL type=NulSym ;
+   RETURN( result )
+END IsComponentDependants ;
+
+
+(*
+   WalkVarDependants - walks all dependants of sym.
+*)
+
+PROCEDURE WalkVarDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   p(GetSType(sym)) ;
+   IF IsComponent(sym)
+   THEN
+      WalkComponentDependants(sym, p)
+   END ;
+   type := GetVarBackEndType(sym) ;
+   IF type#NulSym
+   THEN
+      p(type)
+   END
+END WalkVarDependants ;
+
+
+(*
+   IsVarDependants - returns TRUE if the pointer symbol, sym,
+                     p(dependants) all return TRUE.
+*)
+
+PROCEDURE IsVarDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   type  : CARDINAL ;
+   result: BOOLEAN ;
+BEGIN
+   result := TRUE ;
+   IF NOT q(GetSType(sym))
+   THEN
+      result := FALSE
+   END ;
+   IF IsComponent(sym)
+   THEN
+      IF NOT IsComponentDependants(sym, q)
+      THEN
+         result := FALSE
+      END
+   END ;
+   type := GetVarBackEndType(sym) ;
+   IF type#NulSym
+   THEN
+      IF NOT q(type)
+      THEN
+         result := FALSE
+      END
+   END ;
+   RETURN( result )
+END IsVarDependants ;
+
+
+(*
+   WalkPointerDependants - walks all dependants of sym.
+*)
+
+PROCEDURE WalkPointerDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   align: CARDINAL ;
+BEGIN
+   p(GetSType(sym)) ;
+   align := GetAlignment(sym) ;
+   IF align#NulSym
+   THEN
+      p(align)
+   END
+END WalkPointerDependants ;
+
+
+(*
+   IsPointerDependants - returns TRUE if the pointer symbol, sym,
+      	       	         p(dependants) all return TRUE.
+*)
+
+PROCEDURE IsPointerDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   align: CARDINAL ;
+   final: BOOLEAN ;
+BEGIN
+   final := TRUE ;
+   IF NOT q(GetSType(sym))
+   THEN
+      final := FALSE
+   END ;
+   align := GetAlignment (sym) ;
+   IF final AND (align # NulSym)
+   THEN
+      IF NOT q(align)
+      THEN
+         final := FALSE
+      END
+   END ;
+   RETURN final
+END IsPointerDependants ;
+
+
+(*
+   IsRecordAlignment -
+*)
+
+PROCEDURE IsRecordAlignment (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+BEGIN
+   IF GetDefaultRecordFieldAlignment(sym)#NulSym
+   THEN
+      IF NOT q(GetDefaultRecordFieldAlignment(sym))
+      THEN
+         RETURN( FALSE )
+      END
+   END ;
+   RETURN( TRUE )
+END IsRecordAlignment ;
+
+
+(*
+   IsRecordDependants - returns TRUE if the symbol, sym,
+                        q(dependants) all return TRUE.
+*)
+
+PROCEDURE IsRecordDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   result: BOOLEAN ;
+   i     : CARDINAL ;
+   field : CARDINAL ;
+BEGIN
+   result := IsRecordAlignment(sym, q) ;
+   i := 1 ;
+   REPEAT
+      field := GetNth(sym, i) ;
+      IF field#NulSym
+      THEN
+         IF IsRecordField(field)
+         THEN
+            IF (NOT IsRecordFieldAVarientTag(field)) OR (GetSymName(field)#NulName)
+            THEN
+               IF NOT q(field)
+               THEN
+                  result := FALSE
+               END
+            END
+         ELSIF IsVarient(field)
+         THEN
+            IF NOT q(field)
+            THEN
+               result := FALSE
+      	    END
+      	 ELSIF IsFieldVarient(field)
+      	 THEN
+            InternalError ('should not see a field varient')
+         ELSE
+            InternalError ('unknown symbol in record')
+      	 END
+      END ;
+      INC(i)
+   UNTIL field=NulSym ;
+   RETURN( result )
+END IsRecordDependants ;
+
+
+(*
+   WalkRecordAlignment - walks the alignment constant associated with
+                         record, sym.
+*)
+
+PROCEDURE WalkRecordAlignment (sym: CARDINAL; p: WalkAction) ;
+BEGIN
+   IF GetDefaultRecordFieldAlignment(sym)#NulSym
+   THEN
+      p(GetDefaultRecordFieldAlignment(sym))
+   END
+END WalkRecordAlignment ;
+
+
+(*
+   WalkRecordDependants - walks symbol, sym, dependants.  It only
+                          walks the fields if the alignment is
+                          unused or fully declared.
+*)
+
+PROCEDURE WalkRecordDependants (sym: CARDINAL; p: WalkAction) ;
+BEGIN
+   WalkRecordAlignment(sym, p) ;
+   WalkRecordDependants2(sym, p)
+END WalkRecordDependants ;
+
+
+(*
+   WalkRecordFieldDependants -
+*)
+
+PROCEDURE WalkRecordFieldDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   v    : CARDINAL ;
+   align: CARDINAL ;
+BEGIN
+   Assert(IsRecordField(sym)) ;
+   p(GetSType(sym)) ;
+   v := GetVarient(sym) ;
+   IF v#NulSym
+   THEN
+      p(v)
+   END ;
+   align := GetAlignment(sym) ;
+   IF align#NulSym
+   THEN
+      p(align)
+   END
+END WalkRecordFieldDependants ;
+
+
+(*
+   WalkVarient -
+*)
+
+(*
+PROCEDURE WalkVarient (sym: CARDINAL; p: WalkAction) ;
+VAR
+   v    : CARDINAL ;
+   var,
+   align: CARDINAL ;
+BEGIN
+   p(sym) ;
+   v := GetVarient(sym) ;
+   IF v#NulSym
+   THEN
+      p(v)
+   END ;
+   var := GetRecordOfVarient(sym) ;
+   align := GetDefaultRecordFieldAlignment(var) ;
+   IF align#NulSym
+   THEN
+      p(align)
+   END
+END WalkVarient ;
+*)
+
+
+(*
+   WalkRecordDependants2 - walks the fields of record, sym, calling
+                           p on every dependant.
+*)
+
+PROCEDURE WalkRecordDependants2 (sym: CARDINAL; p: WalkAction) ;
+VAR
+   i    : CARDINAL ;
+   Field: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE GetNth(sym, i)#NulSym DO
+      Field := GetNth(sym, i) ;
+      p(Field) ;
+      IF IsRecordField(Field)
+      THEN
+         WalkRecordFieldDependants(Field, p)
+      ELSIF IsVarient(Field)
+      THEN
+         WalkVarientDependants(Field, p)
+      ELSIF IsFieldVarient(Field)
+      THEN
+         InternalError ('should not see a field varient')
+      ELSE
+         InternalError ('unknown symbol in record')
+      END ;
+      INC(i)
+   END
+END WalkRecordDependants2 ;
+
+
+(*
+   IsVarientAlignment -
+*)
+
+PROCEDURE IsVarientAlignment (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   align: CARDINAL ;
+BEGIN
+   sym := GetRecordOfVarient(sym) ;
+   align := GetDefaultRecordFieldAlignment(sym) ;
+   IF (align#NulSym) AND (NOT q(align))
+   THEN
+      RETURN( FALSE )
+   END ;
+   RETURN( TRUE )
+END IsVarientAlignment ;
+
+
+(*
+   IsVarientDependants - returns TRUE if the symbol, sym,
+                         q(dependants) all return TRUE.
+*)
+
+PROCEDURE IsVarientDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   result: BOOLEAN ;
+   i     : CARDINAL ;
+   Field : CARDINAL ;
+BEGIN
+   result := IsVarientAlignment(sym, q) ;
+   i := 1 ;
+   WHILE GetNth(sym, i)#NulSym DO
+      Field := GetNth(sym, i) ;
+      Assert(IsFieldVarient(Field)) ;
+      IF NOT q(Field)
+      THEN
+         result := FALSE
+      END ;
+      INC(i)
+   END ;
+   RETURN( result )
+END IsVarientDependants ;
+
+
+(*
+   WalkVarientAlignment -
+*)
+
+PROCEDURE WalkVarientAlignment (sym: CARDINAL; p: WalkAction) ;
+VAR
+   align: CARDINAL ;
+BEGIN
+   sym := GetRecordOfVarient(sym) ;
+   align := GetDefaultRecordFieldAlignment(sym) ;
+   IF align#NulSym
+   THEN
+      p(align)
+   END
+END WalkVarientAlignment ;
+
+
+(*
+   WalkVarientDependants - walks symbol, sym, dependants.
+*)
+
+PROCEDURE WalkVarientDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   i    : CARDINAL ;
+   v,
+   Field: CARDINAL ;
+BEGIN
+   WalkVarientAlignment(sym, p) ;
+   IF GetSType(sym)#NulSym
+   THEN
+      p(GetSType(sym))
+   END ;
+   v := GetVarient(sym) ;
+   IF v#NulSym
+   THEN
+      p(v)
+   END ;
+   i := 1 ;
+   WHILE GetNth(sym, i)#NulSym DO
+      Field := GetNth(sym, i) ;
+      Assert(IsFieldVarient(Field)) ;  (* field varients do _not_ have a type *)
+      p(Field) ;
+      WalkVarientFieldDependants(Field, p) ;
+      INC(i)
+   END
+END WalkVarientDependants ;
+
+
+(*
+   IsVarientFieldDependants - returns TRUE if the symbol, sym,
+                              q(dependants) all return TRUE.
+*)
+
+PROCEDURE IsVarientFieldDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   i     : CARDINAL ;
+   type,
+   Field : CARDINAL ;
+   result: BOOLEAN ;
+BEGIN
+   i := 1 ;
+   result := IsVarientAlignment(sym, q) ;
+   WHILE GetNth(sym, i)#NulSym DO
+      Field := GetNth(sym, i) ;
+      IF NOT q(Field)
+      THEN
+         result := FALSE
+      END ;
+      type := GetSType(Field) ;
+      IF type#NulSym
+      THEN
+         IF NOT q(type)
+         THEN
+            result := FALSE
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( result )
+END IsVarientFieldDependants ;
+
+
+(*
+   WalkVarientFieldDependants -
+*)
+
+PROCEDURE WalkVarientFieldDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   i    : CARDINAL ;
+   type,
+   Field: CARDINAL ;
+BEGIN
+   WalkVarientAlignment(sym, p) ;
+   i := 1 ;
+   WHILE GetNth(sym, i)#NulSym DO
+      Field := GetNth(sym, i) ;
+      p(Field) ;
+      type := GetSType(Field) ;
+      IF type#NulSym
+      THEN
+         p(type)
+      END ;
+      INC(i)
+   END
+END WalkVarientFieldDependants ;
+
+
+(*
+   IsArrayDependants - returns TRUE if the symbol, sym,
+      	       	       q(dependants) all return TRUE.
+
+*)
+
+PROCEDURE IsArrayDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   result   : BOOLEAN ;
+   align    : CARDINAL ;
+   subscript: CARDINAL ;
+   high, low: CARDINAL ;
+   type     : CARDINAL ;
+BEGIN
+   result := TRUE ;
+   Assert(IsArray(sym)) ;
+   type := GetSType(sym) ;
+
+   IF NOT q(type)
+   THEN
+      result := FALSE
+   END ;
+   subscript := GetArraySubscript(sym) ;
+   IF subscript#NulSym
+   THEN
+      Assert(IsSubscript(subscript)) ;
+      type := GetSType(subscript) ;
+      IF NOT q(type)
+      THEN
+         result := FALSE
+      END ;
+      type := SkipType(type) ;
+      (* the array might be declared as ARRAY type OF foo *)
+      low  := GetTypeMin(type) ;
+      high := GetTypeMax(type) ;
+      IF NOT q(low)
+      THEN
+         result := FALSE
+      END ;
+      IF NOT q(high)
+      THEN
+         result := FALSE
+      END ;
+      align := GetAlignment(sym) ;
+      IF (align#NulSym) AND (NOT q(align))
+      THEN
+         result := FALSE
+      END
+   END ;
+   RETURN( result )
+END IsArrayDependants ;
+
+
+(*
+   WalkArrayDependants - walks symbol, sym, dependants.
+*)
+
+PROCEDURE WalkArrayDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   align    : CARDINAL ;
+   subscript: CARDINAL ;
+   high, low: CARDINAL ;
+   type     : CARDINAL ;
+BEGIN
+   Assert(IsArray(sym)) ;
+   type := GetSType(sym) ;
+   p(type) ;
+   subscript := GetArraySubscript(sym) ;
+   IF subscript#NulSym
+   THEN
+      Assert(IsSubscript(subscript)) ;
+      type := GetSType(subscript) ;
+      p(type) ;
+      type := SkipType(type) ;
+      (* the array might be declared as ARRAY type OF foo *)
+      low  := GetTypeMin(type) ;
+      high := GetTypeMax(type) ;
+      p(low) ;
+      p(high) ;
+      align := GetAlignment (sym) ;
+      IF align#NulSym
+      THEN
+         p(align)
+      END
+   END
+END WalkArrayDependants ;
+
+
+(*
+   IsSetDependants - returns TRUE if the symbol, sym,
+                     q(dependants) all return TRUE.
+*)
+
+PROCEDURE IsSetDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   result         : BOOLEAN ;
+   type, low, high: CARDINAL ;
+BEGIN
+   result := TRUE ;
+   Assert(IsSet(sym)) ;
+
+   type := GetDType(sym) ;
+   IF NOT q(type)
+   THEN
+      result := FALSE
+   END ;
+   low  := GetTypeMin(type) ;
+   high := GetTypeMax(type) ;
+   IF NOT q(low)
+   THEN
+      result := FALSE
+   END ;
+   IF NOT q(high)
+   THEN
+      result := FALSE
+   END ;
+   RETURN( result )
+END IsSetDependants ;
+
+
+(*
+   WalkSetDependants - walks dependants, sym.
+*)
+
+PROCEDURE WalkSetDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   type, low, high: CARDINAL ;
+BEGIN
+   Assert(IsSet(sym)) ;
+
+   type := GetDType(sym) ;
+   p(type) ;
+   low  := GetTypeMin(type) ;
+   p(low) ;
+   high := GetTypeMax(type) ;
+   p(high)
+END WalkSetDependants ;
+
+
+(*
+   IsProcTypeDependants -
+*)
+
+PROCEDURE IsProcTypeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   i, p, son : CARDINAL ;
+   ParamType,
+   ReturnType: CARDINAL ;
+   result    : BOOLEAN ;
+BEGIN
+   result := TRUE ;
+   Assert(IsProcType(sym)) ;
+   i := 1 ;
+   ReturnType := GetSType(sym) ;
+   p := NoOfParam(sym) ;
+   WHILE i<=p DO
+      son := GetNthParam(sym, i) ;
+      ParamType := GetSType(son) ;
+      IF NOT q(ParamType)
+      THEN
+         result := FALSE
+      END ;
+      INC(i)
+   END ;
+   IF (ReturnType=NulSym) OR q(ReturnType)
+   THEN
+      RETURN( result )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsProcTypeDependants ;
+
+
+(*
+   WalkProcTypeDependants - walks dependants, sym.
+*)
+
+PROCEDURE WalkProcTypeDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   i, n, son : CARDINAL ;
+   ParamType,
+   ReturnType: CARDINAL ;
+BEGIN
+   Assert(IsProcType(sym)) ;
+   i := 1 ;
+   ReturnType := GetSType(sym) ;
+   n := NoOfParam(sym) ;
+   WHILE i<=n DO
+      son := GetNthParam(sym, i) ;
+      ParamType := GetSType(son) ;
+      p(ParamType) ;
+      INC(i)
+   END ;
+   IF ReturnType#NulSym
+   THEN
+      p(ReturnType)
+   END
+END WalkProcTypeDependants ;
+
+
+(*
+   IsProcedureDependants -
+*)
+
+PROCEDURE IsProcedureDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   i, son    : CARDINAL ;
+   type,
+   ReturnType: CARDINAL ;
+   result    : BOOLEAN ;
+BEGIN
+   result := TRUE ;
+   Assert(IsProcedure(sym)) ;
+   i := 1 ;
+   ReturnType := GetSType(sym) ;
+   WHILE GetNth(sym, i)#NulSym DO
+      son := GetNth(sym, i) ;
+      type := GetSType(son) ;
+      IF NOT q(type)
+      THEN
+         result := FALSE
+      END ;
+      INC(i)
+   END ;
+   IF (ReturnType=NulSym) OR q(ReturnType)
+   THEN
+      RETURN( result )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsProcedureDependants ;
+
+
+(*
+   WalkProcedureDependants - walks dependants, sym.
+*)
+
+PROCEDURE WalkProcedureDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   i, son    : CARDINAL ;
+   type,
+   ReturnType: CARDINAL ;
+BEGIN
+   Assert(IsProcedure(sym)) ;
+   i := 1 ;
+   ReturnType := GetSType(sym) ;
+   WHILE GetNth(sym, i)#NulSym DO
+      son := GetNth(sym, i) ;
+      type := GetSType(son) ;
+      p(type) ;
+      INC(i)
+   END ;
+   IF ReturnType#NulSym
+   THEN
+      p(ReturnType)
+   END
+END WalkProcedureDependants ;
+
+
+(*
+   IsUnboundedDependants - returns TRUE if the symbol, sym,
+                           q(dependants) all return TRUE.
+*)
+
+PROCEDURE IsUnboundedDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   result: BOOLEAN ;
+BEGIN
+   result := TRUE ;
+   IF NOT q(GetUnboundedRecordType(sym))
+   THEN
+      result := FALSE
+   END ;
+   IF NOT q(Cardinal)
+   THEN
+      result := FALSE
+   END ;
+   IF NOT q(GetSType(sym))
+   THEN
+      result := FALSE
+   END ;
+   RETURN( result )
+END IsUnboundedDependants ;
+
+
+(*
+   WalkUnboundedDependants - walks the dependants of, sym.
+*)
+
+PROCEDURE WalkUnboundedDependants (sym: CARDINAL; p: WalkAction) ;
+BEGIN
+   p(GetUnboundedRecordType(sym)) ;
+   p(Cardinal) ;
+   p(GetSType(sym))
+END WalkUnboundedDependants ;
+
+
+(*
+   IsTypeDependants - returns TRUE if all q(dependants) return
+                      TRUE.
+*)
+
+PROCEDURE IsTypeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
+VAR
+   align: CARDINAL ;
+   type : CARDINAL ;
+   final: BOOLEAN ;
+BEGIN
+   type := GetSType(sym) ;
+   final := TRUE ;
+   IF (type#NulSym) AND (NOT q(type))
+   THEN
+      final := FALSE
+   END ;
+   align := GetAlignment(sym) ;
+   IF (align#NulSym) AND (NOT q(align))
+   THEN
+      final := FALSE
+   END ;
+   RETURN( final )
+END IsTypeDependants ;
+
+
+(*
+   WalkTypeDependants - walks all dependants of, sym.
+*)
+
+PROCEDURE WalkTypeDependants (sym: CARDINAL; p: WalkAction) ;
+VAR
+   align: CARDINAL ;
+   type : CARDINAL ;
+BEGIN
+   type := GetSType(sym) ;
+   IF type#NulSym
+   THEN
+      p(type)
+   END ;
+   align := GetAlignment(sym) ;
+   IF align#NulSym
+   THEN
+      p(align)
+   END
+END WalkTypeDependants ;
+
+
+(*
+   PoisonSymbols - poisons all gcc symbols from procedure, sym.
+                   A debugging aid.
+*)
+
+PROCEDURE PoisonSymbols (sym: CARDINAL) ;
+BEGIN
+   IF IsProcedure(sym)
+   THEN
+      ForeachLocalSymDo(sym, Poison)
+   END
+END PoisonSymbols ;
+
+
+(*
+   ConstantKnownAndUsed -
+*)
+
+PROCEDURE ConstantKnownAndUsed (sym: CARDINAL; t: Tree) ;
+BEGIN
+   DeclareConstantFromTree(sym, RememberConstant(t))
+END ConstantKnownAndUsed ;
+
+
+(*
+   InitM2LinkModule -
+*)
+
+PROCEDURE InitM2LinkModule ;
+BEGIN
+   M2LinkIndex := NIL
+END InitM2LinkModule ;
+
+
+(*
+   InitDeclarations - initializes default types and the source filename.
+*)
+
+PROCEDURE InitDeclarations ;
+BEGIN
+   DeclareDefaultTypes ;
+   DeclareDefaultConstants
+END InitDeclarations ;
+
+
+BEGIN
+   ToDoList := InitSet(1) ;
+   FullyDeclared := InitSet(1) ;
+   PartiallyDeclared := InitSet(1) ;
+   NilTypedArrays := InitSet(1) ;
+   HeldByAlignment := InitSet(1) ;
+   FinishedAlignment := InitSet(1) ;
+   ToBeSolvedByQuads := InitSet(1) ;
+   ChainedList := InitSet(1) ;
+   WatchList := InitSet(1) ;
+   VisitedList := NIL ;
+   EnumerationIndex := InitIndex(1) ;
+   IncludeElementIntoSet(WatchList, 8) ;
+   HaveInitDefaultTypes := FALSE ;
+   recursionCaught := FALSE ;
+   InitM2LinkModule
+END M2GCCDeclare.
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.def b/gcc/m2/gm2-compiler/M2GenGCC.def
new file mode 100644
index 00000000000..70e0418bc0d
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2GenGCC.def
@@ -0,0 +1,103 @@
+(* M2GenGCC.def convert the quadruples into GCC trees.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2GenGCC ;
+
+(*
+    Title      : M2GenGCC
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Fri Jul  9 13:05:13 1999
+    Last edit  : Fri Jul  9 13:05:13 1999
+    Description: provides an interface to GCC, essentially convert the
+                 internal quadruples of m2f into a GCC tree structure.
+*)
+
+FROM M2GCCDeclare IMPORT WalkAction ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+EXPORT QUALIFIED ConvertQuadsToTree, ResolveConstantExpressions,
+                 GetHighFromUnbounded, StringToChar,
+                 LValueToGenericPtr, ZConstToTypedConst,
+                 DoCopyString ;
+
+
+(*
+   ConvertQuadsToTree - runs through the quadruple list, Start..End, and converts it into
+                        the GCC tree structure.
+*)
+
+PROCEDURE ConvertQuadsToTree (Start, End: CARDINAL) ;
+
+
+(*
+   ResolveConstantExpressions - resolves constant expressions from the quadruple list.
+                                It returns TRUE if one or more constants were folded.
+                                When a constant symbol value is solved, the call back
+                                p(sym) is invoked.
+*)
+
+PROCEDURE ResolveConstantExpressions (p: WalkAction; start, end: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetHighFromUnbounded - returns a Tree containing the value of
+                          param.HIGH.
+*)
+
+PROCEDURE GetHighFromUnbounded (location: location_t; dim, param: CARDINAL) : Tree ;
+
+
+(*
+   StringToChar - if type=Char and str is a string (of size <= 1)
+                  then convert the string into a character constant.
+*)
+
+PROCEDURE StringToChar (t: Tree; type, str: CARDINAL) : Tree ;
+
+
+(*
+   LValueToGenericPtr - returns a Tree representing symbol, sym.
+                        It coerces a lvalue into an internal pointer type
+*)
+
+PROCEDURE LValueToGenericPtr (location: location_t; sym: CARDINAL) : Tree ;
+
+
+(*
+   ZConstToTypedConst - checks whether op1 and op2 are constants and
+                        coerces, t, appropriately.
+*)
+
+PROCEDURE ZConstToTypedConst (t: Tree; op1, op2: CARDINAL) : Tree ;
+
+
+(*
+   DoCopyString - returns trees:
+                  t    number of bytes to be copied (including the nul)
+                  op3t the string with the extra nul character
+                       providing it fits.
+*)
+
+PROCEDURE DoCopyString (tokenno: CARDINAL; VAR length, op3t: Tree; op1t, op3: CARDINAL) ;
+
+
+END M2GenGCC.
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
new file mode 100644
index 00000000000..89c035897d3
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -0,0 +1,7193 @@
+(* M2GenGCC.mod convert the quadruples into GCC trees.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2GenGCC ;
+
+FROM SYSTEM IMPORT ADDRESS, WORD ;
+
+FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
+                        PushVarSize,
+                        PushSumOfLocalVarSize,
+                        PushSumOfParamSize,
+                        MakeConstLit, MakeConstLitString,
+                        RequestSym, FromModuleGetSym,
+                        StartScope, EndScope, GetScope,
+                        GetMainModule, GetModuleScope,
+                        GetSymName, ModeOfAddr, GetMode,
+                        GetGnuAsm, IsGnuAsmVolatile, IsGnuAsmSimple,
+                        GetGnuAsmInput, GetGnuAsmOutput, GetGnuAsmTrash,
+                        GetLowestType,
+                        GetLocalSym, GetVarWritten,
+                        GetVarient, GetVarBackEndType, GetModuleCtors,
+                        NoOfVariables,
+                        NoOfParam, GetParent, GetDimension, IsAModula2Type,
+                        IsModule, IsDefImp, IsType, IsModuleWithinProcedure,
+                        IsConstString, GetString, GetStringLength,
+                        IsConst, IsConstSet, IsProcedure, IsProcType,
+                        IsVar, IsVarParam, IsTemporary,
+                        IsEnumeration,
+                        IsUnbounded, IsArray, IsSet, IsConstructor,
+                        IsProcedureVariable,
+                        IsUnboundedParam,
+                        IsRecordField, IsFieldVarient, IsVarient, IsRecord,
+                        IsExportQualified,
+                        IsExported,
+                        IsSubrange, IsPointer,
+                        IsProcedureBuiltin, IsProcedureInline,
+                        IsParameter, IsParameterVar,
+                        IsValueSolved, IsSizeSolved,
+                        IsProcedureNested, IsInnerModule, IsArrayLarge,
+                        IsComposite, IsVariableSSA, IsPublic, IsCtor,
+                        ForeachExportedDo,
+                        ForeachImportedDo,
+                        ForeachProcedureDo,
+                        ForeachInnerModuleDo,
+                        ForeachLocalSymDo,
+			GetLType,
+                        GetType, GetNth, GetNthParam,
+                        SkipType, SkipTypeAndSubrange,
+                        GetUnboundedHighOffset,
+                        GetUnboundedAddressOffset,
+                        GetSubrange, NoOfElements, GetArraySubscript,
+                        GetFirstUsed, GetDeclaredMod,
+                        GetProcedureBeginEnd,
+                        GetRegInterface,
+                        GetProcedureQuads,
+                        GetProcedureBuiltin,
+                        GetPriority, GetNeedSavePriority,
+                        PutConstString,
+                        PutConst, PutConstSet, PutConstructor,
+			GetSType,
+                        HasVarParameters,
+                        NulSym ;
+
+FROM M2Batch IMPORT MakeDefinitionSource ;
+FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToLocation, MakeVirtualTok ;
+FROM M2Code IMPORT CodeBlock ;
+FROM M2Debug IMPORT Assert ;
+FROM M2Error IMPORT InternalError, WriteFormat0, WriteFormat1, WriteFormat2, WarnStringAt ;
+
+FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3,
+                        MetaError1, MetaError2, MetaErrorStringT1 ;
+
+FROM M2Options IMPORT DisplayQuadruples, UnboundedByReference, PedanticCast,
+                      VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram,
+                      StrictTypeChecking, AutoInit, cflag, ScaffoldMain,
+                      ScaffoldDynamic, ScaffoldStatic,
+                      DebugTraceQuad, DebugTraceAPI ;
+
+FROM M2Printf IMPORT printf0, printf1, printf2, printf4 ;
+FROM M2Quiet IMPORT qprintf0 ;
+
+FROM M2Base IMPORT MixTypes, NegateType, ActivationPointer, IsMathType,
+                   IsRealType, IsComplexType, IsBaseType,
+                   IsOrdinalType,
+                   Cardinal, Char, Integer, IsTrunc,
+                   Boolean, True,
+                   Im, Re, Cmplx, GetCmplxReturnType, GetBaseTypeMinMax,
+                   CheckAssignmentCompatible, IsAssignmentCompatible ;
+
+FROM M2Bitset IMPORT Bitset ;
+FROM NameKey IMPORT Name, MakeKey, KeyToCharStar, LengthKey, makekey, NulName ;
+
+FROM DynamicStrings IMPORT string, InitString, KillString, String,
+                           InitStringCharStar, Mark, Slice, ConCat, ConCatChar ;
+
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4 ;
+FROM M2System IMPORT Address, Word, System, TBitSize, MakeAdr, IsSystemType, IsGenericSystemType, IsRealN, IsComplexN, IsSetN, IsWordN, Loc, Byte ;
+FROM M2FileName IMPORT CalculateFileName ;
+FROM SymbolConversion IMPORT AddModGcc, Mod2Gcc, GccKnowsAbout, RemoveMod2Gcc ;
+
+FROM M2StackWord IMPORT InitStackWord, StackOfWord, PeepWord, ReduceWord,
+                        PushWord, PopWord, IsEmptyWord ;
+
+FROM Lists IMPORT List, InitList, KillList,
+                  PutItemIntoList,
+                  RemoveItemFromList, IncludeItemIntoList,
+                  NoOfItemsInList, GetItemFromList ;
+
+FROM M2ALU IMPORT PtrToValue,
+                  IsValueTypeReal, IsValueTypeSet,
+                  IsValueTypeConstructor, IsValueTypeArray,
+                  IsValueTypeRecord, IsValueTypeComplex,
+                  PushIntegerTree, PopIntegerTree,
+                  PushSetTree, PopSetTree,
+                  PopRealTree, PushCard,
+                  PushRealTree,
+                  PopComplexTree,
+                  Gre, Sub, Equ, NotEqu, LessEqu,
+                  BuildRange, SetOr, SetAnd, SetNegate,
+                  SetSymmetricDifference, SetDifference,
+                  SetShift, SetRotate,
+                  AddBit, SubBit, Less, Addn, GreEqu, SetIn,
+                  CheckOrResetOverflow, GetRange, GetValue,
+                  ConvertToType ;
+
+FROM M2GCCDeclare IMPORT WalkAction,
+                         DeclareConstant, TryDeclareConstant,
+                         DeclareConstructor, TryDeclareConstructor,
+                         StartDeclareScope, EndDeclareScope,
+                         PromoteToString, DeclareLocalVariable,
+                         CompletelyResolved,
+                         PoisonSymbols, GetTypeMin, GetTypeMax,
+                         IsProcedureGccNested, DeclareParameters,
+                         ConstantKnownAndUsed, PrintSym,
+                         DeclareM2linkGlobals ;
+
+FROM M2Range IMPORT CodeRangeCheck, FoldRangeCheck, CodeErrorCheck, GetMinMax ;
+
+FROM m2builtins IMPORT BuiltInMemCopy, BuiltInAlloca,
+                       GetBuiltinConst, GetBuiltinTypeInfo,
+                       BuiltinExists, BuildBuiltinTree ;
+
+FROM m2expr IMPORT GetIntegerZero, GetIntegerOne,
+                   GetCardinalOne,
+                   GetPointerZero,
+                   GetCardinalZero,
+                   GetSizeOfInBits,
+                   FoldAndStrip,
+                   CompareTrees,
+                   StringLength,
+                   AreConstantsEqual,
+                   BuildForeachWordInSetDoIfExpr,
+                   BuildIfConstInVar,
+                   BuildIfVarInVar,
+                   BuildIfNotConstInVar,
+                   BuildIfNotVarInVar,
+                   BuildBinCheckProcedure, BuildUnaryCheckProcedure,
+                   BuildBinProcedure, BuildUnaryProcedure,
+                   BuildSetProcedure, BuildUnarySetFunction,
+		   BuildAddCheck, BuildSubCheck, BuildMultCheck, BuildDivTruncCheck,
+                   BuildDivM2Check, BuildModM2Check,
+                   BuildAdd, BuildSub, BuildMult, BuildLSL,
+		   BuildDivCeil, BuildModCeil,
+                   BuildDivTrunc, BuildModTrunc, BuildDivFloor, BuildModFloor,
+		   BuildDivM2, BuildModM2,
+                   BuildRDiv,
+                   BuildLogicalOrAddress,
+                   BuildLogicalOr, BuildLogicalAnd, BuildSymmetricDifference,
+                   BuildLogicalDifference,
+                   BuildLogicalShift, BuildLogicalRotate,
+                   BuildNegate, BuildNegateCheck, BuildAddr, BuildSize, BuildTBitSize,
+                   BuildOffset, BuildOffset1,
+                   BuildLessThan, BuildGreaterThan,
+                   BuildLessThanOrEqual, BuildGreaterThanOrEqual,
+                   BuildEqualTo, BuildNotEqualTo,
+                   BuildIsSuperset, BuildIsNotSuperset,
+                   BuildIsSubset, BuildIsNotSubset,
+                   BuildIndirect, BuildArray,
+                   BuildTrunc, BuildCoerce,
+                   BuildBinaryForeachWordDo,
+                   BuildBinarySetDo,
+                   BuildSetNegate,
+                   BuildComponentRef,
+                   BuildCap, BuildAbs, BuildIm, BuildRe, BuildCmplx,
+                   BuildAddAddress,
+                   BuildIfInRangeGoto, BuildIfNotInRangeGoto ;
+
+FROM m2tree IMPORT Tree, debug_tree ;
+FROM m2linemap IMPORT location_t ;
+
+FROM m2decl IMPORT BuildStringConstant, DeclareKnownConstant, GetBitsPerBitset,
+                   BuildIntegerConstant,
+                   BuildModuleCtor, DeclareModuleCtor ;
+
+FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunctValue,
+                        DoJump, BuildUnaryForeachWordDo, BuildGoto, BuildCall2, BuildCall3,
+                        BuildStart, BuildEnd, BuildCallInner, BuildStartFunctionCode,
+                        BuildEndFunctionCode,
+                        BuildAssignmentTree, DeclareLabel,
+                        BuildFunctionCallTree,
+                        BuildAssignmentStatement,
+                        BuildIndirectProcedureCallTree,
+                        BuildPushFunctionContext, BuildPopFunctionContext,
+                        BuildReturnValueCode, SetLastFunction,
+                        BuildIncludeVarConst, BuildIncludeVarVar,
+                        BuildExcludeVarConst, BuildExcludeVarVar,
+			GetParamTree, BuildCleanUp,
+			BuildTryFinally,
+			GetLastFunction, SetLastFunction,
+                        SetBeginLocation, SetEndLocation ;
+
+FROM m2type IMPORT ChainOnParamValue, GetPointerType, GetIntegerType, AddStatement,
+                   GetCardinalType, GetWordType, GetM2ZType, GetM2RType, GetM2CType,
+                   BuildCharConstant, AddStringToTreeList, BuildArrayStringConstructor,
+                   GetArrayNoOfElements ;
+
+FROM m2block IMPORT RememberConstant, pushGlobalScope, popGlobalScope, finishFunctionDecl,
+                    pushFunctionScope, popFunctionScope,
+		    push_statement_list, pop_statement_list, begin_statement_list,
+		    addStmtNote, removeStmtNote ;
+
+FROM m2misc IMPORT DebugTree ;
+
+FROM m2convert IMPORT BuildConvert, ConvertConstantAndCheck, ToCardinal, ConvertString ;
+
+FROM m2except IMPORT BuildThrow, BuildTryBegin, BuildTryEnd,
+                     BuildCatchBegin, BuildCatchEnd ;
+
+FROM M2Quads IMPORT QuadOperator, GetQuad, IsReferenced, GetNextQuad,
+                    SubQuad, PutQuad, MustCheckOverflow, GetQuadOtok,
+                    QuadToTokenNo, DisplayQuad, GetQuadtok,
+                    GetM2OperatorDesc, GetQuadOp,
+                    DisplayQuadList ;
+
+FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible ;
+FROM M2SSA IMPORT EnableSSA ;
+
+
+CONST
+   Debugging         = FALSE ;
+   PriorityDebugging = FALSE ;
+   CascadedDebugging = FALSE ;
+
+TYPE
+   DoProcedure      = PROCEDURE (CARDINAL) ;
+   DoUnaryProcedure = PROCEDURE (CARDINAL) ;
+
+VAR
+   CurrentQuadToken         : CARDINAL ;
+   UnboundedLabelNo         : CARDINAL ;
+   LastLine                 : CARDINAL ;(* The Last Line number emitted with the  *)
+                                        (* generated code.                        *)
+   LastOperator             : QuadOperator ; (* The last operator processed.      *)
+   ScopeStack               : StackOfWord ; (* keeps track of the current scope       *)
+                                            (* under translation.                     *)
+   NoChange                 : BOOLEAN ;     (* has any constant been resolved?        *)
+
+
+(*
+   Rules for Quadruples
+   ====================
+
+   Rules
+   =====
+
+   All program declared variables are given the mode, Offset.
+   All constants have mode, Immediate.
+
+   Operators
+   =========
+
+------------------------------------------------------------------------------
+   Array Operators
+------------------------------------------------------------------------------
+   Sym<I>   Base   a            Delivers a constant result if a is a
+                                Global variable. If a is a local variable
+                                then the Frame pointer needs to be added.
+                                Base yields the effective location in memory
+                                of, a, array [0,0, .. ,0] address.
+   Sym<I>   ElementSize 1       Always delivers a constant. The number
+                                indicates which specified element is chosen.
+                                ElementSize is the TypeSize for that element.
+   Unbounded  Op1 Op3           Initializes the op1 StartAddress of the array
+                                op3. Op3 can be a normal array or unbounded array.
+                                op1 (is the Unbounded.ArrayAddress) := ADR(op3).
+                                In GNU Modula-2 the callee saves non var unbounded
+                                arrays. This is direct contrast to the M2F native
+                                code generators.
+------------------------------------------------------------------------------
+   := Operator
+------------------------------------------------------------------------------
+   Sym1<I> := Sym3<I>           := produces a constant
+   Sym1<O> := Sym3<O>           := has the effect Mem[Sym1<I>] := Mem[Sym3<I>]
+------------------------------------------------------------------------------
+   Addr Operator  - contains the address of a variable - may need to add
+------------------------------------------------------------------------------
+   Yields the address of a variable - need to add the frame pointer if
+   a variable is local to a procedure.
+
+   Sym1<O>   Addr   Sym2<O>     meaning     Mem[Sym1<I>] := Sym2<I>
+   Sym1<V>   Addr   Sym2<O>     meaning     Mem[Sym1<I>] := Sym2<I>
+   Sym1<O>   Addr   Sym2<V>     meaning     Mem[Sym1<I>] := Mem[Sym2<I>]
+   Sym1<V>   Addr   Sym2<V>     meaning     Mem[Sym1<I>] := Mem[Sym2<I>]
+------------------------------------------------------------------------------
+   Xindr Operator  ( *a = b)
+------------------------------------------------------------------------------
+   Sym1<O>   Copy   Sym2<I>     Meaning     Mem[Sym1<I>] := constant
+   Sym1<V>   Copy   Sym2<I>     Meaning     Mem[Sym1<I>] := constant
+   Sym1<O>   Copy   Sym2<O>     meaning     Mem[Sym1<I>] := Mem[Sym2<I>]
+   Sym1<V>   Copy   Sym2<O>     meaning     Mem[Sym1<I>] := Mem[Sym2<I>]
+   Sym1<O>   Copy   Sym2<V>     meaning     Mem[Sym1<I>] := Mem[Mem[Sym2<I>]]
+   Sym1<V>   Copy   Sym2<V>     meaning     Mem[Sym1<I>] := Mem[Mem[Sym2<I>]]
+------------------------------------------------------------------------------
+   IndrX Operator  (a = *b)   where <X> means any value
+------------------------------------------------------------------------------
+   Sym1<X>   IndrX  Sym2<I>     meaning     Mem[Sym1<I>] := Mem[constant]
+   Sym1<X>   IndrX  Sym2<I>     meaning     Mem[Sym1<I>] := Mem[constant]
+
+   Sym1<X>   IndrX  Sym2<X>     meaning     Mem[Sym1<I>] := Mem[Mem[Sym2<I>]]
+   Sym1<X>   IndrX  Sym2<X>     meaning     Mem[Sym1<I>] := Mem[Mem[Sym2<I>]]
+------------------------------------------------------------------------------
+   + - / * Operators
+------------------------------------------------------------------------------
+   Sym1<I>   +      Sym2<I>  Sym3<I>  meaning Sym1<I> := Sym2<I> + Sym3<I>
+   Sym1<O>   +      Sym2<O>  Sym3<I>  meaning Mem[Sym1<I>] :=
+                                                    Mem[Sym2<I>] + Sym3<I>
+   Sym1<O>   +      Sym2<O>  Sym3<O>  meaning Mem[Sym1<I>] :=
+                                                    Mem[Sym2<I>] + Mem[Sym3<I>]
+   Sym1<O>   +      Sym2<O>  Sym3<V>  meaning Mem[Sym1<I>] :=
+                                                    Mem[Sym2<I>] + Mem[Sym3<I>]
+   Sym1<V>   +      Sym2<O>  Sym3<V>  meaning Mem[Sym1<I>] :=
+                                                    Mem[Sym2<I>] + Mem[Sym3<I>]
+   Sym1<V>   +      Sym2<V>  Sym3<V>  meaning Mem[Sym1<I>] :=
+                                                    Mem[Sym2<I>] + Mem[Sym3<I>]
+------------------------------------------------------------------------------
+   Base Operator
+------------------------------------------------------------------------------
+   Sym1<O>   Base  Sym2   Sym3<O>     meaning     Mem[Sym1<I>] := Sym3<I>
+   Sym1<V>   Base  Sym2   Sym3<O>     meaning     Should Never Occur But If it did..
+                                                  Mem[Mem[Sym1<I>]] := Sym3<I>
+   Sym1<O>   Base  Sym2   Sym3<V>     meaning     Mem[Sym1<I>] := Mem[Sym3<I>]
+   Sym1<V>   Base  Sym2   Sym3<V>     meaning     Should Never Occur But If it did..
+                                                  Mem[Mem[Sym1<I>]] := Mem[Sym3<I>]
+                   Sym2 is the array type
+------------------------------------------------------------------------------
+*)
+
+
+(*
+   IsExportedGcc - returns TRUE if this symbol should be (as far as the middle/backend of GCC)
+                   is concerned, exported.
+*)
+
+PROCEDURE IsExportedGcc (sym: CARDINAL) : BOOLEAN ;
+VAR
+   scope: CARDINAL ;
+BEGIN
+   (* Has a procedure been overridden as public?  *)
+   IF IsProcedure (sym) AND IsPublic (sym)
+   THEN
+      RETURN TRUE
+   END ;
+   (* Check for whole program.  *)
+   IF WholeProgram
+   THEN
+      scope := GetScope (sym) ;
+      WHILE scope#NulSym DO
+         IF IsDefImp (scope)
+         THEN
+            RETURN IsExported (scope, sym)
+         ELSIF IsModule (scope)
+         THEN
+            RETURN FALSE
+         END ;
+         scope := GetScope(scope)
+      END ;
+      Assert (FALSE)
+   ELSE
+      (* Otherwise it is public if it were exported.  *)
+      RETURN IsExported (GetMainModule (), sym)
+   END
+END IsExportedGcc ;
+
+
+(*
+   ConvertQuadsToTree - runs through the quadruple list and converts it into
+                        the GCC tree structure.
+*)
+
+PROCEDURE ConvertQuadsToTree (Start, End: CARDINAL) ;
+BEGIN
+   REPEAT
+      CodeStatement (Start) ;
+      Start := GetNextQuad (Start)
+   UNTIL (Start > End) OR (Start = 0) ;
+END ConvertQuadsToTree ;
+
+
+(*
+   IsCompilingMainModule -
+*)
+
+PROCEDURE IsCompilingMainModule (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   WHILE (sym # NulSym) AND (GetMainModule () # sym) DO
+      sym := GetModuleScope (sym)
+   END ;
+   RETURN sym # NulSym
+END IsCompilingMainModule ;
+
+
+(*
+   CodeStatement - A multi-way decision call depending on the current
+                   quadruple.
+*)
+
+PROCEDURE CodeStatement (q: CARDINAL) ;
+VAR
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+   location     : location_t ;
+BEGIN
+   GetQuad(q, op, op1, op2, op3) ;
+   IF op=StatementNoteOp
+   THEN
+      FoldStatementNote (op3)  (* will change CurrentQuadToken using op3  *)
+   ELSE
+      CurrentQuadToken := QuadToTokenNo (q)
+   END ;
+   location := TokenToLocation (CurrentQuadToken) ;
+   CheckReferenced(q, op) ;
+   IF DebugTraceQuad
+   THEN
+      printf0('building: ') ;
+      DisplayQuad(q)
+   END ;
+
+   CASE op OF
+
+   StartDefFileOp     : CodeStartDefFile (op3) |
+   StartModFileOp     : CodeStartModFile (op3) |
+   ModuleScopeOp      : CodeModuleScope (op3) |
+   EndFileOp          : CodeEndFile |
+   InitStartOp        : CodeInitStart (op3, IsCompilingMainModule (op3)) |
+   InitEndOp          : CodeInitEnd (op3, IsCompilingMainModule (op3)) |
+   FinallyStartOp     : CodeFinallyStart (op3, IsCompilingMainModule (op3)) |
+   FinallyEndOp       : CodeFinallyEnd (op3, IsCompilingMainModule (op3)) |
+   NewLocalVarOp      : CodeNewLocalVar (op1, op3) |
+   KillLocalVarOp     : CodeKillLocalVar (op3) |
+   ProcedureScopeOp   : CodeProcedureScope (op3) |
+   ReturnOp           : (* Not used as return is achieved by KillLocalVar.  *)  |
+   ReturnValueOp      : CodeReturnValue (op1, op3) |
+   TryOp              : CodeTry |
+   ThrowOp            : CodeThrow (op3) |
+   CatchBeginOp       : CodeCatchBegin |
+   CatchEndOp         : CodeCatchEnd |
+   RetryOp            : CodeRetry (op3) |
+   DummyOp            : |
+   InitAddressOp      : CodeInitAddress(q, op1, op2, op3) |
+   BecomesOp          : CodeBecomes(q) |
+   AddOp              : CodeAddChecked (q, op2, op3) |
+   SubOp              : CodeSubChecked (q, op2, op3) |
+   MultOp             : CodeMultChecked (q, op2, op3) |
+   DivM2Op            : CodeDivM2Checked (q, op2, op3) |
+   ModM2Op            : CodeModM2Checked (q, op2, op3) |
+   DivTruncOp         : CodeDivTrunc (q, op2, op3) |
+   ModTruncOp         : CodeModTrunc (q, op2, op3) |
+   DivCeilOp          : CodeDivCeil (q, op2, op3) |
+   ModCeilOp          : CodeModCeil (q, op2, op3) |
+   DivFloorOp         : CodeDivFloor (q, op2, op3) |
+   ModFloorOp         : CodeModFloor (q, op2, op3) |
+   GotoOp             : CodeGoto (op3) |
+   InclOp             : CodeIncl (op1, op3) |
+   ExclOp             : CodeExcl (op1, op3) |
+   NegateOp           : CodeNegateChecked (q, op1, op3) |
+   LogicalShiftOp     : CodeSetShift (q, op1, op2, op3) |
+   LogicalRotateOp    : CodeSetRotate (q, op1, op2, op3) |
+   LogicalOrOp        : CodeSetOr (q, op1, op2, op3) |
+   LogicalAndOp       : CodeSetAnd (q, op1, op2, op3) |
+   LogicalXorOp       : CodeSetSymmetricDifference (q, op1, op2, op3) |
+   LogicalDiffOp      : CodeSetLogicalDifference (q, op1, op2, op3) |
+   IfLessOp           : CodeIfLess (q, op1, op2, op3) |
+   IfEquOp            : CodeIfEqu (q, op1, op2, op3) |
+   IfNotEquOp         : CodeIfNotEqu (q, op1, op2, op3) |
+   IfGreEquOp         : CodeIfGreEqu (q, op1, op2, op3) |
+   IfLessEquOp        : CodeIfLessEqu (q, op1, op2, op3) |
+   IfGreOp            : CodeIfGre (q, op1, op2, op3) |
+   IfInOp             : CodeIfIn (q, op1, op2, op3) |
+   IfNotInOp          : CodeIfNotIn (q, op1, op2, op3) |
+   IndrXOp            : CodeIndrX (q, op1, op2, op3) |
+   XIndrOp            : CodeXIndr (q, op1, op2, op3) |
+   CallOp             : CodeCall (CurrentQuadToken, op3) |
+   ParamOp            : CodeParam (q, op1, op2, op3) |
+   FunctValueOp       : CodeFunctValue (location, op1) |
+   AddrOp             : CodeAddr (q, op1, op3) |
+   SizeOp             : CodeSize (op1, op3) |
+   UnboundedOp        : CodeUnbounded (op1, op3) |
+   RecordFieldOp      : CodeRecordField (op1, op2, op3) |
+   HighOp             : CodeHigh (op1, op2, op3) |
+   ArrayOp            : CodeArray (op1, op2, op3) |
+   ElementSizeOp      : InternalError ('ElementSizeOp is expected to have been folded via constant evaluation') |
+   ConvertOp          : CodeConvert (q, op1, op2, op3) |
+   CoerceOp           : CodeCoerce (q, op1, op2, op3) |
+   CastOp             : CodeCast (q, op1, op2, op3) |
+   StandardFunctionOp : CodeStandardFunction (q, op1, op2, op3) |
+   SavePriorityOp     : CodeSavePriority (op1, op2, op3) |
+   RestorePriorityOp  : CodeRestorePriority (op1, op2, op3) |
+
+   InlineOp           : CodeInline (location, CurrentQuadToken, op3) |
+   StatementNoteOp    : CodeStatementNote (op3) |
+   CodeOnOp           : |           (* the following make no sense with gcc *)
+   CodeOffOp          : |
+   ProfileOnOp        : |
+   ProfileOffOp       : |
+   OptimizeOnOp       : |
+   OptimizeOffOp      : |
+   RangeCheckOp       : CodeRange (op3) |
+   ErrorOp            : CodeError (op3) |
+   SaveExceptionOp    : CodeSaveException (op1, op3) |
+   RestoreExceptionOp : CodeRestoreException (op1, op3)
+
+   ELSE
+      WriteFormat1 ('quadruple %d not yet implemented', q) ;
+      InternalError ('quadruple not implemented yet')
+   END ;
+   LastOperator := op
+END CodeStatement ;
+
+
+(*
+   ResolveConstantExpressions - resolves constant expressions from the quadruple list.
+                                It returns TRUE if one or more constants were folded.
+                                When a constant symbol value is solved, the call back
+                                p(sym) is invoked.
+*)
+
+PROCEDURE ResolveConstantExpressions (p: WalkAction; start, end: CARDINAL) : BOOLEAN ;
+VAR
+   tokenno: CARDINAL ;
+   quad   : CARDINAL ;
+   op     : QuadOperator ;
+   op1,
+   op2,
+   op3,
+   op1pos,
+   op2pos,
+   op3pos : CARDINAL ;
+   Changed: BOOLEAN ;
+BEGIN
+   Changed  := FALSE ;
+   REPEAT
+      NoChange := TRUE ;
+      quad := start ;
+      WHILE (quad<=end) AND (quad#0) DO
+         tokenno := CurrentQuadToken ;
+         IF tokenno=0
+         THEN
+            tokenno := QuadToTokenNo (quad)
+         END ;
+         GetQuadtok (quad, op, op1, op2, op3,
+                     op1pos, op2pos, op3pos) ;
+         CASE op OF
+
+         StandardFunctionOp : FoldStandardFunction (tokenno, p, quad, op1, op2, op3) |
+         BuiltinConstOp     : FoldBuiltinConst (tokenno, p, quad, op1, op3) |
+         BuiltinTypeInfoOp  : FoldBuiltinTypeInfo (tokenno, p, quad, op1, op2, op3) |
+         LogicalOrOp        : FoldSetOr (tokenno, p, quad, op1, op2, op3) |
+         LogicalAndOp       : FoldSetAnd (tokenno, p, quad, op1, op2, op3) |
+         LogicalXorOp       : FoldSymmetricDifference (tokenno, p, quad, op1, op2, op3) |
+         BecomesOp          : FoldBecomes (tokenno, p, quad, op1, op3) |
+         AddOp              : FoldAdd (op1pos, p, quad, op1, op2, op3) |
+         SubOp              : FoldSub (op1pos, p, quad, op1, op2, op3) |
+         MultOp             : FoldMult (op1pos, p, quad, op1, op2, op3) |
+         DivM2Op            : FoldDivM2 (op1pos, p, quad, op1, op2, op3) |
+         ModM2Op            : FoldModM2 (op1pos, p, quad, op1, op2, op3) |
+         DivTruncOp         : FoldDivTrunc (op1pos, p, quad, op1, op2, op3) |
+         ModTruncOp         : FoldModTrunc (op1pos, p, quad, op1, op2, op3) |
+         DivCeilOp          : FoldDivCeil (op1pos, p, quad, op1, op2, op3) |
+         ModCeilOp          : FoldModCeil (op1pos, p, quad, op1, op2, op3) |
+         DivFloorOp         : FoldDivFloor (op1pos, p, quad, op1, op2, op3) |
+         ModFloorOp         : FoldModFloor (op1pos, p, quad, op1, op2, op3) |
+         NegateOp           : FoldNegate (op1pos, p, quad, op1, op3) |
+         SizeOp             : FoldSize (tokenno, p, quad, op1, op2, op3) |
+         RecordFieldOp      : FoldRecordField (tokenno, p, quad, op1, op2, op3) |
+         HighOp             : FoldHigh (tokenno, p, quad, op1, op2, op3) |
+         ElementSizeOp      : FoldElementSize (tokenno, p, quad, op1, op2) |
+         ConvertOp          : FoldConvert (tokenno, p, quad, op1, op2, op3) |
+         CoerceOp           : FoldCoerce (tokenno, p, quad, op1, op2, op3) |
+         CastOp             : FoldCast (tokenno, p, quad, op1, op2, op3) |
+         InclOp             : FoldIncl (tokenno, p, quad, op1, op3) |
+         ExclOp             : FoldExcl (tokenno, p, quad, op1, op3) |
+         IfLessOp           : FoldIfLess (tokenno, quad, op1, op2, op3) |
+         IfInOp             : FoldIfIn (tokenno, quad, op1, op2, op3) |
+         IfNotInOp          : FoldIfNotIn (tokenno, quad, op1, op2, op3) |
+         LogicalShiftOp     : FoldSetShift(tokenno, p, quad, op1, op2, op3) |
+         LogicalRotateOp    : FoldSetRotate (tokenno, p, quad, op1, op2, op3) |
+         ParamOp            : FoldBuiltinFunction (tokenno, p, quad, op1, op2, op3) |
+         RangeCheckOp       : FoldRange (tokenno, quad, op3) |
+         StatementNoteOp    : FoldStatementNote (op3)
+
+         ELSE
+            (* ignore quadruple as it is not associated with a constant expression *)
+         END ;
+         quad := GetNextQuad(quad)
+      END ;
+      IF NOT NoChange
+      THEN
+         Changed := TRUE
+      END
+   UNTIL NoChange ;
+   IF Debugging AND DisplayQuadruples AND FALSE
+   THEN
+      printf0('after resolving expressions with gcc\n') ;
+      DisplayQuadList
+   END ;
+   RETURN Changed
+END ResolveConstantExpressions ;
+
+
+(*
+   FindSize - given a Modula-2 symbol, sym, return the GCC Tree
+              (constant) representing the storage size in bytes.
+*)
+
+PROCEDURE FindSize (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   IF IsConstString (sym)
+   THEN
+      PushCard (GetStringLength (sym)) ;
+      RETURN PopIntegerTree ()
+   ELSIF IsSizeSolved (sym)
+   THEN
+      PushSize (sym) ;
+      RETURN PopIntegerTree ()
+   ELSE
+      IF GccKnowsAbout (sym)
+      THEN
+         IF IsVar (sym) AND IsVariableSSA (sym)
+         THEN
+            sym := GetType (sym)
+         END ;
+         PushIntegerTree (BuildSize (location, Mod2Gcc (sym), FALSE)) ;
+         PopSize (sym) ;
+         PushSize (sym) ;
+         RETURN PopIntegerTree ()
+      ELSIF IsVar (sym) AND GccKnowsAbout (GetType (sym))
+      THEN
+         PushIntegerTree (BuildSize (location, Mod2Gcc (GetType (sym)), FALSE)) ;
+         RETURN PopIntegerTree ()
+      ELSE
+         InternalError ('expecting gcc to already know about this symbol')
+      END
+   END
+END FindSize ;
+
+
+(*
+   FindType - returns the type of, Sym, if Sym is a TYPE then return Sym otherwise return GetType(Sym)
+*)
+
+PROCEDURE FindType (Sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF IsType (Sym)
+   THEN
+      RETURN Sym
+   ELSE
+      RETURN GetType (Sym)
+   END
+END FindType ;
+
+
+(*
+   BuildTreeFromInterface - generates a GCC tree from an interface definition.
+*)
+
+PROCEDURE BuildTreeFromInterface (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
+VAR
+   i       : CARDINAL ;
+   name    : Name ;
+   str,
+   obj     : CARDINAL ;
+   gccName,
+   tree    : Tree ;
+BEGIN
+   tree := Tree (NIL) ;
+   IF sym#NulSym
+   THEN
+      i := 1 ;
+      REPEAT
+         GetRegInterface (sym, i, name, str, obj) ;
+         IF str#NulSym
+         THEN
+            IF IsConstString (str)
+            THEN
+               DeclareConstant (tokenno, obj) ;
+               IF name = NulName
+               THEN
+                  gccName := NIL
+               ELSE
+                  gccName := BuildStringConstant (KeyToCharStar (name), LengthKey (name))
+               END ;
+               tree := ChainOnParamValue (tree, gccName, PromoteToString (tokenno, str), Mod2Gcc (obj))
+            ELSE
+               WriteFormat0 ('a constraint to the GNU ASM statement must be a constant string')
+            END
+         END ;
+         INC(i)
+      UNTIL (str = NulSym) AND (obj = NulSym) ;
+   END ;
+   RETURN tree
+END BuildTreeFromInterface ;
+
+
+(*
+   BuildTrashTreeFromInterface - generates a GCC string tree from an interface definition.
+*)
+
+PROCEDURE BuildTrashTreeFromInterface (sym: CARDINAL) : Tree ;
+VAR
+   i   : CARDINAL ;
+   str,
+   obj : CARDINAL ;
+   name: Name ;
+   tree: Tree ;
+BEGIN
+   tree := Tree(NIL) ;
+   IF sym#NulSym
+   THEN
+      i := 1 ;
+      REPEAT
+         GetRegInterface(sym, i, name, str, obj) ;
+         IF str#NulSym
+         THEN
+            IF IsConstString(str)
+            THEN
+               tree := AddStringToTreeList(tree, PromoteToString(GetDeclaredMod(str), str))
+            ELSE
+               WriteFormat0('a constraint to the GNU ASM statement must be a constant string')
+            END
+         END ;
+(*
+         IF obj#NulSym
+         THEN
+            InternalError ('not expecting the object to be non null in the trash list')
+         END ;
+*)
+         INC(i)
+      UNTIL (str=NulSym) AND (obj=NulSym)
+   END ;
+   RETURN( tree )
+END BuildTrashTreeFromInterface ;
+
+
+(*
+   CodeInline - InlineOp is a quadruple which has the following format:
+
+                InlineOp   NulSym  NulSym  Sym
+
+                The inline asm statement, Sym, is written to standard output.
+*)
+
+PROCEDURE CodeInline (location: location_t; tokenno: CARDINAL; GnuAsm: CARDINAL) ;
+VAR
+   string  : CARDINAL ;
+   inputs,
+   outputs,
+   trash,
+   labels  : Tree ;
+BEGIN
+   (*
+      no need to explicity flush the outstanding instructions as
+      per M2GenDyn486 and M2GenAPU. The GNU ASM statements in GCC
+      can handle the register dependency providing the user
+      specifies VOLATILE and input/output/trash sets correctly.
+   *)
+   inputs  := BuildTreeFromInterface (tokenno, GetGnuAsmInput(GnuAsm)) ;
+   outputs := BuildTreeFromInterface (tokenno, GetGnuAsmOutput(GnuAsm)) ;
+   trash   := BuildTrashTreeFromInterface (GetGnuAsmTrash(GnuAsm)) ;
+   labels  := NIL ;  (* at present it makes no sence for Modula-2 to jump to a label,
+                        given that labels are not allowed in Modula-2.  *)
+   string  := GetGnuAsm (GnuAsm) ;
+   DeclareConstant (tokenno, string) ;
+   BuildAsm (location,
+             Mod2Gcc (string), IsGnuAsmVolatile (GnuAsm), IsGnuAsmSimple (GnuAsm),
+             inputs, outputs, trash, labels)
+END CodeInline ;
+
+
+(*
+   FoldStatementNote -
+*)
+
+PROCEDURE FoldStatementNote (tokenno: CARDINAL) ;
+BEGIN
+   CurrentQuadToken := tokenno
+END FoldStatementNote ;
+
+
+(*
+   CodeStatementNote -
+*)
+
+PROCEDURE CodeStatementNote (tokenno: CARDINAL) ;
+BEGIN
+   CurrentQuadToken := tokenno ;
+   addStmtNote (TokenToLocation (tokenno))
+END CodeStatementNote ;
+
+
+(*
+   FoldRange - attempts to fold the range test.
+               --fixme-- complete this
+*)
+
+PROCEDURE FoldRange (tokenno: CARDINAL; (* p: WalkAction; *)
+                     quad: CARDINAL; rangeno: CARDINAL) ;
+BEGIN
+   FoldRangeCheck (tokenno, quad, rangeno)
+END FoldRange ;
+
+
+(*
+   CodeSaveException - op1 := op3(TRUE)
+*)
+
+PROCEDURE CodeSaveException (des, exceptionProcedure: CARDINAL) ;
+VAR
+   functValue: Tree ;
+   location  : location_t;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   BuildParam (location, Mod2Gcc (True)) ;
+   BuildFunctionCallTree (location,
+                          Mod2Gcc (exceptionProcedure),
+                          Mod2Gcc (GetType (exceptionProcedure))) ;
+   functValue := BuildFunctValue (location, Mod2Gcc (des)) ;
+   AddStatement (location, functValue)
+END CodeSaveException ;
+
+
+(*
+   CodeRestoreException - op1 := op3(op1)
+*)
+
+PROCEDURE CodeRestoreException (des, exceptionProcedure: CARDINAL) ;
+VAR
+   functValue: Tree ;
+   location  : location_t;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   BuildParam (location, Mod2Gcc (des)) ;
+   BuildFunctionCallTree (location,
+                          Mod2Gcc (exceptionProcedure),
+                          Mod2Gcc (GetType (exceptionProcedure))) ;
+   functValue := BuildFunctValue (location, Mod2Gcc (des)) ;
+   AddStatement (location, functValue)
+END CodeRestoreException ;
+
+
+(*
+   PushScope -
+*)
+
+PROCEDURE PushScope (sym: CARDINAL) ;
+BEGIN
+   PushWord (ScopeStack, sym)
+END PushScope ;
+
+
+(*
+   PopScope -
+*)
+
+PROCEDURE PopScope ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   sym := PopWord (ScopeStack) ;
+   Assert (sym # NulSym)
+END PopScope ;
+
+
+(*
+   GetCurrentScopeDescription - returns a description of the current scope.
+*)
+
+PROCEDURE GetCurrentScopeDescription () : String ;
+VAR
+   sym : CARDINAL ;
+   n   : String ;
+BEGIN
+   IF IsEmptyWord(ScopeStack)
+   THEN
+      InternalError ('not expecting scope stack to be empty')
+   ELSE
+      sym := PeepWord(ScopeStack, 1) ;
+      n := Mark(InitStringCharStar(KeyToCharStar(GetSymName(sym)))) ;
+      IF IsDefImp(sym)
+      THEN
+         RETURN( Sprintf1(Mark(InitString('implementation module %s')), n) )
+      ELSIF IsModule(sym)
+      THEN
+         IF IsInnerModule(sym)
+         THEN
+            RETURN( Sprintf1(Mark(InitString('inner module %s')), n) )
+         ELSE
+            RETURN( Sprintf1(Mark(InitString('program module %s')), n) )
+         END
+      ELSIF IsProcedure(sym)
+      THEN
+         IF IsProcedureNested(sym)
+         THEN
+            RETURN( Sprintf1(Mark(InitString('nested procedure %s')), n) )
+         ELSE
+            RETURN( Sprintf1(Mark(InitString('procedure %s')), n) )
+         END
+      ELSE
+         InternalError ('unexpected scope symbol')
+      END
+   END
+END GetCurrentScopeDescription ;
+
+
+(*
+   CodeRange - encode the range test associated with op3.
+*)
+
+PROCEDURE CodeRange (rangeId: CARDINAL) ;
+BEGIN
+   CodeRangeCheck (rangeId, GetCurrentScopeDescription ())
+END CodeRange ;
+
+
+(*
+   CodeError - encode the error test associated with op3.
+*)
+
+PROCEDURE CodeError (errorId: CARDINAL) ;
+BEGIN
+   (* would like to test whether this position is in the same basicblock
+      as any known entry point.  If so we could emit an error message.
+   *)
+   AddStatement (TokenToLocation (CurrentQuadToken),
+                 CodeErrorCheck (errorId, GetCurrentScopeDescription (), NIL))
+END CodeError ;
+
+
+(*
+   CodeModuleScope - ModuleScopeOp is a quadruple which has the following
+                     format:
+
+                     ModuleScopeOp  _  _  moduleSym
+
+                     Its purpose is to reset the source file to another
+                     file, hence all line numbers emitted with the
+                     generated code will be relative to this source file.
+*)
+
+PROCEDURE CodeModuleScope (moduleSym: CARDINAL) ;
+BEGIN
+   PushScope (moduleSym)
+END CodeModuleScope ;
+
+
+(*
+   CodeStartModFile - StartModFileOp is a quadruple which has the following
+                      format:
+
+                      StartModFileOp  _  _  moduleSym
+
+                      A new source file has been encountered therefore
+                      set LastLine to 1.
+                      Call pushGlobalScope.
+*)
+
+PROCEDURE CodeStartModFile (moduleSym: CARDINAL) ;
+BEGIN
+   pushGlobalScope ;
+   LastLine := 1 ;
+   PushScope (moduleSym)
+END CodeStartModFile ;
+
+
+(*
+   CodeStartDefFile - StartDefFileOp is a quadruple with the following
+                      format:
+
+                      StartDefFileOp  _  _  moduleSym
+
+                      A new source file has been encountered therefore
+                      set LastLine to 1.
+                      Call pushGlobalScope.
+*)
+
+PROCEDURE CodeStartDefFile (moduleSym: CARDINAL) ;
+BEGIN
+   pushGlobalScope ;
+   PushScope (moduleSym) ;
+   LastLine := 1
+END CodeStartDefFile ;
+
+
+(*
+   CodeEndFile - pops the GlobalScope.
+*)
+
+PROCEDURE CodeEndFile ;
+BEGIN
+   popGlobalScope
+END CodeEndFile ;
+
+
+(*
+   CallInnerInit - produce a call to inner module initialization routine.
+*)
+
+PROCEDURE CallInnerInit (moduleSym: WORD) ;
+VAR
+   location             : location_t;
+   ctor, init, fini, dep: CARDINAL ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+   BuildCallInner (location, Mod2Gcc (init))
+END CallInnerInit ;
+
+
+(*
+   CallInnerFinally - produce a call to inner module finalization routine.
+*)
+
+PROCEDURE CallInnerFinally (moduleSym: WORD) ;
+VAR
+   location             : location_t;
+   ctor, init, fini, dep: CARDINAL ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+   BuildCallInner (location, Mod2Gcc (fini))
+END CallInnerFinally ;
+
+
+(*
+   CodeInitStart - emits starting code before the main BEGIN END of the
+                   current module.
+*)
+
+PROCEDURE CodeInitStart (moduleSym: CARDINAL;
+                         CompilingMainModule: BOOLEAN) ;
+VAR
+   location  : location_t;
+   ctor, init,
+   fini, dep : CARDINAL ;
+BEGIN
+   IF CompilingMainModule OR WholeProgram
+   THEN
+      (* SetFileNameAndLineNo (string (FileName), op1) ;  *)
+      location := TokenToLocation (CurrentQuadToken) ;
+      GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+      BuildStartFunctionCode (location, Mod2Gcc (init),
+                              IsExportedGcc (init), FALSE) ;
+      ForeachInnerModuleDo (moduleSym, CallInnerInit)
+   END
+END CodeInitStart ;
+
+
+(*
+   CodeInitEnd - emits terminating code after the main BEGIN END of the
+                 current module.
+*)
+
+PROCEDURE CodeInitEnd (moduleSym: CARDINAL;
+                       CompilingMainModule: BOOLEAN) ;
+VAR
+   location  : location_t;
+   ctor, init,
+   fini, dep : CARDINAL ;
+BEGIN
+   IF CompilingMainModule OR WholeProgram
+   THEN
+      (*
+         SetFileNameAndLineNo(string(FileName), op1) ;
+         EmitLineNote(string(FileName), op1) ;
+      *)
+
+      location := TokenToLocation (GetDeclaredMod (moduleSym)) ;
+      GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+      finishFunctionDecl (location, Mod2Gcc (init)) ;
+      BuildEndFunctionCode (location, Mod2Gcc (init),
+                            IsModuleWithinProcedure (moduleSym))
+   END
+END CodeInitEnd ;
+
+
+(*
+   CodeFinallyStart - emits starting code before the main BEGIN END of the
+                      current module.
+*)
+
+PROCEDURE CodeFinallyStart (moduleSym: CARDINAL;
+                            CompilingMainModule: BOOLEAN) ;
+VAR
+   location  : location_t;
+   ctor, init,
+   fini, dep : CARDINAL ;
+BEGIN
+   IF CompilingMainModule OR WholeProgram
+   THEN
+      (* SetFileNameAndLineNo (string (FileName), op1) ;  *)
+      location := TokenToLocation (CurrentQuadToken) ;
+      GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+      BuildStartFunctionCode (location, Mod2Gcc (fini),
+                              IsExportedGcc (fini), FALSE) ;
+      ForeachInnerModuleDo (moduleSym, CallInnerFinally)
+   END
+END CodeFinallyStart ;
+
+
+(*
+   CodeFinallyEnd - emits terminating code after the main BEGIN END of the
+                    current module.  It also creates the scaffold if the
+                    cflag was not present.
+*)
+
+PROCEDURE CodeFinallyEnd (moduleSym: CARDINAL;
+                          CompilingMainModule: BOOLEAN) ;
+VAR
+   location  : location_t;
+   tokenpos  : CARDINAL ;
+   ctor, init,
+   fini, dep : CARDINAL ;
+BEGIN
+   IF CompilingMainModule OR WholeProgram
+   THEN
+      (*
+         SetFileNameAndLineNo(string(FileName), op1) ;
+         EmitLineNote(string(FileName), op1) ;
+      *)
+
+      tokenpos := GetDeclaredMod (moduleSym) ;
+      location := TokenToLocation (tokenpos) ;
+      GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+      finishFunctionDecl (location, Mod2Gcc (fini)) ;
+      BuildEndFunctionCode (location, Mod2Gcc (fini),
+                            IsModuleWithinProcedure (moduleSym)) ;
+      IF ScaffoldMain OR (NOT cflag)
+      THEN
+         IF CompilingMainModule AND
+            (ScaffoldDynamic OR ScaffoldStatic OR ScaffoldMain) AND
+            (moduleSym = GetMainModule ())
+         THEN
+            qprintf0 ("        generating scaffold m2link information\n");
+            DeclareM2linkGlobals (tokenpos)
+         END
+      END
+   END
+END CodeFinallyEnd ;
+
+
+(*
+   GetAddressOfUnbounded - returns the address of the unbounded array contents.
+*)
+
+PROCEDURE GetAddressOfUnbounded (location: location_t; param: CARDINAL) : Tree ;
+VAR
+   UnboundedType: CARDINAL ;
+BEGIN
+   UnboundedType := GetType (param) ;
+   Assert (IsUnbounded (UnboundedType)) ;
+
+   RETURN BuildConvert (TokenToLocation (GetDeclaredMod (param)),
+                        GetPointerType (),
+                        BuildComponentRef (location, Mod2Gcc (param), Mod2Gcc (GetUnboundedAddressOffset (UnboundedType))),
+                        FALSE)
+END GetAddressOfUnbounded ;
+
+
+(*
+   GetHighFromUnbounded - returns a Tree containing the value of
+                          param.HIGH.
+*)
+
+PROCEDURE GetHighFromUnbounded (location: location_t; dim, param: CARDINAL) : Tree ;
+VAR
+   UnboundedType,
+   ArrayType,
+   HighField    : CARDINAL ;
+   HighTree     : Tree ;
+   accessibleDim: CARDINAL ;
+   (* remainingDim : CARDINAL ;  *)
+BEGIN
+   UnboundedType := GetType (param) ;
+   Assert (IsUnbounded (UnboundedType)) ;
+   ArrayType := GetType (UnboundedType) ;
+   HighField := GetUnboundedHighOffset (UnboundedType, dim) ;
+   IF HighField = NulSym
+   THEN
+      (* it might be a dynamic array of static arrays,
+         so lets see if there is an earlier dimension available.  *)
+      accessibleDim := dim ;
+      WHILE (HighField = NulSym) AND (accessibleDim > 1) DO
+         DEC (accessibleDim) ;
+         HighField := GetUnboundedHighOffset(UnboundedType, accessibleDim)
+      END ;
+      IF HighField = NulSym
+      THEN
+         MetaError1 ('{%EkHIGH} dimension number {%1N} for array does not exist', dim)
+      ELSE
+         (* remainingDim := dim - accessibleDim ;  --fixme-- write tests to stress this code.  *)
+         HighTree := BuildHighFromStaticArray (location, (* remainingDim, *) ArrayType) ;
+         IF HighTree = NIL
+         THEN
+            MetaError1 ('{%EkHIGH} dimension number {%1N} for array does not exist', dim)
+         END ;
+         RETURN HighTree
+      END
+   ELSE
+      RETURN BuildComponentRef (location, Mod2Gcc (param), Mod2Gcc (HighField))
+   END
+END GetHighFromUnbounded ;
+
+
+(*
+   GetSizeOfHighFromUnbounded - returns a Tree containing the value of
+                                param.HIGH * sizeof(unboundedType).
+                                The number of legal bytes this array
+                                occupies.
+*)
+
+PROCEDURE GetSizeOfHighFromUnbounded (tokenno: CARDINAL; param: CARDINAL) : Tree ;
+VAR
+   t            : Tree ;
+   UnboundedType,
+   ArrayType    : CARDINAL ;
+   i, n         : CARDINAL ;
+   location     : location_t;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   UnboundedType := GetType(param) ;
+   Assert(IsUnbounded(UnboundedType)) ;
+   ArrayType := GetType(UnboundedType) ;
+
+   i := 1 ;
+   n := GetDimension(UnboundedType) ;
+   t := GetCardinalOne(location) ;
+   WHILE i<=n DO
+      t := BuildMult(location,
+                     BuildAdd(location,
+                              GetHighFromUnbounded(location, i, param),
+                              GetCardinalOne(location),
+                              FALSE),
+                     t, FALSE) ;
+      (* remember we must add one as HIGH(a) means we can legally reference a[HIGH(a)].  *)
+      INC(i)
+   END ;
+   RETURN( BuildConvert(location,
+                        GetCardinalType(),
+                        BuildMult(location,
+                                  t, BuildConvert(location,
+                                                  GetCardinalType(),
+                                                  FindSize(tokenno, ArrayType), FALSE), FALSE),
+                        FALSE) )
+END GetSizeOfHighFromUnbounded ;
+
+
+(*
+   MaybeDebugBuiltinAlloca -
+*)
+
+PROCEDURE MaybeDebugBuiltinAlloca (location: location_t; tok: CARDINAL; high: Tree) : Tree ;
+VAR
+   func: Tree ;
+BEGIN
+   IF DebugBuiltins
+   THEN
+      func := Mod2Gcc(FromModuleGetSym(tok,
+                                       MakeKey('alloca_trace'),
+                                       MakeDefinitionSource(tok,
+                                       MakeKey('Builtins')))) ;
+      RETURN( BuildCall2(location, func, GetPointerType(), BuiltInAlloca(location, high), high) )
+   ELSE
+      RETURN( BuiltInAlloca(location, high) )
+   END
+END MaybeDebugBuiltinAlloca ;
+
+
+(*
+   MaybeDebugBuiltinMemcpy -
+*)
+
+PROCEDURE MaybeDebugBuiltinMemcpy (location: location_t; tok: CARDINAL; src, dest, nbytes: Tree) : Tree ;
+VAR
+   func: Tree ;
+BEGIN
+   IF DebugBuiltins
+   THEN
+      func := Mod2Gcc(FromModuleGetSym(tok,
+                                       MakeKey('memcpy'),
+                                       MakeDefinitionSource(tok,
+                                       MakeKey('Builtins')))) ;
+      RETURN( BuildCall3(location, func, GetPointerType(), src, dest, nbytes) )
+   ELSE
+      RETURN( BuiltInMemCopy(location, src, dest, nbytes) )
+   END
+END MaybeDebugBuiltinMemcpy ;
+
+
+(*
+   MakeCopyUse - make a copy of the unbounded array and alter all references
+                 from the old unbounded array to the new unbounded array.
+                 The parameter, param, contains a RECORD
+                                                     ArrayAddress: ADDRESS ;
+                                                     ArrayHigh   : CARDINAL ;
+                                                  END
+                 we simply declare a new array of size, ArrayHigh
+                 and set ArrayAddress to the address of the copy.
+
+                 Remember ArrayHigh == sizeof(Array)-sizeof(typeof(array))
+                          so we add 1 for the size and add 1 for a possible <nul>
+*)
+
+PROCEDURE MakeCopyUse (tokenno: CARDINAL; param: CARDINAL) ;
+VAR
+   location     : location_t;
+   UnboundedType: CARDINAL ;
+   Addr,
+   High,
+   NewArray     : Tree ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   UnboundedType := GetType (param) ;
+   Assert (IsUnbounded (UnboundedType)) ;
+
+   High := GetSizeOfHighFromUnbounded (tokenno, param) ;
+   Addr := GetAddressOfUnbounded (location, param) ;
+
+   NewArray := MaybeDebugBuiltinAlloca (location, tokenno, High) ;
+   NewArray := MaybeDebugBuiltinMemcpy (location, tokenno, NewArray, Addr, High) ;
+
+   (* now assign  param.Addr := ADR(NewArray) *)
+
+   BuildAssignmentStatement (location,
+                             BuildComponentRef (location, Mod2Gcc (param), Mod2Gcc (GetUnboundedAddressOffset (UnboundedType))),
+                             NewArray)
+END MakeCopyUse ;
+
+
+(*
+   GetParamAddress - returns the address of parameter, param.
+*)
+
+PROCEDURE GetParamAddress (location: location_t; proc, param: CARDINAL) : Tree ;
+VAR
+   sym,
+   type: CARDINAL ;
+BEGIN
+   IF IsParameter(param)
+   THEN
+      type := GetType(param) ;
+      sym := GetLocalSym(proc, GetSymName(param)) ;
+      IF IsUnbounded(type)
+      THEN
+         RETURN( GetAddressOfUnbounded(location, sym) )
+      ELSE
+         Assert(GetMode(sym)=LeftValue) ;
+         RETURN( Mod2Gcc(sym) )
+      END
+   ELSE
+      Assert(IsVar(param)) ;
+      Assert(GetMode(param)=LeftValue) ;
+      RETURN( Mod2Gcc(param) )
+   END
+END GetParamAddress ;
+
+
+(*
+   IsUnboundedWrittenTo - returns TRUE if the unbounded parameter
+                          might be written to, or if -funbounded-by-reference
+                          was _not_ specified.
+*)
+
+PROCEDURE IsUnboundedWrittenTo (proc, param: CARDINAL) : BOOLEAN ;
+VAR
+   f     : String ;
+   l     : CARDINAL ;
+   sym   : CARDINAL ;
+   n1, n2: Name ;
+BEGIN
+   sym := GetLocalSym(proc, GetSymName(param)) ;
+   IF sym=NulSym
+   THEN
+      InternalError ('should find symbol in table')
+   ELSE
+      IF UnboundedByReference
+      THEN
+         IF (NOT GetVarWritten(sym)) AND VerboseUnbounded
+         THEN
+            n1 := GetSymName(sym) ;
+            n2 := GetSymName(proc) ;
+            f := FindFileNameFromToken(GetDeclaredMod(sym), 0) ;
+            l := TokenToLineNo(GetDeclaredMod(sym), 0) ;
+            printf4('%s:%d:non VAR unbounded parameter %a in procedure %a does not need to be copied\n',
+                    f, l, n1, n2)
+         END ;
+         RETURN( GetVarWritten(sym) )
+      ELSE
+         RETURN( TRUE )
+      END
+   END
+END IsUnboundedWrittenTo ;
+
+
+(*
+   GetParamSize - returns the size in bytes of, param.
+*)
+
+PROCEDURE GetParamSize (tokenno: CARDINAL; param: CARDINAL) : Tree ;
+BEGIN
+   Assert(IsVar(param) OR IsParameter(param)) ;
+   IF IsUnbounded(param)
+   THEN
+      RETURN GetSizeOfHighFromUnbounded(tokenno, param)
+   ELSE
+      RETURN BuildSize(tokenno, Mod2Gcc(GetType(param)), FALSE)
+   END
+END GetParamSize ;
+
+
+(*
+   DoIsIntersection - jumps to, tLabel, if the ranges i1..i2  j1..j2 overlap
+                      else jump to, fLabel.
+*)
+
+PROCEDURE DoIsIntersection (tokenno: CARDINAL; ta, tb, tc, td: Tree; tLabel, fLabel: String) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   (*
+     if (ta>td) OR (tb<tc)
+     then
+        goto fLabel
+     else
+        goto tLabel
+     fi
+   *)
+   DoJump(location, BuildGreaterThan(location, ta, td), NIL, string(fLabel)) ;
+   DoJump(location, BuildLessThan(location, tb, tc), NIL, string(fLabel)) ;
+   BuildGoto(location, string(tLabel)) ;
+   IF CascadedDebugging
+   THEN
+      printf1('label used %s\n', tLabel) ;
+      printf1('label used %s\n', fLabel)
+   END
+END DoIsIntersection ;
+
+
+(*
+   BuildCascadedIfThenElsif - mustCheck contains a list of variables which
+                              must be checked against the address of (proc, param, i).
+                              If the address matches we make a copy of the unbounded
+                              parameter (proc, param) and quit further checking.
+*)
+
+PROCEDURE BuildCascadedIfThenElsif (tokenno: CARDINAL;
+                                    mustCheck: List;
+                                    proc, param: CARDINAL) ;
+VAR
+   ta, tb,
+   tc, td  : Tree ;
+   n, j    : CARDINAL ;
+   tLabel,
+   fLabel,
+   nLabel  : String ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   n := NoOfItemsInList(mustCheck) ;
+   (* want a sequence of if then elsif statements *)
+   IF n>0
+   THEN
+      INC(UnboundedLabelNo) ;
+      j := 1 ;
+      ta := GetAddressOfUnbounded(location, param) ;
+      tb := BuildConvert(TokenToLocation(tokenno),
+                         GetPointerType(),
+                         BuildAddAddress(location, ta, GetSizeOfHighFromUnbounded(tokenno, param)),
+                         FALSE) ;
+      WHILE j<=n DO
+         IF j>1
+         THEN
+            nLabel := CreateLabelProcedureN(proc, "n", UnboundedLabelNo, j) ;
+            IF CascadedDebugging
+            THEN
+               printf1('label declared %s\n', nLabel)
+            END ;
+            DeclareLabel(location, string(nLabel)) ;
+         END ;
+         tc := GetParamAddress(location, proc, GetItemFromList(mustCheck, j)) ;
+         td := BuildConvert(TokenToLocation(tokenno),
+                            GetPointerType(),
+                            BuildAddAddress(location, tc, GetParamSize(tokenno, param)),
+                            FALSE) ;
+         tLabel := CreateLabelProcedureN(proc, "t", UnboundedLabelNo, j+1) ;
+         fLabel := CreateLabelProcedureN(proc, "f", UnboundedLabelNo, j+1) ;
+         DoIsIntersection(tokenno, ta, tb, tc, td, tLabel, fLabel) ;
+         IF CascadedDebugging
+         THEN
+            printf1('label declared %s\n', tLabel)
+         END ;
+         DeclareLabel (location, string (tLabel)) ;
+         MakeCopyUse (tokenno, param) ;
+         IF j<n
+         THEN
+            nLabel := CreateLabelProcedureN(proc, "n", UnboundedLabelNo, n+1) ;
+            BuildGoto(location, string(nLabel)) ;
+            IF CascadedDebugging
+            THEN
+               printf1('goto %s\n', nLabel)
+            END
+         END ;
+         IF CascadedDebugging
+         THEN
+            printf1('label declared %s\n', fLabel)
+         END ;
+         DeclareLabel(location, string(fLabel)) ;
+         INC(j)
+      END ;
+(*
+      nLabel := CreateLabelProcedureN(proc, "fin", UnboundedLabelNo, n+1) ;
+      IF CascadedDebugging
+      THEN
+         printf1('label declared %s\n', nLabel)
+      END ;
+      DeclareLabel(location, string(nLabel))
+*)
+   END
+END BuildCascadedIfThenElsif ;
+
+
+(*
+   CheckUnboundedNonVarParameter - if non var unbounded parameter is written to
+                                   then
+                                      make a copy of the contents of this parameter
+                                      and use the copy
+                                   else if param
+                                      is type compatible with any parameter, symv
+                                      and at runtime its address matches symv
+                                   then
+                                      make a copy of the contents of this parameter
+                                      and use the copy
+                                   fi
+*)
+
+PROCEDURE CheckUnboundedNonVarParameter (tokenno: CARDINAL;
+                                         trashed: List;
+                                         proc, param: CARDINAL) ;
+VAR
+   mustCheck   : List ;
+   paramTrashed,
+   n, j        : CARDINAL ;
+   f           : String ;
+   l           : CARDINAL ;
+   n1, n2      : Name ;
+BEGIN
+   IF IsUnboundedWrittenTo(proc, param)
+   THEN
+      MakeCopyUse (tokenno, param)
+   ELSE
+      InitList(mustCheck) ;
+      n := NoOfItemsInList(trashed) ;
+      j := 1 ;
+      WHILE j<=n DO
+         paramTrashed := GetItemFromList(trashed, j) ;
+         IF IsAssignmentCompatible(GetLowestType(param), GetLowestType(paramTrashed))
+         THEN
+            (* we must check whether this unbounded parameter has the same
+               address as the trashed parameter *)
+            IF VerboseUnbounded
+            THEN
+               n1 := GetSymName(paramTrashed) ;
+               n2 := GetSymName(proc) ;
+               f := FindFileNameFromToken(GetDeclaredMod(paramTrashed), 0) ;
+               l := TokenToLineNo(GetDeclaredMod(paramTrashed), 0) ;
+               printf4('%s:%d:must check at runtime the address of parameter, %a, in procedure, %a, whose contents will be trashed\n',
+                       f, l, n1, n2) ;
+               n1 := GetSymName(param) ;
+               n2 := GetSymName(paramTrashed) ;
+               printf4('%s:%d:against address of parameter, %a, possibly resulting in a copy of parameter, %a\n',
+                       f, l, n1, n2)
+            END ;
+            PutItemIntoList(mustCheck, paramTrashed)
+         END ;
+         INC(j)
+      END ;
+      (* now we build a sequence of if then { elsif then } end to check addresses *)
+      BuildCascadedIfThenElsif (tokenno, mustCheck, proc, param) ;
+      KillList(mustCheck)
+   END
+END CheckUnboundedNonVarParameter ;
+
+
+(*
+   IsParameterWritten - returns TRUE if a parameter, sym, is written to.
+*)
+
+PROCEDURE IsParameterWritten (proc: CARDINAL; sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsParameter(sym)
+   THEN
+      sym := GetLocalSym(proc, GetSymName(sym))
+   END ;
+   IF IsVar(sym)
+   THEN
+      (* unbounded arrays will appear as vars *)
+      RETURN GetVarWritten(sym)
+   END ;
+   InternalError ('expecting IsVar to return TRUE')
+END IsParameterWritten ;
+
+
+(*
+   SaveNonVarUnboundedParameters - for each var parameter, symv, do
+                                      (* not just unbounded var parameters, but _all_
+                                         parameters *)
+                                      if symv is written to
+                                      then
+                                         add symv to a compile list
+                                      fi
+                                   done
+
+                                   for each parameter of procedure, symu, do
+                                      if non var unbounded parameter is written to
+                                      then
+                                         make a copy of the contents of this parameter
+                                         and use the copy
+                                      else if
+                                         symu is type compatible with any parameter, symv
+                                         and at runtime its address matches symv
+                                      then
+                                         make a copy of the contents of this parameter
+                                         and use the copy
+                                      fi
+                                   done
+*)
+
+PROCEDURE SaveNonVarUnboundedParameters (tokenno: CARDINAL; proc: CARDINAL) ;
+VAR
+   i, p   : CARDINAL ;
+   trashed: List ;
+   f      : String ;
+   sym    : CARDINAL ;
+   l      : CARDINAL ;
+   n1, n2 : Name ;
+BEGIN
+   InitList(trashed) ;
+   i := 1 ;
+   p := NoOfParam(proc) ;
+   WHILE i<=p DO
+      sym := GetNthParam(proc, i) ;
+      IF IsParameterWritten(proc, sym)
+      THEN
+         IF VerboseUnbounded
+         THEN
+            n1 := GetSymName(sym) ;
+            n2 := GetSymName(proc) ;
+            f := FindFileNameFromToken(GetDeclaredMod(sym), 0) ;
+            l := TokenToLineNo(GetDeclaredMod(sym), 0) ;
+            printf4('%s:%d:parameter, %a, in procedure, %a, is trashed\n',
+                    f, l, n1, n2)
+         END ;
+         PutItemIntoList(trashed, sym)
+      END ;
+      INC(i)
+   END ;
+   (* now see whether we need to copy any unbounded array parameters *)
+   i := 1 ;
+   p := NoOfParam(proc) ;
+   WHILE i<=p DO
+      IF IsUnboundedParam(proc, i) AND (NOT IsVarParam(proc, i))
+      THEN
+         CheckUnboundedNonVarParameter (tokenno, trashed, proc, GetNth (proc, i))
+      END ;
+      INC(i)
+   END ;
+   KillList(trashed)
+END SaveNonVarUnboundedParameters ;
+
+
+(*
+   AutoInitVariable -
+*)
+
+PROCEDURE AutoInitVariable (location: location_t; sym: CARDINAL) ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   IF (NOT IsParameter (sym)) AND IsVar (sym) AND
+      (NOT IsTemporary (sym))
+   THEN
+      (* PrintSym (sym) ; *)
+      type := SkipType (GetType (sym)) ;
+      (* the type SYSTEM.ADDRESS is a pointer type.  *)
+      IF IsPointer (type)
+      THEN
+         BuildAssignmentStatement (location,
+                                   Mod2Gcc (sym),
+                                   BuildConvert (location,
+                                                 Mod2Gcc (GetType (sym)),
+                                                 GetPointerZero (location),
+                                                 TRUE))
+      END
+   END
+END AutoInitVariable ;
+
+
+(*
+   AutoInitialize - scope will be a procedure, module or defimp.  All pointer
+                    variables are assigned to NIL.
+*)
+
+PROCEDURE AutoInitialize (location: location_t; scope: CARDINAL) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   IF AutoInit
+   THEN
+      n := NoOfVariables (scope) ;
+      i := 1 ;
+      IF IsProcedure (scope)
+      THEN
+         (* the parameters are stored as local variables.  *)
+         INC (i, NoOfParam (scope))
+      END ;
+      WHILE i <= n DO
+         AutoInitVariable (location, GetNth (scope, i)) ;
+         INC (i)
+      END
+   END
+END AutoInitialize ;
+
+
+(*
+   CodeNewLocalVar - Builds a new frame on the stack to contain the procedure
+                     local variables.
+*)
+
+PROCEDURE CodeNewLocalVar (tokenno, CurrentProcedure: CARDINAL) ;
+VAR
+   begin, end: CARDINAL ;
+BEGIN
+   (* callee saves non var unbounded parameter contents *)
+   SaveNonVarUnboundedParameters (tokenno, CurrentProcedure) ;
+   BuildPushFunctionContext ;
+   GetProcedureBeginEnd (CurrentProcedure, begin, end) ;
+   CurrentQuadToken := begin ;
+   SetBeginLocation (TokenToLocation (begin)) ;
+   AutoInitialize (TokenToLocation (begin), CurrentProcedure) ;
+   ForeachProcedureDo (CurrentProcedure, CodeBlock) ;
+   ForeachInnerModuleDo (CurrentProcedure, CodeBlock) ;
+   BuildPopFunctionContext ;
+   ForeachInnerModuleDo (CurrentProcedure, CallInnerInit)
+END CodeNewLocalVar ;
+
+
+(*
+   CodeKillLocalVar - removes local variables and returns to previous scope.
+*)
+
+PROCEDURE CodeKillLocalVar (CurrentProcedure: CARDINAL) ;
+VAR
+   begin, end: CARDINAL ;
+   proc      : Tree ;
+BEGIN
+   GetProcedureBeginEnd (CurrentProcedure, begin, end) ;
+   CurrentQuadToken := end ;
+   proc := NIL ;
+   IF IsCtor (CurrentProcedure)
+   THEN
+      proc := DeclareModuleCtor (Mod2Gcc (CurrentProcedure))
+   END ;
+   BuildEndFunctionCode (TokenToLocation (end),
+                         Mod2Gcc (CurrentProcedure),
+                         IsProcedureGccNested (CurrentProcedure)) ;
+   IF IsCtor (CurrentProcedure) AND (proc # NIL)
+   THEN
+      BuildModuleCtor (proc)
+   END ;
+   PoisonSymbols (CurrentProcedure) ;
+   removeStmtNote () ;
+   PopScope
+END CodeKillLocalVar ;
+
+
+(*
+   CodeProcedureScope -
+*)
+
+PROCEDURE CodeProcedureScope (CurrentProcedure: CARDINAL) ;
+VAR
+   begin, end: CARDINAL ;
+BEGIN
+   removeStmtNote () ;
+   GetProcedureBeginEnd (CurrentProcedure, begin, end) ;
+   BuildStartFunctionCode (TokenToLocation (begin),
+                           Mod2Gcc (CurrentProcedure),
+                           IsExportedGcc (CurrentProcedure),
+                           IsProcedureInline (CurrentProcedure)) ;
+   StartDeclareScope (CurrentProcedure) ;
+   PushScope (CurrentProcedure) ;
+   (* DeclareParameters(CurrentProcedure) *)
+END CodeProcedureScope ;
+
+
+(*
+   CodeReturnValue - places the operand into the return value space
+                     allocated by the function call.
+*)
+
+PROCEDURE CodeReturnValue (res, Procedure: CARDINAL) ;
+VAR
+   value, length, op3t : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   TryDeclareConstant (CurrentQuadToken, res) ;  (* checks to see whether it is a constant and declares it *)
+   TryDeclareConstructor (CurrentQuadToken, res) ;
+   IF IsConstString (res) AND (SkipTypeAndSubrange (GetType (Procedure)) # Char)
+   THEN
+      DoCopyString (CurrentQuadToken, length, op3t, GetType (Procedure), res) ;
+      value := BuildArrayStringConstructor (location,
+                                            Mod2Gcc (GetType (Procedure)), op3t, length)
+   ELSE
+      value := Mod2Gcc (res)
+   END ;
+   BuildReturnValueCode (location, Mod2Gcc (Procedure), value)
+END CodeReturnValue ;
+
+
+(* *******************************
+(*
+   GenerateCleanup - generates a try/catch/clobber tree containing the call to ptree
+*)
+
+PROCEDURE GenerateCleanup (location: location_t; procedure: CARDINAL; p, call: Tree) : Tree ;
+VAR
+   i, n: CARDINAL ;
+   t   : Tree ;
+BEGIN
+   t := push_statement_list (begin_statement_list ()) ;
+   i := 1 ;
+   n := NoOfParam (procedure) ;
+   WHILE i<=n DO
+      IF IsParameterVar (GetNthParam (procedure, i))
+      THEN
+         AddStatement (location, BuildCleanUp (GetParamTree (call, i-1)))
+      END ;
+      INC(i)
+   END ;
+   RETURN BuildTryFinally (location, p, pop_statement_list ())
+END GenerateCleanup ;
+
+
+(*
+   CheckCleanup - checks whether a cleanup is required for a procedure with
+                  VAR parameters.  The final tree is returned.
+*)
+
+PROCEDURE CheckCleanup (location: location_t; procedure: CARDINAL; tree, call: Tree) : Tree ;
+BEGIN
+   IF HasVarParameters(procedure)
+   THEN
+      RETURN tree ;
+      (* RETURN GenerateCleanup(location, procedure, tree, call) *)
+   ELSE
+      RETURN tree
+   END
+END CheckCleanup ;
+************************************** *)
+
+
+(*
+   CodeCall - determines whether the procedure call is a direct call
+              or an indirect procedure call.
+*)
+
+PROCEDURE CodeCall (tokenno: CARDINAL; procedure: CARDINAL) ;
+VAR
+   tree    : Tree ;
+   location: location_t ;
+BEGIN
+   IF IsProcedure (procedure)
+   THEN
+      DeclareParameters (procedure) ;
+      tree := CodeDirectCall (tokenno, procedure)
+   ELSIF IsProcType (SkipType (GetType (procedure)))
+   THEN
+      DeclareParameters (SkipType (GetType (procedure))) ;
+      tree := CodeIndirectCall (tokenno, procedure) ;
+      procedure := SkipType (GetType (procedure))
+   ELSE
+      InternalError ('expecting Procedure or ProcType')
+   END ;
+   IF GetType (procedure) = NulSym
+   THEN
+      location := TokenToLocation (tokenno) ;
+      AddStatement (location, tree)
+      (* was AddStatement(location, CheckCleanup(location, procedure, tree, tree))  *)
+   ELSE
+      (* leave tree alone - as it will be picked up when processing FunctValue *)
+   END
+END CodeCall ;
+
+
+(*
+   CanUseBuiltin - returns TRUE if the procedure, Sym, can be
+                   inlined via a builtin function.
+*)
+
+PROCEDURE CanUseBuiltin (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (NOT DebugBuiltins) AND
+           (BuiltinExists(KeyToCharStar(GetProcedureBuiltin(Sym))) OR
+            BuiltinExists(KeyToCharStar(GetSymName(Sym)))) )
+END CanUseBuiltin ;
+
+
+(*
+   UseBuiltin - returns a Tree containing the builtin function
+                and parameters. It should only be called if
+                CanUseBuiltin returns TRUE.
+*)
+
+PROCEDURE UseBuiltin (tokenno: CARDINAL; Sym: CARDINAL) : Tree ;
+BEGIN
+   IF BuiltinExists(KeyToCharStar(GetProcedureBuiltin(Sym)))
+   THEN
+      RETURN( BuildBuiltinTree(TokenToLocation (tokenno), KeyToCharStar(GetProcedureBuiltin(Sym))) )
+   ELSE
+      RETURN( BuildBuiltinTree(TokenToLocation (tokenno), KeyToCharStar(GetSymName(Sym))) )
+   END
+END UseBuiltin ;
+
+
+(*
+   CodeDirectCall - calls a function/procedure.
+*)
+
+PROCEDURE CodeDirectCall (tokenno: CARDINAL; procedure: CARDINAL) : Tree ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   IF IsProcedureBuiltin(procedure) AND CanUseBuiltin(procedure)
+   THEN
+      RETURN UseBuiltin (tokenno, procedure)
+   ELSE
+      IF GetType(procedure)=NulSym
+      THEN
+         RETURN BuildProcedureCallTree(location, Mod2Gcc(procedure), NIL)
+      ELSE
+         RETURN BuildProcedureCallTree(location, Mod2Gcc(procedure), Mod2Gcc(GetType(procedure)))
+      END
+   END
+END CodeDirectCall ;
+
+
+(*
+   CodeIndirectCall - calls a function/procedure indirectly.
+*)
+
+PROCEDURE CodeIndirectCall (tokenno: CARDINAL; ProcVar: CARDINAL) : Tree ;
+VAR
+   ReturnType: Tree ;
+   proc      : CARDINAL ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   proc := SkipType(GetType(ProcVar)) ;
+   IF GetType(proc)=NulSym
+   THEN
+      ReturnType := Tree(NIL)
+   ELSE
+      ReturnType := Tree(Mod2Gcc(GetType(proc)))
+   END ;
+
+   (* now we dereference the lvalue if necessary *)
+
+   IF GetMode(ProcVar)=LeftValue
+   THEN
+      RETURN BuildIndirectProcedureCallTree(location,
+                                             BuildIndirect(location, Mod2Gcc(ProcVar), Mod2Gcc(proc)),
+                                             ReturnType)
+   ELSE
+      RETURN BuildIndirectProcedureCallTree(location, Mod2Gcc(ProcVar), ReturnType)
+   END
+END CodeIndirectCall ;
+
+
+(*
+   StringToChar - if type=Char and str is a string (of size <= 1)
+                  then convert the string into a character constant.
+*)
+
+PROCEDURE StringToChar (t: Tree; type, str: CARDINAL) : Tree ;
+VAR
+   s: String ;
+   n: Name ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(str)) ;
+   type := SkipType(type) ;
+   IF (type=Char) AND IsConstString(str)
+   THEN
+      IF GetStringLength(str)=0
+      THEN
+         s := InitString('') ;
+         t := BuildCharConstant(location, s) ;
+         s := KillString(s) ;
+      ELSIF GetStringLength(str)>1
+      THEN
+         n := GetSymName(str) ;
+         WriteFormat1("type incompatibility, attempting to use a string ('%a') when a CHAR is expected", n) ;
+         s := InitString('') ;  (* do something safe *)
+         t := BuildCharConstant(location, s)
+      END ;
+      s := InitStringCharStar(KeyToCharStar(GetString(str))) ;
+      s := Slice(s, 0, 1) ;
+      t := BuildCharConstant(location, string(s)) ;
+      s := KillString(s) ;
+   END ;
+   RETURN( t )
+END StringToChar ;
+
+
+(*
+   ConvertTo - convert gcc tree, t, (which currently represents Modula-2 op3) into
+               a symbol of, type.
+*)
+
+PROCEDURE ConvertTo (t: Tree; type, op3: CARDINAL) : Tree ;
+BEGIN
+   IF SkipType(type)#SkipType(GetType(op3))
+   THEN
+      IF IsConst(op3) AND (NOT IsConstString(op3))
+      THEN
+         PushValue(op3) ;
+         RETURN( BuildConvert(TokenToLocation(GetDeclaredMod(op3)),
+                              Mod2Gcc(type), t, FALSE) )
+      END
+   END ;
+   RETURN( t )
+END ConvertTo ;
+
+
+(*
+   ConvertRHS - convert (t, rhs) into, type.  (t, rhs) refer to the
+                same entity t is a GCC Tree and, rhs, is a Modula-2
+                symbol.  It checks for char and strings
+                first and then the remaining types.
+*)
+
+PROCEDURE ConvertRHS (t: Tree; type, rhs: CARDINAL) : Tree ;
+BEGIN
+   t := StringToChar (Mod2Gcc (rhs), type, rhs) ;
+   RETURN ConvertTo (t, type, rhs)
+END ConvertRHS ;
+
+
+(*
+   IsCoerceableParameter - returns TRUE if symbol, sym, is a
+                           coerceable parameter.
+*)
+
+PROCEDURE IsCoerceableParameter (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          IsSet(sym) OR
+          (IsOrdinalType(sym) AND (sym#Boolean) AND (NOT IsEnumeration(sym))) OR
+          IsComplexType(sym) OR IsRealType(sym) OR
+          IsComplexN(sym) OR IsRealN(sym) OR IsSetN(sym)
+         )
+END IsCoerceableParameter ;
+
+
+(*
+   IsConstProcedure - returns TRUE if, p, is a const procedure.
+*)
+
+PROCEDURE IsConstProcedure (p: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsConst(p) AND (GetType(p)#NulSym) AND IsProcType(GetType(p)) )
+END IsConstProcedure ;
+
+
+(*
+   IsConstant - returns TRUE if symbol, p, is either a const or procedure.
+*)
+
+PROCEDURE IsConstant (p: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN IsConst (p) OR IsProcedure (p)
+END IsConstant ;
+
+
+(*
+   CheckConvertCoerceParameter -
+*)
+
+PROCEDURE CheckConvertCoerceParameter (tokenno: CARDINAL; op1, op2, op3: CARDINAL) : Tree ;
+VAR
+   OperandType,
+   ParamType  : CARDINAL ;
+   location   : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   IF GetNthParam(op2, op1)=NulSym
+   THEN
+      (* We reach here if the argument is being passed to a C vararg function.  *)
+      RETURN( Mod2Gcc(op3) )
+   ELSE
+      OperandType := SkipType(GetType(op3)) ;
+      ParamType := SkipType(GetType(GetNthParam(op2, op1)))
+   END ;
+   IF IsProcType(ParamType)
+   THEN
+      IF IsProcedure(op3) OR IsConstProcedure(op3) OR (OperandType = ParamType)
+      THEN
+         RETURN( Mod2Gcc(op3) )
+      ELSE
+         RETURN( BuildConvert(location, Mod2Gcc(ParamType), Mod2Gcc(op3), FALSE) )
+      END
+   ELSIF IsRealType(OperandType) AND IsRealType(ParamType) AND
+      (ParamType#OperandType)
+   THEN
+      (* SHORTREAL, LONGREAL and REAL conversion during parameter passing *)
+      RETURN( BuildConvert(location, Mod2Gcc(ParamType),
+                           Mod2Gcc(op3), FALSE) )
+   ELSIF (OperandType#NulSym) AND IsSet(OperandType) AND IsConst(op3)
+   THEN
+      RETURN( DeclareKnownConstant(location,
+                                   Mod2Gcc(ParamType),
+                                   Mod2Gcc(op3)) )
+   ELSIF IsConst(op3) AND
+         (IsOrdinalType(ParamType) OR IsSystemType(ParamType))
+   THEN
+      RETURN( BuildConvert(location, Mod2Gcc(ParamType),
+                           StringToChar(Mod2Gcc(op3), ParamType, op3),
+                           FALSE) )
+   ELSIF IsConstString(op3) OR ((OperandType#NulSym) AND IsCoerceableParameter(OperandType) AND (OperandType#ParamType))
+   THEN
+      RETURN( BuildConvert(location, Mod2Gcc(ParamType), Mod2Gcc(op3), FALSE) )
+   ELSE
+      RETURN( Mod2Gcc(op3) )
+   END
+END CheckConvertCoerceParameter ;
+
+
+(*
+   CheckConstant - checks to see whether we should declare the constant.
+*)
+
+PROCEDURE CheckConstant (tokenno: CARDINAL; des, expr: CARDINAL) : Tree ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   IF IsProcedure(expr)
+   THEN
+      RETURN( Mod2Gcc(expr) )
+   ELSE
+      RETURN( DeclareKnownConstant(location, Mod2Gcc(GetType(des)), Mod2Gcc(expr)) )
+   END
+END CheckConstant ;
+
+
+(*
+   CodeMakeAdr - code the function MAKEADR.
+*)
+
+PROCEDURE CodeMakeAdr (q: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   r       : CARDINAL ;
+   n       : CARDINAL ;
+   type    : CARDINAL ;
+   op      : QuadOperator ;
+   bits,
+   max,
+   tmp,
+   res,
+   val     : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   n := q ;
+   REPEAT
+      IF op1>0
+      THEN
+         DeclareConstant(CurrentQuadToken, op3)
+      END ;
+      n := GetNextQuad(n) ;
+      GetQuad(n, op, r, op2, op3)
+   UNTIL op=FunctValueOp ;
+
+   n := q ;
+   GetQuad(n, op, op1, op2, op3) ;
+   res := Mod2Gcc(r) ;
+   max := GetSizeOfInBits(Mod2Gcc(Address)) ;
+   bits := GetIntegerZero(location) ;
+   val := GetPointerZero(location) ;
+   REPEAT
+      location := TokenToLocation(CurrentQuadToken) ;
+      IF (op=ParamOp) AND (op1>0)
+      THEN
+         IF GetType(op3)=NulSym
+         THEN
+            WriteFormat0('must supply typed constants to MAKEADR')
+         ELSE
+            type := GetType(op3) ;
+            tmp := BuildConvert(location, GetPointerType(), Mod2Gcc(op3), FALSE) ;
+            IF CompareTrees(bits, GetIntegerZero(location))>0
+            THEN
+               tmp := BuildLSL(location, tmp, bits, FALSE)
+            END ;
+            bits := BuildAdd(location, bits, GetSizeOfInBits(Mod2Gcc(type)), FALSE) ;
+            val := BuildLogicalOrAddress(location, val, tmp, FALSE)
+         END
+      END ;
+      SubQuad(n) ;
+      n := GetNextQuad(n) ;
+      GetQuad(n, op, op1, op2, op3)
+   UNTIL op=FunctValueOp ;
+   IF CompareTrees(bits, max)>0
+   THEN
+      MetaErrorT0 (CurrentQuadToken,
+                   'total number of bits specified as parameters to {%kMAKEADR} exceeds address width')
+   END ;
+   SubQuad(n) ;
+   BuildAssignmentStatement (location, res, val)
+END CodeMakeAdr ;
+
+
+(*
+   CodeBuiltinFunction - attempts to inline a function. Currently it only
+                         inlines the SYSTEM function MAKEADR.
+*)
+
+PROCEDURE CodeBuiltinFunction (q: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF (op1=0) AND (op3=MakeAdr)
+   THEN
+      CodeMakeAdr (q, op1, op2, op3)
+   END
+END CodeBuiltinFunction ;
+
+
+(*
+   FoldMakeAdr - attempts to fold the function MAKEADR.
+*)
+
+PROCEDURE FoldMakeAdr (tokenno: CARDINAL; p: WalkAction;
+                       q: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   resolved: BOOLEAN ;
+   r       : CARDINAL ;
+   n       : CARDINAL ;
+   op      : QuadOperator ;
+   type    : CARDINAL ;
+   bits,
+   max,
+   tmp,
+   val     : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   resolved := TRUE ;
+   n := q ;
+   r := op1 ;
+   REPEAT
+      IF r>0
+      THEN
+         TryDeclareConstant (tokenno, op3) ;
+         IF NOT GccKnowsAbout(op3)
+         THEN
+            resolved := FALSE
+         END
+      END ;
+      n := GetNextQuad(n) ;
+      GetQuad(n, op, r, op2, op3)
+   UNTIL op=FunctValueOp ;
+
+   IF resolved AND IsConst(r)
+   THEN
+      n := q ;
+      GetQuad(n, op, op1, op2, op3) ;
+      max := GetSizeOfInBits(Mod2Gcc(Address)) ;
+      bits := GetIntegerZero(location) ;
+      val := GetPointerZero(location) ;
+      REPEAT
+         location := TokenToLocation(tokenno) ;
+         IF (op=ParamOp) AND (op1>0)
+         THEN
+            IF GetType(op3)=NulSym
+            THEN
+               MetaErrorT0 (tokenno,
+                            'constants passed to {%kMAKEADR} must be typed')
+            ELSE
+               type := GetType(op3) ;
+               tmp := BuildConvert(location, GetPointerType(), Mod2Gcc(op3), FALSE) ;
+               IF CompareTrees(bits, GetIntegerZero(location))>0
+               THEN
+                  tmp := BuildLSL(location, tmp, bits, FALSE)
+               END ;
+	       bits := BuildAdd(location, bits, GetSizeOfInBits(Mod2Gcc(type)), FALSE) ;
+               val := BuildLogicalOrAddress(location, val, tmp, FALSE)
+            END
+         END ;
+         SubQuad(n) ;
+         n := GetNextQuad(n) ;
+         GetQuad(n, op, op1, op2, op3)
+      UNTIL op=FunctValueOp ;
+      IF CompareTrees(bits, max)>0
+      THEN
+         MetaErrorT0 (tokenno,
+                      'total number of bits specified as parameters to {%kMAKEADR} exceeds address width')
+      END ;
+      PutConst(r, Address) ;
+      AddModGcc(r, DeclareKnownConstant(location, Mod2Gcc(Address), val)) ;
+      p(r) ;
+      NoChange := FALSE ;
+      SubQuad(n)
+   END
+END FoldMakeAdr ;
+
+
+(*
+   doParam - builds the parameter, op3, which is to be passed to
+             procedure, op2.  The number of the parameter is op1.
+*)
+
+PROCEDURE doParam (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   DeclareConstant (CurrentQuadToken, op3) ;
+   DeclareConstructor (CurrentQuadToken, quad, op3) ;
+   BuildParam (location, CheckConvertCoerceParameter (CurrentQuadToken, op1, op2, op3))
+END doParam ;
+
+
+(*
+   FoldBuiltin - attempts to fold the gcc builtin function.
+*)
+
+PROCEDURE FoldBuiltin (tokenno: CARDINAL; p: WalkAction; q: CARDINAL) ;
+VAR
+   resolved  : BOOLEAN ;
+   procedure,
+   r         : CARDINAL ;
+   n         : CARDINAL ;
+   op1, op2,
+   op3       : CARDINAL ;
+   op        : QuadOperator ;
+   val       : Tree ;
+   location  : location_t ;
+BEGIN
+   GetQuad (q, op, op1, op2, op3) ;
+   resolved := TRUE ;
+   procedure := NulSym ;
+   n := q ;
+   r := op1 ;
+   REPEAT
+      IF r>0
+      THEN
+         TryDeclareConstant(tokenno, op3) ;
+         IF NOT GccKnowsAbout(op3)
+         THEN
+            resolved := FALSE
+         END
+      END ;
+      IF (op=CallOp) AND (NOT IsProcedure(op3))
+      THEN
+         (* cannot fold an indirect procedure function call *)
+         resolved := FALSE
+      END ;
+      n := GetNextQuad(n) ;
+      GetQuad(n, op, r, op2, op3)
+   UNTIL op=FunctValueOp ;
+
+   IF resolved AND IsConst(r)
+   THEN
+      n := q ;
+      GetQuad(n, op, op1, op2, op3) ;
+      REPEAT
+         IF (op=ParamOp) AND (op1>0)
+         THEN
+            doParam(n, op1, op2, op3)
+         ELSIF op=CallOp
+         THEN
+            procedure := op3
+         END ;
+         SubQuad(n) ;
+         n := GetNextQuad(n) ;
+         GetQuad(n, op, op1, op2, op3)
+      UNTIL op=FunctValueOp ;
+
+      IF IsProcedureBuiltin(procedure) AND CanUseBuiltin(procedure)
+      THEN
+         location := TokenToLocation(tokenno) ;
+         val := FoldAndStrip (UseBuiltin (tokenno, procedure)) ;
+         PutConst(r, GetType(procedure)) ;
+         AddModGcc(r, DeclareKnownConstant(location, Mod2Gcc(GetType(procedure)), val)) ;
+         p(r) ;
+         SetLastFunction(NIL)
+      ELSE
+         MetaErrorT1 (tokenno, 'gcc builtin procedure {%1Ead} cannot be used in a constant expression', procedure) ;
+      END ;
+      NoChange := FALSE ;
+      SubQuad(n)
+   END
+END FoldBuiltin ;
+
+
+(*
+   FoldBuiltinFunction - attempts to inline a function. Currently it only
+                         inlines the SYSTEM function MAKEADR.
+*)
+
+PROCEDURE FoldBuiltinFunction (tokenno: CARDINAL; p: WalkAction;
+                               q: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF op1=0
+   THEN
+      (* must be a function as op1 is the return parameter *)
+      IF op3=MakeAdr
+      THEN
+         FoldMakeAdr (tokenno, p, q, op1, op2, op3)
+      ELSIF IsProcedure (op3) AND IsProcedureBuiltin (op3) AND CanUseBuiltin (op3)
+      THEN
+         FoldBuiltin (tokenno, p, q)
+      END
+   END
+END FoldBuiltinFunction ;
+
+
+(*
+   CodeParam - builds a parameter list.
+
+               NOTE that we almost can treat VAR and NON VAR parameters the same, expect for
+                    some types:
+
+                    procedure parameters
+                    unbounded parameters
+
+                    these require special attention and thus it is easier to test individually
+                    for VAR and NON VAR parameters.
+
+               NOTE that we CAN ignore ModeOfAddr though
+*)
+
+PROCEDURE CodeParam (quad: CARDINAL; nth, procedure, parameter: CARDINAL) ;
+BEGIN
+   IF nth=0
+   THEN
+      CodeBuiltinFunction (quad, nth, procedure, parameter)
+   ELSE
+      IF StrictTypeChecking
+      THEN
+         IF (nth <= NoOfParam (procedure))
+         THEN
+            IF IsVarParam (procedure, nth) AND
+               (NOT ParameterTypeCompatible (CurrentQuadToken,
+                                             'parameter incompatibility when attempting to pass actual parameter {%3Ead} to a {%kVAR} formal parameter {%2ad} during call to procedure {%1ad}',
+                                             procedure, GetNthParam (procedure, nth), parameter, nth, TRUE))
+            THEN
+
+            ELSIF (NOT IsVarParam (procedure, nth)) AND
+               (NOT ParameterTypeCompatible (CurrentQuadToken,
+                                             'parameter incompatibility when attempting to pass actual parameter {%3Ead} to a formal parameter {%2ad} during call to procedure {%1ad}',
+                                             procedure, GetNthParam (procedure, nth), parameter, nth, FALSE))
+            THEN
+               (* use the AssignmentTypeCompatible as the rules are for assignment for non var parameters.  *)
+            ELSE
+               (* doParam (quad, nth, procedure, parameter) *)    (* --fixme--  enable when M2Check works.  *)
+            END
+         END
+      ELSE
+         (* doParam (quad, nth, procedure, parameter)     *)    (* --fixme--  enable when M2Check works.  *)
+      END ;
+
+      (* --fixme  remove B EGIN  *)
+      IF (nth <= NoOfParam (procedure)) AND
+         IsVarParam (procedure, nth) AND IsConst (parameter)
+      THEN
+         MetaErrorT1 (CurrentQuadToken,
+                      'cannot pass a constant {%1Ead} as a VAR parameter', parameter)
+      ELSIF IsAModula2Type (parameter)
+      THEN
+         MetaErrorT2 (CurrentQuadToken,
+                      'cannot pass a type {%1Ead} as a parameter to procedure {%2ad}',
+                      parameter, procedure)
+      ELSE
+         doParam (quad, nth, procedure, parameter)
+      END
+      (* --fixme  remove E ND  once M2Check works.  *)
+   END
+END CodeParam ;
+
+
+(*
+   Replace - replace the entry for sym in the double entry bookkeeping with sym/tree.
+*)
+
+PROCEDURE Replace (sym: CARDINAL; tree: Tree) ;
+BEGIN
+   IF GccKnowsAbout (sym)
+   THEN
+      RemoveMod2Gcc (sym)
+   END ;
+   AddModGcc (sym, tree)
+END Replace ;
+
+
+(*
+   CodeFunctValue - retrieves the function return value and assigns it
+                    into a variable.
+*)
+
+PROCEDURE CodeFunctValue (location: location_t; op1: CARDINAL) ;
+VAR
+   call,
+   value: Tree ;
+BEGIN
+   (*
+      operator : FunctValueOp
+      op1 : The Returned Variable
+      op3 : The Function Returning this Variable
+   *)
+   IF EnableSSA AND IsVariableSSA (op1)
+   THEN
+      call := GetLastFunction () ;
+      SetLastFunction (NIL) ;
+      Replace (op1, call)
+   ELSE
+      value := BuildFunctValue (location, Mod2Gcc (op1)) ;
+      (* AddStatement (location, CheckCleanup (location, op3, value, call))  *)
+      AddStatement (location, value)
+   END
+END CodeFunctValue ;
+
+
+(*
+   Addr Operator  - contains the address of a variable.
+
+   Yields the address of a variable - need to add the frame pointer if
+   a variable is local to a procedure.
+
+   Sym1<X>   Addr   Sym2<X>     meaning     Mem[Sym1<I>] := Sym2<I>
+*)
+
+PROCEDURE CodeAddr (quad: CARDINAL; op1, op3: CARDINAL) ;
+VAR
+   value   : Tree ;
+   type    : CARDINAL ;
+   location: location_t ;
+BEGIN
+   IF IsConst(op3) AND (NOT IsConstString(op3))
+   THEN
+      MetaErrorT1 (CurrentQuadToken, 'error in expression, trying to find the address of a constant {%1Ead}', op3)
+   ELSE
+      location := TokenToLocation (CurrentQuadToken) ;
+      type := SkipType (GetType (op3)) ;
+      DeclareConstant (CurrentQuadToken, op3) ;  (* we might be asked to find the address of a constant string *)
+      DeclareConstructor (CurrentQuadToken, quad, op3) ;
+      IF (IsConst (op3) AND (type=Char)) OR IsConstString (op3)
+      THEN
+         value := BuildStringConstant (KeyToCharStar (GetString (op3)), GetStringLength (op3))
+      ELSE
+         value := Mod2Gcc (op3)
+      END ;
+      BuildAssignmentStatement (location,
+                                Mod2Gcc (op1),
+                                BuildAddr (location, value, FALSE))
+   END
+END CodeAddr ;
+
+
+PROCEDURE stop ; BEGIN END stop ;
+
+PROCEDURE CheckStop (q: CARDINAL) ;
+BEGIN
+   IF q=3827
+   THEN
+      stop
+   END
+END CheckStop ;
+
+(*
+------------------------------------------------------------------------------
+   := Operator
+------------------------------------------------------------------------------
+   Sym1<I> := Sym3<I>           := produces a constant
+*)
+
+PROCEDURE FoldBecomes (tokenno: CARDINAL; p: WalkAction; quad: CARDINAL; op1, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   TryDeclareConstant(tokenno, op3) ;  (* checks to see whether it is a constant literal and declares it *)
+   TryDeclareConstructor(tokenno, op3) ;
+   location := TokenToLocation(tokenno) ;
+   IF IsConst (op1) AND IsConstant (op3)
+   THEN
+      (* constant folding taking place, but have we resolved op3 yet? *)
+      IF GccKnowsAbout (op3)
+      THEN
+         (* now we can tell gcc about the relationship between, op1 and op3 *)
+         (* RemoveSSAPlaceholder (quad, op1) ;  *)
+         IF GccKnowsAbout (op1)
+         THEN
+            MetaErrorT1 (tokenno, 'constant {%1Ead} should not be reassigned', op1)
+         ELSE
+            IF IsConstString(op3)
+            THEN
+               PutConstString(tokenno, op1, GetString(op3)) ;
+            ELSIF GetType(op1)=NulSym
+            THEN
+               Assert(GetType(op3)#NulSym) ;
+               PutConst(op1, GetType(op3))
+            END ;
+            IF GetType(op3)=NulSym
+            THEN
+               CheckOrResetOverflow(tokenno, Mod2Gcc(op3), MustCheckOverflow(quad)) ;
+               AddModGcc(op1, Mod2Gcc(op3))
+            ELSE
+               IF NOT GccKnowsAbout(GetType(op1))
+               THEN
+                  RETURN
+               END ;
+               IF IsProcedure(op3)
+               THEN
+                  AddModGcc(op1,
+                            BuildConvert(location,
+                                         Mod2Gcc(GetType(op1)), BuildAddr(location, Mod2Gcc(op3), FALSE), TRUE))
+               ELSIF IsValueSolved(op3)
+               THEN
+                  PushValue(op3) ;
+                  IF IsValueTypeReal()
+                  THEN
+                     CheckOrResetOverflow(tokenno, PopRealTree(), MustCheckOverflow(quad)) ;
+                     PushValue(op3) ;
+                     AddModGcc(op1, PopRealTree())
+                  ELSIF IsValueTypeSet()
+                  THEN
+                     PopValue(op1) ;
+                     PutConstSet(op1)
+                  ELSIF IsValueTypeConstructor() OR IsValueTypeArray() OR IsValueTypeRecord()
+                  THEN
+                     PopValue(op1) ;
+                     PutConstructor(op1)
+                  ELSIF IsValueTypeComplex()
+                  THEN
+                     CheckOrResetOverflow(tokenno, PopComplexTree(), MustCheckOverflow(quad)) ;
+                     PushValue(op3) ;
+                     PopValue(op1)
+                  ELSE
+                     CheckOrResetOverflow(tokenno, PopIntegerTree(), MustCheckOverflow(quad)) ;
+                     IF GetType(op1)=NulSym
+                     THEN
+                        PushValue(op3) ;
+                        AddModGcc(op1, PopIntegerTree())
+                     ELSE
+                        PushValue(op3) ;
+                        AddModGcc(op1, BuildConvert(location, Mod2Gcc(GetType(op1)), PopIntegerTree(), FALSE))
+                     END
+                  END
+               ELSE
+                  CheckOrResetOverflow(tokenno, Mod2Gcc(op3), MustCheckOverflow(quad)) ;
+                  AddModGcc(op1,
+                            DeclareKnownConstant(location,
+                                                 Mod2Gcc(GetType(op3)),
+                                                 Mod2Gcc(op3)))
+               END
+            END ;
+            p (op1) ;
+            NoChange := FALSE ;
+            SubQuad(quad) ;
+            Assert (RememberConstant(Mod2Gcc (op1)) = Mod2Gcc (op1))
+         END
+      ELSE
+         (* not to worry, we must wait until op3 is known *)
+      END
+   END
+END FoldBecomes ;
+
+VAR
+   tryBlock: Tree ;    (* this must be placed into gccgm2 and it must follow the
+                          current function scope - ie it needs work with nested procedures *)
+   handlerBlock: Tree ;
+
+
+(*
+   CodeTry - starts building a GCC 'try' node.
+*)
+
+PROCEDURE CodeTry ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   handlerBlock := NIL ;
+   tryBlock := BuildTryBegin (location)
+END CodeTry ;
+
+
+(*
+   CodeThrow - builds a GCC 'throw' node.
+*)
+
+PROCEDURE CodeThrow (value: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   IF value = NulSym
+   THEN
+      AddStatement (location, BuildThrow (location, Tree (NIL)))
+   ELSE
+      DeclareConstant (CurrentQuadToken, value) ;  (* checks to see whether it is a constant and declares it *)
+      AddStatement (location, BuildThrow (location, BuildConvert (location,
+                                                                  GetIntegerType (),
+                                                                  Mod2Gcc (value), FALSE)))
+   END
+END CodeThrow ;
+
+
+PROCEDURE CodeRetry (destQuad: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   BuildGoto (location, string (CreateLabelName (destQuad)))
+END CodeRetry ;
+
+
+PROCEDURE CodeCatchBegin ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   BuildTryEnd (tryBlock) ;
+   handlerBlock := BuildCatchBegin (location)
+END CodeCatchBegin ;
+
+
+PROCEDURE CodeCatchEnd ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   tryBlock := BuildCatchEnd (location, handlerBlock, tryBlock) ;
+   AddStatement (location, tryBlock)
+END CodeCatchEnd ;
+
+
+(*
+   DescribeTypeError -
+*)
+
+PROCEDURE DescribeTypeError (token: CARDINAL;
+                             op1, op2: CARDINAL) ;
+BEGIN
+   MetaErrorT2(token, 'incompatible set types in assignment, assignment between {%1ERad} and {%2ad}', op1, op2) ;
+   MetaError2('set types are {%1CDtsad} and {%2Dtsad}', op1, op2)
+END DescribeTypeError ;
+
+
+(*
+   DefaultConvertGM2 - provides a simple mapping between
+                       front end data types and GCC equivalents.
+                       This is only used to aid assignment of
+                       typed constants.
+*)
+
+PROCEDURE DefaultConvertGM2 (sym: CARDINAL) : Tree ;
+BEGIN
+   sym := SkipType (sym) ;
+   IF sym=Bitset
+   THEN
+      RETURN( GetWordType() )
+   ELSE
+      RETURN( Mod2Gcc(sym) )
+   END
+END DefaultConvertGM2 ;
+
+
+(*
+   GetTypeMode -
+*)
+
+PROCEDURE GetTypeMode (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF GetMode(sym)=LeftValue
+   THEN
+      RETURN( Address )
+   ELSE
+      RETURN( GetType(sym) )
+   END
+END GetTypeMode ;
+
+
+(*
+   FoldConstBecomes - returns a Tree containing op3.
+                      The tree will have been folded and
+                      type converted if necessary.
+*)
+
+PROCEDURE FoldConstBecomes (tokenno: CARDINAL;
+                            op1, op3: CARDINAL) : Tree ;
+VAR
+   t, type : Tree ;
+   location: location_t ;
+BEGIN
+   IF IsConstSet(op3) OR ((SkipType(GetType(op3))#NulSym) AND
+                          IsSet(SkipType(GetType(op3))))
+   THEN
+      (* we have not checked set compatibility in
+         M2Quads.mod:BuildAssignmentTree so we do it here.
+      *)
+(*
+      IF (Iso AND (SkipType(GetType(op1))#SkipType(GetType(op3)))) OR
+         (Pim AND ((SkipType(GetType(op1))#SkipType(GetType(op3))) AND
+                   (SkipType(GetType(op1))#Bitset) AND
+                   (SkipType(GetType(op3))#Bitset)))
+*)
+      IF SkipType(GetTypeMode(op1))#SkipType(GetTypeMode(op3))
+      THEN
+         DescribeTypeError (tokenno, op1, op3) ;
+         RETURN( Mod2Gcc (op1) ) (* we might crash if we execute the BuildAssignmentTree with op3 *)
+      END
+   END ;
+   location := TokenToLocation (tokenno) ;
+   TryDeclareConstant (tokenno, op3) ;
+   t := Mod2Gcc (op3) ;
+   Assert (t#NIL) ;
+   IF IsConstant (op3)
+   THEN
+      IF IsProcedure (op3)
+      THEN
+         RETURN t
+	 (*
+         t := BuildConvert(location, Mod2Gcc(GetType(op1)), BuildAddr(location, Mod2Gcc(op3), FALSE), TRUE)
+         *)
+      ELSIF (NOT IsConstString (op3)) AND (NOT IsConstSet (op3)) AND
+         (SkipType (GetType (op3)) # SkipType (GetType (op1)))
+      THEN
+         type := DefaultConvertGM2 (GetType(op1)) ;  (* do we need this now? --fixme-- *)
+         t := ConvertConstantAndCheck (location, type, t)
+      ELSIF GetType (op1) # NulSym
+      THEN
+         t := StringToChar (Mod2Gcc (op3), GetType (op1), op3)
+      END
+   END ;
+   RETURN( t )
+END FoldConstBecomes ;
+
+
+(*
+   DoCopyString - returns trees:
+                  length    number of bytes to be copied (including the nul)
+                  op1t the new string _type_ (with the extra nul character).
+                  op3t the actual string with the extra nul character.
+*)
+
+PROCEDURE DoCopyString (tokenno: CARDINAL; VAR length, op3t: Tree; op1t, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   Assert(IsArray(SkipType(op1t))) ;
+   (* handle string assignments:
+      VAR
+         str: ARRAY [0..10] OF CHAR ;
+         ch : CHAR ;
+
+         str := 'abcde' but not ch := 'a'
+   *)
+   IF GetType (op3) = Char
+   THEN
+      (*
+       *  create string from char and add nul to the end, nul is
+       *  added by BuildStringConstant
+       *)
+      op3t := BuildStringConstant (KeyToCharStar (GetString (op3)), 1)
+   ELSE
+      op3t := Mod2Gcc (op3)
+   END ;
+   op3t := ConvertString (Mod2Gcc (op1t), op3t) ;
+
+   PushIntegerTree(FindSize(tokenno, op3)) ;
+   PushIntegerTree(FindSize(tokenno, op1t)) ;
+   IF Less(tokenno)
+   THEN
+      (* there is room for the extra <nul> character *)
+      length := BuildAdd(location, FindSize(tokenno, op3), GetIntegerOne(location), FALSE)
+   ELSE
+      PushIntegerTree(FindSize(tokenno, op3)) ;
+      PushIntegerTree(FindSize(tokenno, op1t)) ;
+      IF Gre (tokenno)
+      THEN
+         WarnStringAt (InitString('string constant is too large to be assigned to the array'),
+                       tokenno) ;
+         length := FindSize (tokenno, op1t)
+      ELSE
+         (* equal so return max characters in the array *)
+         length := FindSize (tokenno, op1t)
+      END
+   END
+END DoCopyString ;
+
+
+(*
+   checkArrayElements - return TRUE if op1 or op3 are not arrays.
+                        If they are arrays and have different number of
+                        elements return FALSE, otherwise TRUE.
+*)
+
+PROCEDURE checkArrayElements (op1, op3: CARDINAL) : BOOLEAN ;
+VAR
+   e1, e3  : Tree ;
+   t1, t3  : CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+   t1 := GetType(op1) ;
+   t3 := GetType(op3) ;
+   IF (t1#NulSym) AND (t3#NulSym) AND
+      IsArray(SkipType(GetType(op3))) AND IsArray(SkipType(GetType(op1)))
+   THEN
+      (* both arrays continue checking *)
+      e1 := GetArrayNoOfElements(location, Mod2Gcc(SkipType(GetType(op1)))) ;
+      e3 := GetArrayNoOfElements(location, Mod2Gcc(SkipType(GetType(op3)))) ;
+      IF CompareTrees(e1, e3)#0
+      THEN
+         MetaErrorT2(CurrentQuadToken, 'not allowed to assign array {%2Ead} to {%1ad} as they have a different number of elements',
+                     op1, op3) ;
+         RETURN( FALSE )
+      END
+   END ;
+   RETURN( TRUE )
+END checkArrayElements ;
+
+
+(*
+   CodeInitAddress -
+*)
+
+PROCEDURE CodeInitAddress (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   DeclareConstant (CurrentQuadToken, op3) ;  (* checks to see whether it is a constant and declares it *)
+   DeclareConstructor (CurrentQuadToken, quad, op3) ;
+
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   Assert (op2 = NulSym) ;
+   Assert (GetMode (op1) = LeftValue) ;
+   BuildAssignmentStatement (location,
+                             Mod2Gcc (op1),
+                             BuildConvert (location, GetPointerType (), Mod2Gcc (op3), FALSE))
+END CodeInitAddress ;
+
+
+(*
+   checkRecordTypes - returns TRUE if op1 is not a record or if the record
+                      is the same type as op2.
+*)
+
+PROCEDURE checkRecordTypes (op1, op2: CARDINAL) : BOOLEAN ;
+VAR
+   t1, t2: CARDINAL ;
+BEGIN
+   IF (GetType(op1)=NulSym) OR (GetMode(op1)=LeftValue)
+   THEN
+      RETURN( TRUE )
+   ELSE
+      t1 := SkipType(GetType(op1)) ;
+      IF IsRecord(t1)
+      THEN
+         IF GetType(op2)=NulSym
+         THEN
+            MetaErrorT2 (CurrentQuadToken, 'cannot assign an operand of type {%1Ets} to a record type {%2tsa}', op2, op1) ;
+            RETURN( FALSE )
+         ELSE
+            t2 := SkipType(GetType(op2)) ;
+	    IF t1=t2
+            THEN
+               RETURN( TRUE )
+            ELSE
+               MetaErrorT2 (CurrentQuadToken, 'cannot assign an operand of type {%1ts} to a record type {%2tsa}', op2, op1) ;
+	       RETURN( FALSE )
+            END
+         END
+      END
+   END ;
+   RETURN( TRUE )
+END checkRecordTypes ;
+
+
+(*
+   checkIncorrectMeta -
+*)
+
+PROCEDURE checkIncorrectMeta (op1, op2: CARDINAL) : BOOLEAN ;
+VAR
+   t1, t2: CARDINAL ;
+BEGIN
+   t1 := SkipType(GetType(op1)) ;
+   t2 := SkipType(GetType(op2)) ;
+   IF (t1=NulSym) OR (GetMode(op1)=LeftValue) OR
+      (t2=NulSym) OR (GetMode(op2)=LeftValue)
+   THEN
+      RETURN( TRUE )
+   ELSIF (t1#t2) AND (NOT IsGenericSystemType(t1)) AND (NOT IsGenericSystemType(t2))
+   THEN
+      IF IsArray(t1) OR IsSet(t1) OR IsRecord(t1)
+      THEN
+         IF NOT IsAssignmentCompatible(t1, t2)
+         THEN
+            MetaErrorT2 (CurrentQuadToken, 'illegal assignment error between {%1Etad} and {%2tad}', op1, op2) ;
+	    RETURN( FALSE )
+         END
+      END
+   END ;
+   RETURN( TRUE )
+END checkIncorrectMeta ;
+
+
+(*
+   checkBecomes - returns TRUE if the checks pass.
+*)
+
+PROCEDURE checkBecomes (des, expr: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF (NOT checkArrayElements (des, expr)) OR
+      (NOT checkRecordTypes (des, expr)) OR
+      (NOT checkIncorrectMeta (des, expr))
+   THEN
+      RETURN FALSE
+   END ;
+   RETURN TRUE
+END checkBecomes ;
+
+
+(*
+   checkDeclare - checks to see if sym is declared and if it is not then declare it.
+*)
+
+PROCEDURE checkDeclare (sym: CARDINAL) ;
+BEGIN
+   IF IsTemporary (sym) AND IsVariableSSA (sym) AND (NOT GccKnowsAbout (sym))
+   THEN
+      DeclareLocalVariable (sym)
+   END
+END checkDeclare ;
+
+
+(*
+------------------------------------------------------------------------------
+   := Operator
+------------------------------------------------------------------------------
+   Sym1<I> := Sym3<I>           := produces a constant
+   Sym1<O> := Sym3<O>           := has the effect Mem[Sym1<I>] := Mem[Sym3<I>]
+*)
+
+PROCEDURE CodeBecomes (quad: CARDINAL) ;
+VAR
+   op        : QuadOperator ;
+   op1, op2,
+   op3       : CARDINAL ;
+   becomespos,
+   op1pos,
+   op2pos,
+   op3pos    : CARDINAL ;
+   length,
+   op3t      : Tree ;
+   location  : location_t ;
+BEGIN
+   GetQuadOtok (quad, becomespos, op, op1, op2, op3, op1pos, op2pos, op3pos) ;
+   DeclareConstant (CurrentQuadToken, op3) ;  (* checks to see whether it is a constant and declares it *)
+   DeclareConstructor (CurrentQuadToken, quad, op3) ;
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   IF StrictTypeChecking AND
+      (NOT AssignmentTypeCompatible (CurrentQuadToken, "", op1, op3))
+   THEN
+      MetaErrorT2 (MakeVirtualTok (becomespos, op1pos, op3pos),
+                   'assignment check caught mismatch between {%1Ead} and {%2ad}',
+                   op1, op3)
+   END ;
+   IF IsConst (op1) AND (NOT GccKnowsAbout (op1))
+   THEN
+      ConstantKnownAndUsed (op1, CheckConstant (CurrentQuadToken, op1, op3))
+   ELSIF IsConstString (op3) AND (SkipTypeAndSubrange (GetType (op1)) # Char)
+   THEN
+      checkDeclare (op1) ;
+      DoCopyString (CurrentQuadToken, length, op3t, SkipType (GetType (op1)), op3) ;
+      AddStatement (location,
+                    MaybeDebugBuiltinMemcpy (location, CurrentQuadToken,
+                                             BuildAddr (location, Mod2Gcc (op1), FALSE),
+                                             BuildAddr (location, op3t, FALSE),
+                                             length))
+   ELSE
+      IF ((IsGenericSystemType(SkipType(GetType(op1))) #
+           IsGenericSystemType(SkipType(GetType(op3)))) OR
+          (IsUnbounded(SkipType(GetType(op1))) AND
+           IsUnbounded(SkipType(GetType(op3))) AND
+           (IsGenericSystemType(SkipType(GetType(GetType(op1)))) #
+            IsGenericSystemType(SkipType(GetType(GetType(op3))))))) AND
+         (NOT IsConstant(op3))
+      THEN
+         checkDeclare (op1) ;
+         AddStatement (location,
+                       MaybeDebugBuiltinMemcpy (location, CurrentQuadToken,
+                                                BuildAddr(location, Mod2Gcc (op1), FALSE),
+                                                BuildAddr(location, Mod2Gcc (op3), FALSE),
+                                                BuildSize(location, Mod2Gcc (op1), FALSE)))
+      ELSE
+         IF checkBecomes (op1, op3)
+         THEN
+            IF IsVariableSSA (op1)
+            THEN
+               Replace (op1, FoldConstBecomes (CurrentQuadToken, op1, op3))
+            ELSE
+               BuildAssignmentStatement (location,
+                                         Mod2Gcc (op1),
+                                         FoldConstBecomes (CurrentQuadToken, op1, op3))
+            END
+         ELSE
+            SubQuad (quad)  (* we don't want multiple errors for the quad.  *)
+         END
+      END
+   END
+END CodeBecomes ;
+
+
+(*
+   LValueToGenericPtr - returns a Tree representing symbol, sym.
+                        It coerces a lvalue into an internal pointer type
+*)
+
+PROCEDURE LValueToGenericPtr (location: location_t; sym: CARDINAL) : Tree ;
+VAR
+   t: Tree ;
+BEGIN
+   t := Mod2Gcc (sym) ;
+   IF t = NIL
+   THEN
+      InternalError ('expecting symbol to be resolved')
+   END ;
+   IF GetMode (sym) = LeftValue
+   THEN
+      t := BuildConvert (location, GetPointerType (), t, FALSE)
+   END ;
+   RETURN t
+END LValueToGenericPtr ;
+
+
+(*
+   LValueToGenericPtrOrConvert - if sym is an lvalue then convert to pointer type
+                                 else convert to type, type. Return the converted tree.
+*)
+
+PROCEDURE LValueToGenericPtrOrConvert (sym: CARDINAL; type: Tree) : Tree ;
+VAR
+   n       : Tree ;
+   location: location_t ;
+BEGIN
+   n := Mod2Gcc (sym) ;
+   location := TokenToLocation (GetDeclaredMod (sym)) ;
+   IF n = NIL
+   THEN
+      InternalError ('expecting symbol to be resolved')
+   END ;
+   IF GetMode (sym) = LeftValue
+   THEN
+      n := BuildConvert (location, GetPointerType (), n, FALSE)
+   ELSE
+      n := BuildConvert (location, type, n, FALSE)
+   END ;
+   RETURN n
+END LValueToGenericPtrOrConvert ;
+
+
+(*
+   ZConstToTypedConst - checks whether op1 and op2 are constants and
+                        coerces, t, appropriately.
+*)
+
+PROCEDURE ZConstToTypedConst (t: Tree; op1, op2: CARDINAL) : Tree ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(op2)) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      (* leave, Z type, alone *)
+      RETURN( t )
+   ELSIF IsConst(op1)
+   THEN
+      IF GetMode(op2)=LeftValue
+      THEN
+         (* convert, Z type const into type of non constant operand *)
+         RETURN( BuildConvert(location, GetPointerType(), t, FALSE) )
+      ELSE
+         (* convert, Z type const into type of non constant operand *)
+         RETURN( BuildConvert(location, Mod2Gcc(FindType(op2)), t, FALSE) )
+      END
+   ELSIF IsConst(op2)
+   THEN
+      IF GetMode(op1)=LeftValue
+      THEN
+         (* convert, Z type const into type of non constant operand *)
+         RETURN( BuildConvert(location, GetPointerType(), t, FALSE) )
+      ELSE
+         (* convert, Z type const into type of non constant operand *)
+         RETURN( BuildConvert(location, Mod2Gcc(FindType(op1)), t, FALSE) )
+      END
+   ELSE
+      (* neither operands are constants, leave alone *)
+      RETURN( t )
+   END
+END ZConstToTypedConst ;
+
+
+(*
+   FoldBinary - check whether we can fold the binop operation.
+*)
+
+PROCEDURE FoldBinary (tokenno: CARDINAL; p: WalkAction; binop: BuildBinProcedure;
+                      quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   tl, tr, tv, resType: Tree ;
+   location           : location_t ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   TryDeclareConstant(tokenno, op3) ;
+   TryDeclareConstant(tokenno, op2) ;
+   location := TokenToLocation(tokenno) ;
+   IF IsConst(op2) AND IsConst(op3)
+   THEN
+      IF GccKnowsAbout(op2) AND GccKnowsAbout(op3)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst(op1)
+         THEN
+            Assert(MixTypes(FindType(op3), FindType(op2), tokenno)#NulSym) ;
+            PutConst(op1, MixTypes(FindType(op3), FindType(op2), tokenno)) ;
+
+            tl := LValueToGenericPtr(location, op2) ;
+            tr := LValueToGenericPtr(location, op3) ;
+
+            IF GetType(op1)=NulSym
+            THEN
+               resType := GetM2ZType()
+            ELSE
+               resType := Mod2Gcc(GetType(op1))
+            END ;
+
+            tl := BuildConvert(location, resType, tl, FALSE) ;
+            tr := BuildConvert(location, resType, tr, FALSE) ;
+
+            tv := binop(location, tl, tr, TRUE) ;
+            CheckOrResetOverflow(tokenno, tv, MustCheckOverflow(quad)) ;
+
+            AddModGcc(op1, DeclareKnownConstant(location, resType, tv)) ;
+
+            p(op1) ;
+            NoChange := FALSE ;
+            SubQuad(quad)
+         ELSE
+            (* we can still fold the expression, but not the assignment,
+               however, we will not do this here but in CodeBinary
+             *)
+         END
+      END
+   END
+END FoldBinary ;
+
+
+(*
+   ConvertBinaryOperands -
+*)
+
+PROCEDURE ConvertBinaryOperands (location: location_t; VAR tl, tr: Tree; type, op2, op3: CARDINAL) ;
+BEGIN
+   tl := NIL ;
+   tr := NIL ;
+   IF GetMode(op2)=LeftValue
+   THEN
+      tl := LValueToGenericPtr(location, op2) ;
+      type := Address
+   END ;
+   IF GetMode(op3)=LeftValue
+   THEN
+      tr := LValueToGenericPtr(location, op3) ;
+      type := Address
+   END ;
+   IF (tl=NIL) AND (tr=NIL)
+   THEN
+      tl := BuildConvert(location, Mod2Gcc(type), Mod2Gcc(op2), FALSE) ;
+      tr := BuildConvert(location, Mod2Gcc(type), Mod2Gcc(op3), FALSE)
+   ELSIF tl=NIL
+   THEN
+      tl := BuildConvert(location, Mod2Gcc(type), Mod2Gcc(op2), FALSE)
+   ELSIF tr=NIL
+   THEN
+      tr := BuildConvert(location, Mod2Gcc(type), Mod2Gcc(op3), FALSE)
+   END
+END ConvertBinaryOperands ;
+
+
+(*
+   CodeBinaryCheck - encode a binary arithmetic operation.
+*)
+
+PROCEDURE CodeBinaryCheck (binop: BuildBinCheckProcedure; quad: CARDINAL) ;
+VAR
+   op        : QuadOperator ;
+   op1, op2,
+   op3       : CARDINAL ;
+   op1pos,
+   op2pos,
+   op3pos,
+   lowestType,
+   type      : CARDINAL ;
+   min, max,
+   lowest,
+   tv,
+   tl, tr    : Tree ;
+   location  : location_t ;
+BEGIN
+   (* firstly ensure that constant literals are declared.  *)
+   GetQuadtok (quad, op, op1, op2, op3, op1pos, op2pos, op3pos) ;
+   DeclareConstant (op3pos, op3) ;
+   DeclareConstant (op2pos, op2) ;
+   location := TokenToLocation (op1pos) ;
+
+   type := MixTypes (FindType (op2), FindType (op3), op3pos) ;
+   ConvertBinaryOperands (location, tl, tr, type, op2, op3) ;
+
+   lowestType := GetLType (op1) ;
+   lowest := Mod2Gcc (lowestType) ;
+   IF GetMinMax (CurrentQuadToken, lowestType, min, max)
+   THEN
+      tv := binop (location, tl, tr, lowest, min, max)
+   ELSE
+      tv := binop (location, tl, tr, NIL, NIL, NIL)
+   END ;
+   CheckOrResetOverflow (op1pos, tv, MustCheckOverflow (quad)) ;
+   IF IsConst (op1)
+   THEN
+      (* still have a constant which was not resolved, pass it to gcc.  *)
+      Assert (MixTypes (FindType (op3), FindType (op2), op3pos) # NulSym) ;
+
+      PutConst (op1, MixTypes (FindType (op3), FindType (op2), op3pos)) ;
+      ConstantKnownAndUsed (op1, DeclareKnownConstant (location, Mod2Gcc (GetType (op3)), tv))
+   ELSE
+      IF EnableSSA AND IsVariableSSA (op1)
+      THEN
+         Replace (op1, tv)
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (op1), tv)
+      END
+   END
+END CodeBinaryCheck ;
+
+
+(*
+   CodeBinary - encode a binary arithmetic operation.
+*)
+
+PROCEDURE CodeBinary (binop: BuildBinProcedure; quad: CARDINAL) ;
+VAR
+   op      : QuadOperator ;
+   op1, op2,
+   op3     : CARDINAL ;
+   op1pos,
+   op2pos,
+   op3pos,
+   type    : CARDINAL ;
+   tv,
+   tl, tr  : Tree ;
+   location: location_t ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   GetQuadtok (quad, op, op1, op2, op3, op1pos, op2pos, op3pos) ;
+   DeclareConstant (op3pos, op3) ;
+   DeclareConstant (op2pos, op2) ;
+   location := TokenToLocation (op1pos) ;
+
+   type := MixTypes (FindType (op2), FindType (op3), op1pos) ;
+   ConvertBinaryOperands (location, tl, tr, type, op2, op3) ;
+
+   tv := binop (location, tl, tr, FALSE) ;
+   CheckOrResetOverflow (op1pos, tv, MustCheckOverflow(quad)) ;
+   IF IsConst (op1)
+   THEN
+      (* still have a constant which was not resolved, pass it to gcc *)
+      Assert(MixTypes(FindType(op3), FindType(op2), op1pos)#NulSym) ;
+
+      PutConst (op1, MixTypes (FindType (op3), FindType (op2), op1pos)) ;
+      ConstantKnownAndUsed (op1, DeclareKnownConstant (location, Mod2Gcc(GetType(op3)), tv))
+   ELSE
+      IF EnableSSA AND IsVariableSSA (op1)
+      THEN
+         Replace (op1, tv)
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (op1), tv)
+      END
+   END
+END CodeBinary ;
+
+
+(*
+   CodeBinarySet - encode a binary set arithmetic operation.
+                   Set operands may be longer than a word.
+*)
+
+PROCEDURE CodeBinarySet (binop: BuildBinProcedure; doOp: DoProcedure;
+                         quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   DeclareConstant(CurrentQuadToken, op3) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op3) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst(op1)
+   THEN
+      IF IsValueSolved(op2) AND IsValueSolved(op3)
+      THEN
+         Assert(MixTypes(FindType(op3), FindType(op2), CurrentQuadToken)#NulSym) ;
+         PutConst(op1, FindType(op3)) ;
+         PushValue(op2) ;
+         PushValue(op3) ;
+         doOp(CurrentQuadToken) ;
+         PopValue(op1) ;
+         PutConstSet(op1) ;
+      ELSE
+         MetaErrorT0 (CurrentQuadToken,
+                      '{%E}constant expression cannot be evaluated')
+      END
+   ELSE
+      checkDeclare (op1) ;
+      BuildBinaryForeachWordDo(location,
+                               Mod2Gcc(SkipType(GetType(op1))),
+                               Mod2Gcc(op1), Mod2Gcc(op2), Mod2Gcc(op3), binop,
+                               GetMode(op1)=LeftValue,
+                               GetMode(op2)=LeftValue,
+                               GetMode(op3)=LeftValue,
+                               IsConst(op1),
+                               IsConst(op2),
+                               IsConst(op3))
+   END
+END CodeBinarySet ;
+
+
+(*
+   CheckUnaryOperand - checks to see whether operand is using a generic type.
+*)
+
+PROCEDURE CheckUnaryOperand (quad: CARDINAL; operand: CARDINAL) : BOOLEAN ;
+VAR
+   type  : CARDINAL ;
+   s, op : String ;
+BEGIN
+   type := SkipType (GetType (operand)) ;
+   IF (Word=type) OR IsWordN (type) OR (Byte=type) OR (Loc=type)
+   THEN
+      op := GetM2OperatorDesc (GetQuadOp (quad)) ;
+      s := InitString ('operand of type {%1Ets} is not allowed in an unary expression') ;
+      IF op # NIL
+      THEN
+         s := ConCatChar (s, ' ') ;
+         s := ConCat (s, Mark (op))
+      END ;
+      MetaErrorStringT1 (CurrentQuadToken, s, operand) ;
+      RETURN FALSE
+   END ;
+   RETURN TRUE
+END CheckUnaryOperand ;
+
+
+(*
+   UnaryOperand - returns TRUE if operand is acceptable for
+                  unary operator: + -.  If FALSE
+                  is returned, an error message will be generated
+                  and the quad is deleted.
+*)
+
+PROCEDURE UnaryOperand (quad: CARDINAL; operand: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF NOT CheckUnaryOperand (quad, operand)
+   THEN
+      SubQuad (quad) ;  (* We do not want multiple copies of the same error.  *)
+      RETURN FALSE
+   END ;
+   RETURN TRUE
+END UnaryOperand ;
+
+
+(*
+   CheckBinaryOperand - checks to see whether operand is using a generic type.
+*)
+
+PROCEDURE CheckBinaryOperand (quad: CARDINAL; isleft: BOOLEAN;
+                              operand: CARDINAL; result: BOOLEAN) : BOOLEAN ;
+VAR
+   type  : CARDINAL ;
+   qop   : QuadOperator ;
+   op1,
+   op2,
+   op3,
+   op1pos,
+   op2pos,
+   op3pos: CARDINAL ;
+   s, op : String ;
+BEGIN
+   type := SkipType (GetType (operand)) ;
+   IF (Word=type) OR IsWordN (type) OR (Byte=type) OR (Loc=type)
+   THEN
+      GetQuadtok (quad, qop, op1, op2, op3,
+                  op1pos, op2pos, op3pos) ;
+         op := GetM2OperatorDesc (GetQuadOp (quad)) ;
+      IF isleft
+      THEN
+         s := InitString ('left operand {%1Ea} of type {%1Ets} is not allowed in binary expression')
+      ELSE
+         s := InitString ('right operand {%1Ea} of type {%1Ets} is not allowed in binary expression')
+      END ;
+      IF op # NIL
+      THEN
+         s := ConCatChar (s, ' ') ;
+         s := ConCat (s, Mark (op))
+      END ;
+      MetaErrorStringT1 (op1pos, s, operand) ;
+      RETURN FALSE
+   END ;
+   RETURN result
+END CheckBinaryOperand ;
+
+
+(*
+   BinaryOperands - returns TRUE if, l, and, r, are acceptable for
+                    binary operator: + - / * and friends.  If FALSE
+                    is returned, an error message will be generated
+                    and the, quad, is deleted.
+*)
+
+PROCEDURE BinaryOperands (quad: CARDINAL; l, r: CARDINAL) : BOOLEAN ;
+VAR
+   result: BOOLEAN ;
+BEGIN
+   result := CheckBinaryOperand (quad, TRUE, l, TRUE) ;
+   result := CheckBinaryOperand (quad, FALSE, r, result) ;
+   IF NOT result
+   THEN
+      SubQuad (quad)   (* We do not want multiple copies of the same error.  *)
+   END ;
+   RETURN result
+END BinaryOperands ;
+
+
+(*
+   FoldAdd - check addition for constant folding.
+*)
+
+PROCEDURE FoldAdd (tokenno: CARDINAL; p: WalkAction;
+                   quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   IF IsConst(op2) AND IsConst(op3) AND IsConst(op3) AND
+      IsConstString(op2) AND IsConstString(op3)
+   THEN
+      (* handle special addition for constant strings *)
+      s := InitStringCharStar(KeyToCharStar(GetString(op2))) ;
+      s := ConCat(s, Mark(InitStringCharStar(KeyToCharStar(GetString(op3))))) ;
+      PutConstString(tokenno, op1, makekey(string(s))) ;
+      TryDeclareConstant(tokenno, op1) ;
+      p(op1) ;
+      NoChange := FALSE ;
+      SubQuad(quad) ;
+      s := KillString(s)
+   ELSE
+      IF BinaryOperands (quad, op2, op3)
+      THEN
+         FoldBinary (tokenno, p, BuildAdd, quad, op1, op2, op3)
+      END
+   END
+END FoldAdd ;
+
+
+(*
+   CodeAddChecked - code an addition instruction, determine whether checking
+                    is required.
+*)
+
+PROCEDURE CodeAddChecked (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF MustCheckOverflow (quad)
+   THEN
+      CodeAddCheck (quad, left, right)
+   ELSE
+      CodeAdd (quad, left, right)
+   END
+END CodeAddChecked ;
+
+
+(*
+   CodeAddCheck - encode addition but check for overflow.
+*)
+
+PROCEDURE CodeAddCheck (quad, left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinaryCheck (BuildAddCheck, quad)
+   END
+END CodeAddCheck ;
+
+
+(*
+   CodeAdd - encode addition.
+*)
+
+PROCEDURE CodeAdd (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinary (BuildAdd, quad)
+   END
+END CodeAdd ;
+
+
+(*
+   FoldSub - check subtraction for constant folding.
+*)
+
+PROCEDURE FoldSub (tokenno: CARDINAL; p: WalkAction;
+                   quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      FoldBinary(tokenno, p, BuildSub, quad, op1, op2, op3)
+   END
+END FoldSub ;
+
+
+(*
+   CodeSubChecked - code a subtract instruction, determine whether checking
+                    is required.
+*)
+
+PROCEDURE CodeSubChecked (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF MustCheckOverflow (quad)
+   THEN
+      CodeSubCheck (quad, left, right)
+   ELSE
+      CodeSub (quad, left, right)
+   END
+END CodeSubChecked ;
+
+
+(*
+   CodeSubCheck - encode subtraction but check for overflow.
+*)
+
+PROCEDURE CodeSubCheck (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinaryCheck (BuildSubCheck, quad)
+   END
+END CodeSubCheck ;
+
+
+(*
+   CodeSub - encode subtraction.
+*)
+
+PROCEDURE CodeSub (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinary (BuildSub, quad)
+   END
+END CodeSub ;
+
+
+(*
+   FoldMult - check multiplication for constant folding.
+*)
+
+PROCEDURE FoldMult (tokenno: CARDINAL; p: WalkAction;
+                    quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      FoldBinary(tokenno, p, BuildMult, quad, op1, op2, op3)
+   END
+END FoldMult ;
+
+
+(*
+   CodeMultChecked - code a multiplication instruction, determine whether checking
+                     is required.
+*)
+
+PROCEDURE CodeMultChecked (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF MustCheckOverflow (quad)
+   THEN
+      CodeMultCheck (quad, left, right)
+   ELSE
+      CodeMult (quad, left, right)
+   END
+END CodeMultChecked ;
+
+
+(*
+   CodeMultCheck - encode multiplication but check for overflow.
+*)
+
+PROCEDURE CodeMultCheck (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinaryCheck (BuildMultCheck, quad)
+   END
+END CodeMultCheck ;
+
+
+(*
+   CodeMult - encode multiplication.
+*)
+
+PROCEDURE CodeMult (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinary (BuildMult, quad)
+   END
+END CodeMult ;
+
+
+(*
+   CodeDivM2Checked - code a divide instruction, determine whether checking
+                      is required.
+*)
+
+PROCEDURE CodeDivM2Checked (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF MustCheckOverflow (quad)
+   THEN
+      CodeDivM2Check (quad, left, right)
+   ELSE
+      CodeDivM2 (quad, left, right)
+   END
+END CodeDivM2Checked ;
+
+
+(*
+   CodeDivM2Check - encode addition but check for overflow.
+*)
+
+PROCEDURE CodeDivM2Check (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinaryCheck (BuildDivM2Check, quad)
+   END
+END CodeDivM2Check ;
+
+
+(*
+   CodeModM2Checked - code a modulus instruction, determine whether checking
+                      is required.
+*)
+
+PROCEDURE CodeModM2Checked (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF MustCheckOverflow (quad)
+   THEN
+      CodeModM2Check (quad, left, right)
+   ELSE
+      CodeModM2 (quad, left, right)
+   END
+END CodeModM2Checked ;
+
+
+(*
+   CodeModM2Check - encode addition but check for overflow.
+*)
+
+PROCEDURE CodeModM2Check (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinaryCheck (BuildModM2Check, quad)
+   END
+END CodeModM2Check ;
+
+
+(*
+   BinaryOperandRealFamily -
+*)
+
+PROCEDURE BinaryOperandRealFamily (op: CARDINAL) : BOOLEAN ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := SkipType(GetType(op)) ;
+   RETURN( IsComplexType(t) OR IsComplexN(t) OR
+           IsRealType(t) OR IsRealN(t) )
+END BinaryOperandRealFamily ;
+
+
+(*
+   FoldDivM2 - check division for constant folding.
+*)
+
+PROCEDURE FoldDivM2 (tokenno: CARDINAL; p: WalkAction;
+                     quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
+      THEN
+         FoldBinary(tokenno, p, BuildRDiv, quad, op1, op2, op3)
+      ELSE
+         FoldBinary(tokenno, p, BuildDivM2, quad, op1, op2, op3)
+      END
+   END
+END FoldDivM2 ;
+
+
+(*
+   CodeDivM2 - encode division.
+*)
+
+PROCEDURE CodeDivM2 (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
+      THEN
+         CodeBinary (BuildRDiv, quad)
+      ELSE
+         CodeBinary (BuildDivM2, quad)
+      END
+   END
+END CodeDivM2 ;
+
+
+(*
+   FoldModM2 - check modulus for constant folding.
+*)
+
+PROCEDURE FoldModM2 (tokenno: CARDINAL; p: WalkAction;
+                     quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      FoldBinary(tokenno, p, BuildModM2, quad, op1, op2, op3)
+   END
+END FoldModM2 ;
+
+
+(*
+   CodeModM2 - encode modulus.
+*)
+
+PROCEDURE CodeModM2 (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinary (BuildModM2, quad)
+   END
+END CodeModM2 ;
+
+
+(*
+   FoldDivTrunc - check division for constant folding.
+*)
+
+PROCEDURE FoldDivTrunc (tokenno: CARDINAL; p: WalkAction;
+                        quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
+      THEN
+         FoldBinary(tokenno, p, BuildRDiv, quad, op1, op2, op3)
+      ELSE
+         FoldBinary(tokenno, p, BuildDivTrunc, quad, op1, op2, op3)
+      END
+   END
+END FoldDivTrunc ;
+
+
+(*
+   CodeDivTrunc - encode multiplication.
+*)
+
+PROCEDURE CodeDivTrunc (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
+      THEN
+         CodeBinary (BuildRDiv, quad)
+      ELSE
+         CodeBinary (BuildDivTrunc, quad)
+      END
+   END
+END CodeDivTrunc ;
+
+
+(*
+   FoldModTrunc - check modulus for constant folding.
+*)
+
+PROCEDURE FoldModTrunc (tokenno: CARDINAL; p: WalkAction;
+                        quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      FoldBinary(tokenno, p, BuildModTrunc, quad, op1, op2, op3)
+   END
+END FoldModTrunc ;
+
+
+(*
+   CodeModTrunc - encode modulus.
+*)
+
+PROCEDURE CodeModTrunc (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinary (BuildModTrunc, quad)
+   END
+END CodeModTrunc ;
+
+
+(*
+   FoldDivCeil - check division for constant folding.
+*)
+
+PROCEDURE FoldDivCeil (tokenno: CARDINAL; p: WalkAction;
+                       quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
+      THEN
+         FoldBinary(tokenno, p, BuildRDiv, quad, op1, op2, op3)
+      ELSE
+         FoldBinary(tokenno, p, BuildDivCeil, quad, op1, op2, op3)
+      END
+   END
+END FoldDivCeil ;
+
+
+(*
+   CodeDivCeil - encode multiplication.
+*)
+
+PROCEDURE CodeDivCeil (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
+      THEN
+         CodeBinary (BuildRDiv, quad)
+      ELSE
+         CodeBinary (BuildDivCeil, quad)
+      END
+   END
+END CodeDivCeil ;
+
+
+(*
+   FoldModCeil - check modulus for constant folding.
+*)
+
+PROCEDURE FoldModCeil (tokenno: CARDINAL; p: WalkAction;
+                       quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      FoldBinary(tokenno, p, BuildModCeil, quad, op1, op2, op3)
+   END
+END FoldModCeil ;
+
+
+(*
+   CodeModCeil - encode multiplication.
+*)
+
+PROCEDURE CodeModCeil (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinary (BuildModCeil, quad)
+   END
+END CodeModCeil ;
+
+
+(*
+   FoldDivFloor - check division for constant folding.
+*)
+
+PROCEDURE FoldDivFloor (tokenno: CARDINAL; p: WalkAction;
+                        quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      IF BinaryOperandRealFamily(op2) OR BinaryOperandRealFamily(op3)
+      THEN
+         FoldBinary(tokenno, p, BuildRDiv, quad, op1, op2, op3)
+      ELSE
+         FoldBinary(tokenno, p, BuildDivFloor, quad, op1, op2, op3)
+      END
+   END
+END FoldDivFloor ;
+
+
+(*
+   CodeDivFloor - encode multiplication.
+*)
+
+PROCEDURE CodeDivFloor (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      IF BinaryOperandRealFamily (left) OR BinaryOperandRealFamily (right)
+      THEN
+         CodeBinary (BuildRDiv, quad)
+      ELSE
+         CodeBinary (BuildDivFloor, quad)
+      END
+   END
+END CodeDivFloor ;
+
+
+(*
+   FoldModFloor - check modulus for constant folding.
+*)
+
+PROCEDURE FoldModFloor (tokenno: CARDINAL; p: WalkAction;
+                        quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, op2, op3)
+   THEN
+      FoldBinary(tokenno, p, BuildModFloor, quad, op1, op2, op3)
+   END
+END FoldModFloor ;
+
+
+(*
+   CodeModFloor - encode modulus.
+*)
+
+PROCEDURE CodeModFloor (quad: CARDINAL; left, right: CARDINAL) ;
+BEGIN
+   IF BinaryOperands (quad, left, right)
+   THEN
+      CodeBinary (BuildModFloor, quad)
+   END
+END CodeModFloor ;
+
+
+(*
+   FoldBuiltinConst -
+*)
+
+PROCEDURE FoldBuiltinConst (tokenno: CARDINAL; p: WalkAction;
+                            quad: CARDINAL; result, constDesc: CARDINAL) ;
+VAR
+   value: Tree ;
+BEGIN
+   value := GetBuiltinConst (KeyToCharStar (Name (constDesc))) ;
+   IF value = NIL
+   THEN
+      MetaErrorT1 (tokenno, 'unknown built in constant {%1Ead}', constDesc)
+   ELSE
+      AddModGcc (result, value) ;
+      p (result) ;
+      NoChange := FALSE ;
+      SubQuad (quad)
+   END
+END FoldBuiltinConst ;
+
+
+(*
+   FoldBuiltinTypeInfo - attempts to fold a builtin attribute value on type op2.
+*)
+
+PROCEDURE FoldBuiltinTypeInfo (tokenno: CARDINAL; p: WalkAction;
+                               quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   t       : Tree ;
+   location: location_t ;
+BEGIN
+   IF GccKnowsAbout(op2) AND CompletelyResolved(op2)
+   THEN
+      location := TokenToLocation(tokenno) ;
+      t := GetBuiltinTypeInfo(location, Mod2Gcc(op2), KeyToCharStar(Name(op3))) ;
+      IF t=NIL
+      THEN
+         MetaErrorT2 (tokenno, 'unknown built in constant {%1Ead} attribute for type {%2ad}', op3, op2)
+      ELSE
+         AddModGcc(op1, t) ;
+         p(op1) ;
+         NoChange := FALSE ;
+         SubQuad(quad)
+      END
+   END
+END FoldBuiltinTypeInfo ;
+
+
+(*
+   FoldStandardFunction - attempts to fold a standard function.
+*)
+
+PROCEDURE FoldStandardFunction (tokenno: CARDINAL; p: WalkAction;
+                                quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   s       : String ;
+   type,
+   d,
+   result  : CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   IF GetSymName(op2)=MakeKey('Length')
+   THEN
+      TryDeclareConstant(tokenno, op3) ;
+      IF IsConst(op3) AND GccKnowsAbout(op3)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst(op1)
+         THEN
+            IF IsConstString(op3)
+            THEN
+               AddModGcc(op1, FindSize(tokenno, op3)) ;
+               p(op1) ;
+               NoChange := FALSE ;
+               SubQuad(quad)
+            ELSE
+               MetaErrorT1 (tokenno, 'parameter to LENGTH must be a string {%1Ead}', op3)
+            END
+         ELSE
+            (* rewrite the quad to use becomes.  *)
+            d := GetStringLength (op3) ;
+            s := Sprintf1 (Mark (InitString ("%d")), d) ;
+            result := MakeConstLit (tokenno, makekey (string (s)), Cardinal) ;
+            s := KillString (s) ;
+            TryDeclareConstant (tokenno, result) ;
+            PutQuad (quad, BecomesOp, op1, NulSym, result)
+         END
+      END
+   ELSIF GetSymName(op2)=MakeKey('CAP')
+   THEN
+      TryDeclareConstant(tokenno, op3) ;
+      IF IsConst(op3) AND GccKnowsAbout(op3)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst(op1)
+         THEN
+            IF (IsConstString(op3) AND (GetStringLength(op3)=1)) OR
+               (GetType(op3)=Char)
+            THEN
+               AddModGcc(op1, BuildCap(location, Mod2Gcc(op3))) ;
+               p(op1) ;
+               NoChange := FALSE ;
+               SubQuad(quad)
+            ELSE
+               MetaErrorT1 (tokenno, 'parameter to CAP must be a single character {%1Ead}', op3)
+            END
+         END
+      END
+   ELSIF GetSymName(op2)=MakeKey('ABS')
+   THEN
+      TryDeclareConstant(tokenno, op3) ;
+      IF IsConst(op3) AND GccKnowsAbout(op3)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst(op1)
+         THEN
+            AddModGcc(op1, BuildAbs(location, Mod2Gcc(op3))) ;
+            p(op1) ;
+            NoChange := FALSE ;
+            SubQuad(quad)
+         END
+      END
+   ELSIF op2=Im
+   THEN
+      TryDeclareConstant(tokenno, op3) ;
+      IF IsConst(op3) AND GccKnowsAbout(op3)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst(op1)
+         THEN
+            AddModGcc(op1, BuildIm(Mod2Gcc(op3))) ;
+            p(op1) ;
+            NoChange := FALSE ;
+            SubQuad(quad)
+         END
+      END
+   ELSIF op2=Re
+   THEN
+      TryDeclareConstant(tokenno, op3) ;
+      IF IsConst(op3) AND GccKnowsAbout(op3)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst(op1)
+         THEN
+            AddModGcc(op1, BuildRe(Mod2Gcc(op3))) ;
+            p(op1) ;
+            NoChange := FALSE ;
+            SubQuad(quad)
+         END
+      END
+   ELSIF op2=Cmplx
+   THEN
+      TryDeclareConstant(tokenno, GetNth(op3, 1)) ;
+      TryDeclareConstant(tokenno, GetNth(op3, 2)) ;
+      IF IsConst(GetNth(op3, 1)) AND GccKnowsAbout(GetNth(op3, 1)) AND
+         IsConst(GetNth(op3, 2)) AND GccKnowsAbout(GetNth(op3, 2))
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst(op1)
+         THEN
+            type := GetCmplxReturnType(GetType(GetNth(op3, 1)), GetType(GetNth(op3, 2))) ;
+            IF type=NulSym
+            THEN
+               MetaErrorT2 (tokenno, 'real {%1Eatd} and imaginary {%2atd} types are incompatible',
+                            GetNth(op3, 1), GetNth(op3, 2))
+            ELSE
+               AddModGcc(op1, BuildCmplx(location,
+                                         Mod2Gcc(type),
+                                         Mod2Gcc(GetNth(op3, 1)),
+                                         Mod2Gcc(GetNth(op3, 2)))) ;
+               p(op1) ;
+               NoChange := FALSE ;
+               SubQuad(quad)
+            END
+         END
+      END
+   ELSIF op2=TBitSize
+   THEN
+      IF GccKnowsAbout(op3)
+      THEN
+         AddModGcc(op1, BuildTBitSize(location, Mod2Gcc(op3))) ;
+         p(op1) ;
+         NoChange := FALSE ;
+         SubQuad(quad)
+      END
+   ELSE
+      InternalError ('only expecting LENGTH, CAP, ABS, IM, RE')
+   END
+END FoldStandardFunction ;
+
+
+(*
+   CodeStandardFunction -
+*)
+
+PROCEDURE CodeStandardFunction (quad: CARDINAL; result, function, param: CARDINAL) ;
+VAR
+   type    : CARDINAL ;
+   location: location_t ;
+BEGIN
+   DeclareConstant (CurrentQuadToken, param) ;
+   DeclareConstructor (CurrentQuadToken, quad, param) ;
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   IF (function # NulSym) AND (GetSymName (function) = MakeKey ('Length'))
+   THEN
+      IF IsConst (result)
+      THEN
+         InternalError ('LENGTH function should already have been folded')
+      END
+   ELSIF (function # NulSym) AND (GetSymName (function) = MakeKey ('CAP'))
+   THEN
+      IF IsConst (result)
+      THEN
+         InternalError ('CAP function should already have been folded')
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (result), BuildCap (location, Mod2Gcc (param)))
+      END
+   ELSIF (function # NulSym) AND (GetSymName (function) = MakeKey('ABS'))
+   THEN
+      IF IsConst (result)
+      THEN
+         InternalError ('ABS function should already have been folded')
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (result), BuildAbs (location, Mod2Gcc (param)))
+      END
+   ELSIF function = Im
+   THEN
+      IF IsConst (result)
+      THEN
+         InternalError ('IM function should already have been folded')
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (result), BuildIm (Mod2Gcc (param)))
+      END
+   ELSIF function = Re
+   THEN
+      IF IsConst (result)
+      THEN
+         InternalError ('RE function should already have been folded')
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (result), BuildRe (Mod2Gcc (param)))
+      END
+   ELSIF function = Cmplx
+   THEN
+      IF IsConst (result)
+      THEN
+         InternalError ('CMPLX function should already have been folded')
+      ELSE
+         type := GetCmplxReturnType (GetType (GetNth (param, 1)), GetType (GetNth (param, 2))) ;
+         IF type = NulSym
+         THEN
+            MetaErrorT2 (CurrentQuadToken,
+                         'real {%1Eatd} and imaginary {%2atd} types are incompatible',
+                         GetNth (param, 1), GetNth (param, 2))
+         ELSE
+            BuildAssignmentStatement (location, Mod2Gcc (result), BuildCmplx(location,
+                                                                             Mod2Gcc (type),
+                                                                             Mod2Gcc (GetNth (param, 1)),
+                                                                             Mod2Gcc (GetNth (param, 2))))
+         END
+      END
+   ELSIF function = TBitSize
+   THEN
+      IF IsConst (result)
+      THEN
+         InternalError ('TBITSIZE function should already have been folded')
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (result), BuildTBitSize (location, Mod2Gcc (param)))
+      END
+   ELSE
+      InternalError ('expecting LENGTH, CAP, ABS, IM')
+   END
+END CodeStandardFunction ;
+
+
+(*
+   CodeSavePriority - checks to see whether op2 is reachable and is directly accessible
+                      externally. If so then it saves the current interrupt priority
+                      in op1 and sets the current priority to that determined by
+                      appropriate module.
+
+                      op1 := op3(GetModuleScope(op2))
+*)
+
+PROCEDURE CodeSavePriority (oldValue, scopeSym, procedureSym: CARDINAL) ;
+VAR
+   funcTree: Tree ;
+   mod     : CARDINAL ;
+   n       : Name ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsModule (scopeSym) OR IsDefImp (scopeSym) OR
+      (IsProcedure (scopeSym) AND GetNeedSavePriority (scopeSym))
+   THEN
+      IF IsProcedure (scopeSym)
+      THEN
+         mod := GetModuleScope (scopeSym) ;
+      ELSE
+         Assert (IsModule(scopeSym) OR IsDefImp (scopeSym)) ;
+         mod := scopeSym
+      END ;
+      IF GetPriority (mod) # NulSym
+      THEN
+         IF PriorityDebugging
+         THEN
+            n := GetSymName (scopeSym) ;
+            printf1 ('procedure <%a> needs to save interrupts\n', n)
+         END ;
+         DeclareConstant (CurrentQuadToken, GetPriority (mod)) ;
+         BuildParam (location, Mod2Gcc (GetPriority (mod))) ;
+         funcTree := BuildProcedureCallTree (location, Mod2Gcc (procedureSym), Mod2Gcc (GetType (procedureSym))) ;
+         funcTree := BuildFunctValue (location, Mod2Gcc (oldValue)) ;
+         AddStatement (location, funcTree)
+      END
+   END
+END CodeSavePriority ;
+
+
+(*
+   CodeRestorePriority - checks to see whether op2 is reachable and is directly accessible
+                         externally. If so then it restores the previous interrupt priority
+                         held in op1.
+
+                         op1 := op3(op1)
+*)
+
+PROCEDURE CodeRestorePriority (oldValue, scopeSym, procedureSym: CARDINAL) ;
+VAR
+   funcTree: Tree ;
+   mod     : CARDINAL ;
+   n       : Name ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   IF IsModule (scopeSym) OR IsDefImp (scopeSym) OR
+      (IsProcedure (scopeSym) AND GetNeedSavePriority (scopeSym))
+   THEN
+      IF IsProcedure (scopeSym)
+      THEN
+         mod := GetModuleScope (scopeSym) ;
+      ELSE
+         Assert (IsModule (scopeSym) OR IsDefImp (scopeSym)) ;
+         mod := scopeSym
+      END ;
+      IF GetPriority (mod) # NulSym
+      THEN
+         IF PriorityDebugging
+         THEN
+            n := GetSymName (scopeSym) ;
+            printf1 ('procedure <%a> needs to restore interrupts\n', n)
+         END ;
+         BuildParam (location, Mod2Gcc (oldValue)) ;
+         funcTree := BuildProcedureCallTree (location, Mod2Gcc (procedureSym), Mod2Gcc (GetType (procedureSym))) ;
+         funcTree := BuildFunctValue (location, Mod2Gcc (oldValue)) ;
+         AddStatement(location, funcTree)
+      END
+   END
+END CodeRestorePriority ;
+
+
+(*
+   FoldBinarySet - attempts to fold set arithmetic it removes the quad if successful.
+*)
+
+PROCEDURE FoldBinarySet (tokenno: CARDINAL; p: WalkAction; op: DoProcedure;
+                         quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   (* firstly try and ensure that constants are declared *)
+   TryDeclareConstant(tokenno, op2) ;
+   TryDeclareConstant(tokenno, op3) ;
+   location := TokenToLocation(tokenno) ;
+
+   IF IsConst(op2) AND IsConstSet(op2) AND
+      IsConst(op3) AND IsConstSet(op3) AND
+      IsConst(op1)
+   THEN
+      IF IsValueSolved(op2) AND IsValueSolved(op3)
+      THEN
+         Assert(MixTypes(FindType(op3), FindType(op2), tokenno)#NulSym) ;
+         PutConst(op1, MixTypes(FindType(op3), FindType(op2), tokenno)) ;
+         PushValue(op2) ;
+         PushValue(op3) ;
+         op(tokenno) ;
+         PopValue(op1) ;
+         PushValue(op1) ;
+         PutConstSet(op1) ;
+         AddModGcc(op1,
+                   DeclareKnownConstant(location,
+                                        Mod2Gcc(GetType(op3)),
+                                        PopSetTree(tokenno))) ;
+         p(op1) ;
+         NoChange := FALSE ;
+         SubQuad(quad)
+      END
+   END
+END FoldBinarySet ;
+
+
+(*
+   FoldSetOr - check whether we can fold a set arithmetic or.
+*)
+
+PROCEDURE FoldSetOr (tokenno: CARDINAL; p: WalkAction;
+                     quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   FoldBinarySet (tokenno, p, SetOr, quad, op1, op2, op3)
+END FoldSetOr ;
+
+
+(*
+   CodeSetOr - encode set arithmetic or.
+*)
+
+PROCEDURE CodeSetOr (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   CodeBinarySet (BuildLogicalOr, SetOr, quad, op1, op2, op3)
+END CodeSetOr ;
+
+
+(*
+   FoldSetAnd - check whether we can fold a logical and.
+*)
+
+PROCEDURE FoldSetAnd (tokenno: CARDINAL; p: WalkAction;
+                      quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   FoldBinarySet(tokenno, p, SetAnd, quad, op1, op2, op3)
+END FoldSetAnd ;
+
+
+(*
+   CodeSetAnd - encode set arithmetic and.
+*)
+
+PROCEDURE CodeSetAnd (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   CodeBinarySet (BuildLogicalAnd, SetAnd, quad, op1, op2, op3)
+END CodeSetAnd ;
+
+
+(*
+   CodeBinarySetShift - encode a binary set arithmetic operation.
+                        The set maybe larger than a machine word
+                        and the value of one word may effect the
+                        values of another - ie shift and rotate.
+                        Set sizes of a word or less are evaluated
+                        with binop, whereas multiword sets are
+                        evaluated by M2RTS.
+*)
+
+PROCEDURE CodeBinarySetShift (binop: BuildSetProcedure;
+                              doOp : DoProcedure;
+                              var, left, right: Name;
+                              quad: CARDINAL;
+                              op1, op2, op3: CARDINAL) ;
+VAR
+   nBits,
+   unbounded,
+   leftproc,
+   rightproc,
+   varproc  : Tree ;
+   location : location_t ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   DeclareConstant(CurrentQuadToken, op3) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op3) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst(op1)
+   THEN
+      IF IsValueSolved(op2) AND IsValueSolved(op3)
+      THEN
+         Assert(MixTypes(FindType(op3),
+                         FindType(op2), CurrentQuadToken)#NulSym) ;
+         PutConst(op1, FindType(op3)) ;
+         PushValue(op2) ;
+         PushValue(op3) ;
+         doOp(CurrentQuadToken) ;
+         PopValue(op1) ;
+         PutConstSet(op1)
+      ELSE
+         MetaErrorT0 (CurrentQuadToken, '{%E}constant expression cannot be evaluated')
+      END
+   ELSE
+      varproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, var, System)) ;
+      leftproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, left, System)) ;
+      rightproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, right, System)) ;
+      unbounded := Mod2Gcc(GetType(GetNthParam(FromModuleGetSym(CurrentQuadToken,
+                                                                var, System), 1))) ;
+      PushValue(GetTypeMax(SkipType(GetType(op1)))) ;
+      PushIntegerTree(BuildConvert(location, GetM2ZType(), PopIntegerTree(), FALSE)) ;
+
+      PushValue(GetTypeMin(SkipType(GetType(op1)))) ;
+      PushIntegerTree(BuildConvert(location, GetM2ZType(), PopIntegerTree(), FALSE)) ;
+      Sub ;
+      PushCard(1) ;
+      PushIntegerTree(BuildConvert(location, GetM2ZType(), PopIntegerTree(), FALSE)) ;
+      Addn ;
+      nBits := PopIntegerTree() ;
+      BuildBinarySetDo(location,
+                       Mod2Gcc(SkipType(GetType(op1))),
+                       Mod2Gcc(op1),
+                       Mod2Gcc(op2),
+                       Mod2Gcc(op3),
+                       binop,
+                       GetMode(op1)=LeftValue,
+                       GetMode(op2)=LeftValue,
+                       GetMode(op3)=LeftValue,
+                       nBits,
+                       unbounded,
+                       varproc, leftproc, rightproc)
+   END
+END CodeBinarySetShift ;
+
+
+(*
+   FoldSetShift - check whether we can fold a logical shift.
+*)
+
+PROCEDURE FoldSetShift (tokenno: CARDINAL; p: WalkAction;
+                        quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   FoldBinarySet(tokenno, p, SetShift, quad, op1, op2, op3)
+END FoldSetShift ;
+
+
+(*
+   CodeSetShift - encode set arithmetic shift.
+*)
+
+PROCEDURE CodeSetShift (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   CodeBinarySetShift (BuildLogicalShift,
+                       SetShift,
+                       MakeKey('ShiftVal'),
+                       MakeKey('ShiftLeft'),
+                       MakeKey('ShiftRight'),
+                       quad, op1, op2, op3)
+END CodeSetShift ;
+
+
+(*
+   FoldSetRotate - check whether we can fold a logical rotate.
+*)
+
+PROCEDURE FoldSetRotate (tokenno: CARDINAL; p: WalkAction;
+                        quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   FoldBinarySet(tokenno, p, SetRotate, quad, op1, op2, op3)
+END FoldSetRotate ;
+
+
+(*
+   CodeSetRotate - encode set arithmetic rotate.
+*)
+
+PROCEDURE CodeSetRotate (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   CodeBinarySetShift (BuildLogicalRotate,
+                       SetRotate,
+                       MakeKey ('RotateVal'),
+                       MakeKey ('RotateLeft'),
+                       MakeKey ('RotateRight'),
+                       quad, op1, op2, op3)
+END CodeSetRotate ;
+
+
+(*
+   FoldSetLogicalDifference - check whether we can fold a logical difference.
+*)
+
+(*
+PROCEDURE FoldSetLogicalDifference (tokenno: CARDINAL; p: WalkAction;
+                                    quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   FoldBinarySet(tokenno, p, SetDifference, quad, op1, op2, op3)
+END FoldSetLogicalDifference ;
+*)
+
+
+(*
+   CodeSetLogicalDifference - encode set arithmetic logical difference.
+*)
+
+PROCEDURE CodeSetLogicalDifference (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   CodeBinarySet (BuildLogicalDifference, SetDifference,
+                  quad, op1, op2, op3)
+END CodeSetLogicalDifference ;
+
+
+(*
+   FoldSymmetricDifference - check whether we can fold a logical difference.
+*)
+
+PROCEDURE FoldSymmetricDifference (tokenno: CARDINAL; p: WalkAction;
+                                   quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   FoldBinarySet (tokenno, p, SetSymmetricDifference, quad, op1, op2, op3)
+END FoldSymmetricDifference ;
+
+
+(*
+   CodeSetSymmetricDifference - code set difference.
+*)
+
+PROCEDURE CodeSetSymmetricDifference (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+BEGIN
+   CodeBinarySet (BuildSymmetricDifference, SetSymmetricDifference,
+                  quad, op1, op2, op3)
+END CodeSetSymmetricDifference ;
+
+
+(*
+   CodeUnarySet - encode a unary set arithmetic operation.
+                  Set operands may be longer than a word.
+*)
+
+PROCEDURE CodeUnarySet (unop: BuildUnarySetFunction; constop: DoUnaryProcedure;
+                        quad: CARDINAL; result, expr: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   DeclareConstant (CurrentQuadToken, expr) ;
+   DeclareConstructor (CurrentQuadToken, quad, expr) ;
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   IF IsConst (result)
+   THEN
+      IF IsValueSolved (expr)
+      THEN
+         Assert (FindType (expr) # NulSym) ;
+         PutConst (result, FindType (expr)) ;
+         PushValue (expr) ;
+         constop (CurrentQuadToken) ;
+         PopValue (result) ;
+         PushValue (result) ;
+         PutConstSet (result) ;
+         ConstantKnownAndUsed (result,
+                               DeclareKnownConstant(location,
+                                                    Mod2Gcc (GetType (expr)),
+                                                    PopSetTree (CurrentQuadToken)))
+      ELSE
+         MetaErrorT0 (CurrentQuadToken,
+                      '{%E}constant expression cannot be evaluated')
+      END
+   ELSE
+      checkDeclare (result) ;
+      BuildUnaryForeachWordDo (location,
+                               Mod2Gcc (GetType (result)), Mod2Gcc (result), Mod2Gcc (expr), unop,
+                               GetMode(result) = LeftValue, GetMode(expr) = LeftValue,
+                               IsConst (result), IsConst (expr))
+   END
+END CodeUnarySet ;
+
+
+(*
+   FoldIncl - check whether we can fold the InclOp.
+              result := result + (1 << expr)
+*)
+
+PROCEDURE FoldIncl (tokenno: CARDINAL; p: WalkAction;
+                    quad: CARDINAL; result, expr: CARDINAL) ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   TryDeclareConstant (tokenno, expr) ;
+   IF IsConst (result) AND IsConst (expr)
+   THEN
+      IF GccKnowsAbout (expr) AND IsValueSolved (result)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         PushValue (result) ;
+         AddBit (tokenno, expr) ;
+         AddModGcc (result, PopSetTree(tokenno)) ;
+         p (result) ;
+         NoChange := FALSE ;
+         SubQuad (quad)
+      END
+   END
+END FoldIncl ;
+
+
+(*
+   FoldIfLess - check to see if it is possible to evaluate
+                if op1 < op2 then goto op3.
+*)
+
+PROCEDURE FoldIfLess (tokenno: CARDINAL;
+                      quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   TryDeclareConstant(tokenno, left) ;
+   TryDeclareConstant(tokenno, right) ;
+   IF IsConst (left) AND IsConst (right)
+   THEN
+      IF IsValueSolved (left) AND IsValueSolved (right)
+      THEN
+         (* fine, we can take advantage of this and evaluate the condition *)
+         PushValue (left) ;
+         PushValue (right) ;
+         IF Less (tokenno)
+         THEN
+            PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+         ELSE
+            SubQuad (quad)
+         END
+      END
+   END
+END FoldIfLess ;
+
+
+(*
+   FoldIfIn - check whether we can fold the IfInOp
+              if op1 in op2 then goto op3
+*)
+
+PROCEDURE FoldIfIn (tokenno: CARDINAL;
+                    quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   TryDeclareConstant (tokenno, left) ;
+   TryDeclareConstant (tokenno, right) ;
+   IF IsConst (left) AND IsConst (right)
+   THEN
+      IF IsValueSolved (left) AND IsValueSolved (right)
+      THEN
+         (* fine, we can take advantage of this and evaluate the condition *)
+         PushValue (right) ;
+         IF SetIn (tokenno, left)
+         THEN
+            PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+         ELSE
+            SubQuad (quad)
+         END
+      END
+   END
+END FoldIfIn ;
+
+
+(*
+   FoldIfNotIn - check whether we can fold the IfNotInOp
+                 if not (op1 in op2) then goto op3
+*)
+
+PROCEDURE FoldIfNotIn (tokenno: CARDINAL;
+                       quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   TryDeclareConstant (tokenno, left) ;
+   TryDeclareConstant (tokenno, right) ;
+   IF IsConst (left) AND IsConst (right)
+   THEN
+      IF IsValueSolved (left) AND IsValueSolved (right)
+      THEN
+         (* fine, we can take advantage of this and evaluate the condition *)
+         PushValue (right) ;
+         IF NOT SetIn (tokenno, left)
+         THEN
+            PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+         ELSE
+            SubQuad (quad)
+         END
+      END
+   END
+END FoldIfNotIn ;
+
+
+(*
+   GetSetLimits - assigns low and high to the limits of the declared, set.
+*)
+
+PROCEDURE GetSetLimits (set: CARDINAL; VAR low, high: CARDINAL) ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   type := GetType(set) ;
+   IF IsSubrange(type)
+   THEN
+      GetSubrange(type, high, low) ;
+   ELSE
+      low := GetTypeMin(type) ;
+      high := GetTypeMax(type)
+   END
+END GetSetLimits ;
+
+
+(*
+   GetFieldNo - returns the field number in the, set, which contains, element.
+*)
+
+PROCEDURE GetFieldNo (tokenno: CARDINAL; element: CARDINAL; set: CARDINAL; VAR offset: Tree) : INTEGER ;
+VAR
+   low, high, bpw, c: CARDINAL ;
+   location         : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   bpw := GetBitsPerBitset() ;
+   GetSetLimits(set, low, high) ;
+
+   (* check element is legal *)
+
+   PushValue(element) ;
+   PushValue(low) ;
+   IF Less(tokenno)
+   THEN
+      (* out of range *)
+      RETURN( -1 )
+   ELSE
+      PushValue(element) ;
+      PushValue(high) ;
+      IF Gre(tokenno)
+      THEN
+         RETURN( -1 )
+      END
+   END ;
+
+   (* all legal *)
+
+   PushValue(low) ;
+   offset := PopIntegerTree() ;
+   c := 0 ;
+   PushValue(element) ;
+   PushValue(low) ;
+   PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
+   PushCard(bpw) ;
+   PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
+   Addn ;
+   WHILE GreEqu(tokenno) DO
+      INC(c) ;   (* move onto next field *)
+      PushValue(element) ;
+      PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
+      PushCard((c+1)*bpw) ;
+      PushValue(low) ;
+      PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
+      Addn ;
+      PushIntegerTree(offset) ;
+      PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
+      PushCard(bpw) ;
+      PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
+      Addn ;
+      offset := PopIntegerTree()
+   END ;
+   RETURN( VAL(INTEGER, c) )
+END GetFieldNo ;
+
+
+(*
+   CodeIncl - encode an InclOp:
+              result := result + (1 << expr)
+*)
+
+PROCEDURE CodeIncl (result, expr: CARDINAL) ;
+VAR
+   low,
+   high    : CARDINAL ;
+   offset  : Tree ;
+   fieldno : INTEGER ;
+   location: location_t ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   DeclareConstant (CurrentQuadToken, expr) ;
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   IF IsConst (result)
+   THEN
+      IF IsConst (expr)
+      THEN
+         InternalError ('this quadruple should have been removed by FoldIncl')
+      ELSE
+         InternalError ('should not get to here (why are we generating <incl const, var> ?)')
+      END
+   ELSE
+      IF IsConst (expr)
+      THEN
+         fieldno := GetFieldNo (CurrentQuadToken, expr, GetType (result), offset) ;
+         IF fieldno >= 0
+         THEN
+            PushValue (expr) ;
+            PushIntegerTree (offset) ;
+            Sub ;
+            BuildIncludeVarConst (location,
+                                  Mod2Gcc (GetType (result)),
+                                  Mod2Gcc (result),
+                                  PopIntegerTree (),
+                                  GetMode (result) = LeftValue, fieldno)
+         ELSE
+            MetaErrorT1 (CurrentQuadToken, 'bit exceeded the range of set {%1Eatd}', result)
+         END
+      ELSE
+         GetSetLimits (GetType (result), low, high) ;
+         BuildIncludeVarVar (location,
+                             Mod2Gcc (GetType(result)),
+                             Mod2Gcc (result), Mod2Gcc(expr), GetMode(result) = LeftValue, Mod2Gcc (low))
+      END
+   END
+END CodeIncl ;
+
+
+(*
+   FoldExcl - check whether we can fold the InclOp.
+              op1 := op1 - (1 << op3)
+*)
+
+PROCEDURE FoldExcl (tokenno: CARDINAL; p: WalkAction;
+                    quad: CARDINAL; result, expr: CARDINAL) ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   TryDeclareConstant (tokenno, expr) ;
+   IF IsConst (result) AND IsConst (expr)
+   THEN
+      IF GccKnowsAbout (expr) AND IsValueSolved (result)
+      THEN
+         PushValue (result) ;
+         SubBit (tokenno, expr) ;
+         AddModGcc (result, PopSetTree (tokenno)) ;
+         p (result) ;
+         NoChange := FALSE ;
+         SubQuad(quad)
+      END
+   END
+END FoldExcl ;
+
+
+(*
+   CodeExcl - encode an ExclOp:
+              result := result - (1 << expr)
+*)
+
+PROCEDURE CodeExcl (result, expr: CARDINAL) ;
+VAR
+   low,
+   high    : CARDINAL ;
+   offset  : Tree ;
+   fieldno : INTEGER ;
+   location: location_t ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   DeclareConstant (CurrentQuadToken, expr) ;
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst (result)
+   THEN
+      InternalError ('should not get to here (if we do we should consider calling FoldInclOp)')
+   ELSE
+      IF IsConst (expr)
+      THEN
+         fieldno := GetFieldNo (CurrentQuadToken, expr, GetType (result), offset) ;
+         IF fieldno >= 0
+         THEN
+            PushValue (expr) ;
+            PushIntegerTree (offset) ;
+            Sub ;
+            BuildExcludeVarConst (location,
+                                  Mod2Gcc (GetType (result)),
+                                  Mod2Gcc (result), PopIntegerTree (),
+                                  GetMode (result)=LeftValue, fieldno)
+         ELSE
+            MetaErrorT1 (CurrentQuadToken, 'bit exceeded the range of set {%1Eatd}', result)
+         END
+      ELSE
+         GetSetLimits (GetType (result), low, high) ;
+         BuildExcludeVarVar (location,
+                             Mod2Gcc (GetType(result)),
+                             Mod2Gcc (result), Mod2Gcc(expr), GetMode(result) = LeftValue, Mod2Gcc (low))
+      END
+   END
+END CodeExcl ;
+
+
+(*
+   FoldUnary - check whether we can fold the unop operation.
+*)
+
+PROCEDURE FoldUnary (tokenno: CARDINAL; p: WalkAction;
+                     unop: BuildUnaryProcedure; ZConstToTypedConst: Tree;
+                     quad: CARDINAL; result, expr: CARDINAL) ;
+VAR
+   tv      : Tree ;
+   location: location_t ;
+BEGIN
+   (* firstly ensure that any constant literal is declared *)
+   TryDeclareConstant (tokenno, expr) ;
+   location := TokenToLocation (tokenno) ;
+
+   IF IsConst (expr)
+   THEN
+      IF GccKnowsAbout (expr)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst (result)
+         THEN
+            IF ZConstToTypedConst = Tree(NIL)
+            THEN
+               IF (GetType (expr) = NulSym) OR IsOrdinalType (SkipType (GetType (expr)))
+               THEN
+                  ZConstToTypedConst := GetM2ZType ()
+               ELSIF IsRealType (SkipType (GetType (expr))) OR IsRealN (SkipType (GetType (expr)))
+               THEN
+                  ZConstToTypedConst := GetM2RType ()
+               ELSIF IsComplexType (SkipType (GetType (expr))) OR
+                     IsComplexN (SkipType (GetType (expr)))
+               THEN
+                  ZConstToTypedConst := GetM2CType ()
+               END
+            END ;
+            IF GetType(result) = NulSym
+            THEN
+               PutConst (result, NegateType (GetType (expr) (* , tokenno *) ))
+            END ;
+            tv := unop (location, LValueToGenericPtrOrConvert (expr, ZConstToTypedConst), FALSE) ;
+            CheckOrResetOverflow (tokenno, tv, MustCheckOverflow (quad)) ;
+
+            AddModGcc (result, DeclareKnownConstant (location, ZConstToTypedConst, tv)) ;
+            p (result) ;
+            NoChange := FALSE ;
+            SubQuad (quad)
+         ELSE
+            (* we can still fold the expression, but not the assignment, however, we will
+               not do this here but in CodeUnary
+             *)
+         END
+      END
+   END
+END FoldUnary ;
+
+
+(*
+   FoldUnarySet - check whether we can fold the doOp operation.
+*)
+
+PROCEDURE FoldUnarySet (tokenno: CARDINAL; p: WalkAction; doOp: DoUnaryProcedure;
+                        quad: CARDINAL; result, expr: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   (* firstly try and ensure that constants are declared *)
+   TryDeclareConstant (tokenno, expr) ;
+   location := TokenToLocation (tokenno) ;
+
+   IF IsConst (expr) AND IsConstSet (expr) AND
+      IsConst (result)
+   THEN
+      IF IsValueSolved (expr) AND (GetType (expr) # NulSym)
+      THEN
+         PutConst (result, FindType (expr)) ;
+         PushValue (expr) ;
+         doOp (tokenno) ;
+         PopValue (result) ;
+         PushValue (result) ;
+         PutConstSet (result) ;
+         AddModGcc (result,
+                    DeclareKnownConstant (location,
+                                          Mod2Gcc (GetType (expr)),
+                                          PopSetTree (tokenno))) ;
+         p (result) ;
+         NoChange := FALSE ;
+         SubQuad (quad)
+      END
+   END
+END FoldUnarySet ;
+
+
+(*
+   CodeUnaryCheck - encode a unary arithmetic operation.
+*)
+
+PROCEDURE CodeUnaryCheck (unop: BuildUnaryCheckProcedure; ZConstToTypedConst: Tree;
+                          quad: CARDINAL; result, expr: CARDINAL) ;
+VAR
+   lowestType: CARDINAL ;
+   min, max,
+   lowest,
+   tv        : Tree ;
+   location  : location_t ;
+BEGIN
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, expr) ;
+   DeclareConstructor(CurrentQuadToken, quad, expr) ;
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   lowestType := GetLType (result) ;
+   IF lowestType=NulSym
+   THEN
+      lowest := NIL ;
+   ELSE
+      lowest := Mod2Gcc (lowestType)
+   END ;
+   IF GetMinMax (CurrentQuadToken, lowestType, min, max)
+   THEN
+      tv := unop (location, LValueToGenericPtr (location, expr), lowest, min, max)
+   ELSE
+      tv := unop (location, LValueToGenericPtr (location, expr), NIL, NIL, NIL)
+   END ;
+   CheckOrResetOverflow (CurrentQuadToken, tv, MustCheckOverflow(quad)) ;
+   IF IsConst (result)
+   THEN
+      IF ZConstToTypedConst = Tree (NIL)
+      THEN
+         ZConstToTypedConst := Tree (Mod2Gcc( GetType (expr)))
+      END ;
+      (* still have a constant which was not resolved, pass it to gcc *)
+      PutConst (result, FindType (expr)) ;
+      ConstantKnownAndUsed (result, DeclareKnownConstant (location, ZConstToTypedConst, tv))
+   ELSE
+      IF EnableSSA AND IsVariableSSA (result)
+      THEN
+         Replace (result, tv)
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (result), tv)
+      END
+   END
+END CodeUnaryCheck ;
+
+
+(*
+   CodeUnary - encode a unary arithmetic operation.
+*)
+
+PROCEDURE CodeUnary (unop: BuildUnaryProcedure; ZConstToTypedConst: Tree;
+                     quad: CARDINAL; result, expr: CARDINAL) ;
+VAR
+   tv      : Tree ;
+   location: location_t ;
+BEGIN
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant (CurrentQuadToken, expr) ;
+   DeclareConstructor (CurrentQuadToken, quad, expr) ;
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   tv := unop(location, LValueToGenericPtr (location, expr), FALSE) ;
+   CheckOrResetOverflow (CurrentQuadToken, tv, MustCheckOverflow (quad)) ;
+   IF IsConst(result)
+   THEN
+      IF ZConstToTypedConst=Tree(NIL)
+      THEN
+         ZConstToTypedConst := Tree(Mod2Gcc(GetType(expr)))
+      END ;
+      (* still have a constant which was not resolved, pass it to gcc *)
+      PutConst (result, FindType (expr)) ;
+      ConstantKnownAndUsed (result, DeclareKnownConstant (location, ZConstToTypedConst, tv))
+   ELSE
+      IF EnableSSA AND IsVariableSSA (result)
+      THEN
+         Replace (result, tv)
+      ELSE
+         BuildAssignmentStatement (location, Mod2Gcc (result), tv)
+      END
+   END
+END CodeUnary ;
+
+
+(*
+   FoldNegate - check unary negate for constant folding.
+*)
+
+PROCEDURE FoldNegate (tokenno: CARDINAL; p: WalkAction;
+                      quad: CARDINAL; result, expr: CARDINAL) ;
+BEGIN
+   IF IsConstSet (expr)
+   THEN
+      FoldUnarySet (tokenno, p, SetNegate, quad, result, expr)
+   ELSE
+      FoldUnary (tokenno, p, BuildNegate, NIL, quad, result, expr)
+   END
+END FoldNegate ;
+
+
+(*
+   CodeNegateChecked - code a negate instruction, determine whether checking
+                       is required.
+*)
+
+PROCEDURE CodeNegateChecked (quad: CARDINAL; op1, op3: CARDINAL) ;
+BEGIN
+   IF IsConstSet (op3) OR IsSet (GetType (op3))
+   THEN
+      CodeUnarySet (BuildSetNegate, SetNegate, quad, op1, op3)
+   ELSIF UnaryOperand (quad, op3)
+   THEN
+      IF MustCheckOverflow (quad)
+      THEN
+         CodeUnaryCheck (BuildNegateCheck, NIL, quad, op1, op3)
+      ELSE
+         CodeUnary (BuildNegate, NIL, quad, op1, op3)
+      END
+   END
+END CodeNegateChecked ;
+
+
+(*
+   FoldSize - check unary SIZE for constant folding.
+*)
+
+PROCEDURE FoldSize (tokenno: CARDINAL; p: WalkAction;
+                    quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   t       : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   IF IsConst(op1) AND CompletelyResolved(op3)
+   THEN
+      IF op2=NulSym
+      THEN
+         t := BuildSize(location, Mod2Gcc(op3), FALSE) ;
+         PushIntegerTree(t) ;
+         PopValue(op1) ;
+         PutConst(op1, Cardinal) ;
+         p(op1) ;
+         NoChange := FALSE ;
+         SubQuad(quad) ;
+         t := RememberConstant(t)
+      ELSIF GccKnowsAbout(op2)
+      THEN
+         (* ignore the chosen varients as we implement it as a C union *)
+         t := BuildSize(location, Mod2Gcc(op3), FALSE) ;
+         PushIntegerTree(t) ;
+         PopValue(op1) ;
+         PutConst(op1, Cardinal) ;
+         p(op1) ;
+         NoChange := FALSE ;
+         SubQuad(quad) ;
+         t := RememberConstant(t)
+      END
+   END
+END FoldSize ;
+
+
+(*
+   CodeSize - encode the inbuilt SIZE function.
+*)
+
+PROCEDURE CodeSize (result, sym: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   PushIntegerTree (BuildSize (location, Mod2Gcc (sym), FALSE)) ;
+   IF IsConst (result)
+   THEN
+      PopValue (result) ;
+      PutConst (result, Cardinal) ;
+      PushValue (result) ;
+      ConstantKnownAndUsed (result,
+                            DeclareKnownConstant (location,
+                                                  GetIntegerType (),
+                                                  PopIntegerTree ()))
+   ELSE
+      BuildAssignmentStatement (location, Mod2Gcc (result), PopIntegerTree ())
+   END
+END CodeSize ;
+
+
+(*
+   FoldRecordField - check whether we can fold an RecordFieldOp quadruple.
+                     Very similar to FoldBinary, except that we need to
+                     hard code a few parameters to the gcc backend.
+*)
+
+PROCEDURE FoldRecordField (tokenno: CARDINAL; p: WalkAction;
+                           quad: CARDINAL; result, record, field: CARDINAL) ;
+VAR
+   recordType,
+   fieldType : CARDINAL ;
+   ptr       : Tree ;
+   location  : location_t ;
+BEGIN
+   RETURN ;  (* this procedure should no longer be called *)
+
+   location := TokenToLocation(tokenno) ;
+   (* firstly ensure that any constant literal is declared *)
+   TryDeclareConstant(tokenno, record) ;
+   IF IsRecordField(record) OR IsFieldVarient(record)
+   THEN
+      recordType := GetType (record) ;
+      fieldType := GetType (field) ;
+      IF GccKnowsAbout (record) AND GccKnowsAbout (field) AND
+         GccKnowsAbout (recordType) AND GccKnowsAbout (fieldType) AND
+         CompletelyResolved (recordType) AND CompletelyResolved (fieldType)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         IF IsConst (result)
+         THEN
+            ptr := BuildComponentRef (location, Mod2Gcc (record), Mod2Gcc (field)) ;
+            IF NOT IsValueSolved (result)
+            THEN
+               PushIntegerTree (ptr) ;
+               PopValue (result)
+            END ;
+            PutConst (result, fieldType) ;
+            AddModGcc (result, DeclareKnownConstant (location, Mod2Gcc (fieldType), ptr)) ;
+            p (result) ;
+            NoChange := FALSE ;
+            SubQuad (quad)
+         ELSE
+            (* we can still fold the expression, but not the assignment, however, we will
+               not do this here but in CodeOffset
+             *)
+         END
+      END
+   END
+END FoldRecordField ;
+
+
+(*
+   CodeRecordField - encode a reference to a field within a record.
+*)
+
+PROCEDURE CodeRecordField (result, record, field: CARDINAL) ;
+VAR
+   recordType,
+   fieldType : CARDINAL ;
+   ptr       : Tree ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   (* firstly ensure that any constant literal is declared *)
+   IF IsRecordField (field) OR IsFieldVarient (field)
+   THEN
+      recordType := GetType (record) ;
+      fieldType := GetType (field) ;
+      IF GccKnowsAbout (record) AND GccKnowsAbout (field) AND
+         GccKnowsAbout (recordType) AND GccKnowsAbout (fieldType) AND
+         CompletelyResolved (recordType) AND CompletelyResolved (fieldType)
+      THEN
+         IF GetMode(record)=LeftValue
+         THEN
+            ptr := BuildComponentRef (location,
+                                      BuildIndirect (location, Mod2Gcc (record), Mod2Gcc (recordType)),
+                                      Mod2Gcc (field))
+         ELSE
+            ptr := BuildComponentRef (location, Mod2Gcc (record), Mod2Gcc (field))
+         END ;
+         AddModGcc (result, ptr)
+      ELSE
+         InternalError ('symbol type should have been declared by now')
+      END
+   ELSE
+      InternalError ('not expecting this type of symbol')
+   END
+END CodeRecordField ;
+
+
+(*
+   BuildHighFromChar -
+*)
+
+PROCEDURE BuildHighFromChar (operand: CARDINAL) : Tree ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(operand)) ;
+   RETURN( GetCardinalZero(location) )
+END BuildHighFromChar ;
+
+
+(*
+   SkipToArray -
+*)
+
+PROCEDURE SkipToArray (operand, dim: CARDINAL) : CARDINAL ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   WHILE dim>1 DO
+      type := SkipType(GetType(operand)) ;
+      IF IsArray(type)
+      THEN
+         operand := type
+      END ;
+      DEC(dim)
+   END ;
+   RETURN( operand )
+END SkipToArray ;
+
+
+(*
+   BuildHighFromArray -
+*)
+
+PROCEDURE BuildHighFromArray (tokenno: CARDINAL; dim, operand: CARDINAL) : Tree ;
+VAR
+   Type    : CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   Type := SkipType (GetType (SkipToArray (operand, dim))) ;
+   RETURN BuildHighFromStaticArray (location, (* dim, *) Type)
+END BuildHighFromArray ;
+
+
+(*
+   BuildHighFromStaticArray -
+*)
+
+PROCEDURE BuildHighFromStaticArray (location: location_t; (* dim, *) Type: CARDINAL) : Tree ;
+VAR
+   High, Low: CARDINAL ;
+   Subscript,
+   Subrange : CARDINAL ;
+BEGIN
+   Assert (IsArray (Type)) ;
+   Subscript := GetArraySubscript (Type) ;
+   Subrange := SkipType (GetType (Subscript)) ;
+   IF IsEnumeration (Subrange)
+   THEN
+      GetBaseTypeMinMax (Subrange, Low, High) ;
+      IF GccKnowsAbout (High)
+      THEN
+         RETURN Tree (Mod2Gcc (High))
+      END
+   ELSIF IsSubrange(Subrange)
+   THEN
+      GetSubrange (Subrange, High, Low) ;
+      IF GccKnowsAbout (Low) AND GccKnowsAbout (High)
+      THEN
+         RETURN BuildSub (location, Mod2Gcc (High), Mod2Gcc (Low), TRUE)
+      END
+   ELSE
+      MetaError1 ('array subscript {%1EDad:for} must be a subrange or enumeration type', Type) ;
+      RETURN Tree(NIL)
+   END ;
+   IF GccKnowsAbout (High)
+   THEN
+      RETURN Tree (Mod2Gcc (High))
+   ELSE
+      RETURN Tree (NIL)
+   END
+END BuildHighFromStaticArray ;
+
+
+(*
+   BuildHighFromString -
+*)
+
+PROCEDURE BuildHighFromString (operand: CARDINAL) : Tree ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(operand)) ;
+   IF GccKnowsAbout(operand) AND (StringLength(Mod2Gcc(operand))>0)
+   THEN
+      RETURN( BuildIntegerConstant(StringLength(Mod2Gcc(operand))-1) )
+   ELSE
+      RETURN( GetIntegerZero(location) )
+   END
+END BuildHighFromString ;
+
+
+(*
+   ResolveHigh - given an Modula-2 operand, it resolves the HIGH(operand)
+                 and returns a GCC constant symbol containing the value of
+                 HIGH(operand).
+*)
+
+PROCEDURE ResolveHigh (tokenno: CARDINAL; dim, operand: CARDINAL) : Tree ;
+VAR
+   Type    : CARDINAL ;
+   location: location_t ;
+BEGIN
+   Type := SkipType(GetType(operand)) ;
+   location := TokenToLocation(tokenno) ;
+
+   IF (Type=Char) AND (dim=1)
+   THEN
+      RETURN( BuildHighFromChar(operand) )
+   ELSIF IsConstString(operand) AND (dim=1)
+   THEN
+      RETURN( BuildHighFromString(operand) )
+   ELSIF IsArray(Type)
+   THEN
+      RETURN( BuildHighFromArray(tokenno, dim, operand) )
+   ELSIF IsUnbounded(Type)
+   THEN
+      RETURN( GetHighFromUnbounded(location, dim, operand) )
+   ELSE
+      MetaErrorT1 (tokenno,
+                   'base procedure HIGH expects a variable of type array or a constant string or CHAR as its parameter, rather than {%1Etad}',
+                   operand) ;
+      RETURN( GetIntegerZero(location) )
+   END
+END ResolveHigh ;
+
+
+(*
+   FoldHigh - if the array is not dynamic then we should be able to
+              remove the HighOp quadruple and assign op1 with
+              the known compile time HIGH(op3).
+*)
+
+PROCEDURE FoldHigh (tokenno: CARDINAL; p: WalkAction;
+                    quad: CARDINAL; op1, dim, op3: CARDINAL) ;
+VAR
+   t       : Tree ;
+   location: location_t ;
+BEGIN
+   (* firstly ensure that any constant literal is declared *)
+   TryDeclareConstant(tokenno, op3) ;
+   location := TokenToLocation(tokenno) ;
+   IF GccKnowsAbout(op3) AND CompletelyResolved(op3)
+   THEN
+      t := ResolveHigh(tokenno, dim, op3) ;
+      (* fine, we can take advantage of this and fold constants *)
+      IF IsConst(op1) AND (t#Tree(NIL))
+      THEN
+         PutConst(op1, Cardinal) ;
+         AddModGcc(op1,
+                   DeclareKnownConstant(location, GetCardinalType(),
+                                        ToCardinal(location, t))) ;
+         p(op1) ;
+         NoChange := FALSE ;
+         SubQuad(quad)
+      ELSE
+         (* we can still fold the expression, but not the assignment, however, we will
+            not do this here but in CodeHigh
+         *)
+      END
+   END
+END FoldHigh ;
+
+
+(*
+   CodeHigh - encode a unary arithmetic operation.
+*)
+
+PROCEDURE CodeHigh (result, dim, array: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant (CurrentQuadToken, array) ;
+   IF IsConst (result)
+   THEN
+      (* still have a constant which was not resolved, pass it to gcc *)
+      ConstantKnownAndUsed (result,
+                            DeclareKnownConstant(location,
+                                                 GetM2ZType (),
+                                                 ResolveHigh (CurrentQuadToken, dim, array)))
+   ELSE
+      BuildAssignmentStatement (location,
+                                Mod2Gcc (result),
+                                BuildConvert (location,
+                                              Mod2Gcc (GetType (result)),
+                                              ResolveHigh (CurrentQuadToken, dim, array),
+                                              FALSE))
+   END
+END CodeHigh ;
+
+
+(*
+   CodeUnbounded - codes the creation of an unbounded parameter variable.
+                   places the address of op3 into *op1
+*)
+
+PROCEDURE CodeUnbounded (result, array: CARDINAL) ;
+VAR
+   Addr    : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   DeclareConstant(CurrentQuadToken, array) ;
+   IF IsConstString(array)
+   THEN
+      BuildAssignmentStatement (location, Mod2Gcc (result), BuildAddr (location, PromoteToString (CurrentQuadToken, array), FALSE))
+   ELSIF IsConstructor(array)
+   THEN
+      BuildAssignmentStatement (location, Mod2Gcc (result), BuildAddr (location, Mod2Gcc (array), TRUE))
+   ELSIF IsUnbounded (GetType (array))
+   THEN
+      IF GetMode(array) = LeftValue
+      THEN
+         Addr := BuildConvert (location, Mod2Gcc (GetType (result)), Mod2Gcc (array), FALSE)
+      ELSE
+         Addr := BuildComponentRef (location, Mod2Gcc (array), Mod2Gcc (GetUnboundedAddressOffset (GetType (array))))
+      END ;
+      BuildAssignmentStatement (location, Mod2Gcc (result), Addr)
+   ELSIF GetMode(array) = RightValue
+   THEN
+      BuildAssignmentStatement (location, Mod2Gcc (result), BuildAddr (location, Mod2Gcc (array), FALSE))
+   ELSE
+      BuildAssignmentStatement (location, Mod2Gcc (result), Mod2Gcc (array))
+   END
+END CodeUnbounded ;
+
+
+(*
+   AreSubrangesKnown - returns TRUE if the subranges values used within, array, are known.
+*)
+
+PROCEDURE AreSubrangesKnown (array: CARDINAL) : BOOLEAN ;
+VAR
+   type,
+   subscript,
+   low, high: CARDINAL ;
+BEGIN
+   IF GccKnowsAbout(array)
+   THEN
+      subscript := GetArraySubscript(array) ;
+      IF subscript=NulSym
+      THEN
+         InternalError ('not expecting a NulSym as a subscript')
+      ELSE
+         type := SkipType(GetType(subscript)) ;
+         low  := GetTypeMin(type) ;
+         high := GetTypeMax(type) ;
+         RETURN( GccKnowsAbout(low) AND GccKnowsAbout(high) )
+      END
+   ELSE
+      RETURN( FALSE )
+   END
+END AreSubrangesKnown ;
+
+
+(*
+   CodeArray - res is an lvalue which will point to the array element.
+*)
+
+PROCEDURE CodeArray (res, index, array: CARDINAL) ;
+VAR
+   resType,
+   arrayDecl,
+   type,
+   low,
+   subscript  : CARDINAL ;
+   a, ta,
+   ti, tl     : Tree ;
+   location   : location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   arrayDecl := SkipType (GetType (array)) ;
+   IF AreSubrangesKnown (arrayDecl)
+   THEN
+      subscript := GetArraySubscript (arrayDecl) ;
+      type := SkipType (GetType (subscript)) ;
+      low  := GetTypeMin (type) ;
+      resType := GetVarBackEndType(res) ;
+      IF resType=NulSym
+      THEN
+         resType := SkipType(GetType(res))
+      END ;
+      ta := Mod2Gcc(SkipType(GetType(arrayDecl))) ;
+      IF GetMode(array)=LeftValue
+      THEN
+         a := BuildIndirect(location, Mod2Gcc(array), Mod2Gcc(SkipType(GetType(array))))
+      ELSE
+         a := Mod2Gcc(array)
+      END ;
+      IF IsArrayLarge(arrayDecl)
+      THEN
+         tl := BuildConvert(location, Mod2Gcc(type), Mod2Gcc(low), FALSE) ;
+         ti := BuildConvert(location, Mod2Gcc(type), Mod2Gcc(index), FALSE) ;
+         ti := BuildConvert(location, GetIntegerType(), BuildSub(location, ti, tl, FALSE), FALSE) ;
+         tl := GetIntegerZero(location)
+      ELSE
+         tl := BuildConvert(location, GetIntegerType(), Mod2Gcc(low), FALSE) ;
+         ti := BuildConvert(location, GetIntegerType(), Mod2Gcc(index), FALSE)
+      END ;
+      (* ti := BuildConvert(location, GetIntegerType(), Mod2Gcc(high), FALSE) ; *)
+      BuildAssignmentStatement (location,
+                                Mod2Gcc (res),
+                                BuildConvert (location,
+                                              Mod2Gcc (resType),
+                                              BuildAddr (location, BuildArray (location,
+                                                                               ta, a, ti, tl),
+                                                        FALSE),
+                                              FALSE))
+   ELSE
+      InternalError ('subranges not yet resolved')
+   END
+END CodeArray ;
+
+
+(*
+   FoldElementSizeForArray - attempts to calculate the Subscript
+                             multiplier for the index op3.
+*)
+
+PROCEDURE FoldElementSizeForArray (tokenno: CARDINAL; quad: CARDINAL;
+                                   p: WalkAction;
+                                   result, type: CARDINAL) ;
+VAR
+   Subscript: CARDINAL ;
+   location : location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+
+   IF IsConst (result) AND (NOT GccKnowsAbout (result))
+   THEN
+      Subscript := GetArraySubscript (type) ;
+      IF IsSizeSolved (Subscript)
+      THEN
+         PutConst (result, Integer) ;
+         PushSize (Subscript) ;
+         AddModGcc (result,
+                    DeclareKnownConstant (location,
+                                          GetCardinalType (),
+                                          BuildConvert (location,
+                                                        GetCardinalType (),
+                                                        PopIntegerTree (),
+                                                        TRUE))) ;
+         p (result) ;
+         NoChange := FALSE ;
+         SubQuad (quad)
+      END
+   END
+END FoldElementSizeForArray ;
+
+
+(*
+   FoldElementSizeForUnbounded - Unbounded arrays only have one index,
+                                 therefore element size will be the
+                                 TSIZE(Type) where Type is defined as:
+                                 ARRAY OF Type.
+*)
+
+PROCEDURE FoldElementSizeForUnbounded (tokenno: CARDINAL; quad: CARDINAL;
+                                       p: WalkAction;
+                                       result, ArrayType: CARDINAL) ;
+VAR
+   Type    : CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+
+   IF IsConst (result)
+   THEN
+      IF GccKnowsAbout (result)
+      THEN
+         InternalError ('cannot assign a value twice to a constant')
+      ELSE
+         Assert (IsUnbounded (ArrayType)) ;
+         Type := GetType (ArrayType) ;
+         IF GccKnowsAbout (Type)
+         THEN
+            PutConst (result, Cardinal) ;
+            AddModGcc (result,
+                       DeclareKnownConstant (location,
+                                             GetCardinalType (),
+                                             BuildConvert (location,
+                                                           GetCardinalType (),
+                                                           FindSize (tokenno, Type),
+                                                           TRUE))) ;
+            p (result) ;
+            NoChange := FALSE ;
+            SubQuad (quad)
+         END
+      END
+   END
+END FoldElementSizeForUnbounded ;
+
+
+(*
+   FoldElementSize - folds the element size for an ArraySym or UnboundedSym.
+                     ElementSize returns a constant which defines the
+                     multiplier to be multiplied by this element index.
+*)
+
+PROCEDURE FoldElementSize (tokenno: CARDINAL; p: WalkAction;
+                           quad: CARDINAL; result, type: CARDINAL) ;
+BEGIN
+   IF IsUnbounded (type)
+   THEN
+      FoldElementSizeForUnbounded (tokenno, quad, p, result, type)
+   ELSIF IsArray (type)
+   THEN
+      FoldElementSizeForArray (tokenno, quad, p, result, type)
+   ELSE
+      InternalError ('expecting UnboundedSym or ArraySym')
+   END
+END FoldElementSize ;
+
+
+(*
+   PopKindTree - returns a Tree from M2ALU of the type implied by, op.
+*)
+
+PROCEDURE PopKindTree (op: CARDINAL; tokenno: CARDINAL) : Tree ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   type := SkipType (GetType (op)) ;
+   IF IsSet (type)
+   THEN
+      RETURN( PopSetTree (tokenno) )
+   ELSIF IsRealType (type)
+   THEN
+      RETURN( PopRealTree () )
+   ELSE
+      RETURN( PopIntegerTree () )
+   END
+END PopKindTree ;
+
+
+(*
+   FoldConvert - attempts to fold op3 to type op2 placing the result into
+                 op1, providing that op1 and op3 are constants.
+                 Convert will, if need be, alter the machine representation
+                 of op3 to comply with TYPE op2.
+*)
+
+PROCEDURE FoldConvert (tokenno: CARDINAL; p: WalkAction;
+                       quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+
+VAR
+   tl      : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   (* firstly ensure that constant literals are declared *)
+   TryDeclareConstant(tokenno, op3) ;
+   IF IsConstant(op3)
+   THEN
+      IF GccKnowsAbout(op2) AND
+         (IsProcedure(op3) OR IsValueSolved(op3)) AND
+         GccKnowsAbout(SkipType(op2))
+      THEN
+         (* fine, we can take advantage of this and fold constant *)
+         IF IsConst(op1)
+         THEN
+            PutConst(op1, op2) ;
+            tl := Mod2Gcc(SkipType(op2)) ;
+            IF IsProcedure(op3)
+            THEN
+               AddModGcc(op1, BuildConvert(location, tl, Mod2Gcc(op3), TRUE))
+            ELSE
+               PushValue(op3) ;
+               IF IsConstSet(op3)
+               THEN
+                  IF IsSet(SkipType(op2))
+                  THEN
+                     WriteFormat0('cannot convert values between sets')
+                  ELSE
+                     PushIntegerTree(FoldAndStrip(BuildConvert(location, tl, PopSetTree(tokenno), TRUE))) ;
+                     PopValue(op1) ;
+                     PushValue(op1) ;
+                     AddModGcc(op1, PopIntegerTree())
+                  END
+               ELSE
+                  IF IsSet(SkipType(op2))
+                  THEN
+                     PushSetTree(tokenno,
+                                 FoldAndStrip(BuildConvert(location, tl, PopKindTree(op3, tokenno),
+                                                           TRUE)), SkipType(op2)) ;
+                     PopValue(op1) ;
+                     PutConstSet(op1) ;
+                     PushValue(op1) ;
+                     AddModGcc(op1, PopSetTree(tokenno))
+                  ELSIF IsRealType(SkipType(op2))
+                  THEN
+                     PushRealTree(FoldAndStrip(BuildConvert(location, tl, PopKindTree(op3, tokenno),
+                                                            TRUE))) ;
+                     PopValue(op1) ;
+                     PushValue(op1) ;
+                     AddModGcc(op1, PopKindTree(op1, tokenno))
+                  ELSE
+                     (* we let CheckOverflow catch a potential overflow rather than BuildConvert *)
+                     PushIntegerTree(FoldAndStrip(BuildConvert(location, tl,
+                                                               PopKindTree(op3, tokenno),
+                                                               FALSE))) ;
+                     PopValue(op1) ;
+                     PushValue(op1) ;
+                     CheckOrResetOverflow(tokenno, PopKindTree(op1, tokenno), MustCheckOverflow(quad)) ;
+                     PushValue(op1) ;
+                     AddModGcc(op1, PopKindTree(op1, tokenno))
+                  END
+               END
+            END ;
+            p(op1) ;
+            NoChange := FALSE ;
+            SubQuad(quad)
+         END
+      END
+   END
+END FoldConvert ;
+
+
+(*
+   CodeConvert - Converts, rhs, to, type, placing the result into lhs.
+                 Convert will, if need be, alter the machine representation
+                 of op3 to comply with TYPE op2.
+*)
+
+PROCEDURE CodeConvert (quad: CARDINAL; lhs, type, rhs: CARDINAL) ;
+VAR
+   tl, tr  : Tree ;
+   location: location_t ;
+BEGIN
+   CheckStop(quad) ;
+
+   (* firstly ensure that constant literals are declared *)
+   DeclareConstant(CurrentQuadToken, rhs) ;
+   DeclareConstructor(CurrentQuadToken, quad, rhs) ;
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   tl := LValueToGenericPtr(location, type) ;
+   IF IsProcedure(rhs)
+   THEN
+      tr := BuildAddr(location, Mod2Gcc(rhs), FALSE)
+   ELSE
+      tr := LValueToGenericPtr(location, rhs) ;
+      tr := ConvertRHS(tr, type, rhs)
+   END ;
+   IF IsConst(lhs)
+   THEN
+      (* fine, we can take advantage of this and fold constant *)
+      PutConst(lhs, type) ;
+      tl := Mod2Gcc(SkipType(type)) ;
+      ConstantKnownAndUsed (lhs,
+                            BuildConvert (location, tl, Mod2Gcc (rhs), TRUE))
+   ELSE
+      BuildAssignmentStatement (location, Mod2Gcc (lhs), BuildConvert (location, tl, tr, TRUE)) ;
+   END
+END CodeConvert ;
+
+
+(*
+   CodeCoerce - Coerce op3 to type op2 placing the result into
+                op1.
+                Coerce will NOT alter the machine representation
+                of op3 to comply with TYPE op2.
+                Therefore it _insists_ that under all circumstances that the
+                type sizes of op1 and op3 are the same.
+                CONVERT will perform machine manipulation to change variable
+                types, coerce does no such thing.
+*)
+
+PROCEDURE CodeCoerce (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   DeclareConstant(CurrentQuadToken, op3) ;  (* checks to see whether it is a constant literal and declares it *)
+   DeclareConstructor(CurrentQuadToken, quad, op3) ;
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsProcedure(op3)
+   THEN
+      IF AreConstantsEqual(FindSize(CurrentQuadToken, op1), FindSize(CurrentQuadToken, Address))
+      THEN
+         IF IsConst(op1)
+         THEN
+            ConstantKnownAndUsed(op1, CheckConstant(CurrentQuadToken, op1, op3))
+         ELSE
+            BuildAssignmentStatement (location, Mod2Gcc (op1), Mod2Gcc (op3))
+         END
+      ELSE
+         MetaErrorT0 (CurrentQuadToken,
+                      '{%E}procedure address can only be stored in an address sized operand')
+      END
+   ELSIF IsConst(op3) OR AreConstantsEqual(FindSize(CurrentQuadToken, op1), FindSize(CurrentQuadToken, op3))
+   THEN
+      IF IsConst(op1)
+      THEN
+         ConstantKnownAndUsed(op1,
+                              DeclareKnownConstant(location,
+                                                   Mod2Gcc(GetType(op1)),
+                                                   Mod2Gcc(op3)))
+      ELSE
+         Assert(GccKnowsAbout(op2)) ;
+         IF IsConst(op3)
+         THEN
+            BuildAssignmentStatement (location, Mod2Gcc(op1), Mod2Gcc(op3))
+         ELSE
+            (* does not work t := BuildCoerce(Mod2Gcc(op1), Mod2Gcc(op2), Mod2Gcc(op3)) *)
+            checkDeclare (op1) ;
+            AddStatement (location,
+                          MaybeDebugBuiltinMemcpy(location, CurrentQuadToken,
+                                                  BuildAddr(location, Mod2Gcc(op1), FALSE),
+                                                  BuildAddr(location, Mod2Gcc(op3), FALSE),
+                                                  FindSize(CurrentQuadToken, op2)))
+         END
+      END
+   ELSE
+      MetaErrorT0 (CurrentQuadToken,
+                   'can only {%kCAST} objects of the same size')
+   END
+END CodeCoerce ;
+
+
+(*
+   FoldCoerce -
+*)
+
+PROCEDURE FoldCoerce (tokenno: CARDINAL; p: WalkAction;
+                      quad, op1, op2, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   TryDeclareConstant(tokenno, op3) ;  (* checks to see whether it is a constant literal and declares it *)
+   location := TokenToLocation(tokenno) ;
+
+   IF GccKnowsAbout(op2) AND GccKnowsAbout(op3)
+   THEN
+      IF IsProcedure(op3)
+      THEN
+         IF AreConstantsEqual(FindSize(tokenno, op1), FindSize(tokenno, Address))
+         THEN
+            IF IsConst(op1)
+            THEN
+               AddModGcc(op1,
+                         DeclareKnownConstant(location,
+                                              Mod2Gcc(GetType(op1)),
+                                              Mod2Gcc(op3))) ;
+               p(op1) ;
+               NoChange := FALSE ;
+               SubQuad(quad)
+            END
+         ELSE
+            MetaErrorT0 (CurrentQuadToken,
+                         '{%E}procedure address can only be stored in a address sized operand')
+         END
+      ELSIF IsConst(op3)
+      THEN
+         IF IsConst(op1)
+         THEN
+            AddModGcc(op1,
+                      DeclareKnownConstant(location,
+                                           Mod2Gcc(GetType(op1)),
+                                           Mod2Gcc(op3))) ;
+            p(op1) ;
+            NoChange := FALSE ;
+            SubQuad(quad)
+         END
+      END
+   END
+END FoldCoerce ;
+
+
+(*
+   CanConvert - returns TRUE if we can convert variable, var, to a, type.
+*)
+
+PROCEDURE CanConvert (type, var: CARDINAL) : BOOLEAN ;
+VAR
+   svar,
+   stype: CARDINAL ;
+BEGIN
+   stype := SkipType(type) ;
+   svar := SkipType(GetType(var)) ;
+   RETURN (IsBaseType(stype) OR IsOrdinalType(stype) OR IsSystemType(stype)) AND
+          (IsBaseType(svar) OR IsOrdinalType(svar) OR IsSystemType(stype))
+END CanConvert ;
+
+
+(*
+   CodeCast - Cast op3 to type op2 placing the result into op1.
+              Cast will NOT alter the machine representation
+              of op3 to comply with TYPE op2 as long as SIZE(op3)=SIZE(op2).
+              If the sizes differ then Convert is called.
+*)
+
+PROCEDURE CodeCast (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   DeclareConstant(CurrentQuadToken, op3) ;  (* checks to see whether it is a constant literal and declares it *)
+   DeclareConstructor(CurrentQuadToken, quad, op3) ;
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsProcedure(op3)
+   THEN
+      IF AreConstantsEqual(FindSize(CurrentQuadToken, op1), FindSize(CurrentQuadToken, Address))
+      THEN
+         IF IsConst(op1)
+         THEN
+            ConstantKnownAndUsed(op1, CheckConstant(CurrentQuadToken, op1, op3))
+         ELSE
+            BuildAssignmentStatement (location, Mod2Gcc(op1), Mod2Gcc(op3))
+         END
+      ELSE
+         MetaErrorT0 (CurrentQuadToken,
+                      '{%E}procedure address can only be stored in an address sized operand')
+      END
+   ELSIF IsConst(op3) OR AreConstantsEqual(FindSize(CurrentQuadToken, op1), FindSize(CurrentQuadToken, op3))
+   THEN
+      CodeCoerce(quad, op1, op2, op3)
+   ELSE
+      IF PedanticCast AND (NOT CanConvert(op2, op3))
+      THEN
+         MetaError2 ('{%WkCAST} cannot copy a variable src {%2Dad} to a destination {%1Dad} as they are of different sizes and are not ordinal or real types',
+                     op1, op3)
+      END ;
+      CodeConvert(quad, op1, op2, op3)
+   END
+END CodeCast ;
+
+
+(*
+   FoldCoerce -
+*)
+
+PROCEDURE FoldCast (tokenno: CARDINAL; p: WalkAction;
+                    quad, op1, op2, op3: CARDINAL) ;
+BEGIN
+   TryDeclareConstant(tokenno, op3) ;  (* checks to see whether it is a constant literal and declares it *)
+   IF GccKnowsAbout(op2) AND GccKnowsAbout(op3)
+   THEN
+      IF IsProcedure(op3)
+      THEN
+         IF AreConstantsEqual(FindSize(tokenno, op1), FindSize(tokenno, Address))
+         THEN
+            FoldCoerce(tokenno, p, quad, op1, op2, op3)
+         ELSE
+            MetaErrorT0 (tokenno,
+                         '{%E}procedure address can only be stored in an address sized operand')
+         END
+      ELSIF IsConst(op3)
+      THEN
+         FoldCoerce(tokenno, p, quad, op1, op2, op3)
+      END
+   END
+END FoldCast ;
+
+
+(*
+   CreateLabelProcedureN - creates a label using procedure name and
+                           an integer.
+*)
+
+PROCEDURE CreateLabelProcedureN (proc: CARDINAL; leader: ARRAY OF CHAR;
+                                 unboundedCount, n: CARDINAL) : String ;
+VAR
+   n1, n2: String ;
+BEGIN
+   n1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(proc)))) ;
+   n2 := Mark(InitString(leader)) ;
+   (* prefixed by .L unboundedCount and n to ensure that no Modula-2 identifiers clash *)
+   RETURN( Sprintf4(Mark(InitString('.L%d.%d.unbounded.%s.%s')), unboundedCount, n, n1, n2) )
+END CreateLabelProcedureN ;
+
+
+(*
+   CreateLabelName - creates a namekey from quadruple, q.
+*)
+
+PROCEDURE CreateLabelName (q: CARDINAL) : String ;
+BEGIN
+   (* prefixed by . to ensure that no Modula-2 identifiers clash *)
+   RETURN( Sprintf1(Mark(InitString('.L%d')), q) )
+END CreateLabelName ;
+
+
+(*
+   CodeGoto - creates a jump to a labeled quadruple.
+*)
+
+PROCEDURE CodeGoto (destquad: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+   BuildGoto (location, string (CreateLabelName (destquad)))
+END CodeGoto ;
+
+
+(*
+   CheckReferenced - checks to see whether this quadruple requires a label.
+*)
+
+PROCEDURE CheckReferenced (quad: CARDINAL; op: QuadOperator) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* we do not create labels for procedure entries *)
+   IF (op#ProcedureScopeOp) AND (op#NewLocalVarOp) AND IsReferenced(quad)
+   THEN
+      DeclareLabel(location, string(CreateLabelName(quad)))
+   END
+END CheckReferenced ;
+
+
+(*
+   CodeIfSetLess -
+*)
+
+PROCEDURE CodeIfSetLess (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   settype   : CARDINAL ;
+   falselabel: ADDRESS ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      InternalError ('this should have been folded in the calling procedure')
+   ELSIF IsConst(op1)
+   THEN
+      settype := SkipType(GetType(op2))
+   ELSE
+      settype := SkipType(GetType(op1))
+   END ;
+   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
+   THEN
+      (* word size sets *)
+      DoJump(location,
+             BuildIsNotSuperset(location,
+                                BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
+                                BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
+             NIL, string(CreateLabelName(op3)))
+   ELSE
+      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
+
+      BuildForeachWordInSetDoIfExpr(location,
+                                    Mod2Gcc(settype),
+                                    Mod2Gcc(op1), Mod2Gcc(op2),
+                                    GetMode(op1)=LeftValue,
+                                    GetMode(op2)=LeftValue,
+                                    IsConst(op1), IsConst(op2),
+                                    BuildIsSuperset,
+                                    falselabel) ;
+
+      BuildGoto(location, string(CreateLabelName(op3))) ;
+      DeclareLabel(location, falselabel)
+   END
+END CodeIfSetLess ;
+
+
+(*
+   CodeIfLess - codes the quadruple if op1 < op2 then goto op3
+*)
+
+PROCEDURE CodeIfLess (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   tl, tr  : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, op1) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      PushValue(op1) ;
+      PushValue(op2) ;
+      IF Less(CurrentQuadToken)
+      THEN
+         BuildGoto(location, string(CreateLabelName(op3)))
+      ELSE
+         (* fall through *)
+      END
+   ELSIF IsConstSet(op1) OR (IsVar(op1) AND IsSet(SkipType(GetType(op1)))) OR
+         IsConstSet(op2) OR (IsVar(op2) AND IsSet(SkipType(GetType(op2))))
+   THEN
+      CodeIfSetLess(quad, op1, op2, op3)
+   ELSE
+      IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
+      THEN
+         MetaErrorT2 (CurrentQuadToken,
+                      'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
+                      op1, op2)
+      ELSE
+         ConvertBinaryOperands(location,
+                               tl, tr,
+                               MixTypes(SkipType(GetType(op1)),
+                                        SkipType(GetType(op2)),
+                                        CurrentQuadToken),
+                               op1, op2) ;
+         DoJump(location,
+                BuildLessThan(location, tl, tr), NIL, string(CreateLabelName(op3)))
+      END
+   END
+END CodeIfLess ;
+
+
+(*
+   CodeIfSetGre -
+*)
+
+PROCEDURE CodeIfSetGre (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   settype   : CARDINAL ;
+   falselabel: ADDRESS ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      InternalError ('this should have been folded in the calling procedure')
+   ELSIF IsConst(op1)
+   THEN
+      settype := SkipType(GetType(op2))
+   ELSE
+      settype := SkipType(GetType(op1))
+   END ;
+   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
+   THEN
+      (* word size sets *)
+      DoJump(location,
+             BuildIsNotSubset(location,
+                              BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
+                              BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
+             NIL, string(CreateLabelName(op3)))
+   ELSE
+      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
+
+      BuildForeachWordInSetDoIfExpr(location,
+                                    Mod2Gcc(settype),
+                                    Mod2Gcc(op1), Mod2Gcc(op2),
+                                    GetMode(op1)=LeftValue,
+                                    GetMode(op2)=LeftValue,
+                                    IsConst(op1), IsConst(op2),
+                                    BuildIsSubset,
+                                    falselabel) ;
+
+      BuildGoto(location, string(CreateLabelName(op3))) ;
+      DeclareLabel(location, falselabel)
+   END
+END CodeIfSetGre ;
+
+
+(*
+   CodeIfGre - codes the quadruple if op1 > op2 then goto op3
+*)
+
+PROCEDURE CodeIfGre (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   tl, tr  : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, op1) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op1) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      PushValue(op1) ;
+      PushValue(op2) ;
+      IF Gre(CurrentQuadToken)
+      THEN
+         BuildGoto(location, string(CreateLabelName(op3)))
+      ELSE
+         (* fall through *)
+      END
+   ELSIF IsConstSet(op1) OR (IsVar(op1) AND IsSet(SkipType(GetType(op1)))) OR
+         IsConstSet(op2) OR (IsVar(op2) AND IsSet(SkipType(GetType(op2))))
+   THEN
+      CodeIfSetGre(quad, op1, op2, op3)
+   ELSE
+      IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
+      THEN
+         MetaErrorT2 (CurrentQuadToken,
+                      'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
+                      op1, op2)
+      ELSE
+         ConvertBinaryOperands(location,
+                               tl, tr,
+                               MixTypes(SkipType(GetType(op1)),
+                                        SkipType(GetType(op2)),
+                                        CurrentQuadToken),
+                               op1, op2) ;
+         DoJump(location, BuildGreaterThan(location, tl, tr), NIL, string(CreateLabelName(op3)))
+      END
+   END
+END CodeIfGre ;
+
+
+(*
+   CodeIfSetLessEqu -
+*)
+
+PROCEDURE CodeIfSetLessEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   settype   : CARDINAL ;
+   falselabel: ADDRESS ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      InternalError ('this should have been folded in the calling procedure')
+   ELSIF IsConst(op1)
+   THEN
+      settype := SkipType(GetType(op2))
+   ELSE
+      settype := SkipType(GetType(op1))
+   END ;
+   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
+   THEN
+      (* word size sets *)
+      DoJump(location,
+             BuildIsSubset(location,
+                           BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
+                           BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
+             NIL, string(CreateLabelName(op3)))
+   ELSE
+      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
+
+      BuildForeachWordInSetDoIfExpr(location,
+                                    Mod2Gcc(settype),
+                                    Mod2Gcc(op1), Mod2Gcc(op2),
+                                    GetMode(op1)=LeftValue,
+                                    GetMode(op2)=LeftValue,
+                                    IsConst(op1), IsConst(op2),
+                                    BuildIsNotSubset,
+                                    falselabel) ;
+
+      BuildGoto(location, string(CreateLabelName(op3))) ;
+      DeclareLabel(location, falselabel)
+   END
+END CodeIfSetLessEqu ;
+
+
+(*
+   CodeIfLessEqu - codes the quadruple if op1 <= op2 then goto op3
+*)
+
+PROCEDURE CodeIfLessEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   tl, tr  : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, op1) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op1) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      PushValue(op1) ;
+      PushValue(op2) ;
+      IF LessEqu(CurrentQuadToken)
+      THEN
+         BuildGoto(location, string(CreateLabelName(op3)))
+      ELSE
+         (* fall through *)
+      END
+   ELSIF IsConstSet(op1) OR (IsVar(op1) AND IsSet(SkipType(GetType(op1)))) OR
+         IsConstSet(op2) OR (IsVar(op2) AND IsSet(SkipType(GetType(op2))))
+   THEN
+      CodeIfSetLessEqu(quad, op1, op2, op3)
+   ELSE
+      IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
+      THEN
+         MetaErrorT2 (CurrentQuadToken,
+                      'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
+                      op1, op2)
+      ELSE
+         ConvertBinaryOperands(location,
+                               tl, tr,
+                               MixTypes(SkipType(GetType(op1)),
+                                        SkipType(GetType(op2)),
+                                        CurrentQuadToken),
+                               op1, op2) ;
+         DoJump(location, BuildLessThanOrEqual(location, tl, tr), NIL, string(CreateLabelName(op3)))
+      END
+   END
+END CodeIfLessEqu ;
+
+
+(*
+   CodeIfSetGreEqu -
+*)
+
+PROCEDURE CodeIfSetGreEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   settype   : CARDINAL ;
+   falselabel: ADDRESS ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      InternalError ('this should have been folded in the calling procedure')
+   ELSIF IsConst(op1)
+   THEN
+      settype := SkipType(GetType(op2))
+   ELSE
+      settype := SkipType(GetType(op1))
+   END ;
+   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
+   THEN
+      (* word size sets *)
+      DoJump(location,
+             BuildIsSuperset(location,
+                             BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
+                             BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
+             NIL, string(CreateLabelName(op3)))
+   ELSE
+      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
+
+      BuildForeachWordInSetDoIfExpr(location,
+                                    Mod2Gcc(settype),
+                                    Mod2Gcc(op1), Mod2Gcc(op2),
+                                    GetMode(op1)=LeftValue,
+                                    GetMode(op2)=LeftValue,
+                                    IsConst(op1), IsConst(op2),
+                                    BuildIsNotSuperset,
+                                    falselabel) ;
+
+      BuildGoto(location, string(CreateLabelName(op3))) ;
+      DeclareLabel(location, falselabel)
+   END
+END CodeIfSetGreEqu ;
+
+
+(*
+   CodeIfGreEqu - codes the quadruple if op1 >= op2 then goto op3
+*)
+
+PROCEDURE CodeIfGreEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   tl, tr: Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, op1) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op1) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      PushValue(op1) ;
+      PushValue(op2) ;
+      IF GreEqu(CurrentQuadToken)
+      THEN
+         BuildGoto(location, string(CreateLabelName(op3)))
+      ELSE
+         (* fall through *)
+      END
+   ELSIF IsConstSet(op1) OR (IsVar(op1) AND IsSet(SkipType(GetType(op1)))) OR
+         IsConstSet(op2) OR (IsVar(op2) AND IsSet(SkipType(GetType(op2))))
+   THEN
+      CodeIfSetGreEqu(quad, op1, op2, op3)
+   ELSE
+      IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
+      THEN
+         MetaErrorT2 (CurrentQuadToken,
+                      'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
+                      op1, op2)
+      ELSE
+         ConvertBinaryOperands(location,
+                               tl, tr,
+                               MixTypes(SkipType(GetType(op1)),
+                                        SkipType(GetType(op2)),
+                                        CurrentQuadToken),
+                               op1, op2) ;
+         DoJump(location, BuildGreaterThanOrEqual(location, tl, tr), NIL, string(CreateLabelName(op3)))
+      END
+   END
+END CodeIfGreEqu ;
+
+
+(*
+   CodeIfSetEqu - codes if op1 = op2 then goto op3
+                  Note that if op1 and op2 are not both constants
+                  since this will have been evaluated in CodeIfEqu.
+*)
+
+PROCEDURE CodeIfSetEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   settype   : CARDINAL ;
+   falselabel: ADDRESS ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      InternalError ('this should have been folded in the calling procedure')
+   ELSIF IsConst(op1)
+   THEN
+      settype := SkipType(GetType(op2))
+   ELSE
+      settype := SkipType(GetType(op1))
+   END ;
+   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
+   THEN
+      (* word size sets *)
+      DoJump(location,
+             BuildEqualTo(location,
+                          BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
+                          BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
+             NIL, string(CreateLabelName(op3)))
+   ELSIF GetSType(op1)=GetSType(op2)
+   THEN
+      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
+
+      BuildForeachWordInSetDoIfExpr(location,
+                                    Mod2Gcc(settype),
+                                    Mod2Gcc(op1), Mod2Gcc(op2),
+                                    GetMode(op1)=LeftValue,
+                                    GetMode(op2)=LeftValue,
+                                    IsConst(op1), IsConst(op2),
+                                    BuildNotEqualTo,
+                                    falselabel) ;
+
+      BuildGoto(location, string(CreateLabelName(op3))) ;
+      DeclareLabel(location, falselabel)
+   ELSE
+      MetaErrorT2 (CurrentQuadToken,
+                   'set comparison is only allowed between the same set type, the set types used by {%1Eatd} and {%2atd} are different',
+                   op1, op2)
+   END
+END CodeIfSetEqu ;
+
+
+(*
+   CodeIfSetNotEqu - codes if op1 # op2 then goto op3
+                     Note that if op1 and op2 are not both constants
+                     since this will have been evaluated in CodeIfNotEqu.
+*)
+
+PROCEDURE CodeIfSetNotEqu (left, right, destQuad: CARDINAL) ;
+VAR
+   settype  : CARDINAL ;
+   truelabel: ADDRESS ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   IF IsConst (left) AND IsConst (right)
+   THEN
+      InternalError ('this should have been folded in the calling procedure')
+   ELSIF IsConst (left)
+   THEN
+      settype := SkipType (GetType (right))
+   ELSE
+      settype := SkipType (GetType (left))
+   END ;
+   IF CompareTrees (FindSize (CurrentQuadToken, settype), FindSize (CurrentQuadToken, Word)) <= 0
+   THEN
+      (* word size sets *)
+      DoJump (location,
+              BuildNotEqualTo(location,
+                              BuildConvert (location, GetWordType (), Mod2Gcc (left), FALSE),
+                              BuildConvert (location, GetWordType (), Mod2Gcc (right), FALSE)),
+              NIL, string (CreateLabelName (destQuad)))
+   ELSIF GetSType (left) = GetSType (right)
+   THEN
+      truelabel := string (CreateLabelName (destQuad)) ;
+
+      BuildForeachWordInSetDoIfExpr (location,
+                                     Mod2Gcc (settype),
+                                     Mod2Gcc (left), Mod2Gcc (right),
+                                     GetMode (left) = LeftValue,
+                                     GetMode (right) = LeftValue,
+                                     IsConst (left), IsConst (right),
+                                     BuildNotEqualTo,
+                                     truelabel)
+   ELSE
+      MetaErrorT2 (CurrentQuadToken,
+                   'set comparison is only allowed between the same set type, the set types used by {%1Eatd} and {%2atd} are different',
+                   left, right)
+   END
+END CodeIfSetNotEqu ;
+
+
+(*
+   CodeIfEqu - codes the quadruple if op1 = op2 then goto op3
+*)
+
+PROCEDURE CodeIfEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   tl, tr: Tree ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, op1) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op1) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      PushValue(op1) ;
+      PushValue(op2) ;
+      IF Equ(CurrentQuadToken)
+      THEN
+         BuildGoto(location, string(CreateLabelName(op3)))
+      ELSE
+         (* fall through *)
+      END
+   ELSIF IsConstSet(op1) OR (IsVar(op1) AND IsSet(SkipType(GetType(op1)))) OR
+         IsConstSet(op2) OR (IsVar(op2) AND IsSet(SkipType(GetType(op2))))
+   THEN
+      CodeIfSetEqu(quad, op1, op2, op3)
+   ELSE
+      IF IsComposite(GetType(op1)) OR IsComposite(GetType(op2))
+      THEN
+         MetaErrorT2 (CurrentQuadToken,
+                      'equality tests between composite types not allowed {%1Eatd} and {%2atd}',
+                      op1, op2)
+      ELSE
+         ConvertBinaryOperands(location,
+                               tl, tr,
+                               MixTypes(SkipType(GetType(op1)),
+                                        SkipType(GetType(op2)),
+                                        CurrentQuadToken),
+                               op1, op2) ;
+         DoJump(location, BuildEqualTo(location, tl, tr), NIL, string(CreateLabelName(op3)))
+      END
+   END
+END CodeIfEqu ;
+
+
+(*
+   CodeIfNotEqu - codes the quadruple if op1 # op2 then goto op3
+*)
+
+PROCEDURE CodeIfNotEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   tl, tr  : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, op1) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op1) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      PushValue(op1) ;
+      PushValue(op2) ;
+      IF NotEqu(CurrentQuadToken)
+      THEN
+         BuildGoto(location, string(CreateLabelName(op3)))
+      ELSE
+         (* fall through *)
+      END
+   ELSIF IsConstSet(op1) OR (IsVar(op1) AND IsSet(SkipType(GetType(op1)))) OR
+         IsConstSet(op2) OR (IsVar(op2) AND IsSet(SkipType(GetType(op2))))
+   THEN
+      CodeIfSetNotEqu (op1, op2, op3)
+   ELSE
+      IF IsComposite(op1) OR IsComposite(op2)
+      THEN
+         MetaErrorT2 (CurrentQuadToken,
+                      'inequality tests between composite types not allowed {%1Eatd} and {%2atd}',
+                      op1, op2)
+      ELSE
+         ConvertBinaryOperands(location,
+                               tl, tr,
+                               MixTypes(SkipType(GetType(op1)),
+                                        SkipType(GetType(op2)),
+                                        CurrentQuadToken),
+                               op1, op2) ;
+         DoJump(location,
+                BuildNotEqualTo(location, tl, tr), NIL, string(CreateLabelName(op3)))
+      END
+   END
+END CodeIfNotEqu ;
+
+
+(*
+   MixTypes3 - returns a type compatible from, low, high, var.
+*)
+
+PROCEDURE MixTypes3 (low, high, var: CARDINAL; tokenno: CARDINAL) : CARDINAL ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   type := MixTypes(SkipType(GetType(low)), SkipType(GetType(high)), tokenno) ;
+   type := MixTypes(type, SkipType(GetType(var)), tokenno) ;
+   RETURN( type )
+END MixTypes3 ;
+
+
+(*
+   BuildIfVarInConstValue - if var in constsetvalue then goto trueexit
+*)
+
+PROCEDURE BuildIfVarInConstValue (location: location_t; tokenno: CARDINAL;
+                                  constsetvalue: PtrToValue; var, trueexit: CARDINAL) ;
+VAR
+   vt, lt, ht  : Tree ;
+   type,
+   low, high, n: CARDINAL ;
+   truelabel   : String ;
+BEGIN
+   n := 1 ;
+   truelabel := string(CreateLabelName(trueexit)) ;
+   WHILE GetRange(constsetvalue, n, low, high) DO
+      type := MixTypes3(low, high, var, tokenno) ;
+      ConvertBinaryOperands(location, vt, lt, type, var, low) ;
+      ConvertBinaryOperands(location, ht, lt, type, high, low) ;
+      BuildIfInRangeGoto(location, vt, lt, ht, truelabel) ;
+      INC(n)
+   END
+END BuildIfVarInConstValue ;
+
+
+(*
+   BuildIfNotVarInConstValue - if not (var in constsetvalue) then goto trueexit
+*)
+
+PROCEDURE BuildIfNotVarInConstValue (quad: CARDINAL; constsetvalue: PtrToValue; var, trueexit: CARDINAL) ;
+VAR
+   vt, lt, ht  : Tree ;
+   type,
+   low, high, n: CARDINAL ;
+   falselabel,
+   truelabel   : String ;
+   location    : location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   truelabel := string(CreateLabelName(trueexit)) ;
+   n := 1 ;
+   WHILE GetRange(constsetvalue, n, low, high) DO
+      INC(n)
+   END ;
+   IF n=2
+   THEN
+      (* actually only one set range, so we invert it *)
+      type := MixTypes3(low, high, var, CurrentQuadToken) ;
+      ConvertBinaryOperands(location, vt, lt, type, var, low) ;
+      ConvertBinaryOperands(location, ht, lt, type, high, low) ;
+      BuildIfNotInRangeGoto(location, vt, lt, ht, truelabel)
+   ELSE
+      n := 1 ;
+      falselabel := string(Sprintf1(Mark(InitString('.Lset%d')), quad)) ;
+      WHILE GetRange(constsetvalue, n, low, high) DO
+         type := MixTypes3(low, high, var, CurrentQuadToken) ;
+         ConvertBinaryOperands(location, vt, lt, type, var, low) ;
+         ConvertBinaryOperands(location, ht, lt, type, high, low) ;
+         BuildIfInRangeGoto(location, vt, lt, ht, falselabel) ;
+         INC(n)
+      END ;
+      BuildGoto(location, truelabel) ;
+      DeclareLabel(location, falselabel)
+   END
+END BuildIfNotVarInConstValue ;
+
+
+(*
+   CodeIfIn - code the quadruple: if op1 in op2 then goto op3
+*)
+
+PROCEDURE CodeIfIn (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   low,
+   high    : CARDINAL ;
+   lowtree,
+   hightree,
+   offset  : Tree ;
+   fieldno : INTEGER ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, op1) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op1) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      InternalError ('should not get to here (if we do we should consider calling FoldIfIn)')
+   ELSE
+      IF IsConst(op1)
+      THEN
+         fieldno := GetFieldNo(CurrentQuadToken, op1, GetType(op2), offset) ;
+         IF fieldno>=0
+         THEN
+            PushValue(op1) ;
+            PushIntegerTree(offset) ;
+            ConvertToType(GetType(op1)) ;
+            Sub ;
+            BuildIfConstInVar(location,
+                              Mod2Gcc(SkipType(GetType(op2))),
+                              Mod2Gcc(op2), PopIntegerTree(),
+                              GetMode(op2)=LeftValue, fieldno,
+                              string(CreateLabelName(op3)))
+         ELSE
+            MetaErrorT1 (CurrentQuadToken, 'bit exceeded the range of set {%1Eatd}', op1)
+         END
+      ELSIF IsConst(op2)
+      THEN
+         (* builds a cascaded list of if statements *)
+         PushValue(op2) ;
+         BuildIfVarInConstValue(location, CurrentQuadToken, GetValue(CurrentQuadToken), op1, op3)
+      ELSE
+         GetSetLimits(SkipType(GetType(op2)), low, high) ;
+
+         PushValue(low) ;
+         lowtree := PopIntegerTree() ;
+         PushValue(high) ;
+         hightree := PopIntegerTree() ;
+
+         BuildIfVarInVar(location,
+                         Mod2Gcc(SkipType(GetType(op2))),
+                         Mod2Gcc(op2), Mod2Gcc(op1),
+                         GetMode(op2)=LeftValue,
+                         lowtree, hightree,
+                         string(CreateLabelName(op3)))
+      END
+   END
+END CodeIfIn ;
+
+
+(*
+   CodeIfNotIn - code the quadruple: if not (op1 in op2) then goto op3
+*)
+
+PROCEDURE CodeIfNotIn (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   low,
+   high    : CARDINAL ;
+   lowtree,
+   hightree,
+   offset  : Tree ;
+   fieldno : INTEGER ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   (* firstly ensure that any constant literal is declared *)
+   DeclareConstant(CurrentQuadToken, op1) ;
+   DeclareConstant(CurrentQuadToken, op2) ;
+   DeclareConstructor(CurrentQuadToken, quad, op1) ;
+   DeclareConstructor(CurrentQuadToken, quad, op2) ;
+   IF IsConst(op1) AND IsConst(op2)
+   THEN
+      InternalError ('should not get to here (if we do we should consider calling FoldIfIn)')
+   ELSE
+      IF IsConst(op1)
+      THEN
+         fieldno := GetFieldNo(CurrentQuadToken, op1, SkipType(GetType(op2)), offset) ;
+         IF fieldno>=0
+         THEN
+            PushValue(op1) ;
+            PushIntegerTree(offset) ;
+            ConvertToType(GetType(op1)) ;
+            Sub ;
+            BuildIfNotConstInVar(location,
+                                 Mod2Gcc(SkipType(GetType(op2))),
+                                 Mod2Gcc(op2), PopIntegerTree(),
+                                 GetMode(op2)=LeftValue, fieldno,
+                                 string(CreateLabelName(op3)))
+         ELSE
+            MetaErrorT1 (CurrentQuadToken, 'bit exceeded the range of set {%1Eatd}', op2)
+         END
+      ELSIF IsConst(op2)
+      THEN
+         (* builds a cascaded list of if statements *)
+         PushValue(op2) ;
+         BuildIfNotVarInConstValue(quad, GetValue(CurrentQuadToken), op1, op3)
+      ELSE
+         GetSetLimits(SkipType(GetType(op2)), low, high) ;
+
+         PushValue(low) ;
+         lowtree := PopIntegerTree() ;
+         PushValue(high) ;
+         hightree := PopIntegerTree() ;
+
+         BuildIfNotVarInVar(location,
+                            Mod2Gcc(SkipType(GetType(op2))),
+                            Mod2Gcc(op2), Mod2Gcc(op1),
+                            GetMode(op2)=LeftValue,
+                            lowtree, hightree,
+                            string(CreateLabelName(op3)))
+      END
+   END
+END CodeIfNotIn ;
+
+
+(*
+------------------------------------------------------------------------------
+   IndrX Operator           a = *b
+------------------------------------------------------------------------------
+   Sym1<X>   IndrX   Sym2<I>     Meaning     Mem[Sym1<I>] := Mem[constant]
+   Sym1<X>   IndrX   Sym2<X>     Meaning     Mem[Sym1<I>] := Mem[Mem[Sym3<I>]]
+
+   (op2 is the type of the data being indirectly copied)
+*)
+
+PROCEDURE CodeIndrX (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (CurrentQuadToken) ;
+
+   (*
+      Follow the Quadruple rules:
+   *)
+   DeclareConstant (CurrentQuadToken, op3) ;  (* checks to see whether it is a constant and declares it *)
+   DeclareConstructor (CurrentQuadToken, quad, op3) ;
+   IF IsConstString (op3)
+   THEN
+      InternalError ('not expecting to index through a constant string')
+   ELSE
+      (*
+         Mem[op1] := Mem[Mem[op3]]
+      *)
+      BuildAssignmentStatement (location, Mod2Gcc (op1), BuildIndirect (location, Mod2Gcc (op3), Mod2Gcc (op2)))
+   END
+END CodeIndrX ;
+
+
+(*
+------------------------------------------------------------------------------
+   XIndr Operator           *a = b
+------------------------------------------------------------------------------
+   Sym1<I>   XIndr   Sym2<X>     Meaning     Mem[constant]     := Mem[Sym3<I>]
+   Sym1<X>   XIndr   Sym2<X>     Meaning     Mem[Mem[Sym1<I>]] := Mem[Sym3<I>]
+
+   (op2 is the type of the data being indirectly copied)
+*)
+
+PROCEDURE CodeXIndr (quad: CARDINAL; op1, type, op3: CARDINAL) ;
+VAR
+   length,
+   newstr  : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(CurrentQuadToken) ;
+
+   type := SkipType (type) ;
+   DeclareConstant(CurrentQuadToken, op3) ;
+   DeclareConstructor(CurrentQuadToken, quad, op3) ;
+   (*
+      Follow the Quadruple rule:
+
+      Mem[Mem[Op1]] := Mem[Op3]
+   *)
+   IF IsProcType(SkipType(type))
+   THEN
+      BuildAssignmentStatement (location, BuildIndirect(location, Mod2Gcc(op1), GetPointerType()), Mod2Gcc(op3))
+   ELSIF IsConstString(op3) AND (GetStringLength(op3)=0) AND (GetMode(op1)=LeftValue)
+   THEN
+      (*
+         no need to check for type errors,
+         but we handle nul string as a special case as back end
+         complains if we pass through a "" and ask it to copy the
+         contents.
+      *)
+      BuildAssignmentStatement (location,
+                                BuildIndirect(location, LValueToGenericPtr(location, op1), Mod2Gcc(Char)),
+                                StringToChar(Mod2Gcc(op3), Char, op3))
+   ELSIF IsConstString(op3) AND (SkipTypeAndSubrange(GetType(op1))#Char)
+   THEN
+      DoCopyString (CurrentQuadToken, length, newstr, type, op3) ;
+      AddStatement (location,
+                    MaybeDebugBuiltinMemcpy (location, CurrentQuadToken,
+                                             Mod2Gcc (op1),
+                                             BuildAddr (location, newstr, FALSE),
+                                             length))
+   ELSE
+      BuildAssignmentStatement (location,
+                                BuildIndirect (location, Mod2Gcc (op1), Mod2Gcc (type)),
+                                ConvertRHS (Mod2Gcc (op3), type, op3))
+   END
+END CodeXIndr ;
+
+
+BEGIN
+   UnboundedLabelNo := 0 ;
+   CurrentQuadToken := 0 ;
+   ScopeStack := InitStackWord ()
+END M2GenGCC.
diff --git a/gcc/m2/gm2-compiler/M2Graph.def b/gcc/m2/gm2-compiler/M2Graph.def
new file mode 100644
index 00000000000..261e46fb354
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Graph.def
@@ -0,0 +1,58 @@
+(* M2Graph.def maintains the dependancy graph depth.
+
+Copyright (C) 2022 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/>.  *)
+
+DEFINITION MODULE M2Graph ;
+
+FROM Lists IMPORT List ;
+
+TYPE
+   Graph ;
+
+
+(*
+   InitGraph - creates and returns an empty graph.
+*)
+
+PROCEDURE InitGraph () : Graph ;
+
+
+(*
+   KillGraph - deletes graph and all nodes.
+*)
+
+PROCEDURE KillGraph (VAR g: Graph) ;
+
+
+(*
+   AddDependent - adds moduleSym <- dependSym into the graph.
+*)
+
+PROCEDURE AddDependent (graph: Graph; moduleSym, dependSym: CARDINAL) ;
+
+
+(*
+   SortGraph - returns a List containing the sorted graph.
+*)
+
+PROCEDURE SortGraph (g: Graph; topModule: CARDINAL) : List ;
+
+
+END M2Graph.
diff --git a/gcc/m2/gm2-compiler/M2Graph.mod b/gcc/m2/gm2-compiler/M2Graph.mod
new file mode 100644
index 00000000000..489186a4b3b
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Graph.mod
@@ -0,0 +1,234 @@
+(* M2Graph.mod maintains the dependancy graph depth.
+
+Copyright (C) 2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Graph ;
+
+
+FROM Storage IMPORT ALLOCATE ;
+FROM StrLib IMPORT StrEqual, StrCopy ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NameKey IMPORT Name, WriteKey ;
+FROM Lists IMPORT InitList, KillList, IncludeItemIntoList, RemoveItemFromList ;
+FROM Indexing IMPORT Index, HighIndice, IncludeIndiceIntoIndex, InitIndex, KillIndex, GetIndice ;
+FROM M2Printf IMPORT printf0, printf1, printf2 ;
+FROM SymbolTable IMPORT GetSymName, IsDefinitionForC, IsModule ;
+
+
+CONST
+   Debugging = FALSE ;
+
+TYPE
+   state = (initial, started, ordered) ;
+
+   node = POINTER TO RECORD
+             moduleSym: CARDINAL ;  (* SymbolTable entry for module.  *)
+             deps     : Index ;
+             nstate   : state ;
+          END ;
+
+   Graph = POINTER TO RECORD
+                         nodes: Index ;
+                      END ;
+
+
+(*
+   InitGraph - creates and returns an empty graph.
+*)
+
+PROCEDURE InitGraph () : Graph ;
+VAR
+   g: Graph ;
+BEGIN
+   NEW (g) ;
+   g^.nodes := InitIndex (1) ;
+   RETURN g
+END InitGraph ;
+
+
+(*
+   KillNode - deletes the dynamic storage associated with nptr.
+*)
+
+PROCEDURE KillNode (nptr: node) ;
+BEGIN
+   nptr^.deps := KillIndex (nptr^.deps)
+END KillNode ;
+
+
+(*
+   KillGraph - deletes graph and all nodes.
+*)
+
+PROCEDURE KillGraph (VAR g: Graph) ;
+VAR
+   i, n: CARDINAL ;
+   nptr: node ;
+BEGIN
+   n := HighIndice (g^.nodes) ;
+   i := 1 ;
+   WHILE i <= n DO
+      nptr := GetIndice (g^.nodes, i) ;
+      KillNode (nptr) ;
+      INC (i)
+   END ;
+   g := NIL
+END KillGraph ;
+
+
+(*
+   initNode - create a new node in graph and return the node.
+*)
+
+PROCEDURE initNode (graph: Graph; moduleSym: CARDINAL) : node ;
+VAR
+   nptr: node ;
+BEGIN
+   NEW (nptr) ;
+   nptr^.moduleSym := moduleSym ;
+   nptr^.deps := InitIndex (1) ;
+   nptr^.nstate := initial ;
+   IncludeIndiceIntoIndex (graph^.nodes, nptr) ;
+   RETURN nptr
+END initNode ;
+
+
+(*
+   getNode - returns a node from graph representing moduleSym.
+             If the node does not exist it is created.
+*)
+
+PROCEDURE getNode (graph: Graph; moduleSym: CARDINAL) : node ;
+VAR
+   i, n: CARDINAL ;
+   nptr: node ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (graph^.nodes) ;
+   WHILE i <= n DO
+      nptr := GetIndice (graph^.nodes, i) ;
+      IF nptr^.moduleSym = moduleSym
+      THEN
+         RETURN nptr
+      END ;
+      INC (i)
+   END ;
+   RETURN initNode (graph, moduleSym)
+END getNode ;
+
+
+(*
+   createDependent - mptr imports from dptr.
+*)
+
+PROCEDURE createDependent (mptr, dptr: node) ;
+BEGIN
+   IncludeIndiceIntoIndex (mptr^.deps, dptr)
+END createDependent ;
+
+
+(*
+   AddDependent - adds moduleSym <- dependSym into the graph.
+*)
+
+PROCEDURE AddDependent (graph: Graph; moduleSym, dependSym: CARDINAL) ;
+VAR
+   mptr, dptr: node ;
+BEGIN
+   IF (IsModule (moduleSym) OR (NOT IsDefinitionForC (moduleSym))) AND
+      (IsModule (dependSym) OR (NOT IsDefinitionForC (dependSym)))
+   THEN
+      mptr := getNode (graph, moduleSym) ;
+      dptr := getNode (graph, dependSym) ;
+      createDependent (mptr, dptr)
+   END
+END AddDependent ;
+
+
+(*
+   SortGraph - returns a List containing the sorted graph.
+*)
+
+PROCEDURE SortGraph (g: Graph; topModule: CARDINAL) : List ;
+VAR
+   sorted: List ;
+   nptr  : node ;
+BEGIN
+   InitList (sorted) ;
+   setNodesInitial (g) ;
+   nptr := getNode (g, topModule) ;
+   resolveImports (sorted, nptr) ;
+   RemoveItemFromList (sorted, topModule) ;
+   IncludeItemIntoList (sorted, topModule) ;  (* Ensure topModule is last.  *)
+   RETURN sorted
+END SortGraph ;
+
+
+(*
+   resolveImports - recursively resolve imports using ISO Modula-2
+                    rules for the order of module initialization.
+*)
+
+PROCEDURE resolveImports (sorted: List; nptr: node) ;
+VAR
+     i, n: CARDINAL ;
+  name: Name ;
+BEGIN
+   IF nptr^.nstate = initial
+   THEN
+      nptr^.nstate := started ;
+      name := GetSymName (nptr^.moduleSym) ;
+      i := 1 ;
+      n := HighIndice (nptr^.deps) ;
+      IF Debugging
+      THEN
+         printf2 ("resolving %a  %d dependents\n", name, n)
+      END ;
+      WHILE i <= n DO
+         resolveImports (sorted, GetIndice (nptr^.deps, i)) ;
+         INC (i)
+      END ;
+      nptr^.nstate := ordered ;
+      IncludeItemIntoList (sorted, nptr^.moduleSym)
+   END
+END resolveImports ;
+
+
+(*
+   setNodesInitial - changes the state of all nodes in graph to initial.
+*)
+
+PROCEDURE setNodesInitial (g: Graph) ;
+VAR
+   i, n: CARDINAL ;
+   nptr: node ;
+BEGIN
+   i := 1 ;
+   n := HighIndice (g^.nodes) ;
+   WHILE i <= n DO
+      nptr := GetIndice (g^.nodes, i) ;
+      nptr^.nstate := initial ;
+      INC (i)
+   END
+END setNodesInitial ;
+
+
+END M2Graph.
diff --git a/gcc/m2/gm2-compiler/M2Lex.def b/gcc/m2/gm2-compiler/M2Lex.def
new file mode 100644
index 00000000000..34a2b2ea96e
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Lex.def
@@ -0,0 +1,106 @@
+(* M2Lex.def provides a non tokenised lexical analyser.
+
+Copyright (C) 2001-2022 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/>.  *)
+DEFINITION MODULE M2Lex ;
+
+(*
+   Title      : M2Lex
+   Author     : Gaius Mulley
+   Date       : Date: Sat 16-09-1989 Time: 17:54:22.58
+   LastEdit   : Date: Sat 16-09-1989 Time: 17:54:22.58
+   System     : UNIX (GNU Modula-2)
+   Description: Provides a non tokenised version of M2Lexical.
+                Symbols are distinct MODULA-2 symbols.
+*)
+
+EXPORT QUALIFIED MaxLine,
+                 GetSymbol,
+                 PutSymbol,
+                 CurrentSymbol,
+                 LastSymbol,
+                 OpenSource,
+                 CloseSource,
+                 SymIs,
+                 IsSym,
+                 WriteError ;
+
+CONST
+   MaxLine = 1024 ;
+
+VAR
+   LastSymbol,
+   CurrentSymbol : ARRAY [0..MaxLine] OF CHAR ;
+
+
+(*
+   OpenSource - Attempts to open the source file, a.
+                The success of the operation is returned.
+*)
+
+PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   CloseSource - Closes the current open file.
+*)
+
+PROCEDURE CloseSource ;
+
+
+(*
+   SymIs - if Name is equal to the CurrentSymbol the next Symbol is read
+           and true is returned, otherwise false is returned.
+*)
+
+PROCEDURE SymIs (Name: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   IsSym - returns the result of the comparison between CurrentSymbol
+           and Name.
+*)
+
+PROCEDURE IsSym (Name: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   GetSymbol - gets the next Symbol into CurrentSymbol.
+*)
+
+PROCEDURE GetSymbol ;
+
+
+(*
+   PutSymbol - pushes a symbol, Name, back onto the input.
+               GetSymbol will set CurrentSymbol to, Name.
+*)
+
+PROCEDURE PutSymbol (Name: ARRAY OF CHAR) ;
+
+
+(*
+   WriteError - displays the source line and points to the symbol in error.
+                The message, a, is displayed.
+*)
+
+PROCEDURE WriteError (a: ARRAY OF CHAR) ;
+
+
+END M2Lex.
diff --git a/gcc/m2/gm2-compiler/M2Lex.mod b/gcc/m2/gm2-compiler/M2Lex.mod
new file mode 100644
index 00000000000..a38e1bca6b8
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Lex.mod
@@ -0,0 +1,418 @@
+(* M2Lex.mod provides a non tokenised lexical analyser.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Lex ;
+
+
+FROM FIO IMPORT File, OpenToRead, ReadChar, Close, IsNoError ;
+FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
+FROM StdIO IMPORT Write ;
+FROM NumberIO IMPORT WriteCard ;
+FROM ASCII IMPORT nul, lf, cr, EOL ;
+FROM StrLib IMPORT StrCopy, StrEqual, StrLen ;
+
+
+CONST
+   LineBuf = 1 ;
+   Wrap    = LineBuf+1 ;
+   eof     = 032C ;
+   MaxStack= 10 ;
+
+VAR
+   f: File ;
+   Opened        : BOOLEAN ;
+   CurrentChar   : CHAR ;
+   NextChar      : CHAR ;
+   FileName      : ARRAY [0..MaxLine] OF CHAR ;
+   Lines         : ARRAY [0..LineBuf] OF ARRAY [0..255] OF CHAR ;
+                (* Need two lines since the delimiter of the CurrentSymbol *)
+                (* maybe on the next line.                                 *)
+   HighNext      : CARDINAL ;  (* Length of the NextChar line.             *)
+   CurLine       : CARDINAL ;  (* Line number of the Current Char Line.    *)
+   NextLine      : CARDINAL ;  (* Line number of the Next Char Line.       *)
+   IndexCur      : CARDINAL ;  (* Index to the Lines array for Current Ln  *)
+   IndexNext     : CARDINAL ;  (* Index to the Lines array for NextChar Ln *)
+   CurSym        : CARDINAL ;  (* Character start of the CurrentSymbol     *)
+   CurSymLine    : CARDINAL ;  (* Line number of the CurrentSymbol         *)
+   CurCharIndex  : CARDINAL ;  (* Character number of CurChar.             *)
+   NextCharIndex : CARDINAL ;  (* Character number of NextChar.            *)
+   Eof           : BOOLEAN ;   (* End of source file.                      *)
+   InQuotes      : BOOLEAN ;   (* If we are in quotes.                     *)
+   QuoteChar     : CHAR ;      (* Quote character expected.                *)
+   Stack         : ARRAY [0..MaxStack] OF ARRAY [0..255] OF CHAR ;
+   StackPtr      : CARDINAL ;
+
+
+(*
+   IsSym - returns the result of the comparison between CurrentSymbol
+           and Name.
+*)
+
+PROCEDURE IsSym (Name: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( StrEqual(CurrentSymbol, Name) )
+END IsSym ;
+
+
+(*
+   SymIs - if Name is equal to the CurrentSymbol the next Symbol is read
+           and true is returned, otherwise false is returned.
+*)
+
+PROCEDURE SymIs (Name: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   IF StrEqual(CurrentSymbol, Name)
+   THEN
+      GetSymbol ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END SymIs ;
+
+
+(*
+   WriteError - displays the source line and points to the symbol in error.
+                The message, a, is displayed.
+*)
+
+PROCEDURE WriteError (a: ARRAY OF CHAR) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WriteString(FileName) ; Write(':') ; WriteCard(CurSymLine, 0) ; Write(':') ; WriteString(a) ;
+   WriteLn ;
+   WriteString( Lines[IndexCur] ) ; WriteLn ;
+   i := CurSym ;
+   WHILE i>0 DO
+      Write(' ') ;
+      DEC(i)
+   END ;
+   i := StrLen(CurrentSymbol) ;
+   WHILE i>0 DO
+      Write('^') ;
+      DEC(i)
+   END ;
+   WriteLn ;
+   WriteString(a) ; WriteLn ;
+END WriteError ;
+
+
+(*
+   OpenSource - Attempts to open the source file, a.
+                The success of the operation is returned.
+*)
+
+PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   f := OpenToRead(a) ;
+   IF IsNoError(f)
+   THEN
+      StrCopy(a, FileName) ;
+      Opened := TRUE ;
+      Init ;
+      RETURN( TRUE )
+   ELSE
+      Opened := FALSE ;
+      Eof := TRUE ;
+      RETURN( FALSE )
+   END
+END OpenSource ;
+
+
+(*
+   CloseSource - Closes the current open file.
+*)
+
+PROCEDURE CloseSource ;
+BEGIN
+   IF Opened=TRUE
+   THEN
+      Opened := FALSE ;
+      Close( f )
+   END
+END CloseSource ;
+
+
+(*
+   GetSymbol - gets the next Symbol into CurrentSymbol.
+*)
+
+PROCEDURE GetSymbol ;
+BEGIN
+   StrCopy( CurrentSymbol, LastSymbol ) ;
+   IF StackPtr>0
+   THEN
+      DEC(StackPtr) ;
+      StrCopy( Stack[StackPtr], CurrentSymbol )
+   ELSE
+      ReadSymbol( CurrentSymbol )
+   END
+END GetSymbol ;
+
+
+(*
+   PutSymbol - pushes a symbol, Name, back onto the input.
+               GetSymbol will set CurrentSymbol to, Name.
+*)
+
+PROCEDURE PutSymbol (Name: ARRAY OF CHAR) ;
+BEGIN
+   IF StackPtr=MaxStack
+   THEN
+      WriteError('Maximum push back symbol exceeded - Increase CONST MaxStack')
+   ELSE
+      StrCopy(Name, Stack[StackPtr]) ;
+      INC(StackPtr)
+   END
+END PutSymbol ;
+
+
+PROCEDURE ReadSymbol (VAR a: ARRAY OF CHAR) ;
+VAR
+   high,
+   i    : CARDINAL ;
+   ok   : BOOLEAN ;
+BEGIN
+   high := HIGH(a) ;
+   IF NOT Eof
+   THEN
+      IF InQuotes
+      THEN
+         i := 0 ;
+         IF CurrentChar=QuoteChar
+         THEN
+            InQuotes := FALSE ;
+            a[i] := QuoteChar ;
+            INC(i) ;
+            AdvanceChar
+         ELSE
+            (* Fill in string or character *)
+            i := 0 ;
+            REPEAT
+               a[i] := CurrentChar ;
+               INC(i) ;
+               AdvanceChar
+            UNTIL (CurrentChar=QuoteChar) OR Eof OR (i>high) ;
+         END
+      ELSE
+         (* Get rid of all excess spaces *)
+
+         REPEAT
+            IF CurrentChar=' '
+            THEN
+               WHILE (CurrentChar=' ') AND (NOT Eof) DO
+                  AdvanceChar
+               END ;
+               ok := FALSE
+            ELSIF (CurrentChar='(') AND (NextChar='*')
+            THEN
+      	       ConsumeComments ;
+               ok := FALSE
+            ELSE
+              ok := TRUE
+            END
+         UNTIL ok ;
+         i := 0 ;
+         CurSym := CurCharIndex ;
+         CurSymLine := CurLine ;
+         IF (CurrentChar='"') OR (CurrentChar="'")
+         THEN
+            InQuotes := TRUE ;
+            QuoteChar := CurrentChar ;
+            a[i] := CurrentChar ;
+            AdvanceChar ;
+            INC(i)
+         ELSIF DoubleDelimiter()
+         THEN
+            a[i] := CurrentChar ;
+            AdvanceChar ;
+            INC(i) ;
+            a[i] := CurrentChar ;
+            AdvanceChar ;
+            INC(i)
+         ELSIF Delimiter()
+         THEN
+            a[i] := CurrentChar ;
+            AdvanceChar ;
+            INC(i)
+         ELSE
+            REPEAT
+               a[i] := CurrentChar ;
+               AdvanceChar ;
+               INC(i)
+            UNTIL Delimiter() OR (i>high) OR (CurrentChar=' ') OR Eof
+         END
+      END
+   ELSE
+      (* eof *)
+      i := 0 ;
+      a[i] := eof ;
+      INC(i)
+   END ;
+   IF i<=HIGH(a)
+   THEN
+      a[i] := nul
+   END
+END ReadSymbol ;
+
+
+(*
+   ConsumeComments - consumes Modula-2 comments.
+*)
+
+PROCEDURE ConsumeComments ;
+VAR
+   Level: CARDINAL ;
+BEGIN
+   Level := 0 ;
+   REPEAT
+      IF (CurrentChar='(') AND (NextChar='*')
+      THEN
+         INC(Level)
+      ELSIF (CurrentChar='*') AND (NextChar=')')
+      THEN
+         DEC(Level)
+      END ;
+      AdvanceChar ;
+   UNTIL (Level=0) OR Eof ;
+   AdvanceChar
+END ConsumeComments;
+
+
+(* Delimiter returns true if and only if CurrentChar is a delimiter *)
+
+PROCEDURE Delimiter() : BOOLEAN ;
+BEGIN
+   IF (CurrentChar='-') OR
+      (CurrentChar='+') OR (CurrentChar='*') OR (CurrentChar='\') OR
+      (CurrentChar='|') OR (CurrentChar='(') OR (CurrentChar=')') OR
+      (CurrentChar='"') OR (CurrentChar="'") OR (CurrentChar='{')
+   THEN
+      RETURN( TRUE )
+   ELSIF
+      (CurrentChar='}') OR (CurrentChar='[') OR (CurrentChar=']') OR
+      (CurrentChar='#') OR (CurrentChar='=') OR (CurrentChar='<')
+   THEN
+      RETURN( TRUE )
+   ELSIF
+      (CurrentChar='>') OR (CurrentChar='.') OR (CurrentChar=';') OR
+      (CurrentChar=':') OR (CurrentChar='^') OR (CurrentChar=',')
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END Delimiter ;
+
+
+PROCEDURE DoubleDelimiter () : BOOLEAN ;
+BEGIN
+   RETURN (
+           ((CurrentChar='>') AND (NextChar='=')) OR
+           ((CurrentChar='<') AND (NextChar='=')) OR
+           ((CurrentChar='<') AND (NextChar='>')) OR
+           ((CurrentChar=':') AND (NextChar='=')) OR
+           ((CurrentChar='.') AND (NextChar='.'))
+          )
+END DoubleDelimiter ;
+
+
+PROCEDURE AdvanceChar ;
+BEGIN
+   IF NOT Eof
+   THEN
+      CurrentChar := NextChar ;
+      CurCharIndex := NextCharIndex ;
+      IndexCur := IndexNext ;
+      CurLine := NextLine ;
+      IF CurrentChar=eof
+      THEN
+         Eof := TRUE
+      ELSIF NextCharIndex=HighNext
+      THEN
+         IndexNext := (IndexCur+1) MOD Wrap ;
+         HighNext := 0 ;
+         REPEAT
+            NextChar := ReadChar(f) ;
+            IF NOT IsNoError(f)
+            THEN
+               NextChar := eof ;
+               Lines[IndexNext][HighNext] := NextChar ;
+               INC( HighNext )
+            END ;
+            WHILE (NextChar#eof) AND (NextChar#lf) AND (NextChar#cr) AND (HighNext<MaxLine) DO
+               Lines[IndexNext][HighNext] := NextChar ;
+               INC( HighNext ) ;
+               NextChar := ReadChar(f) ;
+               IF NOT IsNoError(f)
+               THEN
+                  NextChar := eof
+               END
+            END ;
+            IF (NextChar=eof) OR (NextChar=lf) OR (NextChar=cr)
+            THEN
+               IF InQuotes
+               THEN
+                  Lines[IndexNext][HighNext] := ' ' ;  (* Space for delimiter *)
+                  Lines[IndexNext][HighNext+1] := nul ;
+                  WriteError('missing end of quote on this source line') ; HALT
+               END ;
+               INC( NextLine )
+            END
+         UNTIL HighNext>0 ;
+         IF HighNext>=MaxLine THEN WriteError('Line too long') ; HALT END ;
+         Lines[IndexNext][HighNext] := ' ' ;  (* Space for delimiter *)
+         Lines[IndexNext][HighNext+1] := nul ;
+         NextCharIndex := 0 ;
+         NextChar := Lines[IndexNext][NextCharIndex]
+      ELSE
+         INC(NextCharIndex) ;
+         NextChar := Lines[IndexNext][NextCharIndex]
+      END
+   END
+END AdvanceChar ;
+
+
+PROCEDURE Init ;
+BEGIN
+   StackPtr := 0 ;
+   InQuotes := FALSE ;
+   Eof := FALSE ;
+   IndexCur := 1 ;
+   IndexNext := 0 ;
+   CurCharIndex := 0 ;
+   Lines[IndexCur][0] := nul ;
+   HighNext := 0 ;
+   NextCharIndex := 0 ;
+   CurLine := 1 ;
+   NextLine := 1 ;
+   CurrentChar := ' ' ;
+   NextChar := ' ' ;
+   StrCopy("", CurrentSymbol) ;
+   StrCopy("", LastSymbol) ;
+   IndexCur := IndexNext
+END Init ;
+
+
+BEGIN
+   Init
+END M2Lex.
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.def b/gcc/m2/gm2-compiler/M2LexBuf.def
new file mode 100644
index 00000000000..038b30b992f
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2LexBuf.def
@@ -0,0 +1,277 @@
+(* M2LexBuf.def provides a buffer for m2.lex.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2LexBuf ;
+
+(*
+    Title      : M2LexBuf
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Jul 27 12:42:13 2001
+    Description: provides a buffer for the all the tokens created by m2.lex.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM M2Reserved IMPORT toktype ;
+FROM DynamicStrings IMPORT String ;
+FROM m2linemap IMPORT location_t ;
+FROM NameKey IMPORT Name ;
+
+EXPORT QUALIFIED OpenSource, CloseSource, ReInitialize, GetToken, InsertToken,
+                 InsertTokenAndRewind, GetPreviousTokenLineNo, GetLineNo,
+                 GetColumnNo, GetTokenNo, TokenToLineNo, TokenToColumnNo,
+                 TokenToLocation, GetTokenName,
+                 FindFileNameFromToken, GetFileName,
+                 ResetForNewPass,
+                 currenttoken, currentstring, currentinteger,
+                 AddTok, AddTokCharStar, AddTokInteger, MakeVirtualTok,
+                 SetFile, PushFile, PopFile,
+                 PrintTokenNo, DisplayToken, DumpTokens,
+                 BuiltinTokenNo, UnknownTokenNo ;
+
+CONST
+   UnknownTokenNo = 0 ;
+   BuiltinTokenNo = 1 ;
+
+VAR
+   currenttoken  : toktype ;
+   currentstring : ADDRESS ;
+   currentcolumn : CARDINAL ;
+   currentinteger: INTEGER ;
+
+
+(*
+   OpenSource - Attempts to open the source file, s.
+                The success of the operation is returned.
+*)
+
+PROCEDURE OpenSource (s: String) : BOOLEAN ;
+
+
+(*
+   CloseSource - closes the current open file.
+*)
+
+PROCEDURE CloseSource ;
+
+
+(*
+   ReInitialize - re-initialize the all the data structures.
+*)
+
+PROCEDURE ReInitialize ;
+
+
+(*
+   ResetForNewPass - reset the buffer pointers to the beginning ready for
+                     a new pass
+*)
+
+PROCEDURE ResetForNewPass ;
+
+
+(*
+   GetToken - gets the next token into currenttoken.
+*)
+
+PROCEDURE GetToken ;
+
+
+(*
+   InsertToken - inserts a symbol, token, infront of the current token
+                 ready for the next pass.
+*)
+
+PROCEDURE InsertToken (token: toktype) ;
+
+
+(*
+   InsertTokenAndRewind - inserts a symbol, token, infront of the current token
+                          and then moves the token stream back onto the inserted token.
+*)
+
+PROCEDURE InsertTokenAndRewind (token: toktype) ;
+
+
+(*
+   GetPreviousTokenLineNo - returns the line number of the previous token.
+*)
+
+PROCEDURE GetPreviousTokenLineNo () : CARDINAL ;
+
+
+(*
+   GetLineNo - returns the current line number where the symbol occurs in
+               the source file.
+*)
+
+PROCEDURE GetLineNo () : CARDINAL ;
+
+
+(*
+   GetTokenNo - returns the current token number.
+*)
+
+PROCEDURE GetTokenNo () : CARDINAL ;
+
+
+(*
+   GetTokenName - returns the token name given the tokenno.
+*)
+
+PROCEDURE GetTokenName (tokenno: CARDINAL) : Name ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE TokenToLineNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetColumnNo - returns the current column where the symbol occurs in
+                 the source file.
+*)
+
+PROCEDURE GetColumnNo () : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE TokenToColumnNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+
+
+(*
+   TokenToLocation - returns the location_t corresponding to, TokenNo.
+*)
+
+PROCEDURE TokenToLocation (TokenNo: CARDINAL) : location_t ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindFileNameFromToken (TokenNo: CARDINAL; depth: CARDINAL) : String ;
+
+
+(*
+   GetFileName - returns a String defining the current file.
+*)
+
+PROCEDURE GetFileName () : String ;
+
+
+(*
+   MakeVirtualTok - creates and return a new tokenno which is created from
+                    tokenno range1 and range2.
+*)
+
+PROCEDURE MakeVirtualTok (caret, left, right: CARDINAL) : CARDINAL ;
+
+
+(* ***********************************************************************
+ *
+ * These functions allow m2.lex to deliver tokens into the buffer
+ *
+ ************************************************************************* *)
+
+(*
+   AddTok - adds a token to the buffer.
+*)
+
+PROCEDURE AddTok (t: toktype) ;
+
+
+(*
+   AddTokCharStar - adds a token to the buffer and an additional string, s.
+                    A copy of string, s, is made.
+*)
+
+PROCEDURE AddTokCharStar (t: toktype; s: ADDRESS) ;
+
+
+(*
+   AddTokInteger - adds a token and an integer to the buffer.
+*)
+
+PROCEDURE AddTokInteger (t: toktype; i: INTEGER) ;
+
+
+(*
+   SetFile - sets the current filename to, filename.
+*)
+
+PROCEDURE SetFile (filename: ADDRESS) ;
+
+
+(*
+   PushFile - indicates that, filename, has just been included.
+*)
+
+PROCEDURE PushFile (filename: ADDRESS) ;
+
+
+(*
+   PopFile - indicates that we are returning to, filename, having finished
+             an include.
+*)
+
+PROCEDURE PopFile (filename: ADDRESS) ;
+
+
+(*
+   PrintTokenNo - displays token and the location of the token.
+*)
+
+PROCEDURE PrintTokenNo (tokenno: CARDINAL) ;
+
+
+(*
+   DisplayToken - display the token name using printf0 no newline is emitted.
+*)
+
+PROCEDURE DisplayToken (tok: toktype) ;
+
+
+(*
+   DumpTokens - developer debugging aid.
+*)
+
+PROCEDURE DumpTokens ;
+
+
+END M2LexBuf.
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.mod b/gcc/m2/gm2-compiler/M2LexBuf.mod
new file mode 100644
index 00000000000..ffdcb674d43
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2LexBuf.mod
@@ -0,0 +1,1231 @@
+(* M2LexBuf.mod provides a buffer for m2.lex.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2LexBuf ;
+
+IMPORT m2flex ;
+
+FROM libc IMPORT strlen ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM DynamicStrings IMPORT string, InitString, InitStringCharStar, Equal, Mark, KillString ;
+FROM FormatStrings IMPORT Sprintf1 ;
+FROM NameKey IMPORT NulName, Name, makekey, MakeKey, KeyToCharStar ;
+FROM M2Reserved IMPORT toktype, tokToTok ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
+FROM M2Debug IMPORT Assert ;
+FROM NameKey IMPORT makekey ;
+FROM m2linemap IMPORT location_t, GetLocationBinary ;
+FROM M2Emit IMPORT UnknownLocation, BuiltinsLocation ;
+FROM M2Error IMPORT WarnStringAt ;
+
+CONST
+   MaxBucketSize      = 100 ;
+   Debugging          = FALSE ;
+   DebugRecover       = FALSE ;
+   InitialSourceToken = 2 ;   (* 0 is unknown, 1 is builtin.  *)
+
+TYPE
+   SourceList = POINTER TO RECORD
+                              left,
+                              right: SourceList ;
+                              name : String ;
+                              line : CARDINAL ;
+                              col  : CARDINAL ;
+                           END ;
+
+   TokenDesc = RECORD
+                  token : toktype ;
+                  str   : Name ;          (* ident name or string literal.  *)
+                  int   : INTEGER ;
+                  line  : CARDINAL ;
+                  col   : CARDINAL ;
+                  file  : SourceList ;
+                  loc   : location_t ;
+                  insert: TokenBucket ;   (* contains any inserted tokens.  *)
+               END ;
+
+   TokenBucket = POINTER TO RECORD
+                               buf : ARRAY [0..MaxBucketSize] OF TokenDesc ;
+                               len : CARDINAL ;
+                               next: TokenBucket ;
+                            END ;
+
+   ListDesc = RECORD
+                 head,
+                 tail            : TokenBucket ;
+                 LastBucketOffset: CARDINAL ;
+              END ;
+
+VAR
+   CurrentSource    : SourceList ;
+   UseBufferedTokens,
+   CurrentUsed      : BOOLEAN ;
+   ListOfTokens     : ListDesc ;
+   CurrentTokNo     : CARDINAL ;
+   InsertionIndex   : CARDINAL ;
+
+
+(*
+   InitTokenList - creates an empty token list, which starts the first source token
+                   at position 2.  This allows position 0 to be for unknown location
+                   and position 1 for builtin token.
+*)
+
+PROCEDURE InitTokenList ;
+BEGIN
+   NEW (ListOfTokens.head) ;
+   ListOfTokens.tail := ListOfTokens.head ;
+   WITH ListOfTokens.tail^.buf[0] DO
+      token := eoftok ;
+      str := NulName ;
+      int := 0 ;
+      line := 0 ;
+      col := 0 ;
+      file := NIL ;
+      loc := UnknownLocation ()
+   END ;
+   WITH ListOfTokens.tail^.buf[1] DO
+      token := eoftok ;
+      str := NulName ;
+      int := 0 ;
+      line := 0 ;
+      col := 0 ;
+      file := NIL ;
+      loc := BuiltinsLocation ()
+   END ;
+   ListOfTokens.tail^.len := InitialSourceToken
+END InitTokenList ;
+
+
+(*
+   Init - initializes the token list and source list.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   InsertionIndex := 0 ;
+   currenttoken := eoftok ;
+   CurrentTokNo := InitialSourceToken ;
+   CurrentSource := NIL ;
+   ListOfTokens.head := NIL ;
+   ListOfTokens.tail := NIL ;
+   UseBufferedTokens := FALSE ;
+   InitTokenList
+END Init ;
+
+
+(*
+   AddTo - adds a new element to the end of SourceList, CurrentSource.
+*)
+
+PROCEDURE AddTo (l: SourceList) ;
+BEGIN
+   l^.right := CurrentSource ;
+   l^.left  := CurrentSource^.left ;
+   CurrentSource^.left^.right := l ;
+   CurrentSource^.left := l ;
+   WITH l^.left^ DO
+      line := m2flex.GetLineNo() ;
+      col  := m2flex.GetColumnNo()
+   END
+END AddTo ;
+
+
+(*
+   SubFrom - subtracts, l, from the source list.
+*)
+
+PROCEDURE SubFrom (l: SourceList) ;
+BEGIN
+   l^.left^.right := l^.right ;
+   l^.right^.left := l^.left
+END SubFrom ;
+
+
+(*
+   NewElement - returns a new SourceList
+*)
+
+PROCEDURE NewElement (s: ADDRESS) : SourceList ;
+VAR
+   l: SourceList ;
+BEGIN
+   NEW (l) ;
+   IF l = NIL
+   THEN
+      HALT
+   ELSE
+      WITH l^ DO
+         name  := InitStringCharStar(s) ;
+         left  := NIL ;
+         right := NIL
+      END
+   END ;
+   RETURN l
+END NewElement ;
+
+
+(*
+   NewList - initializes an empty list with the classic dummy header element.
+*)
+
+PROCEDURE NewList () : SourceList ;
+VAR
+   l: SourceList ;
+BEGIN
+   NEW (l) ;
+   WITH l^ DO
+      left  := l ;
+      right := l ;
+      name  := NIL
+   END ;
+   RETURN l
+END NewList ;
+
+
+(*
+   CheckIfNeedToDuplicate - checks to see whether the CurrentSource has
+                            been used, if it has then duplicate the list.
+*)
+
+PROCEDURE CheckIfNeedToDuplicate ;
+VAR
+   l, h: SourceList ;
+BEGIN
+   IF CurrentUsed
+   THEN
+      l := CurrentSource^.right ;
+      h := CurrentSource ;
+      CurrentSource := NewList() ;
+      WHILE l#h DO
+         AddTo (NewElement (l^.name)) ;
+         l := l^.right
+      END
+   END
+END CheckIfNeedToDuplicate ;
+
+
+(*
+   PushFile - indicates that, filename, has just been included.
+*)
+
+PROCEDURE PushFile (filename: ADDRESS) ;
+VAR
+   l: SourceList ;
+BEGIN
+   CheckIfNeedToDuplicate ;
+   AddTo (NewElement (filename)) ;
+   IF Debugging
+   THEN
+      IF CurrentSource^.right#CurrentSource
+      THEN
+         l := CurrentSource ;
+         REPEAT
+            printf3('name = %s, line = %d, col = %d\n', l^.name, l^.line, l^.col) ;
+            l := l^.right
+         UNTIL l=CurrentSource
+      END
+   END
+END PushFile ;
+
+
+(*
+   PopFile - indicates that we are returning to, filename, having finished
+             an include.
+*)
+
+PROCEDURE PopFile (filename: ADDRESS) ;
+VAR
+   l: SourceList ;
+BEGIN
+   CheckIfNeedToDuplicate ;
+   IF (CurrentSource#NIL) AND (CurrentSource^.left#CurrentSource)
+   THEN
+      l := CurrentSource^.left ;  (* last element *)
+      SubFrom (l) ;
+      DISPOSE (l) ;
+      IF (CurrentSource^.left#CurrentSource) AND
+         (NOT Equal(CurrentSource^.name, Mark(InitStringCharStar(filename))))
+      THEN
+         (* mismatch in source file names after preprocessing files *)
+      END
+   ELSE
+      (* source file list is empty, cannot pop an include.. *)
+   END
+END PopFile ;
+
+
+(*
+   KillList - kills the SourceList providing that it has not been used.
+*)
+
+PROCEDURE KillList ;
+VAR
+   l, k: SourceList ;
+BEGIN
+   IF (NOT CurrentUsed) AND (CurrentSource#NIL)
+   THEN
+      l := CurrentSource ;
+      REPEAT
+         k := l ;
+         l := l^.right ;
+         DISPOSE(k)
+      UNTIL l=CurrentSource
+   END
+END KillList ;
+
+
+(*
+   ReInitialize - re-initialize the all the data structures.
+*)
+
+PROCEDURE ReInitialize ;
+VAR
+   s, t: TokenBucket ;
+BEGIN
+   IF ListOfTokens.head#NIL
+   THEN
+      t := ListOfTokens.head ;
+      REPEAT
+         s := t ;
+         t := t^.next ;
+         DISPOSE(s) ;
+      UNTIL t=NIL ;
+      CurrentUsed := FALSE ;
+      KillList
+   END ;
+   Init
+END ReInitialize ;
+
+
+(*
+   SetFile - sets the current filename to, filename.
+*)
+
+PROCEDURE SetFile (filename: ADDRESS) ;
+BEGIN
+   KillList ;
+   CurrentUsed   := FALSE ;
+   CurrentSource := NewList () ;
+   AddTo (NewElement (filename))
+END SetFile ;
+
+
+(*
+   OpenSource - Attempts to open the source file, s.
+                The success of the operation is returned.
+*)
+
+PROCEDURE OpenSource (s: String) : BOOLEAN ;
+BEGIN
+   IF UseBufferedTokens
+   THEN
+      GetToken ;
+      RETURN TRUE
+   ELSE
+      IF m2flex.OpenSource (string (s))
+      THEN
+         SetFile (string (s)) ;
+         SyncOpenWithBuffer ;
+         GetToken ;
+         RETURN TRUE
+      ELSE
+         RETURN FALSE
+      END
+   END
+END OpenSource ;
+
+
+(*
+   CloseSource - closes the current open file.
+*)
+
+PROCEDURE CloseSource ;
+BEGIN
+   IF UseBufferedTokens
+   THEN
+      WHILE currenttoken#eoftok DO
+         GetToken
+      END
+   ELSE
+      (* a subsequent call to m2flex.OpenSource will really close the file *)
+   END
+END CloseSource ;
+
+
+(*
+   ResetForNewPass - reset the buffer pointers to the beginning ready for
+                     a new pass
+*)
+
+PROCEDURE ResetForNewPass ;
+BEGIN
+   InsertionIndex := 0 ;
+   CurrentTokNo := InitialSourceToken ;
+   UseBufferedTokens := TRUE
+END ResetForNewPass ;
+
+
+(*
+   DisplayToken - display the token name using printf0 no newline is emitted.
+*)
+
+PROCEDURE DisplayToken (tok: toktype) ;
+BEGIN
+   CASE tok OF
+
+   eoftok: printf0('eoftok') |
+   plustok: printf0('plustok') |
+   minustok: printf0('minustok') |
+   timestok: printf0('timestok') |
+   dividetok: printf0('dividetok') |
+   becomestok: printf0('becomestok') |
+   ambersandtok: printf0('ambersandtok') |
+   periodtok: printf0('periodtok') |
+   commatok: printf0('commatok') |
+   semicolontok: printf0('semicolontok') |
+   lparatok: printf0('lparatok') |
+   rparatok: printf0('rparatok') |
+   lsbratok: printf0('lsbratok') |
+   rsbratok: printf0('rsbratok') |
+   lcbratok: printf0('lcbratok') |
+   rcbratok: printf0('rcbratok') |
+   uparrowtok: printf0('uparrowtok') |
+   singlequotetok: printf0('singlequotetok') |
+   equaltok: printf0('equaltok') |
+   hashtok: printf0('hashtok') |
+   lesstok: printf0('lesstok') |
+   greatertok: printf0('greatertok') |
+   lessgreatertok: printf0('lessgreatertok') |
+   lessequaltok: printf0('lessequaltok') |
+   greaterequaltok: printf0('greaterequaltok') |
+   periodperiodtok: printf0('periodperiodtok') |
+   colontok: printf0('colontok') |
+   doublequotestok: printf0('doublequotestok') |
+   bartok: printf0('bartok') |
+   andtok: printf0('andtok') |
+   arraytok: printf0('arraytok') |
+   begintok: printf0('begintok') |
+   bytok: printf0('bytok') |
+   casetok: printf0('casetok') |
+   consttok: printf0('consttok') |
+   definitiontok: printf0('definitiontok') |
+   divtok: printf0('divtok') |
+   dotok: printf0('dotok') |
+   elsetok: printf0('elsetok') |
+   elsiftok: printf0('elsiftok') |
+   endtok: printf0('endtok') |
+   exittok: printf0('exittok') |
+   exporttok: printf0('exporttok') |
+   fortok: printf0('fortok') |
+   fromtok: printf0('fromtok') |
+   iftok: printf0('iftok') |
+   implementationtok: printf0('implementationtok') |
+   importtok: printf0('importtok') |
+   intok: printf0('intok') |
+   looptok: printf0('looptok') |
+   modtok: printf0('modtok') |
+   moduletok: printf0('moduletok') |
+   nottok: printf0('nottok') |
+   oftok: printf0('oftok') |
+   ortok: printf0('ortok') |
+   pointertok: printf0('pointertok') |
+   proceduretok: printf0('proceduretok') |
+   qualifiedtok: printf0('qualifiedtok') |
+   unqualifiedtok: printf0('unqualifiedtok') |
+   recordtok: printf0('recordtok') |
+   repeattok: printf0('repeattok') |
+   returntok: printf0('returntok') |
+   settok: printf0('settok') |
+   thentok: printf0('thentok') |
+   totok: printf0('totok') |
+   typetok: printf0('typetok') |
+   untiltok: printf0('untiltok') |
+   vartok: printf0('vartok') |
+   whiletok: printf0('whiletok') |
+   withtok: printf0('withtok') |
+   asmtok: printf0('asmtok') |
+   volatiletok: printf0('volatiletok') |
+   periodperiodperiodtok: printf0('periodperiodperiodtok') |
+   datetok: printf0('datetok') |
+   linetok: printf0('linetok') |
+   filetok: printf0('filetok') |
+   integertok: printf0('integertok') |
+   identtok: printf0('identtok') |
+   realtok: printf0('realtok') |
+   stringtok: printf0('stringtok')
+
+   ELSE
+   END
+END DisplayToken ;
+
+
+(*
+   UpdateFromBucket - updates the global variables:  currenttoken,
+                      currentstring, currentcolumn and currentinteger
+                      from TokenBucket, b, and, offset.
+*)
+
+PROCEDURE UpdateFromBucket (b: TokenBucket; offset: CARDINAL) ;
+BEGIN
+   IF InsertionIndex > 0
+   THEN
+      (* we have an inserted token to use.  *)
+      Assert (b^.buf[offset].insert # NIL) ;
+      WITH b^.buf[offset].insert^.buf[InsertionIndex] DO
+         currenttoken   := token ;
+         currentstring  := KeyToCharStar(str) ;
+         currentcolumn  := col ;
+         currentinteger := int ;
+         IF Debugging
+         THEN
+            printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
+         END
+      END ;
+      INC (InsertionIndex) ;
+      IF InsertionIndex = b^.buf[offset].insert^.len
+      THEN
+         InsertionIndex := 0 ;  (* finished consuming the inserted tokens.  *)
+         INC (CurrentTokNo)
+      END
+   ELSIF (b^.buf[offset].insert # NIL) AND (InsertionIndex = 0)
+   THEN
+      (* this source token has extra tokens appended after it by the error recovery.  *)
+      Assert (b^.buf[offset].insert^.len > 0) ;  (* we must have at least one token.  *)
+      InsertionIndex := 1 ; (* so set the index ready for the next UpdateFromBucket.  *)
+      (* and read the original token.  *)
+      WITH b^.buf[offset] DO
+         currenttoken   := token ;
+         currentstring  := KeyToCharStar(str) ;
+         currentcolumn  := col ;
+         currentinteger := int ;
+         IF Debugging
+         THEN
+            printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
+         END
+      END
+   ELSE
+      (* no inserted tokens after this token so read it and move on.  *)
+      WITH b^.buf[offset] DO
+         currenttoken   := token ;
+         currentstring  := KeyToCharStar(str) ;
+         currentcolumn  := col ;
+         currentinteger := int ;
+         IF Debugging
+         THEN
+            printf3('line %d (# %d  %d) ', line, offset, CurrentTokNo)
+         END
+      END ;
+      INC (CurrentTokNo)
+   END
+END UpdateFromBucket ;
+
+
+(*
+   DisplayTokenEntry -
+*)
+
+PROCEDURE DisplayTokenEntry (topBucket: TokenBucket; index, total: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   printf1 ("%d: ", total) ;
+   DisplayToken (topBucket^.buf[index].token) ;
+   printf1 (" %a ", topBucket^.buf[index].str) ;
+   IF total = GetTokenNo ()
+   THEN
+      printf0 (" <- current token")
+   END ;
+   printf0 ("\n") ;
+   (* now check for inserted tokens.  *)
+   IF topBucket^.buf[index].insert # NIL
+   THEN
+      i := 1 ;
+      WHILE i < topBucket^.buf[index].insert^.len DO
+         printf1 ("   %d: ", i) ;
+         DisplayToken (topBucket^.buf[index].insert^.buf[i].token) ;
+         printf1 (" %a\n", topBucket^.buf[index].insert^.buf[i].str) ;
+         INC (i)
+      END
+   END
+END DisplayTokenEntry ;
+
+
+(*
+   DumpTokens - developer debugging aid.
+*)
+
+PROCEDURE DumpTokens ;
+VAR
+   tb    : TokenBucket ;
+   i,
+   tokenNo,
+   total,
+   length : CARDINAL ;
+BEGIN
+   tokenNo := GetTokenNo () ;
+   tb := ListOfTokens.head ;
+   total := 0 ;
+   WHILE tb # NIL DO
+      length := tb^.len ;
+      i := 0 ;
+      WHILE i < length DO
+         DisplayTokenEntry (tb, i, total) ;
+         INC (i) ;
+         INC (total)
+      END ;
+      tb := tb^.next
+   END ;
+   printf2 ("%d: tokenNo,  %d: total\n", tokenNo, total) ;
+   IF (total # 0) AND (tokenNo = total)
+   THEN
+      printf1 ("%d: end of buffer ", total) ;
+      printf0 (" <- current token") ;
+      printf0 ("\n") ;
+   END ;
+END DumpTokens ;
+
+
+(*
+   GetToken - gets the next token into currenttoken.
+*)
+
+PROCEDURE GetToken ;
+VAR
+   t: CARDINAL ;
+   b: TokenBucket ;
+BEGIN
+   IF UseBufferedTokens
+   THEN
+      t := CurrentTokNo ;
+      b := FindTokenBucket(t) ;
+      UpdateFromBucket (b, t)
+   ELSE
+      IF ListOfTokens.tail=NIL
+      THEN
+         m2flex.GetToken () ;
+         IF ListOfTokens.tail=NIL
+         THEN
+            HALT
+         END
+      END ;
+      IF CurrentTokNo>=ListOfTokens.LastBucketOffset
+      THEN
+         (* CurrentTokNo is in the last bucket or needs to be read *)
+         IF CurrentTokNo-ListOfTokens.LastBucketOffset<ListOfTokens.tail^.len
+         THEN
+            UpdateFromBucket (ListOfTokens.tail,
+                              CurrentTokNo-ListOfTokens.LastBucketOffset)
+         ELSE
+            (* call the lexical phase to place a new token into the last bucket *)
+            m2flex.GetToken () ;
+            GetToken ;  (* and call ourselves again to collect the token from bucket *)
+            RETURN
+         END
+      ELSE
+         t := CurrentTokNo ;
+         b := FindTokenBucket (t) ;
+         UpdateFromBucket (b, t)
+      END
+   END
+END GetToken ;
+
+
+(*
+   SyncOpenWithBuffer - synchronise the buffer with the start of a file.
+                        Skips all the tokens to do with the previous file.
+*)
+
+PROCEDURE SyncOpenWithBuffer ;
+BEGIN
+   IF ListOfTokens.tail#NIL
+   THEN
+      WITH ListOfTokens.tail^ DO
+         CurrentTokNo := ListOfTokens.LastBucketOffset+len
+      END
+   END
+END SyncOpenWithBuffer ;
+
+
+(*
+   GetInsertBucket - returns the insertion bucket associated with token count
+                     and the topBucket.  It creates a new TokenBucket if necessary.
+*)
+
+PROCEDURE GetInsertBucket (topBucket: TokenBucket; count: CARDINAL) : TokenBucket ;
+BEGIN
+   IF topBucket^.buf[count].insert = NIL
+   THEN
+      NEW (topBucket^.buf[count].insert) ;
+      topBucket^.buf[count].insert^.buf[0] := topBucket^.buf[count] ;
+      topBucket^.buf[count].insert^.buf[0].insert := NIL ;
+      topBucket^.buf[count].insert^.len := 1  (* empty, slot 0 contains the original token for ease.  *)
+   END ;
+   RETURN topBucket^.buf[count].insert
+END GetInsertBucket ;
+
+
+(*
+   AppendToken - appends desc to the end of the insertionBucket.
+*)
+
+PROCEDURE AppendToken (insertionBucket: TokenBucket; desc: TokenDesc) ;
+BEGIN
+   IF insertionBucket^.len < MaxBucketSize
+   THEN
+      insertionBucket^.buf[insertionBucket^.len] := desc ;
+      INC (insertionBucket^.len)
+   END
+END AppendToken ;
+
+
+(*
+   InsertToken - inserts a symbol, token, infront of the current token
+                 ready for the next pass.
+*)
+
+PROCEDURE InsertToken (token: toktype) ;
+VAR
+   topBucket, insertionBucket: TokenBucket ;
+   count : CARDINAL ;
+   desc  : TokenDesc ;
+BEGIN
+   Assert (ListOfTokens.tail # NIL) ;
+   count := GetTokenNo () -1 ;
+   topBucket := FindTokenBucket (count) ;
+   insertionBucket := GetInsertBucket (topBucket, count) ;
+   desc := topBucket^.buf[count] ;
+   desc.token := token ;
+   desc.insert := NIL ;
+   AppendToken (insertionBucket, desc) ;
+   IF DebugRecover
+   THEN
+      DumpTokens
+   END
+END InsertToken ;
+
+
+(*
+   InsertTokenAndRewind - inserts a symbol, token, infront of the current token
+                          and then moves the token stream back onto the inserted token.
+*)
+
+PROCEDURE InsertTokenAndRewind (token: toktype) ;
+VAR
+   offset   : CARDINAL ;
+   topBucket: TokenBucket ;
+BEGIN
+   IF GetTokenNo () > 0
+   THEN
+      InsertToken (token) ;
+      offset := CurrentTokNo -2 ;
+      topBucket := FindTokenBucket (offset) ;
+      InsertionIndex := topBucket^.buf[offset].insert^.len -1 ;
+      DEC (CurrentTokNo, 2) ;
+      GetToken
+   END
+END InsertTokenAndRewind ;
+
+
+(*
+   GetPreviousTokenLineNo - returns the line number of the previous token.
+*)
+
+PROCEDURE GetPreviousTokenLineNo () : CARDINAL ;
+BEGIN
+   (*
+   IF GetTokenNo()>0
+   THEN
+      RETURN( TokenToLineNo(GetTokenNo()-1, 0) )
+   ELSE
+      RETURN( 0 )
+   END
+      *)
+   RETURN GetLineNo ()
+END GetPreviousTokenLineNo ;
+
+
+(*
+   GetLineNo - returns the current line number where the symbol occurs in
+               the source file.
+*)
+
+PROCEDURE GetLineNo () : CARDINAL ;
+BEGIN
+   IF CurrentTokNo = 0
+   THEN
+      RETURN 0
+   ELSE
+      RETURN TokenToLineNo (GetTokenNo (), 0)
+   END
+END GetLineNo ;
+
+
+(*
+   GetColumnNo - returns the current column where the symbol occurs in
+                 the source file.
+*)
+
+PROCEDURE GetColumnNo () : CARDINAL ;
+BEGIN
+   IF CurrentTokNo = 0
+   THEN
+      RETURN 0
+   ELSE
+      RETURN TokenToColumnNo (GetTokenNo (), 0)
+   END
+END GetColumnNo ;
+
+
+(*
+   GetTokenNo - returns the current token number.
+*)
+
+PROCEDURE GetTokenNo () : CARDINAL ;
+BEGIN
+   IF CurrentTokNo = 0
+   THEN
+      RETURN 0
+   ELSE
+      RETURN CurrentTokNo-1
+   END
+END GetTokenNo ;
+
+
+(*
+   GetTokenName - returns the token name given the tokenno.
+*)
+
+PROCEDURE GetTokenName (tokenno: CARDINAL) : Name ;
+VAR
+   b: TokenBucket ;
+   n: Name ;
+BEGIN
+   b := FindTokenBucket (tokenno) ;
+   IF b=NIL
+   THEN
+      RETURN NulName
+   ELSE
+      WITH b^.buf[tokenno] DO
+         n := tokToTok (token) ;
+	 IF n=NulName
+         THEN
+            RETURN str
+         ELSE
+            RETURN n
+         END
+      END
+   END
+END GetTokenName ;
+
+
+(*
+   FindTokenBucket - returns the TokenBucket corresponding to the TokenNo.
+*)
+
+PROCEDURE FindTokenBucket (VAR TokenNo: CARDINAL) : TokenBucket ;
+VAR
+   b: TokenBucket ;
+BEGIN
+   b := ListOfTokens.head ;
+   WHILE b#NIL DO
+      WITH b^ DO
+         IF TokenNo<len
+         THEN
+            RETURN b
+         ELSE
+            DEC (TokenNo, len)
+         END
+      END ;
+      b := b^.next
+   END ;
+   RETURN NIL
+END FindTokenBucket ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE TokenToLineNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+VAR
+   b: TokenBucket ;
+   l: SourceList ;
+BEGIN
+   IF (TokenNo = UnknownTokenNo) OR (TokenNo = BuiltinTokenNo)
+   THEN
+      RETURN 0
+   ELSE
+      b := FindTokenBucket (TokenNo) ;
+      IF b = NIL
+      THEN
+         RETURN 0
+      ELSE
+         IF depth = 0
+         THEN
+            RETURN b^.buf[TokenNo].line
+         ELSE
+            l := b^.buf[TokenNo].file^.left ;
+            WHILE depth>0 DO
+               l := l^.left ;
+               IF l=b^.buf[TokenNo].file^.left
+               THEN
+                  RETURN 0
+               END ;
+               DEC (depth)
+            END ;
+            RETURN l^.line
+         END
+      END
+   END
+END TokenToLineNo ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE TokenToColumnNo (TokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+VAR
+   b: TokenBucket ;
+   l: SourceList ;
+BEGIN
+   IF (TokenNo = UnknownTokenNo) OR (TokenNo = BuiltinTokenNo)
+   THEN
+      RETURN 0
+   ELSE
+      b := FindTokenBucket (TokenNo) ;
+      IF b=NIL
+      THEN
+         RETURN 0
+      ELSE
+         IF depth = 0
+         THEN
+            RETURN b^.buf[TokenNo].col
+         ELSE
+            l := b^.buf[TokenNo].file^.left ;
+            WHILE depth>0 DO
+               l := l^.left ;
+               IF l=b^.buf[TokenNo].file^.left
+               THEN
+                  RETURN 0
+               END ;
+               DEC (depth)
+            END ;
+            RETURN l^.col
+         END
+      END
+   END
+END TokenToColumnNo ;
+
+
+(*
+   TokenToLocation - returns the location_t corresponding to, TokenNo.
+*)
+
+PROCEDURE TokenToLocation (TokenNo: CARDINAL) : location_t ;
+VAR
+   b: TokenBucket ;
+BEGIN
+   IF TokenNo = UnknownTokenNo
+   THEN
+      RETURN UnknownLocation ()
+   ELSIF TokenNo = BuiltinTokenNo
+   THEN
+      RETURN BuiltinsLocation ()
+   ELSE
+      b := FindTokenBucket (TokenNo) ;
+      IF b=NIL
+      THEN
+         RETURN UnknownLocation ()
+      ELSE
+         RETURN b^.buf[TokenNo].loc
+      END
+   END
+END TokenToLocation ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindFileNameFromToken (TokenNo: CARDINAL; depth: CARDINAL) : String ;
+VAR
+   b: TokenBucket ;
+   l: SourceList ;
+BEGIN
+   b := FindTokenBucket (TokenNo) ;
+   IF b=NIL
+   THEN
+      RETURN NIL
+   ELSE
+      IF TokenNo = UnknownTokenNo
+      THEN
+         RETURN NIL
+      ELSIF TokenNo = BuiltinTokenNo
+      THEN
+         RETURN NIL
+      ELSE
+         l := b^.buf[TokenNo].file^.left ;
+         WHILE depth>0 DO
+            l := l^.left ;
+            IF l=b^.buf[TokenNo].file^.left
+            THEN
+               RETURN NIL
+            END ;
+            DEC (depth)
+         END ;
+         RETURN l^.name
+      END
+   END
+END FindFileNameFromToken ;
+
+
+(*
+   GetFileName - returns a String defining the current file.
+*)
+
+PROCEDURE GetFileName () : String ;
+BEGIN
+   RETURN FindFileNameFromToken (GetTokenNo (), 0)
+END GetFileName ;
+
+
+(*
+   AddTokToList - adds a token to a dynamic list.
+*)
+
+PROCEDURE AddTokToList (t: toktype; n: Name;
+                        i: INTEGER; l: CARDINAL; c: CARDINAL;
+                        f: SourceList; location: location_t) ;
+BEGIN
+   IF ListOfTokens.head=NIL
+   THEN
+      NEW (ListOfTokens.head) ;
+      IF ListOfTokens.head=NIL
+      THEN
+         (* list error *)
+      END ;
+      ListOfTokens.tail := ListOfTokens.head ;
+      ListOfTokens.tail^.len := 0
+   ELSIF ListOfTokens.tail^.len=MaxBucketSize
+   THEN
+      Assert(ListOfTokens.tail^.next=NIL) ;
+      NEW (ListOfTokens.tail^.next) ;
+      IF ListOfTokens.tail^.next=NIL
+      THEN
+         (* list error *)
+      ELSE
+         ListOfTokens.tail := ListOfTokens.tail^.next ;
+         ListOfTokens.tail^.len := 0
+      END ;
+      INC (ListOfTokens.LastBucketOffset, MaxBucketSize)
+   END ;
+   WITH ListOfTokens.tail^ DO
+      next := NIL ;
+      WITH buf[len] DO
+         token  := t ;
+         str    := n ;
+         int    := i ;
+         line   := l ;
+         col    := c ;
+         file   := f ;
+         loc    := location ;
+         insert := NIL ;
+      END ;
+      INC (len)
+   END
+END AddTokToList ;
+
+
+(*
+   IsLastTokenEof - returns TRUE if the last token was an eoftok
+*)
+
+PROCEDURE IsLastTokenEof () : BOOLEAN ;
+VAR
+   b: TokenBucket ;
+BEGIN
+   IF ListOfTokens.tail#NIL
+   THEN
+      IF ListOfTokens.tail^.len=0
+      THEN
+         b := ListOfTokens.head ;
+         IF b=ListOfTokens.tail
+         THEN
+            RETURN FALSE
+         END ;
+         WHILE b^.next#ListOfTokens.tail DO
+            b := b^.next
+         END ;
+      ELSE
+         b := ListOfTokens.tail
+      END ;
+      WITH b^ DO
+         Assert (len>0) ;     (* len should always be >0 *)
+         RETURN buf[len-1].token=eoftok
+      END
+   END ;
+   RETURN FALSE
+END IsLastTokenEof ;
+
+
+(*
+   PrintTokenNo - displays token and the location of the token.
+*)
+
+PROCEDURE PrintTokenNo (tokenno: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   printf1 ("tokenno = %d, ", tokenno) ;
+   s := InitStringCharStar (KeyToCharStar (GetTokenName (tokenno))) ;
+   printf1 ("%s\n", s) ;
+   s := KillString (s)
+END PrintTokenNo ;
+
+
+(*
+   isSrcToken -
+*)
+
+PROCEDURE isSrcToken (tokenno: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN (tokenno # UnknownTokenNo) AND (tokenno # BuiltinTokenNo)
+END isSrcToken ;
+
+
+(*
+   MakeVirtualTok - providing caret, left, right are associated with a source file
+                    and exist on the same src line then
+                    create and return a new tokenno which is created from
+                    tokenno range1 and range2.  Otherwise return caret.
+*)
+
+PROCEDURE MakeVirtualTok (caret, left, right: CARDINAL) : CARDINAL ;
+VAR
+   bufLeft, bufRight: TokenBucket ;
+   lc, ll, lr       : location_t ;
+BEGIN
+   IF FALSE
+   THEN
+      RETURN caret
+   END ;
+   IF isSrcToken (caret) AND isSrcToken (left) AND isSrcToken (right)
+   THEN
+      lc := TokenToLocation (caret) ;
+      ll := TokenToLocation (left) ;
+      lr := TokenToLocation (right) ;
+      bufLeft := FindTokenBucket (left) ;   (* left maybe changed now.  *)
+      bufRight := FindTokenBucket (right) ;  (* right maybe changed now.  *)
+
+      IF (bufLeft^.buf[left].line = bufRight^.buf[right].line) AND
+         (bufLeft^.buf[left].file = bufRight^.buf[right].file)
+      THEN
+         (* on the same line, create a new token and location.  *)
+         AddTokToList (virtualrangetok, NulName, 0,
+                       bufLeft^.buf[left].line, bufLeft^.buf[left].col, bufLeft^.buf[left].file,
+                       GetLocationBinary (lc, ll, lr)) ;
+         RETURN ListOfTokens.LastBucketOffset + ListOfTokens.tail^.len - 1
+      END
+   END ;
+   RETURN caret
+END MakeVirtualTok ;
+
+
+(* ***********************************************************************
+ *
+ * These functions allow m2.flex to deliver tokens into the buffer
+ *
+ ************************************************************************* *)
+
+(*
+   AddTok - adds a token to the buffer.
+*)
+
+PROCEDURE AddTok (t: toktype) ;
+VAR
+   s: String ;
+BEGIN
+   IF NOT ((t=eoftok) AND IsLastTokenEof())
+   THEN
+      AddTokToList(t, NulName, 0,
+                   m2flex.GetLineNo(), m2flex.GetColumnNo(), CurrentSource,
+                   m2flex.GetLocation()) ;
+      CurrentUsed := TRUE ;
+      IF Debugging
+      THEN
+         (* display each token as a warning.  *)
+         s := InitStringCharStar (KeyToCharStar (GetTokenName (GetTokenNo ()))) ;
+         WarnStringAt (s, GetTokenNo ())
+      END
+   END
+END AddTok ;
+
+
+(*
+   AddTokCharStar - adds a token to the buffer and an additional string, s.
+                    A copy of string, s, is made.
+*)
+
+PROCEDURE AddTokCharStar (t: toktype; s: ADDRESS) ;
+BEGIN
+   AddTokToList(t, makekey(s), 0, m2flex.GetLineNo(),
+                m2flex.GetColumnNo(), CurrentSource, m2flex.GetLocation()) ;
+   CurrentUsed := TRUE
+END AddTokCharStar ;
+
+
+(*
+   AddTokInteger - adds a token and an integer to the buffer.
+*)
+
+PROCEDURE AddTokInteger (t: toktype; i: INTEGER) ;
+VAR
+   s: String ;
+   c,
+   l: CARDINAL ;
+BEGIN
+   l := m2flex.GetLineNo() ;
+   c := m2flex.GetColumnNo() ;
+   s := Sprintf1(Mark(InitString('%d')), i) ;
+   AddTokToList(t, makekey(string(s)), i, l, c, CurrentSource, m2flex.GetLocation()) ;
+   s := KillString(s) ;
+   CurrentUsed := TRUE
+END AddTokInteger ;
+
+
+BEGIN
+   Init
+END M2LexBuf.
diff --git a/gcc/m2/gm2-compiler/M2MetaError.def b/gcc/m2/gm2-compiler/M2MetaError.def
new file mode 100644
index 00000000000..c6ad21d205b
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2MetaError.def
@@ -0,0 +1,185 @@
+(* M2MetaError.def provides a set of high level error routines.
+
+Copyright (C) 2008-2022 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/>.  *)
+
+DEFINITION MODULE M2MetaError ;
+
+(*
+    Title      : M2MetaError
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Tue Oct 14 12:11:13 2008
+    Revision   : $Version$
+    Description: provides a set of high level error routines.  These
+                 routines utilise M2Error and provides the programmer
+                 with an easier method to obtain useful symbol table
+                 information.
+*)
+
+FROM DynamicStrings IMPORT String ;
+FROM NameKey IMPORT Name ;
+
+EXPORT QUALIFIED MetaError0, MetaError1, MetaError2, MetaError3, MetaError4,
+                 MetaErrors1, MetaErrors2, MetaErrors3, MetaErrors4,
+                 MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3, MetaErrorT4,
+                 MetaErrorsT1, MetaErrorsT2, MetaErrorsT3, MetaErrorsT4,
+                 MetaErrorString0,
+                 MetaErrorString1, MetaErrorString2, MetaErrorString3,
+                 MetaErrorString4,
+                 MetaErrorStringT0, MetaErrorStringT1, MetaErrorStringT2,
+                 MetaErrorStringT3, MetaErrorStringT4,
+                 MetaErrorN1, MetaErrorN2, MetaErrorNT0, MetaErrorNT1, MetaErrorNT2,
+                 MetaString0, MetaString1, MetaString2, MetaString3, MetaString4 ;
+
+
+(*
+    All the procedures below expect the s, s1, s2, s3, s4 to be symbols
+    and m, m1, m2, m3 are error messages and format specifiers.
+    By default all substitutions are enclosed in quotes.  However there
+    are a few format modifiers which disable quotations.
+    The format specifiers are:
+
+    {%1a}     symbol name for the first symbol.
+    {%1q}     qualified name for the first symbol.
+    {%1t}     type name for the first symbol.
+    {%1ts}    skips type pseudonyms.
+    {%1d}     symbol description
+    {%1td}    type name or symbol description
+    {%1Td}    get the type of the first symbol and describe it.
+    {%1Sd}    skip the type pseudonyms of the first symbol and describe it.
+    {%1ua}    force no quotes after substituting the text.
+
+    {%1D}     sets the error message to where symbol 1 was declared.
+              The declaration will choose the definition module, then
+              implementation (or program) module.
+    {%1M}     sets the error message to where symbol 1 was declared.
+              The declaration will choose the implementation or program
+              module and if these do not exist then it falls back to
+              the definition module.
+    {%1U}     sets the error message to where symbol 1 was first used.
+    {%A}      abort, issue non recoverable error message (this should
+              not used for internal errors).
+    {%E}      error (default recoverable error).
+    {%W}      message is a warning, not an error.
+    {%O}      message is a note, not an error.
+    {%Kword}  the string word is quoted and rendered as a keyword.
+    {%kword}  the string word is unquoted and rendered as a keyword.
+    {%C}      chain this error on the previous rooted error.
+    {%R}      this error will be the root of the future chained errors.
+    {%n}      decimal number.  Not quoted.
+    {%N}      count (number), for example, 1st, 2nd, 3rd, 4th.  Not quoted.
+    {%X}      push contents of the output string onto the string stack.
+    {%Yname}  place contents of dictionary entry name onto the output string.
+    {%Zname}  replace dictionary entry name for the output string.
+              Pop contents of the string stack onto the output string.
+    {%Q}      remove all entries in the dictionary.
+    {%P}      push the current color state.
+    {%p}      pop the current color state.
+    {%Ffilename} the string filename will be rendered using the filename color.
+    {%ccolor} change color into one of:  none, fixit-delete, fixit-insert,
+              locus, filename, type, error, warning, note.
+    %<        open quote and color.
+    %>        close quote and color.
+    %%        %
+    %{        {
+    %}        }
+    the error messages may also embed optional strings such as:
+
+    {%1a:this string is emitted if the symbol name is non null}
+    {!%1a:this string is emitted if the symbol name is null}
+    {!%1a:{%1d}}
+           if the symbol name does not exist then print a description
+           of the symbol.
+    {%1atd} was incompatible with the return type of the procedure
+           means print the symbol name (if null then print the type name
+           if null then print out the description) followed by the
+           string "was incompatible with the return type of the procedure"
+
+    Note all replaced names or descriptions are enclosed in quotes, like:
+    'foo', which matches the behaviour of gcc.  Also note temporary names
+    are treated as null.  Finally the order of format specifiers does
+    matter, {%1td} means get type name and use it if non null, otherwise
+    describe the symbol.  If ordinary text is copied then it is not quoted.
+
+   The color strings are: "filename", "quote", "error", "warning", "note",
+                          "locus", "insert", "delete", "type", "range1", range2".
+*)
+
+(*
+   ebnf := { percent | lbra | any } =:
+
+   percent := '%' anych =:
+
+   lbra := '{' [ '!' ] percenttoken '}' =:
+
+   percenttoken := '%' ( '1' op | '2' op | '3' op | '4' op ) =:
+
+   op := {'a'|'q'|'t'|'d'|'n'|'s'|'D'|'U'|'E'|'W'} then =:
+
+   then := [ ':' ebnf ] =:
+*)
+
+PROCEDURE MetaError0 (m: ARRAY OF CHAR) ;
+PROCEDURE MetaError1 (m: ARRAY OF CHAR; s: CARDINAL) ;
+PROCEDURE MetaError2 (m: ARRAY OF CHAR; s1, s2: CARDINAL) ;
+PROCEDURE MetaError3 (m: ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+PROCEDURE MetaError4 (m: ARRAY OF CHAR; s1, s2, s3, s4: CARDINAL) ;
+
+PROCEDURE MetaErrors1 (m1, m2: ARRAY OF CHAR; s: CARDINAL) ;
+PROCEDURE MetaErrors2 (m1, m2: ARRAY OF CHAR; s1, s2: CARDINAL) ;
+PROCEDURE MetaErrors3 (m1, m2: ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+PROCEDURE MetaErrors4 (m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: CARDINAL) ;
+
+PROCEDURE MetaErrorT0 (tok: CARDINAL; m: ARRAY OF CHAR) ;
+PROCEDURE MetaErrorT1 (tok: CARDINAL; m: ARRAY OF CHAR; s: CARDINAL) ;
+PROCEDURE MetaErrorT2 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2: CARDINAL) ;
+PROCEDURE MetaErrorT3 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+PROCEDURE MetaErrorT4 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2, s3, s4: CARDINAL) ;
+
+PROCEDURE MetaErrorsT1 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s: CARDINAL) ;
+PROCEDURE MetaErrorsT2 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2: CARDINAL) ;
+PROCEDURE MetaErrorsT3 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+PROCEDURE MetaErrorsT4 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: CARDINAL) ;
+
+PROCEDURE MetaErrorString0 (m: String) ;
+PROCEDURE MetaErrorString1 (m: String; s: CARDINAL) ;
+PROCEDURE MetaErrorString2 (m: String; s1, s2: CARDINAL) ;
+PROCEDURE MetaErrorString3 (m: String; s1, s2, s3: CARDINAL) ;
+PROCEDURE MetaErrorString4 (m: String; s1, s2, s3, s4: CARDINAL) ;
+
+PROCEDURE MetaErrorStringT0 (tok: CARDINAL; m: String) ;
+PROCEDURE MetaErrorStringT1 (tok: CARDINAL; m: String; s: CARDINAL) ;
+PROCEDURE MetaErrorStringT2 (tok: CARDINAL; m: String; s1, s2: CARDINAL) ;
+PROCEDURE MetaErrorStringT3 (tok: CARDINAL; m: String; s1, s2, s3: CARDINAL) ;
+PROCEDURE MetaErrorStringT4 (tok: CARDINAL; m: String; s1, s2, s3, s4: CARDINAL) ;
+
+PROCEDURE MetaErrorN1 (m: ARRAY OF CHAR; n: Name) ;
+PROCEDURE MetaErrorN2 (m: ARRAY OF CHAR; n1, n2: Name) ;
+PROCEDURE MetaErrorNT0 (tok: CARDINAL; format: ARRAY OF CHAR) ;
+PROCEDURE MetaErrorNT1 (tok: CARDINAL; format: ARRAY OF CHAR; name: Name) ;
+PROCEDURE MetaErrorNT2 (tok: CARDINAL; format: ARRAY OF CHAR; name1, name2: Name) ;
+
+PROCEDURE MetaString0 (m: String) : String ;
+PROCEDURE MetaString1 (m: String; s: CARDINAL) : String ;
+PROCEDURE MetaString2 (m: String; s1, s2: CARDINAL) : String ;
+PROCEDURE MetaString3 (m: String; s1, s2, s3: CARDINAL) : String ;
+PROCEDURE MetaString4 (m: String; s1, s2, s3, s4: CARDINAL) : String ;
+
+END M2MetaError.
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
new file mode 100644
index 00000000000..08c0985f7d2
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -0,0 +1,2477 @@
+(* M2MetaError.mod provides a set of high level error routines.
+
+Copyright (C) 2008-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2MetaError ;
+
+
+FROM M2Base IMPORT ZType, RType, IsPseudoBaseFunction, IsPseudoBaseProcedure ;
+FROM NameKey IMPORT Name, KeyToCharStar, NulName ;
+FROM StrLib IMPORT StrLen ;
+FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ;
+FROM M2Error IMPORT Error, NewError, NewWarning, NewNote, ErrorString, InternalError, ChainError, SetColor, FlushErrors, FlushWarnings ;
+FROM FIO IMPORT StdOut, WriteLine ;
+FROM SFIO IMPORT WriteS ;
+FROM StringConvert IMPORT ctos ;
+FROM M2Printf IMPORT printf1, printf0 ;
+FROM M2Options IMPORT LowerCaseKeywords ;
+FROM StrCase IMPORT Lower ;
+FROM libc IMPORT printf ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM M2Error IMPORT MoveError ;
+FROM M2Debug IMPORT Assert ;
+FROM Storage IMPORT ALLOCATE ;
+
+FROM Indexing IMPORT Index, InitIndex, KillIndex, GetIndice, PutIndice,
+                     DeleteIndice, HighIndice ;
+
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar,
+                           ConCat, ConCatChar, Mark, string, KillString,
+                           Dup, char, Length, Mult, EqualArray, Equal ;
+
+FROM SymbolTable IMPORT NulSym,
+                        IsDefImp, IsModule, IsInnerModule,
+                        IsUnknown, IsType, IsProcedure, IsParameter,
+                        IsParameterUnbounded, IsParameterVar, IsVarParam,
+                        IsUnboundedParam, IsPointer, IsRecord, IsVarient,
+                        IsFieldVarient, IsEnumeration, IsFieldEnumeration,
+                        IsUnbounded, IsArray, IsRecordField, IsProcType,
+                        IsVar, IsConst, IsConstString, IsConstLit, IsConstSet,
+                        IsConstructor, IsDummy, IsTemporary, IsVarAParam,
+                        IsSubscript, IsSubrange, IsSet, IsHiddenType,
+                        IsError, GetSymName, GetScope, IsExported,
+                        GetType, SkipType, GetDeclaredDef, GetDeclaredMod,
+                        GetDeclaredModule, GetDeclaredDefinition, GetScope,
+                        GetFirstUsed, IsNameAnonymous, GetErrorScope ;
+
+IMPORT M2ColorString ;
+IMPORT M2Error ;
+
+
+CONST
+   MaxStack   = 10 ;
+   Debugging  = FALSE ;
+   ColorDebug = FALSE ;
+
+TYPE
+   errorType = (none, error, warning, note, chained, aborta) ;
+   colorType = (unsetColor, noColor, quoteColor, filenameColor, errorColor,
+                warningColor, noteColor, keywordColor, locusColor,
+                insertColor, deleteColor, typeColor, range1Color, range2Color) ;
+
+   errorBlock = RECORD
+                   useError  : BOOLEAN ;
+                   e         : Error ;
+                   type      : errorType ;
+                   out, in   : String ;
+                   highplus1 : CARDINAL ;
+                   len,
+                   ini       : INTEGER ;
+                   glyph,
+                   chain,
+                   root,
+                   quotes,
+                   positive  : BOOLEAN ;
+                   currentCol,
+                   beginCol,                (* the color at the start of the string.          *)
+                   endCol    : colorType ;  (* the color at the end of the text before.       *)
+                   colorStack: ARRAY [0..MaxStack] OF colorType ;
+                   stackPtr  : CARDINAL ;
+                END ;
+
+
+    dictionaryEntry = POINTER TO RECORD
+                                    key,
+                                    value: String ;
+                                    next : dictionaryEntry ;
+                                 END ;
+
+
+VAR
+   lastRoot  : Error ;
+   lastColor : colorType ;
+   seenAbort : BOOLEAN ;
+   dictionary : Index ;
+   outputStack: Index ;
+   freeEntry  : dictionaryEntry ;
+
+
+(*
+   pushOutput -
+*)
+
+PROCEDURE pushOutput (VAR eb: errorBlock) ;
+BEGIN
+   PutIndice (outputStack, HighIndice (outputStack)+1, eb.out) ;
+   eb.out := InitString ('') ;
+   eb.glyph := FALSE
+END pushOutput ;
+
+
+(*
+   readWord - reads and returns a word delimited by '}' it uses '%' as
+              the escape character.
+*)
+
+PROCEDURE readWord (VAR eb: errorBlock) : String ;
+VAR
+   word: String ;
+BEGIN
+   word := InitString ('') ;
+   WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # "}") DO
+      IF char (eb.in, eb.ini) = "%"
+      THEN
+         INC (eb.ini)
+      END ;
+      word := ConCatChar (word, char (eb.in, eb.ini)) ;
+      INC (eb.ini)
+   END ;
+   RETURN word
+END readWord ;
+
+
+(*
+   addEntry -
+*)
+
+PROCEDURE addEntry (key, value: String) ;
+VAR
+   e: dictionaryEntry ;
+   s: String ;
+   i: CARDINAL ;
+BEGIN
+   s := lookupString (key) ;
+   IF s = NIL
+   THEN
+      e := newEntry () ;
+      e^.key := key ;
+      e^.value := value ;
+      PutIndice (dictionary, HighIndice (dictionary)+1, e)
+   ELSE
+      i := 1 ;
+      WHILE i <= HighIndice (dictionary) DO
+         e := GetIndice (dictionary, i) ;
+         IF Equal (e^.key, key)
+         THEN
+            e^.value := KillString (e^.value) ;
+            e^.value := value ;
+            RETURN
+         END ;
+         INC (i)
+      END
+   END
+END addEntry ;
+
+
+(*
+   popOutput -
+*)
+
+PROCEDURE popOutput (VAR eb: errorBlock) ;
+VAR
+   key,
+   previous: String ;
+BEGIN
+   IF HighIndice (outputStack) >= 1
+   THEN
+      previous := GetIndice (outputStack, HighIndice (outputStack)) ;
+      DeleteIndice (outputStack, HighIndice (outputStack)) ;
+      key := readWord (eb) ;
+      addEntry (key, eb.out) ;
+      eb.out := previous
+   END
+END popOutput ;
+
+
+(*
+   newEntry -
+*)
+
+PROCEDURE newEntry () : dictionaryEntry ;
+VAR
+   e: dictionaryEntry ;
+BEGIN
+   IF freeEntry = NIL
+   THEN
+      NEW (e)
+   ELSE
+      e := freeEntry ;
+      freeEntry := freeEntry^.next
+   END ;
+   WITH e^ DO
+      key := NIL ;
+      value := NIL ;
+      next := NIL
+   END ;
+   RETURN e
+END newEntry ;
+
+
+(*
+   killEntry - dispose e and delete any strings.
+*)
+
+PROCEDURE killEntry (e: dictionaryEntry) ;
+BEGIN
+   e^.next := freeEntry ;
+   freeEntry := e ;
+   IF e^.key # NIL
+   THEN
+      e^.key := KillString (e^.key)
+   END ;
+   IF e^.value # NIL
+   THEN
+      e^.value := KillString (e^.value)
+   END
+END killEntry ;
+
+
+(*
+   resetDictionary - remove all entries in the dictionary.
+*)
+
+PROCEDURE resetDictionary ;
+VAR
+   i: CARDINAL ;
+   e: dictionaryEntry ;
+BEGIN
+   i := 1 ;
+   WHILE i <= HighIndice (dictionary) DO
+      e := GetIndice (dictionary, i) ;
+      killEntry (e) ;
+      INC (i)
+   END ;
+   dictionary := KillIndex (dictionary) ;
+   dictionary := InitIndex (1)
+END resetDictionary ;
+
+
+(*
+   lookupString - lookup and return a duplicate of the string value for key s.
+                  NIL is returned if the key s is unknown.
+*)
+
+PROCEDURE lookupString (s: String) : String ;
+VAR
+   i: CARDINAL ;
+   e: dictionaryEntry ;
+BEGIN
+   i := 1 ;
+   WHILE i <= HighIndice (dictionary) DO
+      e := GetIndice (dictionary, i) ;
+      IF Equal (e^.key, s)
+      THEN
+         RETURN Dup (e^.value)
+      END ;
+      INC (i)
+   END ;
+   RETURN NIL
+END lookupString ;
+
+
+(*
+   lookupDefine - looks up the word in the input string (ending with '}').
+                  It uses this word as a key into the dictionary and returns
+                  the entry.
+*)
+
+PROCEDURE lookupDefine (VAR eb: errorBlock) : String ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString ('') ;
+   WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # "}") DO
+      IF char (eb.in, eb.ini) = "%"
+      THEN
+         INC (eb.ini)
+      END ;
+      s := ConCatChar (s, char (eb.in, eb.ini)) ;
+      INC (eb.ini)
+   END ;
+   s := lookupString (s) ;
+   IF s = NIL
+   THEN
+      s := InitString ('')
+   END ;
+   RETURN s
+END lookupDefine ;
+
+
+(*
+   processDefine - place contents of dictionary entry name onto the output string.
+*)
+
+PROCEDURE processDefine (VAR eb: errorBlock) ;
+BEGIN
+   eb.out := ConCat (eb.out, lookupDefine (eb))
+END processDefine ;
+
+
+(*
+   lookupColor - looks up the color enum from the string.
+*)
+
+PROCEDURE lookupColor (s: String) : colorType ;
+BEGIN
+   IF EqualArray (s, "filename")
+   THEN
+      RETURN filenameColor
+   ELSIF EqualArray (s, "quote")
+   THEN
+      RETURN quoteColor
+   ELSIF EqualArray (s, "error")
+   THEN
+      RETURN errorColor
+   ELSIF EqualArray (s, "warning")
+   THEN
+      RETURN warningColor ;
+   ELSIF EqualArray (s, "note")
+   THEN
+      RETURN warningColor ;
+   ELSIF EqualArray (s, "locus")
+   THEN
+      RETURN locusColor
+   ELSIF EqualArray (s, "insert")
+   THEN
+      RETURN insertColor
+   ELSIF EqualArray (s, "delete")
+   THEN
+      RETURN deleteColor
+   ELSIF EqualArray (s, "type")
+   THEN
+      RETURN typeColor
+   ELSIF EqualArray (s, "range1")
+   THEN
+      RETURN range1Color
+   ELSIF EqualArray (s, "range2")
+   THEN
+      RETURN range2Color
+   END ;
+   RETURN noColor
+END lookupColor ;
+
+
+(*
+   readColor -
+*)
+
+PROCEDURE readColor (VAR eb: errorBlock) : colorType ;
+VAR
+   s: String ;
+   c: colorType ;
+BEGIN
+   s := InitString ('') ;
+   WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # "}") DO
+      IF char (eb.in, eb.ini) = "%"
+      THEN
+         INC (eb.ini)
+      END ;
+      s := ConCatChar (s, char (eb.in, eb.ini)) ;
+      INC (eb.ini)
+   END ;
+   c := lookupColor (s) ;
+   s := KillString (s) ;
+   RETURN c
+END readColor ;
+
+
+(*
+   keyword - copy characters until the '}' in the input string and convert them to
+             the keyword color/font.
+*)
+
+PROCEDURE keyword (VAR eb: errorBlock) ;
+BEGIN
+   IF CAP (char (eb.in, eb.ini)) = 'K'
+   THEN
+      INC (eb.ini) ;
+      pushColor (eb) ;
+      changeColor (eb, keywordColor) ;
+      WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # "}") DO
+         IF Debugging
+         THEN
+            dump (eb)
+         END ;
+         IF char (eb.in, eb.ini) = "%"
+         THEN
+            INC (eb.ini)
+         END ;
+         copyKeywordChar (eb) ;
+         INC (eb.ini)
+      END ;
+      popColor (eb)
+   ELSE
+      InternalError ('expecting index to be on the K for keyword')
+   END
+END keyword ;
+
+
+(*
+   filename - copy characters until the '}' in the input string and convert them to
+              the filename color/font.
+*)
+
+PROCEDURE filename (VAR eb: errorBlock) ;
+BEGIN
+   IF CAP (char (eb.in, eb.ini)) = 'F'
+   THEN
+      INC (eb.ini) ;
+      pushColor (eb) ;
+      changeColor (eb, filenameColor) ;
+      WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # "}") DO
+         IF Debugging
+         THEN
+            dump (eb)
+         END ;
+         IF char (eb.in, eb.ini) = "%"
+         THEN
+            INC (eb.ini)
+         END ;
+         copyChar (eb) ;
+         INC (eb.ini)
+      END ;
+      popColor (eb)
+   ELSE
+      InternalError ('expecting index to be on the F for filename')
+   END
+END filename ;
+
+
+(*
+   pushColor -
+*)
+
+PROCEDURE pushColor (VAR eb: errorBlock) ;
+BEGIN
+   WITH eb DO
+      IF stackPtr > MaxStack
+      THEN
+         HALT
+      ELSE
+         colorStack[stackPtr] := currentCol ;
+         INC (stackPtr)
+      END
+   END
+END pushColor ;
+
+
+(*
+   popColor -
+*)
+
+PROCEDURE popColor (VAR eb: errorBlock) ;
+BEGIN
+   WITH eb DO
+      IF stackPtr > 0
+      THEN
+         DEC (stackPtr)
+      ELSE
+         HALT
+      END ;
+      currentCol := colorStack[stackPtr] ;
+      IF currentCol = unsetColor
+      THEN
+         currentCol := noColor
+      END
+   END
+END popColor ;
+
+
+(*
+   initErrorBlock - initialise an error block with the, input, string.
+*)
+
+PROCEDURE initErrorBlock (VAR eb: errorBlock; input: String; sym: ARRAY OF CARDINAL) ;
+BEGIN
+   WITH eb DO
+      useError   := TRUE ;
+      e          := NIL ;
+      type       := error ;  (* default to the error color.  *)
+      out        := InitString ('') ;
+      in         := input ;
+      highplus1  := HIGH (sym) + 1 ;
+      len        := Length (input) ;
+      ini        := 0 ;
+      glyph      := FALSE ;  (* nothing to output yet.  *)
+      quotes     := TRUE ;
+      positive   := TRUE ;
+      root       := FALSE ;
+      chain      := FALSE ;
+      currentCol := findColorType (input) ;
+      beginCol   := unsetColor ;
+      endCol     := unsetColor ;
+      stackPtr   := 0
+   END
+END initErrorBlock ;
+
+
+(*
+   push - performs a push from the oldblock to the newblock.
+          It copies all fields except the output string.
+*)
+
+PROCEDURE push (VAR newblock: errorBlock; oldblock: errorBlock) ;
+BEGIN
+   pushColor (oldblock) ;  (* save the current color.  *)
+   newblock := oldblock ;  (* copy all the fields.  *)
+   newblock.out := NIL ;  (* must do this before a clear as we have copied the address.  *)
+   clear (newblock) ;
+   newblock.quotes := TRUE
+END push ;
+
+
+(*
+   pop - copies contents of oldblock into newblock.  It only copies the error
+         handle if the toblock.e is NIL.
+*)
+
+PROCEDURE pop (VAR toblock, fromblock: errorBlock) ;
+VAR
+   c: colorType ;
+BEGIN
+   IF empty (fromblock)
+   THEN
+      toblock.stackPtr := fromblock.stackPtr ;
+      toblock.colorStack := fromblock.colorStack ;
+      popColor (toblock)   (* and restore the color from the push start.  *)
+   ELSE
+      IF fromblock.quotes
+      THEN
+         (* string needs to be quoted.  *)
+         IF toblock.currentCol = unsetColor
+         THEN
+            (* caller has not yet assigned a color, so use the callee color at the end.  *)
+            OutOpenQuote (toblock) ;
+            OutGlyphS (toblock, fromblock.out) ;
+            OutCloseQuote (toblock) ;
+            changeColor (toblock, fromblock.currentCol)
+         ELSE
+            shutdownColor (fromblock) ;
+            (* caller has assigned a color, so use it after the new string.  *)
+            c := toblock.currentCol ;
+            OutOpenQuote (toblock) ;
+            OutGlyphS (toblock, fromblock.out) ;
+            OutCloseQuote (toblock) ;
+            toblock.currentCol := c
+         END
+      ELSE
+         IF toblock.currentCol = unsetColor
+         THEN
+            OutGlyphS (toblock, fromblock.out) ;
+            toblock.endCol := fromblock.endCol ;
+            changeColor (toblock, fromblock.endCol)
+         ELSE
+            pushColor (toblock) ;
+            OutGlyphS (toblock, fromblock.out) ;
+            toblock.endCol := fromblock.endCol ;
+            popColor (toblock)
+         END
+      END
+   END ;
+   IF toblock.e = NIL
+   THEN
+      toblock.e := fromblock.e
+   END ;
+   toblock.chain := fromblock.chain ;
+   toblock.root := fromblock.root ;
+   toblock.ini := fromblock.ini ;
+   toblock.type := fromblock.type   (* might have been changed by the callee.  *)
+END pop ;
+
+
+(*
+   OutOpenQuote -
+*)
+
+PROCEDURE OutOpenQuote (VAR eb: errorBlock) ;
+BEGIN
+   eb.currentCol := noColor ;
+   flushColor (eb) ;
+   eb.out := ConCat (eb.out, openQuote (InitString ('')))
+END OutOpenQuote ;
+
+
+(*
+   OutCloseQuote -
+*)
+
+PROCEDURE OutCloseQuote (VAR eb: errorBlock) ;
+BEGIN
+   eb.out := ConCat (eb.out, closeQuote (InitString (''))) ;
+   eb.currentCol := noColor ;
+   eb.endCol := noColor
+END OutCloseQuote ;
+
+
+(*
+   findColorType - return the color of the string.  This is determined by the first
+                   occurrance of an error, warning or note marker.  An error message
+                   is assumed to either be: a keyword category, error category, note
+                   category, warning category or to be chained from a previous error.
+*)
+
+PROCEDURE findColorType (s: String) : colorType ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE i < Length (s) DO
+      IF char (s, i) = "{"
+      THEN
+         INC (i) ;
+         IF char (s, i) = "%"
+         THEN
+            INC (i) ;
+            WHILE (i < Length (s)) AND (char (s, i) # "}") DO
+               IF char (s, i) = "%"
+               THEN
+                  INC (i)
+               END ;
+               CASE char (s, i) OF
+
+               "K":  RETURN errorColor |   (* keyword errors start with the fatal error color.  *)
+               "E":  RETURN errorColor |
+               "A":  RETURN errorColor |
+               "O":  RETURN noteColor |
+               "W":  RETURN warningColor |
+               "C":  RETURN lastColor
+
+               ELSE
+               END ;
+               INC (i)
+            END
+         END
+      END ;
+      INC (i)
+   END ;
+   RETURN errorColor  (* default to the error color.  *)
+END findColorType ;
+
+
+(*
+   killErrorBlock - deallocates the dynamic strings associated with the error block.
+*)
+
+PROCEDURE killErrorBlock (VAR eb: errorBlock) ;
+BEGIN
+   WITH eb DO
+      out := KillString (out) ;
+      in := KillString (in)
+   END
+END killErrorBlock ;
+
+
+(*
+   ebnf := { percent
+             | lbra
+             | any                  % copy ch %
+           }
+         =:
+
+   percent := '%' ( "<" |           % open quote
+                    ">" |           % close quote
+                    anych )         % copy anych %
+            =:
+
+   lbra := '{' [ '!' ] percenttoken '}' =:
+
+   percenttoken := '%' (
+                         '1'        % doOperand(1) %
+                             op
+                       | '2'        % doOperand(2) %
+                             op
+                       | '3'        % doOperand(3) %
+                             op
+                       | '4'        % doOperand(4) %
+                             op
+                       )
+                 =:
+
+   op := {'a'|'q'|'t'|'d'|'n'|'s'|'D'|'I'|'U'|'E'|'W'|'A'} then =:
+
+   then := [ ':' ebnf ] =:
+*)
+
+
+(*
+   InternalFormat - produces an informative internal error.
+*)
+
+PROCEDURE InternalFormat (eb: errorBlock; m: ARRAY OF CHAR; line: CARDINAL) ;
+BEGIN
+   printf1 ("M2MetaError.mod:%d:internalformat error detected\n", line) ;
+   dump (eb) ;
+   InternalError (m)
+END InternalFormat ;
+
+
+(*
+   x - checks to see that a=b.
+*)
+
+PROCEDURE x (a, b: String) : String ;
+BEGIN
+   IF a # b
+   THEN
+      InternalError ('different string returned')
+   END ;
+   RETURN a
+END x ;
+
+
+(*
+   IsWhite - returns TRUE if, ch, is a space.
+*)
+
+PROCEDURE IsWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN ch = ' '
+END IsWhite ;
+
+
+(*
+   skip - skips over this level input until the next '}'.
+*)
+
+PROCEDURE skip (VAR sb: errorBlock) ;
+VAR
+   level: INTEGER ;
+BEGIN
+   level := 0 ;
+   WHILE sb.ini < sb.len DO
+      IF (level = 0) AND (char (sb.in, sb.ini) = "}")
+      THEN
+         RETURN
+      END ;
+      IF char (sb.in, sb.ini) = "}"
+      THEN
+         DEC (level)
+      ELSIF char (sb.in, sb.ini) = "{"
+      THEN
+         INC (level)
+      END ;
+      INC (sb.ini)
+   END
+END skip ;
+
+
+(*
+   ifNonNulThen := [ ':' ebnf ] =:
+*)
+
+PROCEDURE ifNonNulThen (VAR eb: errorBlock;
+                        sym: ARRAY OF CARDINAL) ;
+BEGIN
+   IF char (eb.in, eb.ini) = ':'
+   THEN
+      INC (eb.ini) ;
+      IF eb.positive
+      THEN
+         IF empty (eb) AND (Length (eb.out) # 0)
+         THEN
+            printf0 ("inconsistency found\n") ;
+            dump (eb)
+         END ;
+         IF empty (eb)
+         THEN
+            IF Debugging
+            THEN
+               printf0 ("empty expression, skip\n")
+            END ;
+            clear (eb) ;
+            (* skip over this level of input text.  *)
+            skip (eb)
+         ELSE
+            IF Debugging
+            THEN
+               dump (eb) ;
+               printf0 ("non empty expression, clear and continue\n") ;
+            END ;
+            clear (eb) ;
+            IF Debugging
+            THEN
+               dump (eb) ;
+               printf0 ("cleared, continue\n") ;
+               dump (eb)
+            END ;
+            (* carry on processing input text.  *)
+            ebnf (eb, sym) ;
+            IF Debugging
+            THEN
+               printf0 ("evaluated\n") ;
+               dump (eb)
+            END
+         END
+      ELSE
+         IF empty (eb)
+         THEN
+            clear (eb) ;
+            (* carry on processing input text.  *)
+            ebnf (eb, sym)
+         ELSE
+            clear (eb) ;
+            (* skip over this level of input text.  *)
+            skip (eb)
+         END
+      END ;
+      IF (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}')
+      THEN
+         InternalFormat (eb, 'expecting to see }', __LINE__)
+      END
+   END
+END ifNonNulThen ;
+
+
+(*
+   doNumber -
+*)
+
+PROCEDURE doNumber (VAR eb: errorBlock;
+                    sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF empty (eb)
+   THEN
+      eb.quotes := FALSE ;
+      OutGlyphS (eb, ctos (sym[bol], 0, ' '))
+   END
+END doNumber ;
+
+
+(*
+   doCount -
+*)
+
+PROCEDURE doCount (VAR eb: errorBlock;
+                   sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF empty (eb)
+   THEN
+      eb.quotes := FALSE ;
+      OutGlyphS (eb, ctos(sym[bol], 0, ' ')) ;
+      CASE sym[bol] MOD 100 OF
+
+      11..13:  OutGlyphS (eb, Mark (InitString ('th')))
+
+      ELSE
+         CASE sym[bol] MOD 10 OF
+
+         1:  OutGlyphS (eb, Mark (InitString ('st'))) |
+         2:  OutGlyphS (eb, Mark (InitString ('nd'))) |
+         3:  OutGlyphS (eb, Mark (InitString ('rd')))
+
+         ELSE
+            OutGlyphS (eb, Mark (InitString ('th')))
+         END
+      END
+   END
+END doCount ;
+
+
+PROCEDURE doAscii (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF (sym[bol] = NulSym) OR (NOT empty (eb)) OR IsTemporary (sym[bol]) OR IsNameAnonymous (sym[bol])
+   THEN
+      RETURN
+   ELSE
+      OutGlyphS (eb, InitStringCharStar (KeyToCharStar (GetSymName (sym[bol]))))
+   END
+END doAscii ;
+
+
+(*
+   unquotedKeyword -
+*)
+
+PROCEDURE unquotedKeyword (VAR eb: errorBlock) ;
+BEGIN
+   eb.quotes := FALSE ;
+   keyword (eb)
+END unquotedKeyword ;
+
+
+(*
+   OutArray -
+*)
+
+PROCEDURE OutArray (VAR eb: errorBlock; a: ARRAY OF CHAR) ;
+BEGIN
+   OutGlyphS (eb, Mark (InitString (a)))
+END OutArray ;
+
+
+(*
+   OutGlyphS - outputs a string of glyphs.
+*)
+
+PROCEDURE OutGlyphS (VAR eb: errorBlock; s: String) ;
+BEGIN
+   IF Length (s) > 0
+   THEN
+      flushColor (eb) ;
+      checkMe ;
+      eb.glyph := TRUE ;
+      eb.out := ConCat (eb.out, s)
+   END
+END OutGlyphS ;
+
+
+(*
+   OutColorS - outputs a string of color requests.
+*)
+
+(*
+PROCEDURE OutColorS (VAR eb: errorBlock; s: String) ;
+BEGIN
+   flushColor (eb) ;
+   eb.out := ConCat (eb.out, s)
+END OutColorS ;
+*)
+
+
+(*
+   empty - returns TRUE if the output string is empty.
+           It ignores color changes.
+*)
+
+PROCEDURE empty (VAR eb: errorBlock) : BOOLEAN ;
+BEGIN
+   RETURN NOT eb.glyph
+END empty ;
+
+
+(*
+   clear - remove the output string.
+*)
+
+PROCEDURE clear (VAR eb: errorBlock) ;
+BEGIN
+   eb.out := KillString (eb.out) ;
+   eb.out := InitString ('') ;
+   eb.glyph := FALSE ;
+   eb.beginCol := unsetColor ;
+   eb.quotes := FALSE
+END clear ;
+
+
+PROCEDURE doName (VAR eb: errorBlock;
+                  sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF (NOT empty (eb)) OR (sym[bol] = NulSym) OR IsTemporary (sym[bol]) OR IsNameAnonymous (sym[bol])
+   THEN
+      RETURN
+   ELSE
+      IF sym[bol] = ZType
+      THEN
+         eb.quotes := FALSE ;
+         OutArray (eb, 'the ZType')
+      ELSIF sym[bol] = RType
+      THEN
+         eb.quotes := FALSE ;
+         OutArray (eb, 'the RType')
+      ELSE
+         doAscii (eb, sym, bol)
+      END
+   END
+END doName ;
+
+
+PROCEDURE doQualified (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+VAR
+   mod: ARRAY [0..1] OF CARDINAL ;
+BEGIN
+   IF (NOT empty (eb)) OR (sym[bol] = NulSym) OR IsTemporary (sym[bol]) OR IsNameAnonymous (sym[bol])
+   THEN
+      RETURN
+   ELSE
+      mod[0] := GetScope (sym[bol]) ;
+      IF IsDefImp (mod[0]) AND IsExported (mod[0], sym[bol])
+      THEN
+         doAscii (eb, mod, 0) ;
+         OutArray (eb, '.') ;
+         OutGlyphS (eb, Mark (InitStringCharStar (KeyToCharStar (GetSymName (sym[bol])))))
+      ELSE
+         doAscii (eb, sym, bol)
+      END
+   END
+END doQualified ;
+
+
+(*
+   doType - returns a string containing the type name of
+            sym.
+*)
+
+PROCEDURE doType (VAR eb: errorBlock;
+                  sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF (NOT empty (eb)) OR (sym[bol] = NulSym)
+   THEN
+      RETURN
+   ELSE
+      sym[bol] := GetType (sym[bol]) ;
+      doAscii (eb, sym, bol)
+   END
+END doType ;
+
+
+(*
+   doSkipType - will skip all pseudonym types.  It also
+                returns the type symbol found and name.
+*)
+
+PROCEDURE doSkipType (eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF (NOT empty (eb)) OR (sym[bol] = NulSym)
+   THEN
+      RETURN
+   ELSE
+      sym[bol] := SkipType(sym[bol]) ;
+      WHILE IsType(sym[bol]) AND ((GetSymName (sym[bol]) = NulName) OR
+                                  IsNameAnonymous (sym[bol])) DO
+         sym[bol] := GetType (sym[bol])
+      END ;
+      doAscii (eb, sym, bol)
+   END
+END doSkipType ;
+
+
+(*
+   doGetType - attempts to get the type of sym[bol].
+*)
+
+PROCEDURE doGetType (VAR eb: errorBlock;
+                     VAR sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF (bol > HIGH (sym)) OR (NOT empty (eb)) OR (sym[bol] = NulSym)
+   THEN
+      RETURN
+   ELSE
+      sym[bol] := GetType (sym[bol])
+   END
+END doGetType ;
+
+
+(*
+   doGetSkipType - will skip all pseudonym types.  It also
+                   returns the type symbol found and name.
+*)
+
+PROCEDURE doGetSkipType (VAR eb: errorBlock; VAR sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+VAR
+   prev: CARDINAL ;
+BEGIN
+   IF (bol > HIGH (sym)) OR (NOT empty (eb)) OR (sym[bol] = NulSym)
+   THEN
+      RETURN
+   ELSE
+      REPEAT
+         prev := sym[bol] ;
+         sym[bol] := SkipType (sym[bol]) ;
+         IF IsType(sym[bol]) AND ((GetSymName (sym[bol]) = NulName) OR
+                                  IsNameAnonymous (sym[bol])) AND
+            (GetType(sym[bol]) # NulSym)
+         THEN
+            sym[bol] := GetType (sym[bol])
+         END
+      UNTIL sym[bol] = prev
+   END
+END doGetSkipType ;
+
+
+(*
+   doChain -
+*)
+
+PROCEDURE doChain (VAR eb: errorBlock; tok: CARDINAL) ;
+BEGIN
+   IF lastRoot=NIL
+   THEN
+      InternalError ('should not be chaining an error onto an empty error note')
+   ELSE
+      eb.e := ChainError (tok, lastRoot)
+   END
+END doChain ;
+
+
+(*
+   doError - creates and returns an error note.
+*)
+
+PROCEDURE doError (VAR eb: errorBlock; tok: CARDINAL) ;
+BEGIN
+   IF eb.useError
+   THEN
+      chooseError (eb, tok)
+   END
+END doError ;
+
+
+(*
+   defaultError - adds the default error location to, tok, if one has not already been
+                  assigned.
+*)
+
+PROCEDURE defaultError (VAR eb: errorBlock; tok: CARDINAL) ;
+BEGIN
+   IF eb.e = NIL
+   THEN
+      doError (eb, tok)
+   END
+END defaultError ;
+
+
+(*
+   chooseError - choose the error kind dependant upon type.
+                 Either an error, warning or note will be generated.
+*)
+
+PROCEDURE chooseError (VAR eb: errorBlock; tok: CARDINAL) ;
+BEGIN
+   IF eb.chain
+   THEN
+      doChain (eb, tok)
+   ELSE
+      CASE eb.type OF
+
+      chained:  doChain (eb, tok) |
+      none,
+      aborta,
+      error  :  IF eb.e=NIL
+                THEN
+                   eb.e := NewError (tok)
+                ELSE
+                   eb.e := MoveError (eb.e, tok)
+                END |
+      warning:  IF eb.e=NIL
+                THEN
+                   eb.e := NewWarning (tok)
+                ELSE
+                   eb.e := MoveError (eb.e, tok)
+                END |
+      note   :  IF eb.e=NIL
+                THEN
+                   eb.e := NewNote (tok)
+                ELSE
+                   eb.e := MoveError (eb.e, tok)
+                END
+
+      ELSE
+         InternalError ('unexpected enumeration value')
+      END
+   END ;
+   IF eb.root
+   THEN
+      lastRoot := eb.e ;
+      lastColor := findColorType (eb.in)
+   END ;
+   eb.e := SetColor (eb.e)
+END chooseError ;
+
+
+(*
+   doErrorScopeMod - potentially create an error referring to the definition
+                     module, fall back to the implementation or program module if
+                     there is no declaration in the definition module.
+*)
+
+PROCEDURE doErrorScopeMod (VAR eb: errorBlock; sym: CARDINAL) ;
+VAR
+   scope: CARDINAL ;
+BEGIN
+   scope := GetScope (sym) ;
+   IF scope = NulSym
+   THEN
+      M2Error.EnterErrorScope (NIL) ;
+      doError (eb, GetDeclaredMod (sym))
+   ELSE
+      M2Error.EnterErrorScope (GetErrorScope (scope)) ;
+      IF IsProcedure (scope)
+      THEN
+         doError (eb, GetDeclaredMod (sym))
+      ELSE
+         IF IsModule (scope)
+         THEN
+            IF IsInnerModule (scope)
+            THEN
+               doError (eb, GetDeclaredMod (sym))
+            ELSE
+               doError (eb, GetDeclaredMod (sym))
+            END
+         ELSE
+            Assert (IsDefImp (scope)) ;
+            (* if this fails then we need to skip to the outer scope.
+            REPEAT
+             OuterModule := GetScope(OuterModule)
+            UNTIL GetScope(OuterModule)=NulSym ;  *)
+            IF GetDeclaredModule (sym) = UnknownTokenNo
+            THEN
+               doError (eb, GetDeclaredDef (sym))
+            ELSE
+               doError (eb, GetDeclaredMod (sym))
+            END
+         END
+      END
+   END ;
+   M2Error.LeaveErrorScope
+END doErrorScopeMod ;
+
+
+(*
+   doErrorScopeDef - potentially create an error referring to the definition
+                     module, fall back to the implementation or program module if
+                     there is no declaration in the definition module.
+*)
+
+PROCEDURE doErrorScopeDef (VAR eb: errorBlock; sym: CARDINAL) ;
+VAR
+   scope: CARDINAL ;
+BEGIN
+   scope := GetScope (sym) ;
+   IF scope = NulSym
+   THEN
+      M2Error.EnterErrorScope (NIL) ;
+      doError (eb, GetDeclaredDef (sym))
+   ELSE
+      M2Error.EnterErrorScope (GetErrorScope (scope)) ;
+      IF IsProcedure (scope)
+      THEN
+         doError (eb, GetDeclaredDef (sym))
+      ELSE
+         IF IsModule (scope)
+         THEN
+            IF IsInnerModule (scope)
+            THEN
+               doError (eb, GetDeclaredDef (sym))
+            ELSE
+               doError (eb, GetDeclaredDef (sym))
+            END
+         ELSE
+            Assert (IsDefImp (scope)) ;
+            (* if this fails then we need to skip to the outer scope.
+            REPEAT
+             OuterModule := GetScope(OuterModule)
+            UNTIL GetScope(OuterModule)=NulSym ;  *)
+            IF GetDeclaredDefinition (sym) = UnknownTokenNo
+            THEN
+               doError (eb, GetDeclaredMod (sym))
+            ELSE
+               doError (eb, GetDeclaredDef (sym))
+            END
+         END
+   END
+   END ;
+   M2Error.LeaveErrorScope
+END doErrorScopeDef ;
+
+
+(*
+   declaredDef - creates an error note where sym[bol] was declared.
+*)
+
+PROCEDURE declaredDef (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF bol <= HIGH (sym)
+   THEN
+      doErrorScopeDef (eb, sym[bol])
+   END
+END declaredDef ;
+
+
+(*
+   doDeclaredMod - creates an error note where sym[bol] was declared.
+*)
+
+PROCEDURE declaredMod (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF bol <= HIGH (sym)
+   THEN
+      doErrorScopeMod (eb, sym[bol])
+   END
+END declaredMod ;
+
+
+(*
+   used - creates an error note where sym[bol] was first used.
+*)
+
+PROCEDURE used (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF bol <= HIGH (sym)
+   THEN
+      doError (eb, GetFirstUsed (sym[bol]))
+   END
+END used ;
+
+
+(*
+   ConCatWord - joins sentances, a, b, together.
+*)
+
+(*
+PROCEDURE ConCatWord (a, b: String) : String ;
+BEGIN
+   IF (Length (a) = 1) AND (char(a, 0) = 'a')
+   THEN
+      a := x (a, ConCatChar (a, 'n'))
+   ELSIF (Length (a) > 1) AND (char (a, -1) = 'a') AND IsWhite (char(a, -2))
+   THEN
+      a := x (a, ConCatChar (a, 'n'))
+   END ;
+   IF (Length (a) > 0) AND (NOT IsWhite (char (a, -1)))
+   THEN
+      a := x (a, ConCatChar (a, ' '))
+   END ;
+   RETURN x (a, ConCat(a, b))
+END ConCatWord ;
+*)
+
+
+(*
+   symDesc -
+*)
+
+PROCEDURE symDesc (sym: CARDINAL) : String ;
+BEGIN
+   IF IsConstLit (sym)
+   THEN
+      RETURN InitString ('constant literal')
+   ELSIF IsConstSet (sym)
+   THEN
+      RETURN InitString ('constant set')
+   ELSIF IsConstructor (sym)
+   THEN
+      RETURN InitString ('constructor')
+   ELSIF IsConst(sym)
+   THEN
+      RETURN InitString('constant')
+   ELSIF IsArray(sym)
+   THEN
+      RETURN InitString('array')
+   ELSIF IsVar(sym)
+   THEN
+      IF IsTemporary (sym)
+      THEN
+         RETURN InitString('expression')
+      ELSE
+         RETURN InitString('variable')
+      END
+   ELSIF IsEnumeration(sym)
+   THEN
+      RETURN InitString('enumeration type')
+   ELSIF IsFieldEnumeration(sym)
+   THEN
+      RETURN InitString('enumeration field')
+   ELSIF IsUnbounded(sym)
+   THEN
+      RETURN InitString('unbounded parameter')
+   ELSIF IsProcType(sym)
+   THEN
+      RETURN InitString('procedure type')
+   ELSIF IsPseudoBaseFunction (sym)
+   THEN
+      RETURN InitString('standard function procedure')
+   ELSIF IsPseudoBaseProcedure (sym)
+   THEN
+      RETURN InitString('standard procedure')
+   ELSIF IsProcedure(sym)
+   THEN
+      RETURN InitString('procedure')
+   ELSIF IsPointer(sym)
+   THEN
+      RETURN InitString('pointer')
+   ELSIF IsParameter(sym)
+   THEN
+      IF IsParameterVar(sym)
+      THEN
+         RETURN InitString('var parameter')
+      ELSE
+         RETURN InitString('parameter')
+      END
+   ELSIF IsType(sym)
+   THEN
+      RETURN InitString('type')
+   ELSIF IsRecord(sym)
+   THEN
+      RETURN InitString('record')
+   ELSIF IsRecordField(sym)
+   THEN
+      RETURN InitString('record field')
+   ELSIF IsVarient(sym)
+   THEN
+      RETURN InitString('varient record')
+   ELSIF IsModule(sym)
+   THEN
+      RETURN InitString('module')
+   ELSIF IsDefImp(sym)
+   THEN
+      RETURN InitString('definition or implementation module')
+   ELSIF IsSet(sym)
+   THEN
+      RETURN InitString('set')
+   ELSIF IsUnknown(sym)
+   THEN
+      RETURN InitString('an unknown')
+   ELSIF IsSubrange(sym)
+   THEN
+      RETURN InitString('subrange')
+   ELSE
+      RETURN InitString ('')
+   END
+END symDesc ;
+
+
+(*
+   doDesc -
+*)
+
+PROCEDURE doDesc (VAR eb: errorBlock;
+                  sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   IF empty (eb)
+   THEN
+      OutGlyphS (eb, symDesc (sym[bol])) ;
+      IF NOT empty (eb)
+      THEN
+         eb.quotes := FALSE
+      END
+   END
+END doDesc ;
+
+
+(*
+   copySym - copies, n+1, symbols, from, ->, to.
+*)
+
+(*
+PROCEDURE copySym (from: ARRAY OF CARDINAL; VAR to: ARRAY OF CARDINAL; n: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF n>HIGH(to)
+   THEN
+      InternalError ('not enough room in the destination array')
+   ELSE
+      i := 0 ;
+      WHILE i<=n DO
+         to[i] := from[i] ;
+         INC(i)
+      END
+   END
+END copySym ;
+*)
+
+
+(*
+   op := {'a'|'q'|'t'|'d'|'n'|'s'| 'u' |'D'|'I'|'U'|'E'|'W'} then =:
+*)
+
+PROCEDURE op (VAR eb: errorBlock;
+              sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+   WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}') DO
+      IF Debugging
+      THEN
+         printf0 ("while loop in op\n") ;
+         dump (eb)
+      END ;
+      CASE char (eb.in, eb.ini) OF
+
+      '!':  eb.positive := NOT eb.positive |
+      'a':  doName (eb, sym, bol) |
+      'q':  doQualified (eb, sym, bol) |
+      't':  doType (eb, sym, bol) |
+      'd':  doDesc (eb, sym, bol) |
+      'n':  doNumber (eb, sym, bol) |
+      'N':  doCount (eb, sym, bol) |
+      's':  doSkipType (eb, sym, bol) |
+      'D':  declaredDef (eb, sym, bol) |
+      'M':  declaredMod (eb, sym, bol) |
+      'U':  used (eb, sym, bol) |
+      'E':  eb.type := error |
+      'A':  eb.type := aborta ;
+            seenAbort := TRUE |
+      'W':  eb.type := warning |
+      'O':  eb.type := note |
+      'C':  eb.chain := TRUE |
+      'R':  eb.root := TRUE |
+      'S':  doGetSkipType (eb, sym, bol) |
+      'T':  doGetType (eb, sym, bol) |
+      'P':  pushColor (eb) |
+      'p':  popColor (eb) |
+      'c':  eb.currentCol := readColor (eb) ;
+            DEC (eb.ini) |
+      'K':  keyword (eb) ;
+            DEC (eb.ini) |
+      'k':  unquotedKeyword (eb) ;
+            DEC (eb.ini) |
+      'Q':  resetDictionary |
+      'X':  pushOutput (eb) |
+      'Y':  processDefine (eb) |
+      'Z':  popOutput (eb) |
+      'F':  filename (eb) ;
+            DEC (eb.ini) |
+      'u':  eb.quotes := FALSE |
+      ':':  ifNonNulThen (eb, sym) ;
+            DEC (eb.ini)
+
+      ELSE
+         InternalFormat (eb, 'expecting one of [akqtdnpsuCDEFKNOPQRSTUWXYZ:<>%]', __LINE__)
+      END ;
+      INC (eb.ini)
+   END ;
+   IF Debugging
+   THEN
+      printf0 ("finishing op\n") ;
+      dump (eb)
+   END
+END op ;
+
+
+(*
+   percenttoken := '%' (
+                         '1'        % doOperand(1) %
+                             op
+                       | '2'        % doOperand(2) %
+                             op
+                       | '3'        % doOperand(3) %
+                             op
+                       | '4'        % doOperand(4) %
+                             op
+                       )
+                       } =:
+*)
+
+PROCEDURE percenttoken (VAR eb: errorBlock; sym: ARRAY OF CARDINAL) ;
+BEGIN
+   IF char (eb.in, eb.ini) = '%'
+   THEN
+      INC (eb.ini) ;
+      CASE char (eb.in, eb.ini) OF
+
+      '1':  INC (eb.ini) ;
+            op (eb, sym, 0) |
+      '2':  INC (eb.ini) ;
+            op (eb, sym, 1) |
+      '3':  INC (eb.ini) ;
+            op (eb, sym, 2) |
+      '4':  INC (eb.ini) ;
+            op (eb, sym, 3)
+
+      ELSE
+         op (eb, sym, 0)
+      END ;
+      IF (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}')
+      THEN
+         InternalFormat (eb, 'expecting to see }', __LINE__)
+      END
+   END
+END percenttoken ;
+
+
+(*
+   changeColor - changes to color, c.
+*)
+
+PROCEDURE changeColor (VAR eb: errorBlock; c: colorType) ;
+BEGIN
+   eb.currentCol := c
+END changeColor ;
+
+
+(*
+   shutdownColor - shutdown existing color if it exists.
+*)
+
+PROCEDURE shutdownColor (VAR eb: errorBlock) ;
+BEGIN
+   IF (eb.endCol # unsetColor) AND (eb.endCol # noColor)
+   THEN
+      eb.out := colorEnd (eb.out) ;
+      eb.endCol := noColor
+   END
+END shutdownColor ;
+
+
+(*
+   flushColor - flushes any outstanding color change.
+*)
+
+PROCEDURE flushColor (VAR eb: errorBlock) ;
+BEGIN
+   IF eb.endCol # eb.currentCol
+   THEN
+      shutdownColor (eb) ;
+      IF eb.endCol # eb.currentCol
+      THEN
+         emitColor (eb, eb.currentCol) ;
+         eb.endCol := eb.currentCol
+      END ;
+      IF eb.beginCol = unsetColor
+      THEN
+         eb.beginCol := eb.currentCol
+      END
+   END
+END flushColor ;
+
+
+(*
+   emitColorGCC -
+*)
+
+PROCEDURE emitColorGCC (VAR eb: errorBlock; c: colorType) ;
+BEGIN
+   CASE c OF
+
+   unsetColor   :  |
+   noColor      :  eb.out := M2ColorString.endColor (eb.out) |
+   quoteColor   :  eb.out := M2ColorString.quoteColor (eb.out) |
+   filenameColor:  eb.out := M2ColorString.filenameColor (eb.out) |
+   errorColor   :  eb.out := M2ColorString.errorColor (eb.out) |
+   warningColor :  eb.out := M2ColorString.warningColor (eb.out) |
+   noteColor    :  eb.out := M2ColorString.noteColor (eb.out) |
+   keywordColor :  eb.out := M2ColorString.locusColor (eb.out) |
+   locusColor   :  eb.out := M2ColorString.locusColor (eb.out) |
+   insertColor  :  eb.out := M2ColorString.insertColor (eb.out) |
+   deleteColor  :  eb.out := M2ColorString.deleteColor (eb.out) |
+   typeColor    :  eb.out := M2ColorString.typeColor (eb.out) |
+   range1Color  :  eb.out := M2ColorString.range1Color (eb.out) |
+   range2Color  :  eb.out := M2ColorString.range2Color (eb.out)
+
+   END
+END emitColorGCC ;
+
+
+(*
+   emitColorTag -
+*)
+
+PROCEDURE emitColorTag (VAR eb: errorBlock; c: colorType) ;
+VAR
+   s: String ;
+BEGIN
+   CASE c OF
+
+   unsetColor   :  s := InitString ('<unset>') |
+   noColor      :  s := InitString ('<nocol>') ; stop |
+   quoteColor   :  s := InitString ('<quote>') |
+   filenameColor:  s := InitString ('<filename>') |
+   errorColor   :  s := InitString ('<error>') |
+   warningColor :  s := InitString ('<warn>') |
+   noteColor    :  s := InitString ('<note>') |
+   keywordColor :  s := InitString ('<key>') |
+   locusColor   :  s := InitString ('<locus>') |
+   insertColor  :  s := InitString ('<insert>') |
+   deleteColor  :  s := InitString ('<delete>') |
+   typeColor    :  s := InitString ('<type>') |
+   range1Color  :  s := InitString ('<range1>') |
+   range2Color  :  s := InitString ('<range2>')
+
+   END ;
+   eb.out := ConCat (eb.out, Mark (s))
+END emitColorTag ;
+
+
+(*
+   emitColor - adds the appropriate color string to the output string.
+*)
+
+PROCEDURE emitColor (VAR eb: errorBlock; c: colorType) ;
+BEGIN
+   IF ColorDebug
+   THEN
+      emitColorTag (eb, c)
+   ELSE
+      emitColorGCC (eb, c)
+   END
+END emitColor ;
+
+
+(*
+   openQuote -
+*)
+
+PROCEDURE openQuote (s: String) : String ;
+BEGIN
+   IF ColorDebug
+   THEN
+      RETURN ConCat (s, Mark (InitString ('<openquote>')))
+   ELSE
+      RETURN M2ColorString.quoteOpen (s)
+   END
+END openQuote ;
+
+
+(*
+   closeQuote -
+*)
+
+PROCEDURE closeQuote (s: String) : String ;
+BEGIN
+   IF ColorDebug
+   THEN
+      RETURN ConCat (s, Mark (InitString ('<closequote>')))
+   ELSE
+      RETURN M2ColorString.quoteClose (s)
+   END
+END closeQuote ;
+
+
+(*
+   colorEnd -
+*)
+
+PROCEDURE colorEnd (s: String) : String ;
+BEGIN
+   stop ;
+   IF ColorDebug
+   THEN
+      RETURN ConCat (s, Mark (InitString ('<nocol>')))
+   ELSE
+      RETURN M2ColorString.endColor (s)
+   END
+END colorEnd ;
+
+
+(*
+   copyChar - copies a character from in string to out string.
+*)
+
+PROCEDURE copyChar (VAR eb: errorBlock) ;
+BEGIN
+   IF eb.ini < eb.len
+   THEN
+      flushColor (eb) ;
+      checkMe ;
+      eb.glyph := TRUE ;
+      eb.out := x (eb.out, ConCatChar (eb.out, char (eb.in, eb.ini)))
+   END
+END copyChar ;
+
+
+(*
+   copyKeywordChar - copies a character from in string to out string
+                     it will convert the character to lower case if the
+                     -fm2-lower-case option was specified.
+*)
+
+PROCEDURE copyKeywordChar (VAR eb: errorBlock) ;
+VAR
+   ch: CHAR ;
+BEGIN
+   IF eb.ini < eb.len
+   THEN
+      flushColor (eb) ;
+      ch := char (eb.in, eb.ini) ;
+      IF LowerCaseKeywords
+      THEN
+         ch := Lower (ch)
+      END ;
+      eb.glyph := TRUE ;
+      eb.out := x (eb.out, ConCatChar (eb.out, ch))
+   END
+END copyKeywordChar ;
+
+
+(*
+   percent := '%' anych           % copy anych %
+            =:
+*)
+
+PROCEDURE percent (VAR eb: errorBlock; sym: ARRAY OF CARDINAL) ;
+BEGIN
+   IF char (eb.in, eb.ini)='%'
+   THEN
+      INC (eb.ini) ;
+      IF eb.ini < eb.len
+      THEN
+         IF char (eb.in, eb.ini) = '<'
+         THEN
+            (* %< is a quotation symbol.  *)
+            pushColor (eb) ;
+            eb.currentCol := noColor ;
+            flushColor (eb) ;
+            changeColor (eb, quoteColor) ;
+            eb.endCol := quoteColor ;  (* the openQuote will change the color.  *)
+            (* OutGlyphS performs a flush and we are emitting the open quote glyph.  *)
+            OutGlyphS (eb, openQuote (InitString ('')))
+         ELSIF char (eb.in, eb.ini) = '>'
+         THEN
+            OutGlyphS (eb, closeQuote (InitString (''))) ;
+            eb.endCol := noColor ;  (* closeQuote also turns off color.  *)
+            popColor (eb)
+         ELSE
+            copyChar (eb)
+         END
+      END
+   END
+END percent ;
+
+
+(*
+   lbra := '{' [ '!' ] percenttoken '}' =:
+*)
+
+PROCEDURE lbra (VAR eb: errorBlock; sym: ARRAY OF CARDINAL) ;
+BEGIN
+   IF char (eb.in, eb.ini) = '{'
+   THEN
+      eb.positive := TRUE ;
+      INC (eb.ini) ;
+      IF char (eb.in, eb.ini) = '!'
+      THEN
+         eb.positive := FALSE ;
+         INC (eb.ini)
+      END ;
+      IF char (eb.in, eb.ini) # '%'
+      THEN
+         InternalFormat (eb, 'expecting to see %', __LINE__)
+      END ;
+      percenttoken (eb, sym) ;
+      IF (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}')
+      THEN
+         InternalFormat (eb, 'expecting to see }', __LINE__)
+      END
+   END
+END lbra ;
+
+
+PROCEDURE stop ; BEGIN END stop ;
+
+PROCEDURE checkMe ; BEGIN END checkMe ;
+
+
+(*
+   dumpErrorType -
+*)
+
+PROCEDURE dumpErrorType (e: errorType) ;
+BEGIN
+   CASE e OF
+
+   none   :  printf0 ("none") |
+   error  :  printf0 ("error") |
+   warning:  printf0 ("warning") |
+   note   :  printf0 ("note") |
+   chained:  printf0 ("chained") |
+   aborta :  printf0 ("abort")
+
+   END
+END dumpErrorType ;
+
+
+(*
+   dumpColorType -
+*)
+
+PROCEDURE dumpColorType (c: colorType) ;
+BEGIN
+   CASE c OF
+
+   unsetColor   :  printf0 ("unsetColor") |
+   noColor      :  printf0 ("noColor") |
+   quoteColor   :  printf0 ("quoteColor") |
+   filenameColor:  printf0 ("filenameColor") |
+   errorColor   :  printf0 ("errorColor") |
+   warningColor :  printf0 ("warningColor") |
+   noteColor    :  printf0 ("noteColor") |
+   keywordColor :  printf0 ("keywordColor") |
+   locusColor   :  printf0 ("locusColor") |
+   insertColor  :  printf0 ("insertColor") |
+   deleteColor  :  printf0 ("deleteColor") |
+   typeColor    :  printf0 ("typeColor") |
+   range1Color  :  printf0 ("range1Color") |
+   range2Color  :  printf0 ("range2Color")
+
+   END
+END dumpColorType ;
+
+
+(*
+   dump -
+
+*)
+
+PROCEDURE dump (eb: errorBlock) ;
+VAR
+   ch: CHAR ;
+   l : CARDINAL ;
+   i : INTEGER ;
+BEGIN
+   l := Length (eb.out) ;
+   printf0 ("\n\nerrorBlock\n") ;
+   printf0 ("\ntype      = ") ; dumpErrorType (eb.type) ;
+   printf1 ("\nout       = |%s|", eb.out) ;
+   printf1 ("\nin        = |%s|", eb.in) ;
+   printf1 ("\nLength (out) = %d", l) ;
+   printf1 ("\nlen       = %d", eb.len) ;
+   printf1 ("\nhighplus1 = %d", eb.highplus1) ;
+   printf1 ("\nglyph     = %d", eb.glyph) ;
+   printf1 ("\nquotes    = %d", eb.quotes) ;
+   printf1 ("\npositive  = %d", eb.positive) ;
+   printf0 ("\nbeginCol  = ") ; dumpColorType (eb.beginCol) ;
+   printf0 ("\nendCol    = ") ; dumpColorType (eb.endCol) ;
+   printf0 ("\ncurrentCol = ") ; dumpColorType (eb.currentCol) ;
+   printf1 ("\nini        = %d", eb.ini) ;
+   IF eb.ini < eb.len
+   THEN
+      ch := char (eb.in, eb.ini) ;
+      printf1 ("\ncurrent char = %c", ch) ;
+      printf1 ("\n%s\n", eb.in) ;
+      i := 0 ;
+      WHILE i<eb.ini DO
+         printf0 (" ") ;
+         INC (i)
+      END ;
+      printf0 ("^\n")
+   END ;
+   printf0 ("\n")
+END dump ;
+
+
+(*
+   ebnf := { percent
+             | lbra
+             | any                    % copy ch %
+           }
+         =:
+*)
+
+PROCEDURE ebnf (VAR eb: errorBlock; sym: ARRAY OF CARDINAL) ;
+VAR
+   nb: errorBlock ;
+BEGIN
+   IF Debugging
+   THEN
+      printf0 ("top of ebnf\n") ;
+      dump (eb)
+   END ;
+   WHILE eb.ini < eb.len DO
+      IF Debugging
+      THEN
+         printf0 ("while loop ebnf\n") ;
+         dump (eb)
+      END ;
+      CASE char (eb.in, eb.ini) OF
+
+      '!':  eb.positive := NOT eb.positive |
+      '%':  percent (eb, sym) |
+      '{':  push (nb, eb) ;
+            lbra (nb, sym) ;
+            pop (eb, nb) ;
+            IF (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}')
+            THEN
+               InternalFormat (eb, 'expecting to see }', __LINE__)
+            END |
+      '}':  RETURN
+
+      ELSE
+         IF ((IsWhite (char (eb.in, eb.ini)) AND (Length (eb.out) > 0) AND
+              (NOT IsWhite (char (eb.out, -1)))) OR
+            (NOT IsWhite (char (eb.in, eb.ini)))) AND (eb.highplus1 > 0)
+         THEN
+            eb.quotes := FALSE ;  (* copying a normal character, don't quote the result.  *)
+            copyChar (eb)
+         END
+      END ;
+      INC (eb.ini)
+   END ;
+   eb.currentCol := noColor ;
+   flushColor (eb) ;
+   IF Debugging
+   THEN
+      printf0 ("finishing ebnf\n") ;
+      dump (eb)
+   END
+END ebnf ;
+
+
+PROCEDURE MetaErrorStringT0 (tok: CARDINAL; m: String) ;
+VAR
+   eb : errorBlock ;
+   sym: ARRAY [0..0] OF CARDINAL ;
+BEGIN
+   sym[0] := NulSym ;
+   initErrorBlock (eb, m, sym) ;
+   ebnf (eb, sym) ;
+   flushColor (eb) ;
+   defaultError (eb, tok) ;
+   ErrorString (eb.e, Dup (eb.out)) ;
+   killErrorBlock (eb) ;
+   checkAbort
+END MetaErrorStringT0 ;
+
+
+PROCEDURE MetaErrorT0 (tok: CARDINAL; m: ARRAY OF CHAR) ;
+BEGIN
+   MetaErrorStringT0 (tok, InitString(m))
+END MetaErrorT0 ;
+
+
+PROCEDURE MetaErrorStringT1 (tok: CARDINAL; m: String; s: CARDINAL) ;
+VAR
+   eb : errorBlock ;
+   sym: ARRAY [0..0] OF CARDINAL ;
+BEGIN
+   sym[0] := s ;
+   initErrorBlock (eb, m, sym) ;
+   ebnf (eb, sym) ;
+   flushColor (eb) ;
+   defaultError (eb, tok) ;
+   ErrorString (eb.e, Dup (eb.out)) ;
+   killErrorBlock (eb) ;
+   checkAbort
+END MetaErrorStringT1 ;
+
+
+PROCEDURE MetaErrorT1 (tok: CARDINAL; m: ARRAY OF CHAR; s: CARDINAL) ;
+BEGIN
+   MetaErrorStringT1 (tok, InitString (m), s)
+END MetaErrorT1 ;
+
+
+PROCEDURE MetaErrorStringT2 (tok: CARDINAL; m: String; s1, s2: CARDINAL) ;
+VAR
+   eb : errorBlock ;
+   sym: ARRAY [0..1] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   initErrorBlock (eb, m, sym) ;
+   ebnf (eb, sym) ;
+   flushColor (eb) ;
+   defaultError (eb, tok) ;
+   ErrorString (eb.e, Dup (eb.out)) ;
+   killErrorBlock (eb) ;
+   checkAbort
+END MetaErrorStringT2 ;
+
+
+PROCEDURE MetaErrorT2 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2: CARDINAL) ;
+BEGIN
+   MetaErrorStringT2 (tok, InitString (m), s1, s2)
+END MetaErrorT2 ;
+
+
+PROCEDURE MetaErrorStringT3 (tok: CARDINAL; m: String; s1, s2, s3: CARDINAL) ;
+VAR
+   eb : errorBlock ;
+   sym: ARRAY [0..2] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   sym[2] := s3 ;
+   initErrorBlock (eb, m, sym) ;
+   eb.highplus1 := HIGH (sym) + 1 ;
+   ebnf (eb, sym) ;
+   flushColor (eb) ;
+   defaultError (eb, tok) ;
+   ErrorString (eb.e, Dup (eb.out)) ;
+   killErrorBlock (eb) ;
+   checkAbort
+END MetaErrorStringT3 ;
+
+
+PROCEDURE MetaErrorT3 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+BEGIN
+   MetaErrorStringT3 (tok, InitString (m), s1, s2, s3) ;
+END MetaErrorT3 ;
+
+
+PROCEDURE MetaErrorStringT4 (tok: CARDINAL; m: String; s1, s2, s3, s4: CARDINAL) ;
+VAR
+   eb : errorBlock ;
+   sym: ARRAY [0..3] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   sym[2] := s3 ;
+   sym[3] := s4 ;
+   initErrorBlock (eb, m, sym) ;
+   ebnf (eb, sym) ;
+   flushColor (eb) ;
+   defaultError (eb, tok) ;
+   ErrorString (eb.e, Dup (eb.out)) ;
+   killErrorBlock (eb) ;
+   checkAbort
+END MetaErrorStringT4 ;
+
+
+PROCEDURE MetaErrorT4 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2, s3, s4: CARDINAL) ;
+BEGIN
+   MetaErrorStringT4 (tok, InitString (m), s1, s2, s3, s4) ;
+END MetaErrorT4 ;
+
+
+PROCEDURE MetaError0 (m: ARRAY OF CHAR) ;
+BEGIN
+   MetaErrorT0 (GetTokenNo (), m)
+END MetaError0 ;
+
+
+PROCEDURE MetaError1 (m: ARRAY OF CHAR; s: CARDINAL) ;
+BEGIN
+   MetaErrorT1 (GetTokenNo (), m, s)
+END MetaError1 ;
+
+
+PROCEDURE MetaError2 (m: ARRAY OF CHAR; s1, s2: CARDINAL) ;
+BEGIN
+   MetaErrorT2 (GetTokenNo (), m, s1, s2)
+END MetaError2 ;
+
+
+PROCEDURE MetaError3 (m: ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+BEGIN
+   MetaErrorT3 (GetTokenNo (), m, s1, s2, s3)
+END MetaError3 ;
+
+
+PROCEDURE MetaError4 (m: ARRAY OF CHAR; s1, s2, s3, s4: CARDINAL) ;
+BEGIN
+   MetaErrorT4 (GetTokenNo (), m, s1, s2, s3, s4)
+END MetaError4 ;
+
+
+(*
+   wrapErrors -
+*)
+
+PROCEDURE wrapErrors (tok: CARDINAL;
+                      m1, m2: ARRAY OF CHAR;
+                      sym: ARRAY OF CARDINAL) ;
+VAR
+   eb: errorBlock ;
+BEGIN
+   initErrorBlock (eb, InitString (m1), sym) ;
+   ebnf (eb, sym) ;
+   flushColor (eb) ;
+   defaultError (eb, tok) ;
+   lastRoot := eb.e ;
+   ErrorString (eb.e, Dup (eb.out)) ;
+   killErrorBlock (eb) ;
+   initErrorBlock (eb, InitString (m2), sym) ;
+   eb.type := chained ;
+   ebnf (eb, sym) ;
+   flushColor (eb) ;
+   defaultError (eb, tok) ;
+   ErrorString (eb.e, Dup (eb.out)) ;
+   killErrorBlock (eb)
+END wrapErrors ;
+
+
+PROCEDURE MetaErrorsT1 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s: CARDINAL) ;
+VAR
+   sym: ARRAY [0..0] OF CARDINAL ;
+BEGIN
+   sym[0] := s ;
+   wrapErrors (tok, m1, m2, sym)
+END MetaErrorsT1 ;
+
+
+PROCEDURE MetaErrorsT2 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2: CARDINAL) ;
+VAR
+   sym: ARRAY [0..1] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   wrapErrors (tok, m1, m2, sym)
+END MetaErrorsT2 ;
+
+
+PROCEDURE MetaErrorsT3 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+VAR
+   sym : ARRAY [0..2] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   sym[2] := s3 ;
+   wrapErrors (tok, m1, m2, sym)
+END MetaErrorsT3 ;
+
+
+PROCEDURE MetaErrorsT4 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: CARDINAL) ;
+VAR
+   sym : ARRAY [0..3] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   sym[2] := s3 ;
+   sym[3] := s4 ;
+   wrapErrors (tok, m1, m2, sym)
+END MetaErrorsT4 ;
+
+
+PROCEDURE MetaErrors1 (m1, m2: ARRAY OF CHAR; s: CARDINAL) ;
+BEGIN
+   MetaErrorsT1 (GetTokenNo (), m1, m2, s)
+END MetaErrors1 ;
+
+
+PROCEDURE MetaErrors2 (m1, m2: ARRAY OF CHAR; s1, s2: CARDINAL) ;
+BEGIN
+   MetaErrorsT2 (GetTokenNo (), m1, m2, s1, s2)
+END MetaErrors2 ;
+
+
+PROCEDURE MetaErrors3 (m1, m2: ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+BEGIN
+   MetaErrorsT3 (GetTokenNo (), m1, m2, s1, s2, s3)
+END MetaErrors3 ;
+
+
+PROCEDURE MetaErrors4 (m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: CARDINAL) ;
+BEGIN
+   MetaErrorsT4 (GetTokenNo (), m1, m2, s1, s2, s3, s4)
+END MetaErrors4 ;
+
+
+PROCEDURE MetaErrorString0 (m: String) ;
+BEGIN
+   MetaErrorStringT0 (GetTokenNo (), m)
+END MetaErrorString0 ;
+
+
+PROCEDURE MetaErrorString1 (m: String; s: CARDINAL) ;
+BEGIN
+   MetaErrorStringT1 (GetTokenNo (), m, s)
+END MetaErrorString1 ;
+
+
+PROCEDURE MetaErrorString2 (m: String; s1, s2: CARDINAL) ;
+BEGIN
+   MetaErrorStringT2 (GetTokenNo (), m, s1, s2)
+END MetaErrorString2 ;
+
+
+PROCEDURE MetaErrorString3 (m: String; s1, s2, s3: CARDINAL) ;
+BEGIN
+   MetaErrorStringT3 (GetTokenNo (), m, s1, s2, s3)
+END MetaErrorString3 ;
+
+
+PROCEDURE MetaErrorString4 (m: String; s1, s2, s3, s4: CARDINAL) ;
+BEGIN
+   MetaErrorStringT4 (GetTokenNo (), m, s1, s2, s3, s4)
+END MetaErrorString4 ;
+
+
+(*
+   checkAbort - checks to see if the boolean flag seenAbort has been set,
+                if so it flushes all existing errors and terminates.
+*)
+
+PROCEDURE checkAbort ;
+BEGIN
+   IF seenAbort
+   THEN
+      FlushWarnings ;
+      FlushErrors
+   END
+END checkAbort ;
+
+
+(*
+   translate -
+*)
+
+PROCEDURE translate (m, s: String; VAR i: INTEGER; name: Name) : String ;
+VAR
+   l : INTEGER ;
+   ch: CHAR ;
+BEGIN
+   l := Length (m) ;
+   WHILE (i >= 0) AND (i < l) DO
+      ch := char (m, i) ;
+      IF (ch = '%') AND (i < l)
+      THEN
+         INC (i) ;
+         ch := char (m, i) ;
+         INC (i) ;
+         IF ch = 'a'
+         THEN
+            s := ConCat (s, Mark (InitString ('%<'))) ;
+            s := ConCat (s, Mark (InitStringCharStar (KeyToCharStar (name)))) ;
+            s := ConCat (s, Mark (InitString ('%>'))) ;
+            RETURN s
+         END ;
+         s := ConCatChar (s, '%')
+      END ;
+      s := ConCatChar (s, ch) ;
+      INC (i)
+   END ;
+   RETURN s
+END translate ;
+
+
+(*
+   MetaErrorNT0 - generate an error message at tok using format.
+*)
+
+PROCEDURE MetaErrorNT0 (tok: CARDINAL; format: ARRAY OF CHAR) ;
+BEGIN
+   MetaErrorStringT0 (tok, InitString (format))
+END MetaErrorNT0 ;
+
+
+(*
+   MetaErrorNT1 - generate an error message at tok using format and name.
+                  The format should contain %a for name substitution.
+*)
+
+PROCEDURE MetaErrorNT1 (tok: CARDINAL; format: ARRAY OF CHAR; name: Name) ;
+VAR
+   i  : INTEGER ;
+   s,
+   fmt: String ;
+BEGIN
+   i := 0 ;
+   fmt := InitString (format) ;
+   s := InitString ('') ;
+   s := translate (fmt, s, i, name) ;
+   MetaErrorStringT0 (tok, s) ;
+   fmt := KillString (fmt) ;
+END MetaErrorNT1 ;
+
+
+(*
+   MetaErrorN1 -
+*)
+
+PROCEDURE MetaErrorN1 (m: ARRAY OF CHAR; n: Name) ;
+BEGIN
+   MetaErrorNT1 (GetTokenNo (), m, n)
+END MetaErrorN1 ;
+
+
+(*
+   MetaErrorNT1 - generate an error message at tok using format, name1
+                  and name2.  The format should contain two occurances of %a
+                  for name substitution.
+*)
+
+PROCEDURE MetaErrorNT2 (tok: CARDINAL; format: ARRAY OF CHAR; name1, name2: Name) ;
+VAR
+   i  : INTEGER ;
+   s,
+   fmt: String ;
+BEGIN
+   i := 0 ;
+   fmt := InitString (format) ;
+   s := InitString ('') ;
+   s := translate (fmt, s, i, name1) ;
+   s := translate (fmt, s, i, name2) ;
+   MetaErrorStringT0 (tok, s) ;
+   fmt := KillString (fmt) ;
+END MetaErrorNT2 ;
+
+
+(*
+   MetaErrorN2 -
+*)
+
+PROCEDURE MetaErrorN2 (m: ARRAY OF CHAR; n1, n2: Name) ;
+BEGIN
+   MetaErrorNT2 (GetTokenNo (), m, n1, n2)
+END MetaErrorN2 ;
+
+
+(*
+   wrapString - return a string which has been formatted with the specifier codes.
+                Color is disabled.  The result string is returned.
+*)
+
+PROCEDURE wrapString (m: String;
+                      sym: ARRAY OF CARDINAL) : String ;
+VAR
+   eb : errorBlock ;
+   s  : String ;
+   old: BOOLEAN ;
+BEGIN
+   old := M2ColorString.SetEnableColor (FALSE) ;
+   initErrorBlock (eb, Dup (m), sym) ;
+   eb.useError := FALSE ;
+   ebnf (eb, sym) ;
+   flushColor (eb) ;
+   s := Dup (eb.out) ;
+   killErrorBlock (eb) ;
+   old := M2ColorString.SetEnableColor (old) ;
+   RETURN s
+END wrapString ;
+
+
+PROCEDURE MetaString0 (m: String) : String ;
+VAR
+   sym: ARRAY [0..0] OF CARDINAL ;
+BEGIN
+   sym[0] := NulSym ;
+   RETURN wrapString (m, sym)
+END MetaString0 ;
+
+
+PROCEDURE MetaString1 (m: String; s: CARDINAL) : String ;
+VAR
+   sym: ARRAY [0..0] OF CARDINAL ;
+BEGIN
+   sym[0] := s ;
+   RETURN wrapString (m, sym)
+END MetaString1 ;
+
+
+PROCEDURE MetaString2 (m: String; s1, s2: CARDINAL) : String ;
+VAR
+   sym: ARRAY [0..1] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   RETURN wrapString (m, sym)
+END MetaString2 ;
+
+
+PROCEDURE MetaString3 (m: String; s1, s2, s3: CARDINAL) : String ;
+VAR
+   sym: ARRAY [0..2] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   sym[2] := s3 ;
+   RETURN wrapString (m, sym)
+END MetaString3 ;
+
+
+PROCEDURE MetaString4 (m: String; s1, s2, s3, s4: CARDINAL) : String ;
+VAR
+   sym: ARRAY [0..3] OF CARDINAL ;
+BEGIN
+   sym[0] := s1 ;
+   sym[1] := s2 ;
+   sym[2] := s3 ;
+   sym[3] := s4 ;
+   RETURN wrapString (m, sym)
+END MetaString4 ;
+
+
+BEGIN
+   lastRoot := NIL ;
+   lastColor := noColor ;
+   seenAbort := FALSE ;
+   outputStack := InitIndex (1) ;
+   dictionary := InitIndex (1) ;
+   freeEntry := NIL
+END M2MetaError.
diff --git a/gcc/m2/gm2-compiler/M2Optimize.def b/gcc/m2/gm2-compiler/M2Optimize.def
new file mode 100644
index 00000000000..a0aeb07a1ef
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Optimize.def
@@ -0,0 +1,59 @@
+(* M2Optimize.def removes redundant quadruples.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Optimize ;
+
+(*
+    Title      : M2Optimize.def
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Fri Aug 20 14:51:00 1999
+    Description: provides a very simple branch optimization module so that
+                 we dont give too many redundant gotos to gcc.
+*)
+
+
+EXPORT QUALIFIED FoldBranches, RemoveProcedures, DisplayReachable ;
+
+
+(*
+   FoldBranches - folds unneccessary branches in the list of quadruples.
+*)
+
+PROCEDURE FoldBranches (start, end: CARDINAL) ;
+
+
+(*
+   RemoveProcedures - removes any procedures that are never referenced
+                      by the quadruples.
+*)
+
+PROCEDURE RemoveProcedures (scope: CARDINAL) ;
+
+
+(*
+   DisplayReachable - displays the data structures surrounding Reachablity.
+*)
+
+PROCEDURE DisplayReachable ;
+
+
+END M2Optimize.
diff --git a/gcc/m2/gm2-compiler/M2Optimize.mod b/gcc/m2/gm2-compiler/M2Optimize.mod
new file mode 100644
index 00000000000..baf5177e05c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Optimize.mod
@@ -0,0 +1,521 @@
+(* M2Optimize.mod removes redundant quadruples.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Optimize ;
+
+(*
+    Title      : M2Optimize
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Sat Aug 14 15:07:47 1999
+    Description: removes redundant quadruples, redundant GotoOps, redundant procedures.
+*)
+
+FROM M2Debug IMPORT Assert ;
+
+FROM NameKey IMPORT Name, WriteKey, MakeKey, GetKey ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+
+FROM M2Error IMPORT InternalError ;
+FROM M2Batch IMPORT GetModuleNo ;
+FROM M2Quiet IMPORT qprintf1 ;
+FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock, ForeachScopeBlockDo ;
+
+FROM SymbolTable IMPORT GetSymName,
+                        GetProcedureQuads, GetModuleQuads,
+                        GetModule, GetNthProcedure,
+                        GetSubrange, GetModuleScope,
+                        PutProcedureReachable, IsProcedureReachable,
+                        PutProcedureStartQuad, PutProcedureEndQuad,
+                        PutProcedureScopeQuad,
+                        PutNeedSavePriority,
+                        IsProcedure, GetPriority,
+                        GetDeclaredMod, GetFirstUsed,
+                        GetType,
+                        IsExportQualified, IsExportUnQualified, IsExported,
+                        ForeachProcedureDo, ForeachInnerModuleDo,
+                        IsModuleWithinProcedure,
+                        NulSym ;
+
+FROM M2Quads IMPORT QuadOperator, GetQuad, GetFirstQuad, GetNextQuad,
+                    PutQuad, SubQuad, Opposite, IsReferenced,
+                    GetRealQuad ;
+
+
+(*
+   FoldBranches - folds unneccessary branches in the list of quadruples.
+                  It searches for the following patterns:
+
+                  [x]  GotoOp  _   _   y                GotoOp   _   _   z
+                  ...                                   ...
+                  [y]  GotoOp  _   _   z      "deleted"
+
+                  WHERE ... may contain 0..n Pseudo Quads
+
+
+                  OR
+
+
+                  [x]  IfREL   _   _   z      If NOT REL  _   _   a
+                  ...                         ...
+                  [y]  Goto    _   _   a      "deleted"
+                  ...                         ...
+                  [z]
+
+
+                  WHERE ... may contain 0..n Pseudo Quads
+                  but in this case they must not be a
+                      target of any other quad.
+*)
+
+PROCEDURE FoldBranches (start, end: CARDINAL) ;
+VAR
+   Folded     : BOOLEAN ;
+   i, j,
+   Right      : CARDINAL ;
+   Operator   : QuadOperator ;
+   Operand1,
+   Operand2,
+   Operand3   : CARDINAL ;
+BEGIN
+   REPEAT
+      i := start ;
+      Folded := FALSE ;
+      WHILE (i<=end) AND (i#0) DO
+         j := GetNextQuad(i) ;
+         IF (j>end) OR (j=0)
+         THEN
+            RETURN
+         END ;
+         Right := GetRealQuad(j) ;
+         IF Right=0
+         THEN
+            RETURN
+         END ;
+         GetQuad(i, Operator, Operand1, Operand2, Operand3) ;
+         CASE Operator OF
+
+         GotoOp             : Folded := ReduceGoto(i, Operand3,
+                                                   Right, Folded) |
+         IfInOp, IfNotInOp,
+         IfNotEquOp, IfEquOp,
+         IfLessEquOp, IfGreEquOp,
+         IfGreOp, IfLessOp  : Folded := ReduceBranch(Operator, i,
+                                                     Operand1, Operand2, Operand3,
+                                                     Right, Folded)
+
+         ELSE
+         END ;
+         i := Right
+      END
+   UNTIL NOT Folded
+END FoldBranches ;
+
+
+(*
+   ReduceBranch - searches for the following pattern:
+
+                  [x]  IfREL   _   _   z      If NOT REL  _   _   a
+                  ...                         ...
+                  [y]  Goto    _   _   a      "deleted"
+                  ...                         ...
+                  [z]
+
+
+                  WHERE ... may contain 0..n Pseudo Quads
+                  but in this case they must not be a
+                      target of any other quad.
+
+*)
+
+PROCEDURE ReduceBranch (Operator: QuadOperator;
+                        CurrentQuad,
+                        CurrentOperand1, CurrentOperand2,
+                        CurrentOperand3: CARDINAL;
+                        VAR NextQuad: CARDINAL;
+                        Folded: BOOLEAN) : BOOLEAN ;
+VAR
+   OpNext : QuadOperator ;
+   NextPlusOne,
+   Op1Next,
+   Op2Next,
+   Op3Next,
+   From,
+   To     : CARDINAL ;
+BEGIN
+   (* If op         NextQuad+1 *)
+   (* Goto          x          *)
+
+   IF NextQuad#0
+   THEN
+      IF (GetNextQuad(CurrentQuad)=CurrentOperand3) OR
+         (GetRealQuad(GetNextQuad(CurrentQuad))=CurrentOperand3)
+      THEN
+         SubQuad(CurrentQuad) ;
+         Folded := TRUE
+      ELSE
+         From := GetNextQuad(CurrentQuad) ;  (* start after CurrentQuad *)
+         To := NextQuad ;
+         CurrentOperand3 := GetRealQuad(CurrentOperand3) ;
+
+         NextPlusOne := GetRealQuad(GetNextQuad(NextQuad)) ;
+         GetQuad(NextQuad, OpNext, Op1Next, Op2Next, Op3Next) ;
+         IF (OpNext=GotoOp) AND (NextPlusOne=CurrentOperand3) AND
+            IsBasicBlock(From, To)
+         THEN
+            (*       Op3Next := GetRealQuad(Op3Next) ; *)
+            SubQuad(NextQuad) ;
+            PutQuad(CurrentQuad, Opposite(Operator),
+                    CurrentOperand1, CurrentOperand2, Op3Next) ;
+            NextQuad := NextPlusOne ;
+            Folded := TRUE
+         END
+      END ;
+      IF FoldMultipleGoto(CurrentQuad)
+      THEN
+         Folded := TRUE
+      END
+   END ;
+   RETURN( Folded )
+END ReduceBranch ;
+
+
+(*
+   IsBasicBlock - returns TRUE if no other quadruple jumps inbetween
+                  the range From..To.
+                  It assumes that there are no jumps in the quadruples
+                  From..To.
+*)
+
+PROCEDURE IsBasicBlock (From, To: CARDINAL) : BOOLEAN ;
+BEGIN
+   WHILE From # To DO
+      IF IsReferenced (From)
+      THEN
+         RETURN FALSE
+      ELSE
+         IF From > To
+         THEN
+            InternalError ('assert failed From should never be larger than To')
+         END ;
+         From := GetNextQuad (From)
+      END
+   END ;
+   RETURN TRUE
+END IsBasicBlock ;
+
+
+(*
+   ReduceGoto - searches for the following patterns:
+
+                [x]  GotoOp  _   _   y                GotoOp   _   _   z
+                  ...                                   ...
+                [y]  GotoOp  _   _   z      "deleted"
+
+
+*)
+
+PROCEDURE ReduceGoto (CurrentQuad, CurrentOperand3, NextQuad: CARDINAL;
+                      Folded: BOOLEAN) : BOOLEAN ;
+BEGIN
+   CurrentOperand3 := GetRealQuad(CurrentOperand3) ;
+   (* IF next quad is a GotoOp *)
+   IF CurrentOperand3=NextQuad
+   THEN
+      SubQuad(CurrentQuad) ;
+      Folded := TRUE
+   ELSE
+      (* Does Goto point to another Goto ? *)
+      IF FoldMultipleGoto(CurrentQuad)
+      THEN
+         Folded := TRUE
+      END
+   END ;
+   RETURN( Folded )
+END ReduceGoto ;
+
+
+(*
+   FoldMultipleGoto - takes a QuadNo and if it jumps to another GotoOp
+                      then it takes the later target as a replacement
+                      for its own.
+
+                      NOTE  it does not remove any quadruples.
+*)
+
+PROCEDURE FoldMultipleGoto (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   Operator,
+   Op      : QuadOperator ;
+   Op1, Op2,
+   Op3,
+   Operand1,
+   Operand2,
+   Operand3: CARDINAL ;
+BEGIN
+   GetQuad(QuadNo, Operator, Operand1, Operand2, Operand3) ;
+   Operand3 := GetRealQuad(Operand3) ;  (* skip pseudo quadruples *)
+   GetQuad(Operand3, Op, Op1, Op2, Op3) ;
+   IF Op=GotoOp
+   THEN
+      PutQuad(QuadNo, Operator, Operand1, Operand2, Op3) ;
+      (* Dont want success to be returned if in fact the Goto *)
+      (* line number has not changed... otherwise we loop     *)
+      (* forever.                                             *)
+      RETURN( Op3#Operand3 )
+   ELSE
+      RETURN( FALSE )
+   END
+END FoldMultipleGoto ;
+
+
+(*
+   CheckNeedSavePriority -
+*)
+
+PROCEDURE CheckNeedSavePriority (sym: CARDINAL) ;
+BEGIN
+   IF IsProcedure(sym) AND (GetPriority(GetModuleScope(sym))#NulSym)
+   THEN
+      PutNeedSavePriority(sym)
+   END
+END CheckNeedSavePriority ;
+
+
+(*
+   CheckExportedReachable - checks to see whether procedure, sym, was
+                            exported and if so it calls RemoveProcedures.
+*)
+
+PROCEDURE CheckExportedReachable (sym: CARDINAL) ;
+BEGIN
+   IF IsExported(GetModuleScope(sym), sym)
+   THEN
+      RemoveProcedures(sym) ;
+      CheckNeedSavePriority(sym)
+   END
+END CheckExportedReachable ;
+
+
+(*
+   RemoveProcedures - removes any procedures that are never referenced
+                      by the quadruples.
+*)
+
+PROCEDURE RemoveProcedures (scope: CARDINAL) ;
+VAR
+   sb: ScopeBlock ;
+BEGIN
+   sb := InitScopeBlock(scope) ;
+   IF IsProcedure(scope)
+   THEN
+      PutProcedureReachable(scope) ;
+      ForeachScopeBlockDo(sb, KnownReachable)
+   ELSIF IsModuleWithinProcedure(scope)
+   THEN
+      ForeachScopeBlockDo(sb, KnownReachable) ;
+      ForeachProcedureDo(scope, CheckExportedReachable)
+   ELSE
+      ForeachScopeBlockDo(sb, KnownReachable) ;
+      ForeachProcedureDo(scope, CheckExportedReachable)
+   END ;
+   ForeachInnerModuleDo(scope, RemoveProcedures) ;
+   KillScopeBlock(sb) ;
+   (* DeleteUnReachableProcedures *)
+END RemoveProcedures ;
+
+
+PROCEDURE KnownReachable (Start, End: CARDINAL) ;
+VAR
+   Op           : QuadOperator ;
+   Op1, Op2, Op3: CARDINAL ;
+BEGIN
+   IF Start#0
+   THEN
+      REPEAT
+         GetQuad(Start, Op, Op1, Op2, Op3) ;
+         CASE Op OF
+
+         CallOp   : KnownReach(Op3) |
+         AddrOp,
+         ParamOp,
+         XIndrOp,
+         BecomesOp: KnownReach(Op3) ;
+                    CheckNeedSavePriority(Op3)
+
+         ELSE
+         END ;
+         Start := GetNextQuad(Start)
+      UNTIL (Start>End) OR (Start=0)
+   END
+END KnownReachable ;
+
+
+PROCEDURE KnownReach (sym: CARDINAL) ;
+BEGIN
+   IF IsProcedure(sym) AND (NOT IsProcedureReachable(sym))
+   THEN
+      RemoveProcedures(sym)
+   END
+END KnownReach ;
+
+
+(*
+   DeleteUnReachableProcedures - Deletes all procedures that are unreachable.
+*)
+
+(*
+PROCEDURE DeleteUnReachableProcedures ;
+VAR
+   ProcName: Name ;
+   n, m,
+   Scope,
+   Start,
+   End,
+   Module,
+   Proc    : CARDINAL ;
+BEGIN
+   m := 1 ;
+   REPEAT
+      Module := GetModuleNo(m) ;
+      IF Module#NulSym
+      THEN
+         n := 1 ;
+         Proc := GetNthProcedure(Module, n) ;
+         WHILE Proc#NulSym DO
+            IF IsProcedureReachable(Proc) OR
+               IsExportQualified(Proc) OR IsExportUnQualified(Proc)
+            THEN
+               (* is reachable - do not delete it *)
+            ELSE
+               ProcName := GetSymName(Proc) ;
+               qprintf1('[%a]\n', ProcName) ;
+
+               GetProcedureQuads(Proc, Scope, Start, End) ;
+               IF Start#0
+               THEN
+                  Delete(Scope, End) ;
+                  (* No Longer any Quads for this Procedure *)
+                  PutProcedureScopeQuad(Proc, 0) ;
+                  PutProcedureStartQuad(Proc, 0) ;
+                  PutProcedureEndQuad(Proc, 0)
+               END
+            END ;
+            INC(n) ;
+            Proc := GetNthProcedure(Module, n)
+         END ;
+         INC(m)
+      END
+   UNTIL Module=NulSym
+END DeleteUnReachableProcedures ;
+
+
+(*
+   Delete - deletes all quadruples from Start..End
+            or the end of the procedure.
+*)
+
+PROCEDURE Delete (Start, End: CARDINAL) ;
+VAR
+   Last,
+   i   : CARDINAL ;
+   Op  : QuadOperator ;
+   Op1,
+   Op2,
+   Op3 : CARDINAL ;
+BEGIN
+   Last := GetNextQuad(End) ;
+   WHILE (GetFirstQuad()#0) AND (Start#0) AND (Last#Start) DO
+      GetQuad(Start, Op, Op1, Op2, Op3) ;
+      IF Op=DummyOp
+      THEN
+         (* Start has already been deleted - try next quad *)
+         INC(Start)
+      ELSIF Op=ReturnOp
+      THEN
+         (* Found end of procedure therefore just delete and exit *)
+         (* WriteString('Deleting') ; WriteCard(Start, 6) ; WriteLn ; *)
+         SubQuad(Start) ;
+         Start := Last
+      ELSE
+         (* Following the list of quadruples to the End *)
+         i := GetNextQuad(Start) ;
+         (* WriteString('Deleting') ; WriteCard(Start, 6) ; WriteLn ; *)
+         SubQuad(Start) ;
+         Start := i
+      END
+   END
+END Delete ;
+*)
+
+
+(*
+   DisplayReachable - Displays the data structures surrounding Reachablity.
+*)
+
+PROCEDURE DisplayReachable ;
+VAR
+   n, m,
+   Scope,
+   StartInit,
+   EndInit,
+   StartFinish,
+   EndFinish,
+   Module,
+   Proc       : CARDINAL ;
+BEGIN
+   m := 1 ;
+   REPEAT
+      Module := GetModuleNo(m) ;
+      IF Module#NulSym
+      THEN
+         WriteString('Module') ; WriteCard(m, 3) ; WriteKey(GetSymName(Module)) ;
+         GetModuleQuads(Module, StartInit, EndInit, StartFinish, EndFinish) ;
+         WriteString(' Reachable initialization') ;
+         WriteCard(StartInit, 6) ; WriteCard(EndInit, 6) ; WriteLn ;
+         WriteString('Module') ; WriteCard(m, 3) ; WriteKey(GetSymName(Module)) ;
+         GetModuleQuads(Module, StartInit, EndInit, StartFinish, EndFinish) ;
+         WriteString(' Reachable finalization') ;
+         WriteCard(StartFinish, 6) ; WriteCard(EndFinish, 6) ; WriteLn ;
+         n := 1 ;
+         Proc := GetNthProcedure(Module, n) ;
+         WHILE Proc#NulSym DO
+            WriteString('Procedure ') ; WriteKey(GetSymName(Proc)) ;
+            GetProcedureQuads(Proc, Scope, StartInit, EndInit) ;
+            WriteString(' Quads: ') ; WriteCard(StartInit, 6) ; WriteCard(EndInit, 6) ;
+            IF NOT IsProcedureReachable(Proc)
+            THEN
+               WriteString(' UN reachable')
+            ELSE
+               WriteString(' IS reachable')
+            END ;
+            WriteLn ;
+            INC(n) ;
+            Proc := GetNthProcedure(Module, n)
+         END ;
+         INC(m)
+      END
+   UNTIL Module=NulSym
+END DisplayReachable ;
+
+
+END M2Optimize.
diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def
new file mode 100644
index 00000000000..7e0ea4cdefa
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Options.def
@@ -0,0 +1,818 @@
+(* M2Options.def initializes the user options.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Options ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Options
+   Date       : 27/5/87  [$Date: 2013/08/14 20:39:40 $]
+   SYSTEM     : UNIX (GNU Modula-2)
+   Description: Initializes the user options in the Modula-2 compiler.
+   Version    : $Revision: 1.31 $
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String ;
+FROM m2linemap IMPORT location_t ;
+
+EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck,
+                 SetCheckAll, SetVerboseUnbounded, SetQuiet, SetCpp, GetCpp,
+                 (* SetMakeall, SetMakeall0, SetIncludePath, *) SetAutoInit,
+                 SetUnboundedByReference,
+                 SetSearchPath, SetISO, SetPIM, SetPIM2, SetPIM3, SetPIM4,
+                 SetPositiveModFloor, SetCompilerDebugging, SetExceptions,
+                 SetStyle, SetPedantic, SetPedanticParamNames, SetPedanticCast,
+                 SetExtendedOpaque, SetXCode, SetQuadDebugging, SetSources,
+                 SetDumpSystemExports,
+                 SetSwig, SetOptimizing, SetForcedLocation,
+                 SetCC1Quiet, SetWholeProgram, SetDebugTraceQuad, SetDebugTraceAPI,
+                 SetVerbose, SetM2g, GetM2g,
+		 GetISO, GetPIM, GetPIM2, GetPIM3, GetPIM4,
+		 GetPositiveModFloor,
+		 SetFloatValueCheck, GetFloatValueCheck,
+		 SetWholeValueCheck, GetWholeValueCheck,
+                 SetLowerCaseKeywords,
+                 SetIndex, SetRange, SetWholeDiv, SetStrictTypeChecking,
+                 Setc, Getc, SetUselist, GetUselist, GetUselistFilename,
+                 SetShared, SetB,
+
+                 Iso, Pim, Pim2, Pim3, Pim4,
+                 cflag,
+                 PositiveModFloorDiv,
+                 Pedantic, Verbose, Statistics,
+                 UnboundedByReference, VerboseUnbounded,
+                 Profiling, Coding, Optimizing,
+                 OptimizeBasicBlock, OptimizeUncalledProcedures,
+                 OptimizeCommonSubExpressions,
+                 StyleChecking, WholeProgram,
+                 NilChecking,
+                 WholeDivChecking, WholeValueChecking,
+                 IndexChecking, RangeChecking,
+                 ReturnChecking, CaseElseChecking,
+                 AutoInit,
+                 VariantValueChecking,
+                 UnusedVariableChecking, UnusedParameterChecking,
+                 SetUnusedVariableChecking, SetUnusedParameterChecking,
+                 Quiet, LineDirectives, StrictTypeChecking,
+                 CPreProcessor, Xcode, ExtendedOpaque,
+                 LowerCaseKeywords,
+                 PedanticParamNames, PedanticCast,
+      	       	 DisplayQuadruples, DebugTraceQuad, DebugTraceAPI,
+                 CompilerDebugging, GenerateDebugging, GenerateLineDebug,
+                 DumpSystemExports, GenerateSwig, Exceptions,
+                 OverrideLocation, FinaliseOptions,
+                 DebugBuiltins, setdefextension, setmodextension,
+                 SetStatistics, SetWall,
+                 SetSaveTemps, SetSaveTempsDir, SaveTemps, GetSaveTempsDir,
+                 GenModuleList,
+                 CppArg, CppCommandLine, CppRemember,
+		 SetDebugFunctionLineNumbers, DebugFunctionLineNumbers,
+		 SetGenerateStatementNote, GenerateStatementNote,
+                 ScaffoldDynamic, ScaffoldStatic,
+                 SetScaffoldDynamic, SetScaffoldStatic,
+                 SetScaffoldMain, ScaffoldMain,
+                 SetRuntimeModuleOverride, GetRuntimeModuleOverride,
+                 SetGenModuleList, GetGenModuleFilename, SharedFlag,
+                 GetB ;
+
+
+VAR
+   cflag,                        (* -c flag present?                         *)
+   Iso,                          (* -fiso use ISO SYSTEM.def                 *)
+   Pim,                          (* -fpim use PIM [234] SYSTEM.def           *)
+   Pim2,                         (* -fpim2 use strict rules.                 *)
+   Pim3,                         (* -fpim3 use strict rules.                 *)
+   Pim4,                         (* -fpim4 use strict rules.                 *)
+   PositiveModFloorDiv,          (* Force PIM4 behaviour for DIV and MOD     *)
+   CompilerDebugging,            (* -fd internal debugging messages          *)
+   DebugTraceQuad,               (* -fdebug-trace-quad                       *)
+   DebugTraceAPI,                (* -fdebug-trace-api                        *)
+   GenerateDebugging,            (* -g option to generate info for gdb/dbx   *)
+   GenerateLineDebug,            (* -gline to generate line debugging.       *)
+   Verbose,                      (* -verbose produce verbose error messages. *)
+   Pedantic,                     (* -pedantic be pedantic on error checking. *)
+   PedanticParamNames,           (* -Wpedantic-param-names                   *)
+   PedanticCast,                 (* -Wpedantic-cast warns if sizes differ.   *)
+   Statistics,                   (* -fstatistics information about code      *)
+   StyleChecking,                (* -Wstudents checks for common student errs*)
+   DisplayQuadruples,            (* -Wq option will display quadruples.      *)
+   UnboundedByReference,         (* -funbounded-by-reference                 *)
+   VerboseUnbounded,             (* -Wverbose-unbounded                      *)
+   OptimizeUncalledProcedures,   (* -Ouncalled removes uncalled procedures   *)
+   OptimizeBasicBlock,           (* -Obb create basic blocks and optimize.   *)
+   OptimizeCommonSubExpressions, (* -Ocse optimize common subexpressions     *)
+   WholeProgram,                 (* -fwhole-program optimization.            *)
+   NilChecking,                  (* -fnil makes compiler test for pointer    *)
+                                 (* NIL.                                     *)
+   WholeDivChecking,             (* -fwholediv produces code to raise an     *)
+                                 (* exception if a whole number divide by    *)
+                                 (* zero occurs.                             *)
+   WholeValueChecking,           (* -fwholevalue produces code to raise an   *)
+                                 (* exception if a whole value variable is   *)
+                                 (* about to exceed the type limits.         *)
+   FloatValueChecking,           (* -ffloatvalue produces code to raise an   *)
+                                 (* exception if a floating point variable   *)
+                                 (* is about to exceed the type limits.      *)
+   IndexChecking,                (* -findex array bounds checking.           *)
+   RangeChecking,                (* -frange assignment, set values,          *)
+                                 (* constructor values in range.             *)
+   ReturnChecking,               (* -freturn checks that functions always    *)
+                                 (* exit with a RETURN statement.            *)
+   CaseElseChecking,             (* -fcase checks program does not need an   *)
+                                 (* else statement within an case statement  *)
+                                 (* when the user omits one                  *)
+   VariantValueChecking,         (* Should we check all values are present   *)
+                                 (* in a variant record?  True for ISO and   *)
+                                 (* false for PIM.                           *)
+   Quiet,                        (* -fquiet option specified.                *)
+   LineDirectives,               (* Should compiler understand preprocessor  *)
+                                 (* # linenumber "filename" markers?         *)
+   StrictTypeChecking,           (* -fm2-strict-type experimental checker.   *)
+   CPreProcessor,                (* Must we run the cpp on the source?       *)
+   Xcode,                        (* Should errors follow Xcode format?       *)
+   ExtendedOpaque,               (* Do we allow non pointer opaque types?    *)
+   DumpSystemExports,            (* Print all inbuilt system items?          *)
+   GenerateSwig,                 (* Should we generate a swig interface file?*)
+   Exceptions,                   (* Should we generate exception code?       *)
+   UnusedVariableChecking,       (* Should we warn about unused variables?   *)
+   UnusedParameterChecking,      (* Should we warn about unused parameters?  *)
+   LowerCaseKeywords,            (* Should keywords in errors be in lower?   *)
+   DebugBuiltins,                (* Should we always call a real function?   *)
+   AutoInit,                     (* -fauto-init assigns pointers to NIL.     *)
+   SaveTemps,                    (* -save-temps save all temporary files.    *)
+   ScaffoldDynamic,              (* Should we generate a dynamic scaffold?   *)
+   ScaffoldStatic,               (* Should we generate a static scaffold?    *)
+   ScaffoldMain,                 (* Should we generate a main function?      *)
+   GenModuleList,                (* Should the compiler generate a list of   *)
+                                 (* all modules used?                        *)
+   SharedFlag,                   (* -fshared indicating this module needs    *)
+                                 (* the shared library version of the        *)
+                                 (* scaffold.                                *)
+   ForcedLocation,
+   DebugFunctionLineNumbers,
+   GenerateStatementNote,
+   Optimizing,
+   Coding,
+   Profiling               : BOOLEAN ;
+
+
+(*
+   Setc - set the cflag (compile only flag -c) to value.
+*)
+
+PROCEDURE Setc (value: BOOLEAN) ;
+
+
+(*
+   Getc - get the cflag (compile only flag -c).
+*)
+
+PROCEDURE Getc () : BOOLEAN ;
+
+
+(*
+   SetB - assigns Barg to arg.
+*)
+
+PROCEDURE SetB (arg: ADDRESS) ;
+
+
+(*
+   GetB - returns argument to the -B option as a string or NIL if it were never set.
+*)
+
+PROCEDURE GetB () : ADDRESS ;
+
+
+(*
+   SetScaffoldDynamic - set the -fscaffold-dynamic flag.
+*)
+
+PROCEDURE SetScaffoldDynamic (value: BOOLEAN) ;
+
+
+(*
+   SetScaffoldStatic - set the -fscaffold-static flag.
+*)
+
+PROCEDURE SetScaffoldStatic (value: BOOLEAN) ;
+
+
+(*
+   GetScaffoldDynamic - get the -fscaffold-dynamic flag.
+*)
+
+PROCEDURE GetScaffoldDynamic () : BOOLEAN ;
+
+
+(*
+   GetScaffoldStatic - get the -fscaffold-static flag.
+*)
+
+PROCEDURE GetScaffoldStatic () : BOOLEAN ;
+
+
+(*
+   SetScaffoldMain - set the -fscaffold-main flag.
+*)
+
+PROCEDURE SetScaffoldMain (value: BOOLEAN) ;
+
+
+(*
+   SetRuntimeModuleOverride - set the override sequence used for module
+                              initialization and finialization.
+*)
+
+PROCEDURE SetRuntimeModuleOverride (override: ADDRESS) ;
+
+
+(*
+   GetRuntimeModuleOverride - return a string containing any user override
+                              or the default module initialization override
+                              sequence.
+*)
+
+PROCEDURE GetRuntimeModuleOverride () : ADDRESS ;
+
+
+(*
+   SetUselist - set the uselist flag to value and remember the filename.
+*)
+
+PROCEDURE SetUselist (value: BOOLEAN; filename: ADDRESS) ;
+
+
+(*
+   GetUselist - return the uselist flag.
+*)
+
+PROCEDURE GetUselist () : BOOLEAN ;
+
+
+(*
+   GetUselistFilename - return the uselist filename as a String.
+*)
+
+PROCEDURE GetUselistFilename () : String ;
+
+
+(*
+   SetWholeProgram - sets the WholeProgram flag (-fwhole-program).
+*)
+
+PROCEDURE SetWholeProgram (value: BOOLEAN) ;
+
+
+(*
+   SetAutoInit - set the auto initialization flag to value.  If the value
+                 is true then all pointers are automatically
+                 initialized to NIL.
+*)
+
+PROCEDURE SetAutoInit (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetReturnCheck - set return statement checking in procedure functions
+                    to value.
+*)
+
+PROCEDURE SetReturnCheck (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetNilCheck - set access through NIL violation runtime checking to value.
+*)
+
+PROCEDURE SetNilCheck (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetCaseCheck - set else case checking to, value.
+*)
+
+PROCEDURE SetCaseCheck (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetCheckAll - set all runtime checking to, value.
+*)
+
+PROCEDURE SetCheckAll (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetVerboseUnbounded - sets the VerboseUnbounded flag to, value.
+*)
+
+PROCEDURE SetVerboseUnbounded (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetQuiet - sets the quiet flag to, value.
+*)
+
+PROCEDURE SetQuiet (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetCC1Quiet - sets the cc1quiet flag to, value.
+*)
+
+PROCEDURE SetCC1Quiet (value: BOOLEAN) ;
+
+
+(*
+   SetCpp -
+*)
+
+PROCEDURE SetCpp (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   GetCpp - returns TRUE if the C preprocessor was used.
+*)
+
+PROCEDURE GetCpp () : BOOLEAN ;
+
+
+(*
+   SetM2g - set the -fm2-g flag.
+*)
+
+PROCEDURE SetM2g (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   GetM2g - returns TRUE if the -fm2-g flags was used.
+*)
+
+PROCEDURE GetM2g () : BOOLEAN ;
+
+
+(*
+   SetLowerCaseKeywords - set the lower case keyword flag and return the result.
+*)
+
+PROCEDURE SetLowerCaseKeywords (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetMakeall -
+
+PROCEDURE SetMakeall (value: BOOLEAN) : BOOLEAN ;
+*)
+
+
+(*
+   SetMakeall0 -
+
+PROCEDURE SetMakeall0 (value: BOOLEAN) : BOOLEAN ;
+*)
+
+
+(*
+   SetIncludePath -
+
+PROCEDURE SetIncludePath (arg: ADDRESS) : BOOLEAN ;
+*)
+
+
+(*
+   SetUnboundedByReference -
+*)
+
+PROCEDURE SetUnboundedByReference (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetSearchPath -
+*)
+
+PROCEDURE SetSearchPath (arg: ADDRESS) ;
+
+
+(*
+   SetISO -
+*)
+
+PROCEDURE SetISO (value: BOOLEAN) ;
+
+
+(*
+   SetPIM -
+*)
+
+PROCEDURE SetPIM (value: BOOLEAN) ;
+
+
+(*
+   SetPIM2 -
+*)
+
+PROCEDURE SetPIM2 (value: BOOLEAN) ;
+
+
+(*
+   SetPIM3 -
+*)
+
+PROCEDURE SetPIM3 (value: BOOLEAN) ;
+
+
+(*
+   SetPIM4 -
+*)
+
+PROCEDURE SetPIM4 (value: BOOLEAN) ;
+
+
+(*
+   SetPositiveModFloor -
+*)
+
+PROCEDURE SetPositiveModFloor (value: BOOLEAN) ;
+
+
+(*
+   SetWholeDiv - sets the whole division flag.
+*)
+
+PROCEDURE SetWholeDiv (value: BOOLEAN) ;
+
+
+(*
+   SetIndex - sets the runtime array index checking flag.
+*)
+
+PROCEDURE SetIndex (value: BOOLEAN) ;
+
+
+(*
+   SetRange -  sets the runtime range checking flag.
+*)
+
+PROCEDURE SetRange (value: BOOLEAN) ;
+
+
+(*
+   SetExceptions -
+*)
+
+PROCEDURE SetExceptions (value: BOOLEAN) ;
+
+
+(*
+   SetStyle -
+*)
+
+PROCEDURE SetStyle (value: BOOLEAN) ;
+
+
+(*
+   SetPedantic -
+*)
+
+PROCEDURE SetPedantic (value: BOOLEAN) ;
+
+
+(*
+   SetPedanticParamNames -
+*)
+
+PROCEDURE SetPedanticParamNames (value: BOOLEAN) ;
+
+
+(*
+   SetPedanticCast -
+*)
+
+PROCEDURE SetPedanticCast (value: BOOLEAN) ;
+
+
+(*
+   SetExtendedOpaque -
+*)
+
+PROCEDURE SetExtendedOpaque (value: BOOLEAN) ;
+
+
+(*
+   SetXCode -
+*)
+
+PROCEDURE SetXCode (value: BOOLEAN) ;
+
+
+(*
+   SetCompilerDebugging - turn on internal compiler debugging.
+*)
+
+PROCEDURE SetCompilerDebugging (value: BOOLEAN) ;
+
+
+(*
+   SetQuadDebugging - display the quadruples (internal debugging).
+*)
+
+PROCEDURE SetQuadDebugging (value: BOOLEAN) ;
+
+
+(*
+   SetDebugTraceQuad -
+*)
+
+PROCEDURE SetDebugTraceQuad (value: BOOLEAN) ;
+
+
+(*
+   SetDebugTraceAPI -
+*)
+
+PROCEDURE SetDebugTraceAPI (value: BOOLEAN) ;
+
+
+(*
+   SetDebugFunctionLineNumbers - turn DebugFunctionLineNumbers on/off
+                                 (used internally for debugging).
+*)
+
+PROCEDURE SetDebugFunctionLineNumbers (value: BOOLEAN) ;
+
+
+(*
+   SetGenerateStatementNote - turn on generation of nops if necessary
+                              to generate pedalogical single stepping.
+*)
+
+PROCEDURE SetGenerateStatementNote (value: BOOLEAN) ;
+
+
+(*
+   SetSources -
+*)
+
+PROCEDURE SetSources (value: BOOLEAN) ;
+
+
+(*
+   SetDumpSystemExports -
+*)
+
+PROCEDURE SetDumpSystemExports (value: BOOLEAN) ;
+
+
+(*
+   SetSwig -
+*)
+
+PROCEDURE SetSwig (value: BOOLEAN) ;
+
+
+(*
+   SetOptimizing -
+*)
+
+PROCEDURE SetOptimizing (value: CARDINAL) ;
+
+
+(*
+   OverrideLocation - possibly override the location value, depending upon
+                      whether the -flocation= option was used.
+*)
+
+PROCEDURE OverrideLocation (location: location_t) : location_t ;
+
+
+(*
+   SetForcedLocation - sets the location for the lifetime of this compile to, location.
+                       This is primarily an internal debugging switch.
+*)
+
+PROCEDURE SetForcedLocation (location: location_t) ;
+
+
+(*
+   SetUnusedVariableChecking - assigns the UnusedVariableChecking to value.
+*)
+
+PROCEDURE SetUnusedVariableChecking (value: BOOLEAN) ;
+
+
+(*
+   SetUnusedParameterChecking - assigns the UnusedParameterChecking to value.
+*)
+
+PROCEDURE SetUnusedParameterChecking (value: BOOLEAN) ;
+
+
+(*
+   SetStrictTypeChecking - assigns the StrictTypeChecking flag to value.
+*)
+
+PROCEDURE SetStrictTypeChecking (value: BOOLEAN) ;
+
+
+(*
+   setdefextension -
+*)
+
+PROCEDURE setdefextension (arg: ADDRESS) ;
+
+
+(*
+   setmodextension -
+*)
+
+PROCEDURE setmodextension (arg: ADDRESS) ;
+
+
+(*
+   SetStatistics - turn on/off generate of compile time statistics.
+*)
+
+PROCEDURE SetStatistics (on: BOOLEAN) ;
+
+
+(*
+   SetVerbose - set the Verbose flag to, value.  It returns TRUE.
+*)
+
+PROCEDURE SetVerbose (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   CppArg - sets the option and arg in the cpp command line.
+*)
+
+PROCEDURE CppArg (opt, arg: ADDRESS; joined: BOOLEAN) ;
+
+
+(*
+   CppCommandLine - returns the Cpp command line and all arguments.
+*)
+
+PROCEDURE CppCommandLine () : String ;
+
+
+(*
+   CppRemember - remember a string, s, as a cpp related argument.
+                 The string, s, is not garbage collected.
+*)
+
+PROCEDURE CppRemember (s: String) ;
+
+
+(*
+   GetISO - return TRUE if -fiso was present on the command line.
+*)
+
+PROCEDURE GetISO () : BOOLEAN ;
+
+
+(*
+   GetPIM - return TRUE if -fpim was present on the command line.
+*)
+
+PROCEDURE GetPIM () : BOOLEAN ;
+
+
+(*
+   GetPIM2 - return TRUE if -fpim2 was present on the command line.
+*)
+
+PROCEDURE GetPIM2 () : BOOLEAN ;
+
+
+(*
+   GetPIM3 - return TRUE if -fpim3 was present on the command line.
+*)
+
+PROCEDURE GetPIM3 () : BOOLEAN ;
+
+
+(*
+   GetPIM4 - return TRUE if -fpim4 was present on the command line.
+*)
+
+PROCEDURE GetPIM4 () : BOOLEAN ;
+
+
+(*
+   GetPositiveModFloor - return TRUE if -fpositive-mod-floor was present
+                         on the command line.
+*)
+
+PROCEDURE GetPositiveModFloor () : BOOLEAN ;
+
+
+(*
+   GetFloatValueCheck - return TRUE if -ffloatvalue was present on the
+                        command line.
+*)
+
+PROCEDURE GetFloatValueCheck () : BOOLEAN ;
+
+
+(*
+   SetFloatValueCheck - set depending upon the -ffloatvalue.
+*)
+
+PROCEDURE SetFloatValueCheck (value: BOOLEAN) ;
+
+
+(*
+   GetWholeValueCheck - return TRUE if -fwholevalue was present on the
+                        command line.
+*)
+
+PROCEDURE GetWholeValueCheck () : BOOLEAN ;
+
+
+(*
+   SetWholeValueCheck - set depending upon the -fwholevalue.
+*)
+
+PROCEDURE SetWholeValueCheck (value: BOOLEAN) ;
+
+
+(*
+   SetWall - set all warnings to, value.
+*)
+
+PROCEDURE SetWall (value: BOOLEAN) ;
+
+
+(*
+   SetSaveTemps - turn on/off -save-temps.
+*)
+
+PROCEDURE SetSaveTemps (value: BOOLEAN) ;
+
+
+(*
+   SetSaveTempsDir - turn on/off -save-temps specifying the
+                     directory.
+*)
+
+PROCEDURE SetSaveTempsDir (arg: ADDRESS) ;
+
+
+(*
+   GetSaveTempsDir - return SaveTempsDir or NIL if -save-temps was not used.
+*)
+
+PROCEDURE GetSaveTempsDir () : String ;
+
+
+(*
+   SetGenModuleList - set the GenModuleList flag to value and pass
+                      set GenModuleListFilename to filename.
+*)
+
+PROCEDURE SetGenModuleList (value: BOOLEAN; filename: ADDRESS) ;
+
+
+(*
+   GetGenModuleFilename - returns the filename set by SetGenModuleList.
+*)
+
+PROCEDURE GetGenModuleFilename () : String ;
+
+
+(*
+   SetShared - sets the SharedFlag to value.
+*)
+
+PROCEDURE SetShared (value: BOOLEAN) ;
+
+
+(*
+   FinaliseOptions - once all options have been parsed we set any inferred
+                     values.
+*)
+
+PROCEDURE FinaliseOptions ;
+
+
+END M2Options.
diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod
new file mode 100644
index 00000000000..5e2eb570f24
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -0,0 +1,1249 @@
+(* M2Options.mod initializes the user options.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Options ;
+
+
+IMPORT CmdArgs ;
+FROM SArgs IMPORT GetArg, Narg ;
+FROM M2Search IMPORT PrependSearchPath, SetDefExtension, SetModExtension ;
+FROM M2Printf IMPORT printf0, printf1 ;
+FROM libc IMPORT exit ;
+FROM Debug IMPORT Halt ;
+FROM m2linemap IMPORT location_t ;
+FROM m2configure IMPORT FullPathCPP ;
+
+FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
+                           InitStringCharStar, ConCatChar, ConCat, KillString,
+                           Dup, string,
+                           PushAllocation, PopAllocationExemption,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+(*
+#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__)
+*)
+
+CONST
+   Debugging = FALSE ;
+
+VAR
+   Barg,
+   SaveTempsDir,
+   GenModuleListFilename,
+   UselistFilename,
+   RuntimeModuleOverride,
+   CppArgs              : String ;
+   UselistFlag,
+   CC1Quiet,
+   SeenSources          : BOOLEAN ;
+   ForcedLocationValue  : location_t ;
+
+
+(* String garbage collection debugging routines.
+
+(*
+   doDSdbEnter -
+*)
+
+PROCEDURE doDSdbEnter ;
+BEGIN
+   PushAllocation
+END doDSdbEnter ;
+
+
+(*
+   doDSdbExit -
+*)
+
+PROCEDURE doDSdbExit (s: String) ;
+BEGIN
+   s := PopAllocationExemption (TRUE, s)
+END doDSdbExit ;
+
+
+(*
+   DSdbEnter -
+*)
+
+PROCEDURE DSdbEnter ;
+BEGIN
+END DSdbEnter ;
+
+
+(*
+   DSdbExit -
+*)
+
+PROCEDURE DSdbExit (s: String) ;
+BEGIN
+END DSdbExit ;
+*)
+
+(*
+#define DSdbEnter doDSdbEnter
+#define DSdbExit  doDSdbExit
+*)
+
+
+(*
+   SetB - assigns Barg to arg.
+*)
+
+PROCEDURE SetB (arg: ADDRESS) ;
+BEGIN
+   Barg := KillString (Barg) ;
+   Barg := InitStringCharStar (arg)
+END SetB ;
+
+
+(*
+   GetB - returns Barg value as a C string or NIL if it was never set.
+*)
+
+PROCEDURE GetB () : ADDRESS ;
+BEGIN
+   RETURN string (Barg)
+END GetB ;
+
+
+(*
+   CppCommandLine - returns the Cpp command line and all arguments.
+                    NIL is returned if the -fcpp is absent.
+*)
+
+PROCEDURE CppCommandLine () : String ;
+VAR
+   s: String ;
+BEGIN
+   IF CPreProcessor
+   THEN
+      s := InitStringCharStar (FullPathCPP ()) ;
+      s := ConCat (ConCatChar (s, ' '), CppArgs) ;
+      IF CC1Quiet
+      THEN
+         s := ConCat (ConCatChar (s, ' '), Mark (InitString ('-quiet')))
+      END ;
+      RETURN s
+   ELSE
+      RETURN NIL
+   END
+END CppCommandLine ;
+
+
+(*
+   CppArg - sets the option and arg in the cpp command line.
+*)
+
+PROCEDURE CppArg (opt, arg: ADDRESS; joined: BOOLEAN) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar(opt) ;
+   IF EqualArray(s, '-fcpp-begin') OR EqualArray(s, '-fcpp-end')
+   THEN
+      (* do nothing *)
+   ELSE
+      IF NOT EqualArray(CppArgs, '')
+      THEN
+         CppArgs := ConCatChar(CppArgs, ' ')
+      END ;
+      CppArgs := ConCat(CppArgs, Mark(s)) ;
+      IF arg#NIL
+      THEN
+         s := InitStringCharStar(arg) ;
+         IF NOT joined
+         THEN
+            CppArgs := ConCatChar(CppArgs, ' ')
+         END ;
+         CppArgs := ConCat(CppArgs, s)
+      END
+   END
+END CppArg ;
+
+
+(*
+   CppRemember - remember a string, s, as a cpp related argument.
+                 The string, s, is not garbage collected.
+*)
+
+PROCEDURE CppRemember (s: String) ;
+BEGIN
+   IF (CppArgs=NIL) OR EqualArray (CppArgs, '')
+   THEN
+      CppArgs := Dup (s)
+   ELSE
+      CppArgs := ConCatChar (CppArgs, ' ') ;
+      CppArgs := ConCat (CppArgs, s)
+   END
+END CppRemember ;
+
+
+(*
+   FinaliseOptions - once all options have been parsed we set any inferred
+                     values.
+*)
+
+PROCEDURE FinaliseOptions ;
+BEGIN
+   (* currently only one value, this could be make an option in the future *)
+   VariantValueChecking := Iso
+END FinaliseOptions ;
+
+
+(*
+   SetWholeProgram - sets the WholeProgram flag (-fwhole-program).
+*)
+
+PROCEDURE SetWholeProgram (value: BOOLEAN) ;
+BEGIN
+   WholeProgram := value
+END SetWholeProgram ;
+
+
+(*
+   SetReturnCheck -
+*)
+
+PROCEDURE SetReturnCheck (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   ReturnChecking := value ;
+   RETURN TRUE
+END SetReturnCheck ;
+
+
+(*
+   SetNilCheck -
+*)
+
+PROCEDURE SetNilCheck (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   NilChecking := value ;
+   RETURN TRUE
+END SetNilCheck ;
+
+
+(*
+   SetCaseCheck - set else case checking to, value.
+*)
+
+PROCEDURE SetCaseCheck (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   CaseElseChecking := value ;
+   RETURN TRUE
+END SetCaseCheck ;
+
+
+(*
+   SetCheckAll - set all runtime checking to, value.
+*)
+
+PROCEDURE SetCheckAll (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   NilChecking := value ;
+   WholeDivChecking := value ;
+   IndexChecking := value ;
+   RangeChecking := value ;
+   ReturnChecking := value ;
+   NilChecking := value ;
+   CaseElseChecking := value ;
+   FloatValueChecking := value ;
+   WholeValueChecking := value ;
+   RETURN TRUE
+END SetCheckAll ;
+
+
+(*
+   SetAutoInit - -fauto-init turns on automatic initialization of pointers to NIL.
+*)
+
+PROCEDURE SetAutoInit (value: BOOLEAN) ;
+BEGIN
+   AutoInit := value ;
+   RETURN TRUE
+END SetAutoInit ;
+
+
+(*
+   SetUnusedVariableChecking - assigns the UnusedVariableChecking to value.
+*)
+
+PROCEDURE SetUnusedVariableChecking (value: BOOLEAN) ;
+BEGIN
+   UnusedVariableChecking := value
+END SetUnusedVariableChecking ;
+
+
+(*
+   SetUnusedParameterChecking - assigns the UnusedParameterChecking to value.
+*)
+
+PROCEDURE SetUnusedParameterChecking (value: BOOLEAN) ;
+BEGIN
+   UnusedParameterChecking := value
+END SetUnusedParameterChecking ;
+
+
+(*
+   SetStrictTypeChecking - assigns the StrictTypeChecking flag to value.
+*)
+
+PROCEDURE SetStrictTypeChecking (value: BOOLEAN) ;
+BEGIN
+   StrictTypeChecking := value
+END SetStrictTypeChecking ;
+
+
+(*
+   SetVerboseUnbounded - sets the VerboseUnbounded flag to, value.
+*)
+
+PROCEDURE SetVerboseUnbounded (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   VerboseUnbounded := value ;
+   RETURN TRUE
+END SetVerboseUnbounded ;
+
+
+(*
+   SetQuiet - sets the quiet flag to, value.
+*)
+
+PROCEDURE SetQuiet (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   Quiet := value ;
+   RETURN TRUE
+END SetQuiet ;
+
+
+(*
+   SetCpp - enables the source to be preprocessed and enables the
+            recognition of C preprocessor line directives.
+*)
+
+PROCEDURE SetCpp (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   CPreProcessor := value ;
+   LineDirectives := value ;
+   RETURN TRUE
+END SetCpp ;
+
+
+(*
+   GetCpp - returns TRUE if the C preprocessor was used.
+*)
+
+PROCEDURE GetCpp () : BOOLEAN ;
+BEGIN
+   RETURN CPreProcessor
+END GetCpp ;
+
+
+(*
+   Setc - set the cflag (compile only flag -c) to value.
+*)
+
+PROCEDURE Setc (value: BOOLEAN) ;
+BEGIN
+   cflag := value
+END Setc ;
+
+
+(*
+   Getc - get the cflag (compile only flag -c).
+*)
+
+PROCEDURE Getc () : BOOLEAN ;
+BEGIN
+   RETURN cflag
+END Getc ;
+
+
+(*
+   SetUselist - set the uselist flag to value and remember the filename.
+*)
+
+PROCEDURE SetUselist (value: BOOLEAN; filename: ADDRESS) ;
+BEGIN
+   UselistFlag := value ;
+   UselistFilename := KillString (UselistFilename) ;
+   IF filename # NIL
+   THEN
+      UselistFilename := InitStringCharStar (filename)
+   END
+END SetUselist ;
+
+
+(*
+   GetUselist - return the uselist flag.
+*)
+
+PROCEDURE GetUselist () : BOOLEAN ;
+BEGIN
+   RETURN UselistFlag
+END GetUselist ;
+
+
+(*
+   GetUselistFilename - return the uselist filename as a String.
+*)
+
+PROCEDURE GetUselistFilename () : String ;
+BEGIN
+   RETURN UselistFilename
+END GetUselistFilename ;
+
+
+(*
+   SetM2g - set GenerateStatementNote to value and return value.
+            Corresponds to the -fm2-g flag.
+*)
+
+PROCEDURE SetM2g (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   GenerateStatementNote := value ;
+   RETURN GenerateStatementNote
+END SetM2g ;
+
+
+(*
+   GetM2g - returns TRUE if the -fm2-g flags was used.
+*)
+
+PROCEDURE GetM2g () : BOOLEAN ;
+BEGIN
+   RETURN GenerateStatementNote
+END GetM2g ;
+
+
+(*
+   SetLowerCaseKeywords - set the lower case keyword flag and return the result.
+*)
+
+PROCEDURE SetLowerCaseKeywords (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   LowerCaseKeywords := value ;
+   RETURN LowerCaseKeywords
+END SetLowerCaseKeywords ;
+
+
+(*
+   SetVerbose - set the Verbose flag to, value.  It returns TRUE.
+*)
+
+PROCEDURE SetVerbose (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   Verbose := value ;
+   RETURN( TRUE )
+END SetVerbose ;
+
+
+(*
+   SetMakeall -
+
+PROCEDURE SetMakeall (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   (* value is unused *)
+   RETURN( TRUE )
+END SetMakeall ;
+*)
+
+
+(*
+   SetMakeall0 -
+
+PROCEDURE SetMakeall0 (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   (* value is unused *)
+   RETURN( TRUE )
+END SetMakeall0 ;
+*)
+
+
+(*
+   SetIncludePath -
+
+PROCEDURE SetIncludePath (arg: ADDRESS) : BOOLEAN ;
+BEGIN
+   RETURN( TRUE )
+END SetIncludePath ;
+*)
+
+
+(*
+   SetUnboundedByReference -
+*)
+
+PROCEDURE SetUnboundedByReference (value: BOOLEAN) : BOOLEAN ;
+BEGIN
+   UnboundedByReference := value ;
+   RETURN( TRUE )
+END SetUnboundedByReference ;
+
+
+(*
+(*
+   SetDebugging - sets the debugging flag to, v.
+*)
+
+PROCEDURE SetDebugging (value: BOOLEAN) ;
+BEGIN
+   GenerateDebugging := value
+END SetDebugging ;
+
+
+(*
+   SetProfiling - dummy procedure, as profiling is implemented in the gcc backend.
+*)
+
+PROCEDURE SetProfiling (value: BOOLEAN) ;
+BEGIN
+   (* nothing to do *)
+END SetProfiling ;
+*)
+
+
+(*
+   SetISO -
+*)
+
+PROCEDURE SetISO (value: BOOLEAN) ;
+BEGIN
+   Iso := value ;
+   Pim := NOT value ;
+   Pim2 := NOT value ;
+   (* Pim4 is the default, leave it alone since the DIV and MOD rules are the
+      same as ISO.  *)
+END SetISO ;
+
+
+(*
+   SetPIM -
+*)
+
+PROCEDURE SetPIM (value: BOOLEAN) ;
+BEGIN
+   Pim := value ;
+   Iso := NOT value
+END SetPIM ;
+
+
+(*
+   SetPIM2 -
+*)
+
+PROCEDURE SetPIM2 (value: BOOLEAN) ;
+BEGIN
+   Pim := value ;
+   Pim2 := value ;
+   Iso := NOT value ;
+   IF value
+   THEN
+      (* Pim4 is the default, turn it off.  *)
+      Pim4 := FALSE
+   END
+END SetPIM2 ;
+
+
+(*
+   SetPIM3 -
+*)
+
+PROCEDURE SetPIM3 (value: BOOLEAN) ;
+BEGIN
+   Pim := value ;
+   Pim3 := value ;
+   Iso := NOT value ;
+   IF value
+   THEN
+      (* Pim4 is the default, turn it off.  *)
+      Pim4 := FALSE
+   END
+END SetPIM3 ;
+
+
+(*
+   SetPIM4 -
+*)
+
+PROCEDURE SetPIM4 (value: BOOLEAN) ;
+BEGIN
+   Pim := value ;
+   Pim4 := value ;
+   Iso := NOT value
+END SetPIM4 ;
+
+
+(*
+   SetPositiveModFloor - sets the positive mod floor option.
+*)
+
+PROCEDURE SetPositiveModFloor (value: BOOLEAN) ;
+BEGIN
+   PositiveModFloorDiv := value
+END SetPositiveModFloor ;
+
+
+(*
+   SetWholeDiv - sets the whole division flag.
+*)
+
+PROCEDURE SetWholeDiv (value: BOOLEAN) ;
+BEGIN
+   WholeDivChecking := value
+END SetWholeDiv ;
+
+
+(*
+   SetIndex - sets the runtime array index checking flag.
+*)
+
+PROCEDURE SetIndex (value: BOOLEAN) ;
+BEGIN
+   IndexChecking := value
+END SetIndex ;
+
+
+(*
+   SetRange -  sets the runtime range checking flag.
+*)
+
+PROCEDURE SetRange (value: BOOLEAN) ;
+BEGIN
+   RangeChecking := value
+END SetRange ;
+
+
+(*
+   SetExceptions - sets the enable runtime exceptions flag.
+*)
+
+PROCEDURE SetExceptions (value: BOOLEAN) ;
+BEGIN
+   Exceptions := value
+END SetExceptions ;
+
+
+(*
+   SetStyle -
+*)
+
+PROCEDURE SetStyle (value: BOOLEAN) ;
+BEGIN
+   StyleChecking := value
+END SetStyle ;
+
+
+(*
+   SetPedantic -
+*)
+
+PROCEDURE SetPedantic (value: BOOLEAN) ;
+BEGIN
+   Pedantic := value
+END SetPedantic ;
+
+
+(*
+   SetPedanticParamNames - sets the pedantic parameter name flag.
+*)
+
+PROCEDURE SetPedanticParamNames (value: BOOLEAN) ;
+BEGIN
+   PedanticParamNames := value
+END SetPedanticParamNames ;
+
+
+(*
+   SetPedanticCast - sets the pedantic cast flag.
+*)
+
+PROCEDURE SetPedanticCast (value: BOOLEAN) ;
+BEGIN
+   PedanticCast := value
+END SetPedanticCast ;
+
+
+(*
+   SetExtendedOpaque - sets the ExtendedOpaque flag.
+*)
+
+PROCEDURE SetExtendedOpaque (value: BOOLEAN) ;
+BEGIN
+   ExtendedOpaque := value
+END SetExtendedOpaque ;
+
+
+(*
+   SetXCode - sets the xcode flag.
+*)
+
+PROCEDURE SetXCode (value: BOOLEAN) ;
+BEGIN
+   Xcode := value
+END SetXCode ;
+
+
+(*
+   SetSwig -
+*)
+
+PROCEDURE SetSwig (value: BOOLEAN) ;
+BEGIN
+   GenerateSwig := value
+END SetSwig ;
+
+
+(*
+   SetQuadDebugging - display the quadruples (internal debugging).
+*)
+
+PROCEDURE SetQuadDebugging (value: BOOLEAN) ;
+BEGIN
+   DisplayQuadruples := value
+END SetQuadDebugging ;
+
+
+(*
+   SetCompilerDebugging - turn on internal compiler debugging.
+*)
+
+PROCEDURE SetCompilerDebugging (value: BOOLEAN) ;
+BEGIN
+   CompilerDebugging := value
+END SetCompilerDebugging ;
+
+
+(*
+   SetDebugTraceQuad -
+*)
+
+PROCEDURE SetDebugTraceQuad (value: BOOLEAN) ;
+BEGIN
+   DebugTraceQuad := value
+END SetDebugTraceQuad ;
+
+
+(*
+   SetDebugTraceAPI -
+*)
+
+PROCEDURE SetDebugTraceAPI (value: BOOLEAN) ;
+BEGIN
+   DebugTraceAPI := value
+END SetDebugTraceAPI ;
+
+
+(*
+   SetSources -
+*)
+
+PROCEDURE SetSources (value: BOOLEAN) ;
+BEGIN
+   Quiet := NOT value ;
+   SeenSources := value
+END SetSources ;
+
+
+(*
+   SetDumpSystemExports -
+*)
+
+PROCEDURE SetDumpSystemExports (value: BOOLEAN) ;
+BEGIN
+   DumpSystemExports := value
+END SetDumpSystemExports ;
+
+
+(*
+   SetSearchPath -
+*)
+
+PROCEDURE SetSearchPath (arg: ADDRESS) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar(arg) ;
+   IF Debugging
+   THEN
+      printf1("setting search path to: %s\n", s)
+   END ;
+   PrependSearchPath(s) ;
+   s := KillString(s)
+END SetSearchPath ;
+
+
+(*
+   setdefextension -
+*)
+
+PROCEDURE setdefextension (arg: ADDRESS) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar(arg) ;
+   SetDefExtension(s) ;
+   s := KillString(s)
+END setdefextension ;
+
+
+(*
+   setmodextension -
+*)
+
+PROCEDURE setmodextension (arg: ADDRESS) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar(arg) ;
+   SetModExtension(s) ;
+   s := KillString(s)
+END setmodextension ;
+
+
+(*
+   SetOptimizing -
+*)
+
+PROCEDURE SetOptimizing (value: CARDINAL) ;
+BEGIN
+   IF value>0
+   THEN
+      Optimizing := TRUE ;
+      OptimizeBasicBlock := TRUE ;
+      OptimizeUncalledProcedures := TRUE ;
+      OptimizeCommonSubExpressions := TRUE
+   ELSE
+      Optimizing := FALSE ;
+      OptimizeBasicBlock := FALSE ;
+      OptimizeUncalledProcedures := FALSE ;
+      OptimizeCommonSubExpressions := FALSE
+   END
+END SetOptimizing ;
+
+
+(*
+   SetForcedLocation - sets the location for the lifetime of this compile to, location.
+                       This is primarily an internal debugging switch.
+*)
+
+PROCEDURE SetForcedLocation (location: location_t) ;
+BEGIN
+   ForcedLocation := TRUE ;
+   ForcedLocationValue := location
+END SetForcedLocation ;
+
+
+(*
+   SetCC1Quiet - sets the cc1quiet flag to, value.
+*)
+
+PROCEDURE SetCC1Quiet (value: BOOLEAN) ;
+BEGIN
+   CC1Quiet := value
+END SetCC1Quiet ;
+
+
+(*
+   SetStatistics - turn on/off generate of compile time statistics.
+*)
+
+PROCEDURE SetStatistics (on: BOOLEAN) ;
+BEGIN
+   Statistics := on
+END SetStatistics ;
+
+
+(*
+   OverrideLocation - possibly override the location value, depending upon
+                      whether the -flocation= option was used.
+*)
+
+PROCEDURE OverrideLocation (location: location_t) : location_t ;
+BEGIN
+   IF ForcedLocation
+   THEN
+      RETURN( ForcedLocationValue )
+   ELSE
+      RETURN( location )
+   END
+END OverrideLocation ;
+
+
+(*
+   SetDebugFunctionLineNumbers - turn DebugFunctionLineNumbers on/off
+                                 (used internally for debugging).
+*)
+
+PROCEDURE SetDebugFunctionLineNumbers (value: BOOLEAN) ;
+BEGIN
+   DebugFunctionLineNumbers := value
+END SetDebugFunctionLineNumbers ;
+
+
+(*
+   SetGenerateStatementNote - turn on generation of nops if necessary
+                              to generate pedalogical single stepping.
+*)
+
+PROCEDURE SetGenerateStatementNote (value: BOOLEAN) ;
+BEGIN
+   GenerateStatementNote := value
+END SetGenerateStatementNote ;
+
+
+(*
+   GetISO - return TRUE if -fiso was present on the command line.
+*)
+
+PROCEDURE GetISO () : BOOLEAN ;
+BEGIN
+   RETURN Iso
+END GetISO ;
+
+
+(*
+   GetPIM - return TRUE if -fpim was present on the command line.
+*)
+
+PROCEDURE GetPIM () : BOOLEAN ;
+BEGIN
+   RETURN Pim
+END GetPIM ;
+
+
+(*
+   GetPIM2 - return TRUE if -fpim2 was present on the command line.
+*)
+
+PROCEDURE GetPIM2 () : BOOLEAN ;
+BEGIN
+   RETURN Pim2
+END GetPIM2 ;
+
+
+(*
+   GetPIM3 - return TRUE if -fpim3 was present on the command line.
+*)
+
+PROCEDURE GetPIM3 () : BOOLEAN ;
+BEGIN
+   RETURN Pim3
+END GetPIM3 ;
+
+
+(*
+   GetPIM4 - return TRUE if -fpim4 was present on the command line.
+*)
+
+PROCEDURE GetPIM4 () : BOOLEAN ;
+BEGIN
+   RETURN Pim4
+END GetPIM4 ;
+
+
+(*
+   GetPositiveModFloor - return TRUE if -fpositive-mod-floor was present
+                         on the command line.
+*)
+
+PROCEDURE GetPositiveModFloor () : BOOLEAN ;
+BEGIN
+   RETURN PositiveModFloorDiv
+END GetPositiveModFloor ;
+
+
+(*
+   GetFloatValueCheck - return TRUE if -ffloatvalue was present on the
+                        command line.
+*)
+
+PROCEDURE GetFloatValueCheck () : BOOLEAN ;
+BEGIN
+   RETURN FloatValueChecking
+END GetFloatValueCheck ;
+
+
+(*
+   SetFloatValueCheck - set depending upon the -ffloatvalue.
+*)
+
+PROCEDURE SetFloatValueCheck (value: BOOLEAN) ;
+BEGIN
+   FloatValueChecking := value
+END SetFloatValueCheck ;
+
+
+(*
+   GetWholeValueCheck - return TRUE if -fwholevalue was present on the
+                        command line.
+*)
+
+PROCEDURE GetWholeValueCheck () : BOOLEAN ;
+BEGIN
+   RETURN WholeValueChecking
+END GetWholeValueCheck ;
+
+
+(*
+   SetWholeValueCheck - set depending upon the -fwholevalue.
+*)
+
+PROCEDURE SetWholeValueCheck (value: BOOLEAN) ;
+BEGIN
+   WholeValueChecking := value
+END SetWholeValueCheck ;
+
+
+(*
+   SetWall - set all warnings to, value.
+*)
+
+PROCEDURE SetWall (value: BOOLEAN) ;
+BEGIN
+   UnusedVariableChecking  := value ;
+   UnusedParameterChecking := value ;
+   PedanticCast := value ;
+   PedanticParamNames := value ;
+   StyleChecking := value
+END SetWall ;
+
+
+(*
+   SetSaveTemps - turn on/off -save-temps.
+*)
+
+PROCEDURE SetSaveTemps (value: BOOLEAN) ;
+BEGIN
+   SaveTemps := value
+END SetSaveTemps ;
+
+
+(*
+   SetSaveTempsDir - turn on/off -save-temps and specify the directory.
+*)
+
+PROCEDURE SetSaveTempsDir (arg: ADDRESS) ;
+BEGIN
+   SaveTempsDir := InitStringCharStar (arg)
+END SetSaveTempsDir ;
+
+
+(*
+   GetSaveTempsDir - return SaveTempsDir or NIL if -save-temps was not used.
+*)
+
+PROCEDURE GetSaveTempsDir () : String ;
+BEGIN
+   RETURN SaveTempsDir
+END GetSaveTempsDir ;
+
+
+(*
+   SetScaffoldDynamic - set the -fscaffold-dynamic flag.
+*)
+
+PROCEDURE SetScaffoldDynamic (value: BOOLEAN) ;
+BEGIN
+   ScaffoldDynamic := value ;
+   IF ScaffoldDynamic
+   THEN
+      ScaffoldStatic := FALSE
+   END
+END SetScaffoldDynamic ;
+
+
+(*
+   SetScaffoldStatic - set the -fscaffold-static flag.
+*)
+
+PROCEDURE SetScaffoldStatic (value: BOOLEAN) ;
+BEGIN
+   ScaffoldStatic := value ;
+   IF ScaffoldStatic
+   THEN
+      ScaffoldDynamic := FALSE
+   END
+END SetScaffoldStatic ;
+
+
+(*
+   GetScaffoldDynamic - get the -fscaffold-dynamic flag.
+*)
+
+PROCEDURE GetScaffoldDynamic () : BOOLEAN ;
+BEGIN
+   RETURN ScaffoldDynamic
+END GetScaffoldDynamic ;
+
+
+(*
+   GetScaffoldStatic - get the -fscaffold-static flag.
+*)
+
+PROCEDURE GetScaffoldStatic () : BOOLEAN ;
+BEGIN
+   RETURN ScaffoldStatic
+END GetScaffoldStatic ;
+
+
+(*
+   SetScaffoldMain - set the -fscaffold-main flag.
+*)
+
+PROCEDURE SetScaffoldMain (value: BOOLEAN) ;
+BEGIN
+   ScaffoldMain := value
+END SetScaffoldMain ;
+
+
+(*
+   SetRuntimeModuleOverride - set the override sequence used for module
+                              initialization and finialization.
+*)
+
+PROCEDURE SetRuntimeModuleOverride (override: ADDRESS) ;
+BEGIN
+   RuntimeModuleOverride := KillString (RuntimeModuleOverride) ;
+   RuntimeModuleOverride := InitStringCharStar (override)
+END SetRuntimeModuleOverride ;
+
+
+(*
+   GetRuntimeModuleOverride - return a string containing any user override
+                              or the default module initialization override
+                              sequence.
+*)
+
+PROCEDURE GetRuntimeModuleOverride () : ADDRESS ;
+BEGIN
+   RETURN RuntimeModuleOverride
+END GetRuntimeModuleOverride ;
+
+
+(*
+   SetGenModuleList - set the GenModuleList flag to true and pass
+                      set GenModuleListFilename to filename.
+*)
+
+PROCEDURE SetGenModuleList (value: BOOLEAN; filename: ADDRESS) ;
+BEGIN
+   GenModuleListFilename := KillString (GenModuleListFilename) ;
+   IF filename # NIL
+   THEN
+      GenModuleListFilename := InitStringCharStar (filename)
+   END ;
+   GenModuleList := value
+END SetGenModuleList ;
+
+
+(*
+   GetGenModuleFilename - returns the filename set by SetGenModuleList.
+*)
+
+PROCEDURE GetGenModuleFilename () : String ;
+BEGIN
+   RETURN GenModuleListFilename
+END GetGenModuleFilename ;
+
+
+(*
+   SetShared - sets the SharedFlag to value.
+*)
+
+PROCEDURE SetShared (value: BOOLEAN) ;
+BEGIN
+   SharedFlag := value
+END SetShared ;
+
+
+BEGIN
+   cflag                        := FALSE ;  (* -c.  *)
+   RuntimeModuleOverride        := NIL ;
+   CppArgs                      := InitString ('') ;
+   Pim                          :=  TRUE ;
+   Pim2                         := FALSE ;
+   Pim3                         := FALSE ;
+   Pim4                         :=  TRUE ;
+   PositiveModFloorDiv          := FALSE ;
+   Iso                          := FALSE ;
+   SeenSources                  := FALSE ;
+   Statistics                   := FALSE ;
+   StyleChecking                := FALSE ;
+   CompilerDebugging            := FALSE ;
+   GenerateDebugging            := FALSE ;
+   Optimizing                   := FALSE ;
+   Pedantic                     := FALSE ;
+   Verbose                      := FALSE ;
+   Quiet                        :=  TRUE ;
+   CC1Quiet                     :=  TRUE ;
+   Profiling                    := FALSE ;
+   DisplayQuadruples            := FALSE ;
+   OptimizeBasicBlock           := FALSE ;
+   OptimizeUncalledProcedures   := FALSE ;
+   OptimizeCommonSubExpressions := FALSE ;
+   NilChecking                  := FALSE ;
+   WholeDivChecking             := FALSE ;
+   WholeValueChecking           := FALSE ;
+   FloatValueChecking           := FALSE ;
+   IndexChecking                := FALSE ;
+   RangeChecking                := FALSE ;
+   ReturnChecking               := FALSE ;
+   CaseElseChecking             := FALSE ;
+   CPreProcessor                := FALSE ;
+   LineDirectives               := FALSE ;
+   ExtendedOpaque               := FALSE ;
+   UnboundedByReference         := FALSE ;
+   VerboseUnbounded             := FALSE ;
+   PedanticParamNames           := FALSE ;
+   PedanticCast                 := FALSE ;
+   Xcode                        := FALSE ;
+   DumpSystemExports            := FALSE ;
+   GenerateSwig                 := FALSE ;
+   Exceptions                   :=  TRUE ;
+   DebugBuiltins                := FALSE ;
+   ForcedLocation               := FALSE ;
+   WholeProgram                 := FALSE ;
+   DebugTraceQuad               := FALSE ;
+   DebugTraceAPI                := FALSE ;
+   DebugFunctionLineNumbers     := FALSE ;
+   GenerateStatementNote        := FALSE ;
+   LowerCaseKeywords            := FALSE ;
+   UnusedVariableChecking       := FALSE ;
+   UnusedParameterChecking      := FALSE ;
+   StrictTypeChecking           := TRUE ;
+   AutoInit                     := FALSE ;
+   SaveTemps                    := FALSE ;
+   ScaffoldDynamic              := TRUE ;
+   ScaffoldStatic               := FALSE ;
+   ScaffoldMain                 := FALSE ;
+   UselistFilename              := NIL ;
+   GenModuleList                := FALSE ;
+   GenModuleListFilename        := NIL ;
+   SharedFlag                   := FALSE ;
+   Barg                         := NIL ;
+   SaveTempsDir                 := NIL
+END M2Options.
diff --git a/gcc/m2/gm2-compiler/M2Pass.def b/gcc/m2/gm2-compiler/M2Pass.def
new file mode 100644
index 00000000000..baa8c714bb6
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Pass.def
@@ -0,0 +1,178 @@
+(* M2Pass.def provides setting and testing of the current pass.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Pass ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Lexical
+   Date       : Thu Nov  2 12:58:18 GMT 1989
+   Description: Controls the setting and testing of the current pass.
+   Last update: Thu Nov  2 12:58:27 GMT 1989
+*)
+
+EXPORT QUALIFIED SetPassToNoPass,
+                 SetPassToPass0,
+                 SetPassToPass1,
+                 SetPassToPass2,
+                 SetPassToPassC,
+                 SetPassToPass3,
+                 SetPassToPassHidden,
+                 SetPassToCodeGeneration,
+                 SetPassToErrorPass,
+                 IsNoPass,
+                 IsPass0,
+                 IsPass1,
+                 IsPass2,
+                 IsPass3,
+                 IsPassC,
+                 IsPassHidden,
+                 IsPassCodeGeneration,
+                 IsErrorPass ;
+
+
+(*
+   SetPassToNoPass - sets the pass state to no Pass.
+*)
+
+PROCEDURE SetPassToNoPass ;
+
+
+(*
+   SetPassToPass0 - sets the pass state to Pass 0.
+*)
+
+PROCEDURE SetPassToPass0 ;
+
+
+(*
+   SetPassToPass1 - sets the pass state to Pass 1.
+*)
+
+PROCEDURE SetPassToPass1 ;
+
+
+(*
+   SetPassToPass2 - sets the pass state to Pass 2.
+*)
+
+PROCEDURE SetPassToPass2 ;
+
+
+(*
+   SetPassToPassC - sets the pass state to Pass C.
+*)
+
+PROCEDURE SetPassToPassC ;
+
+
+(*
+   SetPassToPass3 - sets the pass state to Pass 3.
+*)
+
+PROCEDURE SetPassToPass3 ;
+
+
+(*
+   SetPassToPassHidden - sets the pass state to the hidden type pass.
+*)
+
+PROCEDURE SetPassToPassHidden ;
+
+
+(*
+   SetPassToCodeGeneration - sets the pass state to CodeGeneration.
+*)
+
+PROCEDURE SetPassToCodeGeneration ;
+
+
+(*
+   SetPassToErrorPass - sets the pass state to no Error Pass.
+*)
+
+PROCEDURE SetPassToErrorPass ;
+
+
+(*
+   IsNoPass - returns true if currently in no Pass.
+*)
+
+PROCEDURE IsNoPass () : BOOLEAN ;
+
+
+(*
+   IsPass0 - returns true if currently in Pass 0.
+*)
+
+PROCEDURE IsPass0 () : BOOLEAN ;
+
+
+(*
+   IsPass1 - returns true if currently in Pass 1.
+*)
+
+PROCEDURE IsPass1 () : BOOLEAN ;
+
+
+(*
+   IsPass2 - returns true if currently in Pass 2.
+*)
+
+PROCEDURE IsPass2 () : BOOLEAN ;
+
+
+(*
+   IsPassC - returns true if currently in Pass C.
+*)
+
+PROCEDURE IsPassC () : BOOLEAN ;
+
+
+(*
+   IsPass3 - returns true if currently in Pass 3.
+*)
+
+PROCEDURE IsPass3 () : BOOLEAN ;
+
+
+(*
+   IsPassHidden - returns TRUE if currently parsing for hidden types.
+*)
+
+PROCEDURE IsPassHidden () : BOOLEAN ;
+
+
+(*
+   IsPassCodeGeneration - returns true if currently in the CodeGeneration Pass.
+*)
+
+PROCEDURE IsPassCodeGeneration () : BOOLEAN ;
+
+
+(*
+   IsErrorPass - returns true if currently in the Error Pass.
+*)
+
+PROCEDURE IsErrorPass () : BOOLEAN ;
+
+
+END M2Pass.
diff --git a/gcc/m2/gm2-compiler/M2Pass.mod b/gcc/m2/gm2-compiler/M2Pass.mod
new file mode 100644
index 00000000000..59c0203abf9
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Pass.mod
@@ -0,0 +1,246 @@
+(* M2Pass.mod provides setting and testing of the current pass.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Pass ;
+
+FROM M2Error IMPORT InternalError ;
+
+TYPE
+   Pass = (NoPass, Pass0, Pass1, Pass2, PassC, Pass3, CodeGeneration, ErrorPass, HiddenPass) ;
+
+VAR
+   CurrentPass: Pass ;
+
+
+(*
+   SetPassToNoPass - sets the pass state to no Pass.
+*)
+
+PROCEDURE SetPassToNoPass ;
+BEGIN
+   CurrentPass := NoPass
+END SetPassToNoPass ;
+
+
+(*
+   SetPassToPass0 - sets the pass state to Pass 0.
+*)
+
+PROCEDURE SetPassToPass0 ;
+BEGIN
+   IF CurrentPass=NoPass
+   THEN
+      CurrentPass := Pass0
+   ELSE
+      InternalError ('attempting to set CurrentPass to Pass1')
+   END
+END SetPassToPass0 ;
+
+
+(*
+   SetPassToPass1 - sets the pass state to Pass 1.
+*)
+
+PROCEDURE SetPassToPass1 ;
+BEGIN
+   IF CurrentPass=NoPass
+   THEN
+      CurrentPass := Pass1
+   ELSE
+      InternalError ('attempting to set CurrentPass to Pass1')
+   END
+END SetPassToPass1 ;
+
+
+
+(*
+   SetPassToPass2 - sets the pass state to Pass 2.
+*)
+
+PROCEDURE SetPassToPass2 ;
+BEGIN
+   IF CurrentPass=NoPass
+   THEN
+      CurrentPass := Pass2
+   ELSE
+      InternalError ('attempting to set CurrentPass to Pass2')
+   END
+END SetPassToPass2 ;
+
+
+(*
+   SetPassToPassC - sets the pass state to Pass C.
+*)
+
+PROCEDURE SetPassToPassC ;
+BEGIN
+   IF CurrentPass=NoPass
+   THEN
+      CurrentPass := PassC
+   ELSE
+      InternalError ('attempting to set CurrentPass to PassC')
+   END
+END SetPassToPassC ;
+
+
+(*
+   SetPassToPass3 - sets the pass state to Pass 3.
+*)
+
+PROCEDURE SetPassToPass3 ;
+BEGIN
+   IF CurrentPass=NoPass
+   THEN
+      CurrentPass := Pass3
+   ELSE
+      InternalError ('attempting to set CurrentPass to Pass3')
+   END
+END SetPassToPass3 ;
+
+
+(*
+   SetPassToErrorPass - sets the pass state to no Error Pass.
+*)
+
+PROCEDURE SetPassToErrorPass ;
+BEGIN
+   CurrentPass := ErrorPass
+END SetPassToErrorPass ;
+
+
+(*
+   SetPassToPassHidden - sets the pass state to the hidden type pass.
+*)
+
+PROCEDURE SetPassToPassHidden ;
+BEGIN
+   CurrentPass := HiddenPass
+END SetPassToPassHidden ;
+
+
+(*
+   SetPassToCodeGeneration - sets the pass state to CodeGeneration.
+*)
+
+PROCEDURE SetPassToCodeGeneration ;
+BEGIN
+   IF CurrentPass=NoPass
+   THEN
+      CurrentPass := CodeGeneration
+   ELSE
+      InternalError ('attempting to set CurrentPass to CodeGeneration')
+   END
+END SetPassToCodeGeneration ;
+
+
+(*
+   IsNoPass - returns true if currently in no Pass.
+*)
+
+PROCEDURE IsNoPass () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=NoPass )
+END IsNoPass ;
+
+
+(*
+   IsPass0 - returns true if currently in Pass 0.
+*)
+
+PROCEDURE IsPass0 () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=Pass0 )
+END IsPass0 ;
+
+
+(*
+   IsPass1 - returns true if currently in Pass 1.
+*)
+
+PROCEDURE IsPass1 () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=Pass1 )
+END IsPass1 ;
+
+
+(*
+   IsPass2 - returns true if currently in Pass 2.
+*)
+
+PROCEDURE IsPass2 () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=Pass2 )
+END IsPass2 ;
+
+
+(*
+   IsPassC - returns true if currently in Pass C.
+*)
+
+PROCEDURE IsPassC () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=PassC )
+END IsPassC ;
+
+
+(*
+   IsPass3 - returns true if currently in Pass 3.
+*)
+
+PROCEDURE IsPass3 () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=Pass3 )
+END IsPass3 ;
+
+
+(*
+   IsPassCodeGeneration - returns true if currently in the CodeGeneration Pass.
+*)
+
+PROCEDURE IsPassCodeGeneration () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=CodeGeneration )
+END IsPassCodeGeneration ;
+
+
+(*
+   IsPassHidden - returns TRUE if currently parsing for hidden types.
+*)
+
+PROCEDURE IsPassHidden () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=HiddenPass )
+END IsPassHidden ;
+
+
+(*
+   IsErrorPass - returns true if currently in the Error Pass.
+*)
+
+PROCEDURE IsErrorPass () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentPass=ErrorPass )
+END IsErrorPass ;
+
+
+BEGIN
+   SetPassToNoPass
+END M2Pass.
diff --git a/gcc/m2/gm2-compiler/M2Preprocess.def b/gcc/m2/gm2-compiler/M2Preprocess.def
new file mode 100644
index 00000000000..7f8d798a7de
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Preprocess.def
@@ -0,0 +1,51 @@
+(* M2Preprocess.def provides a mechanism to invoke the C preprocessor.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Preprocess ;
+
+(*
+    Title      : M2Preprocess
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Thu Dec  6 17:59:57 2001
+    Last edit  : $Date: 2010/10/03 19:01:06 $
+    Revision   : $Version$
+    Description: provides a mechanism to invoke the C preprocessor.
+*)
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED PreprocessModule ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE PreprocessModule (filename: String) : String ;
+
+
+END M2Preprocess.
diff --git a/gcc/m2/gm2-compiler/M2Preprocess.mod b/gcc/m2/gm2-compiler/M2Preprocess.mod
new file mode 100644
index 00000000000..44a688d2008
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Preprocess.mod
@@ -0,0 +1,152 @@
+(* M2Preprocess.mod provides a mechanism to invoke the C preprocessor.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Preprocess ;
+
+
+FROM SYSTEM IMPORT WORD ;
+
+FROM DynamicStrings IMPORT string, InitString, Mark, KillString, EqualArray, InitStringCharStar,
+                           Dup, ConCat, ConCatChar, RIndex, Slice ;
+
+FROM choosetemp IMPORT make_temp_file ;
+FROM pexecute IMPORT pexecute ;
+FROM libc IMPORT system, exit, unlink, printf, atexit ;
+FROM Lists IMPORT List, InitList, KillList, IncludeItemIntoList, ForeachItemInListDo ;
+FROM FIO IMPORT StdErr, StdOut ;
+FROM M2Printf IMPORT fprintf1 ;
+FROM M2Options IMPORT Verbose, CppCommandLine, SaveTemps ;
+FROM NameKey IMPORT Name, MakeKey, KeyToCharStar, makekey ;
+
+
+VAR
+   ListOfFiles: List ;
+
+
+(*
+   OnExitDelete -
+*)
+
+PROCEDURE OnExitDelete (filename: String) : String ;
+BEGIN
+   IncludeItemIntoList (ListOfFiles, makekey (filename)) ;
+   RETURN filename
+END OnExitDelete ;
+
+
+(*
+   RemoveFile - removes a single file, s.
+*)
+
+PROCEDURE RemoveFile (w: WORD) ;
+VAR
+   n: Name ;
+BEGIN
+   n := w ;
+   IF unlink (KeyToCharStar (n)) # 0
+   THEN
+   END
+END RemoveFile ;
+
+
+(*
+   RemoveFiles -
+*)
+
+PROCEDURE RemoveFiles () : INTEGER ;
+BEGIN
+   ForeachItemInListDo (ListOfFiles, RemoveFile) ;
+   RETURN 0
+END RemoveFiles ;
+
+
+(*
+   MakeSaveTempsFileName - return a temporary file "filename.i".
+*)
+
+PROCEDURE MakeSaveTempsFileName (filename: String) : String ;
+BEGIN
+   RETURN ConCat (Dup (filename), InitString ('.i'))
+END MakeSaveTempsFileName ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE PreprocessModule (filename: String) : String ;
+VAR
+   tempfile,
+   command,
+   commandLine: String ;
+BEGIN
+   command := CppCommandLine () ;
+   IF (command = NIL) OR EqualArray (command, '')
+   THEN
+      RETURN filename
+   ELSE
+      IF SaveTemps
+      THEN
+         tempfile := InitStringCharStar (MakeSaveTempsFileName (filename))
+      ELSE
+         tempfile := InitStringCharStar (make_temp_file (KeyToCharStar (MakeKey('i'))))
+      END ;
+      commandLine := Dup (command) ;
+      commandLine := ConCat (ConCat (ConCat (ConCatChar (Dup (commandLine), ' '), filename),
+                                     Mark (InitString(' -o '))),
+                             tempfile) ;
+(*  use pexecute in the future
+      res := pexecute(string(Slice(commandLine, 0, Index(commandLine, ' ', 0))), etc etc );
+*)
+      (* for now we'll use system *)
+      IF Verbose
+      THEN
+         fprintf1 (StdOut, "preprocess: %s\n", commandLine)
+      END ;
+      IF system (string (commandLine)) # 0
+      THEN
+         fprintf1 (StdErr, 'C preprocessor failed when preprocessing %s\n', filename) ;
+         exit (1)
+      END ;
+      commandLine := KillString (commandLine) ;
+      IF SaveTemps
+      THEN
+         RETURN tempfile
+      ELSE
+         RETURN OnExitDelete (tempfile)
+      END
+   END
+END PreprocessModule ;
+
+
+BEGIN
+   InitList (ListOfFiles) ;
+   IF atexit (RemoveFiles) # 0
+   THEN
+      HALT
+   END
+END M2Preprocess.
diff --git a/gcc/m2/gm2-compiler/M2Printf.def b/gcc/m2/gm2-compiler/M2Printf.def
new file mode 100644
index 00000000000..470307c3430
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Printf.def
@@ -0,0 +1,66 @@
+(* M2Printf.def provides a simple printf capability.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Printf ;
+
+(*
+    Title      : M2Printf
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Tue Aug  7 15:32:02 2001
+    Last edit  : $Date: 2010/10/03 19:01:07 $
+    Revision   : $Version$
+    Description: provides a simple printf capability. It requires NameKey
+                 as it will translate %a into a namekey.
+                 It supports %a, %d, %c and %s.
+*)
+
+FROM SYSTEM IMPORT BYTE ;
+FROM FIO IMPORT File ;
+EXPORT QUALIFIED printf0, printf1, printf2, printf3, printf4,
+                 fprintf0, fprintf1, fprintf2, fprintf3, fprintf4 ;
+
+
+(*
+   printf0 - writes out an array to, StdOut, after the escape sequences have been
+             translated.
+*)
+
+PROCEDURE printf0 (a: ARRAY OF CHAR) ;
+PROCEDURE printf1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+PROCEDURE printf2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+PROCEDURE printf3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+PROCEDURE printf4 (a: ARRAY OF CHAR; w1, w2, w3, w4: ARRAY OF BYTE) ;
+
+
+(*
+   fprintf0 - writes out an array to, file, after the escape sequences have been
+              translated.
+*)
+
+PROCEDURE fprintf0 (file: File; a: ARRAY OF CHAR) ;
+PROCEDURE fprintf1 (file: File; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+PROCEDURE fprintf2 (file: File; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+PROCEDURE fprintf3 (file: File; a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+PROCEDURE fprintf4 (file: File; a: ARRAY OF CHAR; w1, w2, w3, w4: ARRAY OF BYTE) ;
+
+
+END M2Printf.
diff --git a/gcc/m2/gm2-compiler/M2Printf.mod b/gcc/m2/gm2-compiler/M2Printf.mod
new file mode 100644
index 00000000000..8f7c98a47ff
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Printf.mod
@@ -0,0 +1,314 @@
+(* M2Printf.mod provides a simple printf capability.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Printf ;
+
+FROM SFIO IMPORT WriteS ;
+FROM FIO IMPORT StdOut ;
+FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, Mark ;
+FROM StrLib IMPORT StrLen ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4 ;
+FROM NameKey IMPORT Name, KeyToCharStar ;
+
+
+(*
+   IsDigit - returns TRUE if, ch, is a character 0..9
+*)
+
+(*
+PROCEDURE IsDigit (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch>='0') AND (ch<='9')
+END IsDigit ;
+*)
+
+
+(*
+   Cast - casts a := b
+*)
+
+PROCEDURE Cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF HIGH(a) = HIGH(b)
+   THEN
+      FOR i := 0 TO HIGH(a) DO
+         a[i] := b[i]
+      END
+   ELSE
+      HALT
+   END
+END Cast ;
+
+
+(*
+   TranslateNameToCharStar - takes a format specification string, a, and
+                             if it contains %a then this is translated
+                             into a String and %a is replaced by %s.
+*)
+
+PROCEDURE TranslateNameToCharStar (VAR a: ARRAY OF CHAR;
+                                   n: CARDINAL) : BOOLEAN ;
+VAR
+   argno,
+   i, h : CARDINAL ;
+BEGIN
+   argno := 1 ;
+   i := 0 ;
+   h := StrLen(a) ;
+   WHILE i<h DO
+      IF (a[i]='%') AND (i+1<h)
+      THEN
+         IF (a[i+1] = 'a') AND (argno = n)
+         THEN
+            a[i+1] := 's' ;
+            RETURN TRUE
+         END ;
+         INC (argno) ;
+         IF argno>n
+         THEN
+            (* all done *)
+            RETURN FALSE
+         END
+      END ;
+      INC (i)
+   END ;
+   RETURN FALSE
+END TranslateNameToCharStar ;
+
+
+(*
+   fprintf0 - writes out an array to, file, after the escape sequences
+              have been translated.
+*)
+
+PROCEDURE fprintf0 (file: File; a: ARRAY OF CHAR) ;
+BEGIN
+   IF KillString (WriteS (file, Sprintf0 (InitString(a)))) = NIL
+   THEN
+   END
+END fprintf0 ;
+
+
+PROCEDURE fprintf1 (file: File; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   s, t: String ;
+   n   : Name ;
+BEGIN
+   IF TranslateNameToCharStar (a, 1)
+   THEN
+      Cast (n, w) ;
+      s := Mark (InitStringCharStar (KeyToCharStar (n))) ;
+      t := Mark (InitString (a)) ;
+      s := Sprintf1 (t, s)
+   ELSE
+      t := Mark (InitString (a)) ;
+      s := Sprintf1 (t, w)
+   END ;
+   IF KillString (WriteS (file, s)) = NIL
+   THEN
+   END
+END fprintf1 ;
+
+
+PROCEDURE fprintf2 (file: File; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+VAR
+   n     : Name ;
+   s,
+   s1, s2: String ;
+   b     : BITSET ;
+BEGIN
+   b := {} ;
+   IF TranslateNameToCharStar (a, 1)
+   THEN
+      Cast (n, w1) ;
+      s1 := Mark(InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 1)
+   END ;
+   IF TranslateNameToCharStar (a, 2)
+   THEN
+      Cast(n, w2) ;
+      s2 := Mark(InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 2)
+   END ;
+   CASE b OF
+
+   {}   :  s := Sprintf2 (Mark (InitString(a)), w1, w2) |
+   {1}  :  s := Sprintf2 (Mark (InitString(a)), s1, w2) |
+   {2}  :  s := Sprintf2 (Mark (InitString(a)), w1, s2) |
+   {1,2}:  s := Sprintf2 (Mark (InitString(a)), s1, s2)
+
+   ELSE
+      HALT
+   END ;
+   IF KillString (WriteS (file, s)) = NIL
+   THEN
+   END
+END fprintf2 ;
+
+
+PROCEDURE fprintf3 (file: File; a: ARRAY OF CHAR;
+                    w1, w2, w3: ARRAY OF BYTE) ;
+VAR
+   n            : Name ;
+   s, s1, s2, s3: String ;
+   b            : BITSET ;
+BEGIN
+   b := {} ;
+   IF TranslateNameToCharStar (a, 1)
+   THEN
+      Cast (n, w1) ;
+      s1 := Mark (InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 1)
+   END ;
+   IF TranslateNameToCharStar(a, 2)
+   THEN
+      Cast (n, w2) ;
+      s2 := Mark (InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 2)
+   END ;
+   IF TranslateNameToCharStar(a, 3)
+   THEN
+      Cast (n, w3) ;
+      s3 := Mark (InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 3)
+   END ;
+   CASE b OF
+
+   {}     :  s := Sprintf3 (Mark (InitString (a)), w1, w2, w3) |
+   {1}    :  s := Sprintf3 (Mark (InitString (a)), s1, w2, w3) |
+   {2}    :  s := Sprintf3 (Mark (InitString (a)), w1, s2, w3) |
+   {1,2}  :  s := Sprintf3 (Mark (InitString (a)), s1, s2, w3) |
+   {3}    :  s := Sprintf3 (Mark (InitString (a)), w1, w2, s3) |
+   {1,3}  :  s := Sprintf3 (Mark (InitString (a)), s1, w2, s3) |
+   {2,3}  :  s := Sprintf3 (Mark (InitString (a)), w1, s2, s3) |
+   {1,2,3}:  s := Sprintf3 (Mark (InitString (a)), s1, s2, s3)
+
+   ELSE
+      HALT
+   END ;
+   IF KillString (WriteS (file, s)) = NIL
+   THEN
+   END
+END fprintf3 ;
+
+
+PROCEDURE fprintf4 (file: File; a: ARRAY OF CHAR;
+                    w1, w2, w3, w4: ARRAY OF BYTE) ;
+VAR
+   n                : Name ;
+   s, s1, s2, s3, s4: String ;
+   b                : BITSET ;
+BEGIN
+   b := {} ;
+   IF TranslateNameToCharStar (a, 1)
+   THEN
+      Cast (n, w1) ;
+      s1 := Mark (InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 1)
+   END ;
+   IF TranslateNameToCharStar (a, 2)
+   THEN
+      Cast (n, w2) ;
+      s2 := Mark (InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 2)
+   END ;
+   IF TranslateNameToCharStar (a, 3)
+   THEN
+      Cast (n, w3) ;
+      s3 := Mark (InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 3)
+   END ;
+   IF TranslateNameToCharStar (a, 4)
+   THEN
+      Cast (n, w4) ;
+      s4 := Mark (InitStringCharStar (KeyToCharStar (n))) ;
+      INCL (b, 4)
+   END ;
+   CASE b OF
+
+   {}       :  s := Sprintf4 (Mark (InitString (a)), w1, w2, w3, w4) |
+   {1}      :  s := Sprintf4 (Mark (InitString (a)), s1, w2, w3, w4) |
+   {2}      :  s := Sprintf4 (Mark (InitString (a)), w1, s2, w3, w4) |
+   {1,2}    :  s := Sprintf4 (Mark (InitString (a)), s1, s2, w3, w4) |
+   {3}      :  s := Sprintf4 (Mark (InitString (a)), w1, w2, s3, w4) |
+   {1,3}    :  s := Sprintf4 (Mark (InitString (a)), s1, w2, s3, w4) |
+   {2,3}    :  s := Sprintf4 (Mark (InitString (a)), w1, s2, s3, w4) |
+   {1,2,3}  :  s := Sprintf4 (Mark (InitString (a)), s1, s2, s3, w4) |
+   {4}      :  s := Sprintf4 (Mark (InitString (a)), w1, w2, w3, s4) |
+   {1,4}    :  s := Sprintf4 (Mark (InitString (a)), s1, w2, w3, s4) |
+   {2,4}    :  s := Sprintf4 (Mark (InitString (a)), w1, s2, w3, s4) |
+   {1,2,4}  :  s := Sprintf4 (Mark (InitString (a)), s1, s2, w3, s4) |
+   {3,4}    :  s := Sprintf4 (Mark (InitString (a)), w1, w2, s3, s4) |
+   {1,3,4}  :  s := Sprintf4 (Mark (InitString (a)), s1, w2, s3, s4) |
+   {2,3,4}  :  s := Sprintf4 (Mark (InitString (a)), w1, s2, s3, s4) |
+   {1,2,3,4}:  s := Sprintf4 (Mark (InitString (a)), s1, s2, s3, s4)
+
+   ELSE
+      HALT
+   END ;
+   IF KillString (WriteS (file, s)) = NIL
+   THEN
+   END
+END fprintf4 ;
+
+
+(*
+   printf0 - writes out an array to, StdOut, after the escape
+             sequences have been translated.
+*)
+
+PROCEDURE printf0 (a: ARRAY OF CHAR) ;
+BEGIN
+   fprintf0 (StdOut, a)
+END printf0 ;
+
+
+PROCEDURE printf1 (a: ARRAY OF CHAR;
+                   w: ARRAY OF BYTE) ;
+BEGIN
+   fprintf1 (StdOut, a, w)
+END printf1 ;
+
+
+PROCEDURE printf2 (a: ARRAY OF CHAR;
+                   w1, w2: ARRAY OF BYTE) ;
+BEGIN
+   fprintf2 (StdOut, a, w1, w2)
+END printf2 ;
+
+
+PROCEDURE printf3 (a: ARRAY OF CHAR;
+                   w1, w2, w3: ARRAY OF BYTE) ;
+BEGIN
+   fprintf3 (StdOut, a, w1, w2, w3)
+END printf3 ;
+
+
+PROCEDURE printf4 (a: ARRAY OF CHAR;
+                   w1, w2, w3, w4: ARRAY OF BYTE) ;
+BEGIN
+   fprintf4 (StdOut, a, w1, w2, w3, w4)
+END printf4 ;
+
+
+END M2Printf.
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
new file mode 100644
index 00000000000..bc84c24e758
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -0,0 +1,2713 @@
+(* M2Quads.def generates quadruples.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Quads ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Quads
+   Date       : 3/6/87
+   Description:  generates quadruples.
+*)
+
+FROM SYSTEM IMPORT WORD ;
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
+                 BuildModuleStart, BuildScaffold,
+                 StartBuildInit, EndBuildInit,
+                 StartBuildFinally, EndBuildFinally,
+                 BuildExceptInitial, BuildExceptFinally,
+                 BuildExceptProcedure,
+                 BuildRetry,
+                 BuildReThrow,
+                 BuildBuiltinConst, BuildBuiltinTypeInfo,
+                 BuildAssignment, BuildAssignConstant,
+                 BuildAlignment,
+                 BuildDefaultFieldAlignment, BuildPragmaField,
+                 BuildRepeat, BuildUntil,
+                 BuildWhile, BuildDoWhile, BuildEndWhile,
+                 BuildLoop, BuildExit, BuildEndLoop,
+                 BuildThenIf, BuildElse, BuildEndIf,
+                 BuildElsif1, BuildElsif2,
+                 BuildForToByDo, BuildPseudoBy, BuildEndFor,
+                 BuildCaseStartStatementSequence,
+                 BuildCaseEndStatementSequence,
+                 BuildCaseList,
+                 BuildCaseStart,
+                 BuildCaseOr,
+                 BuildCaseElse, BuildCaseEnd, BuildCaseCheck,
+                 BuildCaseRange, BuildCaseEquality,
+                 BuildNulParam, BuildProcedureCall,
+                 CheckBuildFunction,
+                 BuildFunctionCall, BuildConstFunctionCall,
+                 BuildProcedureStart, BuildProcedureEnd,
+                 BuildProcedureBegin,
+                 BuildReturn,
+                 BuildModulePriority,
+                 BuildBooleanVariable,
+                 BuildSizeCheckStart,
+                 StartBuildWith, EndBuildWith, CheckWithReference,
+                 BuildDesignatorRecord,
+                 BuildDesignatorArray,
+                 BuildDesignatorPointer,
+      	       	 BuildSetStart, BuildSetEnd,
+                 BuildEmptySet,
+                 BuildInclRange, BuildInclBit,
+                 BuildNulExpression,
+                 BuildNot,
+                 BuildRelOp,
+                 BuildBinaryOp,
+                 BuildUnaryOp,
+                 RecordOp,
+                 Top,
+                 PopTF, PushTF, PopT, PushT, PopNothing, PopN, PushTFA,
+                 PushTtok, PushTFtok, PopTFtok, PopTtok, PushTFAtok,
+                 PushTFn, PushTFntok, PopTFn,
+                 OperandT, OperandF, OperandA, OperandAnno, OperandTok,
+                 DisplayStack, WriteOperand, Annotate,
+
+                 BuildCodeOn, BuildCodeOff,
+                 BuildProfileOn, BuildProfileOff,
+                 BuildOptimizeOn, BuildOptimizeOff,
+                 BuildInline, BuildStmtNote, BuildLineNo, PushLineNo,
+                 BuildConstructor,
+                 BuildConstructorStart,
+                 BuildConstructorEnd,
+                 NextConstructorField, BuildTypeForConstructor,
+                 PopConstructor,
+                 BuildComponentValue,
+                 SilentBuildConstructor, SilentBuildConstructorStart,
+
+                 SetOptionOptimizing, SetOptionCoding, SetOptionProfiling,
+
+                 QuadOperator,
+                 Opposite,
+
+                 IsReferenced,
+                 IsBackReference,
+                 IsUnConditional,
+                 IsConditional, IsBackReferenceConditional,
+                 IsCall,
+                 IsReturn,
+                 IsProcedureScope,
+                 IsNewLocalVar,
+                 IsKillLocalVar,
+                 IsCatchBegin,
+                 IsCatchEnd,
+                 IsInitStart,
+                 IsInitEnd,
+                 IsFinallyStart,
+                 IsFinallyEnd,
+                 IsCodeOn,          (* Compiler flag testing routines *)
+                 IsProfileOn,
+                 IsOptimizeOn,
+                 IsPseudoQuad,
+                 IsDefOrModFile,
+                 IsInitialisingConst,
+
+                 DisplayQuadList, DisplayQuadRange, DisplayQuad,
+                 WriteOperator, BackPatchSubrangesAndOptParam,
+
+                 GetQuad, GetFirstQuad, GetNextQuad, PutQuad,
+                 SubQuad, EraseQuad, GetRealQuad,
+                 GetQuadtok, GetQuadOtok,
+                 GetQuadOp, GetM2OperatorDesc,
+                 CountQuads,
+                 GetLastFileQuad,
+                 GetLastQuadNo,
+                 QuadToLineNo, QuadToTokenNo,
+                 VariableAnalysis, LoopAnalysis, ForLoopAnalysis,
+                 AddVarientFieldToList, AddRecordToList,
+                 AddVarientToList,
+                 AddVarientRange, AddVarientEquality,
+                 BeginVarient, EndVarient, ElseVarient,
+                 BeginVarientList, EndVarientList,
+                 IsAutoPushOn, PushAutoOn, PushAutoOff, PopAuto,
+                 PushInConstExpression, PopInConstExpression,
+                 IsInConstExpression,
+                 MustCheckOverflow ;
+
+
+TYPE
+   QuadOperator = (BecomesOp, IndrXOp, XIndrOp, ArrayOp, ElementSizeOp,
+                   RecordFieldOp,
+                   AddrOp, SizeOp,
+                   IfEquOp, IfLessEquOp, IfGreEquOp, IfGreOp, IfLessOp,
+                   IfNotEquOp, IfInOp, IfNotInOp,
+                   CallOp, ParamOp, OptParamOp, ReturnOp, ReturnValueOp, FunctValueOp,
+                   NewLocalVarOp, KillLocalVarOp,
+                   ProcedureScopeOp, ModuleScopeOp,
+                   DummyOp,
+                   GotoOp, InitEndOp, InitStartOp,
+                   FinallyStartOp, FinallyEndOp,
+                   RetryOp, TryOp, CatchBeginOp, CatchEndOp, ThrowOp,
+                   NegateOp, AddOp, SubOp, MultOp,
+		   DivM2Op, ModM2Op,
+                   DivCeilOp, ModCeilOp,
+                   DivFloorOp, ModFloorOp, DivTruncOp, ModTruncOp,
+      	       	   LogicalOrOp, LogicalAndOp, LogicalXorOp, LogicalDiffOp,
+                   InclOp, ExclOp, LogicalShiftOp, LogicalRotateOp,
+                   UnboundedOp, HighOp,
+                   CoerceOp, ConvertOp, CastOp,
+                   InitAddressOp,
+                   StartDefFileOp, StartModFileOp, EndFileOp,
+                   CodeOnOp, CodeOffOp,
+                   ProfileOnOp, ProfileOffOp,
+                   OptimizeOnOp, OptimizeOffOp,
+                   InlineOp, LineNumberOp, StatementNoteOp,
+                   SubrangeLowOp, SubrangeHighOp,
+                   BuiltinConstOp, BuiltinTypeInfoOp, StandardFunctionOp,
+                   SavePriorityOp, RestorePriorityOp,
+                   SaveExceptionOp, RestoreExceptionOp,
+                   RangeCheckOp, ErrorOp) ;
+
+
+(*
+   SetOptionCoding - builds a code quadruple if the profiling
+                     option was given to the compiler.
+*)
+
+PROCEDURE SetOptionCoding (b: BOOLEAN) ;
+
+
+(*
+   SetOptionProfiling - builds a profile quadruple if the profiling
+                        option was given to the compiler.
+*)
+
+PROCEDURE SetOptionProfiling (b: BOOLEAN) ;
+
+
+(*
+   SetOptionOptimizing - builds a code quadruple if the profiling
+                         option was given to the compiler.
+*)
+
+PROCEDURE SetOptionOptimizing (b: BOOLEAN) ;
+
+
+(*
+   Opposite - returns the opposite comparison operator.
+*)
+
+PROCEDURE Opposite (Operator: QuadOperator) : QuadOperator ;
+
+
+(*
+   IsReferenced - returns true if QuadNo is referenced by another quadruple.
+*)
+
+PROCEDURE IsReferenced (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsBackReference - returns TRUE if quadruple, q, is referenced from a quad further on.
+*)
+
+PROCEDURE IsBackReference (q: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsUnConditional - returns true if QuadNo is an unconditional jump.
+*)
+
+PROCEDURE IsUnConditional (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConditional - returns true if QuadNo is a conditional jump.
+*)
+
+PROCEDURE IsConditional (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsBackReferenceConditional - returns TRUE if quadruple, q, is referenced from
+                                a conditional quad further on.
+*)
+
+PROCEDURE IsBackReferenceConditional (q: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsCall - returns true if QuadNo is a call operation.
+*)
+
+PROCEDURE IsCall (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsReturn - returns true if QuadNo is a return operation.
+*)
+
+PROCEDURE IsReturn (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsProcedureScope - returns true if QuadNo is a ProcedureScope operation.
+*)
+
+PROCEDURE IsProcedureScope (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsNewLocalVar - returns true if QuadNo is a NewLocalVar operation.
+*)
+
+PROCEDURE IsNewLocalVar (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsKillLocalVar - returns true if QuadNo is a KillLocalVar operation.
+*)
+
+PROCEDURE IsKillLocalVar (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsCatchBegin - returns true if QuadNo is a catch begin quad.
+*)
+
+PROCEDURE IsCatchBegin (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsCatchEnd - returns true if QuadNo is a catch end quad.
+*)
+
+PROCEDURE IsCatchEnd (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsInitStart - returns true if QuadNo is a init start quad.
+*)
+
+PROCEDURE IsInitStart (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsInitEnd - returns true if QuadNo is a init end quad.
+*)
+
+PROCEDURE IsInitEnd (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsFinallyStart - returns true if QuadNo is a finally start quad.
+*)
+
+PROCEDURE IsFinallyStart (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsFinallyEnd - returns true if QuadNo is a finally end quad.
+*)
+
+PROCEDURE IsFinallyEnd (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsInitialisingConst - returns TRUE if the quadruple is setting
+                         a const (op1) with a value.
+*)
+
+PROCEDURE IsInitialisingConst (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsOptimizeOn - returns true if the Optimize flag was true at QuadNo.
+*)
+
+PROCEDURE IsOptimizeOn (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsProfileOn - returns true if the Profile flag was true at QuadNo.
+*)
+
+PROCEDURE IsProfileOn (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsCodeOn - returns true if the Code flag was true at QuadNo.
+*)
+
+PROCEDURE IsCodeOn (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsPseudoQuad - returns true if QuadNo is a compiler directive.
+                  ie code, profile and optimize.
+*)
+
+PROCEDURE IsPseudoQuad (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsDefOrModFile - returns TRUE if QuadNo is a start of Module or Def file
+                    directive.
+*)
+
+PROCEDURE IsDefOrModFile (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   DisplayQuadList - displays all quads.
+*)
+
+PROCEDURE DisplayQuadList ;
+
+
+(*
+   DisplayQuadRange - displays all quads in list range, start..end.
+*)
+
+PROCEDURE DisplayQuadRange (start, end: CARDINAL) ;
+
+
+(*
+   DisplayQuad - displays a quadruple, QuadNo.
+*)
+
+PROCEDURE DisplayQuad (QuadNo: CARDINAL) ;
+
+
+(*
+   GetLastFileQuad - returns the Quadruple number of the last StartDefFile or
+                     StartModFile quadruple.
+*)
+
+PROCEDURE GetLastFileQuad (QuadNo: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetLastQuadNo - returns the last quadruple number referenced
+                   by a GetQuad.
+*)
+
+PROCEDURE GetLastQuadNo () : CARDINAL ;
+
+
+(*
+   QuadToTokenNo - Converts a QuadNo into the approprate token number of the
+                   source file, the line number is returned.
+
+                   This may be used to yield an idea where abouts in the
+                   source file the code generetion is
+                   processing.
+*)
+
+PROCEDURE QuadToTokenNo (QuadNo: CARDINAL) : CARDINAL ;
+
+
+(*
+   QuadToLineNo - Converts a QuadNo into the approprate line number of the
+                  source file, the line number is returned.
+
+                  This may be used to yield an idea where abouts in the
+                  source file the code generetion is
+                  processing.
+*)
+
+PROCEDURE QuadToLineNo (QuadNo: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetQuad - returns the Quadruple QuadNo.
+*)
+
+PROCEDURE GetQuad (QuadNo: CARDINAL;
+                   VAR Op: QuadOperator;
+                   VAR Oper1, Oper2, Oper3: CARDINAL) ;
+
+
+(*
+   GetQuadOp - returns the operator for quad.
+*)
+
+PROCEDURE GetQuadOp (quad: CARDINAL) : QuadOperator ;
+
+
+(*
+   GetM2OperatorDesc - returns the Modula-2 string associated with the quad operator
+                       (if possible).  It returns NIL if no there is not an obvious match
+                       in Modula-2.  It is assummed that the string will be used during
+                       construction of error messages and therefore keywords are
+                       wrapped with a format specifier.
+*)
+
+PROCEDURE GetM2OperatorDesc (op: QuadOperator) : String ;
+
+
+(*
+   GetQuadtok - returns the Quadruple QuadNo.
+*)
+
+PROCEDURE GetQuadtok (QuadNo: CARDINAL;
+                      VAR Op: QuadOperator;
+                      VAR Oper1, Oper2, Oper3: CARDINAL;
+                      VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+
+
+(*
+   GetQuadOtok - returns the Quadruple QuadNo.
+*)
+
+PROCEDURE GetQuadOtok (QuadNo: CARDINAL;
+                       VAR tok: CARDINAL;
+                       VAR Op: QuadOperator;
+                       VAR Oper1, Oper2, Oper3: CARDINAL;
+                       VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+
+
+(*
+   PutQuad - overwrites a quadruple QuadNo with Op, Oper1, Oper2, Oper3
+*)
+
+PROCEDURE PutQuad (QuadNo: CARDINAL;
+                   Op: QuadOperator;
+                   Oper1, Oper2, Oper3: CARDINAL) ;
+
+(*
+   GetFirstQuad - returns the first quadruple.
+*)
+
+PROCEDURE GetFirstQuad () : CARDINAL ;
+
+
+(*
+   GetNextQuad - returns the Quadruple number following QuadNo.
+*)
+
+PROCEDURE GetNextQuad (QuadNo: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetRealQuad - returns the Quadruple number of the real quadruple
+                 at QuadNo or beyond.
+*)
+
+PROCEDURE GetRealQuad (QuadNo: CARDINAL) : CARDINAL ;
+
+
+(*
+   SubQuad - removes quadruple QuadNo.
+*)
+
+PROCEDURE SubQuad (QuadNo: CARDINAL) ;
+
+
+(*
+   EraseQuad - erases a quadruple QuadNo, the quaduple is still in the list
+               but wiped clean.
+*)
+
+PROCEDURE EraseQuad (QuadNo: CARDINAL) ;
+
+
+(*
+   CountQuads - returns the number of quadruples.
+*)
+
+PROCEDURE CountQuads () : CARDINAL ;
+
+
+(*
+   BuildScaffold - generate the main, init, finish functions if
+                   no -c and this is the application module.
+*)
+
+PROCEDURE BuildScaffold (tok: CARDINAL; moduleSym: CARDINAL) ;
+
+
+(*
+   StartBuildDefFile - generates a StartFileOp quadruple indicating the file
+                       that has produced the subsequent quadruples.
+                       The code generator uses the StartDefFileOp quadruples
+                       to relate any error to the appropriate file.
+
+
+                       Entry                   Exit
+                       =====                   ====
+
+
+                Ptr ->                                        <- Ptr
+                       +------------+          +------------+
+                       | ModuleName |          | ModuleName |
+                       |------------|          |------------|
+
+
+                       Quadruples Produced
+
+                       q     StartDefFileOp  _  _  ModuleSym
+*)
+
+PROCEDURE StartBuildDefFile (tok: CARDINAL) ;
+
+
+(*
+   StartBuildModFile - generates a StartModFileOp quadruple indicating the file
+                       that has produced the subsequent quadruples.
+                       The code generator uses the StartModFileOp quadruples
+                       to relate any error to the appropriate file.
+
+
+                       Entry                   Exit
+                       =====                   ====
+
+
+                Ptr ->                                        <- Ptr
+                       +------------+          +------------+
+                       | ModuleName |          | ModuleName |
+                       |------------|          |------------|
+
+
+                       Quadruples Produced
+
+                       q     StartModFileOp  _  _  ModuleSym
+*)
+
+PROCEDURE StartBuildModFile (tok: CARDINAL) ;
+
+
+(*
+   EndBuildFile - generates an EndFileOp quadruple indicating the file
+                  that has produced the previous quadruples has ended.
+
+                  Entry                   Exit
+                  =====                   ====
+
+
+           Ptr ->                                        <- Ptr
+                  +------------+          +------------+
+                  | ModuleName |          | ModuleName |
+                  |------------|          |------------|
+
+
+                  Quadruples Produced
+
+                  q     EndFileOp  _  _  ModuleSym
+*)
+
+PROCEDURE EndBuildFile (tok: CARDINAL) ;
+
+
+(*
+   StartBuildInit - Builds the start initialisation code of a module.
+*)
+
+PROCEDURE StartBuildInit (tok: CARDINAL) ;
+
+
+(*
+   EndBuildInit - Builds the end initialisation code of a module.
+*)
+
+PROCEDURE EndBuildInit (tok: CARDINAL) ;
+
+
+(*
+   StartBuildFinally - Builds the start finalisation code of a module.
+*)
+
+PROCEDURE StartBuildFinally (tok: CARDINAL) ;
+
+
+(*
+   EndBuildFinally - Builds the end finalisation code of a module.
+*)
+
+PROCEDURE EndBuildFinally (tok: CARDINAL) ;
+
+
+(*
+   BuildExceptInitial - adds an ExceptOp quadruple in a modules
+                        initial block.
+*)
+
+PROCEDURE BuildExceptInitial (tok: CARDINAL) ;
+
+
+(*
+   BuildExceptFinally - adds an ExceptOp quadruple in a modules
+                        finally block.
+*)
+
+PROCEDURE BuildExceptFinally (tok: CARDINAL) ;
+
+
+(*
+   BuildExceptProcedure - adds an ExceptOp quadruple in a procedure
+                          block.
+*)
+
+PROCEDURE BuildExceptProcedure (tok: CARDINAL) ;
+
+
+(*
+   BuildRetry - adds an RetryOp quadruple.
+*)
+
+PROCEDURE BuildRetry (tok: CARDINAL) ;
+
+
+(*
+   BuildReThrow - creates a ThrowOp _ _ NulSym, indicating that
+                  the exception needs to be rethrown.  The stack
+                  is unaltered.
+*)
+
+PROCEDURE BuildReThrow (tokenno: CARDINAL) ;
+
+
+(*
+   StartBuildInnerInit - Sets the start of initialization code of the
+                         inner module to the next quadruple.
+*)
+
+PROCEDURE StartBuildInnerInit (tok: CARDINAL) ;
+
+
+(*
+   EndBuildInnerInit - Sets the end initialization code of a module.
+*)
+
+PROCEDURE EndBuildInnerInit (tok: CARDINAL) ;
+
+
+(*
+   BuildBuiltinConst - makes reference to a builtin constant within gm2.
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +------------+
+                              | Ident      |        | Sym        |
+                              |------------|        |------------|
+
+                       Quadruple produced:
+
+                       q    Sym  BuiltinConstOp  Ident
+*)
+
+PROCEDURE BuildBuiltinConst ;
+
+
+(*
+   BuildBuiltinTypeInfo - make reference to a builtin typeinfo function
+                          within gm2.
+
+                                 Entry                 Exit
+
+                          Ptr ->
+                                 +-------------+
+                                 | IdentType   |
+                                 |-------------|       +------------+
+                                 | ConstString |       | Sym        |
+                                 |-------------|       |------------|
+
+                          Quadruple produced:
+
+                          q    Sym  BuiltinTypeInfoOp  Ident ConstString
+*)
+
+PROCEDURE BuildBuiltinTypeInfo ;
+
+
+(*
+   BuildAssignment - Builds an assignment from the values given on the
+                     quad stack. Either an assignment to an
+                     arithmetic expression or an assignment to a
+                     boolean expression.  This procedure should not
+                     be called in CONST declarations.
+                     The Stack is expected to contain:
+
+
+       Either
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | Expression |
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  Expression
+
+       OR
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | True |False|
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  TRUE
+                     q+1   GotoOp                    q+3
+                     q+2   BecomesOp  Designator  _  FALSE
+
+*)
+
+PROCEDURE BuildAssignment (becomesTokNo: CARDINAL) ;
+
+
+(*
+   BuildAssignConstant - used to create constant in the CONST declaration.
+                         The stack is expected to contain:
+
+       Either
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | Expression |
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  Expression
+
+       OR
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | True |False|
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  TRUE
+                     q+1   GotoOp                    q+3
+                     q+2   BecomesOp  Designator  _  FALSE
+*)
+
+PROCEDURE BuildAssignConstant (equalsTokNo: CARDINAL) ;
+
+
+(*
+   BuildAlignment - builds an assignment to an alignment constant.
+
+                    The Stack is expected to contain:
+
+
+                            Entry                   Exit
+                            =====                   ====
+
+                    Ptr ->
+                            +---------------+
+                            | Expression    |
+                            |---------------|
+                            | bytealignment |
+                            |---------------|       empty
+*)
+
+PROCEDURE BuildAlignment ;
+
+
+(*
+   BuildBitLength - builds an assignment to a bit length constant.
+
+                    The Stack is expected to contain:
+
+
+                           Entry                   Exit
+                           =====                   ====
+
+                    Ptr ->
+                           +------------+
+                           | Expression |
+                           |------------|          empty
+*)
+
+PROCEDURE BuildBitLength ;
+
+
+(*
+   BuildPragmaField - builds an assignment to a pragma constant.
+
+                      The Stack is expected to contain:
+
+
+                                 Entry                   Exit
+                                 =====                   ====
+
+                         Ptr ->
+                                +------------+
+                                | Expression |
+                                |------------|          empty
+*)
+
+PROCEDURE BuildPragmaField ;
+
+
+(*
+   BuildDefaultFieldAlignment - builds an assignment to an alignment constant.
+
+                                The Stack is expected to contain:
+
+
+                                       Entry                   Exit
+                                       =====                   ====
+
+                                Ptr ->
+                                       +------------+
+                                       | Expression |
+                                       |------------|          empty
+*)
+
+PROCEDURE BuildDefaultFieldAlignment ;
+
+
+(*
+   BuildRepeat - Builds the repeat statement from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+
+                 Empty
+                                                        <- Ptr
+                                         +------------+
+                                         | RepeatQuad |
+                                         |------------|
+
+*)
+
+PROCEDURE BuildRepeat ;
+
+
+(*
+   BuildUntil - Builds the until part of the repeat statement
+                from the quad stack.
+                The Stack is expected to contain:
+
+
+                Entry                   Exit
+                =====                   ====
+
+        Ptr ->
+                +------------+
+                | t   | f    |
+                |------------|
+                | RepeatQuad |          Empty
+                |------------|
+*)
+
+PROCEDURE BuildUntil ;
+
+
+(*
+   BuildWhile - Builds the While part of the While statement
+                from the quad stack.
+                The Stack is expected to contain:
+
+
+                Entry                   Exit
+                =====                   ====
+
+                                                       <- Ptr
+                                        |------------|
+                Empty                   | WhileQuad  |
+                                        |------------|
+*)
+
+PROCEDURE BuildWhile ;
+
+
+(*
+   BuildDoWhile - Builds the Do part of the while statement
+                  from the quad stack.
+                  The Stack is expected to contain:
+
+
+                  Entry                   Exit
+                  =====                   ====
+
+          Ptr ->
+                  +------------+          +------------+
+                  | t   | f    |          | 0    | f   |
+                  |------------|          |------------|
+                  | WhileQuad  |          | WhileQuad  |
+                  |------------|          |------------|
+
+                  Quadruples
+
+                  BackPatch t exit to the NextQuad
+*)
+
+PROCEDURE BuildDoWhile ;
+
+
+(*
+   BuildEndWhile - Builds the end part of the while statement
+                   from the quad stack.
+                   The Stack is expected to contain:
+
+
+                   Entry                   Exit
+                   =====                   ====
+
+           Ptr ->
+                   +------------+
+                   | t   | f    |
+                   |------------|
+                   | WhileQuad  |          Empty
+                   |------------|
+
+                   Quadruples
+
+                   q    GotoOp  WhileQuad
+                   False exit is backpatched with q+1
+*)
+
+PROCEDURE BuildEndWhile ;
+
+
+(*
+   BuildLoop - Builds the Loop part of the Loop statement
+               from the quad stack.
+               The Stack is expected to contain:
+
+
+               Entry                   Exit
+               =====                   ====
+
+                                                      <- Ptr
+               Empty                   +------------+
+                                       | LoopQuad   |
+                                       |------------|
+*)
+
+PROCEDURE BuildLoop ;
+
+
+(*
+   BuildExit - Builds the Exit part of the Loop statement.
+*)
+
+PROCEDURE BuildExit ;
+
+
+(*
+   BuildEndLoop - Builds the End part of the Loop statement
+                  from the quad stack.
+                  The Stack is expected to contain:
+
+
+                  Entry                   Exit
+                  =====                   ====
+
+          Ptr ->
+                  +------------+
+                  | LoopQuad   |          Empty
+                  |------------|
+
+                  Quadruples
+
+                  Goto  _  _  LoopQuad
+*)
+
+PROCEDURE BuildEndLoop ;
+
+
+(*
+   BuildThenIf - Builds the Then part of the If statement
+                 from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+         Ptr ->                                          <- Ptr
+                 +------------+          +------------+
+                 | t   | f    |          | 0    | f   |
+                 |------------|          |------------|
+
+                 Quadruples
+
+                 The true exit is BackPatched to point to
+                 the NextQuad.
+*)
+
+PROCEDURE BuildThenIf ;
+
+
+(*
+   BuildElse - Builds the Else part of the If statement
+               from the quad stack.
+               The Stack is expected to contain:
+
+
+               Entry                   Exit
+               =====                   ====
+
+       Ptr ->
+               +------------+          +------------+
+               | t   | f    |          | t+q  | 0   |
+               |------------|          |------------|
+
+               Quadruples
+
+               q    GotoOp  _  _  0
+               q+1  <- BackPatched from f
+*)
+
+PROCEDURE BuildElse ;
+
+
+(*
+   BuildEndIf - Builds the End part of the If statement
+                from the quad stack.
+                The Stack is expected to contain:
+
+
+                Entry                   Exit
+                =====                   ====
+
+        Ptr ->
+                +------------+
+                | t   | f    |          Empty
+                |------------|
+
+                Quadruples
+
+                Both t and f are backpatched to point to the NextQuad
+*)
+
+PROCEDURE BuildEndIf ;
+
+
+(*
+   BuildElsif1 - Builds the Elsif part of the If statement
+                 from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+         Ptr ->
+                 +------------+          +------------+
+                 | t   | f    |          | t+q  | 0   |
+                 |------------|          |------------|
+
+                 Quadruples
+
+                 q    GotoOp  _  _  0
+                 q+1  <- BackPatched from f
+*)
+
+PROCEDURE BuildElsif1 ;
+
+
+(*
+   BuildElsif2 - Builds the Elsif until part of the If statement
+                 from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+          Ptr ->
+                 +--------------+
+                 | 0    | f1    |                            <- Ptr
+                 |--------------|          +---------------+
+                 | t2   | f2    |          | t2    | f1+f2 |
+                 |--------------|          |---------------|
+*)
+
+PROCEDURE BuildElsif2 ;
+
+
+(*
+   BuildForToByDo - Builds the For To By Do part of the For statement
+                    from the quad stack.
+                    The Stack is expected to contain:
+
+
+                    Entry                   Exit
+                    =====                   ====
+
+
+             Ptr ->                                        <- Ptr
+                    +------------+          +------------+
+                    | BySym      |          | t   | f    |
+                    |------------|          |------------|
+                    | e2         |          | ForQuad    |
+                    |------------|          |------------|
+                    | e1         |          | BySym      |
+                    |------------|          |------------|
+                    | Ident      |          | IdentSym   |
+                    |------------|          |------------|
+
+                    Quadruple
+
+                    q   BecomesOp  IdentSym  _  e1
+                    q+1 if <       by        0  q+5
+      	       	    q+2 GotoOp                  q+3
+                    q+3 If >       IdentSym  e2 _
+      	       	    q+4 GotoOp                  q+7
+                    q+5 If <=      IdentSym  e2 _
+      	       	    q+6 GotoOp                  q+7
+
+
+                    The For Loop is regarded:
+
+                    For ident := e1 To e2 By by Do
+
+                    End
+*)
+
+PROCEDURE BuildForToByDo ;
+
+
+(*
+   BuildPseudoBy - Builds the Non existant part of the By
+                   clause of the For statement
+                   from the quad stack.
+                   The Stack is expected to contain:
+
+
+                   Entry                   Exit
+                   =====                   ====
+
+                                                           <- Ptr
+                                           +------------+
+                   Empty                   | BySym      |
+                                           |------------|
+*)
+
+PROCEDURE BuildPseudoBy ;
+
+
+(*
+   BuildEndFor - Builds the End part of the For statement
+                 from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+         Ptr ->
+                 +------------+
+                 | t   | f    |
+                 |------------|
+                 | ForQuad    |
+                 |------------|
+                 | BySym      |
+                 |------------|
+                 | IdSym      |          Empty
+                 |------------|
+*)
+
+PROCEDURE BuildEndFor (endpostok: CARDINAL) ;
+
+
+(*
+   BuildCaseStart - starts the case statement.
+                    It initializes a backpatch list on the compile
+                    time stack, the list is used to contain all
+                    case break points. The list is later backpatched
+                    and contains all positions of the case statement
+                    which jump to the end of the case statement.
+                    The stack also contains room for a boolean
+                    expression, this is needed to allow , operator
+                    in the CaseField alternatives.
+
+                    The Stack is expected to contain:
+
+
+                    Entry                   Exit
+                    =====                   ====
+
+                                                           <- Ptr
+                                            +------------+
+                    Empty                   | 0    | 0   |
+                                            |------------|
+                                            | 0    | 0   |
+                                            |------------|
+*)
+
+PROCEDURE BuildCaseStart ;
+
+
+(*
+   BuildCaseStartStatementSequence - starts the statement sequence
+                                     inside a case clause.
+                                     BackPatches the true exit to the
+                                     NextQuad.
+                                     The Stack:
+
+                                     Entry             Exit
+
+                              Ptr ->                                  <- Ptr
+                                     +-----------+     +------------+
+                                     | t   | f   |     | 0   | f    |
+                                     |-----------|     |------------|
+*)
+
+PROCEDURE BuildCaseStartStatementSequence ;
+
+
+(*
+   BuildCaseEndStatementSequence - ends the statement sequence
+                                   inside a case clause.
+                                   BackPatches the false exit f1 to the
+                                   NextQuad.
+                                   Asserts that t1 and f2 is 0
+                                   Pushes t2+q and 0
+
+                                   Quadruples:
+
+                                   q  GotoOp  _  _  0
+
+                                   The Stack:
+
+                                   Entry             Exit
+
+                            Ptr ->                                  <- Ptr
+                                   +-----------+     +------------+
+                                   | t1  | f1  |     | 0    | 0   |
+                                   |-----------|     |------------|
+                                   | t2  | f2  |     | t2+q | 0   |
+                                   |-----------|     |------------|
+*)
+
+PROCEDURE BuildCaseEndStatementSequence ;
+
+
+(*
+   BuildCaseRange - builds the range testing quaruples for
+                    a case clause.
+
+                    IF (e1>=ce1) AND (e1<=ce2)
+                    THEN
+
+                    ELS..
+
+                    The Stack:
+
+                    Entry             Exit
+
+             Ptr ->
+                    +-----------+
+                    | ce2       |                   <- Ptr
+                    |-----------|     +-----------+
+                    | ce1       |     | t   | f   |
+                    |-----------|     |-----------|
+                    | t1  | f1  |     | t1  | f1  |
+                    |-----------|     |-----------|
+                    | t2  | f2  |     | t2  | f2  |
+                    |-----------|     |-----------|
+                    | e1        |     | e1        |
+                    |-----------|     |-----------|
+*)
+
+PROCEDURE BuildCaseRange ;
+
+
+(*
+   BuildCaseEquality - builds the range testing quadruples for
+                       a case clause.
+
+                       IF e1=ce1
+                       THEN
+
+                       ELS..
+
+                       The Stack:
+
+                       Entry             Exit
+
+                Ptr ->
+                       +-----------+     +-----------+
+                       | ce1       |     | t   | f   |
+                       |-----------|     |-----------|
+                       | t1  | f1  |     | t1  | f1  |
+                       |-----------|     |-----------|
+                       | t2  | f2  |     | t2  | f2  |
+                       |-----------|     |-----------|
+                       | e1        |     | e1        |
+                       |-----------|     |-----------|
+*)
+
+PROCEDURE BuildCaseEquality ;
+
+
+(*
+   BuildCaseList - merges two case tests into one
+
+                   The Stack:
+
+                   Entry             Exit
+
+            Ptr ->
+                   +-----------+
+                   | t2  | f2  |
+                   |-----------|     +-------------+
+                   | t1  | f1  |     | t1+t2| f1+f2|
+                   |-----------|     |-------------|
+*)
+
+PROCEDURE BuildCaseList ;
+
+
+(*
+   BuildCaseOr - builds the , in the case clause.
+
+                 The Stack:
+
+                 Entry             Exit
+
+          Ptr ->                                  <- Ptr
+                 +-----------+     +------------+
+                 | t   | f   |     | t    | 0   |
+                 |-----------|     |------------|
+*)
+
+PROCEDURE BuildCaseOr ;
+
+
+(*
+   BuildCaseElse - builds the else of case clause.
+
+                  The Stack:
+
+                  Entry             Exit
+
+           Ptr ->                                  <- Ptr
+                  +-----------+     +------------+
+                  | t   | f   |     | t    | 0   |
+                  |-----------|     |------------|
+*)
+
+PROCEDURE BuildCaseElse ;
+
+
+(*
+   BuildCaseEnd - builds the end of case clause.
+
+                  The Stack:
+
+                  Entry             Exit
+
+           Ptr ->
+                  +-----------+
+                  | t1  | f1  |
+                  |-----------|
+                  | t2  | f2  |
+                  |-----------|
+                  | e1        |
+                  |-----------|     Empty
+*)
+
+PROCEDURE BuildCaseEnd ;
+
+
+(*
+   BuildCaseCheck - builds the case checking code to ensure that
+                    the program does not need an else clause at runtime.
+                    The stack is unaltered.
+*)
+
+PROCEDURE BuildCaseCheck ;
+
+
+(*
+   BuildNulParam - Builds a nul parameter on the stack.
+                   The Stack:
+
+                   Entry             Exit
+
+                                                    <- Ptr
+                   Empty             +------------+
+                                     | 0          |
+                                     |------------|
+*)
+
+PROCEDURE BuildNulParam ;
+
+
+(*
+   BuildProcedureCall - builds a procedure call.
+                        The Stack:
+
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        .                .
+                        .                .
+                        .                .
+                        |----------------|
+                        | Param #        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildProcedureCall (tokno: CARDINAL) ;
+
+
+(*
+   CheckBuildFunction - checks to see whether ProcSym is a function
+                        and if so it adds a TempSym value which will
+                        hold the return value once the function finishes.
+                        This procedure also generates an error message
+                        if the user is calling a function and ignoring
+                        the return result.  The additional TempSym
+                        is not created if ProcSym is a procedure
+                        and the stack is unaltered.
+
+                        The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+
+                                                  +----------------+
+                                                  | ProcSym | Type |
+                       +----------------+         |----------------|
+                       | ProcSym | Type |         | TempSym | Type |
+                       |----------------|         |----------------|
+*)
+
+PROCEDURE CheckBuildFunction () : BOOLEAN ;
+
+
+(*
+   BuildFunctionCall - builds a function call.
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |                        <- Ptr
+                       |----------------|         +------------+
+                       | ProcSym | Type |         | ReturnVar  |
+                       |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildFunctionCall ;
+
+
+(*
+   BuildConstFunctionCall - builds a function call and checks that this function can be
+                            called inside a ConstExpression.
+
+                            The Stack:
+
+
+                            Entry                      Exit
+
+                     Ptr ->
+                            +----------------+
+                            | NoOfParam      |
+                            |----------------|
+                            | Param 1        |
+                            |----------------|
+                            | Param 2        |
+                            |----------------|
+                            .                .
+                            .                .
+                            .                .
+                            |----------------|
+                            | Param #        |                        <- Ptr
+                            |----------------|         +------------+
+                            | ProcSym | Type |         | ReturnVar  |
+                            |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildConstFunctionCall ;
+
+
+(*
+   BuildBooleanVariable - tests to see whether top of stack is a boolean
+                          conditional and if so it converts it into a boolean
+                          variable.
+*)
+
+PROCEDURE BuildBooleanVariable ;
+
+
+(*
+   BuildModuleStart - starts current module scope.
+*)
+
+PROCEDURE BuildModuleStart (tok: CARDINAL) ;
+
+
+(*
+   BuildProcedureStart - Builds start of the procedure. Creates space for
+                         the local variables.
+                         The Stack is expected to contain:
+
+
+                         Entry                   Exit
+                         =====                   ====
+
+                 Ptr ->                                       <- Ptr
+                        +------------+          +-----------+
+                        | ProcSym    |          | ProcSym   |
+                        |------------|          |-----------|
+                        | Name       |          | Name      |
+                        |------------|          |-----------|
+
+
+                        Quadruples:
+
+                        q   NewLocalVarOp  _  _  ProcSym
+*)
+
+PROCEDURE BuildProcedureStart ;
+
+
+(*
+   BuildProcedureBegin - determines the start of the BEGIN END block of
+                         the procedure.
+                         The Stack is expected to contain:
+
+
+                         Entry                   Exit
+                         =====                   ====
+
+                 Ptr ->                                       <- Ptr
+                        +------------+          +-----------+
+                        | ProcSym    |          | ProcSym   |
+                        |------------|          |-----------|
+                        | Name       |          | Name      |
+                        |------------|          |-----------|
+
+
+                        Quadruples:
+
+                        q   BeginOp  _  _  ProcSym
+*)
+
+PROCEDURE BuildProcedureBegin ;
+
+
+(*
+   BuildProcedureEnd - Builds end of the procedure. Destroys space for
+                       the local variables.
+                       The Stack is expected to contain:
+
+
+                       Entry                   Exit
+                       =====                   ====
+
+                Ptr ->                                       <- Ptr
+                       +------------+          +-----------+
+                       | ProcSym    |          | ProcSym   |
+                       |------------|          |-----------|
+                       | Name       |          | Name      |
+                       |------------|          |-----------|
+
+
+                       Quadruples:
+
+                       q   KillLocalVarOp  _  _  ProcSym
+*)
+
+PROCEDURE BuildProcedureEnd ;
+
+
+(*
+   BuildReturn - Builds the Return part of the procedure.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+         Ptr ->
+                 +------------+
+                 | e1         |          Empty
+                 |------------|
+*)
+
+PROCEDURE BuildReturn (tokno: CARDINAL) ;
+
+
+(*
+   BuildModulePriority - assigns the current module with a priority
+                         from the top of stack.
+
+                         Entry                   Exit
+                         =====                   ====
+
+
+                  Ptr ->                         Empty
+                         +------------+
+                         | Priority   |
+                         |------------|
+*)
+
+PROCEDURE BuildModulePriority ;
+
+
+(*
+   StartBuildWith - performs the with statement.
+                    The Stack:
+
+                    Entry                    Exit
+
+                    +------------+
+                    | Sym | Type |           Empty
+                    |------------|
+*)
+
+PROCEDURE StartBuildWith (withTok: CARDINAL) ;
+
+
+(*
+   EndBuildWith - terminates the innermost with scope.
+*)
+
+PROCEDURE EndBuildWith ;
+
+
+(*
+   CheckWithReference - performs the with statement.
+                        The Stack:
+
+                        Entry                    Exit
+
+                        +------------+           +------------+
+                        | Sym | Type |           | Sym | Type |
+                        |------------|           |------------|
+*)
+
+PROCEDURE CheckWithReference ;
+
+
+(*
+   BuildDesignatorRecord - Builds the record referencing.
+                           The Stack is expected to contain:
+
+
+                           Entry                   Exit
+                           =====                   ====
+
+                   Ptr ->
+                           +--------------+
+                           | n            |
+                           |--------------|
+                           | fld1 | type1 |
+                           |--------------|
+                           .              .
+                           .              .
+                           .              .
+                           |--------------|
+                           | fldn | typen |                        <- Ptr
+                           |--------------|        +-------------+
+                           | Sym  | Type  |        | S    | type1|
+                           |--------------|        |-------------|
+*)
+
+PROCEDURE BuildDesignatorRecord (dottok: CARDINAL) ;
+
+
+(*
+   BuildDesignatorArray - Builds the array referencing.
+                          The Stack is expected to contain:
+
+
+                          Entry                   Exit
+                          =====                   ====
+
+                  Ptr ->
+                          +--------------+
+                          | n            |        Empty
+                          |--------------|
+                          | e1           |
+                          |--------------|
+                          .              .
+                          .              .
+                          .              .
+                          |--------------|
+                          | e2           |                      <- Ptr
+                          |--------------|       +------------+
+                          | Sym  | Type  |       | S    | T   |
+                          |--------------|       |------------|
+*)
+
+PROCEDURE BuildDesignatorArray ;
+
+
+(*
+   BuildDesignatorPointer - Builds the record referencing.
+                            The Stack is expected to contain:
+
+
+                            Entry                   Exit
+                            =====                   ====
+
+                    Ptr ->                                           <- Ptr
+                            +--------------+        +--------------+
+                            | Sym1  | Type1|        | Sym2  | Type2|
+                            |--------------|        |--------------|
+*)
+
+PROCEDURE BuildDesignatorPointer (ptrtok: CARDINAL) ;
+
+
+(*
+   BuildNulExpression - Builds a nul expression on the stack.
+                        The Stack:
+
+                        Entry             Exit
+
+                                                         <- Ptr
+                        Empty             +------------+
+                                          | NulSym     |
+                                          |------------|
+*)
+
+PROCEDURE BuildNulExpression ;
+
+
+(*
+   BuildSetStart - Pushes a Bitset type on the stack.
+
+                      The Stack:
+
+                      Entry             Exit
+
+               Ptr ->                                        <- Ptr
+
+                      Empty             +--------------+
+                                        | Bitset       |
+                                        |--------------|
+*)
+
+PROCEDURE BuildSetStart ;
+
+
+(*
+   BuildSetEnd - pops the set value and type from the stack
+                 and pushes the value,type pair.
+
+                        Entry                   Exit
+
+                 Ptr ->
+                        +--------------+
+                        | Set Value    |                         <- Ptr
+                        |--------------|        +--------------+
+                        | Set Type     |        | Value | Type |
+                        |--------------|        |--------------|
+*)
+
+PROCEDURE BuildSetEnd ;
+
+
+(*
+   BuildEmptySet - Builds an empty set on the stack.
+                   The Stack:
+
+                   Entry             Exit
+
+                                                     <- Ptr
+                                     +-------------+
+            Ptr ->                   | Value       |
+                   +-----------+     |-------------|
+      	       	   | SetType   |     | SetType     |
+                   |-----------|     |-------------|
+
+*)
+
+PROCEDURE BuildEmptySet ;
+
+
+(*
+   BuildInclRange - includes a set range with a set.
+
+
+                          Entry                   Exit
+                          =====                   ====
+
+
+                   Ptr ->
+                          +------------+
+                          | El2        |
+                          |------------|
+                          | El1        |                                 <- Ptr
+                          |------------|           +-------------------+
+                          | Set Value  |           | Value + {El1..El2}|
+                          |------------|           |-------------------|
+                          | Set Type   |           | Set Type          |
+                          |------------|           |-------------------|
+
+                   No quadruples produced as the range info is contained within
+                   the set value.
+*)
+
+PROCEDURE BuildInclRange ;
+
+
+(*
+   BuildInclBit - includes a bit into the set.
+
+                         Entry                   Exit
+                         =====                   ====
+
+
+                  Ptr ->
+                         +------------+
+                         | Element    |                         <- Ptr
+                         |------------|          +------------+
+                         | Value      |          | Value      |
+                         |------------|          |------------|
+                         | Type       |          | Type       |
+                         |------------|          |------------|
+
+                  No quadruples produced as this bit inclusion is contained within
+                  the set value.
+*)
+
+PROCEDURE BuildInclBit ;
+
+
+(*
+   SilentBuildConstructor - places NulSym into the constructor fifo queue.
+*)
+
+PROCEDURE SilentBuildConstructor ;
+
+
+(*
+   SilentBuildConstructorStart - removes an entry from the constructor fifo queue.
+*)
+
+PROCEDURE SilentBuildConstructorStart ;
+
+
+(*
+   BuildConstructor - builds a constructor.
+                      Stack
+
+                      Entry                 Exit
+
+               Ptr ->
+                      +------------+
+                      | Type       |                <- Ptr
+                      |------------+
+*)
+
+PROCEDURE BuildConstructor (tokcbrpos: CARDINAL) ;
+
+
+(*
+   BuildConstructorStart - builds a constructor.
+                           Stack
+
+                           Entry                 Exit
+
+                    Ptr ->                                      <- Ptr
+                           +------------+        +------------+
+                           | Name       |        | Sym        |
+                           |------------+        |------------|
+*)
+
+PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
+
+
+(*
+   BuildConstructorEnd - removes the current constructor frame from the
+                         constructor stack (it does not effect the quad
+                         stack)
+
+                         Stack
+
+                         Entry                 Exit
+
+                  Ptr ->                                      <- Ptr
+                         +------------+        +------------+
+                         | const      |        | const      |
+                         |------------+        |------------|
+*)
+
+PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
+
+
+(*
+   NextConstructorField - increments the top of constructor stacks
+                          index by one.
+*)
+
+PROCEDURE NextConstructorField ;
+
+
+(*
+   BuildTypeForConstructor - pushes the type implied by the current constructor.
+                             If no constructor is currently being built then
+                             it Pushes a Bitset type.
+*)
+
+PROCEDURE BuildTypeForConstructor ;
+
+
+(*
+   BuildComponentValue -  builds a component value.
+
+                          Entry                 Exit
+
+                   Ptr ->                                      <- Ptr
+
+
+                          +------------+        +------------+
+                          | const      |        | const      |
+                          |------------|        |------------|
+
+                          (this is incomplete (fixme))
+*)
+
+PROCEDURE BuildComponentValue ;
+
+
+(*
+   PopConstructor - removes the top constructor from the top of stack.
+*)
+
+PROCEDURE PopConstructor ;
+
+
+(*
+   BuildNot   - Builds a NOT operation from the quad stack.
+                The Stack is expected to contain:
+
+
+                  Entry                   Exit
+                  =====                   ====
+
+           Ptr ->                                        <- Ptr
+                  +------------+          +------------+
+                  | t    | f   |          | f    | t   |
+                  |------------|          |------------|
+*)
+
+PROCEDURE BuildNot ;
+
+
+(*
+   RecordOp - Records the operator passed on the stack.
+              Checks for AND operator or OR operator
+              if either of these operators are found then BackPatching
+              takes place.
+              The Expected Stack:
+
+              Entry                        Exit
+
+       Ptr ->                                               <- Ptr
+              +-------------+               +-------------+
+              | OperatorTok |               | OperatorTok |
+              |-------------|               |-------------|
+              | t    | f    |               | t    | f    |
+              |-------------|               |-------------|
+
+
+              If OperatorTok=AndTok
+              Then
+                 BackPatch(f, NextQuad)
+              Elsif OperatorTok=OrTok
+              Then
+                 BackPatch(t, NextQuad)
+              End
+*)
+
+PROCEDURE RecordOp ;
+
+
+(*
+   BuildRelOp   - Builds a relative operation from the quad stack.
+                  The Stack is expected to contain:
+
+
+                  Entry                   Exit
+                  =====                   ====
+
+           Ptr ->
+                  +------------+
+                  | e1         |
+                  |------------|                          <- Ptr
+                  | Operator   |
+                  |------------|          +------------+
+                  | e2         |          | t    | f   |
+                  |------------|          |------------|
+
+
+                    Quadruples Produced
+
+                    q     IFOperator  e1  e2  TrueExit
+                    q+1   GotoOp              FalseExit
+*)
+
+PROCEDURE BuildRelOp (optokpos: CARDINAL) ;
+
+
+(*
+   BuildBinaryOp   - Builds a binary operation from the quad stack.
+                     The Stack is expected to contain:
+
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | Sym1       |
+                     |------------|
+                     | Operator   |                          <- Ptr
+                     |------------|          +------------+
+                     | Sym2       |          | Temporary  |
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     Operator  Temporary  Sym1  Sym2
+
+*)
+
+PROCEDURE BuildBinaryOp ;
+
+
+(*
+   BuildUnaryOp   - Builds a unary operation from the quad stack.
+                    The Stack is expected to contain:
+
+
+                    Entry                   Exit
+                    =====                   ====
+
+             Ptr ->
+                    +------------+
+                    | Sym1       |
+                    |------------|          +------------+
+                    | Operator   |          | Temporary  |  <- Ptr
+                    |------------|          |------------|
+
+
+                    Quadruples Produced
+
+                    q     Operator  Temporary  _ Sym1
+
+*)
+
+PROCEDURE BuildUnaryOp ;
+
+
+(*
+   OperandT - returns the ident operand stored in the true position on the boolean stack.
+*)
+
+PROCEDURE OperandT (pos: CARDINAL) : WORD ;
+
+
+(*
+   OperandF - returns the ident operand stored in the false position on the boolean stack.
+*)
+
+PROCEDURE OperandF (pos: CARDINAL) : WORD ;
+
+
+(*
+   PushTF - Push a True and a False exit quad numbers onto the
+            True/False stack.
+*)
+
+PROCEDURE PushTF (True, False: WORD) ;
+
+
+(*
+   PopTF - Pops a True and a False exit quad numbers from the
+           True/False stack.
+*)
+
+PROCEDURE PopTF (VAR True, False: WORD) ;
+
+
+(*
+   PushT - Push a True exit quad numbers onto the
+           True/False stack. The False exit will be zero.
+*)
+
+PROCEDURE PushT (True: WORD) ;
+
+
+(*
+   PopT - Pop a True exit quad number from the True/False
+          stack. The False exit is ignored.
+*)
+
+PROCEDURE PopT (VAR True: WORD) ;
+
+
+(*
+   PushTtok - Push an item onto the stack in the T (true) position,
+              it is assummed to be a token and its token location is recorded.
+*)
+
+PROCEDURE PushTtok (True: WORD; tokno: CARDINAL) ;
+
+
+(*
+   PushTFtok - Push an item onto the stack in the T (true) position,
+               it is assummed to be a token and its token location is recorded.
+*)
+
+PROCEDURE PushTFtok (True, False: WORD; tokno: CARDINAL) ;
+
+
+(*
+   PopTFtok - Pop T/F/tok from the stack.
+*)
+
+PROCEDURE PopTFtok (VAR True, False: WORD; VAR tokno: CARDINAL) ;
+
+
+(*
+   PushTFAtok - Push T/F/A/tok to the stack.
+*)
+
+PROCEDURE PushTFAtok (True, False, Array: WORD; tokno: CARDINAL) ;
+
+
+(*
+   PopTtok - Pops the T value from the stack and token position.
+*)
+
+PROCEDURE PopTtok (VAR True: WORD; VAR tok: CARDINAL) ;
+
+
+(*
+   PushTFn - Push a True and False numbers onto the True/False stack.
+             True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFn (True, False, n: WORD) ;
+
+
+(*
+   PushTFntok - Push a True and False numbers onto the True/False stack.
+                True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFntok (True, False, n: WORD; tokno: CARDINAL) ;
+
+
+(*
+   PopTFn - Pop a True and False number from the True/False stack.
+            True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PopTFn (VAR True, False, n: WORD) ;
+
+
+(*
+   PopNothing - pops the top element on the stack.
+*)
+
+PROCEDURE PopNothing ;
+
+
+(*
+   PopN - pops multiple elements from the BoolStack.
+*)
+
+PROCEDURE PopN (n: CARDINAL) ;
+
+
+(*
+   PushTFA - Push True, False, Array, numbers onto the
+             True/False stack.  True and False are assumed to
+             contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFA (True, False, Array: WORD) ;
+
+
+(*
+   OperandTok - returns the token associated with pos, on the stack.
+*)
+
+PROCEDURE OperandTok (pos: CARDINAL) : WORD ;
+
+
+(*
+   OperandA - returns possible array symbol associated with the ident
+              operand stored on the boolean stack.
+*)
+
+PROCEDURE OperandA (pos: CARDINAL) : WORD ;
+
+
+(*
+   OperandAnno - returns the annotation string associated with the
+                 position, n, on the stack.
+*)
+
+PROCEDURE OperandAnno (n: CARDINAL) : String ;
+
+
+(*
+   Annotate - annotate the top of stack.
+*)
+
+PROCEDURE Annotate (a: ARRAY OF CHAR) ;
+
+
+(*
+   DisplayStack - displays the compile time symbol stack.
+*)
+
+PROCEDURE DisplayStack ;
+
+
+(*
+   Top - returns the no of items held in the stack.
+*)
+
+PROCEDURE Top () : CARDINAL ;
+
+
+(*
+   WriteOperand - displays the operands name, symbol id and mode of addressing.
+*)
+
+PROCEDURE WriteOperand (Sym: CARDINAL) ;
+
+
+(*
+   BeginVarient - begin a varient record.
+*)
+
+PROCEDURE BeginVarient ;
+
+
+(*
+   EndVarient - end a varient record.
+*)
+
+PROCEDURE EndVarient ;
+
+
+(*
+   ElseVarient - associate an ELSE clause with a varient record.
+*)
+
+PROCEDURE ElseVarient ;
+
+
+(*
+   BeginVarientList - begin an ident list containing ranges belonging to a
+                      varient list.
+*)
+
+PROCEDURE BeginVarientList ;
+
+
+(*
+   EndVarientList - end a range list for a varient field.
+*)
+
+PROCEDURE EndVarientList ;
+
+
+(*
+   AddRecordToList - adds the record held on the top of stack to the
+                     list of records and varient fields.
+*)
+
+PROCEDURE AddRecordToList ;
+
+
+(*
+   AddVarientToList - adds varient held on the top of stack to the list.
+*)
+
+PROCEDURE AddVarientToList ;
+
+
+(*
+   AddVarientFieldToList - adds varient field, f, to the list of all varient
+                           fields created.
+*)
+
+PROCEDURE AddVarientFieldToList (f: CARDINAL) ;
+
+
+(*
+   AddVarientRange - creates a range from the top two contant expressions
+                     on the stack which are recorded with the current
+                     varient field.  The stack is unaltered.
+*)
+
+PROCEDURE AddVarientRange ;
+
+
+(*
+   AddVarientEquality - adds the contant expression on the top of the stack
+                        to the current varient field being recorded.
+                        The stack is unaltered.
+*)
+
+PROCEDURE AddVarientEquality ;
+
+
+(*
+   BuildCodeOn - generates a quadruple declaring that code should be
+                 emitted from henceforth.
+
+                 The Stack is unnaffected.
+*)
+
+PROCEDURE BuildCodeOn ;
+
+
+(*
+   BuildCodeOff - generates a quadruple declaring that code should not be
+                  emmitted from henceforth.
+
+                  The Stack is unnaffected.
+*)
+
+PROCEDURE BuildCodeOff ;
+
+
+(*
+   BuildProfileOn - generates a quadruple declaring that profile timings
+                    should be emmitted from henceforth.
+
+                    The Stack is unnaffected.
+*)
+
+PROCEDURE BuildProfileOn ;
+
+
+(*
+   BuildProfileOn - generates a quadruple declaring that profile timings
+                    should be emmitted from henceforth.
+
+                    The Stack is unnaffected.
+*)
+
+PROCEDURE BuildProfileOff ;
+
+
+(*
+   BuildOptimizeOn - generates a quadruple declaring that optimization
+                     should occur from henceforth.
+
+                     The Stack is unnaffected.
+*)
+
+PROCEDURE BuildOptimizeOn ;
+
+
+(*
+   BuildOptimizeOff - generates a quadruple declaring that optimization
+                      should not occur from henceforth.
+
+                      The Stack is unnaffected.
+*)
+
+PROCEDURE BuildOptimizeOff ;
+
+
+(*
+   BuildInline - builds an Inline pseudo quadruple operator.
+                 The inline interface, Sym, is stored as the operand
+                 to the operator InlineOp.
+
+                 The stack is expected to contain:
+
+
+                        Entry                   Exit
+                        =====                   ====
+
+                 Ptr ->
+                        +--------------+
+                        | Sym          |        Empty
+                        |--------------|
+*)
+
+PROCEDURE BuildInline ;
+
+
+(*
+   BuildLineNo - builds a LineNumberOp pseudo quadruple operator.
+                 This quadruple indicates which source line has been
+                 processed, these quadruples are only generated if we
+                 are producing runtime debugging information.
+
+                 The stack is not affected, read or altered in any way.
+
+
+                        Entry                   Exit
+                        =====                   ====
+
+                 Ptr ->                              <- Ptr
+*)
+
+PROCEDURE BuildLineNo ;
+
+
+(*
+   PushLineNo - pushes the current file and line number to the stack.
+*)
+
+PROCEDURE PushLineNo ;
+
+
+(*
+   BuildStmtNote - builds a StatementNoteOp pseudo quadruple operator.
+                   This quadruple indicates which source line has been
+                   processed and it represents the start of a statement
+                   sequence.
+                   It differs from LineNumberOp in that multiple successive
+                   LineNumberOps will be removed and the final one is attached to
+                   the next real GCC tree.  Whereas a StatementNoteOp is always left
+                   alone.  Depending upon the debugging level it will issue a nop
+                   instruction to ensure that the gdb single step will step into
+                   this line.  Practically it allows pedalogical debugging to
+                   occur when there is syntax sugar such as:
+
+
+                         END  (* step *)
+                      END  (* step *)
+                   END ; (* step *)
+		   a := 1 ; (* step *)
+
+                   REPEAT (* step *)
+		      i := 1  (* step *)
+
+                   The stack is not affected, read or altered in any way.
+
+
+                        Entry                   Exit
+                        =====                   ====
+
+                 Ptr ->                              <- Ptr
+*)
+
+PROCEDURE BuildStmtNote (offset: INTEGER) ;
+
+
+(*
+   VariableAnalysis - checks to see whether a variable is:
+
+                      read without being initialized or
+                      written over when it is a non var parameter
+*)
+
+PROCEDURE VariableAnalysis (Start, End: CARDINAL) ;
+
+
+(*
+   LoopAnalysis - checks whether an infinite loop exists.
+*)
+
+PROCEDURE LoopAnalysis (Current, End: CARDINAL) ;
+
+
+(*
+   ForLoopAnalysis - checks all the FOR loops for index variable manipulation
+                     and dangerous usage outside the loop.
+*)
+
+PROCEDURE ForLoopAnalysis ;
+
+
+(*
+   BuildSizeCheckStart - switches off all quadruple generation if the function SIZE
+                         is being "called". This should be done as SIZE only requires the
+                         actual type of the expression, not its value. Consider the problem of
+                         SIZE(UninitializedPointer^) quite legal and it must also be safe!
+
+
+                         The Stack is expected to contain:
+
+
+                         Entry                   Exit
+                         =====                   ====
+
+                 Ptr ->                                       <- Ptr
+                        +------------+          +-----------+
+                        | ProcSym    |          | ProcSym   |
+                        |------------|          |-----------|
+*)
+
+PROCEDURE BuildSizeCheckStart ;
+
+
+(*
+   BackPatchSubrangesAndOptParam - runs through all the quadruples and finds SubrangeLow or SubrangeHigh
+                                   quadruples and replaces it by an assignment to the Low or High component
+                                   of the subrange type.
+
+                                   Input:
+                                   SubrangeLow    op1     op3         (* op3 is a subrange *)
+
+                                   Output:
+                                   Becomes        op1     low
+
+                                   Input:
+                                   SubrangeHigh   op1     op3         (* op3 is a subrange *)
+
+                                   Output:
+                                   Becomes        op1     high
+
+                                   Input:
+                                   OptParam       op1     op2    op3
+
+                                   Output:
+                                   Param          op1     op2    GetOptArgInit(op3)
+*)
+
+PROCEDURE BackPatchSubrangesAndOptParam ;
+
+
+(*
+   WriteOperator - writes the name of the quadruple operator.
+*)
+
+PROCEDURE WriteOperator (Operator: QuadOperator) ;
+
+
+(*
+   PushAutoOn - push the auto flag and then set it to TRUE.
+                Any call to ident in the parser will result in the token being pushed.
+*)
+
+PROCEDURE PushAutoOn ;
+
+
+(*
+   PushAutoOff - push the auto flag and then set it to FALSE.
+*)
+
+PROCEDURE PushAutoOff ;
+
+
+(*
+   IsAutoPushOn - returns the value of the current Auto ident push flag.
+*)
+
+PROCEDURE IsAutoPushOn () : BOOLEAN ;
+
+
+(*
+   PopAuto - restores the previous value of the Auto flag.
+*)
+
+PROCEDURE PopAuto ;
+
+
+(*
+   MustCheckOverflow - returns TRUE if the quadruple should test for overflow.
+*)
+
+PROCEDURE MustCheckOverflow (q: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PushInConstExpression - push the InConstExpression flag and then set it to TRUE.
+*)
+
+PROCEDURE PushInConstExpression ;
+
+
+(*
+   PopInConstExpression - restores the previous value of the InConstExpression.
+*)
+
+PROCEDURE PopInConstExpression ;
+
+
+(*
+   IsInConstExpression - returns the value of the InConstExpression.
+*)
+
+PROCEDURE IsInConstExpression () : BOOLEAN ;
+
+
+END M2Quads.
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
new file mode 100644
index 00000000000..cbd4a975374
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -0,0 +1,15069 @@
+(* M2Quads.mod generates quadruples.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Quads ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2Debug IMPORT Assert, WriteDebug ;
+FROM NameKey IMPORT Name, NulName, MakeKey, GetKey, makekey, KeyToCharStar, WriteKey ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ;
+FROM M2DebugStack IMPORT DebugStack ;
+FROM M2Scaffold IMPORT DeclareScaffold, mainFunction, initFunction,
+                       finiFunction, linkFunction, PopulateCtorArray,
+                       ForeachModuleCallInit, ForeachModuleCallFinish ;
+
+FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaError3,
+                        MetaErrors1, MetaErrors2, MetaErrors3,
+                        MetaErrorT0, MetaErrorT1, MetaErrorT2,
+                        MetaErrorsT1, MetaErrorsT2,
+                        MetaErrorStringT0, MetaErrorStringT1,
+                        MetaErrorString1, MetaErrorString2,
+                        MetaErrorN1, MetaErrorN2,
+                        MetaErrorNT0, MetaErrorNT1, MetaErrorNT2 ;
+
+FROM DynamicStrings IMPORT String, string, InitString, KillString,
+                           ConCat, InitStringCharStar, Dup, Mark,
+                           PushAllocation, PopAllocationExemption,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
+                        MakeTemporary,
+                        MakeTemporaryFromExpression,
+                        MakeTemporaryFromExpressions,
+                        MakeConstLit, MakeConstLitString,
+                        MakeConstString, MakeConstant,
+                        Make2Tuple,
+                        RequestSym, MakePointer, PutPointer,
+                        SkipType,
+			GetDType, GetSType, GetLType,
+                        GetScope, GetCurrentScope,
+                        GetSubrange, SkipTypeAndSubrange,
+                        GetModule, GetMainModule,
+                        GetCurrentModule, GetFileModule, GetLocalSym,
+                        GetStringLength, GetString,
+                        GetArraySubscript, GetDimension,
+                        GetParam,
+                        GetNth, GetNthParam,
+                        GetFirstUsed, GetDeclaredMod,
+                        GetQuads, GetReadQuads, GetWriteQuads,
+                        GetWriteLimitQuads, GetReadLimitQuads,
+                        GetVarScope,
+                        GetModuleQuads, GetProcedureQuads,
+                        GetModuleCtors,
+                        MakeProcedure,
+                        MakeConstStringCnul, MakeConstStringM2nul,
+                        PutConstString,
+                        PutModuleStartQuad, PutModuleEndQuad,
+                        PutModuleFinallyStartQuad, PutModuleFinallyEndQuad,
+                        PutProcedureStartQuad, PutProcedureEndQuad,
+                        PutProcedureScopeQuad,
+                        PutVar, PutConstSet,
+                        GetVarPointerCheck, PutVarPointerCheck,
+                        PutVarWritten,
+                        PutReadQuad, RemoveReadQuad,
+                        PutWriteQuad, RemoveWriteQuad,
+                        PutPriority, GetPriority,
+                        PutProcedureBegin, PutProcedureEnd,
+                        PutVarConst, IsVarConst,
+                        IsVarParam, IsProcedure, IsPointer, IsParameter,
+                        IsUnboundedParam, IsEnumeration, IsDefinitionForC,
+                        IsVarAParam, IsVarient, IsLegal,
+                        UsesVarArgs, UsesOptArg,
+                        GetOptArgInit,
+                        IsReturnOptional,
+                        NoOfElements,
+                        NoOfParam,
+                        StartScope, EndScope,
+                        HasExceptionBlock, PutExceptionBlock,
+                        HasExceptionFinally, PutExceptionFinally,
+                        GetParent, GetRecord, IsRecordField, IsFieldVarient, IsRecord,
+                        IsFieldEnumeration,
+                        IsVar, IsProcType, IsType, IsSubrange, IsExported,
+                        IsConst, IsConstString, IsModule, IsDefImp,
+                        IsArray, IsUnbounded, IsProcedureNested,
+                        IsParameterUnbounded,
+                        IsPartialUnbounded, IsProcedureBuiltin,
+                        IsSet, IsConstSet, IsConstructor, PutConst,
+                        PutConstructor, PutConstructorFrom,
+                        PutDeclared,
+                        MakeComponentRecord, MakeComponentRef,
+                        IsSubscript,
+                        IsTemporary,
+                        IsAModula2Type,
+                        PutLeftValueFrontBackType,
+                        PushSize, PushValue, PopValue,
+                        GetVariableAtAddress, IsVariableAtAddress,
+                        MakeError, UnknownReported,
+                        IsError,
+                        IsInnerModule,
+                        IsImportStatement, IsImport, GetImportModule, GetImportDeclared,
+                        GetImportStatementList,
+                        GetModuleDefImportStatementList, GetModuleModImportStatementList,
+                        IsCtor, IsPublic, IsExtern, IsMonoName,
+
+                        GetUnboundedRecordType,
+                        GetUnboundedAddressOffset,
+                        GetUnboundedHighOffset,
+
+                        ForeachFieldEnumerationDo, ForeachLocalSymDo,
+                        GetExported, PutImported, GetSym,
+                        IsUnused,
+                        NulSym ;
+
+FROM M2Batch IMPORT MakeDefinitionSource ;
+FROM M2GCCDeclare IMPORT PutToBeSolvedByQuads ;
+
+FROM FifoQueue IMPORT GetConstFromFifoQueue,
+                      PutConstructorIntoFifoQueue, GetConstructorFromFifoQueue ;
+
+FROM M2Comp IMPORT CompilingImplementationModule,
+                   CompilingProgramModule ;
+
+FROM M2LexBuf IMPORT currenttoken, UnknownTokenNo, BuiltinTokenNo,
+                     GetToken, MakeVirtualTok,
+                     GetFileName, TokenToLineNo, GetTokenName,
+                     GetTokenNo, GetLineNo, GetPreviousTokenLineNo, PrintTokenNo ;
+
+FROM M2Error IMPORT Error,
+                    InternalError,
+                    WriteFormat0, WriteFormat1, WriteFormat2, WriteFormat3,
+                    NewError, NewWarning, ErrorFormat0, ErrorFormat1,
+                    ErrorFormat2, ErrorFormat3, FlushErrors, ChainError,
+                    ErrorString,
+                    ErrorStringAt, ErrorStringAt2, ErrorStringsAt2,
+                    WarnStringAt, WarnStringAt2, WarnStringsAt2 ;
+
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ;
+
+FROM M2Reserved IMPORT PlusTok, MinusTok, TimesTok, DivTok, ModTok,
+                       DivideTok, RemTok,
+                       OrTok, AndTok, AmbersandTok,
+                       EqualTok, LessEqualTok, GreaterEqualTok,
+                       LessTok, GreaterTok, HashTok, LessGreaterTok,
+                       InTok,
+                       UpArrowTok, RParaTok, LParaTok, CommaTok,
+                       NulTok, ByTok,
+                       SemiColonTok, toktype ;
+
+FROM M2Base IMPORT True, False, Boolean, Cardinal, Integer, Char,
+                   Real, LongReal, ShortReal, Nil,
+                   ZType, RType, CType,
+                   Re, Im, Cmplx,
+                   NegateType, ComplexToScalar, GetCmplxReturnType,
+                   IsAssignmentCompatible, IsExpressionCompatible,
+                   AssignmentRequiresWarning,
+                   CannotCheckTypeInPass3, ScalarToComplex, MixTypes,
+                   CheckAssignmentCompatible, CheckExpressionCompatible,
+                   High, LengthS, New, Dispose, Inc, Dec, Incl, Excl,
+                   Cap, Abs, Odd,
+                   IsOrd, Chr, Convert, Val, IsFloat, IsTrunc,
+                   IsInt, Min, Max,
+                   IsPseudoBaseProcedure, IsPseudoBaseFunction,
+                   IsMathType, IsOrdinalType, IsRealType,
+                   IsBaseType, GetBaseTypeMinMax, ActivationPointer ;
+
+FROM M2System IMPORT IsPseudoSystemFunction, IsPseudoSystemProcedure,
+                     IsSystemType, GetSystemTypeMinMax,
+                     IsPseudoSystemFunctionConstExpression,
+                     IsGenericSystemType,
+                     Adr, TSize, TBitSize, AddAdr, SubAdr, DifAdr, Cast,
+                     Shift, Rotate, MakeAdr, Address, Byte, Word, Loc, Throw ;
+
+FROM M2Size IMPORT Size ;
+FROM M2Bitset IMPORT Bitset ;
+
+FROM M2ALU IMPORT PushInt, Gre, Less, PushNulSet, AddBitRange, AddBit,
+                  IsGenericNulSet, IsValueAndTreeKnown, AddField,
+                  AddElements, ChangeToConstructor ;
+
+FROM Lists IMPORT List, InitList, GetItemFromList, NoOfItemsInList, PutItemIntoList,
+                  IsItemInList, KillList, IncludeItemIntoList ;
+
+FROM M2Options IMPORT NilChecking,
+                      WholeDivChecking, WholeValueChecking,
+                      IndexChecking, RangeChecking,
+                      CaseElseChecking, ReturnChecking,
+                      UnusedVariableChecking, UnusedParameterChecking,
+                      Iso, Pim, Pim2, Pim3, Pim4, PositiveModFloorDiv,
+                      Pedantic, CompilerDebugging, GenerateDebugging,
+                      GenerateLineDebug, Exceptions,
+                      Profiling, Coding, Optimizing,
+                      ScaffoldDynamic, ScaffoldStatic, cflag,
+                      ScaffoldMain, SharedFlag, WholeProgram ;
+
+FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ;
+
+FROM M2StackAddress IMPORT StackOfAddress, InitStackAddress, KillStackAddress,
+                           PushAddress, PopAddress, PeepAddress,
+                           IsEmptyAddress, NoOfItemsInStackAddress ;
+
+FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord,
+                        PushWord, PopWord, PeepWord, RemoveTop,
+                        IsEmptyWord, NoOfItemsInStackWord ;
+
+FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, InBounds, HighIndice, IncludeIndiceIntoIndex ;
+
+FROM M2Range IMPORT InitAssignmentRangeCheck,
+                    InitReturnRangeCheck,
+                    InitSubrangeRangeCheck,
+                    InitStaticArraySubscriptRangeCheck,
+                    InitDynamicArraySubscriptRangeCheck,
+                    InitIncRangeCheck,
+                    InitDecRangeCheck,
+                    InitInclCheck,
+                    InitExclCheck,
+                    InitRotateCheck,
+                    InitShiftCheck,
+                    InitTypesAssignmentCheck,
+                    InitTypesExpressionCheck,
+                    InitTypesParameterCheck,
+                    InitForLoopBeginRangeCheck,
+                    InitForLoopToRangeCheck,
+                    InitForLoopEndRangeCheck,
+                    InitPointerRangeCheck,
+                    InitNoReturnRangeCheck,
+                    InitNoElseRangeCheck,
+                    InitCaseBounds,
+                    InitWholeZeroDivisionCheck,
+                    InitWholeZeroRemainderCheck,
+                    InitParameterRangeCheck,
+                    (* CheckRangeAddVariableRead,  *)
+                    (* CheckRangeRemoveVariableRead,  *)
+                    WriteRangeCheck ;
+
+FROM M2CaseList IMPORT PushCase, PopCase, AddRange, BeginCaseList, EndCaseList, ElseCase ;
+FROM PCSymBuild IMPORT SkipConst ;
+FROM m2builtins IMPORT GetBuiltinTypeInfoType ;
+
+IMPORT M2Error ;
+
+
+CONST
+   DebugStackOn = TRUE ;
+   DebugVarients = FALSE ;
+   BreakAtQuad = 4423 ;
+   DebugTokPos = FALSE ;
+
+TYPE
+   ConstructorFrame = POINTER TO constructorFrame ;
+   constructorFrame = RECORD
+                         type : CARDINAL ;
+                         index: CARDINAL ;
+                      END ;
+
+   BoolFrame = POINTER TO RECORD
+                             TrueExit  : CARDINAL ;
+                             FalseExit : CARDINAL ;
+                             Unbounded : CARDINAL ;
+                             BooleanOp : BOOLEAN ;
+                             Dimension : CARDINAL ;
+                             ReadWrite : CARDINAL ;
+                             name      : CARDINAL ;
+                             Annotation: String ;
+                             tokenno   : CARDINAL ;
+                          END ;
+
+   QuadFrame = POINTER TO RECORD
+                             Operator           : QuadOperator ;
+                             Operand1           : CARDINAL ;
+                             Operand2           : CARDINAL ;
+                             Operand3           : CARDINAL ;
+                             Next               : CARDINAL ;     (* Next quadruple                 *)
+                             LineNo             : CARDINAL ;     (* Line No of source text         *)
+                             TokenNo            : CARDINAL ;     (* Token No of source text        *)
+                             NoOfTimesReferenced: CARDINAL ;     (* No of times quad is referenced *)
+                             CheckOverflow      : BOOLEAN ;      (* should backend check overflow  *)
+                             op1pos,
+                             op2pos,
+                             op3pos             : CARDINAL ;     (* token position of operands.    *)
+                          END ;
+
+   WithFrame = POINTER TO RECORD
+                             RecordSym   : CARDINAL ;
+                             RecordType  : CARDINAL ;
+                             RecordRef   : CARDINAL ;
+                             rw          : CARDINAL ;  (* The record variable.  *)
+                             RecordTokPos: CARDINAL ;  (* Token of the record.  *)
+                          END ;
+
+   ForLoopInfo = POINTER TO RECORD
+                               IncrementQuad,
+                               StartOfForLoop,                 (* we keep a list of all for      *)
+                               EndOfForLoop,                   (* loops so we can check index    *)
+                               ForLoopIndex,
+                               IndexTok      : CARDINAL ;      (* variables are not abused       *)
+                            END ;
+
+   LineNote  = POINTER TO RECORD
+                             Line: CARDINAL ;
+                             File: Name ;
+                             Next: LineNote ;
+                          END ;
+VAR
+   ConstructorStack,
+   LineStack,
+   BoolStack,
+   WithStack            : StackOfAddress ;
+   TryStack,
+   CatchStack,
+   ExceptStack,
+   ConstStack,
+   AutoStack,
+   RepeatStack,
+   WhileStack,
+   ForStack,
+   ExitStack,
+   ReturnStack          : StackOfWord ;   (* Return quadruple of the procedure.      *)
+   PriorityStack        : StackOfWord ;   (* temporary variable holding old priority *)
+   SuppressWith         : BOOLEAN ;
+   QuadArray            : Index ;
+   NextQuad             : CARDINAL ;  (* Next quadruple number to be created.    *)
+   FreeList             : CARDINAL ;  (* FreeList of quadruples.                 *)
+   CurrentProc          : CARDINAL ;  (* Current procedure being compiled, used  *)
+                                      (* to determine which procedure a RETURN   *)
+                                      (* ReturnValueOp must have as its 3rd op.  *)
+   InitQuad             : CARDINAL ;  (* Initial Quad BackPatch that starts the  *)
+                                      (* suit of Modules.                        *)
+   LastQuadNo           : CARDINAL ;  (* Last Quadruple accessed by GetQuad.     *)
+   LogicalOrTok,                      (* Internal _LOR token.                    *)
+   LogicalAndTok,                     (* Internal _LAND token.                   *)
+   LogicalXorTok,                     (* Internal _LXOR token.                   *)
+   LogicalDifferenceTok : Name ;      (* Internal _LDIFF token.                  *)
+   InConstExpression,
+   IsAutoOn,                          (* should parser automatically push idents *)
+   MustNotCheckBounds   : BOOLEAN ;
+   ForInfo              : Index ;     (* start and end of all FOR loops       *)
+   GrowInitialization   : CARDINAL ;  (* upper limit of where the initialized    *)
+                                      (* quadruples.                             *)
+   BuildingHigh,
+   BuildingSize,
+   QuadrupleGeneration  : BOOLEAN ;      (* should we be generating quadruples?  *)
+   FreeLineList         : LineNote ;  (* free list of line notes                 *)
+   VarientFields        : List ;      (* the list of all varient fields created  *)
+   VarientFieldNo       : CARDINAL ;  (* used to retrieve the VarientFields      *)
+                                      (* in order.                               *)
+   NoOfQuads            : CARDINAL ;  (* Number of used quadruples.              *)
+   Head                 : CARDINAL ;  (* Head of the list of quadruples *)
+
+
+(*
+   Rules for file and initialization quadruples:
+
+   StartModFileOp  - indicates that this file (module) has produced the
+                     following code
+   StartDefFileOp  - indicates that this definition module has produced
+                     this code.
+   EndFileOp       - indicates that a module has finished
+   InitStartOp     - the start of the initialization code of a module
+   InitEndOp       - the end of the above
+   FinallyStartOp  - the start of the finalization code of a module
+   FinallyEndOp    - the end of the above
+*)
+
+
+(*
+#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__)
+*)
+
+
+(*
+   doDSdbEnter -
+*)
+
+(*
+PROCEDURE doDSdbEnter ;
+BEGIN
+   PushAllocation
+END doDSdbEnter ;
+*)
+
+(*
+   doDSdbExit -
+*)
+
+(*
+PROCEDURE doDSdbExit (s: String) ;
+BEGIN
+   s := PopAllocationExemption(TRUE, s)
+END doDSdbExit ;
+*)
+
+(*
+   DSdbEnter -
+*)
+
+PROCEDURE DSdbEnter ;
+BEGIN
+END DSdbEnter ;
+
+
+(*
+   DSdbExit -
+*)
+
+PROCEDURE DSdbExit ;
+BEGIN
+END DSdbExit ;
+
+
+(*
+#define DBsbEnter doDBsbEnter
+#define DBsbExit  doDBsbExit
+*)
+
+
+(*
+   SetOptionProfiling - builds a profile quadruple if the profiling
+                        option was given to the compiler.
+*)
+
+PROCEDURE SetOptionProfiling (b: BOOLEAN) ;
+BEGIN
+   IF b#Profiling
+   THEN
+      IF b
+      THEN
+         BuildProfileOn
+      ELSE
+         BuildProfileOff
+      END ;
+      Profiling := b
+   END
+END SetOptionProfiling ;
+
+
+(*
+   SetOptionCoding - builds a code quadruple if the profiling
+                     option was given to the compiler.
+*)
+
+PROCEDURE SetOptionCoding (b: BOOLEAN) ;
+BEGIN
+   IF b#Coding
+   THEN
+      IF b
+      THEN
+         BuildCodeOn
+      ELSE
+         BuildCodeOff
+      END ;
+      Coding := b
+   END
+END SetOptionCoding ;
+
+
+(*
+   SetOptionOptimizing - builds a quadruple to say that the optimization option
+                         has been found in a comment.
+*)
+
+PROCEDURE SetOptionOptimizing (b: BOOLEAN) ;
+BEGIN
+   IF b
+   THEN
+      BuildOptimizeOn
+   ELSE
+      BuildOptimizeOff
+   END
+END SetOptionOptimizing ;
+
+
+(*
+   GetQF - returns the QuadFrame associated with, q.
+*)
+
+PROCEDURE GetQF (q: CARDINAL) : QuadFrame ;
+BEGIN
+   RETURN QuadFrame (GetIndice (QuadArray, q))
+END GetQF ;
+
+
+(*
+   Opposite - returns the opposite comparison operator.
+*)
+
+PROCEDURE Opposite (Operator: QuadOperator) : QuadOperator ;
+VAR
+   Op: QuadOperator ;
+BEGIN
+   CASE Operator OF
+
+   IfNotEquOp : Op := IfEquOp |
+   IfEquOp    : Op := IfNotEquOp |
+   IfLessEquOp: Op := IfGreOp |
+   IfGreOp    : Op := IfLessEquOp |
+   IfGreEquOp : Op := IfLessOp |
+   IfLessOp   : Op := IfGreEquOp |
+   IfInOp     : Op := IfNotInOp |
+   IfNotInOp  : Op := IfInOp
+
+   ELSE
+      InternalError ('unexpected operator')
+   END ;
+   RETURN Op
+END Opposite ;
+
+
+(*
+   IsReferenced - returns true if QuadNo is referenced by another quadruple.
+*)
+
+PROCEDURE IsReferenced (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   WITH f^ DO
+      RETURN( (Operator=ProcedureScopeOp) OR (Operator=NewLocalVarOp) OR
+              (NoOfTimesReferenced>0) )
+   END
+END IsReferenced ;
+
+
+(*
+   IsBackReference - returns TRUE if quadruple, q, is referenced from a quad further on.
+*)
+
+PROCEDURE IsBackReference (q: CARDINAL) : BOOLEAN ;
+VAR
+   i            : CARDINAL ;
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+BEGIN
+   i := q ;
+   WHILE i#0 DO
+      GetQuad (i, op, op1, op2, op3) ;
+      CASE op OF
+
+      NewLocalVarOp,
+      KillLocalVarOp,
+      FinallyStartOp,
+      FinallyEndOp,
+      InitEndOp,
+      InitStartOp,
+      EndFileOp,
+      StartDefFileOp,
+      StartModFileOp:  RETURN( FALSE ) |       (* run into end of procedure or module *)
+
+      GotoOp,
+      IfEquOp,
+      IfLessEquOp,
+      IfGreEquOp,
+      IfGreOp,
+      IfLessOp,
+      IfNotEquOp,
+      IfInOp,
+      IfNotInOp     :  IF op3=q
+                       THEN
+                          RETURN( TRUE )
+                       END
+
+      END ;
+      i := GetNextQuad(i)
+   END ;
+   InternalError ('fix this for the sake of efficiency..')
+END IsBackReference ;
+
+
+(*
+   IsUnConditional - returns true if QuadNo is an unconditional jump.
+*)
+
+PROCEDURE IsUnConditional (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   WITH f^ DO
+      CASE Operator OF
+
+      ThrowOp,
+      RetryOp,
+      CallOp,
+      ReturnOp,
+      GotoOp  : RETURN( TRUE )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsUnConditional ;
+
+
+(*
+   IsConditional - returns true if QuadNo is a conditional jump.
+*)
+
+PROCEDURE IsConditional (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   WITH f^ DO
+      CASE Operator OF
+
+      IfInOp,
+      IfNotInOp,
+      IfEquOp,
+      IfNotEquOp,
+      IfLessOp,
+      IfLessEquOp,
+      IfGreOp,
+      IfGreEquOp : RETURN( TRUE )
+
+      ELSE
+         RETURN( FALSE )
+      END ;
+   END
+END IsConditional ;
+
+
+(*
+   IsBackReferenceConditional - returns TRUE if quadruple, q, is referenced from
+                                a conditional quad further on.
+*)
+
+PROCEDURE IsBackReferenceConditional (q: CARDINAL) : BOOLEAN ;
+VAR
+   i            : CARDINAL ;
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+BEGIN
+   i := q ;
+   WHILE i#0 DO
+      GetQuad (i, op, op1, op2, op3) ;
+      CASE op OF
+
+      NewLocalVarOp,
+      KillLocalVarOp,
+      FinallyStartOp,
+      FinallyEndOp,
+      InitEndOp,
+      InitStartOp,
+      EndFileOp,
+      StartDefFileOp,
+      StartModFileOp:  RETURN( FALSE ) |       (* run into end of procedure or module *)
+
+      TryOp,
+      RetryOp,
+      GotoOp,
+      IfEquOp,
+      IfLessEquOp,
+      IfGreEquOp,
+      IfGreOp,
+      IfLessOp,
+      IfNotEquOp,
+      IfInOp,
+      IfNotInOp     :  IF (op3=q) AND IsConditional(q)
+                       THEN
+                          RETURN( TRUE )
+                       END
+
+      END ;
+      i := GetNextQuad(i)
+   END ;
+   InternalError ('fix this for the sake of efficiency..')
+END IsBackReferenceConditional ;
+
+
+(*
+   IsQuadA - returns true if QuadNo is a op.
+*)
+
+PROCEDURE IsQuadA (QuadNo: CARDINAL; op: QuadOperator) : BOOLEAN ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   WITH f^ DO
+      RETURN( Operator=op )
+   END
+END IsQuadA ;
+
+
+(*
+   IsCall - returns true if QuadNo is a call operation.
+*)
+
+PROCEDURE IsCall (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, CallOp) )
+END IsCall ;
+
+
+(*
+   IsReturn - returns true if QuadNo is a return operation.
+*)
+
+PROCEDURE IsReturn (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, ReturnOp) )
+END IsReturn ;
+
+
+(*
+   IsNewLocalVar - returns true if QuadNo is a NewLocalVar operation.
+*)
+
+PROCEDURE IsNewLocalVar (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, NewLocalVarOp) )
+END IsNewLocalVar ;
+
+
+(*
+   IsKillLocalVar - returns true if QuadNo is a KillLocalVar operation.
+*)
+
+PROCEDURE IsKillLocalVar (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, KillLocalVarOp) )
+END IsKillLocalVar ;
+
+
+(*
+   IsProcedureScope - returns true if QuadNo is a ProcedureScope operation.
+*)
+
+PROCEDURE IsProcedureScope (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, ProcedureScopeOp) )
+END IsProcedureScope ;
+
+
+(*
+   IsCatchBegin - returns true if QuadNo is a catch begin quad.
+*)
+
+PROCEDURE IsCatchBegin (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, CatchBeginOp) )
+END IsCatchBegin ;
+
+
+(*
+   IsCatchEnd - returns true if QuadNo is a catch end quad.
+*)
+
+PROCEDURE IsCatchEnd (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, CatchEndOp) )
+END IsCatchEnd ;
+
+
+(*
+   IsInitStart - returns true if QuadNo is a init start quad.
+*)
+
+PROCEDURE IsInitStart (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, InitStartOp) )
+END IsInitStart ;
+
+
+(*
+   IsInitEnd - returns true if QuadNo is a init end quad.
+*)
+
+PROCEDURE IsInitEnd (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, InitEndOp) )
+END IsInitEnd ;
+
+
+(*
+   IsFinallyStart - returns true if QuadNo is a finally start quad.
+*)
+
+PROCEDURE IsFinallyStart (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, FinallyStartOp) )
+END IsFinallyStart ;
+
+
+(*
+   IsFinallyEnd - returns true if QuadNo is a finally end quad.
+*)
+
+PROCEDURE IsFinallyEnd (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsQuadA(QuadNo, FinallyEndOp) )
+END IsFinallyEnd ;
+
+
+(*
+   IsInitialisingConst - returns TRUE if the quadruple is setting
+                         a const (op1) with a value.
+*)
+
+PROCEDURE IsInitialisingConst (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+BEGIN
+   GetQuad (QuadNo, op, op1, op2, op3) ;
+   CASE op OF
+
+   InclOp,
+   ExclOp,
+   UnboundedOp,
+   FunctValueOp,
+   NegateOp,
+   BecomesOp,
+   HighOp,
+   SizeOp,
+   AddrOp,
+   RecordFieldOp,
+   ArrayOp,
+   LogicalShiftOp,
+   LogicalRotateOp,
+   LogicalOrOp,
+   LogicalAndOp,
+   LogicalXorOp,
+   CoerceOp,
+   ConvertOp,
+   CastOp,
+   AddOp,
+   SubOp,
+   MultOp,
+   ModFloorOp,
+   DivCeilOp,
+   ModCeilOp,
+   DivFloorOp,
+   ModTruncOp,
+   DivTruncOp,
+   DivM2Op,
+   ModM2Op,
+   XIndrOp,
+   IndrXOp,
+   SaveExceptionOp,
+   RestoreExceptionOp:  RETURN( IsConst(op1) )
+
+   ELSE
+      RETURN( FALSE )
+   END
+END IsInitialisingConst ;
+
+
+(*
+   IsOptimizeOn - returns true if the Optimize flag was true at QuadNo.
+*)
+
+PROCEDURE IsOptimizeOn (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   f : QuadFrame ;
+   n,
+   q : CARDINAL ;
+   On: BOOLEAN ;
+BEGIN
+   On := Optimizing ;
+   q := Head ;
+   WHILE (q#0) AND (q#QuadNo) DO
+      f := GetQF(q) ;
+      WITH f^ DO
+         IF Operator=OptimizeOnOp
+         THEN
+            On := TRUE
+         ELSIF Operator=OptimizeOffOp
+         THEN
+            On := FALSE
+         END ;
+         n := Next
+      END ;
+      q := n
+   END ;
+   RETURN( On )
+END IsOptimizeOn ;
+
+
+(*
+   IsProfileOn - returns true if the Profile flag was true at QuadNo.
+*)
+
+PROCEDURE IsProfileOn (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   f : QuadFrame ;
+   n,
+   q : CARDINAL ;
+   On: BOOLEAN ;
+BEGIN
+   On := Profiling ;
+   q := Head ;
+   WHILE (q#0) AND (q#QuadNo) DO
+      f := GetQF(q) ;
+      WITH f^ DO
+         IF Operator=ProfileOnOp
+         THEN
+            On := TRUE
+         ELSIF Operator=ProfileOffOp
+         THEN
+            On := FALSE
+         END ;
+         n := Next
+      END ;
+      q := n
+   END ;
+   RETURN( On )
+END IsProfileOn ;
+
+
+(*
+   IsCodeOn - returns true if the Code flag was true at QuadNo.
+*)
+
+PROCEDURE IsCodeOn (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   f : QuadFrame ;
+   n,
+   q : CARDINAL ;
+   On: BOOLEAN ;
+BEGIN
+   On := Coding ;
+   q := Head ;
+   WHILE (q#0) AND (q#QuadNo) DO
+      f := GetQF(q) ;
+      WITH f^ DO
+         IF Operator=CodeOnOp
+         THEN
+            On := TRUE
+         ELSIF Operator=CodeOffOp
+         THEN
+            On := FALSE
+         END ;
+         n := Next
+      END ;
+      q := n
+   END ;
+   RETURN( On )
+END IsCodeOn ;
+
+
+(*
+   IsDefOrModFile - returns TRUE if QuadNo is a start of Module or Def file
+                    directive.
+*)
+
+PROCEDURE IsDefOrModFile (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   WITH f^ DO
+      RETURN( (Operator=StartDefFileOp) OR (Operator=StartModFileOp) )
+   END
+END IsDefOrModFile ;
+
+
+(*
+   IsPseudoQuad - returns true if QuadNo is a compiler directive.
+                  ie code, profile and optimize.
+                     StartFile, EndFile,
+*)
+
+PROCEDURE IsPseudoQuad (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   WITH f^ DO
+      RETURN( (Operator=CodeOnOp) OR (Operator=CodeOffOp) OR
+              (Operator=ProfileOnOp) OR (Operator=ProfileOffOp) OR
+              (Operator=OptimizeOnOp) OR (Operator=OptimizeOffOp) OR
+              (Operator=EndFileOp) OR
+              (Operator=StartDefFileOp) OR (Operator=StartModFileOp)
+            )
+   END
+END IsPseudoQuad ;
+
+
+(*
+   GetLastFileQuad - returns the Quadruple number of the last StartDefFile or
+                     StartModFile quadruple.
+*)
+
+PROCEDURE GetLastFileQuad (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+   f       : QuadFrame ;
+   q, i,
+   FileQuad: CARDINAL ;
+BEGIN
+   q := Head ;
+   FileQuad := 0 ;
+   REPEAT
+      f := GetQF(q) ;
+      WITH f^ DO
+         IF (Operator=StartModFileOp) OR (Operator=StartDefFileOp)
+         THEN
+            FileQuad := q
+         END ;
+         i := Next
+      END ;
+      q := i
+   UNTIL (i=QuadNo) OR (i=0) ;
+   Assert(i#0) ;
+   Assert(FileQuad#0) ;
+   RETURN( FileQuad )
+END GetLastFileQuad ;
+
+
+(*
+   GetLastQuadNo - returns the last quadruple number referenced
+                   by a GetQuad.
+*)
+
+PROCEDURE GetLastQuadNo () : CARDINAL ;
+BEGIN
+   RETURN( LastQuadNo )
+END GetLastQuadNo ;
+
+
+(*
+   QuadToLineNo - Converts a QuadNo into the approprate line number of the
+                  source file, the line number is returned.
+
+                  This may be used to yield an idea where abouts in the
+                  source file the code generetion is
+                  processing.
+*)
+
+PROCEDURE QuadToLineNo (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   IF ((LastQuadNo=0) AND (NOT IsNoPass()) AND (NOT IsPassCodeGeneration())) OR
+      (NOT InBounds(QuadArray, QuadNo))
+   THEN
+      RETURN( 0 )
+   ELSE
+      f := GetQF(QuadNo) ;
+      RETURN( f^.LineNo )
+   END
+END QuadToLineNo ;
+
+
+(*
+   QuadToTokenNo - Converts a QuadNo into the approprate token number of the
+                   source file, the line number is returned.
+
+                   This may be used to yield an idea where abouts in the
+                   source file the code generetion is
+                   processing.
+*)
+
+PROCEDURE QuadToTokenNo (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   IF ((LastQuadNo=0) AND (NOT IsNoPass()) AND (NOT IsPassCodeGeneration())) OR
+      (NOT InBounds(QuadArray, QuadNo))
+   THEN
+      RETURN( 0 )
+   ELSE
+      f := GetQF(QuadNo) ;
+      RETURN( f^.TokenNo )
+   END
+END QuadToTokenNo ;
+
+
+(*
+   GetQuad - returns the Quadruple QuadNo.
+*)
+
+PROCEDURE GetQuad (QuadNo: CARDINAL;
+                   VAR Op: QuadOperator;
+                   VAR Oper1, Oper2, Oper3: CARDINAL) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   LastQuadNo := QuadNo ;
+   WITH f^ DO
+      Op := Operator ;
+      Oper1 := Operand1 ;
+      Oper2 := Operand2 ;
+      Oper3 := Operand3
+   END
+END GetQuad ;
+
+
+(*
+   GetQuadtok - returns the Quadruple QuadNo.
+*)
+
+PROCEDURE GetQuadtok (QuadNo: CARDINAL;
+                      VAR Op: QuadOperator;
+                      VAR Oper1, Oper2, Oper3: CARDINAL;
+                      VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   LastQuadNo := QuadNo ;
+   WITH f^ DO
+      Op := Operator ;
+      Oper1 := Operand1 ;
+      Oper2 := Operand2 ;
+      Oper3 := Operand3 ;
+      Op1Pos := op1pos ;
+      Op2Pos := op2pos ;
+      Op3Pos := op3pos
+   END
+END GetQuadtok ;
+
+
+(*
+   GetQuadOtok - returns the Quadruple QuadNo.
+*)
+
+PROCEDURE GetQuadOtok (QuadNo: CARDINAL;
+                       VAR tok: CARDINAL;
+                       VAR Op: QuadOperator;
+                       VAR Oper1, Oper2, Oper3: CARDINAL;
+                       VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   LastQuadNo := QuadNo ;
+   WITH f^ DO
+      Op := Operator ;
+      Oper1 := Operand1 ;
+      Oper2 := Operand2 ;
+      Oper3 := Operand3 ;
+      Op1Pos := op1pos ;
+      Op2Pos := op2pos ;
+      Op3Pos := op3pos ;
+      tok := TokenNo
+   END
+END GetQuadOtok ;
+
+
+(*
+   AddQuadInformation - adds variable analysis and jump analysis to the new quadruple.
+*)
+
+PROCEDURE AddQuadInformation (QuadNo: CARDINAL;
+                              Op: QuadOperator;
+                              Oper1, Oper2, Oper3: CARDINAL) ;
+BEGIN
+   CASE Op OF
+
+   IfInOp,
+   IfNotInOp,
+   IfEquOp,
+   IfNotEquOp,
+   IfLessOp,
+   IfLessEquOp,
+   IfGreOp,
+   IfGreEquOp : ManipulateReference(QuadNo, Oper3) ;
+                CheckAddVariableRead(Oper1, FALSE, QuadNo) ;
+                CheckAddVariableRead(Oper2, FALSE, QuadNo) |
+
+   TryOp,
+   RetryOp,
+   GotoOp     : ManipulateReference(QuadNo, Oper3) |
+
+   (* variable references *)
+
+   InclOp,
+   ExclOp            : CheckConst(Oper1) ;
+                       CheckAddVariableRead(Oper3, FALSE, QuadNo) ;
+                       CheckAddVariableWrite(Oper1, TRUE, QuadNo) |
+   UnboundedOp,
+   FunctValueOp,
+   NegateOp,
+   BecomesOp,
+   HighOp,
+   SizeOp            : CheckConst(Oper1) ;
+                       CheckAddVariableWrite(Oper1, FALSE, QuadNo) ;
+                       CheckAddVariableRead(Oper3, FALSE, QuadNo) |
+   AddrOp            : CheckConst(Oper1) ;
+                       CheckAddVariableWrite(Oper1, FALSE, QuadNo) ;
+                       (* CheckAddVariableReadLeftValue(Oper3, QuadNo) *)
+                       (* the next line is a kludge and assumes we _will_
+                          write to the variable as we have taken its address *)
+                       CheckRemoveVariableWrite(Oper1, TRUE, QuadNo) |
+   ReturnValueOp     : CheckAddVariableRead(Oper1, FALSE, QuadNo) |
+   ReturnOp,
+   NewLocalVarOp,
+   KillLocalVarOp    : |
+   CallOp            : CheckAddVariableRead(Oper3, TRUE, QuadNo) |
+
+   ParamOp           : CheckAddVariableRead(Oper2, FALSE, QuadNo) ;
+                       CheckAddVariableRead(Oper3, FALSE, QuadNo) ;
+                       IF (Oper1>0) AND (Oper1<=NoOfParam(Oper2)) AND
+                          IsVarParam(Oper2, Oper1)
+                       THEN
+                          (* _may_ also write to a var parameter, although we dont know *)
+                          CheckAddVariableWrite(Oper3, TRUE, QuadNo)
+                       END |
+   RecordFieldOp,
+   ArrayOp,
+   LogicalShiftOp,
+   LogicalRotateOp,
+   LogicalOrOp,
+   LogicalAndOp,
+   LogicalXorOp,
+   CoerceOp,
+   ConvertOp,
+   CastOp,
+   AddOp,
+   SubOp,
+   MultOp,
+   DivM2Op,
+   ModM2Op,
+   ModFloorOp,
+   DivCeilOp,
+   ModCeilOp,
+   DivFloorOp,
+   ModTruncOp,
+   DivTruncOp        : CheckConst(Oper1) ;
+                       CheckAddVariableWrite(Oper1, FALSE, QuadNo) ;
+                       CheckAddVariableRead(Oper2, FALSE, QuadNo) ;
+                       CheckAddVariableRead(Oper3, FALSE, QuadNo) |
+
+   XIndrOp           : CheckConst(Oper1) ;
+                       CheckAddVariableWrite(Oper1, TRUE, QuadNo) ;
+                       CheckAddVariableRead(Oper3, FALSE, QuadNo) |
+
+   IndrXOp           : CheckConst(Oper1) ;
+                       CheckAddVariableWrite(Oper1, FALSE, QuadNo) ;
+                       CheckAddVariableRead(Oper3, TRUE, QuadNo) |
+
+(* RangeCheckOp      : CheckRangeAddVariableRead(Oper3, QuadNo) | *)
+   SaveExceptionOp   : CheckConst(Oper1) ;
+                       CheckAddVariableWrite(Oper1, FALSE, QuadNo) |
+   RestoreExceptionOp: CheckAddVariableRead(Oper1, FALSE, QuadNo)
+
+   ELSE
+   END
+END AddQuadInformation ;
+
+
+PROCEDURE stop ; BEGIN END stop ;
+
+
+(*
+   PutQuadO - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
+              sets a boolean to determinine whether overflow should be checked.
+*)
+
+PROCEDURE PutQuadO (QuadNo: CARDINAL;
+                    Op: QuadOperator;
+                    Oper1, Oper2, Oper3: CARDINAL;
+                    overflow: BOOLEAN) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   IF QuadNo = BreakAtQuad
+   THEN
+      stop
+   END ;
+   IF QuadrupleGeneration
+   THEN
+      EraseQuad (QuadNo) ;
+      AddQuadInformation (QuadNo, Op, Oper1, Oper2, Oper3) ;
+      f := GetQF (QuadNo) ;
+      WITH f^ DO
+         Operator      := Op ;
+         Operand1      := Oper1 ;
+         Operand2      := Oper2 ;
+         Operand3      := Oper3 ;
+         CheckOverflow := overflow
+      END
+   END
+END PutQuadO ;
+
+
+(*
+   PutQuad - overwrites a quadruple QuadNo with Op, Oper1, Oper2, Oper3
+*)
+
+PROCEDURE PutQuad (QuadNo: CARDINAL;
+                   Op: QuadOperator;
+                   Oper1, Oper2, Oper3: CARDINAL) ;
+BEGIN
+   PutQuadO (QuadNo, Op, Oper1, Oper2, Oper3, TRUE)
+END PutQuad ;
+
+
+(*
+   UndoReadWriteInfo -
+*)
+
+PROCEDURE UndoReadWriteInfo (QuadNo: CARDINAL;
+                             Op: QuadOperator;
+                             Oper1, Oper2, Oper3: CARDINAL) ;
+BEGIN
+   CASE Op OF
+
+   (* jumps, calls and branches *)
+   IfInOp,
+   IfNotInOp,
+   IfEquOp,
+   IfNotEquOp,
+   IfLessOp,
+   IfLessEquOp,
+   IfGreOp,
+   IfGreEquOp        : RemoveReference(QuadNo) ;
+                       CheckRemoveVariableRead(Oper1, FALSE, QuadNo) ;
+                       CheckRemoveVariableRead(Oper2, FALSE, QuadNo) |
+
+   TryOp,
+   RetryOp,
+   GotoOp            : RemoveReference(QuadNo) |
+
+   (* variable references *)
+
+   InclOp,
+   ExclOp            : CheckRemoveVariableRead(Oper1, FALSE, QuadNo) ;
+                       CheckRemoveVariableWrite(Oper1, TRUE, QuadNo) |
+
+   UnboundedOp,
+   FunctValueOp,
+   NegateOp,
+   BecomesOp,
+   HighOp,
+   SizeOp            : CheckRemoveVariableWrite(Oper1, FALSE, QuadNo) ;
+                       CheckRemoveVariableRead(Oper3, FALSE, QuadNo) |
+   AddrOp            : CheckRemoveVariableWrite(Oper1, FALSE, QuadNo) ;
+                       (* CheckRemoveVariableReadLeftValue(Oper3, QuadNo) ; *)
+                       (* the next line is a kludge and assumes we _will_
+                          write to the variable as we have taken its address *)
+                       CheckRemoveVariableWrite(Oper1, TRUE, QuadNo) |
+   ReturnValueOp     : CheckRemoveVariableRead(Oper1, FALSE, QuadNo) |
+   ReturnOp,
+   CallOp,
+   NewLocalVarOp,
+   KillLocalVarOp    : |
+   ParamOp           : CheckRemoveVariableRead(Oper2, FALSE, QuadNo) ;
+                       CheckRemoveVariableRead(Oper3, FALSE, QuadNo) ;
+                       IF (Oper1>0) AND (Oper1<=NoOfParam(Oper2)) AND
+                          IsVarParam(Oper2, Oper1)
+                       THEN
+                          (* _may_ also write to a var parameter, although we dont know *)
+                          CheckRemoveVariableWrite(Oper3, TRUE, QuadNo)
+                       END |
+   RecordFieldOp,
+   ArrayOp,
+   LogicalShiftOp,
+   LogicalRotateOp,
+   LogicalOrOp,
+   LogicalAndOp,
+   LogicalXorOp,
+   CoerceOp,
+   ConvertOp,
+   CastOp,
+   AddOp,
+   SubOp,
+   MultOp,
+   DivM2Op,
+   ModM2Op,
+   ModFloorOp,
+   DivCeilOp,
+   ModCeilOp,
+   DivFloorOp,
+   ModTruncOp,
+   DivTruncOp        : CheckRemoveVariableWrite(Oper1, FALSE, QuadNo) ;
+                       CheckRemoveVariableRead(Oper2, FALSE, QuadNo) ;
+                       CheckRemoveVariableRead(Oper3, FALSE, QuadNo) |
+
+   XIndrOp           : CheckRemoveVariableWrite(Oper1, TRUE, QuadNo) ;
+                       CheckRemoveVariableRead(Oper3, FALSE, QuadNo) |
+
+   IndrXOp           : CheckRemoveVariableWrite(Oper1, FALSE, QuadNo) ;
+                       CheckRemoveVariableRead(Oper3, TRUE, QuadNo) |
+
+(* RangeCheckOp      : CheckRangeRemoveVariableRead(Oper3, QuadNo) | *)
+   SaveExceptionOp   : CheckRemoveVariableWrite(Oper1, FALSE, QuadNo) |
+   RestoreExceptionOp: CheckRemoveVariableRead(Oper1, FALSE, QuadNo)
+
+   ELSE
+   END
+END UndoReadWriteInfo ;
+
+
+(*
+   EraseQuad - erases a quadruple QuadNo, the quadruple is still in the list
+               but wiped clean.
+*)
+
+PROCEDURE EraseQuad (QuadNo: CARDINAL) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   WITH f^ DO
+      UndoReadWriteInfo(QuadNo, Operator, Operand1, Operand2, Operand3) ;
+      Operator := DummyOp ;   (* finally blank it out *)
+      Operand1 := 0 ;
+      Operand2 := 0 ;
+      Operand3 := 0 ;
+      op1pos   := UnknownTokenNo ;
+      op2pos   := UnknownTokenNo ;
+      op3pos   := UnknownTokenNo
+   END
+END EraseQuad ;
+
+
+(*
+   CheckAddVariableReadLeftValue -
+*)
+
+(*
+PROCEDURE CheckAddVariableReadLeftValue (sym: CARDINAL; q: CARDINAL) ;
+BEGIN
+   IF IsVar(sym)
+   THEN
+      PutReadQuad(sym, LeftValue, q)
+   END
+END CheckAddVariableReadLeftValue ;
+*)
+
+
+(*
+   CheckRemoveVariableReadLeftValue -
+*)
+
+(*
+PROCEDURE CheckRemoveVariableReadLeftValue (sym: CARDINAL; q: CARDINAL) ;
+BEGIN
+   IF IsVar(sym)
+   THEN
+      RemoveReadQuad(sym, LeftValue, q)
+   END
+END CheckRemoveVariableReadLeftValue ;
+*)
+
+
+(*
+   CheckAddVariableRead - checks to see whether symbol, Sym, is a variable or
+                          a parameter and if so it then adds this quadruple
+                          to the variable list.
+*)
+
+PROCEDURE CheckAddVariableRead (Sym: CARDINAL; canDereference: BOOLEAN; Quad: CARDINAL) ;
+BEGIN
+   IF IsVar(Sym)
+   THEN
+      PutReadQuad(Sym, GetMode(Sym), Quad) ;
+      IF (GetMode(Sym)=LeftValue) AND canDereference
+      THEN
+         PutReadQuad(Sym, RightValue, Quad)
+      END
+   END
+END CheckAddVariableRead ;
+
+
+(*
+   CheckRemoveVariableRead - checks to see whether, Sym, is a variable or
+                             a parameter and if so then it removes the
+                             quadruple from the variable list.
+*)
+
+PROCEDURE CheckRemoveVariableRead (Sym: CARDINAL; canDereference: BOOLEAN; Quad: CARDINAL) ;
+BEGIN
+   IF IsVar(Sym)
+   THEN
+      RemoveReadQuad(Sym, GetMode(Sym), Quad) ;
+      IF (GetMode(Sym)=LeftValue) AND canDereference
+      THEN
+         RemoveReadQuad(Sym, RightValue, Quad)
+      END
+   END
+END CheckRemoveVariableRead ;
+
+
+(*
+   CheckAddVariableWrite - checks to see whether symbol, Sym, is a variable and
+                           if so it then adds this quadruple to the variable list.
+*)
+
+PROCEDURE CheckAddVariableWrite (Sym: CARDINAL; canDereference: BOOLEAN; Quad: CARDINAL) ;
+BEGIN
+   IF IsVar(Sym)
+   THEN
+      IF (GetMode(Sym)=LeftValue) AND canDereference
+      THEN
+         PutReadQuad(Sym, LeftValue, Quad) ;
+         PutWriteQuad(Sym, RightValue, Quad)
+      ELSE
+         PutWriteQuad(Sym, GetMode(Sym), Quad)
+      END
+   END
+END CheckAddVariableWrite ;
+
+
+(*
+   CheckRemoveVariableWrite - checks to see whether, Sym, is a variable and
+                              if so then it removes the quadruple from the
+                              variable list.
+*)
+
+PROCEDURE CheckRemoveVariableWrite (Sym: CARDINAL; canDereference: BOOLEAN; Quad: CARDINAL) ;
+BEGIN
+   IF IsVar(Sym)
+   THEN
+      IF (GetMode(Sym)=LeftValue) AND canDereference
+      THEN
+         RemoveReadQuad(Sym, LeftValue, Quad) ;
+         RemoveWriteQuad(Sym, RightValue, Quad)
+      ELSE
+         RemoveWriteQuad(Sym, GetMode(Sym), Quad)
+      END
+   END
+END CheckRemoveVariableWrite ;
+
+
+(*
+   CheckConst -
+*)
+
+PROCEDURE CheckConst (sym: CARDINAL) ;
+BEGIN
+   IF IsConst(sym)
+   THEN
+      PutToBeSolvedByQuads(sym)
+   END
+END CheckConst ;
+
+
+(*
+   GetFirstQuad - returns the first quadruple.
+*)
+
+PROCEDURE GetFirstQuad () : CARDINAL ;
+BEGIN
+   RETURN( Head )
+END GetFirstQuad ;
+
+
+(*
+   GetNextQuad - returns the Quadruple number following QuadNo.
+*)
+
+PROCEDURE GetNextQuad (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   RETURN( f^.Next )
+END GetNextQuad ;
+
+
+(*
+   SubQuad - subtracts a quadruple QuadNo from a list Head.
+*)
+
+PROCEDURE SubQuad (QuadNo: CARDINAL) ;
+VAR
+   i   : CARDINAL ;
+   f, g: QuadFrame ;
+BEGIN
+   f := GetQF(QuadNo) ;
+   WITH f^ DO
+      AlterReference(Head, QuadNo, f^.Next) ;
+      UndoReadWriteInfo(QuadNo, Operator, Operand1, Operand2, Operand3)
+   END ;
+   IF Head=QuadNo
+   THEN
+      Head := f^.Next
+   ELSE
+      i := Head ;
+      g := GetQF(i) ;
+      WHILE g^.Next#QuadNo DO
+         i := g^.Next ;
+         g := GetQF(i)
+      END ;
+      g^.Next := f^.Next
+   END ;
+   f^.Operator := DummyOp ;
+   DEC(NoOfQuads)
+END SubQuad ;
+
+
+(*
+   GetRealQuad - returns the Quadruple number of the real quadruple
+                 at QuadNo or beyond.
+*)
+
+PROCEDURE GetRealQuad (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   WHILE QuadNo#0 DO
+      IF InBounds(QuadArray, QuadNo)
+      THEN
+         f := GetQF(QuadNo) ;
+         WITH f^ DO
+            IF (NOT IsPseudoQuad(QuadNo)) AND
+               (Operator#DummyOp) AND (Operator#LineNumberOp) AND (Operator#StatementNoteOp)
+            THEN
+               RETURN( QuadNo )
+            END
+         END ;
+         INC(QuadNo)
+      ELSE
+         RETURN( 0 )
+      END
+   END ;
+   RETURN( 0 )
+END GetRealQuad ;
+
+
+(*
+   AlterReference - alters all references from OldQuad, to NewQuad in a
+                    quadruple list Head.
+*)
+
+PROCEDURE AlterReference (Head, OldQuad, NewQuad: CARDINAL) ;
+VAR
+   f, g: QuadFrame ;
+   i   : CARDINAL ;
+BEGIN
+   f := GetQF(OldQuad) ;
+   WHILE (f^.NoOfTimesReferenced>0) AND (Head#0) DO
+      g := GetQF(Head) ;
+      WITH g^ DO
+         CASE Operator OF
+
+         IfInOp,
+         IfNotInOp,
+         IfEquOp,
+         IfNotEquOp,
+         IfLessOp,
+         IfLessEquOp,
+         IfGreOp,
+         IfGreEquOp,
+         TryOp,
+         RetryOp,
+         GotoOp     : IF Operand3=OldQuad
+                      THEN
+                         ManipulateReference(Head, NewQuad)
+                      END
+
+         ELSE
+         END ;
+         i := Next
+      END ;
+      Head := i
+   END
+END AlterReference ;
+
+
+(*
+   GrowQuads - grows the list of quadruples to the quadruple, to.
+*)
+
+PROCEDURE GrowQuads (to: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+   f: QuadFrame ;
+BEGIN
+   IF (to#0) AND (to>GrowInitialization)
+   THEN
+      i := GrowInitialization+1 ;
+      WHILE i<=to DO
+         IF InBounds(QuadArray, i)
+         THEN
+            Assert(GetIndice(QuadArray, i)#NIL)
+         ELSE
+            NEW(f) ;
+            IF f=NIL
+            THEN
+               InternalError ('out of memory error when trying to allocate a quadruple')
+            END ;
+            PutIndice(QuadArray, i, f) ;
+            f^.NoOfTimesReferenced := 0
+         END ;
+         INC(i)
+      END ;
+      GrowInitialization := to
+   END
+END GrowQuads ;
+
+
+(*
+   ManipulateReference - manipulates the quadruple, q, so that it now points to quad, to.
+*)
+
+PROCEDURE ManipulateReference (q: CARDINAL; to: CARDINAL) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   Assert((GrowInitialization>=q) OR (to=0)) ;
+   GrowQuads(to) ;
+   RemoveReference(q) ;
+   f := GetQF(q) ;
+   f^.Operand3 := to ;
+   IF to#0
+   THEN
+      f := GetQF(to) ;
+      INC(f^.NoOfTimesReferenced)
+   END
+END ManipulateReference ;
+
+
+(*
+   RemoveReference - remove the reference by quadruple, q, to wherever
+                     it was pointing to.
+*)
+
+PROCEDURE RemoveReference (q: CARDINAL) ;
+VAR
+   f, g: QuadFrame ;
+BEGIN
+   f := GetQF(q) ;
+   IF (f^.Operand3#0) AND (f^.Operand3<NextQuad)
+   THEN
+      g := GetQF(f^.Operand3) ;
+      Assert(g^.NoOfTimesReferenced#0) ;
+      DEC(g^.NoOfTimesReferenced)
+   END
+END RemoveReference ;
+
+
+(*
+   CountQuads - returns the number of quadruples.
+*)
+
+PROCEDURE CountQuads () : CARDINAL ;
+BEGIN
+   RETURN( NoOfQuads )
+END CountQuads ;
+
+
+(*
+   NewQuad - sets QuadNo to a new quadruple.
+*)
+
+PROCEDURE NewQuad (VAR QuadNo: CARDINAL) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   QuadNo := FreeList ;
+   IF InBounds (QuadArray, QuadNo) AND (GetIndice (QuadArray, QuadNo) # NIL)
+   THEN
+      f := GetIndice (QuadArray, QuadNo)
+   ELSE
+      NEW (f) ;
+      IF f=NIL
+      THEN
+         InternalError ('out of memory error trying to allocate a quadruple')
+      ELSE
+         INC (NoOfQuads) ;
+         PutIndice (QuadArray, QuadNo, f) ;
+         f^.NoOfTimesReferenced := 0
+      END
+   END ;
+   WITH f^ DO
+      Operator := DummyOp ;
+      Operand3 := 0 ;
+      Next := 0
+   END ;
+   INC (FreeList) ;
+   IF GrowInitialization < FreeList
+   THEN
+      GrowInitialization := FreeList
+   END
+END NewQuad ;
+
+
+(*
+   CheckVariableAt - checks to see whether, sym, was declared at a particular address.
+*)
+
+PROCEDURE CheckVariableAt (sym: CARDINAL) ;
+BEGIN
+   IF IsVar (sym) AND IsVariableAtAddress (sym)
+   THEN
+      IF GetMode (sym) = LeftValue
+      THEN
+         GenQuad (InitAddressOp, sym, NulSym, GetVariableAtAddress (sym))
+      ELSE
+         InternalError ('expecting lvalue for this variable which is declared at an explicit address')
+      END
+   END
+END CheckVariableAt ;
+
+
+(*
+   CheckVariablesAt - checks to see whether we need to initialize any pointers
+                      which point to variable declared at addresses.
+*)
+
+PROCEDURE CheckVariablesAt (scope: CARDINAL) ;
+BEGIN
+   ForeachLocalSymDo (scope, CheckVariableAt)
+END CheckVariablesAt ;
+
+
+(*
+   GetTurnInterrupts - returns the TurnInterrupts procedure function.
+*)
+
+PROCEDURE GetTurnInterrupts (tok: CARDINAL) : CARDINAL ;
+BEGIN
+   IF Iso
+   THEN
+      RETURN GetQualidentImport (tok,
+                                 MakeKey ('TurnInterrupts'), MakeKey ('COROUTINES'))
+   ELSE
+      RETURN GetQualidentImport (tok,
+                                 MakeKey ('TurnInterrupts'), MakeKey ('SYSTEM'))
+   END
+END GetTurnInterrupts ;
+
+
+(*
+   GetProtection - returns the PROTECTION data type.
+*)
+
+PROCEDURE GetProtection (tok: CARDINAL) : CARDINAL ;
+BEGIN
+   IF Iso
+   THEN
+      RETURN GetQualidentImport (tok,
+                                 MakeKey ('PROTECTION'), MakeKey ('COROUTINES'))
+   ELSE
+      RETURN GetQualidentImport (tok,
+                                 MakeKey ('PROTECTION'), MakeKey ('SYSTEM'))
+   END
+END GetProtection ;
+
+
+(*
+   CheckNeedPriorityBegin - checks to see whether we need to save the old
+                            module priority and change to another module
+                            priority.
+                            The current module initialization or procedure
+                            being built is defined by, scope. The module whose
+                            priority will be used is defined by, module.
+*)
+
+PROCEDURE CheckNeedPriorityBegin (tok: CARDINAL; scope, module: CARDINAL) ;
+VAR
+   ProcSym, old: CARDINAL ;
+BEGIN
+   IF GetPriority (module) # NulSym
+   THEN
+      (* module has been given a priority *)
+      ProcSym := GetTurnInterrupts (tok) ;
+      IF ProcSym # NulSym
+      THEN
+         old := MakeTemporary (tok, RightValue) ;
+         PutVar (old, GetProtection (tok)) ;
+
+         GenQuadO (tok, SavePriorityOp, old, scope, ProcSym, FALSE) ;
+         PushWord (PriorityStack, old)
+      END
+   END
+END CheckNeedPriorityBegin ;
+
+
+(*
+   CheckNeedPriorityEnd - checks to see whether we need to restore the old
+                          module priority.
+                          The current module initialization or procedure
+                          being built is defined by, scope.
+*)
+
+PROCEDURE CheckNeedPriorityEnd (tok: CARDINAL;
+                                scope, module: CARDINAL) ;
+VAR
+   ProcSym, old: CARDINAL ;
+BEGIN
+   IF GetPriority (module) # NulSym
+   THEN
+      (* module has been given a priority *)
+      ProcSym := GetTurnInterrupts (tok) ;
+      IF ProcSym # NulSym
+      THEN
+         old := PopWord (PriorityStack) ;
+         GenQuad (RestorePriorityOp, old, scope, ProcSym)
+      END
+   END
+END CheckNeedPriorityEnd ;
+
+
+(*
+   StartBuildDefFile - generates a StartFileDefOp quadruple indicating the file
+                       that has produced the subsequent quadruples.
+                       The code generator uses the StartDefFileOp quadruples
+                       to relate any error to the appropriate file.
+
+
+                       Entry                   Exit
+                       =====                   ====
+
+
+                Ptr ->                                        <- Ptr
+                       +------------+          +------------+
+                       | ModuleName |          | ModuleName |
+                       |------------|          |------------|
+
+
+                       Quadruples Produced
+
+                       q     StartDefFileOp  _  _  ModuleSym
+*)
+
+PROCEDURE StartBuildDefFile (tok: CARDINAL) ;
+VAR
+   ModuleName: Name ;
+BEGIN
+   PopT (ModuleName) ;
+   PushT (ModuleName) ;
+   GenQuadO (tok, StartDefFileOp, tok, NulSym, GetModule (ModuleName), FALSE)
+END StartBuildDefFile ;
+
+
+(*
+   StartBuildModFile - generates a StartModFileOp quadruple indicating the file
+                       that has produced the subsequent quadruples.
+                       The code generator uses the StartModFileOp quadruples
+                       to relate any error to the appropriate file.
+
+
+                       Entry                   Exit
+                       =====                   ====
+
+
+                Ptr ->                                        <- Ptr
+                       +------------+          +------------+
+                       | ModuleName |          | ModuleName |
+                       |------------|          |------------|
+
+
+                       Quadruples Produced
+
+                       q     StartModFileOp  lineno  filename  ModuleSym
+*)
+
+PROCEDURE StartBuildModFile (tok: CARDINAL) ;
+BEGIN
+   GenQuadO (tok, StartModFileOp, tok,
+             WORD (makekey (string (GetFileName ()))),
+             GetFileModule (), FALSE)
+END StartBuildModFile ;
+
+
+(*
+   EndBuildFile - generates an EndFileOp quadruple indicating the file
+                  that has produced the previous quadruples has ended.
+
+                  Entry                   Exit
+                  =====                   ====
+
+
+           Ptr ->                                        <- Ptr
+                  +------------+          +------------+
+                  | ModuleName |          | ModuleName |
+                  |------------|          |------------|
+
+
+                  Quadruples Produced
+
+                  q     EndFileOp  _  _  ModuleSym
+*)
+
+PROCEDURE EndBuildFile (tok: CARDINAL) ;
+VAR
+   ModuleName: Name ;
+BEGIN
+   ModuleName := OperandT (1) ;
+   GenQuadO (tok, EndFileOp, NulSym, NulSym, GetModule (ModuleName), FALSE)
+END EndBuildFile ;
+
+
+(*
+   StartBuildInit - Sets the start of initialization code of the
+                    current module to the next quadruple.
+*)
+
+PROCEDURE StartBuildInit (tok: CARDINAL) ;
+VAR
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopT(name) ;
+   ModuleSym := GetCurrentModule() ;
+   Assert(IsModule(ModuleSym) OR IsDefImp(ModuleSym)) ;
+   Assert(GetSymName(ModuleSym)=name) ;
+   PutModuleStartQuad(ModuleSym, NextQuad) ;
+   GenQuad(InitStartOp, tok, GetFileModule(), ModuleSym) ;
+   PushWord(ReturnStack, 0) ;
+   PushT(name) ;
+   CheckVariablesAt(ModuleSym) ;
+   CheckNeedPriorityBegin(tok, ModuleSym, ModuleSym) ;
+   PushWord(TryStack, NextQuad) ;
+   PushWord(CatchStack, 0) ;
+   IF HasExceptionBlock(ModuleSym)
+   THEN
+      GenQuad(TryOp, NulSym, NulSym, 0)
+   END
+END StartBuildInit ;
+
+
+(*
+   EndBuildInit - Sets the end initialization code of a module.
+*)
+
+PROCEDURE EndBuildInit (tok: CARDINAL) ;
+BEGIN
+   IF HasExceptionBlock(GetCurrentModule())
+   THEN
+      BuildRTExceptLeave (tok, TRUE) ;
+      GenQuadO (tok, CatchEndOp, NulSym, NulSym, NulSym, FALSE)
+   END ;
+   BackPatch (PopWord (ReturnStack), NextQuad) ;
+   CheckNeedPriorityEnd (tok, GetCurrentModule(), GetCurrentModule()) ;
+   PutModuleEndQuad (GetCurrentModule(), NextQuad) ;
+   CheckVariablesInBlock (GetCurrentModule()) ;
+   GenQuadO (tok, InitEndOp, tok, GetFileModule(), GetCurrentModule(), FALSE)
+END EndBuildInit ;
+
+
+(*
+   StartBuildFinally - Sets the start of finalization code of the
+                       current module to the next quadruple.
+*)
+
+PROCEDURE StartBuildFinally (tok: CARDINAL) ;
+VAR
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopT(name) ;
+   ModuleSym := GetCurrentModule() ;
+   Assert(IsModule(ModuleSym) OR IsDefImp(ModuleSym)) ;
+   Assert(GetSymName(ModuleSym)=name) ;
+   PutModuleFinallyStartQuad(ModuleSym, NextQuad) ;
+   GenQuadO (tok, FinallyStartOp, tok, GetFileModule(), ModuleSym, FALSE) ;
+   PushWord (ReturnStack, 0) ;
+   PushT (name) ;
+   (* CheckVariablesAt(ModuleSym) ; *)
+   CheckNeedPriorityBegin (tok, ModuleSym, ModuleSym) ;
+   PushWord (TryStack, NextQuad) ;
+   PushWord (CatchStack, 0) ;
+   IF HasExceptionFinally (ModuleSym)
+   THEN
+      GenQuadO (tok, TryOp, NulSym, NulSym, 0, FALSE)
+   END
+END StartBuildFinally ;
+
+
+(*
+   EndBuildFinally - Sets the end finalization code of a module.
+*)
+
+PROCEDURE EndBuildFinally (tok: CARDINAL) ;
+BEGIN
+   IF HasExceptionFinally(GetCurrentModule())
+   THEN
+      BuildRTExceptLeave (tok, TRUE) ;
+      GenQuadO (tok, CatchEndOp, NulSym, NulSym, NulSym, FALSE)
+   END ;
+   BackPatch (PopWord (ReturnStack), NextQuad) ;
+   CheckNeedPriorityEnd (tok, GetCurrentModule (), GetCurrentModule ()) ;
+   PutModuleFinallyEndQuad(GetCurrentModule (), NextQuad) ;
+   CheckVariablesInBlock (GetCurrentModule ()) ;
+   GenQuadO (tok, FinallyEndOp, tok, GetFileModule (),
+             GetCurrentModule(), FALSE)
+END EndBuildFinally ;
+
+
+(*
+   BuildRTExceptEnter - informs RTExceptions that we are about to enter the except state.
+*)
+
+PROCEDURE BuildRTExceptEnter (tok: CARDINAL) ;
+VAR
+   old,
+   ProcSym: CARDINAL ;
+BEGIN
+   IF Exceptions
+   THEN
+      (* now inform the Modula-2 runtime we are in the exception state *)
+      ProcSym := GetQualidentImport (tok,
+                                     MakeKey('SetExceptionState'), MakeKey('RTExceptions')) ;
+      IF ProcSym=NulSym
+      THEN
+         MetaErrorT0 (tok,
+                      '{%W}no procedure SetExceptionState found in RTExceptions which is needed to implement exception handling')
+      ELSE
+         old := MakeTemporary (tok, RightValue) ;
+         PutVar (old, Boolean) ;
+         GenQuadO (tok, SaveExceptionOp, old, NulSym, ProcSym, FALSE) ;
+         PushWord (ExceptStack, old)
+      END
+   ELSE
+      MetaErrorT0 (tok,
+                   '{%E}cannot use {%kEXCEPT} blocks with the -fno-exceptions flag')
+   END
+END BuildRTExceptEnter ;
+
+
+(*
+   BuildRTExceptLeave - informs RTExceptions that we are about to leave the except state.
+                        If, destroy, is TRUE then pop the ExceptStack.
+*)
+
+PROCEDURE BuildRTExceptLeave (tok: CARDINAL; destroy: BOOLEAN) ;
+VAR
+   old,
+   ProcSym: CARDINAL ;
+BEGIN
+   IF Exceptions
+   THEN
+      (* now inform the Modula-2 runtime we are in the exception state *)
+      ProcSym := GetQualidentImport (tok,
+                                     MakeKey('SetExceptionState'), MakeKey('RTExceptions')) ;
+      IF ProcSym#NulSym
+      THEN
+         IF destroy
+         THEN
+            old := PopWord (ExceptStack)
+         ELSE
+            old := PeepWord (ExceptStack, 1)
+         END ;
+         GenQuadO (tok, RestoreExceptionOp, old, NulSym, ProcSym, FALSE)
+      END
+   ELSE
+      (* no need for an error message here as it will be generated in the Enter procedure above *)
+   END
+END BuildRTExceptLeave ;
+
+
+(*
+   BuildExceptInitial - adds an CatchBeginOp, CatchEndOp quadruple
+                        in the current block.
+*)
+
+PROCEDURE BuildExceptInitial (tok: CARDINAL) ;
+VAR
+   previous: CARDINAL ;
+BEGIN
+   (* we have finished the 'try' block, so now goto the return
+      section which will tidy up (any) priorities before returning.
+   *)
+   GenQuadO (tok, GotoOp, NulSym, NulSym, PopWord(ReturnStack), FALSE) ;
+   PushWord (ReturnStack, NextQuad-1) ;
+   (*
+      this is the 'catch' block.
+   *)
+   BackPatch (PeepWord (TryStack, 1), NextQuad) ;
+   GenQuadO (tok, CatchBeginOp, NulSym, NulSym, NulSym, FALSE) ;
+   previous := PopWord (CatchStack) ;
+   IF previous # 0
+   THEN
+      MetaErrorT0 (tok,
+                   '{%E}only allowed one EXCEPT statement in a procedure or module')
+   END ;
+   PushWord (CatchStack, NextQuad-1) ;
+   BuildRTExceptEnter (tok)
+END BuildExceptInitial ;
+
+
+(*
+   BuildExceptFinally - adds an ExceptOp quadruple in a modules
+                        finally block.
+*)
+
+PROCEDURE BuildExceptFinally (tok: CARDINAL) ;
+BEGIN
+   BuildExceptInitial (tok)
+END BuildExceptFinally ;
+
+
+(*
+   BuildExceptProcedure - adds an ExceptOp quadruple in a procedure
+                          block.
+*)
+
+PROCEDURE BuildExceptProcedure (tok: CARDINAL) ;
+BEGIN
+   BuildExceptInitial (tok)
+END BuildExceptProcedure ;
+
+
+(*
+   BuildRetry - adds an RetryOp quadruple.
+*)
+
+PROCEDURE BuildRetry (tok: CARDINAL);
+BEGIN
+   IF PeepWord (CatchStack, 1) = 0
+   THEN
+      MetaErrorT0 (tok,
+                   '{%E}the {%kRETRY} statement must occur after an {%kEXCEPT} statement in the same module or procedure block')
+   ELSE
+      BuildRTExceptLeave (tok, FALSE) ;
+      GenQuadO (tok, RetryOp, NulSym, NulSym, PeepWord (TryStack, 1), FALSE)
+   END
+END BuildRetry ;
+
+
+(*
+   SafeRequestSym - only used during scaffold to get argc, argv, envp.
+                    It attempts to get symbol name from the current scope(s) and if
+                    it fails then it falls back onto default constants.
+*)
+
+PROCEDURE SafeRequestSym (tok: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   sym := GetSym (name) ;
+   IF sym = NulSym
+   THEN
+      IF name = MakeKey ('argc')
+      THEN
+         RETURN MakeConstLit (tok, MakeKey ('0'), ZType)
+      ELSIF (name = MakeKey ('argv')) OR (name = MakeKey ('envp'))
+      THEN
+         RETURN Nil
+      ELSE
+         InternalError ('not expecting this parameter name') ;
+         RETURN Nil
+      END
+   END ;
+   RETURN sym
+END SafeRequestSym ;
+
+
+(*
+   callRequestDependant - create a call:
+                          RequestDependant (GetSymName (modulesym), GetSymName (depModuleSym));
+*)
+
+PROCEDURE callRequestDependant (tokno: CARDINAL;
+                                moduleSym, depModuleSym: CARDINAL;
+                                requestDep: CARDINAL) ;
+BEGIN
+   Assert (requestDep # NulSym) ;
+   PushTtok (requestDep, tokno) ;
+   PushTF (Adr, Address) ;
+   PushTtok (MakeConstLitString (tokno, GetSymName (moduleSym)), tokno) ;
+   PushT (1) ;
+   BuildAdrFunction ;
+
+   IF depModuleSym = NulSym
+   THEN
+      PushTF (Nil, Address)
+   ELSE
+      PushTF (Adr, Address) ;
+      PushTtok (MakeConstLitString (tokno, GetSymName (depModuleSym)), tokno) ;
+      PushT (1) ;
+      BuildAdrFunction
+   END ;
+
+   PushT (2) ;
+   BuildProcedureCall (tokno)
+END callRequestDependant ;
+
+
+(*
+   ForeachImportInDepDo -
+*)
+
+PROCEDURE ForeachImportInDepDo (importStatements: List; moduleSym, requestDep: CARDINAL) ;
+VAR
+   i, j,
+   m, n    : CARDINAL ;
+   imported,
+   stmt     : CARDINAL ;
+   l       : List ;
+BEGIN
+   IF importStatements # NIL
+   THEN
+      i := 1 ;
+      n := NoOfItemsInList (importStatements) ;
+      WHILE i <= n DO
+         stmt := GetItemFromList (importStatements, i) ;
+         Assert (IsImportStatement (stmt)) ;
+         l := GetImportStatementList (stmt) ;
+         j := 1 ;
+         m := NoOfItemsInList (l) ;
+         WHILE j <= m DO
+            imported := GetItemFromList (l, j) ;
+            Assert (IsImport (imported)) ;
+            callRequestDependant (GetImportDeclared (imported),
+                                  moduleSym, GetImportModule (imported),
+                                  requestDep) ;
+            INC (j) ;
+         END ;
+         INC (i)
+      END
+   END
+END ForeachImportInDepDo ;
+
+
+(*
+   ForeachImportedModuleDo -
+*)
+
+PROCEDURE ForeachImportedModuleDo (moduleSym, requestDep: CARDINAL) ;
+VAR
+   importStatements: List ;
+BEGIN
+   importStatements := GetModuleModImportStatementList (moduleSym) ;
+   ForeachImportInDepDo (importStatements, moduleSym, requestDep) ;
+   importStatements := GetModuleDefImportStatementList (moduleSym) ;
+   ForeachImportInDepDo (importStatements, moduleSym, requestDep)
+END ForeachImportedModuleDo ;
+
+
+(*
+   BuildM2DepFunction - creates the dependency graph procedure using IR:
+                        static void
+                        dependencies (void)
+                        {
+                           M2RTS_RequestDependant (module_name, "b");
+                           M2RTS_RequestDependant (module_name, NULL);
+                        }
+*)
+
+PROCEDURE BuildM2DepFunction (tokno: CARDINAL; moduleSym: CARDINAL) ;
+VAR
+   requestDep,
+   ctor, init, fini, dep: CARDINAL ;
+BEGIN
+   IF ScaffoldDynamic
+   THEN
+      (* Scaffold required and dynamic dependency graph should be produced.  *)
+      GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+      PushT (dep) ;
+      BuildProcedureStart ;
+      BuildProcedureBegin ;
+      StartScope (dep) ;
+      requestDep := GetQualidentImport (tokno,
+                                        MakeKey ("RequestDependant"),
+                                        MakeKey ("M2RTS")) ;
+      IF requestDep # NulSym
+      THEN
+         ForeachImportedModuleDo (moduleSym, requestDep) ;
+         callRequestDependant (tokno, moduleSym, NulSym, requestDep)
+      END ;
+      EndScope ;
+      BuildProcedureEnd ;
+      PopN (1)
+   END
+END BuildM2DepFunction ;
+
+
+(*
+   BuildM2LinkFunction - creates the _M2_link procedure which will
+                         cause the linker to pull in all the module ctors.
+*)
+
+PROCEDURE BuildM2LinkFunction (tokno: CARDINAL) ;
+BEGIN
+   IF ScaffoldDynamic
+   THEN
+      IF linkFunction # NulSym
+      THEN
+         (* void
+           _M2_link (void)
+           {
+              for each module in uselist do
+                 PROC foo_%d = _M2_module_ctor
+              done
+           }.  *)
+         PushT (linkFunction) ;
+         BuildProcedureStart ;
+         BuildProcedureBegin ;
+         StartScope (linkFunction) ;
+         PopulateCtorArray (tokno) ;
+         EndScope ;
+         BuildProcedureEnd ;
+         PopN (1)
+      END
+   END
+END BuildM2LinkFunction ;
+
+
+(*
+   BuildTry - build the try statement for main.
+*)
+
+PROCEDURE BuildTry (tokno: CARDINAL) ;
+BEGIN
+   IF Exceptions
+   THEN
+      PushWord (TryStack, NextQuad) ;
+      PushWord (CatchStack, 0) ;
+      GenQuadO (tokno, TryOp, NulSym, NulSym, 0, FALSE)
+   END
+END BuildTry ;
+
+
+(*
+   BuildExcept - build the except block for main.
+*)
+
+PROCEDURE BuildExcept (tokno: CARDINAL) ;
+VAR
+   catchProcedure: CARDINAL ;
+BEGIN
+   IF Exceptions
+   THEN
+      BuildExceptInitial (tokno) ;
+      catchProcedure := GetQualidentImport (tokno,
+                                            MakeKey ('DefaultErrorCatch'),
+                                            MakeKey ('RTExceptions')) ;
+      IF catchProcedure # NulSym
+      THEN
+         PushTtok (catchProcedure, tokno) ;
+         PushT (0) ;
+         BuildProcedureCall (tokno)
+      END ;
+      BuildRTExceptLeave (tokno, TRUE) ;
+      GenQuadO (tokno, CatchEndOp, NulSym, NulSym, NulSym, FALSE)
+   END
+END BuildExcept ;
+
+
+(*
+   BuildM2MainFunction - creates the main function with appropriate calls to the scaffold.
+*)
+
+PROCEDURE BuildM2MainFunction (tokno: CARDINAL) ;
+BEGIN
+   IF (ScaffoldDynamic OR ScaffoldStatic) AND (NOT SharedFlag)
+   THEN
+      (* Scaffold required and main should be produced.  *)
+      (*
+         int
+         main (int argc, char *argv[], char *envp[])
+         {
+            try {
+               _M2_init (argc, argv, envp);
+               _M2_fini (argc, argv, envp);
+               return 0;
+            }
+            catch (...) {
+               RTExceptions_DefaultErrorCatch ();
+            }
+         }
+      *)
+      PushT (mainFunction) ;
+      BuildProcedureStart ;
+      BuildProcedureBegin ;
+      StartScope (mainFunction) ;
+      BuildTry (tokno) ;
+      (* _M2_init (argc, argv, envp);  *)
+      PushTtok (initFunction, tokno) ;
+      PushTtok (RequestSym (tokno, MakeKey ("argc")), tokno) ;
+      PushTtok (RequestSym (tokno, MakeKey ("argv")), tokno) ;
+      PushTtok (RequestSym (tokno, MakeKey ("envp")), tokno) ;
+      PushT (3) ;
+      BuildProcedureCall (tokno) ;
+
+      (* _M2_fini (argc, argv, envp);  *)
+      PushTtok (finiFunction, tokno) ;
+      PushTtok (RequestSym (tokno, MakeKey ("argc")), tokno) ;
+      PushTtok (RequestSym (tokno, MakeKey ("argv")), tokno) ;
+      PushTtok (RequestSym (tokno, MakeKey ("envp")), tokno) ;
+      PushT (3) ;
+      BuildProcedureCall (tokno) ;
+
+      PushZero (tokno, Integer) ;
+      BuildReturn (tokno) ;
+      BuildExcept (tokno) ;
+      EndScope ;
+      BuildProcedureEnd ;
+      PopN (1)
+   END
+END BuildM2MainFunction ;
+
+
+(*
+   BuildM2InitFunction -
+*)
+
+PROCEDURE BuildM2InitFunction (tok: CARDINAL; moduleSym: CARDINAL) ;
+VAR
+   constructModules: CARDINAL ;
+BEGIN
+   IF ScaffoldDynamic OR ScaffoldStatic
+   THEN
+      (* Scaffold required and main should be produced.  *)
+      (* int
+         _M2_init (int argc, char *argv[], char *envp[])
+         {
+            M2RTS_ConstructModules (module_name, argc, argv, envp);
+         }  *)
+      PushT (initFunction) ;
+      BuildProcedureStart ;
+      BuildProcedureBegin ;
+      StartScope (initFunction) ;
+      IF ScaffoldDynamic
+      THEN
+         IF linkFunction # NulSym
+         THEN
+            (* _M2_link ();  *)
+            PushTtok (linkFunction, tok) ;
+            PushT (0) ;
+            BuildProcedureCall (tok)
+         END ;
+
+         (* Lookup ConstructModules and call it.  *)
+         constructModules := GetQualidentImport (tok,
+                                                 MakeKey ("ConstructModules"),
+                                                 MakeKey ("M2RTS")) ;
+         IF constructModules # NulSym
+         THEN
+            (* ConstructModules (module_name, argc, argv, envp);  *)
+            PushTtok (constructModules, tok) ;
+
+            PushTF(Adr, Address) ;
+            PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
+            PushT(1) ;
+            BuildAdrFunction ;
+
+            PushTtok (SafeRequestSym (tok, MakeKey ("argc")), tok) ;
+            PushTtok (SafeRequestSym (tok, MakeKey ("argv")), tok) ;
+            PushTtok (SafeRequestSym (tok, MakeKey ("envp")), tok) ;
+            PushT (4) ;
+            BuildProcedureCall (tok) ;
+         END
+      ELSIF ScaffoldStatic
+      THEN
+         ForeachModuleCallInit (tok,
+                                SafeRequestSym (tok, MakeKey ("argc")),
+                                SafeRequestSym (tok, MakeKey ("argv")),
+                                SafeRequestSym (tok, MakeKey ("envp")))
+      END ;
+      EndScope ;
+      BuildProcedureEnd ;
+      PopN (1)
+   END
+END BuildM2InitFunction ;
+
+
+(*
+   BuildM2FiniFunction -
+*)
+
+PROCEDURE BuildM2FiniFunction (tok: CARDINAL; moduleSym: CARDINAL) ;
+VAR
+   deconstructModules: CARDINAL ;
+BEGIN
+   IF ScaffoldDynamic OR ScaffoldStatic
+   THEN
+      (* Scaffold required and main should be produced.  *)
+      PushT (finiFunction) ;
+      BuildProcedureStart ;
+      BuildProcedureBegin ;
+      StartScope (finiFunction) ;
+      IF ScaffoldDynamic
+      THEN
+         (* static void
+            _M2_finish (int argc, char *argv[], char *envp[])
+            {
+              M2RTS_DeconstructModules (module_name, argc, argv, envp);
+            }  *)
+         deconstructModules := GetQualidentImport (tok,
+                                                   MakeKey ("DeconstructModules"),
+                                                   MakeKey ("M2RTS")) ;
+         IF deconstructModules # NulSym
+         THEN
+            (* DeconstructModules (module_name, argc, argv, envp);  *)
+            PushTtok (deconstructModules, tok) ;
+
+            PushTF(Adr, Address) ;
+            PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
+            PushT(1) ;
+            BuildAdrFunction ;
+
+            PushTtok (SafeRequestSym (tok, MakeKey ("argc")), tok) ;
+            PushTtok (SafeRequestSym (tok, MakeKey ("argv")), tok) ;
+            PushTtok (SafeRequestSym (tok, MakeKey ("envp")), tok) ;
+            PushT (4) ;
+            BuildProcedureCall (tok)
+         END
+      ELSIF ScaffoldStatic
+      THEN
+         ForeachModuleCallFinish (tok,
+                                  SafeRequestSym (tok, MakeKey ("argc")),
+                                  SafeRequestSym (tok, MakeKey ("argv")),
+                                  SafeRequestSym (tok, MakeKey ("envp")))
+      END ;
+      EndScope ;
+      BuildProcedureEnd ;
+      PopN (1)
+   END
+END BuildM2FiniFunction ;
+
+
+(*
+   BuildM2CtorFunction - create a constructor function associated with moduleSym.
+
+                         void
+                         ctorFunction ()
+                         {
+                           M2RTS_RegisterModule (GetSymName (moduleSym),
+                                                 init, fini, dependencies);
+                         }
+*)
+
+PROCEDURE BuildM2CtorFunction (tok: CARDINAL; moduleSym: CARDINAL) ;
+VAR
+   RegisterModule       : CARDINAL ;
+   ctor, init, fini, dep: CARDINAL ;
+BEGIN
+   IF ScaffoldDynamic
+   THEN
+      GetModuleCtors (moduleSym, ctor, init, fini, dep) ;
+      IF ctor # NulSym
+      THEN
+         Assert (IsProcedure (ctor)) ;
+         PushT (ctor) ;
+         BuildProcedureStart ;
+         BuildProcedureBegin ;
+         StartScope (ctor) ;
+         RegisterModule := GetQualidentImport (tok,
+                                               MakeKey ("RegisterModule"),
+                                               MakeKey ("M2RTS")) ;
+         IF RegisterModule # NulSym
+         THEN
+            (* RegisterModule (module_name, init, fini, dependencies);  *)
+            PushTtok (RegisterModule, tok) ;
+
+            PushTF (Adr, Address) ;
+            PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
+            PushT (1) ;
+            BuildAdrFunction ;
+
+            PushTtok (init, tok) ;
+            PushTtok (fini, tok) ;
+            PushTtok (dep, tok) ;
+            PushT (4) ;
+            BuildProcedureCall (tok)
+         END ;
+         EndScope ;
+         BuildProcedureEnd ;
+         PopN (1)
+      END
+   END
+END BuildM2CtorFunction ;
+
+
+(*
+   BuildScaffold - generate the main, init, finish functions if
+                   no -c and this is the application module.
+*)
+
+PROCEDURE BuildScaffold (tok: CARDINAL; moduleSym: CARDINAL) ;
+BEGIN
+   IF GetMainModule () = moduleSym
+   THEN
+      DeclareScaffold (tok) ;
+      IF (ScaffoldMain OR (NOT cflag))
+      THEN
+         (* There are module init/fini functions and
+            application init/fini functions.
+            Here we create the application pair.  *)
+         BuildM2LinkFunction (tok) ;
+         BuildM2MainFunction (tok) ;
+         BuildM2InitFunction (tok, moduleSym) ;  (* Application init.  *)
+         BuildM2FiniFunction (tok, moduleSym) ;  (* Application fini.  *)
+      END ;
+      BuildM2DepFunction (tok, moduleSym) ;  (* Per module dependency.  *)
+      (* Each module needs a ctor to register the module
+         init/finish/dep with M2RTS.  *)
+      BuildM2CtorFunction (tok, moduleSym)
+   ELSIF WholeProgram
+   THEN
+      DeclareScaffold (tok) ;
+      BuildM2DepFunction (tok, moduleSym) ;  (* Per module dependency.  *)
+      (* Each module needs a ctor to register the module
+         init/finish/dep with M2RTS.  *)
+      BuildM2CtorFunction (tok, moduleSym)
+   END
+END BuildScaffold ;
+
+
+(*
+   BuildModuleStart - starts current module scope.
+*)
+
+PROCEDURE BuildModuleStart (tok: CARDINAL) ;
+BEGIN
+   GenQuadO (tok,
+             ModuleScopeOp, tok,
+             WORD (makekey (string (GetFileName ()))), GetCurrentModule (), FALSE)
+END BuildModuleStart ;
+
+
+(*
+   StartBuildInnerInit - Sets the start of initialization code of the
+                         inner module to the next quadruple.
+*)
+
+PROCEDURE StartBuildInnerInit (tok: CARDINAL) ;
+BEGIN
+   PutModuleStartQuad (GetCurrentModule(), NextQuad) ;
+   GenQuadO (tok, InitStartOp, tok, NulSym, GetCurrentModule(), FALSE) ;
+   PushWord (ReturnStack, 0) ;
+   CheckNeedPriorityBegin (tok, GetCurrentModule(), GetCurrentModule()) ;
+   PushWord (TryStack, NextQuad) ;
+   PushWord (CatchStack, 0) ;
+   IF HasExceptionFinally (GetCurrentModule())
+   THEN
+      GenQuadO (tok, TryOp, NulSym, NulSym, 0, FALSE)
+   END
+END StartBuildInnerInit ;
+
+
+(*
+   EndBuildInnerInit - Sets the end initialization code of a module.
+*)
+
+PROCEDURE EndBuildInnerInit (tok: CARDINAL) ;
+BEGIN
+   IF HasExceptionBlock (GetCurrentModule())
+   THEN
+      BuildRTExceptLeave (tok, TRUE) ;
+      GenQuadO (tok, CatchEndOp, NulSym, NulSym, NulSym, FALSE)
+   END ;
+   PutModuleEndQuad (GetCurrentModule(), NextQuad) ;
+   CheckVariablesInBlock (GetCurrentModule ()) ;
+   BackPatch (PopWord (ReturnStack), NextQuad) ;
+   CheckNeedPriorityEnd (tok, GetCurrentModule (), GetCurrentModule ()) ;
+   GenQuadO (tok, InitEndOp, tok, NulSym, GetCurrentModule (), FALSE)
+END EndBuildInnerInit ;
+
+
+(*
+   BuildModulePriority - assigns the current module with a priority
+                         from the top of stack.
+
+                         Entry                   Exit
+                         =====                   ====
+
+
+                  Ptr ->                         Empty
+                         +------------+
+                         | Priority   |
+                         |------------|
+*)
+
+PROCEDURE BuildModulePriority ;
+VAR
+   Priority: CARDINAL ;
+BEGIN
+   PopT (Priority) ;
+   PutPriority (GetCurrentModule (), Priority)
+END BuildModulePriority ;
+
+
+(*
+   ForLoopAnalysis - checks all the FOR loops for index variable manipulation
+                     and dangerous usage outside the loop.
+*)
+
+PROCEDURE ForLoopAnalysis ;
+VAR
+   i, n   : CARDINAL ;
+   forDesc: ForLoopInfo ;
+BEGIN
+   IF Pedantic
+   THEN
+      n := HighIndice (ForInfo) ;
+      i := 1 ;
+      WHILE i <= n DO
+         forDesc := GetIndice (ForInfo, i) ;
+         CheckForIndex (forDesc) ;
+         INC (i)
+      END
+   END
+END ForLoopAnalysis ;
+
+
+(*
+   AddForInfo - adds the description of the FOR loop into the record list.
+                This is used if -pedantic is turned on to check index variable
+                usage.
+*)
+
+PROCEDURE AddForInfo (Start, End, IncQuad: CARDINAL; Sym: CARDINAL; idtok: CARDINAL) ;
+VAR
+   forDesc: ForLoopInfo ;
+BEGIN
+   IF Pedantic
+   THEN
+      NEW (forDesc) ;
+      WITH forDesc^ DO
+         IncrementQuad := IncQuad ;
+         StartOfForLoop := Start ;
+         EndOfForLoop := End ;
+         ForLoopIndex := Sym ;
+         IndexTok := idtok
+      END ;
+      IncludeIndiceIntoIndex (ForInfo, forDesc)
+   END
+END AddForInfo ;
+
+
+(*
+   CheckForIndex - checks the quadruples: Start..End to see whether a
+                   for loop index is manipulated by the programmer.
+                   It generates a warning if this is the case.
+                   It also checks to see whether the IndexSym is read
+                   immediately outside the loop in which case a warning
+                   is issued.
+*)
+
+PROCEDURE CheckForIndex (forDesc: ForLoopInfo) ;
+VAR
+   ReadStart, ReadEnd,
+   WriteStart, WriteEnd: CARDINAL ;
+BEGIN
+   GetWriteLimitQuads (forDesc^.ForLoopIndex, RightValue, forDesc^.StartOfForLoop, forDesc^.EndOfForLoop, WriteStart, WriteEnd) ;
+   IF (WriteStart < forDesc^.IncrementQuad) AND (WriteStart > forDesc^.StartOfForLoop)
+   THEN
+      MetaErrorT1 (forDesc^.IndexTok,
+                   '{%kFOR} loop index variable {%1Wad} is being manipulated inside the loop',
+                   forDesc^.ForLoopIndex) ;
+      MetaErrorT1 (QuadToTokenNo (WriteStart),
+                   '{%kFOR} loop index variable {%1Wad} is being manipulated, this is considered bad practice and may cause unknown program behaviour',
+                   forDesc^.ForLoopIndex)
+   END ;
+   GetWriteLimitQuads (forDesc^.ForLoopIndex, RightValue, forDesc^.EndOfForLoop, 0, WriteStart, WriteEnd) ;
+   GetReadLimitQuads (forDesc^.ForLoopIndex, RightValue, forDesc^.EndOfForLoop, 0, ReadStart, ReadEnd) ;
+   IF (ReadStart#0) AND ((ReadStart < WriteStart) OR (WriteStart = 0))
+   THEN
+      MetaErrorT1 (forDesc^.IndexTok,
+                   '{%kFOR} loop index variable {%1Wad} is being read outside the FOR loop (without being reset)',
+                   forDesc^.ForLoopIndex) ;
+      MetaErrorT1 (QuadToTokenNo (ReadStart),
+                   '{%kFOR} loop index variable {%1Wad} is being read outside the FOR loop (without being reset), this is considered extremely bad practice and may cause unknown program behaviour',
+                   forDesc^.ForLoopIndex)
+   END
+END CheckForIndex ;
+
+
+(*
+   GetCurrentFunctionName - returns the name for the current __FUNCTION__
+*)
+
+(*
+PROCEDURE GetCurrentFunctionName () : Name ;
+VAR
+   s: String ;
+   n: Name ;
+BEGIN
+   IF CurrentProc=NulSym
+   THEN
+      s := InitStringCharStar(KeyToCharStar(GetSymName(GetCurrentModule()))) ;
+      s := Sprintf1(Mark(InitString('module %s initialization')), s) ;
+      n := makekey(string(s)) ;
+      s := KillString(s) ;
+      RETURN( n )
+   ELSE
+      RETURN( GetSymName(CurrentProc) )
+   END
+END GetCurrentFunctionName ;
+*)
+
+
+(*
+   BuildRange - generates a RangeCheckOp quad with, r, as its operand.
+*)
+
+PROCEDURE BuildRange (r: CARDINAL) ;
+BEGIN
+   GenQuad (RangeCheckOp, WORD (GetLineNo ()), NulSym, r)
+END BuildRange ;
+
+
+(*
+   BuildError - generates a ErrorOp quad, indicating that if this
+                quadruple is reachable, then a runtime error would
+                occur.
+*)
+
+PROCEDURE BuildError (r: CARDINAL) ;
+BEGIN
+   GenQuad (ErrorOp, WORD (GetLineNo ()), NulSym, r)
+END BuildError ;
+
+
+(*
+   CheckPointerThroughNil - builds a range quadruple, providing, sym, is
+                            a candidate for checking against NIL.
+                            This range quadruple is only expanded into
+                            code during the code generation phase
+                            thus allowing limited compile time checking.
+*)
+
+PROCEDURE CheckPointerThroughNil (tokpos: CARDINAL; sym: CARDINAL) ;
+BEGIN
+   IF IsVar (sym) AND GetVarPointerCheck (sym)
+   THEN
+      (* PutVarPointerCheck(sym, FALSE) ;  (* so we do not detect this again *) *)
+      BuildRange (InitPointerRangeCheck (tokpos, sym, GetMode (sym) = LeftValue))
+   END
+END CheckPointerThroughNil ;
+
+
+(*
+   CollectLow - returns the low of the subrange value.
+*)
+
+PROCEDURE CollectLow (sym: CARDINAL) : CARDINAL ;
+VAR
+   low, high: CARDINAL ;
+BEGIN
+   IF IsSubrange (sym)
+   THEN
+      GetSubrange (sym, high, low) ;
+      RETURN low
+   ELSE
+      InternalError  ('expecting Subrange symbol')
+   END
+END CollectLow ;
+
+
+(*
+   CollectHigh - returns the high of the subrange value, sym.
+*)
+
+PROCEDURE CollectHigh (sym: CARDINAL) : CARDINAL ;
+VAR
+   low, high: CARDINAL ;
+BEGIN
+   IF IsSubrange (sym)
+   THEN
+      GetSubrange (sym, high, low) ;
+      RETURN high
+   ELSE
+      InternalError  ('expecting Subrange symbol')
+   END
+END CollectHigh ;
+
+
+(*
+   BackPatchSubrangesAndOptParam - runs through all the quadruples and finds SubrangeLow or SubrangeHigh
+                                   quadruples and replaces it by an assignment to the Low or High component
+                                   of the subrange type.
+
+                                   Input:
+                                   SubrangeLow    op1     op3         (* op3 is a subrange *)
+
+                                   Output:
+                                   Becomes        op1     low
+
+                                   Input:
+                                   SubrangeHigh   op1     op3         (* op3 is a subrange *)
+
+                                   Output:
+                                   Becomes        op1     high
+
+                                   Input:
+                                   OptParam       op1     op2    op3
+
+                                   Output:
+                                   Param          op1     op2    GetOptArgInit(op3)
+*)
+
+PROCEDURE BackPatchSubrangesAndOptParam ;
+VAR
+   f: QuadFrame ;
+   q: CARDINAL ;
+BEGIN
+   q := GetFirstQuad () ;
+   IF q # 0
+   THEN
+      REPEAT
+         f := GetQF (q) ;
+         WITH f^ DO
+            CASE Operator OF
+
+            SubrangeLowOp :  Operand3 := CollectLow (Operand3) ;
+                             Operator := BecomesOp |
+            SubrangeHighOp:  Operand3 := CollectHigh (Operand3) ;
+                             Operator := BecomesOp |
+            OptParamOp    :  Operand3 := GetOptArgInit (Operand3) ;
+                             Operator := ParamOp
+
+            ELSE
+            END ;
+            q := Next
+         END
+      UNTIL q = 0
+   END
+END BackPatchSubrangesAndOptParam ;
+
+
+(*
+   CheckCompatibleWithBecomes - checks to see that symbol, sym, is
+                                compatible with the := operator.
+*)
+
+PROCEDURE CheckCompatibleWithBecomes (des, expr,
+                                      destok, exprtok: CARDINAL) ;
+BEGIN
+   IF IsType (des)
+   THEN
+      MetaErrorT1 (destok,
+                   'an assignment cannot assign a value to a type {%1a}', des)
+   ELSIF IsProcedure (des)
+   THEN
+      MetaErrorT1 (destok,
+                   'an assignment cannot assign a value to a procedure {%1a}', des)
+   ELSIF IsFieldEnumeration (des)
+   THEN
+      MetaErrorT1 (destok,
+                   'an assignment cannot assign a value to an enumeration field {%1a}', des)
+   END ;
+   IF IsPseudoBaseProcedure (expr) OR IsPseudoBaseFunction (expr)
+   THEN
+      MetaErrorT1 (exprtok,
+                  'an assignment cannot assign a {%1d} {%1a}', expr)
+   END
+END CheckCompatibleWithBecomes ;
+
+
+(*
+   BuildAssignmentWithoutBounds - calls BuildAssignment but makes sure we do not
+                                  check bounds.
+*)
+
+PROCEDURE BuildAssignmentWithoutBounds (tok: CARDINAL; checkTypes, checkOverflow: BOOLEAN) ;
+VAR
+   old: BOOLEAN ;
+BEGIN
+   old := MustNotCheckBounds ;
+   MustNotCheckBounds := TRUE ;
+   doBuildAssignment (tok, checkTypes, checkOverflow) ;
+   MustNotCheckBounds := old
+END BuildAssignmentWithoutBounds ;
+
+
+(*
+   MarkArrayWritten - marks, Array, as being written.
+*)
+
+PROCEDURE MarkArrayWritten (Array: CARDINAL) ;
+BEGIN
+   IF (Array#NulSym) AND IsVarAParam(Array)
+   THEN
+      PutVarWritten(Array, TRUE)
+   END
+END MarkArrayWritten ;
+
+
+(*
+   MarkAsReadWrite - marks the variable or parameter as being
+                     read/write.
+*)
+
+PROCEDURE MarkAsReadWrite (sym: CARDINAL) ;
+BEGIN
+   IF (sym#NulSym) AND IsVar(sym)
+   THEN
+      PutReadQuad (sym, RightValue, NextQuad) ;
+      PutWriteQuad (sym, RightValue, NextQuad)
+   END
+END MarkAsReadWrite ;
+
+
+(*
+   MarkAsRead - marks the variable or parameter as being read.
+*)
+
+PROCEDURE MarkAsRead (sym: CARDINAL) ;
+BEGIN
+   IF (sym#NulSym) AND IsVar(sym)
+   THEN
+      PutReadQuad (sym, RightValue, NextQuad)
+   END
+END MarkAsRead ;
+
+
+(*
+   MarkAsWrite - marks the variable or parameter as being written.
+*)
+
+PROCEDURE MarkAsWrite (sym: CARDINAL) ;
+BEGIN
+   IF (sym#NulSym) AND IsVar(sym)
+   THEN
+      PutWriteQuad(sym, RightValue, NextQuad)
+   END
+END MarkAsWrite ;
+
+
+(*
+   doVal - return an expression which is VAL(type, expr).  If
+           expr is a constant then return expr.
+*)
+
+PROCEDURE doVal (type, expr: CARDINAL) : CARDINAL ;
+BEGIN
+   IF (NOT IsConst(expr)) AND (SkipType(type)#GetDType(expr))
+   THEN
+      PushTF(Convert, NulSym) ;
+      PushT(SkipType(type)) ;
+      PushT(expr) ;
+      PushT(2) ;          (* Two parameters *)
+      BuildConvertFunction ;
+      PopT(expr)
+   END ;
+   RETURN( expr )
+END doVal ;
+
+
+(*
+   MoveWithMode -
+*)
+
+PROCEDURE MoveWithMode (tokno: CARDINAL;
+                        Des, Exp, Array: CARDINAL;
+                        destok, exptok: CARDINAL;
+                        checkOverflow: BOOLEAN) ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   IF IsConstString(Exp) AND IsConst(Des)
+   THEN
+      GenQuadOtok (tokno, BecomesOp, Des, NulSym, Exp, TRUE,
+                   tokno, destok, exptok) ;
+      PutConstString (tokno, Des, GetString (Exp))
+   ELSE
+      IF GetMode(Des)=RightValue
+      THEN
+         IF GetMode(Exp)=LeftValue
+         THEN
+            CheckPointerThroughNil (tokno, Exp) ;  (*    Des = *Exp    *)
+            doIndrX (tokno, Des, Exp)
+         ELSE
+            GenQuadOtok (tokno, BecomesOp, Des, NulSym, Exp, TRUE,
+                         tokno, destok, exptok)
+         END
+      ELSIF GetMode(Des)=LeftValue
+      THEN
+         MarkArrayWritten (Array) ;
+         IF GetMode(Exp) = LeftValue
+         THEN
+            t := MakeTemporary (tokno, RightValue) ;
+            PutVar(t, GetSType(Exp)) ;
+            CheckPointerThroughNil (tokno, Exp) ;
+            doIndrX (tokno, t, Exp) ;
+            CheckPointerThroughNil (tokno, Des) ;  (*    *Des = Exp    *)
+            GenQuadO (tokno, XIndrOp, Des, GetSType (Des), doVal (GetSType (Des), t),
+                      checkOverflow)
+         ELSE
+            CheckPointerThroughNil (tokno, Des) ;  (*    *Des = Exp    *)
+            GenQuadO (tokno, XIndrOp, Des, GetSType (Des), doVal (GetSType (Des), Exp),
+                      checkOverflow)
+         END
+      ELSE
+         GenQuadOtok (tokno, BecomesOp, Des, NulSym, Exp, TRUE,
+                      tokno, destok, exptok)
+      END
+   END
+END MoveWithMode ;
+
+
+(*
+   BuildBuiltinConst - makes reference to a builtin constant within gm2.
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +------------+
+                              | Ident      |        | Sym        |
+                              |------------|        |------------|
+
+                       Quadruple produced:
+
+                       q    Sym  BuiltinConstOp  Ident
+*)
+
+PROCEDURE BuildBuiltinConst ;
+VAR
+   idtok: CARDINAL ;
+   Id   : CARDINAL ;
+   Sym  : CARDINAL ;
+BEGIN
+   PopTtok (Id, idtok) ;
+   Sym := MakeTemporary (idtok, ImmediateValue) ;
+   PutVar (Sym, Integer) ;
+(*
+   CASE GetBuiltinConstType(KeyToCharStar(Name(Id))) OF
+
+   0:  ErrorFormat1(NewError(GetTokenNo()),
+                    '%a unrecognised builtin constant', Id) |
+   1:  PutVar(Sym, Integer) |
+   2:  PutVar(Sym, Real)
+
+   ELSE
+      InternalError ('unrecognised value')
+   END ;
+*)
+   GenQuadO (idtok, BuiltinConstOp, Sym, NulSym, Id, FALSE) ;
+   PushTtok (Sym, idtok)
+END BuildBuiltinConst ;
+
+
+(*
+   BuildBuiltinTypeInfo - make reference to a builtin typeinfo function
+                          within gm2.
+
+                                 Entry                 Exit
+
+                          Ptr ->
+                                 +-------------+
+                                 | Type        |
+                                 |-------------|       +------------+
+                                 | Ident       |       | Sym        |
+                                 |-------------|       |------------|
+
+                          Quadruple produced:
+
+                          q    Sym  BuiltinTypeInfoOp  Type Ident
+*)
+
+PROCEDURE BuildBuiltinTypeInfo ;
+VAR
+   idtok: CARDINAL ;
+   Ident,
+   Type,
+   Sym  : CARDINAL ;
+BEGIN
+   PopTtok (Ident, idtok) ;
+   PopT (Type) ;
+   Sym := MakeTemporary (BuiltinTokenNo, ImmediateValue) ;
+   CASE GetBuiltinTypeInfoType (KeyToCharStar (Name (Ident))) OF
+
+   0:  ErrorFormat1 (NewError(idtok),
+                     '%a unrecognised builtin constant', Ident) |
+   1:  PutVar (Sym, Boolean) |
+   2:  PutVar (Sym, ZType) |
+   3:  PutVar (Sym, RType)
+
+   ELSE
+      InternalError ('unrecognised value')
+   END ;
+   GenQuadO (idtok, BuiltinTypeInfoOp, Sym, Type, Ident, FALSE) ;
+   PushTtok (Sym, idtok)
+END BuildBuiltinTypeInfo ;
+
+
+(*
+   CheckBecomesMeta - checks to make sure that we are not
+                      assigning a variable to a constant.
+                      Also check we are not assigning to an
+                      unbounded array.
+*)
+
+PROCEDURE CheckBecomesMeta (Des, Exp: CARDINAL; combinedtok, destok, exprtok: CARDINAL) ;
+BEGIN
+   IF IsConst (Des) AND IsVar (Exp)
+   THEN
+      MetaErrorsT2 (combinedtok,
+                    'in assignment, cannot assign a variable {%2a} to a constant {%1a}',
+                    'designator {%1Da} is declared as a {%kCONST}', Des, Exp)
+   END ;
+   IF (GetDType(Des) # NulSym) AND IsVar (Des) AND IsUnbounded (GetDType (Des))
+   THEN
+      MetaErrorT1 (destok,
+                   'in assignment, cannot assign to an unbounded array {%1ad}', Des)
+   END ;
+   IF (GetDType(Exp) # NulSym) AND IsVar (Exp) AND IsUnbounded (GetDType (Exp))
+   THEN
+      MetaErrorT1 (exprtok,
+                  'in assignment, cannot assign from an unbounded array {%1ad}', Exp)
+   END
+END CheckBecomesMeta ;
+
+
+(*
+   BuildAssignment - Builds an assignment from the values given on the
+                     quad stack. Either an assignment to an
+                     arithmetic expression or an assignment to a
+                     boolean expression.  This procedure should not
+                     be called in CONST declarations.
+                     The Stack is expected to contain:
+
+
+       Either
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | Expression |
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  Expression
+
+       OR
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | True |False|
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  TRUE
+                     q+1   GotoOp                    q+3
+                     q+2   BecomesOp  Designator  _  FALSE
+
+*)
+
+PROCEDURE BuildAssignment (becomesTokNo: CARDINAL) ;
+VAR
+   des, exp   : CARDINAL ;
+   destok,
+   exptok,
+   combinedtok: CARDINAL ;
+BEGIN
+   des := OperandT (2) ;
+   IF IsReadOnly (des)
+   THEN
+      destok := OperandTok (2) ;
+      exptok := OperandTok (1) ;
+      exp := OperandT (1) ;
+      IF DebugTokPos
+      THEN
+         MetaErrorT1 (destok, 'destok {%1Ead}', des) ;
+         MetaErrorT1 (exptok, 'exptok {%1Ead}', exp)
+      END ;
+      combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ;
+      IF DebugTokPos
+      THEN
+         MetaErrorT1 (combinedtok, 'combined {%1Ead}', des)
+      END ;
+      IF IsBoolean (1)
+      THEN
+         MetaErrorT1 (combinedtok,
+                      'cannot assign expression to a constant designator {%1Ead}', des)
+      ELSE
+         exp := OperandT (1) ;
+         MetaErrorT2 (combinedtok,
+                      'cannot assign a constant designator {%1Ead} with an expression {%2Ead}',
+                      des, exp)
+      END ;
+      PopN (2)  (* Remove both parameters.  *)
+   ELSIF IsError (des)
+   THEN
+      PopN (2)  (* Remove both parameters.  *)
+   ELSE
+      doBuildAssignment (becomesTokNo, TRUE, TRUE)
+   END
+END BuildAssignment ;
+
+
+(*
+   BuildAssignConstant - used to create constant in the CONST declaration.
+                         The stack is expected to contain:
+
+       Either
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | Expression |
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  Expression
+
+       OR
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | True |False|
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  TRUE
+                     q+1   GotoOp                    q+3
+                     q+2   BecomesOp  Designator  _  FALSE
+*)
+
+PROCEDURE BuildAssignConstant (equalsTokNo: CARDINAL) ;
+BEGIN
+   doBuildAssignment (equalsTokNo, TRUE, TRUE)
+END BuildAssignConstant ;
+
+
+(*
+   doBuildAssignment - subsiduary procedure of BuildAssignment.
+                       It builds the assignment and optionally
+                       checks the types are compatible.
+*)
+
+PROCEDURE doBuildAssignment (becomesTokNo: CARDINAL; checkTypes, checkOverflow: BOOLEAN) ;
+VAR
+   r, w,
+   t, f,
+   Array,
+   Des, Exp      : CARDINAL ;
+   combinedtok,
+   destok, exptok: CARDINAL ;
+BEGIN
+   DisplayStack ;
+   IF IsBoolean (1)
+   THEN
+      PopBool (t, f) ;
+      PopTtok (Des, destok) ;
+      (* Conditional Boolean Assignment.  *)
+      BackPatch (t, NextQuad) ;
+      IF GetMode (Des) = RightValue
+      THEN
+         GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, True, checkOverflow)
+      ELSE
+         CheckPointerThroughNil (destok, Des) ;
+         GenQuadO (destok, XIndrOp, Des, Boolean, True, checkOverflow)
+      END ;
+      GenQuadO (destok, GotoOp, NulSym, NulSym, NextQuad+2, checkOverflow) ;
+      BackPatch (f, NextQuad) ;
+      IF GetMode (Des) = RightValue
+      THEN
+         GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, False, checkOverflow)
+      ELSE
+         CheckPointerThroughNil (destok, Des) ;
+         GenQuadO (destok, XIndrOp, Des, Boolean, False, checkOverflow)
+      END
+   ELSE
+      PopTrwtok (Exp, r, exptok) ;
+      MarkAsRead (r) ;
+      IF Exp = NulSym
+      THEN
+         MetaError0 ('{%E}unknown expression found during assignment') ;
+         FlushErrors
+      END ;
+      Array := OperandA (1) ;
+      PopTrwtok (Des, w, destok) ;
+      MarkAsWrite (w) ;
+      CheckCompatibleWithBecomes (Des, Exp, destok, exptok) ;
+      combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ;
+      IF (GetSType (Des) # NulSym) AND (NOT IsSet (GetDType (Des)))
+      THEN
+         (* Tell code generator to test runtime values of assignment so ensure we
+            catch overflow and underflow.  *)
+         BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp))
+      END ;
+      IF checkTypes
+      THEN
+         CheckBecomesMeta (Des, Exp, combinedtok, destok, exptok)
+      END ;
+      (* Traditional Assignment.  *)
+      MoveWithMode (becomesTokNo, Des, Exp, Array, destok, exptok, checkOverflow) ;
+      IF checkTypes
+      THEN
+         (*
+         IF (CannotCheckTypeInPass3 (Des) OR CannotCheckTypeInPass3 (Exp))
+         THEN
+            (* We must do this after the assignment to allow the Designator to be
+               resolved (if it is a constant) before the type checking is done.  *)
+            (* Prompt post pass 3 to check the assignment once all types are resolved.  *)
+            BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp))
+         END ;
+         *)
+         (* BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp)) ; *)
+         CheckAssignCompatible (Des, Exp, combinedtok, destok, exptok)
+      END
+   END ;
+   DisplayStack
+END doBuildAssignment ;
+
+
+(*
+   CheckAssignCompatible - checks to see that an assignment is compatible.
+                           It performs limited checking - thorough checking
+                           is done in pass 3.  But we do what we can here
+                           given knowledge so far.
+*)
+
+PROCEDURE CheckAssignCompatible (Des, Exp: CARDINAL; combinedtok, destok, exprtok: CARDINAL) ;
+VAR
+   DesT, ExpT, DesL: CARDINAL ;
+BEGIN
+   DesT := GetSType(Des) ;
+   ExpT := GetSType(Exp) ;
+   DesL := GetLType(Des) ;
+   IF IsProcedure(Exp) AND
+      ((DesT#NulSym) AND (NOT IsProcType(DesT))) AND
+      ((DesL#NulSym) AND (NOT IsProcType(DesL)))
+   THEN
+      MetaErrorT1 (destok,
+                  'incorrectly assigning a procedure to a designator {%1Ead} (designator is not a procedure type, {%1ast})', Des)
+   ELSIF IsProcedure (Exp) AND IsProcedureNested (Exp)
+   THEN
+      MetaErrorT1 (exprtok,
+                   'cannot call nested procedure {%1Ead} indirectly as the outer scope will not be known', Exp)
+   ELSIF IsConstString(Exp)
+   THEN
+   ELSIF (DesT#NulSym) AND (IsUnbounded(DesT))
+   THEN
+   ELSIF (ExpT#NulSym) AND (IsUnbounded(ExpT))
+   THEN
+   ELSIF (DesL#NulSym) AND IsArray(DesL)
+   THEN
+   ELSIF IsConstructor(Exp)
+   THEN
+      IF ExpT=NulSym
+      THEN
+         (* ignore type checking *)
+      ELSIF (DesT=NulSym) AND IsConst(Des) AND (IsConstructor(Des) OR IsConstSet(Des))
+      THEN
+         PutConst(Des, ExpT)
+      ELSIF NOT IsAssignmentCompatible(DesT, ExpT)
+      THEN
+         MetaErrorT1 (combinedtok,
+                      'constructor expression is not compatible during assignment to {%1Ead}', Des)
+      END
+   ELSIF (DesT#NulSym) AND IsSet(DesT) AND IsConst(Exp)
+   THEN
+      (* We ignore checking of these types in pass 3 - but we do check them thoroughly post pass 3 *)
+   ELSIF IsConst(Exp) AND (ExpT#Address) AND (NOT IsConst(Des)) AND
+         (DesL#NulSym) AND ((DesL=Cardinal) OR (NOT IsSubrange(DesL))) AND
+         (NOT IsEnumeration(DesL))
+   THEN
+      IF (IsBaseType(DesL) OR IsSystemType(DesL))
+      THEN
+         CheckAssignmentCompatible (combinedtok, ExpT, DesT)
+      ELSE
+         MetaErrorT2 (combinedtok,
+                      'assignment of a constant {%1Ead} can only be made to a variable whose type is equivalent to a Modula-2 base type {%2tsa}', Exp, Des)
+      END
+   ELSE
+      IF (DesT#NulSym) AND IsProcType(DesT) AND IsProcedure(Exp)
+      THEN
+         DesT := GetSType(DesT) ; (* we can at least check RETURN values of procedure variables *)
+         (* remember that thorough assignment checking is done post pass 3 *)
+         CheckAssignmentCompatible (combinedtok, ExpT, DesT)
+      END
+   END
+END CheckAssignCompatible ;
+
+
+(*
+   CheckBooleanId - Checks to see if the top operand is a boolean.
+                    If the operand is not a boolean then it is tested
+                    with true and a boolean is generated.
+                    The Stack:
+
+
+                    Entry                     Exit
+             Ptr ->                                          <- Ptr
+                    +------------+            +------------+
+                    | Sym        |            | t   | f    |
+                    |------------|            |------------|
+
+                     Quadruples
+
+                     q   If=      Sym   True   _
+                     q+1 GotoOp   _     _      _
+*)
+
+PROCEDURE CheckBooleanId ;
+VAR
+   tok: CARDINAL ;
+BEGIN
+   IF NOT IsBoolean (1)
+   THEN
+      tok := OperandTok (1) ;
+      IF IsVar (OperandT (1))
+      THEN
+         IF GetSType (OperandT (1)) # Boolean
+         THEN
+            MetaError1 ('{%1Ua:is not a boolean expression}' +
+                        '{!%1Ua:boolean expression expected}', OperandT (1))
+         END
+      END ;
+      PushT (EqualTok) ;
+      PushT (True) ;
+      BuildRelOp (tok)
+   END
+END CheckBooleanId ;
+
+
+(*
+   BuildAlignment - builds an assignment to an alignment constant.
+
+                    The Stack is expected to contain:
+
+
+                            Entry                   Exit
+                            =====                   ====
+
+                    Ptr ->
+                            +---------------+
+                            | Expression    |
+                            |---------------|
+                            | bytealignment |
+                            |---------------|       empty
+*)
+
+PROCEDURE BuildAlignment (tokno: CARDINAL) ;
+VAR
+   name : Name ;
+   expr,
+   align: CARDINAL ;
+BEGIN
+   PopT (expr) ;
+   PopT (name) ;
+   IF name # MakeKey ('bytealignment')
+   THEN
+      MetaError1 ('expecting bytealignment identifier, rather than {%1Ea}',
+                  MakeError (tokno, name))
+   END ;
+   GetConstFromFifoQueue (align) ;
+   PushT (align) ;
+   PushT (expr) ;
+   BuildAssignConstant (tokno)
+END BuildAlignment ;
+
+
+(*
+   BuildBitLength - builds an assignment to a bit length constant.
+
+                    The Stack is expected to contain:
+
+
+                           Entry                   Exit
+                           =====                   ====
+
+                    Ptr ->
+                           +------------+
+                           | Expression |
+                           |------------|          empty
+*)
+
+PROCEDURE BuildBitLength (tokno: CARDINAL) ;
+VAR
+   expr,
+   length: CARDINAL ;
+BEGIN
+   PopT (expr) ;
+   GetConstFromFifoQueue (length) ;
+   PushT (length) ;
+   PushT (expr) ;
+   BuildAssignConstant (tokno)
+END BuildBitLength ;
+
+
+(*
+   BuildDefaultFieldAlignment - builds an assignment to an alignment constant.
+
+                                The Stack is expected to contain:
+
+
+                                       Entry                   Exit
+                                       =====                   ====
+
+                                Ptr ->
+                                       +------------+
+                                       | Expression |
+                                       |------------|          empty
+*)
+
+PROCEDURE BuildDefaultFieldAlignment ;
+VAR
+   expr,
+   align: CARDINAL ;
+   name : Name ;
+BEGIN
+   PopT (expr) ;
+   PopT (name) ;
+   IF name # MakeKey ('bytealignment')
+   THEN
+      MetaError0 ('{%E}only allowed to use the attribute {%kbytealignment} in the default record field alignment pragma')
+   END ;
+   GetConstFromFifoQueue (align) ;
+   PushT (align) ;
+   PushT (expr) ;
+   BuildAssignConstant (GetTokenNo ())
+END BuildDefaultFieldAlignment ;
+
+
+(*
+   BuildPragmaField - builds an assignment to an alignment constant.
+
+                      The Stack is expected to contain:
+
+
+                      Entry                   Exit
+                      =====                   ====
+
+               Ptr ->
+                      +------------+
+                      | Expression |
+                      |------------|          empty
+*)
+
+PROCEDURE BuildPragmaField ;
+VAR
+   expr,
+   const: CARDINAL ;
+   name : Name ;
+BEGIN
+   PopT (expr) ;
+   PopT (name) ;
+   IF (name # MakeKey ('unused')) AND (name # MakeKey ('bytealignment'))
+   THEN
+      MetaError0 ('only allowed to use the attribute {%Ekbytealignment} in the default record field alignment pragma')
+   END ;
+   IF expr # NulSym
+   THEN
+      GetConstFromFifoQueue (const) ;
+      PushT (const) ;
+      PushT (expr) ;
+      BuildAssignConstant (GetTokenNo ())
+   END
+END BuildPragmaField ;
+
+
+(*
+   BuildRepeat - Builds the repeat statement from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+
+                 Empty
+                                                        <- Ptr
+                                         +------------+
+                                         | RepeatQuad |
+                                         |------------|
+
+*)
+
+PROCEDURE BuildRepeat ;
+BEGIN
+   PushT(NextQuad)
+END BuildRepeat ;
+
+
+(*
+   BuildUntil - Builds the until part of the repeat statement
+                from the quad stack.
+                The Stack is expected to contain:
+
+
+                Entry                   Exit
+                =====                   ====
+
+        Ptr ->
+                +------------+
+                | t   | f    |
+                |------------|
+                | RepeatQuad |          Empty
+                |------------|
+*)
+
+PROCEDURE BuildUntil ;
+VAR
+   t, f,
+   Repeat: CARDINAL ;
+BEGIN
+   CheckBooleanId ;
+   PopBool(t, f) ;
+   PopT(Repeat) ;
+   BackPatch(f, Repeat) ;          (* If False then keep on repeating *)
+   BackPatch(t, NextQuad) ;        (* If True then exit repeat        *)
+END BuildUntil ;
+
+
+(*
+   BuildWhile - Builds the While part of the While statement
+                from the quad stack.
+                The Stack is expected to contain:
+
+
+                Entry                   Exit
+                =====                   ====
+
+                                                       <- Ptr
+                                        |------------|
+                Empty                   | WhileQuad  |
+                                        |------------|
+*)
+
+PROCEDURE BuildWhile ;
+BEGIN
+   PushT(NextQuad)
+END BuildWhile ;
+
+
+(*
+   BuildDoWhile - Builds the Do part of the while statement
+                  from the quad stack.
+                  The Stack is expected to contain:
+
+
+                  Entry                   Exit
+                  =====                   ====
+
+          Ptr ->
+                  +------------+          +------------+
+                  | t   | f    |          | 0    | f   |
+                  |------------|          |------------|
+                  | WhileQuad  |          | WhileQuad  |
+                  |------------|          |------------|
+
+                  Quadruples
+
+                  BackPatch t exit to the NextQuad
+*)
+
+PROCEDURE BuildDoWhile ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   CheckBooleanId ;
+   PopBool(t, f) ;
+   BackPatch(t, NextQuad) ;
+   PushBool(0, f)
+END BuildDoWhile ;
+
+
+(*
+   BuildEndWhile - Builds the end part of the while statement
+                   from the quad stack.
+                   The Stack is expected to contain:
+
+
+                   Entry                   Exit
+                   =====                   ====
+
+           Ptr ->
+                   +------------+
+                   | t   | f    |
+                   |------------|
+                   | WhileQuad  |          Empty
+                   |------------|
+
+                   Quadruples
+
+                   q    GotoOp  WhileQuad
+                   False exit is backpatched with q+1
+*)
+
+PROCEDURE BuildEndWhile ;
+VAR
+   While,
+   t, f : CARDINAL ;
+BEGIN
+   PopBool(t, f) ;
+   Assert(t=0) ;
+   PopT(While) ;
+   GenQuad(GotoOp, NulSym, NulSym, While) ;
+   BackPatch(f, NextQuad)
+END BuildEndWhile ;
+
+
+(*
+   BuildLoop - Builds the Loop part of the Loop statement
+               from the quad stack.
+               The Stack is expected to contain:
+
+
+               Entry                   Exit
+               =====                   ====
+
+                                                      <- Ptr
+               Empty                   +------------+
+                                       | LoopQuad   |
+                                       |------------|
+*)
+
+PROCEDURE BuildLoop ;
+BEGIN
+   PushT(NextQuad) ;
+   PushExit(0)       (* Seperate Exit Stack for loop end *)
+END BuildLoop ;
+
+
+(*
+   BuildExit - Builds the Exit part of the Loop statement.
+*)
+
+PROCEDURE BuildExit ;
+BEGIN
+   IF IsEmptyWord(ExitStack)
+   THEN
+      MetaError0 ('{%EkEXIT} is only allowed in a {%kLOOP} statement')
+   ELSE
+      GenQuad(GotoOp, NulSym, NulSym, 0) ;
+      PushExit(Merge(PopExit(), NextQuad-1))
+   END
+END BuildExit ;
+
+
+(*
+   BuildEndLoop - Builds the End part of the Loop statement
+                  from the quad stack.
+                  The Stack is expected to contain:
+
+
+                  Entry                   Exit
+                  =====                   ====
+
+          Ptr ->
+                  +------------+
+                  | LoopQuad   |          Empty
+                  |------------|
+
+                  Quadruples
+
+                  Goto  _  _  LoopQuad
+*)
+
+PROCEDURE BuildEndLoop ;
+VAR
+   Loop: CARDINAL ;
+BEGIN
+   PopT(Loop) ;
+   GenQuad(GotoOp, NulSym, NulSym, Loop) ;
+   BackPatch(PopExit(), NextQuad)
+END BuildEndLoop ;
+
+
+(*
+   BuildThenIf - Builds the Then part of the If statement
+                 from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+         Ptr ->                                          <- Ptr
+                 +------------+          +------------+
+                 | t   | f    |          | 0    | f   |
+                 |------------|          |------------|
+
+                 Quadruples
+
+                 The true exit is BackPatched to point to
+                 the NextQuad.
+*)
+
+PROCEDURE BuildThenIf ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   CheckBooleanId ;
+   PopBool(t, f) ;
+   BackPatch(t, NextQuad) ;
+   PushBool(0, f)
+END BuildThenIf ;
+
+
+(*
+   BuildElse - Builds the Else part of the If statement
+               from the quad stack.
+               The Stack is expected to contain:
+
+
+               Entry                   Exit
+               =====                   ====
+
+       Ptr ->
+               +------------+          +------------+
+               | t   | f    |          | t+q  | 0   |
+               |------------|          |------------|
+
+               Quadruples
+
+               q    GotoOp  _  _  0
+               q+1  <- BackPatched from f
+*)
+
+PROCEDURE BuildElse ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   GenQuad(GotoOp, NulSym, NulSym, 0) ;
+   PopBool(t, f) ;
+   BackPatch(f, NextQuad) ;
+   PushBool(Merge(t, NextQuad-1), 0)   (* NextQuad-1 = Goto Quad *)
+END BuildElse ;
+
+
+(*
+   BuildEndIf - Builds the End part of the If statement
+                from the quad stack.
+                The Stack is expected to contain:
+
+
+                Entry                   Exit
+                =====                   ====
+
+        Ptr ->
+                +------------+
+                | t   | f    |          Empty
+                |------------|
+
+                Quadruples
+
+                Both t and f are backpatched to point to the NextQuad
+*)
+
+PROCEDURE BuildEndIf ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   PopBool(t, f) ;
+   BackPatch(t, NextQuad) ;
+   BackPatch(f, NextQuad)
+END BuildEndIf ;
+
+
+(*
+   BuildElsif1 - Builds the Elsif part of the If statement
+                 from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+         Ptr ->
+                 +------------+          +------------+
+                 | t   | f    |          | t+q  | 0   |
+                 |------------|          |------------|
+
+                 Quadruples
+
+                 q    GotoOp  _  _  0
+                 q+1  <- BackPatched from f
+*)
+
+PROCEDURE BuildElsif1 ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   GenQuad(GotoOp, NulSym, NulSym, 0) ;
+   PopBool(t, f) ;
+   BackPatch(f, NextQuad) ;
+   PushBool(Merge(t, NextQuad-1), 0)   (* NextQuad-1 = Goto Quad *)
+END BuildElsif1 ;
+
+
+(*
+   BuildElsif2 - Builds the Elsif until part of the If statement
+                 from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+          Ptr ->
+                 +--------------+
+                 | 0    | f1    |                            <- Ptr
+                 |--------------|          +---------------+
+                 | t2   | f2    |          | t2    | f1+f2 |
+                 |--------------|          |---------------|
+*)
+
+PROCEDURE BuildElsif2 ;
+VAR
+   t1, f1,
+   t2, f2: CARDINAL ;
+BEGIN
+   PopBool(t1, f1) ;
+   Assert(t1=0) ;
+   PopBool(t2, f2) ;
+   PushBool(t2, Merge(f1, f2))
+END BuildElsif2 ;
+
+
+(*
+   PushOne - pushes the value one to the stack.
+             The Stack is changed:
+
+
+                    Entry                   Exit
+                    =====                   ====
+
+                                                            <- Ptr
+                                            +------------+
+             Ptr ->                         | 1 | type   |
+                                            |------------|
+*)
+
+PROCEDURE PushOne (tok: CARDINAL; type: CARDINAL; message: ARRAY OF CHAR) ;
+BEGIN
+   IF type = NulSym
+   THEN
+      PushTF (MakeConstLit (tok, MakeKey('1'), NulSym), NulSym)
+   ELSIF IsEnumeration (type)
+   THEN
+      IF NoOfElements (type) = 0
+      THEN
+         MetaErrorString1 (ConCat (InitString ('enumeration type only has one element {%1Dad} and therefore '),
+                                   Mark (InitString (message))),
+                           type) ;
+         PushZero (tok, type)
+      ELSE
+         PushTF (Convert, NulSym) ;
+         PushT (type) ;
+         PushT (MakeConstLit (tok, MakeKey ('1'), ZType)) ;
+         PushT (2) ;          (* Two parameters *)
+         BuildConvertFunction
+      END
+   ELSE
+      PushTF (MakeConstLit (tok, MakeKey ('1'), type), type)
+   END
+END PushOne ;
+
+
+(*
+   PushZero - pushes the value zero to the stack.
+              The Stack is changed:
+
+
+                    Entry                   Exit
+                    =====                   ====
+
+                                                            <- Ptr
+                                            +------------+
+             Ptr ->                         | 0 | type   |
+                                            |------------|
+*)
+
+PROCEDURE PushZero (tok: CARDINAL; type: CARDINAL) ;
+BEGIN
+   IF type = NulSym
+   THEN
+      PushTFtok (MakeConstLit (tok, MakeKey ('0'), NulSym), NulSym, tok)
+   ELSIF IsEnumeration (type)
+   THEN
+      PushTFtok (Convert, NulSym, tok) ;
+      PushTtok (type, tok) ;
+      PushTtok (MakeConstLit (tok, MakeKey ('0'), ZType), tok) ;
+      PushT (2) ;          (* Two parameters *)
+      BuildConvertFunction
+   ELSE
+      PushTFtok (MakeConstLit (tok, MakeKey ('0'), type), type, tok)
+   END
+END PushZero ;
+
+
+(*
+   BuildPseudoBy - Builds the Non existant part of the By
+                   clause of the For statement
+                   from the quad stack.
+                   The Stack is expected to contain:
+
+
+                   Entry                   Exit
+                   =====                   ====
+
+                                                           <- Ptr
+                                           +------------+
+            Ptr ->                         | BySym | t  |
+                   +------------+          |------------|
+                   | e    | t   |          | e     | t  |
+                   |------------|          |------------|
+*)
+
+PROCEDURE BuildPseudoBy ;
+VAR
+   e, t, dotok: CARDINAL ;
+BEGIN
+   PopTFtok (e, t, dotok) ;  (* as there is no BY token this position is the DO at the end of the last expression.  *)
+   PushTFtok (e, t, dotok) ;
+   IF t=NulSym
+   THEN
+      t := GetSType (e)
+   END ;
+   PushOne (dotok, t, 'the implied FOR loop increment will cause an overflow {%1ad}')
+END BuildPseudoBy ;
+
+
+(*
+   BuildForLoopToRangeCheck - builds the range check to ensure that the id
+                              does not exceed the limits of its type.
+*)
+
+PROCEDURE BuildForLoopToRangeCheck ;
+VAR
+   d, dt,
+   e, et: CARDINAL ;
+BEGIN
+   PopTF (e, et) ;
+   PopTF (d, dt) ;
+   BuildRange (InitForLoopToRangeCheck (d, e)) ;
+   PushTF (d, dt) ;
+   PushTF (e, et)
+END BuildForLoopToRangeCheck ;
+
+
+(*
+   BuildForToByDo - Builds the For To By Do part of the For statement
+                    from the quad stack.
+                    The Stack is expected to contain:
+
+
+                    Entry                   Exit
+                    =====                   ====
+
+
+             Ptr ->                                           <- Ptr
+                    +----------------+      |----------------|
+                    | BySym | ByType |      | ForQuad        |
+                    |----------------|      |----------------|
+                    | e2             |      | LastValue      |
+                    |----------------|      |----------------|
+                    | e1             |      | BySym | ByType |
+                    |----------------|      |----------------|
+                    | Ident          |      | IdentSym       |
+                    |----------------|      |----------------|
+
+
+                    x := e1 ;
+                    LASTVALUE := ((e2-e1) DIV BySym) * BySym + e1
+                    IF BySym<0
+                    THEN
+                       IF e1<e2
+                       THEN
+                          goto exit
+                       END
+                    ELSE
+                       IF e1>e2
+                       THEN
+                          goto exit
+                       END
+                    END ;
+                    LOOP
+                       body
+                       IF x=LASTVALUE
+                       THEN
+                          goto exit
+                       END ;
+                       INC(x, BySym)
+                    END
+
+                    Quadruples:
+
+                    q     BecomesOp  IdentSym  _  e1
+                    q+    LastValue  := ((e1-e2) DIV by) * by + e1
+                    q+1   if >=      by        0  q+..2
+                    q+2   GotoOp                  q+3
+                    q+3   If >=      e1  e2       q+5
+                    q+4   GotoOp                  exit
+                    q+5   ..
+                    q+..1 Goto                    q+..5
+                    q+..2 If >=      e2  e1       q+..4
+                    q+..3 GotoOp                  exit
+                    q+..4 ..
+
+                    The For Loop is regarded:
+
+                    For ident := e1 To e2 By by Do
+
+                    End
+*)
+
+PROCEDURE BuildForToByDo ;
+VAR
+   l1, l2    : LineNote ;
+   e1, e2,
+   Id        : Name ;
+   e1tok,
+   e2tok,
+   idtok,
+   bytok     : CARDINAL ;
+   FinalValue,
+   exit1,
+   IdSym,
+   BySym,
+   ByType,
+   ForLoop,
+   t, f      : CARDINAL ;
+   etype,
+   t1        : CARDINAL ;
+BEGIN
+   l2 := PopLineNo() ;
+   l1 := PopLineNo() ;
+   UseLineNote(l1) ;
+   PushFor (0) ;
+   PopTFtok (BySym, ByType, bytok) ;
+   PopTtok (e2, e2tok) ;
+   PopTtok (e1, e1tok) ;
+   PopTtok (Id, idtok) ;
+   IdSym := RequestSym (idtok, Id) ;
+   IF NOT IsExpressionCompatible (GetSType (e1), GetSType (e2))
+   THEN
+      MetaError2 ('incompatible types found in {%EkFOR} loop header, initial expression {%E1tsad} and final expression {%E2tsad}',
+                 e1, e2) ;
+      CheckExpressionCompatible (idtok, GetSType (e1), GetSType (e2))
+   END ;
+   IF NOT IsExpressionCompatible( GetSType (e1), ByType)
+   THEN
+      MetaError2 ('incompatible types found in {%EkFOR} loop header, initial expression {%E1tsad} and {%kBY} {%E2tsad}',
+                  e2, BySym) ;
+      CheckExpressionCompatible (e1tok, GetSType (e1), ByType)
+   ELSIF NOT IsExpressionCompatible (GetSType (e2), ByType)
+   THEN
+      MetaError2 ('incompatible types found in {%EkFOR} loop header, final expression {%E1tsad} and {%kBY} {%E2tsad}',
+                  e2, BySym) ;
+      CheckExpressionCompatible (e1tok, GetSType (e2), ByType)
+   END ;
+   BuildRange (InitForLoopBeginRangeCheck (IdSym, e1)) ;
+   PushTtok (IdSym, idtok) ;
+   PushTtok (e1, e1tok) ;
+   BuildAssignmentWithoutBounds (idtok, TRUE, TRUE) ;
+
+   UseLineNote (l2) ;
+   FinalValue := MakeTemporary (e2tok,
+                                AreConstant (IsConst (e1) AND IsConst (e2) AND
+                                            IsConst (BySym))) ;
+   PutVar (FinalValue, GetSType (IdSym)) ;
+   etype := MixTypes (GetSType (e1), GetSType (e2), e2tok) ;
+   e1 := doConvert (etype, e1) ;
+   e2 := doConvert (etype, e2) ;
+
+   PushTF (FinalValue, GetSType(FinalValue)) ;
+   PushTFtok (e2, GetSType(e2), e2tok) ;  (* FinalValue := ((e1-e2) DIV By) * By + e1 *)
+   PushT (MinusTok) ;
+   PushTFtok (e1, GetSType(e1), e1tok) ;
+   doBuildBinaryOp (TRUE, FALSE) ;
+   PushT (DivideTok) ;
+   PushTFtok (BySym, ByType, bytok) ;
+   doBuildBinaryOp (FALSE, FALSE) ;
+   PushT (TimesTok) ;
+   PushTFtok (BySym, ByType, bytok) ;
+   doBuildBinaryOp (FALSE, FALSE) ;
+   PushT (PlusTok) ;
+   PushTFtok (e1, GetSType (e1), e1tok) ;
+   doBuildBinaryOp (FALSE, FALSE) ;
+   BuildForLoopToRangeCheck ;
+   BuildAssignmentWithoutBounds (e1tok, FALSE, FALSE) ;
+
+   (* q+1 if >=      by        0  q+..2 *)
+   (* q+2 GotoOp                  q+3   *)
+   PushTFtok (BySym, ByType, bytok) ;  (* BuildRelOp  1st parameter *)
+   PushT (GreaterEqualTok) ;           (*             2nd parameter *)
+                                       (* 3rd parameter *)
+   PushZero (bytok, ByType) ;
+
+   BuildRelOp (e2tok) ;       (* choose final expression position.  *)
+   PopBool(t, f) ;
+   BackPatch(f, NextQuad) ;
+   (* q+3 If >=       e1  e2      q+5  *)
+   (* q+4 GotoOp                  Exit *)
+   PushTFtok (e1, GetSType (e1), e1tok) ;  (* BuildRelOp  1st parameter *)
+   PushT (GreaterEqualTok) ;               (*             2nd parameter *)
+   PushTFtok (e2, GetSType (e2), e2tok) ;  (*             3rd parameter *)
+   BuildRelOp (e2tok) ;           (* choose final expression position.  *)
+   PopBool (t1, exit1) ;
+   BackPatch (t1, NextQuad) ;
+   PushFor (Merge (PopFor(), exit1)) ;    (* merge exit1 *)
+
+   GenQuad (GotoOp, NulSym, NulSym, 0) ;
+   ForLoop := NextQuad-1 ;
+
+   (* ELSE *)
+
+   BackPatch (t, NextQuad) ;
+   PushTFtok (e2, GetSType(e2), e2tok) ; (* BuildRelOp  1st parameter *)
+   PushT (GreaterEqualTok) ;             (*             2nd parameter *)
+   PushTFtok (e1, GetSType(e1), e1tok) ; (*             3rd parameter *)
+   BuildRelOp (e2tok) ;
+   PopBool (t1, exit1) ;
+   BackPatch (t1, NextQuad) ;
+   PushFor (Merge (PopFor (), exit1)) ;       (* merge exit1 *)
+
+   BackPatch(ForLoop, NextQuad) ; (* fixes the start of the for loop *)
+   ForLoop := NextQuad ;
+
+   (* and set up the stack *)
+
+   PushTFtok (IdSym, GetSym (IdSym), idtok) ;
+   PushTFtok (BySym, ByType, bytok) ;
+   PushTFtok (FinalValue, GetSType (FinalValue), e2tok) ;
+   PushT (ForLoop)
+END BuildForToByDo ;
+
+
+(*
+   BuildEndFor - Builds the End part of the For statement
+                 from the quad stack.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+         Ptr ->
+                 +----------------+
+                 | ForQuad        |
+                 |----------------|
+                 | LastValue      |
+                 |----------------|
+                 | BySym | ByType |
+                 |----------------|
+                 | IdSym          |      Empty
+                 |----------------|
+*)
+
+PROCEDURE BuildEndFor (endpostok: CARDINAL) ;
+VAR
+   t, f,
+   tsym,
+   IncQuad,
+   ForQuad: CARDINAL ;
+   LastSym,
+   ByType,
+   BySym,
+   bytok,
+   IdSym,
+   idtok  : CARDINAL ;
+BEGIN
+   PopT (ForQuad) ;
+   PopT (LastSym) ;
+   PopTFtok (BySym, ByType, bytok) ;
+   PopTtok (IdSym, idtok) ;
+
+   (* IF IdSym=LastSym THEN exit END *)
+   PushTF(IdSym, GetSType (IdSym)) ;
+   PushT (EqualTok) ;
+   PushTF (LastSym, GetSType (LastSym)) ;
+   BuildRelOp (endpostok) ;
+   PopBool (t, f) ;
+
+   BackPatch (t, NextQuad) ;
+   GenQuad (GotoOp, NulSym, NulSym, 0) ;
+   PushFor (Merge (PopFor (), NextQuad-1)) ;
+   BackPatch (f, NextQuad) ;
+   IF GetMode (IdSym) = LeftValue
+   THEN
+      (* index variable is a LeftValue, therefore we must dereference it *)
+      tsym := MakeTemporary (idtok, RightValue) ;
+      PutVar (tsym, GetSType (IdSym)) ;
+      CheckPointerThroughNil (idtok, IdSym) ;
+      doIndrX (endpostok, tsym, IdSym) ;
+      BuildRange (InitForLoopEndRangeCheck (tsym, BySym)) ;  (* --fixme-- pass endpostok.  *)
+      IncQuad := NextQuad ;
+      (* we have explicitly checked using the above and also
+         this addition can legally overflow if a cardinal type
+         is counting down.  The above test will generate a more
+         precise error message, so we suppress overflow detection
+         here.  *)
+      GenQuadO (bytok, AddOp, tsym, tsym, BySym, FALSE) ;
+      CheckPointerThroughNil (idtok, IdSym) ;
+      GenQuadO (idtok, XIndrOp, IdSym, GetSType (IdSym), tsym, FALSE)
+   ELSE
+      BuildRange (InitForLoopEndRangeCheck (IdSym, BySym)) ;
+      IncQuad := NextQuad ;
+      (* we have explicitly checked using the above and also
+         this addition can legally overflow if a cardinal type
+         is counting down.  The above test will generate a more
+         precise error message, so we suppress overflow detection
+         here.  *)
+      GenQuadO (idtok, AddOp, IdSym, IdSym, BySym, FALSE)
+   END ;
+   GenQuadO (endpostok, GotoOp, NulSym, NulSym, ForQuad, FALSE) ;
+   BackPatch (PopFor (), NextQuad) ;
+   AddForInfo (ForQuad, NextQuad-1, IncQuad, IdSym, idtok)
+END BuildEndFor ;
+
+
+(*
+   BuildCaseStart - starts the case statement.
+                    It initializes a backpatch list on the compile
+                    time stack, the list is used to contain all
+                    case break points. The list is later backpatched
+                    and contains all positions of the case statement
+                    which jump to the end of the case statement.
+                    The stack also contains room for a boolean
+                    expression, this is needed to allow , operator
+                    in the CaseField alternatives.
+
+                    The Stack is expected to contain:
+
+
+                    Entry                   Exit
+                    =====                   ====
+
+                                                           <- Ptr
+                                            +------------+
+                    Empty                   | 0    | 0   |
+                                            |------------|
+                                            | 0    | 0   |
+                                            |------------|
+*)
+
+PROCEDURE BuildCaseStart ;
+BEGIN
+   BuildRange (InitCaseBounds (PushCase (NulSym, NulSym))) ;
+   PushBool (0, 0) ;  (* BackPatch list initialized *)
+   PushBool (0, 0)    (* Room for a boolean expression *)
+END BuildCaseStart ;
+
+
+(*
+   BuildCaseStartStatementSequence - starts the statement sequence
+                                     inside a case clause.
+                                     BackPatches the true exit to the
+                                     NextQuad.
+                                     The Stack:
+
+                                     Entry             Exit
+
+                              Ptr ->                                  <- Ptr
+                                     +-----------+     +------------+
+                                     | t   | f   |     | 0   | f    |
+                                     |-----------|     |------------|
+*)
+
+PROCEDURE BuildCaseStartStatementSequence ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   PopBool (t, f) ;
+   BackPatch (t, NextQuad) ;
+   PushBool (0, f)
+END BuildCaseStartStatementSequence ;
+
+
+(*
+   BuildCaseEndStatementSequence - ends the statement sequence
+                                   inside a case clause.
+                                   BackPatches the false exit f1 to the
+                                   NextQuad.
+                                   Asserts that t1 and f2 is 0
+                                   Pushes t2+q and 0
+
+                                   Quadruples:
+
+                                   q  GotoOp  _  _  0
+
+                                   The Stack:
+
+                                   Entry             Exit
+
+                            Ptr ->                                  <- Ptr
+                                   +-----------+     +------------+
+                                   | t1  | f1  |     | 0    | 0   |
+                                   |-----------|     |------------|
+                                   | t2  | f2  |     | t2+q | 0   |
+                                   |-----------|     |------------|
+*)
+
+PROCEDURE BuildCaseEndStatementSequence ;
+VAR
+   t1, f1,
+   t2, f2: CARDINAL ;
+BEGIN
+   GenQuad (GotoOp, NulSym, NulSym, 0) ;
+   PopBool (t1, f1) ;
+   PopBool (t2, f2) ;          (* t2 contains the break list for the case *)
+   BackPatch (f1, NextQuad) ;  (* f1 no longer needed *)
+   Assert (t1=0) ;
+   Assert (f2=0) ;
+   PushBool (Merge (t2, NextQuad-1), 0) ;  (* NextQuad-1 = Goto Quad *)
+   PushBool (0, 0)             (* Room for boolean expression *)
+END BuildCaseEndStatementSequence ;
+
+
+(*
+   BuildCaseRange - builds the range testing quaruples for
+                    a case clause.
+
+                    IF (e1>=ce1) AND (e1<=ce2)
+                    THEN
+
+                    ELS..
+
+                    The Stack:
+
+                    Entry             Exit
+
+             Ptr ->
+                    +-----------+
+                    | ce2       |                   <- Ptr
+                    |-----------|     +-----------+
+                    | ce1       |     | t   | f   |
+                    |-----------|     |-----------|
+                    | t1  | f1  |     | t1  | f1  |
+                    |-----------|     |-----------|
+                    | t2  | f2  |     | t2  | f2  |
+                    |-----------|     |-----------|
+                    | e1        |     | e1        |
+                    |-----------|     |-----------|
+*)
+
+PROCEDURE BuildCaseRange ;
+VAR
+   ce1, ce2,
+   combinedtok,
+   ce1tok,
+   ce2tok,
+   e1tok,
+   e1,
+   t2, f2,
+   t1, f1  : CARDINAL ;
+BEGIN
+   PopTtok (ce2, ce2tok) ;
+   PopTtok (ce1, ce1tok) ;
+   combinedtok := MakeVirtualTok (ce2tok, ce2tok, ce1tok) ;
+   AddRange (ce1, ce2, combinedtok) ;
+   PopBool (t1, f1) ;
+   PopBool (t2, f2) ;
+   PopTtok (e1, e1tok) ;
+   PushTtok (e1, e1tok) ;  (* leave e1 on bottom of stack when exit procedure *)
+   PushBool (t2, f2) ;
+   PushBool (t1, f1) ;  (* also leave t1 and f1 on the bottom of the stack *)
+   PushTtok (e1, e1tok) ;
+   PushT (GreaterEqualTok) ;
+   PushTtok (ce1, ce1tok) ;
+   BuildRelOp (combinedtok) ;
+   PushT (AndTok) ;
+   RecordOp ;
+   PushTtok (e1, e1tok) ;
+   PushT (LessEqualTok) ;
+   PushTtok (ce2, ce2tok) ;
+   BuildRelOp (combinedtok) ;
+   BuildBinaryOp
+END BuildCaseRange ;
+
+
+(*
+   BuildCaseEquality - builds the range testing quadruples for
+                       a case clause.
+
+                       IF e1=ce1
+                       THEN
+
+                       ELS..
+
+                       The Stack:
+
+                       Entry             Exit
+
+                Ptr ->
+                       +-----------+     +-----------+
+                       | ce1       |     | t   | f   |
+                       |-----------|     |-----------|
+                       | t1  | f1  |     | t1  | f1  |
+                       |-----------|     |-----------|
+                       | t2  | f2  |     | t2  | f2  |
+                       |-----------|     |-----------|
+                       | e1        |     | e1        |
+                       |-----------|     |-----------|
+*)
+
+PROCEDURE BuildCaseEquality ;
+VAR
+   ce1tok,
+   e1tok,
+   ce1, e1,
+   t2, f2,
+   t1, f1 : CARDINAL ;
+BEGIN
+   PopTtok (ce1, ce1tok) ;
+   AddRange (ce1, NulSym, ce1tok) ;
+   PopBool (t1, f1) ;
+   PopBool (t2, f2) ;
+   PopTtok (e1, e1tok) ;
+   PushTtok (e1, e1tok) ;   (* leave e1 on bottom of stack when exit procedure *)
+   PushBool (t2, f2) ;      (* also leave t2 and f2 on the bottom of the stack *)
+   PushBool (t1, f1) ;
+   PushTtok (e1, e1tok) ;
+   PushT (EqualTok) ;
+   PushTtok (ce1, ce1tok) ;
+   BuildRelOp (ce1tok)
+END BuildCaseEquality ;
+
+
+(*
+   BuildCaseList - merges two case tests into one
+
+                   The Stack:
+
+                   Entry             Exit
+
+            Ptr ->
+                   +-----------+
+                   | t2  | f2  |
+                   |-----------|     +-------------+
+                   | t1  | f1  |     | t1+t2| f1+f2|
+                   |-----------|     |-------------|
+*)
+
+PROCEDURE BuildCaseList ;
+VAR
+   t2, f2,
+   t1, f1: CARDINAL ;
+BEGIN
+   PopBool (t2, f2) ;
+   PopBool (t1, f1) ;
+   PushBool (Merge (t1, t2), Merge (f1, f2))
+END BuildCaseList ;
+
+
+(*
+   BuildCaseOr - builds the , in the case clause.
+
+                 The Stack:
+
+                 Entry             Exit
+
+          Ptr ->                                  <- Ptr
+                 +-----------+     +------------+
+                 | t   | f   |     | t    | 0   |
+                 |-----------|     |------------|
+*)
+
+PROCEDURE BuildCaseOr ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   PopBool (t, f) ;
+   BackPatch (f, NextQuad) ;
+   PushBool (t, 0)
+END BuildCaseOr ;
+
+
+(*
+   BuildCaseElse - builds the else of case clause.
+
+                  The Stack:
+
+                  Entry             Exit
+
+           Ptr ->                                  <- Ptr
+                  +-----------+     +------------+
+                  | t   | f   |     | t    | 0   |
+                  |-----------|     |------------|
+*)
+
+PROCEDURE BuildCaseElse ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   PopBool (t, f) ;
+   BackPatch (f, NextQuad) ;
+   PushBool (t, 0)
+END BuildCaseElse ;
+
+
+(*
+   BuildCaseEnd - builds the end of case clause.
+
+                  The Stack:
+
+                  Entry             Exit
+
+           Ptr ->
+                  +-----------+
+                  | t1  | f1  |
+                  |-----------|
+                  | t2  | f2  |
+                  |-----------|
+                  | e1        |
+                  |-----------|     Empty
+*)
+
+PROCEDURE BuildCaseEnd ;
+VAR
+   e1,
+   t, f: CARDINAL ;
+BEGIN
+   PopBool (t, f) ;
+   BackPatch (f, NextQuad) ;
+   BackPatch (t, NextQuad) ;
+   PopBool (t, f) ;
+   BackPatch (f, NextQuad) ;
+   BackPatch (t, NextQuad) ;
+   PopT (e1) ;
+   PopCase
+END BuildCaseEnd ;
+
+
+(*
+   BuildCaseCheck - builds the case checking code to ensure that
+                    the program does not need an else clause at runtime.
+                    The stack is unaltered.
+*)
+
+PROCEDURE BuildCaseCheck ;
+BEGIN
+   BuildError (InitNoElseRangeCheck ())
+END BuildCaseCheck ;
+
+
+(*
+   BuildNulParam - Builds a nul parameter on the stack.
+                   The Stack:
+
+                   Entry             Exit
+
+                                                    <- Ptr
+                   Empty             +------------+
+                                     | 0          |
+                                     |------------|
+*)
+
+PROCEDURE BuildNulParam ;
+BEGIN
+   PushT (0)
+END BuildNulParam ;
+
+
+(*
+   BuildSizeCheckStart - switches off all quadruple generation if the function SIZE or HIGH
+                         is being "called".  This should be done as SIZE only requires the
+                         actual type of the expression, not its value.  Consider the problem of
+                         SIZE(UninitializedPointer^) which is quite legal and it must
+                         also be safe!
+                         ISO Modula-2 also allows HIGH(a[0]) for a two dimensional array
+                         and there is no need to compute a[0], we just need to follow the
+                         type and count dimensions.  However if SIZE(a) or HIGH(a) occurs
+                         and, a, is an unbounded array then we turn on quadruple generation.
+
+                         The Stack is expected to contain:
+
+
+                         Entry                       Exit
+                         =====                       ====
+
+                 Ptr ->                                                       <- Ptr
+                        +----------------------+     +----------------------+
+                        | ProcSym | Type | tok |     | ProcSym | Type | tok |
+                        |----------------------|     |----------------------|
+*)
+
+PROCEDURE BuildSizeCheckStart ;
+VAR
+   ProcSym, Type, tok: CARDINAL ;
+BEGIN
+   PopTFtok (ProcSym, Type, tok) ;
+   IF (ProcSym=Size) OR (ProcSym=TSize) OR (ProcSym=TBitSize)
+   THEN
+      QuadrupleGeneration := FALSE ;
+      BuildingSize := TRUE
+   ELSIF ProcSym=High
+   THEN
+      QuadrupleGeneration := FALSE ;
+      BuildingHigh := TRUE
+   END ;
+   PushTFtok (ProcSym, Type, tok)
+END BuildSizeCheckStart ;
+
+
+(*
+   BuildSizeCheckEnd - checks to see whether the function "called" was in fact SIZE.
+                       If so then we restore quadruple generation.
+*)
+
+PROCEDURE BuildSizeCheckEnd (ProcSym: CARDINAL) ;
+BEGIN
+   IF (ProcSym=Size) OR (ProcSym=TSize) OR (ProcSym=TBitSize)
+   THEN
+      QuadrupleGeneration := TRUE ;
+      BuildingSize := FALSE
+   ELSIF ProcSym=High
+   THEN
+      QuadrupleGeneration := TRUE ;
+      BuildingHigh := FALSE
+   END ;
+END BuildSizeCheckEnd ;
+
+
+(*
+   BuildProcedureCall - builds a procedure call.
+                        Although this procedure does not directly
+                        destroy the procedure parameters, it calls
+                        routine which will manipulate the stack and
+                        so the entry and exit states of the stack are shown.
+
+                        The Stack:
+
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        .                .
+                        .                .
+                        .                .
+                        |----------------|
+                        | Param #        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildProcedureCall (tokno: CARDINAL) ;
+VAR
+   NoOfParam,
+   ProcSym  : CARDINAL ;
+BEGIN
+   PopT(NoOfParam) ;
+   ProcSym := OperandT (NoOfParam+1) ;
+   PushT (NoOfParam) ;  (* Compile time stack restored to entry state *)
+   IF IsPseudoBaseProcedure (ProcSym) OR IsPseudoSystemProcedure (ProcSym)
+   THEN
+      DisplayStack ;
+      ManipulatePseudoCallParameters ;
+      DisplayStack ;
+      BuildPseudoProcedureCall (tokno) ;
+      DisplayStack
+   ELSIF IsUnknown (ProcSym)
+   THEN
+      MetaError1 ('{%1Ua} is not recognised as a procedure, check declaration or import', ProcSym) ;
+      PopN (NoOfParam + 2)
+   ELSE
+      DisplayStack ;
+      BuildRealProcedureCall (tokno) ;
+      DisplayStack ;
+   END
+END BuildProcedureCall ;
+
+
+(*
+   BuildRealProcedureCall - builds a real procedure call.
+                            The Stack:
+
+
+                            Entry                      Exit
+
+                     Ptr ->
+                            +----------------+
+                            | NoOfParam      |
+                            |----------------|
+                            | Param 1        |
+                            |----------------|
+                            | Param 2        |
+                            |----------------|
+                            .                .
+                            .                .
+                            .                .
+                            |----------------|
+                            | Param #        |
+                            |----------------|
+                            | ProcSym | Type |         Empty
+                            |----------------|
+*)
+
+PROCEDURE BuildRealProcedureCall (tokno: CARDINAL) ;
+VAR
+   NoOfParam: CARDINAL ;
+   ProcSym  : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   PushT (NoOfParam) ;
+   ProcSym := OperandT (NoOfParam+2) ;
+   ProcSym := SkipConst (ProcSym) ;
+   (* tokno := OperandTtok (NoOfParam+2) ; *)   (* --checkme-- *)
+   IF IsVar (ProcSym)
+   THEN
+      (* Procedure Variable ? *)
+      ProcSym := SkipType (OperandF (NoOfParam+2))
+   END ;
+   IF IsDefImp (GetScope (ProcSym)) AND IsDefinitionForC (GetScope (ProcSym))
+   THEN
+      BuildRealFuncProcCall (tokno, FALSE, TRUE)
+   ELSE
+      BuildRealFuncProcCall (tokno, FALSE, FALSE)
+   END
+END BuildRealProcedureCall ;
+
+
+(*
+   BuildRealFuncProcCall - builds a real procedure or function call.
+                           The Stack:
+
+
+                            Entry                      Exit
+
+                     Ptr ->
+                            +----------------+
+                            | NoOfParam      |
+                            |----------------|
+                            | Param 1        |
+                            |----------------|
+                            | Param 2        |
+                            |----------------|
+                            .                .
+                            .                .
+                            .                .
+                            |----------------|
+                            | Param #        |
+                            |----------------|
+                            | ProcSym | Type |         Empty
+                            |----------------|
+*)
+
+PROCEDURE BuildRealFuncProcCall (tokno: CARDINAL; IsFunc, IsForC: BOOLEAN) ;
+VAR
+   ForcedFunc,
+   ParamConstant : BOOLEAN ;
+   resulttok,
+   paramtok,
+   proctok,
+   NoOfParameters,
+   i, pi,
+   ReturnVar,
+   ProcSym,
+   Proc          : CARDINAL ;
+BEGIN
+   CheckProcedureParameters (IsForC) ;
+   PopT (NoOfParameters) ;
+   PushT (NoOfParameters) ;  (* Restore stack to original state.  *)
+   ProcSym := OperandT (NoOfParameters+2) ;
+   proctok := tokno ;  (* OperandTtok (NoOfParameters+2) ;  *)
+   IF proctok = UnknownTokenNo
+   THEN
+      proctok := GetTokenNo ()
+   END ;
+   paramtok := proctok ;
+   ProcSym := SkipConst (ProcSym) ;
+   ForcedFunc := FALSE ;
+   IF IsVar (ProcSym)
+   THEN
+      (* Procedure Variable ? *)
+      Proc := SkipType (OperandF (NoOfParameters+2)) ;
+      ParamConstant := FALSE
+   ELSE
+      Proc := ProcSym ;
+      ParamConstant := IsProcedureBuiltin (Proc)
+   END ;
+   IF IsFunc
+   THEN
+      IF GetSType (Proc) = NulSym
+      THEN
+         MetaErrors1 ('procedure {%1a} cannot be used as a function',
+                      'procedure {%1Da} does not have a return type',
+                      Proc)
+      END
+   ELSE
+      (* is being called as a procedure *)
+      IF GetSType (Proc) # NulSym
+      THEN
+         (* however it was declared as a procedure function *)
+         IF NOT IsReturnOptional (Proc)
+         THEN
+            MetaErrors1 ('function {%1a} is being called but its return value is ignored',
+                         'function {%1Da} return a type {%1ta:of {%1ta}}',
+                         Proc)
+         END ;
+         IsFunc := TRUE ;
+         ForcedFunc := TRUE
+      END
+   END ;
+   ManipulateParameters (IsForC) ;
+   CheckParameterOrdinals ;
+   PopT(NoOfParameters) ;
+   IF IsFunc
+   THEN
+      GenQuad (ParamOp, 0, Proc, ProcSym)  (* Space for return value *)
+   END ;
+   IF (NoOfParameters+1=NoOfParam(Proc)) AND UsesOptArg(Proc)
+   THEN
+      GenQuad (OptParamOp, NoOfParam(Proc), Proc, Proc)
+   END ;
+   i := NoOfParameters ;
+   pi := 1 ;     (* stack index referencing stacked parameter, i *)
+   WHILE i>0 DO
+      paramtok := OperandTtok (pi) ;
+      GenQuadO (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE) ;
+      IF NOT IsConst (OperandT (pi))
+      THEN
+         ParamConstant := FALSE
+      END ;
+      DEC (i) ;
+      INC (pi)
+   END ;
+   GenQuadO (proctok, CallOp, NulSym, NulSym, ProcSym, TRUE) ;
+   PopN (NoOfParameters+1) ; (* Destroy arguments and procedure call *)
+   IF IsFunc
+   THEN
+      (* ReturnVar - will have the type of the procedure *)
+      resulttok := MakeVirtualTok (proctok, proctok, paramtok) ;
+      ReturnVar := MakeTemporary (resulttok, AreConstant(ParamConstant)) ;
+      PutVar (ReturnVar, GetSType(Proc)) ;
+      GenQuadO (resulttok, FunctValueOp, ReturnVar, NulSym, Proc, TRUE) ;
+      IF NOT ForcedFunc
+      THEN
+         PushTFtok (ReturnVar, GetSType (Proc), resulttok)
+      END
+   END
+END BuildRealFuncProcCall ;
+
+
+(*
+   CheckProcedureParameters - Checks the parameters which are being passed to
+                              procedure ProcSym.
+
+                              The Stack:
+
+
+                              Entry                      Exit
+
+                       Ptr ->                                               <- Ptr
+                              +----------------+         +----------------+
+                              | NoOfParam      |         | NoOfParam      |
+                              |----------------|         |----------------|
+                              | Param 1        |         | Param 1        |
+                              |----------------|         |----------------|
+                              | Param 2        |         | Param 2        |
+                              |----------------|         |----------------|
+                              .                .         .                .
+                              .                .         .                .
+                              .                .         .                .
+                              |----------------|         |----------------|
+                              | Param #        |         | Param #        |
+                              |----------------|         |----------------|
+                              | ProcSym | Type |         | ProcSym | Type |
+                              |----------------|         |----------------|
+
+*)
+
+PROCEDURE CheckProcedureParameters (IsForC: BOOLEAN) ;
+VAR
+   proctok,
+   paramtok    : CARDINAL ;
+   n1, n2      : Name ;
+   Dim,
+   Actual,
+   FormalI,
+   ParamTotal,
+   pi,
+   Proc,
+   ProcSym,
+   i           : CARDINAL ;
+   s           : String ;
+BEGIN
+   PopT(ParamTotal) ;
+   PushT(ParamTotal) ;  (* Restore stack to origional state *)
+   ProcSym := OperandT(ParamTotal+1+1) ;
+   proctok := OperandTtok(ParamTotal+1+1) ;
+   IF IsVar(ProcSym) AND IsProcType(GetDType(ProcSym))
+   THEN
+      (* Procedure Variable ? *)
+      Proc := SkipType(OperandF(ParamTotal+1+1))
+   ELSE
+      Proc := SkipConst(ProcSym)
+   END ;
+   IF NOT (IsProcedure(Proc) OR IsProcType(Proc))
+   THEN
+      IF IsUnknown(Proc)
+      THEN
+         MetaError1('{%1Ua} is not recognised as a procedure, check declaration or import', Proc)
+      ELSE
+         MetaErrors1('{%1a} is not recognised as a procedure, check declaration or import',
+                     '{%1Ua} is not recognised as a procedure, check declaration or import',
+                     Proc)
+      END
+   END ;
+   IF CompilerDebugging
+   THEN
+      n1 := GetSymName(Proc) ;
+      printf1('  %a ( ', n1)
+   END ;
+   IF DebugTokPos
+   THEN
+      s := InitString ('procedure') ;
+      WarnStringAt (s, proctok)
+   END ;
+
+   i := 1 ;
+   pi := ParamTotal+1 ;   (* stack index referencing stacked parameter, i *)
+   WHILE i<=ParamTotal DO
+      IF i<=NoOfParam(Proc)
+      THEN
+         FormalI := GetParam(Proc, i) ;
+         IF CompilerDebugging
+         THEN
+            n1 := GetSymName(FormalI) ;
+            n2 := GetSymName(GetSType(FormalI)) ;
+            printf2('%a: %a', n1, n2)
+         END ;
+         Actual := OperandT(pi) ;
+         Dim := OperandD(pi) ;
+         paramtok := OperandTtok(pi) ;
+         IF DebugTokPos
+         THEN
+            s := InitString ('actual') ;
+            WarnStringAt (s, paramtok)
+         END ;
+
+         BuildRange(InitTypesParameterCheck(Proc, i, FormalI, Actual)) ;
+         IF IsConst(Actual)
+         THEN
+            IF IsVarParam(Proc, i)
+            THEN
+               FailParameter (paramtok,
+                              'trying to pass a constant to a VAR parameter',
+                              Actual, FormalI, Proc, i)
+            ELSIF IsConstString (Actual)
+            THEN
+               IF (GetStringLength (Actual) = 0)   (* if = 0 then it maybe unknown at this time *)
+               THEN
+                  (* dont check this yet *)
+               ELSIF IsArray(GetDType(FormalI)) AND (GetSType(GetDType(FormalI))=Char)
+               THEN
+                  (* allow string literals to be passed to ARRAY [0..n] OF CHAR *)
+               ELSIF (GetStringLength(Actual) = 1)   (* if = 1 then it maybe treated as a char *)
+               THEN
+                  CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
+               ELSIF NOT IsUnboundedParam(Proc, i)
+               THEN
+                  IF IsForC AND (GetSType(FormalI)=Address)
+                  THEN
+                     FailParameter (paramtok,
+                                    'a string constant can either be passed to an ADDRESS parameter or an ARRAY OF CHAR',
+                                    Actual, FormalI, Proc, i)
+                  ELSE
+                     FailParameter (paramtok,
+                                    'cannot pass a string constant to a non unbounded array parameter',
+                                    Actual, FormalI, Proc, i)
+                  END
+               END
+            END
+         ELSE
+            CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
+         END
+      ELSE
+         IF IsForC AND UsesVarArgs(Proc)
+         THEN
+            (* these are varargs, therefore we don't check them *)
+            i := ParamTotal
+         ELSE
+            MetaErrorT2 (proctok, 'too many parameters, {%2n} passed to {%1a} ', Proc, i)
+         END
+      END ;
+      INC(i) ;
+      DEC(pi) ;
+      IF CompilerDebugging
+      THEN
+         IF i<=ParamTotal
+         THEN
+            printf0('; ')
+         ELSE
+            printf0(' ) ; \n')
+         END
+      END
+   END
+END CheckProcedureParameters ;
+
+
+(*
+   CheckProcTypeAndProcedure - checks the ProcType with the call.
+*)
+
+PROCEDURE CheckProcTypeAndProcedure (ProcType: CARDINAL; call: CARDINAL) ;
+VAR
+   n1, n2          : Name ;
+   i, n, t         : CARDINAL ;
+   CheckedProcedure: CARDINAL ;
+   e               : Error ;
+BEGIN
+   n := NoOfParam(ProcType) ;
+   IF IsVar(call) OR IsTemporary(call) OR IsParameter(call)
+   THEN
+      CheckedProcedure := GetDType(call)
+   ELSE
+      CheckedProcedure := call
+   END ;
+   IF n#NoOfParam(CheckedProcedure)
+   THEN
+      e := NewError(GetDeclaredMod(ProcType)) ;
+      n1 := GetSymName(call) ;
+      n2 := GetSymName(ProcType) ;
+      ErrorFormat2(e, 'procedure (%a) is a parameter being passed as variable (%a) but they are declared with different number of parameters',
+                   n1, n2) ;
+      e := ChainError(GetDeclaredMod(call), e) ;
+      t := NoOfParam(CheckedProcedure) ;
+      IF n<2
+      THEN
+         ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameter, declared with (%d)',
+                      n1, n, t)
+      ELSE
+         ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameters, declared with (%d)',
+                      n1, n, t)
+      END
+   ELSE
+      i := 1 ;
+      WHILE i<=n DO
+         IF IsVarParam(ProcType, i) # IsVarParam(CheckedProcedure, i)
+         THEN
+            MetaError3('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', ProcType, GetNth(ProcType, i), i) ;
+            MetaError3('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', call, GetNth(call, i), i)
+         END ;
+         BuildRange(InitTypesParameterCheck(CheckedProcedure, i,
+                                            GetParam(CheckedProcedure, i),
+                                            GetParam(ProcType, i))) ;
+         (* CheckParameter(tokpos, GetParam(CheckedProcedure, i), 0, GetParam(ProcType, i), call, i, TypeList) ; *)
+         INC(i)
+      END
+   END
+END CheckProcTypeAndProcedure ;
+
+
+(*
+   IsReallyPointer - returns TRUE is sym is a pointer, address or a type declared
+                     as a pointer or address.
+*)
+
+PROCEDURE IsReallyPointer (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsVar(Sym)
+   THEN
+      Sym := GetSType(Sym)
+   END ;
+   Sym := SkipType(Sym) ;
+   RETURN( IsPointer(Sym) OR (Sym=Address) )
+END IsReallyPointer ;
+
+
+(*
+   LegalUnboundedParam - returns TRUE if the parameter, Actual, can legally be
+                         passed to ProcSym, i, the, Formal, parameter.
+*)
+
+PROCEDURE LegalUnboundedParam (tokpos: CARDINAL; ProcSym, i, ActualType, Actual, Dimension, Formal: CARDINAL) : BOOLEAN ;
+VAR
+   FormalType: CARDINAL ;
+   n, m      : CARDINAL ;
+BEGIN
+   ActualType := SkipType(ActualType) ;
+   FormalType := GetDType(Formal) ;
+   FormalType := GetSType(FormalType) ;   (* type of the unbounded ARRAY *)
+   IF IsArray(ActualType)
+   THEN
+      m := GetDimension(Formal) ;
+      n := 0 ;
+      WHILE IsArray(ActualType) DO
+         INC(n) ;
+         ActualType := GetDType(ActualType) ;
+         IF (m=n) AND (ActualType=FormalType)
+         THEN
+            RETURN( TRUE )
+         END
+      END ;
+      IF n=m
+      THEN
+         (* now we fall though and test ActualType against FormalType *)
+      ELSE
+         IF IsGenericSystemType(FormalType)
+         THEN
+            RETURN( TRUE )
+         ELSE
+            FailParameter(tokpos,
+                          'attempting to pass an array with the incorrect number dimenisons to an unbounded formal parameter of different dimensions',
+                          Actual, Formal, ProcSym, i) ;
+            RETURN( FALSE )
+         END
+      END
+   ELSIF IsUnbounded(ActualType)
+   THEN
+      IF (Dimension=0) AND (GetDimension(Formal)=GetDimension(Actual))
+      THEN
+         (* now we fall though and test ActualType against FormalType *)
+         ActualType := GetSType(ActualType)
+      ELSE
+         IF IsGenericSystemType(FormalType)
+         THEN
+            RETURN( TRUE )
+         ELSE
+            IF GetDimension(Actual)-Dimension = GetDimension(Formal)
+            THEN
+               ActualType := GetSType(ActualType)
+            ELSE
+               FailParameter(tokpos,
+                             'attempting to pass an unbounded array with the incorrect number dimenisons to an unbounded formal parameter of different dimensions',
+                             Actual, Formal, ProcSym, i) ;
+               RETURN( FALSE )
+            END
+         END
+      END
+   END ;
+   IF IsGenericSystemType (FormalType) OR
+      IsGenericSystemType (ActualType) OR
+      IsAssignmentCompatible (FormalType, ActualType)
+   THEN
+      (* we think it is legal, but we ask post pass 3 to check as
+         not all types are known at this point *)
+      RETURN( TRUE )
+   ELSE
+      FailParameter(tokpos,
+                    'identifier with an incompatible type is being passed to this procedure',
+                    Actual, Formal, ProcSym, i) ;
+      RETURN( FALSE )
+   END
+END LegalUnboundedParam ;
+
+
+(*
+   CheckParameter - checks that types ActualType and FormalType are compatible for parameter
+                    passing. ProcSym is the procedure and i is the parameter number.
+
+                    We obey the following rules:
+
+                    (1)  we allow WORD, BYTE, LOC to be compitable with any like sized
+                         type.
+                    (2)  we allow ADDRESS to be compatible with any pointer type.
+                    (3)  we relax INTEGER and CARDINAL checking for Temporary variables.
+
+                    Note that type sizes are checked during the code generation pass.
+*)
+
+PROCEDURE CheckParameter (tokpos: CARDINAL;
+                          Actual, Dimension, Formal, ProcSym: CARDINAL;
+                          i: CARDINAL; TypeList: List) ;
+VAR
+   NewList            : BOOLEAN ;
+   ActualType, FormalType: CARDINAL ;
+BEGIN
+   FormalType := GetDType(Formal) ;
+   IF IsConstString(Actual) AND (GetStringLength(Actual) = 1)   (* if = 1 then it maybe treated as a char *)
+   THEN
+      ActualType := Char
+   ELSIF Actual=Boolean
+   THEN
+      ActualType := Actual
+   ELSE
+      ActualType := GetDType(Actual)
+   END ;
+   IF TypeList=NIL
+   THEN
+      NewList := TRUE ;
+      InitList(TypeList)
+   ELSE
+      NewList := FALSE
+   END ;
+   IF IsItemInList(TypeList, ActualType)
+   THEN
+      (* no need to check *)
+      RETURN
+   END ;
+   IncludeItemIntoList(TypeList, ActualType) ;
+   IF IsProcType(FormalType)
+   THEN
+      IF (NOT IsProcedure(Actual)) AND ((ActualType=NulSym) OR (NOT IsProcType(SkipType(ActualType))))
+      THEN
+         FailParameter(tokpos,
+                       'expecting a procedure or procedure variable as a parameter',
+                       Actual, Formal, ProcSym, i) ;
+         RETURN
+      END ;
+      IF IsProcedure(Actual) AND IsProcedureNested(Actual)
+      THEN
+         MetaError2 ('cannot pass a nested procedure {%1Ea} seen in the {%2N} parameter as the outer scope will be unknown at runtime', Actual, i)
+      END ;
+      (* we can check the return type of both proc types *)
+      IF (ActualType#NulSym) AND IsProcType(ActualType)
+      THEN
+         IF ((GetSType(ActualType)#NulSym) AND (GetSType(FormalType)=NulSym))
+         THEN
+            FailParameter(tokpos,
+                          'the item being passed is a function whereas the formal procedure parameter is a procedure',
+                          Actual, Formal, ProcSym, i) ;
+            RETURN
+         ELSIF ((GetSType(ActualType)=NulSym) AND (GetSType(FormalType)#NulSym))
+         THEN
+            FailParameter(tokpos,
+                          'the item being passed is a procedure whereas the formal procedure parameter is a function',
+                          Actual, Formal, ProcSym, i) ;
+            RETURN
+         ELSIF AssignmentRequiresWarning(GetSType(ActualType), GetSType(FormalType))
+         THEN
+            WarnParameter(tokpos,
+                          'the return result of the procedure variable parameter may not be compatible on other targets with the return result of the item being passed',
+                          Actual, Formal, ProcSym, i) ;
+            RETURN
+         ELSIF IsGenericSystemType (GetSType(FormalType)) OR
+               IsGenericSystemType (GetSType(ActualType)) OR
+               IsAssignmentCompatible(GetSType(ActualType), GetSType(FormalType))
+         THEN
+            (* pass *)
+         ELSE
+            FailParameter(tokpos,
+                          'the return result of the procedure variable parameter is not compatible with the return result of the item being passed',
+                          Actual, Formal, ProcSym, i) ;
+            RETURN
+         END
+      END ;
+      (* now to check each parameter of the proc type *)
+      CheckProcTypeAndProcedure (FormalType, Actual)
+   ELSIF (ActualType#FormalType) AND (ActualType#NulSym)
+   THEN
+      IF IsUnknown(FormalType)
+      THEN
+         FailParameter(tokpos,
+                       'procedure parameter type is undeclared',
+                       Actual, Formal, ProcSym, i) ;
+         RETURN
+      END ;
+      IF IsUnbounded(ActualType) AND (NOT IsUnboundedParam(ProcSym, i))
+      THEN
+         FailParameter(tokpos,
+                       'attempting to pass an unbounded array to a NON unbounded parameter',
+                       Actual, Formal, ProcSym, i) ;
+         RETURN
+      ELSIF IsUnboundedParam(ProcSym, i)
+      THEN
+         IF NOT LegalUnboundedParam(tokpos, ProcSym, i, ActualType, Actual, Dimension, Formal)
+         THEN
+            RETURN
+         END
+      ELSIF ActualType#FormalType
+      THEN
+         IF AssignmentRequiresWarning(FormalType, ActualType)
+         THEN
+            WarnParameter (tokpos,
+                           'identifier being passed to this procedure may contain a possibly incompatible type when compiling for a different target',
+                           Actual, Formal, ProcSym, i)
+         ELSIF IsGenericSystemType (FormalType) OR
+               IsGenericSystemType (ActualType) OR
+               IsAssignmentCompatible (ActualType, FormalType)
+         THEN
+            (* so far we know it is legal, but not all types have been resolved
+               and so this is checked later on in another pass.  *)
+         ELSE
+            FailParameter (tokpos,
+                           'identifier with an incompatible type is being passed to this procedure',
+                           Actual, Formal, ProcSym, i)
+         END
+      END
+   END ;
+   IF NewList
+   THEN
+      KillList(TypeList)
+   END
+END CheckParameter ;
+
+
+(*
+   DescribeType - returns a String describing a symbol, Sym, name and its type.
+*)
+
+PROCEDURE DescribeType (Sym: CARDINAL) : String ;
+VAR
+   s, s1, s2: String ;
+   Low, High,
+   Subrange,
+   Subscript,
+   Type     : CARDINAL ;
+BEGIN
+   s := NIL ;
+   IF IsConstString(Sym)
+   THEN
+      IF (GetStringLength(Sym) = 1)   (* if = 1 then it maybe treated as a char *)
+      THEN
+         s := InitString('(constant string) or {%kCHAR}')
+      ELSE
+         s := InitString('(constant string)')
+      END
+   ELSIF IsConst(Sym)
+   THEN
+      s := InitString('(constant)')
+   ELSIF IsUnknown(Sym)
+   THEN
+      s := InitString('(unknown)')
+   ELSE
+      Type := GetSType(Sym) ;
+      IF Type=NulSym
+      THEN
+         s := InitString('(unknown)')
+      ELSIF IsUnbounded(Type)
+      THEN
+         s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(GetSType(Type))))) ;
+         s := Sprintf1(Mark(InitString('{%%kARRAY} {%%kOF} %s')), s1)
+      ELSIF IsArray(Type)
+      THEN
+         s := InitString('{%kARRAY} [') ;
+         Subscript := GetArraySubscript(Type) ;
+         IF Subscript#NulSym
+         THEN
+            Assert(IsSubscript(Subscript)) ;
+            Subrange := GetSType(Subscript) ;
+            IF NOT IsSubrange(Subrange)
+            THEN
+               MetaError3 ('error in definition of array {%1Ead} in the {%2N} subscript which has no subrange, instead type given is {%3a}',
+                            Sym, Subscript, Subrange)
+            END ;
+            Assert(IsSubrange(Subrange)) ;
+            GetSubrange(Subrange, High, Low) ;
+            s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Low)))) ;
+            s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(High)))) ;
+            s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s..%s')),
+                                         s1, s2)))
+         END ;
+         s1 := Mark(DescribeType(Type)) ;
+         s := ConCat(ConCat(s, Mark(InitString('] OF '))), s1)
+      ELSE
+         IF IsUnknown(Type)
+         THEN
+            s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Type)))) ;
+            s := Sprintf1(Mark(InitString('%s (currently unknown, check declaration or import)')),
+                          s1)
+         ELSE
+            s := InitStringCharStar(KeyToCharStar(GetSymName(Type)))
+         END
+      END
+   END ;
+   RETURN( s )
+END DescribeType ;
+
+
+(*
+   FailParameter - generates an error message indicating that a parameter
+                   declaration has failed.
+
+                   The parameters are:
+
+                   CurrentState  - string describing the current failing state.
+                   Given         - the token that the source code provided.
+                   Expecting     - token or identifier that was expected.
+                   ParameterNo   - parameter number that has failed.
+                   ProcedureSym  - procedure symbol where parameter has failed.
+
+                   If any parameter is Nul then it is ignored.
+*)
+
+PROCEDURE FailParameter (tokpos       : CARDINAL;
+                         CurrentState : ARRAY OF CHAR;
+                         Given        : CARDINAL;
+                         Expecting    : CARDINAL;
+                         ProcedureSym : CARDINAL;
+                         ParameterNo  : CARDINAL) ;
+VAR
+   First,
+   ExpectType: CARDINAL ;
+   s, s1, s2 : String ;
+BEGIN
+   MetaError2 ('parameter mismatch between the {%2N} parameter of procedure {%1Ead}',
+               ProcedureSym, ParameterNo) ;
+   s := InitString ('{%kPROCEDURE} {%1Eau} (') ;
+   IF NoOfParam(ProcedureSym)>=ParameterNo
+   THEN
+      IF ParameterNo>1
+      THEN
+         s := ConCat(s, Mark(InitString('.., ')))
+      END ;
+      IF IsVarParam(ProcedureSym, ParameterNo)
+      THEN
+         s := ConCat(s, Mark(InitString('{%kVAR} ')))
+      END ;
+
+      First := GetDeclaredMod(GetNthParam(ProcedureSym, ParameterNo)) ;
+      ExpectType := GetSType(Expecting) ;
+      IF IsUnboundedParam(ProcedureSym, ParameterNo)
+      THEN
+         s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Expecting)))) ;
+         s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(GetSType(ExpectType))))) ;
+         s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s: {%%kARRAY} {%%kOF} %s')),
+                                      s1, s2)))
+      ELSE
+         s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Expecting)))) ;
+         s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ExpectType)))) ;
+         s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s: %s')), s1, s2)))
+      END ;
+      IF ParameterNo<NoOfParam(ProcedureSym)
+      THEN
+         s := ConCat(s, Mark(InitString('; ... ')))
+      END
+   ELSE
+      First := GetDeclaredMod(ProcedureSym) ;
+      IF NoOfParam(ProcedureSym)>0
+      THEN
+         s := ConCat(s, Mark(InitString('..')))
+      END
+   END ;
+   s := ConCat (s, Mark (InitString ('){%1Tau:% : {%1Tau}} ;'))) ;
+   MetaErrorStringT1 (First, Dup (s), ProcedureSym) ;
+   MetaErrorStringT1 (tokpos, s, ProcedureSym) ;
+   MetaError1 ('item being passed is {%1EDda} {%1Dad} of type {%1Dtsd}', Given)
+END FailParameter ;
+
+
+(*
+   WarnParameter - generates a warning message indicating that a parameter
+                   use might cause problems on another target.
+
+                   The parameters are:
+
+                   CurrentState  - string describing the current failing state.
+                   Given         - the token that the source code provided.
+                   Expecting     - token or identifier that was expected.
+                   ParameterNo   - parameter number that has failed.
+                   ProcedureSym  - procedure symbol where parameter has failed.
+
+                   If any parameter is Nul then it is ignored.
+*)
+
+PROCEDURE WarnParameter (tokpos       : CARDINAL;
+                         CurrentState : ARRAY OF CHAR;
+                         Given        : CARDINAL;
+                         Expecting    : CARDINAL;
+                         ProcedureSym : CARDINAL;
+                         ParameterNo  : CARDINAL) ;
+VAR
+   First,
+   ExpectType,
+   ReturnType: CARDINAL ;
+   s, s1, s2 : String ;
+BEGIN
+   s := InitString('{%W}') ;
+   IF CompilingImplementationModule()
+   THEN
+      s := ConCat(s, Sprintf0(Mark(InitString('warning issued while compiling the implementation module\n'))))
+   ELSIF CompilingProgramModule()
+   THEN
+      s := ConCat(s, Sprintf0(Mark(InitString('warning issued while compiling the program module\n'))))
+   END ;
+   s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ProcedureSym)))) ;
+   s := ConCat(s, Mark(Sprintf2(Mark(InitString('problem in parameter %d, PROCEDURE %s (')),
+                                ParameterNo,
+                                s1))) ;
+   IF NoOfParam(ProcedureSym)>=ParameterNo
+   THEN
+      IF ParameterNo>1
+      THEN
+         s := ConCat(s, Mark(InitString('.., ')))
+      END ;
+      IF IsVarParam(ProcedureSym, ParameterNo)
+      THEN
+         s := ConCat(s, Mark(InitString('{%kVAR} ')))
+      END ;
+
+      First := GetDeclaredMod(GetNthParam(ProcedureSym, ParameterNo)) ;
+      ExpectType := GetSType(Expecting) ;
+      IF IsUnboundedParam(ProcedureSym, ParameterNo)
+      THEN
+         s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Expecting)))) ;
+         s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(GetSType(ExpectType))))) ;
+         s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s: {%%kARRAY} {%%kOF} %s')),
+                                      s1, s2)))
+      ELSE
+         s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Expecting)))) ;
+         s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ExpectType)))) ;
+         s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s: %s')), s1, s2)))
+      END ;
+      IF ParameterNo<NoOfParam(ProcedureSym)
+      THEN
+         s := ConCat(s, Mark(InitString('; ... ')))
+      END
+   ELSE
+      First := GetDeclaredMod(ProcedureSym) ;
+      IF NoOfParam(ProcedureSym)>0
+      THEN
+         s := ConCat(s, Mark(InitString('..')))
+      END
+   END ;
+   ReturnType := GetSType(ProcedureSym) ;
+   IF ReturnType=NulSym
+   THEN
+      s := ConCat(s, Sprintf0(Mark(InitString(') ;\n'))))
+   ELSE
+      s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ReturnType)))) ;
+      s := ConCat(s, Mark(Sprintf1(Mark(InitString(') : %s ;\n')), s1)))
+   END ;
+   IF IsConstString(Given)
+   THEN
+      s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Given)))) ;
+      s := ConCat(s, Mark(Sprintf1(Mark(InitString("item being passed is '%s'")),
+                                   s1)))
+   ELSIF IsTemporary(Given)
+   THEN
+      s := ConCat(s, Mark(InitString("item being passed has type")))
+   ELSE
+      s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Given)))) ;
+      s := ConCat(s, Mark(Sprintf1(Mark(InitString("item being passed is '%s'")),
+                                   s1)))
+   END ;
+   s1 := DescribeType(Given) ;
+   s2 := Mark(InitString(CurrentState)) ;
+   s := ConCat(s, Mark(Sprintf2(Mark(InitString(': %s\nparameter mismatch: %s')),
+                                s1, s2))) ;
+   MetaErrorStringT0 (tokpos, Dup (s)) ;
+   MetaErrorStringT0 (First, Dup (s))
+END WarnParameter ;
+
+
+(*
+   ExpectVariable - checks to see whether, sym, is declared as a variable.
+                    If not then it generates an error message.
+*)
+
+(*
+PROCEDURE ExpectVariable (a: ARRAY OF CHAR; sym: CARDINAL) ;
+VAR
+   e         : Error ;
+   s1, s2, s3: String ;
+BEGIN
+   IF NOT IsVar(sym)
+   THEN
+      e := NewError(GetTokenNo()) ;
+      IF IsUnknown(sym)
+      THEN
+         s1 := ConCat (InitString (a),
+                       Mark (InitString ('but was given an undeclared symbol {%E1a}'))) ;
+
+         ErrorString(e, Sprintf2(Mark(InitString('%s but was given an undeclared symbol %s')), s1, s2))
+      ELSE
+         s1 := Mark(InitString(a)) ;
+         s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(sym)))) ;
+         s3 := Mark(DescribeType(sym)) ;
+         ErrorString(e, Sprintf3(Mark(InitString('%s but was given %s: %s')),
+                                 s1, s2, s3))
+      END
+   END
+END ExpectVariable ;
+*)
+
+
+(*
+   doIndrX - perform des = *exp with a conversion if necessary.
+*)
+
+PROCEDURE doIndrX (tok: CARDINAL;
+                   des, exp: CARDINAL) ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   IF GetDType(des)=GetDType(exp)
+   THEN
+      GenQuadO (tok, IndrXOp, des, GetSType(des), exp, TRUE)
+   ELSE
+      t := MakeTemporary (tok, RightValue) ;
+      PutVar (t, GetSType (exp)) ;
+      GenQuadO (tok, IndrXOp, t, GetSType (exp), exp, TRUE) ;
+      GenQuadO (tok, BecomesOp, des, NulSym, doVal (GetSType(des), t), TRUE)
+   END
+END doIndrX ;
+
+
+(*
+   MakeRightValue - returns a temporary which will have the RightValue of symbol, Sym.
+                    If Sym is a right value and has type, type, then no quadruples are
+                    generated and Sym is returned. Otherwise a new temporary is created
+                    and an IndrX quadruple is generated.
+*)
+
+PROCEDURE MakeRightValue (tok: CARDINAL;
+                          Sym: CARDINAL; type: CARDINAL) : CARDINAL ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   IF GetMode (Sym) = RightValue
+   THEN
+      IF GetSType(Sym) = type
+      THEN
+         RETURN Sym    (* already a RightValue with desired type *)
+      ELSE
+         (*
+            type change or mode change, type changes are a pain, but I've
+            left them here as it is perhaps easier to remove them later.
+         *)
+         t := MakeTemporary (tok, RightValue) ;
+         PutVar (t, type) ;
+         GenQuadO (tok, BecomesOp, t, NulSym, doVal(type, Sym), TRUE) ;
+         RETURN t
+      END
+   ELSE
+      t := MakeTemporary (tok, RightValue) ;
+      PutVar (t, type) ;
+      CheckPointerThroughNil (tok, Sym) ;
+      doIndrX (tok, t, Sym) ;
+      RETURN t
+   END
+END MakeRightValue ;
+
+
+(*
+   MakeLeftValue - returns a temporary coresponding to the LeftValue of
+                   symbol, Sym. No quadruple is generated if Sym is already
+                   a LeftValue and has the same type.
+*)
+
+PROCEDURE MakeLeftValue (tok: CARDINAL;
+                         Sym: CARDINAL; with: ModeOfAddr; type: CARDINAL) : CARDINAL ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   IF GetMode (Sym) = LeftValue
+   THEN
+      IF GetSType (Sym) = type
+      THEN
+         RETURN Sym
+      ELSE
+         (*
+            type change or mode change, type changes are a pain, but I've
+            left them here as it is perhaps easier to remove them later
+         *)
+         t := MakeTemporary (tok, with) ;
+         PutVar (t, type) ;
+         GenQuadO (tok, BecomesOp, t, NulSym, Sym, TRUE) ;
+         RETURN t
+      END
+   ELSE
+      t := MakeTemporary (tok, with) ;
+      PutVar (t, type) ;
+      GenQuadO (tok, AddrOp, t, NulSym, Sym, TRUE) ;
+      RETURN t
+   END
+END MakeLeftValue ;
+
+
+(*
+   ManipulatePseudoCallParameters - manipulates the parameters to a pseudo function or
+                                    procedure. It dereferences all LeftValue parameters
+                                    and Boolean parameters.
+                                    The Stack:
+
+
+                                    Entry                      Exit
+
+                             Ptr ->                            exactly the same
+                                    +----------------+
+                                    | NoOfParameters |
+                                    |----------------|
+                                    | Param 1        |
+                                    |----------------|
+                                    | Param 2        |
+                                    |----------------|
+                                    .                .
+                                    .                .
+                                    .                .
+                                    |----------------|
+                                    | Param #        |
+                                    |----------------|
+                                    | ProcSym | Type |
+                                    |----------------|
+
+*)
+
+PROCEDURE ManipulatePseudoCallParameters ;
+VAR
+   NoOfParameters,
+   ProcSym, Proc,
+   i, pi         : CARDINAL ;
+   f             : BoolFrame ;
+BEGIN
+   PopT(NoOfParameters) ;
+   PushT(NoOfParameters) ;    (* restored to original state *)
+   (* Ptr points to the ProcSym *)
+   ProcSym := OperandT(NoOfParameters+1+1) ;
+   IF IsVar(ProcSym)
+   THEN
+      InternalError ('expecting a pseudo procedure or a type')
+   ELSE
+      Proc := ProcSym
+   END ;
+   i := 1 ;
+   pi := NoOfParameters+1 ;
+   WHILE i<=NoOfParameters DO
+      IF (GetMode(OperandT(pi))=LeftValue) AND
+         (Proc#Adr) AND (Proc#Size) AND (Proc#TSize) AND (Proc#High) AND
+         (* procedures which have first parameter as a VAR param *)
+         (((Proc#Inc) AND (Proc#Incl) AND (Proc#Dec) AND (Proc#Excl) AND (Proc#New) AND (Proc#Dispose)) OR (i>1))
+      THEN
+         (* must dereference LeftValue *)
+         f := PeepAddress(BoolStack, pi) ;
+         f^.TrueExit := MakeRightValue (GetTokenNo(), OperandT(pi), GetSType(OperandT(pi)))
+      END ;
+      INC(i) ;
+      DEC(pi)
+   END
+END ManipulatePseudoCallParameters ;
+
+
+(*
+   ManipulateParameters - manipulates the procedure parameters in
+                          preparation for a procedure call.
+                          Prepares Boolean, Unbounded and VAR parameters.
+                          The Stack:
+
+
+                          Entry                      Exit
+
+                   Ptr ->                            exactly the same
+                          +----------------+
+                          | NoOfParameters |
+                          |----------------|
+                          | Param 1        |
+                          |----------------|
+                          | Param 2        |
+                          |----------------|
+                          .                .
+                          .                .
+                          .                .
+                          |----------------|
+                          | Param #        |
+                          |----------------|
+                          | ProcSym | Type |
+                          |----------------|
+*)
+
+PROCEDURE ManipulateParameters (IsForC: BOOLEAN) ;
+VAR
+   tokpos,
+   np           : CARDINAL ;
+   s            : String ;
+   ArraySym,
+   UnboundedType,
+   ParamType,
+   NoOfParameters,
+   i, pi,
+   ProcSym, rw,
+   Proc,
+   t            : CARDINAL ;
+   f            : BoolFrame ;
+BEGIN
+   PopT(NoOfParameters) ;
+   ProcSym := OperandT(NoOfParameters+1) ;
+   tokpos := OperandTtok(NoOfParameters+1) ;
+   IF IsVar(ProcSym)
+   THEN
+      (* Procedure Variable ? *)
+      Proc := SkipType(OperandF(NoOfParameters+1))
+   ELSE
+      Proc := SkipConst(ProcSym)
+   END ;
+
+   IF IsForC AND UsesVarArgs(Proc)
+   THEN
+      IF NoOfParameters<NoOfParam(Proc)
+      THEN
+         s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Proc)))) ;
+         np := NoOfParam(Proc) ;
+         ErrorStringAt2(Sprintf3(Mark(InitString('attempting to pass (%d) parameters to procedure (%s) which was declared with varargs but contains at least (%d) parameters')),
+                                 NoOfParameters, s, np),
+                        tokpos, GetDeclaredMod(ProcSym))
+      END
+   ELSIF UsesOptArg(Proc)
+   THEN
+      IF NOT ((NoOfParameters=NoOfParam(Proc)) OR (NoOfParameters+1=NoOfParam(Proc)))
+      THEN
+         s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Proc)))) ;
+         np := NoOfParam(Proc) ;
+         ErrorStringAt2(Sprintf3(Mark(InitString('attempting to pass (%d) parameters to procedure (%s) which was declared with an optarg with a maximum of (%d) parameters')),
+                                 NoOfParameters, s, np),
+                        tokpos, GetDeclaredMod(ProcSym))
+      END
+   ELSIF NoOfParameters#NoOfParam(Proc)
+   THEN
+      s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Proc)))) ;
+      np := NoOfParam(Proc) ;
+      ErrorStringAt2(Sprintf3(Mark(InitString('attempting to pass (%d) parameters to procedure (%s) which was declared with (%d) parameters')),
+                              NoOfParameters, s, np),
+                     tokpos, GetDeclaredMod(ProcSym))
+   END ;
+   i := 1 ;
+   pi := NoOfParameters ;
+   WHILE i<=NoOfParameters DO
+      f := PeepAddress(BoolStack, pi) ;
+      rw := OperandMergeRW(pi) ;
+      Assert(IsLegal(rw)) ;
+      IF i>NoOfParam(Proc)
+      THEN
+         IF IsForC AND UsesVarArgs(Proc)
+         THEN
+            IF (GetSType(OperandT(pi))#NulSym) AND IsArray(GetDType(OperandT(pi)))
+            THEN
+               f^.TrueExit := MakeLeftValue(OperandTok(pi), OperandT(pi), RightValue, Address) ;
+               MarkAsReadWrite(rw)
+            ELSIF IsConstString (OperandT (pi))
+            THEN
+               f^.TrueExit := MakeLeftValue (OperandTok (pi),
+                                             MakeConstStringCnul (OperandTok (pi), OperandT (pi)), RightValue, Address) ;
+               MarkAsReadWrite(rw)
+            ELSIF (GetSType(OperandT(pi))#NulSym) AND IsUnbounded(GetSType(OperandT(pi)))
+            THEN
+               MarkAsReadWrite(rw) ;
+               (* pass the address field of an unbounded variable *)
+               PushTF(Adr, Address) ;
+               PushTFAD (f^.TrueExit, f^.FalseExit, f^.Unbounded, f^.Dimension) ;
+               PushT(1) ;
+               BuildAdrFunction ;
+               PopT(f^.TrueExit)
+            ELSIF GetMode(OperandT(pi))=LeftValue
+            THEN
+               MarkAsReadWrite(rw) ;
+               (* must dereference LeftValue (even if we are passing variable as a vararg) *)
+               t := MakeTemporary (OperandTok (pi), RightValue) ;
+               PutVar(t, GetSType (OperandT (pi))) ;
+               CheckPointerThroughNil (tokpos, OperandT (pi)) ;
+               doIndrX (OperandTok(pi), t, OperandT (pi)) ;
+               f^.TrueExit := t
+            END
+         ELSE
+            MetaErrorT2 (tokpos,
+                         'attempting to pass too many parameters to procedure {%1a}, the {%2N} parameter does not exist',
+                         Proc, i)
+         END
+      ELSIF IsForC AND IsUnboundedParam(Proc, i) AND
+            (GetSType(OperandT(pi))#NulSym) AND IsArray(GetDType(OperandT(pi)))
+      THEN
+         f^.TrueExit := MakeLeftValue(OperandTok(pi), OperandT(pi), RightValue, Address) ;
+         MarkAsReadWrite(rw)
+      ELSIF IsForC AND IsUnboundedParam(Proc, i) AND
+            (GetSType(OperandT(pi))#NulSym) AND IsUnbounded(GetDType(OperandT(pi)))
+      THEN
+         MarkAsReadWrite(rw) ;
+         (* pass the address field of an unbounded variable *)
+         PushTF(Adr, Address) ;
+         PushTFAD (f^.TrueExit, f^.FalseExit, f^.Unbounded, f^.Dimension) ;
+         PushT(1) ;
+         BuildAdrFunction ;
+         PopT(f^.TrueExit)
+      ELSIF IsForC AND IsConstString(OperandT(pi)) AND
+                        (IsUnboundedParam(Proc, i) OR (GetDType(GetParam(Proc, i))=Address))
+      THEN
+         f^.TrueExit := MakeLeftValue (OperandTok (pi),
+                                       MakeConstStringCnul (OperandTok (pi), OperandT (pi)),
+                                       RightValue, Address) ;
+         MarkAsReadWrite (rw)
+      ELSIF IsUnboundedParam(Proc, i)
+      THEN
+         (* always pass constant strings with a nul terminator, but leave the HIGH as before.  *)
+         IF IsConstString (OperandT(pi))
+         THEN
+            (* this is a Modula-2 string which must be nul terminated.  *)
+            f^.TrueExit := MakeConstStringM2nul (OperandTok (pi), OperandT (pi))
+         END ;
+         t := MakeTemporary (OperandTok (pi), RightValue) ;
+         UnboundedType := GetSType(GetParam(Proc, i)) ;
+         PutVar(t, UnboundedType) ;
+         ParamType := GetSType(UnboundedType) ;
+         IF OperandD(pi)=0
+         THEN
+            ArraySym := OperandT(pi)
+         ELSE
+            ArraySym := OperandA(pi)
+         END ;
+         IF IsVarParam(Proc, i)
+         THEN
+            MarkArrayWritten (OperandT (pi)) ;
+            MarkArrayWritten (OperandA (pi)) ;
+            MarkAsReadWrite(rw) ;
+            AssignUnboundedVar (OperandTtok (pi), OperandT (pi), ArraySym, t, ParamType, OperandD (pi))
+         ELSE
+            MarkAsRead(rw) ;
+            AssignUnboundedNonVar (OperandTtok (pi), OperandT (pi), ArraySym, t, ParamType, OperandD (pi))
+         END ;
+         f^.TrueExit := t
+      ELSIF IsVarParam(Proc, i)
+      THEN
+         (* must reference by address, but we contain the type of the referenced entity *)
+         MarkArrayWritten(OperandT(pi)) ;
+         MarkArrayWritten(OperandA(pi)) ;
+         MarkAsReadWrite(rw) ;
+         f^.TrueExit := MakeLeftValue(OperandTok(pi), OperandT(pi), LeftValue, GetSType(GetParam(Proc, i)))
+      ELSIF (NOT IsVarParam(Proc, i)) AND (GetMode(OperandT(pi))=LeftValue)
+      THEN
+         (* must dereference LeftValue *)
+         t := MakeTemporary (OperandTok (pi), RightValue) ;
+         PutVar(t, GetSType(OperandT(pi))) ;
+         CheckPointerThroughNil (tokpos, OperandT (pi)) ;
+         doIndrX (OperandTok(pi), t, OperandT(pi)) ;
+         f^.TrueExit := t ;
+         MarkAsRead(rw)
+      ELSE
+         MarkAsRead(rw)
+      END ;
+      INC(i) ;
+      DEC(pi)
+   END ;
+   PushT(NoOfParameters)
+END ManipulateParameters ;
+
+
+(*
+   CheckParameterOrdinals - check that ordinal values are within type range.
+*)
+
+PROCEDURE CheckParameterOrdinals ;
+VAR
+   Proc,
+   ProcSym   : CARDINAL ;
+   Actual,
+   FormalI   : CARDINAL ;
+   ParamTotal,
+   pi, i     : CARDINAL ;
+BEGIN
+   PopT (ParamTotal) ;
+   PushT (ParamTotal) ;  (* Restore stack to origional state *)
+   ProcSym := OperandT (ParamTotal+1+1) ;
+   IF IsVar(ProcSym) AND IsProcType(GetDType(ProcSym))
+   THEN
+      (* Indirect procedure call.  *)
+      Proc := SkipType(OperandF(ParamTotal+1+1))
+   ELSE
+      Proc := SkipConst(ProcSym)
+   END ;
+   i := 1 ;
+   pi := ParamTotal+1 ;   (* stack index referencing stacked parameter, i *)
+   WHILE i<=ParamTotal DO
+      IF i<=NoOfParam(Proc)
+      THEN
+         FormalI := GetParam (Proc, i) ;
+         Actual := OperandT (pi) ;
+         IF IsOrdinalType (GetLType (FormalI))
+         THEN
+            IF NOT IsSet (GetDType (FormalI))
+            THEN
+               (* tell code generator to test runtime values of assignment so ensure we
+                  catch overflow and underflow *)
+               BuildRange (InitParameterRangeCheck (Proc, i, FormalI, Actual))
+            END
+         END
+      END ;
+      INC (i) ;
+      DEC (pi)
+   END
+END CheckParameterOrdinals ;
+
+
+(*
+   IsSameUnbounded - returns TRUE if unbounded types, t1, and, t2,
+                     are compatible.
+*)
+
+PROCEDURE IsSameUnbounded (t1, t2: CARDINAL) : BOOLEAN ;
+BEGIN
+   Assert(IsUnbounded(t1)) ;
+   Assert(IsUnbounded(t2)) ;
+   RETURN( GetDType(t1)=GetDType(t2) )
+END IsSameUnbounded ;
+
+
+(*
+   AssignUnboundedVar - assigns an Unbounded symbol fields,
+                        ArrayAddress and ArrayHigh, from an array symbol.
+                        UnboundedSym is not a VAR parameter and therefore
+                        this procedure can complete both of the fields.
+                        Sym can be a Variable with type Unbounded.
+                        Sym can be a Variable with type Array.
+                        Sym can be a String Constant.
+
+                        ParamType is the TYPE of the parameter
+*)
+
+PROCEDURE AssignUnboundedVar (tok: CARDINAL;
+                              Sym, ArraySym, UnboundedSym, ParamType: CARDINAL; dim: CARDINAL) ;
+VAR
+   Type: CARDINAL ;
+BEGIN
+   IF IsConst(Sym)
+   THEN
+      MetaErrorT1 (tok, '{%1ad} cannot be passed to a VAR formal parameter', Sym)
+   ELSIF IsVar(Sym)
+   THEN
+      Type := GetDType(Sym) ;
+      IF IsUnbounded(Type)
+      THEN
+         IF Type = GetSType (UnboundedSym)
+         THEN
+            (* Copy Unbounded Symbol ie. UnboundedSym := Sym *)
+            PushT (UnboundedSym) ;
+            PushT (Sym) ;
+            BuildAssignmentWithoutBounds (tok, FALSE, TRUE)
+         ELSIF IsSameUnbounded (Type, GetSType (UnboundedSym)) OR
+               IsGenericSystemType (ParamType)
+         THEN
+            UnboundedVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim)
+         ELSE
+            MetaErrorT1 (tok, '{%1ad} cannot be passed to a VAR formal parameter', Sym)
+         END
+      ELSIF IsArray (Type) OR IsGenericSystemType (ParamType)
+      THEN
+         UnboundedVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim)
+      ELSE
+         MetaErrorT1 (tok, '{%1ad} cannot be passed to a VAR formal parameter', Sym)
+      END
+   ELSE
+      MetaErrorT1 (tok, '{%1ad} cannot be passed to a VAR formal parameter', Sym)
+   END
+END AssignUnboundedVar ;
+
+
+(*
+   AssignUnboundedNonVar - assigns an Unbounded symbol fields,
+                           The difference between this procedure and
+                           AssignUnboundedVar is that this procedure cannot
+                           set the Unbounded.Address since the data from
+                           Sym will be copied because parameter is NOT a VAR
+                           parameter.
+                           UnboundedSym is not a VAR parameter and therefore
+                           this procedure can only complete the HIGH field
+                           and not the ADDRESS field.
+                           Sym can be a Variable with type Unbounded.
+                           Sym can be a Variable with type Array.
+                           Sym can be a String Constant.
+
+                           ParamType is the TYPE of the paramater
+*)
+
+PROCEDURE AssignUnboundedNonVar (tok: CARDINAL;
+                                 Sym, ArraySym, UnboundedSym, ParamType: CARDINAL; dim: CARDINAL) ;
+VAR
+   Type: CARDINAL ;
+BEGIN
+   IF IsConst (Sym)  (* was IsConstString(Sym) *)
+   THEN
+      UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim)
+   ELSIF IsVar (Sym)
+   THEN
+      Type := GetDType (Sym) ;
+      IF IsUnbounded (Type)
+      THEN
+         UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim)
+      ELSIF IsArray (Type) OR IsGenericSystemType (ParamType)
+      THEN
+         UnboundedNonVarLinkToArray (tok, Sym, ArraySym, UnboundedSym, ParamType, dim)
+      ELSE
+         MetaErrorT1 (tok, 'illegal type parameter {%1Ead} expecting array or dynamic array', Sym)
+      END
+   ELSE
+      MetaErrorT1 (tok, 'illegal parameter {%1Ead} which cannot be passed as {%kVAR} {%kARRAY} {%kOF} {%1tsad}', Sym)
+   END
+END AssignUnboundedNonVar ;
+
+
+(*
+   GenHigh - generates a HighOp but it checks if op3 is a
+             L value and if so it dereferences it.  This
+             is inefficient, however it is clean and we let the gcc
+             backend detect these as common subexpressions.
+             It will also detect that a R value -> L value -> R value
+             via indirection and eleminate these.
+*)
+
+PROCEDURE GenHigh (tok: CARDINAL;
+                   op1, op2, op3: CARDINAL) ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   IF (GetMode(op3)=LeftValue) AND IsUnbounded(GetSType(op3))
+   THEN
+      sym := MakeTemporary (tok, RightValue) ;
+      PutVar (sym, GetSType (op3)) ;
+      doIndrX (tok, sym, op3) ;
+      GenQuadO (tok, HighOp, op1, op2, sym, TRUE)
+   ELSE
+      GenQuadO (tok, HighOp, op1, op2, op3, TRUE)
+   END
+END GenHigh ;
+
+
+(*
+   AssignHighField -
+*)
+
+PROCEDURE AssignHighField (tok: CARDINAL;
+                           Sym, ArraySym, UnboundedSym, ParamType: CARDINAL;
+                           actuali, formali: CARDINAL) ;
+VAR
+   ReturnVar,
+   ArrayType,
+   Field    : CARDINAL ;
+BEGIN
+   (* Unbounded.ArrayHigh := HIGH(ArraySym) *)
+   PushTFtok (UnboundedSym, GetSType (UnboundedSym), tok) ;
+   Field := GetUnboundedHighOffset (GetSType (UnboundedSym), formali) ;
+   PushTFtok (Field, GetSType (Field), tok) ;
+   PushT (1) ;
+   BuildDesignatorRecord (tok) ;
+   IF IsGenericSystemType (ParamType)
+   THEN
+      IF IsConstString (Sym)
+      THEN
+         PushTtok (MakeLengthConst (tok, Sym), tok)
+      ELSE
+         ArrayType := GetSType (Sym) ;
+         IF IsUnbounded (ArrayType)
+         THEN
+            (*
+             *  SIZE(parameter) DIV TSIZE(ParamType)
+             *  however in this case parameter
+             *  is an unbounded symbol and therefore we must use
+             *  (HIGH(parameter)+1)*SIZE(unbounded type) DIV TSIZE(ParamType)
+             *
+             *  we call upon the function SIZE(ArraySym)
+             *  remember SIZE doubles as
+             *  (HIGH(a)+1) * SIZE(ArrayType) for unbounded symbols
+             *)
+            PushTFtok (calculateMultipicand (tok, ArraySym, ArrayType, actuali-1), Cardinal, tok) ;
+            PushT (DivideTok) ;        (* Divide by                    *)
+            PushTFtok (TSize, Cardinal, tok) ; (* TSIZE(ParamType)     *)
+            PushTtok (ParamType, tok) ;
+            PushT (1) ;                (* 1 parameter for TSIZE()      *)
+            BuildFunctionCall ;
+            BuildBinaryOp
+         ELSE
+            (* SIZE(parameter) DIV TSIZE(ParamType)                    *)
+            PushTFtok (TSize, Cardinal, tok) ;  (* TSIZE(ArrayType)    *)
+            PushTtok (ArrayType, tok) ;
+            PushT (1) ;                (* 1 parameter for TSIZE()      *)
+            BuildFunctionCall ;
+            PushT (DivideTok) ;        (* Divide by                    *)
+            PushTFtok (TSize, Cardinal, tok) ; (* TSIZE(ParamType)     *)
+            PushTtok (ParamType, tok) ;
+            PushT (1) ;                (* 1 parameter for TSIZE()      *)
+            BuildFunctionCall ;
+            BuildBinaryOp
+         END ;
+         (* now convert from no of elements into HIGH by subtracting 1 *)
+         PushT (MinusTok) ;           (* -1                            *)
+         PushTtok (MakeConstLit (tok, MakeKey('1'), Cardinal), tok) ;
+         BuildBinaryOp
+      END
+   ELSE
+      ReturnVar := MakeTemporary (tok, RightValue) ;
+      PutVar (ReturnVar, Cardinal) ;
+      IF (actuali # formali) AND (ArraySym # NulSym) AND IsUnbounded (GetSType (ArraySym))
+      THEN
+         GenHigh (tok, ReturnVar, actuali, ArraySym)
+      ELSE
+         GenHigh (tok, ReturnVar, formali, Sym)
+      END ;
+      PushTFtok (ReturnVar, GetSType(ReturnVar), tok)
+   END ;
+   BuildAssignmentWithoutBounds (tok, FALSE, TRUE)
+END AssignHighField ;
+
+
+(*
+   AssignHighFields -
+*)
+
+PROCEDURE AssignHighFields (tok: CARDINAL;
+                            Sym, ArraySym, UnboundedSym, ParamType: CARDINAL; dim: CARDINAL) ;
+VAR
+   type            : CARDINAL ;
+   actuali, formali,
+   actualn, formaln: CARDINAL ;
+BEGIN
+   type := GetDType (Sym) ;
+   actualn := 1 ;
+   IF (type # NulSym) AND (IsUnbounded (type) OR IsArray (type))
+   THEN
+      actualn := GetDimension (type)
+   END ;
+   actuali := dim + 1 ;
+   formali := 1 ;
+   formaln := GetDimension (GetDType (UnboundedSym)) ;
+   WHILE (actuali < actualn) AND (formali < formaln) DO
+      AssignHighField (tok, Sym, ArraySym, UnboundedSym, NulSym, actuali, formali) ;
+      INC (actuali) ;
+      INC (formali)
+   END ;
+   AssignHighField (tok, Sym, ArraySym, UnboundedSym, ParamType, actuali, formali)
+END AssignHighFields ;
+
+
+(*
+   UnboundedNonVarLinkToArray - links an array, ArraySym, to an unbounded
+                                array, UnboundedSym. The parameter is a
+                                NON VAR variety.
+*)
+
+PROCEDURE UnboundedNonVarLinkToArray (tok: CARDINAL;
+                                      Sym, ArraySym, UnboundedSym, ParamType: CARDINAL; dim: CARDINAL) ;
+VAR
+   Field,
+   AddressField: CARDINAL ;
+BEGIN
+   (* Unbounded.ArrayAddress := to be assigned at runtime.  *)
+   PushTFtok (UnboundedSym, GetSType (UnboundedSym), tok) ;
+
+   Field := GetUnboundedAddressOffset(GetSType(UnboundedSym)) ;
+   PushTFtok (Field, GetSType(Field), tok) ;
+   PushT (1) ;
+   BuildDesignatorRecord (tok) ;
+   PopT (AddressField) ;
+
+   (* caller saves non var unbounded array contents.  *)
+   GenQuadO (tok, UnboundedOp, AddressField, NulSym, Sym, FALSE) ;
+
+   AssignHighFields (tok, Sym, ArraySym, UnboundedSym, ParamType, dim)
+END UnboundedNonVarLinkToArray ;
+
+
+(*
+   UnboundedVarLinkToArray - links an array, ArraySym, to an unbounded array,
+                             UnboundedSym. The parameter is a VAR variety.
+*)
+
+PROCEDURE UnboundedVarLinkToArray (tok: CARDINAL;
+                                   Sym, ArraySym, UnboundedSym, ParamType: CARDINAL; dim: CARDINAL) ;
+VAR
+   SymType,
+   Field  : CARDINAL ;
+BEGIN
+   SymType := GetSType (Sym) ;
+   (* Unbounded.ArrayAddress := ADR(Sym) *)
+   PushTFtok (UnboundedSym, GetSType (UnboundedSym), tok) ;
+   Field := GetUnboundedAddressOffset (GetSType (UnboundedSym)) ;
+   PushTFtok (Field, GetSType (Field), tok) ;
+   PushT (1) ;
+   BuildDesignatorRecord (tok) ;
+   PushTFtok (Adr, Address, tok) ;   (* ADR(Sym)                     *)
+   IF IsUnbounded (SymType) AND (dim = 0)
+   THEN
+      PushTFADtok (Sym, SymType, UnboundedSym, dim, tok)
+   ELSE
+      PushTFADtok (Sym, SymType, ArraySym, dim, tok)
+   END ;
+   PushT (1) ;               (* 1 parameter for ADR()        *)
+   BuildFunctionCall ;
+   BuildAssignmentWithoutBounds (tok, FALSE, TRUE) ;
+
+   AssignHighFields (tok, Sym, ArraySym, UnboundedSym, ParamType, dim)
+END UnboundedVarLinkToArray ;
+
+
+(*
+   BuildPseudoProcedureCall - builds a pseudo procedure call.
+                              This procedure does not directly alter the
+                              stack, but by calling routines the stack
+                              will change in the following way when this
+                              procedure returns.
+
+                              The Stack:
+
+
+                              Entry                      Exit
+
+                       Ptr ->
+                              +----------------+
+                              | NoOfParam      |
+                              |----------------|
+                              | Param 1        |
+                              |----------------|
+                              | Param 2        |
+                              |----------------|
+                              .                .
+                              .                .
+                              .                .
+                              |----------------|
+                              | Param #        |
+                              |----------------|
+                              | ProcSym | Type |         Empty
+                              |----------------|
+*)
+
+PROCEDURE BuildPseudoProcedureCall (tokno: CARDINAL) ;
+VAR
+   NoOfParam,
+   ProcSym  : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   ProcSym := OperandT (NoOfParam + 1) ;
+   PushT (NoOfParam) ;
+   (* Compile time stack restored to entry state *)
+   IF ProcSym = New
+   THEN
+      BuildNewProcedure (tokno)
+   ELSIF ProcSym = Dispose
+   THEN
+      BuildDisposeProcedure (tokno)
+   ELSIF ProcSym = Inc
+   THEN
+      BuildIncProcedure
+   ELSIF ProcSym = Dec
+   THEN
+      BuildDecProcedure
+   ELSIF ProcSym = Incl
+   THEN
+      BuildInclProcedure
+   ELSIF ProcSym = Excl
+   THEN
+      BuildExclProcedure
+   ELSIF ProcSym = Throw
+   THEN
+      BuildThrowProcedure
+   ELSE
+      InternalError  ('pseudo procedure not implemented yet')
+   END
+END BuildPseudoProcedureCall ;
+
+
+(*
+   GetItemPointedTo - returns the symbol type that is being pointed to
+                      by Sym.
+*)
+
+PROCEDURE GetItemPointedTo (Sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF IsPointer (Sym)
+   THEN
+      RETURN GetSType (Sym)
+   ELSIF IsVar (Sym) OR IsType (Sym)
+   THEN
+      RETURN GetItemPointedTo (GetSType (Sym))
+   END
+END GetItemPointedTo ;
+
+
+(*
+   BuildThrowProcedure - builds the pseudo procedure call M2RTS.Throw.
+                         The Stack:
+
+
+                         Entry                      Exit
+
+                Ptr ->
+                         +----------------+
+                         | NoOfParam      |
+                         |----------------|
+                         | Param 1        |
+                         |----------------|
+                         | Param 2        |
+                         |----------------|
+                         .                .
+                         .                .
+                         .                .
+                         |----------------|
+                         | Param #        |
+                         |----------------|
+                         | ProcSym | Type |         Empty
+                         |----------------|
+*)
+
+PROCEDURE BuildThrowProcedure ;
+VAR
+   functok  : CARDINAL ;
+   op       : CARDINAL ;
+   NoOfParam: CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok  := OperandTtok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      op := OperandT (NoOfParam) ;
+      GenQuadO (functok, ThrowOp, NulSym, NulSym, op, FALSE)
+   ELSE
+      MetaErrorT1 (functok, 'the pseudo procedure %{1Ea} takes one INTEGER parameter', Throw)
+   END ;
+   PopN (NoOfParam+1)
+END BuildThrowProcedure ;
+
+
+(*
+   BuildReThrow - creates a ThrowOp _ _ NulSym, indicating that
+                  the exception needs to be rethrown.  The stack
+                  is unaltered.
+*)
+
+PROCEDURE BuildReThrow (tokenno: CARDINAL) ;
+BEGIN
+   GenQuadO (tokenno, ThrowOp, NulSym, NulSym, NulSym, FALSE)
+END BuildReThrow ;
+
+
+(*
+   BuildNewProcedure - builds the pseudo procedure call NEW.
+                       This procedure is traditionally a "macro" for
+                       NEW(x, ...) --> ALLOCATE(x, TSIZE(x^, ...))
+                       One method of implementation is to emulate a "macro"
+                       processor by pushing the relevant input tokens
+                       back onto the input stack.
+                       However this causes two problems:
+
+                       (i)  Unnecessary code is produced for x^
+                       (ii) SIZE must be imported from SYSTEM
+                       Therefore we chose an alternative method of
+                       implementation;
+                       generate quadruples for ALLOCATE(x, TSIZE(x^, ...))
+                       this, although slightly more efficient,
+                       is more complex and circumvents problems (i) and (ii).
+
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |
+                       |----------------|
+                       | ProcSym | Type |         Empty
+                       |----------------|
+*)
+
+PROCEDURE BuildNewProcedure (functok: CARDINAL) ;
+VAR
+   NoOfParam,
+   SizeSym,
+   PtrSym,
+   ProcSym    : CARDINAL ;
+   paramtok,
+   combinedtok: CARDINAL ;
+BEGIN
+   PopT(NoOfParam) ;
+   IF NoOfParam>=1
+   THEN
+      ProcSym := RequestSym (functok, MakeKey('ALLOCATE')) ;
+      IF (ProcSym#NulSym) AND IsProcedure(ProcSym)
+      THEN
+         PtrSym := OperandT (NoOfParam) ;
+         paramtok := OperandTtok (1) ;
+         IF IsReallyPointer(PtrSym)
+         THEN
+            combinedtok := MakeVirtualTok (functok, functok, paramtok) ;
+            (*
+               Build macro: ALLOCATE( PtrSym, SIZE(PtrSym^) )
+            *)
+            PushTFtok (TSize, Cardinal, paramtok) ;(* Procedure      *)
+                                      (* x^             *)
+            PushTtok (GetItemPointedTo (PtrSym), paramtok) ;
+            PushT (1) ;               (* One parameter  *)
+            BuildFunctionCall ;
+            PopT (SizeSym) ;
+
+            PushTtok (ProcSym, combinedtok) ;  (* ALLOCATE       *)
+            PushTtok (PtrSym, paramtok) ;      (* x              *)
+            PushTtok (SizeSym, paramtok) ;     (* TSIZE(x^)      *)
+            PushT (2) ;                        (* Two parameters *)
+            BuildProcedureCall (combinedtok)
+         ELSE
+            MetaErrorT0 (paramtok, 'parameter to {%EkNEW} must be a pointer')
+         END
+      ELSE
+         MetaErrorT0 (functok, '{%E}ALLOCATE procedure not found for NEW substitution')
+      END
+   ELSE
+      MetaErrorT0 (functok, 'the pseudo procedure {%EkNEW} has one or more parameters')
+   END ;
+   PopN (NoOfParam+1)
+END BuildNewProcedure ;
+
+
+(*
+   BuildDisposeProcedure - builds the pseudo procedure call DISPOSE.
+                           This procedure is traditionally a "macro" for
+                           DISPOSE(x) --> DEALLOCATE(x, TSIZE(x^))
+                           One method of implementation is to emulate a "macro"
+                           processor by pushing the relevant input tokens
+                           back onto the input stack.
+                           However this causes two problems:
+
+                           (i)  Unnecessary code is produced for x^
+                           (ii) TSIZE must be imported from SYSTEM
+                           Therefore we chose an alternative method of
+                           implementation;
+                           generate quadruples for DEALLOCATE(x, TSIZE(x^))
+                           this, although slightly more efficient,
+                           is more complex and circumvents problems (i)
+                           and (ii).
+
+                           The Stack:
+
+
+                           Entry                      Exit
+
+                    Ptr ->
+                           +----------------+
+                           | NoOfParam      |
+                           |----------------|
+                           | Param 1        |
+                           |----------------|
+                           | Param 2        |
+                           |----------------|
+                           .                .
+                           .                .
+                           .                .
+                           |----------------|
+                           | Param #        |
+                           |----------------|
+                           | ProcSym | Type |         Empty
+                           |----------------|
+*)
+
+PROCEDURE BuildDisposeProcedure (functok: CARDINAL) ;
+VAR
+   NoOfParam,
+   SizeSym,
+   PtrSym,
+   ProcSym    : CARDINAL ;
+   combinedtok,
+   paramtok   : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   IF NoOfParam>=1
+   THEN
+      ProcSym := RequestSym (functok, MakeKey ('DEALLOCATE')) ;
+      IF (ProcSym # NulSym) AND IsProcedure (ProcSym)
+      THEN
+         PtrSym := OperandT (NoOfParam) ;
+         paramtok := OperandTtok (1) ;
+         IF IsReallyPointer (PtrSym)
+         THEN
+            combinedtok := MakeVirtualTok (functok, functok, paramtok) ;
+            (*
+               Build macro: DEALLOCATE( PtrSym, TSIZE(PtrSym^) )
+            *)
+            PushTFtok (TSize, Cardinal, paramtok) ;(* Procedure      *)
+                                      (* x^             *)
+            PushTtok (GetItemPointedTo(PtrSym), paramtok) ;
+            PushT (1) ;               (* One parameter  *)
+            BuildFunctionCall ;
+            PopT (SizeSym) ;
+
+            PushTtok (ProcSym, combinedtok) ;         (* DEALLOCATE     *)
+            PushTtok (PtrSym, paramtok) ;             (* x              *)
+            PushTtok (SizeSym, paramtok) ;            (* TSIZE(x^)      *)
+            PushT (2) ;                               (* Two parameters *)
+            BuildProcedureCall (combinedtok)
+         ELSE
+            MetaErrorT0 (paramtok, 'argument to {%EkDISPOSE} must be a pointer')
+         END
+      ELSE
+         MetaErrorT0 (functok, '{%E}DEALLOCATE procedure not found for DISPOSE substitution')
+      END
+   ELSE
+      MetaErrorT0 (functok, 'the pseudo procedure {%EkDISPOSE} has one or more parameters')
+   END ;
+   PopN (NoOfParam+1)
+END BuildDisposeProcedure ;
+
+
+(*
+   CheckRangeIncDec - performs des := des <tok> expr
+                      with range checking (if enabled).
+
+                               Stack
+                      Entry              Exit
+
+                                     +------------+
+                      empty          | des + expr |
+                                     |------------|
+*)
+
+PROCEDURE CheckRangeIncDec (tokenpos: CARDINAL; des, expr: CARDINAL; tok: Name) ;
+VAR
+   dtype, etype: CARDINAL ;
+BEGIN
+   dtype := GetDType(des) ;
+   etype := GetDType(expr) ;
+   IF WholeValueChecking AND (NOT MustNotCheckBounds)
+   THEN
+      IF tok=PlusTok
+      THEN
+         BuildRange (InitIncRangeCheck (des, expr))
+      ELSE
+         BuildRange (InitDecRangeCheck (des, expr))
+      END
+   END ;
+
+   IF IsExpressionCompatible (dtype, etype)
+   THEN
+      (* the easy case simulate a straightforward macro *)
+      PushTF(des, dtype) ;
+      PushT(tok) ;
+      PushTF(expr, etype) ;
+      doBuildBinaryOp(FALSE, TRUE)
+   ELSE
+      IF (IsOrdinalType(dtype) OR (dtype=Address) OR IsPointer(dtype)) AND
+         (IsOrdinalType(etype) OR (etype=Address) OR IsPointer(etype))
+      THEN
+         PushTF (des, dtype) ;
+         PushT (tok) ;
+         PushTF (Convert, NulSym) ;
+         PushT (dtype) ;
+         PushT (expr) ;
+         PushT (2) ;          (* Two parameters *)
+         BuildConvertFunction ;
+         doBuildBinaryOp (FALSE, TRUE)
+      ELSE
+         IF tok=PlusTok
+         THEN
+            MetaError0 ('cannot perform {%EkINC} using non ordinal types')
+         ELSE
+            MetaError0 ('cannot perform {%EkDEC} using non ordinal types')
+         END ;
+         PushTFtok (MakeConstLit (tokenpos, MakeKey ('0'), NulSym), NulSym, tokenpos)
+      END
+   END
+END CheckRangeIncDec ;
+
+
+(*
+   BuildIncProcedure - builds the pseudo procedure call INC.
+                       INC is a procedure which increments a variable.
+                       It takes one or two parameters:
+                       INC(a, b)  or  INC(a)
+                       a := a+b   or  a := a+1
+
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |
+                       |----------------|
+                       | ProcSym | Type |         Empty
+                       |----------------|
+*)
+
+PROCEDURE BuildIncProcedure ;
+VAR
+   proctok   : CARDINAL ;
+   NoOfParam,
+   dtype,
+   OperandSym,
+   VarSym,
+   TempSym   : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   proctok := OperandTtok (NoOfParam + 1) ;
+   IF (NoOfParam = 1) OR (NoOfParam = 2)
+   THEN
+      VarSym := OperandT (NoOfParam) ;  (* bottom/first parameter *)
+      IF IsVar (VarSym)
+      THEN
+         dtype := GetDType (VarSym) ;
+         IF NoOfParam = 2
+         THEN
+            OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
+         ELSE
+            PushOne (proctok, dtype, 'the {%EkINC} will cause an overflow {%1ad}') ;
+	    PopT (OperandSym)
+         END ;
+
+         PushT (VarSym) ;
+         TempSym := DereferenceLValue (OperandTok (NoOfParam), VarSym) ;
+         CheckRangeIncDec (proctok, TempSym, OperandSym, PlusTok) ;  (* TempSym + OperandSym *)
+         BuildAssignmentWithoutBounds (proctok, FALSE, TRUE)   (* VarSym := TempSym + OperandSym *)
+      ELSE
+         MetaErrorT1 (proctok,
+                      'base procedure {%EkINC} expects a variable as a parameter but was given {%1Ed}',
+                      VarSym)
+      END
+   ELSE
+      MetaErrorT0 (proctok,
+                   'the base procedure {%EkINC} expects 1 or 2 parameters')
+   END ;
+   PopN (NoOfParam + 1)
+END BuildIncProcedure ;
+
+
+(*
+   BuildDecProcedure - builds the pseudo procedure call DEC.
+                       DEC is a procedure which decrements a variable.
+                       It takes one or two parameters:
+                       DEC(a, b)  or  DEC(a)
+                       a := a-b   or  a := a-1
+
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |
+                       |----------------|
+                       | ProcSym | Type |         Empty
+                       |----------------|
+*)
+
+PROCEDURE BuildDecProcedure ;
+VAR
+   proctok,
+   NoOfParam,
+   dtype,
+   OperandSym,
+   VarSym,
+   TempSym   : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   proctok := OperandTtok (NoOfParam + 1) ;
+   IF (NoOfParam = 1) OR (NoOfParam = 2)
+   THEN
+      VarSym := OperandT (NoOfParam) ;  (* bottom/first parameter *)
+      IF IsVar (VarSym)
+      THEN
+         dtype := GetDType (VarSym) ;
+         IF NoOfParam = 2
+         THEN
+            OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
+         ELSE
+            PushOne (proctok, dtype, 'the {%EkDEC} will cause an overflow {%1ad}') ;
+	    PopT (OperandSym)
+         END ;
+
+         PushT (VarSym) ;
+         TempSym := DereferenceLValue (OperandTok (NoOfParam), VarSym) ;
+         CheckRangeIncDec (proctok, TempSym, OperandSym, MinusTok) ;  (* TempSym - OperandSym *)
+         BuildAssignmentWithoutBounds (proctok, FALSE, TRUE)   (* VarSym := TempSym - OperandSym *)
+      ELSE
+         MetaErrorT1 (proctok,
+                      'base procedure {%EkDEC} expects a variable as a parameter but was given {%1Ed}',
+                      VarSym)
+      END
+   ELSE
+      MetaErrorT0 (proctok,
+                   'the base procedure {%EkDEC} expects 1 or 2 parameters')
+   END ;
+   PopN (NoOfParam + 1)
+END BuildDecProcedure ;
+
+
+(*
+   DereferenceLValue - checks to see whether, operand, is declare as an LValue
+                       and if so it dereferences it.
+*)
+
+PROCEDURE DereferenceLValue (tok: CARDINAL; operand: CARDINAL) : CARDINAL ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   IF GetMode (operand) = LeftValue
+   THEN
+      (* dereference the pointer *)
+      sym := MakeTemporary (tok, AreConstant(IsConst(operand))) ;
+      PutVar(sym, GetSType (operand)) ;
+
+      PushTtok (sym, tok) ;
+      PushTtok (operand, tok) ;
+      BuildAssignmentWithoutBounds (tok, FALSE, TRUE) ;
+      RETURN sym
+   ELSE
+      RETURN operand
+   END
+END DereferenceLValue ;
+
+
+(*
+   BuildInclProcedure - builds the pseudo procedure call INCL.
+                        INCL is a procedure which adds bit b into a BITSET a.
+                        It takes two parameters:
+                        INCL(a, b)
+
+                        a := a + {b}
+
+                        The Stack:
+
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildInclProcedure ;
+VAR
+   proctok,
+   optok     : CARDINAL ;
+   NoOfParam,
+   DerefSym,
+   OperandSym,
+   VarSym    : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   proctok := OperandTtok (NoOfParam + 1) ;
+   IF NoOfParam = 2
+   THEN
+      VarSym := OperandT (2) ;
+      MarkArrayWritten (OperandA (2)) ;
+      OperandSym := OperandT (1) ;
+      optok := OperandTok (1) ;
+      IF IsVar (VarSym)
+      THEN
+         IF IsSet (GetDType (VarSym))
+         THEN
+            DerefSym := DereferenceLValue (optok, OperandSym) ;
+            BuildRange (InitInclCheck (VarSym, DerefSym)) ;
+            GenQuadO (proctok, InclOp, VarSym, NulSym, DerefSym, FALSE)
+         ELSE
+            MetaErrorT1 (proctok,
+                         'the first parameter to {%EkINCL} must be a set variable but is {%E1d}',
+                         VarSym)
+         END
+      ELSE
+         MetaErrorT1 (proctok,
+                      'base procedure {%EkINCL} expects a variable as a parameter but is {%E1d}',
+                      VarSym)
+      END
+   ELSE
+      MetaErrorT0 (proctok, 'the base procedure {%EkINCL} expects 1 or 2 parameters')
+   END ;
+   PopN (NoOfParam + 1)
+END BuildInclProcedure ;
+
+
+(*
+   BuildExclProcedure - builds the pseudo procedure call EXCL.
+                        INCL is a procedure which removes bit b from SET a.
+                        It takes two parameters:
+                        EXCL(a, b)
+
+                        a := a - {b}
+
+                        The Stack:
+
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildExclProcedure ;
+VAR
+   proctok,
+   optok     : CARDINAL ;
+   NoOfParam,
+   DerefSym,
+   OperandSym,
+   VarSym    : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   proctok := OperandTtok (NoOfParam + 1) ;
+   IF NoOfParam=2
+   THEN
+      VarSym := OperandT (2) ;
+      MarkArrayWritten (OperandA(2)) ;
+      OperandSym := OperandT (1) ;
+      optok := OperandTok (1) ;
+      IF IsVar (VarSym)
+      THEN
+         IF IsSet (GetDType (VarSym))
+         THEN
+            DerefSym := DereferenceLValue (optok, OperandSym) ;
+            BuildRange (InitExclCheck (VarSym, DerefSym)) ;
+            GenQuadO (proctok, ExclOp, VarSym, NulSym, DerefSym, FALSE)
+         ELSE
+            MetaErrorT1 (proctok,
+                         'the first parameter to {%EkEXCL} must be a set variable but is {%E1d}',
+                         VarSym)
+         END
+      ELSE
+         MetaErrorT1 (proctok,
+                      'base procedure {%EkEXCL} expects a variable as a parameter but is {%E1d}',
+                      VarSym)
+      END
+   ELSE
+      MetaErrorT0 (proctok,
+                   'the base procedure {%EkEXCL} expects 1 or 2 parameters')
+   END ;
+   PopN (NoOfParam + 1)
+END BuildExclProcedure ;
+
+
+(*
+   CheckBuildFunction - checks to see whether ProcSym is a function
+                        and if so it adds a TempSym value which will
+                        hold the return value once the function finishes.
+                        This procedure also generates an error message
+                        if the user is calling a function and ignoring
+                        the return result.  The additional TempSym
+                        is not created if ProcSym is a procedure
+                        and the stack is unaltered.
+
+                        The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+
+                                                  +----------------+
+                                                  | ProcSym | Type |
+                       +----------------+         |----------------|
+                       | ProcSym | Type |         | TempSym | Type |
+                       |----------------|         |----------------|
+*)
+
+PROCEDURE CheckBuildFunction () : BOOLEAN ;
+VAR
+   n            : Name ;
+   tokpos,
+   TempSym,
+   ProcSym, Type: CARDINAL ;
+BEGIN
+   PopTFtok(ProcSym, Type, tokpos) ;
+   IF IsVar(ProcSym) AND IsProcType(Type)
+   THEN
+      IF GetSType(Type)#NulSym
+      THEN
+         TempSym := MakeTemporary (tokpos, RightValue) ;
+         PutVar(TempSym, GetSType(Type)) ;
+         PushTFtok(TempSym, GetSType(Type), tokpos) ;
+         PushTFtok(ProcSym, Type, tokpos) ;
+         IF NOT IsReturnOptional(Type)
+         THEN
+            IF IsTemporary(ProcSym)
+            THEN
+               ErrorFormat0 (NewError (tokpos),
+                             'function is being called but its return value is ignored')
+            ELSE
+               n := GetSymName (ProcSym) ;
+               ErrorFormat1 (NewError (tokpos),
+                            'function (%a) is being called but its return value is ignored', n)
+            END
+         END ;
+         RETURN TRUE
+      END
+   ELSIF IsProcedure(ProcSym) AND (Type#NulSym)
+   THEN
+      TempSym := MakeTemporary (tokpos, RightValue) ;
+      PutVar(TempSym, Type) ;
+      PushTFtok(TempSym, Type, tokpos) ;
+      PushTFtok(ProcSym, Type, tokpos) ;
+      IF NOT IsReturnOptional(ProcSym)
+      THEN
+         n := GetSymName(ProcSym) ;
+         ErrorFormat1(NewError(tokpos),
+                      'function (%a) is being called but its return value is ignored', n)
+      END ;
+      RETURN TRUE
+   END ;
+   PushTFtok (ProcSym, Type, tokpos) ;
+   RETURN FALSE
+END CheckBuildFunction ;
+
+
+(*
+   BuildFunctionCall - builds a function call.
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |                        <- Ptr
+                       |----------------|         +------------+
+                       | ProcSym | Type |         | ReturnVar  |
+                       |----------------|         |------------|
+*)
+
+PROCEDURE BuildFunctionCall ;
+VAR
+   paramtok,
+   combinedtok,
+   functok,
+   NoOfParam,
+   ProcSym    : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok  := OperandTtok (NoOfParam + 1) ;
+   ProcSym := OperandT (NoOfParam + 1) ;
+   ProcSym := SkipConst (ProcSym) ;
+   PushT (NoOfParam) ;
+   (* Compile time stack restored to entry state *)
+   IF IsUnknown (ProcSym)
+   THEN
+      paramtok := OperandTtok (1) ;
+      combinedtok := MakeVirtualTok (functok, functok, paramtok) ;
+      MetaErrorT1 (functok, 'procedure function {%1Ea} is undefined', ProcSym) ;
+      PopN (NoOfParam + 2) ;
+      PushT (MakeConstLit (combinedtok, MakeKey ('0'), NulSym))   (* fake return value to continue compiling *)
+   ELSIF IsAModula2Type (ProcSym)
+   THEN
+      ManipulatePseudoCallParameters ;
+      BuildTypeCoercion
+   ELSIF IsPseudoSystemFunction (ProcSym) OR
+         IsPseudoBaseFunction (ProcSym)
+   THEN
+      ManipulatePseudoCallParameters ;
+      BuildPseudoFunctionCall
+   ELSE
+      BuildRealFunctionCall (functok)
+   END
+END BuildFunctionCall ;
+
+
+(*
+   BuildConstFunctionCall - builds a function call and checks that this function can be
+                            called inside a ConstExpression.
+
+                            The Stack:
+
+
+                            Entry                      Exit
+
+                     Ptr ->
+                            +----------------+
+                            | NoOfParam      |
+                            |----------------|
+                            | Param 1        |
+                            |----------------|
+                            | Param 2        |
+                            |----------------|
+                            .                .
+                            .                .
+                            .                .
+                            |----------------|
+                            | Param #        |                        <- Ptr
+                            |----------------|         +------------+
+                            | ProcSym | Type |         | ReturnVar  |
+                            |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildConstFunctionCall ;
+VAR
+   functok,
+   combinedtok,
+   paramtok,
+   ConstExpression,
+   NoOfParam,
+   ProcSym        : CARDINAL ;
+BEGIN
+   DisplayStack ;
+   PopT(NoOfParam) ;
+   ProcSym := OperandT (NoOfParam + 1) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   IF CompilerDebugging
+   THEN
+      printf2 ('procsym = %d  token = %d\n', ProcSym, functok) ;
+      ErrorStringAt (InitString ('constant function'), functok)
+   END ;
+   PushT (NoOfParam) ;
+   IF (ProcSym # Convert) AND
+      (IsPseudoBaseFunction (ProcSym) OR
+       IsPseudoSystemFunctionConstExpression (ProcSym) OR
+       (IsProcedure (ProcSym) AND IsProcedureBuiltin (ProcSym)))
+   THEN
+      BuildFunctionCall
+   ELSE
+      IF IsAModula2Type (ProcSym)
+      THEN
+         (* type conversion *)
+         IF NoOfParam = 1
+         THEN
+            ConstExpression := OperandT (NoOfParam + 1) ;
+            paramtok := OperandTtok (NoOfParam + 1) ;
+            PopN (NoOfParam + 2) ;
+            (*
+               Build macro: CONVERT( ProcSym, ConstExpression )
+            *)
+            PushTFtok (Convert, NulSym, functok) ;
+            PushTtok (ProcSym, functok) ;
+            PushTtok (ConstExpression, paramtok) ;
+            PushT (2) ;          (* Two parameters *)
+            BuildConvertFunction
+         ELSE
+            MetaErrorT0 (functok, '{%E}a constant type conversion can only have one argument')
+         END
+      ELSE
+         (* error issue message and fake return stack *)
+         IF Iso
+         THEN
+            MetaErrorT0 (functok, 'the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kCMPLX}, {%kFLOAT}, {%kHIGH}, {%kIM}, {%kLENGTH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kRE}, {%kSIZE}, {%kTSIZE}, {%kTRUNC}, {%kVAL} and gcc builtins')
+         ELSE
+            MetaErrorT0 (functok, 'the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kFLOAT}, {%kHIGH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kSIZE}, {%kTSIZE}, {%kTRUNC}, {%kVAL} and gcc builtins')
+         END ;
+	 IF NoOfParam > 0
+	 THEN
+            paramtok := OperandTtok (NoOfParam + 1) ;
+            combinedtok := MakeVirtualTok (functok, functok, paramtok)
+         ELSE
+	    combinedtok := functok
+         END ;
+         PopN (NoOfParam+2) ;
+         PushT (MakeConstLit (combinedtok, MakeKey('0'), NulSym))   (* fake return value to continue compiling *)
+      END
+   END
+END BuildConstFunctionCall ;
+
+
+(*
+   BuildTypeCoercion - builds the type coersion.
+                       MODULA-2 allows types to be coersed with no runtime
+                       penility.
+                       It insists that the TSIZE(t1)=TSIZE(t2) where
+                       t2 variable := t2(variable of type t1).
+                       The ReturnVar on the stack is of type t2.
+
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |                        <- Ptr
+                       |----------------|         +------------+
+                       | ProcSym | Type |         | ReturnVar  |
+                       |----------------|         |------------|
+
+                       Quadruples:
+
+                       CoerceOp  ReturnVar  Type  Param1
+
+                       A type coercion will only be legal if the different
+                       types have exactly the same size.
+                       Since we can only decide this after M2Eval has processed
+                       the symbol table then we create a quadruple explaining
+                       the coercion taking place, the code generator can test
+                       this assertion and report an error if the type sizes
+                       differ.
+*)
+
+PROCEDURE BuildTypeCoercion ;
+VAR
+   resulttok,
+   proctok,
+   exptok   : CARDINAL ;
+   r,
+   exp,
+   NoOfParam,
+   ReturnVar,
+   ProcSym  : CARDINAL ;
+BEGIN
+   PopT(NoOfParam) ;
+   ProcSym := OperandT (NoOfParam+1) ;
+   proctok := OperandTok (NoOfParam+1) ;
+   IF NOT IsAModula2Type (ProcSym)
+   THEN
+      MetaError1 ('coersion expecting a type, seen {%1Ea} which is {%1Ed}', ProcSym)
+   END ;
+   IF NoOfParam = 1
+   THEN
+      PopTrwtok (exp, r, exptok) ;
+      MarkAsRead (r) ;
+      resulttok := MakeVirtualTok (proctok, proctok, exptok) ;
+      ReturnVar := MakeTemporary (resulttok, RightValue) ;
+      PutVar (ReturnVar, ProcSym) ;  (* Set ReturnVar's TYPE *)
+      PopN (1) ;   (* pop procedure.  *)
+      IF IsConst (exp) OR IsVar (exp)
+      THEN
+         GenQuad (CoerceOp, ReturnVar, ProcSym, exp)
+      ELSE
+         MetaError2 ('trying to coerse {%1EMRad} which is not a variable or constant into {%2ad}',
+                     exp, ProcSym) ;
+         MetaError2 ('trying to coerse {%1ECad} which is not a variable or constant into {%2ad}',
+                     exp, ProcSym)
+      END ;
+      PushTFtok (ReturnVar, ProcSym, resulttok)
+   ELSE
+      MetaError0 ('{%E}only one parameter expected in a TYPE coersion')
+   END
+END BuildTypeCoercion ;
+
+
+(*
+   BuildRealFunctionCall - builds a function call.
+                           The Stack:
+
+
+                           Entry                      Exit
+
+                    Ptr ->
+                           +----------------+
+                           | NoOfParam      |
+                           |----------------|
+                           | Param 1        |
+                           |----------------|
+                           | Param 2        |
+                           |----------------|
+                           .                .
+                           .                .
+                           .                .
+                           |----------------|
+                           | Param #        |                        <- Ptr
+                           |----------------|         +------------+
+                           | ProcSym | Type |         | ReturnVar  |
+                           |----------------|         |------------|
+*)
+
+PROCEDURE BuildRealFunctionCall (tokno: CARDINAL) ;
+VAR
+   NoOfParam,
+   ProcSym  : CARDINAL ;
+BEGIN
+   PopT(NoOfParam) ;
+   PushT(NoOfParam) ;
+   ProcSym := OperandT (NoOfParam+2) ;
+   ProcSym := SkipConst (ProcSym) ;
+   IF IsVar(ProcSym)
+   THEN
+      (* Procedure Variable ? *)
+      ProcSym := SkipType(OperandF(NoOfParam+2))
+   END ;
+   IF IsDefImp (GetScope (ProcSym)) AND IsDefinitionForC (GetScope(ProcSym))
+   THEN
+      BuildRealFuncProcCall (tokno, TRUE, TRUE)
+   ELSE
+      BuildRealFuncProcCall (tokno, TRUE, FALSE)
+   END
+END BuildRealFunctionCall ;
+
+
+(*
+   BuildPseudoFunctionCall - builds the pseudo function
+                             The Stack:
+
+
+                             Entry                      Exit
+
+                      Ptr ->
+                             +----------------+
+                             | NoOfParam      |
+                             |----------------|
+                             | Param 1        |
+                             |----------------|
+                             | Param 2        |
+                             |----------------|
+                             .                .
+                             .                .
+                             .                .
+                             |----------------|
+                             | Param #        |                        <- Ptr
+                             |----------------|         +------------+
+                             | ProcSym | Type |         | ReturnVar  |
+                             |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildPseudoFunctionCall ;
+VAR
+   NoOfParam,
+   ProcSym  : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   ProcSym := OperandT (NoOfParam+1) ;
+   ProcSym := SkipConst (ProcSym) ;
+   PushT (NoOfParam) ;
+   (* Compile time stack restored to entry state *)
+   IF ProcSym = High
+   THEN
+      BuildHighFunction
+   ELSIF ProcSym = LengthS
+   THEN
+      BuildLengthFunction
+   ELSIF ProcSym = Adr
+   THEN
+      BuildAdrFunction
+   ELSIF ProcSym = Size
+   THEN
+      BuildSizeFunction
+   ELSIF ProcSym = TSize
+   THEN
+      BuildTSizeFunction
+   ELSIF ProcSym = TBitSize
+   THEN
+      BuildTBitSizeFunction
+   ELSIF ProcSym = Convert
+   THEN
+      BuildConvertFunction
+   ELSIF ProcSym = Odd
+   THEN
+      BuildOddFunction
+   ELSIF ProcSym = Abs
+   THEN
+      BuildAbsFunction
+   ELSIF ProcSym = Cap
+   THEN
+      BuildCapFunction
+   ELSIF ProcSym = Val
+   THEN
+      BuildValFunction
+   ELSIF ProcSym = Chr
+   THEN
+      BuildChrFunction
+   ELSIF IsOrd (ProcSym)
+   THEN
+      BuildOrdFunction (ProcSym)
+   ELSIF IsInt (ProcSym)
+   THEN
+      BuildIntFunction (ProcSym)
+   ELSIF IsTrunc (ProcSym)
+   THEN
+      BuildTruncFunction (ProcSym)
+   ELSIF IsFloat (ProcSym)
+   THEN
+      BuildFloatFunction (ProcSym)
+   ELSIF ProcSym = Min
+   THEN
+      BuildMinFunction
+   ELSIF ProcSym = Max
+   THEN
+      BuildMaxFunction
+   ELSIF ProcSym = AddAdr
+   THEN
+      BuildAddAdrFunction
+   ELSIF ProcSym = SubAdr
+   THEN
+      BuildSubAdrFunction
+   ELSIF ProcSym = DifAdr
+   THEN
+      BuildDifAdrFunction
+   ELSIF ProcSym = Cast
+   THEN
+      BuildCastFunction
+   ELSIF ProcSym = Shift
+   THEN
+      BuildShiftFunction
+   ELSIF ProcSym = Rotate
+   THEN
+      BuildRotateFunction
+   ELSIF ProcSym = MakeAdr
+   THEN
+      BuildMakeAdrFunction
+   ELSIF ProcSym = Re
+   THEN
+      BuildReFunction
+   ELSIF ProcSym = Im
+   THEN
+      BuildImFunction
+   ELSIF ProcSym = Cmplx
+   THEN
+      BuildCmplxFunction
+   ELSE
+      InternalError  ('pseudo function not implemented yet')
+   END
+END BuildPseudoFunctionCall ;
+
+
+(*
+   BuildAddAdrFunction - builds the pseudo procedure call ADDADR.
+
+                         PROCEDURE ADDADR (addr: ADDRESS; offset: CARDINAL): ADDRESS ;
+
+                         Which returns address given by (addr + offset),
+                         [ the standard says that it _may_
+                           "raise an exception if this address is not valid."
+                           currently we do not generate any exception code ]
+
+                         The Stack:
+
+                         Entry                      Exit
+
+                  Ptr ->
+                         +----------------+
+                         | NoOfParam      |
+                         |----------------|
+                         | Param 1        |
+                         |----------------|
+                         | Param 2        |                        <- Ptr
+                         |----------------|         +------------+
+                         | ProcSym | Type |         | ReturnVar  |
+                         |----------------|         |------------|
+*)
+
+PROCEDURE BuildAddAdrFunction ;
+VAR
+   combinedtok,
+   functok,
+   optok      : CARDINAL ;
+   ReturnVar,
+   NoOfParam,
+   OperandSym,
+   VarSym     : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   IF NoOfParam=2
+   THEN
+      VarSym := OperandT (2) ;
+      OperandSym := OperandT (1) ;
+      optok := OperandTok (1) ;
+      combinedtok := MakeVirtualTok (functok, functok, optok) ;
+      PopN (NoOfParam + 1) ;
+      IF IsVar (VarSym)
+      THEN
+         IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address)
+         THEN
+            ReturnVar := MakeTemporary (combinedtok, RightValue) ;
+            PutVar (ReturnVar, Address) ;
+            GenQuad (AddOp, ReturnVar, VarSym, DereferenceLValue (optok, OperandSym)) ;
+            PushTFtok (ReturnVar, Address, combinedtok)
+         ELSE
+            MetaErrorT1 (functok,
+                         'the first parameter to ADDADR {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+                         VarSym) ;
+            PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), Address, combinedtok)
+         END
+      ELSE
+         MetaErrorT0 (functok, '{%E}SYSTEM procedure ADDADR expects a variable of type ADDRESS or POINTER as its first parameter') ;
+         PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), Address, combinedtok)
+      END
+   ELSE
+      MetaErrorT0 (functok, '{%E}SYSTEM procedure ADDADR expects 2 parameters') ;
+      PopN (NoOfParam + 1) ;
+      PushTFtok (MakeConstLit (functok, MakeKey ('0'), Address), Address, functok)
+   END
+END BuildAddAdrFunction ;
+
+
+(*
+   BuildSubAdrFunction - builds the pseudo procedure call ADDADR.
+
+                         PROCEDURE SUBADR (addr: ADDRESS; offset: CARDINAL): ADDRESS ;
+
+                         Which returns address given by (addr - offset),
+                         [ the standard says that it _may_
+                           "raise an exception if this address is not valid."
+                           currently we do not generate any exception code ]
+
+                         The Stack:
+
+                         Entry                      Exit
+
+                  Ptr ->
+                         +----------------+
+                         | NoOfParam      |
+                         |----------------|
+                         | Param 1        |
+                         |----------------|
+                         | Param 2        |                        <- Ptr
+                         |----------------|         +------------+
+                         | ProcSym | Type |         | ReturnVar  |
+                         |----------------|         |------------|
+*)
+
+PROCEDURE BuildSubAdrFunction ;
+VAR
+   functok,
+   combinedtok,
+   optok,
+   vartok     : CARDINAL ;
+   ReturnVar,
+   NoOfParam,
+   OperandSym,
+   VarSym     : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   OperandSym := OperandT (1) ;
+   optok := OperandTok (1) ;
+   IF NoOfParam = 2
+   THEN
+      VarSym := OperandT (2) ;
+      vartok := OperandTok (2) ;
+      combinedtok := MakeVirtualTok (functok, functok, optok) ;
+      PopN (NoOfParam + 1) ;
+      IF IsVar (VarSym)
+      THEN
+         IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address)
+         THEN
+            ReturnVar := MakeTemporary (combinedtok, RightValue) ;
+            PutVar (ReturnVar, Address) ;
+            GenQuad (SubOp, ReturnVar, VarSym, DereferenceLValue (optok, OperandSym)) ;
+            PushTFtok (ReturnVar, Address, combinedtok)
+         ELSE
+            MetaErrorT1 (functok,
+                         'the first parameter to {%EkSUBADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+                         VarSym) ;
+            PushTFtok (MakeConstLit (vartok, MakeKey('0'), Address), Address, vartok)
+         END
+      ELSE
+         combinedtok := MakeVirtualTok (functok, functok, optok) ;
+         MetaErrorT0 (combinedtok,
+                      '{%E}SYSTEM procedure {%EkSUBADR} expects a variable of type ADDRESS or POINTER as its first parameter') ;
+         PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Address), Address, combinedtok)
+      END
+   ELSE
+      combinedtok := MakeVirtualTok (functok, functok, optok) ;
+      MetaErrorT0 (functok,
+                   '{%E}SYSTEM procedure {%EkSUBADR} expects 2 parameters') ;
+      PopN (NoOfParam+1) ;
+      PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), Address, combinedtok)
+   END
+END BuildSubAdrFunction ;
+
+
+(*
+   BuildDifAdrFunction - builds the pseudo procedure call DIFADR.
+
+                         PROCEDURE DIFADR (addr1, addr2: ADDRESS): INTEGER ;
+
+                         Which returns address given by (addr1 - addr2),
+                         [ the standard says that it _may_
+                           "raise an exception if this address is invalid or
+                            address space is non-contiguous."
+                           currently we do not generate any exception code ]
+
+                         The Stack:
+
+                         Entry                      Exit
+
+                  Ptr ->
+                         +----------------+
+                         | NoOfParam      |
+                         |----------------|
+                         | Param 1        |
+                         |----------------|
+                         | Param 2        |                        <- Ptr
+                         |----------------|         +------------+
+                         | ProcSym | Type |         | ReturnVar  |
+                         |----------------|         |------------|
+*)
+
+PROCEDURE BuildDifAdrFunction ;
+VAR
+   functok,
+   optok,
+   vartok,
+   combinedtok: CARDINAL ;
+   TempVar,
+   NoOfParam,
+   OperandSym,
+   VarSym     : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   OperandSym := OperandT (1) ;
+   optok := OperandTok (1) ;
+   IF NoOfParam = 2
+   THEN
+      VarSym := OperandT (2) ;
+      vartok := OperandTok (2) ;
+      combinedtok := MakeVirtualTok (functok, functok, optok) ;
+      PopN (NoOfParam + 1) ;
+      IF IsVar (VarSym)
+      THEN
+         IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address)
+         THEN
+            IF IsReallyPointer (OperandSym) OR (GetSType (OperandSym) = Address)
+            THEN
+               TempVar := MakeTemporary (vartok, RightValue) ;
+               PutVar (TempVar, Address) ;
+               GenQuad (SubOp, TempVar, VarSym, DereferenceLValue (optok, OperandSym)) ;
+               (*
+                  Build macro: CONVERT( INTEGER, TempVar )
+               *)
+               PushTFtok (Convert, NulSym, functok) ;
+               PushTtok (Integer, functok) ;
+               PushTtok (TempVar, vartok) ;
+               PushT (2) ;          (* Two parameters *)
+               BuildConvertFunction
+            ELSE
+               MetaError1 ('the second parameter to {%EkDIFADR } {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+                           OperandSym) ;
+               PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Integer), Integer, combinedtok)
+            END
+         ELSE
+            MetaError1 ('the first parameter to {%EkDIFADR } {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+                        VarSym) ;
+            PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Integer), Integer, combinedtok)
+         END
+      ELSE
+         MetaError0 ('{%E}SYSTEM procedure {%EkDIFADR } expects a variable of type ADDRESS or POINTER as its first parameter') ;
+         PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), Integer, combinedtok)
+      END
+   ELSE
+      combinedtok := MakeVirtualTok (functok, functok, optok) ;
+      MetaErrorT0 (functok, '{%E}SYSTEM procedure {%EkDIFADR } expects 2 parameters') ;
+      PopN (NoOfParam+1) ;
+      PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), Integer, combinedtok)
+   END
+END BuildDifAdrFunction ;
+
+
+(*
+   BuildHighFunction - checks the stack in preparation for generating
+                       quadruples which perform HIGH.
+                       This procedure does not alter the stack but
+                       determines whether, a, in HIGH(a) is an ArraySym
+                       or UnboundedSym.
+                       Both cases are different and appropriate quadruple
+                       generating routines are called.
+
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |                        <- Ptr
+                       |----------------|         +------------+
+                       | ProcSym | Type |         | ReturnVar  |
+                       |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildHighFunction ;
+VAR
+   functok,
+   combinedtok,
+   paramtok   : CARDINAL ;
+   ProcSym,
+   Type,
+   NoOfParam,
+   Param      : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   ProcSym := OperandT (NoOfParam+1) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   BuildSizeCheckEnd (ProcSym) ;   (* quadruple generation now on *)
+   IF NoOfParam = 1
+   THEN
+      Param := OperandT (1) ;
+      paramtok := OperandTok (1) ;
+      combinedtok := MakeVirtualTok (paramtok, functok, paramtok) ;
+      Type := GetDType (Param) ;
+      (* Restore stack to original form *)
+      PushT (NoOfParam) ;
+      IF (NOT IsVar(Param)) AND (NOT IsConstString(Param)) AND (NOT IsConst(Param))
+      THEN
+         (* we cannot test for IsConst(Param) AND (GetSType(Param)=Char)  as the type might not be assigned yet *)
+         MetaError1 ('base procedure {%EkHIGH} expects a variable or string constant as its parameter {%1d:rather than {%1d}} {%1asa}', Param)
+      ELSIF IsUnbounded(Type)
+      THEN
+         BuildHighFromUnbounded (combinedtok)
+      ELSE
+         BuildConstHighFromSym (combinedtok)
+      END
+   ELSE
+      MetaError0 ('base procedure {%EkHIGH} requires one parameter') ;
+      PopN (2) ;
+      PushTFtok (MakeConstLit (functok, MakeKey ('0'), Cardinal), Cardinal, functok)
+   END
+END BuildHighFunction ;
+
+
+(*
+   BuildConstHighFromSym - builds the pseudo function HIGH from an Sym.
+                           Sym is a constant or an array which has constant bounds
+                           and therefore it can be calculated at compile time.
+
+                           The Stack:
+
+
+                           Entry                      Exit
+
+                   Ptr ->
+                           +----------------+
+                           | NoOfParam      |
+                           |----------------|
+                           | Param 1        |
+                           |----------------|
+                           | Param 2        |
+                           |----------------|
+                           .                .
+                           .                .
+                           .                .
+                           |----------------|
+                           | Param #        |                        <- Ptr
+                           |----------------|         +------------+
+                           | ProcSym | Type |         | ReturnVar  |
+                           |----------------|         |------------|
+*)
+
+PROCEDURE BuildConstHighFromSym (tok: CARDINAL) ;
+VAR
+   Dim,
+   NoOfParam,
+   ReturnVar: CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   ReturnVar := MakeTemporary (tok, ImmediateValue) ;
+   Dim := OperandD (1) ;
+   INC (Dim) ;
+   GenHigh (tok, ReturnVar, 1, OperandT (1)) ;
+   PopN (NoOfParam+1) ;
+   PushTtok (ReturnVar, tok)
+END BuildConstHighFromSym ;
+
+
+(*
+   BuildHighFromUnbounded - builds the pseudo function HIGH from an
+                            UnboundedSym.
+
+                            The Stack:
+
+
+                            Entry                      Exit
+
+                     Ptr ->
+                            +----------------+
+                            | NoOfParam      |
+                            |----------------|
+                            | Param #        |                        <- Ptr
+                            |----------------|         +------------+
+                            | ProcSym | Type |         | ReturnVar  |
+                            |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildHighFromUnbounded (tok: CARDINAL) ;
+VAR
+   Dim,
+   NoOfParam,
+   ReturnVar: CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   Assert (NoOfParam=1) ;
+   ReturnVar := MakeTemporary (tok, RightValue) ;
+   PutVar (ReturnVar, Cardinal) ;
+   Dim := OperandD (1) ;
+   INC (Dim) ;
+   IF Dim > 1
+   THEN
+      GenHigh (tok, ReturnVar, Dim, OperandA(1))
+   ELSE
+      GenHigh (tok, ReturnVar, Dim, OperandT(1))
+   END ;
+   PopN (2) ;
+   PushTFtok (ReturnVar, GetSType(ReturnVar), tok)
+END BuildHighFromUnbounded ;
+
+
+(*
+   GetQualidentImport - returns the symbol as if it were qualified from, module.n.
+                        This is used to reference runtime support procedures and an
+                        error is generated if the symbol cannot be obtained.
+*)
+
+PROCEDURE GetQualidentImport (tokno: CARDINAL;
+                              n: Name; module: Name) : CARDINAL ;
+VAR
+   ModSym: CARDINAL ;
+BEGIN
+   ModSym := MakeDefinitionSource (tokno, module) ;
+   IF ModSym=NulSym
+   THEN
+      MetaErrorNT2 (tokno,
+                    'module %a cannot be found and is needed to import %a', module, n) ;
+      FlushErrors ;
+      RETURN NulSym
+   END ;
+   Assert(IsDefImp(ModSym)) ;
+   IF (GetExported (tokno, ModSym, n)=NulSym) OR IsUnknown (GetExported (tokno, ModSym, n))
+   THEN
+      MetaErrorN2 ('module %a does not export procedure %a which is a necessary component of the runtime system, hint check the path and library/language variant',
+                   module, n) ;
+      FlushErrors ;
+      RETURN NulSym
+   END ;
+   RETURN GetExported (tokno, MakeDefinitionSource (tokno, module), n)
+END GetQualidentImport ;
+
+
+(*
+   MakeLengthConst - creates a constant which contains the length of string, sym.
+*)
+
+PROCEDURE MakeLengthConst (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN MakeConstant (tok, GetStringLength (sym))
+END MakeLengthConst ;
+
+
+(*
+   BuildLengthFunction - builds the inline standard function LENGTH.
+
+                         The Stack:
+
+
+                         Entry                      Exit
+
+                  Ptr ->
+                         +----------------+
+                         | NoOfParam      |
+                         |----------------|
+                         | Param 1        |                        <- Ptr
+                         |----------------|         +------------+
+                         | ProcSym | Type |         | ReturnVar  |
+                         |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildLengthFunction ;
+VAR
+   combinedtok,
+   paramtok,
+   functok    : CARDINAL ;
+   ProcSym,
+   Type,
+   NoOfParam,
+   Param,
+   ReturnVar  : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   Param := OperandT (1) ;
+   paramtok := OperandTok (1) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   (* Restore stack to origional form *)
+   PushT (NoOfParam) ;
+   Type := GetSType (Param) ;  (* get the type from the symbol, not the stack *)
+   IF NoOfParam # 1
+   THEN
+      MetaErrorT1 (functok, 'base procedure {%E1kLENGTH} expects 1 parameter, seen {%1En} parameters', NoOfParam)
+   END ;
+   IF NoOfParam >= 1
+   THEN
+      combinedtok := MakeVirtualTok (paramtok, functok, paramtok) ;
+      IF IsConst (Param) AND (GetSType (Param) = Char)
+      THEN
+         PopT (NoOfParam) ;
+         PopN (NoOfParam + 1) ;
+         ReturnVar := MakeConstLit (combinedtok, MakeKey ('1'), Cardinal) ;
+         PushTtok (ReturnVar, combinedtok)
+      ELSIF IsConstString (Param)
+      THEN
+         PopT (NoOfParam) ;
+         ReturnVar := MakeLengthConst (combinedtok, OperandT (1)) ;
+         PopN (NoOfParam + 1) ;
+         PushTtok (ReturnVar, combinedtok)
+      ELSE
+         ProcSym := GetQualidentImport (functok, MakeKey ('Length'), MakeKey ('M2RTS')) ;
+         IF (ProcSym # NulSym) AND IsProcedure (ProcSym)
+         THEN
+            PopT (NoOfParam) ;
+            IF IsConst (OperandT (1))
+            THEN
+               (* we can fold this in M2GenGCC.  *)
+               ReturnVar := MakeTemporary (combinedtok, ImmediateValue) ;
+               PutVar (ReturnVar, Cardinal) ;
+               GenQuad (StandardFunctionOp, ReturnVar, ProcSym, OperandT (1)) ;
+               PopN (NoOfParam + 1) ;
+               PushTtok (ReturnVar, combinedtok)
+            ELSE
+               (* no we must resolve this at runtime or in the GCC optimizer.  *)
+               PopTF (Param, Type);
+	       PopN (NoOfParam) ;
+	       PushTtok (ProcSym, functok) ;
+               PushTFtok (Param, Type, paramtok) ;
+	       PushT (NoOfParam) ;
+	       BuildRealFunctionCall (functok)
+            END
+         ELSE
+            PopT (NoOfParam) ;
+            PopN (NoOfParam + 1) ;
+            PushTtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), combinedtok) ;
+            MetaErrorT0 (functok, 'no procedure Length found for substitution to the standard function {%E1kLENGTH} which is required to calculate non constant string lengths')
+         END
+      END
+   ELSE
+      (* NoOfParam is _very_ wrong, we flush all outstanding errors *)
+      FlushErrors
+   END
+END BuildLengthFunction ;
+
+
+(*
+   BuildOddFunction - builds the pseudo procedure call ODD.
+                      This procedure is actually a "macro" for
+                      ORD(x) --> VAL(BOOLEAN, x MOD 2)
+                      However we cannot push tokens back onto the input stack
+                      because the compiler is currently building a function
+                      call and expecting a ReturnVar on the stack.
+                      Hence we manipulate the stack and call
+                      BuildConvertFunction.
+
+                      The Stack:
+
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam      |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | Param 2        |
+                      |----------------|
+                      .                .
+                      .                .
+                      .                .
+                      |----------------|
+                      | Param #        |
+                      |----------------|
+                      | ProcSym | Type |         Empty
+                      |----------------|
+*)
+
+PROCEDURE BuildOddFunction ;
+VAR
+   combinedtok,
+   optok,
+   functok    : CARDINAL ;
+   NoOfParam,
+   Res, Var   : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam=1
+   THEN
+      Var := OperandT (1) ;
+      optok := OperandTok (1) ;
+      combinedtok := MakeVirtualTok (functok, functok, optok) ;
+      IF IsVar(Var) OR IsConst(Var)
+      THEN
+         PopN (NoOfParam + 1) ;
+         (*
+            Build macro: VAL(BOOLEAN, (x MOD 2))
+         *)
+
+         (* compute (x MOD 2) *)
+         PushTFtok (Var, GetSType (Var), optok) ;
+         PushT (ModTok) ;
+         PushTFtok (MakeConstLit (optok, MakeKey ('2'), ZType), ZType, optok) ;
+         BuildBinaryOp ;
+         PopT (Res) ;
+
+         (* compute IF ...=0 *)
+         PushTtok (Res, optok) ;
+         PushT (EqualTok) ;
+         PushTFtok (MakeConstLit (optok, MakeKey ('0'), ZType), ZType, optok) ;
+         BuildRelOp (combinedtok) ;
+         BuildThenIf ;
+
+         Res := MakeTemporary (combinedtok, RightValue) ;
+         PutVar (Res, Boolean) ;
+
+         PushTtok (Res, combinedtok) ;
+         PushTtok (False, combinedtok) ;
+         BuildAssignment (combinedtok) ;
+         BuildElse ;
+         PushTtok (Res, combinedtok) ;
+         PushTtok (True, combinedtok) ;
+         BuildAssignment (combinedtok) ;
+         BuildEndIf ;
+
+         PushTtok (Res, combinedtok)
+      ELSE
+         MetaErrorT1 (combinedtok,
+                      'the parameter to {%E1kODD} must be a variable or constant, seen {%E1ad}',
+                      Var) ;
+         PushTtok (False, combinedtok)
+      END
+   ELSE
+      MetaErrorT1 (functok,
+                   'the pseudo procedure {%E1kODD} only has one parameter, seen {%E1n} parameters',
+                   NoOfParam) ;
+      PushTtok (False, functok)
+   END
+END BuildOddFunction ;
+
+
+(*
+   BuildAbsFunction - builds a call to the standard function ABS.
+
+                      We cannot implement it as a macro or inline an
+                      IF THEN statement as the IF THEN ELSE requires
+                      we write the value to the same variable (or constant)
+                      twice. The macro implementation will fail as
+                      the compiler maybe building a function
+                      call and expecting a ReturnVar on the stack.
+                      The only method to implement this is to pass it to the
+                      gcc backend.
+
+                      The Stack:
+
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam      |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | Param 2        |
+                      |----------------|
+                      .                .
+                      .                .
+                      .                .
+                      |----------------|
+                      | Param #        |
+                      |----------------|
+                      | ProcSym | Type |         Empty
+                      |----------------|
+*)
+
+PROCEDURE BuildAbsFunction ;
+VAR
+   functok,
+   combinedtok: CARDINAL ;
+   NoOfParam,
+   ProcSym,
+   Res, Var : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      Var := OperandT (1) ;
+      combinedtok := MakeVirtualTok (functok, functok, vartok) ;
+      IF IsVar(Var) OR IsConst(Var)
+      THEN
+         ProcSym := OperandT (NoOfParam + 1) ;
+         PopN (NoOfParam + 1) ;
+
+         Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+         PutVar (Res, GetSType (Var)) ;
+
+         GenQuadO (combinedtok, StandardFunctionOp, Res, ProcSym, Var, FALSE) ;
+         PushTFtok (Res, GetSType (Var), combinedtok)
+      ELSE
+         MetaErrorT1 (combinedtok,
+                      'the parameter to {%A1kABS} must be a variable or constant, seen {%E1ad}',
+                      Var)
+      END
+   ELSE
+      MetaErrorT1 (functok,
+                   'the pseudo procedure {%A1kABS} only has one parameter, seen {%E1n} parameters',
+                   NoOfParam)
+   END
+END BuildAbsFunction ;
+
+
+(*
+   BuildCapFunction - builds the pseudo procedure call CAP.
+                      We generate a the following quad:
+
+
+                      StandardFunctionOp  ReturnVal  Cap  Param1
+
+                      The Stack:
+
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam = 1  |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|         +-------------+
+                      | ProcSym | Type |         | ReturnVal   |
+                      |----------------|         |-------------|
+*)
+
+PROCEDURE BuildCapFunction ;
+VAR
+   optok,
+   functok,
+   combinedtok: CARDINAL ;
+   NoOfParam,
+   ProcSym,
+   Res, Var : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      Var := OperandT (1) ;
+      optok := OperandTok (1) ;
+      IF IsVar (Var) OR IsConst (Var)
+      THEN
+         ProcSym := OperandT (NoOfParam + 1) ;
+         PopN (NoOfParam + 1) ;
+
+         combinedtok := MakeVirtualTok (functok, functok, optok) ;
+         Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+         PutVar (Res, Char) ;
+         GenQuadO (combinedtok, StandardFunctionOp, Res, ProcSym, Var, FALSE) ;
+         PushTFtok (Res, Char, combinedtok)
+      ELSE
+         MetaErrorT1 (functok,
+                      'the parameter to {%A1kCAP} must be a variable or constant, seen {%E1ad}',
+                      Var)
+      END
+   ELSE
+      MetaErrorT1 (functok,
+                   'the pseudo procedure {%A1kCAP} only has one parameter, seen {%E1n} parameters',
+                   NoOfParam)
+   END
+END BuildCapFunction ;
+
+
+(*
+   BuildChrFunction - builds the pseudo procedure call CHR.
+                      This procedure is actually a "macro" for
+                      CHR(x) --> CONVERT(CHAR, x)
+                      However we cannot push tokens back onto the input stack
+                      because the compiler is currently building a function
+                      call and expecting a ReturnVar on the stack.
+                      Hence we manipulate the stack and call
+                      BuildConvertFunction.
+
+                      The Stack:
+
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam      |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | Param 2        |
+                      |----------------|
+                      .                .
+                      .                .
+                      .                .
+                      |----------------|
+                      | Param #        |
+                      |----------------|
+                      | ProcSym | Type |         Empty
+                      |----------------|
+*)
+
+PROCEDURE BuildChrFunction ;
+VAR
+   functok,
+   optok      : CARDINAL ;
+   NoOfParam,
+   Var        : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      Var := OperandT (1) ;
+      optok := OperandTok (1) ;
+      IF IsVar (Var) OR IsConst (Var)
+      THEN
+         PopN (NoOfParam + 1) ;
+         (*
+            Build macro: CONVERT( CHAR, Var )
+         *)
+         PushTFtok (Convert, NulSym, functok) ;
+         PushTtok (Char, functok) ;
+         PushTtok (Var, optok) ;
+         PushT (2) ;          (* Two parameters *)
+         BuildConvertFunction
+      ELSE
+         MetaErrorT1 (functok,
+                      'the parameter to {%A1kCHR} must be a variable or constant, seen {%E1ad}',
+                      Var)
+      END
+   ELSE
+      MetaErrorT1 (functok,
+                   'the pseudo procedure {%A1kCHR} only has one parameter, seen {%E1n} parameters',
+                   NoOfParam)
+   END
+END BuildChrFunction ;
+
+
+(*
+   BuildOrdFunction - builds the pseudo procedure call ORD.
+                      This procedure is actually a "macro" for
+                      ORD(x) --> CONVERT(GetSType(sym), x)
+                      However we cannot push tokens back onto the input stack
+                      because the compiler is currently building a function
+                      call and expecting a ReturnVar on the stack.
+                      Hence we manipulate the stack and call
+                      BuildConvertFunction.
+
+                      The Stack:
+
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam      |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | Param 2        |
+                      |----------------|
+                      .                .
+                      .                .
+                      .                .
+                      |----------------|
+                      | Param #        |
+                      |----------------|
+                      | ProcSym | Type |         Empty
+                      |----------------|
+*)
+
+PROCEDURE BuildOrdFunction (Sym: CARDINAL) ;
+VAR
+   functok,
+   optok    : CARDINAL ;
+   NoOfParam,
+   Type, Var: CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      Var := OperandT (1) ;
+      optok := OperandTok (1) ;
+      IF IsVar (Var) OR IsConst (Var)
+      THEN
+         Type := GetSType (Sym) ;
+         PopN (NoOfParam + 1) ;
+         (*
+            Build macro: CONVERT( CARDINAL, Var )
+         *)
+         PushTFtok (Convert, NulSym, functok) ;
+         PushTtok (Type, optok) ;
+         PushTtok (Var, optok) ;
+         PushT (2) ;          (* Two parameters *)
+         BuildConvertFunction
+      ELSE
+         MetaErrorT2 (functok,
+                      'the parameter to {%A1k%a} must be a variable or constant, seen {%2ad}',
+                      Sym, Var)
+      END
+   ELSE
+      MetaErrorT2 (functok,
+                   'the pseudo procedure {%A1k%a} only has one parameter, seen {%2n} parameters',
+                   Sym, NoOfParam)
+   END
+END BuildOrdFunction ;
+
+
+(*
+   BuildIntFunction - builds the pseudo procedure call INT.
+                      This procedure is actually a "macro" for
+                      INT(x) --> CONVERT(INTEGER, x)
+                      However we cannot push tokens back onto the input stack
+                      because the compiler is currently building a function
+                      call and expecting a ReturnVar on the stack.
+                      Hence we manipulate the stack and call
+                      BuildConvertFunction.
+
+                      The Stack:
+
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam      |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | Param 2        |
+                      |----------------|
+                      .                .
+                      .                .
+                      .                .
+                      |----------------|
+                      | Param #        |
+                      |----------------|
+                      | ProcSym | Type |         Empty
+                      |----------------|
+*)
+
+PROCEDURE BuildIntFunction (Sym: CARDINAL) ;
+VAR
+   combinedtok,
+   functok,
+   optok      : CARDINAL ;
+   NoOfParam,
+   Type, Var  : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      Var := OperandT (1) ;
+      optok := OperandTok (1) ;
+      IF IsVar (Var) OR IsConst (Var)
+      THEN
+         Type := GetSType (Sym) ;  (* return type of function *)
+         PopN (NoOfParam + 1) ;
+         (* Build macro: CONVERT( CARDINAL, Var ).  *)
+         PushTFtok (Convert, NulSym, functok) ;
+         PushTtok (Type, functok) ;
+         PushTtok (Var, optok) ;
+         PushT (2) ;          (* Two parameters *)
+         BuildConvertFunction
+      ELSE
+         combinedtok := MakeVirtualTok (functok, optok, optok) ;
+         MetaErrorT2 (combinedtok,
+                      'the parameter to {%E1k%a} must be a variable or constant, seen {%2ad}',
+                      Sym, Var) ;
+         PushTtok (combinedtok, MakeConstLit (combinedtok, MakeKey ('0'), ZType))
+      END
+   ELSE
+      MetaErrorT2 (functok,
+                   'the pseudo procedure {%E1k%a} only has one parameter, seen {%2n} parameters',
+                   Sym, NoOfParam) ;
+      PushTtok (functok, MakeConstLit (functok, MakeKey ('0'), ZType))
+   END
+END BuildIntFunction ;
+
+
+(*
+   BuildMakeAdrFunction - builds the pseudo procedure call MAKEADR.
+
+                          The Stack:
+
+
+                          Entry                      Exit
+
+                   Ptr ->
+                          +----------------+
+                          | NoOfParam      |
+                          |----------------|
+                          | Param 1        |
+                          |----------------|
+                          | Param 2        |
+                          |----------------|
+                          .                .
+                          .                .
+                          .                .
+                          |----------------|
+                          | Param #        |
+                          |----------------|
+                          | ProcSym | Type |         Empty
+                          |----------------|
+*)
+
+PROCEDURE BuildMakeAdrFunction ;
+VAR
+   functok,
+   starttok,
+   endtok,
+   resulttok     : CARDINAL ;
+   AreConst      : BOOLEAN ;
+   i, pi,
+   NoOfParameters: CARDINAL ;
+   ReturnVar     : CARDINAL ;
+BEGIN
+   PopT (NoOfParameters) ;
+   functok := OperandTok (NoOfParameters + 1) ;
+   IF NoOfParameters>0
+   THEN
+      starttok := OperandTok (NoOfParameters + 1) ;  (* ADR token.  *)
+      endtok := OperandTok (1) ;  (* last parameter.  *)
+      GenQuad (ParamOp, 0, MakeAdr, MakeAdr) ;
+      i := NoOfParameters ;
+      (* stack index referencing stacked parameter, i *)
+      pi := 1 ;
+      WHILE i > 0 DO
+         GenQuadO (OperandTok (pi), ParamOp, i, MakeAdr, OperandT (pi), TRUE) ;
+         DEC (i) ;
+         INC (pi)
+      END ;
+      AreConst := TRUE ;
+      i := 1 ;
+      WHILE i <= NoOfParameters DO
+         IF IsVar (OperandT (i))
+         THEN
+            AreConst := FALSE ;
+         ELSIF NOT IsConst (OperandT (i))
+         THEN
+            MetaError1 ('problem in the {%E1N} argument for {%EkMAKEADR}, all arguments to {%EkMAKEADR} must be either variables or constants', i)
+         END ;
+         INC (i)
+      END ;
+      (* ReturnVar - will have the type of the procedure *)
+      resulttok := MakeVirtualTok (starttok, starttok, endtok) ;
+      ReturnVar := MakeTemporary (resulttok, AreConstant(AreConst)) ;
+      PutVar (ReturnVar, GetSType(MakeAdr)) ;
+      GenQuadO (resulttok, FunctValueOp, ReturnVar, NulSym, MakeAdr, TRUE) ;
+      PopN (NoOfParameters+1) ;
+      PushTFtok (ReturnVar, GetSType (MakeAdr), resulttok)
+   ELSE
+      MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one parameter, seen {%E1n}', NoOfParameters) ;
+      PopN (1) ;
+      PushTFtok (Nil, GetSType (MakeAdr), functok)
+   END
+END BuildMakeAdrFunction ;
+
+
+(*
+   BuildShiftFunction - builds the pseudo procedure call SHIFT.
+
+                        PROCEDURE SHIFT (val: <any type>;
+                                         num: INTEGER): <any type> ;
+
+                       "Returns a bit sequence obtained from val by
+                        shifting up or down (left or right) by the
+                        absolute value of num, introducing
+                        zeros as necessary.  The direction is down if
+                        the sign of num is negative, otherwise the
+                        direction is up."
+
+                        The Stack:
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |                        <- Ptr
+                        |----------------|         +------------+
+                        | ProcSym | Type |         | ReturnVar  |
+                        |----------------|         |------------|
+*)
+
+PROCEDURE BuildShiftFunction ;
+VAR
+   combinedtok,
+   paramtok,
+   functok,
+   vartok,
+   exptok     : CARDINAL ;
+   r,
+   procSym,
+   returnVar,
+   NoOfParam,
+   derefExp,
+   Exp,
+   varSet     : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   paramtok := OperandTok (1) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam=2
+   THEN
+      PopTrwtok (Exp, r, exptok) ;
+      MarkAsRead (r) ;
+      PopTtok (varSet, vartok) ;
+      PopT (procSym) ;
+      combinedtok := MakeVirtualTok (functok, exptok, vartok) ;
+      IF (GetSType (varSet) # NulSym) AND IsSet (GetDType (varSet))
+      THEN
+         derefExp := DereferenceLValue (exptok, Exp) ;
+         BuildRange (InitShiftCheck (varSet, derefExp)) ;
+         returnVar := MakeTemporary (combinedtok, RightValue) ;
+         PutVar (returnVar, GetSType (varSet)) ;
+         GenQuad (LogicalShiftOp, returnVar, varSet, derefExp) ;
+         PushTFtok (returnVar, GetSType (varSet), combinedtok)
+      ELSE
+         MetaError1 ('SYSTEM procedure {%E1kSHIFT} expects a constant or variable which has a type of SET as its first parameter, seen {%E1ad}',
+                     varSet) ;
+         PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), Cardinal, combinedtok)
+      END
+   ELSE
+      combinedtok := MakeVirtualTok (functok, functok, paramtok) ;
+      MetaErrorT1 (functok,
+                   'the pseudo procedure {%EkSHIFT} requires at least two parameters, seen {%E1n}',
+                   NoOfParam) ;
+      PopN (NoOfParam + 1) ;
+      PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), Cardinal, combinedtok)
+   END
+END BuildShiftFunction ;
+
+
+(*
+   BuildRotateFunction - builds the pseudo procedure call ROTATE.
+
+                         PROCEDURE ROTATE (val: <any type>;
+                                           num: INTEGER): <any type> ;
+
+                        "Returns a bit sequence obtained from val
+                         by rotating up or down (left or right) by
+                         the absolute value of num.  The direction is
+                         down if the sign of num is negative, otherwise
+                         the direction is up."
+
+                         The Stack:
+
+                         Entry                      Exit
+
+                  Ptr ->
+                         +----------------+
+                         | NoOfParam      |
+                         |----------------|
+                         | Param 1        |
+                         |----------------|
+                         | Param 2        |                        <- Ptr
+                         |----------------|         +------------+
+                         | ProcSym | Type |         | ReturnVar  |
+                         |----------------|         |------------|
+*)
+
+PROCEDURE BuildRotateFunction ;
+VAR
+   combinedtok,
+   functok,
+   vartok,
+   exptok     : CARDINAL ;
+   r,
+   procSym,
+   returnVar,
+   NoOfParam,
+   derefExp,
+   Exp,
+   varSet     : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 2
+   THEN
+      PopTrwtok (Exp, r, exptok) ;
+      MarkAsRead (r) ;
+      PopTtok (varSet, vartok) ;
+      PopT (procSym) ;
+      IF (GetSType (varSet) # NulSym) AND IsSet (GetDType (varSet))
+      THEN
+         combinedtok := MakeVirtualTok (functok, functok, exptok) ;
+         derefExp := DereferenceLValue (exptok, Exp) ;
+         BuildRange (InitRotateCheck (varSet, derefExp)) ;
+         returnVar := MakeTemporary (combinedtok, RightValue) ;
+         PutVar (returnVar, GetSType (varSet)) ;
+         GenQuadO (combinedtok, LogicalRotateOp, returnVar, varSet, derefExp, TRUE) ;
+         PushTFtok (returnVar, GetSType (varSet), combinedtok)
+      ELSE
+         MetaErrorT0 (functok,
+                      'SYSTEM procedure {%EkROTATE} expects a constant or variable which has a type of SET as its first parameter') ;
+         PushTFtok (MakeConstLit (functok, MakeKey('0'), Cardinal), Cardinal, functok)
+      END
+   ELSE
+      MetaErrorT1 (functok,
+                   'SYSTEM procedure {%EkROTATE} expects 2 parameters and was given {%1n} parameters',
+                   NoOfParam) ;
+      PopN (NoOfParam + 1) ;
+      PushTFtok (MakeConstLit (functok, MakeKey ('0'), Cardinal), Cardinal, functok)
+   END
+END BuildRotateFunction ;
+
+
+(*
+   BuildValFunction - builds the pseudo procedure call VAL.
+                      This procedure is actually a "macro" for
+                      VAL(Type, x) --> CONVERT(Type, x)
+                      However we cannot push tokens back onto the input stack
+                      because the compiler is currently building a function
+                      call and expecting a ReturnVar on the stack.
+                      Hence we manipulate the stack and call
+                      BuildConvertFunction.
+
+                      The Stack:
+
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam      |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | Param 2        |
+                      |----------------|
+                      .                .
+                      .                .
+                      .                .
+                      |----------------|
+                      | Param #        |
+                      |----------------|
+                      | ProcSym | Type |         Empty
+                      |----------------|
+*)
+
+PROCEDURE BuildValFunction ;
+VAR
+   functok  : CARDINAL ;
+   NoOfParam,
+   ProcSym,
+   Exp, Type: CARDINAL ;
+   tok, r,
+   typetok,
+   exptok   : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 2
+   THEN
+      PopTrwtok (Exp, r, exptok) ;
+      MarkAsRead (r) ;
+      PopTtok (Type, typetok) ;
+      PopTtok (ProcSym, tok) ;
+      IF IsUnknown (Type)
+      THEN
+         (* not sensible to try and recover when we dont know the return type.  *)
+         MetaErrorT1 (typetok,
+                      'undeclared type found in builtin procedure function {%AkVAL} {%A1ad}',
+                      Type)
+         (* non recoverable error.  *)
+      ELSIF (IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR
+             IsType (Type) OR IsPointer (Type) OR IsProcType (Type)) AND
+             (IsVar (Exp) OR IsConst (Exp) OR IsProcedure (Exp))
+      THEN
+         (*
+            Build macro: CONVERT( Type, Var )
+         *)
+         PushTFtok (Convert, NulSym, tok) ;
+         PushTtok (Type, typetok) ;
+         PushTtok (Exp, exptok) ;
+         PushT (2) ;          (* Two parameters *)
+         BuildConvertFunction
+      ELSE
+         (* not sensible to try and recover when we dont know the return type.  *)
+         MetaErrorT0 (functok,
+                      'the builtin procedure {%AkVAL} has thw following formal parameter declaration {%kVAL} (type, expression)')
+         (* non recoverable error.  *)
+      END
+   ELSE
+      (* not sensible to try and recover when we dont know the return type.  *)
+      MetaErrorT1 (functok,
+                   'the builtin procedure {%AkVAL} expects 2 parameters, a type and an expression, but was given {%1n} parameters', NoOfParam)
+      (* non recoverable error.  *)
+   END
+END BuildValFunction ;
+
+
+(*
+   BuildCastFunction - builds the pseudo procedure call CAST.
+                       This procedure is actually a "macro" for
+                       CAST(Type, x) --> Type(x)
+                       However we cannot push tokens back onto the input stack
+                       because the compiler is currently building a function
+                       call and expecting a ReturnVar on the stack.
+                       Hence we manipulate the stack and call
+                       BuildConvertFunction.
+
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |
+                       |----------------|
+                       | ProcSym | Type |         Empty
+                       |----------------|
+*)
+
+PROCEDURE BuildCastFunction ;
+VAR
+   combinedtok,
+   typetok,
+   functok,
+   vartok     : CARDINAL ;
+   n          : Name ;
+   ReturnVar,
+   NoOfParam,
+   Var, Type  : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 2
+   THEN
+      Type := OperandT (2) ;
+      typetok := OperandTok (2) ;
+      Var := OperandT (1) ;
+      vartok := OperandTok (1) ;
+      IF IsUnknown (Type)
+      THEN
+         n := GetSymName (Type) ;
+         WriteFormat1 ('undeclared type found in CAST (%a)', n)
+      ELSIF IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR IsType (Type) OR
+            IsPointer (Type) OR IsArray (Type) OR IsProcType (Type)
+      THEN
+         IF IsConst (Var)
+         THEN
+            PopN (NoOfParam+1) ;
+            (*
+               Build macro: Type( Var )
+            *)
+            PushTFtok (Type, NulSym, typetok) ;
+            PushTtok (Var, vartok) ;
+            PushT (1) ;          (* one parameter *)
+            BuildTypeCoercion
+         ELSIF IsVar (Var) OR IsProcedure (Var)
+         THEN
+            PopN (NoOfParam + 1) ;
+            combinedtok := MakeVirtualTok (functok, functok, vartok) ;
+            ReturnVar := MakeTemporary (combinedtok, RightValue) ;
+            PutVar (ReturnVar, Type) ;
+            GenQuadO (combinedtok, CastOp, ReturnVar, Type, Var, FALSE) ;
+            PushTFtok (ReturnVar, Type, combinedtok)
+         ELSE
+            (* not sensible to try and recover when we dont know the return type.  *)
+            MetaErrorT0 (functok,
+                         'the second parameter to the builtin procedure {%AkCAST} must either be a variable, constant or a procedure.  The formal parameters to cast are CAST(type, variable or constant or procedure)')
+            (* non recoverable error.  *)
+         END
+      ELSE
+         (* not sensible to try and recover when we dont know the return type.  *)
+         MetaErrorT0 (functok,
+                      'the builtin procedure {%AkCAST} has the following formal parameter declaration {%kCAST} (type, expression)')
+         (* non recoverable error.  *)
+      END
+   ELSE
+      (* not sensible to try and recover when we dont know the return type.  *)
+      MetaErrorT1 (functok,
+                   'the builtin procedure {%AkCAST} `expects 2 parameters, a type and an expression, but was given {%1n} parameters', NoOfParam)
+      (* non recoverable error.  *)
+   END
+END BuildCastFunction ;
+
+
+(*
+   BuildConvertFunction - builds the pseudo function CONVERT.
+                          CONVERT( Type, Variable ) ;
+
+                          The Stack:
+
+
+                          Entry                      Exit
+
+                   Ptr ->
+                          +----------------+
+                          | NoOfParam      |
+                          |----------------|
+                          | Param 1        |
+                          |----------------|
+                          | Param 2        |
+                          |----------------|
+                          .                .
+                          .                .
+                          .                .
+                          |----------------|
+                          | Param #        |                                 <- Ptr
+                          |----------------|         +---------------------+
+                          | ProcSym | Type |         | ReturnVar | Param1  |
+                          |----------------|         |---------------------|
+
+                          Quadruples:
+
+                          ConvertOp  ReturnVar  Param1  Param2
+
+                          Converts variable Param2 into a variable Param1
+                          with a type Param1.
+*)
+
+PROCEDURE BuildConvertFunction ;
+VAR
+   combinedtok,
+   functok,
+   typetok,
+   exptok     : CARDINAL ;
+   t, r,
+   Exp, Type,
+   ProcSym,
+   NoOfParam,
+   ReturnVar  : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTok (NoOfParam + 1) ;
+   IF NoOfParam = 2
+   THEN
+      PopTrwtok (Exp, r, exptok) ;
+      MarkAsRead (r) ;
+      PopTtok (Type, typetok) ;
+      PopT (ProcSym) ;
+      IF IsUnknown (Type)
+      THEN
+         (* we cannot recover if we dont have a type.  *)
+         MetaErrorT1 (typetok, 'undeclared type {%A1ad} found in {%kCONVERT}', Type)
+         (* non recoverable error.  *)
+      ELSIF IsUnknown (Exp)
+      THEN
+         (* we cannot recover if we dont have a type.  *)
+         MetaErrorT1 (typetok, 'unknown {%A1d} {%1ad} found in {%kCONVERT}', Exp)
+         (* non recoverable error.  *)
+      ELSIF (IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR
+             IsType (Type) OR IsPointer (Type) OR IsProcType (Type) OR IsRecord (Type)) AND
+            (IsVar (Exp) OR IsConst (Exp) OR IsProcedure (Exp))
+      THEN
+         (* firstly dereference Var *)
+         IF GetMode (Exp) = LeftValue
+         THEN
+            t := MakeTemporary (exptok, RightValue) ;
+            PutVar (t, GetSType (Exp)) ;
+            CheckPointerThroughNil (exptok, Exp) ;
+            doIndrX (exptok, t, Exp) ;
+            Exp := t
+         END ;
+
+         combinedtok := MakeVirtualTok (functok, functok, exptok) ;
+         ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Exp))) ;
+         PutVar (ReturnVar, Type) ;
+         GenQuadO (combinedtok, ConvertOp, ReturnVar, Type, Exp, TRUE) ;
+         PushTFtok (ReturnVar, Type, combinedtok)
+      ELSE
+         (* not sensible to try and recover when we dont know the return type.  *)
+         MetaErrorT0 (functok,
+                      'the builtin procedure {%AkCONVERT} has the following formal parameter declaration {%kCONVERT} (type, expression)')
+         (* non recoverable error.  *)
+      END
+   ELSE
+      (* not sensible to try and recover when we dont know the return type.  *)
+      MetaErrorT1 (functok,
+                   'the builtin procedure {%AkCONVERT} expects 2 parameters, a type and an expression, but was given {%1n} parameters', NoOfParam)
+      (* non recoverable error.  *)
+   END
+END BuildConvertFunction ;
+
+
+(*
+   CheckBaseTypeValue - checks to see whether the value, min, really exists.
+*)
+
+PROCEDURE CheckBaseTypeValue (tok: CARDINAL;
+                              type: CARDINAL;
+                              min: CARDINAL;
+                              func: CARDINAL) : CARDINAL ;
+BEGIN
+   IF (type = Real) OR (type = LongReal) OR (type = ShortReal)
+   THEN
+      PushValue (min) ;
+      IF NOT IsValueAndTreeKnown ()
+      THEN
+         MetaErrorT2 (tok,
+                      '{%1Ead} ({%2ad}) cannot be calculated at compile time for the target architecture', func, type) ;
+         RETURN MakeConstLit (tok, MakeKey ('1.0'), RType)
+      END
+   END ;
+   RETURN min
+END CheckBaseTypeValue ;
+
+
+(*
+   GetTypeMin - returns the minimium value of type.
+*)
+
+PROCEDURE GetTypeMin (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ;
+VAR
+   min, max: CARDINAL ;
+BEGIN
+   IF IsSubrange (type)
+   THEN
+      min := MakeTemporary (tok, ImmediateValue) ;
+      PutVar (min, type) ;
+      GenQuad (SubrangeLowOp, min, NulSym, type) ;
+      RETURN min
+   ELSIF IsSet (SkipType (type))
+   THEN
+      RETURN GetTypeMin (tok, func, GetSType (SkipType (type)))
+   ELSIF IsBaseType (type) OR IsEnumeration (type)
+   THEN
+      GetBaseTypeMinMax (type, min, max) ;
+      min := CheckBaseTypeValue (tok, type, min, func) ;
+      RETURN min
+   ELSIF IsSystemType (type)
+   THEN
+      GetSystemTypeMinMax (type, min, max) ;
+      RETURN min
+   ELSIF GetSType (type) = NulSym
+   THEN
+      MetaErrorT1 (tok,
+                   'unable to obtain the {%AkMIN} value for type {%1Aad}', type)
+      (* non recoverable error.  *)
+   ELSE
+      RETURN GetTypeMin (tok, func, GetSType (type))
+   END
+END GetTypeMin ;
+
+
+(*
+   GetTypeMax - returns the maximum value of type.
+*)
+
+PROCEDURE GetTypeMax (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ;
+VAR
+   min, max: CARDINAL ;
+BEGIN
+   IF IsSubrange (type)
+   THEN
+      max := MakeTemporary (tok, ImmediateValue) ;
+      PutVar (max, type) ;
+      GenQuad (SubrangeHighOp, max, NulSym, type) ;
+      RETURN max
+   ELSIF IsSet (SkipType (type))
+   THEN
+      RETURN GetTypeMax (tok, func, GetSType (SkipType (type)))
+   ELSIF IsBaseType (type) OR IsEnumeration (type)
+   THEN
+      GetBaseTypeMinMax (type, min, max) ;
+      min := CheckBaseTypeValue (tok, type, min, func) ;
+      RETURN max
+   ELSIF IsSystemType (type)
+   THEN
+      GetSystemTypeMinMax (type, min, max) ;
+      RETURN max
+   ELSIF GetSType (type) = NulSym
+   THEN
+      MetaErrorT1 (tok,
+                   'unable to obtain the {%AkMAX} value for type {%1Aad}', type)
+      (* non recoverable error.  *)
+   ELSE
+      RETURN GetTypeMax (tok, func, GetSType (type))
+   END
+END GetTypeMax ;
+
+
+(*
+   BuildMinFunction - builds the pseudo function call Min.
+
+                      The Stack:
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam=1    |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | ProcSym | Type |         Empty
+                      |----------------|
+*)
+
+PROCEDURE BuildMinFunction ;
+VAR
+   combinedtok,
+   functok,
+   vartok     : CARDINAL ;
+   func,
+   min,
+   NoOfParam,
+   Var        : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   func := OperandT (NoOfParam + 1) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      Var := OperandT (1) ;
+      vartok := OperandTok (1) ;
+      PopN (NoOfParam+1) ;    (* destroy arguments to this function *)
+      combinedtok := MakeVirtualTok (functok, functok, vartok) ;
+      IF IsAModula2Type (Var)
+      THEN
+         min := GetTypeMin (vartok, func, Var) ;
+         PushTFtok (min, GetSType (min), combinedtok)
+      ELSIF IsVar (Var)
+      THEN
+         min := GetTypeMin (vartok, func, GetSType (Var)) ;
+         PushTFtok (min, GetSType (Var), combinedtok)
+      ELSE
+         (* we dont know the type therefore cannot fake a return.  *)
+         MetaErrorT1 (vartok,
+                      'parameter to {%AkMIN} must be a type or a variable, seen {%1Aad}',
+                      Var)
+         (* non recoverable error.  *)
+      END
+   ELSE
+      (* we dont know the type therefore cannot fake a return.  *)
+      MetaErrorT1 (functok,
+                   'the pseudo builtin procedure function {%AkMIN} only has one parameter, seen  {%1An}',
+                   NoOfParam)
+      (* non recoverable error.  *)
+   END
+END BuildMinFunction ;
+
+
+(*
+   BuildMaxFunction - builds the pseudo function call Max.
+
+                      The Stack:
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam=1    |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | ProcSym | Type |         Empty
+                      |----------------|
+*)
+
+PROCEDURE BuildMaxFunction ;
+VAR
+   combinedtok,
+   functok,
+   vartok     : CARDINAL ;
+   func,
+   max,
+   NoOfParam,
+   Var        : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   func := OperandT (NoOfParam + 1) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      Var := OperandT (1) ;
+      vartok := OperandTok (1) ;
+      PopN (NoOfParam + 1) ;    (* destroy arguments to this function *)
+      combinedtok := MakeVirtualTok (functok, functok, vartok) ;
+      IF IsAModula2Type (Var)
+      THEN
+         max := GetTypeMax (vartok, func, Var) ;
+         PushTFtok (max, GetSType (max), combinedtok)
+      ELSIF IsVar(Var)
+      THEN
+         max := GetTypeMax (vartok, func, GetSType (Var)) ;
+         PushTFtok (max, GetSType (Var), combinedtok)
+      ELSE
+         (* we dont know the type therefore cannot fake a return.  *)
+         MetaErrorT1 (vartok,
+                      'parameter to {%AkMAX} must be a type or a variable, seen {%1Aad}',
+                      Var)
+         (* non recoverable error.  *)
+      END
+   ELSE
+      (* we dont know the type therefore cannot fake a return.  *)
+      MetaErrorT1 (functok,
+                   'the pseudo builtin procedure function {%AkMAX} only has one parameter, seen {%1An}',
+                   NoOfParam)
+      (* non recoverable error.  *)
+   END
+END BuildMaxFunction ;
+
+
+(*
+   BuildTruncFunction - builds the pseudo procedure call TRUNC.
+                        This procedure is actually a "macro" for
+                        TRUNC(x) --> CONVERT(INTEGER, x)
+                        However we cannot push tokens back onto the input stack
+                        because the compiler is currently building a function
+                        call and expecting a ReturnVar on the stack.
+                        Hence we manipulate the stack and call
+                        BuildConvertFunction.
+
+                        The Stack:
+
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        .                .
+                        .                .
+                        .                .
+                        |----------------|
+                        | Param #        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildTruncFunction (Sym: CARDINAL) ;
+VAR
+   vartok,
+   functok  : CARDINAL ;
+   NoOfParam: CARDINAL ;
+   ProcSym,
+   Type,
+   Var      : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   Assert (IsTrunc (OperandT (NoOfParam+1))) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   IF NoOfParam = 1
+   THEN
+      ProcSym := RequestSym (functok, MakeKey ('CONVERT')) ;
+      IF (ProcSym # NulSym) AND IsProcedure (ProcSym)
+      THEN
+         Var := OperandT (1) ;
+         vartok := OperandTtok (1) ;
+         Type := GetSType (Sym) ;
+         PopN (NoOfParam + 1) ;    (* destroy arguments to this function *)
+         IF IsVar (Var) OR IsConst (Var)
+         THEN
+            IF IsRealType (GetSType (Var))
+            THEN
+               (* build macro: CONVERT( INTEGER, Var ).  *)
+               PushTFtok (ProcSym, NulSym, functok) ;
+               PushTtok (Type, functok) ;
+               PushTtok (Var, vartok) ;
+               PushT (2) ;          (* two parameters *)
+               BuildConvertFunction
+            ELSE
+               MetaErrorT1 (functok,
+                            'argument to {%1E%ad} must be a float point type', Sym) ;
+               PushTFtok (MakeConstLit (functok, MakeKey('0'), Type), Type, functok)
+            END
+         ELSE
+            MetaErrorT2 (functok,
+                         'argument to {%1E%ad} must be a variable or constant, seen {%2ad}',
+                         Sym, Var) ;
+            PushTFtok (MakeConstLit (functok, MakeKey('0'), Type), Type, functok)
+         END
+      ELSE
+         InternalError  ('CONVERT procedure not found for TRUNC substitution')
+      END
+   ELSE
+      (* we dont know the type therefore cannot fake a return.  *)
+      MetaErrorT1 (functok,
+                   'the pseudo builtin procedure function {%AkTRUNC} only has one parameter, seen  {%1An}', NoOfParam)
+      (* non recoverable error.  *)
+   END
+END BuildTruncFunction ;
+
+
+(*
+   BuildFloatFunction - builds the pseudo procedure call FLOAT.
+                        This procedure is actually a "macro" for
+                        FLOAT(x) --> CONVERT(REAL, x)
+                        However we cannot push tokens back onto the input stack
+                        because the compiler is currently building a function
+                        call and expecting a ReturnVar on the stack.
+                        Hence we manipulate the stack and call
+                        BuildConvertFunction.
+
+                        The Stack:
+
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        .                .
+                        .                .
+                        .                .
+                        |----------------|
+                        | Param #        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildFloatFunction (Sym: CARDINAL) ;
+VAR
+   vartok,
+   functok  : CARDINAL ;
+   NoOfParam: CARDINAL ;
+   Type,
+   Var,
+   ProcSym  : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   Type := GetSType (Sym) ;
+   IF NoOfParam = 1
+   THEN
+      ProcSym := RequestSym (functok, MakeKey ('CONVERT')) ;
+      IF (ProcSym # NulSym) AND IsProcedure (ProcSym)
+      THEN
+         Var := OperandT (1) ;
+         vartok := OperandTtok (1) ;
+         IF IsVar (Var) OR IsConst (Var)
+         THEN
+            PopN (NoOfParam + 1) ;    (* destroy arguments to this function.  *)
+            (* build macro: CONVERT (REAL, Var).  *)
+            PushTFtok (ProcSym, NulSym, functok) ;
+            PushTtok (Type, functok) ;
+            PushTtok (Var, vartok) ;
+            PushT(2) ;          (* two parameters.  *)
+            BuildConvertFunction
+         ELSE
+            MetaErrorT1 (functok,
+                         'argument to {%1E%ad} must be a variable or constant', ProcSym) ;
+            PushTFtok (MakeConstLit (functok, MakeKey('0.0'), Type), Type, functok)
+         END
+      ELSE
+         InternalError  ('CONVERT procedure not found for FLOAT substitution')
+      END
+   ELSE
+      MetaErrorT1 (functok,
+                   'the builtin procedure function {%1Ead} only has one parameter',
+                   Sym) ;
+      PushTFtok (MakeConstLit (functok, MakeKey('0.0'), Type), Type, functok)
+   END
+END BuildFloatFunction ;
+
+
+(*
+   BuildReFunction - builds the pseudo procedure call RE.
+
+                     The Stack:
+
+
+                         Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        .                .
+                        .                .
+                        .                .
+                        |----------------|
+                        | Param #        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildReFunction ;
+VAR
+   func,
+   combinedtok,
+   vartok,
+   functok    : CARDINAL ;
+   NoOfParam  : CARDINAL ;
+   ReturnVar,
+   Var        : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   func := OperandT (NoOfParam + 1) ;
+   IF NoOfParam=1
+   THEN
+      Var := OperandT (1) ;
+      vartok := OperandTok (1) ;
+      combinedtok := MakeVirtualTok (functok, functok, vartok) ;
+      IF IsVar(Var) OR IsConst(Var)
+      THEN
+         ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+         PutVar (ReturnVar, ComplexToScalar (GetSType (Var))) ;
+         GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Re, Var, FALSE) ;
+         PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
+         PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok)
+      ELSE
+         PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
+         PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ;
+         MetaErrorT2 (functok,
+                      'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}',
+                      func, Var)
+      END
+   ELSE
+      PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
+      PushTFtok (MakeConstLit (functok, MakeKey ('1.0'), RType), RType, functok) ;
+      MetaErrorT2 (functok,
+                   'the builtin procedure function {%1Ead} only has one parameter, seen {%2n}',
+                   func, NoOfParam)
+   END
+END BuildReFunction ;
+
+
+(*
+   BuildImFunction - builds the pseudo procedure call IM.
+
+                     The Stack:
+
+
+                         Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        .                .
+                        .                .
+                        .                .
+                        |----------------|
+                        | Param #        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildImFunction ;
+VAR
+   func,
+   combinedtok,
+   vartok,
+   functok    : CARDINAL ;
+   NoOfParam  : CARDINAL ;
+   ReturnVar,
+   Var        : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   func := OperandT (NoOfParam + 1) ;
+   IF NoOfParam=1
+   THEN
+      Var := OperandT (1) ;
+      vartok := OperandTok (1) ;
+      combinedtok := MakeVirtualTok (functok, functok, vartok) ;
+      IF IsVar(Var) OR IsConst(Var)
+      THEN
+         ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ;
+         PutVar (ReturnVar, ComplexToScalar (GetSType (Var))) ;
+         GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Im, Var, FALSE) ;
+         PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
+         PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok)
+      ELSE
+         PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
+         PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ;
+         MetaErrorT2 (functok,
+                      'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}',
+                      func, Var)
+      END
+   ELSE
+      PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
+      PushTFtok (MakeConstLit (functok, MakeKey ('1.0'), RType), RType, functok) ;
+      MetaErrorT2 (functok,
+                   'the builtin procedure function {%1Ead} only has one parameter, seen {%2n}',
+                   func, NoOfParam)
+   END
+END BuildImFunction ;
+
+
+(*
+   BuildCmplxFunction - builds the pseudo procedure call CMPLX.
+
+                        The Stack:
+
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        .                .
+                        .                .
+                        .                .
+                        |----------------|
+                        | Param #        |
+                        |----------------|
+                        | ProcSym | Type |         Empty
+                        |----------------|
+*)
+
+PROCEDURE BuildCmplxFunction ;
+VAR
+   functok,
+   endtok,
+   combinedtok: CARDINAL ;
+   NoOfParam  : CARDINAL ;
+   func,
+   ReturnVar,
+   l, r       : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   func := OperandT (NoOfParam + 1) ;
+   IF NoOfParam = 2
+   THEN
+      l := OperandT (2) ;
+      r := OperandT (1) ;
+      endtok := OperandTok (1) ;
+      combinedtok := MakeVirtualTok (functok, functok, endtok) ;
+      IF (IsVar(l) OR IsConst(l)) AND
+         (IsVar(r) OR IsConst(r))
+      THEN
+         CheckExpressionCompatible (combinedtok, GetSType(l), GetSType(r)) ;
+         ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (l) AND IsConst (r))) ;
+         PutVar (ReturnVar, GetCmplxReturnType (GetDType (l), GetDType (r))) ;
+         GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Cmplx, Make2Tuple (l, r), TRUE) ;
+         PopN (NoOfParam+1) ;   (* destroy arguments to this function *)
+         PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok)
+      ELSE
+         IF IsVar (l) OR IsConst (l)
+         THEN
+            MetaErrorT2 (functok,
+                      'the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the second parameter is {%2d}',
+                      func, r)
+         ELSE
+            MetaErrorT2 (functok,
+                         'the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the first parameter is {%2d}',
+                      func, l)
+         END ;
+         PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
+         PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), CType), CType, combinedtok)
+      END
+   ELSE
+      MetaErrorT2 (functok,
+                   'the builtin procedure {%1Ead} requires two parameters, seen {%2n}',
+                   func, NoOfParam) ;
+      PopN (NoOfParam + 1) ;  (* destroy arguments to this function *)
+      PushTFtok (MakeConstLit (functok, MakeKey ('1.0'), CType), CType, functok)
+   END
+END BuildCmplxFunction ;
+
+
+(*
+   BuildAdrFunction - builds the pseudo function ADR
+                      The Stack:
+
+
+                      Entry                      Exit
+
+               Ptr ->
+                      +----------------+
+                      | NoOfParam      |
+                      |----------------|
+                      | Param 1        |
+                      |----------------|
+                      | Param 2        |
+                      |----------------|
+                      .                .
+                      .                .
+                      .                .
+                      |----------------|
+                      | Param #        |                        <- Ptr
+                      |----------------|         +------------+
+                      | ProcSym | Type |         | ReturnVar  |
+                      |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildAdrFunction ;
+VAR
+   endtok,
+   combinedTok,
+   procTok,
+   t,
+   UnboundedSym,
+   Dim,
+   Field,
+   noOfParameters,
+   procSym,
+   returnVar,
+   Type, rw    : CARDINAL ;
+BEGIN
+   DisplayStack ;
+   PopT (noOfParameters) ;
+   procSym := OperandT (noOfParameters + 1) ;
+   procTok := OperandTok (noOfParameters + 1) ;  (* token of procedure ADR.  *)
+   endtok := OperandTok (1) ;  (* last parameter.  *)
+   combinedTok := MakeVirtualTok (procTok, procTok, endtok) ;
+   IF noOfParameters # 1
+   THEN
+      MetaErrorNT0 (combinedTok,
+                    'SYSTEM procedure ADR expects 1 parameter') ;
+      PopN (noOfParameters + 1) ;    (* destroy the arguments and function *)
+      PushTF (Nil, Address)
+   ELSIF IsConstString (OperandT (1))
+   THEN
+      returnVar := MakeLeftValue (combinedTok, OperandT (1), RightValue,
+                                  GetSType (procSym)) ;
+      PopN (noOfParameters + 1) ;    (* destroy the arguments and function *)
+      PushTFtok (returnVar, GetSType (returnVar), combinedTok)
+   ELSIF (NOT IsVar(OperandT(1))) AND (NOT IsProcedure(OperandT(1)))
+   THEN
+      MetaErrorNT0 (combinedTok,
+                    'SYSTEM procedure ADR expects a variable, procedure or a constant string as its parameter') ;
+      PopN (noOfParameters + 1) ;    (* destroy the arguments and function *)
+      PushTFtok (Nil, Address, combinedTok)
+   ELSIF IsProcedure (OperandT (1))
+   THEN
+      returnVar := MakeLeftValue (combinedTok, OperandT (1), RightValue,
+                                  GetSType (procSym)) ;
+      PopN (noOfParameters + 1) ;    (* destroy the arguments and function *)
+      PushTFtok (returnVar, GetSType (returnVar), combinedTok)
+   ELSE
+      Type := GetSType (OperandT (1)) ;
+      Dim := OperandD (1) ;
+      MarkArrayWritten (OperandT (1)) ;
+      MarkArrayWritten (OperandA (1)) ;
+      (* if the operand is an unbounded which has not been indexed
+         then we will lookup its address from the unbounded record.
+         Otherwise we obtain the address of the operand.
+      *)
+      IF IsUnbounded (Type) AND (Dim = 0)
+      THEN
+         (* we will reference the address field of the unbounded structure *)
+         UnboundedSym := OperandT (1) ;
+         rw := OperandRW (1) ;
+         PushTFrw (UnboundedSym, GetSType (UnboundedSym), rw) ;
+         Field := GetUnboundedAddressOffset (GetSType (UnboundedSym)) ;
+         PushTF (Field, GetSType (Field)) ;
+         PushT (1) ;
+         BuildDesignatorRecord (combinedTok) ;
+         PopTrw (returnVar, rw) ;
+         IF GetMode (returnVar) = LeftValue
+         THEN
+            t := MakeTemporary (combinedTok, RightValue) ;
+            PutVar (t, GetSType (procSym)) ;
+            doIndrX (combinedTok, t, returnVar) ;
+            returnVar := t
+         ELSE
+            (* we need to cast returnVar into ADDRESS *)
+            t := MakeTemporary (combinedTok, RightValue) ;
+            PutVar (t, GetSType (procSym)) ;
+            GenQuadO (combinedTok, ConvertOp, t, GetSType (procSym), returnVar, FALSE) ;
+            returnVar := t
+         END
+      ELSE
+         returnVar := MakeTemporary (combinedTok, RightValue) ;
+         PutVar (returnVar, GetSType (procSym)) ;
+         IF GetMode (OperandT (1)) = LeftValue
+         THEN
+            PutVar (returnVar, GetSType (procSym)) ;
+            GenQuadO (combinedTok, ConvertOp, returnVar, GetSType (procSym), OperandT (1), FALSE)
+         ELSE
+            GenQuadO (combinedTok, AddrOp, returnVar, NulSym, OperandT (1), FALSE)
+         END ;
+         rw := OperandMergeRW (1) ;
+         Assert (IsLegal (rw))
+      END ;
+      PopN (noOfParameters + 1) ;    (* destroy the arguments and function *)
+      PushTFrwtok (returnVar, GetSType (returnVar), rw, combinedTok)
+   END
+END BuildAdrFunction ;
+
+
+(*
+   BuildSizeFunction - builds the pseudo function SIZE
+                       The Stack:
+
+
+                       Entry                      Exit
+
+                Ptr ->
+                       +----------------+
+                       | NoOfParam      |
+                       |----------------|
+                       | Param 1        |
+                       |----------------|
+                       | Param 2        |
+                       |----------------|
+                       .                .
+                       .                .
+                       .                .
+                       |----------------|
+                       | Param #        |                        <- Ptr
+                       |----------------|         +------------+
+                       | ProcSym | Type |         | ReturnVar  |
+                       |----------------|         |------------|
+*)
+
+PROCEDURE BuildSizeFunction ;
+VAR
+   resulttok,
+   paramtok,
+   functok     : CARDINAL ;
+   dim         : CARDINAL ;
+   Type,
+   NoOfParam,
+   ProcSym,
+   ReturnVar   : CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   ProcSym := OperandT (NoOfParam + 1) ;
+   functok := OperandTtok (NoOfParam + 1) ;
+   IF NoOfParam # 1
+   THEN
+      MetaErrorT1 (functok,
+                   '{%E} SYSTEM procedure function {%kSIZE} requires one parameter, seen {%1n}',
+                   NoOfParam) ;
+      resulttok := functok ;
+      ReturnVar := MakeConstLit (resulttok, MakeKey('0'), Cardinal)
+   ELSIF IsAModula2Type (OperandT (1))
+   THEN
+      paramtok := OperandTok (1) ;
+      resulttok := MakeVirtualTok (functok, functok, paramtok) ;
+      BuildSizeCheckEnd (ProcSym) ;   (* quadruple generation now on *)
+      ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
+      GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, OperandT(1), TRUE)
+   ELSIF IsVar (OperandT (1))
+   THEN
+      BuildSizeCheckEnd (ProcSym) ;   (* quadruple generation now on *)
+      Type := GetSType (OperandT (1)) ;
+      paramtok := OperandTok (1) ;
+      resulttok := MakeVirtualTok (functok, functok, paramtok) ;
+      IF IsUnbounded (Type)
+      THEN
+         (* eg. SIZE(a)  ; where a is unbounded dereference HIGH and multiply by the TYPE *)
+         dim := OperandD (1) ;
+         IF dim = 0
+         THEN
+            ReturnVar := calculateMultipicand (resulttok, OperandT (1), Type, dim)
+         ELSE
+            ReturnVar := calculateMultipicand (resulttok, OperandA (1), Type, dim)
+         END
+      ELSE
+         ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
+         IF Type = NulSym
+         THEN
+            MetaErrorT1 (resulttok,
+                         'cannot get the type and size of {%E1ad}', OperandT (1))
+         END ;
+         GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, Type, TRUE)
+      END
+   ELSE
+      resulttok := functok ;
+      MetaErrorT1 (resulttok,
+                   '{%E}SYSTEM procedure {%kSIZE} expects a variable as its parameter, seen {%E1d}',
+                   OperandT (1)) ;
+      ReturnVar := MakeConstLit (resulttok, MakeKey('0'), Cardinal)
+   END ;
+   PopN (NoOfParam+1) ;       (* destroy the arguments and function *)
+   PushTFtok (ReturnVar, GetSType(ProcSym), resulttok)
+END BuildSizeFunction ;
+
+
+(*
+   BuildTSizeFunction - builds the pseudo function TSIZE
+                        The Stack:
+
+
+                        Entry                      Exit
+
+                 Ptr ->
+                        +----------------+
+                        | NoOfParam      |
+                        |----------------|
+                        | Param 1        |
+                        |----------------|
+                        | Param 2        |
+                        |----------------|
+                        .                .
+                        .                .
+                        .                .
+                        |----------------|
+                        | Param #        |                        <- Ptr
+                        |----------------|         +------------+
+                        | ProcSym | Type |         | ReturnVar  |
+                        |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildTSizeFunction ;
+VAR
+   resulttok,
+   paramtok,
+   functok  : CARDINAL ;
+   NoOfParam: CARDINAL ;
+   ProcSym,
+   Record,
+   ReturnVar: CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   ProcSym := OperandT (NoOfParam + 1) ;
+   functok := OperandTtok (NoOfParam) ;
+   BuildSizeCheckEnd (ProcSym) ;   (* quadruple generation now on *)
+   IF NoOfParam = 1
+   THEN
+      paramtok := OperandTtok (1) ;
+      resulttok := MakeVirtualTok (functok, functok, paramtok) ;
+      IF IsAModula2Type (OperandT (1))
+      THEN
+         ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
+         GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, OperandT (1), FALSE)
+      ELSIF IsVar (OperandT (1))
+      THEN
+         ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
+         GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, GetSType (OperandT (1)), FALSE)
+      ELSE
+         MetaErrorT1 (resulttok,
+                      '{%E}SYSTEM procedure function {%kTSIZE} expects a variable as its first parameter, seen {%E1d}',
+                      OperandT (1)) ;
+         ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
+      END
+   ELSIF NoOfParam = 0
+   THEN
+      resulttok := functok ;
+      MetaErrorT0 (resulttok,
+                   '{%E}SYSTEM procedure function {%kTSIZE} expects either one or two parameters, seen none') ;
+      ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
+   ELSE
+      Record := OperandT (NoOfParam) ;
+      paramtok := OperandTtok (1) ;
+      resulttok := OperandTtok (NoOfParam) ;
+      IF IsRecord (Record)
+      THEN
+         paramtok := OperandTtok (1) ;
+         resulttok := MakeVirtualTok (functok, functok, paramtok) ;
+         ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
+         GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, Record, FALSE)
+      ELSE
+         resulttok := MakeVirtualTok (functok, functok, paramtok) ;
+         MetaErrorT1 (resulttok,
+                      '{%E}SYSTEM procedure function {%kTSIZE} expects the first parameter to be a record type, seen {%E1d}',
+                      Record) ;
+         ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
+      END
+   END ;
+   PopN (NoOfParam+1) ;       (* destroy the arguments and function *)
+   PushTFtok (ReturnVar, GetSType (ProcSym), resulttok)
+END BuildTSizeFunction ;
+
+
+(*
+   BuildTBitSizeFunction - builds the pseudo function TBITSIZE
+                           The Stack:
+
+
+                           Entry                      Exit
+
+                   Ptr ->
+                           +----------------+
+                           | NoOfParam      |
+                           |----------------|
+                           | Param 1        |
+                           |----------------|
+                           | Param 2        |
+                           |----------------|
+                           .                .
+                           .                .
+                           .                .
+                           |----------------|
+                           | Param #        |                        <- Ptr
+                           |----------------|         +------------+
+                           | ProcSym | Type |         | ReturnVar  |
+                           |----------------|         |------------|
+
+*)
+
+PROCEDURE BuildTBitSizeFunction ;
+VAR
+   resulttok,
+   paramtok,
+   functok  : CARDINAL ;
+   NoOfParam: CARDINAL ;
+   ProcSym,
+   Record,
+   ReturnVar: CARDINAL ;
+BEGIN
+   PopT (NoOfParam) ;
+   ProcSym := OperandT (NoOfParam + 1) ;
+   functok := OperandTtok (NoOfParam) ;
+   BuildSizeCheckEnd (ProcSym) ;   (* quadruple generation now on *)
+   IF NoOfParam = 1
+   THEN
+      paramtok := OperandTtok (1) ;
+      resulttok := MakeVirtualTok (functok, functok, paramtok) ;
+      IF IsAModula2Type (OperandT (1))
+      THEN
+         ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
+         GenQuadO (resulttok, StandardFunctionOp, ReturnVar, ProcSym, OperandT (1), FALSE)
+      ELSIF IsVar (OperandT (1))
+      THEN
+         ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
+         GenQuadO (resulttok, StandardFunctionOp, ReturnVar, ProcSym, OperandT(1), FALSE)
+      ELSE
+         MetaErrorT1 (resulttok,
+                      '{%E}SYSTEM procedure function {%kTBITSIZE} expects a variable as its first parameter, seen {%E1d}',
+                      OperandT (1)) ;
+         ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
+      END
+   ELSIF NoOfParam = 0
+   THEN
+      resulttok := functok ;
+      MetaErrorT0 (functok,
+                   '{%E}SYSTEM procedure function {%kTBITSIZE} expects either one or two parameters, seen none') ;
+      ReturnVar := MakeConstLit (functok, MakeKey ('0'), Cardinal)
+   ELSE
+      Record := OperandT (NoOfParam) ;
+      paramtok := OperandTtok (1) ;
+      resulttok := OperandTtok (NoOfParam) ;
+      IF IsRecord (Record)
+      THEN
+         paramtok := OperandTtok (1) ;
+         resulttok := MakeVirtualTok (functok, functok, paramtok) ;
+         ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
+         GenQuad(StandardFunctionOp, ReturnVar, ProcSym, OperandT(1)) ;
+      ELSE
+         resulttok := MakeVirtualTok (functok, functok, paramtok) ;
+         MetaErrorT1 (resulttok,
+                      '{%E}SYSTEM procedure function {%kTBITSIZE} expects the first parameter to be a record type, seen {%E1d}',
+                      Record) ;
+         ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
+      END
+   END ;
+   PopN (NoOfParam + 1) ;       (* destroy the arguments and function *)
+   PushTFtok (ReturnVar, GetSType (ProcSym), resulttok)
+END BuildTBitSizeFunction ;
+
+
+(*
+   ExpectingParameterType -
+*)
+
+PROCEDURE ExpectingParameterType (BlockSym, Type: CARDINAL) ;
+BEGIN
+   IF NOT IsAModula2Type (Type)
+   THEN
+      IF (Type = NulSym) OR IsPartialUnbounded (Type) OR IsUnknown (Type)
+      THEN
+         MetaError1 ('the type used in the formal parameter declaration in {%1Md} {%1a} is unknown',
+                     BlockSym)
+      ELSE
+         MetaError2 ('the type {%1Ead} used in the formal parameter declaration in {%2Md} {%2a} was not declared as a type',
+                     Type, BlockSym)
+      END
+   END
+END ExpectingParameterType ;
+
+
+(*
+   ExpectingVariableType -
+*)
+
+PROCEDURE ExpectingVariableType (BlockSym, Type: CARDINAL) ;
+BEGIN
+   IF NOT IsAModula2Type(Type)
+   THEN
+      IF Type=NulSym
+      THEN
+         MetaError1 ('the type used during the variable declaration section in procedure {%1EMad} is unknown',
+                     BlockSym) ;
+         MetaError1 ('the type used during the variable declaration section in procedure {%1Ead} is unknown',
+                     BlockSym)
+      ELSIF IsPartialUnbounded(Type) OR IsUnknown(Type)
+      THEN
+         MetaError2 ('the type {%1EMad} used during variable declaration section in procedure {%2ad} is unknown',
+                     Type, BlockSym) ;
+         MetaError2 ('the type {%1Ead} used during variable declaration section in procedure {%2Mad} is unknown',
+                     Type, BlockSym)
+      ELSE
+         MetaError2 ('the {%1d} {%1Ea} is not a type and therefore cannot be used to declare a variable in {%2d} {%2a}',
+                     Type, BlockSym)
+      END
+   END
+END ExpectingVariableType ;
+
+
+(*
+   CheckVariablesAndParameterTypesInBlock - checks to make sure that block, BlockSym, has
+                                            parameters types and variable types which are legal.
+*)
+
+PROCEDURE CheckVariablesAndParameterTypesInBlock (BlockSym: CARDINAL) ;
+VAR
+   i, n,
+   ParamNo: CARDINAL ;
+BEGIN
+   IF IsProcedure(BlockSym)
+   THEN
+      ParamNo := NoOfParam(BlockSym)
+   ELSE
+      ParamNo := 0
+   END ;
+   i := 1 ;
+   REPEAT
+      n := GetNth(BlockSym, i) ;
+      IF (n#NulSym) AND (NOT IsTemporary(n)) AND
+         (IsProcedure(BlockSym) OR ((IsDefImp(BlockSym) AND (GetMainModule()=BlockSym)) OR IsModule(BlockSym)))
+      THEN
+         IF i<=ParamNo
+         THEN
+            (* n is a parameter *)
+            ExpectingParameterType(BlockSym, GetSType(n))
+         ELSE
+            (* n is a local variable *)
+            ExpectingVariableType(BlockSym, GetSType(n))
+         END
+      END ;
+      INC(i)
+   UNTIL n=NulSym ;
+END CheckVariablesAndParameterTypesInBlock ;
+
+
+(*
+   BuildProcedureStart - Builds start of the procedure. Generates a
+                         quadruple which indicated the start of
+                         this procedure declarations scope.
+                         The Stack is expected to contain:
+
+
+                         Entry                   Exit
+                         =====                   ====
+
+                 Ptr ->                                       <- Ptr
+                        +------------+          +-----------+
+                        | ProcSym    |          | ProcSym   |
+                        |------------|          |-----------|
+                        | Name       |          | Name      |
+                        |------------|          |-----------|
+
+
+                        Quadruples:
+
+                        q   ProcedureScopeOp  Line#  Scope  ProcSym
+*)
+
+PROCEDURE BuildProcedureStart ;
+VAR
+   ProcSym: CARDINAL ;
+BEGIN
+   PopT(ProcSym) ;
+   Assert(IsProcedure(ProcSym)) ;
+   PutProcedureScopeQuad(ProcSym, NextQuad) ;
+   GenQuad(ProcedureScopeOp, GetPreviousTokenLineNo(), GetScope(ProcSym), ProcSym) ;
+   PushT(ProcSym)
+END BuildProcedureStart ;
+
+
+(*
+   BuildProcedureBegin - determines the start of the BEGIN END block of
+                         the procedure.
+                         The Stack is expected to contain:
+
+
+                         Entry                   Exit
+                         =====                   ====
+
+                 Ptr ->                                       <- Ptr
+                        +------------+          +-----------+
+                        | ProcSym    |          | ProcSym   |
+                        |------------|          |-----------|
+                        | Name       |          | Name      |
+                        |------------|          |-----------|
+
+
+                        Quadruples:
+
+                        q   NewLocalVarOp  TokenNo(BEGIN)  _  ProcSym
+*)
+
+PROCEDURE BuildProcedureBegin ;
+VAR
+   ProcSym: CARDINAL ;
+BEGIN
+   PopT(ProcSym) ;
+   Assert(IsProcedure(ProcSym)) ;
+   PutProcedureStartQuad(ProcSym, NextQuad) ;
+   PutProcedureBegin(ProcSym, GetTokenNo()) ;
+   GenQuad(NewLocalVarOp, GetTokenNo(), GetScope(ProcSym), ProcSym) ;
+   CurrentProc := ProcSym ;
+   PushWord(ReturnStack, 0) ;
+   PushT(ProcSym) ;
+   CheckVariablesAt(ProcSym) ;
+   CheckNeedPriorityBegin(GetTokenNo(), ProcSym, GetCurrentModule()) ;
+   PushWord(TryStack, NextQuad) ;
+   PushWord(CatchStack, 0) ;
+   IF HasExceptionBlock(ProcSym)
+   THEN
+      GenQuad(TryOp, NulSym, NulSym, 0)
+   END
+END BuildProcedureBegin ;
+
+
+(*
+   BuildProcedureEnd - Builds end of the procedure. Destroys space for
+                       the local variables.
+                       The Stack is expected to contain:
+
+
+                       Entry                   Exit
+                       =====                   ====
+
+                Ptr ->                                       <- Ptr
+                       +------------+          +-----------+
+                       | ProcSym    |          | ProcSym   |
+                       |------------|          |-----------|
+                       | Name       |          | Name      |
+                       |------------|          |-----------|
+
+
+                       Quadruples:
+
+                       q   KillLocalVarOp  TokenNo(END)  _  ProcSym
+*)
+
+PROCEDURE BuildProcedureEnd ;
+VAR
+   tok    : CARDINAL ;
+   ProcSym: CARDINAL ;
+BEGIN
+   PopTtok(ProcSym, tok) ;
+   IF HasExceptionBlock(ProcSym)
+   THEN
+      BuildRTExceptLeave(tok, TRUE) ;
+      GenQuad(CatchEndOp, NulSym, NulSym, NulSym)
+   END ;
+   IF GetSType(ProcSym)#NulSym
+   THEN
+      BuildError(InitNoReturnRangeCheck())
+   END ;
+   BackPatch(PopWord(ReturnStack), NextQuad) ;
+   CheckNeedPriorityEnd(tok, ProcSym, GetCurrentModule()) ;
+   CurrentProc := NulSym ;
+   PutProcedureEnd(ProcSym, GetTokenNo()-1) ;   (* --fixme-- *)
+   GenQuad(KillLocalVarOp, GetTokenNo()-1, NulSym, ProcSym) ;
+   PutProcedureEndQuad(ProcSym, NextQuad) ;
+   GenQuad(ReturnOp, NulSym, NulSym, ProcSym) ;
+   CheckFunctionReturn(ProcSym) ;
+   CheckVariablesInBlock(ProcSym) ;
+   RemoveTop (CatchStack) ;
+   RemoveTop (TryStack) ;
+   PushT(ProcSym)
+END BuildProcedureEnd ;
+
+
+(*
+   CheckReadBeforeInitialized -
+*)
+
+PROCEDURE CheckReadBeforeInitialized (ProcSym: CARDINAL; End: CARDINAL) ;
+VAR
+   s1, s2              : String ;
+   i, n, ParamNo,
+   ReadStart, ReadEnd,
+   WriteStart, WriteEnd: CARDINAL ;
+BEGIN
+   ParamNo := NoOfParam(ProcSym) ;
+   i := 1 ;
+   REPEAT
+      n := GetNth(ProcSym, i) ;
+      IF (n#NulSym) AND (NOT IsTemporary(n))
+      THEN
+         GetReadQuads(n, RightValue, ReadStart, ReadEnd) ;
+         GetWriteQuads(n, RightValue, WriteStart, WriteEnd) ;
+         IF i>ParamNo
+         THEN
+            (* n is a not a parameter thus we can check *)
+            IF (ReadStart>0) AND (ReadStart<End)
+            THEN
+               (* it is read in the first basic block *)
+               IF ReadStart<WriteStart
+               THEN
+                  (* read before written, this is a problem which must be fixed *)
+                  s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(n)))) ;
+                  s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ProcSym)))) ;
+                  ErrorStringAt2(Sprintf2(Mark(InitString('reading from a variable (%s) before it is initialized in procedure (%s)')),
+                                          s1, s2),
+                                 GetDeclaredMod(n), GetDeclaredMod(n))
+               END
+            END
+         END
+      END ;
+      INC(i)
+   UNTIL n=NulSym
+END CheckReadBeforeInitialized ;
+
+
+(*
+   VariableAnalysis - checks to see whether a variable is:
+
+                      read before it has been initialized
+*)
+
+PROCEDURE VariableAnalysis (Start, End: CARDINAL) ;
+VAR
+   Op           : QuadOperator ;
+   Op1, Op2, Op3: CARDINAL ;
+BEGIN
+   IF Pedantic
+   THEN
+      GetQuad(Start, Op, Op1, Op2, Op3) ;
+      CASE Op OF
+
+      NewLocalVarOp:  CheckReadBeforeInitialized(Op3, End)
+
+      ELSE
+      END
+   END
+END VariableAnalysis ;
+
+
+(*
+   IsNeverAltered - returns TRUE if variable, sym, is never altered
+                    between quadruples: Start..End
+*)
+
+PROCEDURE IsNeverAltered (sym: CARDINAL; Start, End: CARDINAL) : BOOLEAN ;
+VAR
+   WriteStart, WriteEnd: CARDINAL ;
+BEGIN
+   GetWriteLimitQuads(sym, GetMode(sym), Start, End, WriteStart, WriteEnd) ;
+   RETURN( (WriteStart=0) AND (WriteEnd=0) )
+END IsNeverAltered ;
+
+
+(*
+   IsConditionVariable - returns TRUE if the condition at quadruple, q, is variable.
+*)
+
+PROCEDURE IsConditionVariable (q: CARDINAL; Start, End: CARDINAL) : BOOLEAN ;
+VAR
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+   LeftFixed,
+   RightFixed   : BOOLEAN ;
+BEGIN
+   GetQuad(q, op, op1, op2, op3) ;
+   IF op=GotoOp
+   THEN
+      RETURN( FALSE )
+   ELSE
+      LeftFixed  := IsConst(op1) ;
+      RightFixed := IsConst(op2) ;
+      IF NOT LeftFixed
+      THEN
+         LeftFixed := IsNeverAltered(op1, Start, End)
+      END ;
+      IF NOT RightFixed
+      THEN
+         RightFixed := IsNeverAltered(op2, Start, End)
+      END ;
+      RETURN( NOT (LeftFixed AND RightFixed) )
+   END
+END IsConditionVariable ;
+
+
+(*
+   IsInfiniteLoop - returns TRUE if an infinite loop is found.
+                    Given a backwards jump at, End, it returns a BOOLEAN which depends on
+                    whether a jump is found to jump beyond, End. If a conditonal jump is found
+                    to pass over, End, the condition is tested for global variables, procedure variables and
+                    constants.
+
+                         constant        - ignored
+                         variables       - tested to see whether they are altered inside the loop
+                         global variable - the procedure tests to see whether it is altered as above
+                                           but will also test to see whether this loop calls a procedure
+                                           in which case it believes the loop NOT to be infinite
+                                           (as this procedure call might alter the global variable)
+
+                    Note that this procedure can easily be fooled by the user altering variables
+                    with pointers.
+*)
+
+PROCEDURE IsInfiniteLoop (End: CARDINAL) : BOOLEAN ;
+VAR
+   SeenCall,
+   IsGlobal     : BOOLEAN ;
+   Current,
+   Start        : CARDINAL ;
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+BEGIN
+   SeenCall := FALSE ;
+   IsGlobal := FALSE ;
+   GetQuad(End, op, op1, op2, Start) ;
+   Current := Start ;
+   WHILE Current#End DO
+      GetQuad(Current, op, op1, op2, op3) ;
+      (* remember that this function is only called once we have optimized the redundant gotos and conditionals *)
+      IF IsConditional(Current) AND (NOT IsGlobal)
+      THEN
+         IsGlobal := (IsVar(op1) AND (NOT IsProcedure(GetVarScope(op1)))) OR
+                     (IsVar(op2) AND (NOT IsProcedure(GetVarScope(op2))))
+      END ;
+      IF op=CallOp
+      THEN
+         SeenCall := TRUE
+      END ;
+      IF (op=GotoOp) OR (IsConditional(Current) AND IsConditionVariable(Current, Start, End))
+      THEN
+         IF (op3>End) OR (op3<Start)
+         THEN
+            RETURN( FALSE )    (* may jump out of this loop, good *)
+         END
+      END ;
+      Current := GetNextQuad(Current)
+   END ;
+   GetQuad(End, op, op1, op2, op3) ;
+   IF IsConditional(End)
+   THEN
+      IF IsConditionVariable(End, Start, End)
+      THEN
+         RETURN( FALSE )
+      ELSE
+         IF NOT IsGlobal
+         THEN
+            IsGlobal := (IsVar(op1) AND (NOT IsProcedure(GetVarScope(op1)))) OR
+                        (IsVar(op2) AND (NOT IsProcedure(GetVarScope(op2))))
+         END
+      END
+   END ;
+   (* we have found a likely infinite loop if no conditional uses a global and no procedure call was seen *)
+   RETURN( NOT (IsGlobal AND SeenCall) )
+END IsInfiniteLoop ;
+
+
+(*
+   LoopAnalysis - checks whether an infinite loop exists.
+*)
+
+PROCEDURE LoopAnalysis (Current, End: CARDINAL) ;
+VAR
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+BEGIN
+   IF Pedantic
+   THEN
+      WHILE (Current<=End) AND (Current#0) DO
+         GetQuad(Current, op, op1, op2, op3) ;
+         IF (op=GotoOp) OR IsConditional(Current)
+         THEN
+            IF op3<=Current
+            THEN
+               (* found a loop - ie a branch which goes back in quadruple numbers *)
+               IF IsInfiniteLoop(Current)
+               THEN
+                  WarnStringAt(InitString('it is very likely (although not absolutely certain) that the top of an infinite loop is here'),
+                               QuadToTokenNo(op3)) ;
+                  WarnStringAt(InitString('and the bottom of the infinite loop is ends here or alternatively a component of this loop is never executed'),
+                               QuadToTokenNo(Current))
+               END
+            END
+         END ;
+         Current := GetNextQuad(Current)
+      END
+   END
+END LoopAnalysis ;
+
+
+(*
+   CheckUninitializedVariablesAreUsed - checks to see whether uninitialized variables are used.
+*)
+
+PROCEDURE CheckUninitializedVariablesAreUsed (BlockSym: CARDINAL) ;
+VAR
+   i, n,
+   ParamNo   : CARDINAL ;
+   ReadStart,
+   ReadEnd,
+   WriteStart,
+   WriteEnd  : CARDINAL ;
+BEGIN
+   IF IsProcedure(BlockSym)
+   THEN
+      ParamNo := NoOfParam(BlockSym)
+   ELSE
+      ParamNo := 0
+   END ;
+   i := 1 ;
+   REPEAT
+      n := GetNth(BlockSym, i) ;
+      IF (n#NulSym) AND (NOT IsTemporary(n)) AND
+         (IsProcedure(BlockSym) OR (((IsDefImp(BlockSym) AND (GetMainModule()=BlockSym)) OR IsModule(BlockSym)) AND
+                                    (NOT IsExported(BlockSym, n))))
+      THEN
+         GetReadQuads(n, RightValue, ReadStart, ReadEnd) ;
+         GetWriteQuads(n, RightValue, WriteStart, WriteEnd) ;
+         IF i<=ParamNo
+         THEN
+            (* n is a parameter *)
+            IF UnusedParameterChecking
+            THEN
+               IF ReadStart = 0
+               THEN
+                  IF WriteStart = 0
+                  THEN
+                     MetaError2 ('unused parameter {%1WMad} in procedure {%2ad}', n, BlockSym)
+                  ELSE
+                     IF NOT IsVarParam (BlockSym, i)
+                     THEN
+                        (* --fixme-- reconsider this.  *)
+                        (* MetaError2 ('writing to a non var parameter {%1WMad} and never reading from it in procedure {%2ad}',
+                                    n, BlockSym) *)
+                     END
+                  END
+               END
+            END
+         ELSE
+            (* n is a local variable *)
+            IF UnusedVariableChecking
+            THEN
+               IF ReadStart=0
+               THEN
+                  IF WriteStart=0
+                  THEN
+                     MetaError2 ('unused variable {%1WMad} in {%2d} {%2ad}', n, BlockSym)
+                  ELSE
+                     (* --fixme-- reconsider this.  *)
+                     (* MetaError2 ('writing to a variable {%1WMad} and never reading from it in {%2d} {%2ad}', n, BlockSym) *)
+                  END
+               ELSE
+                  IF WriteStart=0
+                  THEN
+                     MetaError2 ('variable {%1WMad} is being used but it is never initialized in {%2d} {%2ad}', n, BlockSym)
+                  END
+               END
+            END
+         END
+      END ;
+      INC(i)
+   UNTIL n=NulSym
+END CheckUninitializedVariablesAreUsed ;
+
+
+(*
+   IsInlineWithinBlock - returns TRUE if an InlineOp is found
+                         within start..end.
+*)
+
+PROCEDURE IsInlineWithinBlock (start, end: CARDINAL) : BOOLEAN ;
+VAR
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+BEGIN
+   WHILE (start#end) AND (start#0) DO
+      GetQuad(start, op, op1, op2, op3) ;
+      IF op=InlineOp
+      THEN
+         RETURN( TRUE )
+      END ;
+      start := GetNextQuad(start)
+   END ;
+   RETURN( FALSE )
+END IsInlineWithinBlock ;
+
+
+(*
+   AsmStatementsInBlock - returns TRUE if an ASM statement is found within a block, BlockSym.
+*)
+
+PROCEDURE AsmStatementsInBlock (BlockSym: CARDINAL) : BOOLEAN ;
+VAR
+   Scope,
+   StartInit,
+   EndInit,
+   StartFinish,
+   EndFinish    : CARDINAL ;
+BEGIN
+   IF IsProcedure(BlockSym)
+   THEN
+      GetProcedureQuads(BlockSym, Scope, StartInit, EndInit) ;
+      RETURN( IsInlineWithinBlock(StartInit, EndInit) )
+   ELSE
+      GetModuleQuads(BlockSym, StartInit, EndInit, StartFinish, EndFinish) ;
+      RETURN( IsInlineWithinBlock(StartInit, EndInit) OR
+              IsInlineWithinBlock(StartFinish, EndFinish) )
+   END
+END AsmStatementsInBlock ;
+
+
+(*
+   CheckVariablesInBlock - given a block, BlockSym, check whether all variables are used.
+*)
+
+PROCEDURE CheckVariablesInBlock (BlockSym: CARDINAL) ;
+BEGIN
+   CheckVariablesAndParameterTypesInBlock (BlockSym) ;
+   IF UnusedVariableChecking OR UnusedParameterChecking
+   THEN
+      IF (NOT AsmStatementsInBlock (BlockSym))
+      THEN
+         CheckUninitializedVariablesAreUsed (BlockSym)
+      END
+   END
+END CheckVariablesInBlock ;
+
+
+(*
+   CheckFunctionReturn - checks to see that a RETURN statement was present in a function.
+*)
+
+PROCEDURE CheckFunctionReturn (ProcSym: CARDINAL) ;
+VAR
+   Op           : QuadOperator ;
+   Op1, Op2, Op3,
+   Scope,
+   Start, End   : CARDINAL ;
+BEGIN
+   IF GetSType(ProcSym)#NulSym
+   THEN
+      (* yes it is a function *)
+      GetProcedureQuads(ProcSym, Scope, Start, End) ;
+      GetQuad(Start, Op, Op1, Op2, Op3) ;
+      IF Start=0
+      THEN
+         InternalError ('incorrect start quad')
+      END ;
+      WHILE (Start#End) AND (Op#ReturnValueOp) AND (Op#InlineOp) DO
+         Start := GetNextQuad(Start) ;
+         GetQuad(Start, Op, Op1, Op2, Op3)
+      END ;
+      IF (Op#ReturnValueOp) AND (Op#InlineOp)
+      THEN
+         (* an InlineOp can always be used to emulate a RETURN *)
+         MetaError1 ('procedure function {%1Ea} does not RETURN a value', ProcSym)
+      END
+   END
+END CheckFunctionReturn ;
+
+
+(*
+   CheckReturnType - checks to see that the return type from currentProc is
+                     assignment compatible with actualType.
+*)
+
+PROCEDURE CheckReturnType (tokno: CARDINAL; currentProc, actualVal, actualType: CARDINAL) ;
+VAR
+   procType: CARDINAL ;
+   s1, s2  : String ;
+   n1, n2  : Name ;
+BEGIN
+   procType := GetSType (currentProc) ;
+   IF procType = NulSym
+   THEN
+      MetaError1 ('attempting to RETURN a value from procedure {%1Ea} which was not a declared as a procedure function', currentProc)
+   ELSIF AssignmentRequiresWarning (actualType, GetSType (currentProc))
+   THEN
+      MetaError2 ('attempting to RETURN a value {%1Wa} with an incompatible type {%1Wtsa} from a procedure function {%1a} which returns {%1tsa}', actualVal, currentProc)
+   ELSIF NOT IsAssignmentCompatible (actualType, procType)
+   THEN
+      n1 := GetSymName(actualType) ;
+      n2 := GetSymName(procType) ;
+      WriteFormat2('attempting to RETURN a value with an incompatible type (%a) from a function which returns (%a)',
+                   n1, n2)
+   ELSIF IsProcedure(actualVal) AND (NOT IsAssignmentCompatible(actualVal, procType))
+   THEN
+(*
+      MetaWarnings2('attempting to RETURN a value with an incompatible type {%1ad} from function {%2a} which returns {%2ta}',
+                    actualVal, currentProc)
+
+      --fixme--  introduce MetaWarning, MetaWarning2, MetaWarning3 into M2MetaError
+*)
+      s1 := InitStringCharStar(KeyToCharStar(GetSymName(actualVal))) ;
+      s2 := InitStringCharStar(KeyToCharStar(GetSymName(procType))) ;
+      ErrorString(NewWarning(GetTokenNo()),
+                  Sprintf2(Mark(InitString('attempting to RETURN a value with a (possibly on other targets) incompatible type (%s) from a function which returns (%s)')),
+                           s1, s2))
+   ELSIF IsProcedure(actualVal) AND (NOT IsAssignmentCompatible(actualVal, GetSType(CurrentProc)))
+   THEN
+      n1 := GetSymName(actualVal) ;
+      n2 := GetSymName(GetSType(currentProc)) ;
+      WriteFormat2('attempting to RETURN a value with an incompatible type (%a) from a function which returns (%a)',
+                   n1, n2)
+   ELSE
+      (* this checks the types are compatible, not the data contents.  *)
+      BuildRange (InitTypesAssignmentCheck (tokno, currentProc, actualVal))
+   END
+END CheckReturnType ;
+
+
+(*
+   BuildReturn - Builds the Return part of the procedure.
+                 tokno is the location of the RETURN keyword.
+                 The Stack is expected to contain:
+
+
+                 Entry                   Exit
+                 =====                   ====
+
+         Ptr ->
+                 +------------+
+                 | e1         |          Empty
+                 |------------|
+*)
+
+PROCEDURE BuildReturn (tokno: CARDINAL) ;
+VAR
+   e2, t2,
+   e1, t1,
+   t, f,
+   Des   : CARDINAL ;
+BEGIN
+   IF IsBoolean (1)
+   THEN
+      PopBool(t, f) ;
+      (* Des will be a boolean type *)
+      Des := MakeTemporary (tokno, RightValue) ;
+      PutVar (Des, Boolean) ;
+      PushTF (Des, Boolean) ;
+      PushBool (t, f) ;
+      BuildAssignmentWithoutBounds (tokno, FALSE, TRUE) ;
+      PushTF (Des, Boolean)
+   END ;
+   PopTF (e1, t1) ;
+   IF e1 # NulSym
+   THEN
+      (* this will check that the type returned is compatible with
+         the formal return type of the procedure.  *)
+      CheckReturnType (tokno, CurrentProc, e1, t1) ;
+      (* dereference LeftValue if necessary *)
+      IF GetMode (e1) = LeftValue
+      THEN
+         t2 := GetSType (CurrentProc) ;
+         e2 := MakeTemporary (tokno, RightValue) ;
+         PutVar(e2, t2) ;
+         CheckPointerThroughNil (tokno, e1) ;
+         doIndrX (tokno, e2, e1) ;
+	 (* here we check the data contents to ensure no overflow.  *)
+         BuildRange (InitReturnRangeCheck (tokno, CurrentProc, e2)) ;
+         GenQuadO (tokno, ReturnValueOp, e2, NulSym, CurrentProc, FALSE)
+      ELSE
+	 (* here we check the data contents to ensure no overflow.  *)
+         BuildRange (InitReturnRangeCheck (tokno, CurrentProc, e1)) ;
+         GenQuadO (tokno, ReturnValueOp, e1, NulSym, CurrentProc, FALSE)
+      END
+   END ;
+   GenQuadO (tokno, GotoOp, NulSym, NulSym, PopWord(ReturnStack), FALSE) ;
+   PushWord (ReturnStack, NextQuad-1)
+END BuildReturn ;
+
+
+(*
+   IsReadOnly - a helper procedure function to detect constants.
+*)
+
+PROCEDURE IsReadOnly (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN IsConst (sym) OR (IsVar (sym) AND IsVarConst (sym))
+END IsReadOnly ;
+
+
+(*
+   BuildDesignatorRecord - Builds the record referencing.
+                           The Stack is expected to contain:
+
+
+                           Entry                   Exit
+                           =====                   ====
+
+                   Ptr ->
+                           +--------------+
+                           | n            |
+                           |--------------|
+                           | fld1 | type1 |
+                           |--------------|
+                           .              .
+                           .              .
+                           .              .
+                           |--------------|
+                           | fldn | typen |                        <- Ptr
+                           |--------------|        +-------------+
+                           | Sym  | Type  |        | S    | type1|
+                           |--------------|        |-------------|
+*)
+
+PROCEDURE BuildDesignatorRecord (dottok: CARDINAL) ;
+VAR
+   RecordTok,
+   FieldTok,
+   combinedtok: CARDINAL ;
+   n, rw,
+   Field,
+   FieldType,
+   RecordSym,
+   Res        : CARDINAL ;
+BEGIN
+   PopT(n) ;
+   RecordSym := OperandT (n+1) ;
+   (* RecordType could be found by:  SkipType (OperandF (n+1)).  *)
+   RecordTok := OperandTok (n+1) ;
+   rw := OperandMergeRW (n+1) ;
+   Assert (IsLegal (rw)) ;
+   Field := OperandT (n) ;
+   FieldType := SkipType (OperandF (n)) ;
+   FieldTok := OperandTok (n) ;
+   combinedtok := MakeVirtualTok (dottok, RecordTok, FieldTok) ;
+   IF n>1
+   THEN
+      InternalError ('not expecting to see n>1')
+   END ;
+   IF IsUnused (Field)
+   THEN
+      MetaErrors1 ('record field {%1Dad} was declared as unused by a pragma',
+                   'record field {%1ad} is being used after being declared as unused by a pragma', Field)
+   END ;
+   Res := MakeComponentRef (MakeComponentRecord (combinedtok,
+                                                 RightValue, RecordSym), Field) ;
+   PutVarConst (Res, IsReadOnly (RecordSym)) ;
+   GenQuadO (combinedtok, RecordFieldOp, Res, RecordSym, Field, FALSE) ;
+   PopN (n+1) ;
+   PushTFrwtok (Res, FieldType, rw, combinedtok)
+END BuildDesignatorRecord ;
+
+
+(*
+   BuildDesignatorError - removes the designator from the stack and replaces
+                          it with an error symbol.
+*)
+
+PROCEDURE BuildDesignatorError (message: ARRAY OF CHAR) ;
+VAR
+   combinedTok,
+   arrayTok,
+   exprTok    : CARDINAL ;
+   e, d, error,
+   Sym,
+   Type       : CARDINAL ;
+BEGIN
+   PopTtok (e, exprTok) ;
+   PopTFDtok (Sym, Type, d, arrayTok) ;
+   combinedTok := MakeVirtualTok (arrayTok, arrayTok, exprTok) ;
+   error := MakeError (combinedTok, MakeKey (message)) ;
+   PushTFDtok (error, Type, d, arrayTok)
+END BuildDesignatorError ;
+
+
+
+(*
+   BuildDesignatorArray - Builds the array referencing.
+                          The purpose of this procedure is to work out
+                          whether the DesignatorArray is a static or
+                          dynamic array and to call the appropriate
+                          BuildRoutine.
+
+                          The Stack is expected to contain:
+
+
+                          Entry                   Exit
+                          =====                   ====
+
+                  Ptr ->
+                          +--------------+
+                          | e            |                        <- Ptr
+                          |--------------|        +------------+
+                          | Sym  | Type  |        | S    | T   |
+                          |--------------|        |------------|
+*)
+
+PROCEDURE BuildDesignatorArray ;
+VAR
+   combinedTok,
+   arrayTok,
+   exprTok    : CARDINAL ;
+   e, t, d,
+   Sym,
+   Type       : CARDINAL ;
+BEGIN
+   IF IsConst (OperandT (2)) AND IsConstructor (OperandT (2))
+   THEN
+      t := GetDType (OperandT (2)) ;
+      IF t = NulSym
+      THEN
+         InternalError ('constructor type should have been resolved')
+      ELSIF IsArray (t)
+      THEN
+         PopTtok (e, exprTok) ;
+         PopTFDtok (Sym, Type, d, arrayTok) ;
+         t := MakeTemporary (exprTok, RightValue) ;
+         PutVar (t, Type) ;
+         PushTFtok (t, GetSType(t), exprTok) ;
+         PushTtok (Sym, arrayTok) ;
+         combinedTok := MakeVirtualTok (arrayTok, arrayTok, exprTok) ;
+         PutVarConst (t, TRUE) ;
+         BuildAssignConstant (combinedTok) ;
+         PushTFDtok (t, GetDType(t), d, arrayTok) ;
+         PushTtok (e, exprTok)
+      END
+   END ;
+   IF (NOT IsVar (OperandT (2))) AND (NOT IsTemporary (OperandT (2)))
+   THEN
+      MetaErrorT1 (OperandTtok (2),
+                   'can only access arrays using variables or formal parameters not {%1Ead}',
+                   OperandT (2)) ;
+      BuildDesignatorError ('bad array access')
+   END ;
+   Sym := OperandT (2) ;
+   Type := GetDType (Sym) ;
+   arrayTok := OperandTtok (2) ;
+   IF Type = NulSym
+   THEN
+      IF (arrayTok = UnknownTokenNo) OR (arrayTok = BuiltinTokenNo)
+      THEN
+         arrayTok := GetTokenNo ()
+      END ;
+      MetaErrorT0 (arrayTok, "type of array is undefined") ;
+      BuildDesignatorError ('bad array access')
+   ELSIF IsUnbounded (Type)
+   THEN
+      BuildDynamicArray
+   ELSIF IsArray (Type)
+   THEN
+      BuildStaticArray
+   ELSE
+      MetaErrorT1 (arrayTok,
+                   'can only index static or dynamic arrays, {%1Ead} is not an array but a {%tad}',
+                   Sym) ;
+      BuildDesignatorError ('bad array access')
+   END
+END BuildDesignatorArray ;
+
+
+(*
+   BuildStaticArray - Builds the array referencing for static arrays.
+                      The Stack is expected to contain:
+
+
+                      Entry                   Exit
+                      =====                   ====
+
+              Ptr ->
+                      +--------------+
+                      | e            |                       <- Ptr
+                      |--------------|        +------------+
+                      | Sym  | Type  |        | S    | T   |
+                      |--------------|        |------------|
+*)
+
+PROCEDURE BuildStaticArray ;
+VAR
+   combinedTok,
+   indexTok,
+   arrayTok   : CARDINAL ;
+   rw,
+   Dim,
+   Array,
+   Index,
+   BackEndType,
+   Type, Adr  : CARDINAL ;
+BEGIN
+   Index := OperandT (1) ;
+   indexTok := OperandTtok (1) ;
+   Array  := OperandT (2) ;
+   arrayTok := OperandTtok (2) ;
+   Type := SkipType (OperandF (2)) ;
+   rw := OperandMergeRW (2) ;
+   Assert (IsLegal (rw)) ;
+   Dim := OperandD (2) ;
+   INC (Dim) ;
+   IF GetMode (Index)=LeftValue
+   THEN
+      Index := MakeRightValue (indexTok, Index, GetSType (Index))
+   END ;
+   BuildRange (InitStaticArraySubscriptRangeCheck (GetArraySubscript (Type), Index, Dim)) ;
+
+   (* now make Adr point to the address of the indexed element *)
+   combinedTok := MakeVirtualTok (arrayTok, arrayTok, indexTok) ;
+   Adr := MakeTemporary (combinedTok, LeftValue) ;
+   IF IsVar (Array)
+   THEN
+      (* BuildDesignatorArray may have detected des is a constant.  *)
+      PutVarConst (Adr, IsVarConst (Array))
+   END ;
+   (*
+      From now on it must reference the array element by its lvalue
+      - so we create the type of the referenced entity
+   *)
+
+   BackEndType := MakePointer (combinedTok, NulName) ;
+   PutPointer (BackEndType, GetDType (Type)) ;
+   (* PutVar(Adr, BackEndType) ; *)
+   PutLeftValueFrontBackType (Adr, GetDType (Type), BackEndType) ;
+
+   GenQuadO (combinedTok, ArrayOp, Adr, Index, Array, TRUE) ;
+   PopN (2) ;   (* remove all parameters to this procedure *)
+   PushTFDrwtok (Adr, GetSType (Adr), Dim, rw, combinedTok)
+END BuildStaticArray ;
+
+
+(*
+   calculateMultipicand - generates quadruples which calculate the
+                          multiplicand for the array at dimension, dim.
+*)
+
+PROCEDURE calculateMultipicand (tok: CARDINAL;
+                                arraySym, arrayType: CARDINAL; dim: CARDINAL) : CARDINAL ;
+VAR
+   ti, tj, tk, tl: CARDINAL ;
+BEGIN
+   IF dim = GetDimension (arrayType)
+   THEN
+      (* ti has no type since constant *)
+      ti := MakeTemporary (tok, ImmediateValue) ;
+      PutVar(ti, Cardinal) ;
+      GenQuadO (tok, ElementSizeOp, ti, arrayType, 1, TRUE)
+   ELSE
+      INC(dim) ;
+      tk := MakeTemporary (tok, RightValue) ;
+      PutVar(tk, Cardinal) ;
+      GenHigh (tok, tk, dim, arraySym) ;
+      tl := MakeTemporary (tok, RightValue) ;
+      PutVar(tl, Cardinal) ;
+      GenQuadO (tok, AddOp, tl, tk, MakeConstLit (tok, MakeKey ('1'), Cardinal), TRUE) ;
+      tj := calculateMultipicand (tok, arraySym, arrayType, dim) ;
+      ti := MakeTemporary (tok, RightValue) ;
+      PutVar (ti, Cardinal) ;
+      GenQuadO (tok, MultOp, ti, tj, tl, TRUE)
+   END ;
+   RETURN ti
+END calculateMultipicand ;
+
+
+(*
+   BuildDynamicArray - Builds the array referencing for dynamic arrays.
+                       The Stack is expected to contain:
+
+
+                       Entry                          Exit
+                       =====                          ====
+
+               Ptr ->
+                       +-----------------------+
+                       | Index                 |                                    <- Ptr
+                       |-----------------------|      +---------------------------+
+                       | ArraySym | Type | Dim |      | S  | T | ArraySym | Dim+1 |
+                       |-----------------------|      |---------------------------|
+
+
+   if Dim=1
+   then
+      S := base of ArraySym + TSIZE(Type)*Index
+   else
+      S := S + TSIZE(Type)*Index
+   fi
+*)
+
+PROCEDURE BuildDynamicArray ;
+VAR
+   combinedTok,
+   arrayTok,
+   indexTok     : CARDINAL ;
+   Sym, idx,
+   Type, Adr,
+   ArraySym,
+   BackEndType,
+   UnboundedType,
+   PtrToBase,
+   Base,
+   Dim, rw,
+   ti, tj, tk   : CARDINAL ;
+BEGIN
+   DisplayStack ;
+   Sym  := OperandT (2) ;
+   Type := SkipType (OperandF (2)) ;
+   arrayTok := OperandTok (2) ;
+   indexTok := OperandTok (1) ;
+   combinedTok := MakeVirtualTok (arrayTok, arrayTok, indexTok) ;
+   Dim := OperandD (2) ;
+   rw := OperandMergeRW (2) ;
+   Assert (IsLegal (rw)) ;
+   INC (Dim) ;
+   IF Dim = 1
+   THEN
+      (*
+         Base has type address since
+         BuildDesignatorRecord references by address.
+
+         Build a record for retrieving the address of dynamic array.
+         BuildDesignatorRecord will generate the required quadruples,
+         therefore build sets up the stack for BuildDesignatorRecord
+         which will generate the quads to access the record.
+      *)
+      ArraySym := Sym ;
+      UnboundedType := GetUnboundedRecordType (GetSType (Sym)) ;
+      PushTFrwtok (Sym, UnboundedType, rw, arrayTok) ;
+      PushTF (GetUnboundedAddressOffset (GetSType (Sym)),
+              GetSType (GetUnboundedAddressOffset (GetSType (Sym)))) ;
+      PushT (1) ;  (* One record field to dereference *)
+      BuildDesignatorRecord (combinedTok) ;
+      PopT (PtrToBase) ;
+      DisplayStack ;
+      (* Now actually copy Unbounded.ArrayAddress into base *)
+      IF GetMode(PtrToBase) = LeftValue
+      THEN
+         Base := MakeTemporary (arrayTok, RightValue) ;
+         PutVar (Base, Address) ;           (* has type ADDRESS *)
+         CheckPointerThroughNil (arrayTok, PtrToBase) ;
+         GenQuad (IndrXOp, Base, Address, PtrToBase)           (* Base = *PtrToBase *)
+      ELSE
+         Assert (GetMode (PtrToBase) # ImmediateValue) ;
+         Base := PtrToBase
+      END
+   ELSE
+      (* Base already calculated previously and pushed to stack *)
+      UnboundedType := SkipType (OperandF (2)) ;
+      Base := Sym ;
+      ArraySym := OperandA (2)
+   END ;
+   Assert (GetSType (Sym) = Type) ;
+   ti := calculateMultipicand (indexTok, Sym, Type, Dim) ;
+   idx := OperandT (1) ;
+   IF IsConst (idx)
+   THEN
+      (* tj has no type since constant *)
+      tj := MakeTemporary (indexTok, ImmediateValue) ;
+      tk := MakeTemporary (indexTok, ImmediateValue) ;
+      PutVar (tj, Cardinal) ;
+      PutVar (tk, Cardinal)
+   ELSE
+      (* tj has Cardinal type since we have multiplied array indices *)
+      tj := MakeTemporary (indexTok, RightValue) ;
+      IF GetSType (idx) # Cardinal
+      THEN
+         PushTF (RequestSym (indexTok, MakeKey ('CONVERT')), NulSym) ;
+         PushT (Cardinal) ;
+         PushTtok (idx, indexTok) ;
+         PushT(2) ;          (* Two parameters *)
+         BuildConvertFunction ;
+         PopT (idx)
+      END ;
+      PutVar (tj, Cardinal) ;
+      tk := MakeTemporary (indexTok, RightValue) ;
+      PutVar (tk, Cardinal)
+   END ;
+   BuildRange (InitDynamicArraySubscriptRangeCheck (ArraySym, idx, Dim)) ;
+
+   PushTtok (tj, indexTok) ;
+   PushTtok (idx, indexTok) ;
+   BuildAssignmentWithoutBounds (indexTok, FALSE, TRUE) ;
+
+   GenQuad (MultOp, tk, ti, tj) ;
+   Adr := MakeTemporary (combinedTok, LeftValue) ;
+   (*
+      Ok must reference by address
+      - but we contain the type of the referenced entity
+   *)
+   BackEndType := MakePointer (combinedTok, NulName) ;
+   PutPointer (BackEndType, GetSType (Type)) ;
+
+   IF Dim = GetDimension (Type)
+   THEN
+      PutLeftValueFrontBackType (Adr, GetSType(Type), BackEndType) ;
+
+      GenQuad (AddOp, Adr, Base, tk) ;
+      PopN (2) ;
+      PushTFADrwtok (Adr, GetSType(Adr), ArraySym, Dim, rw, combinedTok)
+   ELSE
+      (* more to index *)
+      PutLeftValueFrontBackType (Adr, Type, BackEndType) ;
+
+      GenQuad (AddOp, Adr, Base, tk) ;
+      PopN (2) ;
+      PushTFADrwtok (Adr, GetSType(Adr), ArraySym, Dim, rw, combinedTok)
+   END
+END BuildDynamicArray ;
+
+
+(*
+   BuildDesignatorPointer - Builds a pointer reference.
+                            The Stack is expected to contain:
+
+
+                            Entry                   Exit
+                            =====                   ====
+
+                    Ptr ->                                           <- Ptr
+                            +--------------+        +--------------+
+                            | Sym1  | Type1|        | Sym2  | Type2|
+                            |--------------|        |--------------|
+*)
+
+PROCEDURE BuildDesignatorPointer (ptrtok: CARDINAL) ;
+VAR
+   combinedtok,
+   exprtok    : CARDINAL ;
+   rw,
+   Sym1, Type1,
+   Sym2, Type2: CARDINAL ;
+BEGIN
+   PopTFrwtok (Sym1, Type1, rw, exprtok) ;
+   Type1 := SkipType (Type1) ;
+   IF IsUnknown (Sym1)
+   THEN
+      MetaError1 ('{%1EMad} is undefined and therefore {%1ad}^ cannot be resolved', Sym1)
+   ELSIF IsPointer (Type1)
+   THEN
+      Type2 := GetSType (Type1) ;
+      Sym2 := MakeTemporary (ptrtok, LeftValue) ;
+      (*
+         Ok must reference by address
+         - but we contain the type of the referenced entity
+      *)
+      MarkAsRead (rw) ;
+      PutVarPointerCheck (Sym1, TRUE) ;
+      CheckPointerThroughNil (ptrtok, Sym1) ;
+      IF GetMode (Sym1) = LeftValue
+      THEN
+         rw := NulSym ;
+         PutLeftValueFrontBackType (Sym2, Type2, Type1) ;
+         GenQuad (IndrXOp, Sym2, Type1, Sym1)            (* Sym2 := *Sym1 *)
+      ELSE
+         PutLeftValueFrontBackType (Sym2, Type2, NulSym) ;
+         GenQuad (BecomesOp, Sym2, NulSym, Sym1)         (* Sym2 :=  Sym1 *)
+      END ;
+      PutVarPointerCheck (Sym2, TRUE) ;       (* we should check this for *)
+                                     (* Sym2 later on (pointer via NIL)   *)
+      combinedtok := MakeVirtualTok (exprtok, exprtok, ptrtok) ;
+      PushTFrwtok (Sym2, Type2, rw, combinedtok)
+   ELSE
+      MetaError2 ('{%1ad} is not a pointer type but a {%2d}', Sym1, Type1)
+   END
+END BuildDesignatorPointer ;
+
+
+(*
+   StartBuildWith - performs the with statement.
+                    The Stack:
+
+                    Entry                    Exit
+
+                    +------------+
+                    | Sym | Type |           Empty
+                    |------------|
+*)
+
+PROCEDURE StartBuildWith (withTok: CARDINAL) ;
+VAR
+   tok      : CARDINAL ;
+   Sym, Type,
+   Ref      : CARDINAL ;
+BEGIN
+   DisplayStack ;
+   PopTFtok (Sym, Type, tok) ;
+   Type := SkipType (Type) ;
+
+   Ref := MakeTemporary (tok, LeftValue) ;
+   PutVar (Ref, Type) ;
+   IF GetMode (Sym) = LeftValue
+   THEN
+      (* copy LeftValue *)
+      GenQuadO (tok, BecomesOp, Ref, NulSym, Sym, TRUE)
+   ELSE
+      (* calculate the address of Sym *)
+      GenQuadO (tok, AddrOp, Ref, NulSym, Sym, TRUE)
+   END ;
+
+   PushWith (Sym, Type, Ref, tok) ;
+   IF Type = NulSym
+   THEN
+      MetaError1 ('{%1Ea} {%1d} has a no type, the {%kWITH} statement requires a variable or parameter of a {%kRECORD} type',
+                  Sym)
+   ELSIF NOT IsRecord(Type)
+   THEN
+      MetaError1 ('the {%kWITH} statement requires that {%1Ea} {%1d} be of a {%kRECORD} {%1tsa:type rather than {%1tsa}}',
+		   Sym)
+   END ;
+   StartScope (Type)
+ ; DisplayStack ;
+END StartBuildWith ;
+
+
+(*
+   EndBuildWith - terminates the innermost with scope.
+*)
+
+PROCEDURE EndBuildWith ;
+BEGIN
+   DisplayStack ;
+   EndScope ;
+   PopWith
+ ; DisplayStack ;
+END EndBuildWith ;
+
+
+(*
+   PushWith - pushes sym and type onto the with stack. It checks for
+              previous declaration of this record type.
+*)
+
+PROCEDURE PushWith (Sym, Type, Ref, Tok: CARDINAL) ;
+VAR
+   i, n: CARDINAL ;
+   f   : WithFrame ;
+BEGIN
+   IF Pedantic
+   THEN
+      n := NoOfItemsInStackAddress(WithStack) ;
+      i := 1 ;  (* top of the stack *)
+      WHILE i <= n DO
+         (* Search for other declarations of the with using Type *)
+         f := PeepAddress(WithStack, i) ;
+         IF f^.RecordSym=Type
+         THEN
+            MetaErrorT1 (Tok,
+                         'cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}',
+                         Sym) ;
+            MetaErrorT1 (f^.RecordTokPos,
+                         'cannot have nested {%kWITH} statements referencing the same {%kRECORD} {%1Ead}',
+                         f^.RecordSym)
+         END ;
+         INC (i)
+      END
+   END ;
+   NEW (f) ;
+   WITH f^ DO
+      RecordSym    := Sym ;
+      RecordType   := Type ;
+      RecordRef    := Ref ;
+      rw           := Sym ;
+      RecordTokPos := Tok
+   END ;
+   PushAddress (WithStack, f)
+END PushWith ;
+
+
+PROCEDURE PopWith ;
+VAR
+   f: WithFrame ;
+BEGIN
+   f := PopAddress (WithStack) ;
+   DISPOSE (f)
+END PopWith ;
+
+
+(*
+   CheckWithReference - performs the with statement.
+                        The Stack:
+
+                        Entry                    Exit
+
+                        +------------+           +------------+
+                        | Sym | Type |           | Sym | Type |
+                        |------------|           |------------|
+*)
+
+PROCEDURE CheckWithReference ;
+VAR
+   f        : WithFrame ;
+   tokpos,
+   i, n, rw,
+   Sym, Type: CARDINAL ;
+BEGIN
+   n := NoOfItemsInStackAddress(WithStack) ;
+   IF (n>0) AND (NOT SuppressWith)
+   THEN
+      PopTFrwtok (Sym, Type, rw, tokpos) ;
+      Assert (tokpos # UnknownTokenNo) ;
+      (* inner WITH always has precidence *)
+      i := 1 ;  (* top of stack *)
+      WHILE i<=n DO
+         (* WriteString('Checking for a with') ; *)
+         f := PeepAddress (WithStack, i) ;
+         WITH f^ DO
+            IF IsRecordField (Sym) AND (GetRecord (GetParent (Sym)) = RecordType)
+            THEN
+               IF IsUnused (Sym)
+               THEN
+                  MetaError1('record field {%1Dad} was declared as unused by a pragma', Sym)
+               END ;
+               (* Fake a RecordSym.op *)
+               PushTFrwtok (RecordRef, RecordType, rw, RecordTokPos) ;
+               PushTFtok (Sym, Type, tokpos) ;
+               BuildAccessWithField ;
+               PopTFrw (Sym, Type, rw) ;
+               i := n+1  (* Finish loop.  *)
+            ELSE
+               INC (i)
+            END
+         END
+      END ;
+      PushTFrwtok (Sym, Type, rw, tokpos)
+   END
+END CheckWithReference ;
+
+
+(*
+   BuildAccessWithField - similar to BuildDesignatorRecord except it
+                          does not perform the address operation.
+                          The address will have been computed at the
+                          beginning of the WITH statement.
+                          It also stops the GenQuad procedure from examining the
+                          with stack.
+
+                          The Stack
+
+                          Entry
+
+                   Ptr ->
+                          +--------------+
+                          | Field | Type1|                          <- Ptr
+                          |-------|------|          +-------------+
+                          | Adr   | Type2|          | Sym  | Type1|
+                          |--------------|          |-------------|
+*)
+
+PROCEDURE BuildAccessWithField ;
+VAR
+   rectok, fieldtok  : CARDINAL ;
+   OldSuppressWith   : BOOLEAN ;
+   rw,
+   Field, FieldType,
+   Record, RecordType,
+   Ref               : CARDINAL ;
+BEGIN
+   OldSuppressWith := SuppressWith ;
+   SuppressWith := TRUE ;
+   (*
+      now the WITH cannot look at the stack of outstanding WITH records.
+   *)
+   PopTFtok (Field, FieldType, fieldtok) ;
+   PopTFrwtok (Record, RecordType, rw, rectok) ;
+
+   Ref := MakeComponentRef (MakeComponentRecord (fieldtok,
+                                                 RightValue, Record), Field) ;
+   PutVarConst (Ref, IsReadOnly (Record)) ;
+   GenQuadO (fieldtok,
+             RecordFieldOp, Ref, Record, Field, TRUE) ;
+
+   PushTFrwtok (Ref, FieldType, rw, fieldtok) ;
+   SuppressWith := OldSuppressWith
+END BuildAccessWithField ;
+
+
+(*
+   BuildNulExpression - Builds a nul expression on the stack.
+                        The Stack:
+
+                        Entry             Exit
+
+                                                         <- Ptr
+                        Empty             +------------+
+                                          | NulSym     |
+                                          |------------|
+*)
+
+PROCEDURE BuildNulExpression ;
+BEGIN
+   PushT(NulSym)
+END BuildNulExpression ;
+
+
+(*
+   BuildTypeForConstructor - pushes the type implied by the current constructor.
+                             If no constructor is currently being built then
+                             it Pushes a Bitset type.
+*)
+
+PROCEDURE BuildTypeForConstructor ;
+VAR
+   c: ConstructorFrame ;
+BEGIN
+   IF NoOfItemsInStackAddress(ConstructorStack)=0
+   THEN
+      PushT(Bitset)
+   ELSE
+      c := PeepAddress(ConstructorStack, 1) ;
+      WITH c^ DO
+         IF IsArray(type) OR IsSet(type)
+         THEN
+            PushT(GetSType(type))
+         ELSIF IsRecord(type)
+         THEN
+            PushT(GetSType(GetNth(type, index)))
+         ELSE
+            MetaError1('{%1ad} is not a set, record or array type which is expected when constructing an aggregate entity',
+                       type)
+         END
+      END
+   END
+END BuildTypeForConstructor ;
+
+
+(*
+   BuildSetStart - Pushes a Bitset type on the stack.
+
+                      The Stack:
+
+                      Entry             Exit
+
+               Ptr ->                                        <- Ptr
+
+                      Empty             +--------------+
+                                        | Bitset       |
+                                        |--------------|
+*)
+
+PROCEDURE BuildSetStart ;
+BEGIN
+   PushT(Bitset)
+END BuildSetStart ;
+
+
+(*
+   BuildSetEnd - pops the set value and type from the stack
+                 and pushes the value,type pair.
+
+                    Entry                   Exit
+
+             Ptr ->
+                    +--------------+
+                    | Set Value    |                         <- Ptr
+                    |--------------|        +--------------+
+                    | Set Type     |        | Value | Type |
+                    |--------------|        |--------------|
+*)
+
+PROCEDURE BuildSetEnd ;
+VAR
+   v, t: CARDINAL ;
+BEGIN
+   PopT(v) ;
+   PopT(t) ;
+   PushTF(v, t) ;
+   Assert(IsSet(t))
+END BuildSetEnd ;
+
+
+(*
+   BuildEmptySet - Builds an empty set on the stack.
+                   The Stack:
+
+                   Entry             Exit
+
+                                                     <- Ptr
+                                     +-------------+
+            Ptr ->                   | Value       |
+                   +-----------+     |-------------|
+      	       	   | SetType   |     | SetType     |
+                   |-----------|     |-------------|
+
+*)
+
+PROCEDURE BuildEmptySet ;
+VAR
+   n     : Name ;
+   Type  : CARDINAL ;
+   NulSet: CARDINAL ;
+   tok   : CARDINAL ;
+BEGIN
+   PopT(Type) ;  (* type of set we are building *)
+   tok := GetTokenNo () ;
+   IF (Type=NulSym) AND Pim
+   THEN
+      (* allowed generic {} in PIM Modula-2 *)
+   ELSIF IsUnknown(Type)
+   THEN
+      n := GetSymName(Type) ;
+      WriteFormat1('set type %a is undefined', n) ;
+      Type := Bitset
+   ELSIF NOT IsSet(SkipType(Type))
+   THEN
+      n := GetSymName(Type) ;
+      WriteFormat1('expecting a set type %a', n) ;
+      Type := Bitset
+   ELSE
+      Type := SkipType(Type) ;
+      Assert((Type#NulSym))
+   END ;
+   NulSet := MakeTemporary(tok, ImmediateValue) ;
+   PutVar(NulSet, Type) ;
+   PutConstSet(NulSet) ;
+   IF CompilerDebugging
+   THEN
+      n := GetSymName(Type) ;
+      printf1('set type = %a\n', n)
+   END ;
+   PushNulSet(Type) ;   (* onto the ALU stack  *)
+   PopValue(NulSet) ;   (* ALU -> symbol table *)
+
+   (* and now construct the M2Quads stack as defined by the comments above *)
+   PushT(Type) ;
+   PushT(NulSet) ;
+   IF CompilerDebugging
+   THEN
+      n := GetSymName(Type) ;
+      printf2('Type = %a  (%d)  built empty set\n', n, Type) ;
+      DisplayStack    (* Debugging info *)
+   END
+END BuildEmptySet ;
+
+
+(*
+   BuildInclRange - includes a set range with a set.
+
+
+                          Entry                   Exit
+                          =====                   ====
+
+
+                   Ptr ->
+                          +------------+
+                          | El2        |
+                          |------------|
+                          | El1        |                                 <- Ptr
+                          |------------|           +-------------------+
+                          | Set Value  |           | Value + {El1..El2}|
+                          |------------|           |-------------------|
+
+                   No quadruples produced as the range info is contained within
+                   the set value.
+*)
+
+PROCEDURE BuildInclRange ;
+VAR
+   n       : Name ;
+   el1, el2,
+   value   : CARDINAL ;
+BEGIN
+   PopT(el2) ;
+   PopT(el1) ;
+   PopT(value) ;
+   IF NOT IsConstSet(value)
+   THEN
+      n := GetSymName(el1) ;
+      WriteFormat1('can only add bit ranges to a constant set, %a is not a constant set', n)
+   END ;
+   IF IsConst(el1) AND IsConst(el2)
+   THEN
+      PushValue(value) ;  (* onto ALU stack *)
+      AddBitRange(GetTokenNo(), el1, el2) ;
+      PopValue(value)     (* ALU -> symboltable *)
+   ELSE
+      IF NOT IsConst(el1)
+      THEN
+         n := GetSymName(el1) ;
+         WriteFormat1('must use constants as ranges when defining a set constant, problem with the low value %a', n)
+      END ;
+      IF NOT IsConst(el2)
+      THEN
+         n := GetSymName(el2) ;
+         WriteFormat1('must use constants as ranges when defining a set constant, problem with the high value %a', n)
+      END
+   END ;
+   PushT(value)
+END BuildInclRange ;
+
+
+(*
+   BuildInclBit - includes a bit into the set.
+
+                         Entry                   Exit
+                         =====                   ====
+
+
+                  Ptr ->
+                         +------------+
+                         | Element    |                         <- Ptr
+                         |------------|          +------------+
+                         | Value      |          | Value      |
+                         |------------|          |------------|
+
+*)
+
+PROCEDURE BuildInclBit ;
+VAR
+   tok         : CARDINAL ;
+   el, value, t: CARDINAL ;
+BEGIN
+   PopT(el) ;
+   PopT(value) ;
+   tok := GetTokenNo () ;
+   IF IsConst(el)
+   THEN
+      PushValue(value) ;  (* onto ALU stack *)
+      AddBit(tok, el) ;
+      PopValue(value)    (* ALU -> symboltable *)
+   ELSE
+      IF GetMode(el)=LeftValue
+      THEN
+         t := MakeTemporary(tok, RightValue) ;
+         PutVar(t, GetSType(el)) ;
+         CheckPointerThroughNil (tok, el) ;
+         doIndrX(tok, t, el) ;
+         el := t
+      END ;
+      IF IsConst(value)
+      THEN
+         (* move constant into a variable to achieve the include *)
+         t := MakeTemporary(tok, RightValue) ;
+         PutVar(t, GetSType(value)) ;
+         GenQuad(BecomesOp, t, NulSym, value) ;
+         value := t
+      END ;
+      GenQuad(InclOp, value, NulSym, el)
+   END ;
+   PushT(value)
+END BuildInclBit ;
+
+
+(*
+   PushConstructor -
+*)
+
+PROCEDURE PushConstructor (sym: CARDINAL) ;
+VAR
+   c: ConstructorFrame ;
+BEGIN
+   NEW(c) ;
+   WITH c^ DO
+      type := SkipType(sym) ;
+      index := 1
+   END ;
+   PushAddress(ConstructorStack, c)
+END PushConstructor ;
+
+
+(*
+   PopConstructor - removes the top constructor from the top of stack.
+*)
+
+PROCEDURE PopConstructor ;
+VAR
+   c: ConstructorFrame ;
+BEGIN
+   c := PopAddress (ConstructorStack) ;
+   DISPOSE(c)
+END PopConstructor ;
+
+
+(*
+   NextConstructorField - increments the top of constructor stacks index by one.
+*)
+
+PROCEDURE NextConstructorField ;
+VAR
+   c: ConstructorFrame ;
+BEGIN
+   c := PeepAddress(ConstructorStack, 1) ;
+   INC(c^.index)
+END NextConstructorField ;
+
+
+(*
+   SilentBuildConstructor - places NulSym into the constructor fifo queue.
+*)
+
+PROCEDURE SilentBuildConstructor ;
+BEGIN
+   PutConstructorIntoFifoQueue (NulSym)
+END SilentBuildConstructor ;
+
+
+(*
+   BuildConstructor - builds a constructor.
+                      Stack
+
+                      Entry                 Exit
+
+               Ptr ->
+                      +------------+
+                      | Type       |                <- Ptr
+                      |------------+
+*)
+
+PROCEDURE BuildConstructor (tokcbrpos: CARDINAL) ;
+VAR
+   tok       : CARDINAL ;
+   constValue,
+   type      : CARDINAL ;
+BEGIN
+   PopTtok (type, tok) ;
+   constValue := MakeTemporary (tok, ImmediateValue) ;
+   PutVar (constValue, type) ;
+   PutConstructor (constValue) ;
+   PushValue (constValue) ;
+   IF type = NulSym
+   THEN
+      MetaErrorT0 (tokcbrpos,
+                   '{%E}constructor requires a type before the opening {')
+   ELSE
+      ChangeToConstructor (tok, type) ;
+      PutConstructorFrom (constValue, type) ;
+      PopValue (constValue) ;
+      PutConstructorIntoFifoQueue (constValue)
+   END ;
+   PushConstructor (type)
+END BuildConstructor ;
+
+
+(*
+   SilentBuildConstructorStart - removes an entry from the constructor fifo queue.
+*)
+
+PROCEDURE SilentBuildConstructorStart ;
+VAR
+   constValue: CARDINAL ;
+BEGIN
+   GetConstructorFromFifoQueue (constValue)
+END SilentBuildConstructorStart ;
+
+
+(*
+   BuildConstructorStart - builds a constructor.
+                           Stack
+
+                           Entry                 Exit
+
+                    Ptr ->                                          <- Ptr
+                           +------------+        +----------------+
+                           | Type       |        | ConstructorSym |
+                           |------------+        |----------------|
+*)
+
+PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
+VAR
+   constValue,
+   type      : CARDINAL ;
+BEGIN
+   PopT (type) ;   (* we ignore the type as we already have the constructor symbol from pass C *)
+   GetConstructorFromFifoQueue (constValue) ;
+   Assert (type = GetSType (constValue)) ;
+   PushTtok (constValue, cbratokpos) ;
+   PushConstructor (type)
+END BuildConstructorStart ;
+
+
+(*
+   BuildConstructorEnd - removes the current constructor frame from the
+                         constructor stack (it does not effect the quad
+                         stack)
+
+                         Entry                 Exit
+
+                  Ptr ->                                      <- Ptr
+                         +------------+        +------------+
+                         | const      |        | const      |
+                         |------------|        |------------|
+*)
+
+PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
+VAR
+   typetok,
+   value, valtok: CARDINAL ;
+BEGIN
+   PopTtok (value, valtok) ;
+   IF IsBoolean (1)
+   THEN
+      typetok := valtok
+   ELSE
+      typetok := OperandTtok (1)
+   END ;
+   valtok := MakeVirtualTok (typetok, typetok, cbratokpos) ;
+   PutDeclared (valtok, value) ;
+   PushTtok (value, valtok) ;   (* Use valtok as we now know it was a constructor.  *)
+   PopConstructor
+   (* ; ErrorStringAt (Mark (InitString ('aggregate constant')), valtok) *)
+END BuildConstructorEnd ;
+
+
+(*
+   AddFieldTo - adds field, e, to, value.
+*)
+
+PROCEDURE AddFieldTo (value, e: CARDINAL) : CARDINAL ;
+BEGIN
+   IF IsSet(GetDType(value))
+   THEN
+      PutConstSet(value) ;
+      PushT(value) ;
+      PushT(e) ;
+      BuildInclBit ;
+      PopT(value)
+   ELSE
+      PushValue(value) ;
+      AddField(GetTokenNo(), e) ;
+      PopValue(value)
+   END ;
+   RETURN( value )
+END AddFieldTo ;
+
+
+(*
+   BuildComponentValue -  builds a component value.
+
+                          Entry                 Exit
+
+                   Ptr ->                                      <- Ptr
+
+
+                          +------------+        +------------+
+                          | const      |        | const      |
+                          |------------|        |------------|
+*)
+
+PROCEDURE BuildComponentValue ;
+VAR
+   const,
+   e1, e2   : CARDINAL ;
+   nuldotdot,
+   nulby    : Name ;
+BEGIN
+   PopT(nulby) ;
+   IF nulby=NulTok
+   THEN
+      PopT(nuldotdot) ;
+      IF nuldotdot=NulTok
+      THEN
+         PopT(e1) ;
+         PopT(const) ;
+         PushT(AddFieldTo(const, e1))
+      ELSE
+         PopT(e2) ;
+         PopT(e1) ;
+         PopT(const) ;
+         PushValue(const) ;
+         AddBitRange(GetTokenNo(), e1, e2) ;
+         PopValue(const) ;
+         PushT(const)
+      END
+   ELSE
+      PopT(e1) ;
+      PopT(nuldotdot) ;
+      IF nuldotdot=NulTok
+      THEN
+         PopT(e2) ;
+         PopT(const) ;
+         PushValue(const) ;
+         AddElements(GetTokenNo(), e2, e1) ;
+         PopValue(const) ;
+         PushT(const)
+      ELSE
+         PopT(e2) ;
+         PopT(e1) ;
+         PopT(const) ;
+         WriteFormat0('the constant must be an array constructor or a set constructor but not both') ;
+         PushT(const)
+      END
+   END
+END BuildComponentValue ;
+
+
+(*
+   RecordOp - Records the operator passed on the stack.
+              Checks for AND operator or OR operator
+              if either of these operators are found then BackPatching
+              takes place.
+              The Expected Stack:
+
+              Entry                        Exit
+
+       Ptr ->                                               <- Ptr
+              +-------------+               +-------------+
+              | OperatorTok |               | OperatorTok |
+              |-------------|               |-------------|
+              | t    | f    |               | t    | f    |
+              |-------------|               |-------------|
+
+
+              If OperatorTok=AndTok
+              Then
+                 BackPatch(f, NextQuad)
+              Elsif OperatorTok=OrTok
+              Then
+                 BackPatch(t, NextQuad)
+              End
+*)
+
+PROCEDURE RecordOp ;
+VAR
+   Op   : Name ;
+   tokno: CARDINAL ;
+   t, f : CARDINAL ;
+BEGIN
+   PopTtok(Op, tokno) ;
+   IF (Op=AndTok) OR (Op=AmbersandTok)
+   THEN
+      CheckBooleanId ;
+      PopBool(t, f) ;
+      BackPatch(t, NextQuad) ;
+      PushBool(0, f)
+   ELSIF Op=OrTok
+   THEN
+      CheckBooleanId ;
+      PopBool(t, f) ;
+      BackPatch(f, NextQuad) ;
+      PushBool(t, 0)
+   END ;
+   PushTtok(Op, tokno)
+END RecordOp ;
+
+
+(*
+   CheckLogicalOperator - returns a logical operator if the operands imply
+                          a logical operation should be performed.
+*)
+
+PROCEDURE CheckLogicalOperator (Tok: Name; left, lefttype: CARDINAL) : Name ;
+BEGIN
+   IF (Tok=PlusTok) OR (Tok=TimesTok) OR (Tok=DivideTok) OR (Tok=MinusTok)
+   THEN
+      (* --fixme-- when we add complex arithmetic, we must check constructor is not a complex constant.  *)
+      IF ((lefttype#NulSym) AND IsSet(SkipType(lefttype))) OR
+         IsConstSet(left) OR IsConstructor(left)
+      THEN
+         IF Tok=PlusTok
+         THEN
+            RETURN( LogicalOrTok )
+         ELSIF Tok=DivideTok
+         THEN
+            RETURN( LogicalXorTok )
+         ELSIF Tok=TimesTok
+         THEN
+            RETURN( LogicalAndTok )
+         ELSIF Tok=MinusTok
+         THEN
+            RETURN( LogicalDifferenceTok )
+         END
+      END
+   END ;
+   RETURN( Tok )
+END CheckLogicalOperator ;
+
+
+(*
+   doCheckGenericNulSet - checks to see whether e1 is a generic nul set and if so it alters it
+                          to the nul set of t2.
+*)
+
+(*
+PROCEDURE doCheckGenericNulSet (e1: CARDINAL; VAR t1: CARDINAL; t2: CARDINAL) ;
+BEGIN
+   IF IsConstSet (e1)
+   THEN
+      IF NOT IsSet (t2)
+      THEN
+         MetaError2 ('incompatibility between a set constant {%1Ea} of type {%1tsa} and an object of type {%2sa}',
+                     e1, t2)
+      END ;
+      PushValue (e1) ;
+      IF IsGenericNulSet ()
+      THEN
+         PopValue (e1) ;
+         PushNulSet (t2) ;
+         t1 := t2
+      END ;
+      PopValue (e1)
+   END
+END doCheckGenericNulSet ;
+*)
+
+
+(*
+   CheckGenericNulSet - if e1 or e2 is the generic nul set then
+                        alter it to the nul set of the other operands type.
+*)
+
+(*
+PROCEDURE CheckGenericNulSet (e1, e2: CARDINAL; VAR t1, t2: CARDINAL) ;
+BEGIN
+   IF t1#t2
+   THEN
+      doCheckGenericNulSet(e1, t1, t2) ;
+      doCheckGenericNulSet(e2, t2, t1)
+   END
+END CheckGenericNulSet ;
+*)
+
+
+(*
+   CheckDivModRem - initiates calls to check the divisor for DIV, MOD, REM
+                    expressions.
+*)
+
+PROCEDURE CheckDivModRem (TokPos: CARDINAL; tok: Name; d, e: CARDINAL) ;
+BEGIN
+   IF tok=DivTok
+   THEN
+      BuildRange (InitWholeZeroDivisionCheck (TokPos, d, e))
+   ELSIF tok=ModTok
+   THEN
+      BuildRange (InitWholeZeroDivisionCheck (TokPos, d, e))
+   ELSIF tok=RemTok
+   THEN
+      BuildRange (InitWholeZeroRemainderCheck (TokPos, d, e))
+   END
+END CheckDivModRem ;
+
+
+(*
+   doConvert - convert, sym, to a new symbol with, type.
+               Return the new symbol.
+*)
+
+PROCEDURE doConvert (type: CARDINAL; sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF GetSType(sym)#type
+   THEN
+      PushTF(Convert, NulSym) ;
+      PushT(type) ;
+      PushT(sym) ;
+      PushT(2) ;          (* Two parameters *)
+      BuildConvertFunction ;
+      PopT(sym)
+   END ;
+   RETURN( sym )
+END doConvert ;
+
+
+(*
+   BuildBinaryOp   - Builds a binary operation from the quad stack.
+                     Be aware that this procedure will check for
+                     the overloading of the bitset operators + - \ *.
+                     So do NOT call this procedure if you are building
+                     a reference to an array which has a bitset type or
+                     the address arithmetic will be wrongly coersed into
+                     logical ORs.
+
+                     The Stack is expected to contain:
+
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | Sym1       |
+                     |------------|
+                     | Operator   |                          <- Ptr
+                     |------------|          +------------+
+                     | Sym2       |          | Temporary  |
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     Operator  Temporary  Sym1  Sym2
+
+
+                OR
+
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | T1   | F1  |
+                     |------------|
+                     | OrTok      |                          <- Ptr
+                     |------------|          +------------+
+                     | T2   | F2  |          | T1+T2| F1  |
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+*)
+
+PROCEDURE BuildBinaryOp ;
+BEGIN
+   doBuildBinaryOp (TRUE, TRUE)
+END BuildBinaryOp ;
+
+
+(*
+   doBuildBinaryOp - build the binary op, with or without type
+                     checking.
+*)
+
+PROCEDURE doBuildBinaryOp (checkTypes, checkOverflow: BOOLEAN) ;
+VAR
+   s                  : String ;
+   NewOp,
+   Operator           : Name ;
+   OperatorPos,
+   OldPos,
+   leftrw, rightrw,
+   t1, f1,
+   t2, f2,
+   lefttype, righttype,
+   left, right,
+   leftpos, rightpos  : CARDINAL ;
+   value              : CARDINAL ;
+BEGIN
+   Operator := OperandT(2) ;
+   IF Operator = OrTok
+   THEN
+      CheckBooleanId ;
+      PopBool (t1, f1) ;
+      PopTtok (Operator, OperatorPos) ;
+      PopBool (t2, f2) ;
+      Assert (f2=0) ;
+      PushBool (Merge (t1, t2), f1)
+   ELSIF (Operator = AndTok) OR (Operator = AmbersandTok)
+   THEN
+      CheckBooleanId ;
+      PopBool (t1, f1) ;
+      PopTtok (Operator, OperatorPos) ;
+      PopBool (t2, f2) ;
+      Assert (t2=0) ;
+      PushBool (t1, Merge (f1, f2))
+   ELSE
+      PopTFrwtok (right, righttype, rightrw, rightpos) ;
+      PopTtok (Operator, OperatorPos) ;
+      PopTFrwtok (left, lefttype, leftrw, leftpos) ;
+      MarkAsRead (rightrw) ;
+      MarkAsRead (leftrw) ;
+      NewOp := CheckLogicalOperator (Operator, (* right, righttype, *) left, lefttype) ;
+      IF NewOp = Operator
+      THEN
+         (*
+            BinaryOps and UnaryOps only work with immediate and
+            offset addressing.  This is fine for calculating
+            array and record offsets but we need to get the real
+            values to perform normal arithmetic. Not address
+            arithmetic.
+
+            However the set operators will dereference LValues
+            (to optimize large set arithemetic)
+         *)
+         IF GetMode (right) = LeftValue
+         THEN
+            value := MakeTemporary (rightpos, RightValue) ;
+            PutVar (value, righttype) ;
+            CheckPointerThroughNil (rightpos, right) ;
+            doIndrX (rightpos, value, right) ;
+            right := value
+         END ;
+         IF GetMode (left) = LeftValue
+         THEN
+            value := MakeTemporary (leftpos, RightValue) ;
+            PutVar (value, lefttype) ;
+            CheckPointerThroughNil (leftpos, left) ;
+            doIndrX (leftpos, value, left) ;
+            left := value
+         END
+      ELSE
+         (* CheckForGenericNulSet(e1, e2, t1, t2) *)
+      END ;
+      IF (Operator = PlusTok) AND IsConstString(left) AND IsConstString(right)
+      THEN
+         (* handle special addition for constant strings *)
+         s := InitStringCharStar (KeyToCharStar (GetString (left))) ;
+         s := ConCat (s, Mark (InitStringCharStar (KeyToCharStar (GetString (right))))) ;
+         value := MakeConstLitString (OperatorPos, makekey (string (s))) ;
+         s := KillString (s)
+      ELSE
+         OldPos := OperatorPos ;
+         OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
+         IF checkTypes
+         THEN
+            BuildRange (InitTypesExpressionCheck (OperatorPos, left, right, FALSE, FALSE))
+         END ;
+         value := MakeTemporaryFromExpressions (OperatorPos,
+                                                right, left,
+                                                AreConstant (IsConst (left) AND IsConst (right))) ;
+
+         CheckDivModRem (OperatorPos, NewOp, value, right) ;
+
+         IF DebugTokPos
+         THEN
+            s := InitStringCharStar (KeyToCharStar (GetTokenName (Operator))) ;
+            WarnStringAt (s, OldPos) ;
+            s := InitString ('left') ;
+            WarnStringAt (s, leftpos) ;
+            s := InitString ('right') ;
+            WarnStringAt (s, rightpos) ;
+            s := InitString ('caret') ;
+            WarnStringAt (s, OldPos) ;
+            s := InitString ('combined') ;
+            WarnStringAt (s, OperatorPos) ;
+            (* MetaErrorT1 (GetDeclaredMod (t), 'in binary with a {%1a}', t) *)
+         END ;
+         GenQuadOtok (OperatorPos, MakeOp (NewOp), value, left, right, checkOverflow,
+                      OperatorPos, leftpos, rightpos)
+      END ;
+      PushTFtok (value, GetSType (value), OperatorPos)
+   END
+END doBuildBinaryOp ;
+
+
+(*
+   BuildUnaryOp   - Builds a unary operation from the quad stack.
+                    The Stack is expected to contain:
+
+
+                    Entry                   Exit
+                    =====                   ====
+
+             Ptr ->
+                    +------------+
+                    | Sym        |
+                    |------------|          +------------+
+                    | Operator   |          | Temporary  | <- Ptr
+                    |------------|          |------------|
+
+
+                    Quadruples Produced
+
+                    q     Operator  Temporary  _ Sym
+
+*)
+
+PROCEDURE BuildUnaryOp ;
+VAR
+   sympos,
+   tokpos    : CARDINAL ;
+   Tok       : Name ;
+   type,
+   Sym,
+   SymT, r, t: CARDINAL ;
+BEGIN
+   PopTrwtok (Sym, r, sympos) ;
+   PopTtok (Tok, tokpos) ;
+   IF Tok=MinusTok
+   THEN
+      MarkAsRead(r) ;
+      type := NegateType (GetSType (Sym) (* , sympos *) ) ;
+      tokpos := MakeVirtualTok (tokpos, tokpos, sympos) ;
+
+      t := MakeTemporary (tokpos, AreConstant(IsConst(Sym))) ;
+      PutVar(t, type) ;
+
+      (*
+         variables must have a type and REAL/LONGREAL constants must
+         be typed
+      *)
+
+      IF NOT IsConst(Sym)
+      THEN
+         IF (type#NulSym) AND IsSet(SkipType(type))
+         THEN
+            (* do not dereference set variables *)
+         ELSIF GetMode(Sym)=LeftValue
+         THEN
+            (* dereference symbols which are not sets and which are variables *)
+
+            SymT := MakeTemporary (sympos, RightValue) ;
+            PutVar (SymT, GetSType (Sym)) ;
+            CheckPointerThroughNil (sympos, Sym) ;
+            doIndrX (sympos, SymT, Sym) ;
+            Sym := SymT
+         END
+      END ;
+      GenQuadO (tokpos, NegateOp, t, NulSym, Sym, TRUE) ;
+      PushTtok (t, tokpos)
+   ELSIF Tok=PlusTok
+   THEN
+      tokpos := MakeVirtualTok (tokpos, tokpos, sympos) ;
+      PushTrwtok (Sym, r, tokpos)
+   ELSE
+      MetaErrorNT1 (tokpos,
+                    'expecting an unary operator, seen {%Ek%a}', Tok)
+   END
+END BuildUnaryOp ;
+
+
+(*
+   AreConstant - returns immediate addressing mode if b is true else
+                 offset mode is returned. b determines whether the
+                 operands are all constant - in which case we can use
+                 a constant temporary variable.
+*)
+
+PROCEDURE AreConstant (b: BOOLEAN) : ModeOfAddr ;
+BEGIN
+   IF b
+   THEN
+      RETURN ImmediateValue
+   ELSE
+      RETURN RightValue
+   END
+END AreConstant ;
+
+
+(*
+   ConvertBooleanToVariable - converts a BoolStack(i) from a Boolean True|False
+                              exit pair into a variable containing the value TRUE or
+                              FALSE. The parameter, i, is relative to the top
+                              of the stack.
+*)
+
+PROCEDURE ConvertBooleanToVariable (tok: CARDINAL; i: CARDINAL) ;
+VAR
+   Des: CARDINAL ;
+   f  : BoolFrame ;
+BEGIN
+   Assert (IsBoolean (i)) ;
+   (*
+      need to convert it to a variable containing the result.
+      Des will be a boolean type
+   *)
+   Des := MakeTemporary (tok, RightValue) ;
+   PutVar (Des, Boolean) ;
+   PushTtok (Des, tok) ;   (* we have just increased the stack so we must use i+1 *)
+   f := PeepAddress (BoolStack, i+1) ;
+   PushBool (f^.TrueExit, f^.FalseExit) ;
+   BuildAssignmentWithoutBounds (tok, FALSE, TRUE) ;  (* restored stack *)
+   f := PeepAddress (BoolStack, i) ;
+   WITH f^ DO
+      TrueExit := Des ;  (* alter Stack(i) to contain the variable *)
+      FalseExit := Boolean ;
+      BooleanOp := FALSE ; (* no longer a Boolean True|False pair    *)
+      Unbounded := NulSym ;
+      Dimension := 0 ;
+      ReadWrite := NulSym ;
+      tokenno := tok ;
+      Annotation := KillString (Annotation) ;
+      Annotation := InitString ('%1s(%1d)|%2s(%2d)||boolean var|type')
+   END
+END ConvertBooleanToVariable ;
+
+
+(*
+   BuildBooleanVariable - tests to see whether top of stack is a boolean
+                          conditional and if so it converts it into a boolean
+                          variable.
+*)
+
+PROCEDURE BuildBooleanVariable ;
+BEGIN
+   IF IsBoolean (1)
+   THEN
+      ConvertBooleanToVariable (OperandTtok (1), 1)
+   END
+END BuildBooleanVariable ;
+
+
+(*
+   BuildRelOpFromBoolean - builds a relational operator sequence of quadruples
+                           instead of using a temporary boolean variable.
+                           This function can only be used when we perform
+                           the following translation:
+
+                           (a=b) # (c=d)  alternatively   (a=b) = (c=d)
+                                 ^                              ^
+
+                           it only allows # = to be used as >= <= > < all
+                           assume a particular value for TRUE and FALSE.
+                           (In which case the user should specify ORD)
+
+
+                           before
+
+                           q    if r1      op1     op2     t2
+                           q+1  Goto                       f2
+                           q+2  if r2      op3     op4     t1
+                           q+3  Goto                       f1
+
+                           after (in case of =)
+
+                           q    if r1      op1     op2     q+2
+                           q+1  Goto                       q+4
+                           q+2  if r2      op3     op4     t
+                           q+3  Goto                       f
+                           q+4  if r2      op3     op4     f
+                           q+5  Goto                       t
+
+                           after (in case of #)
+
+                           q    if r1      op1     op2     q+2
+                           q+1  Goto                       q+4
+                           q+2  if r2      op3     op4     f
+                           q+3  Goto                       t
+                           q+4  if r2      op3     op4     t
+                           q+5  Goto                       f
+
+                           The Stack is expected to contain:
+
+
+                           Entry                   Exit
+                           =====                   ====
+
+                    Ptr ->
+                           +------------+
+                           | t1 | f1    |
+                           |------------|
+                           | Operator   |                          <- Ptr
+                           |------------|          +------------+
+                           | t2 | f2    |          | t    | f   |
+                           |------------|          |------------|
+
+
+*)
+
+PROCEDURE BuildRelOpFromBoolean (tokpos: CARDINAL) ;
+VAR
+   Tok,
+   t1, f1,
+   t2, f2: CARDINAL ;
+   f     : QuadFrame ;
+BEGIN
+   Assert (IsBoolean (1) AND IsBoolean (3)) ;
+   IF OperandT (2) = EqualTok
+   THEN
+      (* are the two boolean expressions the same? *)
+      PopBool (t1, f1) ;
+      PopT (Tok) ;
+      PopBool (t2, f2) ;
+      (* give the false exit a second chance *)
+      BackPatch (t2, t1) ;        (* q    if   _     _    q+2 *)
+      BackPatch (f2, NextQuad) ;  (* q+1  if   _     _    q+4 *)
+      Assert (NextQuad = f1+1) ;
+      f := GetQF (t1) ;
+      WITH f^ DO
+         GenQuadO (tokpos, Operator, Operand1, Operand2, 0, FALSE)
+      END ;
+      GenQuadO (tokpos, GotoOp, NulSym, NulSym, 0, FALSE) ;
+      PushBool (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1))
+   ELSIF (OperandT (2) = HashTok) OR (OperandT (2) = LessGreaterTok)
+   THEN
+      (* are the two boolean expressions the different? *)
+      PopBool (t1, f1) ;
+      PopT (Tok) ;
+      PopBool (t2, f2) ;
+      (* give the false exit a second chance *)
+      BackPatch (t2, t1) ;        (* q    if   _     _    q+2 *)
+      BackPatch (f2, NextQuad) ;  (* q+1  if   _     _    q+4 *)
+      Assert (NextQuad = f1+1) ;
+      f := GetQF (t1) ;
+      WITH f^ DO
+         GenQuadO (tokpos, Operator, Operand1, Operand2, 0, FALSE)
+      END ;
+      GenQuadO (tokpos, GotoOp, NulSym, NulSym, 0, FALSE) ;
+      PushBool (Merge (NextQuad-2, f1), Merge (NextQuad-1, t1))
+   ELSE
+      MetaError0 ('only allowed to use the relation operators {%Ek=} {%Ek#} rather than {%Ek<} or {%Ek>} on {%EkBOOLEAN} expressions as these do not imply an ordinal value for {%kTRUE} or {%kFALSE}')
+   END
+END BuildRelOpFromBoolean ;
+
+
+(*
+   CheckVariableOrConstantOrProcedure - checks to make sure sym is a variable, constant or procedure.
+*)
+
+PROCEDURE CheckVariableOrConstantOrProcedure (tokpos: CARDINAL; sym: CARDINAL) ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   type := GetSType (sym) ;
+   IF IsUnknown (sym)
+   THEN
+      MetaErrorT1 (tokpos, '{%1EUad} has not been declared', sym) ;
+      UnknownReported (sym)
+   ELSIF IsPseudoSystemFunction (sym) OR IsPseudoBaseFunction (sym)
+   THEN
+      MetaErrorT1 (tokpos,
+                   '{%1Ead} expected a variable, procedure, constant or expression, not an intrinsic procedure function',
+                   sym)
+   ELSIF (NOT IsConst(sym)) AND (NOT IsVar(sym)) AND
+         (NOT IsProcedure(sym)) AND
+         (NOT IsTemporary(sym)) AND (NOT MustNotCheckBounds)
+   THEN
+      MetaErrorsT1 (tokpos,
+                    '{%1Ead} expected a variable, procedure, constant or expression',
+                    'and it was declared as a {%1Dd}', sym) ;
+   ELSIF (type#NulSym) AND IsArray(type)
+   THEN
+      MetaErrorsT1 (tokpos,
+                    '{%1EU} not expecting an array variable as an operand for either comparison or binary operation',
+                    'it was declared as a {%1Dd}', sym)
+   ELSIF IsConstString(sym) AND (GetStringLength(sym)>1)
+   THEN
+      MetaErrorT1 (tokpos,
+                   '{%1EU} not expecting a string constant as an operand for either comparison or binary operation',
+                   sym)
+   END
+END CheckVariableOrConstantOrProcedure ;
+
+
+(*
+   BuildRelOp   - Builds a relative operation from the quad stack.
+                  The Stack is expected to contain:
+
+
+                  Entry                   Exit
+                  =====                   ====
+
+           Ptr ->
+                  +------------+
+                  | e1         |
+                  |------------|                          <- Ptr
+                  | Operator   |
+                  |------------|          +------------+
+                  | e2         |          | t    | f   |
+                  |------------|          |------------|
+
+
+                    Quadruples Produced
+
+                    q     IFOperator  e2  e1  TrueExit    ; e2  e1 since
+                    q+1   GotoOp              FalseExit   ; relation > etc
+                                                          ; requires order.
+*)
+
+PROCEDURE BuildRelOp (optokpos: CARDINAL) ;
+VAR
+   combinedTok,
+   rightpos,
+   leftpos            : CARDINAL ;
+   Op                 : Name ;
+   t,
+   rightType, leftType,
+   right, left        : CARDINAL ;
+BEGIN
+   IF CompilerDebugging
+   THEN
+      DisplayStack    (* Debugging info *)
+   END ;
+   IF IsBoolean (1) AND IsBoolean (3)
+   THEN
+      (*
+         we allow # and = to be used with Boolean expressions.
+         we do not allow >  <  >=  <=  though
+      *)
+      BuildRelOpFromBoolean (optokpos)
+   ELSE
+      IF IsBoolean (1)
+      THEN
+         ConvertBooleanToVariable (OperandTtok (1), 1)
+      END ;
+      IF IsBoolean (3)
+      THEN
+         ConvertBooleanToVariable (OperandTtok (3), 3)
+      END ;
+      PopTFtok (right, rightType, rightpos) ;
+      PopT (Op) ;
+      PopTFtok (left, leftType, leftpos) ;
+
+      CheckVariableOrConstantOrProcedure (rightpos, right) ;
+      CheckVariableOrConstantOrProcedure (leftpos, left) ;
+
+      IF (left#NulSym) AND (right#NulSym)
+      THEN
+         (* BuildRange will check the expression later on once gcc knows about all data types.  *)
+         BuildRange (InitTypesExpressionCheck (optokpos, left, right, TRUE, Op = InTok))
+      END ;
+
+      (* Must dereference LeftValue operands.  *)
+      IF GetMode(right) = LeftValue
+      THEN
+         t := MakeTemporary (rightpos, RightValue) ;
+         PutVar(t, GetSType(right)) ;
+         CheckPointerThroughNil (rightpos, right) ;
+         doIndrX (rightpos, t, right) ;
+         right := t
+      END ;
+      IF GetMode(left) = LeftValue
+      THEN
+         t := MakeTemporary (leftpos, RightValue) ;
+         PutVar (t, GetSType (left)) ;
+         CheckPointerThroughNil (leftpos, left) ;
+         doIndrX (leftpos, t, left) ;
+         left := t
+      END ;
+      combinedTok := MakeVirtualTok (optokpos, leftpos, rightpos) ;
+      GenQuadO (combinedTok, MakeOp(Op), left, right, 0, FALSE) ;  (* True  Exit *)
+      GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ;  (* False Exit *)
+      PushBool (NextQuad-2, NextQuad-1)
+   END
+END BuildRelOp ;
+
+
+(*
+   BuildNot   - Builds a NOT operation from the quad stack.
+                The Stack is expected to contain:
+
+
+                  Entry                   Exit
+                  =====                   ====
+
+           Ptr ->                                        <- Ptr
+                  +------------+          +------------+
+                  | t    | f   |          | f    | t   |
+                  |------------|          |------------|
+*)
+
+PROCEDURE BuildNot ;
+VAR
+   t, f: CARDINAL ;
+BEGIN
+   CheckBooleanId ;
+   PopBool (t, f) ;
+   PushBool (f, t)
+END BuildNot ;
+
+
+(*
+   MakeOp - returns the equalent quadruple operator to a token, t.
+*)
+
+PROCEDURE MakeOp (t: Name) : QuadOperator ;
+BEGIN
+   IF t=PlusTok
+   THEN
+      RETURN( AddOp )
+   ELSIF t=MinusTok
+   THEN
+      RETURN( SubOp )
+   ELSIF t=DivTok
+   THEN
+      RETURN( DivM2Op )
+   ELSIF t=DivideTok
+   THEN
+      RETURN( DivTruncOp )
+   ELSIF t=RemTok
+   THEN
+      RETURN( ModTruncOp )
+   ELSIF t=ModTok
+   THEN
+      RETURN( ModM2Op )
+   ELSIF t=TimesTok
+   THEN
+      RETURN( MultOp )
+   ELSIF t=HashTok
+   THEN
+      RETURN( IfNotEquOp )
+   ELSIF t=LessGreaterTok
+   THEN
+      RETURN( IfNotEquOp )
+   ELSIF t=GreaterEqualTok
+   THEN
+      RETURN( IfGreEquOp )
+   ELSIF t=LessEqualTok
+   THEN
+      RETURN( IfLessEquOp )
+   ELSIF t=EqualTok
+   THEN
+      RETURN( IfEquOp )
+   ELSIF t=LessTok
+   THEN
+      RETURN( IfLessOp )
+   ELSIF t=GreaterTok
+   THEN
+      RETURN( IfGreOp )
+   ELSIF t=InTok
+   THEN
+      RETURN( IfInOp )
+   ELSIF t=LogicalOrTok
+   THEN
+      RETURN( LogicalOrOp )
+   ELSIF t=LogicalAndTok
+   THEN
+      RETURN( LogicalAndOp )
+   ELSIF t=LogicalXorTok
+   THEN
+      RETURN( LogicalXorOp )
+   ELSIF t=LogicalDifferenceTok
+   THEN
+      RETURN( LogicalDiffOp )
+   ELSE
+      InternalError('binary operation not implemented yet')
+   END
+END MakeOp ;
+
+
+(*
+   GenQuadO - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
+*)
+
+PROCEDURE GenQuadO (TokPos: CARDINAL;
+                    Operation: QuadOperator;
+                    Op1, Op2, Op3: CARDINAL; overflow: BOOLEAN) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   (* WriteString('Potential Quad: ') ; *)
+   IF QuadrupleGeneration
+   THEN
+      IF NextQuad # Head
+      THEN
+         f := GetQF (NextQuad-1) ;
+         f^.Next := NextQuad
+      END ;
+      PutQuadO (NextQuad, Operation, Op1, Op2, Op3, overflow) ;
+      f := GetQF (NextQuad) ;
+      WITH f^ DO
+         Next := 0 ;
+         LineNo := GetLineNo () ;
+         IF TokPos = UnknownTokenNo
+         THEN
+            TokenNo := GetTokenNo ()
+         ELSE
+            TokenNo := TokPos
+         END
+      END ;
+      IF NextQuad=BreakAtQuad
+      THEN
+         stop
+      END ;
+      (* DisplayQuad(NextQuad) ; *)
+      NewQuad (NextQuad)
+   END
+END GenQuadO ;
+
+
+(*
+   GenQuad - Generate a quadruple with Operation, Op1, Op2, Op3.
+*)
+
+PROCEDURE GenQuad (Operation: QuadOperator;
+                   Op1, Op2, Op3: CARDINAL) ;
+BEGIN
+   GenQuadO (UnknownTokenNo, Operation, Op1, Op2, Op3, TRUE)
+END GenQuad ;
+
+
+(*
+   GenQuadOtok - generate a quadruple with Operation, Op1, Op2, Op3, overflow.
+*)
+
+PROCEDURE GenQuadOtok (TokPos: CARDINAL;
+                       Operation: QuadOperator;
+                       Op1, Op2, Op3: CARDINAL; overflow: BOOLEAN;
+                       Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   (* WriteString('Potential Quad: ') ; *)
+   IF QuadrupleGeneration
+   THEN
+      IF NextQuad # Head
+      THEN
+         f := GetQF (NextQuad-1) ;
+         f^.Next := NextQuad
+      END ;
+      PutQuadO (NextQuad, Operation, Op1, Op2, Op3, overflow) ;
+      f := GetQF (NextQuad) ;
+      WITH f^ DO
+         Next := 0 ;
+         LineNo := GetLineNo () ;
+         IF TokPos = UnknownTokenNo
+         THEN
+            TokenNo := GetTokenNo ()
+         ELSE
+            TokenNo := TokPos
+         END ;
+         op1pos := Op1Pos ;
+         op2pos := Op2Pos ;
+         op3pos := Op3Pos
+      END ;
+      IF NextQuad=BreakAtQuad
+      THEN
+         stop
+      END ;
+      (* DisplayQuad(NextQuad) ; *)
+      NewQuad (NextQuad)
+   END
+END GenQuadOtok ;
+
+
+(*
+   DisplayQuadList - displays all quads.
+*)
+
+PROCEDURE DisplayQuadList ;
+VAR
+   i: CARDINAL ;
+   f: QuadFrame ;
+BEGIN
+   printf0('Quadruples:\n') ;
+   i := Head ;
+   WHILE i#0 DO
+      DisplayQuad(i) ;
+      f := GetQF(i) ;
+      i := f^.Next
+   END
+END DisplayQuadList ;
+
+
+(*
+   DisplayQuadRange - displays all quads in list range, start..end.
+*)
+
+PROCEDURE DisplayQuadRange (start, end: CARDINAL) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   printf0('Quadruples:\n') ;
+   WHILE (start<=end) AND (start#0) DO
+      DisplayQuad(start) ;
+      f := GetQF(start) ;
+      start := f^.Next
+   END
+END DisplayQuadRange ;
+
+
+(*
+   BackPatch - Makes each of the quadruples on the list pointed to by
+               StartQuad, take quadruple Value as a target.
+*)
+
+PROCEDURE BackPatch (QuadNo, Value: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+   f: QuadFrame ;
+BEGIN
+   IF QuadrupleGeneration
+   THEN
+      WHILE QuadNo#0 DO
+         f := GetQF(QuadNo) ;
+         WITH f^ DO
+            i := Operand3 ;                       (* Next Link along the BackPatch *)
+            ManipulateReference(QuadNo, Value)    (* Filling in the BackPatch.     *)
+         END ;
+         QuadNo := i
+      END
+   END
+END BackPatch ;
+
+
+(*
+   Merge - joins two quad lists, QuadList2 to the end of QuadList1.
+           A QuadList of value zero is a nul list.
+*)
+
+PROCEDURE Merge (QuadList1, QuadList2: CARDINAL) : CARDINAL ;
+VAR
+   i, j: CARDINAL ;
+   f   : QuadFrame ;
+BEGIN
+   IF QuadList1=0
+   THEN
+      RETURN( QuadList2 )
+   ELSIF QuadList2=0
+   THEN
+      RETURN( QuadList1 )
+   ELSE
+      i := QuadList1 ;
+      REPEAT
+         j := i ;
+         f := GetQF(i) ;
+         i := f^.Operand3
+      UNTIL i=0 ;
+      ManipulateReference(j, QuadList2) ;
+      RETURN( QuadList1 )
+   END
+END Merge ;
+
+
+(*
+   Annotate - annotate the top of stack.
+*)
+
+PROCEDURE Annotate (a: ARRAY OF CHAR) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   IF DebugStackOn AND CompilerDebugging AND (NoOfItemsInStackAddress(BoolStack)>0)
+   THEN
+      f := PeepAddress(BoolStack, 1) ;    (* top of stack *)
+      WITH f^ DO
+         IF Annotation#NIL
+         THEN
+            Annotation := KillString(Annotation)
+         END ;
+         Annotation := InitString(a)
+      END
+   END
+END Annotate ;
+
+
+(*
+   OperandAnno - returns the annotation string associated with the
+                 position, n, on the stack.
+*)
+
+PROCEDURE OperandAnno (n: CARDINAL) : String ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PeepAddress (BoolStack, n) ;
+   RETURN f^.Annotation
+END OperandAnno ;
+
+
+(*
+   DisplayStack - displays the compile time symbol stack.
+*)
+
+PROCEDURE DisplayStack ;
+BEGIN
+   IF DebugStackOn AND CompilerDebugging
+   THEN
+      DebugStack (NoOfItemsInStackAddress (BoolStack),
+                  OperandTno, OperandFno, OperandA,
+                  OperandD, OperandRW, OperandTok, OperandAnno)
+   END
+END DisplayStack ;
+
+
+(*
+   ds - tiny procedure name, useful for calling from the gdb shell.
+*)
+
+(*
+PROCEDURE ds ;
+BEGIN
+   DisplayStack
+END ds ;
+*)
+
+
+(*
+   DisplayQuad - displays a quadruple, QuadNo.
+*)
+
+PROCEDURE DisplayQuad (QuadNo: CARDINAL) ;
+BEGIN
+   DSdbEnter ;
+   printf1('%4d  ', QuadNo) ; WriteQuad(QuadNo) ; printf0('\n') ;
+   DSdbExit
+END DisplayQuad ;
+
+
+(*
+   DisplayProcedureAttributes -
+*)
+
+PROCEDURE DisplayProcedureAttributes (proc: CARDINAL) ;
+BEGIN
+   IF IsCtor (proc)
+   THEN
+      printf0 (" (ctor)")
+   END ;
+   IF IsPublic (proc)
+   THEN
+      printf0 (" (public)")
+   END ;
+   IF IsExtern (proc)
+   THEN
+      printf0 (" (extern)")
+   END ;
+   IF IsMonoName (proc)
+   THEN
+      printf0 (" (mononame)")
+   END
+END DisplayProcedureAttributes ;
+
+
+(*
+   WriteQuad - Writes out the Quad BufferQuad.
+*)
+
+PROCEDURE WriteQuad (BufferQuad: CARDINAL) ;
+VAR
+   n1, n2: Name ;
+   f     : QuadFrame ;
+   n     : Name ;
+   l     : CARDINAL ;
+BEGIN
+   f := GetQF(BufferQuad) ;
+   WITH f^ DO
+      WriteOperator(Operator) ;
+      printf1('  [%d]    ', NoOfTimesReferenced) ;
+      CASE Operator OF
+
+      HighOp           : WriteOperand(Operand1) ;
+                         printf1('  %4d  ', Operand2) ;
+                         WriteOperand(Operand3) |
+      InitAddressOp,
+      SavePriorityOp,
+      RestorePriorityOp,
+      SubrangeLowOp,
+      SubrangeHighOp,
+      BecomesOp,
+      InclOp,
+      ExclOp,
+      UnboundedOp,
+      ReturnValueOp,
+      FunctValueOp,
+      NegateOp,
+      AddrOp            : WriteOperand(Operand1) ;
+                          printf0('  ') ;
+                          WriteOperand(Operand3) |
+      ElementSizeOp,
+      IfInOp,
+      IfNotInOp,
+      IfNotEquOp,
+      IfEquOp,
+      IfLessOp,
+      IfGreOp,
+      IfLessEquOp,
+      IfGreEquOp        : WriteOperand(Operand1) ;
+                          printf0('  ') ;
+                          WriteOperand(Operand2) ;
+                          printf1('  %4d', Operand3) |
+
+      InlineOp,
+      RetryOp,
+      TryOp,
+      GotoOp            : printf1('%4d', Operand3) |
+
+      StatementNoteOp   : l := TokenToLineNo(Operand3, 0) ;
+                          n := GetTokenName (Operand3) ;
+                          printf4('%a:%d:%a (tokenno %d)', Operand1, l, n, Operand3) |
+      LineNumberOp      : printf2('%a:%d', Operand1, Operand3) |
+
+      EndFileOp         : n1 := GetSymName(Operand3) ;
+                          printf1('%a', n1) |
+
+      ThrowOp,
+      ReturnOp,
+      CallOp,
+      KillLocalVarOp    : WriteOperand(Operand3) |
+
+      ProcedureScopeOp  : n1 := GetSymName(Operand2) ;
+                          n2 := GetSymName(Operand3) ;
+                          printf3('  %4d  %a  %a', Operand1, n1, n2) ;
+                          DisplayProcedureAttributes (Operand3) |
+      NewLocalVarOp,
+      FinallyStartOp,
+      FinallyEndOp,
+      InitEndOp,
+      InitStartOp       : n1 := GetSymName(Operand2) ;
+                          n2 := GetSymName(Operand3) ;
+                          printf3('  %4d  %a  %a', Operand1, n1, n2) |
+
+      ModuleScopeOp,
+      StartModFileOp    : n1 := GetSymName(Operand3) ;
+                          printf4('%a:%d  %a(%d)', Operand2, Operand1, n1, Operand3) |
+
+      StartDefFileOp    : n1 := GetSymName(Operand3) ;
+                          printf2('  %4d  %a', Operand1, n1) |
+
+      OptParamOp,
+      ParamOp           : printf1('%4d  ', Operand1) ;
+                          WriteOperand(Operand2) ;
+                          printf0('  ') ;
+                          WriteOperand(Operand3) |
+      SizeOp,
+      RecordFieldOp,
+      IndrXOp,
+      XIndrOp,
+      ArrayOp,
+      LogicalShiftOp,
+      LogicalRotateOp,
+      LogicalOrOp,
+      LogicalAndOp,
+      LogicalXorOp,
+      LogicalDiffOp,
+      CoerceOp,
+      ConvertOp,
+      CastOp,
+      AddOp,
+      SubOp,
+      MultOp,
+      DivM2Op,
+      ModM2Op,
+      ModFloorOp,
+      DivCeilOp,
+      ModCeilOp,
+      DivFloorOp,
+      ModTruncOp,
+      DivTruncOp        : WriteOperand(Operand1) ;
+                          printf0('  ') ;
+                          WriteOperand(Operand2) ;
+                          printf0('  ') ;
+                          WriteOperand(Operand3) |
+      DummyOp,
+      CodeOnOp,
+      CodeOffOp,
+      ProfileOnOp,
+      ProfileOffOp,
+      OptimizeOnOp,
+      OptimizeOffOp     : |
+      BuiltinConstOp    : WriteOperand(Operand1) ;
+                          printf1('   %a', Operand3) |
+      BuiltinTypeInfoOp : WriteOperand(Operand1) ;
+                          printf1('   %a', Operand2) ;
+                          printf1('   %a', Operand3) |
+      StandardFunctionOp: WriteOperand(Operand1) ;
+                          printf0('  ') ;
+                          WriteOperand(Operand2) ;
+                          printf0('  ') ;
+                          WriteOperand(Operand3) |
+      CatchBeginOp,
+      CatchEndOp        : |
+
+      RangeCheckOp,
+      ErrorOp           : WriteRangeCheck(Operand3) |
+      SaveExceptionOp,
+      RestoreExceptionOp: WriteOperand(Operand1) ;
+                          printf0('  ') ;
+                          WriteOperand(Operand3)
+
+      ELSE
+         InternalError ('quadruple not recognised')
+      END
+   END
+END WriteQuad ;
+
+
+(*
+   WriteOperator - writes the name of the quadruple operator.
+*)
+
+PROCEDURE WriteOperator (Operator: QuadOperator) ;
+BEGIN
+   CASE Operator OF
+
+   InitAddressOp            : printf0('InitAddress       ') |
+   LogicalOrOp              : printf0('Or                ') |
+   LogicalAndOp             : printf0('And               ') |
+   LogicalXorOp             : printf0('Xor               ') |
+   LogicalDiffOp            : printf0('Ldiff             ') |
+   LogicalShiftOp           : printf0('Shift             ') |
+   LogicalRotateOp          : printf0('Rotate            ') |
+   BecomesOp                : printf0('Becomes           ') |
+   IndrXOp                  : printf0('IndrX             ') |
+   XIndrOp                  : printf0('XIndr             ') |
+   ArrayOp                  : printf0('Array             ') |
+   ElementSizeOp            : printf0('ElementSize       ') |
+   RecordFieldOp            : printf0('RecordField       ') |
+   AddrOp                   : printf0('Addr              ') |
+   SizeOp                   : printf0('Size              ') |
+   IfInOp                   : printf0('If IN             ') |
+   IfNotInOp                : printf0('If NOT IN         ') |
+   IfNotEquOp               : printf0('If <>             ') |
+   IfEquOp                  : printf0('If =              ') |
+   IfLessEquOp              : printf0('If <=             ') |
+   IfGreEquOp               : printf0('If >=             ') |
+   IfGreOp                  : printf0('If >              ') |
+   IfLessOp                 : printf0('If <              ') |
+   GotoOp                   : printf0('Goto              ') |
+   DummyOp                  : printf0('Dummy             ') |
+   ModuleScopeOp            : printf0('ModuleScopeOp     ') |
+   StartDefFileOp           : printf0('StartDefFile      ') |
+   StartModFileOp           : printf0('StartModFile      ') |
+   EndFileOp                : printf0('EndFileOp         ') |
+   InitStartOp              : printf0('InitStart         ') |
+   InitEndOp                : printf0('InitEnd           ') |
+   FinallyStartOp           : printf0('FinallyStart      ') |
+   FinallyEndOp             : printf0('FinallyEnd        ') |
+   RetryOp                  : printf0('Retry             ') |
+   TryOp                    : printf0('Try               ') |
+   ThrowOp                  : printf0('Throw             ') |
+   CatchBeginOp             : printf0('CatchBegin        ') |
+   CatchEndOp               : printf0('CatchEnd          ') |
+   AddOp                    : printf0('+                 ') |
+   SubOp                    : printf0('-                 ') |
+   DivM2Op                  : printf0('DIV M2            ') |
+   ModM2Op                  : printf0('MOD M2            ') |
+   DivCeilOp                : printf0('DIV ceil          ') |
+   ModCeilOp                : printf0('MOD ceil          ') |
+   DivFloorOp               : printf0('DIV floor         ') |
+   ModFloorOp               : printf0('MOD floor         ') |
+   DivTruncOp               : printf0('DIV trunc         ') |
+   ModTruncOp               : printf0('MOD trunc         ') |
+   MultOp                   : printf0('*                 ') |
+   NegateOp                 : printf0('Negate            ') |
+   InclOp                   : printf0('Incl              ') |
+   ExclOp                   : printf0('Excl              ') |
+   ReturnOp                 : printf0('Return            ') |
+   ReturnValueOp            : printf0('ReturnValue       ') |
+   FunctValueOp             : printf0('FunctValue        ') |
+   CallOp                   : printf0('Call              ') |
+   ParamOp                  : printf0('Param             ') |
+   OptParamOp               : printf0('OptParam          ') |
+   NewLocalVarOp            : printf0('NewLocalVar       ') |
+   KillLocalVarOp           : printf0('KillLocalVar      ') |
+   ProcedureScopeOp         : printf0('ProcedureScope    ') |
+   UnboundedOp              : printf0('Unbounded         ') |
+   CoerceOp                 : printf0('Coerce            ') |
+   ConvertOp                : printf0('Convert           ') |
+   CastOp                   : printf0('Cast              ') |
+   HighOp                   : printf0('High              ') |
+   CodeOnOp                 : printf0('CodeOn            ') |
+   CodeOffOp                : printf0('CodeOff           ') |
+   ProfileOnOp              : printf0('ProfileOn         ') |
+   ProfileOffOp             : printf0('ProfileOff        ') |
+   OptimizeOnOp             : printf0('OptimizeOn        ') |
+   OptimizeOffOp            : printf0('OptimizeOff       ') |
+   InlineOp                 : printf0('Inline            ') |
+   StatementNoteOp          : printf0('StatementNote     ') |
+   LineNumberOp             : printf0('LineNumber        ') |
+   BuiltinConstOp           : printf0('BuiltinConst      ') |
+   BuiltinTypeInfoOp        : printf0('BuiltinTypeInfo   ') |
+   StandardFunctionOp       : printf0('StandardFunction  ') |
+   SavePriorityOp           : printf0('SavePriority      ') |
+   RestorePriorityOp        : printf0('RestorePriority   ') |
+   RangeCheckOp             : printf0('RangeCheck        ') |
+   ErrorOp                  : printf0('Error             ') |
+   SaveExceptionOp          : printf0('SaveException     ') |
+   RestoreExceptionOp       : printf0('RestoreException  ')
+
+   ELSE
+      InternalError ('operator not expected')
+   END
+END WriteOperator ;
+
+
+(*
+   WriteOperand - displays the operands name, symbol id and mode of addressing.
+*)
+
+PROCEDURE WriteOperand (Sym: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   IF Sym=NulSym
+   THEN
+      printf0('<nulsym>')
+   ELSE
+      n := GetSymName(Sym) ;
+      printf1('%a', n) ;
+      IF IsVar(Sym) OR IsConst(Sym)
+      THEN
+         printf0('[') ; WriteMode(GetMode(Sym)) ; printf0(']')
+      END ;
+      printf1('(%d)', Sym)
+   END
+END WriteOperand ;
+
+
+PROCEDURE WriteMode (Mode: ModeOfAddr) ;
+BEGIN
+   CASE Mode OF
+
+   ImmediateValue: printf0('i') |
+   NoValue       : printf0('n') |
+   RightValue    : printf0('r') |
+   LeftValue     : printf0('l')
+
+   ELSE
+      InternalError ('unrecognised mode')
+   END
+END WriteMode ;
+
+
+(*
+   GetQuadOp - returns the operator for quad.
+*)
+
+PROCEDURE GetQuadOp (quad: CARDINAL) : QuadOperator ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF (quad) ;
+   RETURN f^.Operator
+END GetQuadOp ;
+
+
+(*
+   GetM2OperatorDesc - returns the Modula-2 string associated with the quad operator
+                       (if possible).  It returns NIL if no there is not an obvious match
+                       in Modula-2.  It is assummed that the string will be used during
+                       construction of error messages and therefore keywords are
+                       wrapped with a format specifier.
+*)
+
+PROCEDURE GetM2OperatorDesc (op: QuadOperator) : String ;
+BEGIN
+   CASE op OF
+
+   NegateOp    :  RETURN InitString ('-') |
+   AddOp       :  RETURN InitString ('+') |
+   SubOp       :  RETURN InitString ('-') |
+   MultOp      :  RETURN InitString ('*') |
+   DivM2Op,
+   DivCeilOp,
+   DivFloorOp,
+   DivTruncOp  :  RETURN InitString ('{%kDIV}') |
+   ModM2Op,
+   ModCeilOp,
+   ModFloorOp  :  RETURN InitString ('{%kMOD}') |
+   ModTruncOp  :  RETURN InitString ('{%kREM}') |
+   LogicalOrOp :  RETURN InitString ('{%kOR}') |
+   LogicalAndOp:  RETURN InitString ('{%kAND}') |
+   InclOp      :  RETURN InitString ('{%kINCL}') |
+   ExclOp      :  RETURN InitString ('{%kEXCL}')
+
+   ELSE
+      RETURN NIL
+   END
+END GetM2OperatorDesc ;
+
+
+
+(*
+   PushExit - pushes the exit value onto the EXIT stack.
+*)
+
+PROCEDURE PushExit (Exit: CARDINAL) ;
+BEGIN
+   PushWord(ExitStack, Exit)
+END PushExit ;
+
+
+(*
+   PopExit - pops the exit value from the EXIT stack.
+*)
+
+PROCEDURE PopExit() : WORD ;
+BEGIN
+   RETURN( PopWord(ExitStack) )
+END PopExit ;
+
+
+(*
+   PushFor - pushes the exit value onto the FOR stack.
+*)
+
+PROCEDURE PushFor (Exit: CARDINAL) ;
+BEGIN
+   PushWord(ForStack, Exit)
+END PushFor ;
+
+
+(*
+   PopFor - pops the exit value from the FOR stack.
+*)
+
+PROCEDURE PopFor() : WORD ;
+BEGIN
+   RETURN( PopWord(ForStack) )
+END PopFor ;
+
+
+(*
+   OperandTno - returns the ident operand stored in the true position
+                on the boolean stack.  This is exactly the same as
+                OperandT but it has no IsBoolean checking.
+*)
+
+PROCEDURE OperandTno (pos: CARDINAL) : WORD ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   Assert(pos>0) ;
+   f := PeepAddress(BoolStack, pos) ;
+   RETURN( f^.TrueExit )
+END OperandTno ;
+
+
+(*
+   OperandFno - returns the ident operand stored in the false position
+                on the boolean stack.  This is exactly the same as
+                OperandF but it has no IsBoolean checking.
+*)
+
+PROCEDURE OperandFno (pos: CARDINAL) : WORD ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   Assert(pos>0) ;
+   f := PeepAddress (BoolStack, pos) ;
+   RETURN f^.FalseExit
+END OperandFno ;
+
+
+(*
+   OperandTtok - returns the token associated with the position, pos
+                 on the boolean stack.
+*)
+
+PROCEDURE OperandTtok (pos: CARDINAL) : CARDINAL ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   Assert (pos > 0) ;
+   f := PeepAddress (BoolStack, pos) ;
+   RETURN f^.tokenno
+END OperandTtok ;
+
+
+(*
+   PopBool - Pops a True and a False exit quad number from the True/False
+             stack.
+*)
+
+PROCEDURE PopBool (VAR True, False: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress (BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      False := FalseExit ;
+      Assert (BooleanOp)
+   END ;
+   DISPOSE (f)
+END PopBool ;
+
+
+(*
+   PushBool - Push a True and a False exit quad numbers onto the
+              True/False stack.
+*)
+
+PROCEDURE PushBool (True, False: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   Assert(True<=NextQuad) ;
+   Assert(False<=NextQuad) ;
+   NEW(f) ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      BooleanOp := TRUE ;
+      Annotation := NIL
+   END ;
+   PushAddress (BoolStack, f) ;
+   Annotate ('<q%1d>|<q%2d>||true quad|false quad')
+END PushBool ;
+
+
+(*
+   IsBoolean - returns true is the Stack position pos contains a Boolean
+               Exit. False is returned if an Ident is stored.
+*)
+
+PROCEDURE IsBoolean (pos: CARDINAL) : BOOLEAN ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   Assert(pos>0) ;
+   f := PeepAddress(BoolStack, pos) ;
+   RETURN( f^.BooleanOp )
+END IsBoolean ;
+
+
+(*
+   OperandD - returns possible array dimension associated with the ident
+              operand stored on the boolean stack.
+*)
+
+PROCEDURE OperandD (pos: CARDINAL) : WORD ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   Assert(pos>0) ;
+   Assert(NOT IsBoolean (pos)) ;
+   f := PeepAddress(BoolStack, pos) ;
+   RETURN( f^.Dimension )
+END OperandD ;
+
+
+(*
+   OperandA - returns possible array symbol associated with the ident
+              operand stored on the boolean stack.
+*)
+
+PROCEDURE OperandA (pos: CARDINAL) : WORD ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   Assert(pos>0) ;
+   Assert(NOT IsBoolean (pos)) ;
+   f := PeepAddress(BoolStack, pos) ;
+   RETURN( f^.Unbounded )
+END OperandA ;
+
+
+(*
+   OperandT - returns the ident operand stored in the true position on the boolean stack.
+*)
+
+PROCEDURE OperandT (pos: CARDINAL) : WORD ;
+BEGIN
+   Assert(NOT IsBoolean (pos)) ;
+   RETURN( OperandTno(pos) )
+END OperandT ;
+
+
+(*
+   OperandF - returns the ident operand stored in the false position on the boolean stack.
+*)
+
+PROCEDURE OperandF (pos: CARDINAL) : WORD ;
+BEGIN
+   Assert(NOT IsBoolean (pos)) ;
+   RETURN( OperandFno(pos) )
+END OperandF ;
+
+
+(*
+   OperandRW - returns the rw operand stored on the boolean stack.
+*)
+
+PROCEDURE OperandRW (pos: CARDINAL) : WORD ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   Assert(pos>0) ;
+   Assert(NOT IsBoolean (pos)) ;
+   f := PeepAddress(BoolStack, pos) ;
+   RETURN( f^.ReadWrite )
+END OperandRW ;
+
+
+(*
+   OperandMergeRW - returns the rw operand if not NulSym else it
+                    returns True.
+*)
+
+PROCEDURE OperandMergeRW (pos: CARDINAL) : WORD ;
+BEGIN
+   IF OperandRW (pos) = NulSym
+   THEN
+      RETURN OperandT (pos)
+   ELSE
+      RETURN OperandRW (pos)
+   END
+END OperandMergeRW ;
+
+
+(*
+   OperandTok - returns the token associated with pos, on the stack.
+*)
+
+PROCEDURE OperandTok (pos: CARDINAL) : WORD ;
+BEGIN
+   Assert (NOT IsBoolean (pos)) ;
+   RETURN OperandTtok (pos)
+END OperandTok ;
+
+
+(*
+   BuildCodeOn - generates a quadruple declaring that code should be
+                 emmitted from henceforth.
+
+                 The Stack is unnaffected.
+*)
+
+PROCEDURE BuildCodeOn ;
+BEGIN
+   GenQuad(CodeOnOp, NulSym, NulSym, NulSym)
+END BuildCodeOn ;
+
+
+(*
+   BuildCodeOff - generates a quadruple declaring that code should not be
+                  emmitted from henceforth.
+
+                  The Stack is unnaffected.
+*)
+
+PROCEDURE BuildCodeOff ;
+BEGIN
+   GenQuad(CodeOffOp, NulSym, NulSym, NulSym)
+END BuildCodeOff ;
+
+
+(*
+   BuildProfileOn - generates a quadruple declaring that profile timings
+                    should be emmitted from henceforth.
+
+                    The Stack is unnaffected.
+*)
+
+PROCEDURE BuildProfileOn ;
+BEGIN
+   GenQuad(ProfileOnOp, NulSym, NulSym, NulSym)
+END BuildProfileOn ;
+
+
+(*
+   BuildProfileOn - generates a quadruple declaring that profile timings
+                    should be emmitted from henceforth.
+
+                    The Stack is unnaffected.
+*)
+
+PROCEDURE BuildProfileOff ;
+BEGIN
+   GenQuad(ProfileOffOp, NulSym, NulSym, NulSym)
+END BuildProfileOff ;
+
+
+(*
+   BuildOptimizeOn - generates a quadruple declaring that optimization
+                     should occur from henceforth.
+
+                     The Stack is unnaffected.
+*)
+
+PROCEDURE BuildOptimizeOn ;
+BEGIN
+   GenQuad(OptimizeOnOp, NulSym, NulSym, NulSym)
+END BuildOptimizeOn ;
+
+
+(*
+   BuildOptimizeOff - generates a quadruple declaring that optimization
+                      should not occur from henceforth.
+
+                      The Stack is unnaffected.
+*)
+
+PROCEDURE BuildOptimizeOff ;
+BEGIN
+   GenQuad(OptimizeOffOp, NulSym, NulSym, NulSym)
+END BuildOptimizeOff ;
+
+
+(*
+   BuildInline - builds an Inline pseudo quadruple operator.
+                 The inline interface, Sym, is stored as the operand
+                 to the operator InlineOp.
+
+                 The stack is expected to contain:
+
+
+                        Entry                   Exit
+                        =====                   ====
+
+                 Ptr ->
+                        +--------------+
+                        | Sym          |        Empty
+                        |--------------|
+*)
+
+PROCEDURE BuildInline ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   PopT(Sym) ;
+   GenQuad(InlineOp, NulSym, NulSym, Sym)
+END BuildInline ;
+
+
+(*
+   BuildLineNo - builds a LineNumberOp pseudo quadruple operator.
+                 This quadruple indicates which source line has been
+                 processed, these quadruples are only generated if we
+                 are producing runtime debugging information.
+
+                 The stack is not affected, read or altered in any way.
+
+
+                        Entry                   Exit
+                        =====                   ====
+
+                 Ptr ->                              <- Ptr
+*)
+
+PROCEDURE BuildLineNo ;
+VAR
+   filename: Name ;
+   f       : QuadFrame ;
+BEGIN
+   IF (NextQuad#Head) AND (GenerateLineDebug OR GenerateDebugging) AND FALSE
+   THEN
+      filename := makekey(string(GetFileName())) ;
+      f := GetQF(NextQuad-1) ;
+      IF NOT ((f^.Operator=LineNumberOp) AND (f^.Operand1=WORD(filename)))
+      THEN
+         GenQuad(LineNumberOp, WORD(filename), NulSym, WORD(GetLineNo()))
+      END
+   END
+END BuildLineNo ;
+
+
+(*
+   UseLineNote - uses the line note and returns it to the free list.
+*)
+
+PROCEDURE UseLineNote (l: LineNote) ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   WITH l^ DO
+      f := GetQF(NextQuad-1) ;
+      IF (f^.Operator=LineNumberOp) AND (f^.Operand1=WORD(File))
+      THEN
+         (* do nothing *)
+      ELSE
+         IF FALSE
+         THEN
+            GenQuad(LineNumberOp, WORD(File), NulSym, WORD(Line))
+         END
+      END ;
+      Next := FreeLineList
+   END ;
+   FreeLineList := l
+END UseLineNote ;
+
+
+(*
+   PopLineNo - pops a line note from the line stack.
+*)
+
+PROCEDURE PopLineNo () : LineNote ;
+VAR
+   l: LineNote ;
+BEGIN
+   l := PopAddress(LineStack) ;
+   IF l=NIL
+   THEN
+      InternalError ('no line note available')
+   END ;
+   RETURN( l  )
+END PopLineNo ;
+
+
+(*
+   InitLineNote - creates a line note and initializes it to
+                  contain, file, line.
+*)
+
+PROCEDURE InitLineNote (file: Name; line: CARDINAL) : LineNote ;
+VAR
+   l: LineNote ;
+BEGIN
+   IF FreeLineList=NIL
+   THEN
+      NEW(l)
+   ELSE
+      l := FreeLineList ;
+      FreeLineList := FreeLineList^.Next
+   END ;
+   WITH l^ DO
+      File := file ;
+      Line := line
+   END ;
+   RETURN( l )
+END InitLineNote ;
+
+
+(*
+   PushLineNote -
+*)
+
+PROCEDURE PushLineNote (l: LineNote) ;
+BEGIN
+   PushAddress(LineStack, l)
+END PushLineNote ;
+
+
+(*
+   PushLineNo - pushes the current file and line number to the stack.
+*)
+
+PROCEDURE PushLineNo ;
+BEGIN
+   PushLineNote(InitLineNote(makekey(string(GetFileName())), GetLineNo()))
+END PushLineNo ;
+
+
+(*
+   BuildStmtNote - builds a StatementNoteOp pseudo quadruple operator.
+                   This quadruple indicates which source line has been
+                   processed and it represents the start of a statement
+                   sequence.
+                   It differs from LineNumberOp in that multiple successive
+                   LineNumberOps will be removed and the final one is attached to
+                   the next real GCC tree.  Whereas a StatementNoteOp is always left
+                   alone.  Depending upon the debugging level it will issue a nop
+                   instruction to ensure that the gdb single step will step into
+                   this line.  Practically it allows pedalogical debugging to
+                   occur when there is syntax sugar such as:
+
+
+                         END  (* step *)
+                      END  (* step *)
+                   END ; (* step *)
+		   a := 1 ; (* step *)
+
+                   REPEAT (* step *)
+		      i := 1  (* step *)
+
+                   The stack is not affected, read or altered in any way.
+
+
+                        Entry                   Exit
+                        =====                   ====
+
+                 Ptr ->                              <- Ptr
+*)
+
+PROCEDURE BuildStmtNote (offset: INTEGER) ;
+VAR
+   filename: Name ;
+   f       : QuadFrame ;
+   i       : INTEGER ;
+BEGIN
+   IF NextQuad#Head
+   THEN
+      f := GetQF (NextQuad-1) ;
+      i := offset ;
+      INC (i, GetTokenNo ()) ;
+      (* no need to have multiple notes at the same position.  *)
+      IF (f^.Operator # StatementNoteOp) OR (f^.Operand3 # VAL (CARDINAL, i))
+      THEN
+         filename := makekey (string (GetFileName ())) ;
+         GenQuad (StatementNoteOp, WORD (filename), NulSym, i)
+      END
+   END
+END BuildStmtNote ;
+
+
+(*
+   AddRecordToList - adds the record held on the top of stack to the
+                     list of records and varient fields.
+*)
+
+PROCEDURE AddRecordToList ;
+VAR
+   r: CARDINAL ;
+   n: CARDINAL ;
+BEGIN
+   r := OperandT(1) ;
+   Assert(IsRecord(r) OR IsFieldVarient(r)) ;
+   (*
+      r might be a field varient if the declaration consists of nested
+      varients.  However ISO TSIZE can only utilise record types, we store
+      a varient field anyway as the next pass would not know whether to
+      ignore a varient field.
+   *)
+   PutItemIntoList (VarientFields, r) ;
+   IF DebugVarients
+   THEN
+      n := NoOfItemsInList(VarientFields) ;
+      IF IsRecord(r)
+      THEN
+         printf2('in list: record %d is %d\n', n, r)
+      ELSE
+         printf2('in list: varient field %d is %d\n', n, r)
+      END
+   END
+END AddRecordToList ;
+
+
+(*
+   AddVarientToList - adds varient held on the top of stack to the list.
+*)
+
+PROCEDURE AddVarientToList ;
+VAR
+   v, n: CARDINAL ;
+BEGIN
+   v := OperandT(1) ;
+   Assert(IsVarient(v)) ;
+   PutItemIntoList(VarientFields, v) ;
+   IF DebugVarients
+   THEN
+      n := NoOfItemsInList(VarientFields) ;
+      printf2('in list: varient %d is %d\n', n, v)
+   END
+END AddVarientToList ;
+
+
+(*
+   AddVarientFieldToList - adds varient field, f, to the list of all varient
+                           fields created.
+*)
+
+PROCEDURE AddVarientFieldToList (f: CARDINAL) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   Assert(IsFieldVarient(f)) ;
+   PutItemIntoList(VarientFields, f) ;
+   IF DebugVarients
+   THEN
+      n := NoOfItemsInList(VarientFields) ;
+      printf2('in list: varient field %d is %d\n', n, f)
+   END
+END AddVarientFieldToList ;
+
+
+(*
+   GetRecordOrField -
+*)
+
+PROCEDURE GetRecordOrField () : CARDINAL ;
+VAR
+   f: CARDINAL ;
+BEGIN
+   INC(VarientFieldNo) ;
+   f := GetItemFromList(VarientFields, VarientFieldNo) ;
+   IF DebugVarients
+   THEN
+      IF IsRecord(f)
+      THEN
+         printf2('out list: record %d is %d\n', VarientFieldNo, f)
+      ELSE
+         printf2('out list: varient field %d is %d\n', VarientFieldNo, f)
+      END
+   END ;
+   RETURN( f )
+END GetRecordOrField ;
+
+
+(*
+   BeginVarient - begin a varient record.
+*)
+
+PROCEDURE BeginVarient ;
+VAR
+   r, v: CARDINAL ;
+BEGIN
+   r := GetRecordOrField() ;
+   Assert(IsRecord(r) OR IsFieldVarient(r)) ;
+   v := GetRecordOrField() ;
+   Assert(IsVarient(v)) ;
+   BuildRange(InitCaseBounds(PushCase(r, v)))
+END BeginVarient ;
+
+
+(*
+   EndVarient - end a varient record.
+*)
+
+PROCEDURE EndVarient ;
+BEGIN
+   PopCase
+END EndVarient ;
+
+
+(*
+   ElseVarient - associate an ELSE clause with a varient record.
+*)
+
+PROCEDURE ElseVarient ;
+VAR
+   f: CARDINAL ;
+BEGIN
+   f := GetRecordOrField() ;
+   Assert(IsFieldVarient(f)) ;
+   ElseCase(f)
+END ElseVarient ;
+
+
+
+(*
+   BeginVarientList - begin an ident list containing ranges belonging to a
+                      varient list.
+*)
+
+PROCEDURE BeginVarientList ;
+VAR
+   f: CARDINAL ;
+BEGIN
+   f := GetRecordOrField() ;
+   Assert(IsFieldVarient(f)) ;
+   BeginCaseList(f)
+END BeginVarientList ;
+
+
+(*
+   EndVarientList - end a range list for a varient field.
+*)
+
+PROCEDURE EndVarientList ;
+BEGIN
+   EndCaseList
+END EndVarientList ;
+
+
+(*
+   AddVarientRange - creates a range from the top two contant expressions
+                     on the stack which are recorded with the current
+                     varient field.  The stack is unaltered.
+*)
+
+PROCEDURE AddVarientRange ;
+VAR
+   r1, r2: CARDINAL ;
+BEGIN
+   PopT(r2) ;
+   PopT(r1) ;
+   AddRange(r1, r2, GetTokenNo())
+END AddVarientRange ;
+
+
+(*
+   AddVarientEquality - adds the contant expression on the top of the stack
+                        to the current varient field being recorded.
+                        The stack is unaltered.
+*)
+
+PROCEDURE AddVarientEquality ;
+VAR
+   r1: CARDINAL ;
+BEGIN
+   PopT(r1) ;
+   AddRange(r1, NulSym, GetTokenNo())
+END AddVarientEquality ;
+
+
+(*
+   IncOperandD - increment the dimension number associated with symbol
+                 at, pos, on the boolean stack.
+*)
+
+(*
+PROCEDURE IncOperandD (pos: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PeepAddress(BoolStack, pos) ;
+   INC(f^.Dimension)
+END IncOperandD ;
+*)
+
+
+(*
+   PushTFA - Push True, False, Array, numbers onto the
+             True/False stack.  True and False are assumed to
+             contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFA (True, False, Array: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      Unbounded := Array
+   END ;
+   PushAddress(BoolStack, f)
+END PushTFA ;
+
+
+(*
+   PushTFAD - Push True, False, Array, Dim, numbers onto the
+              True/False stack.  True and False are assumed to
+              contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFAD (True, False, Array, Dim: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      Unbounded := Array ;
+      Dimension := Dim
+   END ;
+   PushAddress(BoolStack, f)
+END PushTFAD ;
+
+
+(*
+   PushTFADtok - Push True, False, Array, Dim, numbers onto the
+                 True/False stack.  True and False are assumed to
+                 contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFADtok (True, False, Array, Dim: WORD; tokno: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      Unbounded := Array ;
+      Dimension := Dim ;
+      tokenno := tokno
+   END ;
+   PushAddress (BoolStack, f)
+END PushTFADtok ;
+
+
+(*
+   PushTFADrwtok - Push True, False, Array, Dim, rw, numbers onto the
+                   True/False stack.  True and False are assumed to
+                   contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFADrwtok (True, False, Array, Dim, rw: WORD; Tok: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      Unbounded := Array ;
+      Dimension := Dim ;
+      ReadWrite := rw ;
+      tokenno := Tok
+   END ;
+   PushAddress (BoolStack, f)
+END PushTFADrwtok ;
+
+
+(*
+   PopTFrwtok - Pop a True and False number from the True/False stack.
+                True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PopTFrwtok (VAR True, False, rw: WORD; VAR tokno: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      False := FalseExit ;
+      Assert(NOT BooleanOp) ;
+      rw := ReadWrite ;
+      tokno := tokenno
+   END ;
+   DISPOSE(f)
+END PopTFrwtok ;
+
+
+(*
+   PushTFrwtok - Push an item onto the stack in the T (true) position,
+                 it is assummed to be a token and its token location is recorded.
+*)
+
+PROCEDURE PushTFrwtok (True, False, rw: WORD; tokno: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      ReadWrite := rw ;
+      tokenno := tokno
+   END ;
+   PushAddress(BoolStack, f)
+END PushTFrwtok ;
+
+
+(*
+   PushTFDtok - Push True, False, Dim, numbers onto the
+                True/False stack.  True and False are assumed to
+                contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFDtok (True, False, Dim: WORD; Tok: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      Dimension := Dim ;
+      tokenno := Tok
+   END ;
+   PushAddress (BoolStack, f)
+END PushTFDtok ;
+
+
+(*
+   PopTFDtok - Pop a True, False, Dim number from the True/False stack.
+               True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PopTFDtok (VAR True, False, Dim: WORD; VAR Tok: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      False := FalseExit ;
+      Dim := Dimension ;
+      Tok := tokenno ;
+      Assert(NOT BooleanOp)
+   END ;
+   DISPOSE(f)
+END PopTFDtok ;
+
+
+(*
+   PushTFDrwtok - Push True, False, Dim, numbers onto the
+                  True/False stack.  True and False are assumed to
+                  contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFDrwtok (True, False, Dim, rw: WORD; Tok: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      Dimension := Dim ;
+      ReadWrite := rw ;
+      tokenno := Tok
+   END ;
+   PushAddress (BoolStack, f)
+END PushTFDrwtok ;
+
+
+(*
+   PushTFrw - Push a True and False numbers onto the True/False stack.
+              True and False are assumed to contain Symbols or Ident etc.
+              It also pushes the higher level symbol which is associated
+              with the True symbol.  Eg record variable or array variable.
+*)
+
+PROCEDURE PushTFrw (True, False: WORD; rw: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      ReadWrite := rw
+   END ;
+   PushAddress(BoolStack, f)
+END PushTFrw ;
+
+
+(*
+   PopTFrw - Pop a True and False number from the True/False stack.
+             True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PopTFrw (VAR True, False, rw: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      False := FalseExit ;
+      Assert(NOT BooleanOp) ;
+      rw := ReadWrite
+   END ;
+   DISPOSE(f)
+END PopTFrw ;
+
+
+(*
+   PushTF - Push a True and False numbers onto the True/False stack.
+            True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTF (True, False: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False
+   END ;
+   PushAddress(BoolStack, f)
+END PushTF ;
+
+
+(*
+   PopTF - Pop a True and False number from the True/False stack.
+           True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PopTF (VAR True, False: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      False := FalseExit ;
+      Assert(NOT BooleanOp)
+   END ;
+   DISPOSE(f)
+END PopTF ;
+
+
+(*
+   newBoolFrame - creates a new BoolFrame with all fields initialised to their defaults.
+*)
+
+PROCEDURE newBoolFrame () : BoolFrame ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   NEW(f) ;
+   WITH f^ DO
+      TrueExit   := 0 ;
+      FalseExit  := 0 ;
+      Unbounded  := NulSym ;
+      BooleanOp  := FALSE ;
+      Dimension  := 0 ;
+      ReadWrite  := NulSym ;
+      name       := NulSym ;
+      Annotation := NIL ;
+      tokenno    := UnknownTokenNo
+   END ;
+   RETURN f
+END newBoolFrame ;
+
+
+(*
+   PushTtok - Push an item onto the stack in the T (true) position,
+              it is assummed to be a token and its token location is recorded.
+*)
+
+PROCEDURE PushTtok (True: WORD; tokno: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   (* PrintTokenNo (tokno) ; *)
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      tokenno := tokno
+   END ;
+   PushAddress (BoolStack, f)
+END PushTtok ;
+
+
+(*
+   PushT - Push an item onto the stack in the T (true) position.
+*)
+
+PROCEDURE PushT (True: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True
+   END ;
+   PushAddress(BoolStack, f)
+END PushT ;
+
+
+(*
+   PopT - Pops the T value from the stack.
+*)
+
+PROCEDURE PopT (VAR True: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      Assert(NOT BooleanOp)
+   END ;
+   DISPOSE(f)
+END PopT ;
+
+
+(*
+   PopTtok - Pops the T value from the stack and token position.
+*)
+
+PROCEDURE PopTtok (VAR True: WORD; VAR tok: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      tok := tokenno ;
+      Assert(NOT BooleanOp)
+   END ;
+   DISPOSE(f)
+END PopTtok ;
+
+
+(*
+   PushTrw - Push an item onto the True/False stack. The False value will be zero.
+*)
+
+(*
+PROCEDURE PushTrw (True: WORD; rw: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      ReadWrite := rw
+   END ;
+   PushAddress(BoolStack, f)
+END PushTrw ;
+*)
+
+
+(*
+   PushTrwtok - Push an item onto the True/False stack. The False value will be zero.
+*)
+
+PROCEDURE PushTrwtok (True: WORD; rw: WORD; tok: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      ReadWrite := rw ;
+      tokenno := tok
+   END ;
+   PushAddress(BoolStack, f)
+END PushTrwtok ;
+
+
+(*
+   PopTrw - Pop a True field and rw symbol from the stack.
+*)
+
+PROCEDURE PopTrw (VAR True, rw: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      Assert(NOT BooleanOp) ;
+      rw := ReadWrite
+   END ;
+   DISPOSE(f)
+END PopTrw ;
+
+
+(*
+   PopTrwtok - Pop a True field and rw symbol from the stack.
+*)
+
+PROCEDURE PopTrwtok (VAR True, rw: WORD; VAR tok: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      Assert(NOT BooleanOp) ;
+      rw := ReadWrite ;
+      tok := tokenno
+   END ;
+   DISPOSE(f)
+END PopTrwtok ;
+
+
+(*
+   PushTFn - Push a True and False numbers onto the True/False stack.
+             True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFn (True, False, n: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit  := True ;
+      FalseExit := False ;
+      name      := n
+   END ;
+   PushAddress(BoolStack, f)
+END PushTFn ;
+
+
+(*
+   PushTFntok - Push a True and False numbers onto the True/False stack.
+                True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFntok (True, False, n: WORD; tokno: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit  := True ;
+      FalseExit := False ;
+      name      := n ;
+      tokenno   := tokno
+   END ;
+   PushAddress (BoolStack, f)
+END PushTFntok ;
+
+
+(*
+   PopTFn - Pop a True and False number from the True/False stack.
+            True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PopTFn (VAR True, False, n: WORD) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      False := FalseExit ;
+      n := name ;
+      Assert(NOT BooleanOp)
+   END ;
+   DISPOSE(f)
+END PopTFn ;
+
+
+(*
+   PopNothing - pops the top element on the boolean stack.
+*)
+
+PROCEDURE PopNothing ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   DISPOSE(f)
+END PopNothing ;
+
+
+(*
+   PopN - pops multiple elements from the BoolStack.
+*)
+
+PROCEDURE PopN (n: CARDINAL) ;
+BEGIN
+   WHILE n>0 DO
+      PopNothing ;
+      DEC(n)
+   END
+END PopN ;
+
+
+(*
+   PushTFtok - Push an item onto the stack in the T (true) position,
+               it is assummed to be a token and its token location is recorded.
+*)
+
+PROCEDURE PushTFtok (True, False: WORD; tokno: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      tokenno := tokno
+   END ;
+   PushAddress(BoolStack, f)
+END PushTFtok ;
+
+
+(*
+   PopTFtok - Pop T/F/tok from the stack.
+*)
+
+PROCEDURE PopTFtok (VAR True, False: WORD; VAR tokno: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := PopAddress(BoolStack) ;
+   WITH f^ DO
+      True := TrueExit ;
+      False := FalseExit ;
+      tokno := tokenno
+   END
+END PopTFtok ;
+
+
+(*
+   PushTFAtok - Push T/F/A/tok to the stack.
+*)
+
+PROCEDURE PushTFAtok (True, False, Array: WORD; tokno: CARDINAL) ;
+VAR
+   f: BoolFrame ;
+BEGIN
+   f := newBoolFrame () ;
+   WITH f^ DO
+      TrueExit := True ;
+      FalseExit := False ;
+      Unbounded := Array ;
+      tokenno := tokno
+   END ;
+   PushAddress(BoolStack, f)
+END PushTFAtok ;
+
+
+(*
+   Top - returns the no of items held in the stack.
+*)
+
+PROCEDURE Top () : CARDINAL ;
+BEGIN
+   RETURN( NoOfItemsInStackAddress(BoolStack) )
+END Top ;
+
+
+(*
+   PushAutoOn - push the auto flag and then set it to TRUE.
+                Any call to ident in the parser will result in the token being pushed.
+*)
+
+PROCEDURE PushAutoOn ;
+BEGIN
+   PushWord(AutoStack, IsAutoOn) ;
+   IsAutoOn := TRUE
+END PushAutoOn ;
+
+
+(*
+   PushAutoOff - push the auto flag and then set it to FALSE.
+*)
+
+PROCEDURE PushAutoOff ;
+BEGIN
+   PushWord(AutoStack, IsAutoOn) ;
+   IsAutoOn := FALSE
+END PushAutoOff ;
+
+
+(*
+   IsAutoPushOn - returns the value of the current Auto ident push flag.
+*)
+
+PROCEDURE IsAutoPushOn () : BOOLEAN ;
+BEGIN
+   RETURN( IsAutoOn )
+END IsAutoPushOn ;
+
+
+(*
+   PopAuto - restores the previous value of the Auto flag.
+*)
+
+PROCEDURE PopAuto ;
+BEGIN
+   IsAutoOn := PopWord(AutoStack)
+END PopAuto ;
+
+
+(*
+   PushInConstExpression - push the InConstExpression flag and then set it to TRUE.
+*)
+
+PROCEDURE PushInConstExpression ;
+BEGIN
+   PushWord(ConstStack, InConstExpression) ;
+   InConstExpression := TRUE
+END PushInConstExpression ;
+
+
+(*
+   PopInConstExpression - restores the previous value of the InConstExpression.
+*)
+
+PROCEDURE PopInConstExpression ;
+BEGIN
+   InConstExpression := PopWord(ConstStack)
+END PopInConstExpression ;
+
+
+(*
+   IsInConstExpression - returns the value of the InConstExpression.
+*)
+
+PROCEDURE IsInConstExpression () : BOOLEAN ;
+BEGIN
+   RETURN( InConstExpression )
+END IsInConstExpression ;
+
+
+(*
+   MustCheckOverflow - returns TRUE if the quadruple should test for overflow.
+*)
+
+PROCEDURE MustCheckOverflow (q: CARDINAL) : BOOLEAN ;
+VAR
+   f: QuadFrame ;
+BEGIN
+   f := GetQF(q) ;
+   RETURN( f^.CheckOverflow )
+END MustCheckOverflow ;
+
+
+(*
+   StressStack -
+*)
+
+(*
+PROCEDURE StressStack ;
+CONST
+   Maxtries = 1000 ;
+VAR
+   n, i, j: CARDINAL ;
+BEGIN
+   PushT(1) ;
+   PopT(i) ;
+   Assert(i=1) ;
+   FOR n := 1 TO Maxtries DO
+      FOR i := n TO 1 BY -1 DO
+         PushT(i)
+      END ;
+      FOR i := n TO 1 BY -1 DO
+         Assert(OperandT(i)=i)
+      END ;
+      FOR i := 1 TO n DO
+         Assert(OperandT(i)=i)
+      END ;
+      FOR i := 1 TO n BY 10 DO
+         Assert(OperandT(i)=i)
+      END ;
+      IF (n>1) AND (n MOD 2 = 0)
+      THEN
+         FOR i := 1 TO n DIV 2 DO
+            PopT(j) ;
+            Assert(j=i)
+         END ;
+         FOR i := n DIV 2 TO 1 BY -1 DO
+            PushT(i)
+         END
+      END ;
+      FOR i := 1 TO n DO
+         PopT(j) ;
+         Assert(j=i)
+      END
+   END
+END StressStack ;
+*)
+
+
+(*
+   Init - initialize the M2Quads module, all the stacks, all the lists
+          and the quads list.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   LogicalOrTok := MakeKey('_LOR') ;
+   LogicalAndTok := MakeKey('_LAND') ;
+   LogicalXorTok := MakeKey('_LXOR') ;
+   LogicalDifferenceTok := MakeKey('_LDIFF') ;
+   QuadArray := InitIndex (1) ;
+   FreeList := 1 ;
+   NewQuad(NextQuad) ;
+   Assert(NextQuad=1) ;
+   BoolStack := InitStackAddress() ;
+   ExitStack := InitStackWord() ;
+   RepeatStack := InitStackWord() ;
+   WhileStack := InitStackWord() ;
+   ForStack := InitStackWord() ;
+   WithStack := InitStackAddress() ;
+   ReturnStack := InitStackWord() ;
+   LineStack := InitStackAddress() ;
+   PriorityStack := InitStackWord() ;
+   TryStack := InitStackWord() ;
+   CatchStack := InitStackWord() ;
+   ExceptStack := InitStackWord() ;
+   ConstructorStack := InitStackAddress() ;
+   ConstStack := InitStackWord() ;
+   (* StressStack ; *)
+   SuppressWith := FALSE ;
+   Head := 1 ;
+   LastQuadNo := 0 ;
+   MustNotCheckBounds := FALSE ;
+   InitQuad := 0 ;
+   GrowInitialization := 0 ;
+   ForInfo := InitIndex (1) ;
+   QuadrupleGeneration := TRUE ;
+   BuildingHigh := FALSE ;
+   BuildingSize := FALSE ;
+   AutoStack := InitStackWord() ;
+   IsAutoOn := TRUE ;
+   InConstExpression := FALSE ;
+   FreeLineList := NIL ;
+   InitList(VarientFields) ;
+   VarientFieldNo := 0 ;
+   NoOfQuads := 0
+END Init ;
+
+
+BEGIN
+   Init
+END M2Quads.
diff --git a/gcc/m2/gm2-compiler/M2Quiet.def b/gcc/m2/gm2-compiler/M2Quiet.def
new file mode 100644
index 00000000000..ec215f6eb8a
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Quiet.def
@@ -0,0 +1,46 @@
+(* M2Quiet.def provides a wrapper to M2Printf.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Quiet ;
+
+(*
+    Title      : M2Quiet
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Oct 12 15:27:27 2001
+    Last edit  : $Date: 2010/10/03 19:01:07 $
+    Revision   : $Version$
+    Description: provides a wrapper to M2Printf the output only occurs if
+                 M2Options.Quiet is set.
+*)
+
+FROM SYSTEM IMPORT BYTE ;
+EXPORT QUALIFIED qprintf0, qprintf1, qprintf2, qprintf3, qprintf4 ;
+
+
+PROCEDURE qprintf0 (a: ARRAY OF CHAR) ;
+PROCEDURE qprintf1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+PROCEDURE qprintf2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+PROCEDURE qprintf3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+PROCEDURE qprintf4 (a: ARRAY OF CHAR; w1, w2, w3, w4: ARRAY OF BYTE) ;
+
+
+END M2Quiet.
diff --git a/gcc/m2/gm2-compiler/M2Quiet.mod b/gcc/m2/gm2-compiler/M2Quiet.mod
new file mode 100644
index 00000000000..b473208ef42
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Quiet.mod
@@ -0,0 +1,74 @@
+(* M2Quiet.mod provides a wrapper to M2Printf.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Quiet ;
+
+(* importing from M2Options is the reason why it is not a good idea to put this into M2Printf *)
+FROM M2Options IMPORT Quiet ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ;
+
+
+PROCEDURE qprintf0 (a: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT Quiet
+   THEN
+      printf0(a)
+   END
+END qprintf0 ;
+
+
+PROCEDURE qprintf1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+BEGIN
+   IF NOT Quiet
+   THEN
+      printf1(a, w)
+   END
+END qprintf1 ;
+
+
+PROCEDURE qprintf2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+BEGIN
+   IF NOT Quiet
+   THEN
+      printf2(a, w1, w2)
+   END
+END qprintf2 ;
+
+
+PROCEDURE qprintf3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+BEGIN
+   IF NOT Quiet
+   THEN
+      printf3(a, w1, w2, w3)
+   END
+END qprintf3 ;
+
+
+PROCEDURE qprintf4 (a: ARRAY OF CHAR; w1, w2, w3, w4: ARRAY OF BYTE) ;
+BEGIN
+   IF NOT Quiet
+   THEN
+      printf4(a, w1, w2, w3, w4)
+   END
+END qprintf4 ;
+
+
+END M2Quiet.
diff --git a/gcc/m2/gm2-compiler/M2Range.def b/gcc/m2/gm2-compiler/M2Range.def
new file mode 100644
index 00000000000..d2bc4f62aea
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Range.def
@@ -0,0 +1,418 @@
+(* M2Range.def exports procedures which maintain the range checking.
+
+Copyright (C) 2008-2022 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/>.  *)
+
+DEFINITION MODULE M2Range ;
+
+(*
+    Title      : M2Range
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu Feb 28 10:18:55 2008
+    Revision   : $Version$
+    Description: exports procedures which maintain the range checking
+                 state which is explored once all the subrange values
+                 have been resolved by the front end (once
+                 M2GCCDeclare has completed its task).  We cannot
+                 perform this activity during M2Quads, as we dont
+                 know the subrange values and also we can do so much
+                 more once optimization has occurred.  It should be
+                 possible to detect simple overflow errors at compile
+                 time, post optimization.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED InitAssignmentRangeCheck,
+                 InitReturnRangeCheck,
+                 InitSubrangeRangeCheck,
+                 InitStaticArraySubscriptRangeCheck,
+                 InitDynamicArraySubscriptRangeCheck,
+                 InitIncRangeCheck,
+                 InitDecRangeCheck,
+                 InitInclCheck,
+                 InitExclCheck,
+                 InitRotateCheck,
+                 InitShiftCheck,
+                 InitTypesExpressionCheck,
+                 InitTypesAssignmentCheck,
+                 InitTypesParameterCheck,
+                 InitParameterRangeCheck,
+                 InitForLoopBeginRangeCheck,
+                 InitForLoopToRangeCheck,
+                 InitForLoopEndRangeCheck,
+                 InitPointerRangeCheck,
+                 InitNoReturnRangeCheck,
+                 InitNoElseRangeCheck,
+                 InitCaseBounds,
+                 InitWholeNonPosDivCheck,
+                 InitWholeNonPosModCheck,
+                 InitWholeZeroDivisionCheck,
+                 InitWholeZeroRemainderCheck,
+                 CodeRangeCheck, FoldRangeCheck, CodeErrorCheck,
+                 (* CheckRangeAddVariableRead,  *)
+                 (* CheckRangeRemoveVariableRead,  *)
+                 WriteRangeCheck,
+                 OverlapsRange,
+                 IsEqual, IsGreaterOrEqual, IsGreater,
+		 BuildIfCallRealHandlerLoc,
+                 BuildIfCallWholeHandlerLoc,
+		 GetMinMax ;
+
+
+(*
+   InitAssignmentRangeCheck - returns a range check node which
+                              remembers the information necessary
+                              so that a range check for d := e
+                              can be generated later on.
+*)
+
+PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitReturnRangeCheck - returns a range check node which
+                           remembers the information necessary
+                           so that a range check for RETURN e
+                           from procedure, d, can be generated later on.
+*)
+
+PROCEDURE InitReturnRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitSubrangeRangeCheck - returns a range check node which
+                            remembers the information necessary
+                            so that a range check for d := e
+                            can be generated later on.
+*)
+
+PROCEDURE InitSubrangeRangeCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitStaticArraySubscriptRangeCheck - returns a range check node which
+                                        remembers the information necessary
+                                        so that a range check for d[e]
+                                        can be generated later on.
+*)
+
+PROCEDURE InitStaticArraySubscriptRangeCheck (d, e, dim: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitDynamicArraySubscriptRangeCheck - returns a range check node which
+                                         remembers the information necessary
+                                         so that a range check for d[e]
+                                         can be generated later on.
+*)
+
+PROCEDURE InitDynamicArraySubscriptRangeCheck (d, e, dim: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitIncRangeCheck - returns a range check node which
+                       remembers the information necessary
+                       so that a range check for INC(d, e)
+                       can be generated later on.
+*)
+
+PROCEDURE InitIncRangeCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitDecRangeCheck - returns a range check node which
+                       remembers the information necessary
+                       so that a range check for DEC(d, e)
+                       can be generated later on.
+*)
+
+PROCEDURE InitDecRangeCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitForLoopBeginRangeCheck - returns a range check node which
+                                remembers the information necessary
+                                so that a range check for FOR d := e TO .. DO
+                                can be generated later on.
+*)
+
+PROCEDURE InitForLoopBeginRangeCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitForLoopToRangeCheck - returns a range check node which
+                             remembers the information necessary
+                             so that a range check for the final value
+                             implied by ... e1 TO e2 BY e3 DO
+                             can be generated later on.
+*)
+
+PROCEDURE InitForLoopToRangeCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitForLoopEndRangeCheck - returns a range check node which
+                              remembers the information necessary
+                              so that a range check for
+                              INC or DEC(d, e)
+                              can be generated later on.
+*)
+
+PROCEDURE InitForLoopEndRangeCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitPointerRangeCheck - creates a pointer # NIL check.
+*)
+
+PROCEDURE InitPointerRangeCheck (tokno: CARDINAL;
+                                 d: CARDINAL; isLeft: BOOLEAN) : CARDINAL ;
+
+
+(*
+   InitNoReturnRangeCheck - creates a check held in the function
+                            to detect the absence of a RETURN
+                            statement at runtime.
+*)
+
+PROCEDURE InitNoReturnRangeCheck () : CARDINAL ;
+
+
+(*
+   InitNoElseRangeCheck - creates a check held at the end of
+                          a CASE statement without an ELSE
+                          clause to detect its absence
+                          at runtime.
+*)
+
+PROCEDURE InitNoElseRangeCheck () : CARDINAL ;
+
+
+(*
+   InitWholeNonPosDivCheck - creates a check expression for non positive
+                             or zero 2nd operand to division.
+*)
+
+PROCEDURE InitWholeNonPosDivCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitWholeNonPosModCheck - creates a check expression for non positive
+                             or zero 2nd operand to modulus.
+*)
+
+PROCEDURE InitWholeNonPosModCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitWholeZeroDivisionCheck - creates a check expression for zero 2nd
+                                operand for division.
+*)
+
+PROCEDURE InitWholeZeroDivisionCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitWholeZeroRemainderCheck - creates a check expression for zero 2nd
+                                 operand for remainder.
+*)
+
+PROCEDURE InitWholeZeroRemainderCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitInclCheck - checks to see that bit, e, is type compatible with
+                   d and also in range.
+*)
+
+PROCEDURE InitInclCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitExclCheck - checks to see that bit, e, is type compatible with
+                   d and also in range.
+*)
+
+PROCEDURE InitExclCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitShiftCheck - checks to see that bit, e, is type compatible with
+                    d and also in range.
+*)
+
+PROCEDURE InitShiftCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitRotateCheck - checks to see that bit, e, is type compatible with
+                     d and also in range.
+*)
+
+PROCEDURE InitRotateCheck (d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitTypesAssignmentCheck - checks to see that the types of, d, and, e,
+                              are assignment compatible.
+*)
+
+PROCEDURE InitTypesAssignmentCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitTypesParameterCheck - checks to see that the types of, d, and, e,
+                             are parameter compatible.
+*)
+
+PROCEDURE InitTypesParameterCheck (proc: CARDINAL; i: CARDINAL;
+                                   formal, actual: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitParameterRangeCheck - checks to see that the types of, d, and, e,
+                             are parameter compatible.
+*)
+
+PROCEDURE InitParameterRangeCheck (proc: CARDINAL; i: CARDINAL;
+                                   formal, actual: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitTypesExpressionCheck - checks to see that the types of, d, and, e,
+                              are expression compatible.
+*)
+
+PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL;
+                                    strict, isin: BOOLEAN) : CARDINAL ;
+
+
+(*
+   InitCaseBounds - creates a case bound range check.
+*)
+
+PROCEDURE InitCaseBounds (b: CARDINAL) : CARDINAL ;
+
+
+(*
+   CodeRangeCheck - creates a sequence of Trees representing the code for a
+                    range test defined by, r.
+*)
+
+PROCEDURE CodeRangeCheck (r: CARDINAL; function: String) ;
+
+
+(*
+   FoldRangeCheck - returns a Tree representing the code for a
+                    range test defined by, r.
+*)
+
+PROCEDURE FoldRangeCheck (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+
+
+(*
+   CodeErrorCheck - returns a Tree calling the approprate exception handler.
+*)
+
+PROCEDURE CodeErrorCheck (r: CARDINAL; function, message: String) : Tree ;
+
+
+(*
+   CheckRangeAddVariableRead - ensures that any references to reading
+                               variables used by this range check, r,
+                               at this, quadNo, are recorded in the
+                               symbol table.
+*)
+
+(* PROCEDURE CheckRangeAddVariableRead (r: CARDINAL; quadNo: CARDINAL) ; *)
+
+
+(*
+   CheckRangeRemoveVariableRead - ensures that any references to reading
+                                  variable at this quadNo are removed from
+                                  the symbol table.
+*)
+
+(* PROCEDURE CheckRangeRemoveVariableRead (r: CARDINAL; quadNo: CARDINAL) ; *)
+
+
+(*
+   WriteRangeCheck - displays debugging information about range, r.
+*)
+
+PROCEDURE WriteRangeCheck (r: CARDINAL) ;
+
+
+(*
+   OverlapsRange - returns TRUE if a1..a2 overlaps with b1..b2.
+*)
+
+PROCEDURE OverlapsRange (a1, a2, b1, b2: Tree) : BOOLEAN ;
+
+
+(*
+   IsEqual - returns TRUE if a=b.
+*)
+
+PROCEDURE IsEqual (a, b: Tree) : BOOLEAN ;
+
+
+(*
+   IsGreaterOrEqual - returns TRUE if a>=b.
+*)
+
+PROCEDURE IsGreaterOrEqual (a, b: Tree) : BOOLEAN ;
+
+
+(*
+   IsGreater - returns TRUE if a>b.
+*)
+
+PROCEDURE IsGreater (a, b: Tree) : BOOLEAN ;
+
+
+(*
+   BuildIfCallWholeHandlerLoc - return a Tree containing a runtime test whether, condition, is true.
+*)
+
+PROCEDURE BuildIfCallWholeHandlerLoc (location: location_t; condition: Tree;
+                                      scope, message: ADDRESS) : Tree ;
+
+
+(*
+   BuildIfCallRealHandlerLoc - return a Tree containing a runtime test whether, condition, is true.
+*)
+
+PROCEDURE BuildIfCallRealHandlerLoc (location: location_t; condition: Tree;
+                                     scope, message: ADDRESS) : Tree ;
+
+
+(*
+   GetMinMax - returns TRUE if we know the max and min of a type, t.
+*)
+
+PROCEDURE GetMinMax (tokenno: CARDINAL; type: CARDINAL; VAR min, max: Tree) : BOOLEAN ;
+
+
+END M2Range.
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
new file mode 100644
index 00000000000..fa84515a73e
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -0,0 +1,3472 @@
+(* M2Range.mod exports procedures which maintain the range checking.
+
+Copyright (C) 2008-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Range ;
+
+
+FROM SymbolTable IMPORT NulSym, GetLowestType, PutReadQuad, RemoveReadQuad,
+                        IsVar, IsConst, PushValue, GetSubrange, GetType,
+                        IsSubrange, GetSymName, IsTemporary, IsSet,
+                        IsRecord, IsPointer, IsArray, IsProcType, IsConstLit,
+                        IsAModula2Type, IsUnbounded, IsEnumeration, GetMode,
+                        IsConstString, MakeConstLit, SkipType, IsProcedure,
+                        IsParameter, GetDeclaredMod, IsVarParam, GetNthParam,
+                        ModeOfAddr ;
+
+FROM m2tree IMPORT Tree, debug_tree ;
+FROM m2linemap IMPORT ErrorAt, GetFilenameFromLocation, GetColumnNoFromLocation, GetLineNoFromLocation ;
+
+FROM m2type IMPORT GetMinFrom, GetMaxFrom,
+                   GetIntegerType, GetTreeType,
+                   GetPointerType,
+                   AddStatement ;
+
+FROM m2statement IMPORT BuildProcedureCallTree, BuildIfThenElseEnd, BuildIfThenDoEnd ;
+
+FROM m2expr IMPORT CompareTrees, BuildSub, BuildAdd, GetIntegerZero, GetIntegerOne,
+                   BuildAddr, BuildIndirect, BuildGreaterThan, BuildLessThan,
+                   BuildGreaterThanOrEqual,
+                   GetPointerZero, BuildNegate, BuildEqualTo, BuildLessThanOrEqual,
+                   IsTrue, IsFalse, TreeOverflow ;
+
+FROM m2convert IMPORT BuildConvert ;
+FROM m2statement IMPORT BuildParam ;
+FROM m2decl IMPORT BuildStringConstant, BuildIntegerConstant ;
+FROM m2builtins IMPORT BuiltInIsfinite ;
+
+FROM M2Debug IMPORT Assert ;
+FROM Indexing IMPORT Index, InitIndex, InBounds, PutIndice, GetIndice ;
+FROM Storage IMPORT ALLOCATE ;
+FROM M2ALU IMPORT PushIntegerTree, PushInt, ConvertToInt, Equ, Gre, Less, GreEqu ;
+FROM M2Options IMPORT VariantValueChecking ;
+
+FROM M2Error IMPORT Error, InternalError, ErrorFormat0, ErrorFormat1, ErrorFormat2, FlushErrors,
+                    GetAnnounceScope ;
+
+FROM M2ColorString IMPORT quoteOpen, quoteClose ;
+
+FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3,
+                        MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3,
+                        MetaErrorsT1, MetaErrorsT2, MetaErrorsT3, MetaErrorsT4,
+                        MetaErrorStringT1, MetaErrorStringT2, MetaErrorStringT3,
+                        MetaString3 ;
+
+FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo, FindFileNameFromToken, TokenToLineNo, TokenToColumnNo, TokenToLocation ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM M2GCCDeclare IMPORT TryDeclareConstant, DeclareConstructor ;
+FROM M2Quads IMPORT QuadOperator, PutQuad, SubQuad, WriteOperand ;
+FROM SymbolConversion IMPORT GccKnowsAbout, Mod2Gcc ;
+FROM Lists IMPORT List ;
+FROM NameKey IMPORT Name, MakeKey, KeyToCharStar ;
+FROM StdIO IMPORT Write ;
+FROM DynamicStrings IMPORT String, string, Length, InitString, ConCat, ConCatChar, Mark, InitStringCharStar, KillString ;
+FROM M2GenGCC IMPORT GetHighFromUnbounded, StringToChar, LValueToGenericPtr, ZConstToTypedConst ;
+FROM M2System IMPORT Address, Word, Loc, Byte, IsWordN, IsRealN, IsComplexN ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2 ;
+
+FROM M2Check IMPORT ParameterTypeCompatible, ExpressionTypeCompatible ;
+
+FROM M2Base IMPORT Nil, IsRealType, GetBaseTypeMinMax,
+                   Cardinal, Integer, ZType, IsComplexType,
+                   IsAssignmentCompatible,
+                   IsExpressionCompatible,
+                   IsParameterCompatible,
+                   ExceptionAssign,
+                   ExceptionReturn,
+                   ExceptionInc, ExceptionDec,
+                   ExceptionIncl, ExceptionExcl,
+                   ExceptionShift, ExceptionRotate,
+                   ExceptionStaticArray, ExceptionDynamicArray,
+                   ExceptionForLoopBegin, ExceptionForLoopTo, ExceptionForLoopEnd,
+                   ExceptionPointerNil, ExceptionNoReturn, ExceptionCase,
+                   ExceptionNonPosDiv, ExceptionNonPosMod,
+                   ExceptionZeroDiv, ExceptionZeroRem,
+		   ExceptionWholeValue, ExceptionRealValue,
+                   ExceptionParameterBounds,
+                   ExceptionNo ;
+
+FROM M2CaseList IMPORT CaseBoundsResolved, OverlappingCaseBounds, WriteCase, MissingCaseBounds, TypeCaseBounds ;
+
+
+TYPE
+   TypeOfRange = (assignment, returnassignment, subrangeassignment,
+                  inc, dec, incl, excl, shift, rotate,
+                  typeexpr, typeassign, typeparam, paramassign,
+                  staticarraysubscript,
+                  dynamicarraysubscript,
+                  forloopbegin, forloopto, forloopend,
+                  pointernil, noreturn, noelse,
+                  casebounds,
+                  wholenonposdiv, wholenonposmod,
+                  wholezerodiv, wholezerorem, none) ;
+
+   Range = POINTER TO RECORD
+                         type          : TypeOfRange ;
+                         des,
+                         expr,
+                         desLowestType,
+                         exprLowestType: CARDINAL ;
+                         procedure     : CARDINAL ;
+                         paramNo       : CARDINAL ;
+                         isLeftValue   : BOOLEAN ;   (* is des an LValue,
+                                                        only used in pointernil *)
+                         dimension     : CARDINAL ;
+                         caseList      : CARDINAL ;
+                         tokenNo       : CARDINAL ;
+                         errorReported : BOOLEAN ;  (* error message reported yet? *)
+                         strict        : BOOLEAN ;  (* is it a comparison expression?  *)
+                         isin          : BOOLEAN ;  (* expression created by IN operator?  *)
+                      END ;
+
+
+VAR
+   TopOfRange: CARDINAL ;
+   RangeIndex: Index ;
+
+
+(*
+   OverlapsRange - returns TRUE if a1..a2 overlaps with b1..b2.
+*)
+
+PROCEDURE OverlapsRange (a1, a2, b1, b2: Tree) : BOOLEAN ;
+BEGIN
+   (* RETURN( ((a1<=b2) AND (a2>=b1)) ) *)
+   RETURN( (CompareTrees(a1, b2)<=0) AND (CompareTrees(a2, b1)>=0) )
+END OverlapsRange ;
+
+
+(*
+   IsGreater - returns TRUE if a>b.
+*)
+
+PROCEDURE IsGreater (a, b: Tree) : BOOLEAN ;
+BEGIN
+   RETURN( CompareTrees(a, b)>0 )
+END IsGreater ;
+
+
+(*
+   IsGreaterOrEqual - returns TRUE if a>=b.
+*)
+
+PROCEDURE IsGreaterOrEqual (a, b: Tree) : BOOLEAN ;
+BEGIN
+   RETURN( CompareTrees(a, b)>=0 )
+END IsGreaterOrEqual ;
+
+
+(*
+   IsEqual - returns TRUE if a=b.
+*)
+
+PROCEDURE IsEqual (a, b: Tree) : BOOLEAN ;
+BEGIN
+   RETURN( CompareTrees(a, b)=0 )
+END IsEqual ;
+
+
+(*
+   IsGreaterOrEqualConversion - tests whether t>=e.
+*)
+
+PROCEDURE IsGreaterOrEqualConversion (location: location_t; l: CARDINAL; d, e: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF GetType(d)=NulSym
+   THEN
+      IF GetType(e)=NulSym
+      THEN
+         RETURN( IsGreaterOrEqual(Mod2Gcc(l), LValueToGenericPtr(location, e)) )
+      ELSE
+         RETURN( IsGreaterOrEqual(BuildConvert(location, Mod2Gcc(SkipType(GetType(e))), Mod2Gcc(l), FALSE),
+                                  LValueToGenericPtr(location, e)) )
+      END
+   ELSE
+      RETURN( IsGreaterOrEqual(BuildConvert(location, Mod2Gcc(SkipType(GetType(d))), Mod2Gcc(l), FALSE),
+                               LValueToGenericPtr(location, e)) )
+   END
+END IsGreaterOrEqualConversion ;
+
+
+(*
+   IsEqualConversion - returns TRUE if a=b.
+*)
+
+PROCEDURE IsEqualConversion (l: CARDINAL; d, e: CARDINAL) : BOOLEAN ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(GetDeclaredMod(l)) ;
+   IF GetType(d)=NulSym
+   THEN
+      IF GetType(e)=NulSym
+      THEN
+         RETURN( IsEqual(Mod2Gcc(l), LValueToGenericPtr(location, e)) )
+      ELSE
+         RETURN( IsEqual(BuildConvert(location, Mod2Gcc(SkipType(GetType(e))), Mod2Gcc(l), FALSE),
+                         LValueToGenericPtr(location, e)) )
+      END
+   ELSE
+      RETURN( IsEqual(BuildConvert(location, Mod2Gcc(SkipType(GetType(d))), Mod2Gcc(l), FALSE),
+                      LValueToGenericPtr(location, e)) )
+   END
+END IsEqualConversion ;
+
+
+(*
+   lookupExceptionHandler -
+*)
+
+PROCEDURE lookupExceptionHandler (type: TypeOfRange) : CARDINAL ;
+BEGIN
+   CASE type OF
+
+   assignment           : RETURN( ExceptionAssign ) |
+   returnassignment     : RETURN( ExceptionReturn ) |
+   subrangeassignment   : InternalError ('not expecting this case value') |
+   inc                  : RETURN( ExceptionInc ) |
+   dec                  : RETURN( ExceptionDec ) |
+   incl                 : RETURN( ExceptionIncl ) |
+   excl                 : RETURN( ExceptionExcl ) |
+   shift                : RETURN( ExceptionShift ) |
+   rotate               : RETURN( ExceptionRotate ) |
+   typeassign           : InternalError ('not expecting this case value') |
+   typeparam            : InternalError ('not expecting this case value') |
+   typeexpr             : InternalError ('not expecting this case value') |
+   paramassign          : RETURN( ExceptionParameterBounds ) |
+   staticarraysubscript : RETURN( ExceptionStaticArray ) |
+   dynamicarraysubscript: RETURN( ExceptionDynamicArray ) |
+   forloopbegin         : RETURN( ExceptionForLoopBegin ) |
+   forloopto            : RETURN( ExceptionForLoopTo ) |
+   forloopend           : RETURN( ExceptionForLoopEnd ) |
+   pointernil           : RETURN( ExceptionPointerNil ) |
+   noreturn             : RETURN( ExceptionNoReturn ) |
+   noelse               : RETURN( ExceptionCase ) |
+   casebounds           : InternalError ('not expecting this case value') |
+   wholenonposdiv       : RETURN( ExceptionNonPosDiv ) |
+   wholenonposmod       : RETURN( ExceptionNonPosMod ) |
+   wholezerodiv         : RETURN( ExceptionZeroDiv ) |
+   wholezerorem         : RETURN( ExceptionZeroRem ) |
+   none                 : RETURN( ExceptionNo )
+
+   ELSE
+      InternalError ('enumeration value unknown')
+   END
+END lookupExceptionHandler ;
+
+
+(*
+   InitRange - returns a new range item.
+*)
+
+PROCEDURE InitRange () : CARDINAL ;
+VAR
+   r: CARDINAL ;
+   p: Range ;
+BEGIN
+   INC(TopOfRange) ;
+   r := TopOfRange ;
+   NEW(p) ;
+   IF p=NIL
+   THEN
+      InternalError ('out of memory error')
+   ELSE
+      WITH p^ DO
+         type           := none ;
+         des            := NulSym ;
+         expr           := NulSym ;
+         desLowestType  := NulSym ;
+         exprLowestType := NulSym ;
+         isLeftValue    := FALSE ;   (* ignored in all cases other *)
+         dimension      := 0 ;
+         caseList       := 0 ;
+         tokenNo        := 0 ;       (* than pointernil            *)
+         errorReported  := FALSE
+      END ;
+      PutIndice(RangeIndex, r, p)
+   END ;
+   RETURN( r )
+END InitRange ;
+
+
+(*
+   reportedError - returns whether this is the first time this error has been
+                   reported.
+*)
+
+PROCEDURE reportedError (r: CARDINAL) : BOOLEAN ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice (RangeIndex, r) ;
+   RETURN p^.errorReported
+END reportedError ;
+
+
+(*
+   setReported - assigns errorReported to TRUE.
+*)
+
+PROCEDURE setReported (r: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice (RangeIndex, r) ;
+   p^.errorReported := TRUE
+END setReported ;
+
+
+(*
+   PutRange - initializes contents of, p, to
+              d, e and their lowest types.
+              It also fills in the current token no
+              and returns, p.
+*)
+
+PROCEDURE PutRange (tokno: CARDINAL; p: Range; t: TypeOfRange; d, e: CARDINAL) : Range ;
+BEGIN
+   WITH p^ DO
+      type           := t ;
+      des            := d ;
+      expr           := e ;
+      desLowestType  := GetLowestType (d) ;
+      exprLowestType := GetLowestType (e) ;
+      tokenNo        := tokno ;
+      strict         := FALSE ;
+      isin           := FALSE
+   END ;
+   RETURN p
+END PutRange ;
+
+
+(*
+   chooseTokenPos - returns, tokenpos, if it is not the unknown location, otherwise
+                    it returns GetTokenNo.
+*)
+
+PROCEDURE chooseTokenPos (tokenpos: CARDINAL) : CARDINAL ;
+BEGIN
+   IF tokenpos = UnknownTokenNo
+   THEN
+      RETURN GetTokenNo ()
+   ELSE
+      RETURN tokenpos
+   END
+END chooseTokenPos ;
+
+
+(*
+   PutRangeNoLow - initializes contents of, p.  It
+                   does not set lowest types as they may be
+                   unknown at this point.
+*)
+
+PROCEDURE PutRangeNoLow (tokpos: CARDINAL; p: Range; t: TypeOfRange; d, e: CARDINAL) : Range ;
+BEGIN
+   WITH p^ DO
+      type           := t ;
+      des            := d ;
+      expr           := e ;
+      desLowestType  := NulSym ;
+      exprLowestType := NulSym ;
+      isLeftValue    := FALSE ;
+      tokenNo        := chooseTokenPos (tokpos) ;
+      strict         := FALSE ;
+      isin           := FALSE
+   END ;
+   RETURN p
+END PutRangeNoLow ;
+
+
+(*
+   PutRangeExpr - initializes contents of, p.  It
+                  does not set lowest types as they may be
+                  unknown at this point.
+*)
+
+PROCEDURE PutRangeExpr (tokpos: CARDINAL; p: Range; t: TypeOfRange;
+                        d, e: CARDINAL; strict, isin: BOOLEAN) : Range ;
+BEGIN
+   WITH p^ DO
+      type           := t ;
+      des            := d ;
+      expr           := e ;
+      desLowestType  := NulSym ;
+      exprLowestType := NulSym ;
+      isLeftValue    := FALSE ;
+      tokenNo        := chooseTokenPos (tokpos) ;
+   END ;
+   p^.strict := strict ;
+   p^.isin := isin ;
+   RETURN p
+END PutRangeExpr ;
+
+
+(*
+   PutRangePointer - initializes contents of, p, to
+                     d, isLeft and their lowest types.
+                     It also fills in the current token no
+                     and returns, p.
+*)
+
+PROCEDURE PutRangePointer (tokpos: CARDINAL;
+                           p: Range; d: CARDINAL; isLeft: BOOLEAN) : Range ;
+BEGIN
+   WITH p^ DO
+      type           := pointernil ;
+      des            := d ;
+      expr           := NulSym ;
+      desLowestType  := GetLowestType(GetType(d)) ;
+      exprLowestType := NulSym ;
+      isLeftValue    := isLeft ;
+      tokenNo        := tokpos ;
+      strict         := FALSE ;
+      isin           := FALSE
+   END ;
+   RETURN p
+END PutRangePointer ;
+
+
+(*
+   PutRangeNoEval - initializes contents of, p, to a non evaluation
+                    runtime check such as a no else clause or
+                    no return found in function call.
+*)
+
+PROCEDURE PutRangeNoEval (p: Range; t: TypeOfRange) : Range ;
+BEGIN
+   WITH p^ DO
+      type    := t ;
+      tokenNo := GetTokenNo ()
+   END ;
+   RETURN p
+END PutRangeNoEval ;
+
+
+(*
+   PutRange - initializes contents of, p, to
+              d, e and its lowest type.
+              It also fills in the current token no
+              and returns, p.
+*)
+
+PROCEDURE PutRangeUnary (tokno: CARDINAL; p: Range; t: TypeOfRange; d, e: CARDINAL) : Range ;
+BEGIN
+   WITH p^ DO
+      type           := t ;
+      des            := d ;
+      expr           := e ;
+      desLowestType  := GetLowestType(d) ;
+      exprLowestType := NulSym ;
+      isLeftValue    := FALSE ;
+      tokenNo        := chooseTokenPos (tokno) ;
+      strict         := FALSE ;
+      isin           := FALSE
+   END ;
+   RETURN( p )
+END PutRangeUnary ;
+
+
+(*
+   PutRangeParam - initializes contents of, p, to contain the parameter
+                   type checking information.
+                   It also fills in the current token no
+                   and returns, p.
+*)
+
+PROCEDURE PutRangeParam (p: Range; t: TypeOfRange; proc: CARDINAL;
+                         i: CARDINAL; formal, actual: CARDINAL) : Range ;
+BEGIN
+   WITH p^ DO
+      type           := t ;
+      des            := formal ;
+      expr           := actual ;
+      desLowestType  := NulSym ;
+      exprLowestType := NulSym ;
+      procedure      := proc ;
+      paramNo        := i ;
+      isLeftValue    := FALSE ;
+      tokenNo        := GetTokenNo () ;
+      strict         := FALSE ;
+      isin           := FALSE
+   END ;
+   RETURN p
+END PutRangeParam ;
+
+
+(*
+   PutRangeArraySubscript - initializes contents of, p, to
+                            d, e and their lowest types.  It also
+                            assigns, dim.
+                            It also fills in the current token no
+                            and returns, p.
+*)
+
+PROCEDURE PutRangeArraySubscript (p: Range; t: TypeOfRange;
+                                  d, e: CARDINAL; dim: CARDINAL) : Range ;
+BEGIN
+   WITH p^ DO
+      type           := t ;
+      des            := d ;
+      expr           := e ;
+      desLowestType  := GetLowestType(d) ;
+      exprLowestType := GetLowestType(e) ;
+      dimension      := dim ;
+      tokenNo        := GetTokenNo () ;
+      strict         := FALSE ;
+      isin           := FALSE
+   END ;
+   RETURN p
+END PutRangeArraySubscript ;
+
+
+(*
+   InitAssignmentRangeCheck - returns a range check node which
+                              remembers the information necessary
+                              so that a range check for d := e
+                              can be generated later on.
+*)
+
+PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRange (tokno, GetIndice (RangeIndex, r), assignment, d, e) # NIL) ;
+   RETURN r
+END InitAssignmentRangeCheck ;
+
+
+(*
+   InitReturnRangeCheck - returns a range check node which
+                          remembers the information necessary
+                          so that a range check for RETURN e
+                          from procedure, d, can be generated later on.
+*)
+
+PROCEDURE InitReturnRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRange (tokno, GetIndice (RangeIndex, r), returnassignment, d, e) # NIL) ;
+   RETURN r
+END InitReturnRangeCheck ;
+
+
+(*
+   InitSubrangeRangeCheck - returns a range check node which
+                            remembers the information necessary
+                            so that a range check for d := e
+                            can be generated later on.
+*)
+
+PROCEDURE InitSubrangeRangeCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), subrangeassignment, d, e) # NIL) ;
+   RETURN r
+END InitSubrangeRangeCheck ;
+
+
+(*
+   InitStaticArraySubscriptRangeCheck - returns a range check node which
+                                        remembers the information necessary
+                                        so that a range check for d[e]
+                                        can be generated later on.
+*)
+
+PROCEDURE InitStaticArraySubscriptRangeCheck (d, e, dim: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeArraySubscript (GetIndice (RangeIndex, r), staticarraysubscript, d, e, dim) # NIL) ;
+   RETURN r
+END InitStaticArraySubscriptRangeCheck ;
+
+
+(*
+   InitDynamicArraySubscriptRangeCheck - returns a range check node which
+                                         remembers the information necessary
+                                         so that a range check for d[e]
+                                         can be generated later on.
+*)
+
+PROCEDURE InitDynamicArraySubscriptRangeCheck (d, e, dim: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeArraySubscript (GetIndice (RangeIndex, r), dynamicarraysubscript, d, e, dim) # NIL) ;
+   RETURN r
+END InitDynamicArraySubscriptRangeCheck ;
+
+
+(*
+   InitIncRangeCheck - returns a range check node which
+                       remembers the information necessary
+                       so that a range check for INC(d, e)
+                       can be generated later on.
+*)
+
+PROCEDURE InitIncRangeCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), inc, d, e) # NIL) ;
+   RETURN r
+END InitIncRangeCheck ;
+
+
+(*
+   InitDecRangeCheck - returns a range check node which
+                       remembers the information necessary
+                       so that a range check for DEC(d, e)
+                       can be generated later on.
+*)
+
+PROCEDURE InitDecRangeCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), dec, d, e) # NIL) ;
+   RETURN r
+END InitDecRangeCheck ;
+
+
+(*
+   InitInclCheck - checks to see that bit, e, is type compatible with
+                   e and also in range.
+*)
+
+PROCEDURE InitInclCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), incl, d, e) # NIL) ;
+   RETURN r
+END InitInclCheck ;
+
+
+(*
+   InitExclCheck - checks to see that bit, e, is type compatible with
+                   e and also in range.
+*)
+
+PROCEDURE InitExclCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), excl, d, e) # NIL) ;
+   RETURN r
+END InitExclCheck ;
+
+
+(*
+   InitShiftCheck - checks to see that bit, e, is type compatible with
+                    d and also in range.
+*)
+
+PROCEDURE InitShiftCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), shift, d, e) # NIL) ;
+   RETURN r
+END InitShiftCheck ;
+
+
+(*
+   InitRotateCheck - checks to see that bit, e, is type compatible with
+                     d and also in range.
+*)
+
+PROCEDURE InitRotateCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoLow (GetTokenNo (), GetIndice (RangeIndex, r), rotate, d, e) # NIL) ;
+   RETURN r
+END InitRotateCheck ;
+
+
+(*
+   InitTypesAssignmentCheck - checks to see that the types of, d, and, e,
+                              are assignment compatible.
+*)
+
+PROCEDURE InitTypesAssignmentCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typeassign, d, e) # NIL) ;
+   RETURN r
+END InitTypesAssignmentCheck ;
+
+
+(*
+   InitTypesParameterCheck - checks to see that the types of, d,
+                             and, e, are parameter compatible.
+*)
+
+PROCEDURE InitTypesParameterCheck (proc: CARDINAL; i: CARDINAL;
+                                   formal, actual: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeParam (GetIndice (RangeIndex, r), typeparam, proc, i, formal, actual) # NIL) ;
+   RETURN r
+END InitTypesParameterCheck ;
+
+
+(*
+   PutRangeParamAssign - initializes contents of, p, to contain the parameter
+                         type checking information.
+                         It also fills in the current token no
+                         and returns, p.
+*)
+
+PROCEDURE PutRangeParamAssign (p: Range; t: TypeOfRange; proc: CARDINAL;
+                               i: CARDINAL; formal, actual: CARDINAL) : Range ;
+BEGIN
+   WITH p^ DO
+      type           := t ;
+      des            := formal ;
+      expr           := actual ;
+      desLowestType  := GetLowestType (des) ;
+      exprLowestType := GetLowestType (expr) ;
+      procedure      := proc ;
+      paramNo        := i ;
+      dimension      := i ;
+      isLeftValue    := FALSE ;
+      tokenNo        := GetTokenNo ()
+   END ;
+   RETURN( p )
+END PutRangeParamAssign ;
+
+
+(*
+   InitParameterRangeCheck - checks to see that the types of, d, and, e,
+                             are parameter compatible.
+*)
+
+PROCEDURE InitParameterRangeCheck (proc: CARDINAL; i: CARDINAL;
+                                   formal, actual: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeParamAssign (GetIndice (RangeIndex, r), paramassign, proc, i, formal, actual) # NIL) ;
+   RETURN r
+END InitParameterRangeCheck ;
+
+
+(*
+   InitTypesExpressionCheck - checks to see that the types of, d, and, e,
+                              are expression compatible.
+*)
+
+PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL; strict, isin: BOOLEAN) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange() ;
+   Assert (PutRangeExpr (tokno, GetIndice (RangeIndex, r), typeexpr, d, e, strict, isin) # NIL) ;
+   RETURN r
+END InitTypesExpressionCheck ;
+
+
+(*
+   InitForLoopBeginRangeCheck - returns a range check node which
+                                remembers the information necessary
+                                so that a range check for FOR d := e TO .. DO
+                                can be generated later on.
+*)
+
+PROCEDURE InitForLoopBeginRangeCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopbegin, d, e) # NIL) ;
+   RETURN r
+END InitForLoopBeginRangeCheck ;
+
+
+(*
+   InitForLoopToRangeCheck - returns a range check node which
+                             remembers the information necessary
+                             so that a range check for FOR d := e TO .. DO
+                             can be generated later on.
+*)
+
+PROCEDURE InitForLoopToRangeCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopto, d, e) # NIL) ;
+   RETURN r
+END InitForLoopToRangeCheck ;
+
+
+(*
+   InitForLoopEndRangeCheck - returns a range check node which
+                              remembers the information necessary
+                              so that a range check for
+                              INC or DEC(d, e)
+                              can be generated later on.
+*)
+
+PROCEDURE InitForLoopEndRangeCheck (d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRange (GetTokenNo (), GetIndice (RangeIndex, r), forloopend, d, e) # NIL) ;
+   RETURN r
+END InitForLoopEndRangeCheck ;
+
+
+(*
+   InitPointerRangeCheck - creates a pointer # NIL check.
+*)
+
+PROCEDURE InitPointerRangeCheck (tokno: CARDINAL;
+                                 d: CARDINAL; isLeft: BOOLEAN) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangePointer (tokno, GetIndice (RangeIndex, r), d, isLeft) # NIL) ;
+   RETURN r
+END InitPointerRangeCheck ;
+
+
+(*
+   InitNoReturnRangeCheck - creates a check held in the function
+                            to detect the absence of a RETURN
+                            statement at runtime.
+*)
+
+PROCEDURE InitNoReturnRangeCheck () : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoEval (GetIndice(RangeIndex, r), noreturn) # NIL) ;
+   RETURN r
+END InitNoReturnRangeCheck ;
+
+
+(*
+   InitNoElseRangeCheck - creates a check held at the end of
+                          a CASE statement without an ELSE
+                          clause to detect its absence
+                          at runtime.
+*)
+
+PROCEDURE InitNoElseRangeCheck () : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeNoEval (GetIndice (RangeIndex, r), noelse) # NIL) ;
+   RETURN r
+END InitNoElseRangeCheck ;
+
+
+(*
+   InitWholeNonPosDivCheck - creates a check expression for non positive
+                             or zero 2nd operand to division.
+*)
+
+PROCEDURE InitWholeNonPosDivCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholenonposdiv, d, e) # NIL) ;
+   RETURN r
+END InitWholeNonPosDivCheck ;
+
+
+(*
+   InitWholeNonPosModCheck - creates a check expression for non positive
+                             or zero 2nd operand to modulus.
+*)
+
+PROCEDURE InitWholeNonPosModCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholenonposmod, d, e) # NIL) ;
+   RETURN r
+END InitWholeNonPosModCheck ;
+
+
+(*
+   InitWholeZeroDivisionCheck - creates a check expression for zero 2nd
+                                operand for division.
+*)
+
+PROCEDURE InitWholeZeroDivisionCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholezerodiv, d, e) # NIL) ;
+   RETURN r
+END InitWholeZeroDivisionCheck ;
+
+
+(*
+   InitWholeZeroRemainderCheck - creates a check expression for zero 2nd
+                                 operand for remainder.
+*)
+
+PROCEDURE InitWholeZeroRemainderCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
+VAR
+   r: CARDINAL ;
+BEGIN
+   r := InitRange () ;
+   Assert (PutRangeUnary (tokno, GetIndice (RangeIndex, r), wholezerorem, d, e) # NIL) ;
+   RETURN r
+END InitWholeZeroRemainderCheck ;
+
+
+(*
+   FoldNil - attempts to fold the pointer against nil comparison.
+*)
+
+PROCEDURE FoldNil (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant (tokenno, des) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF GccKnowsAbout (des) AND IsConst (des)
+      THEN
+         PushValue (des) ;
+         PushValue (Nil) ;
+         IF Equ (tokenno)
+         THEN
+            MetaErrorT1 (tokenNo,
+                         'attempting to dereference a pointer {%1Wa} whose value will be NIL',
+                         des) ;
+            PutQuad (q, ErrorOp, NulSym, NulSym, r)
+         ELSE
+            SubQuad (q)
+         END
+      END
+   END
+END FoldNil ;
+
+
+(*
+   GetMinMax - returns TRUE if we know the max and min of m2type.
+*)
+
+PROCEDURE GetMinMax (tokenno: CARDINAL; type: CARDINAL; VAR min, max: Tree) : BOOLEAN ;
+VAR
+   minC, maxC: CARDINAL ;
+   location  : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   Assert (IsAModula2Type (type)) ;
+   IF GccKnowsAbout(type) AND (NOT IsPointer(type)) AND
+      (NOT IsArray(type)) AND (NOT IsRecord(type)) AND
+      (NOT IsRecord(type)) AND (NOT IsUnbounded(type)) AND
+      (NOT IsProcType(type)) AND (NOT IsRealType(type)) AND
+      (NOT IsRealN(type)) AND (NOT IsComplexType(type)) AND
+      (NOT IsComplexN(type)) AND
+      (type#Address) AND (NOT IsSet(type)) AND
+      (type#Word) AND (type#Loc) AND (type#Byte) AND (NOT IsWordN(type))
+   THEN
+      IF IsSubrange(type)
+      THEN
+         GetSubrange(type, maxC, minC) ;
+         max := Mod2Gcc(maxC) ;
+         min := Mod2Gcc(minC)
+      ELSIF IsEnumeration(type)
+      THEN
+         GetBaseTypeMinMax(type, minC, maxC) ;
+         max := Mod2Gcc(maxC) ;
+         min := Mod2Gcc(minC)
+      ELSE
+         max := GetMaxFrom(location, Mod2Gcc(type)) ;
+         min := GetMinFrom(location, Mod2Gcc(type))
+      END ;
+      max := BuildConvert (location, Mod2Gcc(type), max, FALSE) ;
+      Assert (NOT TreeOverflow (max)) ;
+      min := BuildConvert (location, Mod2Gcc(type), min, FALSE) ;
+      Assert (NOT TreeOverflow (min)) ;
+      RETURN TRUE
+   ELSE
+      RETURN FALSE
+   END
+END GetMinMax ;
+
+
+(*
+   OutOfRange - returns TRUE if expr lies outside min..max.
+*)
+
+PROCEDURE OutOfRange (tokenno: CARDINAL;
+                      min: Tree;
+                      expr: CARDINAL;
+                      max: Tree;
+                      type: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF TreeOverflow (min)
+   THEN
+      WriteString ("overflow detected in min\n"); WriteLn ;
+      debug_tree (min)
+   END ;
+   IF TreeOverflow (max)
+   THEN
+      WriteString ("overflow detected in max\n"); WriteLn ;
+      debug_tree (max)
+   END ;
+   IF TreeOverflow (max)
+   THEN
+      WriteString ("overflow detected in expr\n"); WriteLn ;
+      debug_tree (StringToChar (Mod2Gcc (expr), type, expr));
+   END ;
+   PushIntegerTree (StringToChar (Mod2Gcc (expr), type, expr)) ;
+   PushIntegerTree (min) ;
+   IF Less (tokenno)
+   THEN
+      RETURN TRUE
+   END ;
+   PushIntegerTree (StringToChar (Mod2Gcc (expr), type, expr)) ;
+   PushIntegerTree (max) ;
+   IF Gre (tokenno)
+   THEN
+      RETURN TRUE
+   END ;
+   RETURN FALSE
+END OutOfRange ;
+
+
+(*
+   HandlerExists -
+*)
+
+PROCEDURE HandlerExists (r: CARDINAL) : BOOLEAN ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      CASE type OF
+
+      assignment           : RETURN( ExceptionAssign#NulSym ) |
+      returnassignment     : RETURN( ExceptionReturn#NulSym ) |
+      subrangeassignment   : InternalError ('not expecting this case value') |
+      inc                  : RETURN( ExceptionInc#NulSym ) |
+      dec                  : RETURN( ExceptionDec#NulSym ) |
+      incl                 : RETURN( ExceptionIncl#NulSym ) |
+      excl                 : RETURN( ExceptionExcl#NulSym ) |
+      shift                : RETURN( ExceptionShift#NulSym ) |
+      rotate               : RETURN( ExceptionRotate#NulSym ) |
+      typeassign           : RETURN( FALSE ) |
+      typeparam            : RETURN( FALSE ) |
+      typeexpr             : RETURN( FALSE ) |
+      paramassign          : RETURN( ExceptionParameterBounds#NulSym ) |
+      staticarraysubscript : RETURN( ExceptionStaticArray#NulSym ) |
+      dynamicarraysubscript: RETURN( ExceptionDynamicArray#NulSym ) |
+      forloopbegin         : RETURN( ExceptionForLoopBegin#NulSym ) |
+      forloopto            : RETURN( ExceptionForLoopTo#NulSym ) |
+      forloopend           : RETURN( ExceptionForLoopEnd#NulSym ) |
+      pointernil           : RETURN( ExceptionPointerNil#NulSym ) |
+      noreturn             : RETURN( ExceptionNoReturn#NulSym ) |
+      noelse               : RETURN( ExceptionCase#NulSym ) |
+      casebounds           : RETURN( FALSE ) |
+      wholenonposdiv       : RETURN( ExceptionNonPosDiv#NulSym ) |
+      wholenonposmod       : RETURN( ExceptionNonPosMod#NulSym ) |
+      wholezerodiv         : RETURN( ExceptionZeroDiv#NulSym ) |
+      wholezerorem         : RETURN( ExceptionZeroRem#NulSym ) |
+      none                 : RETURN( FALSE )
+
+      ELSE
+         InternalError ('enumeration value unknown')
+      END
+   END
+END HandlerExists ;
+
+
+(*
+   FoldAssignment -
+*)
+
+PROCEDURE FoldAssignment (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   min, max: Tree ;
+BEGIN
+   p := GetIndice (RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant (tokenNo, expr) ;
+      IF desLowestType # NulSym
+      THEN
+         IF GccKnowsAbout (expr) AND IsConst (expr) AND
+            GetMinMax (tokenno, desLowestType, min, max)
+         THEN
+            IF OutOfRange (tokenno, min, expr, max, desLowestType)
+            THEN
+               MetaErrorT2 (tokenNo,
+                            'attempting to assign a value {%2Wa} to a designator {%1a} which will exceed the range of type {%1tad}',
+                            des, expr) ;
+               PutQuad (q, ErrorOp, NulSym, NulSym, r)
+            ELSE
+               SubQuad (q)
+            END
+         END
+      END
+   END
+END FoldAssignment ;
+
+
+(*
+   FoldParameterAssign -
+*)
+
+PROCEDURE FoldParameterAssign (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   min, max: Tree ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant (tokenNo, expr) ;
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND IsConst(expr) AND
+            GetMinMax(tokenno, desLowestType, min, max)
+         THEN
+            IF OutOfRange(tokenno, min, expr, max, desLowestType)
+            THEN
+               (* this is safer to treat as an error, rather than a warning
+                  otherwise the paramater might be widened
+                  (if it is a constant).  *)
+               MetaErrorT3(tokenNo,
+                           'the {%3EN} actual parameter {%2a} will exceed the range of formal parameter type {%1tad}',
+                           des, expr, dimension) ;
+               PutQuad(q, ErrorOp, NulSym, NulSym, r)
+            ELSE
+               SubQuad(q)
+            END
+         END
+      END
+   END
+END FoldParameterAssign ;
+
+
+(*
+   FoldReturn - do we know this is reachable, if so generate an error message.
+*)
+
+PROCEDURE FoldReturn (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   min, max: Tree ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant (tokenNo, expr) ;
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND IsConst(expr) AND
+            GetMinMax(tokenno, desLowestType, min, max)
+         THEN
+            IF OutOfRange(tokenno, min, expr, max, desLowestType)
+            THEN
+               MetaErrorT2(tokenNo,
+                           'attempting to return {%2Wa} from a procedure function {%1a} which will exceed exceed the range of type {%1tad}',
+                           des, expr) ;
+               PutQuad(q, ErrorOp, NulSym, NulSym, r)
+            ELSE
+               SubQuad(q)
+            END
+         END
+      END
+   END
+END FoldReturn ;
+
+
+(*
+   FoldInc -
+*)
+
+PROCEDURE FoldInc (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p          : Range ;
+   t, min, max: Tree ;
+   location   : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND IsConst(expr) AND
+            GetMinMax(tokenno, desLowestType, min, max)
+         THEN
+            IF OutOfRange(tokenno, GetIntegerZero(location), expr, max, desLowestType)
+            THEN
+               MetaErrorT2(tokenNo,
+                           'operand to INC {%2Wa} exceeds the range of type {%1ts} of the designator {%1a}',
+                           des, expr) ;
+               PutQuad(q, ErrorOp, NulSym, NulSym, r)
+            ELSIF GccKnowsAbout(des) AND IsConst(des) AND GccKnowsAbout(desLowestType)
+            THEN
+               t := BuildSub(location,
+                             max,
+                             BuildConvert(location, Mod2Gcc(desLowestType), Mod2Gcc(expr), FALSE),
+                             FALSE) ;
+               PushIntegerTree(Mod2Gcc(des)) ;
+               PushIntegerTree(t) ;
+               IF Gre(tokenNo)
+               THEN
+                  MetaErrorT1(tokenNo,
+                              'the designator to INC {%1Wa} will exceed the range of type {%1ts}',
+                              des) ;
+                  PutQuad(q, ErrorOp, NulSym, NulSym, r)
+               ELSE
+                  (* range check is unnecessary *)
+                  SubQuad(q)
+               END
+            END
+         END
+      END
+   END
+END FoldInc ;
+
+
+(*
+   FoldDec -
+*)
+
+PROCEDURE FoldDec (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p          : Range ;
+   t, min, max: Tree ;
+   location   : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND IsConst(expr) AND
+            GetMinMax(tokenno, desLowestType, min, max)
+         THEN
+            IF OutOfRange(tokenno, GetIntegerZero(location), expr, max, desLowestType)
+            THEN
+               MetaErrorT2(tokenNo,
+                           'operand to DEC {%2Wa} exceeds the range of type {%1ts} of the designator {%1a}',
+                           des, expr) ;
+               PutQuad(q, ErrorOp, NulSym, NulSym, r)
+            ELSIF GccKnowsAbout(des) AND IsConst(des) AND GccKnowsAbout(desLowestType)
+            THEN
+               t := BuildSub(location,
+                             BuildConvert(location, Mod2Gcc(desLowestType), Mod2Gcc(expr), FALSE),
+                             min,
+                             FALSE) ;
+               PushIntegerTree(Mod2Gcc(des)) ;
+               PushIntegerTree(t) ;
+               IF Less(tokenNo)
+               THEN
+                  MetaErrorT1(tokenNo,
+                              'the designator to DEC {%1Wa} will exceed the range of type {%1ts}',
+                              des) ;
+                  PutQuad(q, ErrorOp, NulSym, NulSym, r)
+               ELSE
+                  (* range check is unnecessary *)
+                  SubQuad(q)
+               END
+            END
+         END
+      END
+   END
+END FoldDec ;
+
+
+(*
+   CheckSetAndBit - returns TRUE if des is a set type and expr is compatible with des.
+*)
+
+PROCEDURE CheckSetAndBit (tokenno: CARDINAL;
+                          des, expr: CARDINAL;
+                          name: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   s: String ;
+BEGIN
+   IF IsSet(des)
+   THEN
+      IF IsExpressionCompatible(GetType(des), GetType(expr))
+      THEN
+         RETURN( TRUE )
+      ELSE
+         s := ConCat(ConCat(InitString('operands to '),
+                            Mark(InitString(name))),
+                     Mark(InitString(' {%1Etsd:{%2tsd:{%1tsd} and {%2tsd}}} are incompatible'))) ;
+         MetaErrorStringT2(tokenno, s, des, expr) ;
+         FlushErrors
+      END
+   ELSE
+      s := ConCat(ConCat(InitString('first operand to '),
+                         Mark(InitString(name))),
+                  Mark(InitString(' is not a set {%1Etasd}'))) ;
+      MetaErrorStringT1(tokenno, s, des) ;
+      FlushErrors
+   END ;
+   RETURN( FALSE )
+END CheckSetAndBit ;
+
+
+(*
+   CheckSet - returns TRUE if des is a set type and expr is compatible with INTEGER.
+*)
+
+PROCEDURE CheckSet (tokenno: CARDINAL;
+                    des, expr: CARDINAL;
+                    name: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   s: String ;
+BEGIN
+   IF IsSet(des)
+   THEN
+      IF IsParameterCompatible(Integer, GetType(expr))
+      THEN
+         RETURN( TRUE )
+      ELSE
+         s := ConCat(ConCat(InitString('operands to '),
+                            Mark(InitString(name))),
+                     Mark(InitString(' {%1Etsd:{%2tsd:{%1tsd} and {%2tsd}}} are incompatible'))) ;
+         MetaErrorStringT2(tokenno, s, des, expr) ;
+         FlushErrors
+      END
+   ELSE
+      s := ConCat(ConCat(InitString('first operand to '),
+                         Mark(InitString(name))),
+                  Mark(InitString(' is not a set {%1Etasd}'))) ;
+      MetaErrorStringT1(tokenno, s, des) ;
+      FlushErrors
+   END ;
+   RETURN( FALSE )
+END CheckSet ;
+
+
+(*
+   FoldIncl - folds an INCL statement if the operands are constant.
+*)
+
+PROCEDURE FoldIncl (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   min, max: Tree ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      desLowestType := SkipType(GetType(des)) ;
+      IF desLowestType#NulSym
+      THEN
+         IF CheckSetAndBit(tokenno, desLowestType, expr, "INCL")
+         THEN
+            IF GccKnowsAbout(expr) AND IsConst(expr) AND
+               GetMinMax(tokenno, desLowestType, min, max)
+            THEN
+               IF OutOfRange(tokenno, min, expr, max, desLowestType)
+               THEN
+                  MetaErrorT2(tokenNo,
+                              'operand to INCL {%2Wa} exceeds the range of type {%1tasa}',
+                              des, expr) ;
+                  PutQuad(q, ErrorOp, NulSym, NulSym, r)
+               ELSE
+                  (* range check is unnecessary *)
+                  SubQuad(q)
+               END
+            END
+         END
+      END
+   END
+END FoldIncl ;
+
+
+(*
+   FoldExcl - folds an EXCL statement if the operands are constant.
+*)
+
+PROCEDURE FoldExcl (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   min, max: Tree ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      desLowestType := SkipType(GetType(des)) ;
+      IF desLowestType#NulSym
+      THEN
+         IF CheckSetAndBit(tokenno, desLowestType, expr, "EXCL")
+         THEN
+            IF GccKnowsAbout(expr) AND IsConst(expr) AND
+               GetMinMax(tokenno, desLowestType, min, max)
+            THEN
+               IF OutOfRange(tokenno, min, expr, max, desLowestType)
+               THEN
+                  MetaErrorT2(tokenNo,
+                              'operand to EXCL {%2Wa} exceeds the range of type {%1tasa}',
+                              des, expr) ;
+                  PutQuad(q, ErrorOp, NulSym, NulSym, r)
+               ELSE
+                  (* range check is unnecessary *)
+                  SubQuad(q)
+               END
+            END
+         END
+      END
+   END
+END FoldExcl ;
+
+
+(*
+   FoldShift - folds an SHIFT test statement if the operands are constant.
+*)
+
+PROCEDURE FoldShift (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   ofType  : CARDINAL ;
+   p       : Range ;
+   shiftMin,
+   shiftMax,
+   min, max: Tree ;
+   location   : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      desLowestType := SkipType(GetType(des)) ;
+      IF desLowestType#NulSym
+      THEN
+         IF CheckSet(tokenno, desLowestType, expr, "SHIFT")
+         THEN
+            ofType := SkipType(GetType(desLowestType)) ;
+            IF GccKnowsAbout(ofType) AND
+               GccKnowsAbout(expr) AND IsConst(expr) AND
+               GetMinMax(tokenno, ofType, min, max)
+            THEN
+               min := BuildConvert(location, GetIntegerType(), min, FALSE) ;
+               max := BuildConvert(location, GetIntegerType(), max, FALSE) ;
+               shiftMax := BuildAdd(location, BuildSub(location, max, min, FALSE),
+                                    GetIntegerOne(location),
+                                    FALSE) ;
+               shiftMin := BuildNegate(location, shiftMax, FALSE) ;
+               IF OutOfRange(tokenno, shiftMin, expr, shiftMax, desLowestType)
+               THEN
+                  MetaErrorT2(tokenNo,
+                              'operand to SHIFT {%2Wa} exceeds the range of type {%1tasa}',
+                              des, expr) ;
+                  PutQuad(q, ErrorOp, NulSym, NulSym, r)
+               ELSE
+                  (* range check is unnecessary *)
+                  SubQuad(q)
+               END
+            END
+         END
+      END
+   END
+END FoldShift ;
+
+
+(*
+   FoldRotate - folds a ROTATE test statement if the operands are constant.
+*)
+
+PROCEDURE FoldRotate (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   ofType   : CARDINAL ;
+   p        : Range ;
+   rotateMin,
+   rotateMax,
+   min, max : Tree ;
+   location   : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      desLowestType := SkipType(GetType(des)) ;
+      IF desLowestType#NulSym
+      THEN
+         IF CheckSet(tokenno, desLowestType, expr, "ROTATE")
+         THEN
+            ofType := SkipType(GetType(desLowestType)) ;
+            IF GccKnowsAbout(ofType) AND
+               GccKnowsAbout(expr) AND IsConst(expr) AND
+               GetMinMax(tokenno, ofType, min, max)
+            THEN
+               min := BuildConvert(location, GetIntegerType(), min, FALSE) ;
+               max := BuildConvert(location, GetIntegerType(), max, FALSE) ;
+               rotateMax := BuildAdd(location,
+                                     BuildSub(location, max, min, FALSE),
+                                     GetIntegerOne(location),
+                                     FALSE) ;
+               rotateMin := BuildNegate(location, rotateMax, FALSE) ;
+               IF OutOfRange(tokenno, rotateMin, expr, rotateMax, desLowestType)
+               THEN
+                  MetaErrorT2(tokenNo,
+                              'operand to ROTATE {%2Wa} exceeds the range of type {%1tasa}',
+                              des, expr) ;
+                  PutQuad(q, ErrorOp, NulSym, NulSym, r)
+               ELSE
+                  (* range check is unnecessary *)
+                  SubQuad(q)
+               END
+            END
+         END
+      END
+   END
+END FoldRotate ;
+
+
+(*
+   FoldTypeAssign -
+*)
+
+PROCEDURE FoldTypeAssign (q: CARDINAL; tokenNo: CARDINAL; des, expr: CARDINAL; r: CARDINAL) ;
+VAR
+   exprType: CARDINAL ;
+BEGIN
+   IF IsProcedure(expr)
+   THEN
+      exprType := expr
+   ELSE
+      exprType := GetType(expr)
+   END ;
+
+   IF IsAssignmentCompatible (GetType(des), exprType)
+   THEN
+      SubQuad(q)
+   ELSE
+      IF NOT reportedError (r)
+      THEN
+         IF IsProcedure (des)
+         THEN
+            MetaErrorsT2 (tokenNo,
+                          'the return type {%1Etad} declared in procedure {%1Da}',
+                          'is incompatible with the returned expression {%2ad}}',
+                          des, expr) ;
+         ELSE
+            MetaErrorT3 (tokenNo,
+                         'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%3ad:of type {%3ad}} are incompatible',
+                         des, expr, exprType)
+         END ;
+         setReported (r) ;
+         FlushErrors
+      END
+   END
+END FoldTypeAssign ;
+
+
+(*
+   FoldTypeParam -
+*)
+
+PROCEDURE FoldTypeParam (q: CARDINAL; tokenNo: CARDINAL; formal, actual, procedure: CARDINAL; paramNo: CARDINAL) ;
+BEGIN
+   IF ParameterTypeCompatible (tokenNo,
+                               '{%4EN} type failure between actual {%3ad} and the {%2ad}',
+                               procedure, formal, actual, paramNo, IsVarParam (procedure, paramNo))
+   THEN
+      SubQuad(q)
+   END
+END FoldTypeParam ;
+
+
+(*
+   FoldTypeExpr -
+*)
+
+PROCEDURE FoldTypeExpr (q: CARDINAL; tokenNo: CARDINAL; left, right: CARDINAL; strict, isin: BOOLEAN; r: CARDINAL) ;
+BEGIN
+   IF (left # NulSym) AND (right # NulSym) AND (NOT reportedError (r))
+   THEN
+      IF ExpressionTypeCompatible (tokenNo,
+                                   'expression of type {%1Etad} is incompatible with type {%2tad}',
+                                   left, right, strict, isin)
+      THEN
+         SubQuad(q) ;
+         setReported (r)
+      END
+   END
+END FoldTypeExpr ;
+
+
+(*
+   CodeTypeAssign -
+*)
+
+PROCEDURE CodeTypeAssign (tokenNo: CARDINAL; des, expr: CARDINAL; r: CARDINAL) ;
+VAR
+   exprType: CARDINAL ;
+BEGIN
+   IF IsProcedure(expr)
+   THEN
+      exprType := expr
+   ELSE
+      exprType := GetType(expr)
+   END ;
+   IF NOT IsAssignmentCompatible(GetType(des), exprType)
+   THEN
+      IF NOT reportedError (r)
+      THEN
+         IF IsProcedure(des)
+         THEN
+            MetaErrorsT2(tokenNo,
+                         'the return type {%1Etad} declared in procedure {%1Da}',
+                         'is incompatible with the returned expression {%2EUa} {%2tad:of type {%2tad}}',
+                         des, expr) ;
+         ELSE
+            MetaErrorT2(tokenNo,
+                        'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%2tad:of type {%2tad}} are incompatible',
+                        des, expr)
+         END ;
+         setReported (r)
+      END
+      (* FlushErrors *)
+   END
+END CodeTypeAssign ;
+
+
+(*
+   CodeTypeParam -
+*)
+
+PROCEDURE CodeTypeParam (tokenNo: CARDINAL; formal, actual, procedure: CARDINAL; paramNo: CARDINAL) ;
+BEGIN
+   IF NOT ParameterTypeCompatible (tokenNo,
+                                   '{%4EN} type failure between actual {%3ad} and the formal {%2ad}',
+                                   procedure, formal, actual, paramNo, IsVarParam (procedure, paramNo))
+   THEN
+   END
+END CodeTypeParam ;
+
+
+(*
+   CodeTypeExpr -
+*)
+
+PROCEDURE CodeTypeExpr (tokenNo: CARDINAL; left, right: CARDINAL; strict, isin: BOOLEAN; r: CARDINAL) ;
+BEGIN
+   IF NOT reportedError (r)
+   THEN
+      IF ExpressionTypeCompatible (tokenNo,
+                                   'expression of type {%1Etad} is incompatible with type {%2tad}',
+                                   left, right, strict, isin)
+      THEN
+         setReported (r)
+      END
+   END
+END CodeTypeExpr ;
+
+
+(*
+   FoldTypeCheck - folds a type check.  This is a no-op and it used
+                   for checking types which are resolved post pass 3.
+*)
+
+PROCEDURE FoldTypeCheck (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      (* TryDeclareConstructor(q, expr) ; *)
+      IF (GccKnowsAbout(des) OR (IsParameter(des) AND GccKnowsAbout(GetType(des)))) AND
+          GccKnowsAbout(expr)
+      THEN
+         CASE type OF
+
+         typeassign:  FoldTypeAssign(q, tokenNo, des, expr, r) |
+         typeparam:   FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo) |
+         typeexpr:    FoldTypeExpr(q, tokenNo, des, expr, strict, isin, r)
+
+         ELSE
+            InternalError ('not expecting to reach this point')
+         END
+      END
+   END
+END FoldTypeCheck ;
+
+
+(*
+   CodeTypeCheck - folds a type check.  This is a no-op and it used
+                   for checking types which are resolved post pass 3.
+                   It does assume that both, des, and, expr, have been
+                   resolved at this point.
+*)
+
+PROCEDURE CodeTypeCheck (tokenno: CARDINAL; r: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      (* TryDeclareConstructor(0, expr) ; *)
+      IF (GccKnowsAbout(des) OR (IsParameter(des) AND GccKnowsAbout(GetType(des)))) AND
+          GccKnowsAbout(expr)
+      THEN
+         CASE type OF
+
+         typeassign:  CodeTypeAssign(tokenNo, des, expr, r) |
+         typeparam:   CodeTypeParam(tokenNo, des, expr, procedure, paramNo) |
+         typeexpr:    CodeTypeExpr(tokenNo, des, expr, strict, isin, r)
+
+         ELSE
+            InternalError ('not expecting to reach this point')
+         END
+      ELSE
+         InternalError ('expecting des and expr to be resolved')
+      END
+   END
+END CodeTypeCheck ;
+
+
+(*
+   FoldForLoopBegin -
+*)
+
+PROCEDURE FoldForLoopBegin (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   min, max: Tree ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND IsConst(expr) AND
+            GetMinMax(tokenno, desLowestType, min, max)
+         THEN
+            IF OutOfRange(tokenno, min, expr, max, desLowestType)
+            THEN
+               MetaErrorT2(tokenNo,
+                           'attempting to assign a value {%2Wa} to a FOR loop designator {%1a} which will exceed the range of type {%1tad}',
+                           des, expr) ;
+               PutQuad(q, ErrorOp, NulSym, NulSym, r)
+            ELSE
+               SubQuad(q)
+            END
+         END
+      END
+   END
+END FoldForLoopBegin ;
+
+
+(*
+   FoldForLoopTo -
+*)
+
+PROCEDURE FoldForLoopTo (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   min, max: Tree ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND IsConst(expr) AND
+            GetMinMax(tokenno, desLowestType, min, max)
+         THEN
+            IF OutOfRange(tokenno, min, expr, max, desLowestType)
+            THEN
+               MetaErrorT2(tokenNo,
+                           'final value in FOR loop will exceed type range {%1Wtasa} of designator {%2a}',
+                           des, expr) ;
+               PutQuad(q, ErrorOp, NulSym, NulSym, r)
+            ELSE
+               SubQuad(q)
+            END
+         END
+      END
+   END
+END FoldForLoopTo ;
+
+
+(*
+   FoldStaticArraySubscript -
+*)
+
+PROCEDURE FoldStaticArraySubscript (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   min, max: Tree ;
+BEGIN
+   p := GetIndice (RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant (tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant (tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout (expr) AND IsConst (expr) AND
+            GetMinMax (tokenno, desLowestType, min, max)
+         THEN
+            IF OutOfRange (tokenno, min, expr, max, desLowestType)
+            THEN
+               MetaErrorT3 (tokenNo,
+                           'index {%2Wa} out of range found while attempting to access an element of a static array {%1a} in the {%3N} array subscript',
+                            des, expr, dimension) ;
+               PutQuad (q, ErrorOp, NulSym, NulSym, r)
+            ELSE
+               (* range check is unnecessary *)
+               SubQuad (q)
+            END
+         END
+      END
+   END
+END FoldStaticArraySubscript ;
+
+
+(*
+   FoldDynamicArraySubscript -
+*)
+
+PROCEDURE FoldDynamicArraySubscript (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p       : Range ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND IsConst(expr)
+         THEN
+            IF IsGreater(GetIntegerZero(location), BuildConvert(location, GetIntegerType(), Mod2Gcc(expr), FALSE))
+            THEN
+               MetaErrorT3(tokenNo,
+                           'index {%2Wa} out of range found while attempting to access an element of a dynamic array {%1a} in the {%3N} array subscript',
+                           des, expr, dimension) ;
+               PutQuad(q, ErrorOp, NulSym, NulSym, r)
+            ELSE
+               (* cannot fold high bounds, so leave that for the runtime *)
+            END
+         END
+      END
+   END
+END FoldDynamicArraySubscript ;
+
+
+(*
+   FoldCaseBounds -
+*)
+
+PROCEDURE FoldCaseBounds (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      IF CaseBoundsResolved(tokenno, caseList)
+      THEN
+         IF TypeCaseBounds (caseList)
+         THEN
+            (* nothing to do *)
+         END ;
+         IF OverlappingCaseBounds(caseList)
+         THEN
+            PutQuad(q, ErrorOp, NulSym, NulSym, r) ;
+            IF VariantValueChecking AND MissingCaseBounds(tokenno, caseList)
+            THEN
+               (* nothing to do *)
+            END
+         ELSIF VariantValueChecking AND MissingCaseBounds(tokenno, caseList)
+         THEN
+            PutQuad(q, ErrorOp, NulSym, NulSym, r)
+         ELSE
+            SubQuad(q)
+         END
+      END
+   END
+END FoldCaseBounds ;
+
+
+(*
+   CodeCaseBounds - attempts to resolve whether the case bounds are legal.
+                    This should resolve at compile time as all case bounds
+                    must be constants.  We introduce a CodeCaseBounds as it
+                    might be possible that constants have just been declared
+                    during the code generation of this function.
+*)
+
+PROCEDURE CodeCaseBounds (tokenno: CARDINAL; caseList: CARDINAL) ;
+BEGIN
+   IF CaseBoundsResolved (tokenno, caseList)
+   THEN
+      IF TypeCaseBounds (caseList)
+      THEN
+         (* nothing to do *)
+      END ;
+      IF OverlappingCaseBounds (caseList)
+      THEN
+         (* nothing to do *)
+      END ;
+      IF MissingCaseBounds (tokenno, caseList)
+      THEN
+         (* nothing to do *)
+      END
+   ELSE
+      MetaErrorT0 (tokenno, '{%E}the CASE statement ranges must be constants')
+   END
+END CodeCaseBounds ;
+
+
+(*
+   MakeAndDeclareConstLit - creates a constant of value and declares it to GCC.
+*)
+
+PROCEDURE MakeAndDeclareConstLit (tokenno: CARDINAL; value: Name; type: CARDINAL) : CARDINAL ;
+VAR
+   constant: CARDINAL ;
+BEGIN
+   constant := MakeConstLit (tokenno, value, type) ;
+   TryDeclareConstant (tokenno, constant) ;  (* use quad tokenno, rather than the range tokenNo *)
+   Assert (GccKnowsAbout (constant)) ;
+   RETURN constant
+END MakeAndDeclareConstLit ;
+
+
+(*
+   FoldNonPosDiv - attempts to fold the bound checking for a divide expression.
+*)
+
+PROCEDURE FoldNonPosDiv (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p   : Range ;
+   zero: CARDINAL ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF GccKnowsAbout(expr) AND IsConst(expr)
+      THEN
+         zero := MakeAndDeclareConstLit (tokenno, MakeKey ('0'), ZType) ;
+         IF IsGreaterOrEqualConversion (TokenToLocation (tokenno), zero, des, expr)
+         THEN
+            MetaErrorT2 (tokenNo,
+                         'the divisor {%2Wa} in this division expression is less than or equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}',
+                         des, expr) ;
+            PutQuad (q, ErrorOp, NulSym, NulSym, r)
+         END
+      END
+   END
+END FoldNonPosDiv ;
+
+
+(*
+   FoldNonPosMod - attempts to fold the bound checking for a modulus expression.
+*)
+
+PROCEDURE FoldNonPosMod (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p   : Range ;
+   zero: CARDINAL ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF GccKnowsAbout(expr) AND IsConst(expr)
+      THEN
+         zero := MakeAndDeclareConstLit (tokenno, MakeKey('0'), ZType) ;
+         IF IsGreaterOrEqualConversion (TokenToLocation(tokenno), zero, des, expr)
+         THEN
+            MetaErrorT2 (tokenNo,
+                         'the divisor {%2Wa} in this modulus expression is less than or equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}',
+                         des, expr) ;
+            PutQuad (q, ErrorOp, NulSym, NulSym, r)
+         END
+      END
+   END
+END FoldNonPosMod ;
+
+
+(*
+   FoldZeroDiv -
+*)
+
+PROCEDURE FoldZeroDiv (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p   : Range ;
+   zero: CARDINAL ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF GccKnowsAbout(expr) AND IsConst(expr)
+      THEN
+         zero := MakeAndDeclareConstLit (tokenno, MakeKey ('0'), ZType) ;
+         IF IsEqualConversion (zero, des, expr)
+         THEN
+            MetaErrorT2 (tokenNo,
+                        'the divisor {%2Wa} in this division expression is equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}',
+                         des, expr) ;
+            PutQuad (q, ErrorOp, NulSym, NulSym, r)
+         END
+      END
+   END
+END FoldZeroDiv ;
+
+
+(*
+   FoldZeroRem -
+*)
+
+PROCEDURE FoldZeroRem (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p   : Range ;
+   zero: CARDINAL ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF GccKnowsAbout(expr) AND IsConst(expr)
+      THEN
+         zero := MakeAndDeclareConstLit (tokenno, MakeKey ('0'), ZType) ;
+         IF IsEqualConversion (zero, des, expr)
+         THEN
+            MetaErrorT2 (tokenNo,
+                        'the divisor {%2Wa} in this remainder expression is equal to zero, this will cause an exception to be raised before the result is assigned to the designator {%1a}',
+                         des, expr) ;
+            PutQuad (q, ErrorOp, NulSym, NulSym, r)
+         END
+      END
+   END
+END FoldZeroRem ;
+
+
+(*
+   FoldRangeCheck - attempts to resolve the range check, r.
+                    If it evaluates to true then
+                       it is replaced by an ErrorOp
+                    elsif it evaluates to false then
+                       it is removed
+                    else
+                       it is left alone
+*)
+
+PROCEDURE FoldRangeCheck (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      CASE type OF
+
+      assignment           :  FoldAssignment(tokenno, q, r) |
+      returnassignment     :  FoldReturn(tokenno, q, r) |
+(*      subrangeassignment   :  |  unused currently *)
+      inc                  :  FoldInc(tokenno, q, r) |
+      dec                  :  FoldDec(tokenno, q, r) |
+      incl                 :  FoldIncl(tokenno, q, r) |
+      excl                 :  FoldExcl(tokenno, q, r) |
+      shift                :  FoldShift(tokenno, q, r) |
+      rotate               :  FoldRotate(tokenno, q, r) |
+      typeassign           :  FoldTypeCheck(tokenno, q, r) |
+      typeparam            :  FoldTypeCheck(tokenno, q, r) |
+      typeexpr             :  FoldTypeCheck(tokenno, q, r) |
+      paramassign          :  FoldParameterAssign(tokenno, q, r) |
+      staticarraysubscript :  FoldStaticArraySubscript(tokenno, q, r) |
+      dynamicarraysubscript:  FoldDynamicArraySubscript(tokenno, q, r) |
+      forloopbegin         :  FoldForLoopBegin(tokenno, q, r) |
+      forloopto            :  FoldForLoopTo(tokenno, q, r) |
+      forloopend           :  RETURN (* unable to fold anything at this point, des, will be variable *) |
+      pointernil           :  FoldNil(tokenno, q, r) |
+      noreturn             :  RETURN (* nothing to fold *) |
+      noelse               :  RETURN (* nothing to fold *) |
+      casebounds           :  FoldCaseBounds(tokenno, q, r) |
+      wholenonposdiv       :  FoldNonPosDiv(tokenno, q, r) |
+      wholenonposmod       :  FoldNonPosMod(tokenno, q, r) |
+      wholezerodiv         :  FoldZeroDiv(tokenno, q, r) |
+      wholezerorem         :  FoldZeroRem(tokenno, q, r) |
+      none                 :  SubQuad(q)
+
+      ELSE
+         InternalError ('unexpected case')
+      END
+   END
+END FoldRangeCheck ;
+
+
+(*
+   DeReferenceLValue - returns a Tree which is either ModGcc(expr)
+                       or Mod2Gcc ( *expr) depending whether, expr,
+                       is an LValue.
+*)
+
+PROCEDURE DeReferenceLValue (tokenno: CARDINAL; expr: CARDINAL) : Tree ;
+VAR
+   e       : Tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   e := Mod2Gcc(expr) ;
+   IF GetMode(expr)=LeftValue
+   THEN
+      e := BuildIndirect(location, e, Mod2Gcc(GetType(expr)))
+   END ;
+   RETURN( e )
+END DeReferenceLValue ;
+
+
+(*
+   BuildStringParam - builds a C style string parameter which will be passed
+                      as an ADDRESS type.
+*)
+
+PROCEDURE BuildStringParam (tokenno: CARDINAL; s: String) ;
+BEGIN
+   BuildStringParamLoc (TokenToLocation(tokenno), s)
+END BuildStringParam ;
+
+
+(*
+   BuildStringParamLoc - builds a C style string parameter which will be passed
+                         as an ADDRESS type.
+*)
+
+PROCEDURE BuildStringParamLoc (location: location_t; s: String) ;
+BEGIN
+   BuildParam (location,
+               BuildConvert (location, Mod2Gcc (Address),
+                             BuildAddr (location, BuildStringConstant (string(s), Length(s)),
+                                        FALSE), FALSE))
+END BuildStringParamLoc ;
+
+
+(*
+   CodeErrorCheck - returns a Tree calling the approprate exception handler.
+*)
+
+PROCEDURE CodeErrorCheck (r: CARDINAL; function, message: String) : Tree ;
+VAR
+   filename: String ;
+   line,
+   column  : CARDINAL ;
+   p       : Range ;
+   f       : Tree ;
+   location: location_t ;
+BEGIN
+   IF HandlerExists (r)
+   THEN
+      IF message = NIL
+      THEN
+         message := GetRangeErrorMessage (r)
+      END ;
+      message := FillInParameters (r, message) ;
+      p := GetIndice (RangeIndex, r) ;
+      WITH p^ DO
+         filename := FindFileNameFromToken (tokenNo, 0) ;
+         line := TokenToLineNo (tokenNo, 0) ;
+         column := TokenToColumnNo (tokenNo, 0) ;
+         location := TokenToLocation (tokenNo) ;
+         f := Mod2Gcc (lookupExceptionHandler (type)) ;
+         BuildStringParam (tokenNo, message) ;
+         BuildStringParam (tokenNo, function) ;
+         BuildParam (location, BuildIntegerConstant (column)) ;
+         BuildParam (location, BuildIntegerConstant (line)) ;
+         BuildStringParam (tokenNo, filename) ;
+         RETURN BuildProcedureCallTree (location, f, NIL)
+      END
+   ELSE
+      RETURN NIL
+   END
+END CodeErrorCheck ;
+
+
+(*
+   IssueWarning - issue a warning.  The compiler knows that this basic block can be reached
+                  and we are in scope, function.
+*)
+
+PROCEDURE IssueWarning (function: String; r: CARDINAL) ;
+VAR
+   p: Range ;
+   s: String ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      CASE type OF
+
+      assignment           : s := InitString('if the assignment is ever executed then the designator {%1Wa} will exceed the type range {%1ts:of {%1ts}}') |
+      returnassignment     : s := InitString('if the value {%2Wa} is returned from procedure function {%1Wa} then it will exceed the type range {%1ts:of {%1ts}}') |
+      subrangeassignment   : InternalError ('not expecting this case value') |
+      inc                  : s := InitString('if the INC is ever executed the expression {%2Wa} will cause an overflow error for the designator {%1a} as it exceeds the type range {%1ts:of {%1ts}}') |
+      dec                  : s := InitString('if the DEC is ever executed the expression {%2Wa} will cause an underflow error for the designator {%1a} as it exceeds the type range {%1ts:of {%1ts}}') |
+      incl                 : s := InitString('the expression {%2Wa} given in the INCL exceeds the type range {%1ts} of the designator {%1a}') |
+      excl                 : s := InitString('the expression {%2Wa} given in the EXCL exceeds the type range {%1ts} of the designator {%1a}') |
+      shift                : s := InitString('the expression {%2Wa} given in the second parameter to SHIFT exceeds the type range {%1ts} of the first parameter {%1a}') |
+      rotate               : s := InitString('the expression {%2Wa} given in the second parameter to ROTATE exceeds the type range {%1ts} of the first parameter {%1a}') |
+      typeassign           : s := InitString('') |
+      typeparam            : s := InitString('') |
+      typeexpr             : s := InitString('') |
+      paramassign          : s := InitString('if this call is executed then the actual parameter {%2Wa} will be out of range of the {%3N} formal parameter {%1a}') |
+      staticarraysubscript : s := InitString('if this access to the static array {%1Wa:{%2a:{%1a}[{%2a}]}} is ever made then the index will be out of bounds in the {%3N} array subscript') |
+      dynamicarraysubscript: s := InitString('if this access to the dynamic array {%1Wa:{%2a:{%1a}[{%2a}]}} is ever made then the index will be out of bounds in the {%3N} array subscript') |
+      forloopbegin         : s := InitString('if the assignment in this FOR loop is ever executed then the designator {%1Wa} will be exceed the type range {%1ts:of {%1ts}}') |
+      forloopto            : s := InitString('the final value {%2Wa} in this FOR loop will be out of bounds {%1ts:of type {%1ts}} if ever executed') |
+      forloopend           : s := InitString('the FOR loop will cause the designator {%1Wa} to be out of bounds when the BY value {%2a} is added') |
+      pointernil           : s := InitString('if this pointer value {%1Wa} is ever dereferenced it will cause an exception') |
+      noreturn             : s := InitString('{%1W:}this function will exit without executing a RETURN statement') |
+      noelse               : s := InitString('{%1W:}this CASE statement does not have an ELSE statement') |
+      casebounds           : s := InitString('{%1W:}this CASE statement has overlapping ranges') |
+      wholenonposdiv       : s := InitString('this division expression {%2Wa} will cause an exception as this divisor is less than or equal to zero') |
+      wholenonposmod       : s := InitString('this modulus expression {%2Wa} will cause an exception as this divisor is less than or equal to zero') |
+      wholezerodiv         : s := InitString('this division expression {%2Wa} will cause an exception as the divisor is zero') |
+      wholezerorem         : s := InitString('this remainder expression {%2Wa} will cause an exception as the divisor is zero') |
+      none                 : InternalError ('unexpected value')
+
+      ELSE
+         InternalError ('enumeration value unknown')
+      END ;
+      s := ConCat (s, Mark (InitString (' in ('))) ;
+      s := ConCat (s, function) ;
+      s := ConCatChar (s, ')') ;
+      MetaErrorStringT3 (tokenNo, s, des, expr, dimension) ;
+      (* FlushErrors *)
+   END
+END IssueWarning ;
+
+
+(*
+   CodeErrorCheckLoc - generate a runtime error message positioned at location
+                       and in function.  If function is NIL then the error scope
+                       is used.
+*)
+
+PROCEDURE CodeErrorCheckLoc (location: location_t;
+                             function, message: ADDRESS; func: CARDINAL) : Tree ;
+VAR
+   scope,
+   errorMessage: String ;
+   t           : Tree ;
+   filename    : String ;
+   line,
+   column      : CARDINAL ;
+BEGIN
+   IF func = NulSym
+   THEN
+      RETURN NIL
+   ELSE
+      t := Mod2Gcc (func) ;
+      IF t # NIL
+      THEN
+         filename := InitStringCharStar (GetFilenameFromLocation (location)) ;
+         Assert (message # NIL) ;
+         errorMessage := InitStringCharStar (message) ;
+         column := GetColumnNoFromLocation (location) ;
+         line := GetLineNoFromLocation (location) ;
+         BuildStringParamLoc (location, errorMessage) ;
+         IF function = NIL
+         THEN
+            scope := GetAnnounceScope (filename, NIL)
+         ELSE
+            scope := quoteOpen (InitString ('')) ;
+            scope := ConCat (scope, Mark (InitStringCharStar (function))) ;
+            scope := ConCat (InitString ("procedure "), quoteClose (scope))
+         END ;
+         BuildStringParamLoc (location, scope) ;
+         BuildParam (location, BuildIntegerConstant (column)) ;
+         BuildParam (location, BuildIntegerConstant (line)) ;
+         BuildStringParamLoc (location, filename) ;
+         t := BuildProcedureCallTree (location, t, NIL) ;
+         (*
+         filename := KillString (filename) ;
+         scope := KillString (scope) ;
+         errorMessage := KillString (errorMessage)
+         *)
+      END ;
+      RETURN t
+   END
+END CodeErrorCheckLoc ;
+
+
+(*
+   IssueWarningLoc -
+*)
+
+PROCEDURE IssueWarningLoc (location: location_t; message: ADDRESS) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString ("numerical overflow detected when performing ") ;
+   s := ConCat (s, Mark (InitStringCharStar (message))) ;
+   ErrorAt (location, string (s)) ;
+   s := KillString (s)
+END IssueWarningLoc ;
+
+
+(*
+   BuildIfCallWholeHandlerLoc - return a Tree containing a runtime test whether, condition, is true.
+*)
+
+PROCEDURE BuildIfCallWholeHandlerLoc (location: location_t; condition: Tree;
+                                      scope, message: ADDRESS) : Tree ;
+BEGIN
+   RETURN BuildIfCallHandlerLoc (location, condition, scope, message, ExceptionWholeValue)
+END BuildIfCallWholeHandlerLoc ;
+
+
+(*
+   BuildIfCallRealHandlerLoc - return a Tree containing a runtime test whether, condition, is true.
+*)
+
+PROCEDURE BuildIfCallRealHandlerLoc (location: location_t; condition: Tree;
+                                     scope, message: ADDRESS) : Tree ;
+BEGIN
+   RETURN BuildIfCallHandlerLoc (location, condition, scope, message, ExceptionRealValue)
+END BuildIfCallRealHandlerLoc ;
+
+
+(*
+   BuildIfCallHandlerLoc - return a Tree containing a runtime test whether, condition, is true.
+*)
+
+PROCEDURE BuildIfCallHandlerLoc (location: location_t; condition: Tree;
+                                 scope, message: ADDRESS; func: CARDINAL) : Tree ;
+BEGIN
+   IF IsTrue (condition)
+   THEN
+      IssueWarningLoc (location, message)
+   END ;
+   RETURN BuildIfThenDoEnd (condition, CodeErrorCheckLoc (location, scope, message, func))
+END BuildIfCallHandlerLoc ;
+
+
+(*
+   BuildIfCallHandler -
+*)
+
+PROCEDURE BuildIfCallHandler (condition: Tree; r: CARDINAL;
+                              function, message: String; warning: BOOLEAN) : Tree ;
+BEGIN
+   IF warning AND IsTrue (condition)
+   THEN
+      IssueWarning (function, r)
+   END ;
+   RETURN BuildIfThenDoEnd (condition, CodeErrorCheck (r, function, message))
+END BuildIfCallHandler ;
+
+
+(*
+   RangeCheckReal -
+*)
+
+PROCEDURE RangeCheckReal (p: Range; r: CARDINAL; function, message: String) ;
+VAR
+   e,
+   condition: Tree ;
+   location : location_t ;
+BEGIN
+   WITH p^ DO
+      location := TokenToLocation (tokenNo) ;
+      e := DeReferenceLValue (tokenNo, expr) ;
+      condition := BuildEqualTo (location,
+                                 BuiltInIsfinite (location, e),
+                                 GetIntegerZero (location)) ;
+      AddStatement (location, BuildIfCallHandler (condition, r, function, message, TRUE)) ;
+   END
+END RangeCheckReal ;
+
+
+(*
+   RangeCheckOrdinal -
+*)
+
+PROCEDURE RangeCheckOrdinal (p: Range; r: CARDINAL; function, message: String) ;
+VAR
+   condition,
+   desMin, desMax,
+   exprMin, exprMax: Tree ;
+   location        : location_t ;
+BEGIN
+   WITH p^ DO
+      location := TokenToLocation(tokenNo) ;
+      IF GetMinMax(tokenNo, exprLowestType, exprMin, exprMax) AND
+         GetMinMax(tokenNo, desLowestType, desMin, desMax)
+      THEN
+         IF OverlapsRange(desMin, desMax, exprMin, exprMax)
+         THEN
+            IF IsGreater(desMin, exprMin)
+            THEN
+               condition := BuildLessThan(location, DeReferenceLValue(tokenNo, expr), BuildConvert(location, Mod2Gcc(exprLowestType), desMin, FALSE)) ;
+               AddStatement(location, BuildIfCallHandler(condition, r, function, message, TRUE))
+            END ;
+            IF IsGreater(exprMax, desMax)
+            THEN
+               condition := BuildGreaterThan(location, DeReferenceLValue(tokenNo, expr), BuildConvert(location, Mod2Gcc(exprLowestType), desMax, FALSE)) ;
+               AddStatement(location, BuildIfCallHandler(condition, r, function, message, TRUE))
+            END
+         ELSE
+            MetaErrorStringT3 (tokenNo, message, des, expr, paramNo)
+         END
+      END
+   END
+END RangeCheckOrdinal ;
+
+
+(*
+   DoCodeAssignmentExprType -
+*)
+
+PROCEDURE DoCodeAssignmentExprType (p: Range;
+                                    r: CARDINAL; function, message: String) ;
+BEGIN
+   WITH p^ DO
+      IF GccKnowsAbout(desLowestType) AND
+         GccKnowsAbout(exprLowestType)
+      THEN
+         IF IsRealType(desLowestType) AND IsRealType(exprLowestType)
+         THEN
+            RangeCheckReal (p, r, function, message)
+         ELSE
+            RangeCheckOrdinal (p, r, function, message)
+         END
+      ELSE
+         InternalError ('should have resolved these types')
+      END
+   END
+END DoCodeAssignmentExprType ;
+
+
+(*
+   DoCodeAssignmentWithoutExprType -
+*)
+
+PROCEDURE DoCodeAssignmentWithoutExprType (p: Range;
+                                           r: CARDINAL; function, message: String) ;
+VAR
+   condition,
+   desMin, desMax: Tree ;
+   location      : location_t ;
+BEGIN
+   WITH p^ DO
+      location := TokenToLocation(tokenNo) ;
+      IF GccKnowsAbout(desLowestType)
+      THEN
+         IF GetMinMax(tokenNo, desLowestType, desMin, desMax)
+         THEN
+            condition := BuildLessThan(location,
+                                       BuildConvert(location, Mod2Gcc(desLowestType),
+                                                    DeReferenceLValue(tokenNo, expr), FALSE),
+                                       desMin) ;
+            AddStatement(location, BuildIfCallHandler(condition, r, function, message, TRUE)) ;
+            condition := BuildGreaterThan(location,
+                                          BuildConvert(location, Mod2Gcc(desLowestType),
+                                                       DeReferenceLValue(tokenNo, expr), FALSE),
+                                          desMax) ;
+            AddStatement(location, BuildIfCallHandler(condition, r, function, message, TRUE))
+         END
+      ELSE
+         InternalError ('should have resolved this type')
+      END
+   END
+END DoCodeAssignmentWithoutExprType ;
+
+
+(*
+   DoCodeAssignment -
+*)
+
+PROCEDURE DoCodeAssignment (tokenno: CARDINAL; r: CARDINAL;
+                            function, message: String) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenNo, des) ;
+      TryDeclareConstant(tokenNo, expr) ;
+      DeclareConstructor(tokenno, 0, expr) ;
+      IF desLowestType#NulSym
+      THEN
+         Assert(GccKnowsAbout(expr)) ;
+         IF exprLowestType=NulSym
+         THEN
+            DoCodeAssignmentWithoutExprType (p, r, function, message)
+         ELSE
+            DoCodeAssignmentExprType (p, r, function, message)
+         END
+      END
+   END
+END DoCodeAssignment ;
+
+
+(*
+   CodeAssignment -
+*)
+
+PROCEDURE CodeAssignment (tokenno: CARDINAL;
+                          r: CARDINAL; function, message: String) ;
+BEGIN
+   DoCodeAssignment (tokenno, r, function, message)
+END CodeAssignment ;
+
+
+(*
+   CodeParameterAssign -
+*)
+
+PROCEDURE CodeParameterAssign (tokenno: CARDINAL;
+                               r: CARDINAL; function, message: String) ;
+BEGIN
+   DoCodeAssignment (tokenno, r, function, message)
+END CodeParameterAssign ;
+
+
+(*
+   CodeReturn -
+*)
+
+PROCEDURE CodeReturn (tokenno: CARDINAL;
+                      r: CARDINAL; function, message: String) ;
+BEGIN
+   DoCodeAssignment (tokenno, r, function, message)
+END CodeReturn ;
+
+
+(*
+   IfOutsideLimitsDo -
+*)
+
+PROCEDURE IfOutsideLimitsDo (tokenno: CARDINAL; min, expr, max: Tree; r: CARDINAL;
+                             function, message: String) ;
+VAR
+   condition: Tree ;
+   location : location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   condition := BuildGreaterThan (location, min, expr) ;
+   AddStatement (location, BuildIfThenDoEnd (condition, CodeErrorCheck (r, function, message))) ;
+   condition := BuildLessThan (location, max, expr) ;
+   AddStatement (location, BuildIfThenDoEnd (condition, CodeErrorCheck (r, function, message)))
+END IfOutsideLimitsDo ;
+
+
+(*
+   CodeInc -
+*)
+
+PROCEDURE CodeInc (tokenno: CARDINAL;
+                   r: CARDINAL; function, message: String) ;
+VAR
+   p             : Range ;
+   t, condition,
+   e,
+   desMin, desMax: Tree ;
+   location      : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenNo, des) ;
+      TryDeclareConstant(tokenNo, expr) ;
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND GccKnowsAbout(desLowestType)
+         THEN
+            IF GetMinMax(tokenno, desLowestType, desMin, desMax)
+            THEN
+               e := BuildConvert(location, GetTreeType(desMin), DeReferenceLValue(tokenno, expr), FALSE) ;
+               IfOutsideLimitsDo(tokenNo,
+                                 BuildConvert(location, GetTreeType(desMin), GetIntegerZero(location), FALSE),
+                                 e, desMax, r, function, message) ;
+               t := BuildSub(location,
+                             desMax,
+                             BuildConvert(location, Mod2Gcc(desLowestType), e, FALSE),
+                             FALSE) ;
+               condition := BuildGreaterThan(location, Mod2Gcc(des), t) ;
+               AddStatement (location, BuildIfThenDoEnd (condition, CodeErrorCheck (r, function, message)))
+            END
+         ELSE
+            InternalError ('should have resolved these types')
+         END
+      END
+   END
+END CodeInc ;
+
+
+(*
+   CodeDec -
+*)
+
+PROCEDURE CodeDec (tokenno: CARDINAL;
+                   r: CARDINAL; function, message: String) ;
+VAR
+   p             : Range ;
+   t, condition,
+   e,
+   desMin, desMax: Tree ;
+   location      : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenNo, des) ;
+      TryDeclareConstant(tokenNo, expr) ;
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND GccKnowsAbout(desLowestType)
+         THEN
+            IF GetMinMax(tokenno, desLowestType, desMin, desMax)
+            THEN
+               e := BuildConvert(location, GetTreeType(desMin), DeReferenceLValue(tokenno, expr), FALSE) ;
+               IfOutsideLimitsDo(tokenNo,
+                                 BuildConvert(location, GetTreeType(desMin), GetIntegerZero(location), FALSE),
+                                 e, desMax, r, function, message) ;
+               t := BuildSub(location, BuildConvert(location, Mod2Gcc(desLowestType), e, FALSE),
+                             desMin,
+                             FALSE) ;
+               condition := BuildLessThan(location, Mod2Gcc(des), t) ;
+               AddStatement (location, BuildIfThenDoEnd (condition, CodeErrorCheck (r, function, message)))
+            END
+         ELSE
+            InternalError ('should have resolved these types')
+         END
+      END
+   END
+END CodeDec ;
+
+
+(*
+   CodeInclExcl -
+*)
+
+PROCEDURE CodeInclExcl (tokenno: CARDINAL;
+                        r: CARDINAL; function, message: String) ;
+VAR
+   p             : Range ;
+   e,
+   desMin, desMax: Tree ;
+   location      : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenNo, des) ;
+      TryDeclareConstant(tokenNo, expr) ;
+      desLowestType := SkipType(GetType(des)) ;
+      IF desLowestType#NulSym
+      THEN
+         IF GccKnowsAbout(expr) AND GccKnowsAbout(desLowestType)
+         THEN
+            IF GetMinMax(tokenno, desLowestType, desMin, desMax)
+            THEN
+               e := BuildConvert(location, GetTreeType(desMin), DeReferenceLValue(tokenno, expr), FALSE) ;
+               IfOutsideLimitsDo(tokenNo, desMin, e, desMax, r, function, message)
+(*  this should not be used for incl/excl as des is a set type
+               t := BuildSub(location,
+                             desMax,
+                             BuildConvert(location, Mod2Gcc(desLowestType), e, FALSE),
+                             FALSE) ;
+               condition := BuildGreaterThan(Mod2Gcc(des), t) ;
+               AddStatement(location, BuildIfThenDoEnd(condition, CodeErrorCheck(r, function, message)))
+*)
+            END
+         ELSE
+            InternalError ('should have resolved these types')
+         END
+      END
+   END
+END CodeInclExcl ;
+
+
+(*
+   CodeShiftRotate - ensure that the bit shift is within the range
+                     -(MAX(set)-MIN(set)+1)..(MAX(set)-MIN(set)+1)
+*)
+
+PROCEDURE CodeShiftRotate (tokenno: CARDINAL;
+                           r: CARDINAL; function, message: String) ;
+VAR
+   ofType            : CARDINAL ;
+   p                 : Range ;
+   e,
+   shiftMin, shiftMax,
+   desMin, desMax    : Tree ;
+   location          : location_t ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenNo, des) ;
+      TryDeclareConstant(tokenNo, expr) ;
+      desLowestType := SkipType(GetType(des)) ;
+      IF desLowestType#NulSym
+      THEN
+         ofType := SkipType(GetType(desLowestType)) ;
+         IF GccKnowsAbout(expr) AND GccKnowsAbout(ofType)
+         THEN
+            IF GetMinMax(tokenno, ofType, desMin, desMax)
+            THEN
+               location := TokenToLocation(tokenNo) ;
+               desMin := BuildConvert(location, GetIntegerType(), desMin, FALSE) ;
+               desMax := BuildConvert(location, GetIntegerType(), desMax, FALSE) ;
+               shiftMax := BuildAdd(location,
+                                    BuildSub(location, desMax, desMin, FALSE),
+                                    GetIntegerOne(location),
+                                    FALSE) ;
+               shiftMin := BuildNegate(location, shiftMax, FALSE) ;
+               e := BuildConvert(location, GetIntegerType(), DeReferenceLValue(tokenno, expr), FALSE) ;
+               IfOutsideLimitsDo(tokenNo, shiftMin, e, shiftMax, r, function, message)
+            END
+         ELSE
+            InternalError ('should have resolved these types')
+         END
+      END
+   END
+END CodeShiftRotate ;
+
+
+(*
+   CodeStaticArraySubscript -
+*)
+
+PROCEDURE CodeStaticArraySubscript (tokenno: CARDINAL;
+                                    r: CARDINAL; function, message: String) ;
+VAR
+   p             : Range ;
+   desMin, desMax: Tree ;
+   location      : location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   p := GetIndice (RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant (tokenNo, expr) ;
+      IF GccKnowsAbout (expr) AND GccKnowsAbout (desLowestType)
+      THEN
+         IF GetMinMax (tokenno, desLowestType, desMin, desMax)
+         THEN
+            IfOutsideLimitsDo (tokenno, desMin,
+                               BuildConvert (location, GetTreeType (desMin), DeReferenceLValue (tokenno, expr), FALSE),
+                               desMax, r, function, message)
+         ELSE
+            InternalError  ('should have resolved the bounds of the static array')
+         END
+      ELSE
+         InternalError  ('should have resolved these types')
+      END
+   END
+END CodeStaticArraySubscript ;
+
+
+(*
+   CodeDynamicArraySubscript -
+*)
+
+PROCEDURE CodeDynamicArraySubscript (tokenno: CARDINAL;
+                                     r: CARDINAL; function, message: String) ;
+VAR
+   UnboundedType: CARDINAL ;
+   p            : Range ;
+   high, e      : Tree ;
+   location     : location_t ;
+BEGIN
+   location := TokenToLocation(tokenno) ;
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenNo, expr) ;
+      Assert(IsVar(des)) ;
+      IF GccKnowsAbout(expr) AND GccKnowsAbout(des)
+      THEN
+         UnboundedType := GetType(des) ;
+         Assert(IsUnbounded(UnboundedType)) ;
+         high := BuildConvert(location, GetIntegerType(), GetHighFromUnbounded(location, dimension, des), FALSE) ;
+         e := BuildConvert(location, GetIntegerType(), DeReferenceLValue(tokenno, expr), FALSE) ;
+         IfOutsideLimitsDo(tokenNo, GetIntegerZero(location), e, high, r, function, message)
+      ELSE
+         InternalError ('should have resolved these types')
+      END
+   END
+END CodeDynamicArraySubscript ;
+
+
+(*
+   CodeForLoopBegin -
+*)
+
+PROCEDURE CodeForLoopBegin (tokenno: CARDINAL;
+                            r: CARDINAL; function, message: String) ;
+BEGIN
+   DoCodeAssignment(tokenno, r, function, message)
+END CodeForLoopBegin ;
+
+
+(*
+   CodeForLoopTo -
+*)
+
+PROCEDURE CodeForLoopTo (tokenno: CARDINAL;
+                         r: CARDINAL; function, message: String) ;
+BEGIN
+   DoCodeAssignment(tokenno, r, function, message)
+END CodeForLoopTo ;
+
+
+(*
+   Pseudo template code for CodeLoopEnd:
+
+   PROCEDURE CheckCardinalInteger (des: CARDINAL; inc: INTEGER) ;
+   VAR
+      room,
+      lg  : CARDINAL ;
+   BEGIN
+      IF inc>=0
+      THEN
+         IF des>=0
+         THEN
+            lg := VAL(CARDINAL, inc) ;
+            room := MAX(CARDINAL)-des ;
+            IF lg>room
+            THEN
+               printf("increment exceeds range at end of FOR loop\n") ;
+               exit (2)
+            END
+         ELSE
+            (* inc can never cause an overflow given its type *)
+         END
+      ELSE
+         (* inc < 0 *)
+         IF des>VAL(CARDINAL, MAX(INTEGER))
+         THEN
+            (* inc can never cause an underflow given its range *)
+         ELSE
+            (* des <= MAX(INTEGER) *)
+            IF des=MIN(INTEGER)
+            THEN
+               printf("increment exceeds range at end of FOR loop\n") ;
+               exit (4)
+            ELSE
+               IF inc=MIN(INTEGER)
+               THEN
+                  IF des=0
+                  THEN
+                     printf("increment exceeds range at end of FOR loop\n") ;
+                     exit (5)
+                  END
+               ELSE
+                  lg := VAL(CARDINAL, -inc) ;
+                  IF lg>des
+                  THEN
+                     printf("increment exceeds range at end of FOR loop\n") ;
+                     exit (5)
+                  END
+               END
+            END
+         END
+      END
+   END CheckCardinalInteger ;
+
+
+   PROCEDURE CheckCardinalCardinal (des: CARDINAL; inc: CARDINAL) ;
+   BEGIN
+      IF MAX(CARDINAL)-des<inc
+      THEN
+         printf("increment exceeds range at end of FOR loop\n") ;
+         exit (2)
+      END
+   END CheckCardinalCardinal ;
+*)
+
+
+(*
+   SameTypesCodeForLoopEnd - the trivial case.
+*)
+
+PROCEDURE SameTypesCodeForLoopEnd (tokenNo: CARDINAL; r: CARDINAL; function, message: String;
+                                   p: Range; dmax: Tree) ;
+VAR
+   inc,
+   room,
+   statement,
+   condition: Tree ;
+   location : location_t ;
+BEGIN
+   location := TokenToLocation(tokenNo) ;
+   WITH p^ DO
+      inc := DeReferenceLValue(tokenNo, expr) ;
+      room := BuildSub(location, dmax, Mod2Gcc(des), FALSE) ;
+      condition := BuildLessThan(location, room, inc) ;
+      statement := BuildIfCallHandler(condition, r, function, message, IsTrue(condition)) ;
+      AddStatement(location, statement)
+   END
+END SameTypesCodeForLoopEnd ;
+
+
+(*
+   DiffTypesSameForLoopEnd - remember that lowestType will map onto an int, or unsigned int
+                             of appropriate size.
+*)
+
+PROCEDURE DiffTypesCodeForLoopEnd (tokenNo: CARDINAL; r: CARDINAL; function, message: String;
+                                   p: Range; dmax, emin, emax: Tree) ;
+VAR
+   location  : location_t ;
+   desoftypee,
+   inc,
+   room,
+   c1, c2, c3,
+   c4, c5, c6,
+   c7, c8,
+   s1, s2, s3,
+   s4, s5, s6,
+   s7, s8,
+   lg1, lg2,
+   dz, ez    : Tree ;
+BEGIN
+   location := TokenToLocation(tokenNo) ;
+   WITH p^ DO
+      inc := DeReferenceLValue(tokenNo, expr) ;
+      ez := BuildConvert(location, Mod2Gcc(exprLowestType), GetIntegerZero(location), FALSE) ;
+      dz := BuildConvert(location, Mod2Gcc(desLowestType), GetIntegerZero(location), FALSE) ;
+
+      c1 := BuildGreaterThanOrEqual(location, inc, ez) ;
+      (* if (inc >= 0)                                           [c1] *)
+      c2 := BuildGreaterThanOrEqual(location, Mod2Gcc(des), dz) ;
+      (*    if (des >= 0)                                        [c2] *)
+      lg1 := BuildConvert(location, Mod2Gcc(desLowestType), inc, FALSE) ;
+      room := BuildSub(location, dmax, Mod2Gcc(des), FALSE) ;
+      c3 := BuildGreaterThan(location, lg1, room) ;           (* [c3]  *)
+      (* WarnIf(IsTrue(c1) AND IsTrue(c2) AND IsTrue(c3), function, message) ; --implement me-- *)
+
+      s3 := BuildIfCallHandler(c3, r, function, message, FALSE) ;
+      s2 := BuildIfThenDoEnd(c2, s3) ;
+
+      (* else *)
+      (*    (* inc < 0 *)                                        [s4]  *)
+      (*    if (des <= val(desLowestType, emax)                  [c4]  *)
+      c4 := BuildLessThanOrEqual(location, Mod2Gcc(des), BuildConvert(location, Mod2Gcc(desLowestType), emax, FALSE)) ;
+      (*    (* des <= MAX(exprLowestType) *) *)
+      desoftypee := BuildConvert(location, Mod2Gcc(exprLowestType), Mod2Gcc(des), FALSE) ;
+      c5 := BuildEqualTo(location, desoftypee, emin) ;        (* [c5]  *)
+      s5 := BuildIfCallHandler(c5, r, function, message, FALSE) ;
+      (*       if des = emin  *)
+      (*          error                                          [s5]  *)
+      (*       end                                                     *)
+      c6 := BuildEqualTo(location, inc, emin) ;              (*  [c6]  *)
+      (*      if inc = emin                                            *)
+      (*         if des = 0                                      [c7]  *)
+      c7 := BuildEqualTo(location, Mod2Gcc(des), dz) ;
+      s7 := BuildIfCallHandler(c7, r, function, message, FALSE) ;
+
+      (*         end                                                   *)
+      (*      else                                                     *)
+      (*         lg2 = VAL(desLowestType, -inc)                  [s8]  *)
+      lg2 := BuildConvert(location, Mod2Gcc(desLowestType), BuildNegate(location, inc, FALSE), FALSE) ;
+      (*         if lg2 > des                                          *)
+      (*             error                                             *)
+      c8 := BuildGreaterThan(location, lg2, Mod2Gcc(des)) ;
+      s8 := BuildIfCallHandler(c8, r, function, message, FALSE) ;
+      (*             end                                               *)
+      (*          end                                                  *)
+      (*       end                                                     *)
+      (*    end                                                        *)
+      (* end                                                           *)
+   END ;
+
+   s6 := BuildIfThenElseEnd(c6, s7, s8) ;
+   s4 := BuildIfThenElseEnd(c4, s5, s6) ;
+   s1 := BuildIfThenElseEnd(c1, s2, s4) ;
+   AddStatement(location, s1)
+
+END DiffTypesCodeForLoopEnd ;
+
+
+(*
+   CodeForLoopEnd - checks to see that des := des + expr does not overflow.
+                    This is called at the end of the for loop.  It is more complex
+                    than it initially seems as des and expr might be different types.
+*)
+
+PROCEDURE CodeForLoopEnd (tokenno: CARDINAL;
+                          r: CARDINAL; function, message: String) ;
+VAR
+   isCard    : BOOLEAN ;
+   p         : Range ;
+   dmin, dmax,
+   emin, emax: Tree ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenno, des) ;   (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      IF desLowestType#NulSym
+      THEN
+         Assert(GccKnowsAbout(expr)) ;
+         IF GccKnowsAbout(desLowestType) AND
+            GetMinMax(tokenno, desLowestType, dmin, dmax) AND
+            GccKnowsAbout(exprLowestType) AND
+            GetMinMax(tokenno, exprLowestType, emin, emax)
+         THEN
+            PushIntegerTree(dmin) ;
+            PushInt(0) ;
+            isCard := GreEqu(tokenno) ;
+            IF (desLowestType=exprLowestType) AND isCard
+            THEN
+               SameTypesCodeForLoopEnd(tokenno, r, function, message, p, dmax)
+            ELSE
+               DiffTypesCodeForLoopEnd(tokenno, r, function, message, p, dmax, emin, emax)
+            END
+         END
+      END
+   END
+END CodeForLoopEnd ;
+
+
+(*
+   CodeNil -
+*)
+
+PROCEDURE CodeNil (r: CARDINAL; function, message: String) ;
+VAR
+   p           : Range ;
+   condition, t: Tree ;
+   location    : location_t ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenNo, des) ;
+(*
+      IF GetMode(des)=LeftValue
+      THEN
+         (* t := BuildIndirect(Mod2Gcc(des), Mod2Gcc(GetType(des))) *)
+      ELSE
+         t := Mod2Gcc(des)
+      END ;
+*)
+      t := Mod2Gcc(des) ;
+      location := TokenToLocation(tokenNo) ;
+      condition := BuildEqualTo(location, BuildConvert(location, GetPointerType(), t, FALSE), GetPointerZero(location)) ;
+      AddStatement(location, BuildIfCallHandler(condition, r, function, message, TRUE))
+   END
+END CodeNil ;
+
+
+(*
+   CodeWholeNonPos - generates range check code for expr<=0.
+*)
+
+PROCEDURE CodeWholeNonPos (tokenno: CARDINAL;
+                           r: CARDINAL; function, message: String) ;
+VAR
+   zero     : CARDINAL ;
+   p        : Range ;
+   condition,
+   e        : Tree ;
+   location : location_t ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant (tokenNo, expr) ;
+      IF GccKnowsAbout (expr)
+      THEN
+         location := TokenToLocation (tokenno) ;
+         e := ZConstToTypedConst (LValueToGenericPtr(location, expr), expr, des) ;
+         zero := MakeAndDeclareConstLit (tokenno, MakeKey('0'), ZType) ;
+         condition := BuildLessThanOrEqual (location, e, Mod2Gcc (zero)) ;
+         AddStatement (location, BuildIfThenDoEnd (condition, CodeErrorCheck (r, function, message)))
+      ELSE
+         InternalError ('should have resolved expr')
+      END
+   END
+END CodeWholeNonPos ;
+
+
+(*
+   CodeWholeZero - generates range check code for expr=0.
+*)
+
+PROCEDURE CodeWholeZero (tokenno: CARDINAL;
+                         r: CARDINAL; function, message: String) ;
+VAR
+   zero     : CARDINAL ;
+   p        : Range ;
+   condition,
+   e        : Tree ;
+   location : location_t ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      TryDeclareConstant(tokenNo, expr) ;
+      IF GccKnowsAbout(expr)
+      THEN
+         location := TokenToLocation(tokenno) ;
+         e := ZConstToTypedConst(LValueToGenericPtr(location, expr), expr, des) ;
+         zero := MakeAndDeclareConstLit (tokenno, MakeKey('0'), ZType) ;
+         condition := BuildEqualTo(location,
+                                   e, BuildConvert(location, GetTreeType(e), Mod2Gcc(zero), FALSE)) ;
+         AddStatement(location, BuildIfThenDoEnd(condition, CodeErrorCheck(r, function, message)))
+      ELSE
+         InternalError ('should have resolved expr')
+      END
+   END
+END CodeWholeZero ;
+
+
+(*
+   InitCaseBounds - creates a case bound range check.
+*)
+
+PROCEDURE InitCaseBounds (b: CARDINAL) : CARDINAL ;
+VAR
+   p: Range ;
+   r: CARDINAL ;
+BEGIN
+   r := InitRange() ;
+   p := PutRangeNoEval(GetIndice(RangeIndex, r), casebounds) ;
+   p^.caseList := b ;
+   RETURN( r )
+END InitCaseBounds ;
+
+
+(*
+   FillInParameters -
+*)
+
+PROCEDURE FillInParameters (r: CARDINAL; s: String) : String ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice (RangeIndex, r) ;
+   WITH p^ DO
+      CASE type OF
+
+      assignment           :  s := MetaString3 (s, des, expr, dimension) |
+      returnassignment     :  s := MetaString3 (s, des, expr, dimension) |
+      subrangeassignment   :  InternalError ('unexpected case') |
+      inc                  :  s := MetaString3 (s, des, expr, dimension) |
+      dec                  :  s := MetaString3 (s, des, expr, dimension) |
+      incl                 :  s := MetaString3 (s, des, expr, dimension) |
+      excl                 :  s := MetaString3 (s, des, expr, dimension) |
+      shift                :  s := MetaString3 (s, des, expr, dimension) |
+      rotate               :  s := MetaString3 (s, des, expr, dimension) |
+      typeassign           :  |
+      typeparam            :  |
+      typeexpr             :  |
+      paramassign          :  s := MetaString3 (s, des, expr, paramNo) |
+      staticarraysubscript :  s := MetaString3 (s, des, expr, dimension) |
+      dynamicarraysubscript:  s := MetaString3 (s, des, expr, dimension) |
+      forloopbegin         :  s := MetaString3 (s, des, expr, dimension) |
+      forloopto            :  s := MetaString3 (s, des, expr, dimension) |
+      forloopend           :  s := MetaString3 (s, des, expr, dimension) |
+      pointernil           :  s := MetaString3 (s, des, expr, dimension) |
+      noreturn             :  s := MetaString3 (s, des, expr, dimension) |
+      noelse               :  s := MetaString3 (s, des, expr, dimension) |
+      casebounds           :  s := MetaString3 (s, des, expr, dimension) |
+      wholenonposdiv       :  s := MetaString3 (s, des, expr, dimension) |
+      wholenonposmod       :  s := MetaString3 (s, des, expr, dimension) |
+      wholezerodiv         :  s := MetaString3 (s, des, expr, dimension) |
+      wholezerorem         :  s := MetaString3 (s, des, expr, dimension) |
+      none                 :  |
+
+      ELSE
+         InternalError ('unexpected case')
+      END
+   END ;
+   RETURN s
+END FillInParameters ;
+
+
+(*
+   GetRangeErrorMessage - returns a specific error message for the range, r.
+                          It assumes the 3 parameters to be supplied on the MetaError
+                          parameter list are:  dest, expr, paramNo or dimension.
+
+XYZ
+                    'the initial assignment to {%1a} at the start of the FOR loop will cause a range error, as the type range of {%1taD} does not overlap with {%2tad}')
+                    'the final TO value {%2a} of the FOR loop will cause a range error with the iterator variable {%1a}')
+*)
+
+PROCEDURE GetRangeErrorMessage (r: CARDINAL) : String ;
+VAR
+   p: Range ;
+   s: String ;
+BEGIN
+   p := GetIndice (RangeIndex, r) ;
+   WITH p^ DO
+      CASE type OF
+
+      assignment           :  s := InitString ('assignment will cause a range error, as the runtime instance value of {%1tad} does not overlap with the type {%2tad}') |
+      returnassignment     :  s := InitString ('attempting to return {%2Wa} from a procedure function {%1a} which will exceed exceed the range of type {%1tad}') |
+      subrangeassignment   :  InternalError ('unexpected case') |
+      inc                  :  s := InitString ('if the INC is ever executed the expression {%2Wa} will cause an overflow error for the designator {%1a} as it exceeds the type range {%1ts:of {%1ts}}') |
+      dec                  :  s := InitString ('if the DEC is ever executed the expression {%2Wa} will cause an underflow error for the designator {%1a} as it exceeds the type range {%1ts:of {%1ts}}') |
+      incl                 :  s := InitString ('the expression {%2Wa} given in the INCL exceeds the type range {%1ts} of the designator {%1a}') |
+      excl                 :  s := InitString ('the expression {%2Wa} given in the EXCL exceeds the type range {%1ts} of the designator {%1a}') |
+      shift                :  s := InitString ('the expression {%2Wa} given in the second parameter to SHIFT exceeds the type range {%1ts} of the first parameter {%1a}') |
+      rotate               :  s := InitString ('the expression {%2Wa} given in the second parameter to ROTATE exceeds the type range {%1ts} of the first parameter {%1a}') |
+      typeassign           :  s := NIL |
+      typeparam            :  s := NIL |
+      typeexpr             :  s := NIL |
+      paramassign          :  s := InitString('if this call is executed then the actual parameter {%2Wa} will be out of range of the {%3N} formal parameter {%1a}') |
+      staticarraysubscript :  s := InitString('if this access to the static array {%1Wa:{%2a:{%1a}[{%2a}]}} is ever made then the index will be out of bounds in the {%3N} array subscript') |
+      dynamicarraysubscript:  s := InitString('if this access to the dynamic array {%1Wa:{%2a:{%1a}[{%2a}]}} is ever made then the index will be out of bounds in the {%3N} array subscript') |
+      forloopbegin         :  s := InitString('if the assignment in this FOR loop is ever executed then the designator {%1Wa} will be exceed the type range {%1ts:of {%1ts}}') |
+      forloopto            :  s := InitString('the final value {%2Wa} in this FOR loop will be out of bounds {%1ts:of type {%1ts}} if ever executed') |
+      forloopend           :  s := InitString('the FOR loop will cause the designator {%1Wa} to be out of bounds when the BY value {%2a} is added') |
+      pointernil           :  s := InitString('if this pointer value {%1Wa} is ever dereferenced it will cause an exception') |
+      noreturn             :  s := InitString('{%1W:}this function will exit without executing a RETURN statement') |
+      noelse               :  s := InitString('{%1W:}this CASE statement does not have an ELSE statement') |
+      casebounds           :  s := InitString('{%1W:}this CASE statement has overlapping ranges') |
+      wholenonposdiv       :  s := InitString('this division expression {%2Wa} will cause an exception as this divisor is less than or equal to zero') |
+      wholenonposmod       :  s := InitString('this modulus expression {%2Wa} will cause an exception as this divisor is less than or equal to zero') |
+      wholezerodiv         :  s := InitString('this division expression {%2Wa} will cause an exception as the divisor is zero') |
+      wholezerorem         :  s := InitString('this remainder expression {%2Wa} will cause an exception as the divisor is zero') |
+      none                 :  s := NIL
+
+      ELSE
+         InternalError ('unexpected case')
+      END
+   END ;
+   RETURN s
+END GetRangeErrorMessage ;
+
+
+(*
+   CodeRangeCheck - returns a Tree representing the code for a
+                    range test defined by, r.
+*)
+
+PROCEDURE CodeRangeCheck (r: CARDINAL; function: String) ;
+VAR
+   p      : Range ;
+   message: String ;
+BEGIN
+   p := GetIndice (RangeIndex, r) ;
+   message := GetRangeErrorMessage (r) ;
+   WITH p^ DO
+      CASE type OF
+
+      assignment           :  CodeAssignment (tokenNo, r, function, message) |
+      returnassignment     :  CodeReturn (tokenNo, r, function, message) |
+      subrangeassignment   :  InternalError  ('unexpected case') |
+      inc                  :  CodeInc (tokenNo, r, function, message) |
+      dec                  :  CodeDec (tokenNo, r, function, message) |
+      incl,
+      excl                 :  CodeInclExcl (tokenNo, r, function, message) |
+      shift,
+      rotate               :  CodeShiftRotate (tokenNo, r, function, message) |
+      typeassign           :  CodeTypeCheck (tokenNo, r) |
+      typeparam            :  CodeTypeCheck (tokenNo, r) |
+      typeexpr             :  CodeTypeCheck (tokenNo, r) |
+      staticarraysubscript :  CodeStaticArraySubscript (tokenNo, r, function, message) |
+      dynamicarraysubscript:  CodeDynamicArraySubscript (tokenNo, r, function, message) |
+      forloopbegin         :  CodeForLoopBegin (tokenNo, r, function, message) |
+      forloopto            :  CodeForLoopTo (tokenNo, r, function, message) |
+      forloopend           :  CodeForLoopEnd (tokenNo, r, function, message) |
+      pointernil           :  CodeNil (r, function, message) |
+      noreturn             :  AddStatement (TokenToLocation (tokenNo), CodeErrorCheck (r, function, message)) |
+      noelse               :  AddStatement (TokenToLocation (tokenNo), CodeErrorCheck (r, function, message)) |
+      casebounds           :  CodeCaseBounds (tokenNo, caseList) |
+      wholenonposdiv       :  CodeWholeNonPos (tokenNo, r, function, message) |
+      wholenonposmod       :  CodeWholeNonPos (tokenNo, r, function, message) |
+      wholezerodiv         :  CodeWholeZero (tokenNo, r, function, message) |
+      wholezerorem         :  CodeWholeZero (tokenNo, r, function, message) |
+      paramassign          :  CodeParameterAssign (tokenNo, r, function, message) |
+      none                 :
+
+      ELSE
+         InternalError ('unexpected case')
+      END
+   END
+END CodeRangeCheck ;
+
+
+(*
+   AddVarRead - checks to see whether symbol, Sym, is
+                a variable or a parameter and if so it
+                then adds this quadruple to the variable
+                list.
+*)
+(*
+PROCEDURE AddVarRead (sym: CARDINAL; quadNo: CARDINAL) ;
+BEGIN
+   IF (sym#NulSym) AND IsVar(sym)
+   THEN
+      PutReadQuad(sym, GetMode(sym), quadNo)
+   END
+END AddVarRead ;
+*)
+
+
+(*
+   SubVarRead - checks to see whether symbol, Sym, is
+                a variable or a parameter and if so it
+                then removes this quadruple from the
+                variable list.
+*)
+
+(*
+PROCEDURE SubVarRead (sym: CARDINAL; quadNo: CARDINAL) ;
+BEGIN
+   IF (sym#NulSym) AND IsVar(sym)
+   THEN
+      RemoveReadQuad(sym, GetMode(sym), quadNo)
+   END
+END SubVarRead ;
+*)
+
+
+(*
+   CheckRangeAddVariableRead - ensures that any references to reading
+                               variables used by this range check, r,
+                               at this, quadNo, are recorded in the
+                               symbol table.
+*)
+
+(*
+PROCEDURE CheckRangeAddVariableRead (r: CARDINAL; quadNo: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      (* AddVarRead(des, quadNo) ; *)
+      (* AddVarRead(expr, quadNo) *)
+   END
+END CheckRangeAddVariableRead ;
+*)
+
+
+(*
+   CheckRangeRemoveVariableRead - ensures that any references to reading
+                                  variable at this quadNo are removed from
+                                  the symbol table.
+*)
+
+(*
+PROCEDURE CheckRangeRemoveVariableRead (r: CARDINAL; quadNo: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      (* SubVarRead(des, quadNo) ; *)
+      (* SubVarRead(expr, quadNo) *)
+   END
+END CheckRangeRemoveVariableRead ;
+*)
+
+
+(*
+   WriteRangeCheck - displays debugging information about range, r.
+*)
+
+PROCEDURE WriteRangeCheck (r: CARDINAL) ;
+VAR
+   p: Range ;
+BEGIN
+   p := GetIndice(RangeIndex, r) ;
+   WITH p^ DO
+      CASE type OF
+
+      assignment           :  WriteString('assignment (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      returnassignment     :  WriteString('returnassignment (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      subrangeassignment   :  WriteString('subrangeassignment(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      inc                  :  WriteString('inc(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      dec                  :  WriteString('dec(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      incl                 :  WriteString('incl(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      excl                 :  WriteString('excl(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      shift                :  WriteString('shift(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      rotate               :  WriteString('rotate(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      typeexpr             :  WriteString('expr compatible (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      typeassign           :  WriteString('assignment compatible (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      typeparam            :  WriteString('parameter compatible (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      paramassign          :  WriteString('parameter range (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      staticarraysubscript :  WriteString('staticarraysubscript(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      dynamicarraysubscript:  WriteString('dynamicarraysubscript(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      forloopbegin         :  WriteString('forloopbegin(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      forloopto            :  WriteString('forloopto(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      forloopend           :  WriteString('forloopend(') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
+      pointernil           :  WriteString('pointernil(') ; WriteOperand(des) |
+      noreturn             :  WriteString('noreturn(') |
+      noelse               :  WriteString('noelse(') |
+      casebounds           :  WriteString('casebounds(') ; WriteCase(caseList) |
+      wholenonposdiv       :  WriteString('wholenonposdiv(') ; WriteOperand(expr) |
+      wholenonposmod       :  WriteString('wholenonposmod(') ; WriteOperand(expr) |
+      wholezerodiv         :  WriteString('wholezerodiv(') ; WriteOperand(expr) |
+      wholezerorem         :  WriteString('wholezerorem(') ; WriteOperand(expr) |
+      none                 :  WriteString('none(') |
+
+      ELSE
+         InternalError ('unknown case')
+      END ;
+      Write(')')
+   END
+END WriteRangeCheck ;
+
+
+(*
+   Init - initializes the modules global variables.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   TopOfRange := 0 ;
+   RangeIndex := InitIndex(1)
+END Init ;
+
+
+BEGIN
+   Init
+END M2Range.
diff --git a/gcc/m2/gm2-compiler/M2Reserved.def b/gcc/m2/gm2-compiler/M2Reserved.def
new file mode 100644
index 00000000000..0f63245850c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Reserved.def
@@ -0,0 +1,128 @@
+(* M2Reserved.def determines is a token is a reserved word.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Reserved ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Reserved
+   Date       : 15/5/87
+   Description: implements a procedure to determine if a symbol is a
+                Modula-2 reserved word and provides conversion between
+                toktype and the equivalent stringed, Name.
+*)
+
+FROM NameKey IMPORT Name ;
+
+EXPORT QUALIFIED IsReserved, tokToTok,
+
+   NulTok, PlusTok, MinusTok, TimesTok, DivideTok, BecomesTok,
+   AmbersandTok, PeriodTok, CommaTok, SemiColonTok, LParaTok,
+   LSBraTok, LCBraTok, UpArrowTok, SingleQuoteTok, EqualTok,
+   HashTok, LessTok, GreaterTok, LessGreaterTok, LessEqualTok,
+   GreaterEqualTok, PeriodPeriodTok, ColonTok, RParaTok,
+   RSBraTok, RCBraTok, BarTok, DoubleQuotesTok,
+
+   AndTok, ArrayTok, BeginTok, ByTok, CaseTok, ConstTok,
+   DefinitionTok, DivTok, DoTok, ElseTok, ElsifTok, EndTok,
+   ExceptTok,
+   ExitTok, ExportTok, FinallyTok, ForTok, FromTok, IfTok,
+   ImplementationTok, ImportTok, InTok, LoopTok, ModTok,
+   ModuleTok, NotTok, OfTok, OrTok,
+   PackedSetTok, PointerTok, ProcedureTok,
+   QualifiedTok, UnQualifiedTok, RecordTok, RetryTok,
+   RemTok, RepeatTok,
+   ReturnTok, SetTok, ThenTok, ToTok, TypeTok, UntilTok, VarTok,
+   WhileTok, WithTok,
+
+   (* additional tokens which extend PIM Modula-2 slightly *)
+   EofTok, AsmTok, VolatileTok, DateTok, LineTok, FileTok,
+   AttributeTok, BuiltinTok, InlineTok,
+   toktype ;
+
+TYPE
+   toktype = (eoftok, plustok, minustok, timestok, dividetok,
+              becomestok, ambersandtok, periodtok, commatok,
+              semicolontok, lparatok, rparatok, lsbratok, rsbratok,
+              lcbratok, rcbratok, uparrowtok, singlequotetok,
+              equaltok, hashtok, lesstok, greatertok, lessgreatertok,
+              lessequaltok, greaterequaltok,
+              ldirectivetok, rdirectivetok,
+              periodperiodtok,
+              colontok, doublequotestok, bartok, andtok,
+              arraytok, begintok, bytok, casetok, consttok,
+              definitiontok, divtok, dotok, elsetok, elsiftok,
+              endtok, excepttok, exittok, exporttok, finallytok,
+              fortok, fromtok, iftok, implementationtok,
+              importtok, intok, looptok, modtok,
+              moduletok, nottok, oftok, ortok,
+              packedsettok, pointertok, proceduretok,
+              qualifiedtok, unqualifiedtok,
+              recordtok, remtok, repeattok, retrytok, returntok,
+              settok, thentok,
+              totok, typetok, untiltok, vartok, whiletok, withtok,
+              asmtok, volatiletok, periodperiodperiodtok,
+              datetok, linetok, filetok,
+              attributetok, builtintok, inlinetok,
+              integertok, identtok, realtok, stringtok,
+              virtualrangetok) ;
+
+VAR
+   NulTok, PlusTok, MinusTok, TimesTok, DivideTok, BecomesTok,
+   AmbersandTok, PeriodTok, CommaTok, SemiColonTok, LParaTok,
+   LSBraTok, LCBraTok, UpArrowTok, SingleQuoteTok, EqualTok,
+   HashTok, LessTok, GreaterTok, LessGreaterTok, LessEqualTok,
+   GreaterEqualTok, LDirectiveTok, RDirectiveTok,
+   PeriodPeriodTok, ColonTok, RParaTok,
+   RSBraTok, RCBraTok, BarTok, DoubleQuotesTok,
+
+   AndTok, ArrayTok, BeginTok, ByTok, CaseTok, ConstTok,
+   DefinitionTok, DivTok, DoTok, ElseTok, ElsifTok, EndTok,
+   ExceptTok, ExitTok, ExportTok, FinallyTok, ForTok, FromTok,
+   IfTok, ImplementationTok, ImportTok, InTok, LoopTok, ModTok,
+   ModuleTok, NotTok, OfTok, OrTok,
+   PackedSetTok, PointerTok, ProcedureTok,
+   QualifiedTok, UnQualifiedTok, RecordTok, RemTok, RepeatTok,
+   RetryTok, ReturnTok, SetTok, ThenTok, ToTok, TypeTok,
+   UntilTok, VarTok, WhileTok, WithTok,
+
+   EofTok, AsmTok, VolatileTok,
+   DateTok, LineTok, FileTok,
+   AttributeTok, BuiltinTok, InlineTok: Name ;
+
+
+(*
+   IsReserved - returns TRUE if the symbol, Name, is a reserved word.
+                If TRUE it also sets tok to the appropriate enumerated
+                value.
+*)
+
+PROCEDURE IsReserved (n: Name; VAR tok: toktype) : BOOLEAN ;
+
+
+(*
+   tokToTok - returns a Tok given the enumerated variable, t.
+*)
+
+PROCEDURE tokToTok (t: toktype) : Name ;
+
+
+END M2Reserved.
diff --git a/gcc/m2/gm2-compiler/M2Reserved.mod b/gcc/m2/gm2-compiler/M2Reserved.mod
new file mode 100644
index 00000000000..e5918a60fba
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Reserved.mod
@@ -0,0 +1,358 @@
+(* M2Reserved.mod determines is a token is a reserved word.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Reserved ;
+
+
+FROM SymbolKey IMPORT SymbolTree, InitTree, PutSymKey, GetSymKey ;
+FROM NameKey IMPORT MakeKey, NulName ;
+FROM ASCII IMPORT nul ;
+
+CONST
+   eof = 032C ;
+
+VAR
+   NameTotok,
+   tokToName: SymbolTree ;
+
+
+(*
+   AddKeyword - adds the Name and enumerated value of a keyword
+                into the binary tree.
+*)
+
+PROCEDURE AddKeyword (n: Name; tok: toktype) ;
+BEGIN
+   PutSymKey(NameTotok, n, tok) ;
+   PutSymKey(tokToName, VAL(Name, tok), n)
+END AddKeyword ;
+
+
+PROCEDURE Init ;
+VAR
+   a: ARRAY [0..1] OF CHAR ;
+BEGIN
+   InitTree(NameTotok) ;
+   InitTree(tokToName) ;
+
+   NulTok := NulName ;
+
+   PlusTok := MakeKey('+') ;
+   AddKeyword(PlusTok, plustok) ;
+
+   MinusTok := MakeKey('-') ;
+   AddKeyword(MinusTok, minustok) ;
+
+   TimesTok := MakeKey('*') ;
+   AddKeyword(TimesTok, timestok) ;
+
+   DivideTok := MakeKey('/') ;
+   AddKeyword(DivideTok, dividetok) ;
+
+   BecomesTok := MakeKey(':=') ;
+   AddKeyword(BecomesTok, becomestok) ;
+
+   AmbersandTok := MakeKey('&') ;
+   AddKeyword(AmbersandTok, ambersandtok) ;
+
+   PeriodTok := MakeKey('.') ;
+   AddKeyword(PeriodTok, periodtok) ;
+
+   CommaTok := MakeKey(',') ;
+   AddKeyword(CommaTok, commatok) ;
+
+   SemiColonTok := MakeKey(';') ;
+   AddKeyword(SemiColonTok, semicolontok) ;
+
+   LParaTok := MakeKey('(') ;
+   AddKeyword(LParaTok, lparatok) ;
+
+   LSBraTok := MakeKey('[') ;
+   AddKeyword(LSBraTok, lsbratok) ;
+
+   LCBraTok := MakeKey('{') ;
+   AddKeyword(LCBraTok, lcbratok) ;
+
+   UpArrowTok := MakeKey('^') ;
+   AddKeyword(UpArrowTok, uparrowtok) ;
+
+   SingleQuoteTok := MakeKey("'") ;
+   AddKeyword(SingleQuoteTok, singlequotetok) ;
+
+   EqualTok := MakeKey('=') ;
+   AddKeyword(EqualTok, equaltok) ;
+
+   HashTok := MakeKey('#') ;
+   AddKeyword(HashTok, hashtok) ;
+
+   LessTok := MakeKey('<') ;
+   AddKeyword(LessTok, lesstok) ;
+
+   GreaterTok := MakeKey('>') ;
+   AddKeyword(GreaterTok, greatertok) ;
+
+   LessGreaterTok := MakeKey('<>') ;
+   AddKeyword(LessGreaterTok, lessgreatertok) ;
+
+   LessEqualTok := MakeKey('<=') ;
+   AddKeyword(LessEqualTok, lessequaltok) ;
+
+   GreaterEqualTok := MakeKey('>=') ;
+   AddKeyword(GreaterEqualTok, greaterequaltok) ;
+
+   LDirectiveTok := MakeKey('<*') ;
+   AddKeyword(LDirectiveTok, ldirectivetok) ;
+
+   RDirectiveTok := MakeKey('*>') ;
+   AddKeyword(RDirectiveTok, rdirectivetok) ;
+
+   PeriodPeriodTok := MakeKey('..') ;
+   AddKeyword(PeriodPeriodTok, periodperiodtok) ;
+
+   ColonTok := MakeKey(':') ;
+   AddKeyword(ColonTok, colontok) ;
+
+   RParaTok := MakeKey(')') ;
+   AddKeyword(RParaTok, rparatok) ;
+
+   RSBraTok := MakeKey(']') ;
+   AddKeyword(RSBraTok, rsbratok) ;
+
+   RCBraTok := MakeKey('}') ;
+   AddKeyword(RCBraTok, rcbratok) ;
+
+   BarTok := MakeKey('|') ;
+   AddKeyword(BarTok, bartok) ;
+
+   DoubleQuotesTok := MakeKey('"') ;
+   AddKeyword(DoubleQuotesTok, doublequotestok) ;
+
+
+   AndTok := MakeKey('AND') ;
+   AddKeyword(AndTok, andtok) ;
+
+   ArrayTok := MakeKey('ARRAY') ;
+   AddKeyword(ArrayTok, arraytok) ;
+
+   BeginTok := MakeKey('BEGIN') ;
+   AddKeyword(BeginTok, begintok) ;
+
+   ByTok := MakeKey('BY') ;
+   AddKeyword(ByTok, bytok) ;
+
+   CaseTok := MakeKey('CASE') ;
+   AddKeyword(CaseTok, casetok) ;
+
+   ConstTok := MakeKey('CONST') ;
+   AddKeyword(ConstTok, consttok) ;
+
+   DefinitionTok := MakeKey('DEFINITION') ;
+   AddKeyword(DefinitionTok, definitiontok) ;
+
+   DivTok := MakeKey('DIV') ;
+   AddKeyword(DivTok, divtok) ;
+
+   DoTok := MakeKey('DO') ;
+   AddKeyword(DoTok, dotok) ;
+
+   ElseTok := MakeKey('ELSE') ;
+   AddKeyword(ElseTok, elsetok) ;
+
+   ElsifTok := MakeKey('ELSIF') ;
+   AddKeyword(ElsifTok, elsiftok) ;
+
+   EndTok := MakeKey('END') ;
+   AddKeyword(EndTok, endtok) ;
+
+   ExitTok := MakeKey('EXIT') ;
+   AddKeyword(ExitTok, exittok) ;
+
+   ExceptTok := MakeKey('EXCEPT') ;
+   AddKeyword(ExceptTok, excepttok) ;
+
+   ExportTok := MakeKey('EXPORT') ;
+   AddKeyword(ExportTok, exporttok) ;
+
+   FinallyTok := MakeKey('FINALLY') ;
+   AddKeyword(FinallyTok, finallytok) ;
+
+   ForTok := MakeKey('FOR') ;
+   AddKeyword(ForTok, fortok) ;
+
+   FromTok := MakeKey('FROM') ;
+   AddKeyword(FromTok, fromtok) ;
+
+   IfTok := MakeKey('IF') ;
+   AddKeyword(IfTok, iftok) ;
+
+   ImplementationTok := MakeKey('IMPLEMENTATION') ;
+   AddKeyword(ImplementationTok, implementationtok) ;
+
+   ImportTok := MakeKey('IMPORT') ;
+   AddKeyword(ImportTok, importtok) ;
+
+   InTok := MakeKey('IN') ;
+   AddKeyword(InTok, intok) ;
+
+   LoopTok := MakeKey('LOOP') ;
+   AddKeyword(LoopTok, looptok) ;
+
+   ModTok := MakeKey('MOD') ;
+   AddKeyword(ModTok, modtok) ;
+
+   ModuleTok := MakeKey('MODULE') ;
+   AddKeyword(ModuleTok, moduletok) ;
+
+   NotTok := MakeKey('NOT') ;
+   AddKeyword(NotTok, nottok) ;
+
+   OfTok := MakeKey('OF') ;
+   AddKeyword(OfTok, oftok) ;
+
+   OrTok := MakeKey('OR') ;
+   AddKeyword(OrTok, ortok) ;
+(*
+   PackedTok := MakeKey('PACKED') ;
+   AddKeyword(PackedTok, packedtok) ;
+*)
+   PackedSetTok := MakeKey('PACKEDSET') ;
+   AddKeyword(PackedSetTok, packedsettok) ;
+
+   PointerTok := MakeKey('POINTER') ;
+   AddKeyword(PointerTok, pointertok) ;
+
+   ProcedureTok := MakeKey('PROCEDURE') ;
+   AddKeyword(ProcedureTok, proceduretok) ;
+
+   QualifiedTok := MakeKey('QUALIFIED') ;
+   AddKeyword(QualifiedTok, qualifiedtok) ;
+
+   UnQualifiedTok := MakeKey('UNQUALIFIED') ;
+   AddKeyword(UnQualifiedTok, unqualifiedtok) ;
+
+   RecordTok := MakeKey('RECORD') ;
+   AddKeyword(RecordTok, recordtok) ;
+
+   RemTok := MakeKey('REM') ;
+   AddKeyword(RemTok, remtok) ;
+
+   RepeatTok := MakeKey('REPEAT') ;
+   AddKeyword(RepeatTok, repeattok) ;
+
+   RetryTok := MakeKey('RETRY') ;
+   AddKeyword(RetryTok, retrytok) ;
+
+   ReturnTok := MakeKey('RETURN') ;
+   AddKeyword(ReturnTok, returntok) ;
+
+   SetTok := MakeKey('SET') ;
+   AddKeyword(SetTok, settok) ;
+
+   ThenTok := MakeKey('THEN') ;
+   AddKeyword(ThenTok, thentok) ;
+
+   ToTok := MakeKey('TO') ;
+   AddKeyword(ToTok, totok) ;
+
+   TypeTok := MakeKey('TYPE') ;
+   AddKeyword(TypeTok, typetok) ;
+
+   UntilTok := MakeKey('UNTIL') ;
+   AddKeyword(UntilTok, untiltok) ;
+
+   VarTok := MakeKey('VAR') ;
+   AddKeyword(VarTok, vartok) ;
+
+   WhileTok := MakeKey('WHILE') ;
+   AddKeyword(WhileTok, whiletok) ;
+
+   WithTok := MakeKey('WITH') ;
+   AddKeyword(WithTok, withtok) ;
+
+   AsmTok := MakeKey('ASM') ;
+   AddKeyword(AsmTok, asmtok) ;
+
+   VolatileTok := MakeKey('VOLATILE') ;
+   AddKeyword(VolatileTok, volatiletok) ;
+
+   DateTok := MakeKey('__DATE__') ;     (* C compatible preprocessor primatives *)
+   AddKeyword(DateTok, datetok) ;
+
+   LineTok := MakeKey('__LINE__') ;
+   AddKeyword(LineTok, linetok) ;
+
+   FileTok := MakeKey('__FILE__') ;
+   AddKeyword(FileTok, filetok) ;
+
+   AttributeTok := MakeKey('__ATTRIBUTE__') ; (* GCC extension incorporated into gm2 *)
+   AddKeyword(AttributeTok, attributetok) ;
+
+   BuiltinTok := MakeKey('__BUILTIN__') ; (* GCC extension incorporated into gm2 *)
+   AddKeyword(BuiltinTok, builtintok) ;
+
+   InlineTok := MakeKey('__INLINE__') ; (* GCC extension incorporated into gm2 *)
+   AddKeyword(InlineTok, inlinetok) ;
+
+   a[0] := eof ;
+   a[1] := nul ;
+   EofTok := MakeKey(a)              (* Not a reserved token *)
+END Init ;
+
+
+(*
+   IsReserved - returns TRUE if the symbol, Name, is a reserved word.
+                If TRUE it also sets tok to the appropriate enumerated
+                value. It will set tok to eoftok if appropriate.
+*)
+
+PROCEDURE IsReserved (n: Name; VAR tok: toktype) : BOOLEAN ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := GetSymKey(NameTotok, n) ;
+   IF t=0
+   THEN
+      (* eoftok is not a reserved word *)
+      IF n=EofTok
+      THEN
+         tok := eoftok
+      END ;
+      RETURN( FALSE )
+   ELSE
+      tok := VAL(toktype, t) ;
+      RETURN( TRUE )
+   END
+END IsReserved ;
+
+
+(*
+   tokToTok - returns a Tok given the enumerated variable, t.
+*)
+
+PROCEDURE tokToTok (t: toktype) : Name ;
+BEGIN
+   RETURN( GetSymKey(tokToName, VAL(Name, t)) )
+END tokToTok ;
+
+
+BEGIN
+   Init
+END M2Reserved.
diff --git a/gcc/m2/gm2-compiler/M2SSA.def b/gcc/m2/gm2-compiler/M2SSA.def
new file mode 100644
index 00000000000..b4a85590f52
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2SSA.def
@@ -0,0 +1,27 @@
+DEFINITION MODULE M2SSA ;
+
+(*
+    Title      : M2SSA
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon May 10 17:04:19 2021
+    Revision   : $Version$
+    Description:
+*)
+
+EXPORT QUALIFIED DiscoverSSA, EnableSSA ;
+
+
+CONST
+   EnableSSA = FALSE ;
+
+
+(*
+   DiscoverSSA - perform a very simple check to determine whether a
+                 temporary is a single use write.
+*)
+
+PROCEDURE DiscoverSSA (scope: CARDINAL) ;
+
+
+END M2SSA.
diff --git a/gcc/m2/gm2-compiler/M2SSA.mod b/gcc/m2/gm2-compiler/M2SSA.mod
new file mode 100644
index 00000000000..e2fba18d926
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2SSA.mod
@@ -0,0 +1,173 @@
+(* M2SSA.mod discover very obvious single assignment temporaries.
+
+Copyright (C) 2021-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2SSA ;
+
+
+FROM M2Debug IMPORT Assert ;
+
+FROM NameKey IMPORT Name, WriteKey, MakeKey, GetKey ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+
+FROM M2Error IMPORT InternalError ;
+FROM M2Batch IMPORT GetModuleNo ;
+FROM M2Quiet IMPORT qprintf1 ;
+FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock, ForeachScopeBlockDo ;
+FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord, PushWord, PopWord, PeepWord ;
+FROM M2Options IMPORT CompilerDebugging ;
+FROM Lists IMPORT InitList, KillList, List, IncludeItemIntoList, IsItemInList ;
+FROM M2Printf IMPORT printf0, printf1, printf2 ;
+
+FROM SymbolTable IMPORT GetSymName,
+                        GetProcedureQuads, GetModuleQuads,
+                        GetModule, GetNthProcedure,
+                        GetSubrange, GetModuleScope,
+                        PutProcedureReachable, IsProcedureReachable,
+                        PutProcedureStartQuad, PutProcedureEndQuad,
+                        PutProcedureScopeQuad,
+                        PutNeedSavePriority,
+                        IsProcedure, GetPriority,
+                        GetDeclaredMod, GetFirstUsed,
+                        GetType, GetNth, GetWriteQuads, GetReadQuads, GetMode,
+                        IsExportQualified, IsExportUnQualified, IsExported,
+                        ForeachProcedureDo, ForeachInnerModuleDo,
+                        IsModuleWithinProcedure, IsTemporary,
+                        PutVariableSSA,
+                        NulSym ;
+
+FROM M2Quads IMPORT QuadOperator, GetQuad, GetFirstQuad, GetNextQuad,
+                    PutQuad, SubQuad, Opposite, IsReferenced,
+                    GetRealQuad ;
+
+VAR
+   stack  : StackOfWord ;
+   visited: List ;
+
+
+(*
+   writtenOnce - return TRUE if variable is written to once.
+*)
+
+PROCEDURE writtenOnce (variable: CARDINAL) : BOOLEAN ;
+VAR
+   writeStart, writeEnd: CARDINAL ;
+   readStart, readEnd  : CARDINAL ;
+BEGIN
+   GetWriteQuads (variable, GetMode (variable), writeStart, writeEnd) ;
+   GetReadQuads (variable, GetMode (variable), readStart, readEnd) ;
+   RETURN (writeStart = writeEnd) AND ((readStart > writeStart) OR (readStart = 0))
+END writtenOnce ;
+
+
+(*
+   DetermineSSA - performs a trivial check to see if the temporary is written to
+                  once.
+*)
+
+PROCEDURE DetermineSSA (variable: CARDINAL) ;
+VAR
+   name: Name ;
+BEGIN
+   IF EnableSSA AND IsTemporary (variable)
+   THEN
+      name := GetSymName (variable) ;
+      IF writtenOnce (variable)
+      THEN
+         PutVariableSSA (variable, TRUE) ;
+         IF CompilerDebugging
+         THEN
+            printf1 ("  temporary:  %a  SSA found\n", name)
+         END
+      ELSE
+         IF CompilerDebugging
+         THEN
+            printf1 ("  temporary:  %a  not SSA\n", name)
+         END
+      END
+   END
+END DetermineSSA ;
+
+
+(*
+   DiscoverSSATemporaries -
+*)
+
+PROCEDURE DiscoverSSATemporaries (scope: CARDINAL) ;
+VAR
+   n,
+   variable: CARDINAL ;
+BEGIN
+   IF CompilerDebugging
+   THEN
+      printf1 ("examining scope %d\n", scope)
+   END ;
+   n := 1 ;
+   variable := GetNth (scope, n) ;
+   WHILE variable # NulSym DO
+      DetermineSSA (variable) ;
+      INC (n) ;
+      variable := GetNth (scope, n)
+   END
+END DiscoverSSATemporaries ;
+
+
+(*
+   DiscoverSSA - perform a very simple check to determine whether a
+                 temporary is a single use write.
+*)
+
+PROCEDURE DiscoverSSA (scope: CARDINAL) ;
+VAR
+   sb: ScopeBlock ;
+BEGIN
+   IF NOT IsItemInList (visited, scope)
+   THEN
+      IncludeItemIntoList (visited, scope) ;
+      sb := InitScopeBlock (scope) ;
+      PushWord (stack, scope) ;
+      IF CompilerDebugging
+      THEN
+         printf1 ("DiscoverSSA %d\n", scope)
+      END ;
+
+      IF CompilerDebugging
+      THEN
+         printf0 ("ForeachInnerModuleDo\n")
+      END ;
+      ForeachInnerModuleDo(scope, DiscoverSSA) ;
+      IF CompilerDebugging
+      THEN
+         printf0 ("ForeachProcedureDo\n")
+      END ;
+      ForeachProcedureDo(scope, DiscoverSSA) ;
+      DiscoverSSATemporaries (scope) ;
+
+      Assert (PopWord (stack) = scope) ;
+      KillScopeBlock (sb)
+   END
+END DiscoverSSA ;
+
+
+BEGIN
+   stack := InitStackWord () ;
+   InitList (visited)
+END M2SSA.
diff --git a/gcc/m2/gm2-compiler/M2Scaffold.def b/gcc/m2/gm2-compiler/M2Scaffold.def
new file mode 100644
index 00000000000..48a47c5e0dc
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Scaffold.def
@@ -0,0 +1,74 @@
+(* M2Scaffold.def declare and create scaffold entities.
+
+Copyright (C) 2022 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/>.  *)
+
+DEFINITION MODULE M2Scaffold ;
+
+
+VAR
+   ctorArray,
+   linkFunction,
+   finiFunction,
+   initFunction,
+   mainFunction: CARDINAL ;
+
+
+(*
+   DeclareScaffold - declare scaffold related entities.
+*)
+
+PROCEDURE DeclareScaffold (tokno: CARDINAL) ;
+
+
+(*
+   DeclareArgEnvParams - declares (int argc, void *argv, void *envp)
+*)
+
+PROCEDURE DeclareArgEnvParams (tokno: CARDINAL; proc: CARDINAL) ;
+
+
+(*
+   PopulateCtorArray - assign each element of the ctorArray to the external module ctor.
+                       This is only used to force the linker to pull in the ctors from
+                       a library.
+*)
+
+PROCEDURE PopulateCtorArray (tok: CARDINAL) ;
+
+
+(*
+   ForeachModuleCallInit - precondition: the module list will be ordered.
+                           postcondition: foreach module in the application universe
+                                             call _M2_module_init (argc, argv, envp);
+*)
+
+PROCEDURE ForeachModuleCallInit (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
+
+
+(*
+   ForeachModuleCallFinish - precondition: the module list will be ordered.
+                             postcondition: foreach module in the application universe
+                                               call _M2_module_finish (argc, argv, envp);
+*)
+
+PROCEDURE ForeachModuleCallFinish (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
+
+
+END M2Scaffold.
diff --git a/gcc/m2/gm2-compiler/M2Scaffold.mod b/gcc/m2/gm2-compiler/M2Scaffold.mod
new file mode 100644
index 00000000000..ea8cddf9e2c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Scaffold.mod
@@ -0,0 +1,629 @@
+(* M2Scaffold.mod declare and create scaffold entities.
+
+Copyright (C) 2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Scaffold ;
+
+FROM SymbolTable IMPORT NulSym, MakeProcedure, PutFunction,
+                        PutPublic, PutCtor, PutParam, IsProcedure,
+                        MakeConstant, PutExtern, MakeArray, PutArray,
+                        MakeSubrange, PutSubrange,
+                        MakeSubscript, PutSubscript, PutArraySubscript,
+                        MakeVar, PutVar, MakeProcedureCtorExtern,
+                        PutMonoName,
+                        GetMainModule, GetModuleCtors, MakeDefImp,
+                        PutModuleCtorExtern, IsDefinitionForC,
+                        ForeachModuleDo, IsDefImp, IsModule,
+                        IsModuleBuiltin, IsImport, IsImportStatement,
+                        GetSymName, StartScope, EndScope,
+                        GetModuleDefImportStatementList,
+                        GetModuleModImportStatementList,
+                        GetImportModule, GetImportStatementList ;
+
+FROM NameKey IMPORT NulName, Name, MakeKey, makekey, KeyToCharStar ;
+FROM M2Base IMPORT Integer, Cardinal ;
+FROM M2System IMPORT Address ;
+FROM M2LexBuf IMPORT GetTokenNo ;
+FROM Assertion IMPORT Assert ;
+FROM Lists IMPORT List, InitList, IncludeItemIntoList, NoOfItemsInList, GetItemFromList, KillList, IsItemInList ;
+FROM M2MetaError IMPORT MetaErrorT0, MetaErrorStringT0 ;
+
+FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead, Exists ;
+FROM FIO IMPORT File, EOF, IsNoError, Close ;
+
+FROM M2Options IMPORT GetUselist, ScaffoldStatic, ScaffoldDynamic, GenModuleList,
+                      GetGenModuleFilename, GetUselistFilename, GetUselist, cflag,
+                      SharedFlag, WholeProgram ;
+
+FROM M2Base IMPORT Proc ;
+
+FROM M2Quads IMPORT PushTFtok, PushTtok, PushT, BuildDesignatorArray, BuildAssignment,
+                    BuildProcedureCall ;
+
+FROM M2Batch IMPORT IsModuleKnown, Get ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ;
+FROM FormatStrings IMPORT HandleEscape ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, RemoveWhitePrefix,
+                    EqualArray, Mark, Assign, Fin, InitStringChar, Length, Slice, Equal,
+                    RemoveComment, string, InitStringCharStar ;
+
+FROM M2Graph IMPORT Graph, InitGraph, KillGraph, AddDependent, SortGraph ;
+
+
+CONST
+   Comment   = '#'  ; (* Comment leader      *)
+   Debugging = FALSE ;
+
+VAR
+   uselistModules,
+   ctorModules,
+   ctorGlobals   : List ;
+   ctorArrayType : CARDINAL ;
+   initialized   : BOOLEAN ;
+
+
+(* The dynamic scaffold takes the form:
+
+static void _M2_init (int argc, char *argv[], char *envp[])
+{
+  M2RTS_ConstructModules (module_name, argc, argv, envp);
+}
+
+
+static void _M2_fini (int argc, char *argv[], char *envp[])
+{
+  M2RTS_Terminate ();
+  M2RTS_DeconstructModules (module_name, argc, argv, envp);
+}
+
+
+int
+main (int argc, char *argv[], char *envp[])
+{
+  init (argc, argv, envp);
+  fini (argc, argv, envp);
+  return (0);
+}  *)
+
+
+(*
+   DeclareCtorArrayType - declare an ARRAY [0..high] OF PROC which will
+                          be used to reference every module ctor.
+*)
+
+PROCEDURE DeclareCtorArrayType (tokenno: CARDINAL; high: CARDINAL) : CARDINAL ;
+VAR
+   subscript,
+   subrange : CARDINAL ;
+BEGIN
+   (* ctorArrayType = ARRAY [0..n] OF PROC ;  *)
+   ctorArrayType := MakeArray (tokenno, MakeKey ('ctorGlobalType')) ;
+   PutArray (ctorArrayType, Proc) ;
+   subrange := MakeSubrange (tokenno, NulName) ;
+   PutSubrange (subrange,
+                MakeConstant (tokenno, 0),
+                MakeConstant (tokenno, high),
+                Cardinal) ;
+   subscript := MakeSubscript () ;
+   PutSubscript (subscript, subrange) ;
+   PutArraySubscript (ctorArrayType, subscript) ;
+   RETURN ctorArrayType
+END DeclareCtorArrayType ;
+
+
+(*
+   DeclareCtorGlobal - declare the ctorArray variable.
+*)
+
+PROCEDURE DeclareCtorGlobal (tokenno: CARDINAL) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   n := NoOfItemsInList (ctorGlobals) ;
+   ctorArrayType := DeclareCtorArrayType (tokenno, n) ;
+   ctorArray := MakeVar (tokenno, MakeKey ('_M2_ctorArray')) ;
+   PutVar (ctorArray, ctorArrayType)
+END DeclareCtorGlobal ;
+
+
+(*
+   ForeachModuleCallInit - is only called when -fscaffold-static is enabled.
+                           precondition: the module list will be ordered.
+                           postcondition: foreach module in the application universe
+                                             call _M2_module_init (argc, argv, envp);
+*)
+
+PROCEDURE ForeachModuleCallInit (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
+VAR
+   module    : CARDINAL ;
+   i, n      : CARDINAL ;
+   ctor, init,
+   fini, dep : CARDINAL ;
+BEGIN
+   i := 1 ;
+   n := NoOfItemsInList (uselistModules) ;
+   WHILE i <= n DO
+      module := GetItemFromList (uselistModules, i) ;
+      IF module # NulSym
+      THEN
+         GetModuleCtors (module, ctor, init, fini, dep) ;
+         IF init # NulSym
+         THEN
+            PushTtok (init, tok) ;
+            PushTtok (argc, tok) ;
+            PushTtok (argv, tok) ;
+            PushTtok (envp, tok) ;
+            PushT (3) ;
+            BuildProcedureCall (tok)
+         END
+      END ;
+      INC (i)
+   END
+END ForeachModuleCallInit ;
+
+
+(*
+   ForeachModuleCallFinish - precondition: the module list will be ordered.
+                             postcondition: foreach module in the application universe
+                                               call _M2_module_fini (argc, argv, envp);
+*)
+
+PROCEDURE ForeachModuleCallFinish (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
+VAR
+   module    : CARDINAL ;
+   i         : CARDINAL ;
+   ctor, init,
+   fini, dep : CARDINAL ;
+BEGIN
+   i := NoOfItemsInList (uselistModules) ;
+   WHILE i >= 1 DO
+      module := GetItemFromList (uselistModules, i) ;
+      IF module # NulSym
+      THEN
+         GetModuleCtors (module, ctor, init, fini, dep) ;
+         IF fini # NulSym
+         THEN
+            PushTtok (fini, tok) ;
+            PushTtok (argc, tok) ;
+            PushTtok (argv, tok) ;
+            PushTtok (envp, tok) ;
+            PushT (3) ;
+            BuildProcedureCall (tok)
+         END
+      END ;
+      DEC (i)
+   END
+END ForeachModuleCallFinish ;
+
+
+(*
+   PopulateCtorArray - assign each element of the ctorArray to the external module ctor.
+                       This is only used to force the linker to pull in the ctors from
+                       a library.
+*)
+
+PROCEDURE PopulateCtorArray (tok: CARDINAL) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   n := NoOfItemsInList (ctorModules) ;
+   i := 1 ;
+   WHILE i <= n DO
+      PushTFtok (ctorArray, ctorArrayType, tok) ;
+      PushTtok (MakeConstant (tok, i), tok) ;
+      BuildDesignatorArray ;
+      PushTtok (GetItemFromList (ctorModules, i), tok) ;
+      BuildAssignment (tok) ;
+      INC (i)
+   END
+END PopulateCtorArray ;
+
+
+(*
+   LookupModuleSym - returns a defimp module.  It looks up an existing
+                     module and if this does not exist creates a new one.
+*)
+
+PROCEDURE LookupModuleSym (tok: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   sym := Get (name) ;
+   IF sym = NulSym
+   THEN
+      sym := MakeDefImp (tok, name)
+   END ;
+   IF sym # GetMainModule ()
+   THEN
+      PutModuleCtorExtern (tok, sym, NOT WholeProgram)
+   END ;
+   RETURN sym
+END LookupModuleSym ;
+
+
+(*
+   addDependentStatement -
+*)
+
+PROCEDURE addDependentStatement (graph: Graph; moduleSym: CARDINAL; list: List) ;
+VAR
+   n1, n2: Name ;
+   import,
+   depmod,
+   i, n  : CARDINAL ;
+BEGIN
+   n := NoOfItemsInList (list) ;
+   i := 1 ;
+   WHILE i <= n DO
+      import := GetItemFromList (list, i) ;
+      Assert (IsImport (import)) ;
+      depmod := GetImportModule (import) ;
+      AddDependent (graph, moduleSym, depmod) ;
+      IF Debugging
+      THEN
+         n1 := GetSymName (moduleSym) ;
+         n2 := GetSymName (depmod) ;
+         printf2 ("AddDependent (%a, %a)\n",
+                  n1, n2)
+      END ;
+      INC (i)
+   END
+END addDependentStatement ;
+
+
+(*
+   addDependentImport - adds dependent imports of moduleSym into the graph.
+*)
+
+PROCEDURE addDependentImport (graph: Graph; moduleSym: CARDINAL; importList: List) ;
+VAR
+   stmt,
+   i, n: CARDINAL ;
+BEGIN
+   n := NoOfItemsInList (importList) ;
+   i := 1 ;
+   WHILE i <= n DO
+      stmt := GetItemFromList (importList, i) ;
+      Assert (IsImportStatement (stmt)) ;
+      addDependentStatement (graph, moduleSym, GetImportStatementList (stmt)) ;
+      INC (i)
+   END
+END addDependentImport ;
+
+
+(*
+   TopologicallySortList - topologically sort the list based on import graph.
+                           A new list is returned.
+*)
+
+PROCEDURE TopologicallySortList (list: List; topModule: CARDINAL) : List ;
+VAR
+   graph    : Graph ;
+   i, n     : CARDINAL ;
+   moduleSym: CARDINAL ;
+BEGIN
+   graph := InitGraph () ;
+   n := NoOfItemsInList (list) ;
+   i := 1 ;
+   WHILE i <= n DO
+      moduleSym := GetItemFromList (uselistModules, i) ;
+      addDependentImport (graph, moduleSym, GetModuleDefImportStatementList (moduleSym)) ;
+      addDependentImport (graph, moduleSym, GetModuleModImportStatementList (moduleSym)) ;
+      INC (i) ;
+   END ;
+   (* Ensure that topModule is also in the graph.  *)
+   IF NOT IsItemInList (list, topModule)
+   THEN
+      addDependentImport (graph, topModule, GetModuleDefImportStatementList (topModule)) ;
+      addDependentImport (graph, topModule, GetModuleModImportStatementList (topModule))
+   END ;
+   RETURN SortGraph (graph, topModule)
+END TopologicallySortList ;
+
+
+(*
+   AddEntry - adds an entry to the ctorGlobals and uselistModules.
+*)
+
+PROCEDURE AddEntry (tok: CARDINAL; name: Name) ;
+BEGIN
+   IF ctorGlobals # NIL
+   THEN
+      IncludeItemIntoList (ctorGlobals, name)
+   END ;
+   IncludeItemIntoList (uselistModules, LookupModuleSym (tok, name))
+END AddEntry ;
+
+
+(*
+   ReadModules - populate ctorGlobals with the modules specified by -fuse-list=filename.
+*)
+
+PROCEDURE ReadModules (tok: CARDINAL; filename: String) ;
+VAR
+   f: File ;
+   s: String ;
+BEGIN
+   InitList (ctorGlobals) ;
+   InitList (uselistModules) ;
+   f := OpenToRead (filename) ;
+   WHILE NOT EOF (f) DO
+      s := ReadS (f) ;
+      s := RemoveComment (RemoveWhitePrefix (s), Comment) ;
+      IF (NOT Equal (Mark (InitStringChar (Comment)),
+                     Mark (Slice (s, 0, Length (Mark (InitStringChar (Comment)))-1)))) AND
+         (NOT EqualArray (s, ''))
+      THEN
+         AddEntry (tok, makekey (string (s)))
+      END ;
+      s := KillString (s)
+   END ;
+   Close (f)
+END ReadModules ;
+
+
+VAR
+   ctorTok: CARDINAL ;
+
+
+(*
+   AddModuleToCtor - adds moduleSym to the uselistModules and
+                     sets all modules ctors as extern.
+*)
+
+PROCEDURE AddModuleToCtor (moduleSym: CARDINAL) ;
+BEGIN
+   IF IsModule (moduleSym) OR (NOT IsDefinitionForC (moduleSym))
+   THEN
+      IF (moduleSym # GetMainModule ()) AND (NOT IsModuleBuiltin (moduleSym))
+      THEN
+         PutModuleCtorExtern (ctorTok, moduleSym, NOT WholeProgram) ;
+         IncludeItemIntoList (uselistModules, moduleSym)
+      END
+   END
+END AddModuleToCtor ;
+
+
+(*
+   WriteList - writes the list to GetGenModuleFilename
+               providing the filename is not NIL and not '-'.
+*)
+
+PROCEDURE WriteList (tok: CARDINAL; list: List) ;
+VAR
+   fo       : File ;
+   name     : Name ;
+   moduleSym: CARDINAL ;
+   i, n     : CARDINAL ;
+   s        : String ;
+BEGIN
+   IF (GetGenModuleFilename () # NIL) AND (NOT EqualArray (GetGenModuleFilename (), '-'))
+   THEN
+      fo := OpenToWrite (GetGenModuleFilename ()) ;
+      IF IsNoError (fo)
+      THEN
+         i := 1 ;
+         n := NoOfItemsInList (list) ;
+         WHILE i <= n DO
+            moduleSym := GetItemFromList (list, i) ;
+            name := GetSymName (moduleSym) ;
+            s := InitStringCharStar (KeyToCharStar (name)) ;
+            s := ConCat (s, Mark (InitString ('\n'))) ;
+            s := HandleEscape (s) ;
+            s := WriteS (fo, s) ;
+            s := KillString (s) ;
+            INC (i)
+         END ;
+         Close (fo)
+      ELSE
+         s := InitString ("unable to create file containing ctor module list: ") ;
+         s := ConCat (s, GetGenModuleFilename ()) ;
+         MetaErrorStringT0 (tok, s)
+      END
+   END
+END WriteList ;
+
+
+(*
+   CreateCtorListFromImports - if GenModuleList then populate
+                               the ctor list from all modules which are
+                               not FOR 'C'.
+*)
+
+PROCEDURE CreateCtorListFromImports (tok: CARDINAL) : BOOLEAN ;
+VAR
+   newlist: List ;
+   i, n   : CARDINAL ;
+BEGIN
+   IF GenModuleList
+   THEN
+      InitList (uselistModules) ;
+      ctorTok := tok ;
+      ForeachModuleDo (AddModuleToCtor) ;
+      newlist := TopologicallySortList (uselistModules, GetMainModule ()) ;
+      KillList (uselistModules) ;
+      uselistModules := newlist ;
+      (* Now create the ctorGlobals using uselistModules and retain the same order.  *)
+      InitList (ctorGlobals) ;
+      i := 1 ;
+      n := NoOfItemsInList (uselistModules) ;
+      WHILE i <= n DO
+         IncludeItemIntoList (ctorGlobals, GetSymName (GetItemFromList (uselistModules, i))) ;
+         INC (i)
+      END ;
+      WriteList (tok, uselistModules) ;
+      RETURN TRUE
+   END ;
+   RETURN FALSE
+END CreateCtorListFromImports ;
+
+
+(*
+   CreateCtorList - uses GetUselistFilename and then reads the list of modules.
+*)
+
+PROCEDURE CreateCtorList (tok: CARDINAL) : BOOLEAN ;
+VAR
+   filename: String ;
+BEGIN
+   IF GetUselist ()
+   THEN
+      filename := GetUselistFilename () ;
+      IF filename # NIL
+      THEN
+         IF Exists (filename)
+         THEN
+            ReadModules (tok, filename) ;
+            RETURN TRUE
+         ELSE
+            IF NOT EqualArray (filename, '-')
+            THEN
+               MetaErrorT0 (tok,
+                            '{%E}the filename specified by the -fuse-list= option does not exist') ;
+            END
+         END
+      END ;
+      RETURN FALSE
+   ELSE
+      RETURN CreateCtorListFromImports (tok)
+   END
+END CreateCtorList ;
+
+
+(*
+   DeclareModuleExtern - declare the extern _M2_modulename_ctor, _M2_modulename_init,
+                         _M2_modulename_fini, _M2_modulename_dep for each external module.
+*)
+
+PROCEDURE DeclareModuleExtern (tokenno: CARDINAL) ;
+VAR
+   n1    : Name ;
+   init,
+   fini,
+   dep,
+   ctor,
+   module: CARDINAL ;
+   n, i  : CARDINAL ;
+BEGIN
+   InitList (ctorModules) ;
+   i := 1 ;
+   n := NoOfItemsInList (uselistModules) ;
+   WHILE i <= n DO
+      module := GetItemFromList (uselistModules, i) ;
+      IF module # GetMainModule ()
+      THEN
+         PutModuleCtorExtern (tokenno, module, NOT WholeProgram)
+      END ;
+      GetModuleCtors (module, ctor, init, fini, dep) ;
+      IncludeItemIntoList (ctorModules, ctor) ;
+      IF Debugging
+      THEN
+         n1 := GetSymName (module) ;
+         printf1 ("%a_ctor added to ctorModules\n", n1)
+      END ;
+      INC (i)
+   END
+END DeclareModuleExtern ;
+
+
+(*
+   DeclareScaffoldFunctions - declare main, _M2_init,_M2_finish
+                              and _M2_link to the modula-2
+                              front end.
+*)
+
+PROCEDURE DeclareScaffoldFunctions (tokenno: CARDINAL) ;
+BEGIN
+   IF CreateCtorList (tokenno)
+   THEN
+      DeclareCtorGlobal (tokenno) ;
+      DeclareModuleExtern (tokenno) ;
+      linkFunction := MakeProcedure (tokenno, MakeKey ("_M2_link")) ;
+      PutMonoName (linkFunction, TRUE)
+   ELSIF ScaffoldDynamic AND (NOT cflag)
+   THEN
+      MetaErrorT0 (tokenno,
+                   '{%O}dynamic linking enabled but no module ctor list has been created, hint use -fuse-list=filename or -fgen-module-list=-')
+   END ;
+
+   initFunction := MakeProcedure (tokenno, MakeKey ("_M2_init")) ;
+   PutMonoName (initFunction, TRUE) ;
+   finiFunction := MakeProcedure (tokenno, MakeKey ("_M2_fini")) ;
+   PutMonoName (finiFunction, TRUE) ;
+   IF SharedFlag
+   THEN
+      PutCtor (initFunction, TRUE) ;
+      PutCtor (finiFunction, TRUE)
+   ELSE
+      DeclareArgEnvParams (tokenno, initFunction) ;
+      DeclareArgEnvParams (tokenno, finiFunction) ;
+
+      mainFunction := MakeProcedure (tokenno, MakeKey ("main")) ;
+      PutMonoName (mainFunction, TRUE) ;
+      StartScope (mainFunction) ;
+      PutFunction (mainFunction, Integer) ;
+      DeclareArgEnvParams (tokenno, mainFunction) ;
+      PutPublic (mainFunction, TRUE) ;
+      EndScope
+   END
+END DeclareScaffoldFunctions ;
+
+
+(*
+   DeclareArgEnvParams - declares (int argc, void *argv, void *envp)
+*)
+
+PROCEDURE DeclareArgEnvParams (tokno: CARDINAL; proc: CARDINAL) ;
+BEGIN
+   Assert (IsProcedure (proc)) ;
+   StartScope (proc) ;
+   Assert (PutParam (tokno, proc, 1, MakeKey ("argc"), Integer, FALSE)) ;
+   Assert (PutParam (tokno, proc, 2, MakeKey ("argv"), Address, FALSE)) ;
+   Assert (PutParam (tokno, proc, 3, MakeKey ("envp"), Address, FALSE)) ;
+   EndScope
+END DeclareArgEnvParams ;
+
+
+(*
+   DeclareScaffold - declare scaffold related entities.
+*)
+
+PROCEDURE DeclareScaffold (tokno: CARDINAL) ;
+BEGIN
+   IF NOT initialized
+   THEN
+      initialized := TRUE ;
+      DeclareScaffoldFunctions (tokno)
+   END
+END DeclareScaffold ;
+
+
+BEGIN
+   initialized := FALSE ;
+   finiFunction := NulSym ;
+   initFunction := NulSym ;
+   mainFunction := NulSym ;
+   linkFunction := NulSym ;
+   ctorArray := NulSym ;
+   ctorGlobals := NIL ;
+   ctorModules := NIL ;
+   uselistModules := NIL
+END M2Scaffold.
diff --git a/gcc/m2/gm2-compiler/M2Scope.def b/gcc/m2/gm2-compiler/M2Scope.def
new file mode 100644
index 00000000000..66212a3870c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Scope.def
@@ -0,0 +1,65 @@
+(* M2Scope.def derive the subset of quadruples for each scope.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+DEFINITION MODULE M2Scope ;
+
+(*
+    Title      : M2Scope
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Wed Aug 13 16:04:38 2003
+    Revision   : $Version$
+    Description: provides a set of methods to derive the subset of quadruples
+                 which were generated within a scope.
+*)
+
+EXPORT QUALIFIED ScopeBlock, ScopeProcedure,
+                 InitScopeBlock, KillScopeBlock,
+                 ForeachScopeBlockDo ;
+
+TYPE
+   ScopeBlock ;
+   ScopeProcedure = PROCEDURE (CARDINAL, CARDINAL) ;
+
+
+(*
+   InitScopeBlock - creates a scope block containing all quadruples for the outer, scope.
+*)
+
+PROCEDURE InitScopeBlock (scope: CARDINAL) : ScopeBlock ;
+
+
+(*
+   KillScopeBlock - destroys the ScopeBlock sb and assign sb to NIL.
+*)
+
+PROCEDURE KillScopeBlock (VAR sb: ScopeBlock) ;
+
+
+(*
+   ForeachScopeBlockDo - calls a procedure, p, for each block of contigeous quadruples
+                         defining an outer scope, sb.
+*)
+
+PROCEDURE ForeachScopeBlockDo (sb: ScopeBlock; p: ScopeProcedure) ;
+
+
+END M2Scope.
diff --git a/gcc/m2/gm2-compiler/M2Scope.mod b/gcc/m2/gm2-compiler/M2Scope.mod
new file mode 100644
index 00000000000..ee878971252
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Scope.mod
@@ -0,0 +1,496 @@
+(* M2Scope.mod derive the subset of quadruples for each scope.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Scope ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2Debug IMPORT Assert ;
+FROM NameKey IMPORT Name ;
+
+FROM SymbolTable IMPORT IsProcedure, IsDefImp, GetProcedureQuads, GetScope,
+                        GetProcedureScope, IsModule, IsModuleWithinProcedure,
+                        GetSymName, GetErrorScope, NulSym ;
+
+FROM M2Options IMPORT DisplayQuadruples ;
+FROM M2Printf IMPORT printf0, printf1 ;
+FROM M2Quads IMPORT QuadOperator, GetFirstQuad, GetNextQuad, GetQuad, DisplayQuadRange ;
+FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord,
+                        PopWord, PushWord, PeepWord ;
+IMPORT M2Error ;
+
+
+CONST
+   Debugging = FALSE ;
+
+TYPE
+   scopeKind = (unsetscope, ignorescope, procedurescope, modulescope, definitionscope, implementationscope, programscope) ;
+
+   ScopeBlock = POINTER TO RECORD
+                   scopeSym : CARDINAL ;
+                   kindScope: scopeKind ;
+                   low, high: CARDINAL ;
+                   next     : ScopeBlock ;
+                END ;
+
+VAR
+   FreeList: ScopeBlock ;
+
+
+(*
+   New -
+*)
+
+PROCEDURE New (VAR sb: ScopeBlock) ;
+BEGIN
+   IF FreeList = NIL
+   THEN
+      NEW (sb)
+   ELSE
+      sb := FreeList ;
+      FreeList := FreeList^.next
+   END
+END New ;
+
+
+(*
+   Dispose -
+*)
+
+PROCEDURE Dispose (VAR sb: ScopeBlock) ;
+BEGIN
+   sb^.next := FreeList ;
+   FreeList := sb ;
+   sb := NIL
+END Dispose ;
+
+
+(*
+   SetScope - assigns the scopeSym and kindScope.
+*)
+
+PROCEDURE SetScope (sb: ScopeBlock; sym: CARDINAL; kindScope: scopeKind) ;
+BEGIN
+   sb^.scopeSym := sym ;
+   sb^.kindScope := kindScope
+END SetScope ;
+
+
+(*
+   AddToRange - returns a ScopeBlock pointer to the last block. The,
+                quad, will be added to the end of sb or a later block
+                if First is TRUE.
+*)
+
+PROCEDURE AddToRange (sb: ScopeBlock;
+                      First: BOOLEAN; quad: CARDINAL) : ScopeBlock ;
+BEGIN
+   IF First
+   THEN
+      IF sb^.high=0
+      THEN
+         sb^.high := sb^.low
+      END ;
+      sb^.next := InitScopeBlock (NulSym) ;
+      sb := sb^.next
+   END ;
+   IF sb^.low=0
+   THEN
+      sb^.low := quad
+   END ;
+   sb^.high := quad ;
+   RETURN sb
+END AddToRange ;
+
+
+(*
+   GetGlobalQuads -
+*)
+
+PROCEDURE GetGlobalQuads (sb: ScopeBlock; scope: CARDINAL) : ScopeBlock ;
+VAR
+   prev,
+   nb           : ScopeBlock ;
+   NestedLevel,
+   i            : CARDINAL ;
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+   First        : BOOLEAN ;
+   start, end   : CARDINAL ;
+BEGIN
+   NestedLevel := 0 ;
+   prev := NIL ;
+   First := FALSE ;
+   IF (GetScope(scope)#NulSym) AND
+      (IsProcedure(GetScope(scope)) OR
+       (IsModule(scope) AND IsModuleWithinProcedure(scope)))
+   THEN
+      GetProcedureQuads (GetProcedureScope (scope), i, start, end) ;
+      GetQuad (i, op, op1, op2, op3) ;
+      WHILE (op#ModuleScopeOp) OR (op3#scope) DO
+         i := GetNextQuad (i) ;
+         GetQuad (i, op, op1, op2, op3)
+      END ;
+      end := i ;
+      GetQuad (end, op, op1, op2, op3) ;
+      WHILE (op#FinallyEndOp) OR (op3#scope) DO
+         end := GetNextQuad (end) ;
+         GetQuad (end, op, op1, op2, op3)
+      END
+   ELSE
+      i := GetFirstQuad () ;
+      end := 0
+   END ;
+   nb := sb ;
+   sb^.low := 0 ;
+   sb^.high := 0 ;
+   LOOP
+      IF i=0
+      THEN
+         IF Debugging
+         THEN
+            DisplayScope (sb)
+         END ;
+         RETURN sb
+      END ;
+      GetQuad (i, op, op1, op2, op3) ;
+      IF op=ProcedureScopeOp
+      THEN
+         INC (NestedLevel)
+      ELSIF op=ReturnOp
+      THEN
+         IF NestedLevel>0
+         THEN
+            DEC (NestedLevel)
+         END ;
+         IF NestedLevel=0
+         THEN
+            First := TRUE
+         END
+      ELSIF NestedLevel=0
+      THEN
+         IF op=StartDefFileOp
+         THEN
+            nb := AddToRange (nb, TRUE, i) ;
+            SetScope (nb, op3, definitionscope) ;
+            prev := nb
+         ELSIF (op=StartModFileOp) OR (op=InitStartOp)
+         THEN
+            nb := AddToRange (nb, TRUE, i) ;
+            IF IsDefImp (op3)
+            THEN
+               SetScope (nb, op3, implementationscope)
+            ELSE
+               SetScope (nb, op3, programscope)
+            END ;
+            prev := nb
+         ELSE
+            nb := AddToRange (nb, First, i) ;
+            IF op = InitEndOp
+            THEN
+               IF IsDefImp (op3)
+               THEN
+                  SetScope (nb, op3, implementationscope)
+               ELSE
+                  SetScope (nb, op3, programscope)
+               END ;
+               prev := nb
+            ELSIF First
+            THEN
+               Assert (prev # NIL) ;
+               SetScope (nb, prev^.scopeSym, prev^.kindScope)
+            END
+         END ;
+         First := FALSE
+      END ;
+      IF i=end
+      THEN
+         IF Debugging
+         THEN
+            DisplayScope (sb)
+         END ;
+         RETURN sb
+      END ;
+      i := GetNextQuad (i)
+   END
+END GetGlobalQuads ;
+
+
+(*
+   GetProcQuads -
+*)
+
+PROCEDURE GetProcQuads (sb: ScopeBlock;
+                        proc: CARDINAL) : ScopeBlock ;
+VAR
+   nb           : ScopeBlock ;
+   scope, start,
+   end, i, last : CARDINAL ;
+   op           : QuadOperator ;
+   op1, op2, op3: CARDINAL ;
+   First        : BOOLEAN ;
+   s            : StackOfWord ;
+   n            : Name ;
+BEGIN
+   s := InitStackWord () ;
+   IF Debugging
+   THEN
+      n := GetSymName (proc) ;
+      printf1("GetProcQuads for %a\n", n)
+   END ;
+   Assert(IsProcedure(proc)) ;
+   GetProcedureQuads(proc, scope, start, end) ;
+   IF Debugging
+   THEN
+      printf1(" proc %d\n", proc) ;
+      printf1(" scope %d\n", scope) ;
+      printf1(" start %d\n", start) ;
+      printf1(" end %d\n", end)
+   END ;
+   PushWord(s, 0) ;
+   First := FALSE ;
+   i := scope ;
+   last := scope ;
+   nb := sb ;
+   sb^.low := scope ;
+   sb^.high := 0 ;
+   SetScope (sb, proc, procedurescope) ;
+   WHILE (i<=end) AND (start#0) DO
+      GetQuad (i, op, op1, op2, op3) ;
+      IF (op=ProcedureScopeOp) OR (op=ModuleScopeOp)
+      THEN
+         IF (PeepWord(s, 1)=proc) AND (op3=proc)
+         THEN
+            nb := AddToRange (nb, First, last) ;
+            First := FALSE
+         END ;
+         PushWord (s,  op3) ;
+         IF op=ProcedureScopeOp
+         THEN
+            SetScope (nb, proc, procedurescope)
+         ELSE
+            SetScope (nb, proc, modulescope)
+         END
+      ELSIF (op=ReturnOp) OR (op=FinallyEndOp)
+      THEN
+         op3 := PopWord (s) ;
+         IF PeepWord (s, 1) = proc
+         THEN
+            First := TRUE
+         END
+      ELSE
+         IF PeepWord (s, 1) = proc
+         THEN
+            nb := AddToRange (nb, First, i) ;
+            First := FALSE
+         END
+      END ;
+      last := i ;
+      i := GetNextQuad (i)
+   END ;
+   IF start<=nb^.high
+   THEN
+      nb^.high := end
+   ELSE
+      nb^.next := InitScopeBlock (NulSym) ;
+      nb := nb^.next ;
+      SetScope (nb, proc, unsetscope) ;
+      WITH nb^ DO
+         low := start ;
+         high := end
+      END
+   END ;
+   s := KillStackWord (s) ;
+   RETURN sb
+END GetProcQuads ;
+
+
+(*
+   DisplayScope -
+*)
+
+PROCEDURE DisplayScope (sb: ScopeBlock) ;
+VAR
+   name: Name ;
+BEGIN
+   WITH sb^ DO
+      printf0 ("scope: ") ;
+      CASE sb^.kindScope OF
+
+      unsetscope    :  printf0 ("unset") |
+      ignorescope   :  printf0 ("ignore") |
+      procedurescope     :  name := GetSymName (scopeSym) ;
+                       printf1 ("procedure %a", name) |
+      modulescope        :  name := GetSymName (scopeSym) ;
+                       printf1 ("inner module %a", name) |
+      definitionscope    :  name := GetSymName (scopeSym) ;
+                       printf1 ("definition module %a", name) |
+      implementationscope:  name := GetSymName (scopeSym) ;
+                       printf1 ("implementation module %a", name) |
+      programscope       :  name := GetSymName (scopeSym) ;
+                       printf1 ("program module %a", name)
+
+      END ;
+      printf0 ("\n") ;
+      DisplayQuadRange (low, high) ;
+      IF next#NIL
+      THEN
+         DisplayScope (next)
+      END
+   END
+END DisplayScope ;
+
+
+(*
+   InitScopeBlock -
+*)
+
+PROCEDURE InitScopeBlock (scope: CARDINAL) : ScopeBlock ;
+VAR
+   sb: ScopeBlock ;
+BEGIN
+   New (sb) ;
+   WITH sb^ DO
+      next := NIL ;
+      kindScope := unsetscope ;
+      IF scope=NulSym
+      THEN
+         low := 0 ;
+         high := 0
+      ELSE
+         IF IsProcedure (scope)
+         THEN
+            sb := GetProcQuads (sb, scope)
+         ELSE
+            sb := GetGlobalQuads (sb, scope) ;
+         END ;
+         IF DisplayQuadruples
+         THEN
+            DisplayScope (sb)
+         END
+      END
+   END ;
+   RETURN sb
+END InitScopeBlock ;
+
+
+(*
+   KillScopeBlock - destroys the ScopeBlock sb and assign sb to NIL.
+*)
+
+PROCEDURE KillScopeBlock (VAR sb: ScopeBlock) ;
+VAR
+   t: ScopeBlock ;
+BEGIN
+   t := sb ;
+   WHILE t # NIL DO
+      sb := t ;
+      t := t^.next ;
+      Dispose (sb) ;
+   END ;
+   sb := NIL
+END KillScopeBlock ;
+
+
+(*
+   ForeachScopeBlockDo -
+*)
+
+PROCEDURE ForeachScopeBlockDo (sb: ScopeBlock; p: ScopeProcedure) ;
+BEGIN
+   IF DisplayQuadruples
+   THEN
+      printf0 ("ForeachScopeBlockDo\n")
+   END ;
+   WHILE sb#NIL DO
+      WITH sb^ DO
+         IF DisplayQuadruples
+         THEN
+            DisplayScope (sb)
+         END ;
+         enter (sb) ;
+         IF (low # 0) AND (high # 0)
+         THEN
+            p (low, high)
+         END ;
+         leave (sb)
+      END ;
+      sb := sb^.next
+   END ;
+   IF DisplayQuadruples
+   THEN
+      printf0 ("end ForeachScopeBlockDo\n\n")
+   END ;
+END ForeachScopeBlockDo ;
+
+
+(*
+   enter -
+*)
+
+PROCEDURE enter (sb: ScopeBlock) ;
+BEGIN
+   WITH sb^ DO
+      CASE kindScope OF
+
+      unsetscope,
+      ignorescope        : |
+      procedurescope     ,
+      modulescope        ,
+      definitionscope    ,
+      implementationscope,
+      programscope       : M2Error.EnterErrorScope (GetErrorScope (scopeSym))
+
+      END
+   END
+END enter ;
+
+
+(*
+   leave -
+*)
+
+PROCEDURE leave (sb: ScopeBlock) ;
+BEGIN
+   CASE sb^.kindScope OF
+
+   unsetscope,
+   ignorescope   : |
+
+   ELSE
+      M2Error.LeaveErrorScope
+   END
+END leave ;
+
+
+
+(*
+   Init - initializes the global variables for this module.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   FreeList := NIL
+END Init ;
+
+
+BEGIN
+   Init
+END M2Scope.
diff --git a/gcc/m2/gm2-compiler/M2Search.def b/gcc/m2/gm2-compiler/M2Search.def
new file mode 100644
index 00000000000..0baed2dd75c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Search.def
@@ -0,0 +1,115 @@
+(* M2Search.def provides a mechanism to search selected directories.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Search ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : M2Search
+   Date       : Tue Jan 30 11:59:41 GMT 1990
+   Last update: Tue Aug  7 19:45:46 BST 2001
+   Description: M2Search provides a mechanism to search selected directories
+                in an attempt to locate a given source file.
+*)
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED InitSearchPath, PrependSearchPath, FindSourceFile,
+                 FindSourceDefFile, FindSourceModFile,
+                 SetDefExtension, SetModExtension ;
+
+
+(*
+   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
+*)
+
+PROCEDURE InitSearchPath (Path: String) ;
+
+
+(*
+   PrependSearchPath - prepends a new path to the initial search path.
+*)
+
+PROCEDURE PrependSearchPath (path: String) ;
+
+
+(*
+   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.
+                    FindSourceFile sets FullPath to a new string if successful.
+*)
+
+PROCEDURE FindSourceFile (FileName: String;
+                          VAR FullPath: String) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindSourceModFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+
+
+(*
+   SetDefExtension - sets the default extension for definition modules to, ext.
+                     The string, ext, should be deallocated by the caller at
+                     an appropriate time.
+*)
+
+PROCEDURE SetDefExtension (ext: String) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE SetModExtension (ext: String) ;
+
+
+END M2Search.
diff --git a/gcc/m2/gm2-compiler/M2Search.mod b/gcc/m2/gm2-compiler/M2Search.mod
new file mode 100644
index 00000000000..3a1ae881ca2
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Search.mod
@@ -0,0 +1,313 @@
+(* M2Search.mod provides a mechanism to search selected directories.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Search ;
+
+
+FROM SFIO IMPORT Exists ;
+FROM M2FileName IMPORT CalculateFileName ;
+FROM Assertion IMPORT Assert ;
+
+FROM DynamicStrings IMPORT InitString, InitStringChar,
+                           KillString, ConCat, ConCatChar, Index, Slice,
+                           Add, EqualArray, Dup, Mark,
+                           PushAllocation, PopAllocationExemption,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+
+CONST
+   Directory        =   '/' ;
+   GarbageDebugging = FALSE ;
+
+VAR
+   Def, Mod,
+   UserPath,
+   InitialPath: String ;
+
+(* Internal garbage collection debugging routines.  *)
+
+(*
+#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__)
+*)
+
+
+(*
+   doDSdbEnter - called when compiled with -fcpp to enable runtime garbage
+                 collection debugging.
+
+PROCEDURE doDSdbEnter ;
+BEGIN
+   PushAllocation
+END doDSdbEnter ;
+*)
+
+
+(*
+   doDSdbExit - called when compiled with -fcpp to enable runtime garbage
+                collection debugging.  The parameter string s is exempt from
+                garbage collection analysis.
+
+PROCEDURE doDSdbExit (s: String) ;
+BEGIN
+   (* Check to see whether no strings have been lost since the PushAllocation.  *)
+   Assert (PopAllocationExemption (TRUE, s) = s)
+END doDSdbExit ;
+*)
+
+
+(*
+   DSdbEnter - dummy nop entry code which the preprocessor replaces by
+               doDSsbEnter when debugging garbage collection at runtime.
+*)
+
+PROCEDURE DSdbEnter ;
+BEGIN
+END DSdbEnter ;
+
+
+(*
+   DSdbExit - dummy nop exit code which the preprocessor replaces by
+              doDSsbExit when debugging garbage collection at runtime.
+*)
+
+PROCEDURE DSdbExit (s: String) ;
+BEGIN
+   IF GarbageDebugging
+   THEN
+      Assert (s # NIL)
+   END
+END DSdbExit ;
+
+
+(*
+#define DSdbEnter doDSdbEnter
+#define DSdbExit  doDSdbExit
+*)
+
+
+(*
+   PrependSearchPath - prepends a new path to the initial search path.
+*)
+
+PROCEDURE PrependSearchPath (path: String) ;
+BEGIN
+   DSdbEnter ;
+   IF EqualArray(UserPath, '')
+   THEN
+      UserPath := KillString(UserPath) ;
+      UserPath := Dup(path)
+   ELSE
+      UserPath := ConCat(ConCatChar(UserPath, ':'), path)
+   END ;
+   DSdbExit (UserPath)
+END PrependSearchPath ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindSourceFile (FileName: String;
+                          VAR FullPath: String) : BOOLEAN ;
+VAR
+   CompleteSearchPath: String ;
+   start, end        : INTEGER ;
+   newpath           : String ;
+BEGIN
+   IF EqualArray(UserPath, '')
+   THEN
+      IF EqualArray(InitialPath, '')
+      THEN
+         CompleteSearchPath := InitString('.')
+      ELSE
+         CompleteSearchPath := Dup(InitialPath)
+      END
+   ELSE
+      CompleteSearchPath := ConCat(ConCatChar(Dup(UserPath), ':'), InitialPath)
+   END ;
+   start := 0 ;
+   end   := Index(CompleteSearchPath, ':', CARDINAL(start)) ;
+   REPEAT
+      IF end=-1
+      THEN
+         end := 0
+      END ;
+      newpath := Slice(CompleteSearchPath, start, end) ;
+      IF EqualArray(newpath, '.')
+      THEN
+         newpath := KillString(newpath) ;
+         newpath := Dup(FileName)
+      ELSE
+         newpath := ConCat(ConCatChar(newpath, Directory), FileName)
+      END ;
+      IF Exists(newpath)
+      THEN
+         FullPath := newpath ;
+         CompleteSearchPath := KillString(CompleteSearchPath) ;
+         RETURN( TRUE )
+      END ;
+      newpath := KillString(newpath) ;
+      IF end#0
+      THEN
+         start := end+1 ;
+         end   := Index(CompleteSearchPath, ':', CARDINAL(start))
+      END
+   UNTIL end=0 ;
+
+   FullPath := NIL ;
+   newpath := KillString(newpath) ;
+   CompleteSearchPath :=  KillString(CompleteSearchPath) ;
+   RETURN( FALSE )
+END FindSourceFile ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+VAR
+   f: String ;
+BEGIN
+   IF Def#NIL
+   THEN
+      f := CalculateFileName(Stem, Def) ;
+      IF FindSourceFile(f, FullPath)
+      THEN
+         RETURN( TRUE )
+      END ;
+      f := KillString(f)
+   END ;
+   (* and try the GNU Modula-2 default extension *)
+   f := CalculateFileName(Stem, Mark(InitString('def'))) ;
+   RETURN( FindSourceFile(f, FullPath) )
+END FindSourceDefFile ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindSourceModFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+VAR
+   f: String ;
+BEGIN
+   IF Mod#NIL
+   THEN
+      f := CalculateFileName(Stem, Mod) ;
+      IF FindSourceFile(f, FullPath)
+      THEN
+         RETURN( TRUE )
+      END ;
+      f := KillString(f)
+   END ;
+   (* and try the GNU Modula-2 default extension *)
+   f := CalculateFileName(Stem, Mark(InitString('mod'))) ;
+   RETURN( FindSourceFile(f, FullPath) )
+END FindSourceModFile ;
+
+
+(*
+   SetDefExtension - sets the default extension for definition modules to, ext.
+                     The string, ext, should be deallocated by the caller at
+                     an appropriate time.
+*)
+
+PROCEDURE SetDefExtension (ext: String) ;
+BEGIN
+   Def := KillString(Def) ;
+   Def := Dup(ext)
+END SetDefExtension ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE SetModExtension (ext: String) ;
+BEGIN
+   Mod := KillString(Mod) ;
+   Mod := Dup(ext)
+END SetModExtension ;
+
+
+(*
+   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
+*)
+
+PROCEDURE InitSearchPath (Path: String) ;
+BEGIN
+   IF InitialPath#NIL
+   THEN
+      InitialPath := KillString(InitialPath)
+   END ;
+   InitialPath := Path
+END InitSearchPath ;
+
+
+(*
+   Init - initializes the search path.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   UserPath    := InitString('') ;
+   InitialPath := InitStringChar('.') ;
+   Def := NIL ;
+   Mod := NIL
+END Init ;
+
+
+BEGIN
+   Init
+END M2Search.
diff --git a/gcc/m2/gm2-compiler/M2Size.def b/gcc/m2/gm2-compiler/M2Size.def
new file mode 100644
index 00000000000..74a1c8125fe
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Size.def
@@ -0,0 +1,46 @@
+(* M2Size.def exports the standard function SIZE.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+DEFINITION MODULE M2Size ;
+
+(*
+    Title      : M2Size
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu May  8 20:48:21 2003
+    Revision   : $Version$
+    Description: exports the standard function SIZE.
+*)
+
+EXPORT QUALIFIED Size, MakeSize ;
+
+VAR
+   Size: CARDINAL ;
+
+
+(*
+   MakeSize - creates and declares the standard function SIZE.
+*)
+
+PROCEDURE MakeSize ;
+
+
+END M2Size.
diff --git a/gcc/m2/gm2-compiler/M2Size.mod b/gcc/m2/gm2-compiler/M2Size.mod
new file mode 100644
index 00000000000..0e85c6ff3f1
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Size.mod
@@ -0,0 +1,52 @@
+(* M2Size.mod exports the standard function SIZE.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Size ;
+
+FROM NameKey IMPORT MakeKey ;
+FROM M2Base IMPORT ZType ;
+FROM M2LexBuf IMPORT BuiltinTokenNo ;
+
+FROM SymbolTable IMPORT NulSym, MakeProcedure, PutFunction,
+                        AddSymToModuleScope, GetCurrentScope ;
+
+
+(*
+   MakeSize - creates and declares the standard function SIZE.
+*)
+
+PROCEDURE MakeSize ;
+BEGIN
+   IF Size=NulSym
+   THEN
+                                                     (* Function        *)
+      Size := MakeProcedure (BuiltinTokenNo, MakeKey('SIZE')) ;
+      PutFunction(Size, ZType)                       (* Return Type     *)
+                                                     (* ZType           *)
+   ELSE
+      AddSymToModuleScope(GetCurrentScope(), Size)
+   END
+END MakeSize ;
+
+
+BEGIN
+   Size := NulSym
+END M2Size.
diff --git a/gcc/m2/gm2-compiler/M2StackAddress.def b/gcc/m2/gm2-compiler/M2StackAddress.def
new file mode 100644
index 00000000000..70cbbeae3d0
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2StackAddress.def
@@ -0,0 +1,99 @@
+(* M2StackAddress.def provides a generic stack for ADDRESS sized objects.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2StackAddress ;
+
+(*
+    Title      : M2StackAddress
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Oct 12 17:26:50 2001
+    Revision   : $Version$
+    Description: provides a generic stack for ADDRESS sized objects.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED StackOfAddress, InitStackAddress, KillStackAddress,
+                 PushAddress, PopAddress, PeepAddress,
+                 IsEmptyAddress, NoOfItemsInStackAddress ;
+
+TYPE
+   StackOfAddress ;
+
+
+(*
+   InitStackAddress - creates and returns a new stack.
+*)
+
+PROCEDURE InitStackAddress () : StackOfAddress ;
+
+
+(*
+   KillStackAddress - destroys a stack, returning NIL.
+*)
+
+PROCEDURE KillStackAddress (s: StackOfAddress) : StackOfAddress ;
+
+
+(*
+   PushAddress - pushes a word, w, onto, s.
+*)
+
+PROCEDURE PushAddress (s: StackOfAddress; w: ADDRESS) ;
+
+
+(*
+   PopAddress - pops an element from stack, s.
+*)
+
+PROCEDURE PopAddress (s: StackOfAddress) : ADDRESS ;
+
+
+(*
+   IsEmptyAddress - returns TRUE if stack, s, is empty.
+*)
+
+PROCEDURE IsEmptyAddress (s: StackOfAddress) : BOOLEAN ;
+
+
+(*
+   PeepAddress - returns the element at, n, items below in the stack.
+                 Top of stack can be seen via Peep(s, 1)
+*)
+
+PROCEDURE PeepAddress (s: StackOfAddress; n: CARDINAL) : ADDRESS ;
+
+
+(*
+   ReduceAddress - reduce the stack by n elements.
+*)
+
+PROCEDURE ReduceAddress (s: StackOfAddress; n: CARDINAL) ;
+
+
+(*
+   NoOfItemsInStack - returns the number of items held in the stack, s.
+*)
+
+PROCEDURE NoOfItemsInStackAddress (s: StackOfAddress) : CARDINAL ;
+
+
+END M2StackAddress.
diff --git a/gcc/m2/gm2-compiler/M2StackAddress.mod b/gcc/m2/gm2-compiler/M2StackAddress.mod
new file mode 100644
index 00000000000..ff6f67627c5
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2StackAddress.mod
@@ -0,0 +1,288 @@
+(* M2StackAddress.mod provides a generic stack for ADDRESS sized objects.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2StackAddress ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2Error IMPORT InternalError ;
+FROM M2Debug IMPORT Assert ;
+
+CONST
+   MaxBucket = 10 ;
+
+TYPE
+   StackBucket     = POINTER TO RECORD
+                                   bucket: ARRAY [0..MaxBucket-1] OF ADDRESS ;
+                                   items : CARDINAL ;
+                                   prev  : StackBucket ;
+                                END ;
+
+   StackOfAddress    = POINTER TO RECORD
+                                     tail: StackBucket ;
+                                  END ;
+
+
+(*
+   InitStackAddress - creates and returns a new stack.
+*)
+
+PROCEDURE InitStackAddress () : StackOfAddress ;
+VAR
+   s: StackOfAddress ;
+BEGIN
+   NEW (s) ;
+   WITH s^ DO
+      tail := NIL
+   END ;
+   RETURN s
+END InitStackAddress ;
+
+
+(*
+   KillBucket - destroys a StackBucket and returns, NIL.
+*)
+
+PROCEDURE KillBucket (b: StackBucket) : StackBucket ;
+BEGIN
+   IF b # NIL
+   THEN
+      b := KillBucket (b^.prev) ;
+      DISPOSE (b)
+   END ;
+   RETURN NIL
+END KillBucket ;
+
+
+(*
+   KillStackAddress - destroys a stack, returning NIL.
+*)
+
+PROCEDURE KillStackAddress (s: StackOfAddress) : StackOfAddress ;
+BEGIN
+   IF s#NIL
+   THEN
+      s^.tail := KillBucket (s^.tail) ;
+      DISPOSE (s)
+   END ;
+   RETURN NIL
+END KillStackAddress ;
+
+
+(*
+   InitBucket - returns an empty StackBucket.
+*)
+
+PROCEDURE InitBucket (l: StackBucket) : StackBucket ;
+VAR
+   b: StackBucket ;
+BEGIN
+   NEW(b) ;
+   WITH b^ DO
+      items := 0 ;
+      prev  := l
+   END ;
+   RETURN( b )
+END InitBucket ;
+
+
+(*
+   PushAddress - pushes a word, w, onto, s.
+*)
+
+PROCEDURE PushAddress (s: StackOfAddress; w: ADDRESS) ;
+BEGIN
+   IF s=NIL
+   THEN
+      InternalError ('stack has not been initialized')
+   ELSE
+      WITH s^ DO
+         IF (tail=NIL) OR (tail^.items=MaxBucket)
+         THEN
+            tail := InitBucket(tail)
+         END ;
+         WITH tail^ DO
+            IF items<MaxBucket
+            THEN
+               bucket[items] := w ;
+               INC(items)
+            END
+         END
+      END
+   END
+END PushAddress ;
+
+
+(*
+   PopAddress - pops an element from stack, s.
+*)
+
+PROCEDURE PopAddress (s: StackOfAddress) : ADDRESS ;
+VAR
+   b: StackBucket ;
+BEGIN
+   IF s=NIL
+   THEN
+      InternalError ('stack has not been initialized')
+   ELSE
+      IF s^.tail=NIL
+      THEN
+         InternalError ('stack underflow')
+      ELSE
+         IF s^.tail^.items=0
+         THEN
+            b := s^.tail ;
+            IF b=NIL
+            THEN
+               InternalError ('stack underflow')
+            ELSE
+               s^.tail := b^.prev
+            END ;
+            DISPOSE(b)
+         END ;
+         WITH s^.tail^ DO
+            DEC(items) ;
+            RETURN( bucket[items] )
+         END
+      END
+   END
+END PopAddress ;
+
+
+(*
+   IsEmptyAddress - returns TRUE if stack, s, is empty.
+*)
+
+PROCEDURE IsEmptyAddress (s: StackOfAddress) : BOOLEAN ;
+BEGIN
+   RETURN( (s=NIL) OR (s^.tail=NIL) )
+END IsEmptyAddress ;
+
+
+(*
+   PeepAddress - returns the element at, n, items below in the stack.
+                 Top of stack can be seen via Peep(s, 1)
+*)
+
+PROCEDURE PeepAddress (s: StackOfAddress; n: CARDINAL) : ADDRESS ;
+VAR
+   b: StackBucket ;
+BEGIN
+   IF s^.tail=NIL
+   THEN
+      InternalError ('stack underflow')
+   ELSE
+      IF s^.tail^.items=0
+      THEN
+         b := s^.tail ;
+         IF b=NIL
+         THEN
+            InternalError ('stack underflow')
+         ELSE
+            s^.tail := b^.prev
+         END ;
+         DISPOSE(b)
+      END ;
+      b := s^.tail ;
+      WHILE n>=1 DO
+         IF b=NIL
+         THEN
+            InternalError ('stack underflow')
+         ELSIF b^.items>=n
+         THEN
+            RETURN( b^.bucket[b^.items-n] )
+         ELSE
+            Assert(b^.items<n) ;
+            DEC(n, b^.items) ;
+            b := b^.prev
+         END
+      END ;
+      InternalError ('stack underflow')
+   END
+END PeepAddress ;
+
+
+(*
+   ReduceAddress - reduce the stack by n elements.
+*)
+
+PROCEDURE ReduceAddress (s: StackOfAddress; n: CARDINAL) ;
+VAR
+   b: StackBucket ;
+BEGIN
+   IF s^.tail=NIL
+   THEN
+      InternalError ('stack underflow')
+   ELSE
+      IF s^.tail^.items=0
+      THEN
+         b := s^.tail ;
+         IF b=NIL
+         THEN
+            InternalError ('stack underflow')
+         ELSE
+            s^.tail := b^.prev
+         END ;
+         DISPOSE(b)
+      END ;
+      LOOP
+         IF s^.tail=NIL
+         THEN
+            InternalError ('stack underflow')
+         ELSIF s^.tail^.items>=n
+         THEN
+            DEC( s^.tail^.items, n) ;
+            RETURN  (* all done exit *)
+         ELSE
+            b := s^.tail ;
+            DEC(n, b^.items) ;
+            s^.tail := s^.tail^.prev ;
+            DISPOSE(b)
+         END
+      END
+   END
+END ReduceAddress ;
+
+
+(*
+   NoOfItemsInStackAddress - returns the number of items held in the stack, s.
+*)
+
+PROCEDURE NoOfItemsInStackAddress (s: StackOfAddress) : CARDINAL ;
+VAR
+   b: StackBucket ;
+   n: CARDINAL ;
+BEGIN
+   IF IsEmptyAddress(s)
+   THEN
+      RETURN( 0 )
+   ELSE
+      n := 0 ;
+      b := s^.tail ;
+      WHILE b#NIL DO
+         INC (n, b^.items) ;
+         b := b^.prev
+      END ;
+      RETURN( n )
+   END
+END NoOfItemsInStackAddress ;
+
+
+END M2StackAddress.
diff --git a/gcc/m2/gm2-compiler/M2StackWord.def b/gcc/m2/gm2-compiler/M2StackWord.def
new file mode 100644
index 00000000000..0540f19d17e
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2StackWord.def
@@ -0,0 +1,106 @@
+(* M2StackWord.def provides a generic stack for WORD sized objects.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2StackWord ;
+
+(*
+    Title      : M2StackWord
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Oct 12 17:26:50 2001
+    Revision   : $Version$
+    Description: provides a generic stack for WORD sized objects.
+*)
+
+FROM SYSTEM IMPORT WORD ;
+EXPORT QUALIFIED StackOfWord, InitStackWord, KillStackWord, PushWord,
+                 ReduceWord, RemoveTop, PopWord, PeepWord, IsEmptyWord,
+                 NoOfItemsInStackWord ;
+
+TYPE
+   StackOfWord ;
+
+
+(*
+   InitStackWord - creates and returns a new stack.
+*)
+
+PROCEDURE InitStackWord () : StackOfWord ;
+
+
+(*
+   KillStackWord - destroys a stack, returning NIL.
+*)
+
+PROCEDURE KillStackWord (s: StackOfWord) : StackOfWord ;
+
+
+(*
+   PushWord - pushes a word, w, onto, s.
+*)
+
+PROCEDURE PushWord (s: StackOfWord; w: WORD) ;
+
+
+(*
+   PopWord - pops an element from stack, s.
+*)
+
+PROCEDURE PopWord (s: StackOfWord) : WORD ;
+
+
+(*
+   IsEmptyWord - returns TRUE if stack, s, is empty.
+*)
+
+PROCEDURE IsEmptyWord (s: StackOfWord) : BOOLEAN ;
+
+
+(*
+   PeepWord - returns the element at, n, items below in the stack.
+              Top of stack can be seen via Peep(s, 1)
+*)
+
+PROCEDURE PeepWord (s: StackOfWord; n: CARDINAL) : WORD ;
+
+
+(*
+   ReduceWord - reduce the stack by n elements.
+*)
+
+PROCEDURE ReduceWord (s: StackOfWord; n: CARDINAL) ;
+
+
+(*
+   RemoveTop - throw away the top element of the stack.
+*)
+
+PROCEDURE RemoveTop (s: StackOfWord) ;
+
+
+(*
+   NoOfItemsInStackWord - returns the number of items held in the stack, s.
+*)
+
+PROCEDURE NoOfItemsInStackWord (s: StackOfWord) : CARDINAL ;
+
+
+END M2StackWord.
diff --git a/gcc/m2/gm2-compiler/M2StackWord.mod b/gcc/m2/gm2-compiler/M2StackWord.mod
new file mode 100644
index 00000000000..73d627bca7f
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2StackWord.mod
@@ -0,0 +1,300 @@
+(* M2StackWord.mod provides a generic stack for WORD sized objects.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2StackWord ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2Error IMPORT InternalError ;
+FROM M2Debug IMPORT Assert ;
+
+CONST
+   MaxBucket = 10 ;
+
+TYPE
+   StackBucketWord = POINTER TO BucketWord ;
+   BucketWord      = RECORD
+                         bucket: ARRAY [0..MaxBucket-1] OF WORD ;
+                         items : CARDINAL ;
+                         last  : StackBucketWord ;
+                     END ;
+
+   StackOfWord     = POINTER TO StackDescriptor ;
+   StackDescriptor = RECORD
+                        tail: StackBucketWord ;
+                     END ;
+
+
+(*
+   InitStackWord - creates and returns a new stack.
+*)
+
+PROCEDURE InitStackWord () : StackOfWord ;
+VAR
+   s: StackOfWord ;
+BEGIN
+   NEW(s) ;
+   WITH s^ DO
+      tail := NIL
+   END ;
+   RETURN( s )
+END InitStackWord ;
+
+
+(*
+   KillBucket - destroys a StackBucketWord and returns, NIL.
+*)
+
+PROCEDURE KillBucket (b: StackBucketWord) : StackBucketWord ;
+BEGIN
+   IF b#NIL
+   THEN
+      b := KillBucket(b^.last) ;
+      DISPOSE(b)
+   END ;
+   RETURN( NIL )
+END KillBucket ;
+
+
+(*
+   KillStackWord - destroys a stack, returning NIL.
+*)
+
+PROCEDURE KillStackWord (s: StackOfWord) : StackOfWord ;
+BEGIN
+   IF s#NIL
+   THEN
+      s^.tail := KillBucket(s^.tail) ;
+      DISPOSE(s)
+   END ;
+   RETURN( NIL )
+END KillStackWord ;
+
+
+(*
+   InitBucket - returns an empty StackBucketWord.
+*)
+
+PROCEDURE InitBucket (l: StackBucketWord) : StackBucketWord ;
+VAR
+   b: StackBucketWord ;
+BEGIN
+   NEW(b) ;
+   WITH b^ DO
+      items := 0 ;
+      last  := l
+   END ;
+   RETURN( b )
+END InitBucket ;
+
+
+(*
+   PushWord - pushes a word, w, onto, s.
+*)
+
+PROCEDURE PushWord (s: StackOfWord; w: WORD) ;
+BEGIN
+   IF s=NIL
+   THEN
+      InternalError ('stack has not been initialized')
+   ELSE
+      WITH s^ DO
+         IF (tail=NIL) OR (tail^.items=MaxBucket)
+         THEN
+            tail := InitBucket(tail)
+         END ;
+         WITH tail^ DO
+            IF items<MaxBucket
+            THEN
+               bucket[items] := w ;
+               INC(items)
+            END
+         END
+      END
+   END
+END PushWord ;
+
+
+(*
+   PopWord - pops an element from stack, s.
+*)
+
+PROCEDURE PopWord (s: StackOfWord) : WORD ;
+VAR
+   b: StackBucketWord ;
+BEGIN
+   IF s=NIL
+   THEN
+      InternalError ('stack has not been initialized')
+   ELSE
+      IF s^.tail=NIL
+      THEN
+         InternalError ('stack underflow')
+      ELSE
+         IF s^.tail^.items=0
+         THEN
+            b := s^.tail ;
+            IF b=NIL
+            THEN
+               InternalError ('stack underflow')
+            ELSE
+               s^.tail := b^.last
+            END ;
+            DISPOSE(b)
+         END ;
+         WITH s^.tail^ DO
+            DEC(items) ;
+            RETURN( bucket[items] )
+         END
+      END
+   END
+END PopWord ;
+
+
+(*
+   IsEmptyWord - returns TRUE if stack, s, is empty.
+*)
+
+PROCEDURE IsEmptyWord (s: StackOfWord) : BOOLEAN ;
+BEGIN
+   RETURN( (s=NIL) OR (s^.tail=NIL) )
+END IsEmptyWord ;
+
+
+(*
+   PeepWord - returns the element at, n, items below in the stack.
+              Top of stack can be seen via Peep(s, 1)
+*)
+
+PROCEDURE PeepWord (s: StackOfWord; n: CARDINAL) : WORD ;
+VAR
+   b: StackBucketWord ;
+BEGIN
+   IF s^.tail=NIL
+   THEN
+      InternalError ('stack underflow')
+   ELSE
+      IF s^.tail^.items=0
+      THEN
+         b := s^.tail ;
+         IF b=NIL
+         THEN
+            InternalError ('stack underflow')
+         ELSE
+            s^.tail := b^.last
+         END ;
+         DISPOSE(b)
+      END ;
+      b := s^.tail ;
+      WHILE n>=1 DO
+         IF b=NIL
+         THEN
+            InternalError ('stack underflow')
+         ELSIF b^.items>=n
+         THEN
+            RETURN( b^.bucket[b^.items-n] )
+         ELSE
+            Assert(b^.items<n) ;
+            DEC(n, b^.items) ;
+            b := b^.last
+         END
+      END ;
+      InternalError ('stack underflow')
+   END
+END PeepWord ;
+
+
+(*
+   ReduceWord - reduce the stack by n elements.
+*)
+
+PROCEDURE ReduceWord (s: StackOfWord; n: CARDINAL) ;
+VAR
+   b: StackBucketWord ;
+BEGIN
+   IF s^.tail=NIL
+   THEN
+      InternalError ('stack underflow')
+   ELSE
+      IF s^.tail^.items=0
+      THEN
+         b := s^.tail ;
+         IF b=NIL
+         THEN
+            InternalError ('stack underflow')
+         ELSE
+            s^.tail := b^.last
+         END ;
+         DISPOSE(b)
+      END ;
+      LOOP
+         IF s^.tail=NIL
+         THEN
+            InternalError ('stack underflow')
+         ELSIF s^.tail^.items>=n
+         THEN
+            DEC( s^.tail^.items, n) ;
+            RETURN  (* all done exit *)
+         ELSE
+            b := s^.tail ;
+            DEC(n, b^.items) ;
+            s^.tail := s^.tail^.last ;
+            DISPOSE(b)
+         END
+      END
+   END
+END ReduceWord ;
+
+
+(*
+   RemoveTop - throw away the top element of the stack.
+*)
+
+PROCEDURE RemoveTop (s: StackOfWord) ;
+BEGIN
+   ReduceWord (s, 1)
+END RemoveTop ;
+
+
+(*
+   NoOfItemsInStackWord - returns the number of items held in the stack, s.
+*)
+
+PROCEDURE NoOfItemsInStackWord (s: StackOfWord) : CARDINAL ;
+VAR
+   b: StackBucketWord ;
+   n: CARDINAL ;
+BEGIN
+   IF IsEmptyWord(s)
+   THEN
+      RETURN( 0 )
+   ELSE
+      n := 0 ;
+      b := s^.tail ;
+      WHILE b#NIL DO
+         INC(n, b^.items) ;
+         b := b^.last
+      END ;
+      RETURN( n )
+   END
+END NoOfItemsInStackWord ;
+
+
+END M2StackWord.
diff --git a/gcc/m2/gm2-compiler/M2Students.def b/gcc/m2/gm2-compiler/M2Students.def
new file mode 100644
index 00000000000..d34d902fa02
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Students.def
@@ -0,0 +1,54 @@
+(* M2Students.def checks for new programmer errors.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Students ;
+
+(*
+    Title      : M2Students
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Wed Nov 27 22:11:22 1996
+    Description: checks for new programmer errors.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM NameKey IMPORT Name ;
+EXPORT QUALIFIED StudentVariableCheck, CheckForVariableThatLooksLikeKeyword ;
+
+
+(*
+   CheckForVariableThatLooksLikeKeyword - checks for a identifier that looks the same
+                                          as a keyword except for its case.
+*)
+
+PROCEDURE CheckForVariableThatLooksLikeKeyword (name: Name) ;
+
+
+(*
+   StudentVariableCheck - checks to see that variables are quite different from keywords and
+                          issues an message if they are not. It ignores case so to catch
+                          1st and 2nd semester programming errors.
+*)
+
+PROCEDURE StudentVariableCheck ;
+
+
+END M2Students.
diff --git a/gcc/m2/gm2-compiler/M2Students.mod b/gcc/m2/gm2-compiler/M2Students.mod
new file mode 100644
index 00000000000..20e375f1d3b
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Students.mod
@@ -0,0 +1,256 @@
+(* M2Students.mod checks for new programmer errors.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Students ;
+
+
+FROM SymbolTable IMPORT FinalSymbol, IsVar, IsProcedure, IsModule,
+                        GetMainModule, IsType, NulSym, IsRecord, GetSymName, GetNth, GetNthProcedure, GetDeclaredMod, NoOfParam ;
+FROM NameKey IMPORT GetKey, WriteKey, MakeKey, IsSameExcludingCase, NulName, makekey, KeyToCharStar ;
+FROM M2MetaError IMPORT MetaErrorString0, MetaError2 ;
+FROM Lists IMPORT List, InitList, IsItemInList, IncludeItemIntoList ;
+FROM M2Reserved IMPORT IsReserved, toktype ;
+FROM DynamicStrings IMPORT String, InitString, KillString, ToUpper, InitStringCharStar, string, Mark, ToUpper, Dup ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2 ;
+FROM M2LexBuf IMPORT GetTokenNo ;
+FROM ASCII IMPORT nul ;
+FROM M2Options IMPORT StyleChecking ;
+
+
+VAR
+   ErrantNames,
+   ErrantSymbols: List ;
+
+
+(*
+   IsNotADuplicate - returns TRUE if either s1 or s2 have not been reported before.
+*)
+
+PROCEDURE IsNotADuplicate (s1, s2: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF (NOT IsItemInList(ErrantSymbols, s1)) AND (NOT IsItemInList(ErrantSymbols, s2))
+   THEN
+      IncludeItemIntoList(ErrantSymbols, s1) ;
+      IncludeItemIntoList(ErrantSymbols, s2) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsNotADuplicate ;
+
+
+(*
+   IsNotADuplicateName - returns TRUE if name has not been reported before.
+*)
+
+PROCEDURE IsNotADuplicateName (name: Name) : BOOLEAN ;
+BEGIN
+   IF NOT IsItemInList(ErrantNames, name)
+   THEN
+      IncludeItemIntoList(ErrantNames, name) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsNotADuplicateName ;
+
+
+(*
+   CheckForVariableThatLooksLikeKeyword - checks for a identifier that looks the same
+                                          as a keyword except for its case.
+*)
+
+PROCEDURE CheckForVariableThatLooksLikeKeyword (name: Name) ;
+BEGIN
+   IF StyleChecking
+   THEN
+      PerformVariableKeywordCheck (name)
+   END
+END CheckForVariableThatLooksLikeKeyword ;
+
+
+(*
+   PerformVariableKeywordCheck - performs the check and constructs the metaerror notes if appropriate.
+*)
+
+PROCEDURE PerformVariableKeywordCheck (name: Name) ;
+VAR
+   upper : Name ;
+   token : toktype ;
+   orig,
+   upperS: String ;
+BEGIN
+   orig := InitStringCharStar (KeyToCharStar (name)) ;
+   upperS := ToUpper (Dup (orig)) ;
+   upper := makekey (string (upperS)) ;
+   IF IsReserved (upper, token)
+   THEN
+      IF IsNotADuplicateName (name)
+      THEN
+         MetaErrorString0 (Sprintf2 (Mark (InitString ('either the identifier has the same name as a keyword or alternatively a keyword has the wrong case ({%%K%s} and {!%%O:{%%K%s}})')),
+                                     upperS, orig)) ;
+         MetaErrorString0 (Sprintf1 (Mark (InitString ('the symbol name {!%%O:{%%K%s}} is legal as an identifier, however as such it might cause confusion and is considered bad programming practice')), orig))
+      END
+   END ;
+   upperS := KillString (upperS) ;
+   orig := KillString (orig)
+END PerformVariableKeywordCheck ;
+
+
+(*
+   CheckAsciiName - checks to see whether ascii names, s1, and, s2, are similar.
+*)
+
+PROCEDURE CheckAsciiName (previous, s1, newblock, s2: CARDINAL) ;
+VAR
+   a1, a2: Name ;
+BEGIN
+   a1 := GetSymName (s1) ;
+   a2 := GetSymName (s2) ;
+   IF (a1 = a2) AND (a1 # NulName)
+   THEN
+      IF IsNotADuplicate (s1, s2)
+      THEN
+         MetaError2 ('identical symbol name in two different scopes, scope {%1Oad} has symbol {%2Mad}', previous, s1) ;
+         MetaError2 ('identical symbol name in two different scopes, scope {%1Oad} has symbol {%2Mad}', newblock, s2)
+      END
+   ELSIF IsSameExcludingCase (a1, a2)
+   THEN
+      IF IsNotADuplicate (s1, s2)
+      THEN
+         MetaError2 ('very similar symbol names (different case) in two different scopes, scope {%1ORad} has symbol {%2Mad}', previous, s1) ;
+         MetaError2 ('very similar symbol names (different case) in two different scopes, scope {%1OCad} has symbol {%2Mad}', newblock, s2)
+      END
+   END
+END CheckAsciiName ;
+
+
+(*
+   CheckProcedure - checks the procedure, p, for symbols which look like, s.
+*)
+
+PROCEDURE CheckProcedure (m, p: CARDINAL) ;
+VAR
+   i, n1,
+   j, n2: CARDINAL ;
+BEGIN
+   IF p#NulSym
+   THEN
+      i := 1 ;   (* I would have used NoOfParam(p)+1 but Stuart wants parameters checked as well - maybe he is right.  *)
+      REPEAT
+         n1 := GetNth(p, i) ;
+         IF n1#NulSym
+         THEN
+            IF IsVar(n1) OR IsType(n1) OR IsProcedure(n1) OR IsRecord(n1)
+            THEN
+               j := 1 ;
+               REPEAT
+                  n2 := GetNth(m, j) ;
+                  IF n2#NulSym
+                  THEN
+                     IF IsVar(n2) OR IsType(n2) OR IsProcedure(n2) OR IsRecord(n2)
+                     THEN
+                        CheckAsciiName(m, n2, p, n1)
+                     END
+                  END ;
+                  INC(j)
+               UNTIL n2=NulSym
+            END
+         END ;
+         INC(i)
+      UNTIL n1=NulSym
+   END
+END CheckProcedure ;
+
+
+(*
+   CheckModule - checks the module, m, for symbols which look like, s.
+*)
+
+PROCEDURE CheckModule (m, s: CARDINAL) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   IF m#NulSym
+   THEN
+      i := 1 ;
+      REPEAT
+         n := GetNth(m, i) ;
+         IF n#NulSym
+         THEN
+            IF (n#NulSym) AND (n#s)
+            THEN
+               IF IsVar(n) OR IsType(n) OR IsProcedure(n) OR IsRecord(n)
+               THEN
+                  CheckAsciiName(m, s, m, n)
+               END
+            END
+         END ;
+         INC(i)
+      UNTIL n=NulSym
+   END
+END CheckModule ;
+
+
+(*
+   StudentVariableCheck - checks to see that variables are quite different from keywords and
+                          issues an message if they are not. It ignores case so to catch
+                          1st and 2nd semester programming errors.
+*)
+
+PROCEDURE StudentVariableCheck ;
+VAR
+   i, n, m: CARDINAL ;
+BEGIN
+   m := GetMainModule() ;
+   (* first check global scope *)
+   i := 1 ;
+   REPEAT
+      n := GetNth(m, i) ;
+      IF n#NulSym
+      THEN
+         IF IsVar(n) OR IsType(n) OR IsProcedure(n) OR IsRecord(n)
+         THEN
+            CheckModule(m, n)
+         END
+      END ;
+      INC(i)
+   UNTIL n=NulSym ;
+   (* now check local scope *)
+   i := 1 ;
+   REPEAT
+      n := GetNthProcedure(m, i) ;
+      IF n#NulSym
+      THEN
+         IF IsProcedure(n)
+         THEN
+            CheckProcedure(m, n)
+         END
+      END ;
+      INC(i)
+   UNTIL n=NulSym
+END StudentVariableCheck ;
+
+
+BEGIN
+   InitList(ErrantSymbols) ;
+   InitList(ErrantNames)
+END M2Students.
diff --git a/gcc/m2/gm2-compiler/M2Swig.def b/gcc/m2/gm2-compiler/M2Swig.def
new file mode 100644
index 00000000000..5c44618822b
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Swig.def
@@ -0,0 +1,44 @@
+(* M2Swig.def generates a swig interface file for the main module.
+
+Copyright (C) 2008-2022 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/>.  *)
+
+DEFINITION MODULE M2Swig ;
+
+(*
+    Title      : M2Swig
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu May  1 15:26:28 2008
+    Revision   : $Version$
+    Description: generates a swig interface file for the main module.
+*)
+
+EXPORT QUALIFIED GenerateSwigFile ;
+
+
+(*
+   GenerateSwigFile - if the -fswig option was specified then generate
+                      a swig interface file for the main module.
+*)
+
+PROCEDURE GenerateSwigFile (sym: CARDINAL) ;
+
+
+END M2Swig.
diff --git a/gcc/m2/gm2-compiler/M2Swig.mod b/gcc/m2/gm2-compiler/M2Swig.mod
new file mode 100644
index 00000000000..15b36c427f0
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Swig.mod
@@ -0,0 +1,985 @@
+(* M2Swig.mod generates a swig interface file for the main module.
+
+Copyright (C) 2008-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Swig ;
+
+FROM Storage IMPORT ALLOCATE ;
+FROM M2Options IMPORT GenerateSwig ;
+FROM SFIO IMPORT OpenToWrite ;
+FROM FIO IMPORT File, Close ;
+FROM NameKey IMPORT Name, KeyToCharStar ;
+FROM M2Error IMPORT InternalError ;
+FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2, fprintf3, fprintf4 ;
+FROM M2AsmUtil IMPORT GetFullScopeAsmName ;
+FROM SYSTEM IMPORT WORD ;
+
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, ConCat, Mark,
+                           KillString ;
+
+FROM Lists IMPORT List, InitList, KillList, IsItemInList,
+                  IncludeItemIntoList, RemoveItemFromList,
+                  ForeachItemInListDo, NoOfItemsInList,
+                  GetItemFromList ;
+
+FROM M2Quads IMPORT IsProcedureScope ;
+FROM M2System IMPORT IsSystemType, Address, Byte, Loc, Word ;
+FROM M2Bitset IMPORT Bitset ;
+FROM Indexing IMPORT Index, InitIndex, KillIndex, HighIndice, PutIndice, GetIndice ;
+FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock ;
+
+FROM M2Base IMPORT IsBaseType, Char, Cardinal, Integer, Real, LongReal, ShortReal,
+                   LongCard, ShortCard, LongInt, ShortInt, Boolean ;
+
+FROM SymbolTable IMPORT GetSymName, IsType, IsProcedure, IsConst, IsVar,
+                        GetType, GetNthParam, IsUnbounded, GetMode, ModeOfAddr,
+                        NoOfParam, IsConstString, IsConstLit, IsPointer,
+                        IsExported, ForeachExportedDo, IsUnboundedParam,
+                        IsParameter, IsParameterUnbounded, IsParameterVar,
+                        GetParameterShadowVar, GetReadQuads, GetWriteQuads,
+                        NulSym ;
+
+FROM M2BasicBlock IMPORT BasicBlock, InitBasicBlocks, KillBasicBlocks,
+                         ForeachBasicBlockDo ;
+
+
+TYPE
+   UnboundedSig = POINTER TO RECORD
+                                type: CARDINAL ;
+                                name: Name ;
+                             END ;
+
+VAR
+   includedArray: BOOLEAN ;
+   uKey         : Index ;
+   mainModule   : CARDINAL ;
+   Done,
+   ToDo         : List ;
+   f            : File ;
+   name         : String ;
+
+
+(*
+   DoExported - includes, sym, into the, ToDo, list.
+*)
+
+PROCEDURE DoExported (sym: CARDINAL) ;
+BEGIN
+   IncludeItemIntoList(ToDo, sym)
+END DoExported ;
+
+
+(*
+   MoveToDone - moves a sym to the, Done, list,
+                providing that it is not already on it.
+                It returns TRUE if the lists were modified.
+*)
+
+PROCEDURE MoveToDone (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsItemInList(Done, sym)
+   THEN
+      RETURN( FALSE )
+   ELSIF IsItemInList(ToDo, sym)
+   THEN
+      RemoveItemFromList(ToDo, sym) ;
+      IncludeItemIntoList(Done, sym) ;
+      RETURN( TRUE )
+   END ;
+   IncludeItemIntoList(Done, sym) ;
+   RETURN( TRUE )
+END MoveToDone ;
+
+
+(*
+   MoveToToDo - moves a sym to the, ToDo, list,
+                providing that it is not already on it.
+                It returns TRUE if the lists were modified.
+*)
+
+PROCEDURE MoveToToDo (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsItemInList(Done, sym)
+   THEN
+      InternalError ('not expecting to get here')
+   ELSIF IsItemInList(ToDo, sym)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      IncludeItemIntoList(ToDo, sym) ;
+      RETURN( TRUE )
+   END
+END MoveToToDo ;
+
+
+(*
+   Trybase - returns TRUE
+*)
+
+PROCEDURE TryBase (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF (sym=Cardinal) OR (sym=Integer) OR (sym=LongInt) OR
+      (sym=LongCard) OR (sym=Char) OR (sym=ShortCard) OR
+      (sym=ShortInt) OR (sym=Real) OR (sym=LongReal) OR
+      (sym=ShortReal) OR (sym=Boolean)
+   THEN
+      RETURN( MoveToDone(sym) )
+   ELSE
+      RETURN( FALSE )
+   END
+END TryBase ;
+
+
+(*
+   TrySystem - returns TRUE if sym can be moved to the done list.
+*)
+
+PROCEDURE TrySystem (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF (sym=Bitset) OR (sym=Address) OR (sym=Byte) OR (sym=Loc) OR
+      (sym=Word)
+   THEN
+      RETURN( MoveToDone(sym) )
+   ELSE
+      RETURN( FALSE )
+   END
+END TrySystem ;
+
+
+(*
+   TryMove - tries to move sym to the done queue as long
+             as type is known.
+*)
+
+PROCEDURE TryMove (sym, type: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsItemInList(Done, type)
+   THEN
+      IF MoveToDone(sym)
+      THEN
+         RETURN( TRUE )
+      END
+   ELSE
+      IF MoveToToDo(sym)
+      THEN
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END TryMove ;
+
+
+(*
+   TryType -
+*)
+
+PROCEDURE TryType (sym: CARDINAL) : BOOLEAN ;
+VAR
+   type  : CARDINAL ;
+   result: BOOLEAN ;
+BEGIN
+   type := GetType(sym) ;
+   result := TryDependents(type) ;
+   IF TryMove(sym, type)
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( result )
+   END
+END TryType ;
+
+
+(*
+   TryVar -
+*)
+
+PROCEDURE TryVar (sym: CARDINAL) : BOOLEAN ;
+VAR
+   type  : CARDINAL ;
+   result: BOOLEAN ;
+BEGIN
+   type := GetType(sym) ;
+   result := TryDependents(type) ;
+   IF TryMove(sym, type)
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( result )
+   END
+END TryVar ;
+
+
+(*
+   TryProcedure -
+*)
+
+PROCEDURE TryProcedure (sym: CARDINAL) : BOOLEAN ;
+VAR
+   son,
+   p, i,
+   type  : CARDINAL ;
+   solved,
+   result: BOOLEAN ;
+BEGIN
+   type := GetType(sym) ;
+   result := FALSE ;
+   solved := TRUE ;
+   IF type#NulSym
+   THEN
+      IF TryDependents(type)
+      THEN
+         result := TRUE
+      END ;
+      IF NOT IsItemInList(Done, type)
+      THEN
+         solved := FALSE
+      END
+   END ;
+   p := NoOfParam(sym) ;
+   i := 1 ;
+   WHILE i<=p DO
+      son := GetNthParam(sym, i) ;
+      IF TryDependents(son)
+      THEN
+         result := TRUE
+      END ;
+      IF NOT IsItemInList(Done, son)
+      THEN
+         solved := FALSE
+      END ;
+      INC(i)
+   END ;
+   IF solved
+   THEN
+      IF MoveToDone(sym)
+      THEN
+         RETURN( TRUE )
+      END
+   ELSE
+      IF MoveToToDo(sym)
+      THEN
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( result )
+END TryProcedure ;
+
+
+(*
+   TryUnbounded -
+*)
+
+PROCEDURE TryUnbounded (sym: CARDINAL) : BOOLEAN ;
+VAR
+   type  : CARDINAL ;
+   result: BOOLEAN ;
+BEGIN
+   type := GetType(sym) ;
+   result := TryDependents(type) ;
+   IF TryMove(sym, type)
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( result )
+   END
+END TryUnbounded ;
+
+
+(*
+   TryParameter -
+*)
+
+PROCEDURE TryParameter (sym: CARDINAL) : BOOLEAN ;
+VAR
+   type  : CARDINAL ;
+   result: BOOLEAN ;
+BEGIN
+   type := GetType(sym) ;
+   result := TryDependents(type) ;
+   IF TryMove(sym, type)
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( result )
+   END
+END TryParameter ;
+
+
+(*
+   TryDependents - returns TRUE if any alteration occurred to any
+                   of the lists.
+*)
+
+PROCEDURE TryDependents (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsBaseType(sym)
+   THEN
+      RETURN( TryBase(sym) )
+   ELSIF IsSystemType(sym)
+   THEN
+      RETURN( TrySystem(sym) )
+   ELSIF IsType(sym)
+   THEN
+      RETURN( TryType(sym) )
+   ELSIF IsParameter(sym)
+   THEN
+      RETURN( TryParameter(sym) )
+   ELSIF IsProcedure(sym)
+   THEN
+      RETURN( TryProcedure(sym) )
+   ELSIF IsConstString(sym)
+   THEN
+      RETURN( MoveToDone(sym) )
+   ELSIF IsConstLit(sym)
+   THEN
+      RETURN( MoveToDone(sym) )
+   ELSIF IsVar(sym) AND (GetMode(sym)=ImmediateValue)
+   THEN
+      RETURN( MoveToDone(sym) )
+   ELSIF IsVar(sym)
+   THEN
+      RETURN( TryVar(sym) )
+   ELSIF IsUnbounded(sym)
+   THEN
+      RETURN( TryUnbounded(sym) )
+   ELSE
+      RETURN( FALSE )
+   END
+END TryDependents ;
+
+
+(*
+   DoResolveOrder - resolves the declaration order for swig (C).
+*)
+
+PROCEDURE DoResolveOrder ;
+VAR
+   sym,
+   i, n    : CARDINAL ;
+   movement: BOOLEAN ;
+BEGIN
+   REPEAT
+      n := NoOfItemsInList(ToDo) ;
+      movement := FALSE ;
+      i := 1 ;
+      WHILE (i<=n) AND (NOT movement) DO
+         sym := GetItemFromList(ToDo, i) ;
+         movement := TryDependents(sym) ;
+         INC(i)
+      END
+   UNTIL NOT movement
+END DoResolveOrder ;
+
+
+(*
+   DoName -
+*)
+
+PROCEDURE DoName (sym: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   n := GetFullScopeAsmName(sym) ;
+   fprintf1(f, "%a", n)
+END DoName ;
+
+
+(*
+   DoParamName -
+*)
+
+PROCEDURE DoParamName (sym: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   n := GetSymName(sym) ;
+   fprintf1(f, "%a", n)
+END DoParamName ;
+
+
+(*
+   DoVar -
+*)
+
+PROCEDURE DoVar (sym: CARDINAL) ;
+BEGIN
+   fprintf0(f, 'extern "C" ') ;
+   DoType(GetType(sym)) ;
+   fprintf0(f, ' ') ;
+   DoName(sym) ;
+   fprintf0(f, ';\n')
+END DoVar ;
+
+
+(*
+   DoType -
+*)
+
+PROCEDURE DoType (sym: CARDINAL) ;
+BEGIN
+   IF IsPointer(sym)
+   THEN
+      DoType(GetType(sym)) ;
+      fprintf0(f, ' *')
+   ELSIF sym=Cardinal
+   THEN
+      fprintf0(f, "unsigned int")
+   ELSIF sym=Integer
+   THEN
+      fprintf0(f, "int")
+   ELSIF sym=Boolean
+   THEN
+      fprintf0(f, "unsigned int")
+   ELSIF sym=LongInt
+   THEN
+      fprintf0(f, "long long int")
+   ELSIF sym=LongCard
+   THEN
+      fprintf0(f, "long long unsigned int")
+   ELSIF sym=Char
+   THEN
+      fprintf0(f, "char")
+   ELSIF sym=ShortCard
+   THEN
+      fprintf0(f, "short unsigned int")
+   ELSIF sym=ShortInt
+   THEN
+      fprintf0(f, "short int")
+   ELSIF sym=Real
+   THEN
+      fprintf0(f, "double")
+   ELSIF sym=LongReal
+   THEN
+      fprintf0(f, "long double")
+   ELSIF sym=ShortReal
+   THEN
+      fprintf0(f, "float")
+   ELSIF sym=Bitset
+   THEN
+      fprintf0(f, "unsigned int")
+   ELSIF sym=Address
+   THEN
+      fprintf0(f, "void *")
+   ELSIF sym=Byte
+   THEN
+      fprintf0(f, "unsigned char")
+   ELSIF sym=Loc
+   THEN
+      fprintf0(f, "unsigned char")
+   ELSIF sym=Word
+   THEN
+      fprintf0(f, "unsigned int")
+   END
+END DoType ;
+
+
+(*
+   DoUnbounded -
+*)
+
+PROCEDURE DoUnbounded (sym: CARDINAL) ;
+VAR
+   n   : Name ;
+   type: CARDINAL ;
+BEGIN
+   type := GetType(sym) ;
+   DoType(GetType(type)) ;
+   n := GetSymName(sym) ;
+   fprintf2(f, ' *_m2_address_%a, int _m2_high_%a', n, n)
+END DoUnbounded ;
+
+
+VAR
+   FirstBasicBlock,
+   Input,
+   Output,
+   InOut,
+   CanGuess,
+   IsKnown        : BOOLEAN ;
+   rs, ws         : CARDINAL ;
+
+
+(*
+   DoBasicBlock -
+*)
+
+PROCEDURE DoBasicBlock (start, end: CARDINAL) ;
+BEGIN
+   IF IsProcedureScope(start)
+   THEN
+      (* skip this basic block, as this will not modify the parameter *)
+      RETURN
+   ELSIF IsKnown OR CanGuess
+   THEN
+      (* already resolved *)
+      RETURN
+   ELSE
+      IF (ws=0) AND (rs=0)
+      THEN
+         FirstBasicBlock := FALSE
+      ELSIF rs=0
+      THEN
+         (* only written *)
+         IF ws<=end
+         THEN
+            Output := TRUE ;
+            IF FirstBasicBlock
+            THEN
+               IsKnown := TRUE
+            ELSE
+               CanGuess := TRUE
+            END ;
+            FirstBasicBlock := FALSE
+         END
+      ELSIF ws=0
+      THEN
+         (* only read *)
+         Input := TRUE ;
+         IF (rs<=end) AND FirstBasicBlock
+         THEN
+            IsKnown := TRUE
+         ELSE
+            CanGuess := TRUE
+         END ;
+         FirstBasicBlock := FALSE
+      ELSIF rs<=ws
+      THEN
+         (* read before write *)
+         InOut := TRUE ;
+         IF (rs<=end) AND (ws<=end) AND FirstBasicBlock
+         THEN
+            IsKnown := TRUE
+         ELSE
+            CanGuess := TRUE
+         END ;
+         FirstBasicBlock := FALSE
+      ELSE
+         (* must be written before read *)
+         Output := TRUE ;
+         IF (rs<=end) AND (ws<=end) AND FirstBasicBlock
+         THEN
+            IsKnown := TRUE
+         ELSE
+            CanGuess := TRUE
+         END ;
+         FirstBasicBlock := FALSE
+      END
+   END
+END DoBasicBlock ;
+
+
+(*
+   DetermineParameter -
+*)
+
+PROCEDURE DetermineParameter (procedure, param: CARDINAL) ;
+VAR
+   sb: ScopeBlock ;
+   bb: BasicBlock ;
+   we,
+   re: CARDINAL ;
+BEGIN
+   sb := InitScopeBlock(procedure) ;
+   bb := InitBasicBlocks(sb) ;
+   Input := FALSE ;
+   Output := FALSE ;
+   InOut := FALSE ;
+   CanGuess := FALSE ;
+   IsKnown := FALSE ;
+   FirstBasicBlock := TRUE ;
+   GetReadQuads(param, RightValue, rs, re) ;
+   GetWriteQuads(param, RightValue, ws, we) ;
+   ForeachBasicBlockDo(bb, DoBasicBlock) ;
+   KillBasicBlocks(bb) ;
+   KillScopeBlock(sb)
+END DetermineParameter ;
+
+
+(*
+   PrintDirection -
+*)
+
+PROCEDURE PrintDirection ;
+BEGIN
+   IF Input
+   THEN
+      fprintf0(f, 'INPUT')
+   ELSIF Output
+   THEN
+      fprintf0(f, 'OUTPUT')
+   ELSE
+      fprintf0(f, 'INOUT')
+   END
+END PrintDirection ;
+
+
+(*
+   CalculateVarDirective -
+*)
+
+PROCEDURE CalculateVarDirective (procedure, param: CARDINAL; annotate: BOOLEAN) ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   sym := GetParameterShadowVar(param) ;
+   IF sym=NulSym
+   THEN
+      InternalError ('why did we get here')
+   ELSE
+      DetermineParameter(procedure, sym) ;
+      IF annotate
+      THEN
+         DoParamName(sym) ;
+         IF IsKnown
+         THEN
+            fprintf0(f, ' is known to be an ') ;
+            PrintDirection
+         ELSIF CanGuess
+         THEN
+            fprintf0(f, ' is guessed to be an ') ;
+            PrintDirection
+         ELSE
+            fprintf0(f, ' is unknown')
+         END
+      ELSE
+         fprintf0(f, '*') ;
+         IF IsKnown OR CanGuess
+         THEN
+            PrintDirection
+         ELSE
+            DoParamName(sym)
+         END
+      END
+   END
+END CalculateVarDirective ;
+
+
+(*
+   AnnotateProcedure -
+*)
+
+PROCEDURE AnnotateProcedure (sym: CARDINAL) ;
+VAR
+   son, p, i: CARDINAL ;
+   needComma: BOOLEAN ;
+BEGIN
+   fprintf0(f, '/*  parameter: ') ;
+   p := NoOfParam(sym) ;
+   i := 1 ;
+   needComma := FALSE ;
+   WHILE i<=p DO
+      son := GetNthParam(sym, i) ;
+      IF IsParameterVar(son)
+      THEN
+         IF needComma
+         THEN
+            fprintf0(f, ', ')
+         END ;
+         CalculateVarDirective(sym, son, TRUE) ;
+         needComma := TRUE
+      END ;
+      INC(i)
+   END ;
+   fprintf0(f, ' */\n\n')
+END AnnotateProcedure ;
+
+
+(*
+   DoProcedure -
+*)
+
+PROCEDURE DoProcedure (sym: CARDINAL) : BOOLEAN ;
+VAR
+   son,
+   p, i : CARDINAL ;
+   found: BOOLEAN ;
+BEGIN
+   found := FALSE ;
+   fprintf0(f, 'extern "C" ') ;
+   IF GetType(sym)=NulSym
+   THEN
+      fprintf0(f, 'void') ;
+   ELSE
+      DoType(GetType(sym))
+   END ;
+   fprintf0(f, ' ') ;
+   DoName(sym) ;
+   fprintf0(f, ' (') ;
+   p := NoOfParam(sym) ;
+   IF p=0
+   THEN
+      fprintf0(f, 'void') ;
+   ELSE
+      i := 1 ;
+      WHILE i<=p DO
+         son := GetNthParam(sym, i) ;
+         IF IsUnboundedParam(sym, i)
+         THEN
+            DoUnbounded(son)
+         ELSE
+            DoType(GetType(son)) ;
+            fprintf0(f, ' ') ;
+            IF IsParameterVar(son)
+            THEN
+               found := TRUE ;
+               CalculateVarDirective(sym, son, FALSE)
+            ELSE
+               DoParamName(son)
+            END
+         END ;
+         IF i<p
+         THEN
+            fprintf0(f, ', ')
+         END ;
+         INC(i)
+      END
+   END ;
+   fprintf0(f, ');\n') ;
+   RETURN( found )
+END DoProcedure ;
+
+
+(*
+   DoWriteSymbol -
+*)
+
+PROCEDURE DoWriteSymbol (sym: CARDINAL) ;
+BEGIN
+   IF IsBaseType(sym)
+   THEN
+   ELSIF IsSystemType(sym)
+   THEN
+   ELSIF IsType(sym)
+   THEN
+   ELSIF IsProcedure(sym)
+   THEN
+      IF DoProcedure(sym)
+      THEN
+         AnnotateProcedure(sym)
+      END
+   ELSIF IsConstString(sym)
+   THEN
+   ELSIF IsConstLit(sym)
+   THEN
+   ELSIF IsVar(sym) AND (GetMode(sym)=ImmediateValue)
+   THEN
+   ELSIF IsVar(sym)
+   THEN
+      DoVar(sym)
+   END
+END DoWriteSymbol ;
+
+
+(*
+   DoCheckExported -
+*)
+
+PROCEDURE DoCheckExported (sym: WORD) ;
+BEGIN
+   IF IsExported(mainModule, sym)
+   THEN
+      DoWriteSymbol(sym)
+   END
+END DoCheckExported ;
+
+
+(*
+   IsUnique - returns TRUE if the combination of, n, and, t,
+              is unique.
+*)
+
+PROCEDURE IsUnique (n: Name; t: CARDINAL) : BOOLEAN ;
+VAR
+   p   : UnboundedSig ;
+   h, i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   h := HighIndice(uKey) ;
+   WHILE i<=h DO
+      p := GetIndice(uKey, i) ;
+      IF (p^.type=t) AND (p^.name=n)
+      THEN
+         RETURN( FALSE )
+      END ;
+      INC(i)
+   END ;
+   INC(h) ;
+   NEW(p) ;
+   WITH p^ DO
+      type := t ;
+      name := n
+   END ;
+   PutIndice(uKey, h, p) ;
+   RETURN( TRUE )
+END IsUnique ;
+
+
+(*
+   IsTypeUnique - returns TRUE if type, t, has not been entered yet.
+*)
+
+PROCEDURE IsTypeUnique (t: CARDINAL) : BOOLEAN ;
+VAR
+   p   : UnboundedSig ;
+   h, i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   h := HighIndice(uKey) ;
+   WHILE i<=h DO
+      p := GetIndice(uKey, i) ;
+      IF p^.type=t
+      THEN
+         RETURN( FALSE )
+      END ;
+      INC(i)
+   END ;
+   RETURN( TRUE )
+END IsTypeUnique ;
+
+
+(*
+   DoCheckUnbounded -
+*)
+
+PROCEDURE DoCheckUnbounded (sym: WORD) ;
+VAR
+   name      : Name ;
+   type      : CARDINAL ;
+   typeUnique: BOOLEAN ;
+BEGIN
+   IF IsParameter(sym) AND IsParameterUnbounded(sym)
+   THEN
+      name := GetSymName(sym) ;
+      type := GetType(GetType(sym)) ;
+      typeUnique := IsTypeUnique(type) ;
+      IF IsUnique(name, type)
+      THEN
+         IF NOT includedArray
+         THEN
+            includedArray := TRUE ;
+            fprintf0(f, '%include "carrays.i"\n')
+         END ;
+         fprintf0(f, '%') ;
+         fprintf0(f, 'apply (char *STRING, int LENGTH) { (') ;
+         DoUnbounded(sym) ;
+         fprintf0(f, ') };\n') ;
+         IF typeUnique
+         THEN
+            fprintf0(f, '%array_functions(') ;
+            DoType(type) ;
+            fprintf0(f, ', ') ;
+            DoType(type) ;
+            fprintf0(f, 'Array);\n')
+         END
+      END
+   END
+END DoCheckUnbounded ;
+
+
+(*
+   DoWriteFile -
+*)
+
+PROCEDURE DoWriteFile (sym: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   mainModule := sym ;
+   n := GetSymName(sym) ;
+   fprintf0(f, '/* automatically generated by gm2 -fswig */\n') ;
+   fprintf0(f, '%') ;
+   fprintf1(f, 'module %a\n\n', n) ;
+   fprintf0(f, '%') ;
+   fprintf1(f, 'include exception.i\n\n', n) ;
+   fprintf0(f, '%') ;
+   fprintf0(f, 'exception {\n') ;
+   fprintf0(f, '  try {\n') ;
+   fprintf0(f, '     $action\n') ;
+   fprintf0(f, '  } catch (int i) {\n') ;
+   fprintf0(f, '     return NULL;\n') ;
+   fprintf0(f, '  }\n') ;
+   fprintf0(f, '}\n\n') ;
+   ForeachItemInListDo(Done, DoCheckUnbounded) ;
+   fprintf0(f, '\n%{\n') ;
+   ForeachItemInListDo(Done, DoCheckExported) ;
+   fprintf0(f, '%}\n\n') ;
+   ForeachItemInListDo(Done, DoCheckExported)
+END DoWriteFile ;
+
+
+(*
+   DoGenerateSwig -
+*)
+
+PROCEDURE DoGenerateSwig (sym: CARDINAL) ;
+BEGIN
+   Init ;
+   name := ConCat (InitStringCharStar (KeyToCharStar (GetSymName (sym))),
+                   Mark (InitString ('.i'))) ;
+   f := OpenToWrite (name) ;
+   ForeachExportedDo (sym, DoExported) ;
+   DoResolveOrder ;
+   DoWriteFile (sym) ;
+   Close (f) ;
+   name := KillString (name) ;
+   Kill
+END DoGenerateSwig ;
+
+
+(*
+   GenerateSwigFile - if the -fswig option was specified then generate
+                      a swig interface file for the main module.
+*)
+
+PROCEDURE GenerateSwigFile (sym: CARDINAL) ;
+BEGIN
+   IF GenerateSwig
+   THEN
+      DoGenerateSwig(sym)
+   END
+END GenerateSwigFile ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   InitList(Done) ;
+   InitList(ToDo) ;
+   uKey := InitIndex(1) ;
+   includedArray := FALSE
+END Init ;
+
+
+(*
+   Kill -
+*)
+
+PROCEDURE Kill ;
+BEGIN
+   KillList(Done) ;
+   KillList(ToDo) ;
+   uKey := KillIndex(uKey)
+END Kill ;
+
+
+END M2Swig.
diff --git a/gcc/m2/gm2-compiler/M2System.def b/gcc/m2/gm2-compiler/M2System.def
new file mode 100644
index 00000000000..f1f324b9762
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2System.def
@@ -0,0 +1,253 @@
+(* M2System.def defines the SYSTEM builtin types.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2System ;
+
+(*
+    Title      : M2System
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Tue Jul 11 08:39:17 2000
+    Description: Implements the base types of the module SYSTEM
+                 for the GNU Modula-2 compiler. Note that the base types
+                 are mapped onto their equivalents in the gcc backend.
+*)
+
+FROM m2linemap IMPORT location_t ;
+
+EXPORT QUALIFIED
+                 System,           (* The SYSTEM module symbol.  *)
+                 Loc,              (* ISO specific System Type.  *)
+
+                 Word,             (* System Type *)
+                 Byte,             (* System Type *)
+                 Address,          (* System Type *)
+                 CSizeT,           (* System Type *)
+                 CSSizeT,          (* System Type *)
+
+                 Adr,              (* System Function *)
+                 TSize,            (* System Function *)
+
+                 AddAdr,           (* ISO specific System Function *)
+                 SubAdr,           (* ISO specific System Function *)
+                 DifAdr,           (* ISO specific System Function *)
+                 MakeAdr,          (* ISO specific System Function *)
+                 Rotate,           (* ISO specific System Function *)
+                 Shift,            (* ISO specific System Function *)
+                 Cast,             (* ISO specific System Function *)
+                 Throw,            (* GNU Modula-2 extension *)
+                 TBitSize,         (* GNU Modula-2 extension *)
+
+                 GetSystemTypeMinMax,
+                 IsPseudoSystemFunction, IsPseudoSystemProcedure,
+                 IsSystemType,
+                 IsPseudoSystemFunctionConstExpression,
+
+                 IntegerN, CardinalN, WordN, RealN, SetN, ComplexN,
+                 IsIntegerN, IsCardinalN, IsWordN,
+                 IsRealN, IsSetN, IsComplexN,
+                 IsGenericSystemType,
+                 IsSameSizePervasiveType, IsSameSize,
+                 InitSystem ;
+
+
+VAR
+   System,
+   Loc,
+   Word, Byte,
+   Address,
+   CSizeT, CSSizeT,
+
+   Adr,
+   TSize, TBitSize,
+   AddAdr, SubAdr,
+   DifAdr, MakeAdr,
+   Rotate, Shift,
+   Cast, Throw    : CARDINAL ;
+
+
+(*
+   InitSystem - initializes the base types Word and Byte in the module
+                SYSTEM.
+*)
+
+PROCEDURE InitSystem ;
+
+
+(*
+   GetSystemTypeMinMax - returns the minimum and maximum values for a given system type.
+*)
+
+PROCEDURE GetSystemTypeMinMax (type: CARDINAL; VAR min, max: CARDINAL) ;
+
+
+(*
+   IsPseudoSystemFunction - returns true if Sym is a SYSTEM pseudo function.
+*)
+
+PROCEDURE IsPseudoSystemFunction (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsPseudoSystemProcedure - returns true if Sym is a SYSTEM pseudo procedure.
+*)
+
+PROCEDURE IsPseudoSystemProcedure (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsPseudoSystemFunctionConstExpression - returns TRUE if this procedure
+                                           is legal in a constant expression.
+*)
+
+PROCEDURE IsPseudoSystemFunctionConstExpression (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSystemType - returns TRUE if Sym is a SYSTEM (inbuilt) type.
+                  It does not search your SYSTEM implementation module.
+*)
+
+PROCEDURE IsSystemType (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IntegerN - returns the symbol associated with INTEGER[N].
+              NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE IntegerN (bitlength: CARDINAL) : CARDINAL ;
+
+
+(*
+   CardinalN - returns the symbol associated with CARDINAL[N].
+               NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE CardinalN (bitlength: CARDINAL) : CARDINAL ;
+
+
+(*
+   WordN - returns the symbol associated with WORD[N].
+           NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE WordN (bitlength: CARDINAL) : CARDINAL ;
+
+
+(*
+   SetN - returns the symbol associated with SET[N].
+          NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE SetN (bitlength: CARDINAL) : CARDINAL ;
+
+
+(*
+   RealN - returns the symbol associated with REAL[N].
+           NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE RealN (bitlength: CARDINAL) : CARDINAL ;
+
+
+(*
+   ComplexN - returns the symbol associated with COMPLEX[N].
+              NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE ComplexN (bitlength: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsIntegerN - returns the TRUE if, sym, is one of the SYSTEM
+                INTEGER types (not the base INTEGER type).
+*)
+
+PROCEDURE IsIntegerN (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsCardinalN - returns the TRUE if, sym, is one of the SYSTEM
+                 CARDINAL types (not the base CARDINAL type).
+*)
+
+PROCEDURE IsCardinalN (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsWordN - returns the TRUE if, sym, is one of the SYSTEM
+             WORD[n] types (not the default SYSTEM WORD type).
+*)
+
+PROCEDURE IsWordN (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSetN - returns the TRUE if, sym, is one of the SYSTEM
+            SET[n] types (not the default SYSTEM BITSET type).
+*)
+
+PROCEDURE IsSetN (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsRealN - returns the TRUE if, sym, is one of the SYSTEM
+             REAL[n] types (not the default base REAL type).
+*)
+
+PROCEDURE IsRealN (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsComplexN - returns the TRUE if, sym, is one of the SYSTEM
+                COMPLEX[n] types (not the default base COMPLEX,
+                LONGCOMPLEX or SHORTCOMPLEX types).
+*)
+
+PROCEDURE IsComplexN (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsGenericSystemType - returns TRUE if, sym, is of type
+                         BYTE, WORD or any other length.
+*)
+
+PROCEDURE IsGenericSystemType (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSameSizePervasiveType - returns TRUE if a or b are CARDINAL, INTEGER, REAL,
+                             LONGREAL, SHORTREAL and the other type is the same
+                             size and of the same type.
+*)
+
+PROCEDURE IsSameSizePervasiveType (a, b: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSameSize - return TRUE if SIZE(a)=SIZE(b)
+*)
+
+PROCEDURE IsSameSize (a, b: CARDINAL) : BOOLEAN ;
+
+
+END M2System.
diff --git a/gcc/m2/gm2-compiler/M2System.mod b/gcc/m2/gm2-compiler/M2System.mod
new file mode 100644
index 00000000000..0b8a106b9f5
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2System.mod
@@ -0,0 +1,819 @@
+(* M2System.mod defines the SYSTEM builtin types.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2System ;
+
+(*
+    Title      : M2System
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Mon Jul 10 20:24:31 2000
+    Description: gcc version of M2System. It defines the builtin types within the
+                 SYSTEM.def module. Remember that these modules (SYSTEM.def, SYSTEM.mod)
+                 really exist, but not all type definitions are expressed in this file.
+                 We also need to tell the compiler the size of the data types.
+*)
+
+FROM SymbolTable IMPORT NulSym,
+                        StartScope,
+                        EndScope,
+      	       	     	MakeConstLit,
+                        MakeConstVar,
+                        MakePointer,
+                        MakeType,
+                        MakeProcedure,
+      	       	     	MakeSet,
+      	       	     	MakeSubrange,
+                        PutFunction,
+                        PutType, PutPointer,
+      	       	     	PutSet, PutVar,
+      	       	     	PutSubrange,
+                        PutExportQualified,
+                        GetSym, GetSymName,
+                        GetCurrentModule, SetCurrentModule,
+                        IsLegal,
+                        PopValue,
+                        PopSize ;
+
+FROM Assertion IMPORT Assert ;
+FROM M2LexBuf IMPORT BuiltinTokenNo ;
+FROM M2Options IMPORT Iso, Pim2, Pedantic, DumpSystemExports ;
+FROM NameKey IMPORT Name, MakeKey, NulName ;
+FROM M2Batch IMPORT MakeDefinitionSource ;
+FROM M2Base IMPORT Cardinal, ZType ;
+FROM M2Size IMPORT Size, MakeSize ;
+FROM M2ALU IMPORT PushCard, PushIntegerTree, DivTrunc ;
+FROM M2Error IMPORT InternalError ;
+FROM Lists IMPORT List, InitList, IsItemInList, PutItemIntoList, GetItemFromList, NoOfItemsInList ;
+FROM SymbolKey IMPORT SymbolTree, InitTree, GetSymKey, PutSymKey ;
+FROM StrLib IMPORT StrEqual ;
+FROM M2Printf IMPORT printf1 ;
+FROM SymbolConversion IMPORT Mod2Gcc ;
+
+FROM M2Base IMPORT Real, Cardinal, Integer, Complex,
+                   LongReal, LongCard, LongInt, LongComplex,
+                   ShortReal, ShortCard, ShortInt, ShortComplex ;
+
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT BuiltinsLocation ;
+FROM m2decl IMPORT GetBitsPerBitset, GetBitsPerUnit ;
+
+FROM m2type IMPORT GetMaxFrom, GetMinFrom,
+                   GetWordType, GetPointerType, GetByteType, GetISOLocType,
+                   GetM2Integer8, GetM2Integer16, GetM2Integer32, GetM2Integer64,
+                   GetM2Cardinal8, GetM2Cardinal16, GetM2Cardinal32, GetM2Cardinal64,
+                   GetM2Word16, GetM2Word32, GetM2Word64,
+                   GetM2Bitset8, GetM2Bitset16, GetM2Bitset32,
+                   GetM2Real32, GetM2Real64, GetM2Real96, GetM2Real128,
+                   GetM2Complex32, GetM2Complex64, GetM2Complex96, GetM2Complex128,
+                   GetBitsetType, GetISOByteType, GetISOWordType,
+		   GetCSizeTType, GetCSSizeTType, InitSystemTypes ;
+
+FROM m2expr IMPORT BuildSize, GetSizeOf, AreConstantsEqual ;
+
+
+TYPE
+   IsP = PROCEDURE (CARDINAL) : BOOLEAN ;
+
+VAR
+   MinValues,
+   MaxValues  : SymbolTree ;
+   SystemTypes: List ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   InitList(SystemTypes) ;
+   InitTree(MinValues) ;
+   InitTree(MaxValues)
+END Init ;
+
+
+(*
+   CreateMinMaxFor - creates the min and max values for, type, given gccType.
+*)
+
+PROCEDURE CreateMinMaxFor (type: CARDINAL; min, max: ARRAY OF CHAR; gccType: Tree) ;
+VAR
+   maxval, minval: CARDINAL ;
+BEGIN
+   maxval := MakeConstVar (BuiltinTokenNo, MakeKey(max)) ;
+   PushIntegerTree (GetMaxFrom (BuiltinsLocation (), gccType)) ;
+   PopValue (maxval) ;
+   PutVar (maxval, type) ;
+   PutSymKey (MaxValues, GetSymName (type), maxval) ;
+
+   minval := MakeConstVar (BuiltinTokenNo, MakeKey(min)) ;
+   PushIntegerTree (GetMinFrom (BuiltinsLocation (), gccType)) ;
+   PopValue (minval) ;
+   PutVar (minval, type) ;
+   PutSymKey (MinValues, GetSymName (type), minval)
+END CreateMinMaxFor ;
+
+
+(*
+   MapType -
+*)
+
+PROCEDURE MapType (type: CARDINAL;
+                   name, min, max: ARRAY OF CHAR;
+                   needsExporting: BOOLEAN; t: Tree) ;
+VAR
+   n: Name ;
+BEGIN
+   PushIntegerTree(BuildSize(BuiltinsLocation(), t, FALSE)) ;
+   PopSize(type) ;
+   IF IsItemInList(SystemTypes, type)
+   THEN
+      InternalError ('not expecting system type to already be declared')
+   END ;
+   PutItemIntoList(SystemTypes, type) ;
+
+   (* create min, max constants if type is ordinal *)
+   IF (NOT StrEqual(min, '')) AND (NOT StrEqual(max, ''))
+   THEN
+      CreateMinMaxFor(type, min, max, t)
+   END ;
+   IF needsExporting AND DumpSystemExports
+   THEN
+      n := GetSymName(type) ;
+      printf1('SYSTEM module creates type: %a\n', n)
+   END
+END MapType ;
+
+
+(*
+   CreateType - create and return a frontend type which matches the GCC tree type.
+*)
+
+PROCEDURE CreateType (name, min, max: ARRAY OF CHAR;
+                      needsExporting: BOOLEAN; gccType: Tree) : CARDINAL ;
+VAR
+   type: CARDINAL ;
+BEGIN
+   IF gccType=NIL
+   THEN
+      (* GCC backend does not support this type.  *)
+      RETURN NulSym
+   ELSE
+      (* Create base type.  *)
+      type := MakeType (BuiltinTokenNo, MakeKey (name)) ;
+      PutType (type, NulSym) ;  (* a Base Type *)
+      MapType (type, name, min, max, needsExporting, gccType) ;
+      RETURN type
+   END
+END CreateType ;
+
+
+(*
+   AttemptToCreateType - attempts to create a frontend type which matches the
+                         GCC tree type.
+*)
+
+PROCEDURE AttemptToCreateType (name, min, max: ARRAY OF CHAR;
+                               needsExporting: BOOLEAN; gccType: Tree) ;
+BEGIN
+   Assert (IsLegal (CreateType (name, min, max, needsExporting, gccType)))
+END AttemptToCreateType ;
+
+
+(*
+   CreateSetType - creates and returns a, SET OF [0..highBit], type.
+                   It maps this type onto the GCC type.
+*)
+
+PROCEDURE CreateSetType (name, highBit: ARRAY OF CHAR;
+                         needsExporting: BOOLEAN; gccType: Tree) : CARDINAL ;
+VAR
+   low,
+   high,
+   subrange,
+   type    : CARDINAL ;
+BEGIN
+   IF gccType=NIL
+   THEN
+      (* GCC backend does not support this type *)
+      RETURN NulSym
+   ELSE
+      (* create base type *)
+      type := MakeSet (BuiltinTokenNo, MakeKey (name)) ;
+      low := MakeConstLit (BuiltinTokenNo, MakeKey ('0'), Cardinal) ;
+      high := MakeConstLit (BuiltinTokenNo, MakeKey (highBit), Cardinal) ;
+      subrange := MakeSubrange (BuiltinTokenNo, NulName) ;
+      PutSubrange (subrange, low, high, Cardinal) ;
+      PutSet (type, subrange, FALSE) ;
+      MapType (type, name, '', '', needsExporting, gccType) ;
+      RETURN type
+   END
+END CreateSetType ;
+
+
+(*
+   AttemptToCreateSetType - creates and returns a, SET OF [0..highBit], type.
+                            It maps this type onto the GCC type.
+*)
+
+PROCEDURE AttemptToCreateSetType (name, highBit: ARRAY OF CHAR;
+                                  needsExporting: BOOLEAN; gccType: Tree) ;
+BEGIN
+   Assert (IsLegal (CreateSetType (name, highBit, needsExporting, gccType)))
+END AttemptToCreateSetType ;
+
+
+(*
+   MakeFixedSizedTypes - creates the SYSTEM fixed sized types providing the
+                         gcc backend supports them.
+*)
+
+PROCEDURE MakeFixedSizedTypes ;
+BEGIN
+   AttemptToCreateType ('INTEGER8', 'MinInteger8', 'MaxInteger8', TRUE, GetM2Integer8 ()) ;
+   AttemptToCreateType ('INTEGER16', 'MinInteger16', 'MaxInteger16', TRUE, GetM2Integer16 ()) ;
+   AttemptToCreateType ('INTEGER32', 'MinInteger32', 'MaxInteger32', TRUE, GetM2Integer32 ()) ;
+   AttemptToCreateType ('INTEGER64', 'MinInteger64', 'MaxInteger64', TRUE, GetM2Integer64 ()) ;
+
+   AttemptToCreateType ('CARDINAL8', 'MinCardinal8', 'MaxCardinal8', TRUE, GetM2Cardinal8 ()) ;
+   AttemptToCreateType ('CARDINAL16', 'MinCardinal16', 'MaxCardinal16', TRUE, GetM2Cardinal16 ()) ;
+   AttemptToCreateType ('CARDINAL32', 'MinCardinal32', 'MaxCardinal32', TRUE, GetM2Cardinal32 ()) ;
+   AttemptToCreateType ('CARDINAL64', 'MinCardinal64', 'MaxCardinal64', TRUE, GetM2Cardinal64 ()) ;
+
+   AttemptToCreateType ('WORD16', '', '', TRUE, GetM2Word16 ()) ;
+   AttemptToCreateType ('WORD32', '', '', TRUE, GetM2Word32 ()) ;
+   AttemptToCreateType ('WORD64', '', '', TRUE, GetM2Word64 ()) ;
+
+   AttemptToCreateSetType ('BITSET8' , '7' , TRUE, GetM2Bitset8 ()) ;
+   AttemptToCreateSetType ('BITSET16', '15', TRUE, GetM2Bitset16 ()) ;
+   AttemptToCreateSetType ('BITSET32', '31', TRUE, GetM2Bitset32 ()) ;
+
+   AttemptToCreateType ('REAL32', '', '', TRUE, GetM2Real32 ()) ;
+   AttemptToCreateType ('REAL64', '', '', TRUE, GetM2Real64 ()) ;
+   AttemptToCreateType ('REAL96', '', '', TRUE, GetM2Real96 ()) ;
+   AttemptToCreateType ('REAL128', '', '', TRUE, GetM2Real128 ()) ;
+
+   AttemptToCreateType ('COMPLEX32', '', '', TRUE, GetM2Complex32 ()) ;
+   AttemptToCreateType ('COMPLEX64', '', '', TRUE, GetM2Complex64 ()) ;
+   AttemptToCreateType ('COMPLEX96', '', '', TRUE, GetM2Complex96 ()) ;
+   AttemptToCreateType ('COMPLEX128', '', '', TRUE, GetM2Complex128 ())
+END MakeFixedSizedTypes ;
+
+
+(*
+   InitPIMTypes -
+*)
+
+PROCEDURE InitPIMTypes ;
+BEGIN
+   Loc := CreateType ('LOC', '', '', TRUE, GetISOLocType()) ;
+   InitSystemTypes(BuiltinsLocation(), Loc) ;
+   Word := CreateType ('WORD', '', '', TRUE, GetWordType()) ;
+   Byte := CreateType ('BYTE', '', '', TRUE, GetByteType()) ;
+
+   (* ADDRESS = POINTER TO BYTE *)
+
+   Address := MakePointer (BuiltinTokenNo, MakeKey('ADDRESS')) ;
+   PutPointer (Address, Byte) ;                (* Base Type       *)
+   MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType())
+END InitPIMTypes ;
+
+
+(*
+   InitISOTypes -
+*)
+
+PROCEDURE InitISOTypes ;
+BEGIN
+   Loc := CreateType ('LOC', 'MinLoc', 'MaxLoc', TRUE, GetISOLocType ()) ;
+   InitSystemTypes (BuiltinsLocation (), Loc) ;
+
+   Address := MakePointer (BuiltinTokenNo, MakeKey ('ADDRESS')) ;
+   PutPointer (Address, Loc) ;                (* Base Type       *)
+   MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType()) ;
+
+   Byte := CreateType ('BYTE', '', '', TRUE, GetISOByteType()) ;
+   Word := CreateType ('WORD', '', '', TRUE, GetISOWordType()) ;
+
+   (* CreateMinMaxFor(Loc, 'MinLoc', 'MaxLoc', GetISOLocType()) *)
+END InitISOTypes ;
+
+
+(*
+   MakeExtraSystemTypes - create any extra system types required
+                          for portability.
+*)
+
+PROCEDURE MakeExtraSystemTypes ;
+BEGIN
+   CSizeT  := CreateType ('CSIZE_T' , '', '', TRUE, GetCSizeTType ()) ;
+   CSSizeT := CreateType ('CSSIZE_T', '', '', TRUE, GetCSSizeTType ())
+END MakeExtraSystemTypes ;
+
+
+(*
+   InitSystem - creates the system dependant types and procedures.
+                Note that they are not exported here, but they are
+                exported in the textual module: SYSTEM.def.
+                We build our system types from those given in the gcc
+                backend. Essentially we perform double book keeping.
+*)
+
+PROCEDURE InitSystem ;
+VAR
+   Previous: CARDINAL ;
+BEGIN
+   Init ;
+
+   (* create SYSTEM module *)
+   System := MakeDefinitionSource(BuiltinTokenNo, MakeKey('SYSTEM')) ;
+   StartScope(System) ;
+   Previous := GetCurrentModule() ;
+   SetCurrentModule(System) ;
+
+   IF Iso
+   THEN
+      InitISOTypes ;
+      MakeSize ;
+      PutExportQualified(BuiltinTokenNo, MakeKey('SIZE'))
+   ELSE
+      InitPIMTypes ;
+      (* SIZE is declared in SYSTEM.def in PIM-2 but not PIM-[34] *)
+      IF Pedantic
+      THEN
+         IF Pim2
+         THEN
+            MakeSize ;
+            PutExportQualified(BuiltinTokenNo, MakeKey('SIZE'))
+         END
+      ELSE
+         MakeSize ;
+         PutExportQualified(BuiltinTokenNo, MakeKey('SIZE'))
+      END
+   END ;
+
+   (* And now the predefined pseudo functions *)
+
+   Adr := MakeProcedure(BuiltinTokenNo,
+                        MakeKey('ADR')) ;           (* Function        *)
+   PutFunction(Adr, Address) ;                      (* Return Type     *)
+                                                    (* Address         *)
+
+   TSize := MakeProcedure(BuiltinTokenNo,
+                          MakeKey('TSIZE')) ;       (* Function        *)
+   PutFunction(TSize, ZType) ;                      (* Return Type     *)
+                                                    (* ZType           *)
+
+   TBitSize := MakeProcedure(BuiltinTokenNo,
+                             MakeKey('TBITSIZE')) ; (* GNU extension   *)
+                                                    (* Function        *)
+   PutFunction(TBitSize, ZType) ;                   (* Return Type     *)
+                                                    (* ZType           *)
+   (* and the ISO specific predefined pseudo functions *)
+
+   AddAdr := MakeProcedure(BuiltinTokenNo,
+                           MakeKey('ADDADR')) ;     (* Function        *)
+   PutFunction(AddAdr, Address) ;                   (* Return Type     *)
+
+   SubAdr := MakeProcedure(BuiltinTokenNo,
+                           MakeKey('SUBADR')) ;     (* Function        *)
+   PutFunction(SubAdr, Address) ;                   (* Return Type     *)
+
+   DifAdr := MakeProcedure(BuiltinTokenNo,
+                           MakeKey('DIFADR')) ;     (* Function        *)
+   PutFunction(DifAdr, Address) ;                   (* Return Type     *)
+
+   MakeAdr := MakeProcedure(BuiltinTokenNo,
+                            MakeKey('MAKEADR')) ;   (* Function        *)
+   PutFunction(MakeAdr, Address) ;                  (* Return Type     *)
+
+   (* the return value for ROTATE, SHIFT and CAST is actually the
+      same as the first parameter, this is faked in M2Quads *)
+
+   Rotate := MakeProcedure(BuiltinTokenNo,
+                           MakeKey('ROTATE')) ;     (* Function        *)
+   Shift := MakeProcedure(BuiltinTokenNo,
+                          MakeKey('SHIFT')) ;       (* Function        *)
+   Cast := MakeProcedure(BuiltinTokenNo,
+                         MakeKey('CAST')) ;         (* Function        *)
+
+   Throw := MakeProcedure(BuiltinTokenNo,
+                          MakeKey('THROW')) ;       (* Procedure       *)
+
+   CreateMinMaxFor(Word, 'MinWord', 'MaxWord', GetWordType()) ;
+   CreateMinMaxFor(Address, 'MinAddress', 'MaxAddress', GetPointerType()) ;
+   CreateMinMaxFor(Byte, 'MinByte', 'MaxByte', GetByteType()) ;
+
+   MakeFixedSizedTypes ;
+   MakeExtraSystemTypes ;
+
+   EndScope ;
+   SetCurrentModule(Previous)
+END InitSystem ;
+
+
+(*
+   GetSystemTypeMinMax - returns the minimum and maximum values for a given system type.
+*)
+
+PROCEDURE GetSystemTypeMinMax (type: CARDINAL; VAR min, max: CARDINAL) ;
+BEGIN
+   IF IsItemInList(SystemTypes, type)
+   THEN
+      min := GetSymKey(MinValues, GetSymName(type)) ;
+      max := GetSymKey(MaxValues, GetSymName(type))
+   ELSE
+      InternalError ('system does not know about this type')
+   END
+END GetSystemTypeMinMax ;
+
+
+(*
+   IsISOPseudoSystemFunction -
+*)
+
+PROCEDURE IsISOPseudoSystemFunction (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN Iso AND ((sym=AddAdr) OR (sym=SubAdr) OR (sym=DifAdr) OR
+                   (sym=MakeAdr) OR (sym=Rotate) OR (sym=Shift) OR
+                   (sym=Cast))
+END IsISOPseudoSystemFunction ;
+
+
+(*
+   IsPIMPseudoSystemFunction - returns TRUE if sym is specifically a PIM
+                               system function.
+*)
+
+PROCEDURE IsPIMPseudoSystemFunction (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN (NOT Iso) AND ((sym=Size) OR (sym=Shift) OR (sym=Rotate))
+END IsPIMPseudoSystemFunction ;
+
+
+(*
+   IsPseudoSystemFunction - returns true if sym is a SYSTEM pseudo function.
+*)
+
+PROCEDURE IsPseudoSystemFunction (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (sym=Adr) OR (sym=TSize) OR (sym=TBitSize) OR
+           IsPIMPseudoSystemFunction(sym) OR
+           IsISOPseudoSystemFunction(sym) )
+END IsPseudoSystemFunction ;
+
+
+(*
+   IsPseudoSystemFunctionConstExpression - returns TRUE if this procedure
+                                           is legal in a constant expression.
+*)
+
+PROCEDURE IsPseudoSystemFunctionConstExpression (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym=Size) OR (sym=TSize) OR (sym=Rotate) OR (sym=Shift) OR
+          (Iso AND ((sym=Cast) OR (sym=MakeAdr)))
+         )
+END IsPseudoSystemFunctionConstExpression ;
+
+
+(*
+   IsPseudoSystemProcedure - returns true if sym is a SYSTEM pseudo procedure.
+*)
+
+PROCEDURE IsPseudoSystemProcedure (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( sym=Throw )
+END IsPseudoSystemProcedure ;
+
+
+(*
+   IsSystemType - returns TRUE if sym is a SYSTEM (inbuilt) type.
+                  It does not search your SYSTEM implementation module.
+*)
+
+PROCEDURE IsSystemType (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsItemInList(SystemTypes, sym) )
+END IsSystemType ;
+
+
+(*
+   GetSafeSystem -
+*)
+
+PROCEDURE GetSafeSystem (name: Name) : CARDINAL ;
+VAR
+   sym,
+   i, n: CARDINAL ;
+BEGIN
+   n := NoOfItemsInList(SystemTypes) ;
+   i := 1 ;
+   WHILE i<=n DO
+      sym := GetItemFromList(SystemTypes, i) ;
+      IF GetSymName(sym)=name
+      THEN
+         RETURN( sym )
+      END ;
+      INC(i)
+   END ;
+   RETURN( NulSym )
+END GetSafeSystem ;
+
+
+(*
+   IntegerN - returns the symbol associated with INTEGER[N].
+              NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE IntegerN (bitlength: CARDINAL) : CARDINAL ;
+BEGIN
+   CASE bitlength OF
+
+   8 :  RETURN( GetSafeSystem(MakeKey('INTEGER8')) ) |
+   16:  RETURN( GetSafeSystem(MakeKey('INTEGER16')) ) |
+   32:  RETURN( GetSafeSystem(MakeKey('INTEGER32')) ) |
+   64:  RETURN( GetSafeSystem(MakeKey('INTEGER64')) )
+
+   ELSE
+      InternalError ('system does not know about this type')
+   END
+END IntegerN ;
+
+
+(*
+   CardinalN - returns the symbol associated with CARDINAL[N].
+               NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE CardinalN (bitlength: CARDINAL) : CARDINAL ;
+BEGIN
+   CASE bitlength OF
+
+   8 :  RETURN( GetSafeSystem(MakeKey('CARDINAL8')) ) |
+   16:  RETURN( GetSafeSystem(MakeKey('CARDINAL16')) ) |
+   32:  RETURN( GetSafeSystem(MakeKey('CARDINAL32')) ) |
+   64:  RETURN( GetSafeSystem(MakeKey('CARDINAL64')) )
+
+   ELSE
+      InternalError ('system does not know about this type')
+   END
+END CardinalN ;
+
+
+(*
+   WordN - returns the symbol associated with WORD[N].
+           NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE WordN (bitlength: CARDINAL) : CARDINAL ;
+BEGIN
+   CASE bitlength OF
+
+   16:  RETURN( GetSafeSystem(MakeKey('WORD16')) ) |
+   32:  RETURN( GetSafeSystem(MakeKey('WORD32')) ) |
+   64:  RETURN( GetSafeSystem(MakeKey('WORD64')) )
+
+   ELSE
+      InternalError ('system does not know about this type')
+   END
+END WordN ;
+
+
+(*
+   SetN - returns the symbol associated with SET[N].
+          NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE SetN (bitlength: CARDINAL) : CARDINAL ;
+BEGIN
+   CASE bitlength OF
+
+   8 :  RETURN( GetSafeSystem(MakeKey('BITSET8')) ) |
+   16:  RETURN( GetSafeSystem(MakeKey('BITSET16')) ) |
+   32:  RETURN( GetSafeSystem(MakeKey('BITSET32')) )
+
+   ELSE
+      InternalError ('system does not know about this type')
+   END
+END SetN ;
+
+
+(*
+   RealN - returns the symbol associated with REAL[N].
+           NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE RealN (bitlength: CARDINAL) : CARDINAL ;
+BEGIN
+   CASE bitlength OF
+
+   32 :  RETURN( GetSafeSystem(MakeKey('REAL32')) ) |
+   64 :  RETURN( GetSafeSystem(MakeKey('REAL64')) ) |
+   96 :  RETURN( GetSafeSystem(MakeKey('REAL96')) ) |
+   128:  RETURN( GetSafeSystem(MakeKey('REAL128')) )
+
+   ELSE
+      InternalError ('system does not know about this type')
+   END
+END RealN ;
+
+
+(*
+   ComplexN - returns the symbol associated with COMPLEX[N].
+              NulSym is returned if the type does not exist.
+*)
+
+PROCEDURE ComplexN (bitlength: CARDINAL) : CARDINAL ;
+BEGIN
+   CASE bitlength OF
+
+   32 :  RETURN( GetSafeSystem(MakeKey('COMPLEX32')) ) |
+   64 :  RETURN( GetSafeSystem(MakeKey('COMPLEX64')) ) |
+   96 :  RETURN( GetSafeSystem(MakeKey('COMPLEX96')) ) |
+   128:  RETURN( GetSafeSystem(MakeKey('COMPLEX128')) )
+
+   ELSE
+      InternalError ('system does not know about this type')
+   END
+END ComplexN ;
+
+
+(*
+   IsIntegerN - returns the TRUE if, sym, is one of the SYSTEM
+                INTEGER types (not the base INTEGER type).
+*)
+
+PROCEDURE IsIntegerN (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym#NulSym) AND
+          ((sym=IntegerN(8)) OR (sym=IntegerN(16)) OR
+           (sym=IntegerN(32)) OR (sym=IntegerN(64)))
+         )
+END IsIntegerN ;
+
+
+(*
+   IsCardinalN - returns the TRUE if, sym, is one of the SYSTEM
+                 CARDINAL types (not the base CARDINAL type).
+*)
+
+PROCEDURE IsCardinalN (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym#NulSym) AND
+          ((sym=CardinalN(8)) OR (sym=CardinalN(16)) OR
+           (sym=CardinalN(32)) OR (sym=CardinalN(64)))
+         )
+END IsCardinalN ;
+
+
+(*
+   IsWordN - returns the TRUE if, sym, is one of the SYSTEM
+             WORD[n] types (not the default SYSTEM WORD type).
+*)
+
+PROCEDURE IsWordN (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym#NulSym) AND
+          ((sym=WordN(16)) OR
+           (sym=WordN(32)) OR (sym=WordN(64)))
+         )
+END IsWordN ;
+
+
+(*
+   IsSetN - returns the TRUE if, sym, is one of the SYSTEM
+            SET[n] types (not the default SYSTEM BITSET type).
+*)
+
+PROCEDURE IsSetN (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym#NulSym) AND
+          ((sym=SetN(8)) OR (sym=SetN(16)) OR (sym=SetN(32)))
+         )
+END IsSetN ;
+
+
+(*
+   IsRealN - returns the TRUE if, sym, is one of the SYSTEM
+             REAL[n] types (not the default base REAL type).
+*)
+
+PROCEDURE IsRealN (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym#NulSym) AND
+          ((sym=RealN(32)) OR (sym=RealN(64)) OR
+           (sym=RealN(96)) OR (sym=RealN(128)))
+         )
+END IsRealN ;
+
+
+(*
+   IsComplexN - returns the TRUE if, sym, is one of the SYSTEM
+                COMPLEX[n] types (not the default base COMPLEX,
+                LONGCOMPLEX or SHORTCOMPLEX types).
+*)
+
+PROCEDURE IsComplexN (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym#NulSym) AND
+          ((sym=ComplexN(32)) OR (sym=ComplexN(64)) OR
+           (sym=ComplexN(96)) OR (sym=ComplexN(128)))
+         )
+END IsComplexN ;
+
+
+(*
+   IsGenericSystemType - returns TRUE if, sym, is of type
+                         BYTE, WORD or any other length.
+*)
+
+PROCEDURE IsGenericSystemType (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+          (sym#NulSym) AND
+          (IsWordN(sym) OR (sym=Word) OR (sym=Byte) OR (sym=Loc))
+         )
+END IsGenericSystemType ;
+
+
+(*
+   IsSameSize - return TRUE if SIZE(a)=SIZE(b)
+*)
+
+PROCEDURE IsSameSize (a, b: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( AreConstantsEqual(BuildSize(BuiltinsLocation(), Mod2Gcc(a), FALSE),
+                             BuildSize(BuiltinsLocation(), Mod2Gcc(b), FALSE)) )
+END IsSameSize ;
+
+
+(*
+   IsSameType - returns TRUE if, t, is the same type as a or b
+                and a or b are a type, p.
+*)
+
+PROCEDURE IsSameType (t: CARDINAL; p: IsP; a, b: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF t=a
+   THEN
+      RETURN( p(b) AND IsSameSize(a, b) )
+   ELSIF t=b
+   THEN
+      RETURN( p(a) AND IsSameSize(a, b) )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsSameType ;
+
+
+(*
+   IsSameSizePervasiveType - returns TRUE if a or b are CARDINAL, INTEGER, REAL,
+                             LONGREAL, SHORTREAL and the other type is the same
+                             size and of the same type.
+*)
+
+PROCEDURE IsSameSizePervasiveType (a, b: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsSameType(Integer, IsIntegerN, a, b) OR
+           IsSameType(Cardinal, IsCardinalN, a, b) OR
+           IsSameType(Word, IsWordN, a, b) OR
+           IsSameType(Real, IsRealN, a, b) OR
+           IsSameType(Complex, IsComplexN, a, b) OR
+           IsSameType(LongInt, IsIntegerN, a, b) OR
+           IsSameType(LongCard, IsCardinalN, a, b) OR
+           IsSameType(LongComplex, IsComplexN, a, b) OR
+           IsSameType(LongReal, IsRealN, a, b) OR
+           IsSameType(ShortInt, IsIntegerN, a, b) OR
+           IsSameType(ShortCard, IsCardinalN, a, b) OR
+           IsSameType(ShortComplex, IsComplexN, a, b) OR
+           IsSameType(ShortReal, IsRealN, a, b) )
+END IsSameSizePervasiveType ;
+
+
+END M2System.
diff --git a/gcc/m2/gm2-compiler/M2Version.def b/gcc/m2/gm2-compiler/M2Version.def
new file mode 100644
index 00000000000..dcef2641545
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Version.def
@@ -0,0 +1,70 @@
+(* M2Version.def provides simple procedures which retrieve.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE M2Version ;
+
+(*
+    Title      : M2Version
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Thu May 12 13:22:16 1994
+    Description: provides simple procedures which retrieve 
+                 version strings for gm2 and gcc.
+                 The implementation module is generated by the
+                 makeversion script.
+*)
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED GetGM2Version, GetGM2Date, GetGCCVersion, GetYear ;
+
+
+(*
+   GetGM2Version - returns a string containing the numeric version.
+                   For example '0.68'
+*)
+
+PROCEDURE GetGM2Version () : String ;
+
+
+(*
+   GetGM2Date - returns the date in the numerical form YYYYMMDD.
+                This is the date of the build.
+*)
+
+PROCEDURE GetGM2Date () : String ;
+
+
+(*
+   GetGCCVersion - return the numeric version of gcc.
+                   For example '4.1.2'.
+*)
+
+PROCEDURE GetGCCVersion () : String ;
+
+
+(*
+   GetYear - returns the year of the build.
+*)
+
+PROCEDURE GetYear () : String ;
+
+
+END M2Version.
diff --git a/gcc/m2/gm2-compiler/NameKey.def b/gcc/m2/gm2-compiler/NameKey.def
new file mode 100644
index 00000000000..2838df86649
--- /dev/null
+++ b/gcc/m2/gm2-compiler/NameKey.def
@@ -0,0 +1,122 @@
+(* NameKey.def provides a dynamic binary tree name to key.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE NameKey ;
+
+(*
+    Title      : NameKey.def
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Mon Apr 23 17:20:48 2001
+    Last edit  : Mon Apr 23 17:20:48 2001
+    Description: NameKey provides a totally dynamic binary tree name to key
+                 interface for the Modula-2 compiler.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED Name, NulName,
+                 MakeKey, GetKey, LengthKey, IsKey, WriteKey,
+                 IsSameExcludingCase, KeyToCharStar, makekey,
+                 CharKey ;
+
+
+CONST
+   NulName = 0 ;  (* No legal name.                      *)
+                  (* NulName is not present in the Tree  *)
+
+TYPE
+   Name = CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE MakeKey (a: ARRAY OF CHAR) : Name ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE makekey (a: ADDRESS) : Name ;
+
+
+(*
+   GetKey - returns the name, a, of the key, key.
+*)
+
+PROCEDURE GetKey (key: Name; VAR a: ARRAY OF CHAR) ;
+
+
+(*
+   LengthKey - returns the StrLen of a Key.
+*)
+
+PROCEDURE LengthKey (Key: Name) : CARDINAL ;
+
+
+(*
+   IsKey - returns TRUE if string, a, is currently a key.
+*)
+
+PROCEDURE IsKey (a: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   WriteKey - Display the symbol represented by Key.
+*)
+
+PROCEDURE WriteKey (key: Name) ;
+
+
+(*
+   IsSameExcludingCase - returns TRUE if key1 and key2 are
+                         the same. It is case insensitive.
+*)
+
+PROCEDURE IsSameExcludingCase (key1, key2: Name) : BOOLEAN ;
+
+
+(*
+   KeyToCharStar - returns the C char * string equivalent for, key.
+*)
+
+PROCEDURE KeyToCharStar (key: Name) : ADDRESS ;
+
+
+(*
+   CharKey - returns the key[i] character.
+*)
+
+PROCEDURE CharKey (key: Name; i: CARDINAL) : CHAR ;
+
+
+END NameKey.
diff --git a/gcc/m2/gm2-compiler/NameKey.mod b/gcc/m2/gm2-compiler/NameKey.mod
new file mode 100644
index 00000000000..bcb45718d69
--- /dev/null
+++ b/gcc/m2/gm2-compiler/NameKey.mod
@@ -0,0 +1,417 @@
+(* NameKey.mod provides a dynamic binary tree name to key.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE NameKey ;
+
+
+FROM SYSTEM IMPORT ADR ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, InBounds ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StdIO IMPORT Write ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrLib IMPORT StrLen ;
+FROM libc IMPORT strlen ;
+FROM ASCII IMPORT nul ;
+
+
+TYPE
+   PtrToChar  = POINTER TO CHAR ;
+
+   NameNode   = POINTER TO Node ;
+   Node       = RECORD
+                   Data : PtrToChar ;
+                   Key  : Name ;
+                   Left,
+                   Right: NameNode ;
+                END ;
+
+   Comparison = (less, equal, greater) ;
+
+VAR
+   BinaryTree: NameNode ;
+   KeyIndex  : Index ;
+   LastIndice: CARDINAL ;
+
+
+(*
+   GetKey - returns the name, a, of the key, Key.
+*)
+
+PROCEDURE GetKey (key: Name; VAR a: ARRAY OF CHAR) ;
+VAR
+   p       : PtrToChar ;
+   i, higha: CARDINAL ;
+BEGIN
+   p := KeyToCharStar(key) ;
+   i := 0 ;
+   higha := HIGH(a) ;
+   WHILE (p#NIL) AND (i<=higha) AND (p^#nul) DO
+      a[i] := p^ ;
+      INC(p) ;
+      INC(i)
+   END ;
+   IF i<=higha
+   THEN
+      a[i] := nul
+   END
+END GetKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE IsKey (a: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   child : NameNode ;
+   p     : PtrToChar ;
+   i,
+   higha : CARDINAL ;
+BEGIN
+   (* firstly set up the initial values of child, using sentinal node *)
+   child := BinaryTree^.Left ;
+   IF child#NIL
+   THEN
+      REPEAT
+         i := 0 ;
+         higha := HIGH(a) ;
+         p := KeyToCharStar(child^.Key) ;
+         WHILE (i<=higha) AND (a[i]#nul) DO
+            IF a[i]<p^
+            THEN
+               child := child^.Left ;
+               i := higha
+            ELSIF a[i]>p^
+            THEN
+               child := child^.Right ;
+               i := higha
+            ELSE
+               IF (a[i]=nul) OR (i=higha)
+               THEN
+                  IF p^=nul
+                  THEN
+                     RETURN( TRUE )
+                  ELSE
+                     child := child^.Left
+                  END
+               END ;
+               INC(p)
+            END ;
+            INC(i)
+         END ;
+      UNTIL child=NIL
+   END ;
+   RETURN( FALSE ) ;
+END IsKey ;
+
+
+(*
+   DoMakeKey - finds the name, n, in the tree or else create a name.
+               If a name is found then the string, n, is deallocated.
+*)
+
+PROCEDURE DoMakeKey (n: PtrToChar; higha: CARDINAL) : Name ;
+VAR
+   result: Comparison ;
+   father,
+   child : NameNode ;
+   k     : Name ;
+BEGIN
+   result := FindNodeAndParentInTree(n, child, father) ;
+   IF child=NIL
+   THEN
+      IF result=less
+      THEN
+         NEW(child) ;
+         father^.Left := child
+      ELSIF result=greater
+      THEN
+         NEW(child) ;
+         father^.Right := child
+      END ;
+      WITH child^ DO
+         Right := NIL ;
+         Left := NIL ;
+         INC(LastIndice) ;
+         Key := LastIndice ;
+         Data := n ;
+         PutIndice(KeyIndex, Key, n)
+      END ;
+      k := LastIndice
+   ELSE
+      DEALLOCATE(n, higha+1) ;
+      k := child^.Key
+   END ;
+   RETURN( k )
+END DoMakeKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE MakeKey (a: ARRAY OF CHAR) : Name ;
+VAR
+   n, p  : PtrToChar ;
+   i,
+   higha : CARDINAL ;
+BEGIN
+   higha := StrLen(a) ;
+   ALLOCATE(p, higha+1) ;
+   IF p=NIL
+   THEN
+      HALT      (* out of memory error *)
+   ELSE
+      n := p ;
+      i := 0 ;
+      WHILE i<higha DO
+         p^ := a[i] ;
+         INC(i) ;
+         INC(p)
+      END ;
+      p^ := nul ;
+
+      RETURN( DoMakeKey(n, higha) )
+   END
+END MakeKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE makekey (a: ADDRESS) : Name ;
+VAR
+   n,
+   p, pa : PtrToChar ;
+   i,
+   higha : CARDINAL ;
+BEGIN
+   IF a=NIL
+   THEN
+      RETURN( NulName )
+   ELSE
+      higha := strlen(a) ;
+      ALLOCATE(p, higha+1) ;
+      IF p=NIL
+      THEN
+         HALT      (* out of memory error *)
+      ELSE
+         n  := p ;
+         pa := a ;
+         i  := 0 ;
+         WHILE i<higha DO
+            p^ := pa^ ;
+            INC(i) ;
+            INC(p) ;
+            INC(pa)
+         END ;
+         p^ := nul ;
+
+         RETURN( DoMakeKey(n, higha) )
+      END
+   END
+END makekey ;
+
+
+(*
+   LengthKey - returns the StrLen of Key.
+*)
+
+PROCEDURE LengthKey (Key: Name) : CARDINAL ;
+VAR
+   i: CARDINAL ;
+   p: PtrToChar ;
+BEGIN
+   p := KeyToCharStar(Key) ;
+   i := 0 ;
+   WHILE p^#nul DO
+      INC(i) ;
+      INC(p)
+   END ;
+   RETURN( i )
+END LengthKey ;
+
+
+(*
+   Compare - return the result of Names[i] with Names[j]
+*)
+
+PROCEDURE Compare (pi: PtrToChar; j: Name) : Comparison ;
+VAR
+   pj: PtrToChar ;
+   c1, c2: CHAR ;
+BEGIN
+   pj := KeyToCharStar(j) ;
+   c1 := pi^ ;
+   c2 := pj^ ;
+   WHILE (c1#nul) OR (c2#nul) DO
+      IF c1<c2
+      THEN
+         RETURN( less )
+      ELSIF c1>c2
+      THEN
+         RETURN( greater )
+      ELSE
+         INC(pi) ;
+         INC(pj) ;
+         c1 := pi^ ;
+         c2 := pj^
+      END
+   END ;
+   RETURN( equal )
+END Compare ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindNodeAndParentInTree (n: PtrToChar; VAR child, father: NameNode) : Comparison ;
+VAR
+   result: Comparison ;
+BEGIN
+   (* firstly set up the initial values of child and father, using sentinal node *)
+   father := BinaryTree ;
+   child := BinaryTree^.Left ;
+   IF child=NIL
+   THEN
+      RETURN( less )
+   ELSE
+      REPEAT
+         result := Compare(n, child^.Key) ;
+         IF result=less
+         THEN
+            father := child ;
+            child := child^.Left
+         ELSIF result=greater
+         THEN
+            father := child ;
+            child := child^.Right
+         END
+      UNTIL (child=NIL) OR (result=equal) ;
+      RETURN( result )
+   END
+END FindNodeAndParentInTree ;
+
+
+(*
+   IsSameExcludingCase - returns TRUE if key1 and key2 are
+                         the same. It is case insensitive.
+                         This function deliberately inlines CAP for speed.
+*)
+
+PROCEDURE IsSameExcludingCase (key1, key2: Name) : BOOLEAN ;
+VAR
+   pi, pj: PtrToChar ;
+   c1, c2: CHAR ;
+BEGIN
+   IF key1=key2
+   THEN
+      RETURN( TRUE )
+   ELSE
+      pi := KeyToCharStar(key1) ;
+      pj := KeyToCharStar(key2) ;
+      c1 := pi^ ;
+      c2 := pj^ ;
+      WHILE (c1#nul) AND (c2#nul) DO
+         IF (c1=c2) OR
+            (((c1>='A') AND (c1<='Z')) AND (c2=CHR(ORD(c1)-ORD('A')+ORD('a')))) OR
+            (((c2>='A') AND (c2<='Z')) AND (c1=CHR(ORD(c2)-ORD('A')+ORD('a'))))
+         THEN
+            INC(pi) ;
+            INC(pj) ;
+            c1 := pi^ ;
+            c2 := pj^
+         ELSE
+            (* difference found *)
+            RETURN( FALSE )
+         END
+      END ;
+      RETURN( c1=c2 )
+   END
+END IsSameExcludingCase ;
+
+
+(*
+   KeyToCharStar - returns the C char * string equivalent for, key.
+*)
+
+PROCEDURE KeyToCharStar (key: Name) : ADDRESS ;
+BEGIN
+   IF (key=NulName) OR (NOT InBounds(KeyIndex, key))
+   THEN
+      RETURN( NIL )
+   ELSE
+      RETURN( GetIndice(KeyIndex, key) )
+   END
+END KeyToCharStar ;
+
+
+PROCEDURE WriteKey (key: Name) ;
+VAR
+   s: PtrToChar ;
+BEGIN
+   s := KeyToCharStar(key) ;
+   WHILE (s#NIL) AND (s^#nul) DO
+      Write(s^) ;
+      INC(s)
+   END
+END WriteKey ;
+
+
+(*
+   CharKey - returns the key[i] character.
+*)
+
+PROCEDURE CharKey (key: Name; i: CARDINAL) : CHAR ;
+VAR
+   p: PtrToChar ;
+BEGIN
+   IF i >= LengthKey (key)
+   THEN
+      HALT
+   END ;
+   p := KeyToCharStar (key) ;
+   INC (p, i) ;
+   RETURN p^
+END CharKey ;
+
+
+BEGIN
+   LastIndice := 0 ;
+   KeyIndex := InitIndex(1) ;
+   NEW(BinaryTree) ;
+   BinaryTree^.Left := NIL
+END NameKey.
diff --git a/gcc/m2/gm2-compiler/ObjectFiles.def b/gcc/m2/gm2-compiler/ObjectFiles.def
new file mode 100644
index 00000000000..1a1c99a77f0
--- /dev/null
+++ b/gcc/m2/gm2-compiler/ObjectFiles.def
@@ -0,0 +1,71 @@
+(* ObjectFiles.def determines whether object files exist.
+
+Copyright (C) 2018-2022 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/>.  *)
+
+DEFINITION MODULE ObjectFiles ;
+
+(*
+    Title      : ObjectFiles
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon Jul  9 14:09:20 2018
+    Revision   : $Version$
+    Description: provides a module to determine whether object files
+                 are already known.  An object file will be known by
+                 its name and ultimately its inode.
+*)
+
+FROM DynamicStrings IMPORT String ;
+
+TYPE
+   FileObjects ;
+
+
+(*
+   RegisterModuleObject - returns TRUE if location has not already been registered.
+*)
+
+PROCEDURE RegisterModuleObject (fo: FileObjects; location: String) : BOOLEAN ;
+
+
+(*
+   IsRegistered - returns TRUE if the object at, location, is already registered.
+                  It uses the physical location on the filesystem to determine the
+                  uniqueness of the object file.
+*)
+
+PROCEDURE IsRegistered (fo: FileObjects; location: String) : BOOLEAN ;
+
+
+(*
+   InitFileObject - returns a new file object container.
+*)
+
+PROCEDURE InitFileObject () : FileObjects ;
+
+
+(*
+   KillFileObject - destroys a file object container.
+*)
+
+PROCEDURE KillFileObject (fo: FileObjects) : FileObjects ;
+
+
+END ObjectFiles.
diff --git a/gcc/m2/gm2-compiler/ObjectFiles.mod b/gcc/m2/gm2-compiler/ObjectFiles.mod
new file mode 100644
index 00000000000..87637062fdd
--- /dev/null
+++ b/gcc/m2/gm2-compiler/ObjectFiles.mod
@@ -0,0 +1,171 @@
+(* ObjectFiles.mod determines whether object files exist.
+
+Copyright (C) 2018-2022 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/>.  *)
+
+IMPLEMENTATION MODULE ObjectFiles ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM DynamicStrings IMPORT Dup, Mark, string ;
+FROM Indexing IMPORT Index, InitIndex, KillIndex, GetIndice, PutIndice,
+                     HighIndice, LowIndice, InBounds, IsIndiceInIndex,
+                     RemoveIndiceFromIndex, IncludeIndiceIntoIndex,
+                     ForeachIndiceInIndexDo ;
+
+FROM wrapc IMPORT fileinode ;
+FROM libc IMPORT open, close ;
+FROM M2Printf IMPORT fprintf1, fprintf0 ;
+FROM FIO IMPORT StdErr ;
+FROM Assertion IMPORT Assert ;
+
+
+CONST
+   UNIXREADONLY = 0 ;
+   Debugging    = FALSE ;
+
+TYPE
+   FileObject = POINTER TO RECORD
+                              name : String ;
+                              inodeLow, inodeHigh: CARDINAL ;
+                           END ;
+
+   FileObjects = POINTER TO RECORD
+                               objects: Index ;
+                            END ;
+
+
+(*
+   RegisterModuleObject - returns TRUE if location has not already been registered.
+*)
+
+PROCEDURE RegisterModuleObject (fo: FileObjects; location: String) : BOOLEAN ;
+VAR
+   p: FileObject ;
+   f: INTEGER ;
+BEGIN
+   IF Debugging
+   THEN
+      fprintf1 (StdErr, "first time file %s has been registered... ", location)
+   END ;
+   IF NOT IsRegistered (fo, location)
+   THEN
+      NEW (p) ;
+      p^.name := Dup (location) ;
+      f := open (string (location), UNIXREADONLY, 0) ;
+      IF fileinode (f, p^.inodeLow, p^.inodeHigh) = 0
+      THEN
+         close (f) ;
+         IncludeIndiceIntoIndex (fo^.objects, p) ;
+         IF Debugging
+         THEN
+            fprintf0 (StdErr, " yes\n")
+         END ;
+         RETURN TRUE
+      ELSE
+         IF Debugging
+         THEN
+            fprintf0 (StdErr, " fileinode failed\n")
+         END
+      END ;
+      close (f) ;
+      DISPOSE (p)
+   END ;
+   IF Debugging
+   THEN
+      fprintf0 (StdErr, " no\n")
+   END ;
+   RETURN FALSE
+END RegisterModuleObject ;
+
+
+(*
+   isRegistered -
+*)
+
+PROCEDURE isRegistered (fo: FileObjects; f: INTEGER) : BOOLEAN ;
+VAR
+   i, h,
+   low, high: CARDINAL ;
+   o        : FileObject ;
+BEGIN
+   IF fileinode (f, low, high) = 0
+   THEN
+      h := HighIndice (fo^.objects) ;
+      i := 1 ;
+      WHILE i <= h DO
+         o := GetIndice (fo^.objects, i) ;
+         IF o # NIL
+         THEN
+            IF (o^.inodeLow = low) AND (o^.inodeHigh = high)
+            THEN
+               RETURN TRUE
+            END
+         END ;
+         INC (i)
+      END
+   END ;
+   RETURN FALSE
+END isRegistered ;
+
+
+(*
+   IsRegistered - returns TRUE if the object at, location, is already registered.
+                  It uses the physical location on the filesystem to determine the
+                  uniqueness of the object file.
+*)
+
+PROCEDURE IsRegistered (fo: FileObjects; location: String) : BOOLEAN ;
+VAR
+   f     : INTEGER ;
+   result: BOOLEAN ;
+BEGIN
+   f := open (string (location), UNIXREADONLY, 0) ;
+   result := isRegistered (fo, f) ;
+   close (f) ;
+   RETURN result
+END IsRegistered ;
+
+
+(*
+   InitFileObject - returns a new file object container.
+*)
+
+PROCEDURE InitFileObject () : FileObjects ;
+VAR
+   fo: FileObjects ;
+BEGIN
+   NEW (fo) ;
+   fo^.objects := InitIndex (1) ;
+   RETURN fo
+END InitFileObject ;
+
+
+(*
+   KillFileObject - destroys a file object container.
+*)
+
+PROCEDURE KillFileObject (fo: FileObjects) : FileObjects ;
+BEGIN
+   fo^.objects := KillIndex (fo^.objects) ;
+   DISPOSE (fo) ;
+   RETURN NIL
+END KillFileObject ;
+
+
+END ObjectFiles.
diff --git a/gcc/m2/gm2-compiler/Output.def b/gcc/m2/gm2-compiler/Output.def
new file mode 100644
index 00000000000..7094517cef8
--- /dev/null
+++ b/gcc/m2/gm2-compiler/Output.def
@@ -0,0 +1,116 @@
+(* Output.def redirect output.
+
+Copyright (C) 2021-2022 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/>.  *)
+
+DEFINITION MODULE Output ;
+
+(*
+    Title      : Output
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Jul  9 12:17:35 2021
+    Revision   : $Version$
+    Description: provides an interface to output redirection for common
+                 output procedures.
+*)
+
+FROM NameKey IMPORT Name ;
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   Open - attempt to open filename as the output file.
+          TRUE is returned if success, FALSE otherwise.
+*)
+
+PROCEDURE Open (filename: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   Close - close the output file.
+*)
+
+PROCEDURE Close ;
+
+
+(*
+   Write - write a single character to the output file.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+
+
+(*
+   WriteString - write an unformatted string to the output.
+*)
+
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+
+
+(*
+   KillWriteS - write a string to the output and free the string afterwards.
+*)
+
+PROCEDURE KillWriteS (s: String) ;
+
+
+(*
+   WriteS - write a string to the output.  The string is not freed.
+*)
+
+PROCEDURE WriteS (s: String) ;
+
+
+(*
+   WriteKey - write a key to the output.
+*)
+
+PROCEDURE WriteKey (key: Name) ;
+
+
+(*
+   WriteLn - write a newline to the output.
+*)
+
+PROCEDURE WriteLn ;
+
+
+(*
+   WriteCard - write a cardinal using fieldlength characters.
+*)
+
+PROCEDURE WriteCard (card, fieldlength: CARDINAL) ;
+
+
+(*
+   StartBuffer - create a buffer into which any output is redirected.
+*)
+
+PROCEDURE StartBuffer ;
+
+
+(*
+   EndBuffer - end the redirection and return the contents of the buffer.
+*)
+
+PROCEDURE EndBuffer () : String ;
+
+
+END Output.
diff --git a/gcc/m2/gm2-compiler/Output.mod b/gcc/m2/gm2-compiler/Output.mod
new file mode 100644
index 00000000000..2bd8699d82f
--- /dev/null
+++ b/gcc/m2/gm2-compiler/Output.mod
@@ -0,0 +1,200 @@
+(* Output.mod redirect output.
+
+Copyright (C) 2021-2022 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/>.  *)
+
+IMPLEMENTATION MODULE Output ;
+
+
+IMPORT FIO, SFIO ;
+FROM StrLib IMPORT StrEqual ;
+FROM NameKey IMPORT KeyToCharStar, Name ;
+FROM NumberIO IMPORT CardToStr ;
+FROM ASCII IMPORT nl ;
+
+FROM DynamicStrings IMPORT KillString, InitStringCharStar, ConCatChar,
+                           ConCat, InitString, Mark ;
+
+
+VAR
+   stdout: BOOLEAN ;
+   outputFile: FIO.File ;
+   buffer    : String ;
+
+
+(*
+   Open - attempt to open filename as the output file.
+          TRUE is returned if success, FALSE otherwise.
+*)
+
+PROCEDURE Open (filename: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   IF StrEqual (filename, "<stdout>") OR StrEqual (filename, "-")
+   THEN
+      outputFile := FIO.StdOut ;
+      stdout := TRUE ;
+      RETURN TRUE
+   ELSE
+      outputFile := FIO.OpenToWrite (filename) ;
+      stdout := FALSE ;
+      RETURN FIO.IsNoError (outputFile)
+   END
+END Open ;
+
+
+(*
+   Close - close the output file.
+*)
+
+PROCEDURE Close ;
+BEGIN
+   FIO.Close (outputFile)
+END Close ;
+
+
+(*
+   Write - write a single character to the output file.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+BEGIN
+   IF buffer = NIL
+   THEN
+      FIO.WriteChar (outputFile, ch)
+   ELSE
+      buffer := ConCatChar (buffer, ch)
+   END
+END Write ;
+
+
+(*
+   WriteString - write an unformatted string to the output.
+*)
+
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+BEGIN
+   IF buffer = NIL
+   THEN
+      FIO.WriteString (outputFile, s)
+   ELSE
+      buffer := ConCat (buffer, Mark (InitString (s)))
+   END
+END WriteString ;
+
+
+(*
+   KillWriteS - write a string to the output and free the string afterwards.
+*)
+
+PROCEDURE KillWriteS (s: String) ;
+BEGIN
+   IF KillString (SFIO.WriteS (outputFile, s)) = NIL
+   THEN
+   END
+END KillWriteS ;
+
+
+(*
+   WriteS - write a string to the output.  The string is not freed.
+*)
+
+PROCEDURE WriteS (s: String) ;
+BEGIN
+   IF SFIO.WriteS (outputFile, s) = s
+   THEN
+   END
+END WriteS ;
+
+
+(*
+   WriteKey - write a key to the output.
+*)
+
+PROCEDURE WriteKey (key: Name) ;
+BEGIN
+   IF buffer = NIL
+   THEN
+      KillWriteS (InitStringCharStar (KeyToCharStar (key)))
+   ELSE
+      buffer := ConCat (buffer, Mark (InitStringCharStar (KeyToCharStar (key))))
+   END
+END WriteKey ;
+
+
+(*
+   WriteLn - write a newline to the output.
+*)
+
+PROCEDURE WriteLn ;
+BEGIN
+   IF buffer = NIL
+   THEN
+      FIO.WriteLine (outputFile)
+   ELSE
+      Write (nl)
+   END
+END WriteLn ;
+
+
+(*
+   WriteCard - write a cardinal using fieldlength characters.
+*)
+
+PROCEDURE WriteCard (card, fieldlength: CARDINAL) ;
+VAR
+   s: ARRAY [0..20] OF CHAR ;
+BEGIN
+   CardToStr (card, fieldlength, s) ;
+   WriteString (s)
+END WriteCard ;
+
+
+(*
+   StartBuffer - create a buffer into which any output is redirected.
+*)
+
+PROCEDURE StartBuffer ;
+BEGIN
+   IF buffer # NIL
+   THEN
+      buffer := KillString (buffer)
+   END ;
+   buffer := InitString ('')
+END StartBuffer ;
+
+
+(*
+   EndBuffer - end the redirection and return the contents of the buffer.
+*)
+
+PROCEDURE EndBuffer () : String ;
+VAR
+   s: String ;
+BEGIN
+   s := buffer ;
+   buffer := NIL ;
+   RETURN s
+END EndBuffer ;
+
+
+BEGIN
+   stdout := TRUE ;
+   buffer := NIL ;
+   outputFile := FIO.StdOut ;
+END Output.
diff --git a/gcc/m2/gm2-compiler/P0SymBuild.def b/gcc/m2/gm2-compiler/P0SymBuild.def
new file mode 100644
index 00000000000..c7cfb4800b3
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P0SymBuild.def
@@ -0,0 +1,134 @@
+(* P0SymBuild.def pass 0 symbol creation.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE P0SymBuild ;
+
+(*
+    Title      : P0SymBuild
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Sat Sep  6 11:48:06 2014
+    Revision   : $Version$
+    Description: provides an interface to the construction of symbols during pass 0.
+*)
+
+FROM NameKey IMPORT Name ;
+
+
+(*
+   EndModule - shutdown the module and create definition symbols for all imported
+               modules.
+*)
+
+PROCEDURE EndModule ;
+
+
+(*
+   RegisterImports - remember all imported modules.
+*)
+
+PROCEDURE RegisterImports ;
+
+
+(*
+   RegisterProgramModule - register the top of stack as a program module.
+                           It starts a new module scope.
+*)
+
+PROCEDURE RegisterProgramModule ;
+
+
+(*
+   RegisterImplementationModule - register the top of stack as an implementation module.
+                                  It starts a new module scope.
+*)
+
+PROCEDURE RegisterImplementationModule ;
+
+
+(*
+   RegisterDefinitionModule - register the top of stack as a definition module.
+                              It starts a new module scope.
+*)
+
+PROCEDURE RegisterDefinitionModule (forC: BOOLEAN) ;
+
+
+(*
+   RegisterInnerModule - register the top of stack as an inner module, this module name
+                         will be removed from the list of outstanding imports in the
+                         current module block.
+                         It starts a new module scope.
+*)
+
+PROCEDURE RegisterInnerModule ;
+
+
+(*
+   RegisterInnerImports -
+*)
+
+PROCEDURE RegisterInnerImports ;
+
+
+(*
+   RegisterProcedure - register the top of stack as a procedure.
+*)
+
+PROCEDURE RegisterProcedure ;
+
+
+(*
+   EndBuildProcedure - ends building a Procedure.
+*)
+
+PROCEDURE EndProcedure ;
+
+
+(*
+   P0Init -
+*)
+
+PROCEDURE P0Init ;
+
+
+(*
+   P1Init -
+*)
+
+PROCEDURE P1Init ;
+
+
+(*
+   EnterBlock -
+*)
+
+PROCEDURE EnterBlock (n: Name) ;
+
+
+(*
+   LeaveBlock -
+*)
+
+PROCEDURE LeaveBlock ;
+
+
+END P0SymBuild.
diff --git a/gcc/m2/gm2-compiler/P0SymBuild.mod b/gcc/m2/gm2-compiler/P0SymBuild.mod
new file mode 100644
index 00000000000..00aac85f6a1
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P0SymBuild.mod
@@ -0,0 +1,760 @@
+(* P0SymBuild.mod pass 0 symbol creation.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+IMPLEMENTATION MODULE P0SymBuild ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2Printf IMPORT printf0, printf1, printf2 ;
+FROM Lists IMPORT List, InitList, KillList, IncludeItemIntoList, RemoveItemFromList, NoOfItemsInList, GetItemFromList, IsItemInList ;
+FROM Indexing IMPORT Index, InitIndex, HighIndice, LowIndice, GetIndice, RemoveIndiceFromIndex, IncludeIndiceIntoIndex ;
+FROM M2Batch IMPORT MakeDefinitionSource, MakeProgramSource, MakeImplementationSource ;
+FROM SymbolTable IMPORT NulSym, MakeInnerModule, SetCurrentModule, SetFileModule, MakeError, PutDefinitionForC ;
+FROM NameKey IMPORT Name, NulName ;
+FROM M2Quads IMPORT PushT, PushTF, PopT, PopTF, PopN, OperandT, PopTtok, PushTtok, OperandTok ;
+FROM M2Reserved IMPORT ImportTok ;
+FROM M2Debug IMPORT Assert ;
+FROM M2MetaError IMPORT MetaErrorT1, MetaErrorT2, MetaError1, MetaError2 ;
+FROM M2LexBuf IMPORT GetTokenNo, UnknownTokenNo ;
+IMPORT M2Error ;
+
+
+CONST
+   Debugging = FALSE ;
+
+TYPE
+   Kind = (module, program, defimp, inner, procedure, universe, unknown) ;
+
+   BlockInfoPtr = POINTER TO RECORD
+                     name           : Name ;
+                     kind           : Kind ;
+                     sym            : CARDINAL ;
+                     level          : CARDINAL ;
+                     token          : CARDINAL ;      (* where the block starts.  *)
+                     LocalModules   : List ;          (* locally declared modules at the current level  *)
+                     ImportedModules: Index ;         (* current list of imports for the scanned module *)
+                     toPC,
+                     toReturn,
+                     toNext,                          (* next in same level *)
+                     toUp,                            (* return to outer level *)
+                     toDown         : BlockInfoPtr ;  (* first of the inner level *)
+                  END ;
+
+   ModuleDesc = POINTER TO RECORD
+                              name: Name ;            (* Name of the module.  *)
+                              tok : CARDINAL ;        (* Location where the module ident was first seen.  *)
+                           END ;
+
+VAR
+   headBP,
+   curBP : BlockInfoPtr ;
+   Level : CARDINAL ;
+
+
+(*
+   nSpaces -
+*)
+
+PROCEDURE nSpaces (n: CARDINAL) ;
+BEGIN
+   WHILE n > 0 DO
+      printf0 (" ") ;
+      DEC (n)
+   END
+END nSpaces ;
+
+
+(*
+   DisplayB -
+*)
+
+PROCEDURE DisplayB (b: BlockInfoPtr) ;
+BEGIN
+   CASE b^.kind OF
+
+   program  :  printf1 ("MODULE %a ;\n", b^.name) |
+   defimp   :  printf1 ("DEFIMP %a ;\n", b^.name) |
+   inner    :  printf1 ("INNER MODULE %a ;\n", b^.name) |
+   procedure:  printf1 ("PROCEDURE %a ;\n", b^.name)
+
+   ELSE
+      HALT
+   END
+END DisplayB ;
+
+
+(*
+   DisplayBlock -
+*)
+
+PROCEDURE DisplayBlock (b: BlockInfoPtr; l: CARDINAL) ;
+VAR
+   a: BlockInfoPtr ;
+BEGIN
+   nSpaces (l) ;
+   DisplayB (b) ;
+   a := b^.toDown ;
+   INC (l, 3) ;
+   WHILE a # NIL DO
+      DisplayBlock (a, l) ;
+      a := a^.toNext
+   END ;
+   DEC (l, 3) ;
+   nSpaces (l) ;
+   printf1 ("END %a\n", b^.name)
+END DisplayBlock ;
+
+
+(*
+   pc - an interactive debugging aid callable from gdb.
+*)
+
+(*
+PROCEDURE pc ;
+BEGIN
+   DisplayB (curBP)
+END pc ;
+*)
+
+
+(*
+   Display -
+*)
+
+PROCEDURE Display ;
+VAR
+   b: BlockInfoPtr ;
+BEGIN
+   printf0 ("Universe of Modula-2 modules\n") ;
+   IF headBP # NIL
+   THEN
+      b := headBP^.toDown ;
+      WHILE b # NIL DO
+         DisplayBlock (b, 0) ;
+         b := b^.toNext
+      END
+   END
+END Display ;
+
+
+(*
+   addDown - adds, b, to the down link of, a.
+*)
+
+PROCEDURE addDown (a, b: BlockInfoPtr) ;
+BEGIN
+   IF a^.toDown = NIL
+   THEN
+      a^.toDown := b
+   ELSE
+      a := a^.toDown ;
+      WHILE a^.toNext # NIL DO
+         a := a^.toNext
+      END ;
+      a^.toNext := b
+   END
+END addDown ;
+
+
+(*
+   GraftBlock - add a new block, b, into the tree in the correct order.
+*)
+
+PROCEDURE GraftBlock (b: BlockInfoPtr) ;
+BEGIN
+   Assert (curBP # NIL) ;
+   Assert (ABS (Level-curBP^.level) <= 1) ;
+   CASE Level-curBP^.level OF
+
+   -1:  (* returning up to the outer scope *)
+        curBP := curBP^.toUp ;
+        Assert (curBP^.toNext = NIL) ;
+        curBP^.toNext := b |
+    0:  (* add toNext *)
+        Assert (curBP^.toNext = NIL) ;
+        curBP^.toNext := b ;
+        b^.toUp := curBP^.toUp |
+   +1:  (* insert down a level *)
+        b^.toUp := curBP ;  (* save return value *)
+        addDown (curBP, b)
+
+   ELSE
+      HALT
+   END ;
+   curBP := b
+END GraftBlock ;
+
+
+(*
+   BeginBlock - denotes the start of the next block.  We remember all imports and
+                local modules and procedures created in this block.
+*)
+
+PROCEDURE BeginBlock (n: Name; k: Kind; s: CARDINAL; tok: CARDINAL) ;
+VAR
+   b: BlockInfoPtr ;
+BEGIN
+   NEW (b) ;
+   WITH b^ DO
+      name := n ;
+      kind := k ;
+      sym := s ;
+      InitList (LocalModules) ;
+      ImportedModules := InitIndex (1) ;
+      toPC := NIL ;
+      toReturn := NIL ;
+      toNext := NIL ;
+      toDown := NIL ;
+      toUp := NIL ;
+      level := Level ;
+      token := tok
+   END ;
+   GraftBlock(b)
+END BeginBlock ;
+
+
+(*
+   InitUniverse -
+*)
+
+PROCEDURE InitUniverse ;
+BEGIN
+   NEW (curBP) ;
+   WITH curBP^ DO
+      name := NulName ;
+      kind := universe ;
+      sym := NulSym ;
+      InitList (LocalModules) ;
+      ImportedModules := InitIndex (1) ;
+      toNext := NIL ;
+      toDown := NIL ;
+      toUp := curBP ;
+      level := Level
+   END ;
+   headBP := curBP
+END InitUniverse ;
+
+
+(*
+   FlushImports -
+*)
+
+PROCEDURE FlushImports (b: BlockInfoPtr) ;
+VAR
+   i, n: CARDINAL ;
+   desc: ModuleDesc ;
+BEGIN
+   WITH b^ DO
+      i := LowIndice (ImportedModules) ;
+      n := HighIndice (ImportedModules) ;
+      WHILE i <= n DO
+         desc := GetIndice (ImportedModules, i) ;
+         sym := MakeDefinitionSource (desc^.tok, desc^.name) ;
+         Assert (sym # NulSym) ;
+         INC (i)
+      END
+   END
+END FlushImports ;
+
+
+(*
+   EndBlock - shutdown the module and create definition symbols for all imported
+              modules.
+*)
+
+PROCEDURE EndBlock ;
+BEGIN
+   FlushImports (curBP) ;
+   curBP := curBP^.toUp ;
+   DEC (Level) ;
+   IF Level = 0
+   THEN
+      FlushImports (curBP)
+   END
+END EndBlock ;
+
+
+(*
+   RegisterLocalModule - register, n, as a local module.
+*)
+
+PROCEDURE RegisterLocalModule (modname: Name) ;
+VAR
+   i, n: CARDINAL ;
+   desc: ModuleDesc ;
+BEGIN
+   (* printf1('seen local module %a\n', n) ; *)
+   WITH curBP^ DO
+      IncludeItemIntoList (LocalModules, modname) ;
+      i := LowIndice (ImportedModules) ;
+      n := HighIndice (ImportedModules) ;
+      WHILE i <= n DO
+         desc := GetIndice (ImportedModules, i) ;
+         IF desc^.name = modname
+         THEN
+            RemoveIndiceFromIndex (ImportedModules, desc) ;
+            DISPOSE (desc) ;
+            DEC (n)
+            (* Continue checking in case a user imported the same module again.  *)
+         ELSE
+            INC (i)
+         END
+      END
+   END
+END RegisterLocalModule ;
+
+
+(*
+   RegisterImport - register, n, as a module imported from either a local scope or definition module.
+*)
+
+PROCEDURE RegisterImport (tok: CARDINAL; modname: Name) ;
+VAR
+   bp  : BlockInfoPtr ;
+   desc: ModuleDesc ;
+BEGIN
+   (* printf1('register import from module %a\n', n) ; *)
+   Assert (curBP # NIL) ;
+   Assert (curBP^.toUp # NIL) ;
+   bp := curBP^.toUp ;   (* skip over current module *)
+   WITH bp^ DO
+      IF NOT IsItemInList (LocalModules, modname)
+      THEN
+         NEW (desc) ;
+         desc^.name := modname ;
+         desc^.tok := tok ;
+         IncludeIndiceIntoIndex (ImportedModules, desc)
+      END
+   END
+END RegisterImport ;
+
+
+(*
+   RegisterImports -
+*)
+
+PROCEDURE RegisterImports ;
+VAR
+   index,
+   i, n : CARDINAL ;
+BEGIN
+   PopT (n) ;       (* n   = # of the Ident List *)
+   IF OperandT (n+1) = ImportTok
+   THEN
+      (* Ident list contains Module Names *)
+      i := 1 ;
+      WHILE i<=n DO
+         index := n+1-i ;
+         RegisterImport (OperandTok (index), OperandT (index)) ;
+         INC (i)
+      END
+   ELSE
+      (* Ident List contains list of objects *)
+      RegisterImport (OperandTok (n+1), OperandT (n+1))
+   END ;
+   PopN (n+1)   (* clear stack *)
+END RegisterImports ;
+
+
+(*
+   RegisterInnerImports -
+*)
+
+PROCEDURE RegisterInnerImports ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   PopT (n) ;       (* n   = # of the Ident List *)
+   IF OperandT (n+1) = ImportTok
+   THEN
+      (* Ident list contains list of objects, which will be seen outside the scope of this module.  *)
+   ELSE
+      (* Ident List contains list of objects, but we are importing directly from a module OperandT(n+1) *)
+      RegisterImport (OperandTok (n+1), OperandT (n+1))
+   END ;
+   PopN (n+1)   (* clear stack *)
+END RegisterInnerImports ;
+
+
+(*
+   RegisterProgramModule - register the top of stack as a program module.
+*)
+
+PROCEDURE RegisterProgramModule ;
+VAR
+   n  : Name ;
+   sym: CARDINAL ;
+   tok: CARDINAL ;
+BEGIN
+   Assert (Level = 0) ;
+   INC (Level) ;
+   PopTtok (n, tok) ;
+   PushTtok (n, tok) ;
+   sym := MakeProgramSource (tok, n) ;
+   SetCurrentModule (sym) ;
+   SetFileModule (sym) ;
+   BeginBlock (n, program, sym, tok) ;
+   M2Error.EnterProgramScope (n)
+END RegisterProgramModule ;
+
+
+(*
+   RegisterImplementationModule - register the top of stack as an implementation module.
+*)
+
+PROCEDURE RegisterImplementationModule ;
+VAR
+   n  : Name ;
+   sym: CARDINAL ;
+   tok: CARDINAL ;
+BEGIN
+   Assert (Level = 0) ;
+   INC (Level) ;
+   PopTtok (n, tok) ;
+   PushTtok (n, tok) ;
+   sym := MakeImplementationSource (tok, n) ;
+   SetCurrentModule (sym) ;
+   SetFileModule (sym) ;
+   BeginBlock (n, defimp, sym, tok) ;
+   M2Error.EnterImplementationScope (n)
+END RegisterImplementationModule ;
+
+
+(*
+   RegisterDefinitionModule - register the top of stack as a definition module.
+*)
+
+PROCEDURE RegisterDefinitionModule (forC: BOOLEAN) ;
+VAR
+   n  : Name ;
+   sym: CARDINAL ;
+   tok: CARDINAL ;
+BEGIN
+   Assert (Level=0) ;
+   INC (Level) ;
+   PopTtok (n, tok) ;
+   PushTtok (n, tok) ;
+   sym := MakeDefinitionSource (tok, n) ;
+   SetCurrentModule (sym) ;
+   SetFileModule (sym) ;
+   IF forC
+   THEN
+      PutDefinitionForC (sym)
+   END ;
+   BeginBlock (n, defimp, sym, tok) ;
+   M2Error.EnterDefinitionScope (n)
+END RegisterDefinitionModule ;
+
+
+(*
+   RegisterInnerModule - register the top of stack as an inner module, this module name
+                         will be removed from the list of outstanding imports in the
+                         current module block.
+*)
+
+PROCEDURE RegisterInnerModule ;
+VAR
+   n  : Name ;
+   tok: CARDINAL ;
+BEGIN
+   INC (Level) ;
+   PopTtok (n, tok) ;
+   PushTtok (n, tok) ;
+   RegisterLocalModule (n) ;
+   BeginBlock (n, inner, NulSym, tok) ;
+   M2Error.EnterModuleScope (n)
+END RegisterInnerModule ;
+
+
+(*
+   RegisterProcedure - register the top of stack as a procedure.
+*)
+
+PROCEDURE RegisterProcedure ;
+VAR
+   n  : Name ;
+   tok: CARDINAL ;
+BEGIN
+   INC (Level) ;
+   PopTtok (n, tok) ;
+   PushTtok (n, tok) ;
+   BeginBlock (n, procedure, NulSym, tok) ;
+   M2Error.EnterProcedureScope (n)
+END RegisterProcedure ;
+
+
+(*
+   EndBuildProcedure - ends building a Procedure.
+*)
+
+PROCEDURE EndProcedure ;
+VAR
+   NameEnd, NameStart: Name ;
+   end, start        : CARDINAL ;
+BEGIN
+   PopTtok (NameEnd, end) ;
+   PopTtok (NameStart, start) ;
+   Assert (start # UnknownTokenNo) ;
+   Assert (end # UnknownTokenNo) ;
+   IF NameEnd # NameStart
+   THEN
+      IF NameEnd = NulName
+      THEN
+         MetaErrorT1 (start,
+                      'procedure name at beginning {%1Ea} does not match the name at end',
+                      MakeError (start, NameStart)) ;
+         MetaError1 ('procedure name at end does not match the name at beginning {%1Ea}',
+                     MakeError (start, NameStart))
+      ELSE
+         MetaErrorT2 (start,
+                      'procedure name at beginning {%1Ea} does not match the name at end {%2a}',
+                      MakeError (start, curBP^.name), MakeError (end, NameEnd)) ;
+         MetaErrorT2 (end,
+                      'procedure name at end {%1Ea} does not match the name at beginning {%2Ea}',
+                      MakeError (end, NameEnd), MakeError (start, curBP^.name))
+      END
+   END ;
+   EndBlock ;
+   M2Error.LeaveErrorScope
+END EndProcedure ;
+
+
+(*
+   EndModule -
+*)
+
+PROCEDURE EndModule ;
+VAR
+   NameEnd, NameStart: Name ;
+   end, start        : CARDINAL ;
+BEGIN
+   PopTtok (NameEnd, end) ;
+   PopTtok (NameStart, start) ;
+   Assert (start # UnknownTokenNo) ;
+   Assert (end # UnknownTokenNo) ;
+   IF NameEnd # NameStart
+   THEN
+      IF NameEnd = NulName
+      THEN
+         MetaErrorT1 (start,
+                      'module name at beginning {%1Ea} does not match the name at end',
+                      MakeError (start, NameStart)) ;
+         MetaError1 ('module name at end does not match the name at beginning {%1Ea}',
+                     MakeError (start, NameStart))
+      ELSE
+         MetaErrorT2 (start,
+                      'module name at beginning {%1Ea} does not match the name at end {%2a}',
+                      MakeError (start, curBP^.name), MakeError (end, NameEnd)) ;
+         MetaErrorT2 (end,
+                      'module name at end {%1Ea} does not match the name at beginning {%2Ea}',
+                      MakeError (end, NameEnd), MakeError (start, curBP^.name))
+      END
+   END ;
+   EndBlock ;
+   M2Error.LeaveErrorScope
+END EndModule ;
+
+
+(*
+   DeclareModules - declare all inner modules seen at the current block level.
+*)
+
+PROCEDURE DeclareModules ;
+VAR
+   b: BlockInfoPtr ;
+   s: CARDINAL ;
+BEGIN
+   b := curBP^.toDown ;
+   WHILE b # NIL DO
+      IF b^.kind = inner
+      THEN
+         IF Debugging
+         THEN
+            printf1 ("***  declaring inner module %a\n", b^.name)
+         END ;
+         s := MakeInnerModule (curBP^.token, b^.name) ;
+         Assert (s # NulSym)
+      END ;
+      b := b^.toNext
+   END
+END DeclareModules ;
+
+
+(****
+(*
+   MoveNext -
+*)
+
+PROCEDURE MoveNext ;
+VAR
+   b: BlockInfoPtr ;
+BEGIN
+   IF curBP^.toNext#NIL
+   THEN
+      b := curBP^.toUp ;
+      (* moving to next *)
+      curBP := curBP^.toNext ;
+      (* remember our return *)
+      curBP^.toUp := b
+   END
+END MoveNext ;
+
+
+(*
+   MoveDown -
+*)
+
+PROCEDURE MoveDown ;
+VAR
+   b: BlockInfoPtr ;
+BEGIN
+   (* move down a level *)
+   (* remember where we came from *)
+   b := curBP ;
+   curBP := curBP^.toDown ;
+   curBP^.toUp := b
+END MoveDown ;
+
+
+(*
+   MoveUp -
+*)
+
+PROCEDURE MoveUp ;
+BEGIN
+   (* move up to the outer scope *)
+   curBP := curBP^.toUp ;
+END MoveUp ;
+***** *)
+
+
+(*
+   Move -
+*)
+
+PROCEDURE Move ;
+VAR
+   b: BlockInfoPtr ;
+BEGIN
+   IF Level = curBP^.level
+   THEN
+      b := curBP^.toReturn ;
+      (* moving to next *)
+      curBP := curBP^.toNext ;
+      (* remember our return *)
+      curBP^.toReturn := b
+   ELSE
+      WHILE Level # curBP^.level DO
+         IF Level < curBP^.level
+         THEN
+            (* move up to the outer scope *)
+            b := curBP ;
+            curBP := curBP^.toReturn ;
+            curBP^.toPC := b^.toNext   (* remember where we reached *)
+         ELSE
+            (* move down a level *)
+            (* remember where we came from *)
+            b := curBP ;
+            IF curBP^.toPC = NIL
+            THEN
+               Assert (curBP^.toDown#NIL) ;
+               curBP^.toPC := curBP^.toDown
+            END ;
+            Assert (curBP^.toPC#NIL) ;
+            curBP := curBP^.toPC ;
+            curBP^.toReturn := b
+         END
+      END
+   END
+END Move ;
+
+
+(*
+   EnterBlock -
+*)
+
+PROCEDURE EnterBlock (n: Name) ;
+BEGIN
+   Assert (curBP#NIL) ;
+   INC (Level) ;
+   Move ;
+   IF Debugging
+   THEN
+      nSpaces (Level*3) ;
+      IF n = curBP^.name
+      THEN
+         printf1 ('block %a\n', n)
+      ELSE
+         printf2 ('seen block %a but tree has recorded %a\n', n, curBP^.name)
+      END
+   END ;
+   Assert ((n = curBP^.name) OR (curBP^.name = NulName)) ;
+   DeclareModules
+END EnterBlock ;
+
+
+(*
+   LeaveBlock -
+*)
+
+PROCEDURE LeaveBlock ;
+BEGIN
+   IF Debugging
+   THEN
+      printf1 ('leaving block %a ', curBP^.name)
+   END ;
+   DEC (Level) ;
+   Move
+END LeaveBlock ;
+
+
+(*
+   P0Init -
+*)
+
+PROCEDURE P0Init ;
+BEGIN
+   headBP := NIL ;
+   curBP := NIL ;
+   Level := 0 ;
+   InitUniverse
+END P0Init ;
+
+
+(*
+   P1Init -
+*)
+
+PROCEDURE P1Init ;
+BEGIN
+   IF Debugging
+   THEN
+      Display
+   END ;
+   (* curBP := headBP^.toDown ; *)
+   curBP := headBP ;
+   Assert(curBP#NIL) ;
+   curBP^.toPC := curBP^.toDown ;
+   curBP^.toReturn := curBP ;
+   Level := 0
+END P1Init ;
+
+
+END P0SymBuild.
diff --git a/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf b/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
new file mode 100644
index 00000000000..7e948afd171
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
@@ -0,0 +1,931 @@
+--
+-- m2.bnf grammar and associated actions for pass 0.
+--
+-- Copyright (C) 2001-2022 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/>.
+% module P0SyntaxCheck begin
+(* output from m2.bnf, automatically generated do not edit if these
+   are the top two lines in the file.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE P0SyntaxCheck ;
+
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
+                     InsertTokenAndRewind, GetTokenNo, DisplayToken, DumpTokens ;
+
+FROM M2MetaError IMPORT MetaErrorStringT0 ;
+FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack, PushTFtok, PushTtok ;
+FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
+FROM P2SymBuild IMPORT BuildString, BuildNumber ;
+FROM NameKey IMPORT Name, NulName, makekey ;
+FROM StrLib IMPORT StrCopy, StrConCat, StrEqual ;
+FROM M2Batch IMPORT MakeProgramSource, MakeDefinitionSource, MakeImplementationSource ;
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
+FROM M2Debug IMPORT Assert ;
+FROM M2Printf IMPORT printf0 ;
+
+(* imports for Pass0 *)
+
+FROM P0SymBuild IMPORT RegisterImports, RegisterInnerImports,
+                       RegisterProgramModule,
+                       RegisterImplementationModule, RegisterDefinitionModule,
+                       RegisterInnerModule, EndModule,
+                       RegisterProcedure, EndProcedure ;
+
+FROM SymbolTable IMPORT NulSym, PutModuleContainsBuiltin, PutHiddenTypeDeclared ;
+
+IMPORT M2Error ;
+
+
+CONST
+   Debugging    = FALSE ;
+   DebugRecover = FALSE ;
+   Pass0        = TRUE ;
+   Pass1        = FALSE ;
+   Pass2        = FALSE ;          (* permanently disabled for the time being *)
+   Pass3        = FALSE ;          (* permanently disabled for the time being *)
+   MaxInsert    = 10 ;             (* allow 10 tokens to be inserted before   *)
+                                   (* giving up.                              *)
+
+VAR
+   seenError  : BOOLEAN ;
+   LastIdent  : Name ;
+   InsertCount: CARDINAL ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   MetaErrorStringT0 (GetTokenNo (), s) ;
+   seenError := TRUE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString (InitString (a))
+END ErrorArray ;
+
+
+% declaration P0SyntaxCheck begin
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   WHILE NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      GetToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError (stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   GetMissingTokenMessage - generates and returns a string about a missing token, t.
+*)
+
+PROCEDURE GetMissingTokenMessage (t: toktype) : String ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop (s0, s1, s2) ;
+   RETURN str
+END GetMissingTokenMessage ;
+
+
+(*
+   ErrorMissingToken - generates an error message about a missing token, t.
+*)
+
+PROCEDURE ErrorMissingToken (t: toktype) ;
+VAR
+   str: String ;
+BEGIN
+   str := GetMissingTokenMessage (t) ;
+   str := ConCat (InitString ('syntax error,'), Mark (str)) ;
+   MetaErrorStringT0 (GetTokenNo (), str)
+END ErrorMissingToken ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   str: String ;
+BEGIN
+   str := GetMissingTokenMessage (t) ;
+   str := ConCat (InitString ('{%W}syntax warning,'), Mark (str)) ;
+   MetaErrorStringT0 (GetTokenNo (), str) ;
+   IF DebugRecover
+   THEN
+      printf0 ("warning note created\n")
+   END
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   IF (InsertCount<MaxInsert) AND
+      ((t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok))
+   THEN
+      IF DebugRecover
+      THEN
+         printf0 ("missing token detected and going to be inserted: ");
+         DisplayToken (t)
+      END ;
+      WarnMissingToken (t) ;
+      INC (InsertCount) ;
+      IF DebugRecover
+      THEN
+         printf0 ('inserting token\n')
+      END ;
+      InsertToken (t)
+   ELSE
+      IF DebugRecover
+      THEN
+         printf0 ("missing token detected but cannot be inserted: ");
+         DisplayToken (t)
+      END ;
+      ErrorMissingToken (t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckInsertCandidate -
+*)
+
+PROCEDURE CheckInsertCandidate (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      INC (InsertCount) ;
+      IF InsertCount < MaxInsert
+      THEN
+         WarnMissingToken (t) ;
+         IF DebugRecover
+         THEN
+            printf0 ('buffer before\n') ;
+            DumpTokens ;
+            printf0 ('inserting token: buffer after\n') ;
+            DumpTokens ;
+            printf0 ('inserting token\n')
+         END ;
+         InsertTokenAndRewind (t) ;
+         RETURN TRUE
+      END
+   END ;
+   RETURN FALSE
+END CheckInsertCandidate ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* SyntaxCheck will fail since currentoken is not part of the stopset
+         we check to see whether one of the following is in the stopset and
+         if not emit a warning and also the token.  *)
+      IF CheckInsertCandidate (semicolontok, stopset0, stopset1, stopset2) OR
+         CheckInsertCandidate (rsbratok, stopset0, stopset1, stopset2) OR
+         CheckInsertCandidate (rparatok, stopset0, stopset1, stopset2) OR
+         CheckInsertCandidate (rcbratok, stopset0, stopset1, stopset2) OR
+         CheckInsertCandidate (periodtok, stopset0, stopset1, stopset2) OR
+         CheckInsertCandidate (oftok, stopset0, stopset1, stopset2) OR
+         CheckInsertCandidate (endtok, stopset0, stopset1, stopset2) OR
+         CheckInsertCandidate (commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      GetToken ;
+      IF Pass0
+      THEN
+         PeepToken (stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken (t)
+   END ;
+   SyntaxCheck (stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   seenError := FALSE ;
+   InsertCount := 0 ;
+   FileUnit (SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   RETURN NOT seenError
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   LastIdent := makekey (currentstring) ;
+   IF IsAutoPushOn ()
+   THEN
+      PushTFtok (LastIdent, identtok, GetTokenNo())
+   END ;
+   Expect (identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn ()
+   THEN
+      PushTF (makekey (currentstring), stringtok) ;
+      BuildString
+   END ;
+   Expect (stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey (currentstring), integertok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey (currentstring), realtok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module P0SyntaxCheck end
+END P0SyntaxCheck.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident                first { < identtok > } follow { }
+     '@i{is a builtin and checks for an identifier}'
+special Integer              first { < integertok > } follow { }
+     '@i{is a builtin and checks for an integer}'
+special Real                 first { < realtok > } follow { }
+     '@i{is a builtin and checks for an real constant}'
+special string               first { < stringtok > } follow { }
+     '@i{is a builtin and checks for an string constant}'
+BNF
+
+-- the following are provided by the module m2flex and also hand built procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit :=                                                                % PushAutoOff %
+            ( DefinitionModule | ImplementationOrProgramModule )           % PopAuto %
+         =:
+
+ProgramModule := "MODULE"                                                  % PushAutoOn ; %
+                                                                           % M2Error.DefaultProgramModule %
+                  Ident                                                    % RegisterProgramModule ; %
+                                                                           % PushAutoOff ; %
+                  [ Priority ]
+                  ";"
+                                                                           % PushAutoOn ; %
+                  { Import                                                 % RegisterImports %
+                  }                                                        % PopAuto %
+                  Block                                                    % PopAuto %
+                        Ident "."                                          % EndModule %
+                                                                           % PopAuto %
+                  =:
+
+ImplementationModule := "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
+                                         "MODULE"                          % PushAutoOn ; %
+                         Ident                                             % RegisterImplementationModule ; %
+                                                                           % PushAutoOff ; %
+                         [ Priority ] ";"                                  % PushAutoOn ; %
+                         { Import                                          % RegisterImports %
+                           }                                               % PopAuto %
+                         Block                                             % PopAuto %
+
+                         Ident                                             % EndModule %
+                                                                           % PopAuto %
+                         "." =:
+
+ImplementationOrProgramModule := ImplementationModule | ProgramModule =:
+
+Number := Integer | Real =:
+
+Qualident := Ident { "." Ident } =:
+
+ConstantDeclaration := Ident "=" ConstExpression =:
+
+ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ] =:
+
+Relation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
+
+UnaryOrConstTerm := "+" ConstTerm | "-" ConstTerm | ConstTerm =:
+
+AddOperator := "+" | "-" | "OR" =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor } =:
+
+MulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" | "NOT" ConstFactor |
+               ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string =:
+
+ComponentElement := ConstExpression [ ".." ConstExpression ] =:
+
+ComponentValue := ComponentElement [ 'BY' ConstExpression ] =:
+
+ArraySetRecordValue := ComponentValue { ',' ComponentValue } =:
+
+Constructor := '{' [ ArraySetRecordValue ] '}' =:
+
+ConstSetOrQualidentOrFunction := Constructor | Qualident
+                                 [ Constructor | ConstActualParameters ] =:
+
+ConstActualParameters := "(" [ ExpList ] ")" =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:
+
+ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =:
+
+ByteAlignment := '<*' AttributeExpression '*>' =:
+
+-- AlignmentExpression := "(" ConstExpression ")" =:
+
+Alignment := [ ByteAlignment ] =:
+
+TypeDeclaration := Ident "=" Type Alignment =:
+
+Type := SimpleType | ArrayType | RecordType | SetType |
+        PointerType | ProcedureType =:
+
+SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+
+Enumeration := "(" IdentList ")" =:
+
+IdentList := Ident                                                         % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," Ident                                                   % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+SubrangeType := "[" ConstExpression ".." ConstExpression "]" =:
+
+ArrayType := "ARRAY" SimpleType { "," SimpleType } "OF" Type =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
+
+DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                        { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression := Ident [ '(' ConstExpression ')' ] =:
+
+AttributeExpression := Ident '(' ConstExpression ')' =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+FieldListStatement := [ FieldList ] =:
+
+FieldList := IdentList ":" Type RecordFieldPragma
+                                |
+             "CASE" CaseTag "OF" Varient { "|" Varient }
+             [ "ELSE" FieldListSequence ] "END"
+           =:
+
+TagIdent := [ Ident ] =:
+
+CaseTag := TagIdent [ ":" Qualident ] =:
+
+Varient := [ VarientCaseLabelList ":" FieldListSequence ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression [ ".." ConstExpression ] =:
+
+CaseLabelList := CaseLabels { "," CaseLabels } =:
+
+CaseLabels := ConstExpression [ ".." ConstExpression ] =:
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+
+PointerType := "POINTER" "TO" Type =:
+
+ProcedureType := "PROCEDURE" [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+VarIdent := Ident [ "[" ConstExpression "]" ]
+         =:
+
+VariableDeclaration := VarIdentList ":" Type Alignment =:
+
+VarIdentList := VarIdent                                                   % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," VarIdent                                                % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+Designator := Qualident { SubDesignator } =:
+
+SubDesignator := "." Ident | "[" ExpList "]" | "^" =:
+
+ExpList := Expression { "," Expression } =:
+
+Expression := SimpleExpression [ Relation SimpleExpression ] =:
+
+SimpleExpression := [ "+" | "-" ] Term { AddOperator Term } =:
+
+Term := Factor { MulOperator Factor } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" Factor | ConstAttribute =:
+
+SetOrDesignatorOrFunction := ( Qualident [ Constructor |
+                                           SimpleDes [ ActualParameters ]
+                                         ] | Constructor
+                             )
+                           =:
+
+SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+
+ActualParameters := "(" [ ExpList ] ")" =:
+
+Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               "EXIT" | "RETURN" [ Expression ] | RetryStatement ] =:
+
+RetryStatement := "RETRY" =:
+
+AssignmentOrProcedureCall := Designator ( ":=" Expression |
+                                           ActualParameters |              % (* epsilon *) %
+                                        ) =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence := Statement { ";" Statement } =:
+
+IfStatement := "IF" Expression "THEN" StatementSequence
+              { "ELSIF" Expression "THEN" StatementSequence }
+              [ "ELSE" StatementSequence ] "END" =:
+
+CaseStatement := "CASE" Expression "OF" Case { "|" Case }
+                 [ "ELSE" StatementSequence ] "END" =:
+
+Case := [ CaseLabelList ":" StatementSequence ] =:
+
+WhileStatement := "WHILE" Expression "DO" StatementSequence "END" =:
+
+RepeatStatement := "REPEAT" StatementSequence "UNTIL" Expression =:
+
+ForStatement := "FOR" Ident ":=" Expression "TO" Expression
+                [ "BY" ConstExpression ] "DO"
+                StatementSequence "END" =:
+
+LoopStatement := "LOOP" StatementSequence "END" =:
+
+WithStatement := "WITH" Designator "DO" StatementSequence "END" =:
+
+ProcedureDeclaration :=
+                        ProcedureHeading ";" ( ProcedureBlock             % PushAutoOn %
+                                                              Ident       % EndProcedure %
+                                                                          % PopAuto %
+                                                                    ) =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" |
+                            "__INLINE__" ] =:
+
+ProcedureHeading := "PROCEDURE"                                           % M2Error.DefaultProcedure %
+                     DefineBuiltinProcedure
+                     (                                                    % PushAutoOn %
+                       Ident                                              % RegisterProcedure %
+                                                                          % PopAuto %
+                             [ FormalParameters ] AttributeNoReturn ) =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+AttributeUnused := [ "<*" Ident "*>" ] =:
+
+-- note that we do need to know whether builtins are used as they
+-- determine whether we need to parse the implementation module
+-- the same is true for hidden types
+
+Builtin := [ "__BUILTIN__"                                                % PutModuleContainsBuiltin %
+                           | "__INLINE__"  ] =:
+
+DefProcedureHeading := "PROCEDURE"                                        % M2Error.DefaultProcedure %
+                                   Builtin
+                       ( Ident [ DefFormalParameters ] AttributeNoReturn )
+                                                                          % M2Error.LeaveErrorScope %
+                     =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock := { Declaration } [ "BEGIN" BlockBody ] "END" =:
+
+Block := { Declaration } InitialBlock FinalBlock "END" =:
+
+InitialBlock := [ "BEGIN" BlockBody ] =:
+
+FinalBlock := [ "FINALLY" BlockBody ] =:
+
+BlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration ";" } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP |
+                     FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
+
+MultiFPSection := ExtendedFP |
+                  FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
+
+NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
+
+OptArg := "[" Ident ":" FormalType [ "=" ConstExpression ] "]" =:
+
+DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
+
+FormalType := { "ARRAY" "OF" } Qualident =:
+
+ModuleDeclaration := "MODULE"                                              % PushAutoOn %
+                                                                           % M2Error.DefaultInnerModule %
+                     Ident                                                 % RegisterInnerModule %
+                                                                           % PushAutoOff %
+                     [ Priority ] ";"                                      % PushAutoOn %
+                     { Import                                              % RegisterInnerImports %
+                              }                                            % PopAuto %
+                                [ Export ] Block                           % PopAuto %
+                                                 Ident                     % EndModule %
+                                                                           % PopAuto %
+                  =:
+
+Priority := "[" ConstExpression "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"   IdentList |
+                     "UNQUALIFIED" IdentList |
+                      IdentList
+                   ) ";" =:
+
+Import :=  "FROM" Ident "IMPORT" IdentList ";" |
+           "IMPORT"                                                        % PushTtok (ImportTok, GetTokenNo () -1)
+                                                                             (* determines whether Ident or Module *) %
+            IdentList ";" =:
+
+DefinitionModule :=                                                        % VAR forC: BOOLEAN ; %
+                                                                           % forC := FALSE %
+                    "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
+                                 "MODULE" [ "FOR"  string                  % forC := TRUE %
+                                                          ]                % PushAutoOn %
+                    Ident                                                  % RegisterDefinitionModule (forC) %
+                    ";"
+                    { Import                                               % RegisterImports %
+                             }                                             % PushAutoOff %
+                               [ Export
+                                        ]
+                    { Definition }                                         % PopAuto %
+                                   "END" Ident                             % EndModule %
+                                               "."                         % PopAuto %
+                  =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE" { Ident
+                       ( ";"                                               % PutHiddenTypeDeclared %
+                             | "=" Type Alignment ";" ) }
+              |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ] =:
+
+AsmOperands  := string [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+              =:
+
+AsmList      := [ AsmElement ] { ',' AsmElement } =:
+
+AsmElement   := AsmOperandName string '(' Expression ')'
+              =:
+
+TrashList    := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/gm2-compiler/P0SyntaxCheck.def b/gcc/m2/gm2-compiler/P0SyntaxCheck.def
new file mode 100644
index 00000000000..3c28b5540c7
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P0SyntaxCheck.def
@@ -0,0 +1,44 @@
+(* P0SyntaxCheck.def provides a parser with error recovery.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE P0SyntaxCheck ;
+
+(*
+    Title      : P1SyntaxCheck
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Tue Sep  5 15:15:16 2000
+    Last edit  : Tue Sep  5 15:15:16 2000
+    Description: provides a parser with error recovery for GNU Modula-2
+*)
+
+EXPORT QUALIFIED CompilationUnit ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END P0SyntaxCheck.
diff --git a/gcc/m2/gm2-compiler/P1Build.bnf b/gcc/m2/gm2-compiler/P1Build.bnf
new file mode 100644
index 00000000000..085114a07e9
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P1Build.bnf
@@ -0,0 +1,1050 @@
+--
+-- m2-1.bnf grammar and associated actions for pass 1.
+--
+-- Copyright (C) 2001-2022 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/>.
+% module P1Build begin
+(* output from m2-1.bnf, automatically generated do not edit if these
+   are the top two lines in the file.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE P1Build ;
+
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ;
+FROM M2Error IMPORT ErrorStringAt ;
+FROM M2Quads IMPORT PushT, PushTF, PushTFtok, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack ;
+FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
+FROM NameKey IMPORT Name, NulName, makekey ;
+FROM StrLib IMPORT StrCopy, StrConCat, StrEqual ;
+FROM P2SymBuild IMPORT BuildString, BuildNumber ;
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
+FROM M2Debug IMPORT Assert ;
+FROM M2Printf IMPORT printf0 ;
+FROM SymbolTable IMPORT AddNameToScope ;
+IMPORT M2Error ;
+
+
+(* imports for Pass1 *)
+FROM M2Quads IMPORT PushT, PopT,
+                    StartBuildInit,
+                    EndBuildInit,
+                    BuildProcedureStart,
+                    BuildProcedureEnd,
+                    BuildAssignment,
+                    BuildInline ;
+
+FROM P1SymBuild IMPORT P1StartBuildProgramModule,
+                       P1EndBuildProgramModule,
+                       P1StartBuildDefinitionModule,
+                       P1EndBuildDefinitionModule,
+                       P1StartBuildImplementationModule,
+                       P1EndBuildImplementationModule,
+                       StartBuildInnerModule,
+                       EndBuildInnerModule,
+
+                       BuildImportOuterModule,
+                       BuildImportInnerModule,
+                       BuildExportOuterModule,
+                       BuildExportInnerModule,
+                       CheckExplicitExported,
+
+                       BuildHiddenType,
+                       BuildNulName,
+
+                       StartBuildEnumeration, EndBuildEnumeration,
+
+                       BuildProcedureHeading,
+                       StartBuildProcedure,
+                       EndBuildProcedure,
+                       AddImportToImportStatement,
+                       BuildImportStatement ;
+
+
+FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
+                        PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
+                        MakeRegInterface,
+                        PutRegInterface, GetRegInterface,
+                        GetSymName,
+                        NulSym ;
+
+CONST
+   Debugging = FALSE ;
+   Pass0     = FALSE ;
+   Pass1     = TRUE ;
+   Pass2     = FALSE ;          (* permanently disabled for the time being *)
+   Pass3     = FALSE ;          (* permanently disabled for the time being *)
+   MaxInsert = 10 ;             (* allow 10 tokens to be inserted before   *)
+                                (* giving up.                              *)
+
+VAR
+   WasNoError : BOOLEAN ;
+   LastIdent  : Name ;
+   InsertCount: CARDINAL ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   ErrorStringAt(s, GetTokenNo()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString(InitString(a))
+END ErrorArray ;
+
+
+% declaration P1Build begin
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (*
+      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 NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      GetToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError(stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop(s0, s1, s2) ;
+
+   str := ConCat(InitString('syntax error,'), Mark(str)) ;
+   ErrorStringAt(str, GetTokenNo())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken(t) ;
+   INC(InsertCount) ;
+   IF (InsertCount<MaxInsert) AND
+      ((t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok))
+   THEN
+      IF Debugging
+      THEN
+         printf0('inserting token\n')
+      END ;
+      InsertToken(t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken(t) ;
+      InsertTokenAndRewind(t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      GetToken ;
+(*
+      WriteFormat2('token number %d token was %a',
+                    GetTokenNo(), makekey(currentstring)) ;
+      FlushErrors ;
+*)
+      IF Pass0
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   WasNoError := TRUE ;
+   InsertCount := 0 ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   RETURN( WasNoError )
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   LastIdent := makekey(currentstring) ;
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok(makekey(currentstring), identtok, GetTokenNo())
+   END ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   IdentScope - error checking varient of Ident but it remembers the
+                idents name in the current scope.
+*)
+
+PROCEDURE IdentScope (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   Ident(stopset0, stopset1, stopset2) ;
+   AddNameToScope(LastIdent)
+END IdentScope ;
+
+
+(*
+   PossiblyExportIdent - error checking varient of Ident which also
+                         checks to see if this ident should be
+                         explicitly exported.
+*)
+
+PROCEDURE PossiblyExportIdent (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+VAR
+   nothing: CARDINAL ;
+BEGIN
+   AddNameToScope(makekey(currentstring)) ;
+   PushTF(makekey(currentstring), identtok) ;
+   CheckExplicitExported ;
+   IF NOT IsAutoPushOn()
+   THEN
+      PopT(nothing)
+   END ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END PossiblyExportIdent ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTF(makekey(currentstring), stringtok) ;
+      BuildString
+   END ;
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), integertok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), realtok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module P1Build end
+END P1Build.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special PossiblyExportIdent  first { < identtok > } follow { }
+     '@i{is a builtin which automatically exports an identifier}'
+special Ident                first { < identtok > } follow { }
+     '@i{is a builtin and checks for an identifier}'
+special IdentScope           first { < identtok > } follow { }
+     '@i{a builtin which provides a context for error messages}'
+special Integer              first { < integertok > } follow { }
+     '@i{is a builtin and checks for an integer}'
+special Real                 first { < realtok > } follow { }
+     '@i{is a builtin and checks for an real constant}'
+special string               first { < stringtok > } follow { }
+     '@i{is a builtin and checks for an string constant}'
+BNF
+
+-- the following are provided by the module m2flex and also hand built procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit :=                                                                % PushAutoOff %
+            ( DefinitionModule |
+              ImplementationOrProgramModule )                              % PopAuto %
+         =:
+
+ProgramModule := "MODULE"                                                  % M2Error.DefaultProgramModule %
+                                                                           % PushAutoOn ; %
+                  Ident                                                    % P1StartBuildProgramModule ; %
+                                                                           % PushAutoOff ; %
+                  [ Priority ]
+                  ";"
+                                                                           % PushAutoOn ; %
+                  { Import                                                 % BuildImportOuterModule(FALSE) %
+                  }                                                        % PopAuto %
+                  Block
+                                                                           % PushAutoOn %
+                  Ident                                                    % P1EndBuildProgramModule %
+                  "."                                                      % PopAuto ; PopAuto ; PopAuto %
+                  =:
+
+ImplementationModule := "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
+                                         "MODULE"                          % PushAutoOn ; %
+                         Ident                                             % P1StartBuildImplementationModule ; %
+                                                                           % PushAutoOff ; %
+                         [ Priority ] ";"                                  % PushAutoOn ; %
+                         { Import                                          % BuildImportOuterModule(FALSE) %
+                           }                                               % PopAuto ; %
+                         Block                                             % PushAutoOn ; %
+
+                         Ident                                             % P1EndBuildImplementationModule %
+                                                                           % PopAuto ; PopAuto ; PopAuto ; %
+                         "." =:
+
+ImplementationOrProgramModule := ImplementationModule | ProgramModule =:
+
+Number := Integer | Real =:
+
+Qualident := Ident { "." Ident } =:
+
+ConstantDeclaration := PossiblyExportIdent
+                             "=" ConstExpression =:
+
+ConstExpression :=                                                         % PushAutoOff %
+                   SimpleConstExpr [ Relation SimpleConstExpr ]            % PopAuto %
+                =:
+
+Relation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
+
+UnaryOrConstTerm := "+" ConstTerm | "-" ConstTerm | ConstTerm =:
+
+AddOperator := "+" | "-" | "OR" =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor } =:
+
+MulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" | "NOT" ConstFactor |
+               ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string =:
+
+ComponentElement := ConstExpression [ ".." ConstExpression ] =:
+
+ComponentValue := ComponentElement [ 'BY' ConstExpression ] =:
+
+ArraySetRecordValue := ComponentValue { ',' ComponentValue } =:
+
+Constructor := '{' [ ArraySetRecordValue ] '}' =:
+
+ConstSetOrQualidentOrFunction := Constructor | Qualident
+                                 [ Constructor | ConstActualParameters ] =:
+
+ConstActualParameters := "(" [ ExpList ] ")" =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:
+
+ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =:
+
+ByteAlignment := '<*' AttributeExpression '*>' =:
+
+-- OptAlignmentExpression := [ AlignmentExpression ] =:
+
+-- AlignmentExpression := "(" ConstExpression ")" =:
+
+Alignment := [ ByteAlignment ] =:
+
+TypeDeclaration :=
+                                                                           % PushAutoOn %
+                   ( IdentScope "=" Type Alignment )                       % PopAuto    %
+                =:
+
+Type :=                                                                    % VAR Name: CARDINAL ; %
+                                                                           % PushAutoOff %
+        ( SimpleType | ArrayType | RecordType | SetType |
+          PointerType | ProcedureType )                                    % PopAuto %
+                                                                           % PopT(Name)  (* remove TYPE name from stack *) %
+        =:
+
+SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+
+Enumeration := "("                                                         % PushAutoOn %
+                   ( PossiblyExportIdentList                               % StartBuildEnumeration %
+                                                                           % EndBuildEnumeration %
+                               )                                           % PopAuto %
+               ")" =:
+
+IdentList := Ident                                                         % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," Ident                                                   % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+PossiblyExportIdentList := PossiblyExportIdent                             % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," PossiblyExportIdent                                     % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+SubrangeType := "[" ConstExpression ".." ConstExpression "]" =:
+
+ArrayType := "ARRAY" SimpleType { "," SimpleType } "OF"                    % BuildNulName %
+             Type =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
+
+DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                        { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression :=                                                   % PushAutoOff %
+                         Ident [ '(' ConstExpression ')' ]                 % PopAuto %
+                                                           =:
+
+AttributeExpression :=                                                     % PushAutoOff %
+                       Ident '(' ConstExpression ')'                       % PopAuto %
+                                                     =:
+
+AttributeUnused := [ "<*"                                                  % PushAutoOff %
+                          Ident                                            % PopAuto %
+                                "*>" ] =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+FieldListStatement := [ FieldList ] =:
+
+-- sadly the PIM rules are not LL1 as Ident and Qualident have the same first
+-- symbols. We rewrite FieldList to inline qualident
+-- was
+-- FieldList := IdentList ":"                                              % BuildNulName %
+--                           Type |
+--             "CASE" [ Ident ":" ] Qualident "OF" Varient { "|" Varient }
+--                    [ "ELSE" FieldListSequence ] "END" =:
+
+FieldList := IdentList ":"                                                 % BuildNulName %
+                           Type RecordFieldPragma
+                                |
+             "CASE" CaseTag "OF" Varient { "|" Varient }
+             [ "ELSE" FieldListSequence ] "END"
+           =:
+
+TagIdent := [ Ident ] =:
+
+CaseTag := TagIdent [ ":" Qualident ] =:
+
+Varient := [ VarientCaseLabelList ":" FieldListSequence ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression [ ".." ConstExpression ] =:
+
+CaseLabelList := CaseLabels { "," CaseLabels } =:
+
+CaseLabels := ConstExpression [ ".." ConstExpression ] =:
+
+SetType :=                                                                 % VAR Name: CARDINAL ; %
+
+           ( "SET" | "PACKEDSET" )
+                                   "OF"                                    % BuildNulName ; %
+                                        SimpleType                         % PopT(Name) ; %
+         =:
+
+PointerType := "POINTER" "TO"                                              % BuildNulName %
+                              Type =:
+
+ProcedureType := "PROCEDURE" [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+VarIdent := PossiblyExportIdent [ "[" ConstExpression "]" ]
+         =:
+
+VariableDeclaration :=
+                       ( VarIdentList ":"                                  % BuildNulName %
+                         Type Alignment )
+                    =:
+
+VarIdentList := VarIdent                                                   % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," VarIdent                                                % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+Designator := Qualident { SubDesignator } =:
+
+SubDesignator := "." Ident | "[" ExpList "]" | "^" =:
+
+ExpList := Expression { "," Expression } =:
+
+Expression :=                                                              % PushAutoOff %
+              SimpleExpression [ Relation SimpleExpression ]               % PopAuto %
+           =:
+
+SimpleExpression := [ "+" | "-" ] Term { AddOperator Term } =:
+
+Term := Factor { MulOperator Factor } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" Factor | ConstAttribute =:
+
+SetOrDesignatorOrFunction := ( Qualident [ Constructor |
+                                           SimpleDes [ ActualParameters ]
+                                         ] | Constructor
+                             )
+                           =:
+
+SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+
+ActualParameters := "(" [ ExpList ] ")" =:
+
+Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               "EXIT" | "RETURN" [ Expression ] | RetryStatement ] =:
+
+RetryStatement := "RETRY" =:
+
+AssignmentOrProcedureCall := Designator ( ":=" Expression |
+                                           ActualParameters |              % (* epsilon *) %
+                                        ) =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence := Statement { ";" Statement } =:
+
+IfStatement := "IF" Expression "THEN" StatementSequence
+              { "ELSIF" Expression "THEN" StatementSequence }
+              [ "ELSE" StatementSequence ] "END" =:
+
+CaseStatement := "CASE" Expression "OF" Case { "|" Case }
+                 [ "ELSE" StatementSequence ] "END" =:
+
+Case := [ CaseLabelList ":" StatementSequence ] =:
+
+WhileStatement := "WHILE" Expression "DO" StatementSequence "END" =:
+
+RepeatStatement := "REPEAT" StatementSequence "UNTIL" Expression =:
+
+ForStatement := "FOR" Ident ":=" Expression "TO" Expression
+                [ "BY" ConstExpression ] "DO"
+                StatementSequence "END" =:
+
+LoopStatement := "LOOP" StatementSequence "END" =:
+
+WithStatement := "WITH" Designator "DO" StatementSequence "END" =:
+
+ProcedureDeclaration := ProcedureHeading ";" ( ProcedureBlock              % PushAutoOn %
+                        Ident )                                            % EndBuildProcedure %
+                                                                           % PopAuto %
+                      =:
+
+DefineBuiltinProcedure := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")"
+                          | "__INLINE__"                                   % PushT(InlineTok) %
+                          |                                                % PushT(NulTok) %
+                       =:
+
+ProcedureHeading := "PROCEDURE"                                            % M2Error.DefaultProcedure %
+                                                                           % PushAutoOn %
+                     DefineBuiltinProcedure
+                     ( PossiblyExportIdent                                 % StartBuildProcedure %
+                                                                           % PushAutoOff %
+                       [ FormalParameters ] AttributeNoReturn
+                                                                           % PopAuto %
+                                                                           % BuildProcedureHeading %
+                     )                                                     % PopAuto %
+                     =:
+
+Builtin := "__BUILTIN__"                                                   % PushT(BuiltinTok) %
+            | "__INLINE__"                                                 % PushT(InlineTok) %
+            |                                                              % PushT(NulTok) %
+        =:
+
+DefProcedureHeading := "PROCEDURE"                                         % M2Error.DefaultProcedure %
+                        Builtin                                            % PushAutoOn %
+                       ( PossiblyExportIdent                               % StartBuildProcedure %
+                                                                           % PushAutoOff %
+                       [ DefFormalParameters ] AttributeNoReturn
+                                                                           % PopAuto %
+                                                                           % BuildProcedureHeading %
+                     )                                                     % PopAuto %
+                                                                           % M2Error.LeaveErrorScope %
+                     =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock := { Declaration } [ "BEGIN" BlockBody ] "END" =:
+
+Block := { Declaration } InitialBlock FinalBlock "END" =:
+
+InitialBlock := [ "BEGIN" BlockBody ] =:
+
+FinalBlock := [ "FINALLY" BlockBody ] =:
+
+BlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration ";" } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP |
+                     FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
+
+MultiFPSection := ExtendedFP |
+                  FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
+
+NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
+
+OptArg := "[" IdentScope ":" FormalType [ "=" ConstExpression ] "]" =:
+
+DefOptArg := "[" IdentScope ":" FormalType "=" ConstExpression "]" =:
+
+FormalType := { "ARRAY" "OF" } Qualident =:
+
+ModuleDeclaration := "MODULE"                                              % M2Error.DefaultInnerModule %
+                                                                           % PushAutoOn %
+                     Ident                                                 % StartBuildInnerModule %
+                                                                           % PushAutoOff %
+                     [ Priority ] ";"                                      % PushAutoOn %
+                     { Import                                              % BuildImportInnerModule %
+                        } [ Export                                         % BuildExportInnerModule %
+                            ]                                              % PopAuto %
+                       Block                                               % PushAutoOn %
+                       Ident                                               % EndBuildInnerModule %
+                                                                           % PopAuto ; PopAuto ; PopAuto %
+                     =:
+
+Priority := "[" ConstExpression "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"                                           % PushT(QualifiedTok) %
+                                 IdentList |
+                     "UNQUALIFIED"                                         % PushT(UnQualifiedTok) %
+                                 IdentList |                               % PushT(ExportTok) %
+                     IdentList ) ";" =:
+
+Import :=  "FROM"                                                          % BuildImportStatement (GetTokenNo () -1) %
+                  Ident                                                    % AddImportToImportStatement (TRUE) %
+                        "IMPORT" IdentList ";" |
+           "IMPORT"                                                        % BuildImportStatement (GetTokenNo () -1) %
+                                                                           % PushT(ImportTok)
+                                                                             (* determines whether Ident or Module *) %
+            IdentImportList ";" =:
+
+IdentImportList := Ident                                                   % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                AddImportToImportStatement (FALSE) ;
+                                                                                n := 1
+                                                                             END %
+             { "," Ident                                                   % IF on
+                                                                             THEN
+                                                                                AddImportToImportStatement (FALSE) ;
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+DefinitionModule := "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
+                                 "MODULE"                                  % PushAutoOn %
+                    ( "FOR"  string |                                      % (* epsilon *)
+                                                                             PushT(NulSym) %
+                    )
+                    Ident                                                  % P1StartBuildDefinitionModule %
+                    ";"
+                    { Import                                               % BuildImportOuterModule(TRUE) %
+                             } [ Export                                    % BuildExportOuterModule %
+                                        ]                                  % PushAutoOff %
+                    { Definition }                                         % PopAuto %
+                                   "END" Ident                             % P1EndBuildDefinitionModule %
+                                               "."                         % PopAuto %
+                  =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE"                                                       % PushAutoOn %
+                    { PossiblyExportIdent
+                            ( ";"                                          % BuildHiddenType %
+                                  | "=" Type Alignment ";" ) }             % PopAuto %
+              |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ] =:
+
+AsmOperands  := string [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+             =:
+
+AsmList      := [ AsmElement ] { ',' AsmElement } =:
+
+AsmElement   := AsmOperandName string '(' Expression ')'
+             =:
+
+TrashList    := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/gm2-compiler/P1Build.def b/gcc/m2/gm2-compiler/P1Build.def
new file mode 100644
index 00000000000..74c1bcb8bc3
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P1Build.def
@@ -0,0 +1,44 @@
+(* P1Build.def provides a parser with error recovery for GNU Modula-2.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE P1Build ;
+
+(*
+    Title      : P1Build
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Feb  2 16:11:05 2001
+    Last edit  : Fri Feb  2 16:11:05 2001
+    Description: provides a parser with error recovery for GNU Modula-2
+*)
+
+EXPORT QUALIFIED CompilationUnit ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END P1Build.
diff --git a/gcc/m2/gm2-compiler/P1SymBuild.def b/gcc/m2/gm2-compiler/P1SymBuild.def
new file mode 100644
index 00000000000..d4b31411353
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P1SymBuild.def
@@ -0,0 +1,562 @@
+(* P1SymBuild.def pass 1 symbol creation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE P1SymBuild ;
+
+(*
+   Title      : P1SymBuild
+   Author     : Gaius Mulley
+   Date       : 24/6/87
+   LastEdit   : Sat Dec  9 11:34:34 EST 1989
+   System     : UNIX (GNU Modula-2)
+   Description: Builds symbol entities, types, constants, variables,
+                procedures, modules and scopes.
+                All procedures are only called during Pass 1.
+*)
+
+EXPORT QUALIFIED P1StartBuildDefinitionModule,
+                 P1EndBuildDefinitionModule,
+                 P1StartBuildImplementationModule,
+                 P1EndBuildImplementationModule,
+                 P1StartBuildProgramModule,
+                 P1EndBuildProgramModule,
+                 StartBuildInnerModule,
+                 EndBuildInnerModule,
+                 BuildImportOuterModule,
+                 BuildExportOuterModule,
+                 BuildImportInnerModule,
+                 BuildExportInnerModule,
+                 StartBuildEnumeration,
+                 EndBuildEnumeration,
+                 BuildHiddenType,
+                 StartBuildProcedure,
+                 EndBuildProcedure,
+                 BuildProcedureHeading,
+                 BuildNulName,
+                 BuildTypeEnd,
+                 CheckExplicitExported,
+                 BuildImportStatement,
+                 AddImportToImportStatement ;
+
+
+(*
+   StartBuildDefinitionModule - Creates a definition module and starts
+                                a new scope.
+
+                                The Stack is expected:
+
+                                Entry                 Exit
+
+                         Ptr ->
+                                +------------+
+                                | NameStart  |                       <- Ptr
+                                |------------|        +------------+
+                                | NulName/"C"|        | NameStart  |
+                                |------------|        |------------|
+*)
+
+PROCEDURE P1StartBuildDefinitionModule ;
+
+
+(*
+   EndBuildDefinitionModule - Destroys the definition module scope and
+                              checks for correct name.
+
+                              The Stack is expected:
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +-----------+
+                              | NameEnd    |        |           |
+                              |------------|        |-----------|
+                              | NameStart  |        |           | <- Ptr
+                              |------------|        |-----------|
+*)
+
+PROCEDURE P1EndBuildDefinitionModule ;
+
+
+(*
+   StartBuildImplementationModule - Creates an implementation module and starts
+                                    a new scope.
+
+                                    The Stack is expected:
+
+                                    Entry                 Exit
+
+                             Ptr ->                                     <- Ptr
+                                    +------------+        +-----------+
+                                    | NameStart  |        | NameStart |
+                                    |------------|        |-----------|
+
+*)
+
+PROCEDURE P1StartBuildImplementationModule ;
+
+
+(*
+   EndBuildImplementationModule - Destroys the implementation module scope and
+                                  checks for correct name.
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->
+                                  +------------+        +-----------+
+                                  | NameEnd    |        |           |
+                                  |------------|        |-----------|
+                                  | NameStart  |        |           | <- Ptr
+                                  |------------|        |-----------|
+*)
+
+PROCEDURE P1EndBuildImplementationModule ;
+
+
+(*
+   StartBuildProgramModule - Creates a program module and starts
+                             a new scope.
+
+                             The Stack is expected:
+
+                             Entry                 Exit
+
+                      Ptr ->                                     <- Ptr
+                             +------------+        +-----------+
+                             | NameStart  |        | NameStart |
+                             |------------|        |-----------|
+
+*)
+
+PROCEDURE P1StartBuildProgramModule ;
+
+
+(*
+   EndBuildProgramModule - Destroys the program module scope and
+                           checks for correct name.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+        +-----------+
+                           | NameEnd    |        |           |
+                           |------------|        |-----------|
+                           | NameStart  |        |           | <- Ptr
+                           |------------|        |-----------|
+*)
+
+PROCEDURE P1EndBuildProgramModule ;
+
+
+(*
+   StartBuildInnerModule - Creates an Inner module and starts
+                           a new scope.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                                     <- Ptr
+                           +------------+        +-----------+
+                           | NameStart  |        | NameStart |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE StartBuildInnerModule ;
+
+
+(*
+   EndBuildInnermModule - Destroys the Inner module scope and
+                          checks for correct name.
+
+                          The Stack is expected:
+
+                          Entry                 Exit
+
+                   Ptr ->
+                          +------------+        +-----------+
+                          | NameEnd    |        |           |
+                          |------------|        |-----------|
+                          | NameStart  |        |           | <- Ptr
+                          |------------|        |-----------|
+*)
+
+PROCEDURE EndBuildInnerModule ;
+
+
+(*
+   BuildImportOuterModule - Builds imported identifiers into an outer module
+                            from a definition module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                                                  Error Condition
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildImportOuterModule (definition: BOOLEAN) ;
+
+
+(*
+   BuildExportOuterModule - Builds exported identifiers from an outer module
+                            to the outside world of library modules.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +--------------+
+                            | #          |        | #            |
+                            |------------|        |--------------|
+                            | Id1        |        | Id1          |
+                            |------------|        |--------------|
+                            .            .        .              .
+                            .            .        .              .
+                            .            .        .              .
+                            |------------|        |--------------|
+                            | Id#        |        | Id#          |
+                            |------------|        |--------------|
+                            | ExportTok  |        | QualifiedTok |
+                            |------------|        |--------------|
+
+                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;
+
+                            Error Condition
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildExportOuterModule ;
+
+
+(*
+   CheckExplicitExported - checks to see whether we are compiling
+                           a definition module and whether the ident
+                           is implicitly export qualified or unqualified.
+
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                Ptr ->
+                           +------------+        +-----------+
+                           | Identname  |        | Identname |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE CheckExplicitExported ;
+
+
+(*
+   BuildImportInnerModule - Builds imported identifiers into an inner module
+                            from the last level of module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                                                  Error Condition
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildImportInnerModule ;
+
+
+(*
+   BuildExportInnerModule - Builds exported identifiers from an inner module
+                            to the next layer module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +--------------+
+                            | #          |        | #            |
+                            |------------|        |--------------|
+                            | Id1        |        | Id1          |
+                            |------------|        |--------------|
+                            .            .        .              .
+                            .            .        .              .
+                            .            .        .              .
+                            |------------|        |--------------|
+                            | Id#        |        | Id#          |
+                            |------------|        |--------------|
+                            | ExportTok  |        | QualifiedTok |
+                            |------------|        |--------------|
+
+                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildExportInnerModule ;
+
+
+(*
+   StartBuildEnumeration - Builds an Enumeration type Type.
+
+
+                           Stack
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+
+                           | #          |
+                           |------------|
+                           | en 1       |
+                           |------------|
+                           | en 2       |
+                           |------------|
+                           .            .
+                           .            .
+                           .            .                       <- Ptr
+                           |------------|        +------------+
+                           | en #       |        | Type       |
+                           |------------|        |------------|
+                           | Name       |        | Name       |
+                           |------------|        |------------|
+*)
+
+PROCEDURE StartBuildEnumeration ;
+
+
+(*
+   EndBuildEnumeration - completes the construction of the enumeration type.
+
+
+                         Stack
+
+                         Entry                 Exit
+
+                  Ptr ->
+                         +------------+
+                         | Type       |                          <- Ptr
+                         |------------|        +---------------+
+                         | Name       |        | Type  | Name  |
+                         |------------|        |---------------|
+
+                                               Empty
+*)
+
+PROCEDURE EndBuildEnumeration ;
+
+
+(*
+   BuildHiddenType - Builds a Hidden Type.
+
+
+                     Stack
+
+                     Entry                 Exit
+
+              Ptr ->
+                     +------------+
+                     | Name       |                          <- Ptr
+                     |------------|        Empty
+*)
+
+PROCEDURE BuildHiddenType ;
+
+
+(*
+   StartBuildProcedure - Builds a Procedure.
+
+                         The Stack:
+
+                         Entry                 Exit
+
+                                                              <- Ptr
+                                               +------------+
+                  Ptr ->                       | ProcSym    |
+                         +------------+        |------------|
+                         | Name       |        | Name       |
+                         |------------|        |------------|
+*)
+
+PROCEDURE StartBuildProcedure ;
+
+
+(*
+   EndBuildProcedure - Ends building a Procedure.
+                       It checks the start procedure name matches the end
+                       procedure name.
+
+                       The Stack:
+
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +------------+
+                       | NameEnd    |
+                       |------------|
+                       | ProcSym    |
+                       |------------|
+                       | NameStart  |
+                       |------------|
+                                             Empty
+*)
+
+PROCEDURE EndBuildProcedure ;
+
+
+(*
+   BuildProcedureHeading - Builds a procedure heading for the definition
+                           module procedures.
+
+                           Operation only performed if compiling a
+                           definition module.
+
+                           The Stack:
+
+                           Entry                       Exit
+
+                    Ptr ->
+                           +------------+
+                           | ProcSym    |              Empty
+                           |------------|
+
+*)
+
+PROCEDURE BuildProcedureHeading ;
+
+
+(*
+   BuildNulName - Pushes a NulKey onto the top of the stack.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+                                                          <- Ptr
+                  Empty                    +------------+
+                                           | NulKey     |
+                                           |------------|
+*)
+
+PROCEDURE BuildNulName ;
+
+
+(*
+   BuildTypeEnd - Pops the type Type and Name.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+
+           Ptr ->
+                  +-------------+
+                  | Type | Name |          Empty
+                  |-------------|
+*)
+
+PROCEDURE BuildTypeEnd ;
+
+
+(*
+   BuildImportStatement - create a new import statement in the current module.
+                          It ignores local modules.
+
+                          The quadruple stack is not used.
+*)
+
+PROCEDURE BuildImportStatement (tok: CARDINAL) ;
+
+
+(*
+   AddImportToImportStatement - the top of stack is expected to be a module name.
+                                This is looked up from the module universe and
+                                wrapped in an import symbol and placed into the
+                                current import statement.
+
+                                The quadruple stack is unchanged.
+
+                                Entry                      Exit
+
+
+                         Ptr ->                                                   <- Ptr
+                                +---------------------+   +---------------------+
+                                | ImportedModuleName  |   | ImportedModuleName  |
+                                |---------------------|   |---------------------|
+*)
+
+PROCEDURE AddImportToImportStatement (qualified: BOOLEAN) ;
+
+
+END P1SymBuild.
diff --git a/gcc/m2/gm2-compiler/P1SymBuild.mod b/gcc/m2/gm2-compiler/P1SymBuild.mod
new file mode 100644
index 00000000000..06756bcf5d1
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P1SymBuild.mod
@@ -0,0 +1,1160 @@
+(* P1SymBuild.mod pass 1 symbol creation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE P1SymBuild ;
+
+
+FROM ASCII IMPORT nul ;
+FROM NameKey IMPORT Name, WriteKey, MakeKey, KeyToCharStar, NulName ;
+FROM M2Debug IMPORT Assert, WriteDebug ;
+FROM M2LexBuf IMPORT GetFileName, GetTokenNo, UnknownTokenNo ;
+FROM M2MetaError IMPORT MetaErrorString2, MetaError0, MetaError1, MetaError2, MetaErrorT1, MetaErrorT2 ;
+FROM DynamicStrings IMPORT String, Slice, InitString, KillString, EqualCharStar, RIndex, Mark, ConCat ;
+FROM M2Printf IMPORT printf0, printf1, printf2 ;
+FROM M2Options IMPORT Iso ;
+
+FROM M2Reserved IMPORT ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
+                       NulTok, VarTok, ArrayTok, BuiltinTok, InlineTok ;
+
+FROM FifoQueue IMPORT PutEnumerationIntoFifoQueue ;
+FROM P0SymBuild IMPORT EnterBlock, LeaveBlock ;
+
+FROM SymbolTable IMPORT NulSym,
+                        ModeOfAddr,
+                        AppendModuleOnImportStatement,
+                        AppendModuleImportStatement,
+                        MakeImportStatement, MakeImport,
+
+                        StartScope, EndScope, PseudoScope,
+                        GetScope, GetCurrentScope,
+                        IsDeclaredIn,
+                        SetCurrentModule, SetFileModule,
+                        MakeInnerModule,
+                        MakeEnumeration, MakeSubrange,
+                        MakeVar, MakeType, PutType,
+                        MakeHiddenType,
+                        PutMode,
+                        PutFieldEnumeration, PutSubrange, PutVar,
+                        IsDefImp, IsModule, IsInnerModule, IsType,
+                        GetCurrentModule,
+                        AddSymToModuleScope,
+                        AddNameToImportList,
+                        GetSym, RequestSym, IsUnknown, RenameSym,
+                        GetFromOuterModule,
+                        GetExported, IsExported,
+                        GetLocalSym,
+                        PutImported, PutIncludedByDefinition,
+                        PutExported, PutExportQualified, PutExportUnQualified,
+                        TryMoveUndeclaredSymToInnerModule,
+                        PutDefinitionForC,
+                        IsDefinitionForC,
+                        PutDoesNeedExportList, PutDoesNotNeedExportList,
+                        DoesNotNeedExportList,
+                        MakeProcedure,
+                        PutFunction, PutParam, PutVarParam,
+                        GetNthParam,
+                        IsProcedure, IsConstString,
+                        MakePointer, PutPointer,
+                        MakeRecord, PutFieldRecord,
+                        MakeArray,
+                        MakeSubscript, PutSubscript,
+                        PutArray, GetType, IsArray,
+                        IsProcType, MakeProcType,
+                        PutProcTypeVarParam, PutProcTypeParam,
+                        PutProcedureBuiltin, PutProcedureInline,
+                        GetSymName,
+                        ResolveImports, PutDeclared,
+                        MakeError, MakeErrorS,
+                        DisplayTrees ;
+
+FROM M2Batch IMPORT MakeDefinitionSource,
+                    MakeImplementationSource,
+                    MakeProgramSource,
+                    LookupModule, LookupOuterModule ;
+
+FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, OperandT, PopN, OperandTok,
+                    PopTtok, PushTtok, PushTFtok, PopTFtok ;
+
+FROM M2Comp IMPORT CompilingDefinitionModule,
+                   CompilingImplementationModule,
+                   CompilingProgramModule ;
+
+CONST
+   Debugging = FALSE ;
+
+VAR
+   importStatementCount: CARDINAL ;
+
+
+(*
+   CheckFileName - checks to see that the module name matches the file name.
+*)
+
+(*
+PROCEDURE CheckFileName (tok: CARDINAL; name: Name; ModuleType: ARRAY OF CHAR) ;
+VAR
+   ext,
+   basename: INTEGER ;
+   s,
+   FileName: String ;
+BEGIN
+   FileName := GetFileName() ;
+   basename := RIndex(FileName, '/', 0) ;
+   IF basename=-1
+   THEN
+      basename := 0
+   END ;
+   ext := RIndex(FileName, '.', 0) ;
+   IF ext=-1
+   THEN
+      ext := 0
+   END ;
+   FileName := Slice(FileName, basename, ext) ;
+   IF EqualCharStar(FileName, KeyToCharStar(name))
+   THEN
+      FileName := KillString(FileName)
+   ELSE
+      s := ConCat (InitString (ModuleType),
+                   Mark (InitString (" module name {%1Ea} is inconsistant with the filename {%F{%2a}}"))) ;
+      MetaErrorString2 (s, MakeError (tok, name), MakeErrorS (tok, FileName))
+   END
+END CheckFileName ;
+*)
+
+
+(*
+   StartBuildDefinitionModule - Creates a definition module and starts
+                                a new scope.
+
+                                he Stack is expected:
+
+                                Entry                 Exit
+
+                         Ptr ->
+                                +------------+
+                                | NameStart  |                       <- Ptr
+                                |------------|        +------------+
+                                | NulName/"C"|        | NameStart  |
+                                |------------|        |------------|
+*)
+
+PROCEDURE P1StartBuildDefinitionModule ;
+VAR
+   name     : Name ;
+   language,
+   ModuleSym: CARDINAL ;
+BEGIN
+   importStatementCount := 0 ;
+   PopT(name) ;
+   (* CheckFileName(name, 'definition') ; *)
+   ModuleSym := MakeDefinitionSource(GetTokenNo(), name) ;
+   PutDoesNotNeedExportList(ModuleSym) ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   StartScope(ModuleSym) ;
+   Assert(IsDefImp(ModuleSym)) ;
+   Assert(CompilingDefinitionModule()) ;
+   PopT(language) ;
+   IF (language#NulSym) AND IsConstString(language)
+   THEN
+      IF GetSymName(language)=MakeKey('C')
+      THEN
+         PutDefinitionForC(ModuleSym)
+      ELSIF GetSymName(language)=NulName
+      THEN
+         MetaError0 ('{%E}currently a non modula-2 definition module can only be declared as DEFINITION FOR {%k"C"}')
+      ELSE
+         MetaError1 ('unknown definition module language {%1Ea}, currently a non modula-2 definition module can only be declared as DEFINITION FOR {%k"C"}', language)
+      END
+   END ;
+   PushT(name) ;
+   EnterBlock(name)
+END P1StartBuildDefinitionModule ;
+
+
+(*
+   EndBuildDefinitionModule - Destroys the definition module scope and
+                              checks for correct name.
+
+                              The Stack is expected:
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +-----------+
+                              | NameEnd    |        |           |
+                              |------------|        |-----------|
+                              | NameStart  |        |           | <- Ptr
+                              |------------|        |-----------|
+*)
+
+PROCEDURE P1EndBuildDefinitionModule ;
+VAR
+   start    : CARDINAL ;
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   Assert(CompilingDefinitionModule()) ;
+   EndScope ;
+   PopTtok(NameStart, start) ;
+   PopT(NameEnd) ;
+   IF Debugging
+   THEN
+      printf0('pass 1: ') ;
+      DisplayTrees(GetCurrentModule())
+   END ;
+   IF NameStart#NameEnd
+   THEN
+      MetaError1 ('inconsistant definition module name {%1Wa}', MakeError (start, NameStart))
+   END ;
+   LeaveBlock
+END P1EndBuildDefinitionModule ;
+
+
+(*
+   StartBuildImplementationModule - Creates an implementation module and starts
+                                    a new scope.
+
+                                    The Stack is expected:
+
+                                    Entry                 Exit
+
+                             Ptr ->                                     <- Ptr
+                                    +------------+        +-----------+
+                                    | NameStart  |        | NameStart |
+                                    |------------|        |-----------|
+
+*)
+
+PROCEDURE P1StartBuildImplementationModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   importStatementCount := 0 ;
+   PopTtok (name, tok) ;
+   (* CheckFileName(name, 'implementation') ; *)
+   ModuleSym := MakeImplementationSource (tok, name) ;
+   SetCurrentModule (ModuleSym) ;
+   SetFileModule (ModuleSym) ;
+   StartScope (ModuleSym) ;
+   IF NOT IsDefImp (ModuleSym)
+   THEN
+      MetaError1 ('cannot find corresponding definition module for {%1Ea}', ModuleSym)
+   END ;
+   Assert (CompilingImplementationModule()) ;
+   PushTtok (name, tok) ;
+   EnterBlock (name)
+END P1StartBuildImplementationModule ;
+
+
+(*
+   EndBuildImplementationModule - Destroys the implementation module scope and
+                                  checks for correct name.
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->
+                                  +------------+        +-----------+
+                                  | NameEnd    |        |           |
+                                  |------------|        |-----------|
+                                  | NameStart  |        |           | <- Ptr
+                                  |------------|        |-----------|
+*)
+
+PROCEDURE P1EndBuildImplementationModule ;
+VAR
+   start, end: CARDINAL ;
+   NameStart,
+   NameEnd   : Name ;
+BEGIN
+   ResolveImports ;
+   Assert(CompilingImplementationModule()) ;
+   EndScope ;
+   PopTtok(NameStart, start) ;
+   PopTtok(NameEnd, end) ;
+   IF NameStart#NameEnd
+   THEN
+      MetaErrorT1 (end,
+                   'inconsistant implementation module name {%1Wa}', MakeError (start, NameStart))
+   END ;
+   LeaveBlock
+END P1EndBuildImplementationModule ;
+
+
+(*
+   StartBuildProgramModule - Creates a program module and starts
+                             a new scope.
+
+                             The Stack is expected:
+
+                             Entry                 Exit
+
+                      Ptr ->                                     <- Ptr
+                             +------------+        +-----------+
+                             | NameStart  |        | NameStart |
+                             |------------|        |-----------|
+
+*)
+
+PROCEDURE P1StartBuildProgramModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   importStatementCount := 0 ;
+   PopTtok(name, tok) ;
+   (* CheckFileName(name, 'main') ; *)
+   ModuleSym := MakeProgramSource(tok, name) ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   StartScope(ModuleSym) ;
+   IF (NOT CompilingProgramModule()) OR IsDefImp(ModuleSym)
+   THEN
+      MetaErrorT1 (tok,
+                   'module {%1Ea} has a corresponding DEFINITION MODULE but no IMPLEMENTATION keyword in the main module', ModuleSym)
+   END ;
+   PushTtok(name, tok) ;
+   EnterBlock(name)
+END P1StartBuildProgramModule ;
+
+
+(*
+   EndBuildProgramModule - Destroys the program module scope and
+                           checks for correct name.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+        +-----------+
+                           | NameEnd    |        |           |
+                           |------------|        |-----------|
+                           | NameStart  |        |           | <- Ptr
+                           |------------|        |-----------|
+*)
+
+PROCEDURE P1EndBuildProgramModule ;
+VAR
+   start,
+   end      : CARDINAL ;
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   ResolveImports ;
+   Assert(CompilingProgramModule()) ;
+   EndScope ;
+   PopTtok(NameStart, start) ;
+   PopTtok(NameEnd, end) ;
+   IF Debugging
+   THEN
+      printf0('pass 1: ') ;
+      DisplayTrees(GetCurrentModule())
+   END ;
+   IF NameStart#NameEnd
+   THEN
+      MetaErrorT1 (end,
+                   'inconsistant program module name {%1Wa}', MakeError (start, NameStart))
+   END ;
+   LeaveBlock
+END P1EndBuildProgramModule ;
+
+
+(*
+   StartBuildInnerModule - Creates an Inner module and starts
+                           a new scope.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                                     <- Ptr
+                           +------------+        +-----------+
+                           | NameStart  |        | NameStart |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE StartBuildInnerModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopTtok(name, tok) ;
+   ModuleSym := GetSym(name) ;
+   Assert(ModuleSym#NulSym) ;
+   StartScope(ModuleSym) ;
+   Assert(NOT IsDefImp(ModuleSym)) ;
+   PushTtok(name, tok) ;
+   EnterBlock(name)
+END StartBuildInnerModule ;
+
+
+(*
+   EndBuildInnerModule - Destroys the Inner module scope and
+                         checks for correct name.
+
+                         The Stack is expected:
+
+                         Entry                 Exit
+
+                  Ptr ->
+                         +------------+        +-----------+
+                         | NameEnd    |        |           |
+                         |------------|        |-----------|
+                         | NameStart  |        |           | <- Ptr
+                         |------------|        |-----------|
+*)
+
+PROCEDURE EndBuildInnerModule ;
+VAR
+   start, end: CARDINAL ;
+   NameStart,
+   NameEnd   : Name ;
+BEGIN
+   EndScope ;
+   PopTtok(NameStart, start) ;
+   PopTtok(NameEnd, end) ;
+   IF NameStart#NameEnd
+   THEN
+      MetaErrorT1 (end,
+                   'inconsistant inner module name {%1Wa}', MakeError (start, NameStart))
+   END ;
+   LeaveBlock
+END EndBuildInnerModule ;
+
+
+(*
+   BuildImportOuterModule - Builds imported identifiers into an outer module
+                            from a definition module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildImportOuterModule (definition: BOOLEAN) ;
+VAR
+   Sym, ModSym,
+   i, n       : CARDINAL ;
+BEGIN
+   PopT(n) ;       (* n   = # of the Ident List *)
+   IF OperandT(n+1)=ImportTok
+   THEN
+      (* Ident list contains Module Names *)
+      i := 1 ;
+      WHILE i<=n DO
+         ModSym := LookupModule(OperandTok(n+1-i),
+                                OperandT(n+1-i)) ;
+         PutImported(ModSym) ;
+         IF definition
+         THEN
+            PutIncludedByDefinition(ModSym)
+         END ;
+         INC(i)
+      END
+   ELSE
+      (* Ident List contains list of objects *)
+      ModSym := LookupModule(OperandTok(n+1),
+                             OperandT(n+1)) ;
+      i := 1 ;
+      WHILE i<=n DO
+(*
+         WriteString('Importing ') ; WriteKey(Operand(j)) ; WriteString(' from ') ; WriteKey(GetSymName(ModSym)) ; WriteLn ;
+*)
+         Sym := GetExported (OperandTok (n+1-i),
+                             ModSym, OperandT (n+1-i)) ;
+         PutImported (Sym) ;
+         INC (i)
+      END
+   END ;
+   PopN (n+1)   (* clear stack *)
+END BuildImportOuterModule ;
+
+
+(*
+   BuildExportOuterModule - Builds exported identifiers from an outer module
+                            to the outside world of library modules.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +--------------+
+                            | #          |        | #            |
+                            |------------|        |--------------|
+                            | Id1        |        | Id1          |
+                            |------------|        |--------------|
+                            .            .        .              .
+                            .            .        .              .
+                            .            .        .              .
+                            |------------|        |--------------|
+                            | Id#        |        | Id#          |
+                            |------------|        |--------------|
+                            | ExportTok  |        | QualifiedTok |
+                            |------------|        |--------------|
+
+                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;
+
+                            Error Condition
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildExportOuterModule ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   PopT (n) ;       (* n   = # of the Ident List *)
+   IF (OperandT(n+1)=QualifiedTok) AND CompilingDefinitionModule()
+   THEN
+      PutDoesNeedExportList(GetCurrentModule()) ;
+      (* Ident List contains list of export qualified objects *)
+      i := 1 ;
+      WHILE i<=n DO
+         PutExportQualified (OperandTok (i), OperandT (i)) ;
+         INC (i)
+      END
+   ELSIF (OperandT(n+1)=UnQualifiedTok) AND CompilingDefinitionModule()
+   THEN
+      PutDoesNeedExportList(GetCurrentModule()) ;
+      (* Ident List contains list of export unqualified objects *)
+      i := 1 ;
+      WHILE i<=n DO
+         PutExportUnQualified (OperandTok (i), OperandT(i)) ;
+         INC (i)
+      END
+   ELSIF CompilingDefinitionModule()
+   THEN
+      MetaError0 ('the {%EkEXPORT} must be either {%kQUALIFIED} or {%kUNQUALIFIED} in a definition module')
+   ELSE
+      MetaError0 ('{%E}only allowed inter module exports in a definition module')
+   END ;
+   PopN (n+1)  (* clear stack *)
+END BuildExportOuterModule ;
+
+
+(*
+   CheckExplicitExported - checks to see whether we are compiling
+                           a definition module and whether the ident
+                           is implicitly export qualified or unqualified.
+
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->                Ptr ->
+                                  +------------+        +-----------+
+                                  | Identname  |        | Identname |
+                                  |------------|        |-----------|
+
+*)
+
+PROCEDURE CheckExplicitExported ;
+BEGIN
+   IF CompilingDefinitionModule() AND DoesNotNeedExportList(GetCurrentModule())
+   THEN
+      (* printf1('exporting identifier %a\n', OperandT(1)) ; *)
+      PutExportQualified (OperandTok (1), OperandT(1))
+   END
+END CheckExplicitExported ;
+
+
+(*
+   BuildImportInnerModule - Builds imported identifiers into an inner module
+                            from the last level of module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildImportInnerModule ;
+VAR
+   Sym, ModSym,
+   i, n       : CARDINAL ;
+BEGIN
+   PopT (n) ;       (* n   = # of the Ident List *)
+   IF OperandT (n+1) = ImportTok
+   THEN
+      (* Ident List contains list of objects *)
+      i := 1 ;
+      WHILE i<=n DO
+         AddNameToImportList (OperandT (i)) ;
+         INC (i)
+      END
+   ELSE
+      (* Ident List contains list of objects *)
+      ModSym := LookupOuterModule (OperandTok(n+1),
+                                   OperandT(n+1)) ;
+      i := 1 ;
+      WHILE i<=n DO
+         Sym := GetExported (OperandTok (n+1-i), ModSym, OperandT (n+1-i)) ;
+         PutImported (Sym) ;
+         INC (i)
+      END
+   END ;
+   PopN (n+1)    (* clear stack *)
+END BuildImportInnerModule ;
+
+
+(*
+   BuildExportInnerModule - Builds exported identifiers from an inner module
+                            to the next layer module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +--------------+
+                            | #          |        | #            |
+                            |------------|        |--------------|
+                            | Id1        |        | Id1          |
+                            |------------|        |--------------|
+                            .            .        .              .
+                            .            .        .              .
+                            .            .        .              .
+                            |------------|        |--------------|
+                            | Id#        |        | Id#          |
+                            |------------|        |--------------|
+                            | ExportTok  |        | QualifiedTok |
+                            |------------|        |--------------|
+
+                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;
+
+
+                            Exit
+
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildExportInnerModule ;
+VAR
+   tok    : CARDINAL ;
+   PrevMod,
+   Sym,
+   i, n   : CARDINAL ;
+BEGIN
+   PopT (n) ;       (* n   = # of the Ident List *)
+   IF OperandT (n+1) = ExportTok
+   THEN
+      (* Ident List contains list of objects *)
+      i := 1 ;
+      PrevMod := GetScope (GetCurrentScope ()) ;
+      WHILE i<=n DO
+         tok := OperandTok (i) ;
+         IF (PrevMod#NulSym) AND (IsModule(PrevMod) OR IsDefImp(PrevMod))
+         THEN
+            Sym := GetLocalSym (PrevMod, OperandT(i)) ;
+            IF Sym=NulSym
+            THEN
+               Sym := TryMoveUndeclaredSymToInnerModule (PrevMod, GetCurrentScope (), OperandT (i)) ;
+               IF Sym=NulSym
+               THEN
+                  Sym := RequestSym (tok, OperandT(i)) ;
+                  PutExported (Sym)
+               END
+            ELSE
+               (* use Sym which has already been created in outer scope *)
+               AddSymToModuleScope (GetCurrentScope (), Sym)
+            END
+         ELSE
+            Sym := RequestSym (tok, OperandT(i)) ;
+            PutExported (Sym)
+         END ;
+         INC (i)
+      END
+   ELSE
+      MetaError0 ('{%EkQUALIFIED} not allowed in an inner module')
+   END ;
+   PopN(n+1)    (* clear stack *)
+END BuildExportInnerModule ;
+
+
+(*
+   StartBuildEnumeration - Builds an Enumeration type Type.
+
+
+                           Stack
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+
+                           | #          |
+                           |------------|
+                           | en 1       |
+                           |------------|
+                           | en 2       |
+                           |------------|
+                           .            .
+                           .            .
+                           .            .                       <- Ptr
+                           |------------|        +------------+
+                           | en #       |        | Type       |
+                           |------------|        |------------|
+                           | Name       |        | Name       |
+                           |------------|        |------------|
+*)
+
+PROCEDURE StartBuildEnumeration ;
+VAR
+   name : Name ;
+   n, i,
+   Type : CARDINAL ;
+   tokno: CARDINAL ;
+BEGIN
+   PopT(n) ;      (* No := # *)
+   name := OperandT(n+1) ;
+   tokno := OperandTok(n+1) ;
+   Type := MakeEnumeration(tokno, name) ;
+   i := 1 ;
+   WHILE i<=n DO
+      PutFieldEnumeration(OperandTok(n-i+1), Type, OperandT(n-i+1)) ;
+      INC(i)
+   END ;
+   PutEnumerationIntoFifoQueue(Type) ;  (* store enumeration away for pass 2 *)
+   PopN(n+1) ;
+   PushTtok(name, tokno) ;
+   PushTtok(Type, tokno)
+END StartBuildEnumeration ;
+
+
+(*
+   EndBuildEnumeration - completes the construction of the enumeration type.
+
+
+                         Stack
+
+                         Entry                 Exit
+
+                  Ptr ->
+                         +------------+
+                         | Type       |                          <- Ptr
+                         |------------|        +---------------+
+                         | Name       |        | Type  | Name  |
+                         |------------|        |---------------|
+
+                                               Empty
+*)
+
+PROCEDURE EndBuildEnumeration ;
+VAR
+   tokno : CARDINAL ;
+   Sym,
+   Type  : CARDINAL ;
+   n1, n2,
+   name  : Name ;
+BEGIN
+   (*
+      Two cases
+
+      - the type name the same as Name, or the name is nul. - do nothing.
+      - when type with a name that is different to Name. In which case
+        we create a new type.
+   *)
+   PopTtok(Type, tokno) ;
+   PopT(name) ;
+
+   IF Debugging
+   THEN
+      n1 := GetSymName(GetCurrentModule()) ;
+      printf2('inside module %a declaring type name %a\n',
+              n1, name) ;
+      IF (NOT IsUnknown(Type))
+      THEN
+         n1 := GetSymName(GetScope(Type)) ;
+         n2 := GetSymName(Type) ;
+         printf2('type was created inside scope %a as name %a\n',
+                 n1, n2)
+      END
+   END ;
+   IF (name=NulName) OR (GetSymName(Type)=name)
+   THEN
+      (*
+         Typically the declaration that causes this case is:
+
+         VAR
+            a: (blue, green, red) ;
+             ^
+             |
+             +---- type has no name.
+
+         in which case the constructed from StartBuildEnumeration is complete
+      *)
+      PushTFtok(Type, name, tokno)
+   ELSE
+      (* in this case we are seeing:
+
+         TYPE
+            name = (blue, green, red)
+
+         so we construct the type name and define it to have the previously
+         created enumeration type
+      *)
+      Sym := MakeType(tokno, name) ;
+      PutType(Sym, Type) ;
+      PushTFtok(Sym, name, tokno)
+   END
+END EndBuildEnumeration ;
+
+
+(*
+   BuildHiddenType - Builds a Hidden Type.
+
+
+                     Stack
+
+                     Entry                 Exit
+
+              Ptr ->
+                     +------------+
+                     | Name       |                          <- Ptr
+                     |------------|        Empty
+*)
+
+PROCEDURE BuildHiddenType ;
+VAR
+   name : Name ;
+   tokno: CARDINAL ;
+BEGIN
+   PopTtok (name, tokno) ;
+   (* WriteString('Hidden type encountered: ') ; *)
+   (* WriteKey(Name) ; WriteLn ; *)
+   Assert (MakeHiddenType (tokno, name) # NulSym)
+END BuildHiddenType ;
+
+
+(*
+   StartBuildProcedure - Builds a Procedure.
+
+                         The Stack:
+
+                         Entry                 Exit
+
+                  Ptr ->                                      <- Ptr
+                         +------------+        +------------+
+                         | Name       |        | ProcSym    |
+                         |------------|        |------------|
+                         | inlinetok  |        |            |
+                         | or         |        |            |
+                         | builtintok |        |            |
+                         | or name or |        | Name       |
+                         | NulTok     |        |            |
+                         |------------|        |------------|
+*)
+
+PROCEDURE StartBuildProcedure ;
+VAR
+   tokno   : CARDINAL ;
+   builtin,
+   name    : Name ;
+   ProcSym : CARDINAL ;
+BEGIN
+   PopTtok (name, tokno) ;
+   PopT (builtin) ; (* was this procedure defined as a builtin?        *)
+   PushTtok (name, tokno) ;   (* Name saved for the EndBuildProcedure name check *)
+   ProcSym := RequestSym (tokno, name) ;
+   IF IsUnknown (ProcSym)
+   THEN
+      (*
+         May have been compiled in DEF or IMP module, remember that IMP maybe
+         compiled before corresponding DEF module.
+      *)
+      ProcSym := MakeProcedure (tokno, name)
+   ELSIF IsProcedure (ProcSym)
+   THEN
+      (* declared in the other module, we record declaration here as well *)
+      PutDeclared (tokno, ProcSym)
+   ELSE
+      MetaError1 ('expecting a procedure name and symbol {%1Ea} has been declared as a {%1d}', ProcSym) ;
+      PushT (ProcSym) ;
+      RETURN
+   END ;
+   IF builtin#NulTok
+   THEN
+      IF builtin=BuiltinTok
+      THEN
+         PutProcedureBuiltin (ProcSym, name)
+      ELSIF builtin=InlineTok
+      THEN
+         PutProcedureInline (ProcSym)
+      ELSE
+         PutProcedureBuiltin (ProcSym, builtin)
+      END
+   END ;
+   PushT (ProcSym) ;
+   StartScope (ProcSym) ;
+   IF NOT CompilingDefinitionModule ()
+   THEN
+      EnterBlock (name)
+   END
+END StartBuildProcedure ;
+
+
+(*
+   EndBuildProcedure - Ends building a Procedure.
+                       It checks the start procedure name matches the end
+                       procedure name.
+
+                       The Stack:
+
+                       (Procedure Not Defined in definition module)
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +------------+
+                       | NameEnd    |
+                       |------------|
+                       | ProcSym    |
+                       |------------|
+                       | NameStart  |
+                       |------------|
+                                             Empty
+*)
+
+PROCEDURE EndBuildProcedure ;
+VAR
+   start, end: CARDINAL ;
+   ProcSym   : CARDINAL ;
+   NameEnd,
+   NameStart : Name ;
+BEGIN
+   PopTtok(NameEnd, end) ;
+   PopT(ProcSym) ;
+   PopTtok(NameStart, start) ;
+   IF NameEnd#NameStart
+   THEN
+      IF end # UnknownTokenNo
+      THEN
+         MetaErrorT1 (end,
+                      'procedure name at end does not match name at beginning {%1EDa}', ProcSym)
+      ELSIF start # UnknownTokenNo
+      THEN
+         MetaErrorT2 (start,
+                      'procedure name at end {%1EDa} does not match name at beginning {%2a}',
+                      MakeError (end, NameEnd), ProcSym)
+      ELSE
+         MetaError1 ('procedure name at end does not match name at beginning {%1EDa}', ProcSym)
+      END
+   END ;
+   EndScope ;
+   Assert (NOT CompilingDefinitionModule()) ;
+   LeaveBlock
+END EndBuildProcedure ;
+
+
+(*
+   BuildProcedureHeading - Builds a procedure heading for the definition
+                           module procedures.
+
+                           Operation only performed if compiling a
+                           definition module.
+
+                           The Stack:
+
+                           Entry                       Exit
+
+                    Ptr ->
+                           +------------+
+                           | ProcSym    |
+                           |------------|
+                           | NameStart  |
+                           |------------|
+                                                       Empty
+
+*)
+
+PROCEDURE BuildProcedureHeading ;
+VAR
+   ProcSym  : CARDINAL ;
+   NameStart: Name ;
+BEGIN
+   IF CompilingDefinitionModule()
+   THEN
+      PopT(ProcSym) ;
+      PopT(NameStart) ;
+      EndScope
+   END
+END BuildProcedureHeading ;
+
+
+(*
+   BuildNulName - Pushes a NulName onto the top of the stack.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+                                                          <- Ptr
+                  Empty                    +------------+
+                                           | NulName    |
+                                           |------------|
+*)
+
+PROCEDURE BuildNulName ;
+BEGIN
+   PushT(NulName)
+END BuildNulName ;
+
+
+(*
+   BuildTypeEnd - Pops the type Type and Name.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+
+           Ptr ->
+                  +-------------+
+                  | Type | Name |          Empty
+                  |-------------|
+*)
+
+PROCEDURE BuildTypeEnd ;
+VAR
+   Type: CARDINAL ;
+   name: Name ;
+BEGIN
+   PopTF (Type, name)
+END BuildTypeEnd ;
+
+
+(*
+   BuildImportStatement - create a new import statement in the current module.
+                          It ignores local modules.
+
+                          The quadruple stack is not used.
+*)
+
+PROCEDURE BuildImportStatement (tok: CARDINAL) ;
+VAR
+   scope: CARDINAL ;
+BEGIN
+   scope := GetCurrentScope () ;
+   IF IsDefImp (scope) OR (IsModule (scope) AND (NOT IsInnerModule (scope)))
+   THEN
+      IF CompilingDefinitionModule () AND (NOT IsDefImp (scope))
+      THEN
+         MetaError1 ('module scope should be a definition module rather than {%1EDa}', scope)
+      ELSE
+         INC (importStatementCount) ;
+         AppendModuleImportStatement (scope, MakeImportStatement (tok, importStatementCount))
+      END
+   END
+END BuildImportStatement ;
+
+
+(*
+   AddImportToImportStatement - the top of stack is expected to be a module name.
+                                This is looked up from the module universe and
+                                wrapped in an import symbol and placed into the
+                                current import statement.
+
+                                The quadruple stack is unchanged.
+
+                                Entry                      Exit
+
+
+                         Ptr ->                                                   <- Ptr
+                                +---------------------+    +---------------------+
+                                | ImportedModuleName  |    | ImportedModuleName  |
+                                |---------------------|    |---------------------|
+*)
+
+PROCEDURE AddImportToImportStatement (qualified: BOOLEAN) ;
+VAR
+   scope: CARDINAL ;
+BEGIN
+   scope := GetCurrentScope () ;
+   IF IsDefImp (scope) OR (IsModule (scope) AND (NOT IsInnerModule (scope)))
+   THEN
+      IF CompilingDefinitionModule () AND (NOT IsDefImp (scope))
+      THEN
+         MetaError1 ('module scope should be a definition module rather than {%1EDa}', scope) ;
+      ELSE
+         AppendModuleOnImportStatement (scope, MakeImport (OperandTok (1),
+                                                           LookupModule (OperandTok (1), OperandT (1)),
+                                                           importStatementCount, qualified))
+      END
+   END
+END AddImportToImportStatement ;
+
+
+END P1SymBuild.
diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf
new file mode 100644
index 00000000000..590047eecbe
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P2Build.bnf
@@ -0,0 +1,1237 @@
+--
+-- m2-2.bnf grammar and associated actions for pass 2.
+--
+-- Copyright (C) 2001-2022 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/>.
+% module P2Build begin
+(* output from m2-2.bnf, automatically generated do not edit if these
+   are the top two lines in the file.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+
+IMPLEMENTATION MODULE P2Build ;
+
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ;
+FROM M2MetaError IMPORT MetaErrorStringT0, MetaErrorT1 ;
+FROM NameKey IMPORT NulName, Name, makekey, MakeKey ;
+FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok ;
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
+FROM M2Printf IMPORT printf0 ;
+FROM M2Debug IMPORT Assert ;
+
+FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, OperandT, PushTFA, Top, Annotate,
+                    PushTFtok, PopTFtok, PushTFAtok, PopTtok, PushTtok,
+                    StartBuildInit,
+                    EndBuildInit,
+                    BuildProcedureStart,
+                    BuildProcedureEnd,
+                    BuildAssignment,
+                    BuildInline,
+                    AddRecordToList, AddVarientToList,
+                    IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack ;
+
+FROM P2SymBuild IMPORT P2StartBuildProgramModule,
+                       P2EndBuildProgramModule,
+                       P2StartBuildDefModule,
+                       P2EndBuildDefModule,
+                       P2StartBuildImplementationModule,
+                       P2EndBuildImplementationModule,
+                       StartBuildInnerModule,
+                       EndBuildInnerModule,
+
+                       BuildImportOuterModule,
+                       BuildImportInnerModule,
+                       BuildExportOuterModule,
+                       BuildExportInnerModule,
+
+                       BlockStart, BlockEnd, BlockBegin, BlockFinally,
+                       BuildString, BuildNumber,
+                       BuildConst,
+                       BuildVariable,
+                       BuildTypeEnd,
+                       BuildNulName,
+                       BuildType,
+                       StartBuildEnumeration,
+
+                       StartBuildFormalParameters,
+                       EndBuildFormalParameters,
+                       BuildFPSection,
+                       BuildVarArgs,
+                       BuildOptArg,
+                       BuildFormalVarArgs,
+                       BuildProcedureHeading,
+                       StartBuildProcedure,
+                       EndBuildProcedure,
+                       BuildFunction, BuildOptFunction,
+
+                       BuildPointerType,
+                       BuildRecord, BuildFieldRecord,
+                       StartBuildVarient, EndBuildVarient,
+                       BuildVarientSelector,
+                       StartBuildVarientFieldRecord,
+                       EndBuildVarientFieldRecord,
+                       BuildNulName,
+                       StartBuildArray,
+                       EndBuildArray,
+                       BuildFieldArray, BuildArrayComma,
+                       BuildSubrange, BuildAligned,
+                       BuildTypeAlignment, BuildVarAlignment,
+                       P2BuildDefaultFieldAlignment, BuildPragmaConst,
+                       BuildSetType,
+                       BuildFormalType, BuildFunction, BuildProcedureType,
+                       DetermineType, PushType, PopType,
+                       SeenUnknown, SeenSet, SeenString, SeenArray, SeenConstructor,
+                       SeenCast,
+                       PushRememberConstant, PopRememberConstant ;
+
+FROM M2Reserved IMPORT ArrayTok, VarTok ;
+
+FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
+                        PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
+                        MakeRegInterface,
+                        PutRegInterface, GetRegInterface,
+                        GetSymName, GetType, MakeConstLit,
+                        NulSym,
+                        StartScope, EndScope,
+                        PutIncluded,
+                        PutExceptionFinally, PutExceptionBlock, GetCurrentScope,
+                        IsVarParam, IsProcedure, IsDefImp, IsModule,
+                        IsRecord, IsAModula2Type,
+                        RequestSym ;
+
+IMPORT M2Error ;
+
+
+CONST
+   Debugging = FALSE ;
+   Pass1     = FALSE ;          (* permanently disabled for the time being *)
+   Pass2     =  TRUE ;
+   Pass3     = FALSE ;          (* permanently disabled for the time being *)
+
+VAR
+   WasNoError: BOOLEAN ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   MetaErrorStringT0 (GetTokenNo (), s) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString (InitString (a))
+END ErrorArray ;
+
+
+% declaration P2Build begin
+
+(*
+   checkReturnAttribute -
+*)
+
+PROCEDURE checkReturnAttribute ;
+VAR
+   ident: Name ;
+   tok  : CARDINAL ;
+BEGIN
+   PopTtok (ident, tok) ;
+   IF ident # MakeKey ('noreturn')
+   THEN
+      MetaErrorT1 (tok, 'attribute {%1k} is not allowed in the procedure return type, only noreturn is allowed', ident)
+   END
+END checkReturnAttribute ;
+
+
+(*
+   checkParameterAttribute -
+*)
+
+PROCEDURE checkParameterAttribute ;
+VAR
+   ident: Name ;
+   tok  : CARDINAL ;
+BEGIN
+   PopTtok (ident, tok) ;
+   IF ident # MakeKey ('unused')
+   THEN
+      MetaErrorT1 (tok, 'attribute {%1k} is not allowed in the parameter formal type section, only unused is allowed', ident)
+   END
+END checkParameterAttribute ;
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   WHILE NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      GetToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError(stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD (t) <32
+   THEN
+      INCL (s0, t)
+   ELSIF ORD (t) <64
+   THEN
+      INCL (s1, t)
+   ELSE
+      INCL (s2, t)
+   END ;
+   str := DescribeStop (s0, s1, s2) ;
+
+   str := ConCat (InitString ('syntax error,'), Mark (str)) ;
+   MetaErrorStringT0 (GetTokenNo (), str)
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken(t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0('inserting token\n')
+      END ;
+      InsertToken(t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken(t) ;
+      InsertTokenAndRewind(t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      GetToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   RETURN( WasNoError )
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok(makekey(currentstring), identtok, GetTokenNo()) ;
+      Annotate("%1n|identtok||Ident rule")
+   END ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTF(makekey(currentstring), stringtok) ;
+      BuildString
+   END ;
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), integertok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), realtok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module P2Build end
+END P2Build.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuilt procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit :=                                                                % PushAutoOn %
+            ( DefinitionModule |
+              ImplementationOrProgramModule )                              % PopAuto %
+         =:
+
+ProgramModule := "MODULE"                                                  % M2Error.DefaultProgramModule %
+                                                                           % BlockStart (GetTokenNo () -1) %
+                  Ident                                                    % P2StartBuildProgramModule ; %
+
+
+
+
+                  [ Priority
+                  ]
+                  ";"
+
+                  { Import                                                 % BuildImportOuterModule ; %
+                  }
+
+                  Block
+                                                                           % BlockEnd (GetTokenNo () -1) %
+                  Ident                                                    % P2EndBuildProgramModule ; %
+                  "."
+                  =:
+
+ImplementationModule := "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
+                                                                           % BlockStart (GetTokenNo () -1) %
+                                         "MODULE"
+                         Ident                                             % P2StartBuildImplementationModule ; %
+
+                         [ Priority
+                         ] ";"
+                         { Import                                          % BuildImportOuterModule %
+                           }
+                         Block
+                                                                           % BlockEnd (GetTokenNo () -1) %
+                         Ident                                             % P2EndBuildImplementationModule ; %
+                         "." =:
+
+ImplementationOrProgramModule := ImplementationModule | ProgramModule =:
+
+Number := Integer | Real =:
+
+Qualident :=                                                               % VAR name: Name ;
+                                                                                 Type, Sym, tok: CARDINAL ; %
+             Ident
+                                                                           % IF IsAutoPushOn()
+                                                                             THEN
+                                                                                PopTtok(name, tok) ;
+                                                                                Sym := RequestSym (tok, name) ;
+                                                                                IF IsDefImp(Sym) OR IsModule(Sym)
+                                                                                THEN
+                                                                                   Expect(periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+                                                                                   StartScope(Sym) ;
+                                                                                   Qualident(stopset0, stopset1, stopset2) ;
+                                                                                   (* should we test for lack of ident? *)
+                                                                                   PopTFtok(Sym, Type, tok) ;
+                                                                                   PushTFtok(Sym, Type, tok) ;
+                                                                                   Annotate("%1s(%1d)|%1s(%1d)||qualident|type") ;
+                                                                                   EndScope ;
+                                                                                   PutIncluded(Sym)
+                                                                                ELSE
+                                                                                   PushTFtok(Sym, GetType(Sym), tok) ;
+                                                                                   Annotate("%1s(%1d)|%1s(%1d)||qualident|type")
+                                                                                END
+                                                                             ELSE (* just parse qualident *) %
+             { "." Ident }                                                 % END %
+           =:
+
+ConstantDeclaration := Ident "="                                           % SeenUnknown ;
+                                                                             BuildConst %
+                       ConstExpressionInitial                              % DetermineType ;
+                                                                             PopNothing %
+                     =:
+
+ConstExpressionInitial :=                                                  % PushAutoOff %
+                   SimpleConstExpr [ Relation SimpleConstExpr ]            % PopAuto %
+                =:
+
+ConstExpression :=                                                         % PushType ; SeenUnknown ; PushAutoOff %
+                   SimpleConstExpr [ Relation SimpleConstExpr ]            % PopAuto ; PopType %
+                =:
+
+Relation :=                                                                % SeenUnknown (* actually it will be a BOOLEAN, but this is not a constructor and not a string *) %
+            "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
+
+UnaryOrConstTerm := "+" ConstTerm | "-" ConstTerm | ConstTerm =:
+
+AddOperator := "+" | "-" |
+               "OR"                                                        % SeenUnknown (* actually it will be a BOOLEAN, but this is not a constructor and not a string *) %
+ =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor } =:
+
+MulOperator := "*" | "/"
+               | "DIV"                                                     % SeenUnknown %
+               | "MOD"                                                     % SeenUnknown %
+               | "REM"                                                     % SeenUnknown %
+               | "AND"                                                     % SeenUnknown %
+               | "&"                                                       % SeenUnknown %
+              =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" | "NOT" ConstFactor |
+               ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string                                                      % SeenString %
+             =:
+
+ComponentElement := ConstExpression [ ".."                                 % PopType ; SeenSet ; PushType ; SeenUnknown %
+                                           ConstExpression ] =:
+
+ComponentValue :=                                                          % PushType ; SeenUnknown ; PushRememberConstant %
+                  ComponentElement [ 'BY'                                  % PopType ; SeenArray ; PushType ; SeenUnknown %
+                                          ConstExpression ]
+                                                                           % PopType (* double check position, it must balance PushType *) %
+                                                                           % PopRememberConstant %
+                =:
+
+ArraySetRecordValue := ComponentValue { ',' ComponentValue } =:
+
+Constructor := '{'                                                         % SeenConstructor %
+                   [ ArraySetRecordValue ] '}' =:
+
+ConstSetOrQualidentOrFunction := Constructor | Qualident
+                                 [ Constructor | ConstActualParameters ] =:
+
+
+ConstActualParameters :=                                                   % PushType ; SeenUnknown %
+                         "(" [ ExpList ] ")"                               % PopType %
+                       =:
+
+-- to help satisfy LL1
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:
+
+ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =:
+
+ByteAlignment := '<*'                                                      % PushAutoOn %
+                                AttributeExpression                        % BuildAligned %
+                                                                           % PopAuto %
+                                                    '*>' =:
+
+-- OptAlignmentExpression := [ AlignmentExpression ] =:
+
+-- AlignmentExpression := "(" ConstExpression ")" =:
+
+Alignment := ByteAlignment |                                               % PushT(NulSym) %
+           =:
+
+TypeDeclaration :=                                                         % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+                   Ident "=" Type Alignment                                % BuildTypeAlignment %
+                                                                           % Assert(top=Top()) %
+                 =:
+
+Type :=
+                                                                           % PushAutoOn ; %
+        ( SimpleType | ArrayType                                           % BuildType ; %
+          | RecordType                                                     % BuildType ; %
+          | SetType                                                        % BuildType ; %
+          | PointerType                                                    % BuildType ; %
+          | ProcedureType                                                  % BuildType ; %
+        )                                                                  % PopAuto ; %
+      =:
+
+SimpleType :=
+              ( Qualident [ PrefixedSubrangeType ]                         % BuildType ; %
+                | Enumeration                                              % BuildType ; %
+                | SubrangeType                                             % BuildType ; %
+              )
+           =:
+
+Enumeration := "("
+                   ( IdentList
+                               )
+               ")"                                                         % StartBuildEnumeration ; %
+            =:
+
+IdentList := Ident                                                         % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," Ident                                                   % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+SubrangeType := "[" ConstExpression  ".." ConstExpression "]"              % BuildSubrange(NulSym) %
+              =:
+
+PrefixedSubrangeType := "[" ConstExpression  ".." ConstExpression "]"      % VAR t: CARDINAL ; %
+                                                                           % PopT(t) ;
+                                                                             BuildSubrange(t) %
+              =:
+
+ArrayType := "ARRAY"                                                       % VAR arrayType, tok: CARDINAL ; %
+                                                                           % StartBuildArray ;
+                                                                             PopTtok(arrayType, tok) ;
+                                                                             PushTtok(arrayType, tok) ;
+                                                                             BuildNulName ; %
+              SimpleType                                                   % BuildFieldArray ; %
+              { ","                                                        % BuildArrayComma ;
+                                                                             BuildNulName ; %
+                SimpleType                                                 % BuildFieldArray ; %
+              } "OF"                                                       % BuildNulName ; %
+             Type                                                          % EndBuildArray ;
+                                                                             PopNothing ;
+                                                                             PushTtok(arrayType, tok) %
+           =:
+
+RecordType := "RECORD"                                                     % BuildRecord %
+                       [ DefaultRecordAttributes ]
+                       FieldListSequence "END" =:
+
+DefaultRecordAttributes := '<*'                                            % PushAutoOn %
+                                AttributeExpression                        % P2BuildDefaultFieldAlignment %
+                                                                           % PopAuto %
+                                                    '*>' =:
+
+RecordFieldPragma := ( '<*' FieldPragmaExpression                          % VAR n: CARDINAL ; %
+                                                                           % n := 1 %
+                                                                           % PushT(n) %
+                                                                           % Annotate('(%1d)||pragma count') %
+                        { ','                                              % PopT(n) %
+                              FieldPragmaExpression                        % INC(n) %
+                                                                           % PushT(n) %
+                                                                           % Annotate('(%1d)||pragma count') %
+                                                    } '*>' |               % n := 0 %
+                                                                           % PushT(n) %
+                                                                           % Annotate('(%1d)||pragma count') %
+                                                              ) =:
+
+FieldPragmaExpression :=                                                   % PushAutoOn %
+                         Ident PragmaConstExpression
+                                                                           % PopAuto %
+                                                           =:
+
+PragmaConstExpression := (                                                 % PushAutoOff %
+                           '(' ConstExpression                             % BuildPragmaConst %
+                                               ')'                         % PopAuto %
+                                                   |                       % PushT(NulSym) %
+                                                                           % Annotate('NulSym||no pragma const') %
+                                                     )     =:
+
+AttributeExpression := Ident '(' ConstExpression ')' =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+FieldListStatement := [ FieldList ] =:
+
+-- sadly the PIM rules are not LL1 as Ident and Qualident have the same first
+-- symbols. We rewrite FieldList to inline qualident
+
+FieldList := IdentList ":"                                                 % BuildNulName %
+                           Type RecordFieldPragma                          % BuildFieldRecord %
+             |
+             "CASE"                                                        % AddRecordToList %
+                                                                           % StartBuildVarient %
+                                                                           % AddVarientToList %
+                    CaseTag "OF"
+                                 Varient { "|" Varient }
+             [ "ELSE"                                                      % StartBuildVarientFieldRecord %
+               FieldListSequence                                           % EndBuildVarientFieldRecord %
+             ] "END"                                                       % EndBuildVarient %
+           =:
+
+TagIdent := Ident |                                                        % BuildNulName %
+          =:
+
+CaseTag :=  TagIdent ( ":" Qualident |                                     % PushT(NulSym) %
+                     )                                                     % BuildVarientSelector %
+         =:
+
+Varient :=  [                                                              % StartBuildVarientFieldRecord %
+              VarientCaseLabelList ":" FieldListSequence                   % EndBuildVarientFieldRecord %
+                                                         ]
+                                                           =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression [ ".." ConstExpression ] =:
+
+CaseLabelList := CaseLabels { "," CaseLabels } =:
+
+CaseLabels := ConstExpression [ ".." ConstExpression ] =:
+
+SetType :=                                                                 % VAR ispacked: BOOLEAN ; %
+                                                                           % ispacked := FALSE %
+           ( "SET"                                                         % ispacked := FALSE %
+                   | "PACKEDSET"                                           % ispacked := TRUE %
+                                 ) "OF"                                    % BuildNulName %
+                                        SimpleType                         % BuildSetType (ispacked) %
+         =:
+
+
+PointerType := "POINTER" "TO"                                              % BuildNulName %
+                              Type                                         % BuildPointerType %
+             =:
+
+ProcedureType := "PROCEDURE"                                               % BuildProcedureType ; %
+                 [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters
+                  ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident                                             % BuildOptFunction %
+                               "]" | Qualident                             % BuildFunction %
+               =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter :=  "..."                                               % BuildFormalVarArgs %
+                       | "VAR"                                             % PushT(VarTok) ; %
+                       FormalType                                          % BuildFormalType ; %
+                       |                                                   % PushT(NulTok) ; %
+                       FormalType                                          % BuildFormalType ; %
+                    =:
+
+VarIdent := Ident                                                          % VAR
+                                                                                on            : BOOLEAN ;
+                                                                                Sym, Type, tok: CARDINAL ; %
+                  [ "["                                                    % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                PopTFtok(Sym, Type, tok) ;
+                                                                                PushTFAtok(Sym, Type, Sym, tok)
+                                                                             END %
+                        ConstExpression "]" ]
+         =:
+
+VarIdentList := VarIdent                                                   % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," VarIdent                                                % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+VariableDeclaration := VarIdentList ":"                                    % BuildNulName %
+                                                                           % DisplayStack %
+                       Type                                                % DisplayStack %
+                       Alignment                                           % DisplayStack %
+                                                                           % BuildVarAlignment %
+                                                                           % DisplayStack %
+                                                                           % BuildVariable %
+                    =:
+
+Designator := Qualident { SubDesignator } =:
+
+SubDesignator := "." Ident | "[" ExpList "]" | "^" =:
+
+ExpList := Expression { "," Expression } =:
+
+Expression :=                                                              % PushType ; SeenUnknown ; PushAutoOff %
+              SimpleExpression [ Relation SimpleExpression ]               % PopAuto ; PopType %
+           =:
+
+SimpleExpression := UnaryOrTerm { AddOperator Term } =:
+
+UnaryOrTerm := "+" Term | "-" Term | Term =:
+
+Term := Factor { MulOperator Factor } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" Factor | ConstAttribute =:
+
+SetOrDesignatorOrFunction := ( Qualident [ Constructor |
+                                           SimpleDes [ ActualParameters ]
+                                         ] | Constructor
+                             )
+                           =:
+
+SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+
+ActualParameters := "(" [ ExpList ] ")" =:
+
+Statement :=                                                              % PushAutoOff ; %
+             [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               "EXIT" | "RETURN" [ Expression ] | RetryStatement ]        % PopAuto ; %
+          =:
+
+RetryStatement := "RETRY" =:
+
+AssignmentOrProcedureCall := Designator ( ":=" Expression |
+                                           ActualParameters |             % (* epsilon *) %
+                                        ) =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence := Statement { ";" Statement } =:
+
+IfStatement := "IF" Expression "THEN" StatementSequence
+              { "ELSIF" Expression "THEN" StatementSequence }
+              [ "ELSE" StatementSequence ] "END" =:
+
+CaseStatement := "CASE" Expression "OF" Case { "|" Case }
+                 [ "ELSE" StatementSequence ] "END" =:
+
+Case := [ CaseLabelList ":" StatementSequence ] =:
+
+WhileStatement := "WHILE" Expression "DO" StatementSequence "END" =:
+
+RepeatStatement := "REPEAT" StatementSequence "UNTIL" Expression =:
+
+ForStatement := "FOR" Ident ":=" Expression "TO" Expression
+                [ "BY" ConstExpression ] "DO"
+                StatementSequence "END" =:
+
+LoopStatement := "LOOP" StatementSequence "END" =:
+
+WithStatement := "WITH" Designator "DO" StatementSequence "END" =:
+
+ProcedureDeclaration := ProcedureHeading                                   % Assert(IsProcedure(OperandT(1))) %
+                                         ";" ( ProcedureBlock
+                                                                           % Assert(IsProcedure(OperandT(1))) %
+                        Ident )
+                                                                           % EndBuildProcedure %
+
+                      =:
+
+DefineBuiltinProcedure :=  [ "__ATTRIBUTE__" "__BUILTIN__"
+                              "(" "("                                      % PushAutoOff %
+                                    Ident                                  % PopAuto %
+                                          ")" ")" | "__INLINE__" ]
+                      =:
+
+ProcedureHeading := "PROCEDURE"                                            % M2Error.DefaultProcedure %
+                     DefineBuiltinProcedure
+                     ( Ident
+                                                                           % StartBuildProcedure %
+                                                                           % Assert(IsProcedure(OperandT(1))) %
+                                                                           % StartBuildFormalParameters  %
+                       [ FormalParameters ] AttributeNoReturn
+                                                                           % EndBuildFormalParameters %
+                                                                           % BuildProcedureHeading %
+                     )
+                     =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE"                                         % M2Error.DefaultProcedure %
+                        Builtin
+                        ( Ident
+                                                                           % StartBuildProcedure %
+                                                                           % Assert(IsProcedure(OperandT(1))) %
+                                                                           % StartBuildFormalParameters  %
+                          [ DefFormalParameters ] AttributeNoReturn
+                                                                           % EndBuildFormalParameters %
+                                                                           % BuildProcedureHeading %
+                        )                                                  % M2Error.LeaveErrorScope %
+                    =:
+
+AttributeNoReturn := [ "<*"                                                % PushAutoOn %
+                            Ident                                          % PopAuto %
+                                                                           % checkReturnAttribute %
+                                   "*>" ] =:
+
+AttributeUnused := [ "<*"                                                  % PushAutoOn %
+                          Ident                                            % PopAuto %
+                                                                           % checkParameterAttribute %
+                                "*>" ] =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock :=                                                          % Assert(IsProcedure(OperandT(1))) %
+                  {                                                        % Assert(IsProcedure(OperandT(1))) %
+                    Declaration                                            % Assert(IsProcedure(OperandT(1))) %
+                                } [ "BEGIN" ProcedureBlockBody ] "END"     % Assert(IsProcedure(OperandT(1))) %
+               =:
+
+Block := { Declaration } InitialBlock FinalBlock "END" =:
+
+InitialBlock := [ "BEGIN"                                                  % BlockBegin (GetTokenNo () -1) %
+                          InitialBlockBody ] =:
+
+FinalBlock := [ "FINALLY"                                                  % BlockFinally (GetTokenNo () -1) %
+                          FinalBlockBody ] =:
+
+InitialBlockBody := NormalPart [ "EXCEPT"                                 % PutExceptionBlock(GetCurrentScope()) %
+                                          ExceptionalPart ] =:
+
+FinalBlockBody := NormalPart [ "EXCEPT"                                   % PutExceptionFinally(GetCurrentScope()) %
+                                        ExceptionalPart ] =:
+
+ProcedureBlockBody := NormalPart [ "EXCEPT"                               % PutExceptionBlock(GetCurrentScope()) %
+                                            ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration ";" } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "("
+                        [ DefMultiFPSection ]                              % VAR n: CARDINAL; %
+                                                                           % PopT(n) ; (* remove param count *) %
+                        ")"
+                        FormalReturn                                       % PushT(n) ; (* restore param count *) %
+                     =:
+
+DefMultiFPSection := DefExtendedFP |
+                     FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "("
+                    [ MultiFPSection ]                                     % VAR n: CARDINAL; %
+                                                                           % PopT(n) ; (* remove param count *) %
+                    ")"
+                    FormalReturn                                           % PushT(n) ; (* restore param count *) %
+                  =:
+
+MultiFPSection := ExtendedFP |
+                  FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection
+           =:
+
+DefExtendedFP := DefOptArg | "..."                                         % BuildVarArgs %
+               =:
+
+ExtendedFP := OptArg | "..."                                               % BuildVarArgs %
+            =:
+
+OptArg := "["                                                              % VAR n: CARDINAL ; %
+                                                                           % PopT(n) %
+                                                                           % PushT(NulTok) %
+              Ident                                                        % PushT(1) %
+                    ":" FormalType                                         % PushT(n) %
+                                                                           % BuildFPSection %
+                                                                           % BuildOptArg %
+                                   [ "=" ConstExpression ]
+                                                           "]" =:
+
+DefOptArg := "["                                                           % VAR n: CARDINAL ; %
+                                                                           % PopT(n) %
+                                                                           % PushT(NulTok) %
+              Ident                                                        % PushT(1) %
+                    ":" FormalType                                         % PushT(n) %
+                                                                           % BuildFPSection %
+                                                                           % BuildOptArg %
+                                   "=" ConstExpression
+                                                       "]" =:
+
+VarFPSection := "VAR"                                                      % VAR n: CARDINAL ; %
+                                                                           % PopT(n) ; %
+                                                                           % PushT(VarTok) ; %
+                IdentList ":" FormalType                                   % PushT(n) %
+                [ AttributeUnused ]
+                                                                           % BuildFPSection %
+             =:
+
+NonVarFPSection :=                                                         % VAR n: CARDINAL ; %
+                                                                           % PopT(n) %
+                                                                           % PushT(NulTok) %
+                   IdentList ":" FormalType                                % PushT(n) %
+                   [ AttributeUnused ]
+                                                                           % BuildFPSection %
+                =:
+
+FormalType := "ARRAY" "OF"                                                 % VAR n: CARDINAL ; %
+                                                                           % PushTF(ArrayTok, 1) %
+                           { "ARRAY" "OF"                                  % PopTF(ArrayTok, n) %
+                                                                           % INC(n) %
+                                                                           % PushTF(ArrayTok, n) %
+                                          } Qualident
+                                                      |                    % VAR Sym, Type: CARDINAL ; %
+                                                        Qualident
+                                                                           % PopTF(Sym, Type) ;
+                                                                             PushT(NulTok) ;
+                                                                             PushTF(Sym, Type) %
+            =:
+
+ModuleDeclaration := "MODULE"                                              % M2Error.DefaultInnerModule %
+                                                                           % BlockStart (GetTokenNo () -1) %
+                     Ident                                                 % StartBuildInnerModule %
+                     [ Priority
+                                ] ";"
+                     { Import                                              % BuildImportInnerModule %
+                        } [ Export                                         % BuildExportInnerModule %
+                            ]
+                       Block
+                                                                           % BlockEnd (GetTokenNo () -1) %
+                       Ident                                               % EndBuildInnerModule %
+                     =:
+
+Priority := "[" ConstExpression "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"                                           % PushT(QualifiedTok) %
+                                 IdentList |
+                     "UNQUALIFIED"                                         % PushT(UnQualifiedTok) %
+                                 IdentList |                               % PushT(ExportTok) %
+                     IdentList ) ";" =:
+
+Import :=  "FROM" Ident "IMPORT" IdentList ";" |
+           "IMPORT"                                                        % PushT(ImportTok)
+                                                                             (* determines whether Ident or Module *) %
+            IdentList ";" =:
+
+DefinitionModule := "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
+                                 "MODULE"
+                    [ "FOR" string ]
+                    Ident                                                  % P2StartBuildDefModule %
+                    ";"
+                    { Import                                               % BuildImportOuterModule %
+                             } [ Export                                    % BuildExportOuterModule %
+                                        ]
+                    { Definition }
+                                   "END" Ident                             % P2EndBuildDefModule %
+                                               "."
+                  =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE"
+                    { Ident ( ";"
+                                  | "=" Type Alignment                     % BuildVarAlignment %
+                                                       ";" )               % BuildTypeEnd %
+                    }
+              |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ] =:
+
+AsmOperands  := string [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+             =:
+
+AsmList      := [ AsmElement ] { ',' AsmElement } =:
+
+AsmElement   := AsmOperandName string '(' Expression ')'
+             =:
+
+TrashList    := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/gm2-compiler/P2Build.def b/gcc/m2/gm2-compiler/P2Build.def
new file mode 100644
index 00000000000..f62c4496e4b
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P2Build.def
@@ -0,0 +1,43 @@
+(* P2Build.def provides a parser with error recovery for GNU Modula-2.
+
+Copyright (C) 2001-2022 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/>.  *)
+DEFINITION MODULE P2Build ;
+
+(*
+    Title      : P2Build
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Feb  2 16:11:05 2001
+    Last edit  : Fri Feb  2 16:11:05 2001
+    Description: provides a parser with error recovery for GNU Modula-2
+*)
+
+EXPORT QUALIFIED CompilationUnit ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END P2Build.
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.def b/gcc/m2/gm2-compiler/P2SymBuild.def
new file mode 100644
index 00000000000..e7ed35f5545
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P2SymBuild.def
@@ -0,0 +1,1314 @@
+(* P2SymBuild.def pass 2 symbol creation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE P2SymBuild ;
+
+(*
+   Title      : P2SymBuild
+   Author     : Gaius Mulley
+   Date       : 24/6/87
+   LastEdit   : Sat Dec  9 11:10:57 EST 1989
+   System     : UNIX (GNU Modula-2)
+   Description: pass 2 symbol creation.
+*)
+
+EXPORT QUALIFIED P2StartBuildDefModule,
+                 P2EndBuildDefModule,
+                 P2StartBuildImplementationModule,
+                 P2EndBuildImplementationModule,
+                 P2StartBuildProgramModule,
+                 P2EndBuildProgramModule,
+                 StartBuildInnerModule,
+                 EndBuildInnerModule,
+                 BuildImportOuterModule,
+                 BuildExportOuterModule,
+                 BuildImportInnerModule,
+                 BuildExportInnerModule,
+                 BlockStart, BlockEnd, BlockBegin, BlockFinally,
+                 BuildNumber,
+                 BuildString,
+                 BuildConst,
+                 BuildSubrange, BuildAligned,
+                 BuildTypeAlignment, BuildVarAlignment,
+                 P2BuildDefaultFieldAlignment, BuildPragmaConst,
+                 BuildVariable,
+                 StartBuildEnumeration,
+                 BuildType,
+                 StartBuildFormalParameters,
+                 EndBuildFormalParameters,
+                 BuildProcedureHeading,
+                 BuildFPSection,
+                 BuildVarArgs,
+                 BuildFormalVarArgs,
+                 BuildOptArg,
+                 StartBuildProcedure,
+                 EndBuildProcedure,
+                 BuildFunction,
+                 BuildOptFunction,
+                 BuildPointerType,
+                 BuildSetType,
+                 BuildRecord,
+                 BuildFieldRecord,
+                 StartBuildVarient,
+                 EndBuildVarient,
+                 BuildVarientSelector,
+                 StartBuildVarientFieldRecord,
+                 EndBuildVarientFieldRecord,
+                 BuildNulName,
+                 BuildTypeEnd,
+                 StartBuildArray, BuildArrayComma,
+                 EndBuildArray,
+                 BuildFieldArray,
+                 BuildProcedureType,
+                 BuildFormalType,
+                 SeenCast,
+                 SeenSet,
+                 SeenArray,
+                 SeenConstructor,
+                 SeenUnknown,
+                 SeenString,
+                 SeenBoolean,
+                 SeenCType, SeenRType, SeenZType,
+                 DetermineType, PushType, PopType,
+                 PushRememberConstant,
+                 PopRememberConstant,
+                 RememberConstant ;
+
+
+(*
+   BlockStart - tokno is the module/procedure/implementation/definition token
+*)
+
+PROCEDURE BlockStart (tokno: CARDINAL) ;
+
+(*
+   BlockEnd - declare module ctor/init/fini/dep procedures.
+*)
+
+PROCEDURE BlockEnd (tokno: CARDINAL) ;
+
+
+(*
+   BlockBegin - assign curBeginTok to tokno.
+*)
+
+PROCEDURE BlockBegin (tokno: CARDINAL) ;
+
+
+(*
+   BlockFinally - assign curFinallyTok to tokno.
+*)
+
+PROCEDURE BlockFinally (tokno: CARDINAL) ;
+
+
+(*
+   StartBuildDefinitionModule - Creates a definition module and starts
+                                a new scope.
+
+                                The Stack is expected:
+
+                                Entry                 Exit
+
+                         Ptr ->                                     <- Ptr
+                                +------------+        +-----------+
+                                | NameStart  |        | NameStart |
+                                |------------|        |-----------|
+
+*)
+
+PROCEDURE P2StartBuildDefModule ;
+
+
+(*
+   EndBuildDefinitionModule - Destroys the definition module scope and
+                              checks for correct name.
+
+                              The Stack is expected:
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +-----------+
+                              | NameEnd    |        |           |
+                              |------------|        |-----------|
+                              | NameStart  |        |           | <- Ptr
+                              |------------|        |-----------|
+*)
+
+PROCEDURE P2EndBuildDefModule ;
+
+
+(*
+   StartBuildImplementationModule - Creates an implementation module and starts
+                                    a new scope.
+
+                                    The Stack is expected:
+
+                                    Entry                 Exit
+
+                             Ptr ->                                     <- Ptr
+                                    +------------+        +-----------+
+                                    | NameStart  |        | NameStart |
+                                    |------------|        |-----------|
+
+*)
+
+PROCEDURE P2StartBuildImplementationModule ;
+
+
+(*
+   EndBuildImplementationModule - Destroys the implementation module scope and
+                                  checks for correct name.
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->
+                                  +------------+        +-----------+
+                                  | NameEnd    |        |           |
+                                  |------------|        |-----------|
+                                  | NameStart  |        |           | <- Ptr
+                                  |------------|        |-----------|
+*)
+
+PROCEDURE P2EndBuildImplementationModule ;
+
+
+(*
+   StartBuildProgramModule - Creates a program module and starts
+                             a new scope.
+
+                             The Stack is expected:
+
+                             Entry                 Exit
+
+                      Ptr ->                                     <- Ptr
+                             +------------+        +-----------+
+                             | NameStart  |        | NameStart |
+                             |------------|        |-----------|
+
+*)
+
+PROCEDURE P2StartBuildProgramModule ;
+
+
+(*
+   EndBuildProgramModule - Destroys the program module scope and
+                           checks for correct name.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+        +-----------+
+                           | NameEnd    |        |           |
+                           |------------|        |-----------|
+                           | NameStart  |        |           | <- Ptr
+                           |------------|        |-----------|
+*)
+
+PROCEDURE P2EndBuildProgramModule ;
+
+
+(*
+   StartBuildInnerModule - Creates an Inner module and starts
+                           a new scope.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                                     <- Ptr
+                           +------------+        +-----------+
+                           | NameStart  |        | NameStart |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE StartBuildInnerModule ;
+
+
+(*
+   EndBuildInnerModule - Destroys the Inner module scope and
+                         checks for correct name.
+
+                         The Stack is expected:
+
+                         Entry                 Exit
+
+                  Ptr ->
+                         +------------+        +-----------+
+                         | NameEnd    |        |           |
+                         |------------|        |-----------|
+                         | NameStart  |        |           | <- Ptr
+                         |------------|        |-----------|
+*)
+
+PROCEDURE EndBuildInnerModule ;
+
+
+(*
+   BuildImportOuterModule - Builds imported identifiers into an outer module
+                            from a definition module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                                                  Error Condition
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildImportOuterModule ;
+
+
+(*
+   BuildExportOuterModule - Builds exported identifiers from an outer module
+                            to the outside world of library modules.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +--------------+
+                            | #          |        | #            |
+                            |------------|        |--------------|
+                            | Id1        |        | Id1          |
+                            |------------|        |--------------|
+                            .            .        .              .
+                            .            .        .              .
+                            .            .        .              .
+                            |------------|        |--------------|
+                            | Id#        |        | Id#          |
+                            |------------|        |--------------|
+                            | ExportTok  |        | QualifiedTok |
+                            |------------|        |--------------|
+
+                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;
+
+                            Error Condition
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildExportOuterModule ;
+
+
+(*
+   BuildImportInnerModule - Builds imported identifiers into an inner module
+                            from the last level of module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                                                  Error Condition
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildImportInnerModule ;
+
+
+(*
+   BuildExportInnerModule - Builds exported identifiers from an inner module
+                            to the next layer module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +--------------+
+                            | #          |        | #            |
+                            |------------|        |--------------|
+                            | Id1        |        | Id1          |
+                            |------------|        |--------------|
+                            .            .        .              .
+                            .            .        .              .
+                            .            .        .              .
+                            |------------|        |--------------|
+                            | Id#        |        | Id#          |
+                            |------------|        |--------------|
+                            | ExportTok  |        | QualifiedTok |
+                            |------------|        |--------------|
+
+                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildExportInnerModule ;
+
+
+(*
+   BuildNumber - Converts a number into a symbol.
+
+
+                 Stack
+
+                 Entry                 Exit
+
+          Ptr ->                                      <- Ptr
+                 +------------+        +------------+
+                 | Name       |        | Sym        |
+                 |------------+        |------------|
+*)
+
+PROCEDURE BuildNumber ;
+
+
+(*
+   BuildString - Converts a string into a symbol.
+
+
+                 Stack
+
+                 Entry                 Exit
+
+          Ptr ->                                      <- Ptr
+                 +------------+        +------------+
+                 | Name       |        | Sym        |
+                 |------------+        |------------|
+*)
+
+PROCEDURE BuildString ;
+
+
+(*
+   BuildConst - builds a constant.
+                Stack
+
+                Entry                 Exit
+
+         Ptr ->
+                +------------+
+                | Name       |
+                |------------+                       <- Ptr
+*)
+
+PROCEDURE BuildConst ;
+
+
+(*
+   StartBuildEnumeration - Builds an Enumeration type Type.
+
+
+                           Stack
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+
+                           | #          |
+                           |------------|
+                           | en 1       |
+                           |------------|
+                           | en 2       |
+                           |------------|
+                           .            .
+                           .            .
+                           .            .                       <- Ptr
+                           |------------|        +------------+
+                           | en #       |        | Type       |
+                           |------------|        |------------|
+                           | Name       |        | Name       |
+                           |------------|        |------------|
+*)
+
+PROCEDURE StartBuildEnumeration ;
+
+
+(*
+   BuildSubrange - Builds a Subrange type Symbol, the base type can also be
+                   supplied if known.
+
+                      Stack
+
+                      Entry                 Exit
+
+
+                                                           <- Ptr
+                                            +------------+
+               Ptr ->                       | Type       |
+                      +------------+        |------------|
+                      | Name       |        | Name       |
+                      |------------|        |------------|
+*)
+
+PROCEDURE BuildSubrange (Base: CARDINAL) ;
+
+
+(*
+   BuildAligned - builds an alignment constant symbol which is placed onto
+                  the stack.  It expects the ident ALIGNED to be on the
+                  stack.
+
+                         Stack
+
+                           Entry                 Exit
+
+
+                  Ptr ->                                            <- Ptr
+                         +---------------+      +-----------------+
+                         | bytealignment |      | AlignmentConst  |
+                         +---------------+      |-----------------|
+*)
+
+PROCEDURE BuildAligned ;
+
+
+(*
+   BuildVarAlignment - the AlignmentConst is either a temporary or NulSym.
+                       A type may only have one alignment value and
+                       error checking is performed.
+
+                       Stack
+
+                           Entry                 Exit
+
+
+                   Ptr ->
+                          +-----------------+
+                          | AlignmentConst  |                             <- Ptr
+                          |-----------------|        +------------------+
+                          | Type            |        | Type  | TypeName |
+                          |-----------------|        |------------------|
+*)
+
+PROCEDURE BuildVarAlignment ;
+
+
+(*
+   BuildTypeAlignment - the AlignmentConst is either a temporary or NulSym.
+                        A type may only have one alignment value and
+                        error checking is performed.
+
+                        Stack
+
+                            Entry                 Exit
+
+
+                    Ptr ->
+                           +-----------------+
+                           | AlignmentConst  |
+                           |-----------------|
+                           | Type            |    Empty
+                           |-----------------|
+*)
+
+PROCEDURE BuildTypeAlignment ;
+
+
+(*
+   BuildDefaultFieldAlignment -
+
+                 The Stack:
+
+                 Entry                         Exit
+                 =====                         ====
+
+
+          Ptr ->
+                 +-----------+
+                 | Alignment |
+                 |-----------|                 +-----------+
+                 | RecordSym |                 | RecordSym |
+                 |-----------|                 |-----------|
+                 | Name      |                 | Name      |
+                 |-----------|                 |-----------|
+
+*)
+
+PROCEDURE P2BuildDefaultFieldAlignment ;
+
+
+(*
+   BuildPragmaConst - pushes a constant to the stack and stores it away into the
+                      const fifo queue ready for pass 3.
+*)
+
+PROCEDURE BuildPragmaConst ;
+
+
+(*
+   BuildVariable - Builds variables listed in an IdentList with a Type.
+
+                   Stack
+
+                   Entry                 Exit
+
+            Ptr ->
+                   +------------+        +------------+
+                   | Type | Name|        |            |
+                   |------------|        |------------|
+                   | #          |        |            |
+                   |------------|        |------------|
+                   | Ident 1    |        |            |
+                   |------------|        |------------|
+                   | Ident 2    |        |            |
+                   |------------|        |------------|
+                   .            .        .            .
+                   .            .        .            .
+                   .            .        .            .
+                   |------------|        |------------|
+                   | Ident #    |        |            | <- Ptr
+                   |------------|        |------------|
+
+                                           Empty
+*)
+
+PROCEDURE BuildVariable ;
+
+
+(*
+   BuildType - Builds a Type.
+
+
+               Stack
+
+               Entry                 Exit
+
+        Ptr ->
+               +------------+
+               | Type       |                          <- Ptr
+               |------------|        +---------------+
+               | Name       |        | Type  | Name  |
+               |------------|        |---------------|
+
+                                     Empty
+*)
+
+PROCEDURE BuildType ;
+
+
+(*
+   StartBuildFormalParameters - Initialises the quadruple stack for
+                                Formal Parameters.
+
+                                The Stack:
+
+                                Entry                Exit
+
+                                                                    <- Ptr
+                                                     +------------+
+                                Empty                | 0          |
+                                                     |------------|
+*)
+
+PROCEDURE StartBuildFormalParameters ;
+
+
+(*
+   EndBuildFormalParameters - Resets the quadruple stack after building
+                              Formal Parameters.
+
+                              The Stack:
+
+                              Entry                    Exit
+
+                       Ptr ->
+                              +------------+
+                              | NoOfParam  |                          <- Ptr
+                              |------------|           +------------+
+                              | ProcSym    |           | ProcSym    |
+                              |------------|           |------------|
+*)
+
+PROCEDURE EndBuildFormalParameters ;
+
+
+(*
+   BuildProcedureHeading - Builds a procedure heading for the definition
+                           module procedures.
+
+                           Operation only performed if compiling a
+                           definition module.
+
+                           The Stack:
+
+                           Entry                       Exit
+
+                    Ptr ->
+                           +------------+
+                           | ProcSym    |              Empty
+                           |------------|
+
+*)
+
+PROCEDURE BuildProcedureHeading ;
+
+
+(*
+   BuildFunction - Builds a procedures return type.
+                   Procedure becomes a function.
+
+                    The Stack:
+
+                    Entry                 Exit
+
+             Ptr ->
+                    +------------+
+                    | TypeSym    |                       <- Ptr
+                    |------------|        +------------+
+                    | ProcSym    |        | ProcSym    |
+                    |------------|        |------------|
+*)
+
+PROCEDURE BuildFunction ;
+
+
+(*
+   BuildOptFunction - Builds a procedures optional return type.
+                      Procedure becomes a function and the user
+                      can either call it as a function or a procedure.
+
+                      The Stack:
+
+                      Entry                 Exit
+
+               Ptr ->
+                      +------------+
+                      | TypeSym    |                       <- Ptr
+                      |------------|        +------------+
+                      | ProcSym    |        | ProcSym    |
+                      |------------|        |------------|
+*)
+
+PROCEDURE BuildOptFunction ;
+
+
+(*
+   BuildFPSection - Builds a Formal Parameter in a procedure.
+
+                    The Stack:
+
+                    Entry                 Exit
+
+             Ptr ->
+                    +------------+
+                    | ParamTotal |
+                    |------------|
+                    | TypeName   |
+                    |------------|
+                    | Array/Nul  |
+                    |------------|
+                    | NoOfIds    |
+                    |------------|
+                    | Id 1       |
+                    |------------|
+                    .            .
+                    .            .
+                    .            .
+                    |------------|
+                    | Id n       |                       <- Ptr
+                    |------------|        +------------+
+                    | Var / Nul  |        | ParamTotal |
+                    |------------|        |------------|
+                    | ProcSym    |        | ProcSym    |
+                    |------------|        |------------|
+*)
+
+PROCEDURE BuildFPSection ;
+
+
+(*
+   BuildVarArgs - indicates that the ProcSym takes varargs
+                  after ParamTotal.
+                                                         <- Ptr
+                    +------------+        +------------+
+                    | ParamTotal |        | ParamTotal |
+                    |------------|        |------------|
+                    | ProcSym    |        | ProcSym    |
+                    |------------|        |------------|
+
+*)
+
+PROCEDURE BuildVarArgs ;
+
+
+(*
+   BuildFormalVarArgs - indicates that the procedure type takes varargs.
+                                                             <- Ptr
+                        +------------+        +------------+
+                        | ProcSym    |        | ProcSym    |
+                        |------------|        |------------|
+
+*)
+
+PROCEDURE BuildFormalVarArgs ;
+
+
+(*
+   BuildOptArg - indicates that the ProcSym takes a single optarg
+                 after ParamTotal.
+
+                                                         <- Ptr
+                 +------------+        +------------+
+                 | ParamTotal |        | ParamTotal |
+                 |------------|        |------------|
+                 | ProcSym    |        | ProcSym    |
+                 |------------|        |------------|
+*)
+
+PROCEDURE BuildOptArg ;
+
+
+(*
+   StartBuildProcedure - Builds a Procedure.
+
+                         The Stack:
+
+                         Entry                 Exit
+
+                                                              <- Ptr
+                                               +------------+
+                  Ptr ->                       | ProcSym    |
+                         +------------+        |------------|
+                         | Name       |        | Name       |
+                         |------------|        |------------|
+*)
+
+PROCEDURE StartBuildProcedure ;
+
+
+(*
+   EndBuildProcedure - Ends building a Procedure.
+                       It checks the start procedure name matches the end
+                       procedure name.
+
+                       The Stack:
+
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +------------+
+                       | NameEnd    |
+                       |------------|
+                       | ProcSym    |
+                       |------------|
+                       | NameStart  |
+                       |------------|
+                                             Empty
+*)
+
+PROCEDURE EndBuildProcedure ;
+
+
+(*
+   BuildPointerType - builds a pointer type.
+                      The Stack:
+
+                      Entry                       Exit
+                      =====                       ====
+
+
+               Ptr ->                                             <- Ptr
+                      +------------+              +-------------+
+                      | Type       |              | PointerType |
+                      |------------|              |-------------|
+                      | Name       |              | Name        |
+                      |------------|              |-------------|
+*)
+
+PROCEDURE BuildPointerType ;
+
+
+(*
+   BuildSetType - builds a set type.
+                  The Stack:
+
+                  Entry                       Exit
+                  =====                       ====
+
+
+           Ptr ->                                             <- Ptr
+                  +------------+              +-------------+
+                  | Type       |              | SetType     |
+                  |------------|              |-------------|
+                  | Name       |              | Name        |
+                  |------------|              |-------------|
+*)
+
+PROCEDURE BuildSetType (ispacked: BOOLEAN) ;
+
+
+(*
+   BuildRecord - Builds a record type.
+                 The Stack:
+
+                 Entry                        Exit
+                 =====                        ====
+
+                                                            <- Ptr
+                                              +-----------+
+          Ptr ->                              | RecordSym |
+                 +------------+               |-----------|
+                 | Name       |               | Name      |
+                 |------------|               |-----------|
+*)
+
+PROCEDURE BuildRecord ;
+
+
+(*
+   BuildFieldRecord - Builds a field into a record sym.
+                      The Stack:
+
+
+                      Entry                     Exit
+                      =====                     ====
+
+               Ptr ->
+                      +-------------+
+                      | Alignment   |
+                      |-------------|
+                      | Type | Name |
+                      |-------------|
+                      | n           |
+                      |-------------|
+                      | Id 1        |
+                      |-------------|
+                      .             .
+                      .             .
+                      .             .
+                      |-------------|
+                      | Id n        |                           <- Ptr
+                      |-------------|           +-------------+
+                      | RecordSym   |           | RecordSym   |
+                      |-------------|           |-------------|
+                      | RecordName  |           | RecordName  |
+                      |-------------|           |-------------|
+*)
+
+PROCEDURE BuildFieldRecord ;
+
+
+(*
+   StartBuildVarient - Builds a varient symbol on top of a record sym.
+                       The Stack:
+
+
+                       Entry                     Exit
+                       =====                     ====
+
+                                                                 <- Ptr
+                                                 +-------------+
+                Ptr ->                           | VarientSym  |
+                       +-------------+           |-------------|
+                       | RecordSym   |           | RecordSym   |
+                       |-------------|           |-------------|
+                       | RecordName  |           | RecordName  |
+                       |-------------|           |-------------|
+*)
+
+PROCEDURE StartBuildVarient ;
+
+
+(*
+   EndBuildVarient - Removes the varient symbol from the stack.
+                     The Stack:
+
+                     Entry                     Exit
+                     =====                     ====
+
+              Ptr ->
+                     +-------------+
+                     | VarientSym  |                           <- Ptr
+                     |-------------|           +-------------+
+                     | RecordSym   |           | RecordSym   |
+                     |-------------|           |-------------|
+                     | RecordName  |           | RecordName  |
+                     |-------------|           |-------------|
+*)
+
+PROCEDURE EndBuildVarient ;
+
+
+(*
+   BuildVarientSelector - Builds a field into a record sym.
+                          The Stack:
+
+
+                          Entry                     Exit
+                          =====                     ====
+
+                   Ptr ->
+                          +-------------+
+                          | Qualident   |
+                          |-------------|
+                          | Ident       |                           <- Ptr
+                          |-------------|           +-------------+
+                          | RecordSym   |           | RecordSym   |
+                          |-------------|           |-------------|
+*)
+
+PROCEDURE BuildVarientSelector ;
+
+
+(*
+   StartBuildVarientFieldRecord - Builds a varient field into a varient sym.
+                                  The Stack:
+
+
+                                  Entry                     Exit
+                                  =====                     ====
+
+                                                                       <- Ptr
+                                                       +-------------+
+                      Ptr ->                           | VarientField|
+                             +-------------+           |-------------|
+                             | VarientSym  |           | RecordSym   |
+                             |-------------|           |-------------|
+*)
+
+PROCEDURE StartBuildVarientFieldRecord ;
+
+
+(*
+   EndBuildVarientFieldRecord - Removes a varient field from the stack.
+                                The Stack:
+
+
+                                Entry                     Exit
+                                =====                     ====
+
+                         Ptr ->
+                                +-------------+
+                                | VarientField|                           <- Ptr
+                                |-------------|           +-------------+
+                                | VarientSym  |           | VarientSym  |
+                                |-------------|           |-------------|
+*)
+
+PROCEDURE EndBuildVarientFieldRecord ;
+
+
+(*
+   BuildNulName - Pushes a NulKey onto the top of the stack.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+                                                          <- Ptr
+                  Empty                    +------------+
+                                           | NulKey     |
+                                           |------------|
+*)
+
+PROCEDURE BuildNulName ;
+
+
+(*
+   BuildTypeEnd - Pops the type Type and Name.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+
+           Ptr ->
+                  +-------------+
+                  | Type | Name |          Empty
+                  |-------------|
+*)
+
+PROCEDURE BuildTypeEnd ;
+
+
+(*
+   StartBuildArray - Builds an array type.
+                     The Stack:
+
+                     Entry                        Exit
+                     =====                        ====
+
+                                                                <- Ptr
+                                                  +-----------+
+              Ptr ->                              | ArraySym  |
+                     +------------+               |-----------|
+                     | Name       |               | Name      |
+                     |------------|               |-----------|
+*)
+
+PROCEDURE StartBuildArray ;
+
+
+(*
+   EndBuildArray - Builds an array type.
+                   The Stack:
+
+                   Entry                        Exit
+                   =====                        ====
+
+            Ptr ->
+                   +------------+
+                   | TypeSym    |                              <- Ptr
+                   |------------|               +------------+
+                   | ArraySym   |               | ArraySym   |
+                   |------------|               |------------|
+                   | Name       |               | Name       |
+                   |------------|               |------------|
+*)
+
+PROCEDURE EndBuildArray ;
+
+
+(*
+   BuildFieldArray - Builds a field into an array sym.
+                     The Stack:
+
+
+                     Entry                     Exit
+                     =====                     ====
+
+              Ptr ->
+                     +-------------+
+                     | Type | Name |                           <- Ptr
+                     |-------------|           +-------------+
+                     | ArraySym    |           | ArraySym    |
+                     |-------------|           |-------------|
+                     | ArrayName   |           | ArrayName   |
+                     |-------------|           |-------------|
+*)
+
+PROCEDURE BuildFieldArray ;
+
+
+(*
+   BuildArrayComma - converts ARRAY [..], [..] OF into ARRAY [..] OF ARRAY [..]
+
+
+              Ptr ->                                           <- Ptr
+                     +-------------+           +-------------+
+                     | ArraySym1   |           | ArraySym2   |
+                     |-------------|           |-------------|
+                     | ArrayName   |           | ArrayName   |
+                     |-------------|           |-------------|
+*)
+
+PROCEDURE BuildArrayComma ;
+
+
+(*
+   BuildProcedureType - builds a procedure type symbol.
+                        The Stack:
+
+
+                                                               <- Ptr
+                                               +-------------+
+                 Ptr ->                        | ProcTypeSym |
+                        +-------------+        |-------------|
+                        | Name        |        | Name        |
+                        |-------------|        |-------------|
+*)
+
+PROCEDURE BuildProcedureType ;
+
+
+(*
+   BuildFormalType - Builds a Formal Parameter in a procedure type.
+
+                     The Stack:
+
+                     Entry                 Exit
+
+              Ptr ->
+                     +------------+
+                     | TypeSym    |
+                     |------------|
+                     | Array/Nul  |
+                     |------------|
+                     | Var / Nul  |                         <- Ptr
+                     |------------|        +--------------+
+                     | ProcTypeSym|        | ProcTypeSym  |
+                     |------------|        |--------------|
+*)
+
+PROCEDURE BuildFormalType ;
+
+
+
+(*
+   SeenUnknown - sets the operand type to unknown.
+*)
+
+PROCEDURE SeenUnknown ;
+
+
+(*
+   SeenCast - sets the operand type to cast.
+*)
+
+PROCEDURE SeenCast (sym: CARDINAL) ;
+
+
+(*
+   SeenSet - sets the operand type to set.
+*)
+
+PROCEDURE SeenSet ;
+
+
+(*
+   SeenConstructor - sets the operand type to constructor.
+*)
+
+PROCEDURE SeenConstructor ;
+
+
+(*
+   SeenArray - sets the operand type to array.
+*)
+
+PROCEDURE SeenArray ;
+
+
+(*
+   SeenString - sets the operand type to string.
+*)
+
+PROCEDURE SeenString ;
+
+
+(*
+   SeenBoolean - sets the operand type to a BOOLEAN.
+*)
+
+PROCEDURE SeenBoolean ;
+
+
+(*
+   SeenZType - sets the operand type to a Z type.
+*)
+
+PROCEDURE SeenZType ;
+
+
+(*
+   SeenRType - sets the operand type to a R type.
+*)
+
+PROCEDURE SeenRType ;
+
+
+(*
+   SeenCType - sets the operand type to a C type.
+*)
+
+PROCEDURE SeenCType ;
+
+
+(*
+   DetermineType - assigns the top of stack symbol with the type of
+                   constant expression, if known.
+*)
+
+PROCEDURE DetermineType ;
+
+
+(*
+   PushType - pushes the current constant type.
+*)
+
+PROCEDURE PushType ;
+
+
+(*
+   PopType - pops the stacked type.
+*)
+
+PROCEDURE PopType ;
+
+
+(*
+   PushRememberConstant -
+*)
+
+PROCEDURE PushRememberConstant ;
+
+
+(*
+   PopRememberConstant -
+*)
+
+PROCEDURE PopRememberConstant ;
+
+
+(*
+   RememberConstant -
+*)
+
+PROCEDURE RememberConstant (sym: CARDINAL) ;
+
+
+END P2SymBuild.
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
new file mode 100644
index 00000000000..d5c8d249963
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -0,0 +1,3105 @@
+(* P2SymBuild.mod pass 2 symbol creation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE P2SymBuild ;
+
+
+FROM libc IMPORT strlen ;
+FROM NameKey IMPORT Name, MakeKey, makekey, KeyToCharStar, NulName, LengthKey, WriteKey ;
+FROM StrLib IMPORT StrEqual ;
+FROM M2Debug IMPORT Assert, WriteDebug ;
+FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo ;
+FROM M2Error IMPORT InternalError, WriteFormat1, WriteFormat2, WriteFormat0, ErrorStringAt, ErrorStringAt2 ;
+FROM M2MetaError IMPORT MetaError1, MetaError2, MetaErrorsT2, MetaErrors1, MetaErrors2, MetaErrorString1 ;
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, Mark, Slice, ConCat, KillString, string ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf4 ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
+FROM M2StackWord IMPORT StackOfWord, InitStackWord, PushWord, PopWord ;
+FROM M2Options IMPORT PedanticParamNames, ExtendedOpaque ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM M2Base IMPORT ZType ;
+FROM Storage IMPORT ALLOCATE ;
+FROM m2linemap IMPORT location_t ;
+FROM M2LexBuf IMPORT TokenToLocation ;
+
+FROM M2Reserved IMPORT ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
+                       NulTok, VarTok, ArrayTok ;
+
+FROM FifoQueue IMPORT GetEnumerationFromFifoQueue, PutSubrangeIntoFifoQueue,
+                      PutConstructorIntoFifoQueue, PutConstIntoFifoQueue ;
+
+FROM SymbolTable IMPORT NulSym,
+                        ModeOfAddr,
+                        StartScope, EndScope, PseudoScope,
+                        GetCurrentScope, GetScope,
+                        IsDeclaredIn,
+                        SetCurrentModule, SetFileModule,
+                        GetCurrentModule, GetMainModule,
+                        MakeTemporary, CheckAnonymous, IsNameAnonymous,
+                        MakeConstLit,
+                        MakeConstLitString,
+                        MakeSubrange,
+                        MakeVar, MakeType, PutType,
+                        MakeModuleCtor,
+                        PutMode, PutDeclared,
+                        PutFieldEnumeration, PutSubrange, PutVar, PutConst,
+                        PutConstSet, PutConstructor,
+                        IsDefImp, IsType, IsRecord, IsRecordField, IsPointer,
+                        IsSubrange, IsEnumeration, IsConstString,
+                        IsError, IsAModula2Type, IsParameterVar, IsParameterUnbounded,
+                        GetSym, GetDeclareSym, IsUnknown, RenameSym,
+                        GetLocalSym, GetParent, IsRecord, GetRecord,
+                        GetFromOuterModule,
+                        GetExported,
+                        PutExported, PutExportQualified, PutExportUnQualified,
+                        PutExportUnImplemented,
+                        PutFieldVarient, PutVarientTag,
+                        IsFieldVarient, IsVarient,
+                        CheckForEnumerationInCurrentModule,
+                        CheckForExportedImplementation,
+                        MakeProcedure,
+                        PutFunction, PutOptFunction,
+                        PutParam, PutVarParam,
+                        GetNthParam,
+                        IsProcedure,
+                        NoOfElements,
+                        MakePointer, PutPointer,
+      	          	MakeSet, PutSet,
+                        MakeRecord, PutFieldRecord,
+                        MakeVarient, MakeFieldVarient,
+                        MakeArray, PutArraySubscript,
+                        MakeSubscript, PutSubscript,
+                        PutConstString, GetString,
+                        PutArray, IsArray,
+                        GetType, SkipType,
+                        IsProcType, MakeProcType,
+                        PutProcTypeVarParam, PutProcTypeParam,
+                        MakeConstVar,
+                        PutVariableAtAddress, IsVariableAtAddress,
+                        GetAlignment, PutAlignment,
+                        PutDefaultRecordFieldAlignment,
+                        GetDefaultRecordFieldAlignment,
+                        PutUnused,
+                        MakeUnbounded, IsUnbounded,
+                        NoOfParam,
+                        PutParamName,
+                        GetParam, GetDimension,
+                        AreParametersDefinedInDefinition,
+                        AreParametersDefinedInImplementation,
+                        AreProcedureParametersDefined,
+                        ParametersDefinedInDefinition,
+                        ParametersDefinedInImplementation,
+                        ProcedureParametersDefined,
+                        CheckForUnImplementedExports,
+                        CheckForUndeclaredExports,
+                        IsHiddenTypeDeclared,
+                        IsUnboundedParam,
+                        IsVarParam,
+                        PutUseVarArgs,
+                        UsesVarArgs,
+                        PutUseOptArg,
+                        UsesOptArg,
+                        IsDefinitionForC,
+                        GetSymName,
+                        GetDeclaredDef, GetDeclaredMod,
+                        RequestSym,
+                        PutDeclared,
+                        GetPackedEquivalent,
+                        DisplayTrees ;
+
+FROM M2Batch IMPORT MakeDefinitionSource,
+                    MakeImplementationSource,
+                    MakeProgramSource,
+                    LookupModule, LookupOuterModule ;
+
+FROM M2Quads IMPORT PushT, PopT,
+                    PushTF, PopTF, PopTtok, PushTFtok, PushTtok, PopTFtok,
+                    OperandT, OperandF, OperandA, OperandTok, PopN, DisplayStack, Annotate,
+                    AddVarientFieldToList ;
+
+FROM M2Comp IMPORT CompilingDefinitionModule,
+                   CompilingImplementationModule,
+                   CompilingProgramModule ;
+
+FROM M2Const IMPORT constType ;
+FROM M2Students IMPORT CheckForVariableThatLooksLikeKeyword ;
+IMPORT M2Error ;
+
+
+CONST
+   Debugging = FALSE ;
+
+VAR
+   alignTypeNo       : CARDINAL ;
+   castType          : CARDINAL ;
+   type              : constType ;
+   RememberedConstant: CARDINAL ;
+   RememberStack,
+   TypeStack         : StackOfWord ;
+   curModuleSym      : CARDINAL ;
+   curBeginTok,
+   curFinallyTok,
+   curStartTok,
+   curEndTok         : CARDINAL ;
+   BlockStack        : StackOfWord ;
+
+
+PROCEDURE stop ; BEGIN END stop ;
+
+
+(*
+   BlockStart - tokno is the module/procedure/implementation/definition token
+*)
+
+PROCEDURE BlockStart (tokno: CARDINAL) ;
+BEGIN
+   PushBlock (tokno) ;
+END BlockStart ;
+
+
+(*
+   propageteTokenPosition - if laterTokPos is unknown then return knownTokPos.
+                            else return laterTokPos.
+*)
+
+PROCEDURE propageteTokenPosition (knownTokPos, laterTokPos: CARDINAL) : CARDINAL ;
+BEGIN
+   IF laterTokPos = UnknownTokenNo
+   THEN
+      RETURN knownTokPos
+   ELSE
+      RETURN laterTokPos
+   END
+END propageteTokenPosition ;
+
+
+(*
+   BlockEnd - declare module ctor/init/fini/dep procedures.
+*)
+
+PROCEDURE BlockEnd (tokno: CARDINAL) ;
+BEGIN
+   curBeginTok := propageteTokenPosition (curStartTok, curBeginTok) ;
+   curFinallyTok := propageteTokenPosition (tokno, curFinallyTok) ;
+   Assert (curModuleSym # NulSym) ;
+   MakeModuleCtor (curStartTok, curBeginTok, curFinallyTok,
+                   curModuleSym) ;
+   PopBlock
+END BlockEnd ;
+
+
+(*
+   BlockBegin - assign curBeginTok to tokno.
+*)
+
+PROCEDURE BlockBegin (tokno: CARDINAL) ;
+BEGIN
+   curBeginTok := tokno
+END BlockBegin ;
+
+
+(*
+   BlockFinally - assign curFinallyTok to tokno.
+*)
+
+PROCEDURE BlockFinally (tokno: CARDINAL) ;
+BEGIN
+   curFinallyTok := tokno
+END BlockFinally ;
+
+
+(*
+   PushBlock - push the block variables to the block stack.
+*)
+
+PROCEDURE PushBlock (tokno: CARDINAL) ;
+BEGIN
+   PushWord (BlockStack, curStartTok) ;   (* module/implementation/definition/procedure token pos.  *)
+   PushWord (BlockStack, curBeginTok) ;   (* BEGIN keyword pos.  *)
+   PushWord (BlockStack, curEndTok) ;     (* END keyword pos.  *)
+   PushWord (BlockStack, curFinallyTok) ; (* FINALLY keyword pos.  *)
+   PushWord (BlockStack, curModuleSym) ;  (* current module.  *)
+   curStartTok := tokno ;
+   curBeginTok := UnknownTokenNo ;
+   curEndTok := UnknownTokenNo ;
+   curFinallyTok := UnknownTokenNo ;
+   curModuleSym := NulSym
+END PushBlock ;
+
+
+(*
+   PopBlock - pop the block variables from the block stack.
+*)
+
+PROCEDURE PopBlock ;
+BEGIN
+   curModuleSym := PopWord (BlockStack) ;
+   curFinallyTok := PopWord (BlockStack) ;
+   curEndTok := PopWord (BlockStack) ;
+   curBeginTok := PopWord (BlockStack) ;
+   curStartTok := PopWord (BlockStack)
+END PopBlock ;
+
+
+(*
+   StartBuildDefinitionModule - Creates a definition module and starts
+                                a new scope.
+
+                                he Stack is expected:
+
+                                Entry                 Exit
+
+                         Ptr ->                                     <- Ptr
+                                +------------+        +-----------+
+                                | NameStart  |        | NameStart |
+                                |------------|        |-----------|
+
+*)
+
+PROCEDURE P2StartBuildDefModule ;
+VAR
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+   tokno    : CARDINAL ;
+BEGIN
+   PopTtok(name, tokno) ;
+   ModuleSym := MakeDefinitionSource(tokno, name) ;
+   curModuleSym := ModuleSym ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   StartScope(ModuleSym) ;
+   Assert(IsDefImp(ModuleSym)) ;
+   Assert(CompilingDefinitionModule()) ;
+   PushT(name) ;
+   Annotate("%1n||definition module name") ;
+   M2Error.EnterDefinitionScope (name)
+END P2StartBuildDefModule ;
+
+
+(*
+   EndBuildDefinitionModule - Destroys the definition module scope and
+                              checks for correct name.
+
+                              The Stack is expected:
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +-----------+
+                              | NameEnd    |        |           |
+                              |------------|        |-----------|
+                              | NameStart  |        |           | <- Ptr
+                              |------------|        |-----------|
+*)
+
+PROCEDURE P2EndBuildDefModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   Assert(CompilingDefinitionModule()) ;
+   CheckForUndeclaredExports(GetCurrentModule()) ;
+   EndScope ;
+   PopT(NameStart) ;
+   PopT(NameEnd) ;
+   IF Debugging
+   THEN
+      printf0('pass 2: ') ;
+      DisplayTrees(GetCurrentModule())
+   END ;
+   IF NameStart#NameEnd
+   THEN
+      WriteFormat2('inconsistant definition module name, module began as (%a) and ended with (%a)', NameStart, NameEnd)
+   END ;
+   M2Error.LeaveErrorScope
+END P2EndBuildDefModule ;
+
+
+(*
+   StartBuildImplementationModule - Creates an implementation module and starts
+                                    a new scope.
+
+                                    The Stack is expected:
+
+                                    Entry                 Exit
+
+                             Ptr ->                                     <- Ptr
+                                    +------------+        +-----------+
+                                    | NameStart  |        | NameStart |
+                                    |------------|        |-----------|
+
+*)
+
+PROCEDURE P2StartBuildImplementationModule ;
+VAR
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+   tokno    : CARDINAL ;
+BEGIN
+   PopTtok(name, tokno) ;
+   ModuleSym := MakeImplementationSource(tokno, name) ;
+   curModuleSym := ModuleSym ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   StartScope(ModuleSym) ;
+   Assert(IsDefImp(ModuleSym)) ;
+   Assert(CompilingImplementationModule()) ;
+   PushT(name) ;
+   Annotate("%1n||implementation module name") ;
+   M2Error.EnterImplementationScope (name)
+END P2StartBuildImplementationModule ;
+
+
+(*
+   EndBuildImplementationModule - Destroys the implementation module scope and
+                                  checks for correct name.
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->
+                                  +------------+        +-----------+
+                                  | NameEnd    |        |           |
+                                  |------------|        |-----------|
+                                  | NameStart  |        |           | <- Ptr
+                                  |------------|        |-----------|
+*)
+
+PROCEDURE P2EndBuildImplementationModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   Assert(CompilingImplementationModule()) ;
+   CheckForUnImplementedExports ;
+   EndScope ;
+   PopT(NameStart) ;
+   PopT(NameEnd) ;
+   IF NameStart#NameEnd
+   THEN
+      WriteFormat1('inconsistant implementation module name %a', NameStart)
+   END ;
+   M2Error.LeaveErrorScope
+END P2EndBuildImplementationModule ;
+
+
+(*
+   StartBuildProgramModule - Creates a program module and starts
+                             a new scope.
+
+                             The Stack is expected:
+
+                             Entry                 Exit
+
+                      Ptr ->                                     <- Ptr
+                             +------------+        +-----------+
+                             | NameStart  |        | NameStart |
+                             |------------|        |-----------|
+
+*)
+
+PROCEDURE P2StartBuildProgramModule ;
+VAR
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+   tokno    : CARDINAL ;
+BEGIN
+   PopTtok(name, tokno) ;
+   ModuleSym := MakeProgramSource(tokno, name) ;
+   curModuleSym := ModuleSym ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   StartScope(ModuleSym) ;
+   Assert(CompilingProgramModule()) ;
+   Assert(NOT IsDefImp(ModuleSym)) ;
+   PushT(name) ;
+   Annotate("%1n||program module name") ;
+   M2Error.EnterProgramScope (name)
+END P2StartBuildProgramModule ;
+
+
+(*
+   EndBuildProgramModule - Destroys the program module scope and
+                           checks for correct name.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+        +-----------+
+                           | NameEnd    |        |           |
+                           |------------|        |-----------|
+                           | NameStart  |        |           | <- Ptr
+                           |------------|        |-----------|
+*)
+
+PROCEDURE P2EndBuildProgramModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   Assert(CompilingProgramModule()) ;
+   CheckForUndeclaredExports(GetCurrentModule()) ;  (* Not really allowed exports here though! *)
+   EndScope ;
+   PopT(NameStart) ;
+   PopT(NameEnd) ;
+   IF Debugging
+   THEN
+      printf0('pass 2: ') ;
+      DisplayTrees(GetCurrentModule())
+   END ;
+   IF NameStart#NameEnd
+   THEN
+      WriteFormat2('inconsistant program module name %a does not match %a', NameStart, NameEnd)
+   END ;
+   M2Error.LeaveErrorScope
+END P2EndBuildProgramModule ;
+
+
+(*
+   StartBuildInnerModule - Creates an Inner module and starts
+                           a new scope.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                                     <- Ptr
+                           +------------+        +-----------+
+                           | NameStart  |        | NameStart |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE StartBuildInnerModule ;
+VAR
+   name     : Name ;
+   tok      : CARDINAL ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   ModuleSym := GetDeclareSym (tok, name) ;
+   curModuleSym := ModuleSym ;
+   StartScope (ModuleSym) ;
+   Assert(NOT IsDefImp (ModuleSym)) ;
+   PushTtok (name, tok) ;
+   Annotate ("%1n||inner module name") ;
+   M2Error.EnterModuleScope (name)
+END StartBuildInnerModule ;
+
+
+(*
+   EndBuildInnerModule - Destroys the Inner module scope and
+                         checks for correct name.
+
+                         The Stack is expected:
+
+                         Entry                 Exit
+
+                  Ptr ->
+                         +------------+        +-----------+
+                         | NameEnd    |        |           |
+                         |------------|        |-----------|
+                         | NameStart  |        |           | <- Ptr
+                         |------------|        |-----------|
+*)
+
+PROCEDURE EndBuildInnerModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   CheckForUndeclaredExports(GetCurrentModule()) ;
+   EndScope ;
+   PopT(NameStart) ;
+   PopT(NameEnd) ;
+   IF NameStart#NameEnd
+   THEN
+      WriteFormat2('inconsistant inner module name %a does not match %a',
+                   NameStart, NameEnd)
+   END ;
+   M2Error.LeaveErrorScope
+END EndBuildInnerModule ;
+
+
+(*
+   BuildImportOuterModule - Builds imported identifiers into an outer module
+                            from a definition module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildImportOuterModule ;
+VAR
+   Sym, ModSym,
+   i, n       : CARDINAL ;
+BEGIN
+   PopT (n) ;       (* n   = # of the Ident List *)
+   IF OperandT (n+1) # ImportTok
+   THEN
+      (* Ident List contains list of objects imported from ModSym *)
+      ModSym := LookupModule (OperandTok(n+1), OperandT (n+1)) ;
+      i := 1 ;
+      WHILE i<=n DO
+         Sym := GetExported (OperandTok(i), ModSym, OperandT (i)) ;
+         CheckForEnumerationInCurrentModule (Sym) ;
+         INC (i)
+      END
+   END ;
+   PopN (n+1)   (* clear stack *)
+END BuildImportOuterModule ;
+
+
+(*
+   BuildExportOuterModule - Builds exported identifiers from an outer module
+                            to the outside world of library modules.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +--------------+
+                            | #          |        | #            |
+                            |------------|        |--------------|
+                            | Id1        |        | Id1          |
+                            |------------|        |--------------|
+                            .            .        .              .
+                            .            .        .              .
+                            .            .        .              .
+                            |------------|        |--------------|
+                            | Id#        |        | Id#          |
+                            |------------|        |--------------|
+                            | ExportTok  |        | QualifiedTok |
+                            |------------|        |--------------|
+
+                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;
+
+                            Error Condition
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildExportOuterModule ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   PopT(n) ;       (* n   = # of the Ident List *)
+   PopN(n+1)
+END BuildExportOuterModule ;
+
+
+(*
+   BuildImportInnerModule - Builds imported identifiers into an inner module
+                            from the last level of module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildImportInnerModule ;
+VAR
+   Sym, ModSym,
+   n, i       : CARDINAL ;
+BEGIN
+   PopT (n) ;       (* i   = # of the Ident List *)
+   IF OperandT(n+1)=ImportTok
+   THEN
+      (* Ident List contains list of objects *)
+      i := 1 ;
+      WHILE i<=n DO
+         Sym := GetFromOuterModule (OperandTok (i), OperandT (i)) ;
+         CheckForEnumerationInCurrentModule (Sym) ;
+         INC (i)
+      END
+   ELSE
+      (* Ident List contains list of objects from ModSym *)
+      ModSym := LookupOuterModule(OperandTok(n+1), OperandT(n+1)) ;
+      i := 1 ;
+      WHILE i<=n DO
+         Sym := GetExported (OperandTok (i), ModSym, OperandT(i)) ;
+         CheckForEnumerationInCurrentModule (Sym) ;
+         INC  (i)
+      END
+   END ;
+   PopN (n+1)   (* Clear Stack *)
+END BuildImportInnerModule ;
+
+
+(*
+   BuildExportInnerModule - Builds exported identifiers from an inner module
+                            to the next layer module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +--------------+
+                            | #          |        | #            |
+                            |------------|        |--------------|
+                            | Id1        |        | Id1          |
+                            |------------|        |--------------|
+                            .            .        .              .
+                            .            .        .              .
+                            .            .        .              .
+                            |------------|        |--------------|
+                            | Id#        |        | Id#          |
+                            |------------|        |--------------|
+                            | ExportTok  |        | QualifiedTok |
+                            |------------|        |--------------|
+
+                            EXPORT Id1, .. Id# ;  EXPORT QUALIFIED Id1 .. Id# ;
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE BuildExportInnerModule ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   PopT(n) ;
+   PopN(n+1)   (* clear stack               *)
+END BuildExportInnerModule ;
+
+
+(*
+   BuildNumber - Converts a number into a symbol.
+
+
+                 Stack
+
+                 Entry                 Exit
+
+          Ptr ->                                             <- Ptr
+                 +------------+        +-------------------+
+                 | Name | tok |        | Sym | Type | tok  |
+                 |------------+        |-------------------|
+*)
+
+PROCEDURE BuildNumber ;
+VAR
+   name: Name ;
+   Sym : CARDINAL ;
+   tok : CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   Sym := MakeConstLit (tok, name, NulSym) ;
+   PushTFtok (Sym, GetType (Sym), tok) ;
+   Annotate ("%1s(%1d)||constant number")
+END BuildNumber ;
+
+
+(*
+   BuildString - Converts a string into a symbol.
+
+
+                 Stack
+
+                 Entry                 Exit
+
+          Ptr ->                                               <- Ptr
+                 +-------------+        +--------------------+
+                 | Name | | tok|        | Sym | NulSym | tok |
+                 |-------------+        |--------------------|
+*)
+
+PROCEDURE BuildString ;
+VAR
+   name: Name ;
+   Sym : CARDINAL ;
+   tok : CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   (* slice off the leading and trailing quotes *)
+   IF name = 1140
+   THEN
+      stop
+   END ;
+   Sym := MakeConstLitString (tok, makekey (string (Mark (Slice (Mark (InitStringCharStar (KeyToCharStar (name))), 1, -1))))) ;
+   PushTFtok (Sym, NulSym, tok) ;
+   Annotate ("%1s(%1d)|%3d||constant string")
+END BuildString ;
+
+
+(*
+   BuildConst - builds a constant.
+                Stack
+
+                Entry                 Exit
+
+         Ptr ->
+                +------------+
+                | Name       |
+                |------------+                       <- Ptr
+*)
+
+PROCEDURE BuildConst ;
+VAR
+   name: Name ;
+   sym : CARDINAL ;
+   tok : CARDINAL ;
+BEGIN
+   PopTtok(name, tok) ;
+   sym := MakeConstVar(tok, name) ;
+   PushTtok(sym, tok) ;
+   RememberConstant(sym) ;
+   Annotate("%1s(%1d)|%3d||remembered constant")
+END BuildConst ;
+
+
+(*
+   StartBuildEnumeration - Builds an Enumeration type Type.
+
+
+                           Stack
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+
+                           | #          |
+                           |------------|
+                           | en 1       |
+                           |------------|
+                           | en 2       |
+                           |------------|
+                           .            .
+                           .            .
+                           .            .                       <- Ptr
+                           |------------|        +------------+
+                           | en #       |        | Type       |
+                           |------------|        |------------|
+                           | Name       |        | Name       |
+                           |------------|        |------------|
+*)
+
+PROCEDURE StartBuildEnumeration ;
+VAR
+   n,
+   Type: CARDINAL ;
+   tok : CARDINAL ;
+BEGIN
+   PopT (n) ;       (* n := # *)
+   (* name is in OperandT(n+1) but we dont need it here.  *)
+   tok := OperandTok (n+1) ;
+   GetEnumerationFromFifoQueue (Type) ;
+   CheckForExportedImplementation (Type) ;   (* May be an exported hidden type *)
+   PopN (n) ;
+   PushTtok (Type, tok) ;
+   Annotate ("%1s(%1d)|%3d||enumerated type")
+END StartBuildEnumeration ;
+
+
+(*
+   BuildSubrange - Builds a Subrange type Symbol, the base type can also be
+                   supplied if known.
+
+                      Stack
+
+                      Entry                 Exit
+
+
+                                                           <- Ptr
+                                            +------------+
+               Ptr ->                       | Type       |
+                      +------------+        |------------|
+                      | Name       |        | Name       |
+                      |------------|        |------------|
+*)
+
+PROCEDURE BuildSubrange (Base: CARDINAL) ;
+VAR
+   name: Name ;
+   Type: CARDINAL ;
+   tok : CARDINAL ;
+BEGIN
+   PopTtok(name, tok) ;
+   Type := MakeSubrange(tok, name) ;
+   PutSubrangeIntoFifoQueue(Type) ;   (* Store Subrange away so that we can fill in *)
+                                      (* its bounds during pass 3.                  *)
+   PutSubrangeIntoFifoQueue(Base) ;   (* store Base type of subrange away as well.  *)
+   CheckForExportedImplementation(Type) ; (* May be an exported hidden type *)
+   PushTtok(name, tok) ;
+   Annotate("%1n|%3d||subrange name|token no") ;
+   PushTtok(Type, tok) ;
+   Annotate("%1s(%1d)|%3d||subrange type|token no")
+END BuildSubrange ;
+
+
+(*
+   BuildDefaultFieldAlignment -
+
+                 The Stack:
+
+                 Entry                         Exit
+                 =====                         ====
+
+
+          Ptr ->
+                 +-----------+
+                 | Alignment |
+                 |-----------|                 +-----------+
+                 | RecordSym |                 | RecordSym |
+                 |-----------|                 |-----------|
+                 | Name      |                 | Name      |
+                 |-----------|                 |-----------|
+
+*)
+
+PROCEDURE P2BuildDefaultFieldAlignment ;
+VAR
+   tok      : CARDINAL ;
+   alignment: Name ;
+   align    : CARDINAL ;
+BEGIN
+   PopTtok(alignment, tok) ;
+   align := MakeTemporary(tok, ImmediateValue) ;
+   PutConst(align, ZType) ;
+   PutConstIntoFifoQueue(align) ;     (* store align away ready for pass 3 *)
+   PutDefaultRecordFieldAlignment(OperandT(1), align)
+END P2BuildDefaultFieldAlignment ;
+
+
+(*
+   BuildPragmaConst - pushes a constant to the stack and stores it away into the
+                      const fifo queue ready for pass 3.
+*)
+
+PROCEDURE BuildPragmaConst ;
+VAR
+   value : CARDINAL ;
+BEGIN
+   value := MakeTemporary(GetTokenNo (), ImmediateValue) ;
+   PutConst(value, ZType) ;
+   PutConstIntoFifoQueue(value) ;     (* Store value away so that we can fill it in   *)
+   PushT(value) ;                     (* during pass 3.                               *)
+   Annotate("%1s(%1d)||pragma constant")
+END BuildPragmaConst ;
+
+
+(*
+   BuildAligned - builds an alignment constant symbol which is placed onto
+                  the stack.  It expects the ident ALIGNED to be on the
+                  stack.
+
+                         Stack
+
+                           Entry                 Exit
+
+
+                  Ptr ->                                            <- Ptr
+                         +---------------+      +-----------------+
+                         | bytealignment |      | AlignmentConst  |
+                         +---------------+      |-----------------|
+*)
+
+PROCEDURE BuildAligned ;
+VAR
+   tok  : CARDINAL ;
+   name : Name ;
+   align: CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   IF name=MakeKey('bytealignment')
+   THEN
+      align := MakeTemporary (tok, ImmediateValue) ;
+      PutConst(align, ZType) ;
+      PutConstIntoFifoQueue(align) ;     (* Store align away so that we can fill in its  *)
+      PushT(align) ;                     (* value during pass 3.                         *)
+      Annotate("%1s(%1d)|%3d||bytealignment constant generated from <* *>|token no") ;
+      PushTtok(name, tok)
+   ELSE
+      WriteFormat1('expecting bytealignment identifier, rather than %a', name) ;
+      PushT(NulSym)
+   END ;
+   Annotate("%1n(%1d)||bytealignment constant generated from <* *>")
+END BuildAligned ;
+
+
+(*
+   BuildTypeAlignment - the AlignmentConst is either a temporary or NulSym.
+                        In the case of NulSym it is popped from the stack
+                        and the procedure returns.  Otherwise the temporary
+                        is popped and recorded as the alignment value for this
+                        type.  A type may only have one alignment value and
+                        error checking is performed.
+
+                        Stack
+
+                            Entry                 Exit
+
+
+                    Ptr ->
+                           +-----------------+
+                           | AlignmentConst  |
+                           |-----------------|
+                           | Type            |    Empty
+                           |-----------------|
+*)
+
+PROCEDURE BuildTypeAlignment ;
+VAR
+   alignment: Name ;
+   type,
+   align    : CARDINAL ;
+BEGIN
+   PopT(alignment) ;
+   IF alignment=MakeKey('bytealignment')
+   THEN
+      PopT(align) ;
+      PopT(type) ;
+      IF align#NulSym
+      THEN
+         IF IsRecord(type) OR IsRecordField(type) OR IsType(type) OR IsArray(type) OR IsPointer(type)
+         THEN
+            PutAlignment(type, align)
+         ELSE
+            MetaError1('not allowed to add an alignment attribute to type {%1ad}', type)
+         END
+      END
+   ELSIF alignment#NulName
+   THEN
+      WriteFormat1('unknown type alignment attribute, %a', alignment)
+   ELSE
+      PopT(type)
+   END
+END BuildTypeAlignment ;
+
+
+(*
+   BuildVarAlignment - the AlignmentConst is either a temporary or NulSym.
+                       A type may only have one alignment value and
+                       error checking is performed.
+
+                       Stack
+
+                           Entry                 Exit
+
+
+                   Ptr ->
+                          +-----------------+
+                          | AlignmentConst  |                             <- Ptr
+                          |-----------------|        +------------------+
+                          | Type            |        | Type  | TypeName |
+                          |-----------------|        |------------------|
+*)
+
+PROCEDURE BuildVarAlignment ;
+VAR
+   tokno    : CARDINAL ;
+   alignment,
+   newname  : Name ;
+   new,
+   type,
+   align    : CARDINAL ;
+   s        : String ;
+BEGIN
+   PopT(alignment) ;
+   IF alignment=MakeKey('bytealignment')
+   THEN
+      PopT(align) ;
+      PopTtok(type, tokno) ;
+      IF IsRecord(type) OR IsRecordField(type) OR IsType(type) OR IsArray(type) OR IsPointer(type)
+      THEN
+         stop ;
+         IF IsNameAnonymous(type)
+         THEN
+            PutAlignment(type, align) ;
+            PushTFtok(type, GetSymName(type), tokno) ;
+            Annotate("%1s(%1d)|%2n|%3d||aligned type|aligned type name|token no")
+         ELSE
+            (* create a pseudonym *)
+            s := Sprintf1(Mark(InitString('_$A%d')), alignTypeNo) ;
+            INC(alignTypeNo) ;
+            newname := makekey(string(s)) ;
+            IF IsPointer(type)
+            THEN
+               new := MakePointer(tokno, newname)
+            ELSE
+               new := MakeType(tokno, newname)
+            END ;
+            s := KillString(s) ;
+            PutType(new, type) ;
+            PutAlignment(new, align) ;
+            PushTFtok(new, GetSymName(new), tokno) ;
+            Annotate("%1s(%1d)|%2n|%3d||aligned type|aligned type name")
+         END
+      ELSE
+         MetaError1('not allowed to add an alignment attribute to type {%1ad}', type) ;
+         PushTFtok(type, GetSymName(type), tokno) ;
+         Annotate("%1s(%1d)|%2n|%3d||error aligned type|error aligned type name")
+      END
+   ELSIF alignment#NulName
+   THEN
+      WriteFormat1('unknown variable alignment attribute, %a', alignment)
+   END
+END BuildVarAlignment ;
+
+
+(*
+   BuildVariable - Builds variables listed in an IdentList with a Type.
+
+                   Stack
+
+                   Entry                 Exit
+
+            Ptr ->
+                   +------------+        +------------+
+                   | Type | Name|        |            |
+                   |------------|        |------------|
+                   | #          |        |            |
+                   |------------|        |------------|
+                   | Ident 1    |        |            |
+                   |------------|        |------------|
+                   | Ident 2    |        |            |
+                   |------------|        |------------|
+                   .            .        .            .
+                   .            .        .            .
+                   .            .        .            .
+                   |------------|        |------------|
+                   | Ident #    |        |            | <- Ptr
+                   |------------|        |------------|
+
+                                           Empty
+*)
+
+PROCEDURE BuildVariable ;
+VAR
+   name     : Name ;
+   tok,
+   AtAddress,
+   Type,
+   Var,
+   i, n     : CARDINAL ;
+BEGIN
+   PopTF (Type, name) ;
+   PopT (n) ;
+   i := 1 ;
+   WHILE i <= n DO
+      CheckForVariableThatLooksLikeKeyword (OperandT (n+1-i)) ;
+      Var := MakeVar (OperandTok (n+1-i), OperandT (n+1-i)) ;
+      AtAddress := OperandA (n+1-i) ;
+      IF AtAddress # NulSym
+      THEN
+         PutVariableAtAddress (Var, NulSym) ;
+         PutMode (Var, LeftValue)
+      END ;
+      PutVar (Var, Type) ;
+      tok := OperandTok (n+1-i) ;
+      IF tok # UnknownTokenNo
+      THEN
+         PutDeclared (tok, Var) ;
+         name := OperandT (n+1-i) ;
+         (* printf3 ('declaring variable %a at tok %d Type %d \n', name, tok, Type) *)
+         (*
+         l := TokenToLocation (tok) ;
+         printf3 ('declaring variable %a at position %d location %d\n', name, tok, l)
+         *)
+      END ;
+      INC (i)
+   END ;
+   PopN (n)
+END BuildVariable ;
+
+
+(*
+   BuildType - Builds a Type.
+
+
+               Stack
+
+               Entry                 Exit
+
+        Ptr ->
+               +------------+
+               | Type       |                          <- Ptr
+               |------------|        +---------------+
+               | Name       |        | Type  | Name  |
+               |------------|        |---------------|
+
+                                     Empty
+*)
+
+PROCEDURE BuildType ;
+VAR
+   isunknown: BOOLEAN ;
+   n1, n2   : Name ;
+   Sym,
+   Type     : CARDINAL ;
+   name     : Name ;
+   tokno    : CARDINAL ;
+BEGIN
+   (*
+      Two cases
+
+      - the type name the same as Name, or the name is nul. - do nothing.
+      - when type with a name that is different to Name. In which case
+        we create a new type.
+   *)
+   PopTtok(Type, tokno) ;
+   PopT(name) ;
+   IF Debugging
+   THEN
+      n1 := GetSymName(GetCurrentModule()) ;
+      printf2('inside module %a declaring type name %a\n',
+              n1, name) ;
+      IF (NOT IsUnknown(Type))
+      THEN
+         n1 := GetSymName(GetScope(Type)) ;
+         n2 := GetSymName(Type) ;
+         printf2('type was created inside scope %a as name %a\n',
+                 n1, n2)
+      END
+   END ;
+   IF name=NulName
+   THEN
+      (*
+         Typically the declaration that causes this case is:
+
+         VAR
+            a: RECORD
+                  etc
+               END ;
+             ^
+             |
+             +---- type has no name.
+
+      *)
+      (* WriteString('Blank name type') ; WriteLn ; *)
+      PushTFtok(Type, name, tokno) ;
+      Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
+   ELSIF IsError(Type)
+   THEN
+      PushTFtok(Type, name, tokno) ;
+      Annotate("%1s(%1d)|%2n|%3d||error type|error type name|token no")
+   ELSIF GetSymName(Type)=name
+   THEN
+      isunknown := IsUnknown(Type) ;
+      IF isunknown OR
+         (NOT IsDeclaredIn(GetCurrentScope(), Type))
+      THEN
+         Sym := MakeType(tokno, name) ;
+         IF NOT IsError(Sym)
+         THEN
+            IF Sym=Type
+            THEN
+               IF isunknown
+               THEN
+                  MetaError2('attempting to declare a type {%1ad} to a type which is itself unknown {%2ad}',
+                             Sym, Type)
+               ELSE
+                  MetaError1('attempting to declare a type {%1ad} as itself', Sym)
+               END
+            ELSE
+               PutType(Sym, Type) ;
+               CheckForExportedImplementation(Sym) ;    (* May be an exported hidden type *)
+               (* if Type is an enumerated type then add its contents to the pseudo scope *)
+               CheckForEnumerationInCurrentModule(Type)
+            END
+         END ;
+         PushTFtok(Sym, name, tokno) ;
+         Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
+      ELSE
+         PushTFtok(Type, name, tokno) ;
+         Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
+      END
+   ELSE
+      (* example   TYPE a = CARDINAL *)
+      Sym := MakeType(tokno, name) ;
+      PutType(Sym, Type) ;
+      CheckForExportedImplementation(Sym) ;   (* May be an exported hidden type *)
+      PushTFtok(Sym, name, tokno) ;
+      Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
+   END
+END BuildType ;
+
+
+(*
+   StartBuildProcedure - Builds a Procedure.
+
+                         The Stack:
+
+                         Entry                 Exit
+
+                                                              <- Ptr
+                                               +------------+
+                  Ptr ->                       | ProcSym    |
+                         +------------+        |------------|
+                         | Name       |        | Name       |
+                         |------------|        |------------|
+*)
+
+PROCEDURE StartBuildProcedure ;
+VAR
+   name   : Name ;
+   ProcSym: CARDINAL ;
+   tokno  : CARDINAL ;
+BEGIN
+   PopTtok (name, tokno) ;
+   PushTtok (name, tokno) ;  (* name saved for the EndBuildProcedure name check *)
+   ProcSym := GetDeclareSym (tokno, name) ;
+   IF IsUnknown (ProcSym)
+   THEN
+      (*
+         May have been compiled in the definition or implementation module,
+         remember that implementation maybe compiled before corresponding
+         definition module.
+         - no definition should always be compilied before implementation modules.
+      *)
+      ProcSym := MakeProcedure (tokno, name)
+   ELSIF IsProcedure (ProcSym)
+   THEN
+      PutDeclared (tokno, ProcSym)
+   ELSE
+      ErrorStringAt2 (Sprintf1(Mark(InitString('procedure name (%a) has been declared as another object elsewhere')),
+                               name), tokno, GetDeclaredMod (ProcSym))
+   END ;
+   IF CompilingDefinitionModule ()
+   THEN
+      PutExportUnImplemented (tokno, ProcSym)    (* Defined but not yet implemented *)
+   ELSE
+      CheckForExportedImplementation (ProcSym)   (* May be exported procedure *)
+   END ;
+   PushTtok (ProcSym, tokno) ;
+   Annotate ("%1s(%1d)||procedure start symbol") ;
+   StartScope (ProcSym) ;
+   M2Error.EnterProcedureScope (name)
+END StartBuildProcedure ;
+
+
+(*
+   EndBuildProcedure - Ends building a Procedure.
+                       It checks the start procedure name matches the end
+                       procedure name.
+
+                       The Stack:
+
+                       (Procedure Not Defined in definition module)
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +------------+
+                       | NameEnd    |
+                       |------------|
+                       | ProcSym    |
+                       |------------|
+                       | NameStart  |
+                       |------------|
+                                             Empty
+*)
+
+PROCEDURE EndBuildProcedure ;
+VAR
+   NameEnd,
+   NameStart: Name ;
+   ProcSym  : CARDINAL ;
+BEGIN
+   PopT(NameEnd) ;
+   PopT(ProcSym) ;
+   Assert(IsProcedure(ProcSym)) ;
+   PopT(NameStart) ;
+   IF NameEnd#NameStart
+   THEN
+      WriteFormat2('end procedure name does not match beginning %a name %a', NameStart, NameEnd)
+   END ;
+   EndScope ;
+   M2Error.LeaveErrorScope
+END EndBuildProcedure ;
+
+
+(*
+   BuildProcedureHeading - Builds a procedure heading for the definition
+                           module procedures.
+
+                           Operation only performed if compiling a
+                           definition module.
+
+                           The Stack:
+
+                           Entry                       Exit
+
+                    Ptr ->
+                           +------------+
+                           | ProcSym    |
+                           |------------|
+                           | NameStart  |
+                           |------------|
+                                                       Empty
+
+*)
+
+PROCEDURE BuildProcedureHeading ;
+VAR
+   ProcSym  : CARDINAL ;
+   NameStart: Name ;
+BEGIN
+   IF CompilingDefinitionModule()
+   THEN
+      PopT(ProcSym) ;
+      Assert(IsProcedure(ProcSym)) ;
+      PopT(NameStart) ;
+      EndScope
+   END
+END BuildProcedureHeading ;
+
+
+(*
+   BuildFPSection - Builds a Formal Parameter in a procedure.
+
+                    The Stack:
+
+                    Entry                 Exit
+
+             Ptr ->
+                    +------------+
+                    | ParamTotal |
+                    |------------|
+                    | TypeSym    |
+                    |------------|
+                    | Array/Nul  |
+                    |------------|
+                    | NoOfIds    |
+                    |------------|
+                    | Id 1       |
+                    |------------|
+                    .            .
+                    .            .
+                    .            .
+                    |------------|
+                    | Id n       |                       <- Ptr
+                    |------------|        +------------+
+                    | Var / Nul  |        | ParamTotal |
+                    |------------|        |------------|
+                    | ProcSym    |        | ProcSym    |
+                    |------------|        |------------|
+*)
+
+PROCEDURE BuildFPSection ;
+VAR
+   n         : Name ;
+   ProcSym,
+   ParamTotal: CARDINAL ;
+BEGIN
+   PopT(ParamTotal) ;
+   ProcSym := CARDINAL(OperandT(3+CARDINAL(OperandT(3))+2)) ;
+   PushT(ParamTotal) ;
+   Assert(IsProcedure(ProcSym)) ;
+   IF CompilingDefinitionModule()
+   THEN
+      IF AreParametersDefinedInDefinition(ProcSym) AND (ParamTotal=0)
+      THEN
+         n := GetSymName(ProcSym) ;
+         WriteFormat1('cannot declare procedure %a twice in the definition module', n)
+      ELSIF AreParametersDefinedInImplementation(ProcSym)
+      THEN
+         CheckFormalParameterSection
+      ELSE
+         BuildFormalParameterSection ;
+         IF ParamTotal=0
+         THEN
+            ParametersDefinedInDefinition(ProcSym) ;
+            ProcedureParametersDefined(ProcSym)
+         END
+      END
+   ELSIF CompilingImplementationModule()
+   THEN
+      IF AreParametersDefinedInImplementation(ProcSym) AND (ParamTotal=0)
+      THEN
+         n := GetSymName(ProcSym) ;
+         WriteFormat1('cannot declare procedure %a twice in the implementation module', n)
+      ELSIF AreParametersDefinedInDefinition(ProcSym)
+      THEN
+         CheckFormalParameterSection
+      ELSE
+         BuildFormalParameterSection ;
+         IF ParamTotal=0
+         THEN
+            ParametersDefinedInImplementation(ProcSym) ;
+            ProcedureParametersDefined(ProcSym)
+         END
+      END
+   ELSIF CompilingProgramModule()
+   THEN
+      IF AreProcedureParametersDefined(ProcSym) AND (ParamTotal=0)
+      THEN
+         n := GetSymName(ProcSym) ;
+         WriteFormat1('procedure %a parameters already declared in program module', n)
+      ELSE
+         BuildFormalParameterSection ;
+         IF ParamTotal=0
+         THEN
+            ProcedureParametersDefined(ProcSym)
+         END
+      END
+   ELSE
+      InternalError ('should never reach this point')
+   END ;
+   Assert(IsProcedure(OperandT(2)))
+END BuildFPSection ;
+
+
+(*
+   BuildVarArgs - indicates that the ProcSym takes varargs
+                  after ParamTotal.
+                                                         <- Ptr
+                    +------------+        +------------+
+                    | ParamTotal |        | ParamTotal |
+                    |------------|        |------------|
+                    | ProcSym    |        | ProcSym    |
+                    |------------|        |------------|
+
+*)
+
+PROCEDURE BuildVarArgs ;
+VAR
+   ProcSym,
+   ParamTotal: CARDINAL ;
+BEGIN
+   PopT(ParamTotal) ;
+   PopT(ProcSym) ;
+   IF UsesOptArg(ProcSym)
+   THEN
+      WriteFormat0('procedure can use either a single optional argument or a single vararg section ... at the end of the formal parameter list')
+   END ;
+   IF UsesVarArgs(ProcSym)
+   THEN
+      WriteFormat0('procedure can only have one vararg section ... at the end of the formal parameter list')
+   END ;
+   PutUseVarArgs(ProcSym) ;
+   IF IsDefImp(GetCurrentModule())
+   THEN
+      IF NOT IsDefinitionForC(GetCurrentModule())
+      THEN
+         WriteFormat0('the definition module must be declared as DEFINITION MODULE FOR "C" if varargs are to be used')
+      END
+   ELSE
+      WriteFormat0('varargs can only be used in the module declared as DEFINITION MODULE FOR "C"')
+   END ;
+   PushT(ProcSym) ;
+   PushT(ParamTotal)
+END BuildVarArgs ;
+
+
+(*
+   BuildOptArg - indicates that the ProcSym takes a single optarg
+                 after ParamTotal.
+
+                                                         <- Ptr
+                 +------------+        +------------+
+                 | ParamTotal |        | ParamTotal |
+                 |------------|        |------------|
+                 | ProcSym    |        | ProcSym    |
+                 |------------|        |------------|
+*)
+
+PROCEDURE BuildOptArg ;
+VAR
+   ProcSym,
+   ParamTotal: CARDINAL ;
+BEGIN
+   PopT(ParamTotal) ;
+   PopT(ProcSym) ;
+   IF UsesVarArgs(ProcSym)
+   THEN
+      WriteFormat0('procedure can not use an optional argument after a vararg ...')
+   END ;
+   PutUseOptArg(ProcSym) ;
+   PushT(ProcSym) ;
+   PushT(ParamTotal)
+END BuildOptArg ;
+
+
+(*
+   BuildFormalVarArgs - indicates that the procedure type takes varargs.
+
+                                                             <- Ptr
+                        +------------+        +------------+
+                        | ProcSym    |        | ProcSym    |
+                        |------------|        |------------|
+
+*)
+
+PROCEDURE BuildFormalVarArgs ;
+VAR
+   ProcSym: CARDINAL ;
+BEGIN
+   PopT(ProcSym) ;
+   IF UsesVarArgs(ProcSym)
+   THEN
+      WriteFormat0('procedure type can only have one vararg section ... at the end of the formal parameter list')
+   END ;
+   PutUseVarArgs(ProcSym) ;
+   IF IsDefImp(GetCurrentModule())
+   THEN
+      IF NOT IsDefinitionForC(GetCurrentModule())
+      THEN
+         WriteFormat0('the definition module must be declared as DEFINITION MODULE FOR "C" if varargs are to be used')
+      END
+   ELSE
+      WriteFormat0('varargs can only be used in the module declared as DEFINITION MODULE FOR "C"')
+   END ;
+   PushT(ProcSym)
+END BuildFormalVarArgs ;
+
+
+(*
+   BuildFormalParameterSection - Builds a Formal Parameter in a procedure.
+
+                                 The Stack:
+
+                                 Entry                 Exit
+
+                          Ptr ->
+                                 +------------+
+                                 | ParamTotal |
+                                 |------------|
+                                 | TypeSym    |
+                                 |------------|
+                                 | Array/Nul  |
+                                 |------------|
+                                 | NoOfIds    |
+                                 |------------|
+                                 | Id 1       |
+                                 |------------|
+                                 .            .
+                                 .            .
+                                 .            .
+                                 |------------|
+                                 | Id n       |                       <- Ptr
+                                 |------------|        +------------+
+                                 | Var / Nul  |        | ParamTotal |
+                                 |------------|        |------------|
+                                 | ProcSym    |        | ProcSym    |
+                                 |------------|        |------------|
+*)
+
+PROCEDURE BuildFormalParameterSection ;
+VAR
+   ParamName,
+   Var,
+   Array     : Name ;
+   tok       : CARDINAL ;
+   ParamTotal,
+   TypeSym,
+   UnBoundedSym,
+   NoOfIds,
+   ProcSym,
+   i, ndim   : CARDINAL ;
+BEGIN
+   PopT(ParamTotal) ;
+   PopT(TypeSym) ;
+   PopTF(Array, ndim) ;
+   Assert( (Array=ArrayTok) OR (Array=NulTok) ) ;
+   PopT(NoOfIds) ;
+   ProcSym := OperandT(NoOfIds+2) ;
+   Assert(IsProcedure(ProcSym)) ;
+   Var := OperandT(NoOfIds+1) ;
+   tok := OperandTok (NoOfIds+2) ;
+   Assert( (Var=VarTok) OR (Var=NulTok) ) ;
+   IF Array=ArrayTok
+   THEN
+      UnBoundedSym := MakeUnbounded(tok, TypeSym, ndim) ;
+      TypeSym := UnBoundedSym
+   END ;
+   i := 1 ;
+(*
+   WriteString('Procedure ') ; WriteKey(GetSymName(ProcSym)) ;
+   WriteString(' adding No. of identifiers:') ; WriteCard(NoOfIds, 4) ; WriteLn ;
+*)
+   WHILE i<=NoOfIds DO
+      IF CompilingDefinitionModule() AND (NOT PedanticParamNames) AND
+         (* we will see the parameters in the implementation module *)
+         ((GetMainModule()=GetCurrentModule()) OR
+          (IsHiddenTypeDeclared(GetCurrentModule()) AND ExtendedOpaque))
+      THEN
+         ParamName := NulName
+      ELSE
+         ParamName := OperandT(NoOfIds+1-i)
+      END ;
+      tok := OperandTok(NoOfIds+1-i) ;
+      IF Var=VarTok
+      THEN
+         (* VAR parameter *)
+         IF NOT PutVarParam(tok, ProcSym, ParamTotal+i, ParamName, TypeSym, Array=ArrayTok)
+         THEN
+            InternalError ('problems adding a VarParameter - wrong param #?')
+         END
+      ELSE
+         (* Non VAR parameter *)
+         IF NOT PutParam(tok, ProcSym, ParamTotal+i, ParamName, TypeSym, Array=ArrayTok)
+         THEN
+            InternalError ('problems adding a Parameter - wrong param #?')
+         END
+      END ;
+(*
+      WriteString(' parameter') ; WriteCard(ParamTotal+i, 4) ; WriteLn ;
+      WriteKey(Operand(Ptr+i+1)) ; WriteString(' is a parameter with type ') ;
+      WriteKey(GetSymName(TypeSym)) ; WriteLn ;
+*)
+      INC(i)
+   END ;
+   PopN(NoOfIds+1) ;
+   PushT(ParamTotal+NoOfIds) ;
+   Assert(IsProcedure(OperandT(2)))
+END BuildFormalParameterSection ;
+
+
+(*
+   CheckFormalParameterSection - Checks a Formal Parameter in a procedure.
+
+                                 The Stack:
+
+                                 Entry                 Exit
+
+                          Ptr ->
+                                 +------------+
+                                 | ParamTotal |
+                                 |------------|
+                                 | TypeSym    |
+                                 |------------|
+                                 | Array/Nul  |
+                                 |------------|
+                                 | NoOfIds    |
+                                 |------------|
+                                 | Id 1       |
+                                 |------------|
+                                 .            .
+                                 .            .
+                                 .            .
+                                 |------------|
+                                 | Id n       |                       <- Ptr
+                                 |------------|        +------------+
+                                 | Var / Nul  |        | ParamTotal |
+                                 |------------|        |------------|
+                                 | ProcSym    |        | ProcSym    |
+                                 |------------|        |------------|
+*)
+
+PROCEDURE CheckFormalParameterSection ;
+VAR
+   Array, Var: Name ;
+   Unbounded : BOOLEAN ;
+   ParamI,
+   ParamIType,
+   ParamTotal,
+   TypeSym,
+   NoOfIds,
+   ProcSym,
+   pi, i, ndim: CARDINAL ;
+BEGIN
+   PopT(ParamTotal) ;
+   PopT(TypeSym) ;
+   PopTF(Array, ndim) ;
+   Assert( (Array=ArrayTok) OR (Array=NulTok) ) ;
+   PopT(NoOfIds) ;
+   ProcSym := OperandT(NoOfIds+2) ;
+   Assert(IsProcedure(ProcSym)) ;
+   Var := OperandT(NoOfIds+1) ;
+   Assert( (Var=VarTok) OR (Var=NulTok) ) ;
+   Unbounded := (Array=ArrayTok) ;  (* ARRAY OF Type, parameter *)
+   i := 1 ;
+   pi := NoOfIds ;     (* stack index referencing stacked parameter, i *)
+(*
+   WriteString('No. of identifiers:') ; WriteCard(NoOfIds, 4) ; WriteLn ;
+*)
+   WHILE i<=NoOfIds DO
+      IF ParamTotal+i<=NoOfParam(ProcSym)
+      THEN
+         IF Unbounded AND (NOT IsUnboundedParam(ProcSym, ParamTotal+i))
+         THEN
+            FailParameter('the parameter was declared as an ARRAY OF type',
+                          'the parameter was not declared as an ARRAY OF type',
+                          NulName, ParamTotal+i, ProcSym)
+         ELSIF (NOT Unbounded) AND IsUnboundedParam(ProcSym, ParamTotal+i)
+         THEN
+            FailParameter('the parameter was not declared as an ARRAY OF type',
+                          'the parameter was declared as an ARRAY OF type',
+                          NulName, ParamTotal+i, ProcSym)
+         END ;
+         IF Unbounded
+         THEN
+            IF GetDimension(GetNthParam(ProcSym, ParamTotal+1))#ndim
+            THEN
+               FailParameter('', 'the dynamic array parameter was declared with different number of dimensions',
+                             NulName, ParamTotal+i, ProcSym)
+            END
+         END ;
+         IF (Var=VarTok) AND (NOT IsVarParam(ProcSym, ParamTotal+i))
+         THEN
+            (* expecting non VAR pamarater *)
+            FailParameter('the parameter has been declared as a VAR parameter',
+                          'the parameter was not declared as a VAR parameter',
+                          NulName, ParamTotal+i, ProcSym)
+         ELSIF (Var=NulTok) AND IsVarParam(ProcSym, ParamTotal+i)
+         THEN
+            (* expecting VAR pamarater *)
+            FailParameter('the parameter was not declared as a VAR parameter',
+                          'the parameter has been declared as a VAR parameter',
+                          NulName, ParamTotal+i, ProcSym)
+         END ;
+         ParamI := GetParam(ProcSym, ParamTotal+i) ;
+         IF PedanticParamNames
+         THEN
+            IF GetSymName(ParamI)#OperandT(pi)
+            THEN
+               (* different parameter names *)
+               FailParameter('',
+                             'the parameter has been declared with a different name',
+                             OperandT(pi), ParamTotal+i, ProcSym)
+            END
+         ELSE
+            IF GetSymName(ParamI)=NulName
+            THEN
+               PutParamName (OperandTok (pi), ProcSym, ParamTotal+i, OperandT(pi))
+            END
+         END ;
+         IF Unbounded
+         THEN
+            (* GetType(ParamI) yields an UnboundedSym or a PartialUnboundedSym,
+               depending whether it has been resolved.. *)
+            ParamIType := GetType(GetType(ParamI))
+         ELSE
+            ParamIType := GetType(ParamI)
+         END ;
+         IF ((SkipType(ParamIType)#SkipType(TypeSym)) OR
+             (PedanticParamNames AND (ParamIType#TypeSym))) AND
+            (NOT IsUnknown(SkipType(TypeSym))) AND
+            (NOT IsUnknown(SkipType(ParamIType)))
+         THEN
+            (* different parameter types *)
+            FailParameter('',
+                          'the parameter has been declared with a different type',
+                          OperandT(pi), ParamTotal+i, ProcSym)
+         END
+      ELSE
+         FailParameter('too many parameters',
+                       'fewer parameters were declared',
+                       NulName, ParamTotal+i, ProcSym)
+      END ;
+      INC(i) ;
+      DEC(pi)
+   END ;
+   PopN(NoOfIds+1) ;   (* +1 for the Var/Nul *)
+   PushT(ParamTotal+NoOfIds) ;
+   Assert(IsProcedure(OperandT(2)))
+END CheckFormalParameterSection ;
+
+
+(*
+   FailParameter - generates an error message indicating that a parameter
+                   declaration has failed.
+
+                   The parameters are:
+
+                   CurrentState  - string describing the current failing state.
+                   PreviousState - string describing the old defined state.
+                   Given         - token or identifier that was given.
+                   ParameterNo   - parameter number that has failed.
+                   ProcedureSym  - procedure symbol where parameter has failed.
+
+                   If any parameter is Nul then it is ignored.
+*)
+
+PROCEDURE FailParameter (CurrentState : ARRAY OF CHAR;
+                         PreviousState: ARRAY OF CHAR;
+                         Given        : Name ;
+                         ParameterNo  : CARDINAL;
+                         ProcedureSym : CARDINAL) ;
+VAR
+   First       : CARDINAL ;
+   FirstModule,
+   SecondModule,
+   s1, s2, s3  : String ;
+BEGIN
+   IF NoOfParam(ProcedureSym)>=ParameterNo
+   THEN
+      IF CompilingDefinitionModule()
+      THEN
+         First := GetDeclaredDef(GetNthParam(ProcedureSym, ParameterNo))
+      ELSE
+         First := GetDeclaredMod(GetNthParam(ProcedureSym, ParameterNo))
+      END
+   ELSE
+      (* ParameterNo does not exist - which is probably the reason why this routine was called.. *)
+      IF CompilingDefinitionModule()
+      THEN
+         First := GetDeclaredDef(ProcedureSym)
+      ELSE
+         First := GetDeclaredMod(ProcedureSym)
+      END
+   END ;
+   IF CompilingDefinitionModule()
+   THEN
+      FirstModule := InitString('definition module') ;
+      SecondModule := InitString('implementation module')
+   ELSIF CompilingImplementationModule()
+   THEN
+      FirstModule := InitString('implementation module') ;
+      SecondModule := InitString('definition module')
+   ELSE
+      Assert (CompilingProgramModule ()) ;
+      FirstModule := InitString('program module') ;
+      SecondModule := InitString('definition module')
+   END ;
+   s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ProcedureSym)))) ;
+   s3 := Mark(FirstModule) ;
+   s1 := Sprintf4(Mark(InitString('declaration of procedure %s in the %s differs from the %s, problem with parameter number %d')),
+                  s2, s3,
+                  SecondModule,
+                  ParameterNo) ;
+   IF NoOfParam(ProcedureSym)>=ParameterNo
+   THEN
+      s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(GetNthParam(ProcedureSym, ParameterNo))))) ;
+      s1 := ConCat(s1, Mark(Sprintf1(Mark(InitString(' (%s)')), s2)))
+   END ;
+   IF NOT StrEqual(CurrentState, '')
+   THEN
+      s2 := Mark(InitString(CurrentState)) ;
+      s1 := ConCat(s1, Mark(Sprintf1(Mark(InitString(', %s')), s2)))
+   END ;
+   IF NOT StrEqual(PreviousState, '')
+   THEN
+      s2 := Mark(SecondModule) ;
+      s3 := Mark(InitString(PreviousState)) ;
+      s1 := ConCat(s1, Mark(Sprintf2(Mark(InitString(' in the %s %s')), s2, s3)))
+   END ;
+   IF Given#NulName
+   THEN
+      s2 := Mark(InitStringCharStar(KeyToCharStar(Given))) ;
+      s1 := ConCat(s1, Mark(Sprintf1(Mark(InitString(' (%s)')), s2)))
+   END ;
+   s1 := ConCat(s1, Mark(Sprintf0(Mark(InitString('\n'))))) ;
+   ErrorStringAt2(s1, GetTokenNo(), First)
+END FailParameter ;
+
+
+(*
+   StartBuildFormalParameters - Initialises the quadruple stack for
+                                Formal Parameters.
+
+                                The Stack:
+
+                                Entry                Exit
+
+                                                                    <- Ptr
+                                                     +------------+
+                                Empty                | 0          |
+                                                     |------------|
+*)
+
+PROCEDURE StartBuildFormalParameters ;
+BEGIN
+   PushT(0)
+END StartBuildFormalParameters ;
+
+
+(*
+   EndBuildFormalParameters - Resets the quadruple stack after building
+                              Formal Parameters.
+
+                              The Stack:
+
+                              Entry                    Exit
+
+                       Ptr ->
+                              +------------+
+                              | NoOfParam  |                          <- Ptr
+                              |------------|           +------------+
+                              | ProcSym    |           | ProcSym    |
+                              |------------|           |------------|
+*)
+
+PROCEDURE EndBuildFormalParameters ;
+VAR
+   n      : Name ;
+   NoOfPar: CARDINAL ;
+   ProcSym: CARDINAL ;
+BEGIN
+   PopT(NoOfPar) ;
+   PopT(ProcSym) ;
+   PushT(ProcSym) ;
+   Assert(IsProcedure(ProcSym)) ;
+   IF NoOfParam(ProcSym)#NoOfPar
+   THEN
+      n := GetSymName(ProcSym) ;
+      IF CompilingDefinitionModule()
+      THEN
+         WriteFormat1('procedure (%a) was declared with fewer parameters in the DEFINITION MODULE', n)
+      ELSE
+         WriteFormat1('procedure (%a) was declared with more parameters in the DEFINITION MODULE', n)
+      END
+   END ;
+   Assert(IsProcedure(OperandT(1)))
+END EndBuildFormalParameters ;
+
+
+(*
+   BuildFunction - Builds a procedures return type.
+                   Procedure becomes a function.
+
+                    The Stack:
+
+                    Entry                 Exit
+
+             Ptr ->
+                    +------------+
+                    | TypeSym    |                       <- Ptr
+                    |------------|        +------------+
+                    | ProcSym    |        | ProcSym    |
+                    |------------|        |------------|
+*)
+
+PROCEDURE BuildFunction ;
+VAR
+   PrevSym,
+   TypeSym,
+   ProcSym : CARDINAL ;
+BEGIN
+   PopT(TypeSym) ;
+   PopT(ProcSym) ;
+   IF IsProcedure(ProcSym) AND AreProcedureParametersDefined(ProcSym)
+   THEN
+      PrevSym := GetType(ProcSym) ;
+      IF (PrevSym#NulSym) AND (PrevSym#TypeSym)
+      THEN
+         IF CompilingDefinitionModule()
+         THEN
+            MetaErrorsT2(GetDeclaredDef(ProcSym),
+                         'the return type for procedure {%1a} is defined differently in the definition module as {%1tad} and the implementation module as {%2ad}',
+                         'the return type for procedure {%1a} is defined differently in the definition module as {%1tad} and the implementation module as {%2ad}',
+                         ProcSym, TypeSym)
+         ELSE
+            MetaErrorsT2(GetDeclaredMod(ProcSym),
+                         'the return type for procedure {%1a} is defined differently in the definition module as {%2ad} and the implementation module as {%1tad}',
+                         'the return type for procedure {%1a} is defined differently in the definition module as {%2ad} and the implementation module as {%1tad}',
+                         ProcSym, TypeSym)
+         END
+      END
+   END ;
+   PutFunction(ProcSym, TypeSym) ;
+(*
+   WriteString('Procedure ') ; WriteKey(GetSymName(ProcSym)) ;
+   WriteString(' has a return argument ') ;
+   WriteKey(GetSymName(TypeSym)) ;
+   WriteString(' checking ') ; WriteKey(GetSymName(GetType(ProcSym))) ;
+   WriteLn ;
+*)
+   PushT(ProcSym)
+END BuildFunction ;
+
+
+(*
+   BuildOptFunction - Builds a procedures optional return type.
+                      Procedure becomes a function and the user
+                      can either call it as a function or a procedure.
+
+                      The Stack:
+
+                      Entry                 Exit
+
+               Ptr ->
+                      +------------+
+                      | TypeSym    |                       <- Ptr
+                      |------------|        +------------+
+                      | ProcSym    |        | ProcSym    |
+                      |------------|        |------------|
+*)
+
+PROCEDURE BuildOptFunction ;
+VAR
+   TypeSym,
+   ProcSym : CARDINAL ;
+BEGIN
+   PopT(TypeSym) ;
+   PopT(ProcSym) ;
+   PutOptFunction(ProcSym, TypeSym) ;
+(*
+   WriteString('Procedure ') ; WriteKey(GetSymName(ProcSym)) ;
+   WriteString(' has a return argument ') ;
+   WriteKey(GetSymName(TypeSym)) ;
+   WriteString(' checking ') ; WriteKey(GetSymName(GetType(ProcSym))) ;
+   WriteLn ;
+*)
+   PushT(ProcSym)
+END BuildOptFunction ;
+
+
+(*
+   BuildPointerType - builds a pointer type.
+                      The Stack:
+
+                      Entry                       Exit
+                      =====                       ====
+
+
+               Ptr ->                                             <- Ptr
+                      +------------+              +-------------+
+                      | Type       |              | PointerType |
+                      |------------|              |-------------|
+                      | Name       |              | Name        |
+                      |------------|              |-------------|
+*)
+
+PROCEDURE BuildPointerType ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   Type,
+   PtrToType: CARDINAL ;
+BEGIN
+   PopTtok(Type, tok) ;
+   PopT(name) ;
+   name := CheckAnonymous(name) ;
+
+   PtrToType := MakePointer(tok, name) ;
+   PutPointer(PtrToType, Type) ;
+   CheckForExportedImplementation(PtrToType) ;   (* May be an exported hidden type *)
+   PushTtok(name, tok) ;
+   Annotate("%1n|%3d||pointer type name") ;
+   PushTtok(PtrToType, tok) ;
+   Annotate("%1s(%1d)|%3d||pointer type")
+
+END BuildPointerType ;
+
+
+(*
+   BuildSetType - builds a set type.
+                  The Stack:
+
+                  Entry                       Exit
+                  =====                       ====
+
+
+           Ptr ->                                             <- Ptr
+                  +------------+              +-------------+
+                  | Type       |              | SetType     |
+                  |------------|              |-------------|
+                  | Name       |              | Name        |
+                  |------------|              |-------------|
+*)
+
+PROCEDURE BuildSetType (ispacked: BOOLEAN) ;
+VAR
+   tok    : CARDINAL ;
+   name   : Name ;
+   Type,
+   SetType: CARDINAL ;
+BEGIN
+   PopTtok(Type, tok) ;
+   PopT(name) ;
+   SetType := MakeSet (tok, name) ;
+   CheckForExportedImplementation(SetType) ;   (* May be an exported hidden type *)
+   PutSet(SetType, Type, ispacked) ;
+   PushT(name) ;
+   Annotate("%1n||set type name") ;
+   PushTtok (SetType, tok) ;
+   Annotate ("%1s(%1d)|%3d||set type|token no")
+END BuildSetType ;
+
+
+(*
+   BuildRecord - Builds a record type.
+                 The Stack:
+
+                 Entry                              Exit
+                 =====                              ====
+
+
+                                                                  <- Ptr
+                                                    +-----------+
+          Ptr ->                                    | RecordSym |
+                 +------------------+               |-----------|
+                 | Name             |               | Name      |
+                 |------------------|               |-----------|
+*)
+
+PROCEDURE BuildRecord ;
+VAR
+   tokno     : CARDINAL ;
+   name      : Name ;
+   RecordType: CARDINAL ;
+BEGIN
+   name := OperandT(1) ;
+   name := CheckAnonymous(name) ;
+   tokno := OperandTok(1) ;
+   RecordType := MakeRecord(tokno, name) ;
+   CheckForExportedImplementation(RecordType) ;   (* May be an exported hidden type *)
+   PushT(RecordType) ;
+(* ; WriteKey(name) ; WriteString(' RECORD made') ; WriteLn *)
+   Annotate("%1s(%1d)||record type")
+END BuildRecord ;
+
+
+(*
+   HandleRecordFieldPragmas -
+
+                      Entry                     Exit
+                      =====                     ====
+
+               Ptr ->                                     <- Ptr
+
+                      |-------------|           |-------------|
+                      | Const1      |           | Const1      |
+                      |-------------|           |-------------|
+                      | PragmaName1 |           | PragmaName1 |
+                      |-------------|           |-------------|
+*)
+
+PROCEDURE HandleRecordFieldPragmas (record, field: CARDINAL; n: CARDINAL) ;
+VAR
+   seenAlignment   : BOOLEAN ;
+   defaultAlignment,
+   sym             : CARDINAL ;
+   i               : CARDINAL ;
+   name            : Name ;
+   s               : String ;
+BEGIN
+   seenAlignment := FALSE ;
+   defaultAlignment := GetDefaultRecordFieldAlignment(record) ;
+   i := 1 ;
+   WHILE i<=n DO
+      name := OperandT(i*2) ;
+      sym  := OperandT(i*2-1) ;
+      IF name=MakeKey('unused')
+      THEN
+         IF sym=NulSym
+         THEN
+            PutUnused(field)
+         ELSE
+            WriteFormat0("not expecting pragma 'unused' to contain an expression")
+         END
+      ELSIF name=MakeKey('bytealignment')
+      THEN
+         IF sym=NulSym
+         THEN
+            WriteFormat0("expecting an expression with the pragma 'bytealignment'")
+         ELSE
+            PutAlignment(field, sym) ;
+            seenAlignment := TRUE
+         END
+      ELSE
+         s := InitString("cannot use pragma '") ;
+         s := ConCat(s, Mark(InitStringCharStar(KeyToCharStar(name)))) ;
+         s := ConCat(s, Mark(InitString("' on record field {%1ad}"))) ;
+         MetaErrorString1(s, field)
+      END ;
+      INC(i)
+   END ;
+   IF (NOT seenAlignment) AND (defaultAlignment#NulSym)
+   THEN
+      PutAlignment(field, defaultAlignment)
+   END
+END HandleRecordFieldPragmas ;
+
+
+(*
+   BuildFieldRecord - Builds a field into a record sym.
+                      The Stack:
+
+
+                      Entry                     Exit
+                      =====                     ====
+
+               Ptr ->
+                      +-------------+
+                      | NoOfPragmas |
+                      |-------------|
+                      | Const1      |
+                      |-------------|
+                      | PragmaName1 |
+                      |-------------|
+                      | Type | Name |
+                      |-------------|
+                      | n           |
+                      |-------------|
+                      | Id 1        |
+                      |-------------|
+                      .             .
+                      .             .
+                      .             .
+                      |-------------|
+                      | Id n        |                           <- Ptr
+                      |-------------|           +-------------+
+                      | RecordSym   |           | RecordSym   |
+                      |-------------|           |-------------|
+                      | RecordName  |           | RecordName  |
+                      |-------------|           |-------------|
+*)
+
+PROCEDURE BuildFieldRecord ;
+VAR
+   n1         : Name ;
+   tok,
+   fsym,
+   Field,
+   Varient,
+   Parent,
+   Type,
+   NoOfPragmas,
+   NoOfFields,
+   Record,
+   i          : CARDINAL ;
+BEGIN
+   PopT(NoOfPragmas) ;
+   Type := OperandT(NoOfPragmas*2+1) ;
+   (* name := OperandF(NoOfPragmas*2+1) ;  *)
+   NoOfFields := OperandT(NoOfPragmas*2+2) ;
+   Record := OperandT(NoOfPragmas*2+NoOfFields+3) ;
+   IF IsRecord(Record)
+   THEN
+      Parent := Record ;
+      Varient := NulSym
+   ELSE
+      (* Record maybe FieldVarient *)
+      Parent := GetRecord(GetParent(Record)) ;
+      Assert(IsFieldVarient(Record)) ;
+      Varient := OperandT(NoOfPragmas*2+NoOfFields+4) ;
+      Assert(IsVarient(Varient)) ;
+      PutFieldVarient(Record, Varient) ;
+      IF Debugging
+      THEN
+         n1 := GetSymName(Record) ;
+         WriteString('Record ') ;
+         WriteKey(n1) ;
+         WriteString(' has varient ') ;
+         n1 := GetSymName(Varient) ;
+         WriteKey(n1) ; WriteLn
+      END
+   END ;
+   Field := NulSym ;
+   i := 1 ;
+   WHILE i<=NoOfFields DO
+      IF Debugging
+      THEN
+         n1 := GetSymName(Record) ;
+         WriteString('Record ') ;
+         WriteKey(n1) ;
+         WriteString('  ') ;
+         WriteKey(OperandT(NoOfPragmas*2+NoOfFields+3-i)) ; WriteString(' is a Field with type ') ;
+         WriteKey(GetSymName(Type)) ; WriteLn ;
+      END ;
+      fsym := GetLocalSym(Parent, OperandT(NoOfPragmas*2+NoOfFields+3-i)) ;
+      IF fsym=NulSym
+      THEN
+         Field := PutFieldRecord(Record, OperandT(NoOfPragmas*2+NoOfFields+3-i), Type, Varient) ;
+         HandleRecordFieldPragmas(Record, Field, NoOfPragmas)
+      ELSE
+         MetaErrors2('record field {%1ad} has already been declared inside a {%2Dd} {%2a}',
+                     'attempting to declare a duplicate record field', fsym, Parent)
+      END ;
+      (* adjust the location of declaration to the one on the stack (rather than GetTokenNo).  *)
+      tok := OperandTok(NoOfPragmas*2+NoOfFields+3-i) ;
+      IF (tok # UnknownTokenNo) AND (Field # NulSym)
+      THEN
+         PutDeclared (tok, Field)
+      END ;
+      INC(i)
+   END ;
+   PopN(NoOfPragmas*2+NoOfFields+3) ;
+   PushT(Record) ;
+   IF IsRecord(Record)
+   THEN
+      Annotate("%1s(%1d)||record type")
+   ELSE
+      Assert(IsFieldVarient(Record)) ;
+      Annotate("%1s(%1d)||varient field type")
+   END
+END BuildFieldRecord ;
+
+
+(*
+   BuildVarientSelector - Builds a field into a record sym.
+                          The Stack:
+
+
+                          Entry                     Exit
+                          =====                     ====
+
+                   Ptr ->
+                          +-------------+
+                          | Type        |
+                          |-------------|
+                          | Tag         |                           <- Ptr
+                          |-------------|           +-------------+
+                          | RecordSym   |           | RecordSym   |
+                          |-------------|           |-------------|
+*)
+
+PROCEDURE BuildVarientSelector ;
+VAR
+   tagtok    : CARDINAL ;
+   tag       : Name ;
+   Field,
+   Type,
+   Varient,
+   VarField,
+   Record    : CARDINAL ;
+BEGIN
+   PopT(Type) ;
+   PopTtok (tag, tagtok) ;
+   Record := OperandT(1) ;
+   IF IsRecord(Record)
+   THEN
+      Varient := NulSym ;
+      InternalError ('not expecting a record symbol')
+   ELSIF IsVarient(Record)
+   THEN
+      Varient := Record ;
+      VarField := GetParent(Varient) ;
+      IF (Type=NulSym) AND (tag=NulName)
+      THEN
+         MetaError1('expecting a tag field in the declaration of a varient record {%1Ua}', Record)
+      ELSIF Type=NulSym
+      THEN
+         PutVarientTag (Varient, RequestSym (tagtok, tag))
+      ELSE
+         Field := PutFieldRecord (VarField, tag, Type, Varient) ;
+         PutVarientTag(Varient, Field) ;
+         IF Debugging
+         THEN
+            WriteString('varient field ') ; WriteKey(GetSymName(VarField)) ;
+            WriteString('varient ') ; WriteKey(GetSymName(Varient)) ; WriteLn
+         END
+      END
+   ELSE
+      (* Record maybe FieldVarient *)
+      Assert(IsFieldVarient(Record)) ;
+      Varient := OperandT(1+2) ;
+      Assert(IsVarient(Varient)) ;
+      PutFieldVarient(Record, Varient) ;
+      IF Debugging
+      THEN
+         WriteString('record ') ; WriteKey(GetSymName(Record)) ;
+         WriteString('varient ') ; WriteKey(GetSymName(Varient)) ; WriteLn
+      END ;
+      IF (Type=NulSym) AND (tag=NulName)
+      THEN
+         MetaError1('expecting a tag field in the declaration of a varient record {%1Ua}', Record)
+      ELSIF Type=NulSym
+      THEN
+         PutVarientTag(Varient, RequestSym (tagtok, tag))
+      ELSE
+         Field := PutFieldRecord(Record, tag, Type, Varient) ;
+         PutVarientTag(Varient, Field) ;
+         IF Debugging
+         THEN
+            WriteString('record ') ; WriteKey(GetSymName(Record)) ;
+            WriteString('varient ') ; WriteKey(GetSymName(Varient)) ; WriteLn
+         END
+      END
+   END
+END BuildVarientSelector ;
+
+
+(*
+   StartBuildVarientFieldRecord - Builds a varient field into a varient sym.
+                                  The Stack:
+
+
+                                  Entry                     Exit
+                                  =====                     ====
+
+                                                                       <- Ptr
+                                                       +-------------+
+                      Ptr ->                           | VarientField|
+                             +-------------+           |-------------|
+                             | VarientSym  |           | VarientSym  |
+                             |-------------|           |-------------|
+*)
+
+PROCEDURE StartBuildVarientFieldRecord ;
+VAR
+   VarientSym,
+   FieldSym  : CARDINAL ;
+BEGIN
+   VarientSym := OperandT(1) ;
+   FieldSym := MakeFieldVarient(CheckAnonymous(NulName), VarientSym) ;
+   Annotate("%1s(%1d)||varient sym") ;
+   PushT(FieldSym) ;
+   Annotate("%1s(%1d)||varient field type") ;
+   Assert(IsFieldVarient(FieldSym)) ;
+   PutFieldVarient(FieldSym, VarientSym) ;
+   AddVarientFieldToList(FieldSym)
+END StartBuildVarientFieldRecord ;
+
+
+(*
+   EndBuildVarientFieldRecord - Removes a varient field from the stack.
+                                The Stack:
+
+
+                                Entry                     Exit
+                                =====                     ====
+
+                         Ptr ->
+                                +-------------+
+                                | VarientField|                           <- Ptr
+                                |-------------|           +-------------+
+                                | VarientSym  |           | VarientSym  |
+                                |-------------|           |-------------|
+*)
+
+PROCEDURE EndBuildVarientFieldRecord ;
+VAR
+   FieldSym: CARDINAL ;
+BEGIN
+   PopT(FieldSym) ;
+   (* GCFieldVarient(FieldSym) *)
+END EndBuildVarientFieldRecord ;
+
+
+(*
+   StartBuildVarient - Builds a varient symbol on top of a record sym.
+                       The Stack:
+
+
+                       Entry                     Exit
+                       =====                     ====
+
+                                                                 <- Ptr
+                                                 +-------------+
+                Ptr ->                           | VarientSym  |
+                       +-------------+           |-------------|
+                       | RecordSym   |           | RecordSym   |
+                       |-------------|           |-------------|
+                       | RecordName  |           | RecordName  |
+                       |-------------|           |-------------|
+*)
+
+PROCEDURE StartBuildVarient ;
+VAR
+   tokno    : CARDINAL ;
+   RecordSym,
+   Sym      : CARDINAL ;
+BEGIN
+   RecordSym := OperandT(1) ;
+   tokno := OperandTok(1) ;
+   Sym := MakeVarient(tokno, RecordSym) ;
+   PushT(Sym) ;
+   Annotate("%1s(%1d)||varient type")
+END StartBuildVarient ;
+
+
+(*
+   EndBuildVarient - Removes the varient symbol from the stack.
+                     The Stack:
+
+                     Entry                     Exit
+                     =====                     ====
+
+              Ptr ->
+                     +-------------+
+                     | VarientSym  |                           <- Ptr
+                     |-------------|           +-------------+
+                     | RecordSym   |           | RecordSym   |
+                     |-------------|           |-------------|
+                     | RecordName  |           | RecordName  |
+                     |-------------|           |-------------|
+*)
+
+PROCEDURE EndBuildVarient ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   PopT(Sym)
+END EndBuildVarient ;
+
+
+(*
+   BuildNulName - Pushes a NulName onto the top of the stack.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+                                                          <- Ptr
+                  Empty                    +------------+
+                                           | NulName   |
+                                           |------------|
+*)
+
+PROCEDURE BuildNulName ;
+BEGIN
+   PushTtok (NulName, GetTokenNo ()) ;
+   Annotate ("%1n|%3d||NulName|token no")
+END BuildNulName ;
+
+
+(*
+   BuildTypeEnd - Pops the type Type and Name.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+
+           Ptr ->
+                  +-------------+
+                  | Type | Name |          Empty
+                  |-------------|
+*)
+
+PROCEDURE BuildTypeEnd ;
+VAR
+   Type: CARDINAL ;
+   name: Name ;
+BEGIN
+   PopTF(Type, name)
+END BuildTypeEnd ;
+
+
+(*
+   StartBuildArray - Builds an array type.
+                     The Stack:
+
+                     Entry                        Exit
+                     =====                        ====
+
+                                                                <- Ptr
+                                                  +-----------+
+              Ptr ->                              | ArraySym  |
+                     +------------+               |-----------|
+                     | Name       |               | Name      |
+                     |------------|               |-----------|
+*)
+
+PROCEDURE StartBuildArray ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ArrayType: CARDINAL ;
+BEGIN
+   name := OperandT(1) ;
+   tok := OperandTok(1) ;
+   ArrayType := MakeArray (tok, name) ;
+   CheckForExportedImplementation (ArrayType) ;   (* May be an exported hidden type *)
+   PushTtok(ArrayType, tok) ;
+   Annotate("%1s(%1d)|%3d||array type|token no")
+(* ; WriteKey(Name) ; WriteString(' ARRAY made') ; WriteLn *)
+END StartBuildArray ;
+
+
+(*
+   EndBuildArray - Builds an array type.
+                   The Stack:
+
+                   Entry                        Exit
+                   =====                        ====
+
+            Ptr ->
+                   +------------+
+                   | TypeSym    |                              <- Ptr
+                   |------------|               +------------+
+                   | ArraySym   |               | ArraySym   |
+                   |------------|               |------------|
+                   | Name       |               | Name       |
+                   |------------|               |------------|
+*)
+
+PROCEDURE EndBuildArray ;
+VAR
+   TypeSym,
+   ArraySym: CARDINAL ;
+BEGIN
+   PopT(TypeSym) ;
+   PopT(ArraySym) ;
+   Assert(IsArray(ArraySym)) ;
+   PutArray(ArraySym, TypeSym) ;
+   PushT(ArraySym) ;
+   Annotate("%1s(%1d)||array type")
+END EndBuildArray ;
+
+
+(*
+   BuildFieldArray - Builds a field into an array sym.
+                     The Stack:
+
+
+                     Entry                     Exit
+                     =====                     ====
+
+              Ptr ->
+                     +-------------+
+                     | Type | Name |                           <- Ptr
+                     |-------------|           +-------------+
+                     | ArraySym    |           | ArraySym    |
+                     |-------------|           |-------------|
+                     | ArrayName   |           | ArrayName   |
+                     |-------------|           |-------------|
+*)
+
+PROCEDURE BuildFieldArray ;
+VAR
+   Subscript,
+   Type,
+   Array     : CARDINAL ;
+   name      : Name ;
+BEGIN
+   PopTF(Type, name) ;
+   PopT(Array) ;
+   Assert(IsArray(Array)) ;
+   Subscript := MakeSubscript() ;
+   (*
+      We cannot Assert(IsSubrange(Type)) as the subrange type might be
+      declared later on in the file.
+      We also note it could be an ordinal type or enumerated type.
+      Therefore we must save this information and deal with the
+      different cases in M2GCCDeclare.mod and M2GenGCC.mod.
+      However this works to our advantage as it preserves the
+      actual declaration as specified by the source file.
+   *)
+   PutSubscript(Subscript, Type) ;
+   PutArraySubscript(Array, Subscript) ;
+   PushT(Array) ;
+   Annotate("%1s(%1d)||array type")
+(* ; WriteString('Field Placed in Array') ; WriteLn *)
+END BuildFieldArray ;
+
+
+(*
+   BuildArrayComma - converts ARRAY [..], [..] OF into ARRAY [..] OF ARRAY [..]
+
+
+              Ptr ->                                           <- Ptr
+                     +-------------+           +-------------+
+                     | ArraySym1   |           | ArraySym2   |
+                     |-------------|           |-------------|
+                     | ArrayName   |           | ArrayName   |
+                     |-------------|           |-------------|
+*)
+
+PROCEDURE BuildArrayComma ;
+VAR
+   Nothing,
+   ArraySym1,
+   ArraySym2: CARDINAL ;
+BEGIN
+   PushT(NulName) ;
+   StartBuildArray ;
+   PopT(ArraySym2) ;
+   PopT(Nothing) ;
+   PushT(ArraySym2) ;
+   EndBuildArray ;
+   PopT(ArraySym1) ;
+   PushT(ArraySym2) ;
+   Annotate("%1s(%1d)||array type comma")
+END BuildArrayComma ;
+
+
+(*
+   BuildProcedureType - builds a procedure type symbol.
+                        The Stack:
+
+
+                                                               <- Ptr
+                                               +-------------+
+                 Ptr ->                        | ProcTypeSym |
+                        +-------------+        |-------------|
+                        | Name        |        | Name        |
+                        |-------------|        |-------------|
+*)
+
+PROCEDURE BuildProcedureType ;
+VAR
+   tok        : CARDINAL ;
+   name       : Name ;
+   ProcTypeSym: CARDINAL ;
+BEGIN
+   name := OperandT (1) ;
+   tok := OperandTok (1) ;
+   ProcTypeSym := MakeProcType (tok, name) ;
+   CheckForExportedImplementation (ProcTypeSym) ;   (* May be an exported hidden type *)
+   Annotate ("%1n||procedure type name") ;
+   PushTtok (ProcTypeSym, tok) ;
+   Annotate ("%1s(%1d)|%3d||proc type|token no")
+END BuildProcedureType ;
+
+
+(*
+   BuildFormalType - Builds a Formal Parameter in a procedure type.
+
+                     The Stack:
+
+                     Entry                 Exit
+
+              Ptr ->
+                     +------------+
+                     | TypeSym    |
+                     |------------|
+                     | Array/Nul  |
+                     |------------|
+                     | Var / Nul  |                         <- Ptr
+                     |------------|        +--------------+
+                     | ProcTypeSym|        | ProcTypeSym  |
+                     |------------|        |--------------|
+*)
+
+PROCEDURE BuildFormalType ;
+VAR
+   tok        : CARDINAL ;
+   Array, Var : Name ;
+   TypeSym,
+   UnboundedSym,
+   ProcTypeSym: CARDINAL ;
+BEGIN
+   PopT(TypeSym) ;
+   PopT(Array) ;
+   PopT(Var) ;
+   PopT(ProcTypeSym) ;
+   tok := GetTokenNo () ;
+
+   Assert( (Array=ArrayTok) OR (Array=NulTok) ) ;
+   Assert(IsProcType(ProcTypeSym)) ;
+   Assert( (Var=VarTok) OR (Var=NulTok) ) ;
+
+   IF Array=ArrayTok
+   THEN
+      UnboundedSym := MakeUnbounded(tok, TypeSym, 1) ;
+      TypeSym := UnboundedSym
+   END ;
+   IF Var=VarTok
+   THEN
+      (* VAR parameter *)
+      PutProcTypeVarParam(ProcTypeSym, TypeSym, IsUnbounded(TypeSym))
+   ELSE
+      (* Non VAR parameter *)
+      PutProcTypeParam(ProcTypeSym, TypeSym, IsUnbounded(TypeSym))
+   END ;
+   PushT(ProcTypeSym) ;
+   Annotate("%1s(%1d)||proc type")
+END BuildFormalType ;
+
+
+(*
+   SaveRememberedConstructor -
+*)
+
+PROCEDURE SaveRememberedConstructor ;
+BEGIN
+(*
+   IF RememberedConstant=NulSym
+   THEN
+      RememberedConstant := MakeTemporary(ImmediateValue)
+   END ;
+   PutConstructorIntoFifoQueue(RememberedConstant)
+*)
+
+END SaveRememberedConstructor ;
+
+
+(*
+   GetSeenString - returns a string corresponding to, s.
+*)
+
+PROCEDURE GetSeenString (s: constType) : String ;
+BEGIN
+   CASE s OF
+
+   unknown    : RETURN( InitString('unknown') ) |
+   set        : RETURN( InitString('SET') ) |
+   str        : RETURN( InitString('string') ) |
+   constructor: RETURN( InitString('constructor') ) |
+   array      : RETURN( InitString('ARRAY') ) |
+   cast       : RETURN( InitStringCharStar(KeyToCharStar(GetSymName(castType))) ) |
+   boolean    : RETURN( InitString('BOOLEAN') ) |
+   ztype      : RETURN( InitString('Z type') ) |
+   rtype      : RETURN( InitString('R type') ) |
+   ctype      : RETURN( InitString('C type') ) |
+   procedure  : RETURN( InitString('PROCEDURE') )
+
+   ELSE
+      InternalError ('unexpected value of type')
+   END ;
+   RETURN( NIL )
+END GetSeenString ;
+
+
+(*
+   SetTypeTo - attempts to set, type, to, s.
+*)
+
+PROCEDURE SetTypeTo (s: constType) ;
+VAR
+   s1, s2, s3: String ;
+BEGIN
+   IF type=unknown
+   THEN
+      type := s
+   ELSIF (type=constructor) AND (s#str)
+   THEN
+      type := s
+   ELSIF (s=constructor) AND ((type=array) OR (type=set))
+   THEN
+      (* leave it alone *)
+   ELSIF type#s
+   THEN
+      s1 := GetSeenString(type) ;
+      s2 := GetSeenString(s) ;
+      s3 := Sprintf2(InitString('cannot create a %s constant together with a %s constant'), s1, s2) ;
+      ErrorStringAt(s3, GetTokenNo()) ;
+      s1 := KillString(s1) ;
+      s2 := KillString(s2)
+   END
+END SetTypeTo ;
+
+
+(*
+   SeenUnknown - sets the operand type to unknown.
+*)
+
+PROCEDURE SeenUnknown ;
+BEGIN
+   type := unknown
+END SeenUnknown ;
+
+
+(*
+   SeenCast - sets the operand type to cast.
+*)
+
+PROCEDURE SeenCast (sym: CARDINAL) ;
+BEGIN
+   type := cast ;
+   castType := sym ;
+   Assert(IsAModula2Type(sym)) ;
+END SeenCast ;
+
+
+(*
+   SeenBoolean - sets the operand type to a BOOLEAN.
+*)
+
+PROCEDURE SeenBoolean ;
+BEGIN
+   type := boolean
+END SeenBoolean ;
+
+
+(*
+   SeenZType - sets the operand type to a Z type.
+*)
+
+PROCEDURE SeenZType ;
+BEGIN
+   type := ztype
+END SeenZType ;
+
+
+(*
+   SeenRType - sets the operand type to a R type.
+*)
+
+PROCEDURE SeenRType ;
+BEGIN
+   type := rtype
+END SeenRType ;
+
+
+(*
+   SeenCType - sets the operand type to a C type.
+*)
+
+PROCEDURE SeenCType ;
+BEGIN
+   type := ctype
+END SeenCType ;
+
+
+(*
+   SeenSet - sets the operand type to set.
+*)
+
+PROCEDURE SeenSet ;
+BEGIN
+   SetTypeTo(set) ;
+   SaveRememberedConstructor
+END SeenSet ;
+
+
+(*
+   SeenArray - sets the operand type to array.
+*)
+
+PROCEDURE SeenArray ;
+BEGIN
+   SetTypeTo(array)
+END SeenArray ;
+
+
+(*
+   SeenConstructor - sets the operand type to constructor.
+*)
+
+PROCEDURE SeenConstructor ;
+BEGIN
+   SetTypeTo(constructor) ;
+   SaveRememberedConstructor
+END SeenConstructor ;
+
+
+(*
+   SeenString - sets the operand type to string.
+*)
+
+PROCEDURE SeenString ;
+BEGIN
+   SetTypeTo(str)
+END SeenString ;
+
+
+(*
+   DetermineType - assigns the top of stack symbol with the type of
+                   constant expression, if known.
+*)
+
+PROCEDURE DetermineType ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   Sym := OperandT(1) ;
+   CASE type OF
+
+   set        :  PutConstSet(Sym) |
+   str        :  PutConstString(GetTokenNo(), Sym, MakeKey('')) |
+   array,
+   constructor:  PutConstructor(Sym) |
+   cast       :  PutConst(Sym, castType) |
+   unknown    :
+
+   ELSE
+   END
+END DetermineType ;
+
+
+(*
+   PushType -
+*)
+
+PROCEDURE PushType ;
+BEGIN
+   PushWord(TypeStack, type)
+END PushType ;
+
+
+(*
+   PopType -
+*)
+
+PROCEDURE PopType ;
+BEGIN
+   type := PopWord(TypeStack)
+END PopType ;
+
+
+(*
+   PushRememberConstant -
+*)
+
+PROCEDURE PushRememberConstant ;
+BEGIN
+   PushWord(RememberStack, RememberedConstant) ;
+   RememberConstant(NulSym)
+END PushRememberConstant ;
+
+
+(*
+   PopRememberConstant -
+*)
+
+PROCEDURE PopRememberConstant ;
+BEGIN
+   RememberedConstant := PopWord(RememberStack)
+END PopRememberConstant ;
+
+
+(*
+   RememberConstant -
+*)
+
+PROCEDURE RememberConstant (sym: CARDINAL) ;
+BEGIN
+   RememberedConstant := sym
+END RememberConstant ;
+
+
+BEGIN
+   alignTypeNo := 0 ;
+   TypeStack := InitStackWord () ;
+   RememberStack := InitStackWord () ;
+   BlockStack := InitStackWord () ;
+   castType := NulSym
+END P2SymBuild.
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
new file mode 100644
index 00000000000..8ccc4d604a3
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -0,0 +1,1676 @@
+--
+-- m2-3.bnf grammar and associated actions for pass 3.
+--
+-- Copyright (C) 2001-2022 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/>.
+% module P3Build begin
+(* output from m2-3.bnf, automatically generated do not edit if these
+   are the top two lines in the file.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE P3Build ;
+
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
+                     InsertTokenAndRewind, GetTokenNo, PrintTokenNo, MakeVirtualTok,
+                     UnknownTokenNo ;
+
+FROM M2Error IMPORT ErrorStringAt, WriteFormat1, WriteFormat2 ;
+FROM NameKey IMPORT NulName, Name, makekey ;
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
+FROM M2Printf IMPORT printf0, printf1 ;
+FROM M2Debug IMPORT Assert ;
+FROM P2SymBuild IMPORT BuildString, BuildNumber ;
+FROM M2MetaError IMPORT MetaErrorT0 ;
+
+FROM M2Reserved IMPORT tokToTok, toktype,
+                       NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
+                       EqualTok, HashTok, LessGreaterTok, LessTok, LessEqualTok,
+                       GreaterTok, GreaterEqualTok, InTok, PlusTok, MinusTok,
+                       OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok,
+                       AndTok, AmbersandTok, PeriodPeriodTok, ByTok ;
+
+FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
+                    PushTtok, PushTFtok, PopTtok, PopTFtok, OperandTok,
+                    BuildModuleStart,
+                    StartBuildDefFile, StartBuildModFile,
+                    EndBuildFile,
+                    StartBuildInit,
+                    EndBuildInit,
+                    StartBuildFinally,
+                    EndBuildFinally,
+                    BuildExceptInitial,
+                    BuildExceptFinally,
+                    BuildExceptProcedure,
+                    BuildReThrow,
+                    BuildProcedureStart,
+                    BuildProcedureBegin,
+                    BuildProcedureEnd,
+                    BuildScaffold,
+      	       	    BuildStmtNote,
+                    BuildFunctionCall, BuildConstFunctionCall,
+                    BuildBinaryOp, BuildUnaryOp, BuildRelOp, BuildNot,
+      	       	    BuildEmptySet, BuildInclRange, BuildInclBit,
+                    BuildSetStart, BuildSetEnd,
+                    PushLineNo, BuildSizeCheckStart,
+                    BuildBuiltinConst, BuildBuiltinTypeInfo,
+                    BuildAssignment, BuildAssignConstant,
+                    BuildAlignment,
+                    BuildRepeat, BuildUntil,
+                    BuildWhile, BuildDoWhile, BuildEndWhile,
+                    BuildLoop, BuildExit, BuildEndLoop,
+                    BuildThenIf, BuildElse, BuildEndIf,
+                    BuildForToByDo, BuildPseudoBy, BuildEndFor,
+                    BuildElsif1, BuildElsif2,
+                    BuildProcedureCall, BuildReturn, BuildNulExpression,
+                    CheckBuildFunction,
+                    StartBuildWith, EndBuildWith,
+                    BuildInline,
+                    BuildCaseStart,
+                    BuildCaseOr,
+                    BuildCaseElse,
+                    BuildCaseEnd,
+                    BuildCaseCheck,
+                    BuildCaseStartStatementSequence,
+                    BuildCaseEndStatementSequence,
+                    BuildCaseList,
+                    BuildCaseRange, BuildCaseEquality,
+                    BuildConstructorStart,
+                    BuildConstructorEnd,
+                    SilentBuildConstructorStart,
+                    NextConstructorField, BuildTypeForConstructor,
+                    BuildComponentValue,
+                    BeginVarient, EndVarient, ElseVarient,
+                    BeginVarientList, EndVarientList,
+                    RecordOp,
+                    BuildNulParam,
+                    BuildDesignatorRecord,
+                    BuildDesignatorArray,
+                    BuildDesignatorPointer,
+                    BuildBooleanVariable,
+                    CheckWithReference,
+                    BuildModulePriority,
+                    BuildRetry,
+                    DisplayStack,
+                    AddVarientRange, AddVarientEquality,
+                    BeginVarient, EndVarient, BeginVarientList, EndVarientList,
+                    PushInConstExpression, PopInConstExpression, IsInConstExpression,
+                    BuildDefaultFieldAlignment, BuildPragmaField,
+                    IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto ;
+
+FROM P3SymBuild IMPORT P3StartBuildProgModule,
+                       P3EndBuildProgModule,
+
+                       P3StartBuildDefModule,
+                       P3EndBuildDefModule,
+
+                       P3StartBuildImpModule,
+                       P3EndBuildImpModule,
+
+                       StartBuildInnerModule,
+                       EndBuildInnerModule,
+
+                       CheckImportListOuterModule,
+                       CheckCanBeImported,
+                       StartBuildProcedure,
+                       BuildProcedureHeading,
+                       EndBuildProcedure,
+                       BuildVarAtAddress,
+                       BuildConst,
+                       BuildSubrange,
+                       BuildNulName,
+                       BuildOptArgInitializer ;
+
+FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
+                        PutGnuAsmOutput, PutGnuAsmTrash,
+                        PutGnuAsmVolatile, PutGnuAsmSimple,
+                        MakeRegInterface,
+                        PutRegInterface,
+                        IsRegInterface, IsGnuAsmVolatile, IsGnuAsm,
+                        GetCurrentModule,
+                        GetSymName, GetType, SkipType,
+                        NulSym,
+                        StartScope, EndScope,
+                        PutIncluded,
+                        IsVarParam, IsProcedure, IsDefImp, IsModule, IsProcType,
+                        IsRecord,
+                        RequestSym, IsExported,
+                        GetSym, GetLocalSym ;
+
+FROM M2Batch IMPORT IsModuleKnown ;
+
+FROM M2CaseList IMPORT BeginCaseList, EndCaseList ;
+
+IMPORT M2Error ;
+
+CONST
+   Debugging = FALSE ;
+   Pass1     = FALSE ;          (* permanently disabled for the time being *)
+   Pass2     = FALSE ;
+   Pass3     =  TRUE ;          (* permanently disabled for the time being *)
+   DebugAsm  = FALSE ;
+
+VAR
+   WasNoError: BOOLEAN ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   ErrorStringAt(s, GetTokenNo ()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString(InitString(a))
+END ErrorArray ;
+
+
+% declaration P3Build begin
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   WHILE NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      GetToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError(stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop(s0, s1, s2) ;
+
+   str := ConCat(InitString('syntax error,'), Mark(str)) ;
+   ErrorStringAt (str, GetTokenNo ())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken(t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0('inserting token\n')
+      END ;
+      InsertToken(t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken(t) ;
+      InsertTokenAndRewind(t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      GetToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   RETURN( WasNoError )
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey (currentstring), identtok, GetTokenNo ())
+      (*  ; MetaErrorT0 (GetTokenNo(), "{%W}an ident")  *)
+   END ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok(makekey(currentstring), stringtok, GetTokenNo ()) ;
+      BuildString
+   END ;
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), integertok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), realtok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module P3Build end
+END P3Build.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuild procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit :=                                                                % PushAutoOff %
+            ( DefinitionModule |
+              ImplementationOrProgramModule )                              % PopAuto %
+         =:
+
+ProgramModule :=                                                           % VAR modulet, endt: CARDINAL ; %
+                                                                           % modulet := GetTokenNo () %
+                 "MODULE"                                                  % M2Error.DefaultProgramModule %
+                                                                           % PushAutoOn %
+                  Ident                                                    % P3StartBuildProgModule %
+                                                                           % StartBuildModFile (modulet) %
+                                                                           % BuildModuleStart (modulet) %
+                                                                           % PushAutoOff %
+                  [ Priority
+                  ]
+                  ";"                                                      % BuildScaffold (modulet,
+                                                                                            GetCurrentModule ()) %
+                  { Import }
+                  Block                                                    % PushAutoOn %
+                                                                           % endt := GetTokenNo () -1 %
+                  Ident                                                    % EndBuildFile (endt) %
+                                                                           % P3EndBuildProgModule %
+                  "."                                                      % PopAuto ; PopAuto %
+                  =:
+
+ImplementationModule :=                                                    % VAR modulet, endt: CARDINAL ; %
+                                                                           % modulet := GetTokenNo () %
+                        "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
+                                         "MODULE"                          % PushAutoOn %
+                         Ident                                             % StartBuildModFile (modulet) %
+                                                                           % P3StartBuildImpModule %
+                                                                           % BuildModuleStart (modulet) %
+                                                                           % PushAutoOff %
+                         [ Priority
+                         ] ";"                                             % BuildScaffold (modulet,
+                                                                                            GetCurrentModule ()) %
+                         { Import }
+                         Block                                             % PushAutoOn %
+                                                                           % endt := GetTokenNo () -1 %
+                         Ident                                             % EndBuildFile (endt) %
+                                                                           % P3EndBuildImpModule %
+                         "."                                               % PopAuto ; PopAuto ; PopAuto %
+                      =:
+
+ImplementationOrProgramModule :=                                           % PushAutoOff %
+                                 ( ImplementationModule | ProgramModule )  % PopAuto %
+                              =:
+
+Number := Integer | Real =:
+
+--
+--  In pass 3 Qualident needs some care as we must only parse module.module.ident
+--  and not ident.recordfield.  We leave the ident.recordfield to be parsed by
+--  SubDesignator.  Note that Qualident is called by SubDesignator so if
+--  IsAutoPushOff then we just consume tokens.
+--
+
+Qualident :=                                                               % VAR name          : Name ;
+                                                                                 init, ip1,
+                                                                                 tokstart, tok : CARDINAL ; %
+             Ident
+                                                                           % IF IsAutoPushOn()
+                                                                             THEN
+                                                                                PopTtok(name, tokstart) ;
+										tok := tokstart ;
+                                                                                init := RequestSym (tok, name) ;
+                                                                                WHILE IsDefImp (init) OR IsModule (init) DO
+                                                                                   Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+                                                                                   StartScope (init) ;
+                                                                                   Ident (stopset0, stopset1, stopset2) ;
+                                                                                   PopTtok (name, tok) ;
+                                                                                   ip1 := RequestSym (tok, name) ;
+                                                                                   PutIncluded(ip1) ;
+                                                                                   EndScope ;
+                                                                                   CheckCanBeImported(init, ip1) ;
+                                                                                   init := ip1
+                                                                                END ;
+										IF tok#tokstart
+										THEN
+										   tok := MakeVirtualTok (tokstart, tokstart, tok)
+										END ;
+                                                                                IF IsProcedure(init) OR IsProcType(init)
+                                                                                THEN
+                                                                                   PushTtok(init, tok)
+                                                                                ELSE
+                                                                                   PushTFtok(init, GetType(init), tok) ;
+                                                                                END
+                                                                             ELSE %
+             { "." Ident }                                                 % END %
+           =:
+
+ConstantDeclaration :=                                                     % VAR tokno: CARDINAL ; %
+                                                                           % PushAutoOn %
+                       ( Ident "="                                         % tokno := GetTokenNo () -1 %
+                                                                           % BuildConst %
+                         ConstExpression )                                 % BuildAssignConstant (tokno) %
+                                                                           % PopAuto %
+                     =:
+
+ConstExpression :=                                                         % VAR tokpos: CARDINAL ; %
+                                                                           % PushAutoOn %
+                   SimpleConstExpr [ Relation                              % tokpos := GetTokenNo ()-1 %
+                                              SimpleConstExpr              % BuildRelOp (tokpos) %
+                                   ]                                       % PopAuto %
+                =:
+
+Relation := "="                                                            % PushTtok(EqualTok, GetTokenNo() -1) %
+            | "#"                                                          % PushTtok(HashTok, GetTokenNo() -1) %
+            | "<>"                                                         % PushTtok(LessGreaterTok, GetTokenNo() -1) %
+            | "<"                                                          % PushTtok(LessTok, GetTokenNo() -1) %
+            | "<="                                                         % PushTtok(LessEqualTok, GetTokenNo() -1) %
+            | ">"                                                          % PushTtok(GreaterTok, GetTokenNo() -1) %
+            | ">="                                                         % PushTtok(GreaterEqualTok, GetTokenNo() -1) %
+            | "IN"                                                         % PushTtok(InTok, GetTokenNo() -1) %
+         =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm                % BuildBinaryOp %
+                                    } =:
+
+UnaryOrConstTerm := "+"                                                    % PushTtok(PlusTok, GetTokenNo() -1) %
+                    ConstTerm                                              % BuildUnaryOp %
+                    |
+                    "-"                                                    % PushTtok(MinusTok, GetTokenNo() -1) %
+                    ConstTerm                                              % BuildUnaryOp %
+                    |
+                    ConstTerm =:
+
+AddOperator :=   "+"                                                       % PushTtok(PlusTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+               | "-"                                                       % PushTtok(MinusTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+               | "OR"                                                      % PushTtok(OrTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+            =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor                         % BuildBinaryOp %
+                         } =:
+
+MulOperator := "*"                                                         % PushTtok(TimesTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+               | "/"                                                       % PushTtok(DivideTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+               | "DIV"                                                     % PushTtok(DivTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+               | "MOD"                                                     % PushTtok(ModTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+               | "REM"                                                     % PushTtok(RemTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+               | "AND"                                                     % PushTtok(AndTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+               | "&"                                                       % PushTtok(AmbersandTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+            =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" | "NOT" ConstFactor                 % BuildNot %
+               | ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string =:
+
+ComponentElement := ConstExpression ( ".." ConstExpression                 % PushTtok(PeriodPeriodTok, GetTokenNo() -1) %
+                                      |                                    % PushT(NulTok) %
+                                    )
+                  =:
+
+ComponentValue := ComponentElement ( 'BY' ConstExpression                  % PushTtok(ByTok, GetTokenNo() -1) %
+
+                                     |                                     % PushT(NulTok) %
+                                   )
+                =:
+
+ArraySetRecordValue := ComponentValue                                      % BuildComponentValue %
+                                      { ','                                % NextConstructorField %
+                                            ComponentValue                 % BuildComponentValue %
+                                                           }
+                     =:
+
+Constructor :=                                                             % DisplayStack %
+               '{'                                                         % BuildConstructorStart (GetTokenNo() -1) %
+                  [ ArraySetRecordValue ]                                  % BuildConstructorEnd (GetTokenNo())  %
+               '}' =:
+
+ConstSetOrQualidentOrFunction := Qualident
+                                 [ Constructor | ConstActualParameters     % BuildConstFunctionCall %
+                                                                       ]
+                                   |                                       % BuildTypeForConstructor %
+                                     Constructor =:
+
+ConstActualParameters :=                                                   % PushInConstExpression %
+                         ActualParameters                                  % PopInConstExpression %
+                       =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("                    % PushAutoOn %
+                  ConstAttributeExpression                                 % PopAuto %
+                  ")" ")" =:
+
+ConstAttributeExpression :=
+                            Ident                                          % BuildBuiltinConst %
+                                  | "<" Qualident ',' Ident                % BuildBuiltinTypeInfo %
+                                                              ">"
+                          =:
+
+ByteAlignment := '<*'                                                      % PushAutoOn %
+                      AttributeExpression                                  % BuildAlignment %
+                                          '*>'                             % PopAuto %
+               =:
+
+Alignment := [ ByteAlignment ] =:
+
+TypeDeclaration := Ident "=" Type Alignment
+                =:
+
+Type :=
+                                                                           % PushAutoOff %
+        ( SimpleType | ArrayType
+          | RecordType
+          | SetType
+          | PointerType
+          | ProcedureType )                                                % PopAuto %
+      =:
+
+SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+
+Enumeration := "("
+                   ( IdentList
+                               )
+               ")"
+            =:
+
+IdentList := Ident                                                         % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," Ident                                                   % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+SubrangeType := "[" ConstExpression  ".." ConstExpression "]"              % BuildSubrange ; %
+              =:
+
+ArrayType := "ARRAY"
+
+              SimpleType
+              { ","
+                SimpleType
+              } "OF"
+             Type
+           =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
+
+DefaultRecordAttributes := '<*'                                           % PushAutoOn %
+                                AttributeExpression                       % BuildDefaultFieldAlignment %
+                                                                          % PopAuto %
+                                                    '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                            { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression :=                                                   % PushAutoOn %
+                         Ident PragmaConstExpression                       % BuildPragmaField %
+                                                                           % PopAuto %
+                                                           =:
+
+PragmaConstExpression := ( '(' ConstExpression ')' |                       % PushT(NulSym) %
+                                                                           % Annotate('NulSym||no pragma const') %
+                                                     )     =:
+
+AttributeExpression := Ident '(' ConstExpression ')' =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+-- at present FieldListStatement is as follows:
+FieldListStatement := [ FieldList ] =:
+-- later replace it with FieldList to comply with PIM2
+
+-- sadly the PIM rules are not LL1 as Ident and Qualident have the same first
+-- symbols. We rewrite FieldList to inline qualident
+-- was
+-- FieldList := IdentList ":"                                              % BuildNulName %
+--                           Type |
+--             "CASE" [ Ident ":" ] Qualident "OF" Varient { "|" Varient }
+--                    [ "ELSE" FieldListSequence ] "END" =:
+
+FieldList := IdentList ":"
+                           Type RecordFieldPragma
+             |
+             "CASE"                                                        % BeginVarient %
+                    CaseTag "OF"
+                                 Varient { "|" Varient }
+              [ "ELSE"                                                     % ElseVarient %
+                FieldListSequence
+              ] "END"                                                      % EndVarient %
+           =:
+
+TagIdent := [ Ident ] =:
+
+CaseTag :=  TagIdent [":" Qualident ] =:
+
+Varient := [                                                               % BeginVarientList %
+             VarientCaseLabelList ":" FieldListSequence                    % EndVarientList %
+                                                        ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression ( ".." ConstExpression                % AddVarientRange %
+                                       |                                   % AddVarientEquality ; (* epsilon *) %
+                                     )
+                   =:
+
+--
+--  the following rules are a copy of the ConstExpression ebnf rules but without
+--  any actions all prefixed with Silent.
+--  At present they are only used by CaseLabels, if this continues to be true we
+--  might consider restricting the SilentConstExpression. Eg it makes no sence to allow
+--  String in these circumstances!
+--
+
+SilentConstExpression :=                                                   % PushAutoOff %
+                         SilentSimpleConstExpr
+                         [ SilentRelation SilentSimpleConstExpr ]          % PopAuto %
+                      =:
+
+SilentRelation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
+
+SilentSimpleConstExpr := SilentUnaryOrConstTerm { SilentAddOperator SilentConstTerm } =:
+
+SilentUnaryOrConstTerm := "+" SilentConstTerm | "-" SilentConstTerm | SilentConstTerm =:
+
+SilentAddOperator := "+" | "-" | "OR" =:
+
+SilentConstTerm := SilentConstFactor { SilentMulOperator SilentConstFactor } =:
+
+SilentMulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
+
+SilentConstFactor := Number | SilentConstString | SilentConstSetOrQualidentOrFunction |
+                     "(" SilentConstExpression ")" | "NOT" SilentConstFactor
+                     | SilentConstAttribute =:
+
+SilentConstString := string =:
+
+SilentConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" SilentConstAttributeExpression ")" ")" =:
+
+SilentConstAttributeExpression := Ident | "<" Ident ',' SilentConstString ">" =:
+
+SilentComponentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
+
+SilentComponentValue := SilentComponentElement [ 'BY' SilentConstExpression ] =:
+
+SilentArraySetRecordValue := SilentComponentValue { ',' SilentComponentValue } =:
+
+SilentConstructor := '{'                                                   % SilentBuildConstructorStart %
+                         [ SilentArraySetRecordValue ] '}' =:
+
+SilentConstSetOrQualidentOrFunction := SilentConstructor | Qualident
+                                       [ SilentConstructor | SilentActualParameters ] =:
+
+SilentActualParameters := "(" [ SilentExpList ] ")" =:
+
+SilentExpList := SilentConstExpression { "," SilentConstExpression } =:
+
+-- end of the Silent constant rules
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+
+PointerType := "POINTER" "TO"
+                              Type
+             =:
+
+ProcedureType := "PROCEDURE"
+                 [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+
+VarIdent :=                                                                % VAR
+                                                                                Sym, Type: CARDINAL ;
+                                                                                on: BOOLEAN ; %
+                                                                           % on := IsAutoPushOn() %
+                                                                           % IF NOT on
+                                                                             THEN
+                                                                                PushAutoOn
+                                                                             END %
+            Ident                                                          % IF on
+                                                                             THEN
+                                                                                PopTF(Sym, Type) ;
+                                                                                PushTF(Sym, Type) ;
+                                                                                PushTF(Sym, Type)
+                                                                             END %
+                  [ "[" ConstExpression                                    % BuildVarAtAddress %
+                                        "]" ]
+                                                                           % PopNothing ;
+                                                                             PopAuto %
+         =:
+
+VarIdentList := VarIdent                                                   % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," VarIdent                                                % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+VariableDeclaration := VarIdentList ":"
+                       Type Alignment
+                    =:
+
+Designator := Qualident                                                    % CheckWithReference %
+              { SubDesignator } =:
+
+SubDesignator := "."                                                       % VAR Sym, Type, tok,
+                                                                                 dotpostok     : CARDINAL ;
+                                                                                 name, n1      : Name ; %
+                                                                           % dotpostok := GetTokenNo () -1 ;
+                                                                             PopTFtok (Sym, Type, tok) ;
+                                                                             Type := SkipType(Type) ;
+                                                                             PushTFtok(Sym, Type, tok) ;
+                                                                             IF Type=NulSym
+                                                                             THEN
+                                                                                n1 := GetSymName(Sym) ;
+                                                                                IF IsModuleKnown(GetSymName(Sym))
+                                                                                THEN
+                                                                                   WriteFormat2('%a looks like a module which has not been globally imported (eg. suggest that you IMPORT %a ;)',
+                                                                                   n1, n1)
+                                                                                ELSE
+                                                                                   WriteFormat1('%a is not a record variable', n1)
+                                                                                END
+                                                                             ELSIF NOT IsRecord(Type)
+                                                                             THEN
+                                                                                n1 := GetSymName(Type) ;
+                                                                                WriteFormat1('%a is not a record type', n1)
+                                                                             END ;
+                                                                             StartScope(Type) %
+                 Ident
+                                                                           % PopTtok (name, tok) ;
+                                                                             Sym := GetLocalSym(Type, name) ;
+                                                                             IF Sym=NulSym
+                                                                             THEN
+                                                                                n1 := GetSymName(Type) ;
+                                                                                WriteFormat2('field %a does not exist within record %a', name, n1)
+                                                                             END ;
+                                                                             Type := GetType(Sym) ;
+                                                                             PushTFtok (Sym, Type, tok) ;
+                                                                             EndScope ;
+                                                                             PushT(1) ;
+                                                                             BuildDesignatorRecord (dotpostok) %
+                 | "[" ArrayExpList
+                   "]"
+                 | "^"                                                     % BuildDesignatorPointer (GetTokenNo () -1) %
+            =:
+
+ArrayExpList :=
+           Expression                                                      % BuildBooleanVariable %
+                                                                           % BuildDesignatorArray %
+             { ","
+               Expression                                                  % BuildBooleanVariable %
+                                                                           % BuildDesignatorArray %
+             }
+        =:
+
+ExpList :=                                                                 % VAR n: CARDINAL ; %
+           Expression                                                      % BuildBooleanVariable %
+                                                                           % n := 1 %
+             { ","
+               Expression                                                  % BuildBooleanVariable %
+                                                                           % INC(n) %
+             }
+                                                                           % PushT(n) %
+        =:
+
+Expression :=                                                              % VAR tokpos: CARDINAL ; %
+                                                                           % PushAutoOn %
+              SimpleExpression [ Relation                                  % tokpos := GetTokenNo ()-1 %
+                                          SimpleExpression                 % BuildRelOp (tokpos) %
+                               ]                                           % PopAuto %
+           =:
+
+SimpleExpression := UnaryOrTerm { AddOperator Term                         % BuildBinaryOp %
+                                } =:
+
+UnaryOrTerm := "+"                                                         % PushTtok(PlusTok, GetTokenNo() -1) %
+                 Term                                                      % BuildUnaryOp %
+               | "-"                                                       % PushTtok(MinusTok, GetTokenNo() -1) %
+                 Term                                                      % BuildUnaryOp %
+               | Term =:
+
+Term := Factor { MulOperator Factor                                        % BuildBinaryOp %
+               } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" ( Factor                              % BuildNot %
+          | ConstAttribute
+                                ) =:
+
+SetOrDesignatorOrFunction := Qualident
+                                                                           % Assert (OperandTok(1) # UnknownTokenNo) %
+                                                                           % CheckWithReference %
+                                                                           % Assert (OperandTok(1) # UnknownTokenNo) %
+                              [ Constructor |
+                                SimpleDes                                  % (* Assert (OperandTok(1) # UnknownTokenNo) *) %
+                                          [ ActualParameters               % IF IsInConstExpression()
+                                                                             THEN
+                                                                                BuildConstFunctionCall
+                                                                             ELSE
+                                                                                BuildFunctionCall
+                                                                             END %
+                                                             ]
+                              ]                                |
+                                                                           % BuildTypeForConstructor %
+                              Constructor =:
+
+-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+SimpleDes := { SubDesignator } =:
+
+ActualParameters := "("                                                    % BuildSizeCheckStart %
+                        ( ExpList |                                        % BuildNulParam %
+                        ) ")" =:
+
+ExitStatement := "EXIT"                                                    % BuildExit %
+              =:
+
+ReturnStatement := "RETURN"                                                % VAR tokno: CARDINAL ; %
+                                                                           % tokno := GetTokenNo () -1 %
+                            ( Expression |                                 % BuildNulExpression (* in epsilon *) %
+                                           )                               % BuildReturn (tokno) %
+                =:
+
+Statement :=		                                                   % BuildStmtNote (0) %
+                                                                           % PushAutoOn ; DisplayStack %
+             [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               ExitStatement | ReturnStatement | RetryStatement
+             ]                                                             % PopAuto ; %
+          =:
+
+RetryStatement := "RETRY"                                                  % BuildRetry (GetTokenNo () -1) %
+                =:
+
+AssignmentOrProcedureCall :=                                               % VAR isFunc: BOOLEAN ;
+                                                                                 tokno : CARDINAL ; %
+                                                                           % DisplayStack %
+                             Designator
+                                                                           % tokno := GetTokenNo () %
+                             ( ":="
+                                                                           % (* PrintTokenNo (tokno) *) %
+                                    Expression                             % BuildAssignment (tokno) %
+                                |                                          % isFunc := CheckBuildFunction() %
+                                  ( ActualParameters |                     % BuildNulParam (* in epsilon *) %
+                                  )                                        % IF isFunc
+                                                                             THEN
+                                                                                BuildFunctionCall ;
+                                                                                BuildAssignment (tokno)
+                                                                             ELSE
+                                                                                BuildProcedureCall (tokno - 1)
+                                                                             END %
+                             )                                             % DisplayStack %
+                           =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence :=
+                     Statement
+                               { ";"
+                                     Statement }
+                  =:
+
+IfStatement := "IF"
+                    Expression
+		               "THEN"                                      % BuildThenIf %
+			       		                                   % BuildStmtNote (-1) %
+                                      StatementSequence
+              { "ELSIF"
+                                                                           % BuildElsif1 %
+                                                                           % BuildStmtNote (-1) %
+                        Expression
+			           "THEN"                                  % BuildThenIf %
+                                                                           % BuildStmtNote (-1) %
+                                          StatementSequence                % BuildElsif2 %
+              }
+              [
+	        "ELSE"                                                     % BuildElse %
+                                                                           % BuildStmtNote (-1) %
+                      StatementSequence ] "END"                            % BuildEndIf %
+                                                                           % BuildStmtNote (-1) %
+            =:
+
+CaseStatement := "CASE"
+                        Expression                                         % BuildCaseStart %
+                                   "OF" Case { "|" Case }
+                 CaseEndStatement
+               =:
+
+CaseEndStatement := "END"                                                  % BuildStmtNote (-1) %
+                                                                           % BuildCaseElse %
+                                                                           % BuildCaseCheck %
+                                                                           % BuildCaseEnd %
+                    | "ELSE"                                               % BuildStmtNote (-1) %
+                                                                           % BuildCaseElse %
+                           StatementSequence                               % BuildStmtNote (0) %
+			                     "END"
+                                                                           % BuildCaseEnd %
+                 =:
+
+Case := [                                                                  % BuildStmtNote (-1) %
+          CaseLabelList                                                    % BuildCaseStartStatementSequence %
+                        ":"
+                          StatementSequence                                % BuildCaseEndStatementSequence %
+                                                                           % EndCaseList %
+        ]
+      =:
+
+CaseLabelList :=                                                           % BeginCaseList(NulSym) %
+                 CaseLabels { ","                                          % BuildCaseOr %
+                                  CaseLabels } =:
+
+CaseLabels := ConstExpression ( ".." ConstExpression                       % BuildCaseRange ;
+                                                                             BuildCaseList %
+                                |                                          % BuildCaseEquality ;  (* epsilon *)
+                                                                             BuildCaseList %
+                              ) =:
+
+WhileStatement := "WHILE"                                                  % BuildWhile %
+                                                                           % BuildStmtNote (0) %
+                  Expression
+		                                                           % BuildStmtNote (0) %
+                             "DO"                                          % BuildDoWhile %
+                                  StatementSequence                        % BuildStmtNote (0) %
+				                    "END"                  % DisplayStack ; BuildEndWhile %
+                =:
+
+RepeatStatement := "REPEAT"
+                                                                           % BuildRepeat %
+                            StatementSequence                              % BuildStmtNote (0) %
+                                              "UNTIL"
+                    Expression                                             % BuildUntil %
+                 =:
+
+ForStatement :=                                                            % VAR endpostok: CARDINAL ; %
+                                                                           % PushLineNo %
+                "FOR" Ident ":=" Expression "TO" Expression
+                ( "BY" ConstExpression |                                   % BuildPseudoBy (* epsilon *) %
+                )                                                          % PushLineNo %
+                                                                           % BuildStmtNote (0) %
+                  "DO"                                                     % BuildForToByDo %
+                StatementSequence                                          % BuildStmtNote (0) %
+                                                                           % endpostok := GetTokenNo () %
+                                  "END"                                    % BuildEndFor (endpostok) %
+              =:
+
+LoopStatement := "LOOP"
+                                                                           % BuildLoop %
+                        StatementSequence                                  % BuildStmtNote (0) %
+                                          "END"                            % BuildEndLoop %
+               =:
+
+WithStatement :=                                                           % VAR
+                                                                                tok: CARDINAL ; %
+                 "WITH"                                                    % tok := GetTokenNo () -1 %
+                        Designator                                         % StartBuildWith (tok) %
+                                                                           % BuildStmtNote (0) %
+                                   "DO"
+                        StatementSequence
+                                                                           % BuildStmtNote (0) %
+                 "END"                                                     % EndBuildWith %
+               =:
+
+ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock                % BuildProcedureEnd ;
+                                                                             PushAutoOn %
+
+                        Ident                                              % EndBuildProcedure ;
+                                                                             PopAuto %
+                      =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
+                            "(" "("                                        % PushAutoOff %
+                                    Ident                                  % PopAuto %
+                                          ")" ")" | "__INLINE__" ]
+                      =:
+
+ProcedureHeading := "PROCEDURE"                                            % M2Error.DefaultProcedure %
+                                                                           % PushAutoOn %
+                     DefineBuiltinProcedure
+                     ( Ident
+                                                                           % StartBuildProcedure ;
+                                                                             PushAutoOff %
+                       [ FormalParameters ] AttributeNoReturn
+                                                                           % BuildProcedureHeading ;
+                                                                             PopAuto %
+                     )                                                     % PopAuto %
+                     =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE"                                         % M2Error.DefaultProcedure %
+                                                                           % PushAutoOn %
+                        Builtin
+                        ( Ident
+                                                                           % StartBuildProcedure ;
+                                                                             PushAutoOff %
+                          [ DefFormalParameters ] AttributeNoReturn
+                                                                           % BuildProcedureHeading ;
+                                                                             PopAuto %
+                        )                                                  % PopAuto %
+                                                                           % M2Error.LeaveErrorScope %
+                     =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+AttributeUnused := [ "<*" Ident "*>" ] =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock :=                                                          % BuildProcedureStart %
+                  { Declaration }                                          % BuildProcedureBegin %
+                                  [ "BEGIN"                                % BuildStmtNote (-1) %
+                                            ProcedureBlockBody ]           % BuildStmtNote (0) %
+                                                                 "END"
+                =:
+
+Block := { Declaration }
+                                                                           % StartBuildInit (GetTokenNo ()) %
+                         InitialBlock                                      % EndBuildInit (GetTokenNo ()) ;
+                                                                             StartBuildFinally (GetTokenNo ()) %
+                                      FinalBlock                           % EndBuildFinally (GetTokenNo ()) %
+                                                 "END"
+       =:
+
+InitialBlock := [ "BEGIN"                                                  % BuildStmtNote (-1) %
+                          InitialBlockBody ] =:
+
+FinalBlock := [ "FINALLY"                                                  % BuildStmtNote (-1) %
+                          FinalBlockBody ] =:
+
+InitialBlockBody := NormalPart [
+                                 "EXCEPT"                                  % BuildStmtNote (-1) %
+                                                                           % BuildExceptInitial (GetTokenNo() -1) %
+                                          ExceptionalPart ] =:
+
+FinalBlockBody := NormalPart [
+                               "EXCEPT"                                    % BuildStmtNote (-1) %
+			                                                   % BuildExceptFinally (GetTokenNo() -1) %
+                                        ExceptionalPart ] =:
+
+ProcedureBlockBody := NormalPart [
+                                   "EXCEPT"                                % BuildStmtNote (-1) %
+				                                           % BuildExceptProcedure (GetTokenNo() -1) %
+                                            ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence                                       % BuildReThrow (GetTokenNo()) %
+                 =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration ";" } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP |
+                     FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
+
+MultiFPSection := ExtendedFP |
+                  FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
+
+NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
+
+OptArg := "[" Ident ":" FormalType [ "=" ConstExpression                   % BuildOptArgInitializer %
+                                                         ] "]" =:
+
+DefOptArg := "[" Ident ":" FormalType "=" ConstExpression                  % BuildOptArgInitializer %
+                                                          "]" =:
+
+FormalType := { "ARRAY" "OF" } Qualident =:
+
+ModuleDeclaration :=                                                       % VAR modulet: CARDINAL ; %
+                                                                           % modulet := GetTokenNo () %
+                     "MODULE"                                              % M2Error.DefaultInnerModule %
+                                                                           % PushAutoOn %
+                     Ident                                                 % StartBuildInnerModule %
+                                                                           % BuildModuleStart (modulet) ;
+                                                                             PushAutoOff %
+                     [ Priority ] ";"
+                     { Import } [ Export ]
+                       Block                                               % PushAutoOn %
+                       Ident                                               % EndBuildInnerModule %
+                                                                           % PopAuto ; PopAuto ; PopAuto %
+                     =:
+
+Priority := "["                                                            % PushAutoOn %
+                ConstExpression                                            % BuildModulePriority ;
+                                                                             PopAuto %
+                                "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"
+                                 IdentList |
+                     "UNQUALIFIED"
+                                 IdentList |
+                     IdentList ) ";" =:
+
+FromImport :=                                                              % PushAutoOn %
+               "FROM" Ident "IMPORT" IdentList ";"                         % CheckImportListOuterModule %
+                                                                           % PopAuto %
+            =:
+
+WithoutFromImport :=                                                       % PushAutoOff %
+                      "IMPORT" IdentList ";"
+                                                                           % PopAuto %
+                   =:
+
+Import :=  FromImport | WithoutFromImport =:
+
+DefinitionModule :=                                                        % VAR deft, endt: CARDINAL ; %
+                                                                           % deft := GetTokenNo () %
+                    "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
+                                 "MODULE"                                  % PushAutoOn %
+                    [ "FOR" string ]
+                    Ident                                                  % StartBuildDefFile (deft) ;
+                                                                             P3StartBuildDefModule ;
+                                                                             PushAutoOff %
+                    ";"
+                    { Import } [ Export
+                                        ]
+                    { Definition }                                         % endt := GetTokenNo () %
+                                   "END"                                   % PushAutoOn %
+                                         Ident                             % EndBuildFile (endt) ;
+                                                                             P3EndBuildDefModule %
+                                               "."                         % PopAuto ; PopAuto ; PopAuto %
+                  =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE"
+                    { Ident ( ";"
+                                  | "=" Type Alignment ";" )
+                    }
+              |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement :=                                                            % VAR CurrentAsm: CARDINAL ; %
+                'ASM'                                                      % IF Pass3
+                                                                             THEN
+                                                                                PushAutoOn ;
+                                                                                PushT(0) ;  (* operand count *)
+                                                                                PushT(MakeGnuAsm())
+                                                                             END
+                                                                           %
+                [ 'VOLATILE'                                               % IF Pass3
+                                                                             THEN
+                                                                                PopT(CurrentAsm) ;
+                                                                                PutGnuAsmVolatile(CurrentAsm) ;
+                                                                                PushT(CurrentAsm)
+                                                                             END
+                                                                           %
+                ] '(' AsmOperands                                          % IF Pass3
+                                                                             THEN
+                                                                                PopNothing ;  (* throw away interface sym *)
+                                                                                BuildInline ;
+                                                                                PopNothing ;  (* throw away count *)
+                                                                                PopAuto
+                                                                             END
+                                                                           %
+                  ')' =:
+
+AsmOperands :=                                                             % VAR CurrentAsm, count: CARDINAL ;
+                                                                                 str: CARDINAL ;
+                                                                           %
+               string                                                      % IF Pass3
+                                                                             THEN
+                                                                                PopT(str) ;
+                                                                                PopT(CurrentAsm) ;
+                                                                                Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
+                                                                                PopT(count) ;
+                                                                                IF DebugAsm
+                                                                                THEN
+                                                                                   printf1('1: count of asm operands: %d\n', count)
+                                                                                END ;
+                                                                                PushT(count) ;
+                                                                                (* adds the name/instruction for this asm *)
+                                                                                PutGnuAsm(CurrentAsm, str) ;
+                                                                                PushT(CurrentAsm) ;
+                                                                                PushT(NulSym)    (* the InterfaceSym *)
+                                                                             END
+                                                                           %
+                       ( AsmOperandSpec |                                  % (* epsilon *)
+                                                                             IF Pass3
+                                                                             THEN
+                                                                                PutGnuAsmSimple(CurrentAsm)
+                                                                             END
+                                                                           %
+                                                        )
+               =:
+
+AsmOperandSpec :=                                                          % VAR CurrentAsm, outputs, inputs, trash, count: CARDINAL ;
+                                                                           %
+                  [ ':' AsmList                                            % IF Pass3
+                                                                             THEN
+                                                                                PopT(outputs) ;
+                                                                                PopT(CurrentAsm) ;
+                                                                                Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
+                                                                                PopT(count) ;
+                                                                                IF DebugAsm
+                                                                                THEN
+                                                                                   printf1('2: output count of asm operands: %d\n', count)
+                                                                                END ;
+                                                                                PutGnuAsmOutput(CurrentAsm, outputs) ;
+                                                                                PushT(0) ;  (* reset count *)
+                                                                                PushT(CurrentAsm) ;
+                                                                                PushT(NulSym)    (* the InterfaceSym *)
+                                                                             END
+                                                                           %
+                     [ ':' AsmList                                         % IF Pass3
+                                                                             THEN
+                                                                                PopT(inputs) ;
+                                                                                PopT(CurrentAsm) ;
+                                                                                Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
+                                                                                PopT(count) ;
+                                                                                IF DebugAsm
+                                                                                THEN
+                                                                                   printf1('3: input count of asm operands: %d\n', count)
+                                                                                END ;
+                                                                                PutGnuAsmInput(CurrentAsm, inputs) ;
+                                                                                PushT(0) ;  (* reset count *)
+                                                                                PushT(CurrentAsm) ;
+                                                                                PushT(NulSym)    (* the InterfaceSym *)
+                                                                             END
+                                                                           %
+                        [ ':' TrashList                                    % IF Pass3
+                                                                             THEN
+                                                                                PopT(trash) ;
+                                                                                PopT(CurrentAsm) ;
+                                                                                Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
+                                                                                PopT(count) ;
+                                                                                IF DebugAsm
+                                                                                THEN
+                                                                                   printf1('4: trash count of asm operands: %d\n', count)
+                                                                                END ;
+                                                                                PutGnuAsmTrash(CurrentAsm, trash) ;
+                                                                                PushT(0) ;  (* reset count *)
+                                                                                PushT(CurrentAsm) ;
+                                                                                PushT(NulSym)    (* the InterfaceSym *)
+                                                                             END
+                                                                           %
+                           ] ] ]
+            =:
+
+AsmList     :=                                                             % VAR count, CurrentAsm, CurrentInterface: CARDINAL ; %
+                                                                           % IF Pass3
+                                                                             THEN
+                                                                                PopT(CurrentInterface) ;
+                                                                                PopT(CurrentAsm) ;
+                                                                                PopT(count) ;
+                                                                                Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
+                                                                                PushT(count) ;
+                                                                                PushT(CurrentAsm) ;
+                                                                                PushT(CurrentInterface) ;
+                                                                                IF DebugAsm
+                                                                                THEN
+                                                                                   printf1('8: AsmList has a count of asm operands: %d\n', count)
+                                                                                END
+                                                                             END
+                                                                           %
+               [ AsmElement ] { ',' AsmElement } =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName :=  ( NamedOperand
+                                  |                                        % IF IsAutoPushOn()
+                                                                             THEN
+                                                                                PushTF(NulName, identtok)
+                                                                             END
+                                                                           %
+                                    )
+                =:
+
+AsmElement :=                                                              % VAR n, str, expr,
+                                                                                 CurrentInterface,
+                                                                                 CurrentAsm, name: CARDINAL ; %
+              AsmOperandName
+
+              string '(' Expression                                        % IF Pass3
+                                                                             THEN
+                                                                                PopT(expr) ;
+                                                                                PopT(str) ;
+                                                                                PopT(name) ;
+                                                                                PopT(CurrentInterface) ;
+                                                                                PopT(CurrentAsm) ;
+                                                                                Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
+                                                                                PopT(n) ;
+                                                                                INC(n) ;
+                                                                                IF CurrentInterface=NulSym
+                                                                                THEN
+                                                                                   CurrentInterface := MakeRegInterface()
+                                                                                END ;
+                                                                                IF DebugAsm
+                                                                                THEN
+                                                                                   printf1('5: count of asm operands: %d\n', n)
+                                                                                END ;
+                                                                                PutRegInterface(CurrentInterface, n, name, str, expr) ;
+                                                                                PushT(n) ;
+                                                                                PushT(CurrentAsm) ;
+                                                                                PushT(CurrentInterface)
+                                                                             END
+                                                                           %
+                      ')'
+           =:
+
+TrashList :=                                                               % VAR CurrentInterface,
+                                                                                 CurrentAsm,
+                                                                                 n, str          : CARDINAL ; %
+             [ string                                                      % IF Pass3
+                                                                             THEN
+                                                                                PopT(str) ;
+                                                                                PopT(CurrentInterface) ;
+                                                                                PopT(CurrentAsm) ;
+                                                                                PopT(n) ;
+                                                                                INC(n) ;
+                                                                                Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
+                                                                                IF DebugAsm
+                                                                                THEN
+                                                                                   printf1('6: count of asm trash operands: %d\n', n)
+                                                                                END ;
+                                                                                IF CurrentInterface=NulSym
+                                                                                THEN
+                                                                                   CurrentInterface := MakeRegInterface()
+                                                                                END ;
+                                                                                PutRegInterface(CurrentInterface, n, NulName, str, NulSym) ;
+                                                                                PushT(n) ;
+                                                                                PushT(CurrentAsm) ;
+                                                                                PushT(CurrentInterface)
+                                                                             END
+                                                                           %
+             ] { ',' string                                                % IF Pass3
+                                                                             THEN
+                                                                                PopT(str) ;
+                                                                                PopT(CurrentInterface) ;
+                                                                                PopT(CurrentAsm) ;
+                                                                                PopT(n) ;
+                                                                                INC(n) ;
+                                                                                Assert(IsGnuAsm(CurrentAsm) OR IsGnuAsmVolatile(CurrentAsm)) ;
+                                                                                IF DebugAsm
+                                                                                THEN
+                                                                                   printf1('7: count of asm trash operands: %d\n', n)
+                                                                                END ;
+                                                                                IF CurrentInterface=NulSym
+                                                                                THEN
+                                                                                   CurrentInterface := MakeRegInterface()
+                                                                                END ;
+                                                                                PutRegInterface(CurrentInterface, n, NulName, str, NulSym) ;
+                                                                                PushT(n) ;
+                                                                                PushT(CurrentAsm) ;
+                                                                                PushT(CurrentInterface)
+                                                                             END
+                                                                           %
+                } =:
+
+FNB
diff --git a/gcc/m2/gm2-compiler/P3Build.def b/gcc/m2/gm2-compiler/P3Build.def
new file mode 100644
index 00000000000..674f892658c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P3Build.def
@@ -0,0 +1,43 @@
+(* P3Build.def provides a parser with error recovery for GNU Modula-2.
+
+Copyright (C) 2001-2022 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/>.  *)
+DEFINITION MODULE P3Build ;
+
+(*
+    Title      : P2Build
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Feb  2 16:11:05 2001
+    Last edit  : Fri Feb  2 16:11:05 2001
+    Description: provides a parser with error recovery for GNU Modula-2
+*)
+
+EXPORT QUALIFIED CompilationUnit ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END P3Build.
diff --git a/gcc/m2/gm2-compiler/P3SymBuild.def b/gcc/m2/gm2-compiler/P3SymBuild.def
new file mode 100644
index 00000000000..4d41a40148b
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P3SymBuild.def
@@ -0,0 +1,395 @@
+(* P3SymBuild.def pass 3 symbol creation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE P3SymBuild ;
+
+(*
+   Title      : P3SymBuild
+   Author     : Gaius Mulley
+   Date       : 24/6/87
+   LastEdit   : 1/9/89
+   System     : UNIX (GNU Modula-2)
+   Description: pass 3 symbol creation.
+*)
+
+(* StartBuildDefinitionModule, *)
+(* EndBuildDefinitionModule, *)
+(* StartBuildImplementationModule, *)
+(* EndBuildImplementationModule, *)
+(* StartBuildProgramModule, *)
+(* EndBuildProgramModule, *)
+
+EXPORT QUALIFIED P3StartBuildDefModule,
+                 P3EndBuildDefModule,
+                 P3StartBuildImpModule,
+                 P3EndBuildImpModule,
+                 P3StartBuildProgModule,
+                 P3EndBuildProgModule,
+                 StartBuildInnerModule,
+                 EndBuildInnerModule,
+                 CheckImportListOuterModule,
+                 CheckCanBeImported,
+                 BuildProcedureHeading,
+                 StartBuildProcedure,
+                 EndBuildProcedure,
+                 BuildSubrange,
+                 BuildNulName,
+                 BuildConst,
+                 BuildVarAtAddress,
+                 BuildOptArgInitializer ;
+
+
+(*
+   StartBuildDefinitionModule - Creates a definition module and starts
+                                a new scope.
+
+                                The Stack is expected:
+
+                                Entry                 Exit
+
+                         Ptr ->                                     <- Ptr
+                                +------------+        +-----------+
+                                | NameStart  |        | NameStart |
+                                |------------|        |-----------|
+
+*)
+
+PROCEDURE P3StartBuildDefModule ;
+
+
+(*
+   EndBuildDefinitionModule - Destroys the definition module scope and
+                              checks for correct name.
+
+                              The Stack is expected:
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +-----------+
+                              | NameEnd    |        |           |
+                              |------------|        |-----------|
+                              | NameStart  |        |           | <- Ptr
+                              |------------|        |-----------|
+*)
+
+PROCEDURE P3EndBuildDefModule ;
+
+
+(*
+   StartBuildImplementationModule - Creates an implementation module and starts
+                                    a new scope.
+
+                                    The Stack is expected:
+
+                                    Entry                 Exit
+
+                             Ptr ->                                     <- Ptr
+                                    +------------+        +-----------+
+                                    | NameStart  |        | NameStart |
+                                    |------------|        |-----------|
+
+*)
+
+PROCEDURE P3StartBuildImpModule ;
+
+
+(*
+   EndBuildImplementationModule - Destroys the implementation module scope and
+                                  checks for correct name.
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->
+                                  +------------+        +-----------+
+                                  | NameEnd    |        |           |
+                                  |------------|        |-----------|
+                                  | NameStart  |        |           | <- Ptr
+                                  |------------|        |-----------|
+*)
+
+PROCEDURE P3EndBuildImpModule ;
+
+
+(*
+   StartBuildProgramModule - Creates a program module and starts
+                             a new scope.
+
+                             The Stack is expected:
+
+                             Entry                 Exit
+
+                      Ptr ->                                     <- Ptr
+                             +------------+        +-----------+
+                             | NameStart  |        | NameStart |
+                             |------------|        |-----------|
+
+*)
+
+PROCEDURE P3StartBuildProgModule ;
+
+
+(*
+   EndBuildProgramModule - Destroys the program module scope and
+                           checks for correct name.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+        +-----------+
+                           | NameEnd    |        |           |
+                           |------------|        |-----------|
+                           | NameStart  |        |           | <- Ptr
+                           |------------|        |-----------|
+*)
+
+PROCEDURE P3EndBuildProgModule ;
+
+
+(*
+   CheckCanBeImported - checks to see that it is legal to import, Sym, from, ModSym.
+*)
+
+PROCEDURE CheckCanBeImported (ModSym, Sym: CARDINAL) ;
+
+
+(*
+   StartBuildInnerModule - Creates an Inner module and starts
+                           a new scope.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                                     <- Ptr
+                           +------------+        +-----------+
+                           | NameStart  |        | NameStart |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE StartBuildInnerModule ;
+
+
+(*
+   EndBuildInnerModule - Destroys the Inner module scope and
+                         checks for correct name.
+
+                         The Stack is expected:
+
+                         Entry                 Exit
+
+                  Ptr ->
+                         +------------+        +-----------+
+                         | NameEnd    |        |           |
+                         |------------|        |-----------|
+                         | NameStart  |        |           | <- Ptr
+                         |------------|        |-----------|
+*)
+
+PROCEDURE EndBuildInnerModule ;
+
+
+(*
+   CheckImportListOuterModule - checks to see that all identifiers are
+                                exported from the definition module.
+
+                                The Stack is expected:
+
+                                Entry           OR    Entry
+
+                         Ptr ->                Ptr ->
+                                +------------+        +-----------+
+                                | #          |        | #         |
+                                |------------|        |-----------|
+                                | Id1        |        | Id1       |
+                                |------------|        |-----------|
+                                .            .        .           .
+                                .            .        .           .
+                                .            .        .           .
+                                |------------|        |-----------|
+                                | Id#        |        | Id#       |
+                                |------------|        |-----------|
+                                | ImportTok  |        | Ident     |
+                                |------------|        |-----------|
+
+                                IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                                                      Error Condition
+                                Exit
+
+                                All above stack discarded
+*)
+
+PROCEDURE CheckImportListOuterModule ;
+
+
+(*
+   BuildProcedureHeading - Builds a procedure heading for the definition
+                           module procedures.
+
+                           Operation only performed if compiling a
+                           definition module.
+
+                           The Stack:
+
+                           Entry                       Exit
+
+                    Ptr ->
+                           +------------+
+                           | ProcSym    |              Empty
+                           |------------|
+
+*)
+
+PROCEDURE BuildProcedureHeading ;
+
+
+(*
+   StartBuildProcedure - Builds a Procedure.
+
+                         The Stack:
+
+                         Entry                 Exit
+
+                                                              <- Ptr
+                                               +------------+
+                  Ptr ->                       | ProcSym    |
+                         +------------+        |------------|
+                         | Name       |        | Name       |
+                         |------------|        |------------|
+*)
+
+PROCEDURE StartBuildProcedure ;
+
+
+(*
+   EndBuildProcedure - Ends building a Procedure.
+                       It checks the start procedure name matches the end
+                       procedure name.
+
+                       The Stack:
+
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +------------+
+                       | NameEnd    |
+                       |------------|
+                       | ProcSym    |
+                       |------------|
+                       | NameStart  |
+                       |------------|
+                                             Empty
+*)
+
+PROCEDURE EndBuildProcedure ;
+
+
+(*
+   BuildSubrange - Builds a Subrange type Symbol.
+
+                      Stack
+
+                      Entry                 Exit
+
+               Ptr ->
+                      +------------+
+                      | High       |
+                      |------------|
+                      | Low        |                       <- Ptr
+                      |------------|
+*)
+
+PROCEDURE BuildSubrange ;
+
+
+(*
+   BuildNulName - Pushes a NulKey onto the top of the stack.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+                                                          <- Ptr
+                  Empty                    +------------+
+                                           | NulKey     |
+                                           |------------|
+*)
+
+PROCEDURE BuildNulName ;
+
+
+(*
+   BuildConst - builds a constant.
+                Stack
+
+                Entry                 Exit
+
+         Ptr ->                                      <- Ptr
+                +------------+        +------------+
+                | Name       |        | Sym        |
+                |------------+        |------------|
+*)
+
+PROCEDURE BuildConst ;
+
+
+(*
+   BuildVarAtAddress - updates the symbol table entry of, variable sym, to be declared
+                       at address, address.
+
+                       Stack
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +--------------+
+                       | Expr | EType |                         <- Ptr
+                       |--------------+        +--------------+
+                       | name | SType |        | name | SType |
+                       |--------------+        |--------------|
+*)
+
+PROCEDURE BuildVarAtAddress ;
+
+
+(*
+   BuildOptArgInitializer - assigns the constant value symbol, const, to be the
+                            initial value of the optional parameter should it be
+                            absent.
+
+                            Ptr ->
+                                   +------------+
+                                   | const      |
+                                   |------------|                      <- Ptr
+*)
+
+PROCEDURE BuildOptArgInitializer ;
+
+
+END P3SymBuild.
diff --git a/gcc/m2/gm2-compiler/P3SymBuild.mod b/gcc/m2/gm2-compiler/P3SymBuild.mod
new file mode 100644
index 00000000000..3b8bfb2fa38
--- /dev/null
+++ b/gcc/m2/gm2-compiler/P3SymBuild.mod
@@ -0,0 +1,690 @@
+(* P3SymBuild.mod pass 3 symbol creation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE P3SymBuild ;
+
+
+FROM NameKey IMPORT Name, WriteKey, NulName ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM M2Debug IMPORT Assert, WriteDebug ;
+FROM M2Error IMPORT WriteFormat0, WriteFormat1, WriteFormat2, FlushErrors, InternalError ;
+FROM M2LexBuf IMPORT GetTokenNo ;
+
+FROM SymbolTable IMPORT NulSym, ModeOfAddr,
+                        StartScope, EndScope, GetScope, GetCurrentScope,
+                        GetModuleScope,
+                        SetCurrentModule, GetCurrentModule, SetFileModule,
+                        GetExported, IsExported, IsImplicityExported,
+                        IsDefImp, IsModule, IsImported, IsIncludedByDefinition,
+                        RequestSym,
+                        IsProcedure, PutOptArgInit,
+                        IsFieldEnumeration, GetType,
+                        CheckForUnknownInModule,
+                        GetFromOuterModule,
+                        GetMode, PutVariableAtAddress, ModeOfAddr, SkipType,
+                        IsSet, PutConstSet,
+                        IsConst, IsConstructor, PutConst, PutConstructor,
+                        PopValue, PushValue,
+                        MakeTemporary, PutVar,
+                        PutSubrange,
+                        GetSymName ;
+
+FROM M2Batch IMPORT MakeDefinitionSource,
+                    MakeImplementationSource,
+                    MakeProgramSource,
+                    LookupOuterModule ;
+
+FROM M2Quads IMPORT PushT, PopT, OperandT, PopN, PopTF, PushTF,
+                    PopTtok, PopTFtok, PushTtok, PushTFtok, OperandTok ;
+
+FROM M2Comp IMPORT CompilingDefinitionModule,
+                   CompilingImplementationModule,
+                   CompilingProgramModule ;
+
+FROM FifoQueue IMPORT GetSubrangeFromFifoQueue ;
+FROM M2Reserved IMPORT NulTok, ImportTok ;
+IMPORT M2Error ;
+
+
+(*
+   StartBuildDefinitionModule - Creates a definition module and starts
+                                a new scope.
+
+                                The Stack is expected:
+
+                                Entry                 Exit
+
+                         Ptr ->                                     <- Ptr
+                                +------------+        +-----------+
+                                | NameStart  |        | NameStart |
+                                |------------|        |-----------|
+
+*)
+
+PROCEDURE P3StartBuildDefModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   ModuleSym := MakeDefinitionSource (tok, name) ;
+   SetCurrentModule (ModuleSym) ;
+   SetFileModule (ModuleSym) ;
+   StartScope (ModuleSym) ;
+   Assert (IsDefImp (ModuleSym)) ;
+   Assert (CompilingDefinitionModule ()) ;
+   PushT (name) ;
+   M2Error.EnterDefinitionScope (name)
+END P3StartBuildDefModule ;
+
+
+(*
+   EndBuildDefinitionModule - Destroys the definition module scope and
+                              checks for correct name.
+
+                              The Stack is expected:
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +-----------+
+                              | NameEnd    |        |           |
+                              |------------|        |-----------|
+                              | NameStart  |        |           | <- Ptr
+                              |------------|        |-----------|
+*)
+
+PROCEDURE P3EndBuildDefModule ;
+VAR
+   NameStart,
+   NameEnd  : CARDINAL ;
+BEGIN
+   Assert(CompilingDefinitionModule()) ;
+   CheckForUnknownInModule ;
+   EndScope ;
+   PopT(NameEnd) ;
+   PopT(NameStart) ;
+   IF NameStart#NameEnd
+   THEN
+      WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)',
+                   NameStart, NameEnd)
+   END ;
+   M2Error.LeaveErrorScope
+END P3EndBuildDefModule ;
+
+
+(*
+   StartBuildImplementationModule - Creates an implementation module and starts
+                                    a new scope.
+
+                                    The Stack is expected:
+
+                                    Entry                 Exit
+
+                             Ptr ->                                     <- Ptr
+                                    +------------+        +-----------+
+                                    | NameStart  |        | NameStart |
+                                    |------------|        |-----------|
+
+*)
+
+PROCEDURE P3StartBuildImpModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   ModuleSym := MakeImplementationSource (tok, name) ;
+   SetCurrentModule (ModuleSym) ;
+   SetFileModule (ModuleSym) ;
+   StartScope (ModuleSym) ;
+   Assert (IsDefImp(ModuleSym)) ;
+   Assert (CompilingImplementationModule()) ;
+   PushT (name) ;
+   M2Error.EnterImplementationScope (name)
+END P3StartBuildImpModule ;
+
+
+(*
+   EndBuildImplementationModule - Destroys the implementation module scope and
+                                  checks for correct name.
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->
+                                  +------------+        +-----------+
+                                  | NameEnd    |        |           |
+                                  |------------|        |-----------|
+                                  | NameStart  |        |           | <- Ptr
+                                  |------------|        |-----------|
+*)
+
+PROCEDURE P3EndBuildImpModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   Assert(CompilingImplementationModule()) ;
+   CheckForUnknownInModule ;
+   EndScope ;
+   PopT(NameEnd) ;
+   PopT(NameStart) ;
+   IF NameStart#NameEnd
+   THEN
+      (* we dont issue an error based around incorrect module names as this is done in P1 and P2.
+         If we get here then something has gone wrong with our error recovery in P3, so we bail out.
+      *)
+      WriteFormat0('too many errors in pass 3') ;
+      FlushErrors
+   END ;
+   M2Error.LeaveErrorScope
+END P3EndBuildImpModule ;
+
+
+(*
+   StartBuildProgramModule - Creates a program module and starts
+                             a new scope.
+
+                             The Stack is expected:
+
+                             Entry                 Exit
+
+                      Ptr ->                                     <- Ptr
+                             +------------+        +-----------+
+                             | NameStart  |        | NameStart |
+                             |------------|        |-----------|
+
+*)
+
+PROCEDURE P3StartBuildProgModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   (* WriteString('StartBuildProgramModule') ; WriteLn ; *)
+   PopTtok(name, tok) ;
+   ModuleSym := MakeProgramSource(tok, name) ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   (* WriteString('MODULE - ') ; WriteKey(GetSymName(ModuleSym)) ; WriteLn ; *)
+   StartScope(ModuleSym) ;
+   Assert(CompilingProgramModule()) ;
+   Assert(NOT IsDefImp(ModuleSym)) ;
+   PushT(name) ;
+   M2Error.EnterProgramScope (name)
+END P3StartBuildProgModule ;
+
+
+(*
+   EndBuildProgramModule - Destroys the program module scope and
+                           checks for correct name.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+        +-----------+
+                           | NameEnd    |        |           |
+                           |------------|        |-----------|
+                           | NameStart  |        |           | <- Ptr
+                           |------------|        |-----------|
+*)
+
+PROCEDURE P3EndBuildProgModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   Assert(CompilingProgramModule()) ;
+   CheckForUnknownInModule ;
+   EndScope ;
+   PopT(NameEnd) ;
+   PopT(NameStart) ;
+   IF NameStart#NameEnd
+   THEN
+      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
+         If we get here then something has gone wrong with our error recovery in P3, so we bail out.
+      *)
+      WriteFormat0('too many errors in pass 3') ;
+      FlushErrors
+   END ;
+   M2Error.LeaveErrorScope
+END P3EndBuildProgModule ;
+
+
+(*
+   StartBuildInnerModule - Creates an Inner module and starts
+                           a new scope.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                                     <- Ptr
+                           +------------+        +-----------+
+                           | NameStart  |        | NameStart |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE StartBuildInnerModule ;
+VAR
+   name     : Name ;
+   tok      : CARDINAL ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   ModuleSym := RequestSym (tok, name) ;
+   Assert(IsModule(ModuleSym)) ;
+   StartScope(ModuleSym) ;
+   Assert(NOT IsDefImp(ModuleSym)) ;
+   SetCurrentModule(ModuleSym) ;
+   PushT(name) ;
+   M2Error.EnterModuleScope (name)
+END StartBuildInnerModule ;
+
+
+(*
+   EndBuildInnerModule - Destroys the Inner module scope and
+                         checks for correct name.
+
+                         The Stack is expected:
+
+                         Entry                 Exit
+
+                  Ptr ->
+                         +------------+        +-----------+
+                         | NameEnd    |        |           |
+                         |------------|        |-----------|
+                         | NameStart  |        |           | <- Ptr
+                         |------------|        |-----------|
+*)
+
+PROCEDURE EndBuildInnerModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   CheckForUnknownInModule ;
+   EndScope ;
+   PopT(NameEnd) ;
+   PopT(NameStart) ;
+   IF NameStart#NameEnd
+   THEN
+      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
+         If we get here then something has gone wrong with our error recovery in P3, so we bail out.
+      *)
+      WriteFormat0('too many errors in pass 3') ;
+      FlushErrors
+   END ;
+   SetCurrentModule(GetModuleScope(GetCurrentModule())) ;
+   M2Error.LeaveErrorScope
+END EndBuildInnerModule ;
+
+
+(*
+   CheckImportListOuterModule - checks to see that all identifiers are
+                                exported from the definition module.
+
+                                The Stack is expected:
+
+                                Entry           OR    Entry
+
+                         Ptr ->                Ptr ->
+                                +------------+        +-----------+
+                                | #          |        | #         |
+                                |------------|        |-----------|
+                                | Id1        |        | Id1       |
+                                |------------|        |-----------|
+                                .            .        .           .
+                                .            .        .           .
+                                .            .        .           .
+                                |------------|        |-----------|
+                                | Id#        |        | Id#       |
+                                |------------|        |-----------|
+                                | ImportTok  |        | Ident     |
+                                |------------|        |-----------|
+
+                                IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                                                      Error Condition
+                                Exit
+
+                                All above stack discarded
+*)
+
+PROCEDURE CheckImportListOuterModule ;
+VAR
+   n1, n2     : Name ;
+   tok        : CARDINAL ;
+   ModSym,
+   i, n       : CARDINAL ;
+BEGIN
+   PopT(n) ;       (* n   = # of the Ident List *)
+   IF OperandT(n+1)#ImportTok
+   THEN
+      (* Ident List contains list of objects *)
+      ModSym := LookupOuterModule(OperandTok(n+1), OperandT(n+1)) ;
+      i := 1 ;
+      WHILE i<=n DO
+         tok := OperandTok (i) ;
+         IF (NOT IsExported(ModSym, RequestSym (tok, OperandT (i)))) AND
+            (NOT IsImplicityExported(ModSym, RequestSym (tok, OperandT(i))))
+         THEN
+            n1 := OperandT(n+1) ;
+            n2 := OperandT(i) ;
+            WriteFormat2 ('symbol %a is not exported from definition or inner module %a', n2, n1)
+         END ;
+         INC(i)
+      END
+   END ;
+   PopN(n+1)   (* clear stack *)
+END CheckImportListOuterModule ;
+
+
+(*
+   CheckCanBeImported - checks to see that it is legal to import, Sym, from, ModSym.
+*)
+
+PROCEDURE CheckCanBeImported (ModSym, Sym: CARDINAL) ;
+VAR
+   n1, n2: Name ;
+BEGIN
+   IF IsDefImp(ModSym)
+   THEN
+      IF IsExported(ModSym, Sym)
+      THEN
+         (* great all done *)
+         RETURN
+      ELSE
+         IF IsImplicityExported(ModSym, Sym)
+         THEN
+            (* this is also legal *)
+            RETURN
+         ELSIF IsDefImp(Sym) AND IsIncludedByDefinition(ModSym, Sym)
+         THEN
+            (* this is also legal (for a definition module) *)
+            RETURN
+         END ;
+         n1 := GetSymName(ModSym) ;
+         n2 := GetSymName(Sym) ;
+         WriteFormat2('symbol %a is not exported from definition module %a', n2, n1)
+      END
+   END
+END CheckCanBeImported ;
+
+
+(*
+   StartBuildProcedure - Builds a Procedure.
+
+                         The Stack:
+
+                         Entry                 Exit
+
+                                                              <- Ptr
+                                               +------------+
+                  Ptr ->                       | ProcSym    |
+                         +------------+        |------------|
+                         | Name       |        | Name       |
+                         |------------|        |------------|
+*)
+
+PROCEDURE StartBuildProcedure ;
+VAR
+   tok     : CARDINAL ;
+   name    : Name ;
+   ProcSym : CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   PushTtok (name, tok) ;  (* Name saved for the EndBuildProcedure name check *)
+   ProcSym := RequestSym (tok, name) ;
+   Assert (IsProcedure (ProcSym)) ;
+   PushTtok (ProcSym, tok) ;
+   StartScope (ProcSym) ;
+   M2Error.EnterProcedureScope (name)
+END StartBuildProcedure ;
+
+
+(*
+   EndBuildProcedure - Ends building a Procedure.
+                       It checks the start procedure name matches the end
+                       procedure name.
+
+                       The Stack:
+
+                       (Procedure Not Defined in definition module)
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +------------+
+                       | NameEnd    |
+                       |------------|
+                       | ProcSym    |
+                       |------------|
+                       | NameStart  |
+                       |------------|
+                                             Empty
+*)
+
+PROCEDURE EndBuildProcedure ;
+VAR
+   ProcSym  : CARDINAL ;
+   NameEnd,
+   NameStart: Name ;
+BEGIN
+   PopT(NameEnd) ;
+   PopT(ProcSym) ;
+   PopT(NameStart) ;
+   IF NameEnd#NameStart
+   THEN
+      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
+         If we get here then something has gone wrong with our error recovery in P3, so we bail out.
+      *)
+      WriteFormat0('too many errors in pass 3') ;
+      FlushErrors
+   END ;
+   EndScope ;
+   M2Error.LeaveErrorScope
+END EndBuildProcedure ;
+
+
+(*
+   BuildProcedureHeading - Builds a procedure heading for the definition
+                           module procedures.
+
+                           Operation only performed if compiling a
+                           definition module.
+
+                           The Stack:
+
+                           Entry                       Exit
+
+                    Ptr ->
+                           +------------+
+                           | ProcSym    |
+                           |------------|
+                           | NameStart  |
+                           |------------|
+                                                       Empty
+
+*)
+
+PROCEDURE BuildProcedureHeading ;
+VAR
+   ProcSym  : CARDINAL ;
+   NameStart: Name ;
+BEGIN
+   IF CompilingDefinitionModule()
+   THEN
+      PopT(ProcSym) ;
+      PopT(NameStart) ;
+      EndScope
+   END
+END BuildProcedureHeading ;
+
+
+(*
+   BuildSubrange - Builds a Subrange type Symbol.
+
+
+                      Stack
+
+                      Entry                 Exit
+
+               Ptr ->
+                      +------------+
+                      | High       |
+                      |------------|
+                      | Low        |                       <- Ptr
+                      |------------|
+*)
+
+PROCEDURE BuildSubrange ;
+VAR
+   Base,
+   Type,
+   Low,
+   High: CARDINAL ;
+BEGIN
+   PopT(High) ;
+   PopT(Low) ;
+   GetSubrangeFromFifoQueue(Type) ;  (* Collect subrange type from pass 2 and fill in *)
+                                     (* bounds.                                       *)
+   GetSubrangeFromFifoQueue(Base) ;  (* Get base of subrange (maybe NulSym)           *)
+(*
+   WriteString('Subrange type name is: ') ; WriteKey(GetSymName(Type)) ; WriteLn ;
+   WriteString('Subrange High is: ') ; WriteKey(GetSymName(High)) ;
+   WriteString(' Low is: ') ; WriteKey(GetSymName(Low)) ; WriteLn ;
+*)
+   PutSubrange(Type, Low, High, Base)   (* if Base is NulSym then it is       *)
+                                        (* worked out later in M2GCCDeclare   *)
+END BuildSubrange ;
+
+
+(*
+   BuildNulName - Pushes a NulKey onto the top of the stack.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+                                                          <- Ptr
+                  Empty                    +------------+
+                                           | NulKey     |
+                                           |------------|
+*)
+
+PROCEDURE BuildNulName ;
+BEGIN
+   PushT(NulName)
+END BuildNulName ;
+
+
+(*
+   BuildConst - builds a constant.
+                Stack
+
+                Entry                 Exit
+
+         Ptr ->                                      <- Ptr
+                +------------+        +------------+
+                | Name       |        | Sym        |
+                |------------+        |------------|
+*)
+
+PROCEDURE BuildConst ;
+VAR
+   name: Name ;
+   tok : CARDINAL ;
+   Sym : CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   Sym := RequestSym (tok, name) ;
+   PushTtok (Sym, tok)
+END BuildConst ;
+
+
+(*
+   BuildVarAtAddress - updates the symbol table entry of, variable sym, to be declared
+                       at address, address.
+
+                       Stack
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +--------------+
+                       | Expr | EType |                         <- Ptr
+                       |--------------+        +--------------+
+                       | name | SType |        | name | SType |
+                       |--------------+        |--------------|
+*)
+
+PROCEDURE BuildVarAtAddress ;
+VAR
+   nametok   : CARDINAL ;
+   name      : Name ;
+   Sym, SType,
+   Exp, EType: CARDINAL ;
+BEGIN
+   PopTF(Exp, EType) ;
+   PopTFtok (name, SType, nametok) ;
+   PushTF(name, SType) ;
+   Sym := RequestSym (nametok, name) ;
+   IF GetMode(Sym)=LeftValue
+   THEN
+      PutVariableAtAddress(Sym, Exp)
+   ELSE
+      InternalError ('expecting lvalue for this variable which is declared at an explicit address')
+   END
+END BuildVarAtAddress ;
+
+
+(*
+   BuildOptArgInitializer - assigns the constant value symbol, const, to be the
+                            initial value of the optional parameter should it be
+                            absent.
+
+                            Ptr ->
+                                   +------------+
+                                   | const      |
+                                   |------------|                      <- Ptr
+*)
+
+PROCEDURE BuildOptArgInitializer ;
+VAR
+   const: CARDINAL ;
+BEGIN
+   PopT(const) ;
+   PutOptArgInit(GetCurrentScope(), const)
+END BuildOptArgInitializer ;
+
+
+END P3SymBuild.
diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf
new file mode 100644
index 00000000000..40fc1e63923
--- /dev/null
+++ b/gcc/m2/gm2-compiler/PCBuild.bnf
@@ -0,0 +1,1263 @@
+--
+-- m2-c.bnf grammar and associated actions for pass C.
+--
+-- Copyright (C) 2001-2022 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/>.
+% module PCBuild begin
+(* output from m2-c.bnf, automatically generated do not edit if these
+   are the top two lines in the file.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE PCBuild ;
+
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
+                     InsertTokenAndRewind, GetTokenNo, MakeVirtualTok ;
+
+FROM M2Error IMPORT ErrorStringAt, WriteFormat1, WriteFormat2 ;
+FROM NameKey IMPORT NulName, Name, makekey ;
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
+FROM M2Printf IMPORT printf0 ;
+FROM M2Debug IMPORT Assert ;
+FROM P2SymBuild IMPORT BuildString, BuildNumber ;
+
+FROM M2Reserved IMPORT tokToTok, toktype,
+                       NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
+                       EqualTok, HashTok, LessGreaterTok, LessTok, LessEqualTok,
+                       GreaterTok, GreaterEqualTok, InTok, PlusTok, MinusTok,
+                       OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok,
+                       AndTok, AmbersandTok, PeriodPeriodTok, ByTok ;
+
+FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF, PopNothing, OperandT, PushTFA,
+                    PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok, PushTFntok,
+                    PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto,
+                    BuildTypeForConstructor, BuildConstructor, BuildConstructorEnd,
+                    PopConstructor,
+                    NextConstructorField, SilentBuildConstructor ;
+
+FROM P3SymBuild IMPORT CheckCanBeImported ;
+
+FROM PCSymBuild IMPORT PCStartBuildProgModule,
+                       PCEndBuildProgModule,
+
+                       PCStartBuildDefModule,
+                       PCEndBuildDefModule,
+
+                       PCStartBuildImpModule,
+                       PCEndBuildImpModule,
+
+                       PCStartBuildInnerModule,
+                       PCEndBuildInnerModule,
+
+                       PCStartBuildProcedure,
+                       PCBuildProcedureHeading,
+                       PCEndBuildProcedure,
+                       PCBuildImportOuterModule,
+                       PCBuildImportInnerModule,
+                       StartDesConst,
+                       EndDesConst,
+                       BuildRelationConst,
+                       BuildBinaryConst,
+                       BuildUnaryConst,
+                       PushIntegerType,
+                       PushStringType,
+                       PushConstructorCastType,
+                       PushInConstructor,
+                       PopInConstructor,
+                       PushConstFunctionType,
+                       PushConstType,
+                       PushConstAttributeType,
+                       PushConstAttributePairType,
+                       PushRType ;
+
+FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
+                        PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
+                        MakeRegInterface,
+                        PutRegInterface,
+                        GetSymName, GetType, SkipType,
+                        NulSym,
+                        StartScope, EndScope,
+                        PutIncluded,
+                        IsVarParam, IsProcedure, IsDefImp, IsModule,
+                        IsRecord, IsProcType,
+                        RequestSym,
+                        GetSym, GetLocalSym ;
+
+FROM M2Batch IMPORT IsModuleKnown ;
+
+IMPORT M2Error ;
+
+
+CONST
+   Debugging = FALSE ;
+   Pass1     = FALSE ;
+
+VAR
+   WasNoError  : BOOLEAN ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   ErrorStringAt (s, GetTokenNo ()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString (InitString (a))
+END ErrorArray ;
+
+
+PROCEDURE ErrorArrayAt (a: ARRAY OF CHAR; tok: CARDINAL) ;
+BEGIN
+   ErrorStringAt (InitString(a), tok)
+END ErrorArrayAt ;
+
+
+% declaration PCBuild begin
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   WHILE NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      GetToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError(stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop(s0, s1, s2) ;
+
+   str := ConCat(InitString('syntax error,'), Mark(str)) ;
+   ErrorStringAt(str, GetTokenNo())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken(t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0('inserting token\n')
+      END ;
+      InsertToken(t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken(t) ;
+      InsertTokenAndRewind(t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      GetToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   RETURN( WasNoError )
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey (currentstring), identtok, GetTokenNo ())
+   END ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTF(makekey(currentstring), stringtok) ;
+      BuildString
+   END ;
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), integertok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), realtok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module PCBuild end
+END PCBuild.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuild procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit :=                                                                % PushAutoOff %
+            ( DefinitionModule |
+              ImplementationOrProgramModule )                              % PopAuto %
+         =:
+
+ProgramModule := "MODULE"                                                  % M2Error.DefaultProgramModule %
+                                                                           % PushAutoOn %
+                  Ident                                                    % PCStartBuildProgModule %
+                                                                           % PushAutoOff %
+                  [ Priority
+                  ]
+                  ";"
+                  { Import                                                 % PCBuildImportOuterModule %
+                  }
+                  Block                                                    % PushAutoOn %
+                  Ident                                                    % PCEndBuildProgModule %
+                  "."                                                      % PopAuto ; PopAuto %
+                  =:
+
+ImplementationModule := "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
+                                         "MODULE"                          % PushAutoOn %
+                         Ident                                             % PCStartBuildImpModule %
+                                                                           % PushAutoOff %
+                         [ Priority
+                         ] ";"
+                         { Import                                          % PCBuildImportOuterModule %
+                           }
+                         Block                                             % PushAutoOn %
+
+                         Ident                                             % PCEndBuildImpModule %
+                         "."                                               % PopAuto ; PopAuto ; PopAuto %
+                      =:
+
+ImplementationOrProgramModule :=                                           % PushAutoOff %
+                                 ( ImplementationModule | ProgramModule )  % PopAuto %
+                              =:
+
+Number := Integer | Real =:
+
+Qualident :=                                                               % VAR name          : Name ;
+                                                                                 init, ip1,
+                                                                                 tokstart, tok : CARDINAL ; %
+             Ident
+                                                                           % IF IsAutoPushOn()
+                                                                             THEN
+                                                                                PopTtok(name, tokstart) ;
+										tok := tokstart ;
+                                                                                init := RequestSym (tok, name) ;
+                                                                                WHILE IsDefImp (init) OR IsModule (init) DO
+                                                                                   Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+                                                                                   StartScope (init) ;
+                                                                                   Ident (stopset0, stopset1, stopset2) ;
+                                                                                   PopTtok (name, tok) ;
+                                                                                   ip1 := RequestSym (tok, name) ;
+                                                                                   PutIncluded(ip1) ;
+                                                                                   EndScope ;
+                                                                                   CheckCanBeImported(init, ip1) ;
+                                                                                   init := ip1
+                                                                                END ;
+										IF tok#tokstart
+										THEN
+										   tok := MakeVirtualTok (tokstart, tokstart, tok)
+										END ;
+                                                                                IF IsProcedure(init) OR IsProcType(init)
+                                                                                THEN
+                                                                                   PushTtok(init, tok)
+                                                                                ELSE
+                                                                                   PushTFtok(init, GetType(init), tok) ;
+                                                                                END
+                                                                             ELSE %
+             { "." Ident }                                                 % END %
+           =:
+
+ConstantDeclaration :=                                                     % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+                                                                           % PushAutoOn %
+                       ( Ident "="                                         % StartDesConst %
+                                                                           % PushAutoOff %
+                                   ConstExpression                         % PopAuto %
+                                                    )
+                                                                           % EndDesConst %
+                                                                           % PopAuto %
+                                                                           % Assert(top=Top()) %
+                     =:
+
+ConstExpression :=                                                         % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+                                                                           % PushAutoOff %
+                   SimpleConstExpr [ Relation SimpleConstExpr              % BuildRelationConst %
+                                   ]                                       % PopAuto %
+                                                                           % Assert(top=Top()) %
+                =:
+
+Relation :=   "="                                                          % PushT(EqualTok) %
+            | "#"                                                          % PushT(HashTok) %
+            | "<>"                                                         % PushT(LessGreaterTok) %
+            | "<"                                                          % PushT(LessTok) %
+            | "<="                                                         % PushT(LessEqualTok) %
+            | ">"                                                          % PushT(GreaterTok) %
+            | ">="                                                         % PushT(GreaterEqualTok) %
+            | "IN"                                                         % PushT(InTok) %
+         =:
+
+SimpleConstExpr :=                                                         % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+                   UnaryOrConstTerm { ConstAddOperator ConstTerm           % BuildBinaryConst %
+                                                                 }         % Assert(top=Top()) %
+                                                                   =:
+
+UnaryOrConstTerm :=   "+"                                                  % PushT(PlusTok) %
+                          ConstTerm                                        % BuildUnaryConst %
+                                    | "-"                                  % PushT(MinusTok) %
+                                          ConstTerm                        % BuildUnaryConst %
+                                                    | ConstTerm
+                  =:
+
+ConstAddOperator :=   "+"                                                  % PushT(PlusTok) %
+                    | "-"                                                  % PushT(MinusTok) %
+                    | "OR"                                                 % PushT(OrTok) %
+                  =:
+
+AddOperator :=   "+" | "-" | "OR" =:
+
+ConstTerm :=                                                               % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+             ConstFactor                                                   % Assert(top=Top()) %
+                         { ConstMulOperator ConstFactor                    % BuildBinaryConst %
+                                                                           % Assert(top=Top()) %
+                                                        }                  % Assert(top=Top()) %
+                                                          =:
+
+ConstMulOperator :=   "*"                                                  % PushT(TimesTok) %
+                    | "/"                                                  % PushT(DivideTok) %
+                    | "DIV"                                                % PushT(DivTok) %
+                    | "MOD"                                                % PushT(ModTok) %
+                    | "REM"                                                % PushT(RemTok) %
+                    | "AND"                                                % PushT(AndTok) %
+                    | "&"                                                  % PushT(AmbersandTok) %
+             =:
+
+MulOperator :=   "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&"
+             =:
+
+ConstFactor := ConstNumber | ConstString |
+               ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" |
+               "NOT" ConstFactor
+               | ConstAttribute
+             =:
+
+ConstNumber :=                                                             % PushAutoOn %
+               ( Integer                                                   % PushIntegerType %
+                         | Real                                            % PushRType %
+                                )                                          % PopAuto %
+             =:
+
+-- to help satisfy LL1
+
+ConstString :=                                                             % PushAutoOn %
+               string                                                      % PushStringType %
+                                                                           % PopAuto %
+             =:
+
+ComponentElement := ConstExpression [ ".." ConstExpression ] =:
+
+ComponentValue := ComponentElement [ 'BY' ConstExpression ] =:
+
+ArraySetRecordValue := ComponentValue { ','                                % NextConstructorField %
+                                            ComponentValue } =:
+
+Constructor := '{'                                                         % PushConstructorCastType %
+                                                                           % PushInConstructor %
+                                                                           % BuildConstructor (GetTokenNo ()-1) %
+                  [ ArraySetRecordValue ]                                  % PopConstructor %
+               '}'                                                         % PopInConstructor %
+                   =:
+
+ConstructorOrConstActualParameters := Constructor | ConstActualParameters  % PushConstFunctionType %
+                                                                           % PopNothing (* pop function *) %
+                                    =:
+
+-- the entry to Constructor
+
+ConstSetOrQualidentOrFunction :=                                           % PushAutoOff %
+                                 (
+                                   PushQualident
+                                   ( ConstructorOrConstActualParameters |  % PushConstType %
+                                                                           % PopNothing %
+                                                                          )
+                                   |                                       % BuildTypeForConstructor %
+                                     Constructor )                         % PopAuto %
+                               =:
+
+ConstActualParameters :=                                                   % PushT(0) %
+                         "(" [ ConstExpList ] ")" =:
+
+ConstExpList :=                                                            % VAR n: CARDINAL ; %
+                ConstExpression                                            % PopT(n) %
+                                                                           % INC(n) %
+                                                                           % Assert(n=1) %
+                                                                           % PushT(n) %
+                                { "," ConstExpression                      % PopT(n) %
+                                                                           % INC(n) %
+                                                                           % PushT(n) %
+                                                      } =:
+
+ConstAttribute :=                                                          % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+                  "__ATTRIBUTE__" "__BUILTIN__" "(" "("                    % PushAutoOn %
+                  ConstAttributeExpression                                 % PopAuto %
+                  ")" ")"                                                  % Assert(top=Top()) %
+                =:
+
+ConstAttributeExpression :=
+                            Ident                                          % PushConstAttributeType %
+                                                                           % PopNothing %
+                                  | "<" Qualident ',' Ident ">"            % PushConstAttributePairType %
+                                                                           % PopNothing ; PopNothing %
+                          =:
+
+ByteAlignment := '<*' AttributeExpression '*>' =:
+
+Alignment := [ ByteAlignment ] =:
+
+TypeDeclaration := Ident "=" Type Alignment =:
+
+Type :=
+                                                                           % PushAutoOff %
+        ( SimpleType | ArrayType
+          | RecordType
+          | SetType
+          | PointerType
+          | ProcedureType )                                                % PopAuto %
+      =:
+
+SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+
+Enumeration := "(" IdentList ")" =:
+
+IdentList := Ident                                                         % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," Ident                                                   % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+SubrangeType := "[" ConstExpression  ".." ConstExpression "]" =:
+
+ArrayType := "ARRAY"
+
+              SimpleType
+              { ","
+                SimpleType
+              } "OF"
+             Type
+           =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
+
+DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                        { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression :=                                                           % PushAutoOff %
+                         Ident [ '(' ConstExpression ')' ]
+                                                                                   % PopAuto %
+                       =:
+
+AttributeExpression :=                                                             % PushAutoOff %
+                       Ident '(' ConstExpression ')'                               % PopAuto %
+                     =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+FieldListStatement := [ FieldList ] =:
+
+FieldList := IdentList ":"
+                           Type RecordFieldPragma
+             |
+             "CASE"
+                    CaseTag "OF"
+                                 Varient { "|" Varient }
+              [ "ELSE"
+                FieldListSequence
+              ] "END"
+           =:
+
+TagIdent := [ Ident ] =:
+
+CaseTag :=  TagIdent [":" Qualident ] =:
+
+Varient := [ VarientCaseLabelList ":" FieldListSequence ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression ( ".." ConstExpression
+                                       |                                   % (* epsilon *) %
+                                     )
+                   =:
+
+--
+--  the following rules are a copy of the ConstExpression ebnf rules but without
+--  any actions all prefixed with Silent.
+--  At present they are only used by CaseLabels, if this continues to be true we
+--  might consider restricting the SilentConstExpression. Eg it makes no sence to allow
+--  String in these circumstances!
+--
+
+SilentConstExpression :=                                                   % PushAutoOff %
+                         SilentSimpleConstExpr
+                         [ SilentRelation SilentSimpleConstExpr ]          % PopAuto %
+                      =:
+
+SilentRelation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
+
+SilentSimpleConstExpr := SilentUnaryOrConstTerm { SilentAddOperator SilentConstTerm } =:
+
+SilentUnaryOrConstTerm := "+" SilentConstTerm | "-" SilentConstTerm | SilentConstTerm =:
+
+SilentAddOperator := "+" | "-" | "OR" =:
+
+SilentConstTerm := SilentConstFactor { SilentMulOperator SilentConstFactor } =:
+
+SilentMulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
+
+SilentConstFactor := Number | SilentConstString | SilentConstSetOrQualidentOrFunction |
+                     "(" SilentConstExpression ")" | "NOT" SilentConstFactor
+                     | SilentConstAttribute =:
+
+SilentConstString := string =:
+
+SilentConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" SilentConstAttributeExpression ")" ")" =:
+
+SilentConstAttributeExpression := Ident | "<" Ident ',' SilentConstString ">" =:
+
+SilentComponentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
+
+SilentComponentValue := SilentComponentElement [ 'BY' SilentConstExpression ] =:
+
+SilentArraySetRecordValue := SilentComponentValue { ',' SilentComponentValue } =:
+
+SilentConstructor := '{'                                                   % SilentBuildConstructor %
+                         [ SilentArraySetRecordValue ] '}' =:
+
+SilentConstSetOrQualidentOrFunction := SilentConstructor | Qualident
+                                       [ SilentConstructor | SilentActualParameters ] =:
+
+SilentActualParameters := "(" [ SilentExpList ] ")" =:
+
+SilentExpList := SilentConstExpression { "," SilentConstExpression } =:
+
+-- end of the Silent constant rules
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+
+PointerType := "POINTER" "TO"
+                              Type
+             =:
+
+ProcedureType := "PROCEDURE"
+                 [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+
+VarIdent := Ident [ "[" ConstExpression "]" ]
+         =:
+
+VarIdentList := VarIdent { "," VarIdent }
+              =:
+
+VariableDeclaration := VarIdentList ":" Type Alignment
+                    =:
+
+Designator := Qualident { SubDesignator } =:
+
+SubDesignator := "." Ident | "[" ArrayExpList "]" | "^"
+            =:
+
+ArrayExpList := Expression { "," Expression } =:
+
+ExpList := Expression { "," Expression } =:
+
+Expression := SimpleExpression [ SilentRelation SimpleExpression ]
+           =:
+
+SimpleExpression := UnaryOrTerm { AddOperator Term } =:
+
+UnaryOrTerm := "+" Term | "-" Term | Term =:
+
+Term := Factor { MulOperator Factor } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" ( Factor | ConstAttribute ) =:
+
+PushQualident :=                                                           % VAR name         : Name ;
+                                                                                 init, ip1    : CARDINAL ;
+                                                                                 tok, tokstart: CARDINAL ; %
+                                                                           % PushAutoOn %
+             Ident                                                         % IF IsAutoPushOn()
+                                                                             THEN
+                                                                                PopTtok (name, tokstart) ;
+                                                                                tok := tokstart ;
+                                                                                init := GetSym (name) ;
+                                                                                IF init=NulSym
+                                                                                THEN
+                                                                                   PushTFntok (NulSym, NulSym, name, tok)
+                                                                                ELSE
+                                                                                   WHILE IsDefImp (init) OR IsModule (init) DO
+                                                                                      IF currenttoken # periodtok
+                                                                                      THEN
+                                                                                         ErrorArrayAt ("expecting '.' after module in the construction of a qualident", tok) ;
+                                                                                         IF tok#tokstart
+                                                                                         THEN
+                                                                                            tok := MakeVirtualTok (tokstart, tokstart, tok)
+                                                                                         END ;
+                                                                                         PushTtok (init, tok) ;
+                                                                                         PopAuto ;
+                                                                                         RETURN
+                                                                                      ELSE
+                                                                                         Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+                                                                                         StartScope (init) ;
+                                                                                         Ident (stopset0, stopset1, stopset2) ;
+                                                                                         PopTtok (name, tok) ;
+                                                                                         ip1 := GetSym (name) ;
+                                                                                         IF ip1 = NulSym
+                                                                                         THEN
+                                                                                            ErrorArrayAt ("unknown ident in the construction of a qualident", tok) ;
+                                                                                            EndScope ;
+                                                                                            IF tok#tokstart
+                                                                                            THEN
+                                                                                               tok := MakeVirtualTok (tokstart, tokstart, tok)
+                                                                                            END ;
+                                                                                            PushTFntok (NulSym, NulSym, name, tok) ;
+                                                                                            PopAuto ;
+                                                                                            RETURN
+                                                                                         ELSE
+                                                                                            PutIncluded (ip1)
+                                                                                         END ;
+                                                                                         EndScope ;
+                                                                                         CheckCanBeImported (init, ip1) ;
+                                                                                         init := ip1
+                                                                                      END
+                                                                                   END ;
+                                                                                   IF tok#tokstart
+                                                                                   THEN
+                                                                                      tok := MakeVirtualTok (tokstart, tokstart, tok)
+                                                                                   END ;
+                                                                                   IF IsProcedure (init) OR IsProcType (init)
+                                                                                   THEN
+                                                                                      PushTtok (init, tok)
+                                                                                   ELSE
+                                                                                      PushTFtok (init, GetType(init), tok)
+                                                                                   END
+                                                                                END
+                                                                             ELSE %
+             { "." Ident }                                                 % END %
+                                                                           % PopAuto %
+           =:
+
+ConstructorOrSimpleDes := Constructor |                                    % PopNothing %
+                                          SimpleDes [ ActualParameters ]
+                        =:
+
+SetOrDesignatorOrFunction :=                                              % PushAutoOff %
+                             (
+                               PushQualident
+                               ( ConstructorOrSimpleDes |                 % PopNothing %
+                                                          )
+                                |
+                                                                          % BuildTypeForConstructor %
+                                  Constructor
+                             )                                            % PopAuto %
+                          =:
+
+-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+SimpleDes := { SubDesignator } =:
+
+ActualParameters := "(" [ ExpList ] ")" =:
+
+ExitStatement := "EXIT" =:
+
+ReturnStatement := "RETURN" [ Expression ] =:
+
+Statement :=                                                               % PushAutoOff %
+             [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               ExitStatement | ReturnStatement | RetryStatement
+             ]                                                             % PopAuto ; %
+          =:
+
+RetryStatement := "RETRY" =:
+
+AssignmentOrProcedureCall :=                                               % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+                             Designator ( ":=" Expression |
+                                           ActualParameters |              % (* epsilon *) %
+                                        )                                  % Assert(top=Top()) %
+                                          =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence :=                                                       % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+                     Statement                                             % Assert(top=Top()) %
+                               { ";"
+                                     Statement                             % Assert(top=Top()) %
+                                               }
+                  =:
+
+IfStatement := "IF" Expression "THEN"
+                StatementSequence
+              { "ELSIF" Expression "THEN" StatementSequence
+              }
+              [ "ELSE" StatementSequence ] "END"
+            =:
+
+CaseStatement := "CASE" Expression "OF" Case { "|" Case }
+                 CaseEndStatement
+               =:
+
+CaseEndStatement := "END" | "ELSE" StatementSequence "END"
+                 =:
+
+Case := [ CaseLabelList ":" StatementSequence ]
+      =:
+
+CaseLabelList := CaseLabels { "," CaseLabels } =:
+
+CaseLabels := ConstExpression [ ".." ConstExpression ] =:
+
+WhileStatement := "WHILE" Expression "DO" StatementSequence "END" =:
+
+RepeatStatement := "REPEAT" StatementSequence "UNTIL" Expression =:
+
+ForStatement := "FOR" Ident ":=" Expression "TO" Expression
+                [ "BY" ConstExpression ] "DO"
+                   StatementSequence
+                "END"
+              =:
+
+LoopStatement := "LOOP" StatementSequence "END" =:
+
+WithStatement := "WITH" Designator "DO"
+                     StatementSequence
+                 "END"
+               =:
+
+ProcedureDeclaration := ProcedureHeading ";"                               % PushAutoOff %
+                                             ProcedureBlock                % PopAuto ; PushAutoOn %
+                        Ident                                              % PCEndBuildProcedure ;
+                                                                             PopAuto %
+                      =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
+                            "(" "("                                        % PushAutoOff %
+                                    Ident                                  % PopAuto %
+                                          ")" ")" | "__INLINE__" ]
+                      =:
+
+ProcedureHeading := "PROCEDURE"                                            % M2Error.DefaultProcedure %
+                                                                           % PushAutoOn %
+                     DefineBuiltinProcedure
+                     ( Ident
+                                                                           % PCStartBuildProcedure ;
+                                                                             PushAutoOff %
+                       [ FormalParameters ] AttributeNoReturn
+                                                                           % PCBuildProcedureHeading ;
+                                                                             PopAuto %
+                     )                                                     % PopAuto %
+                     =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE"                                         % M2Error.DefaultProcedure %
+                                                                           % PushAutoOn %
+                        Builtin
+                        ( Ident
+                                                                           % PCStartBuildProcedure ;
+                                                                             PushAutoOff %
+                          [ DefFormalParameters ] AttributeNoReturn
+                                                                           % PCBuildProcedureHeading ;
+                                                                             PopAuto %
+                        )                                                  % PopAuto %
+                                                                           % M2Error.LeaveErrorScope %
+                     =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+AttributeUnused := [ "<*" Ident "*>" ] =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock :=                                                          % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+                  { Declaration                                            % Assert(top=Top()) %
+                                } [ "BEGIN" ProcedureBlockBody             % Assert(top=Top()) %
+                                                               ] "END"     % Assert(top=Top()) %
+                                                                       =:
+
+Block :=                                                                   % VAR top: CARDINAL ; %
+                                                                           % top := Top() %
+         { Declaration } InitialBlock FinalBlock
+                                                 "END"                     % Assert(top=Top()) %
+                                                       =:
+
+InitialBlock := [ "BEGIN" InitialBlockBody ] =:
+
+FinalBlock := [ "FINALLY" FinalBlockBody ] =:
+
+InitialBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+FinalBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+ProcedureBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration ";" } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP |
+                     FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
+
+MultiFPSection := ExtendedFP |
+                  FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
+
+NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
+
+OptArg := "[" Ident ":" FormalType [ "=" ConstExpression ] "]" =:
+
+DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
+
+FormalType := { "ARRAY" "OF" } Qualident =:
+
+ModuleDeclaration := "MODULE"                                              % M2Error.DefaultInnerModule %
+                                                                           % PushAutoOn %
+                     Ident                                                 % PCStartBuildInnerModule %
+                                                                           % PushAutoOff %
+                     [ Priority ] ";"
+                     { Import                                              % PCBuildImportInnerModule %
+                        } [ Export
+                            ]
+                       Block                                               % PushAutoOn %
+                       Ident                                               % PCEndBuildInnerModule %
+                                                                           % PopAuto ; PopAuto ; PopAuto %
+                     =:
+
+Priority := "[" ConstExpression "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"
+                                 IdentList |
+                     "UNQUALIFIED"
+                                 IdentList |
+                     IdentList ) ";" =:
+
+Import :=                                                                  % PushAutoOn %
+          ( "FROM" Ident "IMPORT" IdentList ";" |
+           "IMPORT"                                                        % PushT(ImportTok)
+                                                                             (* determines whether Ident or Module *) %
+            IdentList ";" )                                                % PopAuto %
+        =:
+
+DefinitionModule := "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
+                                 "MODULE"                                  % PushAutoOn %
+                    [ "FOR" string ]
+                    Ident                                                  % PCStartBuildDefModule ;
+                                                                             PushAutoOff %
+                    ";"
+                    { Import                                               % PCBuildImportOuterModule %
+                             } [ Export
+                                        ]
+                    { Definition }
+                                   "END"                                   % PushAutoOn %
+                                         Ident                             % PCEndBuildDefModule %
+                                               "."                         % PopAuto ; PopAuto ; PopAuto %
+                  =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE"
+                    { Ident ( ";"
+                                  | "=" Type Alignment ";" )
+                    }
+              |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ] =:
+
+AsmOperands := string [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ] =:
+
+AsmList     := [ AsmElement ] { ',' AsmElement } =:
+
+AsmElement := AsmOperandName string '(' Expression ')' =:
+
+TrashList := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/gm2-compiler/PCBuild.def b/gcc/m2/gm2-compiler/PCBuild.def
new file mode 100644
index 00000000000..871c7411087
--- /dev/null
+++ b/gcc/m2/gm2-compiler/PCBuild.def
@@ -0,0 +1,44 @@
+(* PCBuild.def provides a parser with error recovery for GNU Modula-2.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE PCBuild ;
+
+(*
+    Title      : PCBuild
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Feb  2 16:11:05 2001
+    Last edit  : Fri Feb  2 16:11:05 2001
+    Description: provides a parser with error recovery for GNU Modula-2
+*)
+
+EXPORT QUALIFIED CompilationUnit ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END PCBuild.
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.def b/gcc/m2/gm2-compiler/PCSymBuild.def
new file mode 100644
index 00000000000..88c7ff39042
--- /dev/null
+++ b/gcc/m2/gm2-compiler/PCSymBuild.def
@@ -0,0 +1,497 @@
+(* PCSymBuild.def pass C symbol creation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE PCSymBuild ;
+
+(*
+   Title      : PCSymBuild
+   Author     : Gaius Mulley
+   System     : UNIX (GNU Modula-2)
+   Description: provides scope mainstance for Pass C it also resolves
+                the import/export symbols and assigns types to constructors.
+*)
+
+EXPORT QUALIFIED PCStartBuildDefModule,
+                 PCEndBuildDefModule,
+                 PCStartBuildImpModule,
+                 PCEndBuildImpModule,
+                 PCStartBuildProgModule,
+                 PCEndBuildProgModule,
+                 PCStartBuildInnerModule,
+                 PCEndBuildInnerModule,
+                 PCBuildProcedureHeading,
+                 PCStartBuildProcedure,
+                 PCEndBuildProcedure,
+                 BuildNulName,
+                 BuildConst,
+                 PCBuildImportOuterModule,
+                 PCBuildImportInnerModule,
+                 StartDesConst,
+                 EndDesConst,
+                 BuildRelationConst,
+                 BuildUnaryConst,
+                 BuildBinaryConst,
+                 PushInConstructor,
+                 PopInConstructor,
+                 SkipConst,
+                 PushConstType,
+                 PushConstAttributeType,
+                 PushConstAttributePairType,
+                 PushConstructorCastType,
+                 PushRType,
+                 PushConstFunctionType,
+                 PushIntegerType,
+                 PushStringType,
+                 ResolveConstTypes ;
+
+
+(*
+   StartBuildDefinitionModule - Creates a definition module and starts
+                                a new scope.
+
+                                The Stack is expected:
+
+                                Entry                 Exit
+
+                         Ptr ->                                     <- Ptr
+                                +------------+        +-----------+
+                                | NameStart  |        | NameStart |
+                                |------------|        |-----------|
+
+*)
+
+PROCEDURE PCStartBuildDefModule ;
+
+
+(*
+   EndBuildDefinitionModule - Destroys the definition module scope and
+                              checks for correct name.
+
+                              The Stack is expected:
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +-----------+
+                              | NameEnd    |        |           |
+                              |------------|        |-----------|
+                              | NameStart  |        |           | <- Ptr
+                              |------------|        |-----------|
+*)
+
+PROCEDURE PCEndBuildDefModule ;
+
+
+(*
+   StartBuildImplementationModule - Creates an implementation module and starts
+                                    a new scope.
+
+                                    The Stack is expected:
+
+                                    Entry                 Exit
+
+                             Ptr ->                                     <- Ptr
+                                    +------------+        +-----------+
+                                    | NameStart  |        | NameStart |
+                                    |------------|        |-----------|
+
+*)
+
+PROCEDURE PCStartBuildImpModule ;
+
+
+(*
+   EndBuildImplementationModule - Destroys the implementation module scope and
+                                  checks for correct name.
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->
+                                  +------------+        +-----------+
+                                  | NameEnd    |        |           |
+                                  |------------|        |-----------|
+                                  | NameStart  |        |           | <- Ptr
+                                  |------------|        |-----------|
+*)
+
+PROCEDURE PCEndBuildImpModule ;
+
+
+(*
+   StartBuildProgramModule - Creates a program module and starts
+                             a new scope.
+
+                             The Stack is expected:
+
+                             Entry                 Exit
+
+                      Ptr ->                                     <- Ptr
+                             +------------+        +-----------+
+                             | NameStart  |        | NameStart |
+                             |------------|        |-----------|
+
+*)
+
+PROCEDURE PCStartBuildProgModule ;
+
+
+(*
+   EndBuildProgramModule - Destroys the program module scope and
+                           checks for correct name.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+        +-----------+
+                           | NameEnd    |        |           |
+                           |------------|        |-----------|
+                           | NameStart  |        |           | <- Ptr
+                           |------------|        |-----------|
+*)
+
+PROCEDURE PCEndBuildProgModule ;
+
+
+(*
+   StartBuildInnerModule - Creates an Inner module and starts
+                           a new scope.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                                     <- Ptr
+                           +------------+        +-----------+
+                           | NameStart  |        | NameStart |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE PCStartBuildInnerModule ;
+
+
+(*
+   EndBuildInnermModule - Destroys the Inner module scope and
+                          checks for correct name.
+
+                          The Stack is expected:
+
+                          Entry                 Exit
+
+                   Ptr ->
+                          +------------+        +-----------+
+                          | NameEnd    |        |           |
+                          |------------|        |-----------|
+                          | NameStart  |        |           | <- Ptr
+                          |------------|        |-----------|
+*)
+
+PROCEDURE PCEndBuildInnerModule ;
+
+
+(*
+   BuildProcedureHeading - Builds a procedure heading for the definition
+                           module procedures.
+
+                           Operation only performed if compiling a
+                           definition module.
+
+                           The Stack:
+
+                           Entry                       Exit
+
+                    Ptr ->
+                           +------------+
+                           | ProcSym    |              Empty
+                           |------------|
+
+*)
+
+PROCEDURE PCBuildProcedureHeading ;
+
+
+(*
+   StartBuildProcedure - Builds a Procedure.
+
+                         The Stack:
+
+                         Entry                 Exit
+
+                                                              <- Ptr
+                                               +------------+
+                  Ptr ->                       | ProcSym    |
+                         +------------+        |------------|
+                         | Name       |        | Name       |
+                         |------------|        |------------|
+*)
+
+PROCEDURE PCStartBuildProcedure ;
+
+
+(*
+   EndBuildProcedure - Ends building a Procedure.
+                       It checks the start procedure name matches the end
+                       procedure name.
+
+                       The Stack:
+
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +------------+
+                       | NameEnd    |
+                       |------------|
+                       | ProcSym    |
+                       |------------|
+                       | NameStart  |
+                       |------------|
+                                             Empty
+*)
+
+PROCEDURE PCEndBuildProcedure ;
+
+
+(*
+   BuildImportOuterModule - Builds imported identifiers into an outer module
+                            from a definition module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE PCBuildImportOuterModule ;
+
+
+(*
+   BuildImportInnerModule - Builds imported identifiers into an inner module
+                            from the last level of module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                                                  Error Condition
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE PCBuildImportInnerModule ;
+
+
+(*
+   BuildNulName - Pushes a NulKey onto the top of the stack.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+                                                          <- Ptr
+                  Empty                    +------------+
+                                           | NulKey     |
+                                           |------------|
+*)
+
+PROCEDURE BuildNulName ;
+
+
+(*
+   BuildConst - builds a constant.
+                Stack
+
+                Entry                 Exit
+
+         Ptr ->                                      <- Ptr
+                +------------+        +------------+
+                | Name       |        | Sym        |
+                |------------+        |------------|
+*)
+
+PROCEDURE BuildConst ;
+
+
+(*
+   StartDesConst -
+*)
+
+PROCEDURE StartDesConst ;
+
+
+(*
+   EndDesConst -
+*)
+
+PROCEDURE EndDesConst ;
+
+
+(*
+   BuildRelationConst - builds a relationship binary operation.
+*)
+
+PROCEDURE BuildRelationConst ;
+
+
+(*
+   BuildUnaryConst - builds a unary operator node.
+*)
+
+PROCEDURE BuildUnaryConst ;
+
+
+(*
+   BuildBinaryConst - builds a binary operator node.
+*)
+
+PROCEDURE BuildBinaryConst ;
+
+
+(*
+   PushConstFunctionType -
+*)
+
+PROCEDURE PushConstFunctionType ;
+
+
+(*
+   PushIntegerType - pushes a ztype or char leaf.
+*)
+
+PROCEDURE PushIntegerType ;
+
+
+(*
+   PushRType -
+*)
+
+PROCEDURE PushRType ;
+
+
+(*
+   PushStringType -
+*)
+
+PROCEDURE PushStringType ;
+
+
+(*
+   SkipConst - returns an alias to constant, sym, if one exists.
+               Otherwise sym is returned.
+*)
+
+PROCEDURE SkipConst (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PushConstType - pushes a constant to the expression stack.
+*)
+
+PROCEDURE PushConstType ;
+
+
+(*
+   PushConstAttributeType -
+*)
+
+PROCEDURE PushConstAttributeType ;
+
+
+(*
+   PushConstAttributePairType -
+*)
+
+PROCEDURE PushConstAttributePairType ;
+
+
+(*
+   PushConstructorCastType -
+*)
+
+PROCEDURE PushConstructorCastType ;
+
+
+(*
+   PushInConstructor -
+*)
+
+PROCEDURE PushInConstructor ;
+
+
+(*
+   PopInConstructor -
+*)
+
+PROCEDURE PopInConstructor ;
+
+
+(*
+   ResolveConstTypes - resolves the types of all designator declared constants.
+*)
+
+PROCEDURE ResolveConstTypes ;
+
+
+END PCSymBuild.
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod
new file mode 100644
index 00000000000..57d77e1b2f5
--- /dev/null
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -0,0 +1,2292 @@
+(* PCSymBuild.mod pass C symbol creation.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE PCSymBuild ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM NameKey IMPORT Name, WriteKey, MakeKey, NulName ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM M2Debug IMPORT Assert, WriteDebug ;
+FROM M2Error IMPORT WriteFormat0, WriteFormat1, WriteFormat2, FlushErrors, InternalError, NewError, ErrorFormat0 ;
+FROM M2MetaError IMPORT MetaError1, MetaErrorT1 ;
+FROM M2LexBuf IMPORT GetTokenNo ;
+FROM M2Reserved IMPORT NulTok, ImportTok ;
+FROM M2Const IMPORT constType ;
+FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, InBounds, IncludeIndiceIntoIndex, HighIndice ;
+
+FROM M2Quads IMPORT PushT, PopT, OperandT, PopN, PopTF, PushTF, IsAutoPushOn,
+                    PopNothing, PushTFn, PopTFn, PushTtok, PopTtok, PushTFtok, PopTFtok, OperandTok ;
+
+FROM M2Options IMPORT Iso ;
+FROM StdIO IMPORT Write ;
+FROM M2System IMPORT IsPseudoSystemFunctionConstExpression ;
+
+FROM M2Base IMPORT MixTypes,
+                   ZType, RType, Char, Boolean, Val, Max, Min, Convert,
+                   IsPseudoBaseFunction, IsRealType, IsComplexType, IsOrdinalType ;
+
+FROM M2Reserved IMPORT PlusTok, MinusTok, TimesTok, DivTok, ModTok,
+                       DivideTok, RemTok,
+                       OrTok, AndTok, AmbersandTok,
+                       EqualTok, LessEqualTok, GreaterEqualTok,
+                       LessTok, GreaterTok, HashTok, LessGreaterTok,
+                       InTok, NotTok ;
+
+FROM SymbolTable IMPORT NulSym, ModeOfAddr,
+                        StartScope, EndScope, GetScope, GetCurrentScope,
+                        GetModuleScope,
+                        SetCurrentModule, GetCurrentModule, SetFileModule,
+                        GetExported,
+                        IsDefImp, IsModule,
+                        RequestSym,
+                        IsProcedure, PutOptArgInit, IsEnumeration,
+                        CheckForUnknownInModule,
+                        GetFromOuterModule,
+                        CheckForEnumerationInCurrentModule,
+                        GetMode, PutVariableAtAddress, ModeOfAddr, SkipType,
+                        IsSet, PutConstSet,
+                        IsConst, IsConstructor, PutConst, PutConstructor,
+                        PopValue, PushValue,
+                        MakeTemporary, PutVar,
+                        PutSubrange,
+                        GetSymName,
+                        CheckAnonymous,
+                        IsProcedureBuiltin,
+                        MakeProcType,
+                        NoOfParam,
+                        GetParam,
+                        IsParameterVar, PutProcTypeParam,
+                        PutProcTypeVarParam, IsParameterUnbounded,
+                        PutFunction, PutProcTypeParam,
+                        GetType,
+                        IsAModula2Type, GetDeclaredMod ;
+
+FROM M2Batch IMPORT MakeDefinitionSource,
+                    MakeImplementationSource,
+                    MakeProgramSource,
+                    LookupModule, LookupOuterModule ;
+
+FROM M2Comp IMPORT CompilingDefinitionModule,
+                   CompilingImplementationModule,
+                   CompilingProgramModule ;
+
+FROM M2StackAddress IMPORT StackOfAddress, InitStackAddress, KillStackAddress,
+                           PushAddress, PopAddress, PeepAddress,
+                           IsEmptyAddress, NoOfItemsInStackAddress ;
+
+FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord,
+                        PushWord, PopWord, PeepWord,
+                        IsEmptyWord, NoOfItemsInStackWord ;
+
+IMPORT M2Error ;
+
+
+CONST
+   Debugging = FALSE ;
+
+TYPE
+   tagType = (leaf, unary, binary, designator, expr, convert, function) ;
+
+   exprNode = POINTER TO eNode ;
+
+   eDes = RECORD
+             type: CARDINAL ;
+             meta: constType ;
+             sym : CARDINAL ;
+             left: exprNode ;
+          END ;
+
+   eLeaf = RECORD
+              type: CARDINAL ;
+              meta: constType ;
+              sym: CARDINAL ;
+           END ;
+
+   eUnary = RECORD
+               type: CARDINAL ;
+               meta: constType ;
+               left: exprNode ;
+               op  : Name ;
+            END ;
+
+   eBinary = RECORD
+                type: CARDINAL ;
+                meta: constType ;
+                left,
+                right: exprNode ;
+                op   : Name ;
+             END ;
+
+   eExpr = RECORD
+              type: CARDINAL ;
+              meta: constType ;
+              left: exprNode ;
+           END ;
+
+   eFunction = RECORD
+                  type  : CARDINAL ;
+                  meta  : constType ;
+                  func  : CARDINAL ;
+                  first,
+                  second: exprNode ;
+                  third : BOOLEAN ;
+               END ;
+
+   eConvert = RECORD
+                 type  : CARDINAL ;
+                 meta  : constType ;
+                 totype: exprNode ;
+                 expr  : exprNode ;
+              END ;
+
+   eNode    = RECORD
+                 CASE tag: tagType OF
+
+                 designator:  edes     : eDes |
+                 leaf      :  eleaf    : eLeaf |
+                 unary     :  eunary   : eUnary |
+                 binary    :  ebinary  : eBinary |
+                 expr      :  eexpr    : eExpr |
+                 function  :  efunction: eFunction |
+                 convert   :  econvert : eConvert
+
+                 END
+              END ;
+
+
+VAR
+   exprStack   : StackOfAddress ;
+   constList   : Index ;
+   constToken  : CARDINAL ;
+   desStack    : StackOfWord ;
+   inDesignator: BOOLEAN ;
+
+
+(*
+   GetSkippedType -
+*)
+
+PROCEDURE GetSkippedType (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( SkipType(GetType(sym)) )
+END GetSkippedType ;
+
+
+(*
+   StartBuildDefinitionModule - Creates a definition module and starts
+                                a new scope.
+
+                                The Stack is expected:
+
+                                Entry                 Exit
+
+                         Ptr ->                                     <- Ptr
+                                +------------+        +-----------+
+                                | NameStart  |        | NameStart |
+                                |------------|        |-----------|
+
+*)
+
+PROCEDURE PCStartBuildDefModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopTtok(name, tok) ;
+   ModuleSym := MakeDefinitionSource(tok, name) ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   StartScope(ModuleSym) ;
+   Assert(IsDefImp(ModuleSym)) ;
+   Assert(CompilingDefinitionModule()) ;
+   PushT(name) ;
+   M2Error.EnterDefinitionScope (name)
+END PCStartBuildDefModule ;
+
+
+(*
+   EndBuildDefinitionModule - Destroys the definition module scope and
+                              checks for correct name.
+
+                              The Stack is expected:
+
+                              Entry                 Exit
+
+                       Ptr ->
+                              +------------+        +-----------+
+                              | NameEnd    |        |           |
+                              |------------|        |-----------|
+                              | NameStart  |        |           | <- Ptr
+                              |------------|        |-----------|
+*)
+
+PROCEDURE PCEndBuildDefModule ;
+VAR
+   NameStart,
+   NameEnd  : CARDINAL ;
+BEGIN
+   Assert(CompilingDefinitionModule()) ;
+   CheckForUnknownInModule ;
+   EndScope ;
+   PopT(NameEnd) ;
+   PopT(NameStart) ;
+   IF NameStart#NameEnd
+   THEN
+      WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)',
+                   NameStart, NameEnd)
+   END ;
+   M2Error.LeaveErrorScope
+END PCEndBuildDefModule ;
+
+
+(*
+   StartBuildImplementationModule - Creates an implementation module and starts
+                                    a new scope.
+
+                                    The Stack is expected:
+
+                                    Entry                 Exit
+
+                             Ptr ->                                     <- Ptr
+                                    +------------+        +-----------+
+                                    | NameStart  |        | NameStart |
+                                    |------------|        |-----------|
+
+*)
+
+PROCEDURE PCStartBuildImpModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopTtok(name, tok) ;
+   ModuleSym := MakeImplementationSource(tok, name) ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   StartScope(ModuleSym) ;
+   Assert(IsDefImp(ModuleSym)) ;
+   Assert(CompilingImplementationModule()) ;
+   PushTtok(name, tok) ;
+   M2Error.EnterImplementationScope (name)
+END PCStartBuildImpModule ;
+
+
+(*
+   EndBuildImplementationModule - Destroys the implementation module scope and
+                                  checks for correct name.
+
+                                  The Stack is expected:
+
+                                  Entry                 Exit
+
+                           Ptr ->
+                                  +------------+        +-----------+
+                                  | NameEnd    |        |           |
+                                  |------------|        |-----------|
+                                  | NameStart  |        |           | <- Ptr
+                                  |------------|        |-----------|
+*)
+
+PROCEDURE PCEndBuildImpModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   Assert(CompilingImplementationModule()) ;
+   CheckForUnknownInModule ;
+   EndScope ;
+   PopT(NameEnd) ;
+   PopT(NameStart) ;
+   IF NameStart#NameEnd
+   THEN
+      (* we dont issue an error based around incorrect module names as this is done in P1 and P2.
+         If we get here then something has gone wrong with our error recovery in PC, so we bail out.
+      *)
+      WriteFormat0('too many errors in pass 3') ;
+      FlushErrors
+   END ;
+   M2Error.LeaveErrorScope
+END PCEndBuildImpModule ;
+
+
+(*
+   StartBuildProgramModule - Creates a program module and starts
+                             a new scope.
+
+                             The Stack is expected:
+
+                             Entry                 Exit
+
+                      Ptr ->                                     <- Ptr
+                             +------------+        +-----------+
+                             | NameStart  |        | NameStart |
+                             |------------|        |-----------|
+
+*)
+
+PROCEDURE PCStartBuildProgModule ;
+VAR
+   tok      : CARDINAL ;
+   name     : Name ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   (* WriteString('StartBuildProgramModule') ; WriteLn ; *)
+   PopTtok(name, tok) ;
+   ModuleSym := MakeProgramSource(tok, name) ;
+   SetCurrentModule(ModuleSym) ;
+   SetFileModule(ModuleSym) ;
+   (* WriteString('MODULE - ') ; WriteKey(GetSymName(ModuleSym)) ; WriteLn ; *)
+   StartScope(ModuleSym) ;
+   Assert(CompilingProgramModule()) ;
+   Assert(NOT IsDefImp(ModuleSym)) ;
+   PushTtok(name, tok) ;
+   M2Error.EnterProgramScope (name)
+END PCStartBuildProgModule ;
+
+
+(*
+   EndBuildProgramModule - Destroys the program module scope and
+                           checks for correct name.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->
+                           +------------+        +-----------+
+                           | NameEnd    |        |           |
+                           |------------|        |-----------|
+                           | NameStart  |        |           | <- Ptr
+                           |------------|        |-----------|
+*)
+
+PROCEDURE PCEndBuildProgModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   Assert(CompilingProgramModule()) ;
+   CheckForUnknownInModule ;
+   EndScope ;
+   PopT(NameEnd) ;
+   PopT(NameStart) ;
+   IF NameStart#NameEnd
+   THEN
+      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
+         If we get here then something has gone wrong with our error recovery in PC, so we bail out.
+      *)
+      WriteFormat0('too many errors in pass 3') ;
+      FlushErrors
+   END ;
+   M2Error.LeaveErrorScope
+END PCEndBuildProgModule ;
+
+
+(*
+   StartBuildInnerModule - Creates an Inner module and starts
+                           a new scope.
+
+                           The Stack is expected:
+
+                           Entry                 Exit
+
+                    Ptr ->                                     <- Ptr
+                           +------------+        +-----------+
+                           | NameStart  |        | NameStart |
+                           |------------|        |-----------|
+
+*)
+
+PROCEDURE PCStartBuildInnerModule ;
+VAR
+   name     : Name ;
+   tok      : CARDINAL ;
+   ModuleSym: CARDINAL ;
+BEGIN
+   PopTtok(name, tok) ;
+   ModuleSym := RequestSym(tok, name) ;
+   Assert(IsModule(ModuleSym)) ;
+   StartScope(ModuleSym) ;
+   Assert(NOT IsDefImp(ModuleSym)) ;
+   SetCurrentModule(ModuleSym) ;
+   PushTtok(name, tok) ;
+   M2Error.EnterModuleScope (name)
+END PCStartBuildInnerModule ;
+
+
+(*
+   EndBuildInnerModule - Destroys the Inner module scope and
+                         checks for correct name.
+
+                         The Stack is expected:
+
+                         Entry                 Exit
+
+                  Ptr ->
+                         +------------+        +-----------+
+                         | NameEnd    |        |           |
+                         |------------|        |-----------|
+                         | NameStart  |        |           | <- Ptr
+                         |------------|        |-----------|
+*)
+
+PROCEDURE PCEndBuildInnerModule ;
+VAR
+   NameStart,
+   NameEnd  : Name ;
+BEGIN
+   CheckForUnknownInModule ;
+   EndScope ;
+   PopT(NameEnd) ;
+   PopT(NameStart) ;
+   IF NameStart#NameEnd
+   THEN
+      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
+         If we get here then something has gone wrong with our error recovery in PC, so we bail out.
+      *)
+      WriteFormat0('too many errors in pass 3') ;
+      FlushErrors
+   END ;
+   SetCurrentModule(GetModuleScope(GetCurrentModule())) ;
+   M2Error.LeaveErrorScope
+END PCEndBuildInnerModule ;
+
+
+(*
+   BuildImportOuterModule - Builds imported identifiers into an outer module
+                            from a definition module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE PCBuildImportOuterModule ;
+VAR
+   Sym, ModSym,
+   i, n       : CARDINAL ;
+BEGIN
+   PopT (n) ;       (* n   = # of the Ident List *)
+   IF OperandT (n+1) # ImportTok
+   THEN
+      (* Ident List contains list of objects imported from ModSym *)
+      ModSym := LookupModule (OperandTok (n+1), OperandT (n+1)) ;
+      i := 1 ;
+      WHILE i<=n DO
+         Sym := GetExported (OperandTok (i), ModSym, OperandT (i)) ;
+         CheckForEnumerationInCurrentModule (Sym) ;
+         INC (i)
+      END
+   END ;
+   PopN (n+1)   (* clear stack *)
+END PCBuildImportOuterModule ;
+
+
+(*
+   BuildImportInnerModule - Builds imported identifiers into an inner module
+                            from the last level of module.
+
+                            The Stack is expected:
+
+                            Entry           OR    Entry
+
+                     Ptr ->                Ptr ->
+                            +------------+        +-----------+
+                            | #          |        | #         |
+                            |------------|        |-----------|
+                            | Id1        |        | Id1       |
+                            |------------|        |-----------|
+                            .            .        .           .
+                            .            .        .           .
+                            .            .        .           .
+                            |------------|        |-----------|
+                            | Id#        |        | Id#       |
+                            |------------|        |-----------|
+                            | ImportTok  |        | Ident     |
+                            |------------|        |-----------|
+
+                            IMPORT Id1, .. Id# ;  FROM Ident IMPORT Id1 .. Id# ;
+
+                            Exit
+
+                            All above stack discarded
+*)
+
+PROCEDURE PCBuildImportInnerModule ;
+VAR
+   Sym, ModSym,
+   n, i       : CARDINAL ;
+BEGIN
+   PopT (n) ;       (* i   = # of the Ident List *)
+   IF OperandT (n+1) = ImportTok
+   THEN
+      (* Ident List contains list of objects *)
+      i := 1 ;
+      WHILE i<=n DO
+         Sym := GetFromOuterModule (OperandTok (i), OperandT (i)) ;
+         CheckForEnumerationInCurrentModule (Sym) ;
+         INC (i)
+      END
+   ELSE
+      (* Ident List contains list of objects imported from ModSym *)
+      ModSym := LookupOuterModule (OperandTok (n+1), OperandT (n+1)) ;
+      i := 1 ;
+      WHILE i<=n DO
+         Sym := GetExported (OperandTok (i), ModSym, OperandT (i)) ;
+         CheckForEnumerationInCurrentModule (Sym) ;
+         INC (i)
+      END
+   END ;
+   PopN (n+1)   (* Clear Stack *)
+END PCBuildImportInnerModule ;
+
+
+(*
+   StartBuildProcedure - Builds a Procedure.
+
+                         The Stack:
+
+                         Entry                 Exit
+
+                                                              <- Ptr
+                                               +------------+
+                  Ptr ->                       | ProcSym    |
+                         +------------+        |------------|
+                         | Name       |        | Name       |
+                         |------------|        |------------|
+*)
+
+PROCEDURE PCStartBuildProcedure ;
+VAR
+   name    : Name ;
+   ProcSym : CARDINAL ;
+   tok     : CARDINAL ;
+BEGIN
+   PopTtok(name, tok) ;
+   PushTtok(name, tok) ;  (* Name saved for the EndBuildProcedure name check *)
+   ProcSym := RequestSym (tok, name) ;
+   Assert (IsProcedure (ProcSym)) ;
+   PushTtok (ProcSym, tok) ;
+   StartScope (ProcSym) ;
+   M2Error.EnterProcedureScope (name)
+END PCStartBuildProcedure ;
+
+
+(*
+   EndBuildProcedure - Ends building a Procedure.
+                       It checks the start procedure name matches the end
+                       procedure name.
+
+                       The Stack:
+
+                       (Procedure Not Defined in definition module)
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +------------+
+                       | NameEnd    |
+                       |------------|
+                       | ProcSym    |
+                       |------------|
+                       | NameStart  |
+                       |------------|
+                                             Empty
+*)
+
+PROCEDURE PCEndBuildProcedure ;
+VAR
+   ProcSym  : CARDINAL ;
+   NameEnd,
+   NameStart: Name ;
+BEGIN
+   PopT(NameEnd) ;
+   PopT(ProcSym) ;
+   PopT(NameStart) ;
+   IF NameEnd#NameStart
+   THEN
+      (* we dont issue an error based around incorrect module names this would be done in P1 and P2.
+         If we get here then something has gone wrong with our error recovery in PC, so we bail out.
+      *)
+      WriteFormat0('too many errors in pass 3') ;
+      FlushErrors
+   END ;
+   EndScope ;
+   M2Error.LeaveErrorScope
+END PCEndBuildProcedure ;
+
+
+(*
+   BuildProcedureHeading - Builds a procedure heading for the definition
+                           module procedures.
+
+                           Operation only performed if compiling a
+                           definition module.
+
+                           The Stack:
+
+                           Entry                       Exit
+
+                    Ptr ->
+                           +------------+
+                           | ProcSym    |
+                           |------------|
+                           | NameStart  |
+                           |------------|
+                                                       Empty
+
+*)
+
+PROCEDURE PCBuildProcedureHeading ;
+VAR
+   ProcSym  : CARDINAL ;
+   NameStart: Name ;
+BEGIN
+   IF CompilingDefinitionModule ()
+   THEN
+      PopT (ProcSym) ;
+      PopT (NameStart) ;
+      EndScope
+   END
+END PCBuildProcedureHeading ;
+
+
+(*
+   BuildNulName - Pushes a NulKey onto the top of the stack.
+                  The Stack:
+
+
+                  Entry                    Exit
+
+                                                          <- Ptr
+                  Empty                    +------------+
+                                           | NulKey     |
+                                           |------------|
+*)
+
+PROCEDURE BuildNulName ;
+BEGIN
+   PushT (NulName)
+END BuildNulName ;
+
+
+(*
+   BuildConst - builds a constant.
+                Stack
+
+                Entry                 Exit
+
+         Ptr ->                                      <- Ptr
+                +------------+        +------------+
+                | Name       |        | Sym        |
+                |------------+        |------------|
+*)
+
+PROCEDURE BuildConst ;
+VAR
+   name: Name ;
+   tok : CARDINAL ;
+   Sym : CARDINAL ;
+BEGIN
+   PopTtok (name, tok) ;
+   Sym := RequestSym (tok, name) ;
+   PushTtok (Sym, tok)
+END BuildConst ;
+
+
+(*
+   BuildVarAtAddress - updates the symbol table entry of, variable sym, to be declared
+                       at address, address.
+
+                       Stack
+
+                       Entry                 Exit
+
+                Ptr ->
+                       +--------------+
+                       | Expr | EType |                         <- Ptr
+                       |--------------+        +--------------+
+                       | name | SType |        | name | SType |
+                       |--------------+        |--------------|
+*)
+
+(*
+PROCEDURE BuildVarAtAddress ;
+VAR
+   name      : Name ;
+   Sym, SType,
+   Exp, EType: CARDINAL ;
+   etok, ntok: CARDINAL ;
+BEGIN
+   PopTFtok (Exp, EType, etok) ;
+   PopTFtok (name, SType, ntok) ;
+   PushTFtok (name, SType, ntok) ;
+   Sym := RequestSym (ntok, name) ;
+   IF GetMode(Sym)=LeftValue
+   THEN
+      PutVariableAtAddress(Sym, Exp)
+   ELSE
+      InternalError ('expecting lvalue for this variable which is declared at an explicit address')
+   END
+END BuildVarAtAddress ;
+*)
+
+
+(*
+   BuildOptArgInitializer - assigns the constant value symbol, const, to be the
+                            initial value of the optional parameter should it be
+                            absent.
+
+                            Ptr ->
+                                   +------------+
+                                   | const      |
+                                   |------------|                      <- Ptr
+*)
+
+(*
+PROCEDURE BuildOptArgInitializer ;
+VAR
+   const: CARDINAL ;
+BEGIN
+   PopT(const) ;
+   PutOptArgInit(GetCurrentScope(), const)
+END BuildOptArgInitializer ;
+*)
+
+
+(*
+   InitDesExpr -
+*)
+
+PROCEDURE InitDesExpr (des: CARDINAL) ;
+VAR
+   e: exprNode ;
+BEGIN
+   NEW(e) ;
+   WITH e^ DO
+      tag := designator ;
+      CASE tag OF
+
+      designator:  WITH edes DO
+                      type := NulSym ;
+                      meta := unknown ;
+                      tag := designator ;
+                      sym := des ;
+                      left := NIL
+                   END
+
+      END
+   END ;
+   PushAddress (exprStack, e)
+END InitDesExpr ;
+
+
+(*
+   DebugNode -
+*)
+
+PROCEDURE DebugNode (d: exprNode) ;
+BEGIN
+   IF Debugging AND (d#NIL)
+   THEN
+      WITH d^ DO
+         CASE tag OF
+
+         designator:  DebugDes(d) |
+         expr      :  DebugExpr(d) |
+         leaf      :  DebugLeaf(d) |
+         unary     :  DebugUnary(d) |
+         binary    :  DebugBinary(d) |
+         function  :  DebugFunction(d) |
+         convert   :  DebugConvert(d)
+
+         END
+      END
+   END
+END DebugNode ;
+
+
+(*
+   DebugDes -
+*)
+
+PROCEDURE DebugDes (d: exprNode) ;
+BEGIN
+   WITH d^ DO
+      WITH edes DO
+         DebugSym(sym) ; Write(':') ; DebugMeta(meta) ; Write(':') ; DebugType(type) ;
+         WriteString(' = ') ;
+         DebugNode(left) ;
+         WriteLn
+      END
+   END
+END DebugDes ;
+
+
+(*
+   DebugSym -
+*)
+
+PROCEDURE DebugSym (sym: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   n := GetSymName(sym) ;
+   IF n#NulName
+   THEN
+      WriteKey(n)
+   END ;
+   Write(':') ; WriteCard(sym, 0)
+END DebugSym ;
+
+
+(*
+   DebugMeta -
+*)
+
+PROCEDURE DebugMeta (m: constType) ;
+BEGIN
+   CASE m OF
+
+   unknown    :  WriteString('unknown') |
+   set        :  WriteString('set') |
+   str        :  WriteString('str') |
+   constructor:  WriteString('constructor') |
+   array      :  WriteString('array') |
+   cast       :  WriteString('cast') |
+   boolean    :  WriteString('boolean') |
+   ztype      :  WriteString('ztype') |
+   rtype      :  WriteString('rtype') |
+   ctype      :  WriteString('ctype') |
+   procedure  :  WriteString('procedure') |
+   char       :  WriteString('ctype')
+
+   END
+END DebugMeta ;
+
+
+(*
+   DebugType -
+*)
+
+PROCEDURE DebugType (type: CARDINAL) ;
+VAR
+   n: Name ;
+BEGIN
+   WriteString('[type:') ;
+   IF type=NulSym
+   THEN
+      WriteString('<nulsym>')
+   ELSE
+      n := GetSymName(type) ;
+      IF n#NulSym
+      THEN
+         WriteKey(n)
+      END ;
+      Write(':') ; WriteCard(type, 0)
+   END ;
+   Write(']')
+END DebugType ;
+
+
+(*
+   DebugExpr -
+*)
+
+PROCEDURE DebugExpr (e: exprNode) ;
+BEGIN
+   WITH e^.eexpr DO
+      WriteString('expr (') ;
+      DebugType(type) ; Write(':') ;
+      DebugMeta(meta) ; Write(' ') ;
+      DebugNode(left) ;
+      WriteString(') ')
+   END
+END DebugExpr ;
+
+
+(*
+   DebugFunction -
+*)
+
+PROCEDURE DebugFunction (f: exprNode) ;
+BEGIN
+   WITH f^.efunction DO
+      WriteKey(GetSymName(func)) ;
+      Write('(') ;
+      IF first#NIL
+      THEN
+         DebugNode(first) ;
+         IF second#NIL
+         THEN
+            WriteString(', ') ;
+            DebugNode(second) ;
+            IF third
+            THEN
+               WriteString(', ...')
+            END
+         END
+      END ;
+      Write(')')
+   END
+END DebugFunction ;
+
+
+(*
+   DebugConvert -
+*)
+
+PROCEDURE DebugConvert (f: exprNode) ;
+BEGIN
+   WITH f^.econvert DO
+      DebugNode(totype) ;
+      Write('(') ;
+      DebugNode(expr) ;
+      Write(')')
+   END
+END DebugConvert ;
+
+
+(*
+   DebugLeaf -
+*)
+
+PROCEDURE DebugLeaf (l: exprNode) ;
+BEGIN
+   WITH l^.eleaf DO
+      WriteString('leaf (') ;
+      DebugType(type) ; Write(':') ;
+      DebugMeta(meta) ; Write(':') ;
+      DebugSym(sym) ;
+      WriteString(') ')
+   END
+END DebugLeaf ;
+
+
+(*
+   DebugUnary -
+*)
+
+PROCEDURE DebugUnary (l: exprNode) ;
+BEGIN
+   WITH l^.eunary DO
+      WriteString('unary (') ;
+      DebugType(type) ; Write(':') ;
+      DebugMeta(meta) ; Write(' ') ;
+      DebugOp(op) ; Write(' ') ;
+      DebugNode(left) ;
+      WriteString(') ')
+   END
+END DebugUnary ;
+
+
+(*
+   DebugBinary -
+*)
+
+PROCEDURE DebugBinary (l: exprNode) ;
+BEGIN
+   WITH l^.ebinary DO
+      WriteString('unary (') ;
+      DebugType(type) ; Write(':') ;
+      DebugMeta(meta) ; Write(' ') ;
+      DebugNode(left) ;
+      DebugOp(op) ; Write(' ') ;
+      DebugNode(right) ;
+      WriteString(') ')
+   END
+END DebugBinary ;
+
+
+(*
+   DebugOp -
+*)
+
+PROCEDURE DebugOp (op: Name) ;
+BEGIN
+   WriteKey(op)
+END DebugOp ;
+
+
+(*
+   PushInConstructor -
+*)
+
+PROCEDURE PushInConstructor ;
+BEGIN
+   PushWord(desStack, inDesignator) ;
+   inDesignator := FALSE
+END PushInConstructor ;
+
+
+(*
+   PopInConstructor -
+*)
+
+PROCEDURE PopInConstructor ;
+BEGIN
+   inDesignator := PopWord(desStack)
+END PopInConstructor ;
+
+
+(*
+   StartDesConst -
+*)
+
+PROCEDURE StartDesConst ;
+VAR
+   name: Name ;
+   tok : CARDINAL ;
+BEGIN
+   inDesignator := TRUE ;
+   exprStack := KillStackAddress (exprStack) ;
+   exprStack := InitStackAddress () ;
+   PopTtok (name, tok) ;
+   InitDesExpr (RequestSym (tok, name))
+END StartDesConst ;
+
+
+(*
+   EndDesConst -
+*)
+
+PROCEDURE EndDesConst ;
+VAR
+   d, e: exprNode ;
+BEGIN
+   e := PopAddress (exprStack) ;
+   d := PopAddress (exprStack) ;
+   Assert(d^.tag=designator) ;
+   d^.edes.left := e ;
+   IncludeIndiceIntoIndex(constList, d) ;
+   inDesignator := FALSE
+END EndDesConst ;
+
+
+(*
+   fixupProcedureType - creates a proctype from a procedure.
+*)
+
+PROCEDURE fixupProcedureType (p: CARDINAL) : CARDINAL ;
+VAR
+   tok : CARDINAL ;
+   par,
+   t   : CARDINAL ;
+   n, i: CARDINAL ;
+BEGIN
+   IF IsProcedure(p)
+   THEN
+      tok := GetTokenNo () ;
+      t := MakeProcType (tok, CheckAnonymous (NulName)) ;
+      i := 1 ;
+      n := NoOfParam(p) ;
+      WHILE i<=n DO
+         par := GetParam (p, i) ;
+         IF IsParameterVar (par)
+         THEN
+            PutProcTypeVarParam (t, GetType (par), IsParameterUnbounded (par))
+         ELSE
+            PutProcTypeParam (t, GetType (par), IsParameterUnbounded (par))
+         END ;
+         INC(i)
+      END ;
+      IF GetType (p) # NulSym
+      THEN
+         PutFunction (t, GetType (p))
+      END ;
+      RETURN( t )
+   ELSE
+      InternalError ('expecting a procedure')
+   END ;
+   RETURN( NulSym )
+END fixupProcedureType ;
+
+
+(*
+   InitFunction -
+*)
+
+PROCEDURE InitFunction (m: constType; p, t: CARDINAL; f, s: exprNode; more: BOOLEAN) ;
+VAR
+   n: exprNode ;
+BEGIN
+   NEW(n) ;
+   WITH n^ DO
+      tag := function ;
+      CASE tag OF
+
+      function:  WITH efunction DO
+                    meta := m ;
+                    type := t ;
+                    func := p ;
+                    first := f ;
+                    second := s ;
+                    third := more
+                 END
+
+      END
+   END ;
+   PushAddress(exprStack, n)
+END InitFunction ;
+
+
+(*
+   InitConvert -
+*)
+
+PROCEDURE InitConvert (m: constType; t: CARDINAL; to, e: exprNode) ;
+VAR
+   n: exprNode ;
+BEGIN
+   NEW(n) ;
+   WITH n^ DO
+      tag := convert ;
+      CASE tag OF
+
+      convert:  WITH econvert DO
+                   type := t ;
+                   meta := m ;
+                   totype := to ;
+                   expr := e
+                 END
+
+      END
+   END ;
+   PushAddress(exprStack, n)
+END InitConvert ;
+
+
+(*
+   InitLeaf -
+*)
+
+PROCEDURE InitLeaf (m: constType; s, t: CARDINAL) ;
+VAR
+   l: exprNode ;
+BEGIN
+   NEW(l) ;
+   WITH l^ DO
+      tag := leaf ;
+      CASE tag OF
+
+      leaf:  WITH eleaf DO
+                type := t ;
+                meta := m ;
+                sym := s
+             END
+
+      END
+   END ;
+   PushAddress(exprStack, l)
+END InitLeaf ;
+
+
+(*
+   InitProcedure -
+*)
+
+PROCEDURE InitProcedure (s: CARDINAL) ;
+BEGIN
+   InitLeaf(procedure, s, fixupProcedureType(s))
+END InitProcedure ;
+
+
+(*
+   InitCharType -
+*)
+
+PROCEDURE InitCharType (s: CARDINAL) ;
+BEGIN
+   InitLeaf(char, s, Char)
+END InitCharType ;
+
+
+(*
+   InitZType -
+*)
+
+PROCEDURE InitZType (s: CARDINAL) ;
+BEGIN
+   InitLeaf(ztype, s, ZType)
+END InitZType ;
+
+
+(*
+   InitRType -
+*)
+
+PROCEDURE InitRType (s: CARDINAL) ;
+BEGIN
+   InitLeaf(rtype, s, RType)
+END InitRType ;
+
+
+(*
+   InitUnknown -
+*)
+
+PROCEDURE InitUnknown (s: CARDINAL) ;
+BEGIN
+   InitLeaf(unknown, s, NulSym)
+END InitUnknown ;
+
+
+(*
+   InitBooleanType -
+*)
+
+PROCEDURE InitBooleanType (s: CARDINAL) ;
+BEGIN
+   InitLeaf(boolean, s, Boolean)
+END InitBooleanType ;
+
+
+(*
+   PushConstType - pushes a constant to the expression stack.
+*)
+
+PROCEDURE PushConstType ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   PopT(c) ;
+   PushT(c) ;
+   IF inDesignator
+   THEN
+      IF c=NulSym
+      THEN
+         WriteFormat0('module or symbol in qualident is not known') ;
+         FlushErrors ;
+         InitUnknown(c)
+      ELSIF IsProcedure(c)
+      THEN
+         InitProcedure(c)
+      ELSIF GetSkippedType(c)=RType
+      THEN
+         InitRType(c)
+      ELSIF GetSkippedType(c)=ZType
+      THEN
+         InitZType(c)
+      ELSIF GetSkippedType(c)=Boolean
+      THEN
+         InitBooleanType(c)
+      ELSE
+         InitUnknown(c)
+      END
+   END
+END PushConstType ;
+
+
+(*
+   PushConstructorCastType -
+*)
+
+PROCEDURE PushConstructorCastType ;
+BEGIN
+   IF inDesignator
+   THEN
+      InitConvert (cast, OperandT (1), NIL, NIL)
+   END
+END PushConstructorCastType ;
+
+
+(*
+   TypeToMeta -
+*)
+
+PROCEDURE TypeToMeta (type: CARDINAL) : constType ;
+BEGIN
+   IF type=Char
+   THEN
+      RETURN( char )
+   ELSIF type=Boolean
+   THEN
+      RETURN( boolean )
+   ELSIF IsRealType(type)
+   THEN
+      RETURN( rtype )
+   ELSIF IsComplexType(type)
+   THEN
+      RETURN( ctype )
+   ELSIF IsOrdinalType(type)
+   THEN
+      RETURN( ztype )
+   ELSE
+      RETURN( unknown )
+   END
+END TypeToMeta ;
+
+
+(*
+   buildConstFunction - we are only concerned about resolving the return type o
+                        a function, so we can ignore all parameters - except
+                        the first one in the case of VAL(type, foo).
+                        buildConstFunction uses a unary exprNode to represent
+                        a function.
+*)
+
+PROCEDURE buildConstFunction (func: CARDINAL; n: CARDINAL) ;
+VAR
+   i   : CARDINAL ;
+   f, s: exprNode ;
+BEGIN
+   f := NIL ;
+   s := NIL ;
+   IF n=1
+   THEN
+      f := PopAddress(exprStack)
+   ELSIF n>=2
+   THEN
+      i := n ;
+      WHILE i>2 DO
+         s := PopAddress(exprStack) ;
+         DISPOSE(s) ;
+         DEC(i)
+      END ;
+      s := PopAddress(exprStack) ;
+      f := PopAddress(exprStack)
+   END ;
+   IF func=Val
+   THEN
+      InitConvert(cast, NulSym, f, s)
+   ELSIF (func=Max) OR (func=Min)
+   THEN
+      InitFunction(unknown, func, NulSym, f, s, FALSE)
+   ELSE
+      InitFunction(TypeToMeta(GetSkippedType(func)), func, GetSkippedType(func), f, s, n>2)
+   END
+END buildConstFunction ;
+
+
+(*
+   PushConstFunctionType -
+*)
+
+PROCEDURE PushConstFunctionType ;
+VAR
+   functok,
+   func   : CARDINAL ;
+   n      : CARDINAL ;
+BEGIN
+   PopT (n) ;
+   PopTtok (func, functok) ;
+   IF inDesignator
+   THEN
+      IF (func#Convert) AND
+         (IsPseudoBaseFunction(func) OR
+          IsPseudoSystemFunctionConstExpression(func) OR
+          (IsProcedure(func) AND IsProcedureBuiltin(func)))
+      THEN
+         buildConstFunction (func, n)
+      ELSIF IsAModula2Type(func)
+      THEN
+         IF n=1
+         THEN
+            (* the top element on the expression stack is the first and only parameter to the cast *)
+            InitUnary(cast, func, GetSymName(func))
+         ELSE
+            WriteFormat0('a constant type conversion can only have one argument')
+         END
+      ELSE
+         IF Iso
+         THEN
+            MetaErrorT1 (functok,
+                         'the only functions permissible in a constant expression are: CAP, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins, but not {%1Ead}',
+                        func)
+         ELSE
+            MetaErrorT1 (functok,
+                         'the only functions permissible in a constant expression are: CAP, CHR, FLOAT, HIGH, MAX, MIN, ODD, ORD, SIZE, TSIZE, TRUNC, VAL and gcc builtins, but not {%1Ead}',
+                        func)
+         END
+      END
+   END ;
+   PushTtok (func, functok)
+END PushConstFunctionType ;
+
+
+(*
+   PushIntegerType -
+*)
+
+PROCEDURE PushIntegerType ;
+VAR
+   sym: CARDINAL ;
+   m  : constType ;
+BEGIN
+   PopT(sym) ;
+   IF inDesignator
+   THEN
+      m := TypeToMeta(GetSkippedType(sym)) ;
+      IF m=char
+      THEN
+         InitCharType(sym)
+      ELSE
+         InitZType(sym)
+      END
+   END
+END PushIntegerType ;
+
+
+(*
+   PushRType -
+*)
+
+PROCEDURE PushRType ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   PopT(sym) ;
+   IF inDesignator
+   THEN
+      InitRType(sym)
+   END
+END PushRType ;
+
+
+(*
+   PushStringType -
+*)
+
+PROCEDURE PushStringType ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   PopT(sym) ;
+   IF inDesignator
+   THEN
+      InitLeaf(str, sym, NulSym)
+   END
+END PushStringType ;
+
+
+(*
+   InitBinary -
+*)
+
+PROCEDURE InitBinary (m: constType; t: CARDINAL; o: Name) ;
+VAR
+   l, r, b: exprNode ;
+BEGIN
+   r := PopAddress(exprStack) ;
+   l := PopAddress(exprStack) ;
+   NEW(b) ;
+   WITH b^ DO
+      tag := binary ;
+      CASE tag OF
+
+      binary:  WITH ebinary DO
+                  meta := m ;
+                  type := t ;
+                  left := l ;
+                  right := r ;
+                  op := o
+               END
+      END
+   END ;
+   PushAddress(exprStack, b)
+END InitBinary ;
+
+
+(*
+   BuildRelationConst - builds a relationship binary operation.
+*)
+
+PROCEDURE BuildRelationConst ;
+VAR
+   op: Name ;
+BEGIN
+   PopT(op) ;
+   IF inDesignator
+   THEN
+      InitBinary(boolean, Boolean, op)
+   END
+END BuildRelationConst ;
+
+
+(*
+   BuildBinaryConst - builds a binary operator node.
+*)
+
+PROCEDURE BuildBinaryConst ;
+VAR
+   op: Name ;
+BEGIN
+   PopT(op) ;
+   IF inDesignator
+   THEN
+      InitBinary(unknown, NulSym, op)
+   END
+END BuildBinaryConst ;
+
+
+(*
+   InitUnary -
+*)
+
+PROCEDURE InitUnary (m: constType; t: CARDINAL; o: Name) ;
+VAR
+   l, b: exprNode ;
+BEGIN
+   l := PopAddress(exprStack) ;
+   NEW(b) ;
+   WITH b^ DO
+      tag := unary ;
+      CASE tag OF
+
+      unary:  WITH eunary DO
+                 meta := m ;
+                 type := t ;
+                 left := l ;
+                 op := o
+              END
+
+      END
+   END ;
+   PushAddress(exprStack, b)
+END InitUnary ;
+
+
+(*
+   BuildUnaryConst - builds a unary operator node.
+*)
+
+PROCEDURE BuildUnaryConst ;
+VAR
+   op: Name ;
+BEGIN
+   PopT(op) ;
+   IF inDesignator
+   THEN
+      InitUnary(unknown, NulSym, op)
+   END
+END BuildUnaryConst ;
+
+
+(*
+   isTypeResolved -
+*)
+
+PROCEDURE isTypeResolved (e: exprNode) : BOOLEAN ;
+BEGIN
+   WITH e^ DO
+      CASE tag OF
+
+      leaf      :  RETURN( (eleaf.type#NulSym) OR (eleaf.meta=str) ) |
+      unary     :  RETURN( (eunary.type#NulSym) OR (eunary.meta=str) ) |
+      binary    :  RETURN( (ebinary.type#NulSym) OR (ebinary.meta=str) ) |
+      designator:  RETURN( (edes.type#NulSym) OR (edes.meta=str) ) |
+      expr      :  RETURN( (eexpr.type#NulSym) OR (eexpr.meta=str) ) |
+      convert   :  RETURN( (econvert.type#NulSym) OR (econvert.meta=str) ) |
+      function  :  RETURN( (efunction.type#NulSym) OR (efunction.meta=str) )
+
+      END
+   END
+END isTypeResolved ;
+
+
+(*
+   getEtype -
+*)
+
+PROCEDURE getEtype (e: exprNode) : CARDINAL ;
+BEGIN
+   WITH e^ DO
+      CASE tag OF
+
+      leaf      :  RETURN( eleaf.type ) |
+      unary     :  RETURN( eunary.type ) |
+      binary    :  RETURN( ebinary.type ) |
+      designator:  RETURN( edes.type ) |
+      expr      :  RETURN( eexpr.type ) |
+      convert   :  RETURN( econvert.type ) |
+      function  :  RETURN( efunction.type )
+
+      END
+   END
+END getEtype ;
+
+
+(*
+   getEmeta -
+*)
+
+PROCEDURE getEmeta (e: exprNode) : constType ;
+BEGIN
+   WITH e^ DO
+      CASE tag OF
+
+      leaf      :  RETURN( eleaf.meta ) |
+      unary     :  RETURN( eunary.meta ) |
+      binary    :  RETURN( ebinary.meta ) |
+      designator:  RETURN( edes.meta ) |
+      expr      :  RETURN( eexpr.meta ) |
+      convert   :  RETURN( econvert.meta ) |
+      function  :  RETURN( efunction.meta )
+
+      END
+   END
+END getEmeta ;
+
+
+(*
+   assignTM -
+*)
+
+PROCEDURE assignTM (VAR td: CARDINAL; VAR md: constType; te: CARDINAL; me: constType) ;
+BEGIN
+   md := me ;
+   td := te
+END assignTM ;
+
+
+(*
+   assignType -
+*)
+
+PROCEDURE assignType (d, e: exprNode) ;
+VAR
+   t: CARDINAL ;
+   m: constType ;
+BEGIN
+   m := getEmeta(e) ;
+   t := getEtype(e) ;
+   WITH d^ DO
+      CASE tag OF
+
+      leaf      :  assignTM(eleaf.type, eleaf.meta, t, m) |
+      unary     :  assignTM(eunary.type, eunary.meta, t, m) |
+      binary    :  assignTM(ebinary.type, ebinary.meta, t, m) |
+      designator:  assignTM(edes.type, edes.meta, t, m) |
+      expr      :  assignTM(eexpr.type, eexpr.meta, t, m) |
+      convert   :  assignTM(econvert.type, econvert.meta, t, m) |
+      function  :  assignTM(efunction.type, efunction.meta, t, m)
+
+      END
+   END
+END assignType ;
+
+
+(*
+   deduceTypes - works out the type and metatype given, l, and, r.
+*)
+
+PROCEDURE deduceTypes (VAR t: CARDINAL;
+                       VAR m: constType;
+                       l, r: exprNode; op: Name) ;
+BEGIN
+   IF r=NIL
+   THEN
+      (* function or cast *)
+      t := getEtype(l) ;
+      m := getEmeta(l)
+   ELSIF (op=EqualTok) OR (op=HashTok) OR (op=LessGreaterTok) OR
+      (op=LessTok) OR (op=LessEqualTok) OR (op=GreaterTok) OR
+      (op=GreaterEqualTok) OR (op=InTok) OR (op=OrTok) OR
+      (op=AndTok) OR (op=NotTok) OR (op=AmbersandTok)
+   THEN
+      t := Boolean ;
+      m := boolean
+   ELSIF (op=PlusTok) OR (op=MinusTok) OR (op=TimesTok) OR (op=ModTok) OR
+         (op=DivTok) OR (op=RemTok) OR (op=DivideTok)
+   THEN
+      t := MixTypes(getEtype(l), getEtype(r), constToken) ;
+      m := getEmeta(l) ;
+      IF m=unknown
+      THEN
+         m := getEmeta(r)
+      ELSIF (getEmeta(r)#unknown) AND (m#getEmeta(r))
+      THEN
+         ErrorFormat0(NewError(constToken),
+                      'the operands to a binary constant expression have different types')
+      END
+   ELSE
+      InternalError ('unexpected operator')
+   END
+END deduceTypes ;
+
+
+(*
+   WalkConvert -
+*)
+
+PROCEDURE WalkConvert (e: exprNode) : BOOLEAN ;
+BEGIN
+   IF isTypeResolved(e)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      WITH e^.econvert DO
+         IF isTypeResolved(totype)
+         THEN
+            assignType(e, totype) ;
+            RETURN( TRUE )
+         END ;
+         RETURN( doWalkNode(totype) )
+      END
+   END
+END WalkConvert ;
+
+
+(*
+   WalkFunctionParam -
+*)
+
+PROCEDURE WalkFunctionParam (func: CARDINAL; e: exprNode) : BOOLEAN ;
+BEGIN
+   IF isTypeResolved(e)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      IF e^.tag=leaf
+      THEN
+         WITH e^.eleaf DO
+            IF (sym#NulSym) AND (type=NulSym)
+            THEN
+               IF (func=Min) OR (func=Max)
+               THEN
+                  IF IsEnumeration(sym) OR IsSet(sym)
+                  THEN
+                     type := SkipType(GetType(sym))
+                  ELSE
+                     (* sym is the type required for MAX, MIN and VAL *)
+                     type := sym
+                  END
+               ELSE
+                  Assert(func=Val) ;
+                  type := sym
+               END ;
+               meta := TypeToMeta(sym) ;
+               RETURN( TRUE )
+            END
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END WalkFunctionParam ;
+
+
+(*
+   WalkFunction -
+*)
+
+PROCEDURE WalkFunction (e: exprNode) : BOOLEAN ;
+BEGIN
+   IF isTypeResolved(e)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      WITH e^.efunction DO
+         IF (func=Max) OR (func=Min) OR (func=Val)
+         THEN
+            IF isTypeResolved(first)
+            THEN
+               IF getEmeta(first)=str
+               THEN
+                  MetaError1('a string parameter cannot be passed to function {%1Dad}', func) ;
+                  RETURN( FALSE )
+               END ;
+               type := getEtype(first) ;
+               RETURN( TRUE )
+            END ;
+            RETURN( WalkFunctionParam(func, first) )
+         ELSE
+            MetaError1('not expecting this function inside a constant expression {%1Dad}', func)
+         END
+      END
+   END
+END WalkFunction ;
+
+
+(*
+   doWalkNode -
+*)
+
+PROCEDURE doWalkNode (e: exprNode) : BOOLEAN ;
+BEGIN
+   WITH e^ DO
+      CASE tag OF
+
+      expr    :  RETURN( WalkExpr(e) ) |
+      leaf    :  RETURN( WalkLeaf(e) ) |
+      unary   :  RETURN( WalkUnary(e) ) |
+      binary  :  RETURN( WalkBinary(e) ) |
+      convert :  RETURN( WalkConvert(e) ) |
+      function:  RETURN( WalkFunction(e) )
+
+      ELSE
+         InternalError ('unexpected tag value')
+      END
+   END ;
+   RETURN( FALSE )
+END doWalkNode ;
+
+
+(*
+   WalkLeaf -
+*)
+
+PROCEDURE WalkLeaf (e: exprNode) : BOOLEAN ;
+VAR
+   c: exprNode ;
+BEGIN
+   IF isTypeResolved(e)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      WITH e^.eleaf DO
+         IF IsConst(sym) AND (GetType(sym)#NulSym)
+         THEN
+            type := GetSkippedType(sym) ;
+            RETURN( TRUE )
+         END ;
+         IF IsAModula2Type(sym)
+         THEN
+            type := sym ;
+            RETURN( TRUE )
+         END ;
+         c := findConstDes(sym) ;
+         IF (c#NIL) AND isTypeResolved(c)
+         THEN
+            assignType(e, c) ;
+            RETURN( TRUE )
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END WalkLeaf ;
+
+
+(*
+   WalkUnary -
+*)
+
+PROCEDURE WalkUnary (e: exprNode) : BOOLEAN ;
+BEGIN
+   IF isTypeResolved(e)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      WITH e^.eunary DO
+         IF isTypeResolved(left)
+         THEN
+            deduceTypes(type, meta, left, left, op) ;
+            RETURN( TRUE )
+         END ;
+         RETURN( doWalkNode(left) )
+      END
+   END
+END WalkUnary ;
+
+
+(*
+   WalkBinary -
+*)
+
+PROCEDURE WalkBinary (e: exprNode) : BOOLEAN ;
+VAR
+   changed: BOOLEAN ;
+BEGIN
+   IF isTypeResolved(e)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      WITH e^.ebinary DO
+         IF isTypeResolved(left) AND isTypeResolved(right)
+         THEN
+            deduceTypes(type, meta, left, right, op) ;
+            RETURN( TRUE )
+         END ;
+         changed := doWalkNode(left) ;
+         RETURN( doWalkNode(right) OR changed )
+      END
+   END
+END WalkBinary ;
+
+
+(*
+   WalkExpr -
+*)
+
+PROCEDURE WalkExpr (e: exprNode) : BOOLEAN ;
+BEGIN
+   IF isTypeResolved(e)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      WITH e^.eexpr DO
+         IF isTypeResolved(left)
+         THEN
+            assignType(e, left) ;
+            RETURN( TRUE )
+         END ;
+         RETURN( doWalkNode(left) )
+      END
+   END
+END WalkExpr ;
+
+
+(*
+   doWalkDesExpr - returns TRUE if the expression trees, d, or, e, are changed.
+*)
+
+PROCEDURE doWalkDesExpr (d, e: exprNode) : BOOLEAN ;
+BEGIN
+   IF isTypeResolved(e)
+   THEN
+      WITH d^.edes DO
+         type := getEtype(e) ;
+         IF type=NulSym
+         THEN
+            meta := getEmeta(e) ;
+            IF meta=str
+            THEN
+               (* PutConstString(sym, getString(e)) *)
+            END
+         ELSE
+            PutConst(sym, type)
+         END ;
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( doWalkNode(e) )
+END doWalkDesExpr ;
+
+
+(*
+   doWalkDes - return TRUE if expression, e, is changed.
+*)
+
+PROCEDURE doWalkDes (d: exprNode) : BOOLEAN ;
+BEGIN
+   IF isTypeResolved(d)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      WITH d^ DO
+         CASE tag OF
+
+         designator:  WITH edes DO
+                         constToken := GetDeclaredMod(sym) ;
+                         RETURN( doWalkDesExpr(d, left) )
+                      END
+
+         ELSE
+            InternalError ('unexpected tag value')
+         END
+      END
+   END
+END doWalkDes ;
+
+
+(*
+   findConstDes -
+*)
+
+PROCEDURE findConstDes (sym: CARDINAL) : exprNode ;
+VAR
+   i: CARDINAL ;
+   e: exprNode ;
+BEGIN
+   i := 1 ;
+   WHILE i<=HighIndice(constList) DO
+      e := GetIndice(constList, i) ;
+      WITH e^ DO
+         CASE tag OF
+
+         designator:  IF edes.sym=sym
+                      THEN
+                         RETURN( e )
+                      END
+
+         ELSE
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( NIL )
+END findConstDes ;
+
+
+(*
+   WalkDes - return TRUE if expression, e, is changed.
+*)
+
+PROCEDURE WalkDes (d: exprNode) : BOOLEAN ;
+BEGIN
+   IF d=NIL
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( doWalkDes(d) )
+   END
+END WalkDes ;
+
+
+(*
+   WalkConst - returns TRUE if the constant tree associated with, sym,
+               is changed.
+*)
+
+(*
+PROCEDURE WalkConst (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( WalkDes(findConstDes(sym)) )
+END WalkConst ;
+*)
+
+
+(*
+   WalkConsts - walk over the constant trees and return TRUE if any tree was changed.
+                (As a result of a type resolution).
+*)
+
+PROCEDURE WalkConsts () : BOOLEAN ;
+VAR
+   changed: BOOLEAN ;
+   i      : CARDINAL ;
+BEGIN
+   changed := FALSE ;
+   i := 1 ;
+   WHILE i<=HighIndice(constList) DO
+      IF WalkDes(GetIndice(constList, i))
+      THEN
+         changed := TRUE
+      END ;
+      INC(i)
+   END ;
+   RETURN( changed )
+END WalkConsts ;
+
+
+(*
+   DebugNodes -
+*)
+
+PROCEDURE DebugNodes ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=HighIndice(constList) DO
+      IF isTypeResolved(GetIndice(constList, i))
+      THEN
+         WriteString('resolved ')
+      ELSE
+         WriteString('unresolved ')
+      END ;
+      DebugNode(GetIndice(constList, i)) ; WriteLn ;
+      INC(i)
+   END
+END DebugNodes ;
+
+
+(*
+   findAlias -
+*)
+
+PROCEDURE findAlias (sym: CARDINAL; e: exprNode) : CARDINAL ;
+BEGIN
+   CASE e^.tag OF
+
+   designator:  RETURN( findAlias(sym, e^.edes.left) ) |
+   leaf      :  RETURN( e^.eleaf.sym ) |
+   expr      :  RETURN( findAlias(sym, e^.eexpr.left) ) |
+   unary,
+   binary    :  RETURN( sym )
+
+   ELSE
+      InternalError ('not expecting this tag value')
+   END
+END findAlias ;
+
+
+(*
+   SkipConst - returns an alias to constant, sym, if one exists.
+               Otherwise sym is returned.
+*)
+
+PROCEDURE SkipConst (sym: CARDINAL) : CARDINAL ;
+VAR
+   i: CARDINAL ;
+   e: exprNode ;
+BEGIN
+   i := 1 ;
+   WHILE i<=HighIndice(constList) DO
+      e := GetIndice(constList, i) ;
+      IF (e^.tag=designator) AND (e^.edes.sym=sym)
+      THEN
+         RETURN( findAlias(sym, e) )
+      END ;
+      INC(i)
+   END ;
+   RETURN( sym )
+END SkipConst ;
+
+
+(*
+   PushConstAttributeType -
+*)
+
+PROCEDURE PushConstAttributeType ;
+VAR
+   n: Name ;
+BEGIN
+   PopT(n) ;
+   PushT(n) ;
+   InitZType(NulSym) ;
+   IF (n=MakeKey('BITS_PER_UNIT')) OR (n=MakeKey('BITS_PER_WORD')) OR
+      (n=MakeKey('BITS_PER_CHAR')) OR (n=MakeKey('UNITS_PER_WORD'))
+   THEN
+      (* all ok *)
+   ELSE
+      WriteFormat1("unknown constant attribute value '%a'", n)
+   END
+END PushConstAttributeType ;
+
+
+(*
+   PushConstAttributePairType -
+*)
+
+PROCEDURE PushConstAttributePairType ;
+VAR
+   q, n: Name ;
+BEGIN
+   PopT(n) ;
+   PopT(q) ;
+   PushT(q) ;
+   PushT(n) ;
+   IF (n=MakeKey('IEC559')) OR (n=MakeKey('LIA1')) OR (n=MakeKey('IEEE')) OR
+      (n=MakeKey('ISO')) OR (n=MakeKey('rounds')) OR (n=MakeKey('gUnderflow')) OR
+      (n=MakeKey('exception')) OR (n=MakeKey('extend'))
+   THEN
+      InitBooleanType(NulSym)
+   ELSIF (n=MakeKey('radix')) OR (n=MakeKey('places')) OR (n=MakeKey('expoMin')) OR
+         (n=MakeKey('expoMax')) OR (n=MakeKey('nModes'))
+   THEN
+      InitZType(NulSym)
+   ELSIF (n=MakeKey('large')) OR (n=MakeKey('small'))
+   THEN
+      InitRType(NulSym)
+   ELSE
+      WriteFormat1("unknown constant attribute value '%a'", n) ;
+      InitUnknown(NulSym)
+   END
+END PushConstAttributePairType ;
+
+
+(*
+   CheckConsts -
+*)
+
+PROCEDURE CheckConsts ;
+VAR
+   i: CARDINAL ;
+   e: exprNode ;
+BEGIN
+   i := 1 ;
+   WHILE i<=HighIndice(constList) DO
+      e := GetIndice(constList, i) ;
+      IF NOT isTypeResolved(e)
+      THEN
+         WITH e^ DO
+            CASE tag OF
+
+            designator:  MetaError1('the type of the constant declaration {%1Dad} cannot be determined', edes.sym)
+
+            ELSE
+            END
+         END
+      END ;
+      INC(i)
+   END
+END CheckConsts ;
+
+
+(*
+   ResolveConstTypes - resolves the types of all designator declared constants.
+*)
+
+PROCEDURE ResolveConstTypes ;
+BEGIN
+   IF Debugging
+   THEN
+      WriteString('initially') ; WriteLn ;
+      DebugNodes
+   END ;
+   WHILE WalkConsts() DO
+      IF Debugging
+      THEN
+         WriteString('iteration') ; WriteLn ;
+         DebugNodes
+      END
+   END ;
+   IF Debugging
+   THEN
+      WriteString('finally') ; WriteLn ;
+      DebugNodes
+   END ;
+   CheckConsts
+END ResolveConstTypes ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   exprStack := InitStackAddress () ;
+   constList := InitIndex (1) ;
+   desStack := InitStackWord () ;
+   inDesignator := FALSE
+END Init ;
+
+
+BEGIN
+   Init
+END PCSymBuild.
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
new file mode 100644
index 00000000000..7cb97421956
--- /dev/null
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -0,0 +1,1264 @@
+--
+-- m2-h.bnf grammar and associated actions for pass h.
+--
+-- Copyright (C) 2001-2022 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/>.
+% module PHBuild begin
+(* output from m2-h.bnf, automatically generated do not edit if these
+   are the top two lines in the file.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE PHBuild ;
+
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ;
+FROM M2Error IMPORT ErrorStringAt ;
+FROM NameKey IMPORT NulName, Name, makekey ;
+FROM M2Reserved IMPORT NulTok, ByTok, PeriodPeriodTok, tokToTok, toktype ;
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
+FROM M2Printf IMPORT printf0 ;
+FROM M2Debug IMPORT Assert ;
+FROM P2SymBuild IMPORT BuildString, BuildNumber ;
+
+FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, PushTFtok, PopTFtok, PopTtok,
+                    StartBuildDefFile, StartBuildModFile,
+                    BuildModuleStart,
+                    EndBuildFile,
+                    StartBuildInit,
+                    EndBuildInit,
+                    BuildProcedureStart,
+                    BuildProcedureEnd,
+                    BuildAssignment, BuildAssignConstant,
+                    BuildFunctionCall, BuildConstFunctionCall,
+                    BuildBinaryOp, BuildUnaryOp, BuildRelOp, BuildNot,
+      	       	    BuildEmptySet, BuildInclRange, BuildInclBit,
+                    BuildSetStart, BuildSetEnd,
+                    BuildSizeCheckStart,
+                    BuildRepeat, BuildUntil,
+                    BuildWhile, BuildDoWhile, BuildEndWhile,
+                    BuildLoop, BuildExit, BuildEndLoop,
+                    BuildThenIf, BuildElse, BuildEndIf,
+                    BuildForToByDo, BuildPseudoBy, BuildEndFor,
+                    BuildElsif1, BuildElsif2,
+                    BuildProcedureCall, BuildReturn, BuildNulExpression,
+                    StartBuildWith, EndBuildWith,
+                    BuildInline,
+                    BuildCaseStart,
+                    BuildCaseOr,
+                    BuildCaseElse,
+                    BuildCaseEnd,
+                    BuildCaseStartStatementSequence,
+                    BuildCaseEndStatementSequence,
+                    BuildCaseList,
+                    BuildCaseRange, BuildCaseEquality,
+                    BuildConstructorStart,
+                    BuildConstructorEnd,
+                    SilentBuildConstructorStart,
+                    BuildComponentValue, BuildTypeForConstructor,
+                    BuildBooleanVariable, BuildAlignment,
+                    RecordOp,
+                    BuildNulParam,
+                    BuildDesignatorRecord,
+                    BuildDesignatorArray,
+                    BuildDesignatorPointer,
+                    BeginVarient, EndVarient, ElseVarient,
+                    BeginVarientList, EndVarientList,
+                    AddVarientRange, AddVarientEquality,
+                    CheckWithReference,
+                    IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto ;
+
+FROM P3SymBuild IMPORT P3StartBuildProgModule,
+                       P3EndBuildProgModule,
+
+                       P3StartBuildDefModule,
+                       P3EndBuildDefModule,
+
+                       P3StartBuildImpModule,
+                       P3EndBuildImpModule,
+
+                       StartBuildInnerModule,
+                       EndBuildInnerModule,
+
+                       StartBuildProcedure,
+                       BuildProcedureHeading,
+                       EndBuildProcedure,
+                       BuildConst,
+                       BuildSubrange,
+                       BuildNulName ;
+
+FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
+                        PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
+                        MakeRegInterface,
+                        PutRegInterface, GetRegInterface,
+                        GetSymName, GetType,
+                        NulSym,
+                        StartScope, EndScope,
+                        PutIncluded,
+                        IsVarParam, IsProcedure, IsDefImp, IsModule,
+                        IsRecord,
+                        RequestSym,
+                        GetSym, GetLocalSym ;
+
+FROM M2Batch IMPORT IsModuleKnown ;
+
+FROM M2CaseList IMPORT BeginCaseList, EndCaseList, ElseCase ;
+
+FROM M2Reserved IMPORT NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
+                       EqualTok, HashTok, LessGreaterTok, LessTok, LessEqualTok,
+                       GreaterTok, GreaterEqualTok, InTok, PlusTok, MinusTok,
+                       OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok, AndTok, AmbersandTok ;
+
+IMPORT M2Error ;
+
+
+CONST
+   Debugging = FALSE ;
+   Pass1     = FALSE ;          (* permanently disabled for the time being *)
+   Pass2     = FALSE ;          (* permanently disabled for the time being *)
+   Pass3     = FALSE ;
+
+VAR
+   WasNoError: BOOLEAN ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   ErrorStringAt(s, GetTokenNo()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString(InitString(a))
+END ErrorArray ;
+
+
+% declaration PHBuild begin
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   WHILE NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      GetToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* --fixme-- this assumes a 32 bit word size.  *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError(stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop(s0, s1, s2) ;
+
+   str := ConCat(InitString('syntax error,'), Mark(str)) ;
+   ErrorStringAt(str, GetTokenNo())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken(t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0('inserting token\n')
+      END ;
+      InsertToken(t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken(t) ;
+      InsertTokenAndRewind(t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      GetToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   RETURN( WasNoError )
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTF(makekey(currentstring), identtok)
+   END ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTF(makekey(currentstring), stringtok) ;
+      BuildString
+   END ;
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), integertok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF IsAutoPushOn()
+   THEN
+      PushTFtok (makekey(currentstring), realtok, GetTokenNo ()) ;
+      BuildNumber
+   END ;
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module PHBuild end
+END PHBuild.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuild procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit :=                                                                % PushAutoOff %
+            ( DefinitionModule |
+              ImplementationOrProgramModule )                              % PopAuto %
+         =:
+
+ProgramModule :=                                                           % VAR begint, endt: CARDINAL ; %
+                                                                           % begint := GetTokenNo () %
+                 "MODULE"                                                  % M2Error.DefaultProgramModule %
+                                                                           % PushAutoOn %
+                  Ident                                                    % P3StartBuildProgModule %
+                                                                           % BuildModuleStart (begint) %
+                                                                           % PushAutoOff %
+                  [ Priority
+                  ]
+                  ";"
+                  { Import
+                  }                                                        % begint := GetTokenNo () %
+                                                                           % StartBuildInit (begint) %
+                  Block                                                    % PushAutoOn %
+                                                                           % endt := GetTokenNo () -1 %
+                  Ident                                                    % EndBuildFile (endt) %
+                                                                           % P3EndBuildProgModule %
+                  "."                                                      % PopAuto ;
+                                                                             EndBuildInit (endt) ;
+                                                                             PopAuto %
+                  =:
+
+ImplementationModule :=                                                    % VAR begint, endt: CARDINAL ; %
+                                                                           % begint := GetTokenNo () %
+                        "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
+                                         "MODULE"                          % PushAutoOn %
+                         Ident                                             % StartBuildModFile (begint) %
+                                                                           % P3StartBuildImpModule %
+                                                                           % BuildModuleStart (begint) %
+                                                                           % PushAutoOff %
+                         [ Priority
+                         ] ";"
+                         { Import
+                           }                                               % begint := GetTokenNo () %
+                                                                           % StartBuildInit (begint) %
+                         Block                                             % PushAutoOn %
+                                                                           % endt := GetTokenNo () -1 %
+                         Ident                                             % EndBuildFile (endt) %
+                                                                           % P3EndBuildImpModule %
+                         "."                                               % PopAuto ;
+                                                                             EndBuildInit (endt) ;
+                                                                             PopAuto ;
+                                                                             PopAuto %
+                      =:
+
+ImplementationOrProgramModule :=                                           % PushAutoOff %
+                                 ( ImplementationModule | ProgramModule )  % PopAuto %
+                              =:
+
+Number := Integer | Real =:
+
+Qualident :=                                                               % VAR name: Name ;
+                                                                                 Type, Sym, tok: CARDINAL ; %
+             Ident
+                                                                           % IF IsAutoPushOn()
+                                                                             THEN
+                                                                                PopTtok(name, tok) ;
+                                                                                Sym := RequestSym (tok, name) ;
+                                                                                IF IsDefImp(Sym) OR IsModule(Sym)
+                                                                                THEN
+                                                                                   Expect(periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+                                                                                   StartScope(Sym) ;
+                                                                                   Qualident(stopset0, stopset1, stopset2) ;
+                                                                                   (* should we test for lack of ident? *)
+                                                                                   PopTFtok(Sym, Type, tok) ;
+                                                                                   PushTFtok(Sym, Type, tok) ;
+                                                                                   EndScope ;
+                                                                                   PutIncluded(Sym)
+                                                                                ELSE
+                                                                                   PushTFtok(Sym, GetType(Sym), tok) ;
+                                                                                END
+                                                                             ELSE (* just parse qualident *) %
+             { "." Ident }                                                 % END %
+           =:
+
+ConstantDeclaration :=                                                     % PushAutoOn %
+                                                                           % VAR tokno: CARDINAL ; %
+                       ( Ident "="                                         % tokno := GetTokenNo () %
+                                                                           % BuildConst %
+                         ConstExpression )                                 % BuildAssignConstant (tokno) %
+                                                                           % PopAuto %
+                     =:
+
+ConstExpression :=                                                         % VAR tokpos: CARDINAL ; %
+                                                                           % PushAutoOn %
+                   SimpleConstExpr [ Relation                              % tokpos := GetTokenNo ()-1 %
+                                              SimpleConstExpr              % BuildRelOp (tokpos) %
+                                   ]                                       % PopAuto %
+                =:
+
+Relation := "="                                                            % PushT(EqualTok) %
+            | "#"                                                          % PushT(HashTok) %
+            | "<>"                                                         % PushT(LessGreaterTok) %
+            | "<"                                                          % PushT(LessTok) %
+            | "<="                                                         % PushT(LessEqualTok) %
+            | ">"                                                          % PushT(GreaterTok) %
+            | ">="                                                         % PushT(GreaterEqualTok) %
+            | "IN"                                                         % PushT(InTok) %
+         =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm                % BuildBinaryOp %
+                                    } =:
+
+UnaryOrConstTerm := "+"                                                    % PushT(PlusTok) %
+                    ConstTerm                                              % BuildUnaryOp %
+                    |
+                    "-"                                                    % PushT(MinusTok) %
+                    ConstTerm                                              % BuildUnaryOp %
+                    |
+                    ConstTerm =:
+
+AddOperator :=   "+"                                                       % PushT(PlusTok) ;
+                                                                             RecordOp %
+               | "-"                                                       % PushT(MinusTok) ;
+                                                                             RecordOp %
+               | "OR"                                                      % PushT(OrTok) ;
+                                                                             RecordOp %
+            =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor                         % BuildBinaryOp %
+                         } =:
+
+MulOperator := "*"                                                         % PushT(TimesTok) ;
+                                                                             RecordOp %
+               | "/"                                                       % PushT(DivideTok) ;
+                                                                             RecordOp %
+               | "DIV"                                                     % PushT(DivTok) ;
+                                                                             RecordOp %
+               | "MOD"                                                     % PushT(ModTok) ;
+                                                                             RecordOp %
+               | "REM"                                                     % PushT(RemTok) ;
+                                                                             RecordOp %
+               | "AND"                                                     % PushT(AndTok) ;
+                                                                             RecordOp %
+               | "&"                                                       % PushT(AmbersandTok) ;
+                                                                             RecordOp %
+            =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" | "NOT" ConstFactor                 % BuildNot %
+               | ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string =:
+
+ComponentElement := ConstExpression ( ".." ConstExpression                 % PushT(PeriodPeriodTok) %
+                                      |                                    % PushT(NulTok) %
+                                    )
+                  =:
+
+ComponentValue := ComponentElement ( 'BY' ConstExpression                  % PushT(ByTok) %
+
+                                     |                                     % PushT(NulTok) %
+                                   )
+                =:
+
+ArraySetRecordValue := ComponentValue                                      % BuildComponentValue %
+                                      { ',' ComponentValue                 % BuildComponentValue %
+                                                           }
+                     =:
+
+Constructor := '{'                                                         % BuildConstructorStart (GetTokenNo() -1) %
+                  [ ArraySetRecordValue ]                                  % BuildConstructorEnd (GetTokenNo())  %
+               '}' =:
+
+ConstSetOrQualidentOrFunction := Qualident
+                                 [ Constructor | ConstActualParameters     % BuildConstFunctionCall %
+                                                                       ]
+                                   |                                       % BuildTypeForConstructor %
+                                     Constructor =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:
+
+ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =:
+
+ByteAlignment := '<*'                                                      % PushAutoOn %
+                      AttributeExpression                                  % BuildAlignment %
+                                          '*>'                             % PopAuto %
+               =:
+
+-- OptAlignmentExpression := [ AlignmentExpression ] =:
+
+-- AlignmentExpression := "(" ConstExpression ")" =:
+
+Alignment := [ ByteAlignment ] =:
+
+TypeDeclaration := Ident "=" Type Alignment
+                =:
+
+Type :=
+                                                                           % PushAutoOff %
+        ( SimpleType | ArrayType
+          | RecordType
+          | SetType
+          | PointerType
+          | ProcedureType )                                                % PopAuto %
+      =:
+
+SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+
+Enumeration := "("
+                   ( IdentList
+                               )
+               ")"
+            =:
+
+IdentList := Ident                                                         % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," Ident                                                   % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+SubrangeType := "[" ConstExpression ".." ConstExpression "]"               % BuildSubrange ; %
+              =:
+
+ArrayType := "ARRAY"
+
+              SimpleType
+              { ","
+                SimpleType
+              } "OF"
+             Type
+           =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
+
+DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                        { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression :=                                                    % PushAutoOff %
+                         Ident [ '(' ConstExpression ')' ]                  % PopAuto %
+                                                           =:
+
+AttributeExpression :=                                                      % PushAutoOff %
+                       Ident '(' ConstExpression ')'                        % PopAuto %
+                                                      =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+-- at present FieldListStatement is as follows:
+FieldListStatement := [ FieldList ] =:
+-- later replace it with FieldList to comply with PIM2
+
+-- sadly the PIM rules are not LL1 as Ident and Qualident have the same first
+-- symbols. We rewrite FieldList to inline qualident
+-- was
+-- FieldList := IdentList ":"                                              % BuildNulName %
+--                           Type |
+--             "CASE" [ Ident ] [ ":" Qualident ] "OF" Varient { "|" Varient }
+--                    [ "ELSE" FieldListSequence ] "END" =:
+
+FieldList := IdentList ":"
+                           Type RecordFieldPragma
+             |
+             "CASE"                                                        % BeginVarient %
+                    CaseTag "OF"
+                                 Varient { "|" Varient }
+              [ "ELSE"                                                     % ElseVarient %
+                FieldListSequence
+              ] "END"                                                      % EndVarient %
+           =:
+
+TagIdent := [ Ident ] =:
+
+CaseTag :=  TagIdent [":" Qualident ] =:
+
+Varient := [                                                               % BeginVarientList %
+             VarientCaseLabelList ":" FieldListSequence                    % EndVarientList %
+                                                        ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression ( ".." ConstExpression                % AddVarientRange %
+                                       |                                   % AddVarientEquality ; (* epsilon *) %
+                                     )
+                   =:
+
+SilentCaseLabelList := SilentCaseLabels { "," SilentCaseLabels } =:
+
+SilentCaseLabels := SilentConstExpression [ ".." SilentConstExpression ] =:
+
+--
+--  the following rules are a copy of the ConstExpression ebnf rules but without
+--  any actions all prefixed with Silent.
+--
+
+SilentConstExpression :=                                                   % PushAutoOff %
+                         SilentSimpleConstExpr
+                         [ SilentRelation SilentSimpleConstExpr ]          % PopAuto %
+                      =:
+
+SilentRelation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
+
+SilentSimpleConstExpr := SilentUnaryOrConstTerm { SilentAddOperator SilentConstTerm } =:
+
+SilentUnaryOrConstTerm := "+" SilentConstTerm | "-" SilentConstTerm | SilentConstTerm =:
+
+SilentAddOperator := "+" | "-" | "OR" =:
+
+SilentConstTerm := SilentConstFactor { SilentMulOperator SilentConstFactor } =:
+
+SilentMulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
+
+SilentConstFactor := Number | SilentConstString | SilentConstSetOrQualidentOrFunction |
+                     "(" SilentConstExpression ")" | "NOT" SilentConstFactor
+                     | SilentConstAttribute =:
+
+SilentConstString := string =:
+
+SilentConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" SilentConstAttributeExpression ")" ")" =:
+
+SilentConstAttributeExpression := Ident | "<" Ident ',' SilentConstString ">" =:
+
+SilentConstSetOrQualidentOrFunction := Qualident [ SilentConstructor | SilentActualParameters ] |
+                                       SilentConstructor =:
+
+SilentSetOrDesignatorOrFunction := ( Qualident
+                                   [ SilentConstructor |
+                                     SilentSimpleDes [ SilentActualParameters ]
+                                   ] | SilentConstructor )
+                                 =:
+
+SilentSimpleDes := { SilentSubDesignator } =:
+
+SilentConstructor := "{"                                                   % SilentBuildConstructorStart %
+                         [ SilentElement { "," SilentElement } ] "}" =:
+
+SilentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
+
+SilentActualParameters := "(" [ SilentExpList ] ")" =:
+
+SilentSubDesignator := "." Ident | "[" SilentExpList "]" | "^"
+                     =:
+
+SilentExpList := SilentExpression { "," SilentExpression } =:
+
+SilentDesignator := Qualident { SilentSubDesignator } =:
+
+SilentExpression :=
+                    SilentSimpleExpression
+                                           [ SilentRelation
+                                                            SilentSimpleExpression ]
+           =:
+
+SilentSimpleExpression := SilentUnaryOrTerm { SilentAddOperator SilentTerm } =:
+
+SilentUnaryOrTerm := "+"
+                        SilentTerm
+                                   | "-"
+                                         SilentTerm
+                                                    | SilentTerm =:
+
+SilentTerm := SilentFactor { SilentMulOperator SilentFactor
+                                                            } =:
+
+SilentFactor := Number | string | SilentSetOrDesignatorOrFunction |
+                "(" SilentExpression ")" | "NOT" SilentFactor | ConstAttribute =:
+
+-- end of the Silent constant rules
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+
+PointerType := "POINTER" "TO" Type
+             =:
+
+ProcedureType := "PROCEDURE"
+                 [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+VarIdent :=                                                                % VAR Sym, Type: CARDINAL ; %
+            Ident [ "[" ConstExpression                                    % PopTF(Sym, Type) %
+                                        "]" ]
+         =:
+
+VarIdentList := VarIdent                                                   % VAR
+                                                                                on: BOOLEAN ;
+                                                                                n : CARDINAL ; %
+                                                                           % on := IsAutoPushOn() ;
+                                                                             IF on
+                                                                             THEN
+                                                                                n := 1
+                                                                             END %
+             { "," VarIdent                                                % IF on
+                                                                             THEN
+                                                                                INC(n)
+                                                                             END %
+             }                                                             % IF on
+                                                                             THEN
+                                                                                PushT(n)
+                                                                             END %
+             =:
+
+VariableDeclaration := VarIdentList ":" Type Alignment
+                    =:
+
+Designator := Qualident
+              { SubDesignator } =:
+
+SubDesignator := "."
+                 Ident
+                 | "[" ExpList
+                   "]"
+                 | "^"
+            =:
+
+ExpList :=
+           Expression
+             { ","
+               Expression
+             }
+        =:
+
+
+Expression :=
+              SimpleExpression [ SilentRelation SimpleExpression
+                               ]
+           =:
+
+SimpleExpression := UnaryOrTerm { SilentAddOperator Term
+                                } =:
+
+UnaryOrTerm := "+"
+                 Term
+               | "-"
+                 Term
+               | Term =:
+
+Term := Factor { SilentMulOperator Factor
+               } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" Factor | ConstAttribute =:
+
+-- again Set | Designator causes problems as both has a first symbol, ident or Qualident
+
+SetOrDesignatorOrFunction := ( Qualident [ Constructor |
+                                           SimpleDes [ ActualParameters ]
+                                         ] | Constructor
+                             )
+                           =:
+
+-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+SimpleDes := { SubDesignator } =:
+
+ActualParameters := "("
+                        ( ExpList |                                         % (* epsilon *) %
+                        ) ")" =:
+
+ConstActualParameters := "("                                                % BuildSizeCheckStart %
+                            ( ConstExpList |                                % BuildNulParam %
+                            ) ")" =:
+
+ConstExpList :=                                                             % VAR n: CARDINAL ; %
+                 ConstExpression                                            % BuildBooleanVariable %
+                                                                            % n := 1 %
+                 { ","
+                   ConstExpression                                          % BuildBooleanVariable %
+                                                                            % INC(n) %
+                 }
+                                                                            % PushT(n) %
+              =:
+
+Statement :=
+             [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               "EXIT"
+               | "RETURN"
+                 ( Expression |                                             % (* in epsilon *) %
+                               ) | RetryStatement
+             ]
+          =:
+
+RetryStatement := "RETRY" =:
+
+AssignmentOrProcedureCall := Designator ( ":=" SilentExpression |
+                                           SilentActualParameters |         % (* in epsilon *) %
+                                        ) =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence :=
+                     Statement
+                               { ";"
+                                     Statement }
+                  =:
+
+IfStatement :=
+               "IF"
+                    SilentExpression "THEN"
+                StatementSequence
+              { "ELSIF"
+                        Expression "THEN"
+                                          StatementSequence
+              }
+              [ "ELSE"
+                      StatementSequence ] "END"
+            =:
+
+CaseStatement := "CASE"
+                        SilentExpression
+                                   "OF" Case { "|" Case }
+                 [ "ELSE"
+                          StatementSequence ] "END"
+               =:
+
+Case := [ SilentCaseLabelList ":" StatementSequence ] =:
+
+WhileStatement := "WHILE"
+                          SilentExpression
+                                           "DO"
+                                                StatementSequence
+                                                                  "END"
+                =:
+
+RepeatStatement := "REPEAT"
+                            StatementSequence
+                                              "UNTIL"
+                                                      SilentExpression
+                 =:
+
+ForStatement := "FOR"
+                      Ident ":=" SilentExpression "TO" SilentExpression
+                ( "BY" SilentConstExpression |                             % (* epsilon *) %
+                ) "DO"
+                StatementSequence "END"
+              =:
+
+LoopStatement := "LOOP"
+                       StatementSequence
+                                         "END"
+               =:
+
+WithStatement := "WITH"
+                        SilentDesignator "DO"
+                        StatementSequence
+                 "END"
+               =:
+
+ProcedureDeclaration := ProcedureHeading ";" ( ProcedureBlock              % PushAutoOn %
+                        Ident )                                            % EndBuildProcedure %
+                                                                           % PopAuto %
+                      =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" |
+                            "__INLINE__" ]
+                       =:
+
+ProcedureHeading := "PROCEDURE"                                            % M2Error.DefaultProcedure %
+                     DefineBuiltinProcedure                                % PushAutoOn %
+                     ( Ident                                               % StartBuildProcedure %
+                                                                           % PushAutoOff %
+                       [ FormalParameters ] AttributeNoReturn
+                                                                           % PopAuto %
+                     )                                                     % PopAuto %
+                 =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE"                                         % M2Error.DefaultProcedure %
+                        Builtin
+                        ( Ident
+                          [ DefFormalParameters ] AttributeNoReturn
+                        )                                                  % M2Error.LeaveErrorScope %
+                    =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+AttributeUnused := [ "<*" Ident "*>" ] =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock := { Declaration } [ "BEGIN" BlockBody ] "END"
+                =:
+
+Block := { Declaration } InitialBlock FinalBlock "END" =:
+
+InitialBlock := [ "BEGIN" BlockBody ] =:
+
+FinalBlock := [ "FINALLY" BlockBody ] =:
+
+BlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration ";" } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP |
+                     FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
+
+MultiFPSection := ExtendedFP |
+                  FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
+
+NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
+
+OptArg := "[" Ident ":" FormalType [ "=" SilentConstExpression ] "]" =:
+
+DefOptArg := "[" Ident ":" FormalType "=" SilentConstExpression "]" =:
+
+FormalType := { "ARRAY" "OF" } Qualident =:
+
+ModuleDeclaration :=                                                       % VAR begint: CARDINAL ; %
+                                                                           % begint := GetTokenNo () %
+                     "MODULE"                                              % M2Error.DefaultInnerModule %
+                                                                           % PushAutoOn %
+                     Ident                                                 % StartBuildInnerModule ;
+                                                                             BuildModuleStart (begint) ;
+
+                                                                             PushAutoOff %
+                     [ Priority ] ";"
+                     { Import
+                        } [ Export
+                            ]
+                       Block                                               % PushAutoOn %
+                       Ident                                               % EndBuildInnerModule %
+                                                                           % PopAuto ; PopAuto ; PopAuto %
+                     =:
+
+Priority := "[" SilentConstExpression "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"
+                                 IdentList |
+                     "UNQUALIFIED"
+                                 IdentList |
+                     IdentList ) ";" =:
+
+Import :=  "FROM" Ident "IMPORT" IdentList ";" |
+           "IMPORT"
+            IdentList ";" =:
+
+DefinitionModule :=                                                        % VAR begint, endt: CARDINAL ; %
+                                                                           % begint := GetTokenNo () %
+                    "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
+                                 "MODULE"                                  % PushAutoOn %
+                    [ "FOR" string ]
+                    Ident                                                  % StartBuildDefFile (begint) ;
+                                                                             P3StartBuildDefModule ;
+                                                                             PushAutoOff %
+                    ";"
+                    { Import
+                             } [ Export
+                                        ]
+                    { Definition }                                         % endt := GetTokenNo () %
+                                   "END"                                   % PushAutoOn %
+                                         Ident                             % EndBuildFile (endt) ;
+                                                                             P3EndBuildDefModule %
+                                               "."                         % PopAuto ; PopAuto ; PopAuto %
+                  =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE"
+                    { Ident ( ";"
+                                  | "=" Type Alignment ";" )
+                    }
+              |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ] =:
+
+AsmOperands  := AsmOperandName string [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+             =:
+
+AsmList      := [ AsmElement ] { ',' AsmElement } =:
+
+AsmElement   := string '(' Expression ')'
+             =:
+
+TrashList    := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/gm2-compiler/PHBuild.def b/gcc/m2/gm2-compiler/PHBuild.def
new file mode 100644
index 00000000000..91dcafb18a0
--- /dev/null
+++ b/gcc/m2/gm2-compiler/PHBuild.def
@@ -0,0 +1,44 @@
+(* PHBuild.def provides a parser with error recovery for GNU Modula-2.
+
+Copyright (C) 2001-2022 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/>.  *)
+DEFINITION MODULE PHBuild ;
+
+(*
+    Title      : PHBuild
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Fri Feb  2 16:11:05 2001
+    Last edit  : Fri Feb  2 16:11:05 2001
+    Description: provides a parser with error recovery for GNU Modula-2.
+                 This pass resolves hidden types.
+*)
+
+EXPORT QUALIFIED CompilationUnit ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END PHBuild.
diff --git a/gcc/m2/gm2-compiler/README b/gcc/m2/gm2-compiler/README
new file mode 100644
index 00000000000..774531ec4f6
--- /dev/null
+++ b/gcc/m2/gm2-compiler/README
@@ -0,0 +1 @@
+This directory contains the majority of the sources to the Modula-2 compiler.
diff --git a/gcc/m2/gm2-compiler/Sets.def b/gcc/m2/gm2-compiler/Sets.def
new file mode 100644
index 00000000000..c33ce35f560
--- /dev/null
+++ b/gcc/m2/gm2-compiler/Sets.def
@@ -0,0 +1,104 @@
+(* Sets.def provides a dynamic set module.
+
+Copyright (C) 2009-2022 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/>.  *)
+
+DEFINITION MODULE Sets ;
+
+(*
+    Title      : Sets
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Wed May  6 22:48:19 2009
+    Revision   : $Version$
+    Description: provides a dynamic set module which allows
+                 sets to contain the elements in the range:
+                 min..SymbolTable.FinalSymbol()
+*)
+
+FROM SymbolKey IMPORT PerformOperation ;
+
+EXPORT QUALIFIED Set,
+                 InitSet, KillSet,
+                 IncludeElementIntoSet, ExcludeElementFromSet,
+                 NoOfElementsInSet, IsElementInSet,
+                 ForeachElementInSetDo, DuplicateSet ;
+
+TYPE
+   Set ;
+
+
+(*
+   InitSet - initializes and returns a set.  The set will
+             never contain an element less than, low.
+*)
+
+PROCEDURE InitSet (low: CARDINAL) : Set ;
+
+
+(*
+   KillSet - deallocates Set, s.
+*)
+
+PROCEDURE KillSet (s: Set) : Set ;
+
+
+(*
+   DuplicateSet - returns a new duplicated set.
+*)
+
+PROCEDURE DuplicateSet (s: Set) : Set ;
+
+
+(*
+   ForeachElementInSetDo - for each element e in, s, call, p(e).
+*)
+
+PROCEDURE ForeachElementInSetDo (s: Set; p: PerformOperation) ;
+
+
+(*
+   IsElementInSet - returns TRUE if element, i, is in set, s.
+*)
+
+PROCEDURE IsElementInSet (s: Set; i: CARDINAL) : BOOLEAN ;
+
+
+(*
+   NoOfElementsInSet - returns the number of elements in a set, s.
+*)
+
+PROCEDURE NoOfElementsInSet (s: Set) : CARDINAL ;
+
+
+(*
+   ExcludeElementFromSet - excludes element, i, from set, s.
+*)
+
+PROCEDURE ExcludeElementFromSet (s: Set; i: CARDINAL) ;
+
+
+(*
+   IncludeElementIntoSet - includes element, i, into set, s.
+*)
+
+PROCEDURE IncludeElementIntoSet (s: Set; i: CARDINAL) ;
+
+
+END Sets.
diff --git a/gcc/m2/gm2-compiler/Sets.mod b/gcc/m2/gm2-compiler/Sets.mod
new file mode 100644
index 00000000000..b8634dcaa90
--- /dev/null
+++ b/gcc/m2/gm2-compiler/Sets.mod
@@ -0,0 +1,318 @@
+(* Sets.mod provides a dynamic set module.
+
+Copyright (C) 2009-2022 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/>.  *)
+
+IMPLEMENTATION MODULE Sets ;
+
+FROM SYSTEM IMPORT ADDRESS, BYTE ;
+FROM SymbolTable IMPORT FinalSymbol ;
+FROM M2Error IMPORT InternalError ;
+FROM Storage IMPORT ALLOCATE, REALLOCATE, DEALLOCATE ;
+FROM libc IMPORT memset, memcpy ;
+FROM M2Printf IMPORT printf0, printf1, printf2 ;
+FROM Assertion IMPORT Assert ;
+
+
+CONST
+   BitsetSize  = SIZE(BITSET) ;
+   MaxBitset   = MAX(BITSET) ;
+   BitsPerByte = (MaxBitset+1) DIV BitsetSize ;
+   Debugging   = FALSE ;
+
+TYPE
+   PtrToByte   = POINTER TO BYTE ;
+   PtrToBitset = POINTER TO BITSET ;
+   Set = POINTER TO RECORD
+                       init,
+                       start,
+                       end     : CARDINAL ;
+                       pb      : PtrToBitset ;
+                       bytes   : CARDINAL ;
+                       elements: CARDINAL ;
+                    END ;
+
+
+(*
+   growSet -
+*)
+
+PROCEDURE growSet (i: CARDINAL; bytes: CARDINAL) ;
+BEGIN
+   printf2("i = %d,  bytes = %d\n", i, bytes)
+END growSet ;
+
+
+(*
+   checkRange - checks to make sure, i, is within range and
+                it will extend the set bitmap if required.
+*)
+
+PROCEDURE checkRange (s: Set; i: CARDINAL) ;
+VAR
+   bits,
+   o, j: CARDINAL ;
+   b   : PtrToBitset ;
+   v   : PtrToByte ;
+BEGIN
+   WITH s^ DO
+      IF i<init
+      THEN
+         InternalError ('set element is too low and out of bounds')
+      ELSIF i>FinalSymbol()
+      THEN
+         InternalError ('set element is too high and out of bounds')
+      ELSE
+         j := bytes * BitsPerByte ;
+         IF i>=j
+         THEN
+            o := bytes ;
+            IF Debugging
+            THEN
+               printf2("previous bitset size %d bytes, need %d bits\n",
+                       o, i)
+            END ;
+            IF bytes=0
+            THEN
+               bytes := BitsetSize
+            END ;
+            WHILE i >= bytes*BitsPerByte DO
+               IF Debugging
+               THEN
+                  growSet(i, bytes)
+               END ;
+               bytes := bytes * 2
+            END ;
+            ALLOCATE(b, bytes) ;
+            IF Debugging
+            THEN
+               bits := bytes*8 ;
+               printf2("new allocated bitset size %d bytes, holds %d bits\n", bytes, bits) ;
+               IF i>bits
+               THEN
+                  InternalError ('buffer is too small')
+               END
+            END ;
+            (* a := memset(b, 0, bytes) ; *)
+            v := PtrToByte(b) ;
+            INC(v, o) ;
+            Assert (memset (v, 0, bytes-o) = v) ;
+            Assert (memcpy (b, pb, o) = b) ;
+            IF Debugging
+            THEN
+               printf1("deallocating old bitset size %d bytes\n", o)
+            END ;
+            IF o>0
+            THEN
+               DEALLOCATE(pb, o)
+            END ;
+            pb := b
+         END
+      END
+   END
+END checkRange ;
+
+
+(*
+   findPos - returns a pointer to the BITSET which will contain, i.
+*)
+
+PROCEDURE findPos (pb: PtrToBitset; i: CARDINAL) : PtrToBitset ;
+VAR
+   v: PtrToByte ;
+BEGIN
+   IF (((i DIV (MaxBitset+1)) * (MaxBitset+1)) DIV BitsPerByte) MOD BitsetSize#0
+   THEN
+      InternalError ('must be a multiple of bitset size')
+   END ;
+   v := PtrToByte(pb) ;
+   INC(v, ((i DIV (MaxBitset+1)) * (MaxBitset+1)) DIV BitsPerByte) ;
+   pb := PtrToBitset(v) ;
+   RETURN( pb )
+END findPos ;
+
+
+(*
+   InitSet - initializes and returns a set.  The set will
+             never contain an element less than, low.
+*)
+
+PROCEDURE InitSet (low: CARDINAL) : Set ;
+VAR
+   s: Set ;
+BEGIN
+   NEW(s) ;
+   WITH s^ DO
+      init     := low ;
+      start    := 0 ;
+      end      := 0 ;
+      pb       := NIL ;
+      bytes    := 0 ;
+      elements := 0
+   END ;
+   RETURN( s )
+END InitSet ;
+
+
+(*
+   KillSet - deallocates Set, s.
+*)
+
+PROCEDURE KillSet (s: Set) : Set ;
+BEGIN
+   WITH s^ DO
+      IF bytes>0
+      THEN
+         DEALLOCATE(pb, bytes)
+      END
+   END ;
+   DISPOSE(s) ;
+   RETURN( NIL )
+END KillSet ;
+
+
+(*
+   DuplicateSet - returns a new duplicated set.
+*)
+
+PROCEDURE DuplicateSet (s: Set) : Set ;
+VAR
+   t: Set ;
+BEGIN
+   NEW(t) ;
+   t^ := s^ ;
+   WITH t^ DO
+      ALLOCATE(pb, bytes) ;
+      Assert (memcpy (pb, s^.pb, bytes) = pb)
+   END ;
+   RETURN( t )
+END DuplicateSet ;
+
+
+(*
+   ForeachElementInSetDo - for each element e in, s, call, p(e).
+*)
+
+PROCEDURE ForeachElementInSetDo (s: Set; p: PerformOperation) ;
+VAR
+   i, j, c: CARDINAL ;
+   b      : PtrToBitset ;
+   v      : PtrToByte ;
+BEGIN
+   WITH s^ DO
+      i := start ;
+      c := elements ;
+      b := findPos(pb, i) ;
+      j := i MOD (MaxBitset+1) ;
+      WHILE (i<=end) AND (c>0) DO
+         IF j IN b^
+         THEN
+            DEC(c) ;
+            p(i)
+         END ;
+         IF j=MaxBitset
+         THEN
+            v := PtrToByte(b) ;
+            INC(v, BitsetSize) ;   (* avoid implications of C address arithmetic in mc PtrToByte *)
+            b := PtrToBitset(v) ;
+            j := 0
+         ELSE
+            INC(j)
+         END ;
+         INC(i)
+      END
+   END
+END ForeachElementInSetDo ;
+
+
+(*
+   IsElementInSet - returns TRUE if element, i, is in set, s.
+*)
+
+PROCEDURE IsElementInSet (s: Set; i: CARDINAL) : BOOLEAN ;
+VAR
+   b: PtrToBitset ;
+BEGIN
+   checkRange(s, i) ;
+   WITH s^ DO
+      b := findPos(pb, i) ;
+      RETURN( (i MOD (MaxBitset+1)) IN b^ )
+   END
+END IsElementInSet ;
+
+
+(*
+   NoOfElementsInSet - returns the number of elements in a set, s.
+*)
+
+PROCEDURE NoOfElementsInSet (s: Set) : CARDINAL ;
+BEGIN
+   RETURN( s^.elements )
+END NoOfElementsInSet ;
+
+
+(*
+   ExcludeElementFromSet - excludes element, i, from set, s.
+*)
+
+PROCEDURE ExcludeElementFromSet (s: Set; i: CARDINAL) ;
+VAR
+   b: PtrToBitset ;
+BEGIN
+   checkRange(s, i) ;
+   WITH s^ DO
+      b := findPos(pb, i) ;
+      IF (i MOD (MaxBitset+1)) IN b^
+      THEN
+         DEC(elements) ;
+         EXCL(b^, i MOD (MaxBitset+1))
+      END
+   END
+END ExcludeElementFromSet ;
+
+
+(*
+   IncludeElementIntoSet - includes element, i, into set, s.
+*)
+
+PROCEDURE IncludeElementIntoSet (s: Set; i: CARDINAL) ;
+VAR
+   b: PtrToBitset ;
+BEGIN
+   checkRange(s, i) ;
+   WITH s^ DO
+      b := findPos(pb, i) ;
+      IF NOT ((i MOD (MaxBitset+1)) IN b^)
+      THEN
+         INC(elements) ;
+         INCL(b^, i MOD (MaxBitset+1)) ;
+         IF (start=0) OR (start>i)
+         THEN
+            start := i
+         END ;
+         IF (end=0) OR (end<i)
+         THEN
+            end := i
+         END
+      END
+   END
+END IncludeElementIntoSet ;
+
+
+END Sets.
diff --git a/gcc/m2/gm2-compiler/SymbolConversion.def b/gcc/m2/gm2-compiler/SymbolConversion.def
new file mode 100644
index 00000000000..a39cb17b022
--- /dev/null
+++ b/gcc/m2/gm2-compiler/SymbolConversion.def
@@ -0,0 +1,87 @@
+(* SymbolConversion.def mapping between m2 symbols and gcc symbols.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE SymbolConversion ;
+
+(*
+    Title      : SymbolConversion
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Mon Jul 26 09:49:36 1999
+    Description: mapping between m2 symbols and gcc symbols.
+*)
+
+FROM m2tree IMPORT Tree ;
+FROM SYSTEM IMPORT WORD ;
+EXPORT QUALIFIED Mod2Gcc, AddModGcc, GccKnowsAbout, AddTemporaryKnown,
+                 RemoveTemporaryKnown, Poison, RemoveMod2Gcc ;
+
+
+(*
+   Mod2Gcc - given a modula-2 symbol, sym, return the gcc equivalent.
+*)
+
+PROCEDURE Mod2Gcc (sym: CARDINAL) : Tree ;
+
+
+(*
+   AddModGcc - adds the tuple [ sym, gcc ] into the database.
+*)
+
+PROCEDURE AddModGcc (sym: CARDINAL; gcc: Tree) ;
+
+
+(*
+   RemoveMod2Gcc - removes the gcc symbol from the lookup table.
+*)
+
+PROCEDURE RemoveMod2Gcc (sym: CARDINAL) ;
+
+
+(*
+   GccKnowsAbout - returns TRUE if gcc knows about the symbol, sym.
+*)
+
+PROCEDURE GccKnowsAbout (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   AddTemporaryKnown - adds a temporary gcc symbol against the modula-2 sym.
+*)
+
+PROCEDURE AddTemporaryKnown (sym: CARDINAL) ;
+
+
+(*
+   RemoveTemporaryKnown - removes the temporary symbol.
+*)
+
+PROCEDURE RemoveTemporaryKnown (sym: CARDINAL) ;
+
+
+(*
+   Poison - poisons a symbol.
+*)
+
+PROCEDURE Poison (sym: WORD) ;
+
+
+END SymbolConversion.
diff --git a/gcc/m2/gm2-compiler/SymbolConversion.mod b/gcc/m2/gm2-compiler/SymbolConversion.mod
new file mode 100644
index 00000000000..3b69f0191ad
--- /dev/null
+++ b/gcc/m2/gm2-compiler/SymbolConversion.mod
@@ -0,0 +1,247 @@
+(* SymbolConversion.mod mapping between m2 symbols and gcc symbols.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE SymbolConversion ;
+
+FROM NameKey IMPORT Name ;
+
+FROM Indexing IMPORT Index, InitIndex, PutIndice, GetIndice, InBounds,
+                     DebugIndex ;
+
+FROM SymbolTable IMPORT IsConst, PopValue, IsValueSolved, GetSymName,
+                        GetType, SkipType ;
+
+FROM M2Error IMPORT InternalError ;
+FROM M2ALU IMPORT PushTypeOfTree ;
+FROM m2block IMPORT GetErrorNode, RememberConstant ;
+FROM m2tree IMPORT Tree ;
+FROM M2Printf IMPORT printf1 ;
+FROM Storage IMPORT ALLOCATE ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+CONST
+   USEPOISON = TRUE ;
+   GGCPOISON = 0A5A5A5A5H ;   (* poisoned memory contains this code *)
+
+TYPE
+   PtrToCardinal = POINTER TO CARDINAL ;
+
+VAR
+   mod2gcc       : Index ;
+   PoisonedSymbol: ADDRESS ;
+
+
+(*
+   Mod2Gcc - given a modula-2 symbol, sym, return the gcc equivalent.
+*)
+
+PROCEDURE Mod2Gcc (sym: CARDINAL) : Tree ;
+VAR
+   n : Name ;
+   t : PtrToCardinal ;
+   tr: Tree ;
+BEGIN
+   IF USEPOISON
+   THEN
+      IF InBounds(mod2gcc, sym)
+      THEN
+         t := PtrToCardinal(GetIndice(mod2gcc, sym)) ;
+         IF (t#NIL) AND (t^=GGCPOISON)
+         THEN
+            InternalError ('gcc symbol has been poisoned')
+         END
+      END
+   END ;
+   IF InBounds(mod2gcc, sym)
+   THEN
+      tr := Tree(GetIndice(mod2gcc, sym)) ;
+      IF tr=PoisonedSymbol
+      THEN
+         n := GetSymName(sym) ;
+         (* not poisoned by the garbage collector, but by the gm2 front end *)
+         printf1('the gm2 front end poisoned this symbol (%a)\n', n) ;
+         InternalError ('attempting to use a gcc symbol which is no longer in scope')
+      END ;
+      RETURN( tr )
+   ELSE
+      RETURN( NIL )
+   END
+END Mod2Gcc ;
+
+
+(*
+   AddModGcc - adds the tuple [ sym, gcc ] into the database.
+*)
+
+PROCEDURE AddModGcc (sym: CARDINAL; gcc: Tree) ;
+VAR
+   old: Tree ;
+   t  : PtrToCardinal ;
+BEGIN
+   IF gcc=GetErrorNode()
+   THEN
+      InternalError ('error node generated during symbol conversion')
+   END ;
+
+   IF USEPOISON
+   THEN
+      t := PtrToCardinal(gcc) ;
+      IF (gcc#Tree(NIL)) AND (t^=GGCPOISON)
+      THEN
+         InternalError ('gcc symbol has been poisoned')
+      END
+   END ;
+
+   old := Mod2Gcc(sym) ;
+   IF old=Tree(NIL)
+   THEN
+      (* absent - add it *)
+      PutIndice(mod2gcc, sym, gcc) ;
+      IF GetIndice(mod2gcc, sym)#gcc
+      THEN
+         InternalError ('failed to add gcc <-> mod2 symbol')
+      END ;
+      gcc := RememberConstant(gcc)
+   ELSIF old=gcc
+   THEN
+      (* do nothing, as it is already stored *)
+   ELSIF old=GetErrorNode()
+   THEN
+      InternalError ('replacing a temporary symbol (currently unexpected)')
+   ELSE
+      InternalError ('should not be replacing a symbol')
+   END ;
+
+   IF IsConst(sym) AND (NOT IsValueSolved(sym))
+   THEN
+      PushTypeOfTree(sym, gcc) ;
+      PopValue(sym)
+   END
+END AddModGcc ;
+
+
+(*
+   RemoveMod2Gcc - removes the gcc symbol from the lookup table.
+*)
+
+PROCEDURE RemoveMod2Gcc (sym: CARDINAL) ;
+BEGIN
+   PutIndice(mod2gcc, sym, NIL)
+END RemoveMod2Gcc ;
+
+
+(*
+   GccKnowsAbout - returns TRUE if gcc knows about the symbol, sym.
+*)
+
+PROCEDURE GccKnowsAbout (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( InBounds(mod2gcc, sym) AND (GetIndice(mod2gcc, sym)#NIL) )
+END GccKnowsAbout ;
+
+
+(*
+   AddTemporaryKnown - adds a temporary gcc symbol against the modula-2 sym.
+*)
+
+PROCEDURE AddTemporaryKnown (sym: CARDINAL) ;
+BEGIN
+   (* we add the error node against symbol, sym.  We expect it to be retacted later. *)
+   PutIndice (mod2gcc, sym, GetErrorNode ())
+END AddTemporaryKnown ;
+
+
+(*
+   RemoveTemporaryKnown - removes the temporary symbol.
+*)
+
+PROCEDURE RemoveTemporaryKnown (sym: CARDINAL) ;
+BEGIN
+   IF Mod2Gcc(sym)=GetErrorNode()
+   THEN
+      PutIndice(mod2gcc, sym, NIL)
+   ELSE
+      InternalError ('attempting to remove a symbol which is not present in the tree')
+   END
+END RemoveTemporaryKnown ;
+
+
+(*
+   Mod2GccWithoutGCCPoison - given a modula-2 symbol, sym, return
+                             the gcc equivalent, it does not check to see
+                             whether the gcc symbol has been poisoned.
+*)
+
+PROCEDURE Mod2GccWithoutGCCPoison (sym: CARDINAL) : Tree ;
+VAR
+   n : Name ;
+   tr: Tree ;
+BEGIN
+   IF InBounds(mod2gcc, sym)
+   THEN
+      tr := Tree(GetIndice(mod2gcc, sym)) ;
+      IF tr=PoisonedSymbol
+      THEN
+         n := GetSymName(sym) ;
+         (* not poisoned by the garbage collector, but by the gm2 front end.  *)
+         printf1 ('the gm2 front end poisoned this symbol (%a)\n', n) ;
+         InternalError ('attempting to use a gcc symbol which is no longer in scope')
+      END ;
+      RETURN tr
+   ELSE
+      RETURN NIL
+   END
+END Mod2GccWithoutGCCPoison ;
+
+
+(*
+   Poison - poisons a symbol.
+*)
+
+PROCEDURE Poison (sym: WORD) ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   IF NOT IsConst(sym)
+   THEN
+      a := Mod2GccWithoutGCCPoison(sym) ;
+      IF a#NIL
+      THEN
+         PutIndice(mod2gcc, sym, PoisonedSymbol)
+      END
+   END
+END Poison ;
+
+
+(*
+   Init - create both binary trees.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   mod2gcc := InitIndex(1) ;
+   ALLOCATE(PoisonedSymbol, 1)
+END Init ;
+
+
+BEGIN
+   Init
+END SymbolConversion.
diff --git a/gcc/m2/gm2-compiler/SymbolKey.def b/gcc/m2/gm2-compiler/SymbolKey.def
new file mode 100644
index 00000000000..0b5f9217fa7
--- /dev/null
+++ b/gcc/m2/gm2-compiler/SymbolKey.def
@@ -0,0 +1,139 @@
+(* SymbolKey.def binary tree operations for storing symbols.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE SymbolKey ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : SymbolKey
+   Date       : 4/3/87
+   Description: Provides binary tree operations for storing symbols.
+                Used by the MODULE SymbolTable to provide scoping of symbols.
+   Last update: Date: Wed 31-01-1990 Time: 18:20:32.63
+                Mon Aug 30 12:07:12 BST 1999
+*)
+
+FROM SYSTEM IMPORT WORD ;
+FROM NameKey IMPORT Name ;
+EXPORT QUALIFIED NulKey, SymbolTree,
+                 IsSymbol, PerformOperation,
+                 InitTree, KillTree, GetSymKey, PutSymKey, DelSymKey,
+                 IsEmptyTree,
+                 DoesTreeContainAny, ForeachNodeDo, ContainsSymKey,
+                 NoOfNodes, ForeachNodeConditionDo ;
+
+CONST
+   NulKey = 0 ;
+
+TYPE
+   SymbolTree ;
+
+   IsSymbol         = PROCEDURE (WORD) : BOOLEAN ;
+   PerformOperation = PROCEDURE (WORD) ;
+
+
+(*
+   InitTree - Initializes a SymbolTree pointed to by t.
+*)
+
+PROCEDURE InitTree (VAR t: SymbolTree) ;
+
+
+(*
+   KillTree - Destroys the SymbolTree pointed to by t.
+*)
+
+PROCEDURE KillTree (VAR t: SymbolTree) ;
+
+
+(*
+   GetSymKey - Searches the SymbolTree t for an entry NameKey. If
+               found then the SymKey is returned. NulKey = not found.
+*)
+
+PROCEDURE GetSymKey (t: SymbolTree; NameKey: Name) : WORD ;
+
+
+(*
+   PutSymKey - Puts an symbol entry NameKey in the SymbolTree t.
+               SymKey is the value stored with NameKey.
+*)
+
+PROCEDURE PutSymKey (t: SymbolTree; NameKey: Name; SymKey: WORD) ;
+
+
+(*
+   DelSymKey - Deletes a symbol entry NameKey in the SymbolTree t.
+*)
+
+PROCEDURE DelSymKey (t: SymbolTree; NameKey: Name) ;
+
+
+(*
+   IsEmptyTree - returns true if SymbolTree, t, is empty.
+*)
+
+PROCEDURE IsEmptyTree (t: SymbolTree) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE DoesTreeContainAny (t: SymbolTree; P: IsSymbol) : BOOLEAN ;
+
+
+(*
+   ForeachNodeDo - for each node in SymbolTree, t, a procedure, P,
+                   is called with the node symbol as its parameter.
+                   It traverse the tree in order.
+*)
+
+PROCEDURE ForeachNodeDo (t: SymbolTree; P: PerformOperation) ;
+
+
+(*
+   ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*)
+
+PROCEDURE ContainsSymKey (t: SymbolTree; NameKey: Name) : BOOLEAN ;
+
+
+(*
+   NoOfNodes - returns the number of nodes in the tree t.
+*)
+
+PROCEDURE NoOfNodes (t: SymbolTree; condition: IsSymbol) : CARDINAL ;
+
+
+(*
+   ForeachNodeConditionDo - traverse the tree t and for any node which satisfied
+                            condition call P.
+*)
+
+PROCEDURE ForeachNodeConditionDo (t: SymbolTree;
+                                  condition: IsSymbol;
+                                  P: PerformOperation) ;
+
+
+END SymbolKey.
diff --git a/gcc/m2/gm2-compiler/SymbolKey.mod b/gcc/m2/gm2-compiler/SymbolKey.mod
new file mode 100644
index 00000000000..83866325102
--- /dev/null
+++ b/gcc/m2/gm2-compiler/SymbolKey.mod
@@ -0,0 +1,407 @@
+(* SymbolKey.mod binary tree operations for storing symbols.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE SymbolKey ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM NameKey IMPORT WriteKey ;
+FROM Assertion IMPORT Assert ;
+FROM Debug IMPORT Halt ;
+
+
+TYPE
+   SymbolTree = POINTER TO Node ;
+   Node       = RECORD
+                   KeyName : Name ;   (* The sorted entity *)
+                   KeySym  : WORD ;   (* The value entity  *)
+                   Left    : SymbolTree ;
+                   Right   : SymbolTree ;
+                END ;
+
+
+PROCEDURE InitTree (VAR t: SymbolTree) ;
+BEGIN
+   NEW(t) ;
+   WITH t^ DO
+      Left := NIL ;
+      Right := NIL
+   END
+END InitTree ;
+
+
+(*
+    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 ;
+*)
+
+
+PROCEDURE KillTree (VAR t: SymbolTree) ;
+BEGIN
+   IF t#NIL
+   THEN
+      KillTree(t^.Left) ;
+      KillTree(t^.Right) ;
+      DISPOSE(t) ;
+      t := NIL
+   END
+END KillTree ;
+
+
+(*
+   ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*)
+
+PROCEDURE ContainsSymKey (t: SymbolTree; NameKey: Name) : BOOLEAN ;
+VAR
+   father,
+   child : SymbolTree ;
+BEGIN
+   FindNodeParentInTree(t, NameKey, child, father) ;
+   RETURN child#NIL
+END ContainsSymKey ;
+
+
+PROCEDURE GetSymKey (t: SymbolTree; NameKey: Name) : WORD ;
+VAR
+   father,
+   child : SymbolTree ;
+BEGIN
+   FindNodeParentInTree(t, NameKey, child, father) ;
+   IF child=NIL
+   THEN
+      RETURN NulKey
+   ELSE
+      RETURN child^.KeySym
+   END
+END GetSymKey ;
+
+
+PROCEDURE PutSymKey (t: SymbolTree; NameKey: Name; SymKey: WORD) ;
+VAR
+   father,
+   child : SymbolTree ;
+BEGIN
+   FindNodeParentInTree(t, NameKey, child, father) ;
+   IF child=NIL
+   THEN
+      (* no child found, now is NameKey less than father or greater? *)
+      IF father=t
+      THEN
+         (* empty tree, add it to the left branch of t *)
+         NEW(child) ;
+         father^.Left := child
+      ELSE
+         IF NameKey<father^.KeyName
+         THEN
+            NEW(child) ;
+            father^.Left := child
+         ELSIF NameKey>father^.KeyName
+         THEN
+            NEW(child) ;
+            father^.Right := child
+         END
+      END ;
+      WITH child^ DO
+         Right   := NIL ;
+         Left    := NIL ;
+         KeySym  := SymKey ;
+         KeyName := NameKey
+      END
+   ELSE
+      Halt('symbol already stored', __LINE__, __FILE__)
+   END
+END PutSymKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE DelSymKey (t: SymbolTree; NameKey: Name) ;
+VAR
+   i, child, father: SymbolTree ;
+BEGIN
+   FindNodeParentInTree(t, NameKey, child, father) ;  (* find father and child of the node *)
+   IF (child#NIL) AND (child^.KeyName=NameKey)
+   THEN
+      (* Have found the node to be deleted *)
+      IF father^.Right=child
+      THEN
+         (* Node is child and this is greater than the father. *)
+         (* Greater being on the right.                        *)
+         (* Connect child^.Left onto the father^.Right.        *)
+         (* Connect child^.Right onto the end of the right     *)
+         (* most branch of child^.Left.                        *)
+         IF child^.Left#NIL
+         THEN
+            (* Scan for Right most node of child^.Left *)
+            i := child^.Left ;
+            WHILE i^.Right#NIL DO
+               i := i^.Right
+            END ;
+            i^.Right      := child^.Right ;
+            father^.Right := child^.Left
+         ELSE
+            (* No child^.Left node therefore link over child   *)
+            (* (as in a single linked list) to child^.Right    *)
+            father^.Right := child^.Right
+         END ;
+         DISPOSE(child)
+      ELSE
+         (* Assert that father^.Left=child will always be true *)
+         (* Perform exactly the mirror image of the above code *)
+
+         (* Connect child^.Right onto the father^.Left.        *)
+         (* Connect child^.Left onto the end of the Left most  *)
+         (* branch of child^.Right                             *)
+         IF child^.Right#NIL
+         THEN
+            (* Scan for Left most node of child^.Right *)
+            i := child^.Right ;
+            WHILE i^.Left#NIL DO
+               i := i^.Left
+            END ;
+            i^.Left      := child^.Left ;
+            father^.Left := child^.Right
+         ELSE
+            (* No child^.Right node therefore link over c      *)
+            (* (as in a single linked list) to child^.Left.    *)
+            father^.Left := child^.Left
+         END ;
+         DISPOSE(child)
+      END
+   ELSE
+      Halt('trying to delete a symbol that is not in the tree - the compiler never expects this to occur',
+            __LINE__, __FILE__)
+   END
+END DelSymKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FindNodeParentInTree (t: SymbolTree; n: Name;
+                                VAR child, parent: SymbolTree) ;
+BEGIN
+   (* remember to skip the sentinal value and assign parent and child *)
+   parent := t ;
+   IF t=NIL
+   THEN
+      Halt('parameter t should never be NIL', __LINE__, __FILE__)
+   END ;
+   Assert (t^.Right = NIL) ;
+   child := t^.Left ;
+   IF child#NIL
+   THEN
+      REPEAT
+         IF n<child^.KeyName
+         THEN
+            parent := child ;
+            child := child^.Left
+         ELSIF n>child^.KeyName
+         THEN
+            parent := child ;
+            child := child^.Right
+         END
+      UNTIL (child=NIL) OR (n=child^.KeyName)
+   END
+END FindNodeParentInTree ;
+
+
+(*
+   IsEmptyTree - returns true if SymbolTree, t, is empty.
+*)
+
+PROCEDURE IsEmptyTree (t: SymbolTree) : BOOLEAN ;
+BEGIN
+   RETURN t^.Left = NIL
+END IsEmptyTree ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE DoesTreeContainAny (t: SymbolTree; P: IsSymbol) : BOOLEAN ;
+BEGIN
+   RETURN SearchForAny (t^.Left, P)
+END DoesTreeContainAny ;
+
+
+(*
+   SearchForAny - performs the search required for DoesTreeContainAny.
+                  The root node always contains a nul data value,
+                  therefore we must skip over it.
+*)
+
+PROCEDURE SearchForAny (t: SymbolTree; P: IsSymbol) : BOOLEAN ;
+BEGIN
+   IF t=NIL
+   THEN
+      RETURN FALSE
+   ELSE
+      RETURN( P (t^.KeySym) OR
+              SearchForAny (t^.Left, P) OR
+                              SearchForAny(t^.Right, P)
+            )
+   END
+END SearchForAny ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ForeachNodeDo (t: SymbolTree; P: PerformOperation) ;
+BEGIN
+   SearchAndDo(t^.Left, P)
+END ForeachNodeDo ;
+
+
+(*
+   SearchAndDo - searches all the nodes in SymbolTree, t, and
+                 calls procedure, P, with a node as its parameter.
+                 It traverse the tree in order.
+*)
+
+PROCEDURE SearchAndDo (t: SymbolTree; P: PerformOperation) ;
+BEGIN
+   IF t#NIL
+   THEN
+      WITH t^ DO
+         SearchAndDo(Right, P) ;
+         P(KeySym) ;
+         SearchAndDo(Left, P)
+      END
+   END
+END SearchAndDo ;
+
+
+(*
+   CountNodes - wrapper for NoOfNodes.
+*)
+
+PROCEDURE CountNodes (t: SymbolTree; condition: IsSymbol; count: CARDINAL) : CARDINAL ;
+BEGIN
+   IF t # NIL
+   THEN
+      WITH t^ DO
+         IF condition (KeySym)
+         THEN
+            INC (count)
+         END ;
+         count := CountNodes (Left, condition, count) ;
+         count := CountNodes (Right, condition, count)
+      END
+   END ;
+   RETURN count
+END CountNodes ;
+
+
+(*
+   NoOfNodes - returns the number of nodes in the tree t.
+*)
+
+PROCEDURE NoOfNodes (t: SymbolTree; condition: IsSymbol) : CARDINAL ;
+BEGIN
+   RETURN CountNodes (t^.Left, condition, 0)
+END NoOfNodes ;
+
+
+(*
+   SearchConditional - wrapper for ForeachNodeConditionDo.
+*)
+
+PROCEDURE SearchConditional (t: SymbolTree; condition: IsSymbol; P: PerformOperation) ;
+BEGIN
+   IF t#NIL
+   THEN
+      WITH t^ DO
+         SearchConditional (Right, condition, P) ;
+         IF (KeySym # 0) AND condition (KeySym)
+         THEN
+            P (KeySym)
+         END ;
+         SearchConditional (Left, condition, P)
+      END
+   END
+END SearchConditional ;
+
+
+(*
+   ForeachNodeConditionDo - traverse the tree t and for any node which satisfied
+                            condition call P.
+*)
+
+PROCEDURE ForeachNodeConditionDo (t: SymbolTree;
+                                  condition: IsSymbol;
+                                  P: PerformOperation) ;
+BEGIN
+   IF t#NIL
+   THEN
+      WITH t^ DO
+         Assert (Right = NIL) ;
+         SearchConditional (Left, condition, P)
+      END
+   END
+END ForeachNodeConditionDo ;
+
+
+END SymbolKey.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
new file mode 100644
index 00000000000..c2f25f4e319
--- /dev/null
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -0,0 +1,3525 @@
+(* SymbolTable.def provides access to the symbol table.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE SymbolTable ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : SymbolTable
+   Date       : 7/3/87
+   Description: SymbolTable provides the higher level routines to
+                maintain a symbol table for the Modula-2 Compiler.
+*)
+
+FROM SYSTEM IMPORT WORD ;
+FROM SymbolKey IMPORT PerformOperation ;
+FROM NameKey IMPORT Name ;
+FROM m2tree IMPORT Tree ;
+FROM DynamicStrings IMPORT String ;
+FROM M2Error IMPORT ErrorScope ;
+FROM Lists IMPORT List ;
+
+EXPORT QUALIFIED NulSym,
+                 FinalSymbol,
+
+                 ModeOfAddr,
+                 GetMode, PutMode,
+
+                 AppendModuleOnImportStatement,
+                 AppendModuleImportStatement,
+
+                 StartScope, EndScope, PseudoScope,
+                 GetCurrentScope,
+                 IsDeclaredIn,
+                 CheckAnonymous, IsNameAnonymous,
+
+                 SetCurrentModule,
+                 SetMainModule,
+                 SetFileModule,
+                 MakeModule, MakeDefImp,
+                 MakeInnerModule, MakeModuleCtor, PutModuleCtorExtern,
+                 MakeProcedure,
+                 MakeProcedureCtorExtern,
+                 MakeConstant,
+                 MakeConstLit,
+                 MakeConstVar,
+                 MakeConstLitString,
+                 MakeConstString,
+                 MakeConstStringC, MakeConstStringCnul, MakeConstStringM2nul,
+                 MakeType,
+                 MakeHiddenType,
+                 MakeVar,
+                 MakeRecord,
+                 MakeVarient,
+                 MakeFieldVarient,
+                 MakeEnumeration,
+                 MakeSubrange,
+      	       	 MakeSet,
+                 MakeArray,
+                 MakeTemporary,
+                 MakeComponentRecord,
+                 MakeComponentRef,
+                 IsComponent,
+                 MakePointer,
+                 MakeSubscript,
+                 MakeUnbounded,
+                 MakeOAFamily,
+                 MakeProcType,
+                 MakeImport, MakeImportStatement,
+                 Make2Tuple,
+                 MakeGnuAsm,
+                 MakeRegInterface,
+                 MakeError, MakeErrorS,
+
+                 ForeachModuleDo,
+                 ForeachInnerModuleDo,
+                 ForeachLocalSymDo,
+                 ForeachFieldEnumerationDo,
+                 GetModule,
+                 GetCurrentModule,
+                 GetFileModule,
+                 GetMainModule,
+                 GetBaseModule,
+                 GetCurrentModuleScope,
+                 GetLastModuleScope,
+                 AddSymToModuleScope,
+                 GetType, GetLType, GetSType, GetDType,
+                 SkipType, SkipTypeAndSubrange,
+                 GetLowestType,
+                 GetSym, GetLocalSym, GetDeclareSym, GetRecord,
+                 FromModuleGetSym,
+                 GetOAFamily,
+                 GetDimension,
+                 GetNth,
+                 GetVarScope,
+                 GetSubrange,
+                 GetParam,
+                 GetString,
+                 GetStringLength,
+                 GetProcedureBuiltin,
+                 GetNthParam,
+                 GetNthProcedure,
+                 GetParameterShadowVar,
+                 GetUnbounded,
+                 GetUnboundedRecordType,
+                 GetUnboundedAddressOffset,
+                 GetUnboundedHighOffset,
+                 GetModuleQuads,
+                 PutModuleFinallyFunction, GetModuleFinallyFunction,
+                 PutExceptionBlock, HasExceptionBlock,
+                 PutExceptionFinally, HasExceptionFinally,
+                 GetProcedureQuads,
+                 GetQuads,
+                 GetReadQuads, GetWriteQuads,
+                 GetReadLimitQuads, GetWriteLimitQuads,
+                 GetDeclaredDef, GetDeclaredMod, PutDeclared,
+                 GetDeclaredDefinition, GetDeclaredModule,
+                 GetFirstUsed,
+                 PutProcedureBegin, PutProcedureEnd, GetProcedureBeginEnd,
+                 GetGnuAsmInput, GetGnuAsmOutput, GetGnuAsmTrash, GetGnuAsm,
+                 GetRegInterface,
+                 GetVariableAtAddress,
+                 GetAlignment, GetDefaultRecordFieldAlignment,
+                 PutDeclaredPacked, IsDeclaredPacked, IsDeclaredPackedResolved,
+                 GetPackedEquivalent, GetNonPackedEquivalent,
+                 GetConstStringM2, GetConstStringC, GetConstStringM2nul, GetConstStringCnul,
+                 GetModuleCtors,
+                 GetImportModule, GetImportDeclared,
+                 GetImportStatementList, GetModuleDefImportStatementList, GetModuleModImportStatementList,
+
+                 PutVar,
+                 PutVarConst,
+                 PutLeftValueFrontBackType,
+                 GetVarBackEndType,
+                 PutVarPointerCheck,
+                 GetVarPointerCheck,
+                 PutVarWritten,
+                 GetVarWritten,
+                 PutConst,
+                 PutConstString,
+                 PutDefLink,
+                 PutModLink,
+                 PutModuleBuiltin,
+
+                 PutConstSet,
+                 PutConstructor,
+                 PutConstructorFrom,
+                 PutFieldRecord,
+                 PutFieldVarient,
+                 GetVarient,
+                 GetVarientTag,
+
+                 PutVarientTag,
+                 IsRecordFieldAVarientTag,
+                 IsEmptyFieldVarient,
+                 PutFieldEnumeration,
+                 PutSubrange,
+      	       	 PutSet, IsSetPacked,
+                 PutArraySubscript, GetArraySubscript,
+                 PutArray,
+		 PutArrayLarge, IsArrayLarge,
+                 PutType,
+                 PutFunction, PutOptFunction,
+                 PutParam, PutVarParam, PutParamName,
+                 PutProcTypeParam, PutProcTypeVarParam,
+                 PutPointer,
+                 PutSubscript,
+                 PutProcedureBuiltin, PutProcedureInline,
+                 PutModuleStartQuad,
+                 PutModuleEndQuad,
+                 PutModuleFinallyStartQuad,
+                 PutModuleFinallyEndQuad,
+                 PutProcedureStartQuad,
+                 PutProcedureEndQuad,
+                 PutProcedureScopeQuad,
+                 PutProcedureReachable,
+                 PutReadQuad, RemoveReadQuad,
+                 PutWriteQuad, RemoveWriteQuad,
+                 PutGnuAsm, PutGnuAsmOutput, PutGnuAsmInput, PutGnuAsmTrash,
+                 PutGnuAsmVolatile, PutGnuAsmSimple,
+                 PutRegInterface,
+                 PutVariableAtAddress,
+                 PutAlignment, PutDefaultRecordFieldAlignment,
+                 PutUnused, IsUnused,
+                 PutVariableSSA, IsVariableSSA,
+                 PutPublic, IsPublic, PutCtor, IsCtor, PutExtern, IsExtern,
+                 PutMonoName, IsMonoName,
+
+                 IsDefImp,
+                 IsModule,
+                 IsInnerModule,
+                 IsUnknown,
+                 IsPartialUnbounded,
+                 IsType,
+                 IsProcedure,
+                 IsParameter,
+                 IsParameterUnbounded,
+                 IsParameterVar,
+                 IsVarParam,
+                 IsUnboundedParam,
+                 IsPointer,
+                 IsRecord,
+                 IsVarient,
+                 IsFieldVarient,
+                 IsEnumeration,
+                 IsFieldEnumeration,
+                 IsUnbounded,
+                 IsArray,
+                 IsRecordField,
+                 IsProcType,
+                 IsImport,
+                 IsImportStatement,
+                 IsVar,
+                 IsVarConst,
+                 IsConst,
+                 IsConstString,
+                 IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul,
+                 IsConstLit,
+                 IsConstSet,
+                 IsConstructor,
+                 IsDummy,
+                 IsTemporary, IsVarAParam,
+                 IsSubscript,
+                 IsSubrange,
+      	       	 IsSet,
+                 IsHiddenType,
+                 IsAModula2Type,
+                 IsGnuAsmVolatile, IsGnuAsmSimple, IsGnuAsm, IsRegInterface,
+                 IsError,
+                 IsObject,
+                 IsTuple,
+                 IsComposite,
+
+                 IsReallyPointer,
+                 IsLegal,
+
+                 IsProcedureReachable,
+                 IsProcedureVariable,
+                 IsProcedureNested,
+                 IsProcedureBuiltin, IsProcedureInline,
+                 IsModuleWithinProcedure,
+                 IsVariableAtAddress,
+                 IsReturnOptional,
+                 IsDefLink,
+                 IsModLink,
+                 IsModuleBuiltin,
+
+                 ForeachProcedureDo,
+                 ProcedureParametersDefined,
+                 AreProcedureParametersDefined,
+                 ParametersDefinedInDefinition,
+                 AreParametersDefinedInDefinition,
+                 ParametersDefinedInImplementation,
+                 AreParametersDefinedInImplementation,
+
+                 PutUseVarArgs,
+                 UsesVarArgs,
+                 PutUseOptArg,
+                 UsesOptArg,
+                 PutOptArgInit,
+                 GetOptArgInit,
+                 PutPriority,
+                 GetPriority,
+                 PutNeedSavePriority,
+                 GetNeedSavePriority,
+
+                 NoOfVariables,
+                 NoOfElements,
+                 NoOfParam,
+                 AddNameToImportList,
+                 AddNameToScope, ResolveImports,
+                 GetScope, GetModuleScope, GetProcedureScope,
+                 GetParent,
+
+                 GetSymName,
+                 RenameSym,
+
+                 RequestSym,
+
+                 GetExported,
+                 PutImported,
+                 PutIncluded,
+                 PutExported,
+                 PutExportQualified,
+                 PutExportUnQualified,
+                 PutExportUnImplemented,
+                 GetFromOuterModule,
+                 IsExportQualified,
+                 IsExportUnQualified,
+                 IsExported,
+                 IsImplicityExported,
+                 IsImported,
+                 PutIncludedByDefinition, IsIncludedByDefinition,
+                 TryMoveUndeclaredSymToInnerModule,
+                 ForeachImportedDo,
+                 ForeachExportedDo,
+                 ForeachOAFamily,
+
+                 CheckForExportedImplementation,
+                 CheckForUnImplementedExports,
+                 CheckForUndeclaredExports,
+                 CheckForUnknownInModule, UnknownReported,
+                 CheckHiddenTypeAreAddress,
+
+                 CheckForEnumerationInCurrentModule,
+                 PutHiddenTypeDeclared,
+                 IsHiddenTypeDeclared,
+
+                 PutDefinitionForC,
+                 IsDefinitionForC,
+
+                 PutDoesNeedExportList, PutDoesNotNeedExportList,
+                 DoesNotNeedExportList,
+                 ResolveConstructorTypes,
+                 MakeTemporaryFromExpression, MakeTemporaryFromExpressions,
+                 SanityCheckConstants,
+
+                 PutModuleContainsBuiltin, IsBuiltinInModule,
+		 HasVarParameters,
+                 GetErrorScope,
+
+                 IsSizeSolved,
+                 IsOffsetSolved,
+                 IsValueSolved,
+                 IsConstructorConstant,
+                 IsSumOfParamSizeSolved,
+                 PushSize,
+                 PushOffset,
+                 PushValue,
+                 PushParamSize,
+                 PushVarSize,
+                 PushSumOfLocalVarSize,
+                 PushSumOfParamSize,
+                 PopValue,
+                 PopSize,
+                 PopOffset,
+                 PopSumOfParamSize,
+                 DisplayTrees,
+		 DebugLineNumbers ;
+
+
+(*
+   Throughout this module any SymKey value of 0 is deemed to be a
+   nul symbol.
+*)
+
+CONST
+   NulSym = 0 ;
+
+
+(*
+   Mode describes the modes of the variables and constants
+*)
+
+TYPE
+   ModeOfAddr = (NoValue, ImmediateValue, RightValue, LeftValue) ;
+   FamilyOperation = PROCEDURE (CARDINAL, CARDINAL, CARDINAL) ;
+
+
+(*
+   FinalSymbol - returns the highest number symbol used.
+*)
+
+PROCEDURE FinalSymbol () : CARDINAL ;
+
+
+(*
+   MakeComponentRecord - make a temporary which will be used to reference and field
+                         (or sub field) of record.
+*)
+
+PROCEDURE MakeComponentRecord (tok: CARDINAL;
+                               Mode: ModeOfAddr; record: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeComponentRef - use, sym, to reference, field, sym is returned.
+*)
+
+PROCEDURE MakeComponentRef (sym: CARDINAL; field: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsComponent - returns TRUE if symbol, sym, is a temporary and a component
+                 reference.
+*)
+
+PROCEDURE IsComponent (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   MakeTemporary - makes a new temporary variable at the highest real scope.
+                   The addressing mode of the temporary is set to Mode.
+*)
+
+PROCEDURE MakeTemporary (tok: CARDINAL; Mode: ModeOfAddr) : CARDINAL ;
+
+
+(*
+   MakeTemporaryFromExpression - makes a new temporary variable at the
+                                 highest real scope.  The addressing
+                                 mode of the temporary is set and the
+                                 type is determined by expressions, e.
+*)
+
+PROCEDURE MakeTemporaryFromExpression (tok: CARDINAL;
+                                       e: CARDINAL;
+                                       mode: ModeOfAddr) : CARDINAL ;
+
+(*
+   MakeTemporaryFromExpressions - makes a new temporary variable at the
+                                  highest real scope.  The addressing
+                                  mode of the temporary is set and the
+                                  type is determined by expressions,
+                                  e1 and e2.
+*)
+
+PROCEDURE MakeTemporaryFromExpressions (tok: CARDINAL;
+                                        e1, e2: CARDINAL;
+                                        mode: ModeOfAddr) : CARDINAL ;
+
+
+(*
+   PutMode - Puts the addressing mode, SymMode, into symbol Sym.
+      	     The mode may only be altered if the mode is None.
+*)
+
+PROCEDURE PutMode (Sym: CARDINAL; SymMode: ModeOfAddr) ;
+
+
+(*
+   GetMode - Returns the addressing mode of a symbol.
+*)
+
+PROCEDURE GetMode (Sym: CARDINAL) : ModeOfAddr ;
+
+
+(*
+   StartScope - starts a block scope at Sym.
+*)
+
+PROCEDURE StartScope (Sym: CARDINAL) ;
+
+
+(*
+   EndScope - ends a block scope started by StartScope. The current
+              head of the symbol scope reverts back to the symbol
+              which was the Head of the symbol scope before the
+              last StartScope was called.
+*)
+
+PROCEDURE EndScope ;
+
+
+(*
+   PseudoScope - starts a pseudo scope. This is used to implement
+                 enumeration types. It is nesessary since the
+                 enumeration type does not have an explicit
+                 structure, as opposed to RECORD, WITH, MODULE and
+                 PROCEDURE. Therefore there is no explicit end and
+                 hence the end of an outer scope would cause the
+                 end of the enumeration scope. Thus we need to have
+                 a pseudo scope which will be treated the same
+                 during the search of a symbol, but will be popped
+                 automatically when the EndScope calls - for a
+                 structured scope end.
+*)
+
+PROCEDURE PseudoScope (Sym: CARDINAL) ;
+
+
+(*
+   GetCurrentScope - returns the symbol who is responsible for the current
+                     scope. Note that it ignores pseudo scopes.
+*)
+
+PROCEDURE GetCurrentScope () : CARDINAL ;
+
+
+(*
+   IsDeclaredIn - returns TRUE if a symbol was declared in, scope.
+*)
+
+PROCEDURE IsDeclaredIn (scope, sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   SetCurrentModule - Used to set the CurrentModule to a symbol, Sym.
+                      This Sym may represent an inner module.
+*)
+
+PROCEDURE SetCurrentModule (Sym: CARDINAL) ;
+
+
+(*
+   SetFileModule - Used to set the FileModule to a symbol, Sym.
+                   This Sym must represent the current program module
+                   file which is being parsed.
+*)
+
+PROCEDURE SetFileModule (Sym: CARDINAL) ;
+
+
+(*
+   SetMainModule - Used to set the MainModule to a symbol, Sym.
+                   This Sym must represent the main module which was
+                   envoked by the user to be compiled.
+*)
+
+PROCEDURE SetMainModule (Sym: CARDINAL) ;
+
+
+(*
+   CheckAnonymous - checks to see whether the name is NulName and if so
+                    it creates a unique anonymous name.
+*)
+
+PROCEDURE CheckAnonymous (name: Name) : Name ;
+
+
+(*
+   IsNameAnonymous - returns TRUE if the symbol, sym, has an anonymous name
+                     or no name.
+*)
+
+PROCEDURE IsNameAnonymous (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   NoOfVariables - returns the number of variables in scope.  The scope maybe
+                   a procedure, module or defimp scope.
+*)
+
+PROCEDURE NoOfVariables (scope: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeModule - creates a module sym with ModuleName. It returns the
+                symbol index.
+*)
+
+PROCEDURE MakeModule (tok: CARDINAL; ModuleName: Name) : CARDINAL ;
+
+
+(*
+   MakeDefImp - creates a definition and implementation module sym
+                with name DefImpName. It returns the symbol index.
+*)
+
+PROCEDURE MakeDefImp (tok: CARDINAL; DefImpName: Name) : CARDINAL ;
+
+
+(*
+   MakeInnerModule - creates an inner module sym with ModuleName. It returns the
+                     symbol index.
+*)
+
+PROCEDURE MakeInnerModule (tok: CARDINAL; ModuleName: Name) : CARDINAL ;
+
+
+(*
+   MakeProcedure - creates a procedure sym with name. It returns
+                   the symbol index.
+*)
+
+PROCEDURE MakeProcedure (tok: CARDINAL; ProcedureName: Name) : CARDINAL ;
+
+
+(*
+   MakeProcedureCtorExtern - creates an extern ctor procedure
+*)
+
+PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; modulename: Name) : CARDINAL ;
+
+
+(*
+   PutMonoName - changes the IsMonoName boolean inside the procedure.
+*)
+
+PROCEDURE PutMonoName (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   IsMonoName - returns the public boolean associated with a procedure.
+*)
+
+PROCEDURE IsMonoName (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutExtern - changes the extern boolean inside the procedure.
+*)
+
+PROCEDURE PutExtern (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   IsExtern - returns the public boolean associated with a procedure.
+*)
+
+PROCEDURE IsExtern (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutPublic - changes the public boolean inside the procedure.
+*)
+
+PROCEDURE PutPublic (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   IsPublic - returns the public boolean associated with a procedure.
+*)
+
+PROCEDURE IsPublic (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutCtor - changes the ctor boolean inside the procedure.
+*)
+
+PROCEDURE PutCtor (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   IsCtor - returns the ctor boolean associated with a procedure.
+*)
+
+PROCEDURE IsCtor (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetModuleCtors - mod can be a DefImp or Module symbol.  ctor, init and fini
+                    are assigned for this module.  An inner module ctor value will
+                    be NulSym.
+*)
+
+PROCEDURE GetModuleCtors (mod: CARDINAL; VAR ctor, init, fini, dep: CARDINAL) ;
+
+
+(*
+   MakeModuleCtor - for a defimp or module symbol create all the ctor
+                    related procedures.
+*)
+
+PROCEDURE MakeModuleCtor (moduleTok, beginTok, finallyTok: CARDINAL;
+                          moduleSym: CARDINAL) ;
+
+
+(*
+   PutModuleCtorExtern - for every ctor related procedure in module sym.
+                         Make it external.  It will create any missing
+                         init/fini procedures but not any missing dep/ctor
+                         procedures.
+*)
+
+PROCEDURE PutModuleCtorExtern (tok: CARDINAL; sym: CARDINAL; external: BOOLEAN) ;
+
+
+(*
+   MakeVar - creates a variable sym with VarName. It returns the
+             symbol index.
+*)
+
+PROCEDURE MakeVar (tok: CARDINAL; VarName: Name) : CARDINAL ;
+
+
+(*
+   MakeRecord - makes a Record symbol with name RecordName.
+*)
+
+PROCEDURE MakeRecord (tok: CARDINAL; RecordName: Name) : CARDINAL ;
+
+
+(*
+   MakeVarient - creates a new symbol, a varient symbol for record or varient field
+                 symbol, RecOrVarFieldSym.
+*)
+
+PROCEDURE MakeVarient (tok: CARDINAL; RecOrVarFieldSym: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeFieldVarient - returns a FieldVarient symbol which has been
+                      assigned to the Varient symbol, Sym.
+*)
+
+PROCEDURE MakeFieldVarient (n: Name; Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeEnumeration - places a new symbol in the current scope, the symbol
+                     is an enumeration symbol. The symbol index is returned.
+*)
+
+PROCEDURE MakeEnumeration (tok: CARDINAL; EnumerationName: Name) : CARDINAL ;
+
+
+(*
+   MakeType - makes a type symbol with name TypeName.
+*)
+
+PROCEDURE MakeType (tok: CARDINAL; TypeName: Name) : CARDINAL ;
+
+
+(*
+   MakeHiddenType - makes a type symbol that is hidden from the
+                    definition module.
+                    This symbol is placed into the UnImplemented list of
+                    the definition/implementation module.
+                    The type will be filled in when the implementation module
+                    is reached.
+*)
+
+PROCEDURE MakeHiddenType (tok: CARDINAL; TypeName: Name) : CARDINAL ;
+
+
+(*
+   MakeConstant - create a constant cardinal and return the symbol.
+*)
+
+PROCEDURE MakeConstant (tok: CARDINAL; value: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeConstLit - returns a constant literal of type, constType, with a constName,
+                  at location, tok.
+*)
+
+PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeConstVar - makes a ConstVar type with
+                  name ConstVarName.
+*)
+
+PROCEDURE MakeConstVar (tok: CARDINAL; ConstVarName: Name) : CARDINAL ;
+
+
+(*
+   MakeConstLitString - put a constant which has the string described by
+                        ConstName into the ConstantTree and return a symbol.
+                        This symbol is known as a String Constant rather than a
+                        ConstLit which indicates a number.
+                        If the constant already exits
+                        then a duplicate constant is not entered in the tree.
+                        All values of constant strings
+                        are ignored in Pass 1 and evaluated in Pass 2 via
+                        character manipulation.
+*)
+
+PROCEDURE MakeConstLitString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
+
+
+(*
+   MakeConstString - puts a constant into the symboltable which is a string.
+                     The string value is unknown at this time and will be
+                     filled in later by PutString.
+*)
+
+PROCEDURE MakeConstString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
+
+
+(*
+   MakeSubrange - makes a new symbol into a subrange type with
+                  name SubrangeName.
+*)
+
+PROCEDURE MakeSubrange (tok: CARDINAL; SubrangeName: Name) : CARDINAL ;
+
+
+(*
+   MakeSet - makes a set Symbol with name, SetName.
+*)
+
+PROCEDURE MakeSet (tok: CARDINAL; SetName: Name) : CARDINAL ;
+
+
+(*
+   MakeArray - makes an Array symbol with name ArrayName.
+*)
+
+PROCEDURE MakeArray (tok: CARDINAL; ArrayName: Name) : CARDINAL ;
+
+
+(*
+   PutArrayLarge - indicates that this is a large array in which case
+                   the interface to gcc maps this array from 0..high-low,
+                   using an integer indice.
+*)
+
+PROCEDURE PutArrayLarge (array: CARDINAL) ;
+
+
+(*
+   IsArrayLarge - returns TRUE if we need to treat this as a large array.
+*)
+
+PROCEDURE IsArrayLarge (array: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutPriority - places a interrupt, priority, value into module, module.
+*)
+
+PROCEDURE PutPriority (module: CARDINAL; priority: CARDINAL) ;
+
+
+(*
+   GetPriority - returns the interrupt priority which was assigned to
+                 module, module.
+*)
+
+PROCEDURE GetPriority (module: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutNeedSavePriority - set a boolean flag indicating that this procedure
+                         needs to save and restore interrupts.
+*)
+
+PROCEDURE PutNeedSavePriority (sym: CARDINAL) ;
+
+
+(*
+   GetNeedSavePriority - returns the boolean flag indicating whether this procedure
+                         needs to save and restore interrupts.
+*)
+
+PROCEDURE GetNeedSavePriority (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutVariableAtAddress - determines that a variable, sym, is declared at
+                          a specific address.
+*)
+
+PROCEDURE PutVariableAtAddress (sym: CARDINAL; address: CARDINAL) ;
+
+
+(*
+   GetVariableAtAddress - returns the address at which variable, sym, is declared.
+*)
+
+PROCEDURE GetVariableAtAddress (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsVariableAtAddress - returns TRUE if a variable, sym, was declared at
+                         a specific address.
+*)
+
+PROCEDURE IsVariableAtAddress (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutVariableSSA - assigns value to the SSA field within variable sym.
+*)
+
+PROCEDURE PutVariableSSA (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   IsVariableSSA - returns TRUE if variable is known to be a SSA.
+*)
+
+PROCEDURE IsVariableSSA (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutVarConst - sets the IsConst field to value indicating the variable is read only.
+*)
+
+PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   MakeGnuAsm - create a GnuAsm symbol.
+*)
+
+PROCEDURE MakeGnuAsm () : CARDINAL ;
+
+
+(*
+   PutGnuAsm - places the instruction textual name into the GnuAsm symbol.
+*)
+
+PROCEDURE PutGnuAsm (sym: CARDINAL; string: CARDINAL) ;
+
+
+(*
+   PutGnuAsmOutput - places the interface object, out, into GnuAsm symbol, sym.
+*)
+
+PROCEDURE PutGnuAsmOutput (sym: CARDINAL; out: CARDINAL) ;
+
+
+(*
+   PutGnuAsmInput - places the interface object, in, into GnuAsm symbol, sym.
+*)
+
+PROCEDURE PutGnuAsmInput (sym: CARDINAL; in: CARDINAL) ;
+
+
+(*
+   PutGnuAsmTrash - places the interface object, trash, into GnuAsm symbol, sym.
+*)
+
+PROCEDURE PutGnuAsmTrash (sym: CARDINAL; trash: CARDINAL) ;
+
+
+(*
+   GetGnuAsm - returns the string symbol, representing the instruction textual
+               of the GnuAsm symbol. It will return a ConstString.
+*)
+
+PROCEDURE GetGnuAsm (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetGnuAsmInput - returns the input list of registers.
+*)
+
+PROCEDURE GetGnuAsmInput (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetGnuAsmOutput - returns the output list of registers.
+*)
+
+PROCEDURE GetGnuAsmOutput (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetGnuAsmTrash - returns the list of trashed registers.
+*)
+
+PROCEDURE GetGnuAsmTrash (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutGnuAsmVolatile - defines a GnuAsm symbol as VOLATILE.
+*)
+
+PROCEDURE PutGnuAsmVolatile (Sym: CARDINAL) ;
+
+
+(*
+   PutGnuAsmSimple - defines a GnuAsm symbol as a simple kind.
+*)
+
+PROCEDURE PutGnuAsmSimple (Sym: CARDINAL) ;
+
+
+(*
+   MakeRegInterface - creates and returns a register interface symbol.
+*)
+
+PROCEDURE MakeRegInterface () : CARDINAL ;
+
+
+(*
+   PutRegInterface - places a, name, string, and, object, into the interface array,
+                     sym, at position, i.
+                     The string symbol will either be a register name or a constraint.
+                     The object is an optional Modula-2 variable or constant symbol.
+*)
+
+PROCEDURE PutRegInterface (sym: CARDINAL; i: CARDINAL;
+                           n: Name; string, object: CARDINAL) ;
+
+
+(*
+   GetRegInterface - gets a, name, string, and, object, from the interface array,
+                     sym, from position, i.
+*)
+
+PROCEDURE GetRegInterface (sym: CARDINAL; i: CARDINAL;
+                           VAR n: Name; VAR string, object: CARDINAL) ;
+
+
+(*
+   GetModule - Returns the Module symbol for the module with name, n.
+*)
+
+PROCEDURE GetModule (name: Name) : CARDINAL ;
+
+
+(*
+   GetCurrentModule - returns the current module Sym that is being
+                      compiled. It may return an inner module.
+*)
+
+PROCEDURE GetCurrentModule () : CARDINAL ;
+
+
+(*
+   GetFileModule - returns the FileModule symbol that was requested by
+                   the user to be compiled.
+*)
+
+PROCEDURE GetFileModule () : CARDINAL ;
+
+
+(*
+   GetBaseModule - returns the base module symbol that contains Modula-2
+                   base types, procedures and functions.
+*)
+
+PROCEDURE GetBaseModule () : CARDINAL ;
+
+
+(*
+   GetMainModule - returns the main module symbol that was requested by
+                   the user to be compiled.
+*)
+
+PROCEDURE GetMainModule () : CARDINAL ;
+
+
+(*
+   GetCurrentModuleScope - returns the module symbol which forms the
+                           current (possibly inner most) module.
+*)
+
+PROCEDURE GetCurrentModuleScope () : CARDINAL ;
+
+
+(*
+   GetLastModuleScope - returns the last module scope encountered,
+                        the module scope before the Current Module Scope.
+*)
+
+PROCEDURE GetLastModuleScope () : CARDINAL ;
+
+
+(*
+   AddSymToModuleScope - adds a symbol, Sym, to the scope of the module
+                         ModSym.
+*)
+
+PROCEDURE AddSymToModuleScope (ModSym: CARDINAL; Sym: CARDINAL) ;
+
+
+(*
+   GetType - Returns the symbol that is the TYPE symbol to Sym.
+             If NulSym is returned then we assume type unknown.
+*)
+
+PROCEDURE GetType (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   SkipType - if sym is a TYPE foo = bar
+              then call SkipType(bar)
+              else return sym
+
+              it does not skip over hidden types.
+*)
+
+PROCEDURE SkipType (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   SkipTypeAndSubrange - if sym is a TYPE foo = bar OR
+                            sym is declared as a subrange of bar
+                         then call SkipTypeAndSubrange(bar)
+                         else return sym
+
+                         it does not skip over hidden types.
+*)
+
+PROCEDURE SkipTypeAndSubrange (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetLowestType - Returns the lowest type in the type chain of
+                   symbol Sym.
+                   If NulSym is returned then we assume type unknown.
+*)
+
+PROCEDURE GetLowestType (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetLType - get lowest type.  It returns the lowest type
+              of symbol, sym.  It skips over type equivalences.
+*)
+
+PROCEDURE GetLType (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetSType - get source type.  It returns the type closest
+              to the object.  It does not skip over type
+              equivalences.
+*)
+
+PROCEDURE GetSType (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetDType - get gcc declared type.  It returns the type
+              of the object which is declared to GCC.
+              It does skip over type equivalences but only
+              if they do not contain a user alignment.
+              It does not skip over hidden types.
+
+              This is the same as SkipType(GetType(sym))
+*)
+
+PROCEDURE GetDType (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetSym - searches the current scope (and previous scopes if the
+            scope tranparent allows) for a symbol with Name.
+*)
+
+PROCEDURE GetSym (name: Name) : CARDINAL ;
+
+
+(*
+   GetDeclareSym - searches for a symbol with a name SymName in the
+                   current and previous scopes.
+                   If the symbol is found then it is returned
+                   else an unknown symbol is returned.
+                   This procedure assumes that SymName is being
+                   declared at this point and therefore it does
+                   not examine the base scope (for pervasive
+                   identifiers).
+*)
+
+PROCEDURE GetDeclareSym (tok: CARDINAL; SymName: Name) : CARDINAL ;
+
+
+(*
+   GetLocalSym - only searches the scope Sym for a symbol with Name
+                 and returns the index to the symbol.
+*)
+
+PROCEDURE GetLocalSym (Sym: CARDINAL; name: Name) : CARDINAL ;
+
+
+(*
+   GetRecord - fetches the record symbol from the parent of Sym.
+               Sym maybe a varient symbol in which case its parent is searched
+               etc.
+*)
+
+PROCEDURE GetRecord (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   FromModuleGetSym - attempts to find a symbol of name, n, in the
+                      module, mod, scope.  An unknown symbol is created
+                      at token position tok if necessary.
+*)
+
+PROCEDURE FromModuleGetSym (tok: CARDINAL;
+                            n: Name; mod: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetNth - returns the n th symbol in the list of father Sym.
+            Sym may be a Module, DefImp, Procedure or Record symbol.
+*)
+
+PROCEDURE GetNth (Sym: CARDINAL; n: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetNthParam - returns the n th parameter in procedure Sym.
+                 Sym may be an ordinary procedure or a
+                 procedure variable.
+                 ParamNo of zero yields the return argument
+                 if the procedure is a function.
+                 NOTE that this is returned as a type NOT
+                 a parameter.
+*)
+
+PROCEDURE GetNthParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetVarScope - returns the symbol definining the scope where, Sym, was declared.
+                 ie a Module, DefImp or Procedure Symbol.
+*)
+
+PROCEDURE GetVarScope (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetSubrange - returns HighSym and LowSym - two constants
+                 which make up the subrange.
+*)
+
+PROCEDURE GetSubrange (Sym: CARDINAL; VAR HighSym, LowSym: CARDINAL) ;
+
+
+(*
+   GetParam - returns the ParamNo parameter from procedure ProcSym
+*)
+
+PROCEDURE GetParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetString - returns the actual string key for ConstString symbol Sym,
+               which is not necessarily the same as its name.
+               ie CONST
+                     hello = 'HELLO' ;      Name = hello, string = HELLO
+                     GetString returns HELLO
+
+               and simply 'Hello World'     Name will be same
+                     GetString returns Hello World
+*)
+
+PROCEDURE GetString (Sym: CARDINAL) : Name ;
+
+
+(*
+   GetStringLength - returns the actual string length for ConstString
+                     symbol Sym.
+*)
+
+PROCEDURE GetStringLength (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetProcedureBuiltin - returns the builtin name for the equivalent procedure, Sym.
+*)
+
+PROCEDURE GetProcedureBuiltin (Sym: CARDINAL) : Name ;
+
+
+(*
+   PutProcedureBuiltin - assigns the builtin name for the equivalent procedure, Sym.
+*)
+
+PROCEDURE PutProcedureBuiltin (Sym: CARDINAL; name: Name) ;
+
+
+(*
+   IsProcedureBuiltin - returns TRUE if this procedure has a builtin equivalent.
+*)
+
+PROCEDURE IsProcedureBuiltin (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutProcedureInline - determines that procedure, Sym, has been requested to be inlined.
+*)
+
+PROCEDURE PutProcedureInline (Sym: CARDINAL) ;
+
+
+(*
+   IsProcedureBuiltin - returns TRUE if this procedure was declared as inlined.
+*)
+
+PROCEDURE IsProcedureInline (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutExceptionBlock - sets a BOOLEAN in block module/procedure/defimp,
+                       sym, indicating that this block as an EXCEPT
+                       statement sequence.
+*)
+
+PROCEDURE PutExceptionBlock (sym: CARDINAL) ;
+
+
+(*
+   HasExceptionBlock - returns a BOOLEAN determining whether
+                       module/procedure/defimp, sym, has
+                       an EXCEPT statement sequence.
+*)
+
+PROCEDURE HasExceptionBlock (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutExceptionFinally - sets a BOOLEAN in block module/defimp,
+                         sym, indicating that this FINALLY block
+                         as an EXCEPT statement sequence.
+*)
+
+PROCEDURE PutExceptionFinally (sym: CARDINAL) ;
+
+
+(*
+   HasExceptionFinally - returns a BOOLEAN determining whether
+                         module/defimp, sym, has
+                         an EXCEPT statement sequence.
+*)
+
+PROCEDURE HasExceptionFinally (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutVar - gives the variable symbol Sym a type VarType.
+*)
+
+PROCEDURE PutVar (Sym: CARDINAL; VarType: CARDINAL) ;
+
+
+(*
+   PutLeftValueFrontBackType - gives the variable symbol a front and backend type.
+                               The variable must be a LeftValue.
+*)
+
+PROCEDURE PutLeftValueFrontBackType (Sym: CARDINAL; FrontType, BackType: CARDINAL) ;
+
+
+(*
+   GetVarBackEndType - returns the back end type if specified.
+*)
+
+PROCEDURE GetVarBackEndType (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutVarPointerCheck - marks variable, sym, as requiring (or not
+                        depending upon the, value), a NIL pointer check
+                        when this symbol is dereferenced.
+*)
+
+PROCEDURE PutVarPointerCheck (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   GetVarPointerCheck - returns TRUE if this symbol is a variable and
+                        has been marked as needing a pointer via NIL check.
+*)
+
+PROCEDURE GetVarPointerCheck (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutVarWritten - marks variable, sym, as being written to (or not
+                   depending upon the, value).
+*)
+
+PROCEDURE PutVarWritten (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   GetVarWritten - returns TRUE if this symbol is a variable and
+                   has been marked as being written.
+*)
+
+PROCEDURE GetVarWritten (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutConst - gives the constant symbol Sym a type ConstType.
+*)
+
+PROCEDURE PutConst (Sym: CARDINAL; ConstType: CARDINAL) ;
+
+
+(*
+   PutConstString - places contents into a constant symbol, sym.
+                    sym maybe a ConstString or a ConstVar.  If the later is
+                    true then the ConstVar is converted to a ConstString.
+*)
+
+PROCEDURE PutConstString (tok: CARDINAL; sym: CARDINAL; contents: Name) ;
+
+
+(*
+   GetConstStringM2 - returns the Modula-2 variant of a string
+                      (with no added nul terminator).
+*)
+
+PROCEDURE GetConstStringM2 (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetConstStringC - returns the C variant of a string
+                     (with no added nul terminator).
+*)
+
+PROCEDURE GetConstStringC (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetConstStringM2nul - returns the Modula-2 variant of a string
+                         (with added nul terminator).
+*)
+
+PROCEDURE GetConstStringM2nul (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetConstStringCnul - returns the C variant of a string
+                        (with no added nul terminator).
+*)
+
+PROCEDURE GetConstStringCnul (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutConstSet - informs the constant symbol, sym, that it is or will contain
+                 a set value.
+*)
+
+PROCEDURE PutConstSet (Sym: CARDINAL) ;
+
+
+(*
+   IsConstSet - returns TRUE if the constant is declared as a set.
+*)
+
+PROCEDURE IsConstSet (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutConstructor - informs the symbol sym that this will be
+                    a constructor constant.
+*)
+
+PROCEDURE PutConstructor (Sym: CARDINAL) ;
+
+
+(*
+   PutConstructorFrom - sets the from type field in constructor
+                        Sym to from.
+*)
+
+PROCEDURE PutConstructorFrom (Sym: CARDINAL; from: CARDINAL) ;
+
+
+(*
+   PutFieldRecord - places a field, FieldName and FieldType into a record, Sym.
+                    VarSym is a optional varient symbol which can be returned
+                    by a call to GetVarient(fieldsymbol).  The created field
+                    is returned.
+*)
+
+PROCEDURE PutFieldRecord (Sym: CARDINAL;
+                          FieldName: Name; FieldType: CARDINAL;
+                          VarSym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutFieldVarient - places the field varient, Field, as a brother to, the
+                     varient symbol, sym.
+*)
+
+PROCEDURE PutFieldVarient (Field, Sym: CARDINAL) ;
+
+
+(*
+   GetVarient - returns the varient symbol associated with the
+                record or varient field symbol, Field.
+*)
+
+PROCEDURE GetVarient (Field: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsRecordFieldAVarientTag - returns TRUE if record field, sym, is
+                              a varient tag.
+*)
+
+PROCEDURE IsRecordFieldAVarientTag (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsEmptyFieldVarient - returns TRUE if the field variant has
+                         no fields.  This will occur then the
+                         compiler constructs 'else end' variants.
+*)
+
+PROCEDURE IsEmptyFieldVarient (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetVarientTag - returns the varient tag from, Sym.
+*)
+
+PROCEDURE GetVarientTag (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutVarientTag - places, Tag, into varient, Sym.
+*)
+
+PROCEDURE PutVarientTag (Sym, Tag: CARDINAL) ;
+
+
+(*
+   PutFieldEnumeration - places a field into the enumeration type
+                         Sym. The field has a name FieldName and a
+                         value FieldVal.
+*)
+
+PROCEDURE PutFieldEnumeration (tok: CARDINAL; Sym: CARDINAL; FieldName: Name) ;
+
+
+(*
+   PutSubrange - places LowSym and HighSym as two symbols
+                 which provide the limits of the range.
+*)
+
+PROCEDURE PutSubrange (Sym: CARDINAL; LowSym, HighSym: CARDINAL;
+                       TypeSymbol: CARDINAL) ;
+
+
+(*
+   PutSet - places SimpleType as the type for set, Sym.
+*)
+
+PROCEDURE PutSet (Sym: CARDINAL; SimpleType: CARDINAL; packed: BOOLEAN) ;
+
+
+(*
+   IsSetPacked - returns TRUE if Sym is packed.
+*)
+
+PROCEDURE IsSetPacked (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetArraySubscript - returns the subrange symbol for array, Sym.
+*)
+
+PROCEDURE GetArraySubscript (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutArraySubscript - places an index field into the array Sym. The
+                       index field is a subscript sym.
+*)
+
+PROCEDURE PutArraySubscript (Sym: CARDINAL; SubscriptSymbol: CARDINAL) ;
+
+
+(*
+   PutType - gives a type symbol Sym type TypeSymbol.
+*)
+
+PROCEDURE PutType (Sym: CARDINAL; TypeSymbol: CARDINAL) ;
+
+
+(*
+   PutFunction - Places a TypeSym as the return type to a procedure Sym.
+*)
+
+PROCEDURE PutFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
+
+
+(*
+   PutOptFunction - places a TypeSym as the optional return type to a procedure Sym.
+*)
+
+PROCEDURE PutOptFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
+
+
+(*
+   IsReturnOptional - returns TRUE if the return value for, sym, is
+                      optional.
+*)
+
+PROCEDURE IsReturnOptional (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutParam - Places a Non VAR parameter ParamName with type ParamType into
+              procedure Sym. The parameter number is ParamNo.
+              If the procedure Sym already has this parameter then
+              the parameter is checked for consistancy and the
+              consistancy test is returned.
+*)
+
+PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
+                    ParamName: Name; ParamType: CARDINAL;
+                    isUnbounded: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   PutVarParam - Places a Non VAR parameter ParamName with type
+                 ParamType into procedure Sym.
+                 The parameter number is ParamNo.
+                 If the procedure Sym already has this parameter then
+                 the parameter is checked for consistancy and the
+                 consistancy test is returned.
+*)
+
+PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
+                       ParamName: Name; ParamType: CARDINAL;
+                       isUnbounded: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   PutParamName - assigns a name, name, to paramater, no, of procedure,
+                  ProcSym.
+*)
+
+PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL; name: Name) ;
+
+
+(*
+   PutProcedureReachable - Sets the procedure, Sym, to be reachable by the
+                           main Module.
+*)
+
+PROCEDURE PutProcedureReachable (Sym: CARDINAL) ;
+
+
+(*
+   IsProcedureReachable - Returns true if the procedure, Sym, is
+                          reachable from the main Module.
+*)
+
+PROCEDURE IsProcedureReachable (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutModuleStartQuad - Places QuadNumber into the Module symbol, Sym.
+                        QuadNumber is the start quad of Module,
+                        Sym.
+*)
+
+PROCEDURE PutModuleStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+
+
+(*
+   PutModuleEndQuad - Places QuadNumber into the Module symbol, Sym.
+                      QuadNumber is the end quad of Module,
+                      Sym.
+*)
+
+PROCEDURE PutModuleEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+
+
+(*
+   PutModuleFinallyStartQuad - Places QuadNumber into the Module symbol, Sym.
+                               QuadNumber is the finally start quad of
+                               Module, Sym.
+*)
+
+PROCEDURE PutModuleFinallyStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+
+
+(*
+   PutModuleFinallyEndQuad - Places QuadNumber into the Module symbol, Sym.
+                             QuadNumber is the end quad of the finally block
+                             in Module, Sym.
+*)
+
+PROCEDURE PutModuleFinallyEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+
+
+(*
+   GetModuleQuads - Returns, StartInit EndInit StartFinish EndFinish,
+                    Quads of a Module, Sym.
+                    Start and End represent the initialization code
+                    of the Module, Sym.
+*)
+
+PROCEDURE GetModuleQuads (Sym: CARDINAL;
+                          VAR StartInit, EndInit,
+                          StartFinish, EndFinish: CARDINAL) ;
+
+(*
+   PutModuleFinallyFunction - Places Tree, finally, into the Module symbol, Sym.
+*)
+
+PROCEDURE PutModuleFinallyFunction (Sym: CARDINAL; finally: Tree) ;
+
+
+(*
+   GetModuleFinallyFunction - returns the finally tree from the Module symbol, Sym.
+*)
+
+PROCEDURE GetModuleFinallyFunction (Sym: CARDINAL) : Tree ;
+
+
+(*
+   PutProcedureScopeQuad - Places QuadNumber into the Procedure symbol, Sym.
+                           QuadNumber is the start quad of procedure,
+                           Sym.
+*)
+
+PROCEDURE PutProcedureScopeQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+
+
+(*
+   PutProcedureStartQuad - Places QuadNumber into the Procedure symbol, Sym.
+                           QuadNumber is the start quad of procedure,
+                           Sym.
+*)
+
+PROCEDURE PutProcedureStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+
+
+(*
+   PutProcedureEndQuad - Places QuadNumber into the Procedure symbol, Sym.
+                         QuadNumber is the end quad of procedure,
+                         Sym.
+*)
+
+PROCEDURE PutProcedureEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+
+
+(*
+   GetProcedureQuads - Returns, Start and End, Quads of a procedure, Sym.
+*)
+
+PROCEDURE GetProcedureQuads (Sym: CARDINAL; VAR scope, start, end: CARDINAL) ;
+
+
+(*
+   GetQuads - assigns Start and End to the beginning and end of
+              symbol, Sym, usage.
+*)
+
+PROCEDURE GetQuads (Sym: CARDINAL; m: ModeOfAddr;
+                    VAR Start, End: CARDINAL) ;
+
+
+(*
+   GetReadQuads - assigns Start and End to the beginning and end of
+                  symbol, Sym, usage.
+*)
+
+PROCEDURE GetReadQuads (Sym: CARDINAL; m: ModeOfAddr;
+                        VAR Start, End: CARDINAL) ;
+
+
+(*
+   GetWriteQuads - assigns Start and End to the beginning and end of
+                   symbol, Sym, usage.
+*)
+
+PROCEDURE GetWriteQuads (Sym: CARDINAL; m: ModeOfAddr;
+                         VAR Start, End: CARDINAL) ;
+
+
+(*
+   PutReadQuad - places Quad into the list of symbol usage.
+*)
+
+PROCEDURE PutReadQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
+
+
+(*
+   RemoveReadQuad - places Quad into the list of symbol usage.
+*)
+
+PROCEDURE RemoveReadQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
+
+
+(*
+   PutWriteQuad - places Quad into the list of symbol usage.
+*)
+
+PROCEDURE PutWriteQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
+
+
+(*
+   RemoveWriteQuad - places Quad into the list of symbol usage.
+*)
+
+PROCEDURE RemoveWriteQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
+
+
+(*
+   GetReadLimitQuads - returns Start and End which have been assigned
+                       the start and end of when the symbol was read
+                       to within: StartLimit..EndLimit.
+*)
+
+PROCEDURE GetReadLimitQuads (Sym: CARDINAL; m: ModeOfAddr;
+                             StartLimit, EndLimit: CARDINAL;
+                             VAR Start, End: CARDINAL) ;
+
+
+(*
+   GetWriteLimitQuads - returns Start and End which have been assigned
+                        the start and end of when the symbol was written
+                        to within: StartLimit..EndLimit.
+*)
+
+PROCEDURE GetWriteLimitQuads (Sym: CARDINAL; m: ModeOfAddr;
+                              StartLimit, EndLimit: CARDINAL;
+                              VAR Start, End: CARDINAL) ;
+
+
+(*
+   GetNthProcedure - Returns the Nth procedure in Module, Sym.
+*)
+
+PROCEDURE GetNthProcedure (Sym: CARDINAL; n: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetDeclaredDef - returns the token where this symbol was declared
+                    with the priority of the definition, implementation,
+                    program.
+*)
+
+PROCEDURE GetDeclaredDef (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetDeclaredMod - returns the token where this symbol was declared.
+                    with the priority of the implementation, program
+                    and definition.
+*)
+
+PROCEDURE GetDeclaredMod (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetDeclaredDefinition - returns the token where this symbol
+                           was declared in the definition module.
+*)
+
+PROCEDURE GetDeclaredDefinition (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetDeclaredModule - returns the token where this symbol was declared
+                       in an implementation or program module.
+*)
+
+PROCEDURE GetDeclaredModule (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutDeclared - adds an entry to symbol, Sym, indicating that it
+                 was declared at, tok.  This routine
+                 may be called twice, once for definition module
+                 partial declaration and once when parsing the
+                 implementation module.
+*)
+
+PROCEDURE PutDeclared (tok: CARDINAL; Sym: CARDINAL) ;
+
+
+(*
+   GetFirstUsed - returns the token where this symbol was first used.
+*)
+
+PROCEDURE GetFirstUsed (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutProcedureBegin - assigns begin as the token number matching the
+                       procedure BEGIN.
+*)
+
+PROCEDURE PutProcedureBegin (Sym: CARDINAL; begin: CARDINAL) ;
+
+
+(*
+   PutProcedureEnd - assigns end as the token number matching the
+                     procedure END.
+*)
+
+PROCEDURE PutProcedureEnd (Sym: CARDINAL; end: CARDINAL) ;
+
+
+(*
+   GetProcedureBeginEnd - assigns, begin, end, to the stored token values.
+*)
+
+PROCEDURE GetProcedureBeginEnd (Sym: CARDINAL; VAR begin, end: CARDINAL) ;
+
+
+(*
+   ForeachProcedureDo - for each procedure in module, Sym, do procedure, P.
+*)
+
+PROCEDURE ForeachProcedureDo (Sym: CARDINAL; P: PerformOperation) ;
+
+
+(*
+   ForeachModuleDo - for each module do procedure, P.
+*)
+
+PROCEDURE ForeachModuleDo (P: PerformOperation) ;
+
+
+(*
+   ForeachInnerModuleDo - for each inner module in module, Sym,
+                          do procedure, P.
+*)
+
+PROCEDURE ForeachInnerModuleDo (Sym: CARDINAL; P: PerformOperation) ;
+
+
+(*
+   IsVarParam - Returns a conditional depending whether parameter ParamNo
+                is a VAR procedure parameter.
+*)
+
+PROCEDURE IsVarParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsUnboundedParam - Returns a conditional depending whether parameter
+                      ParamNo is an unbounded array procedure parameter.
+*)
+
+PROCEDURE IsUnboundedParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsParameterUnbounded - returns TRUE if parameter, Sym, is
+                          unbounded.
+*)
+
+PROCEDURE IsParameterUnbounded (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsParameterVar - returns true if parameter symbol Sym
+                    was declared as a VAR.
+*)
+
+PROCEDURE IsParameterVar (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetParameterShadowVar - returns the local variable associated with the
+                           parameter symbol, sym.
+*)
+
+PROCEDURE GetParameterShadowVar (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   NoOfParam - Returns the number of parameters that procedure Sym contains.
+*)
+
+PROCEDURE NoOfParam (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   HasVarParameters - returns TRUE if procedure, p, has any VAR parameters.
+*)
+
+PROCEDURE HasVarParameters (p: CARDINAL) : BOOLEAN ;
+
+
+(*
+   NoOfLocalVar - returns the number of local variables that exist in
+                  procedure Sym. Parameters are NOT included in the
+                  count.
+*)
+
+PROCEDURE NoOfLocalVar (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsDefImp - returns true is the Sym is a DefImp symbol.
+              Definition/Implementation module symbol.
+*)
+
+PROCEDURE IsDefImp (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsModule - returns true if the Sym is a Module symbol.
+              Program module symbol.
+              Includes inner modules.
+*)
+
+PROCEDURE IsModule (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsInnerModule - returns true if the symbol, Sym, is an inner module.
+*)
+
+PROCEDURE IsInnerModule (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetSymName - returns the symbol name.
+*)
+
+PROCEDURE GetSymName (Sym: CARDINAL) : Name ;
+
+
+(*
+   RenameSym - renames a symbol, Sym, with SymName.
+               It also checks the unknown tree for a symbol
+               with this new name.
+*)
+
+PROCEDURE RenameSym (Sym: CARDINAL; SymName: Name) ;
+
+
+(*
+   IsUnknown - returns true is the symbol Sym is unknown.
+*)
+
+PROCEDURE IsUnknown (Sym: WORD) : BOOLEAN ;
+
+
+(*
+   IsPartialUnbounded - returns TRUE if, sym, is a partially unbounded symbol.
+*)
+
+PROCEDURE IsPartialUnbounded (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   RequestSym - searches for a symbol with a name SymName in the
+                current and previous scopes.
+                If the symbol is found then it is returned
+                else an unknown symbol is returned create at token
+                position, tok.
+                This procedure does search the base scope (for
+                pervasive identifiers).
+*)
+
+PROCEDURE RequestSym (tok: CARDINAL; SymName: Name) : CARDINAL ;
+
+
+(*
+   PutImported - places a symbol, Sym, into the current main scope.
+*)
+
+PROCEDURE PutImported (Sym: CARDINAL) ;
+
+
+(*
+   PutIncluded - places a symbol, Sym, into the included list of the
+                 current module.
+                 Symbols that are placed in this list are indirectly declared
+                 by:
+
+                 import modulename ;
+
+                 modulename.identifier
+*)
+
+PROCEDURE PutIncluded (Sym: CARDINAL) ;
+
+
+(*
+   PutExported - places a symbol, Sym into the the next level out module.
+                 Sym is also placed in the ExportTree of the current inner
+                 module.
+*)
+
+PROCEDURE PutExported (Sym: CARDINAL) ;
+
+
+(*
+   PutExportQualified - places a symbol with the name, SymName,
+                        into the export tree of the
+                        Definition module being compiled.
+                        The symbol with SymName has been export QUALIFIED
+                        by the definition module and therefore any reference
+                        to this symbol in the code generation phase
+                        will be in the form _Module_SymName.
+*)
+
+PROCEDURE PutExportQualified (tokenno: CARDINAL; SymName: Name) ;
+
+
+(*
+   PutExportUnQualified - places a symbol with the name, SymName,
+                          into the export tree of the
+                          Definition module being compiled.
+                          The symbol with SymName has been export unqualified
+                          by the definition module and therefore any reference
+                          to this symbol in the code generation phase
+                          will be in the form _SymName.
+*)
+
+PROCEDURE PutExportUnQualified (tokenno: CARDINAL; SymName: Name) ;
+
+
+(*
+   PutExportUnImplemented - places a symbol, Sym, into the currently compiled
+                            DefImp module NeedToBeImplemented list.
+*)
+
+PROCEDURE PutExportUnImplemented (tokenno: CARDINAL; Sym: CARDINAL) ;
+
+
+(*
+   GetExported - returns the symbol which has a name SymName,
+                 and is exported from module ModSym.
+
+*)
+
+PROCEDURE GetExported (tokenno: CARDINAL;
+                       ModSym: CARDINAL;
+                       SymName: Name) : CARDINAL ;
+
+
+(*
+   GetFromOuterModule - returns a symbol with name, SymName, which comes
+                        from outside the current module.
+*)
+
+PROCEDURE GetFromOuterModule (tokenno: CARDINAL; SymName: Name) : CARDINAL ;
+
+
+(*
+   TryMoveUndeclaredSymToInnerModule - attempts to move a symbol of
+                                       name, name, which is
+                                       currently undefined in the
+                                       outer scope to the inner scope.
+                                       If successful then the symbol is
+                                       returned otherwise NulSym is
+                                       returned.
+*)
+
+PROCEDURE TryMoveUndeclaredSymToInnerModule (OuterScope,
+                                             InnerScope: CARDINAL;
+                                             name: Name) : CARDINAL ;
+
+
+(*
+   IsExportQualified - returns true if a symbol, Sym, was defined as
+                       being EXPORT QUALIFIED.
+                       Sym is expected to be either a procedure or a
+                       variable.
+*)
+
+PROCEDURE IsExportQualified (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsExportUnQualified - returns true if a symbol, Sym, was defined as
+                         being EXPORT UNQUALIFIED.
+                         Sym is expected to be either a procedure or a
+                         variable.
+*)
+
+PROCEDURE IsExportUnQualified (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsExported - returns true if a symbol, Sym, is exported
+                from module, ModSym.
+                If ModSym is a DefImp symbol then its
+                ExportQualified and ExportUnQualified lists are examined.
+*)
+
+PROCEDURE IsExported (ModSym: CARDINAL; Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsImplicityExported - returns TRUE if, Sym, is implicitly exported from module, ModSym.
+                         ModSym must be a defimp symbol.
+*)
+
+PROCEDURE IsImplicityExported (ModSym, Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsImported - returns true if a symbol, Sym, in module, ModSym,
+                was imported.
+*)
+
+PROCEDURE IsImported (ModSym: CARDINAL; Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutIncludedByDefinition - places a module symbol, Sym, into the
+                             included list of the current definition module.
+*)
+
+PROCEDURE PutIncludedByDefinition (Sym: CARDINAL) ;
+
+
+(*
+   IsIncludedByDefinition - returns TRUE if definition module symbol, Sym, was included
+                            by ModSym's definition module.
+*)
+
+PROCEDURE IsIncludedByDefinition (ModSym, Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ForeachImportedDo - calls a procedure, P, foreach imported symbol
+                       in module, ModSym.
+*)
+
+PROCEDURE ForeachImportedDo (ModSym: CARDINAL; P: PerformOperation) ;
+
+
+(*
+   ForeachExportedDo - calls a procedure, P, foreach exported symbol
+                       from module, ModSym.
+*)
+
+PROCEDURE ForeachExportedDo (ModSym: CARDINAL; P: PerformOperation) ;
+
+
+(*
+   CheckForExportedImplementation - checks to see whether an implementation
+                                    module is currently being compiled, if so,
+                                    symbol, Sym, is removed from the
+                                    NeedToBeImplemented list.
+                                    This procedure is called whenever a symbol
+                                    is declared, thus attenpting to reduce
+                                    the NeedToBeImplemented list.
+                                    Only needs to be called when a TYPE or
+                                    PROCEDURE is built since the implementation
+                                    module can only implement these objects
+                                    declared in the definition module.
+*)
+
+PROCEDURE CheckForExportedImplementation (Sym: CARDINAL) ;
+
+
+(*
+   CheckForUnImplementedExports - displays an error and the offending symbols
+                                  which have been EXPORTed but not implemented
+                                  from the current compiled module.
+*)
+
+PROCEDURE CheckForUnImplementedExports ;
+
+
+(*
+   CheckForUndeclaredExports - displays an error and the offending symbols
+                               which have been EXPORTed but not declared
+                               from module, ModSym.
+*)
+
+PROCEDURE CheckForUndeclaredExports (ModSym: CARDINAL) ;
+
+
+(*
+   CheckForUnknownInModule - checks for any unknown symbols in the
+                             current module.
+                             If any unknown symbols are found then
+                             an error message is displayed.
+*)
+
+PROCEDURE CheckForUnknownInModule ;
+
+
+(*
+   UnknownReported - if sym is an unknown symbol and has not been reported
+                     then include it into the set of reported unknowns.
+*)
+
+PROCEDURE UnknownReported (sym: CARDINAL) ;
+
+
+(*
+   IsReallyPointer - returns TRUE is sym is a pointer, address or a
+                     type declared as a pointer or address.
+*)
+
+PROCEDURE IsReallyPointer (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   CheckHiddenTypeAreAddress - checks to see that any hidden types
+                               which we have declared are actually
+                               of type ADDRESS or map onto a POINTER type.
+*)
+
+PROCEDURE CheckHiddenTypeAreAddress ;
+
+
+(*
+   PutDefinitionForC - sets a flag in the module, Sym, which
+                       indicates that this module is a wrapper for a C
+                       file. Parameters passes to procedures in this module
+                       will adopt the C calling convention.
+*)
+
+PROCEDURE PutDefinitionForC (Sym: CARDINAL) ;
+
+
+(*
+   IsDefinitionForC - returns true if this definition module was declared
+                      as a DEFINITION MODULE FOR "C".
+*)
+
+PROCEDURE IsDefinitionForC (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutDoesNeedExportList - sets a flag in module, Sym, which
+                           indicates that this module requires an explicit
+                           EXPORT QUALIFIED or UNQUALIFIED list. PIM-2
+*)
+
+PROCEDURE PutDoesNeedExportList (Sym: CARDINAL) ;
+
+
+(*
+   PutDoesNotNeedExportList - sets a flag in module, Sym, which
+                              indicates that this module does not require an explicit
+                              EXPORT QUALIFIED or UNQUALIFIED list. PIM-3|4
+*)
+
+PROCEDURE PutDoesNotNeedExportList (Sym: CARDINAL) ;
+
+
+(*
+   DoesNotNeedExportList - returns TRUE if module, Sym, does not require an explicit
+                           EXPORT QUALIFIED list.
+*)
+
+PROCEDURE DoesNotNeedExportList (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   CheckForEnumerationInCurrentModule - checks to see whether the enumeration
+                                        type symbol, Sym, has been entered into
+                                        the current modules scope list.
+*)
+
+PROCEDURE CheckForEnumerationInCurrentModule (Sym: CARDINAL) ;
+
+
+(*
+   SanityCheckConstants - must only be called once all constants, types, procedures
+                          have been declared.  It checks to see that constants are
+                          not used as PROCEDURE parameter types.
+*)
+
+PROCEDURE SanityCheckConstants ;
+
+
+(*
+   ForeachLocalSymDo - foreach local symbol in module, Sym, or procedure, Sym,
+                       perform the procedure, P.
+*)
+
+PROCEDURE ForeachLocalSymDo (Sym: CARDINAL; P: PerformOperation) ;
+
+
+(*
+   ForeachFieldEnumerationDo - for each field in enumeration, Sym,
+                               do procedure, P.
+*)
+
+PROCEDURE ForeachFieldEnumerationDo (Sym: CARDINAL; P: PerformOperation) ;
+
+
+(*
+   IsType - returns true if the Sym is a type symbol.
+*)
+
+PROCEDURE IsType (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsProcedure - returns true is Sym is a PROCEDURE symbol.
+*)
+
+PROCEDURE IsProcedure (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsParameter - returns true if Sym is a parameter symbol.
+*)
+
+PROCEDURE IsParameter (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ProcedureParametersDefined - dictates to procedure symbol, Sym,
+                                that its parameters have been defined.
+*)
+
+PROCEDURE ProcedureParametersDefined (Sym: CARDINAL) ;
+
+
+(*
+   AreProcedureParametersDefined - returns true if the parameters to procedure
+                                   symbol, Sym, have been defined.
+*)
+
+PROCEDURE AreProcedureParametersDefined (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ParametersDefinedInDefinition - dictates to procedure symbol, Sym,
+                                   that its parameters have been defined in
+                                   a definition module.
+*)
+
+PROCEDURE ParametersDefinedInDefinition (Sym: CARDINAL) ;
+
+
+(*
+   AreParametersDefinedInDefinition - returns true if procedure symbol, Sym,
+                                      has had its parameters been defined in
+                                      a definition module.
+*)
+
+PROCEDURE AreParametersDefinedInDefinition (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ParametersDefinedInImplementation - dictates to procedure symbol, Sym,
+                                       that its parameters have been defined in
+                                       a implementation module.
+*)
+
+PROCEDURE ParametersDefinedInImplementation (Sym: CARDINAL) ;
+
+
+(*
+   AreParametersDefinedInImplementation - returns true if procedure symbol, Sym,
+                                          has had its parameters been defined in
+                                          an implementation module.
+*)
+
+PROCEDURE AreParametersDefinedInImplementation (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutUseVarArgs - tell the symbol table that this procedure, Sym, uses varargs.
+                   The procedure _must_ be declared inside a
+                   DEFINITION FOR "C"
+
+*)
+
+PROCEDURE PutUseVarArgs (Sym: CARDINAL) ;
+
+
+(*
+   UsesVarArgs - returns TRUE if procedure, Sym, uses varargs.
+                 The procedure _must_ be declared inside a
+                 DEFINITION FOR "C"
+*)
+
+PROCEDURE UsesVarArgs (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutUseOptArg - tell the symbol table that this procedure, Sym,
+                  uses an optarg.
+*)
+
+PROCEDURE PutUseOptArg (Sym: CARDINAL) ;
+
+
+(*
+   UsesOptArg - returns TRUE if procedure, Sym, uses varargs.
+*)
+
+PROCEDURE UsesOptArg (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutOptArgInit - makes symbol, Sym, the initializer value to
+                   procedure, ProcSym.
+*)
+
+PROCEDURE PutOptArgInit (ProcSym, Sym: CARDINAL) ;
+
+
+(*
+   GetOptArgInit - returns the initializer value to the optional parameter in
+                   procedure, ProcSym.
+*)
+
+PROCEDURE GetOptArgInit (ProcSym: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakePointer - returns a pointer symbol with PointerName.
+*)
+
+PROCEDURE MakePointer (tok: CARDINAL; PointerName: Name) : CARDINAL ;
+
+
+(*
+   PutPointer - gives a pointer symbol a type, PointerType.
+*)
+
+PROCEDURE PutPointer (Sym: CARDINAL; PointerType: CARDINAL) ;
+
+
+(*
+   IsPointer - returns true is Sym is a pointer type symbol.
+*)
+
+PROCEDURE IsPointer (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsRecord - returns true is Sym is a record type symbol.
+*)
+
+PROCEDURE IsRecord (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsVarient - returns true if the symbol, Sym, is a
+               varient symbol.
+*)
+
+PROCEDURE IsVarient (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+  IsFieldVarient - returns true if the symbol, Sym, is a
+                   varient field.
+*)
+
+PROCEDURE IsFieldVarient (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsFieldEnumeration - returns true if the symbol, Sym, is an
+                        enumeration field.
+*)
+
+PROCEDURE IsFieldEnumeration (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsArray - returns true is Sym is an array type symbol.
+*)
+
+PROCEDURE IsArray (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsEnumeration - returns true if Sym is an enumeration symbol.
+*)
+
+PROCEDURE IsEnumeration (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSet - returns TRUE if Sym is a set symbol.
+*)
+
+PROCEDURE IsSet (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsHiddenType - returns TRUE if, Sym, is a Type and is also declared as a hidden type.
+*)
+
+PROCEDURE IsHiddenType (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsOAFamily - returns TRUE if, Sym, is an OAFamily symbol.
+*)
+
+PROCEDURE IsOAFamily (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetDimension - return the number of dimensions associated with
+                  this unbounded ARRAY parameter.
+*)
+
+PROCEDURE GetDimension (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeOAFamily - makes an OAFamily symbol based on SimpleType.
+                  It returns the OAFamily symbol.  A new symbol
+                  is created if one does not already exist for
+                  SimpleType.
+*)
+
+PROCEDURE MakeOAFamily (SimpleType: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetOAFamily - returns the oafamily symbol associated with
+                 SimpleType.
+*)
+
+PROCEDURE GetOAFamily (SimpleType: CARDINAL) : CARDINAL ;
+
+
+(*
+   ForeachOAFamily - call, p[oaf, ndim, symbol] for every unbounded symbol,
+                     sym, in the oaf.
+*)
+
+PROCEDURE ForeachOAFamily (sym: CARDINAL; p: FamilyOperation) ;
+
+
+(*
+   IsUnbounded - returns true if Sym is an unbounded symbol.
+*)
+
+PROCEDURE IsUnbounded (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetUnbounded - returns the unbounded symbol associated with
+                  SimpleType.
+*)
+
+PROCEDURE GetUnbounded (oaf: CARDINAL; ndim: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetUnboundedRecordType - returns the record type used to
+                            implement the unbounded array.
+*)
+
+PROCEDURE GetUnboundedRecordType (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetUnboundedAddressOffset - returns the offset of the address field
+                               inside the record used to implement the
+                               unbounded type.
+*)
+
+PROCEDURE GetUnboundedAddressOffset (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetUnboundedHighOffset - returns the offset of the high field
+                            inside the record used to implement the
+                            unbounded type.
+*)
+
+PROCEDURE GetUnboundedHighOffset (sym: CARDINAL; ndim: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeSubscript - makes a subscript Symbol.
+                   No name is required.
+*)
+
+PROCEDURE MakeSubscript () : CARDINAL ;
+
+
+(*
+   PutSubscript - gives a subscript symbol a type, SimpleType.
+*)
+
+PROCEDURE PutSubscript (Sym: CARDINAL; SimpleType: CARDINAL) ;
+
+
+(*
+   MakeUnbounded - makes an unbounded array Symbol.
+                   ndim is the number of dimensions required.
+                   No name is required.
+*)
+
+PROCEDURE MakeUnbounded (tok: CARDINAL;
+                         SimpleType: CARDINAL; ndim: CARDINAL) : CARDINAL ;
+
+
+(*
+   NoOfElements - Returns the number of elements in array Sym,
+                  or the number of elements in an enumeration Sym.
+*)
+
+PROCEDURE NoOfElements (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutArray - places a type symbol into an Array.
+*)
+
+PROCEDURE PutArray (Sym, TypeSymbol: CARDINAL) ;
+
+
+(*
+   ResolveImports -
+*)
+
+PROCEDURE ResolveImports ;
+
+
+(*
+   ResolveConstructorTypes - to be called at the end of pass three.  Its
+                             purpose is to fix up all constructors whose
+                             types are unknown.
+*)
+
+PROCEDURE ResolveConstructorTypes ;
+
+
+(*
+   AddNameToScope - adds a Name, n, to the list of objects declared at the
+                    current scope.
+*)
+
+PROCEDURE AddNameToScope (n: Name) ;
+
+
+(*
+   AddNameToImportList - adds a Name, n, to the import list of the current
+                         module.
+*)
+
+PROCEDURE AddNameToImportList (n: Name) ;
+
+
+(*
+   GetScope - returns the declaration scope of the symbol.
+*)
+
+PROCEDURE GetScope (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetModuleScope - returns the module scope of symbol, sym.
+                    If sym was declared within a nested procedure
+                    then return the module which defines the
+                    procedure.
+*)
+
+PROCEDURE GetModuleScope (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetProcedureScope - returns the innermost procedure (if any)
+                       in which the symbol, sym, resides.
+                       A module inside the PROCEDURE is skipped
+                       over.
+*)
+
+PROCEDURE GetProcedureScope (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsModuleWithinProcedure - returns TRUE if module, sym, is
+                             inside a procedure.
+*)
+
+PROCEDURE IsModuleWithinProcedure (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetParent - returns the parent of symbol, Sym.
+*)
+
+PROCEDURE GetParent (Sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsRecordField - returns true if Sym is a record field.
+*)
+
+PROCEDURE IsRecordField (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   MakeProcType - returns a procedure type symbol with ProcTypeName.
+*)
+
+PROCEDURE MakeProcType (tok: CARDINAL; ProcTypeName: Name) : CARDINAL ;
+
+
+(*
+   PutProcTypeParam - Places a Non VAR parameter ParamName with type
+                      ParamType into ProcType Sym.
+*)
+
+PROCEDURE PutProcTypeParam (Sym: CARDINAL;
+                            ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
+
+
+(*
+   PutProcTypeVarParam - Places a Non VAR parameter ParamName with type
+                         ParamType into ProcType Sym.
+*)
+
+PROCEDURE PutProcTypeVarParam (Sym: CARDINAL;
+                               ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
+
+
+(*
+   IsProcType - returns true if Sym is a ProcType Symbol.
+*)
+
+PROCEDURE IsProcType (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsVar - returns true if Sym is a Var Symbol.
+*)
+
+PROCEDURE IsVar (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsVarConst - returns the IsConst field indicating the variable is read only.
+*)
+
+PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConst - returns true is Sym is a Const Symbol.
+*)
+
+PROCEDURE IsConst (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConstString - returns true if Sym is a string.
+*)
+
+PROCEDURE IsConstString (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConstStringM2 - returns whether this conststring is an unaltered Modula-2 string.
+*)
+
+PROCEDURE IsConstStringM2 (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConstStringC - returns whether this conststring is a C style string
+                    which will have any escape translated.
+*)
+
+PROCEDURE IsConstStringC (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConstStringM2nul - returns whether this conststring is a Modula-2 string which
+                        contains a nul terminator.
+*)
+
+PROCEDURE IsConstStringM2nul (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConstStringCnul - returns whether this conststring is a C style string
+                       which will have any escape translated and also contains
+                       a nul terminator.
+*)
+
+PROCEDURE IsConstStringCnul (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConstStringNulTerminated - returns TRUE if the constant string, sym,
+                                should be created with a nul terminator.
+*)
+
+PROCEDURE IsConstStringNulTerminated (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   MakeConstStringCnul - creates a constant string nul terminated string suitable for C.
+                         sym is a ConstString and a new symbol is returned
+                         with the escape sequences converted into characters.
+*)
+
+PROCEDURE MakeConstStringCnul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeConstStringM2nul - creates a constant string nul terminated string.
+                          sym is a ConstString and a new symbol is returned.
+*)
+
+PROCEDURE MakeConstStringM2nul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeConstStringC - creates a constant string suitable for C.
+                      sym is a Modula-2 ConstString and a new symbol is returned
+                      with the escape sequences converted into characters.
+                      It is not nul terminated.
+*)
+
+PROCEDURE MakeConstStringC (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsConstLit - returns true if Sym is a literal constant.
+*)
+
+PROCEDURE IsConstLit (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConstructor - returns TRUE if the constant is declared as a
+                   constant set, array or record.
+*)
+
+PROCEDURE IsConstructor (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsDummy - returns true if Sym is a Dummy symbol.
+*)
+
+PROCEDURE IsDummy (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsTemporary - returns true if Sym is a Temporary symbol.
+*)
+
+PROCEDURE IsTemporary (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsVarAParam - returns true if Sym is a variable declared as a parameter.
+*)
+
+PROCEDURE IsVarAParam (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSubscript - returns true if Sym is a subscript symbol.
+*)
+
+PROCEDURE IsSubscript (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSubrange - returns true if Sym is a subrange symbol.
+*)
+
+PROCEDURE IsSubrange (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsProcedureVariable - returns true if a Sym is a variable and
+                         it was declared within a procedure.
+*)
+
+PROCEDURE IsProcedureVariable (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsProcedureNested - returns TRUE if procedure, Sym, was
+                       declared as a nested procedure.
+*)
+
+PROCEDURE IsProcedureNested (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsAModula2Type - returns true if Sym, is a:
+                    IsType, IsPointer, IsRecord, IsEnumeration,
+                    IsSubrange, IsArray, IsUnbounded, IsProcType.
+                    NOTE that it different from IsType.
+                    IsType is used for:
+                    TYPE
+                       a = CARDINAL ;  (* IsType(a)=TRUE *)
+*)
+
+PROCEDURE IsAModula2Type (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsGnuAsmVolatile - returns TRUE if a GnuAsm symbol was defined as VOLATILE.
+*)
+
+PROCEDURE IsGnuAsmVolatile (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsGnuAsmSimple - returns TRUE if a GnuAsm symbol is a simple statement of the
+                    form ASM("instruction"), which differs from ASM("instruction" :)
+                    slightly.
+*)
+
+PROCEDURE IsGnuAsmSimple (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsGnuAsm - returns TRUE if Sym is a GnuAsm symbol.
+*)
+
+PROCEDURE IsGnuAsm (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsRegInterface - returns TRUE if Sym is a RegInterface symbol.
+*)
+
+PROCEDURE IsRegInterface (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSizeSolved - returns true if the size of Sym is solved.
+*)
+
+PROCEDURE IsSizeSolved (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsOffsetSolved - returns true if the Offset of Sym is solved.
+*)
+
+PROCEDURE IsOffsetSolved (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsValueSolved - returns true if the value of Sym is solved.
+*)
+
+PROCEDURE IsValueSolved (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsConstructorConstant - returns TRUE if constructor, Sym, is
+                           defined by only constants.
+*)
+
+PROCEDURE IsConstructorConstant (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsComposite - returns TRUE if symbol, sym, is a composite
+                 type:  ie an ARRAY or RECORD.
+*)
+
+PROCEDURE IsComposite (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSumOfParamSizeSolved - has the sum of parameters been solved yet?
+*)
+
+PROCEDURE IsSumOfParamSizeSolved (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutAlignment - assigns the alignment constant associated with,
+                  type, with, align.
+*)
+
+PROCEDURE PutAlignment (type: CARDINAL; align: CARDINAL) ;
+
+
+(*
+   GetAlignment - returns the alignment constant associated with,
+                  type.
+*)
+
+PROCEDURE GetAlignment (type: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetDefaultRecordFieldAlignment - assigns, align, as the default alignment
+                                    to record, sym.
+*)
+
+PROCEDURE GetDefaultRecordFieldAlignment (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutDefaultRecordFieldAlignment - assigns, align, as the default alignment
+                                    to record, sym.
+*)
+
+PROCEDURE PutDefaultRecordFieldAlignment (sym: CARDINAL; align: CARDINAL) ;
+
+
+(*
+   PutUnused - sets, sym, as unused.  This is a gm2 pragma.
+*)
+
+PROCEDURE PutUnused (sym: CARDINAL) ;
+
+
+(*
+   IsUnused - returns TRUE if the symbol was declared as unused with a
+              gm2 pragma.
+*)
+
+PROCEDURE IsUnused (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutDeclaredPacked - sets the Packed field of the record or record field symbol.
+*)
+
+PROCEDURE PutDeclaredPacked (sym: CARDINAL; b: BOOLEAN) ;
+
+
+(*
+   IsDeclaredPacked - was the record symbol or record field, sym,
+                      declared as packed?
+*)
+
+PROCEDURE IsDeclaredPacked (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsDeclaredPackedResolved - do we know if the record symbol or record
+                              field, sym, declared as packed or not packed?
+*)
+
+PROCEDURE IsDeclaredPackedResolved (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetPackedEquivalent - returns the packed equivalent of type, sym.
+                         sym must be a type, subrange, set or enumerated type.
+*)
+
+PROCEDURE GetPackedEquivalent (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetNonPackedEquivalent - returns the equivalent non packed symbol
+                            associated with, sym.
+*)
+
+PROCEDURE GetNonPackedEquivalent (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsEquivalent - returns TRUE if, sym, is an equivalent symbol.
+*)
+
+PROCEDURE IsEquivalent (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PushSize - pushes the size of Sym.
+*)
+
+PROCEDURE PushSize (Sym: CARDINAL) ;
+
+
+(*
+   PushOffset - pushes the Offset of Sym.
+*)
+
+PROCEDURE PushOffset (Sym: CARDINAL) ;
+
+
+(*
+   PushValue - pushes the Value of Sym onto the ALU stack.
+*)
+
+PROCEDURE PushValue (Sym: CARDINAL) ;
+
+
+(*
+   PushParamSize - push the size of parameter, ParamNo,
+                   of procedure Sym onto the ALU stack.
+*)
+
+PROCEDURE PushParamSize (Sym: CARDINAL; ParamNo: CARDINAL) ;
+
+
+(*
+   PushSumOfLocalVarSize - push the total size of all local variables
+                           onto the ALU stack.
+*)
+
+PROCEDURE PushSumOfLocalVarSize (Sym: CARDINAL) ;
+
+
+(*
+   PushSumOfParamSize - push the total size of all parameters onto
+                        the ALU stack.
+*)
+
+PROCEDURE PushSumOfParamSize (Sym: CARDINAL) ;
+
+
+(*
+   PushVarSize - pushes the size of a variable, Sym.
+                 The runtime size of Sym will depend upon its addressing mode,
+                 RightValue has size PushSize(GetType(Sym)) and
+                 LeftValue has size PushSize(Address) since it points to a
+                 variable.
+                 However this procedure uses the Type of Sym therefore
+                 this Type must be solved before this procedure is called.
+*)
+
+PROCEDURE PushVarSize (Sym: CARDINAL) ;
+
+
+(*
+   PopValue - pops the ALU stack into Value of Sym.
+*)
+
+PROCEDURE PopValue (Sym: CARDINAL) ;
+
+
+(*
+   PopSize - pops the ALU stack into Size of Sym.
+*)
+
+PROCEDURE PopSize (Sym: CARDINAL) ;
+
+
+(*
+   PopOffset - pops the ALU stack into Offset of Sym.
+*)
+
+PROCEDURE PopOffset (Sym: CARDINAL) ;
+
+
+(*
+   PopSumOfParamSize - pop the total value on the ALU stack as the
+                       sum of all parameters.
+*)
+
+PROCEDURE PopSumOfParamSize (Sym: CARDINAL) ;
+
+
+(*
+   IsObject - returns TRUE if the symbol is an object symbol.
+*)
+
+PROCEDURE IsObject (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsTuple - returns TRUE if the symbol is a tuple symbol.
+*)
+
+PROCEDURE IsTuple (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Make2Tuple - creates and returns a 2 tuple from, a, and, b.
+*)
+
+PROCEDURE Make2Tuple (a, b: CARDINAL) : CARDINAL ;
+
+
+(*
+   MakeError - creates an error node, which can be used in MetaError messages.
+               It will be removed from ExportUndeclared and Unknown trees.
+*)
+
+PROCEDURE MakeError (tok: CARDINAL; name: Name) : CARDINAL ;
+
+
+(*
+   MakeErrorS - creates an error node from a string, which can be used
+                in MetaError messages.
+                It will be removed from ExportUndeclared and Unknown trees.
+*)
+
+PROCEDURE MakeErrorS (tok: CARDINAL; name: String) : CARDINAL ;
+
+
+(*
+   IsError - returns TRUE if the symbol is an error symbol.
+*)
+
+PROCEDURE IsError (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsLegal - returns TRUE if, sym, is a legal symbol.
+*)
+
+PROCEDURE IsLegal (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutModuleContainsBuiltin - sets a flag in the current compiled module which
+                              indicates that a builtin PROCEDURE is being declared.
+                              This is only expected to be called when we are
+                              parsing the definition module.
+*)
+
+PROCEDURE PutModuleContainsBuiltin ;
+
+
+(*
+   IsBuiltinInModule - returns true if a module, Sym, has declared a builtin procedure.
+*)
+
+PROCEDURE IsBuiltinInModule (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutHiddenTypeDeclared - sets a flag in the current compiled module which
+                           indicates that a Hidden Type is declared within
+                           the implementation part of the module.
+                           This procedure is expected to be called while
+                           compiling the associated definition module.
+*)
+
+PROCEDURE PutHiddenTypeDeclared ;
+
+
+(*
+   IsHiddenTypeDeclared - returns true if a Hidden Type was declared in
+                          the module, Sym.
+*)
+
+PROCEDURE IsHiddenTypeDeclared (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   DisplayTrees - displays the SymbolTrees for Module symbol, ModSym.
+*)
+
+PROCEDURE DisplayTrees (ModSym: CARDINAL) ;
+
+
+(*
+   DebugLineNumbers - internal debugging, emit all procedure names in this module
+                      together with the line numbers for the corresponding begin/end
+                      tokens.
+*)
+
+PROCEDURE DebugLineNumbers (sym: CARDINAL) ;
+
+
+(*
+   GetErrorScope - returns the error scope for a symbol.
+                   The error scope is the title scope which is used to
+                   announce the symbol in the GCC error message.
+*)
+
+PROCEDURE GetErrorScope (sym: CARDINAL) : ErrorScope ;
+
+
+(*
+   PutErrorScope - sets the error scope for a symbol.
+                   The error scope is the title scope which is used to
+                   announce the symbol in the GCC error message.
+
+PROCEDURE PutErrorScope (sym: CARDINAL; errorScope: ErrorScope) ;
+*)
+
+
+(*
+   MakeImport - create and return an import symbol.
+                moduleSym is the symbol being imported.
+                isqualified is FALSE if it were IMPORT modulename and
+                TRUE for the qualified FROM modulename IMPORT etc.
+                listno is the import list count for this module.
+                tok should match this modulename position.
+*)
+
+PROCEDURE MakeImport (tok: CARDINAL;
+                      moduleSym: CARDINAL;
+                      listno: CARDINAL;
+                      isqualified: BOOLEAN) : CARDINAL ;
+
+
+(*
+   MakeImportStatement - return a dependent symbol which represents an import statement
+                         or a qualified import statement.  The tok should either match
+                         the FROM token or the IMPORT token.  listno is the import list
+                         count for the module.
+*)
+
+PROCEDURE MakeImportStatement (tok: CARDINAL; listno: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsImport - returns TRUE if sym is an import symbol.
+*)
+
+PROCEDURE IsImport (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsImportStatement - returns TRUE if sym is a dependent symbol.
+*)
+
+PROCEDURE IsImportStatement (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GetImportModule - returns the module associated with the import symbol.
+*)
+
+PROCEDURE GetImportModule (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetImportDeclared - returns the token associated with the import symbol.
+*)
+
+PROCEDURE GetImportDeclared (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   GetImportStatementList - returns the list of imports for this dependent.
+                            Each import symbol corresponds to a module.
+*)
+
+PROCEDURE GetImportStatementList (sym: CARDINAL) : List ;
+
+
+(*
+   GetModuleDefImportStatementList - returns the list of dependents associated with
+                                     the definition module.
+*)
+
+PROCEDURE GetModuleDefImportStatementList (sym: CARDINAL) : List ;
+
+
+(*
+   GetModuleModImportStatementList - returns the list of dependents associated with
+                                     the implementation or program module.
+*)
+
+PROCEDURE GetModuleModImportStatementList (sym: CARDINAL) : List ;
+
+
+(*
+   AppendModuleImportStatement - appends the ImportStatement symbol onto the
+                                 module import list.
+
+                                 For example:
+
+                                 FROM x IMPORT y, z ;
+                                 ^^^^
+
+                                 also:
+
+                                 IMPORT p, q, r;
+                                 ^^^^^^
+                                 will result in a new ImportStatement symbol added
+                                 to the current module import list.
+                                 The ImportStatement symbol is expected to be created
+                                 by MakeImportStatement using the token positions
+                                 outlined above.
+*)
+
+PROCEDURE AppendModuleImportStatement (module, statement: CARDINAL) ;
+
+
+(*
+   AppendModuleOnImportStatement - appends the import symbol onto the
+                                   dependent list (chain).
+
+                                   For example each:
+
+                                   FROM x IMPORT y, z ;
+                                        ^
+                                   x are added to the dependent list.
+
+                                   also:
+
+                                   IMPORT p, q, r;
+                                          ^  ^  ^
+                                   will result in p, q and r added to
+                                   to the dependent list.
+
+                                   The import symbol is created by MakeImport
+                                   and the token is expected to match the module
+                                   name outlined above.
+*)
+
+PROCEDURE AppendModuleOnImportStatement (module, import: CARDINAL) ;
+
+
+(*
+   PutModLink - assigns link to module sym.
+*)
+
+PROCEDURE PutModLink (sym: CARDINAL; link: BOOLEAN) ;
+
+
+(*
+   IsModLink - returns the ModLink value associated with the module symbol.
+*)
+
+PROCEDURE IsModLink (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutDefLink - assigns link to the definition module sym.
+*)
+
+PROCEDURE PutDefLink (sym: CARDINAL; link: BOOLEAN) ;
+
+
+(*
+   IsDefLink - returns the DefLink value associated with the definition module symbol.
+*)
+
+PROCEDURE IsDefLink (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsModuleBuiltin - returns TRUE if the module is a builtin module.
+                     (For example _BaseTypes).
+*)
+
+PROCEDURE IsModuleBuiltin (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+   PutModuleBuiltin - sets the Builtin flag to value.
+*)
+
+PROCEDURE PutModuleBuiltin (sym: CARDINAL; value: BOOLEAN) ;
+
+
+END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
new file mode 100644
index 00000000000..3a2b44ed990
--- /dev/null
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -0,0 +1,14319 @@
+(* SymbolTable.mod provides access to the symbol table.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE SymbolTable ;
+
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2Debug IMPORT Assert ;
+FROM libc IMPORT printf ;
+
+IMPORT Indexing ;
+FROM Indexing IMPORT InitIndex, InBounds, LowIndice, HighIndice, PutIndice, GetIndice ;
+FROM Sets IMPORT Set, InitSet, IncludeElementIntoSet, IsElementInSet ;
+FROM m2linemap IMPORT location_t ;
+
+FROM M2Options IMPORT Pedantic, ExtendedOpaque, DebugFunctionLineNumbers, ScaffoldDynamic ;
+
+FROM M2LexBuf IMPORT UnknownTokenNo, TokenToLineNo,
+                     FindFileNameFromToken, TokenToLocation ;
+
+FROM M2ALU IMPORT InitValue, PtrToValue, PushCard, PopInto,
+                  PushString, PushFrom, PushChar, PushInt,
+                  IsSolved, IsValueConst ;
+
+FROM M2Error IMPORT Error, NewError, ChainError, InternalError,
+                    ErrorFormat0, ErrorFormat1, ErrorFormat2,
+                    WriteFormat0, WriteFormat1, WriteFormat2, ErrorString,
+                    ErrorAbort0, FlushErrors, ErrorScope, GetCurrentErrorScope ;
+
+FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3, MetaErrors1,
+                        MetaErrorT0,
+                        MetaErrorString1,
+                        MetaErrorStringT0, MetaErrorStringT1,
+                        MetaErrorT1, MetaErrorT2 ;
+
+FROM M2LexBuf IMPORT GetTokenNo ;
+FROM FormatStrings IMPORT Sprintf1 ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ;
+
+FROM DynamicStrings IMPORT String, string, InitString,
+                           InitStringCharStar, Mark, KillString, Length, ConCat,
+                           Index, char ;
+
+FROM Lists IMPORT List, InitList, GetItemFromList, PutItemIntoList,
+                  IsItemInList, IncludeItemIntoList, NoOfItemsInList,
+                  RemoveItemFromList, ForeachItemInListDo ;
+
+FROM NameKey IMPORT Name, MakeKey, makekey, NulName, WriteKey, LengthKey, GetKey, KeyToCharStar ;
+
+FROM SymbolKey IMPORT NulKey, SymbolTree, IsSymbol,
+                      InitTree,
+                      GetSymKey, PutSymKey, DelSymKey, IsEmptyTree,
+                      DoesTreeContainAny, ForeachNodeDo, ForeachNodeConditionDo,
+                      NoOfNodes ;
+
+FROM M2Base IMPORT MixTypes, InitBase, Char, Integer, LongReal,
+                   Cardinal, LongInt, LongCard, ZType, RType ;
+
+FROM M2System IMPORT Address ;
+FROM m2decl IMPORT DetermineSizeOfConstant ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT BuiltinsLocation ;
+FROM StrLib IMPORT StrEqual ;
+
+FROM M2Comp IMPORT CompilingDefinitionModule,
+                   CompilingImplementationModule ;
+
+FROM FormatStrings IMPORT HandleEscape ;
+FROM M2Scaffold IMPORT DeclareArgEnvParams ;
+
+IMPORT Indexing ;
+
+
+CONST
+   DebugUnknowns        =  FALSE ;
+
+   (*
+      The Unbounded is a pseudo type used within the compiler
+      to implement dynamic parameter arrays.  It is implmented
+      as a record structure which has the following fields:
+
+      RECORD
+         _m2_contents: POINTER TO type ;
+         _m2_high    : CARDINAL ;
+      END ;
+   *)
+
+   UnboundedAddressName = "_m2_contents" ;
+   UnboundedHighName    = "_m2_high_%d" ;
+
+TYPE
+   LRLists = ARRAY [RightValue..LeftValue] OF List ;
+
+   TypeOfSymbol = (RecordSym, VarientSym, DummySym,
+                   VarSym, EnumerationSym, SubrangeSym, ArraySym,
+                   ConstStringSym, ConstVarSym, ConstLitSym,
+                   VarParamSym, ParamSym, PointerSym,
+                   UndefinedSym, TypeSym,
+                   RecordFieldSym, VarientFieldSym, EnumerationFieldSym,
+                   DefImpSym, ModuleSym, SetSym, ProcedureSym, ProcTypeSym,
+                   SubscriptSym, UnboundedSym, GnuAsmSym, InterfaceSym,
+                   ObjectSym, PartialUnboundedSym, TupleSym, OAFamilySym,
+                   ImportSym, ImportStatementSym,
+                   EquivSym, ErrorSym) ;
+
+   Where = RECORD
+              DefDeclared,
+              ModDeclared,
+              FirstUsed  : CARDINAL ;
+           END ;
+
+   PackedInfo = RECORD
+                   IsPacked    : BOOLEAN ;    (* is this type packed?        *)
+                   PackedEquiv : CARDINAL ;   (* the equivalent packed type  *)
+                END ;
+
+   PtrToAsmConstraint = POINTER TO RECORD
+                                      name: Name ;
+                                      str : CARDINAL ;   (* regnames or constraints     *)
+                                      obj : CARDINAL ;   (* list of M2 syms             *)
+                                   END ;
+
+   ModuleCtor = RECORD
+                   ctor: CARDINAL ;      (* Procedure which will become a ctor.  *)
+                   init: CARDINAL ;      (* Module initialization block proc.    *)
+                   fini: CARDINAL ;      (* Module Finalization block proc.      *)
+                   dep : CARDINAL ;      (* Module dependency proc.              *)
+                END ;
+
+   (* Each import list has a import statement symbol.  *)
+
+   SymImportStatement = RECORD
+                           listNo       : CARDINAL ;  (* The import list no.     *)
+                           ListOfImports: List ;   (* Vector of SymImports.      *)
+                           at           : Where ;  (* The FROM or IMPORT token.  *)
+                        END ;
+
+   SymImport = RECORD
+                  module   : CARDINAL ;     (* The module imported.              *)
+                  listNo   : CARDINAL ;     (* The import list no.               *)
+                  qualified: BOOLEAN ;      (* Is the complete module imported?  *)
+                  at       : Where ;        (* token corresponding to the        *)
+                                            (* module name in the import.        *)
+               END ;
+
+   SymEquiv = RECORD
+                 packedInfo: PackedInfo ;
+                 nonPacked : CARDINAL ;
+              END ;
+
+   SymOAFamily = RECORD
+                    MaxDimensions: CARDINAL ;
+                    SimpleType   : CARDINAL ;
+                    Dimensions   : Indexing.Index ;
+                 END ;
+
+   SymTuple = RECORD
+                 At    : Where ;
+                 nTuple: CARDINAL ;
+                 list  : Indexing.Index ;
+              END ;
+
+   SymError     = RECORD
+                     name      : Name ;
+                     At        : Where ;      (* Where was sym declared/used *)
+                  END ;
+
+   SymObject    = RECORD
+                     name      : Name ;
+                     At        : Where ;      (* Where was sym declared/used *)
+                  END ;
+
+   SymUndefined = RECORD
+                     name      : Name ;       (* Index into name array, name *)
+                                              (* of record.                  *)
+                     oafamily  : CARDINAL ;   (* The oafamily for this sym   *)
+                     errorScope: ErrorScope ; (* Title scope used if an      *)
+                                              (* error is emitted.           *)
+                     At        : Where ;      (* Where was sym declared/used *)
+                  END ;
+
+   SymGnuAsm    = RECORD
+                     String    : CARDINAL ;   (* (ConstString) the assembly  *)
+                                              (* instruction.                *)
+                     At        : Where ;      (* Where was sym declared/used *)
+                     Inputs,
+                     Outputs,
+                     Trashed   : CARDINAL ;   (* The interface symbols.      *)
+                     Volatile  : BOOLEAN ;    (* Declared as ASM VOLATILE ?  *)
+                     Simple    : BOOLEAN ;    (* is a simple kind?           *)
+                  END ;
+
+   SymInterface = RECORD
+                     Parameters: Indexing.Index ;
+                                              (* regnames or constraints     *)
+                                              (* list of M2 syms.            *)
+                     At        : Where ;      (* Where was sym declared/used *)
+                  END ;
+
+   SymVarient = RECORD
+                   Size        : PtrToValue ; (* Size at runtime of symbol.  *)
+                   ListOfSons  : List ;       (* ListOfSons contains a list  *)
+                                              (* of SymRecordField and       *)
+                                              (* SymVarients                 *)
+                                              (* declared by the source      *)
+                                              (* file.                       *)
+                   DeclPacked  : BOOLEAN ;    (* Is this varient packed?     *)
+                   DeclResolved: BOOLEAN ;    (* has we resolved packed?     *)
+                   Parent      : CARDINAL ;   (* Points to the parent symbol *)
+                   Varient     : CARDINAL ;   (* Index into symbol table to  *)
+                                              (* determine the associated    *)
+                                              (* varient symbol.             *)
+                   tag         : CARDINAL ;   (* The tag of the varient      *)
+                                              (* this can either be a type   *)
+                                              (* or a varient field.         *)
+                   Scope       : CARDINAL ;   (* Scope of declaration.       *)
+                   At          : Where ;      (* Where was sym declared/used *)
+               END ;
+
+   SymRecord = RECORD
+                  name         : Name ;       (* Index into name array, name *)
+                                              (* of record.                  *)
+                  LocalSymbols : SymbolTree ; (* Contains all record fields. *)
+                  Size         : PtrToValue ; (* Size at runtime of symbol.  *)
+                  ListOfSons   : List ;       (* ListOfSons contains a list  *)
+                                              (* of SymRecordField and       *)
+                                              (* SymVarients                 *)
+                                              (* declared by the source      *)
+                                              (* file.                       *)
+                  Align        : CARDINAL ;   (* The alignment of this type. *)
+                  DefaultAlign : CARDINAL ;   (* The default field alignment *)
+                  DeclPacked   : BOOLEAN ;    (* Is this record packed?      *)
+                  DeclResolved : BOOLEAN ;    (* has we resolved packed?     *)
+                  oafamily     : CARDINAL ;   (* The oafamily for this sym.  *)
+                  Parent       : CARDINAL ;   (* Points to the parent symbol *)
+                  Scope        : CARDINAL ;   (* Scope of declaration.       *)
+                  At           : Where ;      (* Where was sym declared/used *)
+               END ;
+
+   SymSubrange = RECORD
+                    name        : Name ;       (* Index into name array, name *)
+                                               (* of subrange.                *)
+                    Low         : CARDINAL ;   (* Index to symbol for lower   *)
+                    High        : CARDINAL ;   (* Index to symbol for higher  *)
+                    Size        : PtrToValue ; (* Size of subrange type.      *)
+                    Type        : CARDINAL ;   (* Index to type symbol for    *)
+                                               (* the type of subrange.       *)
+                    ConstLitTree: SymbolTree ; (* constants of this type.     *)
+                    packedInfo  : PackedInfo ; (* the equivalent packed type  *)
+                    oafamily    : CARDINAL ;   (* The oafamily for this sym   *)
+                    Scope       : CARDINAL ;   (* Scope of declaration.       *)
+                    At          : Where ;      (* Where was sym declared/used *)
+                 END ;
+
+   SymEnumeration =
+                RECORD
+                   name        : Name ;       (* Index into name array, name *)
+                                              (* of enumeration.             *)
+                   NoOfElements: CARDINAL ;   (* No elements in enumeration  *)
+                   LocalSymbols: SymbolTree ; (* Contains all enumeration    *)
+                                              (* fields.                     *)
+                   Size        : PtrToValue ; (* Size at runtime of symbol.  *)
+                   packedInfo  : PackedInfo ; (* the equivalent packed type  *)
+                   oafamily    : CARDINAL ;   (* The oafamily for this sym   *)
+                   Scope       : CARDINAL ;   (* Scope of declaration.       *)
+                   At          : Where ;      (* Where was sym declared/used *)
+                END ;
+
+   SymArray = RECORD
+                 name        : Name ;         (* Index into name array, name *)
+                                              (* of array.                   *)
+                 Subscript   : CARDINAL ;     (* the subscript for this      *)
+                                              (* array.                      *)
+                 Size        : PtrToValue ;   (* Size at runtime of symbol.  *)
+                 Offset      : PtrToValue ;   (* Offset at runtime of symbol *)
+                 Type        : CARDINAL ;     (* Type of the Array.          *)
+                 Align       : CARDINAL ;     (* Alignment for this type.    *)
+		 Large       : BOOLEAN ;      (* is this a large array?      *)
+                 oafamily    : CARDINAL ;     (* The oafamily for this sym   *)
+                 Scope       : CARDINAL ;     (* Scope of declaration.       *)
+                 At          : Where ;        (* Where was sym declared/used *)
+              END ;
+
+  SymSubscript = RECORD
+                    Type       : CARDINAL ;   (* Index to a subrange symbol. *)
+                    Size       : PtrToValue ; (* Size of this indice in*Size *)
+                    Offset     : PtrToValue ; (* Offset at runtime of symbol *)
+                                              (* Pseudo ie: Offset+Size*i    *)
+                                              (* 1..n. The array offset is   *)
+                                              (* the real memory offset.     *)
+                                              (* This offset allows the a[i] *)
+                                              (* to be calculated without    *)
+                                              (* the need to perform         *)
+                                              (* subtractions when a[4..10]  *)
+                                              (* needs to be indexed.        *)
+                    At         : Where ;      (* Where was sym declared/used *)
+                 END ;
+
+   SymUnbounded = RECORD
+                     Type       : CARDINAL ;  (* Index to Simple type symbol *)
+                     Size       : PtrToValue ;(* Max No of words ever        *)
+                                              (* passed to this type.        *)
+                     RecordType : CARDINAL ;  (* Record type used to         *)
+                                              (* implement the unbounded.    *)
+                     Dimensions : CARDINAL ;  (* No of dimensions this
+                                                 open array uses.            *)
+                     Scope      : CARDINAL ;  (* Scope of declaration.       *)
+                     At         : Where ;     (* Where was sym declared/used *)
+                  END ;
+
+   SymPartialUnbounded = RECORD
+                            Type: CARDINAL ;  (* Index to Simple type symbol *)
+                            NDim: CARDINAL ;  (* dimensions associated       *)
+                         END ;
+
+   SymProcedure
+          = RECORD
+               name          : Name ;       (* Index into name array, name   *)
+                                            (* of procedure.                 *)
+               ListOfParam   : List ;       (* Contains a list of all the    *)
+                                            (* parameters in this procedure. *)
+               ParamDefined  : BOOLEAN ;    (* Have the parameters been      *)
+                                            (* defined yet?                  *)
+               DefinedInDef  : BOOLEAN ;    (* Were the parameters defined   *)
+                                            (* in the Definition module?     *)
+                                            (* Note that this depends on     *)
+                                            (* whether the compiler has read *)
+                                            (* the .def or .mod first.       *)
+                                            (* The second occurence is       *)
+                                            (* compared to the first.        *)
+               DefinedInImp  : BOOLEAN ;    (* Were the parameters defined   *)
+                                            (* in the Implementation module? *)
+                                            (* Note that this depends on     *)
+                                            (* whether the compiler has read *)
+                                            (* the .def or .mod first.       *)
+                                            (* The second occurence is       *)
+                                            (* compared to the first.        *)
+               HasVarArgs    : BOOLEAN ;    (* Does this procedure use ... ? *)
+               HasOptArg     : BOOLEAN ;    (* Does this procedure use [ ] ? *)
+               OptArgInit    : CARDINAL ;   (* The optarg initial value.     *)
+               IsBuiltin     : BOOLEAN ;    (* Was it declared __BUILTIN__ ? *)
+               BuiltinName   : Name ;       (* name of equivalent builtin    *)
+               IsInline      : BOOLEAN ;    (* Was it declared __INLINE__ ?  *)
+               ReturnOptional: BOOLEAN ;    (* Is the return value optional? *)
+               IsExtern      : BOOLEAN ;    (* Make this procedure extern.   *)
+               IsPublic      : BOOLEAN ;    (* Make this procedure visible.  *)
+               IsCtor        : BOOLEAN ;    (* Is this procedure a ctor?     *)
+               IsMonoName    : BOOLEAN ;    (* Ignores module name prefix.   *)
+               Unresolved    : SymbolTree ; (* All symbols currently         *)
+                                            (* unresolved in this procedure. *)
+               ScopeQuad     : CARDINAL ;   (* Index into quads for scope    *)
+               StartQuad     : CARDINAL ;   (* Index into quads for start    *)
+                                            (* of procedure.                 *)
+               EndQuad       : CARDINAL ;   (* Index into quads for end of   *)
+                                            (* procedure.                    *)
+               Reachable     : BOOLEAN ;    (* Defines if procedure will     *)
+                                            (* ever be called by the main    *)
+                                            (* Module.                       *)
+               SavePriority  : BOOLEAN ;    (* Does procedure need to save   *)
+                                            (* and restore interrupts?       *)
+               ReturnType    : CARDINAL ;   (* Return type for function.     *)
+               Offset        : CARDINAL ;   (* Location of procedure used    *)
+                                            (* in Pass 2 and if procedure    *)
+                                            (* is a syscall.                 *)
+               LocalSymbols: SymbolTree ;   (* Contains all symbols declared *)
+                                            (* within this procedure.        *)
+               EnumerationScopeList: List ;
+                                            (* Enumeration scope list which  *)
+                                            (* contains a list of all        *)
+                                            (* enumerations which are        *)
+                                            (* visable within this scope.    *)
+               ListOfVars    : List ;       (* List of variables in this     *)
+                                            (* scope.                        *)
+               ListOfProcs   : List ;       (* List of all procedures        *)
+                                            (* declared within this          *)
+                                            (* procedure.                    *)
+               NamedObjects  : SymbolTree ; (* Names of all items declared.  *)
+               Size          : PtrToValue ; (* Activation record size.       *)
+               TotalParamSize: PtrToValue ; (* size of all parameters.       *)
+               ExceptionFinally,
+               ExceptionBlock: BOOLEAN ;    (* does it have an exception?    *)
+               Scope         : CARDINAL ;   (* Scope of declaration.         *)
+               errorScope    : ErrorScope ; (* The title scope.              *)
+               ListOfModules : List ;       (* List of all inner modules.    *)
+               Begin, End    : CARDINAL ;   (* Tokens marking the BEGIN END  *)
+               At            : Where ;      (* Where was sym declared/used   *)
+            END ;
+
+   SymProcType
+          = RECORD
+               name          : Name ;       (* Index into name array, name   *)
+                                            (* of procedure.                 *)
+               ListOfParam   : List ;       (* Contains a list of all the    *)
+                                            (* parameters in this procedure. *)
+               HasVarArgs    : BOOLEAN ;    (* Does this proc type use ... ? *)
+               HasOptArg     : BOOLEAN ;    (* Does this procedure use [ ] ? *)
+               OptArgInit    : CARDINAL ;   (* The optarg initial value.     *)
+               ReturnType    : CARDINAL ;   (* Return type for function.     *)
+               ReturnOptional: BOOLEAN ;    (* Is the return value optional? *)
+               Scope         : CARDINAL ;   (* Scope of declaration.         *)
+               Size          : PtrToValue ; (* Runtime size of symbol.       *)
+               TotalParamSize: PtrToValue ; (* size of all parameters.       *)
+               oafamily      : CARDINAL ;   (* The oafamily for this sym     *)
+               At            : Where ;      (* Where was sym declared/used   *)
+            END ;
+
+   SymParam = RECORD
+                 name          : Name ;       (* Index into name array, name *)
+                                              (* of param.                   *)
+                 Type          : CARDINAL ;   (* Index to the type of param. *)
+                 IsUnbounded   : BOOLEAN ;    (* ARRAY OF Type?              *)
+                 ShadowVar     : CARDINAL ;   (* The local variable used to  *)
+                                              (* shadow this parameter.      *)
+                 At            : Where ;      (* Where was sym declared/used *)
+              END ;
+
+   SymVarParam = RECORD
+                    name          : Name ;    (* Index into name array, name *)
+                                              (* of param.                   *)
+                    Type          : CARDINAL ;(* Index to the type of param. *)
+                    IsUnbounded   : BOOLEAN ; (* ARRAY OF Type?              *)
+                    ShadowVar     : CARDINAL ;(* The local variable used to  *)
+                                              (* shadow this parameter.      *)
+                    At            : Where ;   (* Where was sym declared/used *)
+                 END ;
+
+   ConstStringVariant = (m2str, cstr, m2nulstr, cnulstr) ;
+
+   SymConstString
+               = RECORD
+                    name           : Name ;       (* Index into name array, name *)
+                                                  (* of const.                   *)
+                    Contents       : Name ;       (* Contents of the string.     *)
+                    Length         : CARDINAL ;   (* StrLen (Contents)           *)
+                    M2Variant,
+                    NulM2Variant,
+                    CVariant,
+                    NulCVariant    : CARDINAL ;   (* variants of the same string *)
+                    StringVariant  : ConstStringVariant ;
+                    Scope          : CARDINAL ;   (* Scope of declaration.       *)
+                    At             : Where ;      (* Where was sym declared/used *)
+                 END ;
+
+   SymConstLit = RECORD
+                    name         : Name ;         (* Index into name array, name *)
+                                                  (* of const.                   *)
+                    Value        : PtrToValue ;   (* Value of the constant.      *)
+                    Type         : CARDINAL ;     (* TYPE of constant, char etc  *)
+                    IsSet        : BOOLEAN ;      (* is the constant a set?      *)
+                    IsConstructor: BOOLEAN ;      (* is the constant a set?      *)
+                    FromType     : CARDINAL ;     (* type is determined FromType *)
+                    UnresFromType: BOOLEAN ;      (* is Type unresolved?         *)
+                    Scope        : CARDINAL ;     (* Scope of declaration.       *)
+                    At           : Where ;        (* Where was sym declared/used *)
+                 END ;
+
+   SymConstVar = RECORD
+                    name         : Name ;     (* Index into name array, name *)
+                                              (* of const.                   *)
+                    Value        : PtrToValue ; (* Value of the constant     *)
+                    Type         : CARDINAL ; (* TYPE of constant, char etc  *)
+                    IsSet        : BOOLEAN ;  (* is the constant a set?      *)
+                    IsConstructor: BOOLEAN ;  (* is the constant a set?      *)
+                    FromType     : CARDINAL ; (* type is determined FromType *)
+                    UnresFromType: BOOLEAN ;  (* is Type resolved?           *)
+                    IsTemp       : BOOLEAN ;  (* is it a temporary?          *)
+                    Scope        : CARDINAL ; (* Scope of declaration.       *)
+                    At           : Where ;    (* Where was sym declared/used *)
+                 END ;
+
+   SymVar = RECORD
+               name          : Name ;         (* Index into name array, name *)
+                                              (* of const.                   *)
+               Type          : CARDINAL ;     (* Index to a type symbol.     *)
+               BackType      : CARDINAL ;     (* specific back end symbol.   *)
+               Size          : PtrToValue ;   (* Runtime size of symbol.     *)
+               Offset        : PtrToValue ;   (* Offset at runtime of symbol *)
+               AddrMode      : ModeOfAddr ;   (* Type of Addressing mode.    *)
+               Scope         : CARDINAL ;     (* Scope of declaration.       *)
+               AtAddress     : BOOLEAN ;      (* Is declared at address?     *)
+               Address       : CARDINAL ;     (* Address at which declared   *)
+               IsComponentRef: BOOLEAN ;      (* Is temporary referencing a  *)
+                                              (* record field?               *)
+               list          : Indexing.Index ;  (* the record and fields    *)
+               IsTemp        : BOOLEAN ;      (* Is variable a temporary?    *)
+               IsParam       : BOOLEAN ;      (* Is variable a parameter?    *)
+               IsPointerCheck: BOOLEAN ;      (* Is variable used to         *)
+                                              (* dereference a pointer?      *)
+               IsWritten     : BOOLEAN ;      (* Is variable written to?     *)
+               IsSSA         : BOOLEAN ;      (* Is variable a SSA?          *)
+               IsConst       : BOOLEAN ;      (* Is variable read/only?      *)
+               At            : Where ;        (* Where was sym declared/used *)
+               ReadUsageList,                 (* list of var read quads      *)
+               WriteUsageList: LRLists ;      (* list of var write quads     *)
+            END ;
+
+   SymType = RECORD
+                name        : Name ;          (* Index into name array, name *)
+                                              (* of type.                    *)
+                Type        : CARDINAL ;      (* Index to a type symbol.     *)
+                IsHidden    : BOOLEAN ;       (* Was it declared as hidden?  *)
+                ConstLitTree: SymbolTree ;    (* constants of this type.     *)
+                Size        : PtrToValue ;    (* Runtime size of symbol.     *)
+                packedInfo  : PackedInfo ;    (* the equivalent packed type  *)
+                oafamily    : CARDINAL ;      (* The oafamily for this sym   *)
+                Align       : CARDINAL ;      (* The alignment of this type  *)
+                Scope       : CARDINAL ;      (* Scope of declaration.       *)
+                At          : Where ;         (* Where was sym declared/used *)
+             END ;
+
+   SymPointer
+           = RECORD
+                name        : Name ;          (* Index into name array, name *)
+                                              (* of pointer.                 *)
+                Type        : CARDINAL ;      (* Index to a type symbol.     *)
+                Size        : PtrToValue ;    (* Runtime size of symbol.     *)
+                Align       : CARDINAL ;      (* The alignment of this type  *)
+                ConstLitTree: SymbolTree ;    (* constants of this type.     *)
+                oafamily    : CARDINAL ;      (* The oafamily for this sym   *)
+                Scope       : CARDINAL ;      (* Scope of declaration.       *)
+                At          : Where ;         (* Where was sym declared/used *)
+             END ;
+
+   SymRecordField =
+             RECORD
+                name      : Name ;            (* Index into name array, name *)
+                                              (* of record field.            *)
+                Type      : CARDINAL ;        (* Index to a type symbol.     *)
+                Tag       : BOOLEAN ;         (* is the record field really  *)
+                                              (* a varient tag?              *)
+                Size      : PtrToValue ;      (* Runtime size of symbol.     *)
+                Offset    : PtrToValue ;      (* Offset at runtime of symbol *)
+                Parent    : CARDINAL ;        (* Index into symbol table to  *)
+                                              (* determine the parent symbol *)
+                                              (* for this record field. Used *)
+                                              (* for BackPatching.           *)
+                Varient   : CARDINAL ;        (* Index into symbol table to  *)
+                                              (* determine the associated    *)
+                                              (* varient symbol.             *)
+                Align     : CARDINAL ;        (* The alignment of this type  *)
+                Used      : BOOLEAN ;         (* pragma usused unsets this.  *)
+                DeclPacked: BOOLEAN ;         (* Is this declared packed?    *)
+                DeclResolved: BOOLEAN ;       (* has we resolved packed?     *)
+                Scope     : CARDINAL ;        (* Scope of declaration.       *)
+                At        : Where ;           (* Where was sym declared/used *)
+             END ;
+
+   SymVarientField =
+             RECORD
+                name     : Name ;             (* Index into name array, name *)
+                                              (* of varient field (internal) *)
+                Size     : PtrToValue ;       (* Runtime size of symbol.     *)
+                Offset   : PtrToValue ;       (* Offset at runtime of symbol *)
+                Parent   : CARDINAL ;         (* Index into symbol table to  *)
+                                              (* determine the parent symbol *)
+                                              (* for this record field. Used *)
+                                              (* for BackPatching.           *)
+                Varient  : CARDINAL ;         (* Index into symbol table to  *)
+                                              (* determine the associated    *)
+                                              (* varient symbol.             *)
+                ListOfSons: List ;            (* Contains a list of the      *)
+                                              (* RecordField symbols and     *)
+                                              (* SymVarients                 *)
+                DeclPacked: BOOLEAN ;         (* Is this varient field       *)
+                                              (* packed?                     *)
+                DeclResolved: BOOLEAN ;       (* is it resolved?             *)
+                Scope    : CARDINAL ;         (* Scope of declaration.       *)
+                At       : Where ;            (* Where was sym declared/used *)
+             END ;
+
+   SymEnumerationField =
+             RECORD
+                name     : Name ;             (* Index into name array, name *)
+                                              (* of enumeration field.       *)
+                Value    : PtrToValue ;       (* Enumeration field value.    *)
+                Type     : CARDINAL ;         (* Index to the enumeration.   *)
+                Scope    : CARDINAL ;         (* Scope of declaration.       *)
+                At       : Where ;            (* Where was sym declared/used *)
+             END ;
+
+   SymSet  = RECORD
+      	        name     : Name ;             (* Index into name array, name *)
+                                              (* of set.                     *)
+                Type     : CARDINAL ;         (* Index to a type symbol.     *)
+      	       	     	      	       	      (* (subrange or enumeration).  *)
+                packedInfo: PackedInfo ;      (* the equivalent packed type  *)
+                ispacked : BOOLEAN ;
+                Size     : PtrToValue ;       (* Runtime size of symbol.     *)
+                oafamily : CARDINAL ;         (* The oafamily for this sym   *)
+                Scope    : CARDINAL ;         (* Scope of declaration.       *)
+                At       : Where ;            (* Where was sym declared/used *)
+             END ;
+
+   SymDefImp =
+            RECORD
+               name          : Name ;       (* Index into name array, name   *)
+                                            (* of record field.              *)
+               ctors         : ModuleCtor ; (* All the ctor functions.       *)
+               DefListOfDep,
+               ModListOfDep  : List ;       (* Vector of SymDependency.      *)
+               ExportQualifiedTree: SymbolTree ;
+                                            (* Holds all the export          *)
+                                            (* Qualified identifiers.        *)
+                                            (* This tree may be              *)
+                                            (* deleted at the end of Pass 1. *)
+               ExportUnQualifiedTree: SymbolTree ;
+                                            (* Holds all the export          *)
+                                            (* UnQualified identifiers.      *)
+                                            (* This tree may be              *)
+                                            (* deleted at the end of Pass 1. *)
+               ExportRequest : SymbolTree ; (* Contains all identifiers that *)
+                                            (* have been requested by other  *)
+                                            (* modules before this module    *)
+                                            (* declared its export list.     *)
+                                            (* This tree should be empty at  *)
+                                            (* the end of the compilation.   *)
+                                            (* Each time a symbol is         *)
+                                            (* exported it is removed from   *)
+                                            (* this list.                    *)
+               IncludeList   : List ;       (* Contains all included symbols *)
+                                            (* which are included by         *)
+                                            (* IMPORT modulename ;           *)
+                                            (* modulename.Symbol             *)
+               DefIncludeList: List ;       (* Contains all included symbols *)
+                                            (* which are included by         *)
+                                            (* IMPORT modulename ;           *)
+                                            (* in the definition module only *)
+               ImportTree    : SymbolTree ; (* Contains all IMPORTed         *)
+                                            (* identifiers.                  *)
+               ExportUndeclared: SymbolTree ;
+                                            (* ExportUndeclared contains all *)
+                                            (* the identifiers which were    *)
+                                            (* exported but have not yet     *)
+                                            (* been declared.                *)
+               NeedToBeImplemented: SymbolTree ;
+                                            (* NeedToBeImplemented contains  *)
+                                            (* the identifiers which have    *)
+                                            (* been exported and declared    *)
+                                            (* but have not yet been         *)
+                                            (* implemented.                  *)
+               LocalSymbols  : SymbolTree ; (* The LocalSymbols hold all the *)
+                                            (* variables declared local to   *)
+                                            (* the block. It contains the    *)
+                                            (* IMPORT r ;                    *)
+                                            (* FROM _ IMPORT x, y, x ;       *)
+                                            (*    and also                   *)
+                                            (* MODULE WeAreHere ;            *)
+                                            (*    x y z visible by localsym  *)
+                                            (*    MODULE Inner ;             *)
+                                            (*       EXPORT x, y, z ;        *)
+                                            (*    END Inner ;                *)
+                                            (* END WeAreHere.                *)
+               EnumerationScopeList: List ; (* Enumeration scope list which  *)
+                                            (* contains a list of all        *)
+                                            (* enumerations which are        *)
+                                            (* visible within this scope.    *)
+               NamedObjects  : SymbolTree ; (* Names of all items declared.  *)
+               NamedImports  : SymbolTree ; (* Names of items imported.      *)
+               WhereImported : SymbolTree ; (* Sym to TokenNo where import   *)
+                                            (* occurs. Error message use.    *)
+               Priority      : CARDINAL ;   (* Priority of the module. This  *)
+                                            (* is an index to a constant.    *)
+               Unresolved    : SymbolTree ; (* All symbols currently         *)
+                                            (* unresolved in this module.    *)
+               StartQuad     : CARDINAL ;   (* Signify the initialization    *)
+                                            (* code.                         *)
+               EndQuad       : CARDINAL ;   (* EndQuad should point to a     *)
+                                            (* goto quad.                    *)
+               StartFinishQuad: CARDINAL ;  (* Signify the finalization      *)
+                                            (* code.                         *)
+               EndFinishQuad : CARDINAL ;   (* should point to a finish      *)
+               FinallyFunction: Tree ;      (* The GCC function for finally  *)
+               ExceptionFinally,
+               ExceptionBlock: BOOLEAN ;    (* does it have an exception?    *)
+               ContainsHiddenType: BOOLEAN ;(* True if this module           *)
+                                            (* implements a hidden type.     *)
+               ContainsBuiltin: BOOLEAN ;   (* Does the module define a      *)
+                                            (* builtin procedure?            *)
+               ForC          : BOOLEAN ;    (* Is it a definition for "C"    *)
+               NeedExportList: BOOLEAN ;    (* Must user supply export list? *)
+               ModLink,                     (* Is the Def/Mod module parsed  *)
+               DefLink       : BOOLEAN ;    (* for linkage only?             *)
+               Builtin       : BOOLEAN ;    (* Is the module builtin?        *)
+               ListOfVars    : List ;       (* List of variables in this     *)
+                                            (* scope.                        *)
+               ListOfProcs   : List ;       (* List of all procedures        *)
+                                            (* declared within this module.  *)
+               ListOfModules : List ;       (* List of all inner modules.    *)
+               errorScope    : ErrorScope ; (* The title scope.              *)
+               At            : Where ;      (* Where was sym declared/used *)
+            END ;
+
+   SymModule =
+            RECORD
+               name          : Name ;       (* Index into name array, name   *)
+                                            (* of record field.              *)
+               ctors         : ModuleCtor ; (* All the ctor functions.       *)
+               ModListOfDep  : List ;       (* Vector of SymDependency.      *)
+               LocalSymbols  : SymbolTree ; (* The LocalSymbols hold all the *)
+                                            (* variables declared local to   *)
+                                            (* the block. It contains the    *)
+                                            (* IMPORT r ;                    *)
+                                            (* FROM _ IMPORT x, y, x ;       *)
+                                            (*    and also                   *)
+                                            (* MODULE WeAreHere ;            *)
+                                            (*    x y z visible by localsym  *)
+                                            (*    MODULE Inner ;             *)
+                                            (*       EXPORT x, y, z ;        *)
+                                            (*    END Inner ;                *)
+                                            (* END WeAreHere.                *)
+               ExportTree    : SymbolTree ; (* Holds all the exported        *)
+                                            (* identifiers.                  *)
+                                            (* This tree may be              *)
+                                            (* deleted at the end of Pass 1. *)
+               IncludeList   : List ;       (* Contains all included symbols *)
+                                            (* which are included by         *)
+                                            (* IMPORT modulename ;           *)
+                                            (* modulename.Symbol             *)
+               ImportTree    : SymbolTree ; (* Contains all IMPORTed         *)
+                                            (* identifiers.                  *)
+               ExportUndeclared: SymbolTree ;
+                                            (* ExportUndeclared contains all *)
+                                            (* the identifiers which were    *)
+                                            (* exported but have not yet     *)
+                                            (* been declared.                *)
+               EnumerationScopeList: List ; (* Enumeration scope list which  *)
+                                            (* contains a list of all        *)
+                                            (* enumerations which are        *)
+                                            (* visable within this scope.    *)
+               NamedObjects  : SymbolTree ; (* Names of all items declared.  *)
+               NamedImports  : SymbolTree ; (* Names of items imported.      *)
+               WhereImported : SymbolTree ; (* Sym to TokenNo where import   *)
+                                            (* occurs. Error message use.    *)
+               Scope         : CARDINAL ;   (* Scope of declaration.         *)
+               Priority      : CARDINAL ;   (* Priority of the module. This  *)
+                                            (* is an index to a constant.    *)
+               Unresolved    : SymbolTree ; (* All symbols currently         *)
+                                            (* unresolved in this module.    *)
+               StartQuad     : CARDINAL ;   (* Signify the initialization    *)
+                                            (* code.                         *)
+               EndQuad       : CARDINAL ;   (* EndQuad should point to a     *)
+                                            (* goto quad.                    *)
+               StartFinishQuad: CARDINAL ;  (* Signify the finalization      *)
+                                            (* code.                         *)
+               EndFinishQuad : CARDINAL ;   (* should point to a finish      *)
+               FinallyFunction: Tree ;      (* The GCC function for finally  *)
+               ExceptionFinally,
+               ExceptionBlock: BOOLEAN ;    (* does it have an exception?    *)
+               ModLink       : BOOLEAN ;    (* Is the module parsed for      *)
+                                            (* linkage only?                 *)
+               Builtin       : BOOLEAN ;    (* Is the module builtin?        *)
+               ListOfVars    : List ;       (* List of variables in this     *)
+                                            (* scope.                        *)
+               ListOfProcs   : List ;       (* List of all procedures        *)
+                                            (* declared within this module.  *)
+               ListOfModules : List ;       (* List of all inner modules.    *)
+               errorScope    : ErrorScope ; (* The title scope.              *)
+               At            : Where ;      (* Where was sym declared/used   *)
+            END ;
+
+   SymDummy =
+            RECORD
+               NextFree     : CARDINAL ;    (* Link to the next free symbol. *)
+            END ;
+
+
+   Symbol = RECORD
+               CASE SymbolType : TypeOfSymbol OF
+                                            (* Determines the type of symbol *)
+
+               OAFamilySym         : OAFamily         : SymOAFamily |
+               ObjectSym           : Object           : SymObject |
+               EquivSym            : Equiv            : SymEquiv |
+               RecordSym           : Record           : SymRecord |
+               VarientSym          : Varient          : SymVarient |
+               VarSym              : Var              : SymVar |
+               EnumerationSym      : Enumeration      : SymEnumeration |
+               SubrangeSym         : Subrange         : SymSubrange |
+               SubscriptSym        : Subscript        : SymSubscript |
+               ArraySym            : Array            : SymArray |
+               UnboundedSym        : Unbounded        : SymUnbounded |
+               PartialUnboundedSym : PartialUnbounded : SymPartialUnbounded |
+               ConstVarSym         : ConstVar         : SymConstVar |
+               ConstLitSym         : ConstLit         : SymConstLit |
+               ConstStringSym      : ConstString      : SymConstString |
+               VarParamSym         : VarParam         : SymVarParam |
+               ParamSym            : Param            : SymParam |
+               ErrorSym            : Error            : SymError |
+               UndefinedSym        : Undefined        : SymUndefined |
+               TypeSym             : Type             : SymType |
+               PointerSym          : Pointer          : SymPointer |
+               RecordFieldSym      : RecordField      : SymRecordField |
+               VarientFieldSym     : VarientField     : SymVarientField |
+               EnumerationFieldSym : EnumerationField : SymEnumerationField |
+               DefImpSym           : DefImp           : SymDefImp |
+               ModuleSym           : Module           : SymModule |
+               SetSym              : Set              : SymSet |
+               ProcedureSym        : Procedure        : SymProcedure |
+               ProcTypeSym         : ProcType         : SymProcType |
+               ImportStatementSym        : ImportStatement        : SymImportStatement |
+               ImportSym           : Import           : SymImport |
+               GnuAsmSym           : GnuAsm           : SymGnuAsm |
+               InterfaceSym        : Interface        : SymInterface |
+               TupleSym            : Tuple            : SymTuple |
+               DummySym            : Dummy            : SymDummy
+
+               END
+            END ;
+
+   CallFrame = RECORD
+                  Main  : CARDINAL ;  (* Main scope for insertions        *)
+                  Search: CARDINAL ;  (* Search scope for symbol searches *)
+                  Start : CARDINAL ;  (* ScopePtr value before StartScope *)
+                                      (* was called.                      *)
+               END ;
+
+   PtrToSymbol = POINTER TO Symbol ;
+   PtrToCallFrame = POINTER TO CallFrame ;
+
+   CheckProcedure = PROCEDURE (CARDINAL) ;
+
+VAR
+   Symbols       : Indexing.Index ;       (* ARRAY [1..MaxSymbols] OF Symbol.   *)
+   ScopeCallFrame: Indexing.Index ;       (* ARRAY [1..MaxScopes] OF CallFrame. *)
+   FreeSymbol    : CARDINAL ;    (* The next free symbol indice.       *)
+   DefModuleTree : SymbolTree ;
+   ModuleTree    : SymbolTree ;  (* Tree of all modules ever used.     *)
+   ConstLitStringTree
+                 : SymbolTree ;  (* String Literal Constants only need *)
+                                 (* to be declared once.               *)
+   ConstLitTree  : SymbolTree ;  (* Numerical Literal Constants only   *)
+                                 (* need to be declared once.          *)
+   CurrentModule : CARDINAL ;    (* Index into symbols determining the *)
+                                 (* current module being compiled.     *)
+                                 (* This maybe an inner module.        *)
+   MainModule    : CARDINAL ;    (* Index into symbols determining the *)
+                                 (* module the user requested to       *)
+                                 (* compile.                           *)
+   FileModule    : CARDINAL ;    (* Index into symbols determining     *)
+                                 (* which module (file) is being       *)
+                                 (* compiled. (Maybe an import def)    *)
+   ScopePtr      : CARDINAL ;    (* An index to the ScopeCallFrame.    *)
+                                 (* ScopePtr determines the top of the *)
+                                 (* ScopeCallFrame.                    *)
+   BaseScopePtr  : CARDINAL ;    (* An index to the ScopeCallFrame of  *)
+                                 (* the top of BaseModule. BaseModule  *)
+                                 (* is always left at the bottom of    *)
+                                 (* stack since it is used so          *)
+                                 (* frequently. When the BaseModule    *)
+                                 (* needs to be searched the ScopePtr  *)
+                                 (* is temporarily altered to          *)
+                                 (* BaseScopePtr and GetScopeSym is    *)
+                                 (* called.                            *)
+   BaseModule    : CARDINAL ;    (* Index to the symbol table of the   *)
+                                 (* Base pseudo modeule declaration.   *)
+   TemporaryNo   : CARDINAL ;    (* The next temporary number.         *)
+   CurrentError  : Error ;       (* Current error chain.               *)
+   AddressTypes  : List ;        (* A list of type symbols which must  *)
+                                 (* be declared as ADDRESS or pointer  *)
+(*
+   FreeFVarientList,             (* Lists used to maintain GC of field *)
+   UsedFVarientList: List ;      (* varients.                          *)
+*)
+   UnresolvedConstructorType: List ;  (* all constructors whose type   *)
+                                 (* is not yet known.                  *)
+   AnonymousName     : CARDINAL ;(* anonymous type name unique id      *)
+   ReportedUnknowns  : Set ;     (* set of symbols already reported as *)
+                                 (* unknowns to the user.              *)
+
+
+(*
+   CheckAnonymous - checks to see whether the name is NulName and if so
+                    it creates a unique anonymous name.
+*)
+
+PROCEDURE CheckAnonymous (name: Name) : Name ;
+BEGIN
+   IF name=NulName
+   THEN
+      INC(AnonymousName) ;
+      name := makekey(string(Mark(Sprintf1(Mark(InitString('$$%d')), AnonymousName))))
+   END ;
+   RETURN( name )
+END CheckAnonymous ;
+
+
+(*
+   IsNameAnonymous - returns TRUE if the symbol, sym, has an anonymous name
+                     or no name.
+*)
+
+PROCEDURE IsNameAnonymous (sym: CARDINAL) : BOOLEAN ;
+VAR
+   a: ARRAY [0..1] OF CHAR ;
+   n: Name ;
+BEGIN
+   n := GetSymName(sym) ;
+   IF n=NulName
+   THEN
+      RETURN( TRUE )
+   ELSE
+      GetKey(n, a) ;
+      RETURN( StrEqual(a, '$$') )
+   END
+END IsNameAnonymous ;
+
+
+(*
+   InitWhereDeclared - sets the Declared and FirstUsed fields of record, at.
+*)
+
+PROCEDURE InitWhereDeclaredTok (tok: CARDINAL; VAR at: Where) ;
+BEGIN
+   WITH at DO
+      IF CompilingDefinitionModule ()
+      THEN
+         DefDeclared := tok ;
+         ModDeclared := UnknownTokenNo
+      ELSE
+         DefDeclared := UnknownTokenNo ;
+         ModDeclared := tok
+      END ;
+      FirstUsed := tok   (* we assign this field to something legal *)
+   END
+END InitWhereDeclaredTok ;
+
+
+(*
+   InitWhereDeclared - sets the Declared and FirstUsed fields of record, at.
+*)
+
+PROCEDURE InitWhereDeclared (VAR at: Where) ;
+BEGIN
+   InitWhereDeclaredTok (GetTokenNo (), at)
+END InitWhereDeclared ;
+
+
+(*
+   InitWhereFirstUsed - sets the FirstUsed field of record, at.
+*)
+
+PROCEDURE InitWhereFirstUsed (VAR at: Where) ;
+BEGIN
+   InitWhereFirstUsedTok (GetTokenNo (), at)
+END InitWhereFirstUsed ;
+
+
+(*
+   InitWhereFirstUsedTok - sets the FirstUsed field of record, at.
+*)
+
+PROCEDURE InitWhereFirstUsedTok (tok: CARDINAL; VAR at: Where) ;
+BEGIN
+   WITH at DO
+      FirstUsed := tok
+   END
+END InitWhereFirstUsedTok ;
+
+
+(*
+   FinalSymbol - returns the highest number symbol used.
+*)
+
+PROCEDURE FinalSymbol () : CARDINAL ;
+BEGIN
+   RETURN( FreeSymbol-1 )
+END FinalSymbol ;
+
+
+(*
+   NewSym - Sets Sym to a new symbol index.
+*)
+
+PROCEDURE NewSym (VAR sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   sym := FreeSymbol ;
+   NEW(pSym) ;
+   WITH pSym^ DO
+      SymbolType := DummySym
+   END ;
+   PutIndice(Symbols, sym, pSym) ;
+   INC(FreeSymbol)
+END NewSym ;
+
+
+(*
+   GetPsym - returns the pointer to, sym.
+*)
+
+PROCEDURE GetPsym (sym: CARDINAL) : PtrToSymbol ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF InBounds(Symbols, sym)
+   THEN
+      pSym := GetIndice(Symbols, sym) ;
+      RETURN( pSym )
+   ELSE
+      InternalError ('symbol out of bounds')
+   END
+END GetPsym ;
+
+
+(*
+   GetPcall - returns the pointer to the CallFrame.
+*)
+
+PROCEDURE GetPcall (call: CARDINAL) : PtrToCallFrame ;
+VAR
+   pCall: PtrToCallFrame ;
+BEGIN
+   IF InBounds(ScopeCallFrame, call)
+   THEN
+      pCall := GetIndice(ScopeCallFrame, call) ;
+      RETURN( pCall )
+   ELSE
+      InternalError ('symbol out of bounds')
+   END
+END GetPcall ;
+
+
+(*
+   MakeImport - create and return an import symbol.
+                moduleSym is the symbol being imported.
+                isqualified is FALSE if it were IMPORT modulename and
+                TRUE for the qualified FROM modulename IMPORT etc.
+                listno is the import list count for this module.
+                tok should match this modulename position.
+*)
+
+PROCEDURE MakeImport (tok: CARDINAL;
+                      moduleSym: CARDINAL;
+                      listno: CARDINAL;
+                      isqualified: BOOLEAN) : CARDINAL ;
+VAR
+   importSym: CARDINAL ;
+   pSym     : PtrToSymbol ;
+BEGIN
+   NewSym (importSym) ;
+   pSym := GetPsym (importSym) ;
+   WITH pSym^ DO
+      SymbolType := ImportSym ;
+      WITH Import DO
+         module := moduleSym ;
+         listNo := listno ;
+         qualified := isqualified ;
+         InitWhereDeclaredTok (tok, at)
+      END
+   END ;
+   RETURN importSym
+END MakeImport ;
+
+
+(*
+   MakeImportStatement - return a dependent symbol which represents an import statement
+                   or a qualified import statement.  The tok should either match
+                   the FROM token or the IMPORT token.  listno is the import list
+                   count for the module.
+*)
+
+PROCEDURE MakeImportStatement (tok: CARDINAL; listno: CARDINAL) : CARDINAL ;
+VAR
+   dependentSym: CARDINAL ;
+   pSym        : PtrToSymbol ;
+BEGIN
+   NewSym (dependentSym) ;
+   pSym := GetPsym (dependentSym) ;
+   WITH pSym^ DO
+      SymbolType := ImportStatementSym ;
+      WITH ImportStatement DO
+         listNo := listno ;
+         InitList (ListOfImports) ;
+         InitWhereDeclaredTok (tok, at)
+      END
+   END ;
+   RETURN dependentSym
+END MakeImportStatement ;
+
+
+(*
+   AppendModuleImportStatement - appends the ImportStatement symbol onto the
+                                 module import list.
+
+                                 For example:
+
+                                 FROM x IMPORT y, z ;
+                                 ^^^^
+
+                                 also:
+
+                                 IMPORT p, q, r;
+                                 ^^^^^^
+                                 will result in a new ImportStatement symbol added
+                                 to the current module import list.
+                                 The statement symbol is expected to be created
+                                 by MakeImportStatement using the token positions
+                                 outlined above.
+*)
+
+PROCEDURE AppendModuleImportStatement (module, statement: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsDefImp (module)
+   THEN
+      pSym := GetPsym (module) ;
+      IF CompilingDefinitionModule ()
+      THEN
+         IncludeItemIntoList (pSym^.DefImp.DefListOfDep, statement)
+      ELSE
+         IncludeItemIntoList (pSym^.DefImp.ModListOfDep, statement)
+      END
+   ELSIF IsModule (module)
+   THEN
+      pSym := GetPsym (module) ;
+      IncludeItemIntoList (pSym^.Module.ModListOfDep, statement)
+   ELSE
+      InternalError ('expecting DefImp or Module symbol')
+   END
+END AppendModuleImportStatement ;
+
+
+(*
+   AppendModuleOnImportStatement - appends the import symbol onto the
+                                   dependent list (chain).
+
+                                   For example each:
+
+                                   FROM x IMPORT y, z ;
+                                        ^
+                                   x are added to the dependent list.
+
+                                   also:
+
+                                   IMPORT p, q, r;
+                                          ^  ^  ^
+                                   will result in p, q and r added to
+                                   to the dependent list.
+
+                                   The import symbol is created by MakeImport
+                                   and the token is expected to match the module
+                                   name position outlined above.
+*)
+
+PROCEDURE AppendModuleOnImportStatement (module, import: CARDINAL) ;
+VAR
+   l                  : List ;
+   lastImportStatement: CARDINAL ;
+BEGIN
+   Assert (IsImport (import)) ;
+   IF CompilingDefinitionModule ()
+   THEN
+      l := GetModuleDefImportStatementList (module)
+   ELSE
+      l := GetModuleModImportStatementList (module)
+   END ;
+   Assert (l # NIL) ;
+   Assert (NoOfItemsInList (l) > 0) ;  (* There should always be one on the list.  *)
+   lastImportStatement := GetItemFromList (l, NoOfItemsInList (l)) ;
+   Assert (IsImportStatement (lastImportStatement)) ;
+   l := GetImportStatementList (lastImportStatement) ;
+   IncludeItemIntoList (l, import)
+END AppendModuleOnImportStatement ;
+
+
+(*
+   IsImport - returns TRUE if sym is an import symbol.
+*)
+
+PROCEDURE IsImport (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   RETURN pSym^.SymbolType=ImportSym
+END IsImport ;
+
+
+(*
+   IsImportStatement - returns TRUE if sym is a dependent symbol.
+*)
+
+PROCEDURE IsImportStatement (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   RETURN pSym^.SymbolType=ImportStatementSym
+END IsImportStatement ;
+
+
+(*
+   GetImportModule - returns the module associated with the import symbol.
+*)
+
+PROCEDURE GetImportModule (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert (IsImport (sym)) ;
+   pSym := GetPsym (sym) ;
+   RETURN pSym^.Import.module
+END GetImportModule ;
+
+
+(*
+   GetImportDeclared - returns the token associated with the import symbol.
+*)
+
+PROCEDURE GetImportDeclared (sym: CARDINAL) : CARDINAL ;
+VAR
+   tok : CARDINAL ;
+BEGIN
+   Assert (IsImport (sym)) ;
+   tok := GetDeclaredDefinition (sym) ;
+   IF tok = UnknownTokenNo
+   THEN
+      RETURN GetDeclaredModule (sym)
+   END ;
+   RETURN tok
+END GetImportDeclared ;
+
+
+(*
+   GetImportStatementList - returns the list of imports for this dependent.
+                            Each import symbol corresponds to a module.
+*)
+
+PROCEDURE GetImportStatementList (sym: CARDINAL) : List ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert (IsImportStatement (sym)) ;
+   pSym := GetPsym (sym) ;
+   RETURN pSym^.ImportStatement.ListOfImports
+END GetImportStatementList ;
+
+
+(*
+   GetModuleDefImportStatementList - returns the list of dependents associated with
+                                     the definition module.
+*)
+
+PROCEDURE GetModuleDefImportStatementList (sym: CARDINAL) : List ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert (IsModule (sym) OR IsDefImp (sym)) ;
+   IF IsDefImp (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      RETURN pSym^.DefImp.DefListOfDep
+   END ;
+   RETURN NIL
+END GetModuleDefImportStatementList ;
+
+
+(*
+   GetModuleModImportStatementList - returns the list of dependents associated with
+                                     the implementation or program module.
+*)
+
+PROCEDURE GetModuleModImportStatementList (sym: CARDINAL) : List ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert (IsModule (sym) OR IsDefImp (sym)) ;
+   pSym := GetPsym (sym) ;
+   IF IsDefImp (sym)
+   THEN
+      RETURN pSym^.DefImp.ModListOfDep
+   ELSE
+      RETURN pSym^.Module.ModListOfDep
+   END
+END GetModuleModImportStatementList ;
+
+
+(*
+   DebugProcedureLineNumber -
+*)
+
+PROCEDURE DebugProcedureLineNumber (sym: CARDINAL) ;
+VAR
+   begin, end: CARDINAL ;
+   n         : Name ;
+   f         : String ;
+   l         : CARDINAL ;
+BEGIN
+   GetProcedureBeginEnd (sym, begin, end) ;
+   n := GetSymName(sym) ;
+   IF begin#0
+   THEN
+      f := FindFileNameFromToken (begin, 0) ;
+      l := TokenToLineNo(begin, 0) ;
+      printf3 ('%s:%d:%a:begin\n', f, l, n)
+   END ;
+   IF end#0
+   THEN
+      f := FindFileNameFromToken (end, 0) ;
+      l := TokenToLineNo(end, 0) ;
+      printf3 ('%s:%d:%a:end\n', f, l, n)
+   END
+END DebugProcedureLineNumber ;
+
+
+(*
+   DebugLineNumbers - internal debugging, emit all procedure names in this module
+                      together with the line numbers for the corresponding begin/end
+                      tokens.
+*)
+
+PROCEDURE DebugLineNumbers (sym: CARDINAL) ;
+BEGIN
+   IF DebugFunctionLineNumbers
+   THEN
+      printf0 ('<lines>\n') ;
+      ForeachProcedureDo(sym, DebugProcedureLineNumber) ;
+      printf0 ('</lines>\n')
+   END
+END DebugLineNumbers ;
+
+
+(*
+   IsPartialUnbounded - returns TRUE if, sym, is a partially unbounded symbol.
+*)
+
+PROCEDURE IsPartialUnbounded (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF sym>0
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         PartialUnboundedSym:  RETURN( TRUE )
+
+         ELSE
+            RETURN( FALSE )
+         END
+      END
+   ELSE
+      RETURN( FALSE )
+   END
+END IsPartialUnbounded ;
+
+
+(*
+   PutPartialUnbounded -
+*)
+
+PROCEDURE PutPartialUnbounded (sym: CARDINAL; type: CARDINAL; ndim: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   IF IsDummy(sym)
+   THEN
+      pSym^.SymbolType := PartialUnboundedSym
+   END ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      PartialUnboundedSym:  PartialUnbounded.Type := type ;
+                            PartialUnbounded.NDim := ndim
+
+      ELSE
+         InternalError ('not expecting this type')
+      END
+   END
+END PutPartialUnbounded ;
+
+
+(*
+   AlreadyDeclaredError - generate an error message, a, and two areas of code showing
+                          the places where the symbols were declared.
+*)
+
+PROCEDURE AlreadyDeclaredError (s: String; name: Name; OtherOccurance: CARDINAL) ;
+VAR
+   e: Error ;
+BEGIN
+   IF (OtherOccurance=0) OR (OtherOccurance=GetTokenNo())
+   THEN
+      e := NewError(GetTokenNo()) ;
+      ErrorString(e, s)
+   ELSE
+      e := NewError(GetTokenNo()) ;
+      ErrorString(e, s) ;
+      e := ChainError(OtherOccurance, e) ;
+      ErrorFormat1(e, 'and symbol (%a) is also declared here', name)
+   END
+END AlreadyDeclaredError ;
+
+
+(*
+   AlreadyImportedError - generate an error message, a, and two areas of code showing
+                          the places where the symbols was imported and also declared.
+*)
+
+(*
+PROCEDURE AlreadyImportedError (s: String; name: Name; OtherOccurance: CARDINAL) ;
+VAR
+   e: Error ;
+BEGIN
+   IF (OtherOccurance=0) OR (OtherOccurance=GetTokenNo())
+   THEN
+      e := NewError(GetTokenNo()) ;
+      ErrorString(e, s)
+   ELSE
+      e := NewError(GetTokenNo()) ;
+      ErrorString(e, s) ;
+      e := ChainError(OtherOccurance, e) ;
+      ErrorFormat1(e, 'and symbol (%a) was also seen here', name)
+   END
+END AlreadyImportedError ;
+*)
+
+
+(*
+   MakeError - creates an error node, which can be used in MetaError messages.
+               It will be removed from ExportUndeclared and Unknown trees.
+*)
+
+PROCEDURE MakeError (tok: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   (* if Sym is present on the unknown tree then remove it *)
+   Sym := FetchUnknownSym (name) ;
+   IF Sym=NulSym
+   THEN
+      NewSym(Sym)
+   ELSE
+      (*
+         remove symbol from this tree as we have already generated
+         a meaningful error message
+      *)
+      RemoveExportUndeclared(GetCurrentModuleScope(), Sym)
+   END ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := ErrorSym ;
+      Error.name := name ;
+      InitWhereDeclaredTok(tok, Error.At) ;
+      InitWhereFirstUsedTok(tok, Error.At)
+   END ;
+   RETURN( Sym )
+END MakeError ;
+
+
+(*
+   MakeErrorS - creates an error node from a string, which can be used
+                in MetaError messages.
+                It will be removed from ExportUndeclared and Unknown trees.
+*)
+
+PROCEDURE MakeErrorS (tok: CARDINAL; name: String) : CARDINAL ;
+BEGIN
+   RETURN MakeError (tok, makekey (string (name)))
+END MakeErrorS ;
+
+
+(*
+   IsError - returns TRUE if the symbol is an error symbol.
+*)
+
+PROCEDURE IsError (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=ErrorSym )
+END IsError ;
+
+
+(*
+   MakeObject - creates an object node.
+*)
+
+PROCEDURE MakeObject (name: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   NewSym(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := ObjectSym ;
+      Object.name := name ;
+      InitWhereDeclared(Object.At) ;
+      InitWhereFirstUsed(Object.At)
+   END ;
+   RETURN( Sym )
+END MakeObject ;
+
+
+(*
+   IsTuple - returns TRUE if the symbol is a tuple symbol.
+*)
+
+PROCEDURE IsTuple (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=TupleSym )
+END IsTuple ;
+
+
+(*
+   IsObject - returns TRUE if the symbol is an object symbol.
+*)
+
+PROCEDURE IsObject (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=ObjectSym )
+END IsObject ;
+
+
+(*
+   DeclareSym - returns a symbol which was either in the unknown tree or
+                a New symbol, since name is about to be declared.
+*)
+
+PROCEDURE DeclareSym (tok: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   IF name = NulName
+   THEN
+      NewSym (Sym)
+   ELSIF IsAlreadyDeclaredSym (name)
+   THEN
+      Sym := GetSym (name) ;
+      IF IsImported (GetCurrentModuleScope (), Sym)
+      THEN
+         MetaErrorT1 (GetWhereImported(Sym),
+                      'symbol {%1Rad} is already present in this scope, check both definition and implementation modules, use a different name or remove the import',
+                      Sym) ;
+         MetaErrorT1 (tok, 'symbol {%1Cad} also declared in this module', Sym) ;
+         IF Sym # GetVisibleSym (name)
+         THEN
+            MetaErrorT1 (tok, 'symbol {%1CMad} also declared in this module', GetVisibleSym (name))
+         END
+      ELSE
+         MetaErrorT1 (tok, 'symbol {%1RMad} is already declared in this scope, use a different name or remove the declaration', Sym) ;
+         MetaErrorT1 (tok, 'symbol {%1Cad} also declared in this module', Sym) ;
+         IF Sym # GetVisibleSym(name)
+         THEN
+            MetaErrorT1(tok, 'symbol {%1CMad} also declared in this module', GetVisibleSym (name))
+         END
+      END ;
+      Sym := MakeError (tok, name)
+   ELSE
+      Sym := FetchUnknownSym (name) ;
+      IF Sym=NulSym
+      THEN
+         NewSym (Sym)
+      END ;
+      CheckForExportedDeclaration (Sym)
+   END ;
+   RETURN Sym
+END DeclareSym ;
+
+
+(*
+   Init - Initializes the data structures and variables in this module.
+          Initialize the trees.
+*)
+
+PROCEDURE Init ;
+VAR
+   pCall: PtrToCallFrame ;
+BEGIN
+   AnonymousName := 0 ;
+   CurrentError := NIL ;
+   InitTree(ConstLitTree) ;
+   InitTree(ConstLitStringTree) ;
+   InitTree(DefModuleTree) ;
+   InitTree(ModuleTree) ;
+   Symbols := InitIndex(1) ;
+   FreeSymbol := 1 ;
+   ScopePtr := 1 ;
+   ScopeCallFrame := InitIndex(1) ;
+   NEW(pCall) ;
+   WITH pCall^ DO
+      Main := NulSym ;
+      Search := NulSym
+   END ;
+   PutIndice(ScopeCallFrame, ScopePtr, pCall) ;
+   CurrentModule     := NulSym ;
+   MainModule        := NulSym ;
+   FileModule        := NulSym ;
+   TemporaryNo       := 0 ;
+(*
+   InitList(FreeFVarientList) ;             (* Lists used to maintain GC of field *)
+   InitList(UsedFVarientList) ;             (* varients.                          *)
+*)
+   InitList(UnresolvedConstructorType) ;
+
+   InitBase(BuiltinsLocation(), BaseModule) ;
+   StartScope(BaseModule) ;   (* BaseModule scope placed at the bottom of the stack *)
+   BaseScopePtr := ScopePtr ; (* BaseScopePtr points to the top of the BaseModule scope *)
+   InitList(AddressTypes) ;
+   ReportedUnknowns := InitSet(1)
+END Init ;
+
+
+(*
+   FromModuleGetSym - attempts to find a symbol of name, n, in the
+                      module, mod, scope.  An unknown symbol is created
+                      at token position tok if necessary.
+*)
+
+PROCEDURE FromModuleGetSym (tok: CARDINAL; n: Name; mod: CARDINAL) : CARDINAL ;
+VAR
+   n1         : Name ;
+   sym        : CARDINAL ;
+   OldScopePtr: CARDINAL ;
+BEGIN
+   OldScopePtr := ScopePtr ;
+   StartScope (mod) ;
+   sym := RequestSym (tok, n) ;
+   EndScope ;
+   IF sym=NulSym
+   THEN
+      (* --fixme-- can sym ever be NulSym?  *)
+      n1 := GetSymName(mod) ;
+      WriteFormat2('cannot find procedure %a in module, %a',
+                   n, n1)
+   END ;
+   ScopePtr := OldScopePtr ;
+   RETURN( sym )
+END FromModuleGetSym ;
+
+
+(*
+   AddSymToUnknown -
+*)
+
+PROCEDURE AddSymToUnknown (scope: CARDINAL; name: Name; Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+   n   : Name ;
+BEGIN
+   IF DebugUnknowns
+   THEN
+      n := GetSymName(scope) ;
+      printf3('adding unknown %a (%d) to scope %a\n', name, Sym, n)
+   END ;
+
+   (* Add symbol to unknown tree *)
+   pSym := GetPsym(scope) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : PutSymKey(DefImp.Unresolved, name, Sym) |
+      ModuleSym   : PutSymKey(Module.Unresolved, name, Sym) |
+      ProcedureSym: PutSymKey(Procedure.Unresolved, name, Sym)
+
+      ELSE
+         InternalError ('expecting DefImp, Module or Procedure symbol')
+      END
+   END
+END AddSymToUnknown ;
+
+
+(*
+   AddSymToUnknownTree - adds a symbol with name, name, and Sym to the
+                         unknown tree.
+*)
+
+PROCEDURE AddSymToUnknownTree (ScopeId: INTEGER; name: Name; Sym: CARDINAL) ;
+VAR
+   pCall   : PtrToCallFrame ;
+   ScopeSym: CARDINAL ;
+BEGIN
+   IF ScopeId>0
+   THEN
+      (* choose to place the unknown symbol in the first module scope
+         outside the current scope *)
+      REPEAT
+         pCall := GetPcall(ScopeId) ;
+         ScopeSym := pCall^.Main ;
+         IF (ScopeSym>0) AND (IsDefImp(ScopeSym) OR IsModule(ScopeSym))
+         THEN
+            AddSymToUnknown(ScopeSym, name, Sym) ;
+            RETURN
+         END ;
+         DEC(ScopeId)
+      UNTIL ScopeId=0
+   END ;
+   AddSymToUnknown(CurrentModule, name, Sym)
+END AddSymToUnknownTree ;
+
+
+(*
+   SubSymFromUnknownTree - removes a symbol with name, name, from the
+                           unknown tree.
+*)
+
+PROCEDURE SubSymFromUnknownTree (name: Name) ;
+VAR
+   pCall   : PtrToCallFrame ;
+   ScopeSym,
+   ScopeId : CARDINAL ;
+BEGIN
+   IF ScopePtr>0
+   THEN
+      ScopeId := ScopePtr ;
+      REPEAT
+         pCall := GetPcall(ScopeId) ;
+         ScopeSym := pCall^.Search ;
+         IF IsModule(ScopeSym) OR IsDefImp(ScopeSym) OR IsProcedure(ScopeSym)
+         THEN
+            IF RemoveFromUnresolvedTree(ScopeSym, name)
+            THEN
+               RETURN
+            END
+         END ;
+         DEC(ScopeId) ;
+      UNTIL (ScopeId>0) AND (IsModule(ScopeSym) OR IsDefImp(ScopeSym))
+   END ;
+   IF RemoveFromUnresolvedTree(CurrentModule, name)
+   THEN
+   END
+END SubSymFromUnknownTree ;
+
+
+(*
+   GetSymFromUnknownTree - returns a symbol with name, name, from the
+                           unknown tree.
+                           If no symbol with name is found then NulSym
+                           is returned.
+*)
+
+PROCEDURE GetSymFromUnknownTree (name: Name) : CARDINAL ;
+VAR
+   pCall   : PtrToCallFrame ;
+   ScopeSym,
+   ScopeId ,
+   Sym     : CARDINAL ;
+BEGIN
+   IF ScopePtr>0
+   THEN
+      ScopeId := ScopePtr ;
+      REPEAT
+         pCall := GetPcall(ScopeId) ;
+         ScopeSym := pCall^.Search ;
+         IF IsModule(ScopeSym) OR IsDefImp(ScopeSym) OR IsProcedure(ScopeSym)
+         THEN
+            Sym := ExamineUnresolvedTree(ScopeSym, name) ;
+            IF Sym#NulSym
+            THEN
+               RETURN( Sym )
+            END
+         END ;
+         DEC(ScopeId) ;
+      UNTIL (ScopeId>0) AND (IsModule(ScopeSym) OR IsDefImp(ScopeSym))
+   END ;
+   (* Get symbol from unknown tree *)
+   RETURN( ExamineUnresolvedTree(CurrentModule, name) )
+END GetSymFromUnknownTree ;
+
+
+(*
+   ExamineUnresolvedTree - returns a symbol with name, name, from the
+                           unresolved tree of module, ModSym.
+                           If no symbol with name is found then NulSym
+                           is returned.
+*)
+
+PROCEDURE ExamineUnresolvedTree (ScopeSym: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   (* Get symbol from unknown tree *)
+   pSym := GetPsym(ScopeSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : Sym := GetSymKey(DefImp.Unresolved, name) |
+      ModuleSym   : Sym := GetSymKey(Module.Unresolved, name) |
+      ProcedureSym: Sym := GetSymKey(Procedure.Unresolved, name)
+
+      ELSE
+         InternalError ('expecting DefImp, Module or Procedure symbol')
+      END
+   END ;
+   RETURN( Sym )
+END ExamineUnresolvedTree ;
+
+
+(*
+   TryMoveUndeclaredSymToInnerModule - attempts to move a symbol of
+                                       name, name, which is
+                                       currently undefined in the
+                                       outer scope to the inner scope.
+                                       If successful then the symbol is
+                                       returned otherwise NulSym is
+                                       returned.
+*)
+
+PROCEDURE TryMoveUndeclaredSymToInnerModule (OuterScope,
+                                             InnerScope: CARDINAL;
+                                             name: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   sym : CARDINAL ;
+BEGIN
+   (* assume this should not be called if OuterScope was a procedure
+      as this case is handled by the caller (P1SymBuild)
+   *)
+   Assert(IsModule(OuterScope) OR IsDefImp(OuterScope)) ;
+   sym := GetExportUndeclared(OuterScope, name) ;
+   IF sym#NulSym
+   THEN
+      Assert(IsUnknown(sym)) ;
+      RemoveExportUndeclared(OuterScope, sym) ;
+      AddSymToModuleScope(OuterScope, sym) ;
+      AddVarToScopeList(OuterScope, sym) ;
+      pSym := GetPsym(OuterScope) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         DefImpSym: IF GetSymKey(DefImp.Unresolved, name)=sym
+                    THEN
+                       DelSymKey(DefImp.Unresolved, name)
+                    END |
+         ModuleSym: IF GetSymKey(Module.Unresolved, name)=sym
+                    THEN
+                       DelSymKey(Module.Unresolved, name)
+                    END
+
+         ELSE
+            InternalError ('expecting DefImp, Module symbol')
+         END
+      END ;
+      AddSymToUnknown(InnerScope, name, sym) ;
+      PutExportUndeclared(InnerScope, sym)
+   END ;
+   RETURN( sym )
+END TryMoveUndeclaredSymToInnerModule ;
+
+
+(*
+   RemoveFromUnresolvedTree - removes a symbol with name, name, from the
+                              unresolved tree of symbol, ScopeSym.
+*)
+
+PROCEDURE RemoveFromUnresolvedTree (ScopeSym: CARDINAL; name: Name) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   (* Get symbol from unknown tree *)
+   pSym := GetPsym(ScopeSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : IF GetSymKey(DefImp.Unresolved, name)#NulKey
+                    THEN
+                       DelSymKey(DefImp.Unresolved, name) ;
+                       RETURN( TRUE )
+                    END |
+      ModuleSym   : IF GetSymKey(Module.Unresolved, name)#NulKey
+                    THEN
+                       DelSymKey(Module.Unresolved, name) ;
+                       RETURN( TRUE )
+                    END |
+      ProcedureSym: IF GetSymKey(Procedure.Unresolved, name)#NulKey
+                    THEN
+                       DelSymKey(Procedure.Unresolved, name) ;
+                       RETURN( TRUE )
+                    END
+
+      ELSE
+         InternalError ('expecting DefImp, Module or Procedure symbol')
+      END
+   END ;
+   RETURN( FALSE )
+END RemoveFromUnresolvedTree ;
+
+
+(*
+   FetchUnknownSym - returns a symbol from the unknown tree if one is
+                     available. It also updates the unknown tree.
+*)
+
+PROCEDURE FetchUnknownSym (name: Name) : CARDINAL ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   Sym := GetSymFromUnknownTree(name) ;
+   IF Sym#NulSym
+   THEN
+      SubSymFromUnknownTree(name)
+   END ;
+   RETURN( Sym )
+END FetchUnknownSym ;
+
+
+(*
+   TransparentScope - returns true is the scope symbol Sym is allowed
+                      to look to an outer level for a symbol.
+                      ie is the symbol allowed to look to the parent
+                      scope for a symbol.
+*)
+
+PROCEDURE TransparentScope (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      RETURN( (SymbolType#DefImpSym) AND (SymbolType#ModuleSym) )
+   END
+END TransparentScope ;
+
+
+(*
+   AddSymToModuleScope - adds a symbol, Sym, to the scope of the module
+                         ModSym.
+*)
+
+PROCEDURE AddSymToModuleScope (ModSym: CARDINAL; Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : IF GetSymKey(DefImp.LocalSymbols, GetSymName(Sym))=NulKey
+                    THEN
+                       PutSymKey(DefImp.LocalSymbols, GetSymName(Sym), Sym)
+                    ELSE
+                       MetaError1 ('{%kIMPORT} name clash with symbol {%1Ead} symbol already declared ', Sym)
+                    END |
+      ModuleSym   : IF GetSymKey(Module.LocalSymbols, GetSymName(Sym))=NulKey
+                    THEN
+                       PutSymKey(Module.LocalSymbols, GetSymName(Sym), Sym)
+                    ELSE
+                       MetaError1 ('{%kIMPORT} name clash with symbol {%1Ead} symbol already declared ', Sym)
+                    END |
+      ProcedureSym: IF GetSymKey(Procedure.LocalSymbols, GetSymName(Sym))=NulKey
+                    THEN
+                       PutSymKey(Procedure.LocalSymbols, GetSymName(Sym), Sym)
+                    ELSE
+                       MetaError1 ('{%kIMPORT} name clash with symbol {%1Ead} symbol already declared ', Sym)
+                    END
+
+      ELSE
+         InternalError ('expecting Module or DefImp symbol')
+      END
+   END
+END AddSymToModuleScope ;
+
+
+(*
+   GetCurrentModuleScope - returns the module symbol which forms the
+                           current (possibly inner most) module.
+*)
+
+PROCEDURE GetCurrentModuleScope () : CARDINAL ;
+VAR
+   pCall: PtrToCallFrame ;
+   i    : CARDINAL ;
+BEGIN
+   i := ScopePtr ;
+   pCall := GetPcall(i) ;
+   WHILE (NOT IsModule(pCall^.Search)) AND
+         (NOT IsDefImp(pCall^.Search)) DO
+      Assert(i>0) ;
+      DEC(i) ;
+      pCall := GetPcall(i)
+   END ;
+   RETURN( pCall^.Search )
+END GetCurrentModuleScope ;
+
+
+(*
+   GetLastModuleScope - returns the last module scope encountered,
+                        the module scope before the Current Module Scope.
+*)
+
+PROCEDURE GetLastModuleScope () : CARDINAL ;
+VAR
+   pCall: PtrToCallFrame ;
+   i    : CARDINAL ;
+BEGIN
+   i := ScopePtr ;
+   pCall := GetPcall(i) ;
+   WHILE (NOT IsModule(pCall^.Search)) AND
+         (NOT IsDefImp(pCall^.Search)) DO
+      Assert(i>0) ;
+      DEC(i) ;
+      pCall := GetPcall(i)
+   END ;
+   (* Found module at position, i. *)
+   DEC(i) ;  (* Move to an outer level module scope *)
+   pCall := GetPcall(i) ;
+   WHILE (NOT IsModule(pCall^.Search)) AND
+         (NOT IsDefImp(pCall^.Search)) DO
+      Assert(i>0) ;
+      DEC(i) ;
+      pCall := GetPcall(i)
+   END ;
+   (* Found module at position, i. *)
+   RETURN( pCall^.Search )
+END GetLastModuleScope ;
+
+
+(*
+   GetLastModuleOrProcedureScope - returns the last module or procedure scope encountered,
+                                   the scope before the current module scope.
+*)
+
+PROCEDURE GetLastModuleOrProcedureScope () : CARDINAL ;
+VAR
+   pCall: PtrToCallFrame ;
+   i    : CARDINAL ;
+BEGIN
+   (* find current inner module *)
+   i := ScopePtr ;
+   pCall := GetPcall(i) ;
+   WHILE (NOT IsModule(pCall^.Search)) AND
+         (NOT IsDefImp(pCall^.Search)) DO
+      Assert(i>0) ;
+      DEC(i) ;
+      pCall := GetPcall(i)
+   END ;
+   (* found module at position, i. *)
+   DEC(i) ;  (* Move to an outer level module or procedure scope *)
+   pCall := GetPcall(i) ;
+   WHILE (NOT IsModule(pCall^.Search)) AND
+         (NOT IsDefImp(pCall^.Search)) AND
+         (NOT IsProcedure(pCall^.Search)) DO
+      Assert(i>0) ;
+      DEC(i) ;
+      pCall := GetPcall(i)
+   END ;
+   (* Found module at position, i. *)
+   RETURN( pCall^.Search )
+END GetLastModuleOrProcedureScope ;
+
+
+(*
+   AddSymToScope - adds a symbol Sym with name name to
+                   the current scope symbol tree.
+*)
+
+PROCEDURE AddSymToScope (Sym: CARDINAL; name: Name) ;
+VAR
+   pSym   : PtrToSymbol ;
+   pCall  : PtrToCallFrame ;
+   ScopeId: CARDINAL ;
+BEGIN
+   pCall := GetPcall(ScopePtr) ;
+   ScopeId := pCall^.Main ;
+   (*
+      WriteString('Adding ') ; WriteKey(name) ; WriteString(' :') ; WriteCard(Sym, 4) ; WriteString(' to scope: ') ;
+      WriteKey(GetSymName(ScopeId)) ; WriteLn ;
+   *)
+   pSym := GetPsym(ScopeId) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : IF name#NulName
+                    THEN
+                       PutSymKey(DefImp.LocalSymbols, name, Sym)
+                    END ;
+                    IF IsEnumeration(Sym)
+                    THEN
+                       CheckEnumerationInList(DefImp.EnumerationScopeList, Sym)
+                    END |
+      ModuleSym   : IF name#NulName
+                    THEN
+                       PutSymKey(Module.LocalSymbols, name, Sym)
+                    END ;
+                    IF IsEnumeration(Sym)
+                    THEN
+                       CheckEnumerationInList(Module.EnumerationScopeList, Sym)
+                    END |
+      ProcedureSym: IF name#NulName
+                    THEN
+                       PutSymKey(Procedure.LocalSymbols, name, Sym)
+                    END ;
+                    IF IsEnumeration(Sym)
+                    THEN
+                       CheckEnumerationInList(Procedure.EnumerationScopeList, Sym)
+                    END
+
+      ELSE
+         InternalError ('should never get here')
+      END
+   END
+END AddSymToScope ;
+
+
+(*
+   GetCurrentScope - returns the symbol who is responsible for the current
+                     scope. Note that it ignore pseudo scopes.
+*)
+
+PROCEDURE GetCurrentScope () : CARDINAL ;
+VAR
+   pCall: PtrToCallFrame ;
+BEGIN
+   pCall := GetPcall(ScopePtr) ;
+   RETURN( pCall^.Main )
+END GetCurrentScope ;
+
+
+(*
+   StartScope - starts a block scope at Sym. Transparent determines
+                whether the search for a symbol will look at the
+                previous ScopeCallFrame if Sym does not contain the
+                symbol that GetSym is searching.
+
+                WITH statements are partially implemented by calling
+                StartScope. Therefore we must retain the old Main from
+                the previous ScopePtr when a record is added to the scope
+                stack. (Main contains the symbol where all identifiers
+                should be added.)
+*)
+
+PROCEDURE StartScope (Sym: CARDINAL) ;
+VAR
+   oCall,
+   pCall: PtrToCallFrame ;
+BEGIN
+   Sym := SkipType(Sym) ;
+(*
+   WriteString('New scope is: ') ; WriteKey(GetSymName(Sym)) ; WriteLn ;
+*)
+   INC(ScopePtr) ;
+   IF InBounds(ScopeCallFrame, ScopePtr)
+   THEN
+      pCall := GetPcall(ScopePtr)
+   ELSE
+      NEW(pCall) ;
+      PutIndice(ScopeCallFrame, ScopePtr, pCall)
+   END ;
+   WITH pCall^ DO
+      Start := ScopePtr-1 ;  (* Previous ScopePtr value before StartScope *)
+      Search := Sym ;
+
+      (* If Sym is a record then maintain the old Main scope for adding   *)
+      (* new symbols to ie temporary variables.                           *)
+      IF IsRecord(Sym)
+      THEN
+         oCall := GetPcall(ScopePtr-1) ;
+         Main := oCall^.Main
+      ELSE
+         Main := Sym ;
+         PlaceMajorScopesEnumerationListOntoStack(Sym)
+      END
+   END
+   (* ; DisplayScopes *)
+END StartScope ;
+
+
+(*
+   PlaceMajorScopesEnumerationListOntoStack - places the DefImp, Module and
+                                              Procedure symbols enumeration
+                                              list onto the scope stack.
+*)
+
+PROCEDURE PlaceMajorScopesEnumerationListOntoStack (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : PlaceEnumerationListOntoScope(DefImp.EnumerationScopeList) |
+      ModuleSym   : PlaceEnumerationListOntoScope(Module.EnumerationScopeList) |
+      ProcedureSym: PlaceEnumerationListOntoScope(Procedure.EnumerationScopeList)
+
+      ELSE
+         InternalError ('expecting - DefImp, Module or Procedure symbol')
+      END
+   END
+END PlaceMajorScopesEnumerationListOntoStack ;
+
+
+(*
+   PlaceEnumerationListOntoScope - places an enumeration list, l, onto the
+                                   scope stack. This list will automatically
+                                   removed via one call to EndScope which
+                                   matches the StartScope by which this
+                                   procedure is invoked.
+*)
+
+PROCEDURE PlaceEnumerationListOntoScope (l: List) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   n := NoOfItemsInList(l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      PseudoScope(GetItemFromList(l, i)) ;
+      INC(i)
+   END
+END PlaceEnumerationListOntoScope ;
+
+
+(*
+   EndScope - ends a block scope started by StartScope. The current
+              head of the symbol scope reverts back to the symbol
+              which was the Head of the symbol scope before the
+              last StartScope was called.
+*)
+
+PROCEDURE EndScope ;
+VAR
+   pCall: PtrToCallFrame ;
+BEGIN
+(*
+   ; WriteString('EndScope - ending scope: ') ;
+   pCall := GetPcall(ScopePtr) ;
+   ; WriteKey(GetSymName(pCall^.Search)) ; WriteLn ;
+*)
+   pCall := GetPcall(ScopePtr) ;
+   ScopePtr := pCall^.Start
+   (* ; DisplayScopes *)
+END EndScope ;
+
+
+(*
+   PseudoScope - starts a pseudo scope at Sym.
+                 We always connect parent up to the last scope,
+                 to determine the transparancy of a scope we call
+                 TransparentScope.
+
+                 A Pseudo scope has no end block,
+                 but is terminated when the next EndScope is used.
+                 The function of the pseudo scope is to provide an
+                 automatic mechanism to solve enumeration types.
+                 A declared enumeration type is a Pseudo scope and
+                 identifiers used with the name of an enumeration
+                 type field will find the enumeration symbol by
+                 the scoping algorithm.
+*)
+
+PROCEDURE PseudoScope (Sym: CARDINAL) ;
+VAR
+   oCall,
+   pCall: PtrToCallFrame ;
+BEGIN
+   IF IsEnumeration(Sym)
+   THEN
+      INC(ScopePtr) ;
+      IF InBounds(ScopeCallFrame, ScopePtr)
+      THEN
+         pCall := GetPcall(ScopePtr)
+      ELSE
+         NEW(pCall) ;
+         PutIndice(ScopeCallFrame, ScopePtr, pCall)
+      END ;
+      WITH pCall^ DO
+         oCall := GetPcall(ScopePtr-1) ;
+         Main := oCall^.Main ;
+         Start := oCall^.Start ;
+         Search := Sym
+      END
+   ELSE
+      InternalError ('expecting EnumerationSym')
+   END
+END PseudoScope ;
+
+
+(*
+   IsDeclaredIn - returns TRUE if a symbol was declared in, scope.
+*)
+
+PROCEDURE IsDeclaredIn (scope, sym: CARDINAL) : BOOLEAN ;
+VAR
+   s: CARDINAL ;
+BEGIN
+   s := GetScope(sym) ;
+   WHILE s#scope DO
+      IF (s=NulSym) OR IsProcedure(s) OR IsModule(s) OR IsDefImp(s)
+      THEN
+         RETURN( FALSE )
+      ELSE
+         s := GetScope(s)
+      END
+   END ;
+   RETURN( TRUE )
+END IsDeclaredIn ;
+
+
+(*
+   MakeGnuAsm - create a GnuAsm symbol.
+*)
+
+PROCEDURE MakeGnuAsm () : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   NewSym(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := GnuAsmSym ;
+      WITH GnuAsm DO
+         String   := NulSym ;
+         InitWhereDeclared(At) ;
+         Inputs   := NulSym ;
+         Outputs  := NulSym ;
+         Trashed  := NulSym ;
+         Volatile := FALSE ;
+         Simple   := FALSE
+      END
+   END ;
+   RETURN( Sym )
+END MakeGnuAsm ;
+
+
+(*
+   PutGnuAsm - places the instruction textual name into the GnuAsm symbol.
+*)
+
+PROCEDURE PutGnuAsm (sym: CARDINAL; string: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(IsConstString(string)) ;
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: GnuAsm.String := string
+
+      ELSE
+         InternalError ('expecting PutGnuAsm symbol')
+      END
+   END
+END PutGnuAsm ;
+
+
+(*
+   GetGnuAsm - returns the string symbol, representing the instruction textual
+               of the GnuAsm symbol. It will return a ConstString.
+*)
+
+PROCEDURE GetGnuAsm (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: RETURN( GnuAsm.String )
+
+      ELSE
+         InternalError ('expecting GnuAsm symbol')
+      END
+   END
+END GetGnuAsm ;
+
+
+(*
+   PutGnuAsmOutput - places the interface object, out, into GnuAsm symbol, sym.
+*)
+
+PROCEDURE PutGnuAsmOutput (sym: CARDINAL; out: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: GnuAsm.Outputs := out
+
+      ELSE
+         InternalError ('expecting PutGnuAsm symbol')
+      END
+   END
+END PutGnuAsmOutput ;
+
+
+(*
+   PutGnuAsmInput - places the interface object, in, into GnuAsm symbol, sym.
+*)
+
+PROCEDURE PutGnuAsmInput (sym: CARDINAL; in: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: GnuAsm.Inputs := in
+
+      ELSE
+         InternalError ('expecting PutGnuAsm symbol')
+      END
+   END
+END PutGnuAsmInput ;
+
+
+(*
+   PutGnuAsmTrash - places the interface object, trash, into GnuAsm symbol, sym.
+*)
+
+PROCEDURE PutGnuAsmTrash (sym: CARDINAL; trash: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: GnuAsm.Trashed := trash
+
+      ELSE
+         InternalError ('expecting PutGnuAsm symbol')
+      END
+   END
+END PutGnuAsmTrash ;
+
+
+(*
+   GetGnuAsmInput - returns the input list of registers.
+*)
+
+PROCEDURE GetGnuAsmInput (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: RETURN( GnuAsm.Inputs )
+
+      ELSE
+         InternalError ('expecting PutGnuAsm symbol')
+      END
+   END
+END GetGnuAsmInput ;
+
+
+(*
+   GetGnuAsmOutput - returns the output list of registers.
+*)
+
+PROCEDURE GetGnuAsmOutput (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: RETURN( GnuAsm.Outputs )
+
+      ELSE
+         InternalError ('expecting PutGnuAsm symbol')
+      END
+   END
+END GetGnuAsmOutput ;
+
+
+(*
+   GetGnuAsmTrash - returns the list of trashed registers.
+*)
+
+PROCEDURE GetGnuAsmTrash (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: RETURN( GnuAsm.Trashed )
+
+      ELSE
+         InternalError ('expecting PutGnuAsm symbol')
+      END
+   END
+END GetGnuAsmTrash ;
+
+
+(*
+   PutGnuAsmVolatile - defines a GnuAsm symbol as VOLATILE.
+*)
+
+PROCEDURE PutGnuAsmVolatile (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: GnuAsm.Volatile := TRUE
+
+      ELSE
+         InternalError ('expecting GnuAsm symbol')
+      END
+   END
+END PutGnuAsmVolatile ;
+
+
+(*
+   PutGnuAsmSimple - defines a GnuAsm symbol as a simple kind.
+*)
+
+PROCEDURE PutGnuAsmSimple (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: GnuAsm.Simple := TRUE
+
+      ELSE
+         InternalError ('expecting GnuAsm symbol')
+      END
+   END
+END PutGnuAsmSimple ;
+
+
+(*
+   MakeRegInterface - creates and returns a register interface symbol.
+*)
+
+PROCEDURE MakeRegInterface () : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   NewSym(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := InterfaceSym ;
+      WITH Interface DO
+         Parameters := InitIndex(1) ;
+         InitWhereDeclared(At)
+      END
+   END ;
+   RETURN( Sym )
+END MakeRegInterface ;
+
+
+(*
+   PutRegInterface - places a, name, string, and, object, into the interface array,
+                     sym, at position, i.
+                     The string symbol will either be a register name or a constraint.
+                     The object is an optional Modula-2 variable or constant symbol.
+*)
+
+PROCEDURE PutRegInterface (sym: CARDINAL; i: CARDINAL; n: Name; string, object: CARDINAL) ;
+VAR
+   pSym : PtrToSymbol ;
+   p    : PtrToAsmConstraint ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      InterfaceSym: IF Indexing.InBounds(Interface.Parameters, i)
+                    THEN
+                       p := Indexing.GetIndice(Interface.Parameters, i)
+                    ELSIF i=Indexing.HighIndice(Interface.Parameters)+1
+                    THEN
+                       NEW(p) ;
+                       Indexing.PutIndice(Interface.Parameters, i, p)
+                    ELSE
+                       InternalError ('expecting to add parameters sequentially')
+                    END ;
+                    WITH p^ DO
+                       name := n ;
+                       str  := string ;
+                       obj  := object
+                    END
+
+      ELSE
+         InternalError ('expecting Interface symbol')
+      END
+   END
+END PutRegInterface ;
+
+
+(*
+   GetRegInterface - gets a, name, string, and, object, from the interface array,
+                     sym, from position, i.
+*)
+
+PROCEDURE GetRegInterface (sym: CARDINAL; i: CARDINAL; VAR n: Name; VAR string, object: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+   p   : PtrToAsmConstraint ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      InterfaceSym: IF Indexing.InBounds(Interface.Parameters, i)
+                    THEN
+                       p := Indexing.GetIndice(Interface.Parameters, i) ;
+                       WITH p^ DO
+                          n      := name ;
+                          string := str ;
+                          object := obj
+                       END
+                    ELSE
+                       n      := NulName ;
+                       string := NulSym ;
+                       object := NulSym
+                    END
+
+      ELSE
+         InternalError ('expecting Interface symbol')
+      END
+   END
+END GetRegInterface ;
+
+
+(*
+   GetSubrange - returns HighSym and LowSym - two constants which make up the
+                 subrange.
+*)
+
+PROCEDURE GetSubrange (Sym: CARDINAL; VAR HighSym, LowSym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      SubrangeSym: HighSym := Subrange.High ;
+                   LowSym := Subrange.Low
+
+      ELSE
+         InternalError ('expecting Subrange symbol')
+      END
+   END
+END GetSubrange ;
+
+
+(*
+   PutSubrange - places LowSym and HighSym as two symbols
+                 which provide the limits of the range.
+*)
+
+PROCEDURE PutSubrange (Sym: CARDINAL; LowSym, HighSym: CARDINAL;
+                       TypeSymbol: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      SubrangeSym:  Subrange.Low := LowSym ;      (* Index to symbol for lower   *)
+                    Subrange.High := HighSym ;    (* Index to symbol for higher  *)
+                    Subrange.Type := TypeSymbol ; (* Index to type symbol for    *)
+                                                  (* the type of subrange.       *)
+      ELSE
+         InternalError ('expecting Subrange symbol')
+      END
+   END
+END PutSubrange ;
+
+
+(*
+   SetCurrentModule - Used to set the CurrentModule to a symbol, Sym.
+                      This Sym must represent the module name of the
+                      file currently being compiled.
+*)
+
+PROCEDURE SetCurrentModule (Sym: CARDINAL) ;
+BEGIN
+   CurrentModule := Sym
+END SetCurrentModule ;
+
+
+(*
+   GetCurrentModule - returns the current module Sym that is being
+                      compiled.
+*)
+
+PROCEDURE GetCurrentModule () : CARDINAL ;
+BEGIN
+   RETURN( CurrentModule )
+END GetCurrentModule ;
+
+
+(*
+   SetMainModule - Used to set the MainModule to a symbol, Sym.
+                   This Sym must represent the main module which was
+                   envoked by the user to be compiled.
+*)
+
+PROCEDURE SetMainModule (Sym: CARDINAL) ;
+BEGIN
+   MainModule := Sym
+END SetMainModule ;
+
+
+(*
+   GetMainModule - returns the main module symbol that was requested by
+                   the user to be compiled.
+*)
+
+PROCEDURE GetMainModule () : CARDINAL ;
+BEGIN
+   RETURN( MainModule )
+END GetMainModule ;
+
+
+(*
+   SetFileModule - Used to set the FileModule to a symbol, Sym.
+                   This Sym must represent the current program module
+                   file which is being parsed.
+*)
+
+PROCEDURE SetFileModule (Sym: CARDINAL) ;
+BEGIN
+   FileModule := Sym
+END SetFileModule ;
+
+
+(*
+   GetFileModule - returns the FileModule symbol that was requested by
+                   the user to be compiled.
+*)
+
+PROCEDURE GetFileModule () : CARDINAL ;
+BEGIN
+   RETURN( FileModule )
+END GetFileModule ;
+
+
+(*
+   GetBaseModule - returns the base module symbol that contains Modula-2
+                   base types, procedures and functions.
+*)
+
+PROCEDURE GetBaseModule () : CARDINAL ;
+BEGIN
+   RETURN( BaseModule )
+END GetBaseModule ;
+
+
+(*
+   GetSym - searches the current scope (and previous scopes if the
+            scope tranparent allows) for a symbol with name.
+*)
+
+PROCEDURE GetSym (name: Name) : CARDINAL ;
+VAR
+   Sym        : CARDINAL ;
+   OldScopePtr: CARDINAL ;
+BEGIN
+   Sym := GetScopeSym(name, TRUE) ;
+   IF Sym=NulSym
+   THEN
+      (* Check default base types for symbol *)
+      OldScopePtr := ScopePtr ;  (* Save ScopePtr *)
+      ScopePtr := BaseScopePtr ; (* Alter ScopePtr to point to top of BaseModule *)
+      Sym := GetScopeSym(name, FALSE) ; (* Search BaseModule for name *)
+      ScopePtr := OldScopePtr    (* Restored ScopePtr *)
+   END ;
+   RETURN( Sym )
+END GetSym ;
+
+
+(*
+   CanLookThroughScope - by default this procedure returns TRUE.  It only returns
+                         FALSE if, throughProcedure, is FALSE and the ScopeSym is
+                         a procedure.
+*)
+
+PROCEDURE CanLookThroughScope (ScopeSym: CARDINAL; throughProcedure: BOOLEAN) : BOOLEAN ;
+BEGIN
+   IF IsProcedure(ScopeSym)
+   THEN
+      RETURN( throughProcedure )
+   ELSE
+      RETURN( TRUE )
+   END
+END CanLookThroughScope ;
+
+
+(*
+   GetScopeSym - searches the current scope and below, providing that the
+                 scopes are transparent, for a symbol with name, name.
+                 It only passes over procedure scopes if, throughProcedure,
+                 is TRUE.
+*)
+
+PROCEDURE GetScopeSym (name: Name; throughProcedure: BOOLEAN) : CARDINAL ;
+VAR
+   pCall   : PtrToCallFrame ;
+   ScopeSym,
+   ScopeId ,
+   Sym     : CARDINAL ;
+BEGIN
+   (* DisplayScopes ; *)
+   ScopeId := ScopePtr ;
+   pCall := GetPcall(ScopeId) ;
+   ScopeSym := pCall^.Search ;
+   (* WriteString(' scope: ') ; WriteKey(GetSymName(ScopeSym)) ; *)
+   Sym := CheckScopeForSym(ScopeSym, name) ;
+   WHILE (ScopeId>0) AND (Sym=NulSym) AND TransparentScope(ScopeSym) AND
+         CanLookThroughScope(ScopeSym, throughProcedure) DO
+      DEC(ScopeId) ;
+      pCall := GetPcall(ScopeId) ;
+      ScopeSym := pCall^.Search ;
+      Sym := CheckScopeForSym(ScopeSym, name) ;
+      (* WriteString(' scope: ') ; WriteKey(GetSymName(ScopeSym)) *)
+   END ;
+   (* IF Sym#NulSym THEN WriteKey(GetSymName(Sym)) END ; WriteLn ; *)
+   RETURN( Sym )
+END GetScopeSym ;
+
+
+(*
+   CheckScopeForSym - checks the scope, ScopeSym, for an identifier
+                      of name, name. CheckScopeForSym checks for
+                      the symbol by the GetLocalSym and also
+                      ExamineUnresolvedTree.
+*)
+
+PROCEDURE CheckScopeForSym (ScopeSym: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   Sym := GetLocalSym(ScopeSym, name) ;
+   IF (Sym=NulSym) AND (IsModule(ScopeSym) OR IsDefImp(ScopeSym) OR
+                        IsProcedure(ScopeSym))
+   THEN
+      Sym := ExamineUnresolvedTree(ScopeSym, name)
+   END ;
+   RETURN( Sym )
+END CheckScopeForSym ;
+
+
+(*
+   DisplayScopes - displays the scopes that will be searched to find
+                   a requested symbol.
+*)
+
+(*
+PROCEDURE DisplayScopes ;
+VAR
+   pCall: PtrToCallFrame ;
+   n    : Name ;
+   i    : CARDINAL ;
+   Sym  : CARDINAL ;
+BEGIN
+   i := ScopePtr ;
+   printf0('Displaying scopes\n') ;
+   WHILE i>=1 DO
+      pCall := GetPcall(i) ;
+      Sym := pCall^.Search ;
+      printf1('Symbol %4d', Sym) ;
+      IF Sym#NulSym
+      THEN
+         n := GetSymName(Sym) ;
+         printf1(' : name %a is ', n) ;
+         IF NOT TransparentScope(Sym)
+         THEN
+            printf0('not')
+         END ;
+         printf0(' transparent\n')
+      END ;
+      DEC(i)
+   END ;
+   printf0('\n')
+END DisplayScopes ;
+*)
+
+
+(*
+   GetModuleScopeId - returns the scope index to the next module starting
+                      at index, Id.
+                      Id will either point to a null scope (NulSym) or
+                      alternatively point to a Module or DefImp symbol.
+*)
+
+PROCEDURE GetModuleScopeId (Id: CARDINAL) : CARDINAL ;
+VAR
+   pCall: PtrToCallFrame ;
+   s    : CARDINAL ;
+BEGIN
+   pCall := GetPcall(Id) ;
+   s := pCall^.Search ;
+   WHILE (Id>0) AND (s#NulSym) AND
+         ((NOT IsModule(s)) AND
+          (NOT IsDefImp(s))) DO
+      DEC(Id) ;
+      pCall := GetPcall(Id) ;
+      s := pCall^.Search ;
+   END ;
+   RETURN( Id )
+END GetModuleScopeId ;
+
+
+(*
+   GetVisibleSym -
+*)
+
+PROCEDURE GetVisibleSym (name: Name) : CARDINAL ;
+VAR
+   pCall: PtrToCallFrame ;
+   Sym,
+   i    : CARDINAL ;
+BEGIN
+   i := ScopePtr ;
+   WHILE i>=1 DO
+      pCall := GetPcall(i) ;
+      WITH pCall^ DO
+         IF Search=Main
+         THEN
+            RETURN( GetLocalSym(Main, name) )
+         ELSE
+            IF IsEnumeration(Search)
+            THEN
+               Sym := GetLocalSym(Search, name) ;
+               IF Sym#NulSym
+               THEN
+                  RETURN( Sym )
+               END
+            END
+         END
+      END ;
+      DEC(i)
+   END ;
+   RETURN( NulSym )
+END GetVisibleSym ;
+
+
+(*
+   IsAlreadyDeclaredSym - returns true if Sym has already been declared
+                          in the current main scope.
+*)
+
+PROCEDURE IsAlreadyDeclaredSym (name: Name) : BOOLEAN ;
+VAR
+   pCall: PtrToCallFrame ;
+   i    : CARDINAL ;
+BEGIN
+   i := ScopePtr ;
+   WHILE i>=1 DO
+      pCall := GetPcall(i) ;
+      WITH pCall^ DO
+         IF Search=Main
+         THEN
+            RETURN( GetLocalSym(Main, name)#NulSym )
+         ELSE
+            IF IsEnumeration(Search) AND (GetLocalSym(Search, name)#NulSym)
+            THEN
+               RETURN( TRUE )
+            END
+         END
+      END ;
+      DEC(i)
+   END ;
+   RETURN( FALSE )
+END IsAlreadyDeclaredSym ;
+
+
+(*
+   IsImplicityExported - returns TRUE if, Sym, is implicitly exported from module, ModSym.
+                         ModSym must be a defimp symbol.
+*)
+
+PROCEDURE IsImplicityExported (ModSym, Sym: CARDINAL) : BOOLEAN ;
+VAR
+   type: CARDINAL ;
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsDefImp(ModSym) AND IsFieldEnumeration(Sym)
+   THEN
+      pSym := GetPsym(ModSym) ;
+      type := SkipType(GetType(Sym)) ;
+      RETURN( IsItemInList(pSym^.DefImp.EnumerationScopeList, type) )
+   END ;
+   RETURN( FALSE )
+END IsImplicityExported ;
+
+
+(*
+   MakeProcedureCtorExtern - creates an extern ctor procedure
+*)
+
+PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; modulename: Name) : CARDINAL ;
+VAR
+   ctor: CARDINAL ;
+BEGIN
+   ctor := MakeProcedure (tokenno, GenName ('_M2_', modulename, '_ctor')) ;
+   PutExtern (ctor, TRUE) ;
+   RETURN ctor
+END MakeProcedureCtorExtern ;
+
+
+(*
+   GenName - returns a new name consisting of pre, name, post concatenation.
+*)
+
+PROCEDURE GenName (pre: ARRAY OF CHAR; name: Name; post: ARRAY OF CHAR) : Name ;
+VAR
+   str   : String ;
+   result: Name ;
+BEGIN
+   str := InitString (pre) ;
+   str := ConCat (str, Mark (InitStringCharStar (KeyToCharStar (name)))) ;
+   str := ConCat (str, InitString (post)) ;
+   result := makekey (string (str)) ;
+   str := KillString (str) ;
+   RETURN result
+END GenName ;
+
+
+(*
+   InitCtor - initialize the ModuleCtor fields to NulSym.
+*)
+
+PROCEDURE InitCtor (VAR ctor: ModuleCtor) ;
+BEGIN
+   ctor.ctor := NulSym ;
+   ctor.dep := NulSym ;
+   ctor.init := NulSym ;
+   ctor.fini := NulSym
+END InitCtor ;
+
+
+(*
+   MakeModuleCtor - for a defimp or module symbol create all the ctor
+                    related procedures.
+*)
+
+PROCEDURE MakeModuleCtor (moduleTok, beginTok, finallyTok: CARDINAL;
+                          moduleSym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert (IsDefImp (moduleSym) OR IsModule (moduleSym)) ;
+   pSym := GetPsym (moduleSym) ;
+   IF IsDefImp (moduleSym)
+   THEN
+      InitCtorFields (moduleTok, beginTok, finallyTok,
+                      pSym^.DefImp.ctors, GetSymName (moduleSym),
+                      FALSE, TRUE)
+   ELSE
+      InitCtorFields (moduleTok, beginTok, finallyTok,
+                      pSym^.Module.ctors, GetSymName (moduleSym),
+                      IsInnerModule (moduleSym), TRUE)
+   END
+END MakeModuleCtor ;
+
+
+(*
+   InitCtorFields - initialize the ModuleCtor fields.  An inner module has no
+                    ctor procedure.
+*)
+
+PROCEDURE InitCtorFields (moduleTok, beginTok, finallyTok: CARDINAL;
+                          VAR ctor: ModuleCtor; name: Name;
+                          inner, pub: BOOLEAN) ;
+BEGIN
+   IF ScaffoldDynamic AND (NOT inner)
+   THEN
+      (* The ctor procedure must be public.  *)
+      ctor.ctor := MakeProcedure (moduleTok, GenName ("_M2_", name, "_ctor")) ;
+      PutCtor (ctor.ctor, TRUE) ;
+      Assert (pub) ;
+      PutPublic (ctor.ctor, pub) ;
+      PutExtern (ctor.ctor, NOT pub) ;
+      PutMonoName (ctor.ctor, TRUE) ;
+      (* The dep procedure is local to the module.  *)
+      ctor.dep := MakeProcedure (moduleTok, GenName ("_M2_", name, "_dep")) ;
+      PutMonoName (ctor.dep, TRUE)
+   ELSE
+      ctor.ctor := NulSym ;
+      ctor.dep := NulSym
+   END ;
+   (* The init/fini procedures must be public.  *)
+   ctor.init := MakeProcedure (beginTok, GenName ("_M2_", name, "_init")) ;
+   PutPublic (ctor.init, pub) ;
+   PutExtern (ctor.init, NOT pub) ;
+   PutMonoName (ctor.init, NOT inner) ;
+   DeclareArgEnvParams (beginTok, ctor.init) ;
+   ctor.fini := MakeProcedure (finallyTok, GenName ("_M2_", name, "_fini")) ;
+   PutPublic (ctor.fini, pub) ;
+   PutExtern (ctor.fini, NOT pub) ;
+   PutMonoName (ctor.fini, NOT inner) ;
+   DeclareArgEnvParams (beginTok, ctor.fini)
+END InitCtorFields ;
+
+
+(*
+   GetModuleCtors - mod can be a DefImp or Module symbol.  ctor, init and fini
+                    are assigned for this module.  An inner module ctor value will
+                    be NulSym.
+*)
+
+PROCEDURE GetModuleCtors (mod: CARDINAL; VAR ctor, init, fini, dep: CARDINAL) ;
+VAR
+   pSym : PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (mod) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym:  ctor := Module.ctors.ctor ;
+                  init := Module.ctors.init ;
+                  fini := Module.ctors.fini ;
+                  dep := Module.ctors.dep |
+      DefImpSym:  ctor := DefImp.ctors.ctor ;
+                  init := DefImp.ctors.init ;
+                  fini := DefImp.ctors.fini ;
+                  dep := DefImp.ctors.dep
+
+      ELSE
+         InternalError ('expecting Module or DefImp symbol')
+      END
+   END
+END GetModuleCtors ;
+
+
+(*
+   MakeModule - creates a module sym with ModuleName. It returns the
+                symbol index.
+*)
+
+PROCEDURE MakeModule (tok: CARDINAL; ModuleName: Name) : CARDINAL ;
+VAR
+   pSym : PtrToSymbol ;
+   pCall: PtrToCallFrame ;
+   Sym  : CARDINAL ;
+BEGIN
+   (*
+      Make a new symbol since we are at the outer scope level.
+      DeclareSym examines the current scope level for any symbols
+      that have the correct name, but are yet undefined.
+      Therefore we must not call DeclareSym but create a symbol
+      directly.
+   *)
+   NewSym(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := ModuleSym ;
+      WITH Module DO
+         name := ModuleName ;               (* Index into name array, name   *)
+                                            (* of record field.              *)
+         InitCtor (ctors) ;                 (* Init all ctor functions.      *)
+         InitList(ModListOfDep) ;           (* Vector of SymDependency.      *)
+         InitTree(LocalSymbols) ;           (* The LocalSymbols hold all the *)
+                                            (* variables declared local to   *)
+                                            (* the block. It contains the    *)
+                                            (* FROM _ IMPORT x, y, x ;       *)
+                                            (* IMPORT A ;                    *)
+                                            (*    and also                   *)
+                                            (* MODULE WeAreHere ;            *)
+                                            (*    x y z visiable by localsym *)
+                                            (*    MODULE Inner ;             *)
+                                            (*       EXPORT x, y, z ;        *)
+                                            (*    END Inner ;                *)
+                                            (* END WeAreHere.                *)
+         InitTree(ExportTree) ;             (* Holds all the exported        *)
+                                            (* identifiers.                  *)
+                                            (* This tree may be              *)
+                                            (* deleted at the end of Pass 1. *)
+         InitTree(ImportTree) ;             (* Contains all IMPORTed         *)
+                                            (* identifiers.                  *)
+         InitList(IncludeList) ;            (* Contains all included symbols *)
+                                            (* which are included by         *)
+                                            (* IMPORT modulename ;           *)
+                                            (* modulename.Symbol             *)
+         InitTree(ExportUndeclared) ;       (* ExportUndeclared contains all *)
+                                            (* the identifiers which were    *)
+                                            (* exported but have not yet     *)
+                                            (* been declared.                *)
+         InitList(EnumerationScopeList) ;   (* Enumeration scope list which  *)
+                                            (* contains a list of all        *)
+                                            (* enumerations which are        *)
+                                            (* visable within this scope.    *)
+                                            (* Outer Module.                 *)
+         InitTree(NamedObjects) ;           (* Names of all items declared.  *)
+         InitTree(NamedImports) ;           (* Names of items imported.      *)
+         InitTree(WhereImported) ;          (* Sym to TokenNo where import   *)
+                                            (* occurs. Error message use.    *)
+         Priority := NulSym ;               (* Priority of the module. This  *)
+                                            (* is an index to a constant.    *)
+         InitTree(Unresolved) ;             (* All symbols currently         *)
+                                            (* unresolved in this module.    *)
+         StartQuad := 0 ;                   (* Signify the initialization    *)
+                                            (* code.                         *)
+         EndQuad := 0 ;                     (* EndQuad should point to a     *)
+                                            (* goto quad.                    *)
+         StartFinishQuad := 0 ;             (* Signify the finalization      *)
+                                            (* code.                         *)
+         EndFinishQuad := 0 ;               (* should point to a finish      *)
+         FinallyFunction := NIL ;           (* The GCC function for finally  *)
+         ExceptionFinally := FALSE ;        (* does it have an exception?    *)
+         ExceptionBlock := FALSE ;          (* does it have an exception?    *)
+         ModLink := GetLink () ;            (* Is this parsed for linkage?   *)
+         Builtin := FALSE ;                 (* Is the module builtin?        *)
+         InitList(ListOfVars) ;             (* List of variables in this     *)
+                                            (* scope.                        *)
+         InitList(ListOfProcs) ;            (* List of all procedures        *)
+                                            (* declared within this module.  *)
+         InitList(ListOfModules) ;          (* List of all inner modules.    *)
+         InitWhereDeclaredTok(tok, At) ;    (* Where symbol declared.        *)
+         InitWhereFirstUsedTok(tok, At) ;   (* Where symbol first used.      *)
+         pCall := GetPcall(ScopePtr) ;
+         IF pCall^.Main=GetBaseModule()
+         THEN
+            Scope := NulSym
+         ELSE
+            Scope := pCall^.Main
+         END ;
+         errorScope := GetCurrentErrorScope () ;       (* Title error scope. *)
+      END
+   END ;
+   PutSymKey(ModuleTree, ModuleName, Sym) ;
+   RETURN Sym
+END MakeModule ;
+
+
+(*
+   PutModLink - assigns link to module sym.
+*)
+
+PROCEDURE PutModLink (sym: CARDINAL; link: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsModule (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      pSym^.Module.ModLink := link
+   ELSIF IsDefImp (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      pSym^.DefImp.ModLink := link
+   ELSE
+      InternalError ('expecting a DefImp or Module symbol')
+   END
+END PutModLink ;
+
+
+(*
+   IsModLink - returns the ModLink value associated with the module symbol.
+*)
+
+PROCEDURE IsModLink (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsModule (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      RETURN pSym^.Module.ModLink
+   ELSIF IsDefImp (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      RETURN pSym^.DefImp.ModLink
+   ELSE
+      InternalError ('expecting a DefImp or Module symbol')
+   END
+END IsModLink ;
+
+
+(*
+   PutDefLink - assigns link to the definition module sym.
+*)
+
+PROCEDURE PutDefLink (sym: CARDINAL; link: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsDefImp (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      pSym^.DefImp.DefLink := link
+   ELSE
+      InternalError ('expecting a DefImp symbol')
+   END
+END PutDefLink ;
+
+
+(*
+   IsDefLink - returns the DefLink value associated with the definition module symbol.
+*)
+
+PROCEDURE IsDefLink (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsDefImp (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      RETURN pSym^.DefImp.DefLink
+   ELSE
+      InternalError ('expecting a DefImp symbol')
+   END
+END IsDefLink ;
+
+
+(*
+   GetLink - returns TRUE if the current module is only used for linkage.
+*)
+
+PROCEDURE GetLink () : BOOLEAN ;
+VAR
+   OuterModule: CARDINAL ;
+BEGIN
+   OuterModule := GetCurrentModule () ;
+   IF OuterModule # NulSym
+   THEN
+      IF CompilingDefinitionModule ()
+      THEN
+         RETURN IsDefLink (OuterModule)
+      ELSE
+         RETURN IsModLink (OuterModule)
+      END
+   END ;
+   (* Default is that the module is for compiling.  *)
+   RETURN FALSE
+END GetLink ;
+
+
+(*
+   IsModuleBuiltin - returns TRUE if the module is a builtin module.
+                     (For example _BaseTypes).
+*)
+
+PROCEDURE IsModuleBuiltin (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsDefImp (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      RETURN pSym^.DefImp.Builtin
+   ELSIF IsModule (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      RETURN pSym^.Module.Builtin
+   END ;
+   RETURN FALSE
+END IsModuleBuiltin ;
+
+
+(*
+   PutModuleBuiltin - sets the Builtin flag to value.
+                      Currently the procedure expects sym to be a DefImp
+                      module only.
+*)
+
+PROCEDURE PutModuleBuiltin (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsDefImp (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      pSym^.DefImp.Builtin := value
+   ELSIF IsModule (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      pSym^.Module.Builtin := value
+   ELSE
+      InternalError ('expecting Module or DefImp symbol')
+   END
+END PutModuleBuiltin ;
+
+
+(*
+   AddModuleToParent - adds symbol, Sym, to module, Parent.
+*)
+
+PROCEDURE AddModuleToParent (Sym: CARDINAL; Parent: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Parent) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   :  PutItemIntoList(DefImp.ListOfModules, Sym) |
+      ModuleSym   :  PutItemIntoList(Module.ListOfModules, Sym) |
+      ProcedureSym:  PutItemIntoList(Procedure.ListOfModules, Sym)
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END AddModuleToParent ;
+
+
+(*
+   MakeInnerModule - creates an inner module sym with ModuleName. It returns the
+                     symbol index.
+*)
+
+PROCEDURE MakeInnerModule (tok: CARDINAL; ModuleName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   Sym := DeclareSym (tok, ModuleName) ;
+   IF NOT IsError(Sym)
+   THEN
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         SymbolType := ModuleSym ;
+         WITH Module DO
+            name := ModuleName ;            (* Index into name array, name   *)
+                                            (* of record field.              *)
+            InitCtor (ctors) ;              (* Init all ctor functions.      *)
+            InitTree(LocalSymbols) ;        (* The LocalSymbols hold all the *)
+                                            (* variables declared local to   *)
+                                            (* the block. It contains the    *)
+                                            (* FROM _ IMPORT x, y, x ;       *)
+                                            (* IMPORT A ;                    *)
+                                            (*    and also                   *)
+                                            (* MODULE WeAreHere ;            *)
+                                            (*    x y z visiable by localsym *)
+                                            (*    MODULE Inner ;             *)
+                                            (*       EXPORT x, y, z ;        *)
+                                            (*    END Inner ;                *)
+                                            (* END WeAreHere.                *)
+            InitTree(ExportTree) ;          (* Holds all the exported        *)
+                                            (* identifiers.                  *)
+                                            (* This tree may be              *)
+                                            (* deleted at the end of Pass 1. *)
+            InitTree(ImportTree) ;          (* Contains all IMPORTed         *)
+                                            (* identifiers.                  *)
+            InitList(IncludeList) ;         (* Contains all included symbols *)
+                                            (* which are included by         *)
+                                            (* IMPORT modulename ;           *)
+                                            (* modulename.Symbol             *)
+            InitTree(ExportUndeclared) ;    (* ExportUndeclared contains all *)
+                                            (* the identifiers which were    *)
+                                            (* exported but have not yet     *)
+                                            (* been declared.                *)
+            InitList(EnumerationScopeList) ;(* Enumeration scope list which  *)
+                                            (* contains a list of all        *)
+                                            (* enumerations which are        *)
+                                            (* visable within this scope.    *)
+            InitTree(NamedObjects) ;        (* Names of all items declared.  *)
+            InitTree(NamedImports) ;        (* Names of items imported.      *)
+            InitTree(WhereImported) ;       (* Sym to TokenNo where import   *)
+                                            (* occurs. Error message use.    *)
+            Priority := NulSym ;            (* Priority of the module. This  *)
+                                            (* is an index to a constant.    *)
+            InitTree(Unresolved) ;          (* All symbols currently         *)
+                                            (* unresolved in this module.    *)
+            StartQuad := 0 ;                (* Signify the initialization    *)
+                                            (* code.                         *)
+            EndQuad := 0 ;                  (* EndQuad should point to a     *)
+                                            (* goto quad.                    *)
+            StartFinishQuad := 0 ;          (* Signify the finalization      *)
+                                            (* code.                         *)
+            EndFinishQuad := 0 ;            (* should point to a finish      *)
+            FinallyFunction := NIL ;        (* The GCC function for finally  *)
+            ExceptionFinally := FALSE ;     (* does it have an exception?    *)
+            ExceptionBlock := FALSE ;       (* does it have an exception?    *)
+            ModLink := GetLink () ;         (* Is this parsed for linkage?   *)
+            InitList(ListOfVars) ;          (* List of variables in this     *)
+                                            (* scope.                        *)
+            InitList(ListOfProcs) ;         (* List of all procedures        *)
+                                            (* declared within this module.  *)
+            InitList(ListOfModules) ;       (* List of all inner modules.    *)
+            InitWhereDeclaredTok(tok, At) ;   (* Where symbol declared.        *)
+            InitWhereFirstUsedTok(tok, At) ;  (* Where symbol first used.      *)
+            IF GetCurrentScope()=GetBaseModule()
+            THEN
+               Scope := NulSym
+            ELSE
+               Scope := GetCurrentScope() ;
+               AddModuleToParent(Sym, Scope)
+            END ;
+            errorScope := GetCurrentErrorScope () ;   (* Title error scope.  *)
+         END ;
+      END ;
+      AddSymToScope(Sym, ModuleName)
+   END ;
+   RETURN Sym
+END MakeInnerModule ;
+
+
+(*
+   MakeDefImp - creates a definition and implementation module sym
+                with name DefImpName.  It returns the symbol index.
+*)
+
+PROCEDURE MakeDefImp (tok: CARDINAL; DefImpName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   (* Make a new symbol since we are at the outer scope level.  *)
+   (* We cannot use DeclareSym as it examines the current scope *)
+   (* for any symbols which have the correct name, but are yet  *)
+   (* undefined.  *)
+
+   NewSym(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := DefImpSym ;
+      WITH DefImp DO
+         name := DefImpName ;         (* Index into name array, name   *)
+                                      (* of record field.              *)
+         InitCtor (ctors) ;
+                                      (* Init all ctor functions.      *)
+         InitList(DefListOfDep) ;     (* Vector of SymDependency.      *)
+         InitList(ModListOfDep) ;     (* Vector of SymDependency.      *)
+         InitTree(ExportQualifiedTree) ;
+                                      (* Holds all the EXPORT          *)
+                                      (* QUALIFIED identifiers.        *)
+                                      (* This tree may be              *)
+                                      (* deleted at the end of Pass 1. *)
+         InitTree(ExportUnQualifiedTree) ;
+                                      (* Holds all the EXPORT          *)
+                                      (* UNQUALIFIED identifiers.      *)
+                                      (* This tree may be              *)
+                                      (* deleted at the end of Pass 1. *)
+         InitTree(ExportRequest) ;    (* Contains all identifiers that *)
+                                      (* have been requested by other  *)
+                                      (* modules before this module    *)
+                                      (* declared its export list.     *)
+                                      (* This tree should be empty at  *)
+                                      (* the end of the compilation.   *)
+                                      (* Each time a symbol is         *)
+                                      (* exported it is removed from   *)
+                                      (* this list.                    *)
+         InitTree(ImportTree) ;       (* Contains all IMPORTed         *)
+                                      (* identifiers.                  *)
+         InitList(IncludeList) ;      (* Contains all included symbols *)
+                                      (* which are included by         *)
+                                      (* IMPORT modulename ;           *)
+                                      (* modulename.Symbol             *)
+         InitList(DefIncludeList) ;   (* Contains all included symbols *)
+                                      (* which are included by         *)
+                                      (* IMPORT modulename ;           *)
+                                      (* in the definition module only *)
+         InitTree(ExportUndeclared) ; (* ExportUndeclared contains all *)
+                                      (* the identifiers which were    *)
+                                      (* exported but have not yet     *)
+                                      (* been declared.                *)
+         InitTree(NeedToBeImplemented) ;
+                                      (* NeedToBeImplemented contains  *)
+                                      (* the identifiers which have    *)
+                                      (* been exported and declared    *)
+                                      (* but have not yet been         *)
+                                      (* implemented.                  *)
+         InitTree(LocalSymbols) ;     (* The LocalSymbols hold all the *)
+                                      (* variables declared local to   *)
+                                      (* the block. It contains the    *)
+                                      (* IMPORT r ;                    *)
+                                      (* FROM _ IMPORT x, y, x ;       *)
+                                      (*    and also                   *)
+                                      (* MODULE WeAreHere ;            *)
+                                      (*    x y z visiable by localsym *)
+                                      (*    MODULE Inner ;             *)
+                                      (*       EXPORT x, y, z ;        *)
+                                      (*    END Inner ;                *)
+                                      (* END WeAreHere.                *)
+         InitList(EnumerationScopeList) ;
+                                      (* Enumeration scope list which  *)
+                                      (* contains a list of all        *)
+                                      (* enumerations which are        *)
+                                      (* visable within this scope.    *)
+         InitTree(NamedObjects) ;     (* names of all items declared.  *)
+         InitTree(NamedImports) ;     (* Names of items imported.      *)
+         InitTree(WhereImported) ;    (* Sym to TokenNo where import   *)
+                                      (* occurs. Error message use.    *)
+         Priority := NulSym ;         (* Priority of the module. This  *)
+                                      (* is an index to a constant.    *)
+         InitTree(Unresolved) ;       (* All symbols currently         *)
+                                      (* unresolved in this module.    *)
+         StartQuad := 0 ;             (* Signify the initialization    *)
+                                      (* code.                         *)
+         EndQuad := 0 ;               (* EndQuad should point to a     *)
+                                      (* goto quad.                    *)
+         StartFinishQuad := 0 ;       (* Signify the finalization      *)
+                                      (* code.                         *)
+         EndFinishQuad := 0 ;         (* should point to a finish      *)
+         FinallyFunction := NIL ;     (* The GCC function for finally  *)
+         ExceptionFinally := FALSE ;  (* does it have an exception?    *)
+         ExceptionBlock := FALSE ;    (* does it have an exception?    *)
+         ContainsHiddenType := FALSE ;(* True if this module           *)
+                                      (* implements a hidden type.     *)
+         ContainsBuiltin := FALSE ;   (* Does module define a builtin  *)
+                                      (* procedure?                    *)
+         ForC := FALSE ;              (* Is it a definition for "C"    *)
+         NeedExportList := FALSE ;    (* Must user supply export list? *)
+         DefLink := GetLink () ;      (* Is the def/mod file only      *)
+         ModLink := GetLink () ;      (* parsed for linkage?           *)
+         Builtin := FALSE ;           (* Is the module builtin?        *)
+         InitList(ListOfVars) ;       (* List of variables in this     *)
+                                      (* scope.                        *)
+         InitList(ListOfProcs) ;      (* List of all procedures        *)
+                                      (* declared within this module.  *)
+         InitList(ListOfModules) ;    (* List of all inner modules.    *)
+         InitWhereDeclaredTok(tok, At) ;  (* Where symbol declared.    *)
+         InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used.  *)
+         errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
+      END
+   END ;
+   PutSymKey(ModuleTree, DefImpName, Sym) ;
+   RETURN Sym
+END MakeDefImp ;
+
+
+(*
+   PutProcedureExternPublic - if procedure is not NulSym set extern
+                              and public booleans.
+*)
+
+PROCEDURE PutProcedureExternPublic (procedure: CARDINAL; extern, pub: BOOLEAN) ;
+BEGIN
+   IF procedure # NulSym
+   THEN
+      PutExtern (procedure, extern) ;
+      PutPublic (procedure, pub)
+   END
+END PutProcedureExternPublic ;
+
+
+(*
+   PutCtorExtern -
+*)
+
+PROCEDURE PutCtorExtern (tok: CARDINAL; sym: CARDINAL;
+                         VAR ctor: ModuleCtor; extern: BOOLEAN) ;
+BEGIN
+   (* If the ctor does not exist then make it extern/ (~extern) public.  *)
+   IF ctor.ctor = NulSym
+   THEN
+      ctor.ctor := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_ctor")) ;
+      PutMonoName (ctor.ctor, TRUE)
+   END ;
+   PutProcedureExternPublic (ctor.ctor, extern, NOT extern) ;
+   PutCtor (ctor.ctor, TRUE) ;
+   (* If the ctor does not exist then make it extern/ (~extern) public.  *)
+   IF ctor.dep = NulSym
+   THEN
+      ctor.dep := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_dep")) ;
+      PutMonoName (ctor.dep, TRUE)
+   END ;
+   PutProcedureExternPublic (ctor.dep, extern, NOT extern) ;
+   (* If init/fini do not exist then create them.  *)
+   IF ctor.init = NulSym
+   THEN
+      ctor.init := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_init")) ;
+      DeclareArgEnvParams (tok, ctor.init) ;
+      PutMonoName (ctor.init, NOT IsInnerModule (sym))
+   END ;
+   PutProcedureExternPublic (ctor.init, extern, NOT extern) ;
+   IF ctor.fini = NulSym
+   THEN
+      ctor.fini := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_fini")) ;
+      DeclareArgEnvParams (tok, ctor.fini) ;
+      PutMonoName (ctor.fini, NOT IsInnerModule (sym))
+   END ;
+   PutProcedureExternPublic (ctor.fini, extern, NOT extern)
+END PutCtorExtern ;
+
+
+(*
+   PutModuleCtorExtern - for every ctor related procedure in module sym.
+                         Make it external.  It will create any missing
+                         init/fini procedures but not any missing dep/ctor
+                         procedures.
+*)
+
+PROCEDURE PutModuleCtorExtern (tok: CARDINAL; sym: CARDINAL; external: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert (IsModule (sym) OR IsDefImp (sym)) ;
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym:  PutCtorExtern (tok, sym, DefImp.ctors, external) |
+      ModuleSym:  PutCtorExtern (tok, sym, Module.ctors, external)
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END PutModuleCtorExtern ;
+
+
+(*
+   MakeProcedure - creates a procedure sym with name. It returns
+                   the symbol index.
+*)
+
+PROCEDURE MakeProcedure (tok: CARDINAL; ProcedureName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   Sym := DeclareSym(tok, ProcedureName) ;
+   IF NOT IsError(Sym)
+   THEN
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         SymbolType := ProcedureSym ;
+         WITH Procedure DO
+            name := ProcedureName ;
+            InitList(ListOfParam) ;      (* Contains a list of all the    *)
+                                         (* parameters in this procedure. *)
+            ParamDefined := FALSE ;      (* Have the parameters been      *)
+                                         (* defined yet?                  *)
+            DefinedInDef := FALSE ;      (* Were the parameters defined   *)
+                                         (* in the Definition module?     *)
+                                         (* Note that this depends on     *)
+                                         (* whether the compiler has read *)
+                                         (* the .def or .mod first.       *)
+                                         (* The second occurence is       *)
+                                         (* compared to the first.        *)
+            DefinedInImp := FALSE ;      (* Were the parameters defined   *)
+                                         (* in the Implementation module? *)
+                                         (* Note that this depends on     *)
+                                         (* whether the compiler has read *)
+                                         (* the .def or .mod first.       *)
+                                         (* The second occurence is       *)
+                                         (* compared to the first.        *)
+            HasVarArgs := FALSE ;        (* Does the procedure use ... ?  *)
+            HasOptArg := FALSE ;         (* Does this procedure use [ ] ? *)
+            OptArgInit := NulSym ;       (* The optarg initial value.     *)
+            IsBuiltin := FALSE ;         (* Was it declared __BUILTIN__ ? *)
+            BuiltinName := NulName ;     (* name of equivalent builtin    *)
+            IsInline := FALSE ;          (* Was is declared __INLINE__ ?  *)
+            ReturnOptional := FALSE ;    (* Is the return value optional? *)
+            IsExtern := FALSE ;          (* Make this procedure external. *)
+            IsPublic := FALSE ;          (* Make this procedure visible.  *)
+            IsCtor := FALSE ;            (* Is this procedure a ctor?     *)
+            IsMonoName := FALSE ;        (* Overrides module name prefix. *)
+            Scope := GetCurrentScope() ; (* Scope of procedure.           *)
+            InitTree(Unresolved) ;       (* All symbols currently         *)
+                                         (* unresolved in this procedure. *)
+            ScopeQuad := 0 ;             (* Index into list of quads,     *)
+            StartQuad := 0 ;             (* defining the scope, start and *)
+            EndQuad := 0 ;               (* end of the procedure.         *)
+            Reachable := FALSE ;         (* Procedure not known to be     *)
+                                         (* reachable.                    *)
+            SavePriority := FALSE ;      (* Does procedure need to save   *)
+                                         (* and restore interrupts?       *)
+            ReturnType := NulSym ;       (* Not a function yet!           *)
+            Offset := 0 ;                (* Location of procedure.        *)
+            InitTree(LocalSymbols) ;
+            InitList(EnumerationScopeList) ;
+                                         (* Enumeration scope list which  *)
+                                         (* contains a list of all        *)
+                                         (* enumerations which are        *)
+                                         (* visable within this scope.    *)
+            InitTree(NamedObjects) ;     (* Names of all items declared.  *)
+            InitList(ListOfVars) ;       (* List of variables in this     *)
+                                         (* scope.                        *)
+            InitList(ListOfProcs) ;      (* List of all procedures        *)
+                                         (* declared within this          *)
+                                         (* procedure.                    *)
+            InitList(ListOfModules) ;    (* List of all inner modules.    *)
+            ExceptionFinally := FALSE ;  (* does it have an exception?    *)
+            ExceptionBlock := FALSE ;    (* does it have an exception?    *)
+            Size := InitValue() ;        (* Activation record size.       *)
+            TotalParamSize
+                       := InitValue() ;  (* size of all parameters.       *)
+            Begin := 0 ;                 (* token number for BEGIN        *)
+            End := 0 ;                   (* token number for END          *)
+            InitWhereDeclaredTok(tok, At) ;  (* Where symbol declared.        *)
+            errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
+         END
+      END ;
+      (* Now add this procedure to the symbol table of the current scope *)
+      AddSymToScope(Sym, ProcedureName) ;
+      AddProcedureToList(GetCurrentScope(), Sym)
+   END ;
+   RETURN Sym
+END MakeProcedure ;
+
+
+(*
+   PutMonoName - changes the IsMonoName boolean inside the procedure.
+*)
+
+PROCEDURE PutMonoName (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.IsMonoName := value
+
+      ELSE
+         InternalError ('expecting ProcedureSym symbol')
+      END
+   END
+END PutMonoName ;
+
+
+(*
+   IsMonoName - returns the public boolean associated with a procedure.
+*)
+
+PROCEDURE IsMonoName (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym:  RETURN Procedure.IsMonoName
+
+      ELSE
+         InternalError ('expecting ProcedureSym symbol')
+      END
+   END
+END IsMonoName ;
+
+
+(*
+   PutExtern - changes the extern boolean inside the procedure.
+*)
+
+PROCEDURE PutExtern (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.IsExtern := value
+
+      ELSE
+         InternalError ('expecting ProcedureSym symbol')
+      END
+   END
+END PutExtern ;
+
+
+(*
+   IsExtern - returns the public boolean associated with a procedure.
+*)
+
+PROCEDURE IsExtern (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym:  RETURN Procedure.IsExtern
+
+      ELSE
+         InternalError ('expecting ProcedureSym symbol')
+      END
+   END
+END IsExtern ;
+
+
+(*
+   PutPublic - changes the public boolean inside the procedure.
+*)
+
+PROCEDURE PutPublic (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym   : Procedure.IsPublic := value
+
+      ELSE
+         InternalError ('expecting ProcedureSym symbol')
+      END
+   END
+END PutPublic ;
+
+
+(*
+   IsPublic - returns the public boolean associated with a procedure.
+*)
+
+PROCEDURE IsPublic (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym   :  RETURN Procedure.IsPublic
+
+      ELSE
+         InternalError ('expecting ProcedureSym symbol')
+      END
+   END
+END IsPublic ;
+
+
+(*
+   PutCtor - changes the ctor boolean inside the procedure.
+*)
+
+PROCEDURE PutCtor (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym   : Procedure.IsCtor := value
+
+      ELSE
+         InternalError ('expecting ProcedureSym symbol')
+      END
+   END
+END PutCtor ;
+
+
+(*
+   IsCtor - returns the ctor boolean associated with a procedure.
+*)
+
+PROCEDURE IsCtor (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym   :  RETURN Procedure.IsCtor
+
+      ELSE
+         InternalError ('expecting ProcedureSym symbol')
+      END
+   END
+END IsCtor ;
+
+
+(*
+   AddProcedureToList - adds a procedure, Proc, to the list of procedures
+                        in module, Mod.
+*)
+
+PROCEDURE AddProcedureToList (Mod, Proc: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Mod) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : PutItemIntoList(DefImp.ListOfProcs, Proc) |
+      ModuleSym   : PutItemIntoList(Module.ListOfProcs, Proc) |
+      ProcedureSym: PutItemIntoList(Procedure.ListOfProcs, Proc)
+
+      ELSE
+         InternalError ('expecting ModuleSym, DefImpSym or ProcedureSym symbol')
+      END
+   END
+END AddProcedureToList ;
+
+
+(*
+   AddVarToScopeList - adds symbol, sym, to, scope.
+*)
+
+PROCEDURE AddVarToScopeList (scope, sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(scope) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: PutItemIntoList(Procedure.ListOfVars, sym) |
+      ModuleSym   : PutItemIntoList(Module.ListOfVars, sym) |
+      DefImpSym   : PutItemIntoList(DefImp.ListOfVars, sym)
+
+      ELSE
+         InternalError ('expecting Procedure or Module symbol')
+      END
+   END
+END AddVarToScopeList ;
+
+
+(*
+   AddVarToList - add a variable symbol to the list of variables maintained
+                  by the inner most scope. (Procedure or Module).
+*)
+
+PROCEDURE AddVarToList (Sym: CARDINAL) ;
+VAR
+   pCall: PtrToCallFrame ;
+BEGIN
+   pCall := GetPcall(ScopePtr) ;
+   AddVarToScopeList(pCall^.Main, Sym)
+END AddVarToList ;
+
+
+(*
+   MakeVar - creates a variable sym with VarName. It returns the
+             symbol index.
+*)
+
+PROCEDURE MakeVar (tok: CARDINAL; VarName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   Sym := DeclareSym (tok, VarName) ;
+   IF NOT IsError(Sym)
+   THEN
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         SymbolType := VarSym ;
+         WITH Var DO
+            name := VarName ;
+            Type := NulSym ;
+            BackType := NulSym ;
+            Size := InitValue() ;
+            Offset := InitValue() ;
+            AddrMode := RightValue ;
+            Scope := GetCurrentScope() ;  (* Procedure or Module?  *)
+            AtAddress := FALSE ;
+            Address := NulSym ;           (* Address at which declared.  *)
+            IsTemp := FALSE ;
+            IsComponentRef := FALSE ;
+            IsParam := FALSE ;
+            IsPointerCheck := FALSE ;
+            IsWritten := FALSE ;
+            IsSSA := FALSE ;
+            IsConst := FALSE ;
+            InitWhereDeclaredTok(tok, At) ;
+            InitWhereFirstUsedTok(tok, At) ;   (* Where symbol first used.  *)
+            InitList(ReadUsageList[RightValue]) ;
+            InitList(WriteUsageList[RightValue]) ;
+            InitList(ReadUsageList[LeftValue]) ;
+            InitList(WriteUsageList[LeftValue])
+         END
+      END ;
+      (* Add Var to Procedure or Module variable list.  *)
+      AddVarToList(Sym) ;
+      (* Now add this Var to the symbol table of the current scope.  *)
+      AddSymToScope(Sym, VarName)
+   END ;
+   RETURN Sym
+END MakeVar ;
+
+
+(*
+   PutExceptionBlock - sets a BOOLEAN in block module/procedure/defimp,
+                       sym, indicating that this block as an EXCEPT
+                       statement sequence.
+*)
+
+PROCEDURE PutExceptionBlock (sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.ExceptionBlock := TRUE |
+      ModuleSym   : Module.ExceptionBlock := TRUE |
+      DefImpSym   : DefImp.ExceptionBlock := TRUE
+
+      ELSE
+         InternalError ('expecting Procedure')
+      END
+   END
+END PutExceptionBlock ;
+
+
+(*
+   HasExceptionBlock - returns a BOOLEAN determining whether
+                       module/procedure/defimp, sym, has
+                       an EXCEPT statement sequence.
+*)
+
+PROCEDURE HasExceptionBlock (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: RETURN( Procedure.ExceptionBlock ) |
+      ModuleSym   : RETURN( Module.ExceptionBlock ) |
+      DefImpSym   : RETURN( DefImp.ExceptionBlock )
+
+      ELSE
+         InternalError ('expecting Procedure')
+      END
+   END
+END HasExceptionBlock ;
+
+
+(*
+   PutExceptionFinally - sets a BOOLEAN in block module/defimp,
+                         sym, indicating that this FINALLY block
+                         as an EXCEPT statement sequence.
+*)
+
+PROCEDURE PutExceptionFinally (sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.ExceptionFinally := TRUE |
+      ModuleSym   : Module.ExceptionFinally := TRUE |
+      DefImpSym   : DefImp.ExceptionFinally := TRUE
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END PutExceptionFinally ;
+
+
+(*
+   HasExceptionFinally - returns a BOOLEAN determining whether
+                         module/defimp, sym, has
+                         an EXCEPT statement sequence.
+*)
+
+PROCEDURE HasExceptionFinally (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: RETURN( Procedure.ExceptionFinally ) |
+      ModuleSym   : RETURN( Module.ExceptionFinally ) |
+      DefImpSym   : RETURN( DefImp.ExceptionFinally )
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END HasExceptionFinally ;
+
+
+(*
+   FillInRecordFields - given a new symbol, sym, make it a record symbol
+                        and initialize its fields.
+*)
+
+PROCEDURE FillInRecordFields (tok: CARDINAL; sym: CARDINAL; RecordName: Name;
+                              scope: CARDINAL; oaf: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF NOT IsError(sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      WITH pSym^ DO
+         SymbolType := RecordSym ;
+         WITH Record DO
+            name := RecordName ;
+            InitTree (LocalSymbols) ;
+            Size := InitValue () ;
+            InitList (ListOfSons) ;   (* List of RecordFieldSym and VarientSym *)
+            oafamily := oaf ;
+            Parent := NulSym ;
+            Align := NulSym ;
+            DefaultAlign := NulSym ;
+            DeclPacked := FALSE ;
+            DeclResolved := FALSE ;
+            Scope := scope ;
+            InitWhereDeclaredTok (tok, At)
+         END
+      END
+   END
+END FillInRecordFields ;
+
+
+(*
+   HandleHiddenOrDeclare -
+*)
+
+PROCEDURE HandleHiddenOrDeclare (tok: CARDINAL; name: Name; VAR oaf: CARDINAL) : CARDINAL ;
+VAR
+   sym: CARDINAL ;
+BEGIN
+   sym := CheckForHiddenType (name) ;
+   IF sym=NulSym
+   THEN
+      sym := DeclareSym (tok, name) ;
+      IF NOT IsError (sym)
+      THEN
+         (* Now add this type to the symbol table of the current scope *)
+         AddSymToScope (sym, name)
+      END
+   END ;
+   oaf := GetOAFamily (sym) ;
+   RETURN sym
+END HandleHiddenOrDeclare ;
+
+
+(*
+   MakeRecord - makes a Record symbol with name RecordName.
+*)
+
+PROCEDURE MakeRecord (tok: CARDINAL; RecordName: Name) : CARDINAL ;
+VAR
+   oaf, sym: CARDINAL ;
+BEGIN
+   sym := HandleHiddenOrDeclare (tok, RecordName, oaf) ;
+   FillInRecordFields (tok, sym, RecordName, GetCurrentScope (), oaf) ;
+   ForeachOAFamily (oaf, doFillInOAFamily) ;
+   RETURN sym
+END MakeRecord ;
+
+
+(*
+   MakeVarient - creates a new symbol, a varient symbol for record or varient field
+                 symbol, RecOrVarFieldSym.
+*)
+
+PROCEDURE MakeVarient (tok: CARDINAL; RecOrVarFieldSym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   NewSym (Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := VarientSym ;
+      WITH Varient DO
+         Size := InitValue() ;
+         Parent := RecOrVarFieldSym ; (* GetRecord(RecOrVarFieldSym) ; *)
+         IF IsRecord(RecOrVarFieldSym)
+         THEN
+            Varient := NulSym
+         ELSE
+            Varient := RecOrVarFieldSym
+         END ;
+         tag := NulSym ;
+         DeclPacked := FALSE ;
+         Scope := GetCurrentScope() ;
+         InitList(ListOfSons) ;
+         InitWhereDeclaredTok(tok, At)
+      END
+   END ;
+   (* Now add Sym to the record RecSym field list *)
+   pSym := GetPsym(RecOrVarFieldSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym      : PutItemIntoList(Record.ListOfSons, Sym) |
+      VarientFieldSym: PutItemIntoList(VarientField.ListOfSons, Sym)
+
+      ELSE
+         InternalError ('expecting Record or VarientField symbol')
+      END
+   END ;
+   RETURN Sym
+END MakeVarient ;
+
+
+(*
+   GetRecord - fetches the record symbol from the parent of Sym.
+               Sym maybe a varient symbol in which case its parent is searched
+               etc.
+*)
+
+PROCEDURE GetRecord (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym      : RETURN Sym  |
+      VarientSym     : RETURN GetRecord(Varient.Parent)  |
+      VarientFieldSym: RETURN GetRecord(VarientField.Parent)
+
+      ELSE
+         InternalError ('expecting Record or Varient symbol')
+      END
+   END
+END GetRecord ;
+
+
+(*
+   PutDeclaredPacked - sets the Packed field of the record or record field symbol.
+*)
+
+PROCEDURE PutDeclaredPacked (sym: CARDINAL; b: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym      :  Record.DeclPacked := b ;
+                        Record.DeclResolved := TRUE |
+      RecordFieldSym :  RecordField.DeclPacked := b ;
+                        RecordField.DeclResolved := TRUE |
+      VarientFieldSym:  VarientField.DeclPacked := b ;
+                        VarientField.DeclResolved := TRUE |
+      VarientSym     :  Varient.DeclPacked := b ;
+                        Varient.DeclResolved := TRUE
+
+      ELSE
+         InternalError ('expecting a record or field record symbol')
+      END
+   END
+END PutDeclaredPacked ;
+
+
+(*
+   IsDeclaredPacked - was the record symbol or record field, sym,
+                      declared as packed?
+*)
+
+PROCEDURE IsDeclaredPacked (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym      :  RETURN Record.DeclPacked |
+      RecordFieldSym :  RETURN RecordField.DeclPacked |
+      VarientFieldSym:  RETURN VarientField.DeclPacked |
+      VarientSym     :  RETURN Varient.DeclPacked
+
+      ELSE
+         InternalError ('expecting a record or a record field symbol')
+      END
+   END
+END IsDeclaredPacked ;
+
+
+(*
+   IsDeclaredPackedResolved - do we know if the record symbol or record
+                              field, sym, declared as packed or not packed?
+*)
+
+PROCEDURE IsDeclaredPackedResolved (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym      :  RETURN Record.DeclResolved |
+      RecordFieldSym :  RETURN RecordField.DeclResolved |
+      VarientFieldSym:  RETURN VarientField.DeclResolved |
+      VarientSym     :  RETURN Varient.DeclResolved
+
+      ELSE
+         InternalError ('expecting a record or a record field symbol')
+      END
+   END
+END IsDeclaredPackedResolved ;
+
+
+(*
+   MakeEnumeration - places a new symbol in the current scope, the symbol
+                     is an enumeration symbol. The symbol index is returned.
+*)
+
+PROCEDURE MakeEnumeration (tok: CARDINAL; EnumerationName: Name) : CARDINAL ;
+VAR
+   pSym    : PtrToSymbol ;
+   sym, oaf: CARDINAL ;
+BEGIN
+   sym := CheckForHiddenType (EnumerationName) ;
+   IF sym=NulSym
+   THEN
+      sym := DeclareSym (tok, EnumerationName) ;
+      oaf := GetOAFamily (sym) ;
+      IF NOT IsError (sym)
+      THEN
+         pSym := GetPsym (sym) ;
+         pSym^.SymbolType := EnumerationSym ; (* To satisfy AddSymToScope *)
+         (* Now add this type to the symbol table of the current scope *)
+         AddSymToScope (sym, EnumerationName)
+      END
+   ELSE
+      oaf := GetOAFamily (sym)
+   END ;
+   IF NOT IsError (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      WITH pSym^ DO
+         SymbolType := EnumerationSym ;
+         WITH Enumeration DO
+            name := EnumerationName ;      (* Name of enumeration.   *)
+            NoOfElements := 0 ;            (* No of elements in the  *)
+                                           (* enumeration type.      *)
+            Size := InitValue () ;         (* Size at runtime of sym *)
+            InitTree (LocalSymbols) ;      (* Enumeration fields.    *)
+            InitPacked (packedInfo) ;      (* not packed and no      *)
+                                           (* equivalent (yet).      *)
+            oafamily := oaf ;              (* The open array family  *)
+            Scope := GetCurrentScope () ;  (* Which scope created it *)
+            InitWhereDeclaredTok (tok, At) (* Declared here          *)
+         END
+      END ;
+      CheckIfEnumerationExported (sym, ScopePtr)
+   END ;
+   ForeachOAFamily (oaf, doFillInOAFamily) ;
+   RETURN sym
+END MakeEnumeration ;
+
+
+(*
+   MakeType - makes a type symbol with name TypeName.
+*)
+
+PROCEDURE MakeType (tok: CARDINAL; TypeName: Name) : CARDINAL ;
+VAR
+   pSym    : PtrToSymbol ;
+   sym, oaf: CARDINAL ;
+BEGIN
+   sym := HandleHiddenOrDeclare (tok, TypeName, oaf) ;
+   IF NOT IsError(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         SymbolType := TypeSym ;
+         WITH Type DO
+            name := TypeName ;        (* Index into name array, name *)
+                                      (* of type.                    *)
+            Type := NulSym ;          (* Index to a type symbol.     *)
+            IsHidden := FALSE ;       (* Was it declared as hidden?  *)
+	    InitTree(ConstLitTree) ;  (* constants of this type.     *)
+            Size := InitValue() ;     (* Runtime size of symbol.     *)
+            Align := NulSym ;         (* Alignment of this type.     *)
+            InitPacked(packedInfo) ;  (* not packed and no           *)
+                                      (* equivalent yet.             *)
+            oafamily := oaf ;         (* The open array family.      *)
+            Scope := GetCurrentScope() ;   (* Which scope created it *)
+            InitWhereDeclaredTok(tok, At)  (* Declared here               *)
+         END
+      END
+   END ;
+   ForeachOAFamily(oaf, doFillInOAFamily) ;
+   RETURN sym
+END MakeType ;
+
+
+(*
+   MakeHiddenType - makes a type symbol that is hidden from the
+                    definition module.
+                    This symbol is placed into the UnImplemented list of
+                    the definition/implementation module.
+                    The type will be filled in when the implementation module
+                    is reached.
+*)
+
+PROCEDURE MakeHiddenType (tok: CARDINAL; TypeName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   Sym := DeclareSym (tok, TypeName) ;
+   IF NOT IsError(Sym)
+   THEN
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         SymbolType := TypeSym ;
+         WITH Type DO
+            name   := TypeName ;    (* Index into name array, name *)
+                                    (* of type.                    *)
+            IsHidden := GetMainModule()#GetCurrentScope() ;
+            IF ExtendedOpaque OR (NOT IsHidden)
+            THEN
+               Type := NulSym       (* will be filled in later     *)
+            ELSE
+               Type := Address
+            END ;
+            Align := NulSym ;       (* Alignment of this type.     *)
+            Scope := GetCurrentScope() ; (* Which scope created it *)
+            oafamily := NulSym ;
+            IF NOT ExtendedOpaque
+            THEN
+               IncludeItemIntoList(AddressTypes, Sym)
+            END ;
+            Size := InitValue() ;   (* Runtime size of symbol.     *)
+            InitWhereDeclaredTok(tok, At) (* Declared here         *)
+         END
+      END ;
+      PutExportUnImplemented (tok, Sym) ;
+      IF ExtendedOpaque OR (GetMainModule()=GetCurrentScope())
+      THEN
+         PutHiddenTypeDeclared
+      END ;
+      (* Now add this type to the symbol table of the current scope *)
+      AddSymToScope(Sym, TypeName)
+   END ;
+   RETURN Sym
+END MakeHiddenType ;
+
+
+(*
+   GetConstFromTypeTree - return a constant symbol from the tree owned by constType.
+                          NulSym is returned if the symbol is unknown.
+*)
+
+(*
+PROCEDURE GetConstFromTypeTree (constName: Name; constType: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF constType=NulSym
+   THEN
+      RETURN GetSymKey(ConstLitTree, constName)
+   ELSE
+      pSym := GetPsym(constType) ;
+      Assert(IsType(constType) OR IsSubrange(constType) OR IsPointer(constType)) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         TypeSym    :  RETURN GetSymKey (Type.ConstLitTree, constName) |
+	 SubrangeSym:  RETURN GetSymKey (Subrange.ConstLitTree, constName) |
+	 PointerSym :  RETURN GetSymKey (Pointer.ConstLitTree, constName)
+
+         ELSE
+            InternalError ('expecting Type symbol')
+         END
+      END
+   END
+END GetConstFromTypeTree ;
+*)
+
+
+(*
+   PutConstIntoTypeTree - places, constSym, into the tree of constants owned by, constType.
+                          constName is the name of constSym.
+*)
+
+(*
+PROCEDURE PutConstIntoTypeTree (constName: Name; constType: CARDINAL; constSym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF constType=NulSym
+   THEN
+      PutSymKey(ConstLitTree, constName, constSym)
+   ELSE
+      pSym := GetPsym(constType) ;
+      Assert(IsType(constType) OR IsSubrange(constType) OR IsPointer(constType)) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         TypeSym    :  PutSymKey (Type.ConstLitTree, constName, constSym) |
+         SubrangeSym:  PutSymKey (Subrange.ConstLitTree, constName, constSym) |
+         PointerSym :  PutSymKey (Pointer.ConstLitTree, constName, constSym)
+
+         ELSE
+            InternalError ('expecting Type symbol')
+         END
+      END
+   END
+END PutConstIntoTypeTree ;
+*)
+
+
+(*
+   MakeConstant - create a constant cardinal and return the symbol.
+*)
+
+PROCEDURE MakeConstant (tok: CARDINAL; value: CARDINAL) : CARDINAL ;
+VAR
+   str: String ;
+   sym: CARDINAL ;
+BEGIN
+   str := Sprintf1 (Mark (InitString ("%d")), value) ;
+   sym := MakeConstLit (tok, makekey (string (str)), Cardinal) ;
+   str := KillString (str) ;
+   RETURN sym
+END MakeConstant ;
+
+
+(*
+   MakeConstLit - returns a constant literal of type, constType, with a constName,
+                  at location, tok.
+*)
+
+PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   IF constType=NulSym
+   THEN
+      constType := GetConstLitType (tok, constName)
+   END ;
+   NewSym (Sym) ;
+   pSym := GetPsym (Sym) ;
+   WITH pSym^ DO
+      SymbolType := ConstLitSym ;
+      CASE SymbolType OF
+
+      ConstLitSym : ConstLit.name := constName ;
+                    ConstLit.Value := InitValue () ;
+                    PushString (tok, constName) ;
+                    PopInto (ConstLit.Value) ;
+                    ConstLit.Type := constType ;
+                    ConstLit.IsSet := FALSE ;
+                    ConstLit.IsConstructor := FALSE ;
+                    ConstLit.FromType := NulSym ;     (* type is determined FromType *)
+                    ConstLit.UnresFromType := FALSE ; (* is Type resolved?           *)
+                    ConstLit.Scope := GetCurrentScope() ;
+                    InitWhereDeclaredTok (tok, ConstLit.At) ;
+                    InitWhereFirstUsedTok (tok, ConstLit.At)
+
+      ELSE
+         InternalError ('expecting ConstLit symbol')
+      END
+   END ;
+   RETURN Sym
+END MakeConstLit ;
+
+
+(*
+   MakeConstVar - makes a ConstVar type with
+                  name ConstVarName.
+*)
+
+PROCEDURE MakeConstVar (tok: CARDINAL; ConstVarName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   Sym := DeclareSym (tok, ConstVarName) ;
+   IF NOT IsError(Sym)
+   THEN
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         SymbolType := ConstVarSym ;
+         WITH ConstVar DO
+            name  := ConstVarName ;
+            Value := InitValue() ;
+            Type  := NulSym ;
+            IsSet := FALSE ;
+            IsConstructor := FALSE ;
+            FromType := NulSym ;     (* type is determined FromType *)
+            UnresFromType := FALSE ; (* is Type resolved?           *)
+            IsTemp := FALSE ;
+            Scope := GetCurrentScope() ;
+            InitWhereDeclaredTok (tok, At)
+         END
+      END ;
+      (* Now add this constant to the symbol table of the current scope *)
+      AddSymToScope(Sym, ConstVarName)
+   END ;
+   RETURN( Sym )
+END MakeConstVar ;
+
+
+(*
+   MakeConstLitString - put a constant which has the string described by
+                        ConstName into the ConstantTree.
+                        The symbol number is returned.
+                        This symbol is known as a String Constant rather than a
+                        ConstLit which indicates a number.
+                        If the constant already exits
+                        then a duplicate constant is not entered in the tree.
+                        All values of constant strings
+                        are ignored in Pass 1 and evaluated in Pass 2 via
+                        character manipulation.
+                        In this procedure ConstName is the string.
+*)
+
+PROCEDURE MakeConstLitString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   sym : CARDINAL ;
+BEGIN
+   sym := GetSymKey (ConstLitStringTree, ConstName) ;
+   IF sym=NulSym
+   THEN
+      NewSym (sym) ;
+      PutSymKey (ConstLitStringTree, ConstName, sym) ;
+      pSym := GetPsym (sym) ;
+      WITH pSym^ DO
+         SymbolType := ConstStringSym ;
+         CASE SymbolType OF
+
+         ConstStringSym: InitConstString (tok, sym, ConstName, ConstName,
+                                          m2str,
+                                          sym, NulSym, NulSym, NulSym)
+
+         ELSE
+            InternalError ('expecting ConstString symbol')
+         END
+      END
+   END ;
+   RETURN sym
+END MakeConstLitString ;
+
+
+(*
+   BackFillString -
+*)
+
+PROCEDURE BackFillString (sym, m2sym, m2nulsym, csym, cnulsym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF sym # NulSym
+   THEN
+      pSym := GetPsym (sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ConstStringSym:  ConstString.M2Variant := m2sym ;
+                          ConstString.NulM2Variant := m2nulsym ;
+                          ConstString.CVariant := csym ;
+                          ConstString.NulCVariant := cnulsym
+
+         ELSE
+            InternalError ('expecting ConstStringSym')
+         END
+      END
+   END
+END BackFillString ;
+
+
+(*
+   InitConstString - initialize the constant string and back fill any
+                     previous string variants.
+*)
+
+PROCEDURE InitConstString (tok: CARDINAL; sym: CARDINAL; name, contents: Name;
+                           kind: ConstStringVariant;
+                           m2sym, m2nulsym, csym, cnulsym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      SymbolType := ConstStringSym ;
+      CASE SymbolType OF
+
+      ConstStringSym:  ConstString.name := name ;
+                       ConstString.StringVariant := kind ;
+                       PutConstString (tok, sym, contents) ;
+                       BackFillString (sym,
+                                       m2sym, m2nulsym, csym, cnulsym) ;
+                       BackFillString (m2sym,
+                                       m2sym, m2nulsym, csym, cnulsym) ;
+                       BackFillString (m2nulsym,
+                                       m2sym, m2nulsym, csym, cnulsym) ;
+                       BackFillString (csym,
+                                       m2sym, m2nulsym, csym, cnulsym) ;
+                       BackFillString (cnulsym,
+                                       m2sym, m2nulsym, csym, cnulsym) ;
+                       ConstString.Scope := GetCurrentScope() ;
+                       InitWhereDeclaredTok (tok, ConstString.At)
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END InitConstString ;
+
+
+(*
+   GetConstStringM2 - returns the Modula-2 variant of a string
+                      (with no added nul terminator).
+*)
+
+PROCEDURE GetConstStringM2 (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym:  RETURN ConstString.M2Variant
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END GetConstStringM2 ;
+
+
+(*
+   GetConstStringC - returns the C variant of a string
+                     (with no added nul terminator).
+*)
+
+PROCEDURE GetConstStringC (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym:  RETURN ConstString.CVariant
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END GetConstStringC ;
+
+
+(*
+   GetConstStringM2nul - returns the Modula-2 variant of a string
+                         (with added nul terminator).
+*)
+
+PROCEDURE GetConstStringM2nul (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym:  RETURN ConstString.NulM2Variant
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END GetConstStringM2nul ;
+
+
+(*
+   GetConstStringCnul - returns the C variant of a string
+                        (with no added nul terminator).
+*)
+
+PROCEDURE GetConstStringCnul (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym:  RETURN ConstString.NulCVariant
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END GetConstStringCnul ;
+
+
+(*
+   IsConstStringNulTerminated - returns TRUE if the constant string, sym,
+                                should be created with a nul terminator.
+*)
+
+PROCEDURE IsConstStringNulTerminated (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym:  RETURN ((ConstString.StringVariant = m2nulstr) OR
+                               (ConstString.StringVariant = cnulstr))
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END IsConstStringNulTerminated ;
+
+
+(*
+   MakeConstStringCnul - creates a constant string nul terminated string suitable for C.
+                         sym is a ConstString and a new symbol is returned
+                         with the escape sequences converted into characters.
+*)
+
+PROCEDURE MakeConstStringCnul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym  : PtrToSymbol ;
+   newstr: CARDINAL ;
+BEGIN
+   pSym := GetPsym (GetConstStringM2 (sym)) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym:  Assert (ConstString.StringVariant = m2str) ;
+                       ConstString.CVariant := MakeConstStringC (tok, sym) ;
+                       IF ConstString.NulCVariant = NulSym
+                       THEN
+                          NewSym (newstr) ;
+                          ConstString.NulCVariant := newstr ;
+                          InitConstString (tok, newstr, ConstString.name, GetString (ConstString.CVariant),
+                                           cnulstr,
+                                           ConstString.M2Variant, ConstString.NulM2Variant, ConstString.CVariant, ConstString.NulCVariant)
+                       END ;
+                       RETURN ConstString.NulCVariant
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END MakeConstStringCnul ;
+
+
+(*
+   MakeConstStringM2nul - creates a constant string nul terminated string.
+                          sym is a ConstString and a new symbol is returned.
+*)
+
+PROCEDURE MakeConstStringM2nul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (GetConstStringM2 (sym)) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym:  Assert (ConstString.StringVariant = m2str) ;
+                       IF ConstString.NulM2Variant = NulSym
+                       THEN
+                          NewSym (ConstString.NulM2Variant) ;
+                          InitConstString (tok, ConstString.NulM2Variant,
+                                           ConstString.name, ConstString.Contents,
+                                           m2nulstr,
+                                           ConstString.M2Variant, ConstString.NulM2Variant,
+                                           ConstString.CVariant, ConstString.NulCVariant)
+                       END ;
+                       RETURN ConstString.NulM2Variant
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END MakeConstStringM2nul ;
+
+
+(*
+   MakeConstStringC - creates a constant string suitable for C.
+                      sym is a Modula-2 ConstString and a new symbol is returned
+                      with the escape sequences converted into characters.
+                      It is not nul terminated.
+*)
+
+PROCEDURE MakeConstStringC (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym  : PtrToSymbol ;
+   s     : String ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym:  IF ConstString.StringVariant = cstr
+                       THEN
+                          RETURN sym   (* this is already the C variant.  *)
+                       ELSIF ConstString.CVariant = NulSym
+                       THEN
+                          Assert (ConstString.StringVariant = m2str) ;  (* we can only derive string variants from Modula-2 strings.  *)
+                          Assert (sym = ConstString.M2Variant) ;
+                          (* we need to create a new one and return the new symbol.  *)
+                          s := HandleEscape (InitStringCharStar (KeyToCharStar (GetString (ConstString.M2Variant)))) ;
+                          NewSym (ConstString.CVariant) ;
+                          InitConstString (tok, ConstString.CVariant, ConstString.name, makekey (string (s)),
+                                           cstr,
+                                           ConstString.M2Variant, ConstString.NulM2Variant, ConstString.CVariant, ConstString.NulCVariant) ;
+                          s := KillString (s)
+                       END ;
+                       RETURN ConstString.CVariant
+
+      ELSE
+         InternalError ('expecting ConstStringSym')
+      END
+   END
+END MakeConstStringC ;
+
+
+(*
+   MakeConstString - puts a constant into the symboltable which is a string.
+                     The string value is unknown at this time and will be
+                     filled in later by PutString.
+*)
+
+PROCEDURE MakeConstString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   sym : CARDINAL ;
+BEGIN
+   NewSym (sym) ;
+   PutSymKey (ConstLitStringTree, ConstName, sym) ;
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      SymbolType := ConstStringSym ;
+      CASE SymbolType OF
+
+      ConstStringSym :  InitConstString (tok, sym, ConstName, NulName,
+                                         m2str, sym, NulSym, NulSym, NulSym)
+
+      ELSE
+         InternalError ('expecting ConstString symbol')
+      END
+   END ;
+   RETURN sym
+END MakeConstString ;
+
+
+(*
+   PutConstString - places a string, String, into a constant symbol, Sym.
+                    Sym maybe a ConstString or a ConstVar.  If the later is
+                    true then the ConstVar is converted to a ConstString.
+*)
+
+PROCEDURE PutConstString (tok: CARDINAL; sym: CARDINAL; contents: Name) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym: ConstString.Length := LengthKey (contents) ;
+                      ConstString.Contents := contents ;
+                      InitWhereFirstUsedTok (tok, ConstString.At) |
+
+      ConstVarSym   : (* ok altering this to ConstString *)
+                      (* copy name and alter symbol.     *)
+                      InitConstString (tok, sym, ConstVar.name, contents,
+                                       m2str,
+                                       sym, NulSym, NulSym, NulSym)
+
+      ELSE
+         InternalError ('expecting ConstString or ConstVar symbol')
+      END
+   END
+END PutConstString ;
+
+
+(*
+   IsConstStringM2 - returns whether this conststring is an unaltered Modula-2 string.
+*)
+
+PROCEDURE IsConstStringM2 (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym: RETURN ConstString.StringVariant = m2str
+
+      ELSE
+         InternalError ('expecting ConstString symbol')
+      END
+   END
+END IsConstStringM2 ;
+
+
+(*
+   IsConstStringC - returns whether this conststring is a C style string
+                    which will have any escape translated.
+*)
+
+PROCEDURE IsConstStringC (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym: RETURN ConstString.StringVariant = cstr
+
+      ELSE
+         InternalError ('expecting ConstString symbol')
+      END
+   END
+END IsConstStringC ;
+
+
+(*
+   IsConstStringM2nul - returns whether this conststring is a Modula-2 string which
+                        contains a nul terminator.
+*)
+
+PROCEDURE IsConstStringM2nul (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym: RETURN ConstString.StringVariant = m2nulstr
+
+      ELSE
+         InternalError ('expecting ConstString symbol')
+      END
+   END
+END IsConstStringM2nul ;
+
+
+(*
+   IsConstStringCnul - returns whether this conststring is a C style string
+                       which will have any escape translated and also contains
+                       a nul terminator.
+*)
+
+PROCEDURE IsConstStringCnul (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym: RETURN ConstString.StringVariant = cnulstr
+
+      ELSE
+         InternalError ('expecting ConstString symbol')
+      END
+   END
+END IsConstStringCnul ;
+
+
+(*
+   GetString - returns the contents of the string symbol sym, note that
+               this is not the same as GetName (unless it was a literal).
+*)
+
+PROCEDURE GetString (Sym: CARDINAL) : Name ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym: RETURN ConstString.Contents
+
+      ELSE
+         InternalError ('expecting ConstString symbol')
+      END
+   END
+END GetString ;
+
+
+(*
+   GetStringLength - returns the length of the string symbol Sym.
+*)
+
+PROCEDURE GetStringLength (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym: RETURN ConstString.Length
+
+      ELSE
+         InternalError ('expecting ConstString symbol')
+      END
+   END
+END GetStringLength ;
+
+
+(*
+   PutVariableAtAddress - determines that a variable, sym, is declared at
+                          a specific address.
+*)
+
+PROCEDURE PutVariableAtAddress (sym: CARDINAL; address: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(sym#NulSym) ;
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:  Var.AtAddress := TRUE ;
+               Var.Address := address
+
+      ELSE
+         InternalError ('expecting a variable symbol')
+      END
+   END
+END PutVariableAtAddress ;
+
+
+(*
+   GetVariableAtAddress - returns the address at which variable, sym, is declared.
+*)
+
+PROCEDURE GetVariableAtAddress (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(sym#NulSym) ;
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:  RETURN( Var.Address )
+
+      ELSE
+         InternalError ('expecting a variable symbol')
+      END
+   END
+END GetVariableAtAddress ;
+
+
+(*
+   IsVariableAtAddress - returns TRUE if a variable, sym, was declared at
+                         a specific address.
+*)
+
+PROCEDURE IsVariableAtAddress (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(sym#NulSym) ;
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:  RETURN( Var.AtAddress )
+
+      ELSE
+         InternalError ('expecting a variable symbol')
+      END
+   END
+END IsVariableAtAddress ;
+
+
+(*
+   PutVariableSSA - assigns value to the SSA field within variable sym.
+*)
+
+PROCEDURE PutVariableSSA (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert (sym#NulSym) ;
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:  Var.IsSSA := value
+
+      ELSE
+         InternalError ('expecting a variable symbol')
+      END
+   END
+END PutVariableSSA ;
+
+
+(*
+   IsVariableSSA - returns TRUE if variable is known to be a SSA.
+*)
+
+PROCEDURE IsVariableSSA (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert (sym#NulSym) ;
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:  RETURN Var.IsSSA
+
+      ELSE
+         InternalError ('expecting a variable symbol')
+      END
+   END
+END IsVariableSSA ;
+
+
+(*
+   PutPriority - places a interrupt, priority, value into module, module.
+*)
+
+PROCEDURE PutPriority (module: CARDINAL; priority: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(module#NulSym) ;
+   pSym := GetPsym(module) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym:  DefImp.Priority := priority |
+      ModuleSym:  Module.Priority := priority
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END PutPriority ;
+
+
+(*
+   GetPriority - returns the interrupt priority which was assigned to
+                 module, module.
+*)
+
+PROCEDURE GetPriority (module: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(module#NulSym) ;
+   pSym := GetPsym(module) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym:  RETURN( DefImp.Priority ) |
+      ModuleSym:  RETURN( Module.Priority )
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END GetPriority ;
+
+
+(*
+   PutNeedSavePriority - set a boolean flag indicating that this procedure
+                         needs to save and restore interrupts.
+*)
+
+PROCEDURE PutNeedSavePriority (sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.SavePriority := TRUE
+
+      ELSE
+         InternalError ('expecting procedure symbol')
+      END
+   END
+END PutNeedSavePriority ;
+
+
+(*
+   GetNeedSavePriority - returns the boolean flag indicating whether this procedure
+                         needs to save and restore interrupts.
+*)
+
+PROCEDURE GetNeedSavePriority (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: RETURN( Procedure.SavePriority )
+
+      ELSE
+         InternalError ('expecting procedure symbol')
+      END
+   END
+END GetNeedSavePriority ;
+
+
+(*
+   GetProcedureBuiltin - returns the builtin name for the equivalent procedure, Sym.
+*)
+
+PROCEDURE GetProcedureBuiltin (Sym: CARDINAL) : Name ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: RETURN( Procedure.BuiltinName )
+
+      ELSE
+         InternalError ('expecting procedure symbol')
+      END
+   END
+END GetProcedureBuiltin ;
+
+
+(*
+   PutProcedureBuiltin - assigns the builtin name for the equivalent procedure, Sym.
+*)
+
+PROCEDURE PutProcedureBuiltin (Sym: CARDINAL; name: Name) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym   : Procedure.BuiltinName := name ;
+                       Procedure.IsBuiltin := TRUE ;
+                       (* we use the same extra pass method as hidden types for builtins *)
+                       PutHiddenTypeDeclared
+
+      ELSE
+         InternalError ('expecting procedure symbol')
+      END
+   END
+END PutProcedureBuiltin ;
+
+
+(*
+   IsProcedureBuiltin - returns TRUE if this procedure has a builtin equivalent.
+*)
+
+PROCEDURE IsProcedureBuiltin (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym   : RETURN( Procedure.IsBuiltin )
+
+      ELSE
+         InternalError ('expecting procedure symbol')
+      END
+   END
+END IsProcedureBuiltin ;
+
+
+(*
+   PutProcedureInline - determines that procedure, Sym, has been requested to be inlined.
+*)
+
+PROCEDURE PutProcedureInline (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym   : Procedure.IsInline := TRUE ;
+
+      ELSE
+         InternalError ('expecting procedure symbol')
+      END
+   END
+END PutProcedureInline ;
+
+
+(*
+   IsProcedureBuiltin - returns TRUE if this procedure was declared as inlined.
+*)
+
+PROCEDURE IsProcedureInline (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym   : RETURN( Procedure.IsInline )
+
+      ELSE
+         InternalError ('expecting procedure symbol')
+      END
+   END
+END IsProcedureInline ;
+
+
+(*
+   PutConstSet - informs the const var symbol, sym, that it is or will contain
+                 a set value.
+*)
+
+PROCEDURE PutConstSet (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstVarSym:  ConstVar.IsSet := TRUE |
+      ConstLitSym:  ConstLit.IsSet := TRUE
+
+      ELSE
+         InternalError ('expecting ConstVar symbol')
+      END
+   END
+END PutConstSet ;
+
+
+(*
+   IsConstSet - returns TRUE if the constant is declared as a set.
+*)
+
+PROCEDURE IsConstSet (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstVarSym:  RETURN( ConstVar.IsSet ) |
+      ConstLitSym:  RETURN( ConstLit.IsSet )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsConstSet ;
+
+
+(*
+   PutConstructor - informs the const var symbol, sym, that it is or
+                    will contain a constructor (record, set or array)
+                    value.
+*)
+
+PROCEDURE PutConstructor (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstVarSym:  ConstVar.IsConstructor := TRUE |
+      ConstLitSym:  ConstLit.IsConstructor := TRUE
+
+      ELSE
+         InternalError ('expecting ConstVar or ConstLit symbol')
+      END
+   END
+END PutConstructor ;
+
+
+(*
+   IsConstructor - returns TRUE if the constant is declared as a
+                   constant set, array or record.
+*)
+
+PROCEDURE IsConstructor (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstVarSym:  RETURN( ConstVar.IsConstructor ) |
+      ConstLitSym:  RETURN( ConstLit.IsConstructor )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsConstructor ;
+
+
+(*
+   PutConstructorFrom - sets the from type field in constructor,
+                        Sym, to, from.
+*)
+
+PROCEDURE PutConstructorFrom (Sym: CARDINAL; from: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstVarSym:  ConstVar.FromType := from ;
+                    ConstVar.UnresFromType := TRUE |
+      ConstLitSym:  ConstLit.FromType := from ;
+                    ConstLit.UnresFromType := TRUE
+
+      ELSE
+         InternalError ('expecting ConstVar or ConstLit symbol')
+      END
+   END ;
+   IncludeItemIntoList(UnresolvedConstructorType, Sym)
+END PutConstructorFrom ;
+
+
+(*
+   InitPacked - initialise packedInfo to FALSE and NulSym.
+*)
+
+PROCEDURE InitPacked (VAR packedInfo: PackedInfo) ;
+BEGIN
+   WITH packedInfo DO
+      IsPacked := FALSE ;
+      PackedEquiv := NulSym
+   END
+END InitPacked ;
+
+
+(*
+   doEquivalent - create a packed equivalent symbol for, sym, and return the
+                  new symbol.  It sets both fields in packedInfo to FALSE
+                  and the new symbol.
+*)
+
+PROCEDURE doEquivalent (VAR packedInfo: PackedInfo; sym: CARDINAL) : CARDINAL ;
+VAR
+   nSym: CARDINAL ;
+   pSym: PtrToSymbol ;
+BEGIN
+   NewSym(nSym) ;
+   pSym := GetPsym(nSym) ;
+   WITH pSym^ DO
+      SymbolType := EquivSym ;
+      WITH Equiv DO
+         nonPacked := sym ;
+         packedInfo.IsPacked := TRUE ;
+         packedInfo.PackedEquiv := NulSym
+      END
+   END ;
+   packedInfo.IsPacked := FALSE ;
+   packedInfo.PackedEquiv := nSym ;
+   RETURN( nSym )
+END doEquivalent ;
+
+
+(*
+   MakeEquivalent - return the equivalent packed symbol for, sym.
+*)
+
+PROCEDURE MakeEquivalent (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      EnumerationSym:  RETURN( doEquivalent(Enumeration.packedInfo, sym) ) |
+      SubrangeSym   :  RETURN( doEquivalent(Subrange.packedInfo, sym) ) |
+      TypeSym       :  RETURN( doEquivalent(Type.packedInfo, sym) ) |
+      SetSym        :  RETURN( doEquivalent(Set.packedInfo, sym) )
+
+      ELSE
+         InternalError ('expecting type, subrange or enumerated type symbol')
+      END
+   END
+END MakeEquivalent ;
+
+
+(*
+   GetEquivalent -
+*)
+
+PROCEDURE GetEquivalent (VAR packedInfo: PackedInfo; sym: CARDINAL) : CARDINAL ;
+BEGIN
+   WITH packedInfo DO
+      IF IsPacked
+      THEN
+         RETURN( sym )
+      ELSIF PackedEquiv=NulSym
+      THEN
+         PackedEquiv := MakeEquivalent(sym)
+      END ;
+      RETURN( PackedEquiv )
+   END
+END GetEquivalent ;
+
+
+(*
+   GetPackedEquivalent - returns the packed equivalent of type, sym.
+                         sym must be a type, subrange or enumerated type.
+*)
+
+PROCEDURE GetPackedEquivalent (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      EnumerationSym:  RETURN( GetEquivalent(Enumeration.packedInfo, sym) ) |
+      SubrangeSym   :  RETURN( GetEquivalent(Subrange.packedInfo, sym) ) |
+      TypeSym       :  RETURN( GetEquivalent(Type.packedInfo, sym) ) |
+      SetSym        :  RETURN( GetEquivalent(Set.packedInfo, sym) )
+
+      ELSE
+         InternalError ('expecting type, subrange or enumerated type symbol')
+      END
+   END
+END GetPackedEquivalent ;
+
+
+(*
+   GetNonPackedEquivalent - returns the equivalent non packed symbol associated with, sym.
+*)
+
+PROCEDURE GetNonPackedEquivalent (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      EquivSym:  RETURN( Equiv.nonPacked )
+
+      ELSE
+         InternalError ('expecting equivalent symbol')
+      END
+   END
+END GetNonPackedEquivalent ;
+
+
+(*
+   IsEquivalent - returns TRUE if, sym, is an equivalent symbol.
+*)
+
+PROCEDURE IsEquivalent (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      EquivSym:  RETURN( TRUE )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsEquivalent ;
+
+
+(*
+   MakeSubrange - makes a new symbol into a subrange type with
+                  name SubrangeName.
+*)
+
+PROCEDURE MakeSubrange (tok: CARDINAL; SubrangeName: Name) : CARDINAL ;
+VAR
+   pSym    : PtrToSymbol ;
+   sym, oaf: CARDINAL ;
+BEGIN
+   sym := HandleHiddenOrDeclare (tok, SubrangeName, oaf) ;
+   IF NOT IsError(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         SymbolType := SubrangeSym ;
+         WITH Subrange DO
+            name := SubrangeName ;
+            Low := NulSym ;             (* Index to a symbol determining *)
+                                        (* the lower bound of subrange.  *)
+                                        (* Points to a constant -        *)
+                                        (* possibly created by           *)
+                                        (* ConstExpression.              *)
+            High := NulSym ;            (* Index to a symbol determining *)
+                                        (* the lower bound of subrange.  *)
+                                        (* Points to a constant -        *)
+                                        (* possibly created by           *)
+                                        (* ConstExpression.              *)
+            Type := NulSym ;            (* Index to a type. Determines   *)
+                                        (* the type of subrange.         *)
+            InitPacked(packedInfo) ;    (* not packed and no equivalent  *)
+            InitTree(ConstLitTree) ;    (* constants of this type.       *)
+            Size := InitValue() ;       (* Size determines the type size *)
+            oafamily := oaf ;           (* The unbounded sym for this    *)
+            Scope := GetCurrentScope() ;      (* Which scope created it  *)
+            InitWhereDeclaredTok(tok, At)     (* Declared here           *)
+         END
+      END
+   END ;
+   ForeachOAFamily(oaf, doFillInOAFamily) ;
+   RETURN sym
+END MakeSubrange ;
+
+
+(*
+   MakeArray - makes an Array symbol with name ArrayName.
+*)
+
+PROCEDURE MakeArray (tok: CARDINAL; ArrayName: Name) : CARDINAL ;
+VAR
+   pSym    : PtrToSymbol ;
+   sym, oaf: CARDINAL ;
+BEGIN
+   sym := HandleHiddenOrDeclare (tok, ArrayName, oaf) ;
+   IF NOT IsError(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         SymbolType := ArraySym ;
+         WITH Array DO
+            name := ArrayName ;
+            Subscript := NulSym ;   (* Contains the array subscripts.      *)
+            Size := InitValue() ;   (* Size of array.                      *)
+            Offset := InitValue() ; (* Offset of array.                    *)
+            Type := NulSym ;        (* The Array Type. ARRAY OF Type.      *)
+	    Large := FALSE ;        (* is this array large?                *)
+            Align := NulSym ;       (* The alignment of this type.         *)
+            oafamily := oaf ;       (* The unbounded for this array        *)
+            Scope := GetCurrentScope() ;        (* Which scope created it  *)
+            InitWhereDeclaredTok(tok, At)   (* Declared here               *)
+         END
+      END
+   END ;
+   ForeachOAFamily(oaf, doFillInOAFamily) ;
+   RETURN( sym )
+END MakeArray ;
+
+
+(*
+   PutArrayLarge - indicates that this is a large array in which case
+                   the interface to gcc maps this array from 0..high-low,
+                   using an integer indice.
+*)
+
+PROCEDURE PutArrayLarge (array: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF NOT IsError(array)
+   THEN
+      Assert(IsArray(array)) ;
+      pSym := GetPsym(array) ;
+      WITH pSym^.Array DO
+         Large := TRUE
+      END
+   END
+END PutArrayLarge ;
+
+
+(*
+   IsArrayLarge - returns TRUE if we need to treat this as a large array.
+*)
+
+PROCEDURE IsArrayLarge (array: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(IsArray(array)) ;
+   pSym := GetPsym(array) ;
+   RETURN( pSym^.Array.Large )
+END IsArrayLarge ;
+
+
+(*
+   GetModule - Returns the Module symbol for the module with name, name.
+*)
+
+PROCEDURE GetModule (name: Name) : CARDINAL ;
+BEGIN
+   RETURN( GetSymKey(ModuleTree, name) )
+END GetModule ;
+
+
+(*
+   GetLowestType - Returns the lowest type in the type chain of
+                   symbol Sym.
+                   If NulSym is returned then we assume type unknown or
+                   you have reqested the type of a base type.
+*)
+
+PROCEDURE GetLowestType (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   type: CARDINAL ;
+BEGIN
+   Assert(Sym#NulSym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym              : type := Var.Type |
+      ConstLitSym         : type := ConstLit.Type |
+      ConstVarSym         : type := ConstVar.Type |
+      ConstStringSym      : type := NulSym |  (* No type for a string *)
+      TypeSym             : type := Type.Type |
+      RecordFieldSym      : type := RecordField.Type |
+      RecordSym           : type := NulSym |  (* No type for a record *)
+      EnumerationFieldSym : type := EnumerationField.Type |
+      EnumerationSym      : type := NulSym |  (* No type for enumeration *)
+      PointerSym          : type := Sym |     (* we don't go to Pointer.Type *)
+      ProcedureSym        : type := Procedure.ReturnType |
+      ProcTypeSym         : type := ProcType.ReturnType |
+      ParamSym            : type := Param.Type |
+      VarParamSym         : type := VarParam.Type |
+      SubrangeSym         : type := Subrange.Type |
+      ArraySym            : type := Array.Type |
+      SubscriptSym        : type := Subscript.Type |
+      SetSym              : type := Set.Type |
+      UnboundedSym        : type := Unbounded.Type |
+      UndefinedSym        : type := NulSym |
+      DummySym            : type := NulSym
+
+      ELSE
+         InternalError ('not implemented yet')
+      END
+   END ;
+   pSym := GetPsym(Sym) ;
+   IF (pSym^.SymbolType=TypeSym) AND (type=NulSym)
+   THEN
+      type := Sym             (* Base Type *)
+   ELSIF (type#NulSym) AND IsType(type) AND (GetAlignment(type)=NulSym)
+   THEN
+      type := GetLowestType(type)   (* Type def *)
+   END ;
+   RETURN( type )
+END GetLowestType ;
+
+
+(*
+   doGetType - subsiduary helper procedure function of GetDType, GetSType and GetLType.
+*)
+
+PROCEDURE doGetType (sym: CARDINAL; skipEquiv, skipAlign, skipHidden, skipBase: BOOLEAN) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   type: CARDINAL ;
+BEGIN
+   type := NulSym ;
+   Assert (sym # NulSym) ;
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      OAFamilySym         : type := OAFamily.SimpleType |
+      VarSym              : type := GetTypeOfVar(sym) |
+      ConstLitSym         : type := ConstLit.Type |
+      ConstVarSym         : type := ConstVar.Type |
+      ConstStringSym      : IF ConstString.Length=1
+                            THEN
+                               type := Char
+                            ELSE
+                               type := NulSym  (* No type for a string *)
+                            END |
+      TypeSym             : type := Type.Type |
+      RecordFieldSym      : type := RecordField.Type |
+      RecordSym           : type := NulSym |  (* No type for a record *)
+      VarientSym          : type := NulSym |  (* No type for a record *)
+      EnumerationFieldSym : type := EnumerationField.Type |
+      EnumerationSym      : type := NulSym |  (* No type for enumeration *)
+      PointerSym          : type := Pointer.Type |
+      ProcedureSym        : type := Procedure.ReturnType |
+      ProcTypeSym         : type := ProcType.ReturnType |
+      ParamSym            : type := Param.Type |
+      VarParamSym         : type := VarParam.Type |
+      SubrangeSym         : type := Subrange.Type |
+      ArraySym            : type := Array.Type |
+      SubscriptSym        : type := Subscript.Type |
+      SetSym              : type := Set.Type |
+      UnboundedSym        : type := Unbounded.Type |
+      UndefinedSym        : type := NulSym |
+      PartialUnboundedSym : type := PartialUnbounded.Type |
+      ObjectSym           : type := NulSym
+
+      ELSE
+         InternalError ('not implemented yet')
+      END
+   END ;
+   IF (type=NulSym) AND IsType(sym) AND (NOT skipBase)
+   THEN
+      RETURN sym             (* sym is a base type *)
+   ELSIF type#NulSym
+   THEN
+      IF IsType(type) AND skipEquiv
+      THEN
+         IF (NOT IsHiddenType(type)) OR skipHidden
+         THEN
+            IF (GetAlignment(type)=NulSym) OR skipAlign
+            THEN
+               RETURN doGetType (type, skipEquiv, skipAlign, skipHidden, skipBase)
+            END
+         END
+      END
+   END ;
+   RETURN type
+END doGetType ;
+
+
+(*
+   GetLType - get lowest type.  It returns the lowest type
+              of symbol, sym.  It skips over type equivalences.
+              It will not skip over base types.
+*)
+
+PROCEDURE GetLType (sym: CARDINAL) : CARDINAL ;
+BEGIN
+(*
+   Assert (doGetType (sym, TRUE, TRUE, TRUE, FALSE) = GetLowestType (sym)) ;
+*)
+   RETURN doGetType (sym, TRUE, TRUE, TRUE, FALSE)
+END GetLType ;
+
+
+(*
+   GetSType - get source type.  It returns the type closest
+              to the object.  It does not skip over type
+              equivalences.  It will skip over base types.
+*)
+
+PROCEDURE GetSType (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   Assert (doGetType (sym, FALSE, FALSE, FALSE, TRUE) = GetType (sym)) ;
+   RETURN doGetType (sym, FALSE, FALSE, FALSE, TRUE)
+END GetSType ;
+
+
+(*
+   GetDType - get gcc declared type.  It returns the type
+              of the object which is declared to GCC.
+              It does skip over type equivalences but only
+              if they do not contain a user alignment.
+              It does not skip over hidden types.
+              It does not skip over base types.
+*)
+
+PROCEDURE GetDType (sym: CARDINAL) : CARDINAL ;
+BEGIN
+(*
+   Assert (doGetType (sym, TRUE, FALSE, FALSE, FALSE) = SkipType(GetType(sym))) ;
+*)
+   RETURN doGetType (sym, TRUE, FALSE, FALSE, FALSE)
+END GetDType ;
+
+
+(*
+   GetTypeOfVar - returns the type of symbol, var.
+*)
+
+PROCEDURE GetTypeOfVar (var: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   high: CARDINAL ;
+BEGIN
+   pSym := GetPsym(var) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:  IF Var.IsTemp AND Var.IsComponentRef
+               THEN
+                  high := Indexing.HighIndice(Var.list) ;
+                  RETURN( GetType(GetFromIndex(Var.list, high)) )
+               ELSE
+                  RETURN( Var.Type )
+               END
+
+      ELSE
+         InternalError ('expecting a var symbol')
+      END
+   END
+END GetTypeOfVar ;
+
+
+(*
+   GetType - Returns the symbol that is the TYPE symbol to Sym.
+             If zero is returned then we assume type unknown.
+*)
+
+PROCEDURE GetType (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   type: CARDINAL ;
+BEGIN
+   Assert(Sym#NulSym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      OAFamilySym         : type := OAFamily.SimpleType |
+      VarSym              : type := GetTypeOfVar(Sym) |
+      ConstLitSym         : type := ConstLit.Type |
+      ConstVarSym         : type := ConstVar.Type |
+      ConstStringSym      : IF ConstString.Length=1
+                            THEN
+                               type := Char
+                            ELSE
+                               type := NulSym  (* No type for a string *)
+                            END |
+      TypeSym             : type := Type.Type |
+      RecordFieldSym      : type := RecordField.Type |
+      RecordSym           : type := NulSym |  (* No type for a record *)
+      VarientSym          : type := NulSym |  (* No type for a record *)
+      EnumerationFieldSym : type := EnumerationField.Type |
+      EnumerationSym      : type := NulSym |  (* No type for enumeration *)
+      PointerSym          : type := Pointer.Type |
+      ProcedureSym        : type := Procedure.ReturnType |
+      ProcTypeSym         : type := ProcType.ReturnType |
+      ParamSym            : type := Param.Type |
+      VarParamSym         : type := VarParam.Type |
+      SubrangeSym         : type := Subrange.Type |
+      ArraySym            : type := Array.Type |
+      SubscriptSym        : type := Subscript.Type |
+      SetSym              : type := Set.Type |
+      UnboundedSym        : type := Unbounded.Type |
+      UndefinedSym        : type := NulSym |
+      PartialUnboundedSym : type := PartialUnbounded.Type |
+      ObjectSym           : type := NulSym
+
+      ELSE
+         InternalError ('not implemented yet')
+      END
+   END ;
+   RETURN( type )
+END GetType ;
+
+
+(*
+   SkipType - if sym is a TYPE foo = bar
+              then call SkipType(bar)
+              else return sym
+
+              it does not skip over hidden types.
+*)
+
+PROCEDURE SkipType (Sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF (Sym#NulSym) AND IsType(Sym) AND
+      (NOT IsHiddenType(Sym)) AND (GetType(Sym)#NulSym)
+   THEN
+      RETURN( SkipType(GetType(Sym)) )
+   ELSE
+      RETURN( Sym )
+   END
+END SkipType ;
+
+
+(*
+   SkipTypeAndSubrange - if sym is a TYPE foo = bar OR
+                            sym is declared as a subrange of bar
+                         then call SkipTypeAndSubrange(bar)
+                         else return sym
+
+                         it does not skip over hidden types.
+*)
+
+PROCEDURE SkipTypeAndSubrange (Sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF (Sym#NulSym) AND (IsType(Sym) OR IsSubrange(Sym)) AND
+      (NOT IsHiddenType(Sym)) AND (GetType(Sym)#NulSym)
+   THEN
+      RETURN( SkipTypeAndSubrange(GetType(Sym)) )
+   ELSE
+      RETURN( Sym )
+   END
+END SkipTypeAndSubrange ;
+
+
+(*
+   IsHiddenType - returns TRUE if, Sym, is a Type and is also declared as a hidden type.
+*)
+
+PROCEDURE IsHiddenType (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      TypeSym:  RETURN( Type.IsHidden )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsHiddenType ;
+
+
+(*
+   GetConstLitType - returns the type of the constant of, name.
+                     All floating point constants have type LONGREAL.
+                     Character constants are type CHAR.
+                     Integer values are INTEGER, LONGINT or LONGCARD
+                     depending upon their value.
+*)
+
+PROCEDURE GetConstLitType (tok: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   loc          : location_t ;
+   s            : String ;
+   needsLong,
+   needsUnsigned: BOOLEAN ;
+BEGIN
+   s := InitStringCharStar (KeyToCharStar (name)) ;
+   IF char (s, -1) = 'C'
+   THEN
+      s := KillString (s) ;
+      RETURN Char
+   ELSE
+      IF Index (s, '.', 0) # -1   (* found a '.' in our constant *)
+      THEN
+         s := KillString (s) ;
+         RETURN RType
+      END ;
+      loc := TokenToLocation (tok) ;
+      CASE char (s, -1) OF
+
+      'H':  DetermineSizeOfConstant (loc, string (s), 16,
+                                     needsLong, needsUnsigned) |
+      'B':  DetermineSizeOfConstant (loc, string (s), 8,
+                                     needsLong, needsUnsigned) |
+      'A':  DetermineSizeOfConstant (loc, string (s), 2,
+                                     needsLong, needsUnsigned)
+
+      ELSE
+         DetermineSizeOfConstant (loc, string (s), 10,
+                                  needsLong, needsUnsigned)
+      END ;
+      s := KillString (s) ;
+(*
+      IF needsLong AND needsUnsigned
+      THEN
+         RETURN LongCard
+      ELSIF needsLong AND (NOT needsUnsigned)
+      THEN
+         RETURN LongInt
+      END ;
+*)
+      RETURN ZType
+   END
+END GetConstLitType ;
+
+
+(*
+   GetLocalSym - only searches the scope Sym for a symbol with name
+                 and returns the index to the symbol.
+*)
+
+PROCEDURE GetLocalSym (Sym: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   pSym    : PtrToSymbol ;
+   LocalSym: CARDINAL ;
+BEGIN
+   (*
+   WriteString('Attempting to retrieve symbol from ') ; WriteKey(GetSymName(Sym)) ;
+   WriteString(' local symbol table') ; WriteLn ;
+   *)
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      EnumerationSym : LocalSym := GetSymKey(Enumeration.LocalSymbols, name) |
+      RecordSym      : LocalSym := GetSymKey(Record.LocalSymbols, name) |
+      ProcedureSym   : LocalSym := GetSymKey(Procedure.LocalSymbols, name) |
+      ModuleSym      : LocalSym := GetSymKey(Module.LocalSymbols, name) |
+      DefImpSym      : LocalSym := GetSymKey(DefImp.LocalSymbols, name)
+
+      ELSE
+         InternalError ('symbol does not have a LocalSymbols field')
+      END
+   END ;
+   RETURN( LocalSym )
+END GetLocalSym ;
+
+
+(*
+   GetNthFromComponent -
+*)
+
+PROCEDURE GetNthFromComponent (Sym: CARDINAL; n: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:  IF IsComponent(Sym)
+               THEN
+                  IF InBounds(Var.list, n)
+                  THEN
+                     RETURN( GetFromIndex(Var.list, n) )
+                  ELSE
+                     RETURN( NulSym )
+                  END
+               ELSE
+                  InternalError ('cannot GetNth from this symbol')
+               END
+
+      ELSE
+         InternalError ('cannot GetNth from this symbol')
+      END
+   END
+END GetNthFromComponent ;
+
+
+(*
+   GetNth - returns the n th symbol in the list of father Sym.
+            Sym may be a Module, DefImp, Procedure or Record symbol.
+*)
+
+PROCEDURE GetNth (Sym: CARDINAL; n: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   i   : CARDINAL ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym       : i := GetItemFromList(Record.ListOfSons, n) |
+      VarientSym      : i := GetItemFromList(Varient.ListOfSons, n) |
+      VarientFieldSym : i := GetItemFromList(VarientField.ListOfSons, n) |
+      ProcedureSym    : i := GetItemFromList(Procedure.ListOfVars, n) |
+      DefImpSym       : i := GetItemFromList(DefImp.ListOfVars, n) |
+      ModuleSym       : i := GetItemFromList(Module.ListOfVars, n) |
+      TupleSym        : i := GetFromIndex(Tuple.list, n) |
+      VarSym          : i := GetNthFromComponent(Sym, n)
+
+      ELSE
+         InternalError ('cannot GetNth from this symbol')
+      END
+   END ;
+   RETURN( i )
+END GetNth ;
+
+
+(*
+   GetNthParam - returns the n th parameter of a procedure Sym.
+*)
+
+PROCEDURE GetNthParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   i   : CARDINAL ;
+BEGIN
+   IF ParamNo=0
+   THEN
+      (* Demands the return type of the function *)
+      i := GetType(Sym)
+   ELSE
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ProcedureSym: i := GetItemFromList(Procedure.ListOfParam, ParamNo) |
+         ProcTypeSym : i := GetItemFromList(ProcType.ListOfParam, ParamNo)
+
+         ELSE
+            InternalError ('expecting ProcedureSym or ProcTypeSym')
+         END
+      END
+   END ;
+   RETURN( i )
+END GetNthParam ;
+
+
+(*
+   The Following procedures fill in the symbol table with the
+   symbol entities.
+*)
+
+(*
+   PutVar - gives the VarSym symbol Sym a type Type.
+*)
+
+PROCEDURE PutVar (Sym: CARDINAL; VarType: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym     : Var.Type := VarType |
+      ConstVarSym: ConstVar.Type := VarType
+
+      ELSE
+         InternalError ('expecting VarSym or ConstVarSym')
+      END
+   END
+END PutVar ;
+
+
+(*
+   PutLeftValueFrontBackType - gives the variable symbol a front and backend type.
+                               The variable must be a LeftValue.
+*)
+
+PROCEDURE PutLeftValueFrontBackType (Sym: CARDINAL; FrontType, BackType: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(GetMode(Sym)=LeftValue) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym : Var.Type := FrontType ;
+               Var.BackType := BackType ;
+               PushSize(Address) ;
+               PopInto(Var.Size)
+
+      ELSE
+         InternalError ('expecting VarSym')
+      END
+   END
+END PutLeftValueFrontBackType ;
+
+
+(*
+   GetVarBackEndType - returns the back end type if specified.
+*)
+
+PROCEDURE GetVarBackEndType (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(Sym#NulSym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: RETURN( Var.BackType )
+
+      ELSE
+         RETURN( NulSym )
+      END
+   END
+END GetVarBackEndType ;
+
+
+(*
+   PutVarPointerCheck - marks variable, sym, as requiring (or not
+                        depending upon the, value), a NIL pointer check
+                        when this symbol is dereferenced.
+*)
+
+PROCEDURE PutVarPointerCheck (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsVar(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^.Var DO
+         IsPointerCheck := value
+      END
+   END
+END PutVarPointerCheck ;
+
+
+(*
+   GetVarPointerCheck - returns TRUE if this symbol is a variable and
+                        has been marked as needing a pointer via NIL check.
+*)
+
+PROCEDURE GetVarPointerCheck (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsVar(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^.Var DO
+         RETURN( IsPointerCheck )
+      END
+   END
+END GetVarPointerCheck ;
+
+
+(*
+   PutVarWritten - marks variable, sym, as being written to (or not
+                   depending upon the, value).
+*)
+
+PROCEDURE PutVarWritten (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsVar(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^.Var DO
+         IsWritten := value
+      END
+   END
+END PutVarWritten ;
+
+
+(*
+   GetVarWritten - returns TRUE if this symbol is a variable and
+                   has been marked as being written.
+*)
+
+PROCEDURE GetVarWritten (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: RETURN( Var.IsWritten )
+
+      ELSE
+         InternalError ('expecting VarSym')
+      END
+   END
+END GetVarWritten ;
+
+
+(*
+   PutVarConst - sets the IsConst field to value indicating the variable is read only.
+*)
+
+PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsVar (sym)
+   THEN
+      pSym := GetPsym (sym) ;
+      pSym^.Var.IsConst := value
+   END
+END PutVarConst ;
+
+
+(*
+   IsVarConst - returns the IsConst field indicating the variable is read only.
+*)
+
+PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: RETURN( Var.IsConst )
+
+      ELSE
+         InternalError ('expecting VarSym')
+      END
+   END
+END IsVarConst ;
+
+
+(*
+   PutConst - gives the constant symbol Sym a type ConstType.
+*)
+
+PROCEDURE PutConst (Sym: CARDINAL; ConstType: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstVarSym: ConstVar.Type := ConstType
+
+      ELSE
+         InternalError ('expecting ConstVarSym')
+      END
+   END
+END PutConst ;
+
+
+(*
+   PutFieldRecord - places a field, FieldName and FieldType into a record, Sym.
+                    VarSym is a optional varient symbol which can be returned
+                    by a call to GetVarient(fieldsymbol).  The created field
+                    is returned.
+*)
+
+PROCEDURE PutFieldRecord (Sym: CARDINAL;
+                          FieldName: Name; FieldType: CARDINAL;
+                          VarSym: CARDINAL) : CARDINAL ;
+VAR
+   oSym,
+   pSym  : PtrToSymbol ;
+   esym,
+   ParSym,
+   SonSym: CARDINAL ;
+BEGIN
+   NewSym(SonSym) ; (* Cannot be used before declared since use occurs *)
+                    (* in pass 3 and it will be declared in pass 2.    *)
+   (* Fill in the SonSym and connect it to its brothers (if any) and   *)
+   (* ensure that it is connected its parent.                          *)
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym       : WITH Record DO
+                           PutItemIntoList(ListOfSons, SonSym) ;
+                           Assert(IsItemInList(Record.ListOfSons, SonSym)) ;
+(*
+                           n := NoOfItemsInList(ListOfSons) ;
+                           printf3('record %d no of fields in ListOfSons = %d, field %d\n', Sym, n, SonSym) ;
+*)
+                           (* Ensure that the Field is in the Parents Local Symbols *)
+                           IF FieldName#NulName
+                           THEN
+                              IF GetSymKey(LocalSymbols, FieldName)=NulKey
+                              THEN
+                                 PutSymKey(LocalSymbols, FieldName, SonSym)
+                              ELSE
+                                 esym := GetSymKey(LocalSymbols, FieldName) ;
+                                 MetaErrors1('field record {%1Dad} has already been declared',
+                                             'field record duplicate', esym)
+                              END
+                           END
+                        END ;
+                        CheckRecordConsistency(Sym) |
+      VarientFieldSym : WITH VarientField DO
+                           PutItemIntoList(ListOfSons, SonSym) ;
+                           ParSym := GetRecord(Parent)
+                        END ;
+                        oSym := GetPsym(ParSym) ;
+                        Assert(oSym^.SymbolType=RecordSym) ;
+                        IF FieldName#NulName
+                        THEN
+                           oSym := GetPsym(ParSym) ;
+                           PutSymKey(oSym^.Record.LocalSymbols, FieldName, SonSym)
+                        END
+
+      ELSE
+         InternalError ('expecting Record symbol')
+      END
+   END ;
+   (* Fill in SonSym *)
+   oSym := GetPsym(SonSym) ;
+   WITH oSym^ DO
+      SymbolType := RecordFieldSym ;
+      WITH RecordField DO
+         Type := FieldType ;
+         name := FieldName ;
+         Tag := FALSE ;
+         Parent := Sym ;
+         Varient := VarSym ;
+         Align := NulSym ;
+         Used := TRUE ;
+         DeclPacked := FALSE ;     (* not known as packed (yet). *)
+         DeclResolved := FALSE ;
+         Scope := GetScope(Sym) ;
+         Size := InitValue() ;
+         Offset := InitValue() ;
+         InitWhereDeclared(At)
+      END
+   END ;
+   RETURN( SonSym )
+END PutFieldRecord ;
+
+
+(*
+   MakeFieldVarient - returns a FieldVarient symbol which has been
+                      assigned to the Varient symbol, Sym.
+*)
+
+PROCEDURE MakeFieldVarient (n: Name; Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym  : PtrToSymbol ;
+   SonSym: CARDINAL ;
+BEGIN
+   NewSym(SonSym) ;
+(*
+   IF NoOfItemsInList(FreeFVarientList)=0
+   THEN
+      NewSym(SonSym)
+   ELSE
+      SonSym := GetItemFromList(FreeFVarientList, 1) ;
+      RemoveItemFromList(FreeFVarientList, SonSym)
+   END ;
+*)
+   (* Fill in Sym *)
+   pSym := GetPsym(SonSym) ;
+   WITH pSym^ DO
+      SymbolType := VarientFieldSym ;
+      WITH VarientField DO
+         name := n ;
+         InitList(ListOfSons) ;
+         Parent := GetRecord(Sym) ;
+         Varient := NulSym ;
+         Size := InitValue() ;
+         Offset := InitValue() ;
+         DeclPacked := FALSE ;
+         DeclResolved := FALSE ;
+         Scope := GetCurrentScope() ;
+         InitWhereDeclared(At)
+      END
+   END ;
+   RETURN( SonSym )
+END MakeFieldVarient ;
+
+
+(*
+   PutFieldVarient - places the field varient, Field, as a brother to, the
+                     varient symbol, sym, and also tells Field that its varient
+                     parent is Sym.
+*)
+
+PROCEDURE PutFieldVarient (Field, Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(IsVarient(Sym)) ;
+   Assert(IsFieldVarient(Field)) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarientSym : IncludeItemIntoList(Varient.ListOfSons, Field)
+
+      ELSE
+         InternalError ('expecting Varient symbol')
+      END
+   END ;
+   pSym := GetPsym(Field) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarientFieldSym : VarientField.Varient := Sym
+
+      ELSE
+         InternalError ('expecting VarientField symbol')
+      END
+   END ;
+   (* PutItemIntoList(UsedFVarientList, Field) *)
+END PutFieldVarient ;
+
+
+(*
+   GetVarient - returns the varient symbol associated with the
+                record or varient field symbol, Field.
+*)
+
+PROCEDURE GetVarient (Field: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Field) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarientFieldSym : RETURN( VarientField.Varient ) |
+      RecordFieldSym  : RETURN( RecordField.Varient ) |
+      VarientSym      : RETURN( Varient.Varient )
+
+      ELSE
+         RETURN( NulSym )
+      END
+   END
+END GetVarient ;
+
+
+(*
+   EnsureOrder - providing that both symbols, a, and, b, exist in
+                 list, l.  Ensure that, b, is placed after a.
+*)
+
+PROCEDURE EnsureOrder (l: List; a, b: CARDINAL) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   n := NoOfItemsInList(l) ;
+   IF IsItemInList(l, a) AND IsItemInList(l, b)
+   THEN
+      RemoveItemFromList(l, b) ;
+      IncludeItemIntoList(l, b)
+   END ;
+   Assert(n=NoOfItemsInList(l))
+END EnsureOrder ;
+
+
+VAR
+   recordConsist: CARDINAL ;   (* is used by CheckRecordConsistency and friends.  *)
+
+
+(*
+   DumpSons -
+*)
+
+PROCEDURE DumpSons (sym: CARDINAL) ;
+VAR
+   pSym   : PtrToSymbol ;
+   f, n, i: CARDINAL ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym:  n := NoOfItemsInList(Record.ListOfSons) ;
+                  i := 1 ;
+                  WHILE i<=n DO
+                     f := GetItemFromList(Record.ListOfSons, i) ;
+                     printf3('record %d field %d is %d\n', sym, i, f) ;
+                     INC(i)
+                  END
+
+      ELSE
+         InternalError ('expecting record symbol')
+      END
+   END
+END DumpSons ;
+
+
+
+(*
+   CheckListOfSons - checks to see that sym, is present in, recordConsist, ListOfSons.
+*)
+
+PROCEDURE CheckListOfSons (sym: WORD) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(recordConsist) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym:  IF NOT IsItemInList(Record.ListOfSons, sym)
+                  THEN
+                     DumpSons(recordConsist) ;
+                     MetaError1('internal error:  expecting {%1ad} to exist in record ListOfSons', sym)
+                  END
+
+      ELSE
+         InternalError ('expecting record symbol')
+      END
+   END
+END CheckListOfSons ;
+
+
+(*
+   CheckRecordConsistency -
+*)
+
+PROCEDURE CheckRecordConsistency (sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   RETURN ;
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym:  recordConsist := sym ;
+                  WITH Record DO
+                     ForeachNodeDo(LocalSymbols, CheckListOfSons)
+                  END |
+
+      ELSE
+         InternalError ('record symbol expected')
+      END
+   END
+END CheckRecordConsistency ;
+
+
+(*
+   IsEmptyFieldVarient - returns TRUE if the field variant has
+                         no fields.  This will occur then the
+                         compiler constructs 'else end' variants.
+*)
+
+PROCEDURE IsEmptyFieldVarient (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarientFieldSym:  RETURN( NoOfItemsInList(VarientField.ListOfSons)=0 )
+
+      ELSE
+         InternalError ('varient field symbol expected')
+      END
+   END
+END IsEmptyFieldVarient ;
+
+
+(*
+   IsRecordFieldAVarientTag - returns TRUE if record field, sym, is
+                              a varient tag.
+*)
+
+PROCEDURE IsRecordFieldAVarientTag (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsRecordField(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      RETURN( pSym^.RecordField.Tag )
+   ELSE
+      InternalError ('record field symbol expected')
+   END
+END IsRecordFieldAVarientTag ;
+
+
+(*
+   PutVarientTag - places, Tag, into varient, Sym.
+*)
+
+PROCEDURE PutVarientTag (Sym, Tag: CARDINAL) ;
+VAR
+   pSym  : PtrToSymbol ;
+   parent: CARDINAL ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarientSym:  Varient.tag := Tag
+
+      ELSE
+         InternalError ('varient symbol expected')
+      END
+   END ;
+   (* now ensure that if Tag is a RecordField then it must be
+      placed before the varient symbol in its parent ListOfSons.
+      This allows M2GCCDeclare to declare record fields in order
+      and preserve the order of fields.  Otherwise it will add the
+      tag field after the C union. *)
+   IF IsRecordField(Tag)
+   THEN
+      pSym := GetPsym(Tag) ;
+      pSym^.RecordField.Tag := TRUE ;
+      parent := GetParent(Sym) ;
+      pSym := GetPsym(parent) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ErrorSym: |
+         VarientSym     : EnsureOrder(Varient.ListOfSons, Tag, Sym) |
+         VarientFieldSym: EnsureOrder(VarientField.ListOfSons, Tag, Sym) |
+         RecordSym      : EnsureOrder(Record.ListOfSons, Tag, Sym) ;
+                          CheckRecordConsistency(parent)
+
+         ELSE
+            InternalError ('not expecting this symbol type')
+         END
+      END
+   END
+END PutVarientTag ;
+
+
+(*
+   GetVarientTag - returns the varient tag from, Sym.
+*)
+
+PROCEDURE GetVarientTag (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarientSym:  RETURN( Varient.tag )
+
+      ELSE
+         InternalError ('varient symbol expected')
+      END
+   END
+END GetVarientTag ;
+
+
+(*
+   IsFieldVarient - returns true if the symbol, Sym, is a
+                    varient field.
+*)
+
+PROCEDURE IsFieldVarient (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=VarientFieldSym )
+END IsFieldVarient ;
+
+
+(*
+   IsFieldEnumeration - returns true if the symbol, Sym, is an
+                        enumeration field.
+*)
+
+PROCEDURE IsFieldEnumeration (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=EnumerationFieldSym )
+END IsFieldEnumeration ;
+
+
+(*
+   IsVarient - returns true if the symbol, Sym, is a
+               varient symbol.
+*)
+
+PROCEDURE IsVarient (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=VarientSym )
+END IsVarient ;
+
+
+(*
+   PutUnused - sets, sym, as unused.  This is a gm2 pragma.
+*)
+
+PROCEDURE PutUnused (sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordFieldSym:  RecordField.Used := FALSE
+
+      ELSE
+         MetaError1("cannot use pragma 'unused' on symbol {%1ad}", sym)
+      END
+   END
+END PutUnused ;
+
+
+(*
+   IsUnused - returns TRUE if the symbol was declared as unused with a
+              gm2 pragma.
+*)
+
+PROCEDURE IsUnused (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordFieldSym:  RETURN( NOT RecordField.Used )
+
+      ELSE
+         InternalError ('expecting a record field symbol')
+      END
+   END
+END IsUnused ;
+
+
+(*
+   PutFieldEnumeration - places a field into the enumeration type
+                         Sym. The field has a name FieldName and a
+                         value FieldVal.
+*)
+
+PROCEDURE PutFieldEnumeration (tok: CARDINAL; Sym: CARDINAL; FieldName: Name) ;
+VAR
+   oSym,
+   pSym : PtrToSymbol ;
+   s    : String ;
+   Field: CARDINAL ;
+BEGIN
+   Field := CheckForHiddenType(FieldName) ;
+   IF Field=NulSym
+   THEN
+      Field := DeclareSym (tok, FieldName)
+   END ;
+   IF NOT IsError(Field)
+   THEN
+      pSym := GetPsym(Field) ;
+      WITH pSym^ DO
+         SymbolType := EnumerationFieldSym ;
+         WITH EnumerationField DO
+            name := FieldName ;  (* Index into name array, name *)
+                                 (* of type.                    *)
+            oSym := GetPsym(Sym) ;
+            PushCard(oSym^.Enumeration.NoOfElements) ;
+            Value := InitValue() ;
+            PopInto(Value) ;
+            Type := Sym ;
+            Scope := GetCurrentScope() ;
+            InitWhereDeclaredTok (tok, At)  (* Declared here *)
+         END
+      END ;
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         EnumerationSym: WITH Enumeration DO
+                            INC(NoOfElements) ;
+                            IF GetSymKey(LocalSymbols, FieldName)#NulSym
+                            THEN
+                               s := Mark(InitStringCharStar(KeyToCharStar(FieldName))) ;
+                               AlreadyDeclaredError(Sprintf1(Mark(InitString('enumeration field (%s) is already declared elsewhere, use a different name or remove the declaration')), s),
+                                                    FieldName,
+                                                    GetDeclaredMod(GetSymKey(LocalSymbols, FieldName)))
+                            ELSE
+                               PutSymKey(LocalSymbols, FieldName, Field)
+                            END
+                         END
+
+         ELSE
+            InternalError ('expecting Sym=Enumeration')
+         END
+      END
+   END
+END PutFieldEnumeration ;
+
+
+(*
+   PutType - gives a type symbol Sym type TypeSymbol.
+*)
+
+PROCEDURE PutType (Sym: CARDINAL; TypeSymbol: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF TypeSymbol=Sym
+   THEN
+      InternalError ('not expecting a type to be declared as itself')
+   END ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      TypeSym : Type.Type := TypeSymbol
+
+      ELSE
+         InternalError ('expecting a Type symbol')
+      END
+   END
+END PutType ;
+
+
+(*
+   IsDefImp - returns true is the Sym is a DefImp symbol.
+              Definition/Implementation module symbol.
+*)
+
+PROCEDURE IsDefImp (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=DefImpSym )
+END IsDefImp ;
+
+
+(*
+   IsModule - returns true is the Sym is a Module symbol.
+              Program module symbol.
+*)
+
+PROCEDURE IsModule (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=ModuleSym )
+END IsModule ;
+
+
+(*
+   IsInnerModule - returns true if the symbol, Sym, is an inner module.
+*)
+
+PROCEDURE IsInnerModule (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsModule(Sym)
+   THEN
+      RETURN( GetScope(Sym)#NulSym )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsInnerModule ;
+
+
+(*
+   GetSymName - returns the symbol name.
+*)
+
+PROCEDURE GetSymName (Sym: CARDINAL) : Name ;
+VAR
+   pSym: PtrToSymbol ;
+   n   : Name ;
+BEGIN
+   IF Sym=NulSym
+   THEN
+      n := NulKey
+   ELSE
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ErrorSym            : n := Error.name |
+         ObjectSym           : n := Object.name |
+         DefImpSym           : n := DefImp.name |
+         ModuleSym           : n := Module.name |
+         TypeSym             : n := Type.name |
+         VarSym              : n := Var.name |
+         ConstLitSym         : n := ConstLit.name |
+         ConstVarSym         : n := ConstVar.name |
+         ConstStringSym      : n := ConstString.name |
+         EnumerationSym      : n := Enumeration.name |
+         EnumerationFieldSym : n := EnumerationField.name |
+         UndefinedSym        : n := Undefined.name |
+         ProcedureSym        : n := Procedure.name |
+         ProcTypeSym         : n := ProcType.name |
+         RecordFieldSym      : n := RecordField.name |
+         RecordSym           : n := Record.name |
+         VarientSym          : n := NulName |
+         VarientFieldSym     : n := VarientField.name |
+         VarParamSym         : n := VarParam.name |
+         ParamSym            : n := Param.name |
+         PointerSym          : n := Pointer.name |
+         ArraySym            : n := Array.name |
+         UnboundedSym        : n := NulName |
+         SubrangeSym         : n := Subrange.name |
+      	 SetSym              : n := Set.name |
+         SubscriptSym        : n := NulName |
+         DummySym            : n := NulName |
+         PartialUnboundedSym : n := GetSymName(PartialUnbounded.Type) |
+         TupleSym            : n := NulName |
+         GnuAsmSym           : n := NulName |
+         InterfaceSym        : n := NulName
+
+         ELSE
+            InternalError ('unexpected symbol type')
+         END
+      END
+   END ;
+   RETURN( n )
+END GetSymName ;
+
+
+(*
+   PutConstVarTemporary - indicates that constant, sym, is a temporary.
+*)
+
+PROCEDURE PutConstVarTemporary (sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstVarSym:  ConstVar.IsTemp := TRUE
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END
+END PutConstVarTemporary ;
+
+
+(*
+   buildTemporary - builds the temporary filling in componentRef, record and sets mode.
+*)
+
+PROCEDURE buildTemporary (tok: CARDINAL;
+                          Mode: ModeOfAddr; componentRef: BOOLEAN; record: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   s   : String ;
+   Sym : CARDINAL ;
+BEGIN
+   INC(TemporaryNo) ;
+   (* Make the name *)
+   s := Sprintf1(Mark(InitString('_T%d')), TemporaryNo) ;
+   IF Mode=ImmediateValue
+   THEN
+      Sym := MakeConstVar(tok, makekey(string(s))) ;
+      PutConstVarTemporary(Sym)
+   ELSE
+      Sym := MakeVar(tok, makekey(string(s))) ;
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         VarSym : Var.AddrMode := Mode ;
+                  Var.IsComponentRef := componentRef ;
+                  Var.IsTemp := TRUE ;       (* Variable is a temporary var *)
+                  IF componentRef
+                  THEN
+                     Var.list := Indexing.InitIndex(1) ;
+                     PutIntoIndex(Var.list, 1, record)
+                  END ;
+                  InitWhereDeclaredTok(tok, Var.At) ;    (* Declared here             *)
+                  InitWhereFirstUsedTok(tok, Var.At) ;   (* Where symbol first used.  *)
+
+         ELSE
+            InternalError ('expecting a Var symbol')
+         END
+      END
+   END ;
+   s := KillString(s) ;
+   RETURN Sym
+END buildTemporary ;
+
+
+(*
+   MakeComponentRef - use, sym, to reference, field, sym is returned.
+*)
+
+PROCEDURE MakeComponentRef (sym: CARDINAL; field: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   high: CARDINAL ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:  IF NOT Var.IsTemp
+               THEN
+                  InternalError ('variable must be a temporary')
+               ELSIF Var.IsComponentRef
+               THEN
+                  high := Indexing.HighIndice (Var.list) ;
+                  PutIntoIndex (Var.list, high+1, field)
+               ELSE
+                  InternalError ('temporary is not a component reference')
+               END
+
+      ELSE
+         InternalError ('expecting a variable symbol')
+      END
+   END ;
+   RETURN( sym )
+END MakeComponentRef ;
+
+
+(*
+   MakeComponentRecord - make a temporary which will be used to reference and field
+                         (or sub field) of record.
+*)
+
+PROCEDURE MakeComponentRecord (tok: CARDINAL; Mode: ModeOfAddr; record: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN buildTemporary (tok, Mode, TRUE, record)
+END MakeComponentRecord ;
+
+
+(*
+   IsComponent - returns TRUE if symbol, sym, is a temporary and a component
+                 reference.
+*)
+
+PROCEDURE IsComponent (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym:   RETURN( Var.IsComponentRef )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsComponent ;
+
+
+(*
+   MakeTemporary - Makes a new temporary variable at the highest real scope.
+                   The addressing mode of the temporary is set to NoValue.
+*)
+
+PROCEDURE MakeTemporary (tok: CARDINAL; Mode: ModeOfAddr) : CARDINAL ;
+BEGIN
+   RETURN buildTemporary (tok, Mode, FALSE, NulSym)
+END MakeTemporary ;
+
+
+(*
+   MakeTemporaryFromExpressions - makes a new temporary variable at the
+                                  highest real scope.  The addressing
+                                  mode of the temporary is set and the
+                                  type is determined by expressions,
+                                  e1 and e2.
+*)
+
+PROCEDURE MakeTemporaryFromExpressions (tok: CARDINAL;
+                                        e1, e2: CARDINAL;
+                                        mode: ModeOfAddr) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   s   : String ;
+   t,
+   Sym : CARDINAL ;
+BEGIN
+   INC(TemporaryNo) ;
+   (* Make the name *)
+   s := Sprintf1(Mark(InitString('_T%d')), TemporaryNo) ;
+   IF mode=ImmediateValue
+   THEN
+      Sym := MakeConstVar(tok, makekey(string(s))) ;
+      IF IsConstructor(e1)
+      THEN
+         PutConstructor(Sym) ;
+         PutConstructorFrom(Sym, e1)
+      ELSIF IsConstructor(e2)
+      THEN
+         PutConstructor(Sym) ;
+         PutConstructorFrom(Sym, e2)
+      ELSE
+         PutVar(Sym, MixTypes(GetType(e1), GetType(e2), tok))
+      END ;
+      PutConstVarTemporary(Sym)
+   ELSE
+      Sym := MakeVar(tok, makekey(string(s))) ;
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         VarSym : Var.AddrMode := mode ;
+                  Var.IsComponentRef := FALSE ;
+                  Var.IsTemp := TRUE ;       (* Variable is a temporary var *)
+                  InitWhereDeclaredTok(tok, Var.At)
+                                             (* Declared here               *)
+
+         ELSE
+            InternalError ('expecting a Var symbol')
+         END
+      END ;
+      t := MixTypes(GetType(e1), GetType(e2), tok) ;
+      IF t#NulSym
+      THEN
+         Assert(NOT IsConstructor(t)) ;
+         PutVar(Sym, t)
+      END
+   END ;
+   s := KillString(s) ;
+   RETURN( Sym )
+END MakeTemporaryFromExpressions ;
+
+
+(*
+   MakeTemporaryFromExpression - makes a new temporary variable at the
+                                 highest real scope.  The addressing
+                                 mode of the temporary is set and the
+                                 type is determined by expressions, e.
+*)
+
+PROCEDURE MakeTemporaryFromExpression (tok: CARDINAL;
+                                       e: CARDINAL;
+                                       mode: ModeOfAddr) : CARDINAL ;
+BEGIN
+   RETURN MakeTemporaryFromExpressions (tok, e, e, mode)
+END MakeTemporaryFromExpression ;
+
+
+(*
+   PutMode - Puts the addressing mode, SymMode, into symbol Sym.
+             The mode may only be altered if the mode
+             is None.
+*)
+
+PROCEDURE PutMode (Sym: CARDINAL; SymMode: ModeOfAddr) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      VarSym  : Var.AddrMode := SymMode
+
+      ELSE
+         InternalError ('Expecting VarSym')
+      END
+   END
+END PutMode ;
+
+
+(*
+   GetMode - Returns the addressing mode of a symbol.
+*)
+
+PROCEDURE GetMode (Sym: CARDINAL) : ModeOfAddr ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym           : ErrorAbort0('') |
+      VarSym             : RETURN( Var.AddrMode ) |
+      ConstLitSym        : RETURN( ImmediateValue ) |
+      ConstVarSym        : RETURN( ImmediateValue ) |
+      ConstStringSym     : RETURN( ImmediateValue ) |
+      EnumerationFieldSym: RETURN( ImmediateValue ) |
+      ProcedureSym       : RETURN( ImmediateValue ) |
+      RecordFieldSym     : RETURN( ImmediateValue ) |
+      VarientFieldSym    : RETURN( ImmediateValue ) |
+      TypeSym            : RETURN( NoValue ) |
+      ArraySym           : RETURN( NoValue ) |
+      SubrangeSym        : RETURN( NoValue ) |
+      EnumerationSym     : RETURN( NoValue ) |
+      RecordSym          : RETURN( NoValue ) |
+      PointerSym         : RETURN( NoValue ) |
+      SetSym             : RETURN( NoValue ) |
+      ProcTypeSym        : RETURN( NoValue ) |
+      UnboundedSym       : RETURN( NoValue ) |
+      UndefinedSym       : RETURN( NoValue )
+
+      ELSE
+         InternalError ('not expecting this type')
+      END
+   END
+END GetMode ;
+
+
+(*
+   RenameSym - renames a symbol, Sym, with SymName.
+               It also checks the unknown tree for a symbol
+               with this new name. Must only be renamed in
+               the same scope of being declared.
+*)
+
+PROCEDURE RenameSym (Sym: CARDINAL; SymName: Name) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF GetSymName(Sym)=NulName
+   THEN
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ErrorSym            : ErrorAbort0('') |
+         TypeSym             : Type.name      := SymName |
+         VarSym              : Var.name       := SymName |
+         ConstLitSym         : ConstLit.name  := SymName |
+         ConstVarSym         : ConstVar.name  := SymName |
+         UndefinedSym        : Undefined.name := SymName |
+         RecordSym           : Record.name    := SymName |
+         PointerSym          : Pointer.name   := SymName
+
+         ELSE
+            InternalError ('not implemented yet')
+         END
+      END ;
+      AddSymToScope(Sym, SymName)
+   ELSE
+      InternalError ('old name of symbol must be nul')
+   END
+END RenameSym ;
+
+
+(*
+   IsUnknown - returns true is the symbol Sym is unknown.
+*)
+
+PROCEDURE IsUnknown (Sym: WORD) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal (Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN pSym^.SymbolType=UndefinedSym
+END IsUnknown ;
+
+
+(*
+   CheckLegal - determines whether the Sym is a legal symbol.
+*)
+
+PROCEDURE CheckLegal (Sym: CARDINAL) ;
+BEGIN
+   IF (Sym<1) OR (Sym>FinalSymbol())
+   THEN
+      InternalError ('illegal symbol')
+   END
+END CheckLegal ;
+
+
+(*
+   CheckForHiddenType - scans the NeedToBeImplemented tree providing
+                        that we are currently compiling an implementation
+                        module. If a symbol is found with TypeName
+                        then its Sym is returned.
+                        Otherwise NulSym is returned.
+                        CheckForHiddenType is called before any type is
+                        created, therefore the compiler allows hidden
+                        types to be implemented using any type.
+*)
+
+PROCEDURE CheckForHiddenType (TypeName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   Sym := NulSym ;
+   IF CompilingImplementationModule() AND
+      IsDefImp(CurrentModule) AND
+      IsHiddenTypeDeclared(CurrentModule) AND
+      (TypeName#NulName)
+   THEN
+      (* Check to see whether we are declaring a HiddenType. *)
+      pSym := GetPsym(CurrentModule) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         DefImpSym: Sym := GetSymKey(DefImp.NeedToBeImplemented, TypeName)
+
+         ELSE
+            InternalError ('expecting a DefImp symbol')
+         END
+      END
+   END ;
+   RETURN( Sym )
+END CheckForHiddenType ;
+
+
+(*
+   IsReallyPointer - returns TRUE is sym is a pointer, address or a
+                     type declared as a pointer or address.
+*)
+
+PROCEDURE IsReallyPointer (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsVar(Sym)
+   THEN
+      Sym := GetType(Sym)
+   END ;
+   Sym := SkipType(Sym) ;
+   RETURN( IsPointer(Sym) OR (Sym=Address) )
+END IsReallyPointer ;
+
+
+(*
+   SkipHiddenType - if sym is a TYPE foo = bar
+                    then call SkipType(bar)
+                    else return sym
+
+                    it does skip over hidden type.
+*)
+
+(*
+PROCEDURE SkipHiddenType (Sym: CARDINAL) : CARDINAL ;
+BEGIN
+   IF (Sym#NulSym) AND IsType(Sym) AND (GetType(Sym)#NulSym)
+   THEN
+      RETURN( SkipType(GetType(Sym)) )
+   ELSE
+      RETURN( Sym )
+   END
+END SkipHiddenType ;
+*)
+
+
+(*
+   IsHiddenReallyPointer - returns TRUE is sym is a pointer, address or a
+                           type declared as a pointer or address.
+*)
+
+PROCEDURE IsHiddenReallyPointer (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsVar (Sym)
+   THEN
+      Sym := GetType (Sym)
+   END ;
+   WHILE (Sym # NulSym) AND IsType (Sym) DO
+      Sym := SkipType (GetType (Sym))
+   END ;
+   RETURN (Sym # NulSym) AND (IsPointer (Sym) OR (Sym = Address))
+END IsHiddenReallyPointer ;
+
+
+(*
+   CheckHiddenTypeAreAddress - checks to see that any hidden types
+                               which we have declared are actually
+                               of type ADDRESS or map onto a POINTER type.
+*)
+
+PROCEDURE CheckHiddenTypeAreAddress ;
+VAR
+   name: Name ;
+   e   : Error ;
+   sym,
+   i, n: CARDINAL ;
+BEGIN
+   i := 1 ;
+   n := NoOfItemsInList(AddressTypes) ;
+   WHILE i<=n DO
+      sym := GetItemFromList(AddressTypes, i) ;
+      IF NOT IsHiddenReallyPointer(sym)
+      THEN
+         name := GetSymName(sym) ;
+         e := NewError(GetDeclaredDef(sym)) ;
+         ErrorFormat1(e, 'opaque type (%a) should be equivalent to a POINTER or an ADDRESS', name) ;
+         e := NewError(GetDeclaredMod(sym)) ;
+         ErrorFormat0(e, 'if you really need a non POINTER type use the -fextended-opaque switch')
+      END ;
+      INC(i)
+   END
+END CheckHiddenTypeAreAddress ;
+
+
+(*
+   GetLastMainScopeId - returns the, id, containing the last main scope.
+*)
+
+(*
+PROCEDURE GetLastMainScopeId (id: CARDINAL) : CARDINAL ;
+VAR
+   pCall: PtrToCallFrame ;
+   sym  : CARDINAL ;
+BEGIN
+   IF id>0
+   THEN
+      pCall := GetPcall(id) ;
+      sym := pCall^.Main ;
+      WHILE id>1 DO
+         DEC(id) ;
+         pCall := GetPcall(id) ;
+         IF sym#pCall^.Main
+         THEN
+            RETURN( id )
+         END
+      END
+   END ;
+   RETURN( 0 )
+END GetLastMainScopeId ;
+*)
+
+
+(*
+   GetDeclareSym - searches for a symbol with a name SymName in the
+                   current and previous scopes.
+                   If the symbol is found then it is returned
+                   else an unknown symbol is returned.
+                   This procedure assumes that SymName is being
+                   declared at this point and therefore it does
+                   not examine the base scope (for pervasive
+                   identifiers).
+*)
+
+PROCEDURE GetDeclareSym (tok: CARDINAL; SymName: Name) : CARDINAL ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   Sym := GetScopeSym (SymName, FALSE) ;  (* must not be allowed to fetch a symbol through a procedure scope *)
+   IF Sym=NulSym
+   THEN
+      Sym := GetSymFromUnknownTree (SymName) ;
+      IF Sym=NulSym
+      THEN
+         (* Make unknown *)
+         NewSym (Sym) ;
+         FillInUnknownFields (tok, Sym, SymName) ;
+         (* Add to unknown tree *)
+         AddSymToUnknownTree (ScopePtr, SymName, Sym)
+         (*
+           ; WriteKey(SymName) ; WriteString(' unknown demanded') ; WriteLn
+         *)
+      END
+   END ;
+   RETURN Sym
+END GetDeclareSym ;
+
+
+(*
+   RequestSym - searches for a symbol with a name SymName in the
+                current and previous scopes.
+                If the symbol is found then it is returned
+                else an unknown symbol is returned create at token
+                position, tok.
+                This procedure does search the base scope (for
+                pervasive identifiers).
+*)
+
+PROCEDURE RequestSym (tok: CARDINAL; SymName: Name) : CARDINAL ;
+VAR
+   Sym: CARDINAL ;
+BEGIN
+   (*
+      WriteString('RequestSym for: ') ; WriteKey(SymName) ; WriteLn ;
+   *)
+   Sym := GetSym (SymName) ;
+   IF Sym=NulSym
+   THEN
+      Sym := GetSymFromUnknownTree (SymName) ;
+      IF Sym=NulSym
+      THEN
+         (* Make unknown *)
+         NewSym (Sym) ;
+         FillInUnknownFields (tok, Sym, SymName) ;
+         (* Add to unknown tree *)
+         AddSymToUnknownTree (ScopePtr, SymName, Sym)
+         (*
+           ; WriteKey(SymName) ; WriteString(' unknown demanded') ; WriteLn
+         *)
+      END
+   END ;
+   RETURN( Sym )
+END RequestSym ;
+
+
+(*
+   PutImported - places a symbol, Sym, into the current main scope.
+*)
+
+PROCEDURE PutImported (Sym: CARDINAL) ;
+VAR
+   pSym  : PtrToSymbol ;
+   ModSym: CARDINAL ;
+   n     : Name ;
+BEGIN
+   (*
+      We have currently imported Sym, now place it into the current module.
+   *)
+   ModSym := GetCurrentModuleScope() ;
+   Assert(IsDefImp(ModSym) OR IsModule(ModSym)) ;
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: IF GetSymKey(Module.ImportTree, GetSymName(Sym))=Sym
+                 THEN
+                    IF Pedantic
+                    THEN
+                       n := GetSymName(Sym) ;
+                       WriteFormat1('symbol (%a) has already been imported', n)
+                    END
+                 ELSIF GetSymKey(Module.ImportTree, GetSymName(Sym))=NulKey
+                 THEN
+                    IF GetSymKey(Module.WhereImported, Sym)=NulKey
+                    THEN
+                       PutSymKey(Module.WhereImported, Sym, GetTokenNo())
+                    END ;
+                    PutSymKey(Module.ImportTree, GetSymName(Sym), Sym) ;
+                    AddSymToModuleScope(ModSym, Sym)
+                 ELSE
+                    n := GetSymName(Sym) ;
+                    WriteFormat1('name clash when trying to import (%a)', n)
+                 END |
+      DefImpSym: IF GetSymKey(DefImp.ImportTree, GetSymName(Sym))=Sym
+                 THEN
+                    IF Pedantic
+                    THEN
+                       n := GetSymName(Sym) ;
+                       WriteFormat1('symbol (%a) has already been imported', n)
+                    END
+                 ELSIF GetSymKey(DefImp.ImportTree, GetSymName(Sym))=NulKey
+                 THEN
+                    IF GetSymKey(DefImp.WhereImported, Sym)=NulKey
+                    THEN
+                       PutSymKey(DefImp.WhereImported, Sym, GetTokenNo())
+                    END ;
+                    PutSymKey(DefImp.ImportTree, GetSymName(Sym), Sym) ;
+                    AddSymToModuleScope(ModSym, Sym)
+                 ELSE
+                    n := GetSymName(Sym) ;
+                    WriteFormat1('name clash when trying to import (%a)', n)
+                 END
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END PutImported ;
+
+
+(*
+   PutIncluded - places a symbol, Sym, into the included list of the
+                 current module.
+                 Symbols that are placed in this list are indirectly declared
+                 by:
+
+                 IMPORT modulename ;
+
+                 modulename.identifier
+*)
+
+PROCEDURE PutIncluded (Sym: CARDINAL) ;
+VAR
+   pSym  : PtrToSymbol ;
+   ModSym: CARDINAL ;
+   n1, n2: Name ;
+BEGIN
+   (*
+      We have referenced Sym, via modulename.Sym
+      now place it into the current module include list.
+   *)
+   ModSym := GetCurrentModuleScope() ;
+   Assert(IsDefImp(ModSym) OR IsModule(ModSym)) ;
+   IF DebugUnknowns
+   THEN
+      n1 := GetSymName(Sym) ;
+      n2 := GetSymName(ModSym) ;
+      printf2('including %a into scope %a\n', n1, n2)
+   END ;
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: IncludeItemIntoList(Module.IncludeList, Sym) |
+      DefImpSym: IncludeItemIntoList(DefImp.IncludeList, Sym)
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END PutIncluded ;
+
+
+(*
+   PutExported - places a symbol, Sym into the next level out module.
+                 Sym is also placed in the ExportTree of the current inner
+                 module.
+*)
+
+PROCEDURE PutExported (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+(*
+   WriteString('PutExported') ; WriteLn ;
+*)
+   AddSymToModuleScope(GetLastModuleOrProcedureScope(), Sym) ;
+   pSym := GetPsym(GetCurrentModuleScope()) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: PutSymKey(Module.ExportTree, GetSymName(Sym), Sym) ;
+                 IF IsUnknown(Sym)
+                 THEN
+                    PutExportUndeclared(GetCurrentModuleScope(), Sym)
+                 END
+(*
+                 ; WriteKey(Module.name) ; WriteString(' exports ') ;
+                 ; WriteKey(GetSymName(Sym)) ; WriteLn ;
+*)
+
+      ELSE
+         InternalError ('expecting a Module symbol')
+      END
+   END
+END PutExported ;
+
+
+(*
+   PutExportQualified - places a symbol with the name, SymName,
+                        into the export tree of the
+                        Definition module being compiled.
+                        The symbol with name has been EXPORT QUALIFIED
+                        by the definition module and therefore any reference
+                        to this symbol in the code generation phase
+                        will be in the form _Module_Name.
+*)
+
+PROCEDURE PutExportQualified (tokenno: CARDINAL; SymName: Name) ;
+VAR
+   pSym  : PtrToSymbol ;
+   n     : Name ;
+   Sym,
+   ModSym: CARDINAL ;
+BEGIN
+   ModSym := GetCurrentModule () ;
+   Assert (IsDefImp (ModSym)) ;
+   Assert (CompilingDefinitionModule () OR
+           (GetSymName(ModSym) = MakeKey ('SYSTEM'))) ;
+(* printf2('module %a exporting %a\n', GetSymName(ModSym), SymName) ; *)
+(*
+   WriteString('1st MODULE ') ; WriteKey(GetSymName(ModSym)) ;
+   WriteString(' identifier ') ; WriteKey(SymName) ; WriteLn ;
+*)
+   pSym := GetPsym (ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    IF (GetSymKey (ExportQualifiedTree, SymName) # NulKey) AND
+                       (GetSymKey (ExportRequest, SymName) = NulKey)
+                    THEN
+                       n := GetSymName(ModSym) ;
+                       WriteFormat2('identifier (%a) has already been exported from MODULE %a',
+                                    SymName, n)
+                    ELSIF GetSymKey(ExportRequest, SymName)#NulKey
+                    THEN
+                       Sym := GetSymKey(ExportRequest, SymName) ;
+                       DelSymKey(ExportRequest, SymName) ;
+                       PutSymKey(ExportQualifiedTree, SymName, Sym) ;
+                       PutExportUndeclared (ModSym, Sym)
+                    ELSE
+                       Sym := GetDeclareSym(tokenno, SymName) ;
+                       PutSymKey(ExportQualifiedTree, SymName, Sym) ;
+                       PutExportUndeclared (ModSym, Sym)
+                    END
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutExportQualified ;
+
+
+(*
+   PutExportUnQualified - places a symbol with the name, SymName,
+                          into the export tree of the
+                          Definition module being compiled.
+                          The symbol with Name has been EXPORT UNQUALIFIED
+                          by the definition module and therefore any reference
+                          to this symbol in the code generation phase
+                          will be in the form _Name.
+*)
+
+PROCEDURE PutExportUnQualified (tokenno: CARDINAL; SymName: Name) ;
+VAR
+   pSym  : PtrToSymbol ;
+   n     : Name ;
+   Sym,
+   ModSym: CARDINAL ;
+BEGIN
+   ModSym := GetCurrentModule() ;
+   Assert(IsDefImp(ModSym)) ;
+   Assert(CompilingDefinitionModule() OR (GetSymName(ModSym)=MakeKey('SYSTEM'))) ;
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    IF (GetSymKey(ExportUnQualifiedTree, SymName)#NulKey) AND
+                       (GetSymKey(ExportRequest, SymName)=NulKey)
+                    THEN
+                       n := GetSymName(ModSym) ;
+                       WriteFormat2('identifier (%a) has already been exported from MODULE %a',
+                                    SymName, n)
+                    ELSIF GetSymKey(ExportRequest, SymName)#NulKey
+                    THEN
+                       Sym := GetSymKey(ExportRequest, SymName) ;
+                       DelSymKey(ExportRequest, SymName) ;
+                       PutSymKey(ExportUnQualifiedTree, SymName, Sym) ;
+                       PutExportUndeclared(ModSym, Sym)
+                    ELSE
+                       Sym := GetDeclareSym(tokenno, SymName) ;
+                       PutSymKey(ExportUnQualifiedTree, SymName, Sym) ;
+                       PutExportUndeclared(ModSym, Sym)
+                    END
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutExportUnQualified ;
+
+
+(*
+   GetExported - returns the symbol which has a name SymName,
+                 and is exported from the definition module ModSym.
+
+*)
+
+PROCEDURE GetExported (tokenno: CARDINAL;
+                       ModSym: CARDINAL;
+                       SymName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: Sym := RequestFromDefinition (tokenno, ModSym, SymName) |
+      ModuleSym: Sym := RequestFromModule (tokenno, ModSym, SymName)
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END ;
+   RETURN( Sym )
+END GetExported ;
+
+
+(*
+   RequestFromModule - returns a symbol from module ModSym with name, SymName.
+*)
+
+PROCEDURE RequestFromModule (tok: CARDINAL; ModSym: CARDINAL; SymName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    Sym := GetSymKey (LocalSymbols, SymName) ;
+                    IF Sym=NulSym
+                    THEN
+                       Sym := FetchUnknownFromDefImp (tok, ModSym, SymName)
+                    END
+                 END |
+
+      ModuleSym: WITH Module DO
+                    Sym := GetSymKey (LocalSymbols, SymName) ;
+                    IF Sym=NulSym
+                    THEN
+                       Sym := FetchUnknownFromModule (tok, ModSym, SymName)
+                    END
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END ;
+   RETURN( Sym )
+END RequestFromModule ;
+
+
+(*
+   RequestFromDefinition - returns a symbol from module ModSym with name,
+                           SymName.
+*)
+
+PROCEDURE RequestFromDefinition (tok: CARDINAL;
+                                 ModSym: CARDINAL; SymName: Name) : CARDINAL ;
+VAR
+   pSym       : PtrToSymbol ;
+   Sym        : CARDINAL ;
+   OldScopePtr: CARDINAL ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    Sym := GetSymKey (ExportQualifiedTree, SymName) ;
+                    IF Sym=NulSym
+                    THEN
+                       Sym := GetSymKey (ExportUnQualifiedTree, SymName) ;
+                       IF Sym=NulSym
+                       THEN
+                          Sym := GetSymKey (ExportRequest, SymName) ;
+                          IF Sym=NulSym
+                          THEN
+                             OldScopePtr := ScopePtr ;
+                             StartScope (ModSym) ;
+                             Sym := GetScopeSym (SymName, TRUE) ;
+                             EndScope ;
+                             Assert (OldScopePtr=ScopePtr) ;
+                             IF Sym=NulSym
+                             THEN
+                                Sym := FetchUnknownFromDefImp (tok, ModSym, SymName)
+                             ELSE
+                                IF IsFieldEnumeration (Sym)
+                                THEN
+                                   IF IsExported (ModSym, GetType (Sym))
+                                   THEN
+                                      RETURN( Sym )
+                                   END
+                                END
+                             END ;
+                             PutSymKey (ExportRequest, SymName, Sym)
+                          END
+                       END
+                    END
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END ;
+   RETURN( Sym )
+END RequestFromDefinition ;
+
+
+(*
+   PutIncludedByDefinition - places a module symbol, Sym, into the
+                             included list of the current definition module.
+*)
+
+PROCEDURE PutIncludedByDefinition (Sym: CARDINAL) ;
+VAR
+   pSym  : PtrToSymbol ;
+   ModSym: CARDINAL ;
+BEGIN
+   ModSym := GetCurrentModuleScope() ;
+   Assert(IsDefImp(ModSym)) ;
+   Assert(IsDefImp(Sym)) ;
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: IncludeItemIntoList(DefImp.DefIncludeList, Sym)
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutIncludedByDefinition ;
+
+
+(*
+   IsIncludedByDefinition - returns TRUE if definition module symbol, Sym, was included
+                            by ModSym's definition module.
+*)
+
+PROCEDURE IsIncludedByDefinition (ModSym, Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   Assert(IsDefImp(ModSym)) ;
+   Assert(IsDefImp(Sym)) ;
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: RETURN( IsItemInList(DefImp.DefIncludeList, Sym) )
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END IsIncludedByDefinition ;
+
+
+(*
+   GetWhereImported - returns the token number where this symbol
+                      was imported into the current module.
+*)
+
+PROCEDURE GetWhereImported (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(GetCurrentModuleScope()) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym:  RETURN( GetSymKey(DefImp.WhereImported, Sym) ) |
+      ModuleSym:  RETURN( GetSymKey(Module.WhereImported, Sym) )
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END GetWhereImported ;
+
+
+(*
+   DisplayName - displays the name.
+*)
+
+PROCEDURE DisplayName (sym: WORD) ;
+BEGIN
+   printf1('   %a', sym)
+END DisplayName ;
+
+
+(*
+   DisplaySymbol - displays the name of a symbol
+*)
+
+PROCEDURE DisplaySymbol (sym: WORD) ;
+VAR
+   s: String ;
+BEGIN
+   s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(sym)))) ;
+   printf2('   %s (%d)', s, sym)
+END DisplaySymbol ;
+
+
+(*
+   DisplayTrees - displays the SymbolTrees for Module symbol, ModSym.
+*)
+
+PROCEDURE DisplayTrees (ModSym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+   n   : Name ;
+BEGIN
+   n := GetSymName(ModSym) ;
+   printf1('Symbol trees for module/procedure: %a\n', n) ;
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    n := GetSymName(ModSym) ;
+                    printf1('%a  UndefinedTree', n) ;
+                    ForeachNodeDo(Unresolved, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  Local symbols', n) ;
+                    ForeachNodeDo(LocalSymbols, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ExportRequest', n) ;
+                    ForeachNodeDo(ExportRequest, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ExportQualified', n) ;
+                    ForeachNodeDo(ExportQualifiedTree, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ExportUnQualified', n) ;
+                    ForeachNodeDo(ExportUnQualifiedTree, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ExportUndeclared', n) ;
+                    ForeachNodeDo(ExportUndeclared, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  DeclaredObjects', n) ;
+                    ForeachNodeDo(NamedObjects, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ImportedObjects', n) ;
+                    ForeachNodeDo(NamedImports, DisplayName) ; printf0('\n')
+                 END |
+      ModuleSym: WITH Module DO
+                    n := GetSymName(ModSym) ;
+                    printf1('%a  UndefinedTree', n) ;
+                    ForeachNodeDo(Unresolved, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  Local symbols', n) ;
+                    ForeachNodeDo(LocalSymbols, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ImportTree', n) ;
+                    ForeachNodeDo(ImportTree, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ExportTree', n) ;
+                    ForeachNodeDo(ExportTree, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ExportUndeclared', n) ;
+                    ForeachNodeDo(ExportUndeclared, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  DeclaredObjects', n) ;
+                    ForeachNodeDo(NamedObjects, DisplaySymbol) ; printf0('\n') ;
+                    printf1('%a  ImportedObjects', n) ;
+                    ForeachNodeDo(NamedImports, DisplayName) ; printf0('\n')
+                 END |
+      ProcedureSym: WITH Procedure DO
+                       n := GetSymName(ModSym) ;
+                       printf1('%a  UndefinedTree', n) ;
+                       ForeachNodeDo(Unresolved, DisplaySymbol) ; printf0('\n') ;
+                       printf1('%a  Local symbols', n) ;
+                       ForeachNodeDo(LocalSymbols, DisplaySymbol) ; printf0('\n') ;
+                       printf1('%a  DeclaredObjects', n) ;
+                       ForeachNodeDo(NamedObjects, DisplayName) ; printf0('\n')
+                    END
+
+      ELSE
+         InternalError ('expecting DefImp symbol')
+      END
+   END
+END DisplayTrees ;
+
+
+(*
+   FetchUnknownFromModule - returns an Unknown symbol from module, ModSym.
+*)
+
+PROCEDURE FetchUnknownFromModule (tok: CARDINAL;
+                                  ModSym: CARDINAL;
+                                  SymName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   pSym := GetPsym (ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+         ModuleSym: WITH Module DO
+                       Sym := GetSymKey (Unresolved, SymName) ;
+                       IF Sym=NulSym
+                       THEN
+                          NewSym (Sym) ;
+                          FillInUnknownFields (tok, Sym, SymName) ;
+                          PutSymKey (Unresolved, SymName, Sym)
+                       END
+                    END
+      ELSE
+         InternalError ('expecting a Module symbol')
+      END
+   END ;
+   RETURN( Sym )
+END FetchUnknownFromModule ;
+
+
+(*
+   FetchUnknownFromDefImp - returns an Unknown symbol from module, ModSym.
+*)
+
+PROCEDURE FetchUnknownFromDefImp (tok: CARDINAL;
+                                  ModSym: CARDINAL;
+                                  SymName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   pSym := GetPsym (ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+         DefImpSym: WITH DefImp DO
+                       Sym := GetSymKey (Unresolved , SymName) ;
+                       IF Sym=NulSym
+                       THEN
+                          NewSym(Sym) ;
+                          FillInUnknownFields (tok, Sym, SymName) ;
+                          PutSymKey (Unresolved, SymName, Sym)
+                       END
+                    END
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END ;
+   RETURN( Sym )
+END FetchUnknownFromDefImp ;
+
+
+PROCEDURE FetchUnknownFrom (tok: CARDINAL;
+                            scope: CARDINAL;
+                            SymName: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   pSym := GetPsym(scope) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+         DefImpSym: WITH DefImp DO
+                       Sym := GetSymKey(Unresolved, SymName) ;
+                       IF Sym=NulSym
+                       THEN
+                          NewSym(Sym) ;
+                          FillInUnknownFields (tok, Sym, SymName) ;
+                          PutSymKey(Unresolved, SymName, Sym)
+                       END
+                    END |
+         ModuleSym: WITH Module DO
+                       Sym := GetSymKey(Unresolved, SymName) ;
+                       IF Sym=NulSym
+                       THEN
+                          NewSym(Sym) ;
+                          FillInUnknownFields (tok, Sym, SymName) ;
+                          PutSymKey(Unresolved, SymName, Sym)
+                       END
+                    END |
+         ProcedureSym: WITH Procedure DO
+                          Sym := GetSymKey(Unresolved, SymName) ;
+                          IF Sym=NulSym
+                          THEN
+                             NewSym(Sym) ;
+                             FillInUnknownFields (tok, Sym, SymName) ;
+                             PutSymKey(Unresolved, SymName, Sym)
+                          END
+                       END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module or Procedure symbol')
+      END
+   END ;
+   RETURN( Sym )
+END FetchUnknownFrom ;
+
+
+(*
+   GetFromOuterModule - returns a symbol with name, SymName, which comes
+                        from outside the current module.
+*)
+
+PROCEDURE GetFromOuterModule (tokenno: CARDINAL; SymName: Name) : CARDINAL ;
+VAR
+   pCall   : PtrToCallFrame ;
+   ScopeId : CARDINAL ;
+   Sym,
+   ScopeSym: CARDINAL ;
+BEGIN
+   ScopeId := ScopePtr ;
+   pCall := GetPcall(ScopeId) ;
+   WHILE (NOT IsModule(pCall^.Search)) AND
+         (NOT IsDefImp(pCall^.Search)) DO
+      Assert (ScopeId>0) ;
+      DEC (ScopeId) ;
+      pCall := GetPcall (ScopeId)
+   END ;
+   DEC (ScopeId) ;
+   (* we are now below the current module *)
+   WHILE ScopeId>0 DO
+      pCall := GetPcall(ScopeId) ;
+      ScopeSym := pCall^.Search ;
+      IF ScopeSym#NulSym
+      THEN
+         Sym := GetLocalSym(ScopeSym, SymName) ;
+         IF Sym=NulSym
+         THEN
+            IF IsModule(ScopeSym) OR IsProcedure(ScopeSym) OR IsDefImp(ScopeSym)
+            THEN
+               IF Sym=NulSym
+               THEN
+                  Sym := ExamineUnresolvedTree(ScopeSym, SymName) ;
+                  IF Sym#NulSym
+                  THEN
+                     RETURN( Sym )
+                  END
+               END
+            END
+         ELSE
+            RETURN( Sym )
+         END
+      END ;
+      DEC(ScopeId) ;
+      pCall := GetPcall(ScopeId)
+   END ;
+   (* at this point we force an unknown from the last module scope *)
+   RETURN( RequestFromModule (tokenno, GetLastModuleScope(), SymName) )
+END GetFromOuterModule ;
+
+
+(*
+   IsExportUnQualified - returns true if a symbol, Sym, was defined as
+                         being EXPORT UNQUALIFIED.
+*)
+
+PROCEDURE IsExportUnQualified (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym       : PtrToSymbol ;
+   OuterModule: CARDINAL ;
+BEGIN
+   OuterModule := Sym ;
+   REPEAT
+      OuterModule := GetScope(OuterModule)
+   UNTIL GetScope(OuterModule)=NulSym ;
+   pSym := GetPsym(OuterModule) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: RETURN( FALSE ) |
+      DefImpSym: RETURN( GetSymKey(
+                                    DefImp.ExportUnQualifiedTree,
+                                    GetSymName(Sym)
+                                  )=Sym
+                       )
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END IsExportUnQualified ;
+
+
+(*
+   IsExportQualified - returns true if a symbol, Sym, was defined as
+                       being EXPORT QUALIFIED.
+                       Sym is expected to be either a procedure or a
+                       variable.
+*)
+
+PROCEDURE IsExportQualified (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym       : PtrToSymbol ;
+   OuterModule: CARDINAL ;
+BEGIN
+   OuterModule := Sym ;
+   REPEAT
+      OuterModule := GetScope(OuterModule)
+   UNTIL GetScope(OuterModule)=NulSym ;
+   pSym := GetPsym(OuterModule) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: RETURN( FALSE ) |
+      DefImpSym: RETURN( GetSymKey(DefImp.ExportQualifiedTree, GetSymName(Sym))=Sym )
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END IsExportQualified ;
+
+
+(*
+   ForeachImportedDo - calls a procedure, P, foreach imported symbol
+                       in module, ModSym.
+*)
+
+PROCEDURE ForeachImportedDo (ModSym: CARDINAL; P: PerformOperation) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    ForeachNodeDo( ImportTree, P ) ;
+                    ForeachItemInListDo( IncludeList, P )
+                 END |
+      ModuleSym: WITH Module DO
+                    ForeachNodeDo( ImportTree, P ) ;
+                    ForeachItemInListDo( IncludeList, P )
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END ForeachImportedDo ;
+
+
+(*
+   ForeachExportedDo - calls a procedure, P, foreach imported symbol
+                       in module, ModSym.
+*)
+
+PROCEDURE ForeachExportedDo (ModSym: CARDINAL; P: PerformOperation) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    ForeachNodeDo( ExportQualifiedTree, P ) ;
+                    ForeachNodeDo( ExportUnQualifiedTree, P )
+                 END |
+      ModuleSym: WITH Module DO
+                    ForeachNodeDo( ExportTree, P )
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END ForeachExportedDo ;
+
+
+(*
+   ForeachLocalSymDo - foreach local symbol in module, Sym, or procedure, Sym,
+                       perform the procedure, P.
+*)
+
+PROCEDURE ForeachLocalSymDo (Sym: CARDINAL; P: PerformOperation) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym:      WITH DefImp DO
+                         ForeachNodeDo( LocalSymbols, P )
+                      END |
+      ModuleSym:      WITH Module DO
+                         ForeachNodeDo( LocalSymbols, P )
+                      END |
+      ProcedureSym:   WITH Procedure DO
+                         ForeachNodeDo( LocalSymbols, P )
+                      END |
+      RecordSym:      WITH Record DO
+                         ForeachNodeDo( LocalSymbols, P )
+                      END |
+      EnumerationSym: WITH Enumeration DO
+                         ForeachNodeDo( LocalSymbols, P )
+                      END
+
+      ELSE
+         InternalError ('expecting a DefImp, Module or Procedure symbol')
+      END
+   END
+END ForeachLocalSymDo ;
+
+
+(*
+   CheckForUnknownInModule - checks for any unknown symbols in the
+                             current module.
+                             If any unknown symbols are found then
+                             an error message is displayed.
+*)
+
+PROCEDURE CheckForUnknownInModule ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(GetCurrentModuleScope()) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    CheckForUnknowns( name, ExportQualifiedTree,
+                                      'EXPORT QUALIFIED' ) ;
+                    CheckForUnknowns( name, ExportUnQualifiedTree,
+                                      'EXPORT UNQUALIFIED' ) ;
+                    CheckForSymbols ( ExportRequest,
+                                      'requested by another modules import (symbols have not been exported by the appropriate definition module)' ) ;
+                    CheckForUnknowns( name, Unresolved, 'unresolved' ) ;
+                    CheckForUnknowns( name, LocalSymbols, 'locally used' )
+                 END |
+      ModuleSym: WITH Module DO
+                    CheckForUnknowns( name, Unresolved, 'unresolved' ) ;
+                    CheckForUnknowns( name, ExportUndeclared, 'exported but undeclared' ) ;
+                    CheckForUnknowns( name, ExportTree, 'exported but undeclared' ) ;
+                    CheckForUnknowns( name, LocalSymbols, 'locally used' )
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END CheckForUnknownInModule ;
+
+
+(*
+   UnknownSymbolError - displays symbol name for symbol, sym.
+*)
+
+PROCEDURE UnknownSymbolError (sym: WORD) ;
+BEGIN
+   IF IsUnreportedUnknown (sym)
+   THEN
+      IncludeElementIntoSet (ReportedUnknowns, sym) ;
+      MetaErrorStringT1 (GetFirstUsed (sym), InitString ("unknown symbol {%1EUad}"), sym)
+   END
+END UnknownSymbolError ;
+
+
+(*
+   UnknownReported - if sym is an unknown symbol and has not been reported
+                     then include it into the set of reported unknowns.
+*)
+
+PROCEDURE UnknownReported (sym: CARDINAL) ;
+BEGIN
+   IF IsUnreportedUnknown (sym)
+   THEN
+      IncludeElementIntoSet (ReportedUnknowns, sym)
+   END
+END UnknownReported ;
+
+
+(*
+   IsUnreportedUnknown - returns TRUE if symbol, sym, has not been
+                         reported and is an unknown symbol.
+*)
+
+PROCEDURE IsUnreportedUnknown (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN IsUnknown (sym) AND (NOT IsElementInSet (ReportedUnknowns, sym))
+END IsUnreportedUnknown ;
+
+
+VAR
+   ListifySentance : String ;
+   ListifyTotal,
+   ListifyWordCount: CARDINAL ;
+
+
+(*
+   AddListify -
+*)
+
+PROCEDURE AddListify (sym: CARDINAL) ;
+BEGIN
+   INC (ListifyWordCount) ;
+   IF ListifyWordCount = ListifyTotal
+   THEN
+      ListifySentance := ConCat (ListifySentance, Mark (InitString (" and ")))
+   ELSIF ListifyWordCount > 1
+   THEN
+      ListifySentance := ConCat (ListifySentance, Mark (InitString (", ")))
+   END ;
+   ListifySentance := ConCat (ListifySentance,
+                              Mark (InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
+END AddListify ;
+
+
+(*
+   Listify - convert tree into a string list and return the result.
+*)
+
+PROCEDURE Listify (tree: SymbolTree; isCondition: IsSymbol) : String ;
+BEGIN
+   ListifyTotal := NoOfNodes (tree, isCondition) ;
+   ListifyWordCount := 0 ;
+   ListifySentance := InitString ('') ;
+   ForeachNodeConditionDo (tree, isCondition, AddListify) ;
+   RETURN ListifySentance
+END Listify ;
+
+
+(*
+   CheckForUnknowns - checks a binary tree, Tree, to see whether it contains
+                      an unknown symbol. All unknown symbols are displayed
+                      together with an error message.
+*)
+
+PROCEDURE CheckForUnknowns (name: Name; Tree: SymbolTree;
+                            a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF DoesTreeContainAny(Tree, IsUnreportedUnknown)
+   THEN
+      CurrentError := NewError(GetTokenNo()) ;
+      s := InitString("{%E} the following unknown symbols in module %<") ;
+      s := ConCat(s, Mark(InitStringCharStar(KeyToCharStar(name)))) ;
+      s := ConCat(s, Mark(InitString('%> were '))) ;
+      s := ConCat(s, Mark(InitString(a))) ;
+      s := ConCat (s, Mark (InitString (': '))) ;
+      s := ConCat (s, Mark (Listify (Tree, IsUnreportedUnknown))) ;
+      MetaErrorStringT0(GetTokenNo(), s) ;
+      ForeachNodeDo(Tree, UnknownSymbolError)
+   END
+END CheckForUnknowns ;
+
+
+(*
+   SymbolError - displays symbol name for symbol, Sym.
+*)
+
+PROCEDURE SymbolError (Sym: WORD) ;
+VAR
+   e: Error ;
+   n: Name ;
+BEGIN
+   n := GetSymName(Sym) ;
+   e := ChainError(GetFirstUsed(Sym), CurrentError) ;
+   ErrorFormat1(e, "unknown symbol '%a' found", n)
+END SymbolError ;
+
+
+(*
+   CheckForSymbols  - checks a binary tree, Tree, to see whether it contains
+                      any symbol. The tree is expected to be empty, if not
+                      then an error has occurred.
+*)
+
+PROCEDURE CheckForSymbols (Tree: SymbolTree; a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF NOT IsEmptyTree(Tree)
+   THEN
+      s := InitString ("the symbols are unknown at the end of module {%1Ea} when ") ;
+      s := ConCat (s, Mark(InitString(a))) ;
+      MetaErrorString1 (s, MainModule) ;
+      ForeachNodeDo(Tree, SymbolError)
+   END
+END CheckForSymbols ;
+
+
+(*
+   PutExportUndeclared - places a symbol, Sym, into module, ModSym,
+                         ExportUndeclared list provided that Sym
+                         is unknown.
+*)
+
+PROCEDURE PutExportUndeclared (ModSym: CARDINAL; Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsUnknown (Sym)
+   THEN
+      pSym := GetPsym (ModSym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ModuleSym: PutSymKey (Module.ExportUndeclared, GetSymName (Sym), Sym) |
+         DefImpSym: PutSymKey (DefImp.ExportUndeclared, GetSymName (Sym), Sym)
+
+         ELSE
+            InternalError ('expecting a DefImp or Module symbol')
+         END
+      END
+   END
+END PutExportUndeclared ;
+
+
+(*
+   GetExportUndeclared - returns a symbol which has, name, from module, ModSym,
+                         which is in the ExportUndeclared list.
+*)
+
+PROCEDURE GetExportUndeclared (ModSym: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: RETURN( GetSymKey(Module.ExportUndeclared, name) ) |
+      DefImpSym: RETURN( GetSymKey(DefImp.ExportUndeclared, name) )
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END GetExportUndeclared ;
+
+
+(*
+   RemoveExportUndeclared - removes a symbol, Sym, from the module, ModSym,
+                            ExportUndeclaredTree.
+*)
+
+PROCEDURE RemoveExportUndeclared (ModSym: CARDINAL; Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: IF GetSymKey(Module.ExportUndeclared, GetSymName(Sym))=Sym
+                 THEN
+                    DelSymKey(Module.ExportUndeclared, GetSymName(Sym))
+                 END |
+      DefImpSym: IF GetSymKey(DefImp.ExportUndeclared, GetSymName(Sym))=Sym
+                 THEN
+                    DelSymKey(DefImp.ExportUndeclared, GetSymName(Sym))
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END RemoveExportUndeclared ;
+
+
+(*
+   CheckForExportedDeclaration - checks to see whether a definition module
+                                 is currently being compiled, if so,
+                                 symbol, Sym, is removed from the
+                                 ExportUndeclared list.
+                                 This procedure is called whenever a symbol
+                                 is declared, thus attempting to reduce
+                                 the ExportUndeclared list.
+*)
+
+PROCEDURE CheckForExportedDeclaration (Sym: CARDINAL) ;
+BEGIN
+   IF CompilingDefinitionModule ()
+   THEN
+      RemoveExportUndeclared(GetCurrentModule(), Sym)
+   END
+END CheckForExportedDeclaration ;
+
+
+(*
+   CheckForUndeclaredExports - displays an error and the offending symbols
+                               which have been exported but not declared
+                               from module, ModSym.
+*)
+
+PROCEDURE CheckForUndeclaredExports (ModSym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   (* WriteString('Inside CheckForUndeclaredExports') ; WriteLn ; *)
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: IF NOT IsEmptyTree(Module.ExportUndeclared)
+                 THEN
+                    MetaError1('undeclared identifier(s) in EXPORT list of {%1ERd} {%1a}', ModSym) ;
+                    ForeachNodeDo(Module.ExportUndeclared, UndeclaredSymbolError)
+                 END |
+      DefImpSym: IF NOT IsEmptyTree(DefImp.ExportUndeclared)
+                 THEN
+                    IF DoesNotNeedExportList(ModSym)
+                    THEN
+                       MetaError1('undeclared identifier(s) in {%1ERd} {%1a}', ModSym) ;
+                    ELSE
+                       MetaError1('undeclared identifier(s) in export list of {%1ERd} {%1a}', ModSym) ;
+                    END ;
+                    ForeachNodeDo(DefImp.ExportUndeclared, UndeclaredSymbolError)
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END CheckForUndeclaredExports ;
+
+
+(*
+   UndeclaredSymbolError - displays symbol name for symbol, Sym.
+*)
+
+PROCEDURE UndeclaredSymbolError (Sym: WORD) ;
+BEGIN
+   IF DebugUnknowns
+   THEN
+      printf1('undeclared symbol (%d)\n', Sym)
+   END ;
+   MetaError1('{%1UC} undeclared symbol {%1a}', Sym)
+END UndeclaredSymbolError ;
+
+
+(*
+   PutExportUnImplemented - places a symbol, Sym, into the currently compiled
+                            DefImp module NeedToBeImplemented list.
+*)
+
+PROCEDURE PutExportUnImplemented (tokenno: CARDINAL; Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (CurrentModule) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: IF GetSymKey (DefImp.NeedToBeImplemented, GetSymName (Sym)) = Sym
+                 THEN
+                    MetaErrorT2 (tokenno, 'symbol {%1a} is already exported from module {%2a}',
+                                 Sym, CurrentModule)
+                    (*
+                    n1 := GetSymName (Sym) ;
+                    n2 := GetSymName (CurrentModule) ;
+                    WriteFormat2 ('symbol (%a) already exported from module (%a)', n1, n2)
+                    *)
+                 ELSE
+                    PutSymKey (DefImp.NeedToBeImplemented, GetSymName(Sym), Sym)
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutExportUnImplemented ;
+
+
+(*
+   RemoveExportUnImplemented - removes a symbol, Sym, from the module, ModSym,
+                               NeedToBeImplemented list.
+*)
+
+PROCEDURE RemoveExportUnImplemented (ModSym: CARDINAL; Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: IF GetSymKey(DefImp.NeedToBeImplemented, GetSymName(Sym))=Sym
+                 THEN
+                    DelSymKey(DefImp.NeedToBeImplemented, GetSymName(Sym))
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END RemoveExportUnImplemented ;
+
+
+VAR
+   ExportRequestModule: CARDINAL ;
+
+
+(*
+   RemoveFromExportRequest -
+*)
+
+PROCEDURE RemoveFromExportRequest (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(ExportRequestModule) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: IF GetSymKey(DefImp.ExportRequest, GetSymName(Sym))=Sym
+                 THEN
+                    DelSymKey(DefImp.ExportRequest, GetSymName(Sym))
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END RemoveFromExportRequest ;
+
+
+(*
+   RemoveEnumerationFromExportRequest - removes enumeration symbol, sym,
+                                        (and its fields) from the ExportRequest tree.
+*)
+
+PROCEDURE RemoveEnumerationFromExportRequest (ModSym: CARDINAL; Sym: CARDINAL) ;
+BEGIN
+   IF IsEnumeration(Sym)
+   THEN
+      ExportRequestModule := ModSym ;
+      RemoveFromExportRequest(Sym) ;
+      ForeachLocalSymDo(Sym, RemoveFromExportRequest)
+   END
+END RemoveEnumerationFromExportRequest ;
+
+
+(*
+   CheckForExportedImplementation - checks to see whether an implementation
+                                    module is currently being compiled, if so,
+                                    symbol, Sym, is removed from the
+                                    NeedToBeImplemented list.
+                                    This procedure is called whenever a symbol
+                                    is declared, thus attempting to reduce
+                                    the NeedToBeImplemented list.
+                                    Only needs to be called when a TYPE or
+                                    PROCEDURE is built since the implementation
+                                    module can only implement these objects
+                                    declared in the definition module.
+
+                                    It also checks whether a definition module
+                                    is currently being compiled and, if so,
+                                    it will ensure that symbol, Sym, is removed
+                                    from the ExportRequest list. If Sym is an
+                                    enumerated type it ensures that its fields
+                                    are also removed.
+*)
+
+PROCEDURE CheckForExportedImplementation (Sym: CARDINAL) ;
+BEGIN
+   IF CompilingImplementationModule()
+   THEN
+      RemoveExportUnImplemented(GetCurrentModule(), Sym)
+   END ;
+   IF CompilingDefinitionModule() AND IsEnumeration(Sym)
+   THEN
+      RemoveEnumerationFromExportRequest(GetCurrentModule(), Sym)
+   END
+END CheckForExportedImplementation ;
+
+
+(*
+   CheckForUnImplementedExports - displays an error and the offending symbols
+                                  which have been exported but not implemented
+                                  from the current compiled module.
+*)
+
+PROCEDURE CheckForUnImplementedExports ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   (* WriteString('Inside CheckForImplementedExports') ; WriteLn ; *)
+   pSym := GetPsym (CurrentModule) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: IF NOT IsEmptyTree (DefImp.NeedToBeImplemented)
+                 THEN
+                    CurrentError := NewError (GetTokenNo ()) ;
+                    ErrorFormat1 (CurrentError, 'unimplemented identifier(s) in EXPORT list of DEFINITION MODULE %a\nthe implementation module fails to implement the following exported identifier(s)', DefImp.name) ;
+                    ForeachNodeDo (DefImp.NeedToBeImplemented, UnImplementedSymbolError)
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END CheckForUnImplementedExports ;
+
+
+(*
+   UnImplementedSymbolError - displays symbol name for symbol, Sym.
+*)
+
+PROCEDURE UnImplementedSymbolError (Sym: WORD) ;
+VAR
+   n: Name ;
+BEGIN
+   CurrentError := ChainError (GetFirstUsed (Sym), CurrentError) ;
+   IF IsType (Sym)
+   THEN
+      n := GetSymName(Sym) ;
+      ErrorFormat1 (CurrentError, 'hidden type is undeclared (%a)', n)
+   ELSIF IsProcedure (Sym)
+   THEN
+      n := GetSymName(Sym) ;
+      ErrorFormat1 (CurrentError, 'procedure is undeclared (%a)', n)
+   ELSIF IsProcType (Sym)
+   THEN
+      n := GetSymName(Sym) ;
+      ErrorFormat1 (CurrentError, 'procedure type is undeclared (%a)', n)
+   ELSE
+      ErrorFormat0 (CurrentError, 'undeclared symbol')
+   END
+END UnImplementedSymbolError ;
+
+
+(*
+   PutHiddenTypeDeclared - sets a flag in the current compiled module which
+                           indicates that a Hidden Type is declared within
+                           the implementation part of the module.
+                           This procedure is expected to be called while
+                           compiling the associated definition module.
+*)
+
+PROCEDURE PutHiddenTypeDeclared ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(CurrentModule) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: DefImp.ContainsHiddenType := TRUE
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutHiddenTypeDeclared ;
+
+
+(*
+   IsHiddenTypeDeclared - returns true if a Hidden Type was declared in
+                          the module, Sym.
+*)
+
+PROCEDURE IsHiddenTypeDeclared (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: RETURN( DefImp.ContainsHiddenType )
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END IsHiddenTypeDeclared ;
+
+
+(*
+   PutModuleContainsBuiltin - sets a flag in the current compiled module which
+                              indicates that a builtin procedure is being declared.
+                              This is only expected to be called when we are
+                              parsing the definition module.
+*)
+
+PROCEDURE PutModuleContainsBuiltin ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   PutHiddenTypeDeclared ;
+   pSym := GetPsym(CurrentModule) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: DefImp.ContainsBuiltin := TRUE
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutModuleContainsBuiltin ;
+
+
+(*
+   IsBuiltinInModule - returns true if a module, Sym, has declared a builtin procedure.
+*)
+
+PROCEDURE IsBuiltinInModule (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: RETURN( DefImp.ContainsBuiltin )
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END IsBuiltinInModule ;
+
+
+(*
+   PutDefinitionForC - sets a flag in the current compiled module which
+                       indicates that this module is a wrapper for a C
+                       file. Parameters passes to procedures in this module
+                       will adopt the C calling convention.
+*)
+
+PROCEDURE PutDefinitionForC (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: DefImp.ForC := TRUE
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutDefinitionForC ;
+
+
+(*
+   IsDefinitionForC - returns true if this definition module was declared
+                      as a DEFINITION MODULE FOR "C".
+*)
+
+PROCEDURE IsDefinitionForC (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: RETURN( DefImp.ForC )
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END IsDefinitionForC ;
+
+
+(*
+   PutDoesNeedExportList - sets a flag in module, Sym, which
+                           indicates that this module requires an explicit
+                           EXPORT QUALIFIED or UNQUALIFIED list. PIM-2
+*)
+
+PROCEDURE PutDoesNeedExportList (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: DefImp.NeedExportList := TRUE
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutDoesNeedExportList ;
+
+
+(*
+   PutDoesNotNeedExportList - sets a flag in module, Sym, which
+                              indicates that this module does not require an explicit
+                              EXPORT QUALIFIED or UNQUALIFIED list. PIM-3|4
+*)
+
+PROCEDURE PutDoesNotNeedExportList (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: DefImp.NeedExportList := FALSE
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END PutDoesNotNeedExportList ;
+
+
+(*
+   DoesNotNeedExportList - returns TRUE if module, Sym, does not require an explicit
+                           EXPORT QUALIFIED list.
+*)
+
+PROCEDURE DoesNotNeedExportList (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: RETURN( NOT DefImp.NeedExportList )
+
+      ELSE
+         InternalError ('expecting a DefImp symbol')
+      END
+   END
+END DoesNotNeedExportList ;
+
+
+(*
+   CheckForEnumerationInCurrentModule - checks to see whether the enumeration
+                                        type symbol, Sym, has been entered into
+                                        the current modules scope list.
+*)
+
+PROCEDURE CheckForEnumerationInCurrentModule (Sym: CARDINAL) ;
+VAR
+   pSym  : PtrToSymbol ;
+   ModSym: CARDINAL ;
+BEGIN
+   IF (SkipType(Sym)#NulSym) AND IsEnumeration(SkipType(Sym))
+   THEN
+      Sym := SkipType(Sym)
+   END ;
+
+   IF IsEnumeration(Sym)
+   THEN
+      ModSym := GetCurrentModuleScope() ;
+      pSym := GetPsym(ModSym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         DefImpSym: CheckEnumerationInList(DefImp.EnumerationScopeList, Sym) |
+         ModuleSym: CheckEnumerationInList(Module.EnumerationScopeList, Sym)
+
+         ELSE
+            InternalError ('expecting a DefImp or Module symbol')
+         END
+      END
+   END
+END CheckForEnumerationInCurrentModule ;
+
+
+(*
+   CheckEnumerationInList - places symbol, Sym, in the list, l,
+                            providing it does not already exist.
+                            PseudoScope(Sym) is called if Sym needs to
+                            be added to the enumeration list, l.
+*)
+
+PROCEDURE CheckEnumerationInList (l: List; Sym: CARDINAL) ;
+BEGIN
+   IF NOT IsItemInList(l, Sym)
+   THEN
+      PutItemIntoList(l, Sym) ;
+      PseudoScope(Sym)
+   END
+END CheckEnumerationInList ;
+
+
+(*
+   CheckIfEnumerationExported - An outer module may use an enumeration that
+                                is declared inside an inner module. The usage
+                                may occur before definition. The first pass
+                                exports a symbol, later the symbol is declared
+                                as an emumeration type. At this stage the
+                                CheckIfEnumerationExported procedure should be
+                                called. This procedure ripples from the current
+                                (inner) module to outer module and every time
+                                it is exported it must be added to the outer
+                                module EnumerationScopeList.
+*)
+
+PROCEDURE CheckIfEnumerationExported (Sym: CARDINAL; ScopeId: CARDINAL) ;
+VAR
+   pCall      : PtrToCallFrame ;
+   InnerModId,
+   OuterModId : CARDINAL ;
+   InnerModSym,
+   OuterModSym: CARDINAL ;
+BEGIN
+   InnerModId := GetModuleScopeId(ScopeId) ;
+   IF InnerModId>0
+   THEN
+      OuterModId := GetModuleScopeId(InnerModId-1) ;
+      IF OuterModId>0
+      THEN
+         pCall := GetPcall(InnerModId) ;
+         InnerModSym := pCall^.Search ;
+         pCall := GetPcall(OuterModId) ;
+         OuterModSym := pCall^.Search ;
+         IF (InnerModSym#NulSym) AND (OuterModSym#NulSym)
+         THEN
+            IF IsExported(InnerModSym, Sym)
+            THEN
+               CheckForEnumerationInOuterModule(Sym, OuterModSym) ;
+               CheckIfEnumerationExported(Sym, OuterModId)
+            END
+         END
+      END
+   END
+END CheckIfEnumerationExported ;
+
+
+(*
+   CheckForEnumerationInOuterModule - checks to see whether the enumeration
+                                      type symbol, Sym, has been entered into
+                                      the outer module, OuterModule, scope list.
+                                      OuterModule may be internal to the
+                                      program module.
+*)
+
+PROCEDURE CheckForEnumerationInOuterModule (Sym: CARDINAL;
+                                            OuterModule: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(OuterModule) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: IncludeItemIntoList(DefImp.EnumerationScopeList, Sym) |
+      ModuleSym: IncludeItemIntoList(Module.EnumerationScopeList, Sym)
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END CheckForEnumerationInOuterModule ;
+
+
+(*
+   IsExported - returns true if a symbol, Sym, is exported
+                from module, ModSym.
+                If ModSym is a DefImp symbol then its
+                ExportQualified and ExportUnQualified lists are examined.
+*)
+
+PROCEDURE IsExported (ModSym: CARDINAL; Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym   : PtrToSymbol ;
+   SymName: Name ;
+BEGIN
+   SymName := GetSymName(Sym) ;
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    RETURN(
+                            (GetSymKey(ExportQualifiedTree, SymName)=Sym) OR
+                            (GetSymKey(ExportUnQualifiedTree, SymName)=Sym)
+                          )
+                 END |
+      ModuleSym: WITH Module DO
+                    RETURN( GetSymKey(ExportTree, SymName)=Sym )
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END IsExported ;
+
+
+(*
+   IsImported - returns true if a symbol, Sym, in module, ModSym,
+                was imported.
+*)
+
+PROCEDURE IsImported (ModSym: CARDINAL; Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym   : PtrToSymbol ;
+   SymName: Name ;
+BEGIN
+   SymName := GetSymName(Sym) ;
+   pSym := GetPsym(ModSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: WITH DefImp DO
+                    RETURN(
+                            (GetSymKey(ImportTree, SymName)=Sym) OR
+                            IsItemInList(IncludeList, Sym)
+                          )
+                 END |
+      ModuleSym: WITH Module DO
+                    RETURN(
+                            (GetSymKey(ImportTree, SymName)=Sym) OR
+                            IsItemInList(IncludeList, Sym)
+                          )
+                 END
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END IsImported ;
+
+
+(*
+   IsType - returns true if the Sym is a type symbol.
+*)
+
+PROCEDURE IsType (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=TypeSym )
+END IsType ;
+
+
+(*
+   IsReturnOptional - returns TRUE if the return value for, sym, is
+                      optional.
+*)
+
+PROCEDURE IsReturnOptional (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: RETURN( Procedure.ReturnOptional ) |
+      ProcTypeSym : RETURN( ProcType.ReturnOptional )
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END
+END IsReturnOptional ;
+
+
+(*
+   SetReturnOptional - sets the ReturnOptional field in the Procedure or
+                       ProcType symboltable entry.
+*)
+
+PROCEDURE SetReturnOptional (sym: CARDINAL; isopt: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.ReturnOptional := isopt |
+      ProcTypeSym : ProcType.ReturnOptional := isopt
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END
+END SetReturnOptional ;
+
+
+(*
+   CheckOptFunction - checks to see whether the optional return value
+                      has been set before and if it differs it will
+                      generate an error message.  It will set the
+                      new value to, isopt.
+*)
+
+PROCEDURE CheckOptFunction (sym: CARDINAL; isopt: BOOLEAN) ;
+VAR
+   n: Name ;
+   e: Error ;
+BEGIN
+   IF GetType(sym)#NulSym
+   THEN
+      IF IsReturnOptional(sym) AND (NOT isopt)
+      THEN
+         n := GetSymName(sym) ;
+         e := NewError(GetTokenNo()) ;
+         ErrorFormat1(e, 'function (%a) has no optional return value here', n) ;
+         e := ChainError(GetDeclaredMod(sym), e) ;
+         ErrorFormat1(e, 'whereas the same function (%a) was declared to have an optional return value at this point', n)
+      ELSIF (NOT IsReturnOptional(sym)) AND isopt
+      THEN
+         n := GetSymName(sym) ;
+         e := NewError(GetTokenNo()) ;
+         ErrorFormat1(e, 'function (%a) has an optional return value', n) ;
+         e := ChainError(GetDeclaredMod(sym), e) ;
+         ErrorFormat1(e, 'whereas the same function (%a) was declared to have no optional return value at this point', n)
+      END
+   END ;
+   SetReturnOptional(sym, isopt)
+END CheckOptFunction ;
+
+
+(*
+   PutFunction - Places a TypeSym as the return type to a procedure Sym.
+*)
+
+PROCEDURE PutFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      ProcedureSym: CheckOptFunction(Sym, FALSE) ; Procedure.ReturnType := TypeSym |
+      ProcTypeSym : CheckOptFunction(Sym, FALSE) ; ProcType.ReturnType := TypeSym
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END
+END PutFunction ;
+
+
+(*
+   PutOptFunction - places a TypeSym as the optional return type to a procedure Sym.
+*)
+
+PROCEDURE PutOptFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      ProcedureSym: CheckOptFunction(Sym, TRUE) ; Procedure.ReturnType := TypeSym |
+      ProcTypeSym : CheckOptFunction(Sym, TRUE) ; ProcType.ReturnType := TypeSym
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END
+END PutOptFunction ;
+
+
+(*
+   MakeVariableForParam -
+*)
+
+PROCEDURE MakeVariableForParam (tok      : CARDINAL;
+                                ParamName: Name;
+                                ProcSym  : CARDINAL ;
+                                no       : CARDINAL) : CARDINAL ;
+VAR
+   pSym       : PtrToSymbol ;
+   VariableSym: CARDINAL ;
+BEGIN
+   VariableSym := MakeVar(tok, ParamName) ;
+   pSym := GetPsym(VariableSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: RETURN( NulSym ) |
+      VarSym  : Var.IsParam := TRUE     (* Variable is really a parameter *)
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END ;
+   (* Note that the parameter is now treated as a local variable *)
+   PutVar(VariableSym, GetType(GetNthParam(ProcSym, no))) ;
+   PutDeclared(tok, VariableSym) ;
+   (*
+      Normal VAR parameters have LeftValue,
+      however Unbounded VAR parameters have RightValue.
+      Non VAR parameters always have RightValue.
+   *)
+   IF IsVarParam(ProcSym, no) AND (NOT IsUnboundedParam(ProcSym, no))
+   THEN
+      PutMode(VariableSym, LeftValue)
+   ELSE
+      PutMode(VariableSym, RightValue)
+   END ;
+   RETURN( VariableSym )
+END MakeVariableForParam ;
+
+
+(*
+   PutParam - Places a Non VAR parameter ParamName with type ParamType into
+              procedure Sym. The parameter number is ParamNo.
+              If the procedure Sym already has this parameter then
+              the parameter is checked for consistancy and the
+              consistancy test is returned.
+*)
+
+PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
+                    ParamName: Name; ParamType: CARDINAL;
+                    isUnbounded: BOOLEAN) : BOOLEAN ;
+VAR
+   pSym       : PtrToSymbol ;
+   ParSym     : CARDINAL ;
+   VariableSym: CARDINAL ;
+BEGIN
+   IF ParamNo<=NoOfParam(Sym)
+   THEN
+      InternalError ('why are we trying to put parameters again')
+   ELSE
+      (* Add a new parameter *)
+      NewSym(ParSym) ;
+      pSym := GetPsym(ParSym) ;
+      WITH pSym^ DO
+         SymbolType := ParamSym ;
+         WITH Param DO
+            name := ParamName ;
+            Type := ParamType ;
+            IsUnbounded := isUnbounded ;
+            ShadowVar := NulSym ;
+            InitWhereDeclaredTok(tok, At)
+         END
+      END ;
+      AddParameter(Sym, ParSym) ;
+      IF ParamName#NulName
+      THEN
+         VariableSym := MakeVariableForParam(tok, ParamName, Sym, ParamNo) ;
+         IF VariableSym=NulSym
+         THEN
+            RETURN( FALSE )
+         ELSE
+            pSym := GetPsym(ParSym) ;
+            pSym^.Param.ShadowVar := VariableSym
+         END
+      END
+   END ;
+   RETURN( TRUE )
+END PutParam ;
+
+
+(*
+   PutVarParam - Places a Non VAR parameter ParamName with type
+                 ParamType into procedure Sym.
+                 The parameter number is ParamNo.
+                 If the procedure Sym already has this parameter then
+                 the parameter is checked for consistancy and the
+                 consistancy test is returned.
+*)
+
+PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
+                       ParamName: Name; ParamType: CARDINAL;
+                       isUnbounded: BOOLEAN) : BOOLEAN ;
+VAR
+   pSym       : PtrToSymbol ;
+   ParSym     : CARDINAL ;
+   VariableSym: CARDINAL ;
+BEGIN
+   IF ParamNo<=NoOfParam(Sym)
+   THEN
+      InternalError ('why are we trying to put parameters again')
+   ELSE
+      (* Add a new parameter *)
+      NewSym(ParSym) ;
+      pSym := GetPsym(ParSym) ;
+      WITH pSym^ DO
+         SymbolType := VarParamSym ;
+         WITH VarParam DO
+            name := ParamName ;
+            Type := ParamType ;
+            IsUnbounded := isUnbounded ;
+            ShadowVar := NulSym ;
+            InitWhereDeclaredTok(tok, At)
+         END
+      END ;
+      AddParameter(Sym, ParSym) ;
+      IF ParamName#NulName
+      THEN
+         VariableSym := MakeVariableForParam(tok, ParamName, Sym, ParamNo) ;
+         IF VariableSym=NulSym
+         THEN
+            RETURN( FALSE )
+         ELSE
+            pSym := GetPsym(ParSym) ;
+            pSym^.VarParam.ShadowVar := VariableSym
+         END
+      END ;
+      RETURN( TRUE )
+   END
+END PutVarParam ;
+
+
+(*
+   PutParamName - assigns a name, name, to paramater, no, of procedure,
+                  ProcSym.
+*)
+
+PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL; name: Name) ;
+VAR
+   pSym  : PtrToSymbol ;
+   ParSym: CARDINAL ;
+BEGIN
+   pSym := GetPsym(ProcSym) ;
+   ParSym := NulSym ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : RETURN |
+      ProcedureSym: ParSym := GetItemFromList(Procedure.ListOfParam, no) |
+      ProcTypeSym : ParSym := GetItemFromList(ProcType.ListOfParam, no)
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END ;
+   pSym := GetPsym(ParSym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ParamSym:    IF Param.name=NulName
+                   THEN
+                      Param.name := name ;
+                      Param.ShadowVar := MakeVariableForParam(tok, name, ProcSym, no)
+                   ELSE
+                      InternalError ('name of parameter has already been assigned')
+                   END |
+      VarParamSym: IF VarParam.name=NulName
+                   THEN
+                      VarParam.name := name ;
+                      VarParam.ShadowVar := MakeVariableForParam(tok, name, ProcSym, no)
+                   ELSE
+                      InternalError ('name of parameter has already been assigned')
+                   END
+
+      ELSE
+         InternalError ('expecting a VarParam or Param symbol')
+      END
+   END
+END PutParamName ;
+
+
+(*
+   AddParameter - adds a parameter ParSym to a procedure Sym.
+*)
+
+PROCEDURE AddParameter (Sym: CARDINAL; ParSym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      ProcedureSym: PutItemIntoList(Procedure.ListOfParam, ParSym) |
+      ProcTypeSym : PutItemIntoList(ProcType.ListOfParam, ParSym)
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END AddParameter ;
+
+
+(*
+   IsVarParam - Returns a conditional depending whether parameter ParamNo
+                is a VAR parameter.
+*)
+
+PROCEDURE IsVarParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+VAR
+   pSym : PtrToSymbol ;
+   IsVar: BOOLEAN ;
+BEGIN
+   IsVar := FALSE ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : |
+      ProcedureSym: IsVar := IsNthParamVar(Procedure.ListOfParam, ParamNo) |
+      ProcTypeSym : IsVar := IsNthParamVar(ProcType.ListOfParam, ParamNo)
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END ;
+   RETURN( IsVar )
+END IsVarParam ;
+
+
+(*
+   IsNthParamVar - returns true if the n th parameter of the parameter list,
+                   List, is a VAR parameter.
+*)
+
+PROCEDURE IsNthParamVar (Head: List; n: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+   p   : CARDINAL ;
+BEGIN
+   p := GetItemFromList(Head, n) ;
+   IF p=NulSym
+   THEN
+      InternalError ('parameter does not exist')
+   ELSE
+      pSym := GetPsym(p) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ErrorSym   : RETURN( FALSE ) |
+         VarParamSym: RETURN( TRUE ) |
+         ParamSym   : RETURN( FALSE )
+
+         ELSE
+            InternalError ('expecting Param or VarParam symbol')
+         END
+      END
+   END
+END IsNthParamVar ;
+
+
+(*
+   NoOfParam - Returns the number of parameters that procedure Sym contains.
+*)
+
+PROCEDURE NoOfParam (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   n   : CARDINAL ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : n := 0 |
+      ProcedureSym: n := NoOfItemsInList(Procedure.ListOfParam) |
+      ProcTypeSym : n := NoOfItemsInList(ProcType.ListOfParam)
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END ;
+   RETURN( n )
+END NoOfParam ;
+
+
+(*
+   HasVarParameters - returns TRUE if procedure, p, has any VAR parameters.
+*)
+
+PROCEDURE HasVarParameters (p: CARDINAL) : BOOLEAN ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   n := NoOfParam(p) ;
+   i := 1 ;
+   WHILE i<=n DO
+      IF IsVarParam(p, i)
+      THEN
+         RETURN TRUE
+      END ;
+      INC(i)
+   END ;
+   RETURN FALSE
+END HasVarParameters ;
+
+
+(*
+   PutUseVarArgs - tell the symbol table that this procedure, Sym,
+                   uses varargs.
+                   The procedure _must_ be declared inside a
+                   DEFINITION FOR "C"
+
+*)
+
+PROCEDURE PutUseVarArgs (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      ProcedureSym: Procedure.HasVarArgs := TRUE |
+      ProcTypeSym : ProcType.HasVarArgs := TRUE
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END
+END PutUseVarArgs ;
+
+
+(*
+   UsesVarArgs - returns TRUE if procedure, Sym, uses varargs.
+                 The procedure _must_ be declared inside a
+                 DEFINITION FOR "C"
+*)
+
+PROCEDURE UsesVarArgs (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : RETURN( FALSE ) |
+      ProcedureSym: RETURN( Procedure.HasVarArgs ) |
+      ProcTypeSym : RETURN( ProcType.HasVarArgs )
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END
+END UsesVarArgs ;
+
+
+(*
+   PutUseOptArg - tell the symbol table that this procedure, Sym,
+                  uses an optarg.
+*)
+
+PROCEDURE PutUseOptArg (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      ProcedureSym: Procedure.HasOptArg := TRUE |
+      ProcTypeSym : ProcType.HasOptArg := TRUE
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END
+END PutUseOptArg ;
+
+
+(*
+   UsesOptArg - returns TRUE if procedure, Sym, uses varargs.
+*)
+
+PROCEDURE UsesOptArg (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : RETURN( FALSE ) |
+      ProcedureSym: RETURN( Procedure.HasOptArg ) |
+      ProcTypeSym : RETURN( ProcType.HasOptArg )
+
+      ELSE
+         InternalError ('expecting a Procedure or ProcType symbol')
+      END
+   END
+END UsesOptArg ;
+
+
+(*
+   PutOptArgInit - makes symbol, Sym, the initializer value to
+                   procedure, ProcSym.
+*)
+
+PROCEDURE PutOptArgInit (ProcSym, Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   IF NOT IsError(ProcSym)
+   THEN
+      IF UsesOptArg(ProcSym)
+      THEN
+         pSym := GetPsym(ProcSym) ;
+         WITH pSym^ DO
+            CASE SymbolType OF
+
+            ErrorSym    : |
+            ProcedureSym: Procedure.OptArgInit := Sym |
+            ProcTypeSym : ProcType.OptArgInit := Sym
+
+            ELSE
+               InternalError ('expecting a Procedure or ProcType symbol')
+            END
+         END
+      END
+   END
+END PutOptArgInit ;
+
+
+(*
+   GetOptArgInit - returns the initializer value to the optional parameter in
+                   procedure, ProcSym.
+*)
+
+PROCEDURE GetOptArgInit (ProcSym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF NOT IsError(ProcSym)
+   THEN
+      IF UsesOptArg(ProcSym)
+      THEN
+         pSym := GetPsym(ProcSym) ;
+         WITH pSym^ DO
+            CASE SymbolType OF
+
+            ErrorSym    : |
+            ProcedureSym: RETURN( Procedure.OptArgInit ) |
+            ProcTypeSym : RETURN( ProcType.OptArgInit )
+
+            ELSE
+               InternalError ('expecting a Procedure or ProcType symbol')
+            END
+         END
+      END
+   END ;
+   RETURN( NulSym )
+END GetOptArgInit ;
+
+
+(*
+   NoOfVariables - returns the number of variables in scope.  The scope maybe
+                   a procedure, module or defimp scope.
+*)
+
+PROCEDURE NoOfVariables (scope: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsProcedure (scope)
+   THEN
+      RETURN NoOfLocalVar (scope)
+   ELSIF IsModule (scope)
+   THEN
+      pSym := GetPsym (scope) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ModuleSym:  RETURN NoOfItemsInList (Module.ListOfVars)
+
+         ELSE
+            InternalError ('expecting module symbol')
+         END
+      END
+   ELSIF IsDefImp (scope)
+   THEN
+      pSym := GetPsym (scope) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         DefImpSym:  RETURN NoOfItemsInList (DefImp.ListOfVars)
+
+         ELSE
+            InternalError ('expecting defimp symbol')
+         END
+      END
+   ELSE
+      InternalError ('expecting procedure, module or defimp symbol')
+   END
+END NoOfVariables ;
+
+
+(*
+   NoOfLocalVar - returns the number of local variables that exist in
+                  procedure Sym. Parameters are NOT included in the
+                  count.
+*)
+
+PROCEDURE NoOfLocalVar (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   n   : CARDINAL ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : n := 0 |
+      ProcedureSym: n := NoOfItemsInList(Procedure.ListOfVars)
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END ;
+   (*
+      Parameters are actually included in the list of local varaibles,
+      therefore we must subtract the Parameter Number from local variable
+      total.
+   *)
+   RETURN( n-NoOfParam(Sym) )
+END NoOfLocalVar ;
+
+
+(*
+   IsParameterVar - returns true if parameter symbol Sym
+                    was declared as a VAR.
+*)
+
+PROCEDURE IsParameterVar (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ParamSym   :  RETURN( FALSE ) |
+      VarParamSym:  RETURN( TRUE )
+
+      ELSE
+         InternalError ('expecting Param or VarParam symbol')
+      END
+   END
+END IsParameterVar ;
+
+
+(*
+   IsParameterUnbounded - returns TRUE if parameter, Sym, is
+                          unbounded.
+*)
+
+PROCEDURE IsParameterUnbounded (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ParamSym   :  RETURN( Param.IsUnbounded ) |
+      VarParamSym:  RETURN( VarParam.IsUnbounded )
+
+      ELSE
+         InternalError ('expecting Param or VarParam symbol')
+      END
+   END
+END IsParameterUnbounded ;
+
+
+(*
+   IsUnboundedParam - Returns a conditional depending whether parameter
+                      ParamNo is an unbounded array procedure parameter.
+*)
+
+PROCEDURE IsUnboundedParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+VAR
+   param: CARDINAL ;
+BEGIN
+   Assert(IsProcedure(Sym) OR IsProcType(Sym)) ;
+   param := GetNthParam(Sym, ParamNo) ;
+   RETURN( IsParameterUnbounded(param) )
+END IsUnboundedParam ;
+
+
+(*
+   IsParameter - returns true if Sym is a parameter symbol.
+*)
+
+PROCEDURE IsParameter (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ParamSym,
+      VarParamSym:  RETURN( TRUE )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsParameter ;
+
+
+(*
+   GetParameterShadowVar - returns the local variable associated with the
+                           parameter symbol, sym.
+*)
+
+PROCEDURE GetParameterShadowVar (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ParamSym   :  RETURN( Param.ShadowVar ) |
+      VarParamSym:  RETURN( VarParam.ShadowVar )
+
+      ELSE
+         InternalError ('expecting a ParamSym or VarParamSym')
+      END
+   END
+END GetParameterShadowVar ;
+
+
+(*
+   IsProcedure - returns true if Sym is a procedure symbol.
+*)
+
+PROCEDURE IsProcedure (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=ProcedureSym )
+END IsProcedure ;
+
+
+(*
+   ProcedureParametersDefined - dictates to procedure symbol, Sym,
+                                that its parameters have been defined.
+*)
+
+PROCEDURE ProcedureParametersDefined (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : |
+      ProcedureSym: Assert(NOT Procedure.ParamDefined) ;
+                    Procedure.ParamDefined := TRUE
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END ProcedureParametersDefined ;
+
+
+(*
+   AreProcedureParametersDefined - returns true if the parameters to procedure
+                                   symbol, Sym, have been defined.
+*)
+
+PROCEDURE AreProcedureParametersDefined (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : RETURN( FALSE ) |
+      ProcedureSym: RETURN( Procedure.ParamDefined )
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END AreProcedureParametersDefined ;
+
+
+(*
+   ParametersDefinedInDefinition - dictates to procedure symbol, Sym,
+                                   that its parameters have been defined in
+                                   a definition module.
+*)
+
+PROCEDURE ParametersDefinedInDefinition (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : |
+      ProcedureSym: Assert(NOT Procedure.DefinedInDef) ;
+                    Procedure.DefinedInDef := TRUE
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END ParametersDefinedInDefinition ;
+
+
+(*
+   AreParametersDefinedInDefinition - returns true if procedure symbol, Sym,
+                                      has had its parameters been defined in
+                                      a definition module.
+*)
+
+PROCEDURE AreParametersDefinedInDefinition (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : RETURN( FALSE ) |
+      ProcedureSym: RETURN( Procedure.DefinedInDef )
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END AreParametersDefinedInDefinition ;
+
+
+(*
+   ParametersDefinedInImplementation - dictates to procedure symbol, Sym,
+                                       that its parameters have been defined in
+                                       a implemtation module.
+*)
+
+PROCEDURE ParametersDefinedInImplementation (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : |
+      ProcedureSym: Assert(NOT Procedure.DefinedInImp) ;
+                    Procedure.DefinedInImp := TRUE
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END ParametersDefinedInImplementation ;
+
+
+(*
+   AreParametersDefinedInImplementation - returns true if procedure symbol, Sym,
+                                          has had its parameters been defined in
+                                          an implementation module.
+*)
+
+PROCEDURE AreParametersDefinedInImplementation (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym    : RETURN( FALSE ) |
+      ProcedureSym: RETURN( Procedure.DefinedInImp )
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END AreParametersDefinedInImplementation ;
+
+
+(*
+   FillInUnknownFields -
+*)
+
+PROCEDURE FillInUnknownFields (tok: CARDINAL; sym: CARDINAL; SymName: Name) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      SymbolType := UndefinedSym ;
+      WITH Undefined DO
+         name     := SymName ;
+         oafamily := NulSym ;
+         errorScope := GetCurrentErrorScope () ;
+         InitWhereFirstUsedTok (tok, At)
+      END
+   END
+END FillInUnknownFields ;
+
+
+(*
+   FillInPointerFields - given a new symbol, sym, make it a pointer symbol
+                         and initialize its fields.
+*)
+
+PROCEDURE FillInPointerFields (Sym: CARDINAL; PointerName: Name;
+                               scope: CARDINAL; oaf: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF NOT IsError(Sym)
+   THEN
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         SymbolType := PointerSym ;
+         CASE SymbolType OF
+
+         PointerSym: Pointer.Type := NulSym ;
+                     Pointer.name := PointerName ;
+                     Pointer.oafamily := oaf ;         (* The unbounded for this *)
+		     InitTree(Pointer.ConstLitTree) ;  (* constants of this type *)
+                     Pointer.Scope := scope ;          (* Which scope created it *)
+                     Pointer.Size := InitValue() ;
+                     Pointer.Align := NulSym ;         (* Alignment of this type *)
+
+         ELSE
+            InternalError ('expecting a Pointer symbol')
+         END
+      END
+   END
+END FillInPointerFields ;
+
+
+(*
+   MakePointer - returns a pointer symbol with PointerName.
+*)
+
+PROCEDURE MakePointer (tok: CARDINAL; PointerName: Name) : CARDINAL ;
+VAR
+   oaf, sym: CARDINAL ;
+BEGIN
+   sym := HandleHiddenOrDeclare(tok, PointerName, oaf) ;
+   FillInPointerFields(sym, PointerName, GetCurrentScope(), oaf) ;
+   ForeachOAFamily(oaf, doFillInOAFamily) ;
+   RETURN( sym )
+END MakePointer ;
+
+
+(*
+   PutPointer - gives a pointer symbol a type, PointerType.
+*)
+
+PROCEDURE PutPointer (Sym: CARDINAL; PointerType: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym  : |
+      PointerSym: Pointer.Type := PointerType
+
+      ELSE
+         InternalError ('expecting a Pointer symbol')
+      END
+   END
+END PutPointer ;
+
+
+(*
+   IsPointer - returns true is Sym is a pointer type symbol.
+*)
+
+PROCEDURE IsPointer (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=PointerSym )
+END IsPointer ;
+
+
+(*
+   IsRecord - returns true is Sym is a record type symbol.
+*)
+
+PROCEDURE IsRecord (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=RecordSym )
+END IsRecord ;
+
+
+(*
+   IsArray - returns true is Sym is an array type symbol.
+*)
+
+PROCEDURE IsArray (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=ArraySym )
+END IsArray ;
+
+
+(*
+   IsEnumeration - returns true if Sym is an enumeration symbol.
+*)
+
+PROCEDURE IsEnumeration (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=EnumerationSym )
+END IsEnumeration ;
+
+
+(*
+   IsUnbounded - returns true if Sym is an unbounded symbol.
+*)
+
+PROCEDURE IsUnbounded (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=UnboundedSym )
+END IsUnbounded ;
+
+
+(*
+   GetVarScope - returns the symbol which is the scope of variable Sym.
+                 ie a Module, DefImp or Procedure Symbol.
+*)
+
+PROCEDURE GetVarScope (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: RETURN( NulSym ) |
+      VarSym  : RETURN( Var.Scope )
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END
+END GetVarScope ;
+
+
+(*
+   NoOfElements - Returns the number of elements in array Sym,
+                  or the number of elements in an enumeration Sym or
+                  the number of interface symbols in an Interface list.
+*)
+
+PROCEDURE NoOfElements (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   n   : CARDINAL ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym      : n := 0 |
+(*
+      ArraySym      ,
+      UnboundedSym  : n := 1 |   (* Standard language limitation *)
+*)
+      EnumerationSym: n := pSym^.Enumeration.NoOfElements |
+      InterfaceSym  : n := HighIndice(Interface.Parameters)
+
+      ELSE
+         InternalError ('expecting an Array or UnBounded symbol')
+      END
+   END ;
+   RETURN( n )
+END NoOfElements ;
+
+
+(*
+   PutArraySubscript - places an index field into the array Sym. The
+                       index field is a subscript sym.
+*)
+
+PROCEDURE PutArraySubscript (Sym: CARDINAL; SubscriptSymbol: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      ArraySym: Array.Subscript := SubscriptSymbol
+
+      ELSE
+         InternalError ('expecting an Array symbol')
+      END
+   END
+END PutArraySubscript ;
+
+
+(*
+   GetArraySubscript - returns the subscript symbol for array, Sym.
+*)
+
+PROCEDURE GetArraySubscript (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: RETURN( NulSym ) |
+      ArraySym: RETURN( Array.Subscript )
+
+      ELSE
+         InternalError ('expecting an Array symbol')
+      END
+   END
+END GetArraySubscript ;
+
+
+(*
+   MakeSubscript - makes a subscript Symbol.
+                   No name is required.
+*)
+
+PROCEDURE MakeSubscript () : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   NewSym(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := SubscriptSym ;
+      WITH Subscript DO
+         Type := NulSym ;        (* Index to a subrange symbol. *)
+         Size := InitValue() ;   (* Size of this indice in*Size *)
+         Offset := InitValue() ; (* Offset at runtime of symbol *)
+                                 (* Pseudo ie: Offset+Size*i    *)
+                                 (* 1..n. The array offset is   *)
+                                 (* the real memory offset.     *)
+                                 (* This offset allows the a[i] *)
+                                 (* to be calculated without    *)
+                                 (* the need to perform         *)
+                                 (* subtractions when a[4..10]  *)
+                                 (* needs to be indexed.        *)
+         InitWhereDeclared(At)   (* Declared here               *)
+      END
+   END ;
+   RETURN( Sym )
+END MakeSubscript ;
+
+
+(*
+   PutSubscript - gives a subscript symbol a type, SimpleType.
+*)
+
+PROCEDURE PutSubscript (Sym: CARDINAL; SimpleType: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      SubscriptSym: Subscript.Type := SimpleType ;
+
+      ELSE
+         InternalError ('expecting a SubScript symbol')
+      END
+   END
+END PutSubscript ;
+
+
+(*
+   MakeSet - makes a set Symbol with name, SetName.
+*)
+
+PROCEDURE MakeSet (tok: CARDINAL; SetName: Name) : CARDINAL ;
+VAR
+   pSym    : PtrToSymbol ;
+   oaf, sym: CARDINAL ;
+BEGIN
+   sym := HandleHiddenOrDeclare(tok, SetName, oaf) ;
+   IF NOT IsError(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         SymbolType := SetSym ;
+         WITH Set DO
+            name := SetName ;          (* The name of the set.        *)
+            Type := NulSym ;           (* Index to a subrange symbol. *)
+            Size := InitValue() ;      (* Size of this set            *)
+            InitPacked(packedInfo) ;        (* not packed and no      *)
+                                            (* equivalent (yet).      *)
+            ispacked := FALSE ;        (* Not yet known to be packed. *)
+            oafamily := oaf ;          (* The unbounded sym for this  *)
+            Scope := GetCurrentScope() ;    (* Which scope created it *)
+            InitWhereDeclaredTok(tok, At)   (* Declared here          *)
+         END
+      END
+   END ;
+   ForeachOAFamily(oaf, doFillInOAFamily) ;
+   RETURN( sym )
+END MakeSet ;
+
+
+(*
+   PutSet - places SimpleType as the type for set, Sym.
+*)
+
+PROCEDURE PutSet (Sym: CARDINAL; SimpleType: CARDINAL; packed: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      SetSym: WITH Set DO
+      	         Type := SimpleType ;  (* Index to a subrange symbol  *)
+      	       	     	      	       (* or an enumeration type.     *)
+                 ispacked := packed
+              END
+      ELSE
+         InternalError ('expecting a Set symbol')
+      END
+   END
+END PutSet ;
+
+
+(*
+   IsSet - returns TRUE if Sym is a set symbol.
+*)
+
+PROCEDURE IsSet (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=SetSym )
+END IsSet ;
+
+
+(*
+   IsSetPacked - returns TRUE if Sym is packed.
+*)
+
+PROCEDURE IsSetPacked (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal (Sym) ;
+   pSym := GetPsym (Sym) ;
+   RETURN (pSym^.SymbolType=SetSym) AND pSym^.Set.ispacked
+END IsSetPacked ;
+
+
+(*
+   ForeachParameterDo -
+*)
+
+PROCEDURE ForeachParameterDo (p: CheckProcedure) ;
+VAR
+   l, h: CARDINAL ;
+BEGIN
+   l := LowIndice(Symbols) ;
+   h := HighIndice(Symbols) ;
+   WHILE l<=h DO
+      IF IsParameter(l)
+      THEN
+         p(l)
+      END ;
+      INC(l)
+   END
+END ForeachParameterDo ;
+
+
+(*
+   CheckUnbounded - checks to see if parameter, Sym, is now an unbounded parameter.
+*)
+
+PROCEDURE CheckUnbounded (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ParamSym   :   IF IsUnbounded(Param.Type)
+                     THEN
+                        Param.IsUnbounded := TRUE
+                     END |
+      VarParamSym:   IF IsUnbounded(VarParam.Type)
+                     THEN
+                        VarParam.IsUnbounded := TRUE
+                     END
+
+      ELSE
+         HALT
+      END
+   END
+END CheckUnbounded ;
+
+
+(*
+   IsOAFamily - returns TRUE if, Sym, is an OAFamily symbol.
+*)
+
+PROCEDURE IsOAFamily (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=OAFamilySym )
+END IsOAFamily ;
+
+
+(*
+   MakeOAFamily - makes an OAFamily symbol based on SimpleType.
+                  It returns the OAFamily symbol.  A new symbol
+                  is created if one does not already exist for
+                  SimpleType.
+*)
+
+PROCEDURE MakeOAFamily (SimpleType: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   sym : CARDINAL ;
+BEGIN
+   sym := GetOAFamily(SimpleType) ;
+   IF sym=NulSym
+   THEN
+      NewSym(sym) ;
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         SymbolType := OAFamilySym ;
+         OAFamily.MaxDimensions := 0 ;
+         OAFamily.SimpleType := SimpleType ;
+         OAFamily.Dimensions := Indexing.InitIndex(1)
+      END ;
+      PutOAFamily(SimpleType, sym)
+   END ;
+   RETURN( sym )
+END MakeOAFamily ;
+
+
+(*
+   GetOAFamily - returns the oafamily symbol associated with
+                 SimpleType.
+*)
+
+PROCEDURE GetOAFamily (SimpleType: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(SimpleType) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym      :  RETURN( NulSym ) |
+      RecordSym     :  RETURN( Record.oafamily ) |
+      SubrangeSym   :  RETURN( Subrange.oafamily ) |
+      EnumerationSym:  RETURN( Enumeration.oafamily ) |
+      ArraySym      :  RETURN( Array.oafamily ) |
+      ProcTypeSym   :  RETURN( ProcType.oafamily ) |
+      TypeSym       :  RETURN( Type.oafamily ) |
+      PointerSym    :  RETURN( Pointer.oafamily ) |
+      SetSym        :  RETURN( Set.oafamily ) |
+      UndefinedSym  :  RETURN( Undefined.oafamily )
+
+      ELSE
+         RETURN( NulSym )
+      END
+   END
+END GetOAFamily ;
+
+
+(*
+   PutOAFamily - places the, oaf, into, SimpleType, oafamily field.
+*)
+
+PROCEDURE PutOAFamily (SimpleType: CARDINAL; oaf: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(SimpleType) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym      :  |
+      RecordSym     :  Record.oafamily := oaf |
+      SubrangeSym   :  Subrange.oafamily := oaf |
+      EnumerationSym:  Enumeration.oafamily := oaf |
+      ArraySym      :  Array.oafamily := oaf |
+      ProcTypeSym   :  ProcType.oafamily := oaf |
+      TypeSym       :  Type.oafamily := oaf |
+      PointerSym    :  Pointer.oafamily := oaf |
+      SetSym        :  Set.oafamily := oaf |
+      UndefinedSym  :  Undefined.oafamily := oaf
+
+      ELSE
+         InternalError ('not expecting this SimpleType')
+      END
+   END
+END PutOAFamily ;
+
+
+(*
+   ForeachOAFamily - call, p[oaf, ndim, symbol] for every unbounded symbol,
+                     sym, in the oaf.
+*)
+
+PROCEDURE ForeachOAFamily (sym: CARDINAL; p: FamilyOperation) ;
+VAR
+   pSym: PtrToSymbol ;
+   h, i: CARDINAL ;
+   pc  : POINTER TO CARDINAL ;
+BEGIN
+   IF sym#NulSym
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         OAFamilySym:  h := Indexing.HighIndice(OAFamily.Dimensions) ;
+                       i := 1 ;
+                       WHILE i<=h DO
+                          pc := Indexing.GetIndice(OAFamily.Dimensions, i) ;
+                          IF pc#NIL
+                          THEN
+                             p(sym, i, pc^)
+                          END ;
+                          INC(i)
+                       END
+
+         ELSE
+            InternalError ('expecting OAFamily symbol')
+         END
+      END
+   END
+END ForeachOAFamily ;
+
+
+(*
+   doFillInOAFamily -
+*)
+
+PROCEDURE doFillInOAFamily (oaf: CARDINAL; i: CARDINAL; unbounded: CARDINAL) ;
+VAR
+   SimpleType: CARDINAL ;
+BEGIN
+   SimpleType := GetType(oaf) ;
+   IF unbounded#NulSym
+   THEN
+      FillInUnboundedFields(GetTokenNo(), unbounded, SimpleType, i)
+   END
+END doFillInOAFamily ;
+
+
+(*
+   FillInUnboundedFields -
+*)
+
+PROCEDURE FillInUnboundedFields (tok: CARDINAL;
+                                 sym: CARDINAL; SimpleType: CARDINAL; ndim: CARDINAL) ;
+VAR
+   pSym    : PtrToSymbol ;
+   Contents: CARDINAL ;
+   i       : CARDINAL ;
+BEGIN
+   IF sym#NulSym
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         SymbolType := UnboundedSym ;
+         WITH Unbounded DO
+            Type := SimpleType ;            (* Index to a simple type.     *)
+            Size := InitValue() ;           (* Size in bytes for this sym  *)
+            Scope := GetScope(SimpleType) ; (* Which scope will create it  *)
+            InitWhereDeclaredTok(tok, At) ; (* Declared here               *)
+            NewSym(RecordType) ;
+            FillInRecordFields(tok, RecordType, NulName, GetScope(SimpleType), NulSym) ;
+            NewSym(Contents) ;
+            FillInPointerFields(Contents, NulName, GetScope(SimpleType), NulSym) ;
+            PutPointer(Contents, SimpleType) ;
+	    (* create the contents field for the unbounded array.  *)
+            Assert (PutFieldRecord(RecordType,
+                                   MakeKey(UnboundedAddressName),
+                                   Contents, NulSym) # NulSym) ;
+	    (* create all the high fields for the unbounded array.  *)
+            i := 1 ;
+            WHILE i<=ndim DO
+               Assert (PutFieldRecord(RecordType,
+                                      makekey(string(Mark(Sprintf1(Mark(InitString(UnboundedHighName)), i)))),
+                                      Cardinal, NulSym) # NulSym) ;
+               INC(i)
+            END ;
+            Dimensions := ndim
+         END
+      END ;
+      ForeachParameterDo(CheckUnbounded)
+   END
+END FillInUnboundedFields ;
+
+
+(*
+   MakeUnbounded - makes an unbounded array Symbol.
+                   ndim is the number of dimensions required.
+                   No name is required.
+*)
+
+PROCEDURE MakeUnbounded (tok: CARDINAL;
+                         SimpleType: CARDINAL; ndim: CARDINAL) : CARDINAL ;
+VAR
+   sym, oaf: CARDINAL ;
+BEGIN
+   oaf := MakeOAFamily(SimpleType) ;
+   sym := GetUnbounded(oaf, ndim) ;
+   IF sym=NulSym
+   THEN
+      NewSym(sym) ;
+      IF IsUnknown (SimpleType)
+      THEN
+         PutPartialUnbounded(sym, SimpleType, ndim)
+      ELSE
+         FillInUnboundedFields(tok, sym, SimpleType, ndim)
+      END ;
+      PutUnbounded(oaf, sym, ndim)
+   END ;
+   RETURN( sym )
+END MakeUnbounded ;
+
+
+(*
+   GetUnbounded - returns the unbounded symbol associated with
+                  the OAFamily symbol, oaf, and the number of
+                  dimensions, ndim, of the open array.
+*)
+
+PROCEDURE GetUnbounded (oaf: CARDINAL; ndim: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(oaf) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      OAFamilySym:  WITH OAFamily DO
+                       IF ndim>MaxDimensions
+                       THEN
+                          RETURN( NulSym )
+                       ELSE
+                          RETURN( GetFromIndex(Dimensions, ndim) )
+                       END
+                    END
+
+      ELSE
+         InternalError ('expecting OAFamily symbol')
+      END
+   END
+END GetUnbounded ;
+
+
+(*
+   PutUnbounded - associates the unbounded symbol, open, with
+                  SimpleType.
+*)
+
+PROCEDURE PutUnbounded (oaf: CARDINAL; sym: CARDINAL; ndim: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(oaf) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      OAFamilySym:  WITH OAFamily DO
+                       (* need to check to see if we need to add NulSym for all dimensions < ndim
+                          which have not been used.  *)
+                       WHILE MaxDimensions<ndim DO
+                          INC(MaxDimensions) ;
+			  IF MaxDimensions<ndim
+			  THEN
+			     (* add NulSym to an unused dimension.  *)
+                             PutIntoIndex(Dimensions, MaxDimensions, NulSym)
+			  END
+                       END ;
+                       (* and finally add the known sym.  *)
+                       PutIntoIndex(Dimensions, ndim, sym)
+                    END
+
+      ELSE
+         InternalError ('expecting OAFamily symbol')
+      END
+   END
+END PutUnbounded ;
+
+
+(*
+   GetUnboundedRecordType - returns the record type used to
+                            implement the unbounded array.
+*)
+
+PROCEDURE GetUnboundedRecordType (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      UnboundedSym: RETURN( Unbounded.RecordType )
+
+      ELSE
+         InternalError ('expecting an UnBounded symbol')
+      END
+   END
+END GetUnboundedRecordType ;
+
+
+(*
+   GetUnboundedAddressOffset - returns the offset of the address field
+                               inside the record used to implement the
+                               unbounded type.
+*)
+
+PROCEDURE GetUnboundedAddressOffset (sym: CARDINAL) : CARDINAL ;
+VAR
+   field,
+   rec  : CARDINAL ;
+BEGIN
+   rec := GetUnboundedRecordType(sym) ;
+   IF rec=NulSym
+   THEN
+      InternalError ('expecting record type to be declared')
+   ELSE
+      field := GetLocalSym(rec, MakeKey(UnboundedAddressName)) ;
+      IF field=NulSym
+      THEN
+         InternalError ('expecting address field to be present inside unbounded record')
+      ELSE
+         RETURN( field )
+      END
+   END
+END GetUnboundedAddressOffset ;
+
+
+(*
+   GetUnboundedHighOffset - returns the offset of the high field
+                            inside the record used to implement the
+                            unbounded type.
+*)
+
+PROCEDURE GetUnboundedHighOffset (sym: CARDINAL; ndim: CARDINAL) : CARDINAL ;
+VAR
+   rec: CARDINAL ;
+BEGIN
+   rec := GetUnboundedRecordType(sym) ;
+   IF rec=NulSym
+   THEN
+      InternalError ('expecting record type to be declared')
+   ELSE
+      RETURN GetLocalSym(rec,
+                         makekey(string(Mark(Sprintf1(Mark(InitString(UnboundedHighName)),
+                                                      ndim)))))
+   END
+END GetUnboundedHighOffset ;
+
+
+(*
+   GetArrayDimension - returns the number of dimensions defined.
+*)
+
+PROCEDURE GetArrayDimension (sym: CARDINAL) : CARDINAL ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   n := 0 ;
+   WHILE IsArray(sym) DO
+      sym := SkipType(GetType(sym)) ;
+      INC(n)
+   END ;
+   RETURN( n )
+END GetArrayDimension ;
+
+
+(*
+   GetDimension - return the number of dimensions associated with
+                  this unbounded ARRAY parameter.
+*)
+
+PROCEDURE GetDimension (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      PartialUnboundedSym:  RETURN( PartialUnbounded.NDim ) |
+      UnboundedSym       :  RETURN( Unbounded.Dimensions ) |
+      OAFamilySym        :  RETURN( OAFamily.MaxDimensions ) |
+      ParamSym           :  IF Param.IsUnbounded
+                            THEN
+                               RETURN( GetDimension(GetType(sym)) )
+                            ELSE
+                               InternalError ('expecting unbounded paramater')
+                            END |
+      VarParamSym        :  IF VarParam.IsUnbounded
+                            THEN
+                               RETURN( GetDimension(GetType(sym)) )
+                            ELSE
+                               InternalError ('expecting unbounded paramater')
+                            END |
+      ArraySym           :  RETURN( GetArrayDimension(sym) ) |
+      TypeSym            :  RETURN( GetDimension(GetType(sym)) ) |
+      VarSym             :  RETURN( GetDimension(GetType(sym)) )
+
+      ELSE
+         InternalError ('expecting PartialUnbounded')
+      END
+   END
+END GetDimension ;
+
+
+(*
+   PutArray - places a type symbol into an Array.
+*)
+
+PROCEDURE PutArray (Sym, TypeSymbol: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      ArraySym: WITH Array DO
+                   Type := TypeSymbol (* The Array Type. ARRAY OF Type.      *)
+                END
+      ELSE
+         InternalError ('expecting an Array symbol')
+      END
+   END
+END PutArray ;
+
+
+(*
+   ResolveConstructorType - if, sym, has an unresolved constructor type
+                            then attempt to resolve it by examining the
+                            from, type.
+*)
+
+PROCEDURE ResolveConstructorType (sym: CARDINAL;
+                                  VAR type: CARDINAL;
+                                  VAR from: CARDINAL;
+                                  VAR unres: BOOLEAN) ;
+BEGIN
+   IF unres
+   THEN
+      IF IsConstructor(from)
+      THEN
+         IF IsConstructorResolved(from)
+         THEN
+            unres := FALSE ;
+            type := GetType(from) ;
+            IF (type#NulSym) AND IsSet(SkipType(type))
+            THEN
+               PutConstSet(sym)
+            END
+         END
+      ELSIF (from#NulSym) AND IsSet(SkipType(from))
+      THEN
+         unres := FALSE ;
+         type := from ;
+         PutConstSet(sym)
+      ELSIF (from#NulSym) AND (IsRecord(SkipType(from)) OR IsArray(SkipType(from)))
+      THEN
+         unres := FALSE ;
+         type := from
+      END
+   END
+END ResolveConstructorType ;
+
+
+(*
+   IsConstructorResolved - returns TRUE if the constructor does not
+                           have an unresolved type.
+*)
+
+PROCEDURE IsConstructorResolved (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstVarSym:  RETURN( NOT ConstVar.UnresFromType ) |
+      ConstLitSym:  RETURN( NOT ConstLit.UnresFromType )
+
+      ELSE
+         InternalError ('expecting ConstVar or ConstLit symbol')
+      END
+   END
+END IsConstructorResolved ;
+
+
+(*
+   CanResolveConstructor - returns TRUE if the type of the constructor,
+                           sym, is known.
+*)
+
+PROCEDURE CanResolveConstructor (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF NOT IsConstructorResolved(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ConstVarSym:  WITH ConstVar DO
+                          ResolveConstructorType(sym, Type, FromType, UnresFromType)
+                       END |
+         ConstLitSym:  WITH ConstLit DO
+                          ResolveConstructorType(sym, Type, FromType, UnresFromType)
+                       END |
+
+         ELSE
+            InternalError ('expecting ConstVar or ConstLit symbol')
+         END
+      END
+   END ;
+   RETURN( IsConstructorResolved(sym) )
+END CanResolveConstructor ;
+
+
+(*
+   CheckAllConstructorsResolved - checks to see that the
+                                  UnresolvedConstructorType list is
+                                  empty and if it is not then it
+                                  generates error messages.
+*)
+
+PROCEDURE CheckAllConstructorsResolved ;
+VAR
+   i, n, s: CARDINAL ;
+   e      : Error ;
+BEGIN
+   n := NoOfItemsInList(UnresolvedConstructorType) ;
+   IF n>0
+   THEN
+      FOR i := 1 TO n DO
+         s := GetItemFromList(UnresolvedConstructorType, i) ;
+         e := NewError(GetDeclaredMod(s)) ;
+         ErrorFormat0(e, 'constructor has an unknown type')
+      END ;
+      FlushErrors
+   END
+END CheckAllConstructorsResolved ;
+
+
+(*
+   ResolveConstructorTypes - to be called at the end of pass three.  Its
+                             purpose is to fix up all constructors whose
+                             types are unknown.
+*)
+
+PROCEDURE ResolveConstructorTypes ;
+VAR
+   finished: BOOLEAN ;
+   i, n, s : CARDINAL ;
+BEGIN
+   REPEAT
+      n := NoOfItemsInList(UnresolvedConstructorType) ;
+      finished := TRUE ;
+      i := 1 ;
+      WHILE i<=n DO
+         s := GetItemFromList(UnresolvedConstructorType, i) ;
+         Assert(IsConstructor(s)) ;
+         IF CanResolveConstructor(s)
+         THEN
+            finished := FALSE ;
+            RemoveItemFromList(UnresolvedConstructorType, s) ;
+            i := n
+         END ;
+         INC(i)
+      END
+   UNTIL finished ;
+   CheckAllConstructorsResolved
+END ResolveConstructorTypes ;
+
+
+(*
+   SanityCheckParameters -
+*)
+
+PROCEDURE SanityCheckParameters (sym: CARDINAL) ;
+VAR
+   p   : CARDINAL ;
+   i, n: CARDINAL ;
+BEGIN
+   i := 1 ;
+   n := NoOfParam(sym) ;
+   WHILE i<=n DO
+      p := GetType(GetParam(sym, i)) ;
+      IF IsConst(p)
+      THEN
+         MetaError3('the {%1N} formal parameter in procedure {%2Dad} should have a type rather than a constant {%3Dad}',
+                    i, sym, p)
+      END ;
+      INC(i)
+   END
+END SanityCheckParameters ;
+
+
+(*
+   SanityCheckArray - checks to see that an array has a correct subrange type.
+*)
+
+PROCEDURE SanityCheckArray (sym: CARDINAL) ;
+VAR
+   type     : CARDINAL ;
+   subscript: CARDINAL ;
+BEGIN
+   IF IsArray(sym)
+   THEN
+      subscript := GetArraySubscript(sym) ;
+      IF subscript#NulSym
+      THEN
+         type := SkipType(GetType(subscript)) ;
+         IF IsAModula2Type(type)
+         THEN
+            (* ok all is good *)
+         ELSE
+            MetaError2('the array {%1Dad} must be declared with a simpletype in the [..] component rather than a {%2d}',
+                       sym, type)
+         END
+      END
+   END
+END SanityCheckArray ;
+
+
+(*
+   ForeachSymbolDo - foreach symbol, call, P(sym).
+*)
+
+PROCEDURE ForeachSymbolDo (P: PerformOperation) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   i := Indexing.LowIndice(Symbols) ;
+   n := Indexing.HighIndice(Symbols) ;
+   WHILE i<=n DO
+      P(i) ;
+      INC(i)
+   END
+END ForeachSymbolDo ;
+
+
+(*
+   SanityCheckProcedure - check to see that procedure parameters do not use constants
+                          instead of types in their formal parameter section.
+*)
+
+PROCEDURE SanityCheckProcedure (sym: CARDINAL) ;
+BEGIN
+   SanityCheckParameters(sym)
+END SanityCheckProcedure ;
+
+
+(*
+   SanityCheckModule -
+*)
+
+PROCEDURE SanityCheckModule (sym: CARDINAL) ;
+BEGIN
+   ForeachInnerModuleDo(sym, SanityCheckModule) ;
+   ForeachProcedureDo(sym, SanityCheckProcedure) ;
+   ForeachLocalSymDo(sym, SanityCheckArray)
+END SanityCheckModule ;
+
+
+(*
+   SanityCheckConstants - must only be called once all constants, types, procedures
+                          have been declared.  It checks to see that constants are
+                          not used as procedure parameter types.
+*)
+
+PROCEDURE SanityCheckConstants ;
+BEGIN
+   ForeachModuleDo(SanityCheckModule) ;
+   ForeachSymbolDo(SanityCheckArray)
+END SanityCheckConstants ;
+
+
+(*
+   AddNameTo - adds Name, n, to tree, s.
+*)
+
+PROCEDURE AddNameTo (s: SymbolTree; o: CARDINAL) ;
+BEGIN
+   IF GetSymKey(s, GetSymName(o))=NulKey
+   THEN
+      PutSymKey(s, GetSymName(o), o)
+   END
+END AddNameTo ;
+
+
+(*
+   AddNameToScope - adds a Name, n, to the list of objects declared at the
+                    current scope.
+*)
+
+PROCEDURE AddNameToScope (n: Name) ;
+VAR
+   pSym : PtrToSymbol ;
+   scope: CARDINAL ;
+BEGIN
+   scope := GetCurrentScope() ;
+   pSym := GetPsym(scope) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym:  AddNameTo(Procedure.NamedObjects, MakeObject(n)) |
+      ModuleSym   :  AddNameTo(Module.NamedObjects, MakeObject(n)) |
+      DefImpSym   :  AddNameTo(DefImp.NamedObjects, MakeObject(n))
+
+      ELSE
+         InternalError ('expecting - DefImp')
+      END
+   END
+END AddNameToScope ;
+
+
+(*
+   AddNameToImportList - adds a Name, n, to the import list of the current
+                         module.
+*)
+
+PROCEDURE AddNameToImportList (n: Name) ;
+VAR
+   pSym : PtrToSymbol ;
+   scope: CARDINAL ;
+BEGIN
+   scope := GetCurrentScope() ;
+   pSym := GetPsym(scope) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym:  AddNameTo(Module.NamedImports, MakeObject(n)) |
+      DefImpSym:  AddNameTo(DefImp.NamedImports, MakeObject(n))
+
+      ELSE
+         InternalError ('expecting - DefImp or Module symbol')
+      END
+   END
+END AddNameToImportList ;
+
+
+VAR
+   ResolveModule: CARDINAL ;
+
+
+(*
+   CollectSymbolFrom -
+*)
+
+PROCEDURE CollectSymbolFrom (tok: CARDINAL; scope: CARDINAL; n: Name) : CARDINAL ;
+VAR
+   n1 : Name ;
+   sym: CARDINAL ;
+BEGIN
+   n1 := GetSymName (scope) ;
+   IF DebugUnknowns
+   THEN
+      printf2('declaring %a in %a', n, n1)
+   END ;
+   sym := CheckScopeForSym (scope, n) ;
+   IF sym=NulSym
+   THEN
+      sym := FetchUnknownFrom (tok, scope, n)
+   END ;
+   IF DebugUnknowns
+   THEN
+      printf1(' symbol created (%d)\n', sym)
+   END ;
+   RETURN( sym )
+END CollectSymbolFrom ;
+
+
+(*
+   CollectUnknown -
+*)
+
+PROCEDURE CollectUnknown (tok: CARDINAL; sym: CARDINAL; n: Name) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   s   : CARDINAL ;
+BEGIN
+   IF IsModule (sym) OR IsDefImp (sym)
+   THEN
+      RETURN( CollectSymbolFrom (tok, sym, n) )
+   ELSIF IsProcedure(sym)
+   THEN
+      s := CheckScopeForSym (sym, n) ;
+      IF s=NulSym
+      THEN
+         pSym := GetPsym (sym) ;
+         WITH pSym^ DO
+            CASE SymbolType OF
+
+            ProcedureSym:  IF GetSymKey (Procedure.NamedObjects, n) # NulKey
+                           THEN
+                              RETURN( CollectSymbolFrom (tok, sym, n) )
+                           END
+
+            ELSE
+               InternalError ('expecting - Procedure symbol')
+            END
+         END ;
+         s := CollectUnknown (tok, GetScope (sym), n)
+      END ;
+      RETURN( s )
+   END
+END CollectUnknown ;
+
+
+(*
+   ResolveImport -
+*)
+
+PROCEDURE ResolveImport (o: WORD) ;
+VAR
+   n1, n2: Name ;
+   tok   : CARDINAL ;
+   sym   : CARDINAL ;
+BEGIN
+   IF DebugUnknowns
+   THEN
+      n1 := GetSymName(o) ;
+      printf1('attempting to find out where %a was declared\n', n1) ;
+      n1 := GetSymName(ResolveModule) ;
+      n2 := GetSymName(GetScope(ResolveModule)) ;
+      printf2('scope of module %a is %a\n', n1, n2)
+   END ;
+   tok := GetFirstUsed (o) ;
+   sym := CollectUnknown (tok, GetScope(ResolveModule), GetSymName(o)) ;
+   IF sym=NulSym
+   THEN
+      MetaError2('unknown symbol {%1Uad} found in import list of module {%2a}',
+                 o, ResolveModule)
+   ELSE
+      AddSymToModuleScope(ResolveModule, sym)
+   END
+END ResolveImport ;
+
+
+(*
+   ResolveRelativeImport -
+*)
+
+PROCEDURE ResolveRelativeImport (sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsModule(sym)
+   THEN
+      ResolveModule := sym ;
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ModuleSym:  ForeachNodeDo(Module.NamedImports,
+                                   ResolveImport)
+
+         ELSE
+            InternalError ('expecting - Module symbol')
+         END
+      END
+   END ;
+   ForeachProcedureDo(sym, ResolveRelativeImport) ;
+   ForeachInnerModuleDo(sym, ResolveRelativeImport)
+END ResolveRelativeImport ;
+
+
+(*
+   ResolveImports - it examines the import list of all inner modules
+                    and resolves all relative imports.
+*)
+
+PROCEDURE ResolveImports ;
+VAR
+   scope: CARDINAL ;
+BEGIN
+   scope := GetCurrentScope() ;
+   IF DebugUnknowns
+   THEN
+      DisplayTrees(scope)
+   END ;
+   ForeachProcedureDo(scope, ResolveRelativeImport) ;
+   ForeachInnerModuleDo(scope, ResolveRelativeImport)
+END ResolveImports ;
+
+
+(*
+   GetScope - returns the declaration scope of the symbol.
+*)
+
+PROCEDURE GetScope (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym           : ErrorAbort0('') |
+      DefImpSym          : RETURN( NulSym ) |
+      ModuleSym          : RETURN( Module.Scope ) |
+      VarSym             : RETURN( Var.Scope ) |
+      ProcedureSym       : RETURN( Procedure.Scope ) |
+      ProcTypeSym        : RETURN( ProcType.Scope ) |
+      RecordFieldSym     : RETURN( RecordField.Scope ) |
+      VarientSym         : RETURN( Varient.Scope ) |
+      VarientFieldSym    : RETURN( VarientField.Scope ) |
+      EnumerationSym     : RETURN( Enumeration.Scope ) |
+      EnumerationFieldSym: RETURN( EnumerationField.Scope ) |
+      SubrangeSym        : RETURN( Subrange.Scope ) |
+      ArraySym           : RETURN( Array.Scope ) |
+      TypeSym            : RETURN( Type.Scope ) |
+      PointerSym         : RETURN( Pointer.Scope ) |
+      RecordSym          : RETURN( Record.Scope ) |
+      SetSym             : RETURN( Set.Scope ) |
+      UnboundedSym       : RETURN( Unbounded.Scope ) |
+      ConstLitSym        : RETURN( ConstLit.Scope ) |
+      ConstStringSym     : RETURN( ConstString.Scope ) |
+      ConstVarSym        : RETURN( ConstVar.Scope ) |
+      PartialUnboundedSym: InternalError ('should not be requesting the scope of a PartialUnbounded symbol')
+
+      ELSE
+         InternalError ('not implemented yet')
+      END
+   END
+END GetScope ;
+
+
+(*
+   GetModuleScope - returns the module scope of symbol, sym.
+                    If sym was declared within a nested procedure
+                    then return the module which defines the
+                    procedure.
+*)
+
+PROCEDURE GetModuleScope (sym: CARDINAL) : CARDINAL ;
+VAR
+   mod: CARDINAL ;
+BEGIN
+   mod := GetScope(sym) ;
+   WHILE (mod#NulSym) AND (NOT IsDefImp(mod)) AND (NOT IsModule(mod)) DO
+      mod := GetScope(mod)
+   END ;
+   RETURN( mod )
+END GetModuleScope ;
+
+
+(*
+   GetProcedureScope - returns the innermost procedure (if any)
+                       in which the symbol, sym, resides.
+                       A module inside the procedure is skipped
+                       over.
+*)
+
+PROCEDURE GetProcedureScope (sym: CARDINAL) : CARDINAL ;
+BEGIN
+   WHILE (sym#NulSym) AND (NOT IsProcedure(sym)) DO
+      sym := GetScope(sym)
+   END ;
+   IF (sym#NulSym) AND IsProcedure(sym)
+   THEN
+      RETURN( sym )
+   ELSE
+      RETURN( NulSym )
+   END
+END GetProcedureScope ;
+
+
+(*
+   IsModuleWithinProcedure - returns TRUE if module, sym, is
+                             inside a procedure.
+*)
+
+PROCEDURE IsModuleWithinProcedure (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( GetProcedureScope(sym)#NulSym )
+END IsModuleWithinProcedure ;
+
+
+(*
+   GetParent - returns the parent of symbol, Sym.
+*)
+
+PROCEDURE GetParent (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym           : ErrorAbort0('') |
+      VarientSym         : RETURN( Varient.Parent ) |
+      VarientFieldSym    : RETURN( VarientField.Parent ) |
+      RecordFieldSym     : RETURN( RecordField.Parent ) |
+      EnumerationFieldSym: RETURN( EnumerationField.Type )
+
+      ELSE
+         InternalError ('not implemented yet')
+      END
+   END
+END GetParent ;
+
+
+(*
+   IsRecordField - returns true if Sym is a record field.
+*)
+
+PROCEDURE IsRecordField (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=RecordFieldSym )
+END IsRecordField ;
+
+
+(*
+   MakeProcType - returns a procedure type symbol with ProcTypeName.
+*)
+
+PROCEDURE MakeProcType (tok: CARDINAL; ProcTypeName: Name) : CARDINAL ;
+VAR
+   pSym    : PtrToSymbol ;
+   oaf, sym: CARDINAL ;
+BEGIN
+   sym := HandleHiddenOrDeclare (tok, ProcTypeName, oaf) ;
+   IF NOT IsError(sym)
+   THEN
+      pSym := GetPsym(sym) ;
+      WITH pSym^ DO
+         SymbolType := ProcTypeSym ;
+         CASE SymbolType OF
+
+         ProcTypeSym: ProcType.ReturnType := NulSym ;
+                      ProcType.name := ProcTypeName ;
+                      InitList(ProcType.ListOfParam) ;
+                      ProcType.HasVarArgs := FALSE ;     (* Does this proc type use ... ? *)
+                      ProcType.HasOptArg  := FALSE ;     (* Does this proc type use [ ] ? *)
+                      ProcType.OptArgInit := NulSym ;    (* The optarg initial value.     *)
+                      ProcType.ReturnOptional := FALSE ; (* Is the return value optional? *)
+                      ProcType.Scope := GetCurrentScope() ;
+                                                         (* scope of procedure.           *)
+                      ProcType.Size := InitValue() ;
+                      ProcType.TotalParamSize := InitValue() ;  (* size of all parameters *)
+                      ProcType.oafamily := oaf ;         (* The oa family for this symbol *)
+                      InitWhereDeclaredTok(tok, ProcType.At)     (* Declared here *)
+
+         ELSE
+            InternalError ('expecting ProcType symbol')
+         END
+      END
+   END ;
+   ForeachOAFamily(oaf, doFillInOAFamily) ;
+   RETURN( sym )
+END MakeProcType ;
+
+
+(*
+   PutProcTypeParam - Places a Non VAR parameter ParamName with type
+                      ParamType into ProcType Sym.
+*)
+
+PROCEDURE PutProcTypeParam (Sym: CARDINAL;
+                            ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
+VAR
+   pSym  : PtrToSymbol ;
+   ParSym: CARDINAL ;
+BEGIN
+   NewSym(ParSym) ;
+   pSym := GetPsym(ParSym) ;
+   WITH pSym^ DO
+      SymbolType := ParamSym ;
+      WITH Param DO
+         name := NulName ;
+         Type := ParamType ;
+         IsUnbounded := isUnbounded ;
+         ShadowVar := NulSym ;
+         InitWhereDeclared(At)
+      END
+   END ;
+   AddParameter(Sym, ParSym)
+END PutProcTypeParam ;
+
+
+(*
+   PutProcTypeVarParam - Places a Non VAR parameter ParamName with type
+                         ParamType into ProcType Sym.
+*)
+
+PROCEDURE PutProcTypeVarParam (Sym: CARDINAL;
+                               ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
+VAR
+   pSym  : PtrToSymbol ;
+   ParSym: CARDINAL ;
+BEGIN
+   NewSym(ParSym) ;
+   pSym := GetPsym(ParSym) ;
+   WITH pSym^ DO
+      SymbolType := VarParamSym ;
+      WITH Param DO
+         name := NulName ;
+         Type := ParamType ;
+         IsUnbounded := isUnbounded ;
+         ShadowVar := NulSym ;
+         InitWhereDeclared(At)
+      END
+   END ;
+   AddParameter(Sym, ParSym)
+END PutProcTypeVarParam ;
+
+
+(*
+   PutProcedureReachable - Sets the procedure, Sym, to be reachable by the
+                           main Module.
+*)
+
+PROCEDURE PutProcedureReachable (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      ProcedureSym: Procedure.Reachable := TRUE
+
+      ELSE
+         InternalError ('expecting Procedure symbol')
+      END
+   END
+END PutProcedureReachable ;
+
+
+(*
+   PutModuleStartQuad - Places QuadNumber into the Module symbol, Sym.
+                        QuadNumber is the start quad of Module,
+                        Sym.
+*)
+
+PROCEDURE PutModuleStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: Module.StartQuad := QuadNumber |
+      DefImpSym: DefImp.StartQuad := QuadNumber
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END PutModuleStartQuad ;
+
+
+(*
+   PutModuleEndQuad - Places QuadNumber into the Module symbol, Sym.
+                      QuadNumber is the end quad of Module,
+                      Sym.
+*)
+
+PROCEDURE PutModuleEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: Module.EndQuad := QuadNumber |
+      DefImpSym: DefImp.EndQuad := QuadNumber
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END PutModuleEndQuad ;
+
+
+(*
+   PutModuleFinallyStartQuad - Places QuadNumber into the Module symbol, Sym.
+                               QuadNumber is the finally start quad of
+                               Module, Sym.
+*)
+
+PROCEDURE PutModuleFinallyStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: Module.StartFinishQuad := QuadNumber |
+      DefImpSym: DefImp.StartFinishQuad := QuadNumber
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END PutModuleFinallyStartQuad ;
+
+
+(*
+   PutModuleFinallyEndQuad - Places QuadNumber into the Module symbol, Sym.
+                             QuadNumber is the end quad of the finally block
+                             in Module, Sym.
+*)
+
+PROCEDURE PutModuleFinallyEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: Module.EndFinishQuad := QuadNumber |
+      DefImpSym: DefImp.EndFinishQuad := QuadNumber
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END PutModuleFinallyEndQuad ;
+
+
+(*
+   GetModuleQuads - Returns, StartInit EndInit StartFinish EndFinish,
+                    Quads of a Module, Sym.
+                    Start and End represent the initialization code
+                    of the Module, Sym.
+*)
+
+PROCEDURE GetModuleQuads (Sym: CARDINAL;
+                          VAR StartInit, EndInit,
+                          StartFinish, EndFinish: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: WITH Module DO
+                    StartInit := StartQuad ;
+                    EndInit := EndQuad ;
+                    StartFinish := StartFinishQuad ;
+                    EndFinish := EndFinishQuad
+                 END |
+      DefImpSym: WITH DefImp DO
+                    StartInit := StartQuad ;
+                    EndInit := EndQuad ;
+                    StartFinish := StartFinishQuad ;
+                    EndFinish := EndFinishQuad
+                 END
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END GetModuleQuads ;
+
+
+(*
+   PutModuleFinallyFunction - Places Tree, finally, into the Module symbol, Sym.
+*)
+
+PROCEDURE PutModuleFinallyFunction (Sym: CARDINAL; finally: Tree) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: Module.FinallyFunction := finally |
+      DefImpSym: DefImp.FinallyFunction := finally
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END PutModuleFinallyFunction ;
+
+
+(*
+   GetModuleFinallyFunction - returns the finally tree from the Module symbol, Sym.
+*)
+
+PROCEDURE GetModuleFinallyFunction (Sym: CARDINAL) : Tree ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ModuleSym: RETURN( Module.FinallyFunction) |
+      DefImpSym: RETURN( DefImp.FinallyFunction)
+
+      ELSE
+         InternalError ('expecting a Module or DefImp symbol')
+      END
+   END
+END GetModuleFinallyFunction ;
+
+
+(*
+   PutProcedureScopeQuad - Places QuadNumber into the Procedure symbol, Sym.
+                           QuadNumber is the start quad of scope for procedure,
+                           Sym.
+*)
+
+PROCEDURE PutProcedureScopeQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.ScopeQuad := QuadNumber
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END PutProcedureScopeQuad ;
+
+
+(*
+   PutProcedureStartQuad - Places QuadNumber into the Procedure symbol, Sym.
+                           QuadNumber is the start quad of procedure,
+                           Sym.
+*)
+
+PROCEDURE PutProcedureStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.StartQuad := QuadNumber
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END PutProcedureStartQuad ;
+
+
+(*
+   PutProcedureEndQuad - Places QuadNumber into the Procedure symbol, Sym.
+                         QuadNumber is the end quad of procedure,
+                         Sym.
+*)
+
+PROCEDURE PutProcedureEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.EndQuad := QuadNumber
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END PutProcedureEndQuad ;
+
+
+(*
+   GetProcedureQuads - Returns, Start and End, Quads of a procedure, Sym.
+*)
+
+PROCEDURE GetProcedureQuads (Sym: CARDINAL; VAR scope, start, end: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: WITH Procedure DO
+                       scope := ScopeQuad ;
+                       start := StartQuad ;
+                       end := EndQuad
+                    END
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END GetProcedureQuads ;
+
+
+(*
+   GetReadQuads - assigns Start and End to the beginning and end of
+                  symbol, Sym, read history usage.
+*)
+
+PROCEDURE GetReadQuads (Sym: CARDINAL; m: ModeOfAddr;
+                        VAR Start, End: CARDINAL) ;
+BEGIN
+   GetReadLimitQuads(Sym, m, 0, 0, Start, End)
+END GetReadQuads ;
+
+
+(*
+   GetWriteQuads - assigns Start and End to the beginning and end of
+                   symbol, Sym, usage.
+*)
+
+PROCEDURE GetWriteQuads (Sym: CARDINAL; m: ModeOfAddr;
+                         VAR Start, End: CARDINAL) ;
+BEGIN
+   GetWriteLimitQuads(Sym, m, 0, 0, Start, End)
+END GetWriteQuads ;
+
+
+(*
+   PutProcedureBegin - assigns begin as the token number matching the
+                       procedure BEGIN.
+*)
+
+PROCEDURE PutProcedureBegin (Sym: CARDINAL; begin: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.Begin := begin
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END PutProcedureBegin ;
+
+
+(*
+   PutProcedureEnd - assigns end as the token number matching the
+                     procedure END.
+*)
+
+PROCEDURE PutProcedureEnd (Sym: CARDINAL; end: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: Procedure.End := end
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END PutProcedureEnd ;
+
+
+(*
+   GetProcedureBeginEnd - assigns, begin, end, to the stored token values.
+*)
+
+PROCEDURE GetProcedureBeginEnd (Sym: CARDINAL; VAR begin, end: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: begin := Procedure.Begin ;
+                    end := Procedure.End
+
+      ELSE
+         InternalError ('expecting a Procedure symbol')
+      END
+   END
+END GetProcedureBeginEnd ;
+
+
+(*
+   Max -
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a>b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Max ;
+
+
+(*
+   Min -
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+(*
+   GetQuads - assigns Start and End to the beginning and end of
+              symbol, Sym, usage.
+*)
+
+PROCEDURE GetQuads (Sym: CARDINAL; m: ModeOfAddr; VAR Start, End: CARDINAL) ;
+VAR
+   StartRead, EndRead,
+   StartWrite, EndWrite: CARDINAL ;
+BEGIN
+   GetReadQuads(Sym, m, StartRead, EndRead) ;
+   GetWriteQuads(Sym, m, StartWrite, EndWrite) ;
+   IF StartRead=0
+   THEN
+      Start := StartWrite
+   ELSIF StartWrite=0
+   THEN
+      Start := StartRead
+   ELSE
+      Start := Min(StartRead, StartWrite)
+   END ;
+   IF EndRead=0
+   THEN
+      End := EndWrite
+   ELSIF EndWrite=0
+   THEN
+      End := EndRead
+   ELSE
+      End := Max(EndRead, EndWrite)
+   END
+END GetQuads ;
+
+
+(*
+   PutReadQuad - places Quad into the list of symbol usage.
+*)
+
+PROCEDURE PutReadQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: IncludeItemIntoList(Var.ReadUsageList[m], Quad)
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END
+END PutReadQuad ;
+
+
+(*
+   RemoveReadQuad - places Quad into the list of symbol usage.
+*)
+
+PROCEDURE RemoveReadQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: RemoveItemFromList(Var.ReadUsageList[m], Quad)
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END
+END RemoveReadQuad ;
+
+
+(*
+   PutWriteQuad - places Quad into the list of symbol usage.
+*)
+
+PROCEDURE PutWriteQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: IncludeItemIntoList(Var.WriteUsageList[m], Quad)
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END
+END PutWriteQuad ;
+
+
+(*
+   RemoveWriteQuad - places Quad into the list of symbol usage.
+*)
+
+PROCEDURE RemoveWriteQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: RemoveItemFromList(Var.WriteUsageList[m], Quad)
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END
+END RemoveWriteQuad ;
+
+
+(*
+   DoFindLimits - assigns, Start, and, End, to the start and end
+                  limits contained in the list, l.  It ensures that
+                  Start and End are within StartLimit..EndLimit.
+                  If StartLimit or EndLimit are 0 then Start is
+                  is set to the first value and End to the last.
+*)
+
+PROCEDURE DoFindLimits (StartLimit, EndLimit: CARDINAL;
+                        VAR Start, End: CARDINAL; l: List) ;
+VAR
+   i, j, n: CARDINAL ;
+BEGIN
+   End := 0 ;
+   Start := 0 ;
+   i := 1 ;
+   n := NoOfItemsInList(l) ;
+   WHILE i<=n DO
+      j := GetItemFromList(l, i) ;
+      IF (j>End) AND (j>=StartLimit) AND ((j<=EndLimit) OR (EndLimit=0))
+      THEN
+         End := j
+      END ;
+      IF ((Start=0) OR (j<Start)) AND (j#0) AND (j>=StartLimit) AND
+         ((j<=EndLimit) OR (EndLimit=0))
+      THEN
+         Start := j
+      END ;
+      INC(i)
+   END
+END DoFindLimits ;
+
+
+(*
+   GetReadLimitQuads - returns Start and End which have been assigned
+                       the start and end of when the symbol was read
+                       to within: StartLimit..EndLimit.
+*)
+
+PROCEDURE GetReadLimitQuads (Sym: CARDINAL; m: ModeOfAddr;
+                             StartLimit, EndLimit: CARDINAL;
+                             VAR Start, End: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: DoFindLimits(StartLimit, EndLimit, Start, End,
+                           Var.ReadUsageList[m])
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END
+END GetReadLimitQuads ;
+
+
+(*
+   GetWriteLimitQuads - returns Start and End which have been assigned
+                        the start and end of when the symbol was written
+                        to within: StartLimit..EndLimit.
+*)
+
+PROCEDURE GetWriteLimitQuads (Sym: CARDINAL; m: ModeOfAddr;
+                              StartLimit, EndLimit: CARDINAL;
+                              VAR Start, End: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym     : DoFindLimits(StartLimit, EndLimit, Start, End,
+                                Var.WriteUsageList[m])
+
+      ELSE
+         InternalError ('expecting a Var symbol')
+      END
+   END
+END GetWriteLimitQuads ;
+
+
+(*
+   GetNthProcedure - Returns the Nth procedure in Module, Sym.
+*)
+
+PROCEDURE GetNthProcedure (Sym: CARDINAL; n: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym: RETURN( GetItemFromList(DefImp.ListOfProcs, n) ) |
+      ModuleSym: RETURN( GetItemFromList(Module.ListOfProcs, n) )
+
+      ELSE
+         InternalError ('expecting a DefImp or Module symbol')
+      END
+   END
+END GetNthProcedure ;
+
+
+(*
+   GetDeclaredDefinition - returns the token where this symbol
+                           was declared in the definition module.
+*)
+
+PROCEDURE GetDeclaredDefinition (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym           : RETURN( Error.At.DefDeclared ) |
+      ObjectSym          : RETURN( Object.At.DefDeclared ) |
+      VarientSym         : RETURN( Varient.At.DefDeclared ) |
+      RecordSym          : RETURN( Record.At.DefDeclared ) |
+      SubrangeSym        : RETURN( Subrange.At.DefDeclared ) |
+      EnumerationSym     : RETURN( Enumeration.At.DefDeclared ) |
+      ArraySym           : RETURN( Array.At.DefDeclared ) |
+      SubscriptSym       : RETURN( Subscript.At.DefDeclared ) |
+      UnboundedSym       : RETURN( Unbounded.At.DefDeclared ) |
+      ProcedureSym       : RETURN( Procedure.At.DefDeclared ) |
+      ProcTypeSym        : RETURN( ProcType.At.DefDeclared ) |
+      ParamSym           : RETURN( Param.At.DefDeclared ) |
+      VarParamSym        : RETURN( VarParam.At.DefDeclared ) |
+      ConstStringSym     : RETURN( ConstString.At.DefDeclared ) |
+      ConstLitSym        : RETURN( ConstLit.At.DefDeclared ) |
+      ConstVarSym        : RETURN( ConstVar.At.DefDeclared ) |
+      VarSym             : RETURN( Var.At.DefDeclared ) |
+      TypeSym            : RETURN( Type.At.DefDeclared ) |
+      PointerSym         : RETURN( Pointer.At.DefDeclared ) |
+      RecordFieldSym     : RETURN( RecordField.At.DefDeclared ) |
+      VarientFieldSym    : RETURN( VarientField.At.DefDeclared ) |
+      EnumerationFieldSym: RETURN( EnumerationField.At.DefDeclared ) |
+      SetSym             : RETURN( Set.At.DefDeclared ) |
+      DefImpSym          : RETURN( DefImp.At.DefDeclared ) |
+      ModuleSym          : RETURN( Module.At.DefDeclared ) |
+      UndefinedSym       : RETURN( GetFirstUsed(Sym) ) |
+      ImportSym          : RETURN( Import.at.DefDeclared ) |
+      ImportStatementSym : RETURN( ImportStatement.at.DefDeclared ) |
+      PartialUnboundedSym: RETURN( GetDeclaredDefinition(PartialUnbounded.Type) )
+
+      ELSE
+         InternalError ('not expecting this type of symbol')
+      END
+   END
+END GetDeclaredDefinition ;
+
+
+(*
+   GetDeclaredModule - returns the token where this symbol was declared
+                       in an implementation or program module.
+*)
+
+PROCEDURE GetDeclaredModule (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym           : RETURN( Error.At.ModDeclared ) |
+      ObjectSym          : RETURN( Object.At.ModDeclared ) |
+      VarientSym         : RETURN( Varient.At.ModDeclared ) |
+      RecordSym          : RETURN( Record.At.ModDeclared ) |
+      SubrangeSym        : RETURN( Subrange.At.ModDeclared ) |
+      EnumerationSym     : RETURN( Enumeration.At.ModDeclared ) |
+      ArraySym           : RETURN( Array.At.ModDeclared ) |
+      SubscriptSym       : RETURN( Subscript.At.ModDeclared ) |
+      UnboundedSym       : RETURN( Unbounded.At.ModDeclared ) |
+      ProcedureSym       : RETURN( Procedure.At.ModDeclared ) |
+      ProcTypeSym        : RETURN( ProcType.At.ModDeclared ) |
+      ParamSym           : RETURN( Param.At.ModDeclared ) |
+      VarParamSym        : RETURN( VarParam.At.ModDeclared ) |
+      ConstStringSym     : RETURN( ConstString.At.ModDeclared ) |
+      ConstLitSym        : RETURN( ConstLit.At.ModDeclared ) |
+      ConstVarSym        : RETURN( ConstVar.At.ModDeclared ) |
+      VarSym             : RETURN( Var.At.ModDeclared ) |
+      TypeSym            : RETURN( Type.At.ModDeclared ) |
+      PointerSym         : RETURN( Pointer.At.ModDeclared ) |
+      RecordFieldSym     : RETURN( RecordField.At.ModDeclared ) |
+      VarientFieldSym    : RETURN( VarientField.At.ModDeclared ) |
+      EnumerationFieldSym: RETURN( EnumerationField.At.ModDeclared ) |
+      SetSym             : RETURN( Set.At.ModDeclared ) |
+      DefImpSym          : RETURN( DefImp.At.ModDeclared ) |
+      ModuleSym          : RETURN( Module.At.ModDeclared ) |
+      UndefinedSym       : RETURN( GetFirstUsed(Sym) ) |
+      ImportSym          : RETURN( Import.at.ModDeclared ) |
+      ImportStatementSym : RETURN( ImportStatement.at.ModDeclared ) |
+      PartialUnboundedSym: RETURN( GetDeclaredModule(PartialUnbounded.Type) )
+
+      ELSE
+         InternalError ('not expecting this type of symbol')
+      END
+   END
+END GetDeclaredModule ;
+
+
+(*
+   PutDeclaredDefinition - associates the current tokenno with
+                           the symbols declaration in the definition
+                           module.
+*)
+
+PROCEDURE PutDeclaredDefinition (tok: CARDINAL; Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym           : Error.At.DefDeclared := tok |
+      ObjectSym          : Object.At.DefDeclared := tok |
+      VarientSym         : Varient.At.DefDeclared := tok |
+      RecordSym          : Record.At.DefDeclared := tok |
+      SubrangeSym        : Subrange.At.DefDeclared := tok |
+      EnumerationSym     : Enumeration.At.DefDeclared := tok |
+      ArraySym           : Array.At.DefDeclared := tok |
+      SubscriptSym       : Subscript.At.DefDeclared := tok |
+      UnboundedSym       : Unbounded.At.DefDeclared := tok |
+      ProcedureSym       : Procedure.At.DefDeclared := tok |
+      ProcTypeSym        : ProcType.At.DefDeclared := tok |
+      ParamSym           : Param.At.DefDeclared := tok |
+      VarParamSym        : VarParam.At.DefDeclared := tok |
+      ConstStringSym     : ConstString.At.DefDeclared := tok |
+      ConstLitSym        : ConstLit.At.DefDeclared := tok |
+      ConstVarSym        : ConstVar.At.DefDeclared := tok |
+      VarSym             : Var.At.DefDeclared := tok |
+      TypeSym            : Type.At.DefDeclared := tok |
+      PointerSym         : Pointer.At.DefDeclared := tok |
+      RecordFieldSym     : RecordField.At.DefDeclared := tok |
+      VarientFieldSym    : VarientField.At.DefDeclared := tok |
+      EnumerationFieldSym: EnumerationField.At.DefDeclared := tok |
+      SetSym             : Set.At.DefDeclared := tok |
+      DefImpSym          : DefImp.At.DefDeclared := tok |
+      ModuleSym          : Module.At.DefDeclared := tok |
+      UndefinedSym       : |
+      PartialUnboundedSym: PutDeclaredDefinition(tok, PartialUnbounded.Type)
+
+      ELSE
+         InternalError ('not expecting this type of symbol')
+      END
+   END
+END PutDeclaredDefinition ;
+
+
+(*
+   PutDeclaredModule - returns the token where this symbol was declared
+                       in an implementation or program module.
+*)
+
+PROCEDURE PutDeclaredModule (tok: CARDINAL; Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym           : Error.At.ModDeclared := tok |
+      ObjectSym          : Object.At.ModDeclared := tok |
+      VarientSym         : Varient.At.ModDeclared := tok |
+      RecordSym          : Record.At.ModDeclared := tok |
+      SubrangeSym        : Subrange.At.ModDeclared := tok |
+      EnumerationSym     : Enumeration.At.ModDeclared := tok |
+      ArraySym           : Array.At.ModDeclared := tok |
+      SubscriptSym       : Subscript.At.ModDeclared := tok |
+      UnboundedSym       : Unbounded.At.ModDeclared := tok |
+      ProcedureSym       : Procedure.At.ModDeclared := tok |
+      ProcTypeSym        : ProcType.At.ModDeclared := tok |
+      ParamSym           : Param.At.ModDeclared := tok |
+      VarParamSym        : VarParam.At.ModDeclared := tok |
+      ConstStringSym     : ConstString.At.ModDeclared := tok |
+      ConstLitSym        : ConstLit.At.ModDeclared := tok |
+      ConstVarSym        : ConstVar.At.ModDeclared := tok |
+      VarSym             : Var.At.ModDeclared := tok |
+      TypeSym            : Type.At.ModDeclared := tok |
+      PointerSym         : Pointer.At.ModDeclared := tok |
+      RecordFieldSym     : RecordField.At.ModDeclared := tok |
+      VarientFieldSym    : VarientField.At.ModDeclared := tok |
+      EnumerationFieldSym: EnumerationField.At.ModDeclared := tok |
+      SetSym             : Set.At.ModDeclared := tok |
+      DefImpSym          : DefImp.At.ModDeclared := tok |
+      ModuleSym          : Module.At.ModDeclared := tok |
+      UndefinedSym       : |
+      PartialUnboundedSym: PutDeclaredModule(tok, PartialUnbounded.Type)
+
+      ELSE
+         InternalError ('not expecting this type of symbol')
+      END
+   END
+END PutDeclaredModule ;
+
+
+(*
+   PutDeclared - adds an entry to symbol, Sym, indicating that it
+                 was declared at, tok.  This routine
+                 may be called twice, once for definition module
+                 partial declaration and once when parsing the
+                 implementation module.
+*)
+
+PROCEDURE PutDeclared (tok: CARDINAL; Sym: CARDINAL) ;
+BEGIN
+   IF CompilingDefinitionModule ()
+   THEN
+      PutDeclaredDefinition (tok, Sym)
+   ELSE
+      PutDeclaredModule (tok, Sym)
+   END
+END PutDeclared ;
+
+
+(*
+   GetDeclaredDef - returns the tokenno where the symbol was declared.
+                    The priority of declaration is definition, implementation
+                    and program module.
+*)
+
+PROCEDURE GetDeclaredDef (Sym: CARDINAL) : CARDINAL ;
+VAR
+   declared: CARDINAL ;
+BEGIN
+   declared := GetDeclaredDefinition (Sym) ;
+   IF declared = UnknownTokenNo
+   THEN
+      RETURN GetDeclaredModule (Sym)
+   END ;
+   RETURN declared
+END GetDeclaredDef ;
+
+
+(*
+   GetDeclaredMod - returns the tokenno where the symbol was declared.
+                    The priority of declaration is program,
+                    implementation and definition module.
+*)
+
+PROCEDURE GetDeclaredMod (Sym: CARDINAL) : CARDINAL ;
+VAR
+   declared: CARDINAL ;
+BEGIN
+   declared := GetDeclaredModule (Sym) ;
+   IF declared = UnknownTokenNo
+   THEN
+      RETURN GetDeclaredDefinition (Sym)
+   END ;
+   RETURN declared
+END GetDeclaredMod ;
+
+
+(*
+   GetFirstUsed - returns the token where this symbol was first used.
+*)
+
+PROCEDURE GetFirstUsed (Sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym           : RETURN( Error.At.FirstUsed ) |
+      ObjectSym          : RETURN( Object.At.FirstUsed ) |
+      UndefinedSym       : RETURN( Undefined.At.FirstUsed ) |
+      VarientSym         : RETURN( Varient.At.FirstUsed ) |
+      RecordSym          : RETURN( Record.At.FirstUsed ) |
+      SubrangeSym        : RETURN( Subrange.At.FirstUsed ) |
+      EnumerationSym     : RETURN( Enumeration.At.FirstUsed ) |
+      ArraySym           : RETURN( Array.At.FirstUsed ) |
+      SubscriptSym       : RETURN( Subscript.At.FirstUsed ) |
+      UnboundedSym       : RETURN( Unbounded.At.FirstUsed ) |
+      ProcedureSym       : RETURN( Procedure.At.FirstUsed ) |
+      ProcTypeSym        : RETURN( ProcType.At.FirstUsed ) |
+      ParamSym           : RETURN( Param.At.FirstUsed ) |
+      VarParamSym        : RETURN( VarParam.At.FirstUsed ) |
+      ConstStringSym     : RETURN( ConstString.At.FirstUsed ) |
+      ConstLitSym        : RETURN( ConstLit.At.FirstUsed ) |
+      ConstVarSym        : RETURN( ConstVar.At.FirstUsed ) |
+      VarSym             : RETURN( Var.At.FirstUsed ) |
+      TypeSym            : RETURN( Type.At.FirstUsed ) |
+      PointerSym         : RETURN( Pointer.At.FirstUsed ) |
+      RecordFieldSym     : RETURN( RecordField.At.FirstUsed ) |
+      VarientFieldSym    : RETURN( VarientField.At.FirstUsed ) |
+      EnumerationFieldSym: RETURN( EnumerationField.At.FirstUsed ) |
+      SetSym             : RETURN( Set.At.FirstUsed ) |
+      DefImpSym          : RETURN( DefImp.At.FirstUsed ) |
+      ModuleSym          : RETURN( Module.At.FirstUsed )
+
+      ELSE
+         InternalError ('not expecting this type of symbol')
+      END
+   END
+END GetFirstUsed ;
+
+
+(*
+   ForeachProcedureDo - for each procedure in module, Sym, do procedure, P.
+*)
+
+PROCEDURE ForeachProcedureDo (Sym: CARDINAL; P: PerformOperation) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : ForeachItemInListDo( DefImp.ListOfProcs, P) |
+      ModuleSym   : ForeachItemInListDo( Module.ListOfProcs, P) |
+      ProcedureSym: ForeachItemInListDo( Procedure.ListOfProcs, P)
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END ForeachProcedureDo ;
+
+
+(*
+   ForeachInnerModuleDo - for each inner module in module, Sym,
+                          do procedure, P.
+*)
+
+PROCEDURE ForeachInnerModuleDo (Sym: CARDINAL; P: PerformOperation) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      DefImpSym   : ForeachItemInListDo( DefImp.ListOfModules, P) |
+      ModuleSym   : ForeachItemInListDo( Module.ListOfModules, P) |
+      ProcedureSym: ForeachItemInListDo( Procedure.ListOfModules, P)
+
+      ELSE
+         InternalError ('expecting DefImp or Module symbol')
+      END
+   END
+END ForeachInnerModuleDo ;
+
+
+(*
+   ForeachModuleDo - for each module do procedure, P.
+*)
+
+PROCEDURE ForeachModuleDo (P: PerformOperation) ;
+BEGIN
+   ForeachNodeDo (ModuleTree, P)
+END ForeachModuleDo ;
+
+
+(*
+   ForeachFieldEnumerationDo - for each field in enumeration, Sym,
+                               do procedure, P.
+*)
+
+PROCEDURE ForeachFieldEnumerationDo (Sym: CARDINAL; P: PerformOperation) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      EnumerationSym: ForeachNodeDo( Enumeration.LocalSymbols, P)
+
+      ELSE
+         InternalError ('expecting Enumeration symbol')
+      END
+   END
+END ForeachFieldEnumerationDo ;
+
+
+(*
+   IsProcedureReachable - Returns true if the procedure, Sym, is
+                          reachable from the main Module.
+*)
+
+PROCEDURE IsProcedureReachable (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: RETURN( Procedure.Reachable )
+
+      ELSE
+         InternalError ('expecting Procedure symbol')
+      END
+   END
+END IsProcedureReachable ;
+
+
+(*
+   IsProcType - returns true if Sym is a ProcType Symbol.
+*)
+
+PROCEDURE IsProcType (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=ProcTypeSym )
+END IsProcType ;
+
+
+(*
+   IsVar - returns true if Sym is a Var Symbol.
+*)
+
+PROCEDURE IsVar (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=VarSym )
+END IsVar ;
+
+
+(*
+   DoIsConst - returns TRUE if Sym is defined as a constant
+               or is an enumeration field or string.
+*)
+
+PROCEDURE DoIsConst (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      RETURN( (SymbolType=ConstVarSym) OR
+              (SymbolType=ConstLitSym) OR
+              (SymbolType=ConstStringSym) OR
+              ((SymbolType=VarSym) AND (Var.AddrMode=ImmediateValue)) OR
+              (SymbolType=EnumerationFieldSym)
+            )
+   END
+END DoIsConst ;
+
+
+(*
+   IsConst - returns true if Sym contains a constant value.
+*)
+
+PROCEDURE IsConst (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsConstructor(Sym)
+   THEN
+      RETURN( IsConstructorConstant(Sym) )
+   ELSE
+      RETURN( DoIsConst(Sym) )
+   END
+END IsConst ;
+
+
+(*
+   IsConstString - returns whether sym is a conststring of any variant.
+*)
+
+PROCEDURE IsConstString (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      RETURN SymbolType = ConstStringSym
+   END
+END IsConstString ;
+
+
+(*
+   IsConstLit - returns true if Sym is a literal constant.
+*)
+
+PROCEDURE IsConstLit (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      RETURN( SymbolType=ConstLitSym )
+   END
+END IsConstLit ;
+
+
+(*
+   IsDummy - returns true if Sym is a Dummy symbol.
+*)
+
+PROCEDURE IsDummy (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=DummySym )
+END IsDummy ;
+
+
+(*
+   IsTemporary - returns true if Sym is a Temporary symbol.
+*)
+
+PROCEDURE IsTemporary (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym     :  RETURN( Var.IsTemp ) |
+      ConstVarSym:  RETURN( ConstVar.IsTemp )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsTemporary ;
+
+
+(*
+   IsVarAParam - returns true if Sym is a variable declared as a parameter.
+*)
+
+PROCEDURE IsVarAParam (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym: RETURN( Var.IsParam )
+
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END IsVarAParam ;
+
+
+(*
+   IsSubscript - returns true if Sym is a subscript symbol.
+*)
+
+PROCEDURE IsSubscript (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=SubscriptSym )
+END IsSubscript ;
+
+
+(*
+   IsSubrange - returns true if Sym is a subrange symbol.
+*)
+
+PROCEDURE IsSubrange (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   RETURN( pSym^.SymbolType=SubrangeSym )
+END IsSubrange ;
+
+
+(*
+   IsProcedureVariable - returns true if a Sym is a variable and
+                         it was declared within a procedure.
+*)
+
+PROCEDURE IsProcedureVariable (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   CheckLegal(Sym) ;
+   RETURN( IsVar(Sym) AND IsProcedure(GetVarScope(Sym)) )
+END IsProcedureVariable ;
+
+
+(*
+   IsProcedureNested - returns TRUE if procedure, Sym, was
+                       declared as a nested procedure.
+*)
+
+PROCEDURE IsProcedureNested (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( IsProcedure(Sym) AND (IsProcedure(GetScope(Sym))) )
+END IsProcedureNested ;
+
+
+(*
+   IsAModula2Type - returns true if Sym, is a:
+                    IsType, IsPointer, IsRecord, IsEnumeration,
+                    IsSubrange, IsArray, IsUnbounded, IsProcType.
+                    NOTE that it different from IsType.
+*)
+
+PROCEDURE IsAModula2Type (Sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   CheckLegal(Sym) ;
+   RETURN(
+           IsType(Sym) OR IsRecord(Sym) OR IsPointer(Sym) OR
+           IsEnumeration(Sym) OR IsSubrange(Sym) OR IsArray(Sym) OR
+           IsUnbounded(Sym) OR IsProcType(Sym) OR IsSet(Sym)
+         )
+END IsAModula2Type ;
+
+
+(*
+   IsGnuAsmVolatile - returns TRUE if a GnuAsm symbol was defined as VOLATILE.
+*)
+
+PROCEDURE IsGnuAsmVolatile (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: RETURN( GnuAsm.Volatile )
+
+      ELSE
+         InternalError ('expecting GnuAsm symbol')
+      END
+   END
+END IsGnuAsmVolatile ;
+
+
+(*
+   IsGnuAsmSimple - returns TRUE if a GnuAsm symbol is a simple kind.
+*)
+
+PROCEDURE IsGnuAsmSimple (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      GnuAsmSym: RETURN( GnuAsm.Simple )
+
+      ELSE
+         InternalError ('expecting GnuAsm symbol')
+      END
+   END
+END IsGnuAsmSimple ;
+
+
+(*
+   IsGnuAsm - returns TRUE if Sym is a GnuAsm symbol.
+*)
+
+PROCEDURE IsGnuAsm (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      RETURN( SymbolType=GnuAsmSym )
+   END
+END IsGnuAsm ;
+
+
+(*
+   IsRegInterface - returns TRUE if Sym is a RegInterface symbol.
+*)
+
+PROCEDURE IsRegInterface (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      RETURN( SymbolType=InterfaceSym )
+   END
+END IsRegInterface ;
+
+
+(*
+   GetParam - returns the ParamNo parameter from procedure ProcSym
+*)
+
+PROCEDURE GetParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
+BEGIN
+   CheckLegal(Sym) ;
+   IF ParamNo=0
+   THEN
+      (* Parameter Zero is the return argument for the Function *)
+      RETURN(GetType(Sym))
+   ELSE
+      RETURN(GetNthParam(Sym, ParamNo))
+   END
+END GetParam ;
+
+
+(*
+   GetFromIndex - return a value from list, i, at position, n.
+*)
+
+PROCEDURE GetFromIndex (i: Indexing.Index; n: CARDINAL) : CARDINAL ;
+VAR
+   p: POINTER TO CARDINAL ;
+BEGIN
+   p := Indexing.GetIndice(i, n) ;
+   RETURN( p^ )
+END GetFromIndex ;
+
+
+(*
+   PutIntoIndex - places value, v, into list, i, at position, n.
+*)
+
+PROCEDURE PutIntoIndex (VAR i: Indexing.Index; n: CARDINAL; v: CARDINAL) ;
+VAR
+   p: POINTER TO CARDINAL ;
+BEGIN
+   NEW(p) ;
+   p^ := v ;
+   Indexing.PutIndice(i, n, p)
+END PutIntoIndex ;
+
+
+(*
+   Make2Tuple - creates and returns a 2 tuple from, a, and, b.
+*)
+
+PROCEDURE Make2Tuple (a, b: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+   Sym : CARDINAL ;
+BEGIN
+   NewSym(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      SymbolType := TupleSym ;
+      WITH Tuple DO
+         nTuple := 2 ;
+         list := Indexing.InitIndex(1) ;
+         PutIntoIndex(list, 1, a) ;
+         PutIntoIndex(list, 2, b) ;
+         InitWhereDeclared(At) ;
+         InitWhereFirstUsed(At)
+      END
+   END ;
+   RETURN( Sym )
+END Make2Tuple ;
+
+
+(*
+   IsSizeSolved - returns true if the size of Sym is solved.
+*)
+
+PROCEDURE IsSizeSolved (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym    : RETURN( IsSolved(Procedure.Size) ) |
+      VarSym          : RETURN( IsSolved(Var.Size) ) |
+      TypeSym         : RETURN( IsSolved(Type.Size) ) |
+      SetSym          : RETURN( IsSolved(Set.Size) ) |
+      RecordSym       : RETURN( IsSolved(Record.Size) ) |
+      VarientSym      : RETURN( IsSolved(Varient.Size) ) |
+      EnumerationSym  : RETURN( IsSolved(Enumeration.Size) ) |
+      PointerSym      : RETURN( IsSolved(Pointer.Size) ) |
+      ArraySym        : RETURN( IsSolved(Array.Size) ) |
+      RecordFieldSym  : RETURN( IsSolved(RecordField.Size) ) |
+      VarientFieldSym : RETURN( IsSolved(VarientField.Size) ) |
+      SubrangeSym     : RETURN( IsSolved(Subrange.Size) ) |
+      SubscriptSym    : RETURN( IsSolved(Subscript.Size) ) |
+      ProcTypeSym     : RETURN( IsSolved(ProcType.Size) ) |
+      UnboundedSym    : RETURN( IsSolved(Unbounded.Size) )
+
+      ELSE
+         InternalError ('not expecting this kind of symbol')
+      END
+   END
+END IsSizeSolved ;
+
+
+(*
+   IsOffsetSolved - returns true if the Offset of Sym is solved.
+*)
+
+PROCEDURE IsOffsetSolved (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym          : RETURN( IsSolved(Var.Offset) ) |
+      RecordFieldSym  : RETURN( IsSolved(RecordField.Offset) ) |
+      VarientFieldSym : RETURN( IsSolved(VarientField.Offset) )
+
+      ELSE
+         InternalError ('not expecting this kind of symbol')
+      END
+   END
+END IsOffsetSolved ;
+
+
+(*
+   IsValueSolved - returns true if the value of Sym is solved.
+*)
+
+PROCEDURE IsValueSolved (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstLitSym         : RETURN( IsSolved(ConstLit.Value) ) |
+      ConstVarSym         : RETURN( IsSolved(ConstVar.Value) ) |
+      EnumerationFieldSym : RETURN( IsSolved(EnumerationField.Value) ) |
+      ConstStringSym      : RETURN( TRUE )
+
+      ELSE
+         InternalError ('not expecting this kind of symbol')
+      END
+   END
+END IsValueSolved ;
+
+
+(*
+   IsConstructorConstant - returns TRUE if constructor, Sym, is
+                           defined by only constants.
+*)
+
+PROCEDURE IsConstructorConstant (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   IF IsConstructor(Sym) OR IsConstSet(Sym)
+   THEN
+      pSym := GetPsym(Sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         ConstVarSym:  RETURN( IsValueConst(ConstVar.Value) ) |
+         ConstLitSym:  RETURN( IsValueConst(ConstLit.Value) )
+
+         ELSE
+            InternalError ('expecting Constructor')
+         END
+      END
+   ELSE
+      InternalError ('expecting Constructor')
+   END
+END IsConstructorConstant ;
+
+
+(*
+   IsComposite - returns TRUE if symbol, sym, is a composite
+                 type:  ie an ARRAY or RECORD.
+*)
+
+PROCEDURE IsComposite (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF sym=NulSym
+   THEN
+      RETURN( FALSE )
+   ELSE
+      sym := SkipType(sym) ;
+      RETURN( IsArray(sym) OR IsRecord(sym) )
+   END
+END IsComposite ;
+
+
+(*
+   IsSumOfParamSizeSolved - has the sum of parameters been solved yet?
+*)
+
+PROCEDURE IsSumOfParamSizeSolved (Sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: RETURN( IsSolved(Procedure.TotalParamSize) ) |
+      ProcTypeSym : RETURN( IsSolved(ProcType.TotalParamSize) )
+
+      ELSE
+         InternalError ('expecting Procedure or ProcType symbol')
+      END
+   END
+END IsSumOfParamSizeSolved ;
+
+
+(*
+   PushSize - pushes the size of Sym.
+*)
+
+PROCEDURE PushSize (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym    : PushFrom(Procedure.Size) |
+      VarSym          : PushFrom(Var.Size) |
+      TypeSym         : PushFrom(Type.Size) |
+      SetSym          : PushFrom(Set.Size) |
+      VarientSym      : PushFrom(Varient.Size) |
+      RecordSym       : PushFrom(Record.Size) |
+      EnumerationSym  : PushFrom(Enumeration.Size) |
+      PointerSym      : PushFrom(Pointer.Size) |
+      ArraySym        : PushFrom(Array.Size) |
+      RecordFieldSym  : PushFrom(RecordField.Size) |
+      VarientFieldSym : PushFrom(VarientField.Size) |
+      SubrangeSym     : PushFrom(Subrange.Size) |
+      SubscriptSym    : PushFrom(Subscript.Size) |
+      ProcTypeSym     : PushFrom(ProcType.Size) |
+      UnboundedSym    : PushFrom(Unbounded.Size)
+
+      ELSE
+         InternalError ('not expecting this kind of symbol')
+      END
+   END
+END PushSize ;
+
+
+(*
+   PushOffset - pushes the Offset of Sym.
+*)
+
+PROCEDURE PushOffset (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym          : PushFrom(Var.Offset) |
+      RecordFieldSym  : PushFrom(RecordField.Offset) |
+      VarientFieldSym : PushFrom(VarientField.Offset)
+
+      ELSE
+         InternalError ('not expecting this kind of symbol')
+      END
+   END
+END PushOffset ;
+
+
+(*
+   PushValue - pushes the Value of Sym onto the ALU stack.
+*)
+
+PROCEDURE PushValue (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstLitSym         : PushFrom(ConstLit.Value) |
+      ConstVarSym         : PushFrom(ConstVar.Value) |
+      EnumerationFieldSym : PushFrom(EnumerationField.Value) |
+      ConstStringSym      : PushConstString(Sym)
+
+      ELSE
+         InternalError ('not expecting this kind of symbol')
+      END
+   END
+END PushValue ;
+
+
+(*
+   PushConstString - pushes the character string onto the ALU stack.
+                     It assumes that the character string is only
+                     one character long.
+*)
+
+PROCEDURE PushConstString (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+   a   : ARRAY [0..10] OF CHAR ;
+BEGIN
+   CheckLegal (Sym) ;
+   pSym := GetPsym (Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstStringSym: WITH ConstString DO
+                         IF Length = 1
+                         THEN
+                            GetKey (Contents, a) ;
+                            PushChar (a[0])
+                         ELSE
+                            WriteFormat0 ('ConstString must be length 1')
+                         END
+                      END
+
+      ELSE
+         InternalError  ('expecting ConstString symbol')
+      END
+   END
+END PushConstString ;
+
+
+(*
+   PushParamSize - push the size of parameter, ParamNo,
+                   of procedure Sym onto the ALU stack.
+*)
+
+PROCEDURE PushParamSize (Sym: CARDINAL; ParamNo: CARDINAL) ;
+VAR
+   p, Type: CARDINAL ;
+BEGIN
+   CheckLegal(Sym) ;
+   Assert(IsProcedure(Sym) OR IsProcType(Sym)) ;
+   IF ParamNo=0
+   THEN
+      PushSize(GetType(Sym))
+   ELSE
+      (*
+         can use GetNthParam but 1..n returns parameter.
+         But 0 yields the function return type.
+
+         Note that VAR Unbounded parameters and non VAR Unbounded parameters
+              contain the unbounded descriptor. VAR unbounded parameters
+              do NOT JUST contain an address re: other VAR parameters.
+      *)
+      IF IsVarParam(Sym, ParamNo) AND (NOT IsUnboundedParam(Sym, ParamNo))
+      THEN
+         PushSize(Address)     (* VAR parameters point to the variable *)
+      ELSE
+         p := GetNthParam(Sym, ParamNo) ; (* nth Parameter *)
+         (*
+            N.B. chose to get the Type of the parameter rather than the Var
+            because ProcType's have Type but no Var associated with them.
+         *)
+         Type := GetType(p) ;  (* ie Variable from Procedure Sym *)
+         Assert(p#NulSym) ;    (* If this fails then ParamNo is out of range *)
+         PushSize(Type)
+      END
+   END
+END PushParamSize ;
+
+
+(*
+   PushSumOfLocalVarSize - push the total size of all local variables
+                           onto the ALU stack.
+*)
+
+PROCEDURE PushSumOfLocalVarSize (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym,
+      DefImpSym,
+      ModuleSym   : PushSize(Sym)
+
+      ELSE
+         InternalError ('expecting Procedure, DefImp or Module symbol')
+      END
+   END
+END PushSumOfLocalVarSize ;
+
+
+(*
+   PushSumOfParamSize - push the total size of all parameters onto
+                        the ALU stack.
+*)
+
+PROCEDURE PushSumOfParamSize (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: PushFrom(Procedure.TotalParamSize) |
+      ProcTypeSym : PushFrom(ProcType.TotalParamSize)
+
+      ELSE
+         InternalError ('expecting Procedure or ProcType symbol')
+      END
+   END
+END PushSumOfParamSize ;
+
+
+(*
+   PushVarSize - pushes the size of a variable, Sym.
+                 The runtime size of Sym will depend upon its addressing mode,
+                 RightValue has size PushSize(GetType(Sym)) and
+                 LeftValue has size PushSize(Address) since it points to a
+                 variable.
+*)
+
+PROCEDURE PushVarSize (Sym: CARDINAL) ;
+BEGIN
+   CheckLegal(Sym) ;
+   Assert(IsVar(Sym)) ;
+   IF GetMode(Sym)=LeftValue
+   THEN
+      PushSize(Address)
+   ELSE
+      Assert(GetMode(Sym)=RightValue) ;
+      PushSize(GetType(Sym))
+   END
+END PushVarSize ;
+
+
+(*
+   PopValue - pops the ALU stack into Value of Sym.
+*)
+
+PROCEDURE PopValue (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ConstLitSym         : PopInto(ConstLit.Value) |
+      ConstVarSym         : PopInto(ConstVar.Value) |
+      EnumerationFieldSym : InternalError ('cannot pop into an enumeration field')
+
+      ELSE
+         InternalError ('symbol type not expected')
+      END
+   END
+END PopValue ;
+
+
+(*
+   PopSize - pops the ALU stack into Size of Sym.
+*)
+
+PROCEDURE PopSize (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym    : PopInto(Procedure.Size) |
+      VarSym          : PopInto(Var.Size) |
+      TypeSym         : PopInto(Type.Size) |
+      RecordSym       : PopInto(Record.Size) |
+      VarientSym      : PopInto(Varient.Size) |
+      EnumerationSym  : PopInto(Enumeration.Size) |
+      PointerSym      : PopInto(Pointer.Size) |
+      ArraySym        : PopInto(Array.Size) |
+      RecordFieldSym  : PopInto(RecordField.Size) |
+      VarientFieldSym : PopInto(VarientField.Size) |
+      SubrangeSym     : PopInto(Subrange.Size) |
+      SubscriptSym    : PopInto(Subscript.Size) |
+      ProcTypeSym     : PopInto(ProcType.Size) |
+      UnboundedSym    : PopInto(Unbounded.Size) |
+      SetSym          : PopInto(Set.Size)
+
+      ELSE
+         InternalError ('not expecting this kind of symbol')
+      END
+   END
+END PopSize ;
+
+
+(*
+   PopOffset - pops the ALU stack into Offset of Sym.
+*)
+
+PROCEDURE PopOffset (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      VarSym          : PopInto(Var.Offset) |
+      RecordFieldSym  : PopInto(RecordField.Offset) |
+      VarientFieldSym : PopInto(VarientField.Offset)
+
+      ELSE
+         InternalError ('not expecting this kind of symbol')
+      END
+   END
+END PopOffset ;
+
+
+(*
+   PopSumOfParamSize - pop the total value on the ALU stack as the
+                       sum of all parameters.
+*)
+
+PROCEDURE PopSumOfParamSize (Sym: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   CheckLegal(Sym) ;
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym: PopInto(Procedure.TotalParamSize) |
+      ProcTypeSym : PopInto(ProcType.TotalParamSize)
+
+      ELSE
+         InternalError ('expecting Procedure or ProcType symbol')
+      END
+   END
+END PopSumOfParamSize ;
+
+
+(*
+   PutAlignment - assigns the alignment constant associated with,
+                  type, with, align.
+*)
+
+PROCEDURE PutAlignment (type: CARDINAL; align: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(type) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym     :  Record.Align := align |
+      RecordFieldSym:  RecordField.Align := align |
+      TypeSym       :  Type.Align := align |
+      ArraySym      :  Array.Align := align |
+      PointerSym    :  Pointer.Align := align
+
+      ELSE
+         InternalError ('expecting record, field, pointer, type or an array symbol')
+      END
+   END
+END PutAlignment ;
+
+
+(*
+   GetAlignment - returns the alignment constant associated with,
+                  type.
+*)
+
+PROCEDURE GetAlignment (type: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(type) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym      :  RETURN( Record.Align ) |
+      RecordFieldSym :  RETURN( RecordField.Align ) |
+      TypeSym        :  RETURN( Type.Align ) |
+      ArraySym       :  RETURN( Array.Align ) |
+      PointerSym     :  RETURN( Pointer.Align ) |
+      VarientFieldSym:  RETURN( GetAlignment(VarientField.Parent) ) |
+      VarientSym     :  RETURN( GetAlignment(Varient.Parent) )
+
+      ELSE
+         InternalError ('expecting record, field, pointer, type or an array symbol')
+      END
+   END
+END GetAlignment ;
+
+
+(*
+   PutDefaultRecordFieldAlignment - assigns, align, as the default alignment
+                                    to record, sym.
+*)
+
+PROCEDURE PutDefaultRecordFieldAlignment (sym: CARDINAL; align: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym:  Record.DefaultAlign := align
+
+      ELSE
+         InternalError ('expecting record symbol')
+      END
+   END
+END PutDefaultRecordFieldAlignment ;
+
+
+(*
+   GetDefaultRecordFieldAlignment - assigns, align, as the default alignment
+                                    to record, sym.
+*)
+
+PROCEDURE GetDefaultRecordFieldAlignment (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      RecordSym      :  RETURN( Record.DefaultAlign ) |
+      VarientFieldSym:  RETURN( GetDefaultRecordFieldAlignment(GetParent(sym)) ) |
+      VarientSym     :  RETURN( GetDefaultRecordFieldAlignment(GetParent(sym)) )
+
+      ELSE
+         InternalError ('expecting record symbol')
+      END
+   END
+END GetDefaultRecordFieldAlignment ;
+
+
+(*
+   DumpSymbols - display all symbol numbers and their type.
+*)
+
+(*
+PROCEDURE DumpSymbols ;
+VAR
+   pSym: PtrToSymbol ;
+   sym : CARDINAL ;
+BEGIN
+   sym := 1 ;
+   WHILE sym <= FinalSymbol () DO
+      pSym := GetPsym(sym) ;
+      printf ("%d  ", sym) ;
+      WITH pSym^ DO
+         CASE SymbolType OF
+
+         RecordSym:  printf ("RecordSym") |
+         VarientSym:  printf ("VarientSym") |
+         DummySym:  printf ("DummySym") |
+         VarSym:  printf ("VarSym") |
+         EnumerationSym:  printf ("EnumerationSym") |
+         SubrangeSym:  printf ("SubrangeSym") |
+         ArraySym:  printf ("ArraySym") |
+         ConstStringSym:  printf ("ConstStringSym") |
+         ConstVarSym:  printf ("ConstVarSym") |
+         ConstLitSym:  printf ("ConstLitSym") |
+         VarParamSym:  printf ("VarParamSym") |
+         ParamSym:  printf ("ParamSym") |
+         PointerSym:  printf ("PointerSym") |
+         UndefinedSym:  printf ("UndefinedSym") |
+         TypeSym:  printf ("TypeSym") |
+         RecordFieldSym:  printf ("RecordFieldSym") |
+         VarientFieldSym:  printf ("VarientFieldSym") |
+         EnumerationFieldSym:  printf ("EnumerationFieldSym") |
+         DefImpSym:  printf ("DefImpSym") |
+         ModuleSym:  printf ("ModuleSym") |
+         SetSym:  printf ("SetSym") |
+         ProcedureSym:  printf ("ProcedureSym") |
+         ProcTypeSym:  printf ("ProcTypeSym") |
+         SubscriptSym:  printf ("SubscriptSym") |
+         UnboundedSym:  printf ("UnboundedSym") |
+         GnuAsmSym:  printf ("GnuAsmSym") |
+         InterfaceSym:  printf ("InterfaceSym") |
+         ObjectSym:  printf ("ObjectSym") |
+         PartialUnboundedSym:  printf ("PartialUnboundedSym") |
+         TupleSym:  printf ("TupleSym") |
+         OAFamilySym:  printf ("OAFamilySym") |
+         EquivSym:  printf ("EquivSym") |
+         ErrorSym:  printf ("ErrorSym")
+
+         END
+      END ;
+      printf ("\n") ;
+      INC (sym)
+   END
+END DumpSymbols ;
+*)
+
+
+(*
+   GetErrorScope - returns the error scope for a symbol.
+                   The error scope is the title scope which is used to
+                   announce the symbol in the GCC error message.
+*)
+
+PROCEDURE GetErrorScope (sym: CARDINAL) : ErrorScope ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym:  RETURN Procedure.errorScope |
+      ModuleSym   :  RETURN Module.errorScope |
+      DefImpSym   :  RETURN DefImp.errorScope |
+      UndefinedSym:  RETURN Undefined.errorScope
+
+      ELSE
+         InternalError ('expecting procedure, module or defimp symbol')
+      END
+   END
+END GetErrorScope ;
+
+
+(*
+   PutErrorScope - sets the error scope for a symbol.
+                   The error scope is the title scope which is used to
+                   announce the symbol in the GCC error message.
+*)
+
+(*
+PROCEDURE PutErrorScope (sym: CARDINAL; errorScope: ErrorScope) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (type) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ProcedureSym:  Procedure.errorScope := errorScope |
+      ModuleSym   :  Module.errorScope := errorScope |
+      DefImpSym   :  DefImp.errorScope := errorScope
+
+      ELSE
+         InternalError ('expecting procedure, module or defimp symbol')
+      END
+   END
+END PutErrorScope ;
+*)
+
+
+(*
+   IsLegal - returns TRUE if, sym, is a legal symbol.
+*)
+
+PROCEDURE IsLegal (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN sym < FreeSymbol
+END IsLegal ;
+
+
+BEGIN
+   Init
+END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/bnflex.def b/gcc/m2/gm2-compiler/bnflex.def
new file mode 100644
index 00000000000..0deb8e3f4e7
--- /dev/null
+++ b/gcc/m2/gm2-compiler/bnflex.def
@@ -0,0 +1,156 @@
+(* bnflex.def provides a simple lexical package for pg.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE bnflex ;
+
+(*
+    Title      : bnflex
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Mon Sep 13 08:53:02 1999
+    Last edit  : Mon Sep 13 08:53:02 1999
+    Description: provides a simple lexical package for pg.
+*)
+
+FROM NameKey IMPORT Name ;
+EXPORT QUALIFIED IsSym, SymIs, TokenType, GetCurrentTokenType, GetCurrentToken,
+                 GetChar, PutChar, OpenSource, CloseSource,
+                 SkipUntilWhite, SkipWhite, SkipUntilEoln, AdvanceToken, IsReserved, PushBackToken,
+                 SetDebugging ;
+
+TYPE
+   TokenType = (identtok, literaltok, codetok, lbecomestok, rbecomestok, bartok, lsparatok, rsparatok,
+                lcparatok, rcparatok, lparatok, rparatok, errortok, tfunctok, symfunctok,
+                squotetok, dquotetok, moduletok, begintok, rulestok, endtok, lesstok, gretok,
+                tokentok, specialtok, firsttok, followtok, BNFtok, FNBtok, declarationtok,
+                epsilontok, eoftok) ;
+
+
+(*
+   OpenSource - Attempts to open the source file, a.
+                The success of the operation is returned.
+*)
+
+PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   CloseSource - Closes the current open file.
+*)
+
+PROCEDURE CloseSource ;
+
+
+(*
+   GetChar - returns the current character on the input stream.
+*)
+
+PROCEDURE GetChar () : CHAR ;
+
+
+(*
+   PutChar - pushes a character onto the push back stack, it also
+             returns the character which has been pushed.
+*)
+
+PROCEDURE PutChar (ch: CHAR) : CHAR ;
+
+
+(*
+   SymIs - if t is equal to the current token the next token is read
+           and true is returned, otherwise false is returned.
+*)
+
+PROCEDURE SymIs (t: TokenType) : BOOLEAN ;
+
+
+(*
+   IsSym - returns the result of the comparison between the current token
+           type and t.
+*)
+
+PROCEDURE IsSym (t: TokenType) : BOOLEAN ;
+
+
+(*
+   GetCurrentTokenType - returns the type of current token.
+*)
+
+PROCEDURE GetCurrentTokenType () : TokenType ;
+
+
+(*
+   GetCurrentToken - returns the NameKey of the current token.
+*)
+
+PROCEDURE GetCurrentToken () : Name ;
+
+
+(*
+   SkipUntilWhite - skips all characters until white space is seen.
+*)
+
+PROCEDURE SkipUntilWhite ;
+
+
+(*
+   SkipWhite - skips all white space.
+*)
+
+PROCEDURE SkipWhite ;
+
+
+(*
+   SkipUntilEoln - skips until a lf is seen. It consumes the lf.
+*)
+
+PROCEDURE SkipUntilEoln ;
+
+
+(*
+   AdvanceToken - advances to the next token.
+*)
+
+PROCEDURE AdvanceToken ;
+
+
+(*
+   IsReserved - returns TRUE if the name is a reserved word.
+*)
+
+PROCEDURE IsReserved (name: Name) : BOOLEAN ;
+
+
+(*
+   PushBackToken - pushes a token back onto input.
+*)
+
+PROCEDURE PushBackToken (t: Name) ;
+
+
+(*
+   SetDebugging - sets the debugging flag.
+*)
+
+PROCEDURE SetDebugging (flag: BOOLEAN) ;
+
+
+END bnflex.
diff --git a/gcc/m2/gm2-compiler/bnflex.mod b/gcc/m2/gm2-compiler/bnflex.mod
new file mode 100644
index 00000000000..46076f2e60b
--- /dev/null
+++ b/gcc/m2/gm2-compiler/bnflex.mod
@@ -0,0 +1,417 @@
+(* bnflex.mod provides a simple lexical package for pg.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE bnflex ;
+
+
+FROM PushBackInput IMPORT GetCh, PutCh, PutString, WarnError ;
+FROM SymbolKey IMPORT SymbolTree, InitTree, PutSymKey, GetSymKey ;
+FROM ASCII IMPORT tab, lf, nul ;
+FROM Debug IMPORT Halt ;
+FROM NameKey IMPORT Name, LengthKey, MakeKey, GetKey, WriteKey, NulName ;
+FROM StrLib IMPORT StrEqual, StrLen ;
+FROM FIO IMPORT File, IsNoError ;
+FROM StrCase IMPORT Lower ;
+FROM StdIO IMPORT Write ;
+
+IMPORT PushBackInput ;
+
+
+CONST
+   MaxNameLength = 8192 ;
+
+VAR
+   f            : File ;
+   ReservedWords: SymbolTree ;
+   CurrentToken : Name ;
+   CurrentType  : TokenType ;
+   Debugging    ,
+   InQuote      : BOOLEAN ;
+   QuoteChar    : CHAR ;
+
+
+(*
+   OpenSource - Attempts to open the source file, a.
+                The success of the operation is returned.
+*)
+
+PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   f := PushBackInput.Open(a) ;
+   RETURN( IsNoError(f) )
+END OpenSource ;
+
+
+(*
+   CloseSource - Closes the current open file.
+*)
+
+PROCEDURE CloseSource ;
+BEGIN
+   PushBackInput.Close(f)
+END CloseSource ;
+
+
+(*
+   GetChar - returns the current character on the input stream.
+*)
+
+PROCEDURE GetChar () : CHAR ;
+BEGIN
+   RETURN( PushBackInput.GetCh(f) )
+END GetChar ;
+
+
+(*
+   PutChar - pushes a character onto the push back stack, it also
+             returns the character which has been pushed.
+*)
+
+PROCEDURE PutChar (ch: CHAR) : CHAR ;
+BEGIN
+   RETURN( PushBackInput.PutCh(ch) )
+END PutChar ;
+
+
+(*
+   EatChar - consumes the next character in the input.
+*)
+
+PROCEDURE EatChar ;
+BEGIN
+   IF PushBackInput.GetCh(f)=nul
+   THEN
+   END
+END EatChar ;
+
+
+(*
+   IsWhite - returns TRUE if, ch, is a space or a tab.
+*)
+
+PROCEDURE IsWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( (ch=' ') OR (ch=tab) OR (ch=lf) )
+END IsWhite ;
+
+
+(*
+   SkipWhite - skips all white space.
+*)
+
+PROCEDURE SkipWhite ;
+BEGIN
+   WHILE IsWhite(PutChar(GetChar())) DO
+      EatChar
+   END
+END SkipWhite ;
+
+
+(*
+   SkipUntilEoln - skips until a lf is seen. It consumes the lf.
+*)
+
+PROCEDURE SkipUntilEoln ;
+BEGIN
+   WHILE (PutChar(GetChar())#lf) AND (PutChar(GetChar())#nul) DO
+      EatChar
+   END ;
+   IF PutChar(GetChar())=lf
+   THEN
+      EatChar
+   END
+END SkipUntilEoln ;
+
+
+(*
+   SkipUntilWhite - skips all characters until white space is seen.
+*)
+
+PROCEDURE SkipUntilWhite ;
+BEGIN
+   WHILE ((NOT IsWhite(PutChar(GetChar()))) AND (PutChar(GetChar())#nul)) OR
+         (PutChar(GetChar())=lf) DO
+      EatChar
+   END
+END SkipUntilWhite ;
+
+
+(*
+   IsReserved - returns TRUE if the name is a reserved word.
+*)
+
+PROCEDURE IsReserved (name: Name) : BOOLEAN ;
+BEGIN
+   RETURN (GetSymKey(ReservedWords, name)#0)
+END IsReserved ;
+
+
+(*
+   GetCurrentTokenType - returns the type of current token.
+*)
+
+PROCEDURE GetCurrentTokenType () : TokenType ;
+BEGIN
+   RETURN( CurrentType )
+END GetCurrentTokenType ;
+
+
+(*
+   GetCurrentToken - returns the NameKey of the current token.
+*)
+
+PROCEDURE GetCurrentToken () : Name ;
+BEGIN
+   RETURN( CurrentToken )
+END GetCurrentToken ;
+
+
+(*
+   SkipComments - consumes comments.
+*)
+
+PROCEDURE SkipComments ;
+BEGIN
+   SkipWhite ;
+   WHILE PutChar(GetChar())='-' DO
+      IF (GetChar()='-') AND (PutChar(GetChar())='-')
+      THEN
+         (* found comment, skip it *)
+         SkipUntilEoln ;
+         SkipWhite
+      ELSE
+         (* no second '-' found thus restore first '-' *)
+         IF PutChar('-')='-'
+         THEN
+         END ;
+         RETURN
+      END
+   END
+END SkipComments ;
+
+
+(*
+   WriteToken -
+*)
+
+PROCEDURE WriteToken ;
+BEGIN
+   WriteKey(CurrentToken) ; Write(' ')
+END WriteToken ;
+
+
+(*
+   AdvanceToken - advances to the next token.
+*)
+
+PROCEDURE AdvanceToken ;
+VAR
+   a: ARRAY [0..MaxNameLength] OF CHAR ;
+   i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   IF InQuote
+   THEN
+      IF CurrentType=literaltok
+      THEN
+         IF PutChar(GetChar())=QuoteChar
+         THEN
+            a[i] := GetChar() ;
+            InQuote := FALSE ;
+            INC(i) ;
+            a[i] := nul ;
+            CurrentToken := MakeKey(a) ;
+            CurrentType := VAL(TokenType, GetSymKey(ReservedWords, CurrentToken))
+         ELSE
+            IF QuoteChar='"'
+            THEN
+               WarnError('missing " at the end of a literal')
+            ELSE
+               WarnError("missing ' at the end of a literal")
+            END ;
+            InQuote := FALSE    (* to avoid a contineous list of the same error message *)
+         END
+      ELSE
+         WHILE (i<MaxNameLength) AND (PutChar(GetChar())#nul) AND
+               (PutChar(GetChar())#lf) AND (PutChar(GetChar())#QuoteChar) DO
+            a[i] := GetChar() ;
+            INC(i)
+         END ;
+         IF PutChar(GetChar())=QuoteChar
+         THEN
+            CurrentType := literaltok ;
+            a[i] := nul ;
+            CurrentToken := MakeKey(a)
+         ELSE
+            IF QuoteChar='"'
+            THEN
+               WarnError('missing " at the end of a literal')
+            ELSE
+               WarnError("missing ' at the end of a literal")
+            END ;
+            InQuote := FALSE    (* to avoid a contineous list of the same error message *)
+         END
+      END
+   ELSE
+      SkipComments ;
+
+      IF (PutChar(GetChar())='"') OR (PutChar(GetChar())="'")
+      THEN
+         a[i] := GetChar() ;
+         QuoteChar := a[i] ;
+         INC(i) ;
+         InQuote := TRUE ;
+         a[i] := nul ;
+         CurrentToken := MakeKey(a) ;
+         CurrentType := VAL(TokenType, GetSymKey(ReservedWords, CurrentToken))
+      ELSE
+         WHILE (i<MaxNameLength) AND (PutChar(GetChar())#nul) AND
+               (PutChar(GetChar())#lf) AND (PutChar(GetChar())#QuoteChar) AND
+               (NOT IsWhite(PutChar(GetChar()))) DO
+            a[i] := GetChar() ;
+            INC(i)
+         END ;
+         a[i] := nul ;
+         CurrentToken := MakeKey(a) ;
+         IF GetSymKey(ReservedWords, CurrentToken)=0
+         THEN
+            CurrentType := identtok
+         ELSE
+            CurrentType := VAL(TokenType, GetSymKey(ReservedWords, CurrentToken))
+         END
+      END
+   END ;
+   IF Debugging
+   THEN
+      WriteToken
+   END
+END AdvanceToken ;
+
+
+(*
+   SymIs - if t is equal to the current token the next token is read
+           and true is returned, otherwise false is returned.
+*)
+
+PROCEDURE SymIs (t: TokenType) : BOOLEAN ;
+BEGIN
+   IF CurrentType=t
+   THEN
+      AdvanceToken ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END SymIs ;
+
+
+(*
+   IsSym - returns the result of the comparison between the current token
+           type and t.
+*)
+
+PROCEDURE IsSym (t: TokenType) : BOOLEAN ;
+BEGIN
+   RETURN( t=CurrentType )
+END IsSym ;
+
+
+(*
+   PushBackToken - pushes a token back onto input.
+*)
+
+PROCEDURE PushBackToken (t: Name) ;
+VAR
+   a: ARRAY [0..MaxNameLength] OF CHAR ;
+BEGIN
+   GetKey(t, a) ;
+   PutString(a)
+END PushBackToken ;
+
+
+(*
+   SetDebugging - sets the debugging flag.
+*)
+
+PROCEDURE SetDebugging (flag: BOOLEAN) ;
+BEGIN
+   Debugging := flag
+END SetDebugging ;
+
+
+(*
+   Init - initialize the modules global variables.
+*)
+
+PROCEDURE Init ;
+VAR
+   a: ARRAY [0..1] OF CHAR ;
+BEGIN
+   InitTree(ReservedWords) ;
+   Debugging := FALSE ;
+
+   a[0] := nul ;
+   PutSymKey(ReservedWords, MakeKey(a)            , ORD(eoftok)) ;
+   PutSymKey(ReservedWords, MakeKey('%')          , ORD(codetok)) ;
+   PutSymKey(ReservedWords, MakeKey(':=')         , ORD(lbecomestok)) ;
+   PutSymKey(ReservedWords, MakeKey('=:')         , ORD(rbecomestok)) ;
+   PutSymKey(ReservedWords, MakeKey('|')          , ORD(bartok)) ;
+   PutSymKey(ReservedWords, MakeKey('[')          , ORD(lsparatok)) ;
+   PutSymKey(ReservedWords, MakeKey(']')          , ORD(rsparatok)) ;
+   PutSymKey(ReservedWords, MakeKey('{')          , ORD(lcparatok)) ;
+   PutSymKey(ReservedWords, MakeKey('}')          , ORD(rcparatok)) ;
+   PutSymKey(ReservedWords, MakeKey('(')          , ORD(lparatok)) ;
+   PutSymKey(ReservedWords, MakeKey(')')          , ORD(rparatok)) ;
+   PutSymKey(ReservedWords, MakeKey('<')          , ORD(lesstok)) ;
+   PutSymKey(ReservedWords, MakeKey('>')          , ORD(gretok)) ;
+   PutSymKey(ReservedWords, MakeKey('error')      , ORD(errortok)) ;
+   PutSymKey(ReservedWords, MakeKey('tokenfunc')  , ORD(tfunctok)) ;
+   PutSymKey(ReservedWords, MakeKey('symfunc')    , ORD(symfunctok)) ;
+   PutSymKey(ReservedWords, MakeKey("'")          , ORD(squotetok)) ;
+   PutSymKey(ReservedWords, MakeKey('"')          , ORD(dquotetok)) ;
+   PutSymKey(ReservedWords, MakeKey('module')     , ORD(moduletok)) ;
+   PutSymKey(ReservedWords, MakeKey('begin')      , ORD(begintok)) ;
+   PutSymKey(ReservedWords, MakeKey('rules')      , ORD(rulestok)) ;
+   PutSymKey(ReservedWords, MakeKey('end')        , ORD(endtok)) ;
+   PutSymKey(ReservedWords, MakeKey('declaration'), ORD(declarationtok)) ;
+   PutSymKey(ReservedWords, MakeKey('token')      , ORD(tokentok)) ;
+   PutSymKey(ReservedWords, MakeKey('special')    , ORD(specialtok)) ;
+   PutSymKey(ReservedWords, MakeKey('first')      , ORD(firsttok)) ;
+   PutSymKey(ReservedWords, MakeKey('follow')     , ORD(followtok)) ;
+   PutSymKey(ReservedWords, MakeKey('epsilon')    , ORD(epsilontok)) ;
+   PutSymKey(ReservedWords, MakeKey('BNF')        , ORD(BNFtok)) ;
+   PutSymKey(ReservedWords, MakeKey('FNB')        , ORD(FNBtok)) ;
+
+   CurrentToken := NulName ;
+   CurrentType  := identtok ;
+   InQuote      := FALSE
+
+END Init ;
+
+
+BEGIN
+   Init
+END bnflex.
+(*
+ * Local variables:
+ *  compile-command: "../bin2/m2f -quiet -g -verbose -M \"../libs ../gm2s\" bnflex.mod"
+ * End:
+ *)
diff --git a/gcc/m2/gm2-compiler/cflex.def b/gcc/m2/gm2-compiler/cflex.def
new file mode 100644
index 00000000000..6902bdc7821
--- /dev/null
+++ b/gcc/m2/gm2-compiler/cflex.def
@@ -0,0 +1,105 @@
+(* cflex.def provides a Modula-2 definition module for C lexical analysis.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+DEFINITION MODULE cflex ;
+
+(*
+    Title      : clex
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu Jan 23 12:39:36 2003
+    Revision   : $Version$
+    Description: provides a Modula-2 definition module for C lexical analysis.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED GetToken, AdvanceToken, CError, OpenSource, CloseSource, GetLineNo,
+                 ParsingOn, SetSearchPath, AddTypeDef ;
+
+
+(*
+   CloseSource - provided for semantic sugar
+*)
+
+PROCEDURE CloseSource ;
+
+
+(*
+   OpenSource - returns TRUE if file, s, can be opened and
+                all tokens are taken from this file.
+*)
+
+PROCEDURE OpenSource (s: ADDRESS) : BOOLEAN ;
+
+
+(*
+   GetToken - returns the ADDRESS of the next token.
+*)
+
+PROCEDURE GetToken () : ADDRESS ;
+
+
+(*
+   AdvanceToken - move onto the next token.
+*)
+
+PROCEDURE AdvanceToken ;
+
+
+(*
+   GetLineNo - returns the current line number.
+*)
+
+PROCEDURE GetLineNo () : CARDINAL ;
+
+
+(*
+   CError - displays the error message, s, after the code line and pointer
+            to the erroneous token.
+*)
+
+PROCEDURE CError (s: ADDRESS) ;
+
+
+(*
+   ParsingOn - if t is FALSE then the lexical analysis will
+               consume all lines except when a line is one of
+               '#endif' or '#else' or '#if' or '#ifdef'
+*)
+
+PROCEDURE ParsingOn (t: BOOLEAN) ;
+
+
+(*
+   SetSearchPath - reassigns the search path to newPath.
+*)
+
+PROCEDURE SetSearchPath (newPath: ADDRESS) ;
+
+
+(*
+   AddTypeDef - adds the string, a, to the list of typedefs.
+*)
+
+PROCEDURE AddTypeDef (a: ADDRESS) ;
+
+
+END cflex.
diff --git a/gcc/m2/gm2-compiler/gm2.mod b/gcc/m2/gm2-compiler/gm2.mod
new file mode 100644
index 00000000000..9f0ffbe5d87
--- /dev/null
+++ b/gcc/m2/gm2-compiler/gm2.mod
@@ -0,0 +1,52 @@
+(* gm2.mod main module of the compiler.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE gm2 ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : gm2
+   Date       : 1987  [$Date: 2013/02/11 14:45:17 $]
+   SYSTEM     : UNIX (GNU Modula-2)
+   Description: Main module of the compiler, collects arguments and
+                starts the compilation.
+   Version    : $Revision: 1.16 $
+*)
+
+FROM M2Comp IMPORT Compile ;
+FROM DynamicStrings IMPORT String, KillString, InitStringCharStar ;
+
+
+(*
+   CompileFile - compile the filename.
+*)
+
+PROCEDURE CompileFile (filename: ADDRESS) ;
+VAR
+   f: String ;
+BEGIN
+   f := InitStringCharStar(filename) ;
+   Compile(f) ;
+   f := KillString(f) ;
+END CompileFile
+
+
+END gm2.
diff --git a/gcc/m2/gm2-compiler/gm2lcc.mod b/gcc/m2/gm2-compiler/gm2lcc.mod
new file mode 100644
index 00000000000..8a89bfa0014
--- /dev/null
+++ b/gcc/m2/gm2-compiler/gm2lcc.mod
@@ -0,0 +1,842 @@
+(* gm2lcc.mod generates the link command from a list of modules.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+MODULE gm2lcc ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : gm2lcc
+   Date       : Fri Jul 24 11:45:08 BST 1992
+   Description: generates the link command from a list of modules.
+*)
+
+FROM libc IMPORT system, exit ;
+FROM SYSTEM IMPORT ADR ;
+FROM NameKey IMPORT Name, MakeKey, WriteKey, GetKey ;
+FROM M2Search IMPORT FindSourceFile, PrependSearchPath ;
+FROM M2FileName IMPORT CalculateFileName ;
+FROM SArgs IMPORT GetArg ;
+FROM StrLib IMPORT StrEqual, StrLen, StrCopy, StrConCat, StrRemoveWhitePrefix, IsSubString ;
+FROM FIO IMPORT File, StdIn, StdErr, StdOut, Close, IsNoError, EOF, WriteString, WriteLine ;
+FROM SFIO IMPORT OpenToRead, WriteS, ReadS ;
+FROM ASCII IMPORT nul ;
+FROM M2FileName IMPORT ExtractExtension ;
+FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, ConCatChar, Length, Slice, Equal, EqualArray, RemoveWhitePrefix, RemoveWhitePostfix, RemoveComment, string, Mark, InitStringChar, Dup, Mult, Assign, char ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2 ;
+FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2, fprintf3, fprintf4 ;
+FROM ObjectFiles IMPORT FileObjects, InitFileObject, KillFileObject,
+                        RegisterModuleObject, IsRegistered ;
+FROM Indexing IMPORT Index, InitIndex, GetIndice,
+                     HighIndice, LowIndice, IncludeIndiceIntoIndex,
+                     ForeachIndiceInIndexDo ;
+
+
+
+CONST
+   Comment     =     '#' ;      (* Comment leader.                 *)
+   MaxSpaces   =      20 ;      (* Maximum spaces after a module   *)
+                                (* name.                           *)
+   Debugging   =     FALSE ;
+
+VAR
+   DebugFound    : BOOLEAN ;
+   CheckFound    : BOOLEAN ;
+   VerboseFound  : BOOLEAN ;
+   ProfileFound  : BOOLEAN ;
+   LibrariesFound: BOOLEAN ;
+   TargetFound   : BOOLEAN ;
+   ExecCommand   : BOOLEAN ;    (* should we execute the final cmd *)
+   UseAr         : BOOLEAN ;    (* use 'ar' and create archive     *)
+   UseRanlib     : BOOLEAN ;    (* use 'ranlib' to index archive   *)
+   IgnoreMain    : BOOLEAN ;    (* ignore main module when linking *)
+   UseLibtool    : BOOLEAN ;    (* use libtool and suffixes?       *)
+   Shared        : BOOLEAN ;    (* is a shared library required?   *)
+   BOption,                  (* the full -B option and directory.  *)
+   FOptions,
+   CompilerDir,               (* contains the directory after -B.  *)
+   RanlibProgram,
+   ArProgram,
+   Archives,
+   Path,
+   StartupFile,
+   Libraries,
+   MainModule,
+   MainObject,
+   Command,
+   Target        : String ;
+   CmdLine,
+   objects       : FileObjects ;
+   CmdLineObjects: Index ;
+   fi, fo        : File ;       (* the input and output files      *)
+
+
+(*
+   FlushCommand - flush the command to the output file,
+                  or execute the command.
+*)
+
+PROCEDURE FlushCommand () : INTEGER ;
+BEGIN
+   IF ExecCommand
+   THEN
+      IF VerboseFound
+      THEN
+         Command := WriteS (StdOut, Command) ;
+         fprintf0 (StdOut, '\n')
+      END ;
+      RETURN system (string (Command))
+   ELSE
+      Command := WriteS (fo, Command)
+   END ;
+   RETURN 0
+END FlushCommand ;
+
+
+(*
+   GenerateLinkCommand - generate the appropriate linkage command
+                         with the correct options.
+*)
+
+PROCEDURE GenerateLinkCommand ;
+BEGIN
+   IF UseAr
+   THEN
+      Command := ConCat (ArProgram, InitString (' rc ')) ;
+      IF TargetFound
+      THEN
+         Command := ConCat (Command, Target) ;
+         Command := ConCatChar (Command, ' ')
+      ELSE
+         WriteString (StdErr, 'need target with ar') ; WriteLine (StdErr) ; Close (StdErr) ;
+         exit (1)
+      END
+   ELSIF UseLibtool
+   THEN
+      Command := InitString ('libtool --tag=CC --mode=link gcc ') ;
+      IF BOption # NIL
+      THEN
+         Command := ConCat (Command, Dup (BOption)) ;
+         Command := ConCatChar (Command, ' ')
+      END ;
+      IF DebugFound
+      THEN
+         Command := ConCat (Command, Mark (InitString ('-g ')))
+      END ;
+      IF ProfileFound
+      THEN
+         Command := ConCat(Command, Mark(InitString ('-p ')))
+      END ;
+      Command := ConCat (Command, FOptions) ;
+      IF Shared
+      THEN
+         Command := ConCat (Command, Mark (InitString ('-shared ')))
+      END ;
+      IF TargetFound
+      THEN
+         Command := ConCat (Command, Mark (InitString ('-o '))) ;
+         Command := ConCat (Command, Target) ;
+         Command := ConCatChar (Command, ' ')
+      END ;
+      IF ProfileFound
+      THEN
+         Command := ConCat (Command, Mark (InitString ('-lgmon ')))
+      END
+   END
+END GenerateLinkCommand ;
+
+
+(*
+   GenerateRanlibCommand - generate the appropriate ranlib command.
+*)
+
+PROCEDURE GenerateRanlibCommand ;
+BEGIN
+   Command := ConCat (RanlibProgram, Mark (InitStringChar (' '))) ;
+   IF TargetFound
+   THEN
+      Command := ConCat (Command, Target) ;
+      Command := ConCatChar (Command, ' ')
+   ELSE
+      WriteString (StdErr, 'need target with ranlib') ; WriteLine (StdErr) ; Close (StdErr) ;
+      exit (1)
+   END
+END GenerateRanlibCommand ;
+
+
+(*
+   RemoveLinkOnly - removes the <onlylink> prefix, if present.  This will occur
+                    for a definition for "C" module where there is no
+                    module constructor/destructor (_init and _finish pairs).
+                    Otherwise, s, is returned.
+*)
+
+PROCEDURE RemoveLinkOnly (s: String) : String ;
+VAR
+   t: String ;
+BEGIN
+   t := InitString ('<onlylink>') ;
+   IF Equal (Mark (Slice (s, 0, Length (t)-1)), t)
+   THEN
+      RETURN RemoveWhitePrefix (Slice (Mark (s), Length (t), 0))
+   ELSE
+      RETURN s
+   END
+END RemoveLinkOnly ;
+
+
+(*
+   ConCatStartupFile - check to see if the startup object file has not been added
+                       to the command line and if so add it.
+*)
+
+PROCEDURE ConCatStartupFile ;
+BEGIN
+   IF RegisterModuleObject (objects, StartupFile)
+   THEN
+      IF UseLibtool
+      THEN
+         Command := ConCat (Command, Mark (Sprintf1 (Mark (InitString ('%s.lo')),
+                                                     StartupFile)))
+      ELSE
+         Command := ConCat (Command, Mark (Sprintf1 (Mark (InitString ('%s.o')),
+                                                     StartupFile)))
+      END
+   END
+END ConCatStartupFile ;
+
+
+(*
+   GenObjectSuffix -
+*)
+
+PROCEDURE GenObjectSuffix () : String ;
+BEGIN
+   IF UseLibtool
+   THEN
+      RETURN InitString ('lo')
+   ELSE
+      RETURN InitString ('o')
+   END
+END GenObjectSuffix ;
+
+
+(*
+   GenArchiveSuffix -
+*)
+
+PROCEDURE GenArchiveSuffix () : String ;
+BEGIN
+   IF UseLibtool
+   THEN
+      RETURN InitString ('la')
+   ELSE
+      RETURN InitString ('a')
+   END
+END GenArchiveSuffix ;
+
+
+(*
+   LookupObjectFile - attempts to lookup the location of file name.extension
+                      from using the -fobject-path path.  NIL is retured if
+                      the object file is not found.  extension will be
+                      marked and deleted.
+*)
+
+PROCEDURE LookupObjectFile (name, extension: String) : String ;
+VAR
+   location,
+   filename: String ;
+BEGIN
+   filename := CalculateFileName (name, Mark (extension)) ;
+   IF FindSourceFile (filename, location)
+   THEN
+      RETURN location
+   ELSE
+      RETURN NIL
+   END
+END LookupObjectFile ;
+
+
+(*
+   ConCatModuleObject - this object will be associated with a module, therefore
+                        we remember it and make sure that it is not duplicated on the
+                        command line by the user.
+*)
+
+PROCEDURE ConCatModuleObject (module: String) ;
+VAR
+   location: String ;
+BEGIN
+   location := LookupObjectFile (module, GenObjectSuffix ()) ;
+   IF location = NIL
+   THEN
+      location := LookupObjectFile (module, GenArchiveSuffix ()) ;
+      IF location # NIL
+      THEN
+         Archives := ConCatChar (ConCat (Archives, location), ' ')
+      END
+   ELSE
+      IF RegisterModuleObject (objects, location)
+      THEN
+         Command := ConCat (ConCatChar (Command, ' '), location)
+      END
+   END
+END ConCatModuleObject ;
+
+
+(*
+   FindModulesInFileList -
+*)
+
+PROCEDURE FindModulesInFileList ;
+VAR
+   text: String ;
+BEGIN
+   REPEAT
+      text := RemoveComment (RemoveWhitePrefix( ReadS (fi)), Comment) ;
+      IF (NOT EqualArray (text, '')) AND (NOT (IgnoreMain AND Equal (text, MainModule)))
+      THEN
+         text := RemoveLinkOnly (text) ;
+         ConCatModuleObject (text)
+      END
+   UNTIL EOF (fi) ;
+   IF (NOT EqualArray (MainObject, "")) AND RegisterModuleObject (objects, MainObject)
+   THEN
+      Command := ConCat (ConCatChar (Command, ' '), MainObject)
+   END
+END FindModulesInFileList ;
+
+
+(*
+   CollectObjects -
+*)
+
+PROCEDURE CollectObjects (Command: String) : String ;
+VAR
+   i, h: CARDINAL ;
+   name: String ;
+BEGIN
+   i := 1 ;
+   h := HighIndice (CmdLineObjects) ;
+   WHILE i <= h DO
+      name := GetIndice (CmdLineObjects, i) ;
+      IF NOT IsRegistered (objects, name)
+      THEN
+         Command := ConCat (ConCatChar (Command, ' '), Dup (name))
+      END ;
+      INC (i)
+   END ;
+   IF Debugging
+   THEN
+      fprintf1 (StdErr, "objects on command line: %s\n", Command)
+   END ;
+   RETURN Command
+END CollectObjects ;
+
+
+(*
+   CollectArchives -
+*)
+
+PROCEDURE CollectArchives (Command: String) : String ;
+BEGIN
+   IF LibrariesFound
+   THEN
+      Command := ConCat (ConCatChar (Command, ' '), Libraries)
+   END ;
+   RETURN Command
+END CollectArchives ;
+
+
+(*
+   AddProgramModule - add the program module to the Command string, providing
+                      that the user did not specify it on the command line.
+*)
+
+PROCEDURE AddProgramModule (Command: String) : String ;
+BEGIN
+   IF Debugging
+   THEN
+      fprintf1 (StdErr, "mainobject: %s\n", MainObject)
+   END ;
+   IF (NOT EqualArray (MainObject, "")) AND RegisterModuleObject (objects, MainObject)
+   THEN
+      IF Debugging
+      THEN
+         fprintf1 (StdErr, "first time: %s\n", MainObject)
+      END ;
+      Command := ConCat (ConCatChar (Command, ' '), MainObject)
+   ELSE
+      IF Debugging
+      THEN
+         fprintf0 (StdErr, "(ignored)\n")
+      END
+   END ;
+   RETURN Command
+END AddProgramModule ;
+
+
+(*
+   GenCC - writes out the linkage command for the C compiler.
+*)
+
+PROCEDURE GenCC ;
+VAR
+   Error: INTEGER ;
+BEGIN
+   GenerateLinkCommand ;
+   ConCatStartupFile ;
+   FindModulesInFileList ;
+   Command := AddProgramModule (Command) ;
+   Command := ConCat (Command, Archives) ;
+   Command := CollectObjects (Command) ;
+   Command := CollectArchives (Command) ;
+   Error := FlushCommand () ;
+   IF Error=0
+   THEN
+      IF UseRanlib
+      THEN
+         GenerateRanlibCommand ;
+         Error := FlushCommand () ;
+         IF Error#0
+         THEN
+            fprintf1 (StdErr, 'ranlib failed with exit code %d\n', Error) ;
+            Close (StdErr) ;
+            exit (Error)
+         END
+      END
+   ELSE
+      fprintf1 (StdErr, 'ar failed with exit code %d\n', Error) ;
+      Close (StdErr) ;
+      exit (Error)
+   END
+END GenCC ;
+
+
+(*
+   WriteModuleName - displays a module name, ModuleName, with formatted spaces
+                     after the string.
+*)
+
+(*
+PROCEDURE WriteModuleName (ModuleName: String) ;
+BEGIN
+   ModuleName := WriteS (fo, ModuleName) ;
+   IF KillString (WriteS (fo, Mark (Mult (Mark (InitString (' ')), MaxSpaces-Length(ModuleName))))) = NIL
+   THEN
+   END
+END WriteModuleName ;
+*)
+
+
+(*
+   CheckCC - checks to see whether all the object files can be found
+             for each module.
+*)
+
+PROCEDURE CheckCC ;
+VAR
+   s, t, u: String ;
+   Error  : INTEGER ;
+BEGIN
+   Error := 0 ;
+   REPEAT
+      s := RemoveComment (RemoveWhitePrefix (ReadS (fi)), Comment) ;
+      IF NOT EqualArray (s, '')
+      THEN
+         s := RemoveLinkOnly (s) ;
+         t := Dup (s) ;
+         t := CalculateFileName (s, Mark (GenObjectSuffix ())) ;
+         IF FindSourceFile (t, u)
+         THEN
+            IF KillString (WriteS (fo, Mark (Sprintf2 (Mark (InitString ('%-20s : %s\n')), t, u)))) = NIL
+            THEN
+            END ;
+            u := KillString (u)
+         ELSE
+            t := KillString (t) ;
+            (* try finding .a archive *)
+            t := CalculateFileName (s, Mark (GenArchiveSuffix ())) ;
+            IF FindSourceFile (t, u)
+            THEN
+               IF KillString (WriteS (fo, Mark (Sprintf2 (Mark (InitString ('%-20s : %s\n')), t, u)))) = NIL
+               THEN
+               END ;
+               u := KillString (u)
+            ELSE
+               IF KillString (WriteS (fo, Mark (Sprintf1 (InitString ('%-20s : distinct object or archive not found\n'), t)))) = NIL
+               THEN
+               END ;
+               Error := 1
+            END
+         END
+      END
+   UNTIL EOF (fi) ;
+   Close (fo) ;
+   exit (Error)
+END CheckCC ;
+
+
+(*
+   ProcessTarget - copies the specified target file into Target
+                   and sets the boolean TargetFound.
+*)
+
+PROCEDURE ProcessTarget (i: CARDINAL) ;
+BEGIN
+   IF NOT GetArg (Target, i)
+   THEN
+      fprintf0 (StdErr, 'cannot get target argument after -o\n') ;
+      Close (StdErr) ;
+      exit (1)
+   END ;
+   TargetFound := TRUE
+END ProcessTarget ;
+
+
+(*
+   StripModuleExtension - returns a String without an extension from, s.
+                          It only considers '.obj', '.o' and '.lo' as
+                          extensions.
+*)
+
+PROCEDURE StripModuleExtension (s: String) : String ;
+VAR
+   t: String ;
+BEGIN
+   t := ExtractExtension (s, Mark (InitString ('.lo'))) ;
+   IF s=t
+   THEN
+      t := ExtractExtension (s, Mark (InitString ('.obj'))) ;
+      IF s=t
+      THEN
+         RETURN ExtractExtension (s, Mark(InitString('.o')))
+      END
+   END ;
+   RETURN t
+END StripModuleExtension ;
+
+
+(*
+   ProcessStartupFile - copies the specified startup file name into StartupFile.
+*)
+
+PROCEDURE ProcessStartupFile (i: CARDINAL) ;
+BEGIN
+   IF GetArg (StartupFile, i)
+   THEN
+      StartupFile := StripModuleExtension (StartupFile)
+   ELSE
+      fprintf0 (StdErr, 'cannot get startup argument after --startup\n') ;
+      Close (StdErr) ;
+      exit (1)
+   END
+END ProcessStartupFile ;
+
+
+(*
+   IsALibrary - returns TRUE if, a, is a library. If TRUE we add it to the
+                Libraries string.
+*)
+
+PROCEDURE IsALibrary (s: String) : BOOLEAN ;
+BEGIN
+   IF EqualArray (Mark (Slice (s, 0, 2)), '-l')
+   THEN
+      LibrariesFound := TRUE ;
+      Libraries := ConCat (ConCatChar (Libraries, ' '), s) ;
+      RETURN TRUE
+   ELSE
+      RETURN FALSE
+   END
+END IsALibrary ;
+
+
+(*
+   IsALibraryPath -
+*)
+
+PROCEDURE IsALibraryPath (s: String) : BOOLEAN ;
+BEGIN
+   IF EqualArray (Mark (Slice (s, 0, 2)), '-L')
+   THEN
+      IF UseLibtool
+      THEN
+         LibrariesFound := TRUE ;
+         Libraries := ConCat (ConCatChar (Libraries, ' '), s)
+      END ;
+      RETURN TRUE
+   ELSE
+      RETURN FALSE
+   END
+END IsALibraryPath ;
+
+
+(*
+   AddCommandLineObject - adds, s, to a list of objects specified on the command line.
+*)
+
+PROCEDURE AddCommandLineObject (s: String) ;
+BEGIN
+   s := Dup (s) ;
+   IncludeIndiceIntoIndex (CmdLineObjects, s) ;
+   IF RegisterModuleObject (CmdLine, s)
+   THEN
+      IF Debugging
+      THEN
+         fprintf1 (StdErr, "object registered first time: %s\n", s)
+      END
+   ELSE
+      IF Debugging
+      THEN
+         fprintf1 (StdErr, "  object ignored: %s\n", s)
+      END
+   END
+END AddCommandLineObject ;
+
+
+(*
+   IsAnObject - returns TRUE if, a, is a library.
+*)
+
+PROCEDURE IsAnObject (s: String) : BOOLEAN ;
+BEGIN
+   IF ((Length (s) > 2) AND EqualArray (Mark (Slice (s, -2, 0)), '.o')) OR
+      ((Length (s) > 4) AND EqualArray (Mark (Slice (s, -4, 0)), '.obj'))
+   THEN
+      RETURN TRUE
+   ELSE
+      RETURN FALSE
+   END
+END IsAnObject ;
+
+
+(*
+   AdditionalFOptions - add an -f option to the compiler.
+*)
+
+PROCEDURE AdditionalFOptions (s: String) ;
+BEGIN
+   FOptions := ConCat (FOptions, Mark (s)) ;
+   FOptions := ConCatChar (FOptions, ' ')
+END AdditionalFOptions ;
+
+
+(*
+   DisplayHelp -
+*)
+
+PROCEDURE DisplayHelp ;
+BEGIN
+   fprintf0 (StdErr, 'Usage: gm2lcc [-c][-g][-h][--help][--main mainmodule]\n');
+   fprintf0 (StdErr, '              [--mainobject objectname][-Bdirectory][-p][--exec][-fshared]\n');
+   fprintf0 (StdErr, '              [--ignoremain][--ar][-fobject-path=path][-ftarget-ar=arname]\n');
+   fprintf0 (StdErr, '              [-ftarget-ranlib=ranlibname][-o outputname][--startup filename]\n') ;
+   fprintf0 (StdErr, '              [-foption][-llibname][-Lpath] filename\n');
+   exit (0)
+END DisplayHelp ;
+
+
+(*
+   ScanArguments - scans arguments for flags: -fobject-path= -g and -B
+*)
+
+PROCEDURE ScanArguments ;
+VAR
+   filename,
+   s        : String ;
+   i        : CARDINAL ;
+   FoundFile: BOOLEAN ;
+BEGIN
+   FoundFile := FALSE ;
+   filename := NIL ;
+   i := 1 ;
+   WHILE GetArg (s, i) DO
+      IF EqualArray (s, '-h') OR EqualArray (s, '--help')
+      THEN
+         DisplayHelp
+      ELSIF EqualArray (s, '-g')
+      THEN
+         DebugFound := TRUE
+      ELSIF EqualArray (s, '-c')
+      THEN
+         CheckFound := TRUE
+      ELSIF EqualArray (s, '--main')
+      THEN
+         INC (i) ;
+         IF NOT GetArg (MainModule, i)
+         THEN
+            fprintf0 (StdErr, 'expecting modulename after the --main option\n') ;
+            Close (StdErr) ;
+            exit (1)
+         END
+      ELSIF EqualArray (s, '--mainobject')
+      THEN
+         INC (i) ;
+         IF GetArg (MainObject, i)
+         THEN
+            (* do nothing.  *)
+         ELSE
+            fprintf0 (StdErr, 'expecting an object file after the --mainobject option\n') ;
+            Close (StdErr) ;
+            exit (1)
+         END
+      ELSIF EqualArray (Mark (Slice (s, 0, 2)), '-B')
+      THEN
+         CompilerDir := KillString (CompilerDir) ;
+         IF Length (s) = 2
+         THEN
+            INC(i) ;
+            IF NOT GetArg (CompilerDir, i)
+            THEN
+               fprintf0 (StdErr, 'expecting path after -B option\n') ;
+               Close (StdErr) ;
+               exit (1)
+            END
+         ELSE
+            CompilerDir := Slice (s, 2, 0)
+         END ;
+         BOption := Dup (s)
+      ELSIF EqualArray (s, '-p')
+      THEN
+         ProfileFound := TRUE
+      ELSIF EqualArray (s, '-v')
+      THEN
+         VerboseFound := TRUE
+      ELSIF EqualArray (s, '--exec')
+      THEN
+         ExecCommand := TRUE
+      ELSIF EqualArray (s, '-fshared')
+      THEN
+         Shared := TRUE
+      ELSIF EqualArray (s, '--ignoremain')
+      THEN
+         IgnoreMain := TRUE
+      ELSIF EqualArray (s, '--ar')
+      THEN
+         UseAr := TRUE ;
+         UseRanlib := TRUE ;
+         UseLibtool := FALSE
+      ELSIF EqualArray (Mark (Slice (s, 0, 14)), '-fobject-path=')
+      THEN
+         PrependSearchPath (Slice (s, 14, 0))
+      ELSIF EqualArray (Mark (Slice (s, 0, 12)), '-ftarget-ar=')
+      THEN
+         ArProgram := KillString (ArProgram) ;
+         ArProgram := Slice (s, 12, 0)
+      ELSIF EqualArray (Mark (Slice (s, 0, 16)), '-ftarget-ranlib=')
+      THEN
+         RanlibProgram := KillString (RanlibProgram) ;
+         RanlibProgram := Slice (s, 16, 0)
+      ELSIF EqualArray (s, '-o')
+      THEN
+         INC (i) ;                 (* Target found *)
+         ProcessTarget (i)
+      ELSIF EqualArray (s, '--startup')
+      THEN
+         INC (i) ;                 (* Target found.  *)
+         ProcessStartupFile (i)
+      ELSIF EqualArray (Mark (Slice (s, 0, 2)), '-f')
+      THEN
+         AdditionalFOptions (s)
+      ELSIF IsALibrary (s) OR IsALibraryPath (s)
+      THEN
+      ELSIF IsAnObject (s)
+      THEN
+         AddCommandLineObject (s)
+      ELSE
+         IF FoundFile
+         THEN
+            fprintf2 (StdErr, 'already specified input filename (%s), unknown option (%s)\n', filename, s) ;
+            Close (StdErr) ;
+            exit (1)
+         ELSE
+            (* must be input filename.  *)
+            Close (StdIn) ;
+            fi := OpenToRead (s) ;
+            IF NOT IsNoError (fi)
+            THEN
+               fprintf1 (StdErr, 'failed to open %s\n', s) ;
+               Close (StdErr) ;
+               exit (1)
+            END ;
+            FoundFile := TRUE ;
+            filename := Dup (s)
+         END
+      END ;
+      INC (i)
+   END
+END ScanArguments ;
+
+
+(*
+   Init - initializes the global variables.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   DebugFound    := FALSE ;
+   CheckFound    := FALSE ;
+   TargetFound   := FALSE ;
+   ProfileFound  := FALSE ;
+   IgnoreMain    := FALSE ;
+   UseAr         := FALSE ;
+   UseLibtool    := FALSE ;
+   UseRanlib     := FALSE ;
+   VerboseFound  := FALSE ;
+   Shared        := FALSE ;
+   ArProgram     := InitString ('ar') ;
+   RanlibProgram := InitString ('ranlib') ;
+   MainModule    := InitString ('') ;
+   StartupFile   := InitString ('mod_init') ;
+   fi            := StdIn ;
+   fo            := StdOut ;
+   ExecCommand   := FALSE ;
+
+   CompilerDir   := InitString ('') ;
+
+   FOptions      := InitString ('') ;
+   Archives      := NIL ;
+   Path          := NIL ;
+   LibrariesFound:= FALSE ;
+   Libraries     := InitString ('') ;
+   Command       := NIL ;
+   Target        := NIL ;
+   BOption       := NIL ;
+   objects       := InitFileObject () ;
+   CmdLine       := InitFileObject () ;
+   CmdLineObjects:= InitIndex (1) ;
+   MainObject    := InitString ('') ;
+
+   ScanArguments ;
+   IF CheckFound
+   THEN
+      CheckCC
+   ELSE
+      GenCC
+   END ;
+   Close (fo)
+END Init ;
+
+
+BEGIN
+   Init
+END gm2lcc.
diff --git a/gcc/m2/gm2-compiler/gm2lgen.mod b/gcc/m2/gm2-compiler/gm2lgen.mod
new file mode 100644
index 00000000000..6be16b084d5
--- /dev/null
+++ b/gcc/m2/gm2-compiler/gm2lgen.mod
@@ -0,0 +1,424 @@
+(* gm2lgen.mod generates the main C function from a list of module names.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+MODULE gm2lgen ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : gm2lgen
+   Date       : Fri Sep 15 14:42:17 BST 1989
+   Description: Generates the main C function, from a list of module names.
+*)
+
+FROM libc IMPORT exit ;
+FROM ASCII IMPORT eof ;
+FROM SArgs IMPORT GetArg ;
+
+FROM Indexing IMPORT Index, InitIndex, KillIndex, HighIndice, LowIndice,
+                     IncludeIndiceIntoIndex, GetIndice ;
+
+FROM FIO IMPORT File, StdIn, StdOut, StdErr, WriteChar,
+                ReadString, WriteString, EOF, IsNoError, WriteLine, Close ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, RemoveWhitePrefix,
+                    EqualArray, Mark, Assign, Fin, InitStringChar, Length, Slice, Equal,
+                    RemoveComment ;
+
+FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2 ;
+FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1 ;
+
+
+CONST
+   Comment = '#'  ; (* Comment leader      *)
+
+VAR
+   CPlusPlus,
+   SharedLibrary,
+   NeedInitial,
+   NeedTerminate,
+   ExitNeeded   : BOOLEAN ;
+   MainName     : String ;
+   FunctionList : Index ;
+   fi, fo       : File ;
+
+
+(*
+   OpenOutputFile - attempts to open an output file.
+*)
+
+PROCEDURE OpenOutputFile (s: String) ;
+BEGIN
+   fo := OpenToWrite(s) ;
+   IF NOT IsNoError(fo)
+   THEN
+      fprintf1(StdErr, 'cannot write to: %s\n', s) ;
+      exit(1)
+   END
+END OpenOutputFile ;
+
+
+(*
+   OpenInputFile - attempts to open an input file.
+*)
+
+PROCEDURE OpenInputFile (s: String) ;
+BEGIN
+   fi := OpenToRead(s) ;
+   IF NOT IsNoError(fo)
+   THEN
+      fprintf1 (StdErr, 'cannot open: %s\n', s) ;
+      exit (1)
+   END
+END OpenInputFile ;
+
+
+(*
+   DisplayHelp - display brief help and exit.
+*)
+
+PROCEDURE DisplayHelp ;
+BEGIN
+   fprintf0 (StdErr, 'gm2lgen [--exit] [-fcpp] [-fshared] [-h] [--help] [--main function]\n');
+   fprintf0 (StdErr, '        [-o outputfile] [--terminate] [inputfile]\n');
+   exit (0)
+END DisplayHelp ;
+
+
+(*
+   ScanArgs -
+*)
+
+PROCEDURE ScanArgs ;
+VAR
+   i: CARDINAL ;
+   s: String ;
+BEGIN
+   i             := 1 ;
+   CPlusPlus     := FALSE ;
+   NeedTerminate := TRUE ;
+   NeedInitial   := TRUE ;
+   ExitNeeded    := TRUE ;
+   SharedLibrary := FALSE ;
+   MainName      := InitString('main') ;
+   fi            := StdIn ;
+   fo            := StdOut ;
+   WHILE GetArg(s, i) DO
+      IF EqualArray(s, '--exit')
+      THEN
+         ExitNeeded := FALSE
+      ELSIF EqualArray(s, '--terminate')
+      THEN
+         NeedTerminate := FALSE
+      ELSIF EqualArray(s, '--initial')
+      THEN
+         NeedInitial := FALSE
+      ELSIF EqualArray(s, '-h') OR EqualArray(s, '--help')
+      THEN
+         DisplayHelp
+      ELSIF EqualArray(s, '-fshared')
+      THEN
+         SharedLibrary := TRUE
+      ELSIF EqualArray(s, '-fcpp')
+      THEN
+         CPlusPlus := TRUE
+      ELSIF EqualArray(s, '-o')
+      THEN
+         INC(i) ;
+         IF GetArg(s, i)
+         THEN
+            OpenOutputFile(s)
+         ELSE
+            fprintf0(StdErr, 'missing filename option after -o\n') ;
+            exit(1)
+         END
+      ELSIF EqualArray(s, '--main')
+      THEN
+         INC(i) ;
+         IF GetArg(s, i)
+         THEN
+            MainName := Assign(MainName, s)
+         ELSE
+            fprintf0(StdErr, 'missing functionname after option -main\n') ;
+            exit(1)
+         END
+      ELSE
+         OpenInputFile(s)
+      END ;
+      INC(i)
+   END
+END ScanArgs ;
+
+
+(*
+   GenInit -
+*)
+
+PROCEDURE GenInit ;
+BEGIN
+   IF SharedLibrary
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((constructor)) init (void);\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((constructor)) init (void)\n'))))))
+   ELSE
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nstatic void init (int argc, char *argv[])\n')))))) ;
+   END ;
+   Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n'))))));
+   GenInitializationCalls ;
+   Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n'))))));
+END GenInit ;
+
+
+(*
+   GenFinish -
+*)
+
+PROCEDURE GenFinish ;
+BEGIN
+   IF SharedLibrary
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((destructor)) finish (void);\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nvoid __attribute__ ((destructor)) finish (void)\n'))))))
+   ELSE
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nstatic void finish (void)\n'))))))
+   END ;
+   Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n')))))) ;
+   GenFinalizationCalls ;
+   Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n'))))))
+END GenFinish ;
+
+
+(*
+   GenMain - writes out the main() function together with module initialization
+             calls.
+*)
+
+PROCEDURE GenMain ;
+BEGIN
+   FunctionList := InitIndex(1) ;
+   ScanArgs ;
+   BuildFunctionList ;
+   GenExternals ;
+   GenInit ;
+   GenFinish ;
+   IF NOT SharedLibrary
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('\nint %s (int argc, char *argv[])\n')), MainName)))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('{\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   init (argc, argv);\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   finish ();\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   return (0);\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('}\n'))))))
+   END ;
+   Close(fo)
+END GenMain ;
+
+
+(*
+   GenExternals - writes out the external prototypes for each module initializer.
+*)
+
+PROCEDURE GenExternals ;
+VAR
+   funcname: String ;
+   i, n    : CARDINAL ;
+BEGIN
+   IF ExitNeeded
+   THEN
+      Fin(WriteS(fo, Mark(InitString('extern ')))) ;
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(InitString('"C"'))))
+      END ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void exit(int);\n\n')))))) ;
+   END ;
+   IF CPlusPlus
+   THEN
+      Fin(WriteS(fo, Mark(InitString('extern "C"')))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void RTExceptions_DefaultErrorCatch(void);\n'))))))
+   END ;
+   n := HighIndice(FunctionList) ;
+   i := 1 ;
+   WHILE i<=n DO
+      funcname := GetIndice(FunctionList, i) ;
+      Fin(WriteS(fo, Mark(InitString('extern ')))) ;
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(InitString('"C"'))))
+      END ;
+      Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' void _M2_%s_init (int argc, char *argv[]);\n')), funcname)))) ;
+      Fin(WriteS(fo, Mark(InitString('extern ')))) ;
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(InitString('"C"'))))
+      END ;
+      Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString(' void _M2_%s_finish (void);\n')), funcname)))) ;
+      INC(i)
+   END ;
+   IF NeedTerminate
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nextern ')))))) ;
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(InitString('"C"'))))
+      END ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void M2RTS_ExecuteTerminationProcedures(void);\n'))))))
+   END ;
+   IF NeedInitial
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('\nextern ')))))) ;
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(InitString('"C"'))))
+      END ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString(' void M2RTS_ExecuteInitialProcedures(void);\n'))))))
+   END
+END GenExternals ;
+
+
+(*
+   GenInitializationCalls - writes out the initialization calls for the modules
+                            in the application suit.
+*)
+
+PROCEDURE GenInitializationCalls ;
+VAR
+   funcname: String ;
+   i, n    : CARDINAL ;
+BEGIN
+   n := HighIndice(FunctionList) ;
+   i := LowIndice(FunctionList) ;
+   IF CPlusPlus
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   try {\n'))))))
+   END ;
+   WHILE i<=n DO
+      IF i=n
+      THEN
+         IF NeedInitial
+         THEN
+            IF CPlusPlus
+            THEN
+               Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   '))))))
+            END ;
+            Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   M2RTS_ExecuteInitialProcedures ();\n'))))))
+         END
+      END ;
+      funcname := GetIndice(FunctionList, i) ;
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(InitString('   '))))
+      END ;
+      IF SharedLibrary
+      THEN
+         Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('    _M2_%s_init (0, (char **)0);\n')),
+                                      funcname))))
+      ELSE
+         Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('    _M2_%s_init (argc, argv);\n')),
+                                      funcname))))
+      END ;
+      INC(i)
+   END ;
+   IF CPlusPlus
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    }\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    catch (...) {\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('       RTExceptions_DefaultErrorCatch();\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    }\n'))))))
+   END ;
+END GenInitializationCalls ;
+
+
+(*
+   GenFinalizationCalls - writes out the finalization calls for the modules
+                          in the application suit.
+*)
+
+PROCEDURE GenFinalizationCalls ;
+VAR
+   funcname: String ;
+   i, n    : CARDINAL ;
+BEGIN
+   IF CPlusPlus
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   try {\n'))))))
+   END ;
+   IF NeedTerminate
+   THEN
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   '))))))
+      END ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   M2RTS_ExecuteTerminationProcedures ();\n'))))))
+   END ;
+   n := HighIndice(FunctionList) ;
+   i := LowIndice(FunctionList) ;
+   WHILE i<=n DO
+      funcname := GetIndice(FunctionList, n) ;
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   '))))))
+      END ;
+      Fin(WriteS(fo, Mark(Sprintf1(Mark(InitString('   _M2_%s_finish ();\n')),
+                                   funcname)))) ;
+      DEC(n)
+   END ;
+   IF ExitNeeded
+   THEN
+      IF CPlusPlus
+      THEN
+         Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   '))))))
+      END ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('   exit (0);\n'))))))
+   END ;
+   IF CPlusPlus
+   THEN
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    }\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    catch (...) {\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('       RTExceptions_DefaultErrorCatch();\n')))))) ;
+      Fin(WriteS(fo, Mark(Sprintf0(Mark(InitString('    }\n'))))))
+   END
+END GenFinalizationCalls ;
+
+
+(*
+   BuildFunctionList - reads in the list of functions and stores them.
+*)
+
+PROCEDURE BuildFunctionList ;
+VAR
+   s: String ;
+BEGIN
+   REPEAT
+      s := RemoveComment(RemoveWhitePrefix(ReadS(fi)), Comment) ;
+      IF (NOT Equal(Mark(InitStringChar(Comment)),
+                    Mark(Slice(s, 0, Length(Mark(InitStringChar(Comment)))-1)))) AND
+         (NOT EqualArray(s, ''))
+      THEN
+         IncludeIndiceIntoIndex(FunctionList, s)
+      END
+   UNTIL EOF(fi)
+END BuildFunctionList ;
+
+
+BEGIN
+   GenMain
+END gm2lgen.
diff --git a/gcc/m2/gm2-compiler/gm2lorder.mod b/gcc/m2/gm2-compiler/gm2lorder.mod
new file mode 100644
index 00000000000..e862b062ed5
--- /dev/null
+++ b/gcc/m2/gm2-compiler/gm2lorder.mod
@@ -0,0 +1,269 @@
+(* gm2lorder.mod ensure that underlying runtime modules are initialized.
+
+Copyright (C) 2008-2022 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/>.  *)
+
+MODULE gm2lorder ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : gm2lorder
+   Date       : Thu Sep  4 21:18:33 BST 2008
+   Description: Ensures that underlying runtime modules are initialized
+                before all other modules.
+*)
+
+
+FROM libc IMPORT exit ;
+FROM ASCII IMPORT eof ;
+FROM SArgs IMPORT GetArg ;
+FROM StrLib IMPORT StrLen ;
+FROM DynamicStrings IMPORT String, InitString, KillString, Length, Equal, EqualArray, Slice, Mark ;
+FROM Indexing IMPORT Index, PutIndice, GetIndice, RemoveIndiceFromIndex, InitIndex, KillIndex, HighIndice ;
+FROM FIO IMPORT File, StdIn, StdOut, StdErr, WriteChar, WriteLine,
+                Close, EOF, IsNoError, WriteString, FlushBuffer ;
+FROM SFIO IMPORT OpenToRead, OpenToWrite, ReadS, WriteS ;
+
+IMPORT DynamicStrings ;
+
+
+CONST
+   Comment = '#' ;               (* Comment identifier.     *)
+   DefaultRuntimeModules = 'Storage,SYSTEM,M2RTS,RTExceptions,IOLink' ;
+
+VAR
+   fi, fo    : File ;
+   runTime   : Index ;
+   moduleList: Index ;
+
+
+(*
+   InitRuntimeModules - initializes the list of critical runtime modules
+                        which must be initialized first and in a particular
+                        order.
+*)
+
+PROCEDURE InitRuntimeModules (s: String) ;
+VAR
+   a   : CARDINAL ;
+   i, j: INTEGER ;
+BEGIN
+   IF runTime # NIL
+   THEN
+      runTime := KillIndex (runTime)
+   END ;
+   runTime := InitIndex (0) ;
+   i := 0 ;
+   a := 0 ;
+   REPEAT
+      j := DynamicStrings.Index (s, ',', i) ;
+      IF j = -1
+      THEN
+         PutIndice (runTime, a, Slice (s, i, 0))
+      ELSE
+         PutIndice (runTime, a, Slice (s, i, j)) ;
+         i := j+1
+      END ;
+      INC(a)
+   UNTIL j=-1 ;
+   s := KillString (s)
+END InitRuntimeModules ;
+
+
+(*
+   Reorder - reorders the list of modules to ensure critical runtime
+             modules are initialized first.  It writes out the new
+             ordered list.
+*)
+
+PROCEDURE Reorder ;
+VAR
+   rh, mh,
+   ri, mi: CARDINAL ;
+   rs, ms: String ;
+BEGIN
+   rh := HighIndice (runTime) ;
+   mh := HighIndice (moduleList) ;
+   ri := 0 ;
+   WHILE ri <= rh DO
+      mi := 0 ;
+      rs := GetIndice (runTime, ri) ;
+      WHILE mi <= mh DO
+         ms := GetIndice (moduleList, mi) ;
+         IF Equal (rs, ms)
+         THEN
+            rs := WriteS (fo, rs) ; WriteLine (fo) ;
+            RemoveIndiceFromIndex (moduleList, ms) ;
+            mh := HighIndice (moduleList)
+         ELSE
+            INC (mi)
+         END
+      END ;
+      INC (ri)
+   END ;
+   mi := 0 ;
+   WHILE mi <= mh DO
+      ms := GetIndice (moduleList, mi) ;
+      ms := WriteS (fo, ms) ; WriteLine (fo) ;
+      INC (mi)
+   END ;
+   Close (fo)
+END Reorder ;
+
+
+(*
+   ReadList - populates the moduleList with a list of module names.
+*)
+
+PROCEDURE ReadList ;
+VAR
+   s: String ;
+   i: CARDINAL ;
+BEGIN
+   moduleList := InitIndex (0) ;
+   i := 0 ;
+   s := ReadS (fi) ;
+   WHILE NOT EOF (fi) DO
+      IF NOT EqualArray (s, '')
+      THEN
+         PutIndice (moduleList, i, s) ;
+         INC (i)
+      END ;
+      s := ReadS (fi)
+   END ;
+   IF NOT EqualArray (s, '')
+   THEN
+      PutIndice (moduleList, i, s)
+   END
+END ReadList ;
+
+
+(*
+   OpenOutputFile - attempts to open an output file.
+*)
+
+PROCEDURE OpenOutputFile (s: String) ;
+BEGIN
+   IF EqualArray(s, '-')
+   THEN
+      fo := StdOut
+   ELSE
+      fo := OpenToWrite(s) ;
+      IF NOT IsNoError(fo)
+      THEN
+         WriteString(StdErr, 'cannot write to: ') ; s := WriteS(StdErr, s) ; WriteLine(StdErr) ;
+         exit(1)
+      END
+   END
+END OpenOutputFile ;
+
+
+(*
+   Usage - prints out a usage and exits with 0.
+*)
+
+PROCEDURE Usage ;
+BEGIN
+   WriteString(StdOut, 'gm2lorder [-h] [-o outputfile] [-fruntime-modules=] inputfile') ; WriteLine(StdOut) ;
+   WriteString(StdOut, '    inputfile is a file containing a list of modules, each module on a separate line') ; WriteLine(StdOut) ;
+   WriteString(StdOut, '    the list of runtime modules can be specified as follows -fruntime-modules=module1,module2,module3') ; WriteLine(StdOut) ;
+   WriteString(StdOut, '    the default for this flag is -fruntime-modules=') ;
+   WriteString(StdOut, DefaultRuntimeModules) ; WriteLine(StdOut) ;
+   WriteString(StdOut, '    Note that the list of runtime modules does not mean they will appear in the executable') ; WriteLine(StdOut) ;
+   WriteString(StdOut, '    a runtime module is only included into the final executable if it is required,') ; WriteLine(StdOut) ;
+   WriteString(StdOut, '    however gm2lorder will ensure the order of these modules.') ; WriteLine(StdOut) ;
+   FlushBuffer(StdOut) ;
+   exit(0)
+END Usage ;
+
+
+(*
+   ScanArgs - scans arguments.
+*)
+
+PROCEDURE ScanArgs ;
+VAR
+   i        : CARDINAL ;
+   s        : String ;
+   FoundFile: BOOLEAN ;
+BEGIN
+   FoundFile := FALSE ;
+   fi        := StdIn ;
+   fo        := StdOut ;
+   i := 1 ;
+   WHILE GetArg(s, i) DO
+      IF EqualArray(s, '-o')
+      THEN
+         s := KillString(s) ;
+         INC(i) ;
+         IF GetArg(s, i)
+         THEN
+            OpenOutputFile(s)
+         ELSE
+            WriteString(StdErr, 'missing filename option after -o') ; WriteLine(StdErr) ;
+            exit(1)
+         END
+      ELSIF EqualArray(s, '-h')
+      THEN
+         Usage
+      ELSIF EqualArray(Mark(Slice(s, 0, StrLen('-fruntime-modules='))), '-fruntime-modules=')
+      THEN
+         InitRuntimeModules(Slice(s, StrLen('-fruntime-modules='), 0))
+      ELSE
+         IF FoundFile
+         THEN
+            WriteString(StdErr, 'already opened one file for reading') ; WriteLine(StdErr)
+         ELSE
+            FoundFile := TRUE ;
+            fi := OpenToRead(s) ;
+            IF NOT IsNoError(fi)
+            THEN
+               WriteString(StdErr, 'failed to open: ') ; s := WriteS(StdErr, s) ; WriteLine(StdErr) ;
+               exit(1)
+            END
+         END
+      END ;
+      INC(i)
+   END ;
+   IF NOT FoundFile
+   THEN
+      WriteString(StdErr, 'a module file list must be specified on the command line') ; WriteLine(StdErr) ;
+      exit(1)
+   END
+END ScanArgs ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   runTime := NIL ;
+   moduleList := NIL ;
+   InitRuntimeModules(InitString(DefaultRuntimeModules)) ;
+   ScanArgs ;
+   ReadList ;
+   Reorder
+END Init ;
+
+
+BEGIN
+   Init
+END gm2lorder.
diff --git a/gcc/m2/gm2-compiler/m2flex.def b/gcc/m2/gm2-compiler/m2flex.def
new file mode 100644
index 00000000000..9da7b5a5781
--- /dev/null
+++ b/gcc/m2/gm2-compiler/m2flex.def
@@ -0,0 +1,101 @@
+(* m2flex.def provides access to the C lexical implemenation m2.flex.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+DEFINITION MODULE m2flex ;
+
+(*
+    Title      : m2flex
+    Author     : Gaius Mulley
+    System     : UNIX (GNU Modula-2)
+    Date       : Tue Jul 31 17:46:41 2001
+    Last edit  : $Date: 2013/02/11 14:45:17 $
+    Revision   : $Version$
+    Description: provides a Modula-2 definition module for the C lexical
+                 analysis flex file m2.flex
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM m2linemap IMPORT location_t ;
+
+EXPORT QUALIFIED GetToken, M2Error, OpenSource, CloseSource, GetLineNo,
+                 GetColumnNo, GetLocation, GetTotalLines ;
+
+
+(*
+   CloseSource - provided for semantic sugar
+*)
+
+PROCEDURE CloseSource ;
+
+
+(*
+   OpenSource - returns TRUE if file, s, can be opened and
+                all tokens are taken from this file.
+*)
+
+PROCEDURE OpenSource (s: ADDRESS) : BOOLEAN ;
+
+
+(*
+   GetToken - returns the ADDRESS of the next token and advances to
+              the next token.
+*)
+
+PROCEDURE GetToken () : [ ADDRESS ] ;
+
+
+(*
+   GetLineNo - returns the current line number.
+*)
+
+PROCEDURE GetLineNo () : CARDINAL ;
+
+
+(*
+   GetColumnNo - returns the column where the current token starts.
+*)
+
+PROCEDURE GetColumnNo () : CARDINAL ;
+
+
+(*
+   GetLocation - returns the gcc location_t of the current token.
+*)
+
+PROCEDURE GetLocation () : location_t ;
+
+
+(*
+   M2Error - displays the error message, s, after the code line and pointer
+             to the erroneous token.
+*)
+
+PROCEDURE M2Error (s: ADDRESS) ;
+
+
+(*
+   GetTotalLines - returns the total number of lines parsed.
+*)
+
+PROCEDURE GetTotalLines () : CARDINAL ;
+
+
+END m2flex.
diff --git a/gcc/m2/gm2-compiler/ppg.mod b/gcc/m2/gm2-compiler/ppg.mod
new file mode 100644
index 00000000000..aabe1150a62
--- /dev/null
+++ b/gcc/m2/gm2-compiler/ppg.mod
@@ -0,0 +1,5515 @@
+(* ppg.mod master source file of the ebnf parser generator.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+MODULE ppg ;
+
+FROM PushBackInput IMPORT WarnError, WarnString, GetColumnPosition, GetCurrentLine ;
+FROM bnflex IMPORT IsSym, SymIs, TokenType, GetCurrentToken, GetCurrentTokenType, GetChar, PutChar,
+                   SkipWhite, SkipUntilEoln, AdvanceToken, IsReserved, OpenSource, CloseSource,
+                   PushBackToken, SetDebugging ;
+FROM StrLib IMPORT StrCopy, StrEqual, StrLen, StrConCat ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM NameKey IMPORT Name, MakeKey, WriteKey, LengthKey, GetKey, KeyToCharStar, NulName ;
+FROM NumberIO IMPORT CardToStr, WriteCard ;
+FROM SymbolKey IMPORT InitTree, SymbolTree, PutSymKey, GetSymKey, ForeachNodeDo, ContainsSymKey, NulKey ;
+FROM Lists IMPORT InitList, IsItemInList, IncludeItemIntoList, RemoveItemFromList, KillList, List ;
+FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, Mark, ConCatChar,
+                           InitStringCharStar, char, Length ;
+FROM ASCII IMPORT nul, lf, tab ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StdIO IMPORT Write ;
+FROM Debug IMPORT Halt ;
+FROM Args IMPORT GetArg, Narg ;
+FROM SYSTEM IMPORT WORD ;
+FROM libc IMPORT exit ;
+IMPORT Output ;
+
+
+CONST
+   MaxCodeHunkLength = 8192 ;
+   MaxFileName       = 8192 ;
+   MaxString         = 8192 ;
+   DefaultRecovery   = TRUE ;   (* default is to generate a parser which will recover from errors.  *)
+   MaxElementsInSet  =   32 ;
+
+   (* formatting constants *)
+   BaseRightLimit    = 75 ;
+   BaseRightMargin   = 50 ;
+   BaseNewLine       =  3 ;
+
+TYPE
+   ElementType = (idel, tokel, litel) ;
+
+   m2condition = (m2none, m2if, m2elsif, m2while) ;
+
+   TraverseResult = (unknown, true, false) ;
+
+   IdentDesc      = POINTER TO RECORD
+                                  definition: ProductionDesc ;   (* where this idents production is defined *)
+                                  name      : Name ;
+                                  line      : CARDINAL ;
+                               END ;
+
+   SetDesc        = POINTER TO RECORD
+                                  next          : SetDesc ;
+                                  CASE type: ElementType OF
+
+                                  idel  : ident : IdentDesc |
+                                  tokel,
+                                  litel : string: Name
+
+                                  END
+                               END ;
+
+(* note that epsilon refers to whether we can satisfy this component part
+   of a sentance without consuming a token. Reachend indicates we can get
+   to the end of the sentance without consuming a token.
+
+   For expression, statement, productions, terms: the epsilon value should
+   equal the reachend value but for factors the two may differ.
+*)
+
+   FollowDesc     = POINTER TO RECORD
+                                  calcfollow  : BOOLEAN ;          (* have we solved the follow set yet? *)
+                                  follow      : SetDesc ;          (* the follow set *)
+                                  reachend    : TraverseResult ;   (* can we see the end of the sentance (due to multiple epsilons) *)
+                                  epsilon     : TraverseResult ;   (* potentially no token may be consumed within this component of the sentance *)
+                                  line        : CARDINAL ;
+                    END ;
+
+   TermDesc       = POINTER TO termdesc ;
+
+   ExpressionDesc = POINTER TO RECORD
+                                  term      : TermDesc ;
+                                  followinfo: FollowDesc ;
+                                  line      : CARDINAL ;
+                               END ;
+
+   StatementDesc  = POINTER TO RECORD
+                                  ident      : IdentDesc ;
+                                  expr       : ExpressionDesc ;
+                                  followinfo : FollowDesc ;
+                                  line       : CARDINAL ;
+                               END ;
+
+   CodeHunk       = POINTER TO RECORD
+                                  codetext  : ARRAY [0..MaxCodeHunkLength] OF CHAR ;
+                                  next      : CodeHunk ;
+                               END ;
+
+   CodeDesc       = POINTER TO RECORD
+                                  code      : CodeHunk ;
+                                  indent    : CARDINAL ;         (* column of the first % *)
+                                  line      : CARDINAL ;
+                               END ;
+
+   FactorType     = (id, lit, sub, opt, mult, m2) ;
+
+   FactorDesc     = POINTER TO RECORD
+                                  followinfo: FollowDesc ;
+                                  next      : FactorDesc ;   (* chain of successive factors *)
+                                  line      : CARDINAL ;
+                                  pushed    : FactorDesc ;   (* chain of pushed code factors *)
+                                  CASE type: FactorType OF
+
+                                  id  : ident : IdentDesc |
+                                  lit : string: Name |
+                                  sub,
+                                  opt,
+                                  mult: expr  : ExpressionDesc |
+                                  m2  : code  : CodeDesc ;
+
+                                  END
+                               END ;
+
+   termdesc       =            RECORD
+                                  factor    : FactorDesc ;
+                                  next      : TermDesc ;  (* chain of alternative terms *)
+                                  followinfo: FollowDesc ;
+                                  line      : CARDINAL ;
+                               END ;
+
+   ProductionDesc = POINTER TO RECORD
+                                  next        : ProductionDesc ;   (* the chain of productions *)
+                                  statement   : StatementDesc ;
+                                  first       : SetDesc ;          (* the first set *)
+                                  firstsolved : BOOLEAN ;
+                                  followinfo  : FollowDesc ;
+                                  line        : CARDINAL ;
+                                  description : Name ;
+                               END ;
+
+   DoProcedure    = PROCEDURE (ProductionDesc) ;
+
+
+VAR
+   LastLineNo         : CARDINAL ;
+   Finished,
+   SuppressFileLineTag,
+   KeywordFormatting,
+   PrettyPrint,
+   EmitCode,
+   Texinfo,
+   Sphinx,
+   FreeDocLicense,
+   Debugging,
+   WasNoError         : BOOLEAN ;
+   LinePrologue,
+   LineEpilogue,
+   LineDeclaration    : CARDINAL ;
+   CodePrologue,
+   CodeEpilogue,
+   CodeDeclaration    : CodeHunk ;
+   CurrentProduction,
+   TailProduction,
+   HeadProduction     : ProductionDesc ;
+   CurrentExpression  : ExpressionDesc ;
+   CurrentTerm        : TermDesc ;
+   CurrentFactor      : FactorDesc ;
+   CurrentIdent       : IdentDesc ;
+   CurrentStatement   : StatementDesc ;
+   CurrentSetDesc     : SetDesc ;
+   ReverseValues,
+   Values,                           (* tree of tokens and their ORD value        *)
+   ReverseAliases,
+   Aliases            : SymbolTree ;
+   ModuleName         : Name ;
+   LastLiteral        : Name ;
+   LastIdent          : Name ;
+   SymIsProc,                        (* the name of the SymIs function tests and consumes token *)
+   TokenTypeProc,                    (* the name of the function which yields the current token type *)
+   ErrorProcArray,
+   ErrorProcString    : Name ;       (* the name of the error procedures *)
+   ArgName,
+   FileName           : ARRAY [0..MaxFileName] OF CHAR ;
+   OnLineStart,
+   BeginningOfLine    : BOOLEAN ;
+   Indent             : CARDINAL ;
+   EmittedVar         : BOOLEAN ;    (* have we written VAR yet?                   *)
+   ErrorRecovery      : BOOLEAN ;    (* do we want to recover from parsing errors? *)
+   LargestValue       : CARDINAL ;   (* the number of tokens we are using.         *)
+   InitialElement     : BOOLEAN ;    (* used to determine whether we are writing   *)
+                                     (* the first element of a case statement.     *)
+   ParametersUsed     : BITSET ;     (* which parameters have been used?           *)
+
+
+(* % declaration *)
+
+(*
+   AddEntry - adds an entry into, t, containing [def:value].
+*)
+
+PROCEDURE AddEntry (VAR t: SymbolTree; def, value: Name) ;
+BEGIN
+   IF ContainsSymKey(t, def)
+   THEN
+      WarnError1("already seen a definition for token '%s'", def)
+   ELSE
+      PutSymKey(t, def, value)
+   END
+END AddEntry ;
+
+
+(*
+   Format1 - converts string, src, into, dest, together with encapsulated
+             entity, n. It only formats the first %s or %d with n.
+*)
+
+PROCEDURE Format1 (src: ARRAY OF CHAR; n: WORD; VAR dest: ARRAY OF CHAR) ;
+VAR
+   HighSrc,
+   HighDest,
+   i, j    : CARDINAL ;
+   str     : ARRAY [0..MaxString] OF CHAR ;
+BEGIN
+   HighSrc := StrLen(src) ;
+   HighDest := HIGH(dest) ;
+   i := 0 ;
+   j := 0 ;
+   WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) AND (src[i]#'%') DO
+      dest[j] := src[i] ;
+      INC(i) ;
+      INC(j)
+   END ;
+   IF (i+1<HighSrc) AND (src[i]='%') AND (j<HighDest)
+   THEN
+      IF src[i+1]='s'
+      THEN
+         dest[j] := nul ;
+         GetKey(n, str) ;
+         StrConCat(dest, str, dest) ;
+         j := StrLen(dest) ;
+         INC(i, 2)
+      ELSIF src[i+1]='d'
+      THEN
+         dest[j] := nul ;
+         CardToStr(n, 0, str) ;
+         StrConCat(dest, str, dest) ;
+         j := StrLen(dest) ;
+         INC(i, 2)
+      ELSE
+         dest[j] := src[i] ;
+         INC(i) ;
+         INC(j)
+      END
+   END ;
+   (* and finish off copying src into dest *)
+   WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) DO
+      dest[j] := src[i] ;
+      INC(i) ;
+      INC(j)
+   END ;
+   IF j<HighDest
+   THEN
+      dest[j] := nul
+   END ;
+END Format1 ;
+
+
+(*
+   WarnError1 -
+*)
+
+PROCEDURE WarnError1 (a: ARRAY OF CHAR; n: WORD) ;
+VAR
+   line: ARRAY [0..MaxString] OF CHAR ;
+BEGIN
+   Format1(a, n, line) ;
+   WarnError(line)
+END WarnError1 ;
+
+
+(*
+   PrettyFollow -
+*)
+
+PROCEDURE PrettyFollow (start, end: ARRAY OF CHAR; f: FollowDesc) ;
+BEGIN
+   IF Debugging
+   THEN
+      Output.WriteString(start) ;
+      IF f#NIL
+      THEN
+         WITH f^ DO
+            IF calcfollow
+            THEN
+               Output.WriteString('followset defined as:') ;
+               EmitSet(follow, 0, 0)
+            END ;
+            CASE reachend OF
+
+            true :   Output.WriteString(' [E]') |
+            false:   Output.WriteString(' [C]') |
+            unknown: Output.WriteString(' [U]')
+
+            ELSE
+            END ;
+            CASE epsilon OF
+
+            true   : Output.WriteString(' [e]') |
+            false  : |
+            unknown: Output.WriteString(' [u]')
+
+            ELSE
+            END
+         END
+      END ;
+      Output.WriteString(end)
+   END
+END PrettyFollow ;
+
+
+(*
+   NewFollow - creates a new follow descriptor and returns the data structure.
+*)
+
+PROCEDURE NewFollow () : FollowDesc ;
+VAR
+   f: FollowDesc ;
+BEGIN
+   NEW(f) ;
+   WITH f^ DO
+      follow       := NIL ;
+      reachend     := unknown ;
+      epsilon      := unknown ;
+   END ;
+   RETURN( f )
+END NewFollow ;
+
+
+(*
+   AssignEpsilon - assigns the epsilon value and sets the epsilon to value,
+                   providing condition is TRUE.
+*)
+
+PROCEDURE AssignEpsilon (condition: BOOLEAN; f: FollowDesc; value: TraverseResult) ;
+BEGIN
+   WITH f^ DO
+      IF condition AND (value#unknown) AND (epsilon=unknown)
+      THEN
+         epsilon := value ;
+         Finished := FALSE
+      END
+   END
+END AssignEpsilon ;
+
+
+(*
+   GetEpsilon - returns the value of epsilon
+*)
+
+PROCEDURE GetEpsilon (f: FollowDesc) : TraverseResult ;
+BEGIN
+   IF f=NIL
+   THEN
+      Halt('why is the follow info NIL?', __LINE__, __FILE__)
+   ELSE
+      RETURN( f^.epsilon )
+   END
+END GetEpsilon ;
+
+
+(*
+   AssignReachEnd - assigns the reachend value providing that, condition, is TRUE.
+*)
+
+PROCEDURE AssignReachEnd (condition: BOOLEAN; f: FollowDesc; value: TraverseResult) ;
+BEGIN
+   IF condition
+   THEN
+      WITH f^ DO
+         IF (reachend=unknown) AND (value#unknown)
+         THEN
+            reachend := value ;
+            Finished := FALSE
+         END
+      END
+   END
+END AssignReachEnd ;
+
+
+(*
+   GetReachEnd - returns the value of reachend
+*)
+
+PROCEDURE GetReachEnd (f: FollowDesc) : TraverseResult ;
+BEGIN
+   IF f=NIL
+   THEN
+      Halt('why is the follow info NIL?', __LINE__, __FILE__)
+   ELSE
+      RETURN( f^.reachend )
+   END
+END GetReachEnd ;
+
+
+(*
+   AssignFollow - assigns the follow set and sets the calcfollow to TRUE.
+*)
+
+PROCEDURE AssignFollow (f: FollowDesc; s: SetDesc) ;
+BEGIN
+   WITH f^ DO
+      IF calcfollow
+      THEN
+         Halt('why are we reassigning this follow set?', __LINE__, __FILE__)
+      END ;
+      follow     := s ;
+      calcfollow := TRUE
+   END
+END AssignFollow ;
+
+
+(*
+   GetFollow - returns the follow set.
+*)
+
+PROCEDURE GetFollow (f: FollowDesc) : SetDesc ;
+BEGIN
+   IF f=NIL
+   THEN
+      Halt('why is the follow info NIL?', __LINE__, __FILE__)
+   ELSE
+      WITH f^ DO
+         IF calcfollow
+         THEN
+            RETURN( follow )
+         ELSE
+            Halt('not calculated the follow set yet..', __LINE__, __FILE__)
+         END
+      END
+   END
+END GetFollow ;
+
+
+(*
+   NewProduction - creates a new production and returns the data structure.
+*)
+
+PROCEDURE NewProduction () : ProductionDesc ;
+VAR
+   p: ProductionDesc ;
+BEGIN
+   NEW(p) ;
+   IF TailProduction#NIL
+   THEN
+      TailProduction^.next := p
+   END ;
+   TailProduction := p ;
+   IF HeadProduction=NIL
+   THEN
+      HeadProduction := p
+   END ;
+   WITH p^ DO
+      next         := NIL ;
+      statement    := NIL ;
+      first        := NIL ;
+      firstsolved  := FALSE ;
+      followinfo   := NewFollow() ;
+      line         := GetCurrentLine() ;
+      description  := NulName
+   END ;
+   RETURN( p )
+END NewProduction ;
+
+
+(*
+   NewFactor -
+*)
+
+PROCEDURE NewFactor () : FactorDesc ;
+VAR
+   f: FactorDesc ;
+BEGIN
+   NEW(f) ;
+   WITH f^ DO
+      next       := NIL ;
+      followinfo := NewFollow() ;
+      line       := GetCurrentLine()
+   END ;
+   RETURN( f )
+END NewFactor ;
+
+
+(*
+   NewTerm - returns a new term.
+*)
+
+PROCEDURE NewTerm () : TermDesc ;
+VAR
+   t: TermDesc ;
+BEGIN
+   NEW(t) ;
+   WITH t^ DO
+      factor     := NIL ;
+      followinfo := NewFollow() ;
+      next       := NIL ;
+      line       := GetCurrentLine()
+   END ;
+   RETURN( t )
+END NewTerm ;
+
+
+(*
+   NewExpression - returns a new expression.
+*)
+
+PROCEDURE NewExpression () : ExpressionDesc ;
+VAR
+   e: ExpressionDesc ;
+BEGIN
+   NEW(e) ;
+   WITH e^ DO
+      term       := NIL ;
+      followinfo := NewFollow() ;
+      line       := GetCurrentLine()
+   END ;
+   RETURN( e )
+END NewExpression ;
+
+
+(*
+   NewStatement - returns a new statement.
+*)
+
+PROCEDURE NewStatement () : StatementDesc ;
+VAR
+   s: StatementDesc ;
+BEGIN
+   NEW(s) ;
+   WITH s^ DO
+      ident      := NIL ;
+      expr       := NIL ;
+      followinfo := NewFollow() ;
+      line       := GetCurrentLine()
+   END ;
+   RETURN( s )
+END NewStatement ;
+
+
+(*
+   NewSetDesc - creates a new set description and returns the data structure.
+*)
+
+PROCEDURE NewSetDesc () : SetDesc ;
+VAR
+   s: SetDesc ;
+BEGIN
+   NEW(s) ;
+   WITH s^ DO
+      next := NIL
+   END ;
+   RETURN( s )
+END NewSetDesc ;
+
+
+(*
+   NewCodeDesc - creates a new code descriptor and initializes all fields to zero.
+*)
+
+PROCEDURE NewCodeDesc () : CodeDesc ;
+VAR
+   c: CodeDesc ;
+BEGIN
+   NEW(c) ;
+   WITH c^ DO
+      code   := NIL ;
+      indent := 0 ;
+      line   := GetCurrentLine()
+   END ;
+   RETURN( c )
+END NewCodeDesc ;
+
+
+(*
+   CodeFragmentPrologue - consumes code text up to a "%" after a newline.
+*)
+
+PROCEDURE CodeFragmentPrologue ;
+BEGIN
+   LinePrologue := GetCurrentLine() ;
+   GetCodeFragment(CodePrologue)
+END CodeFragmentPrologue ;
+
+
+(*
+   CodeFragmentEpilogue - consumes code text up to a "%" after a newline.
+*)
+
+PROCEDURE CodeFragmentEpilogue ;
+BEGIN
+   LineEpilogue := GetCurrentLine() ;
+   GetCodeFragment(CodeEpilogue)
+END CodeFragmentEpilogue ;
+
+
+(*
+   CodeFragmentDeclaration - consumes code text up to a "%" after a newline.
+*)
+
+PROCEDURE CodeFragmentDeclaration ;
+BEGIN
+   LineDeclaration := GetCurrentLine() ;
+   GetCodeFragment(CodeDeclaration)
+END CodeFragmentDeclaration ;
+
+
+(*
+   GetCodeFragment - collects the code fragment up until ^ %
+*)
+
+PROCEDURE GetCodeFragment (VAR h: CodeHunk) ;
+VAR
+   i : CARDINAL ;
+   ch: CHAR ;
+BEGIN
+   h := NIL ;
+   i := 0 ;
+   WHILE (PutChar(GetChar())#'%') AND (PutChar(GetChar())#nul) DO
+      REPEAT
+         WHILE (PutChar(GetChar())#nul) AND (PutChar(GetChar())#lf) DO
+            h := Add(h, GetChar(), i)
+         END ;
+         IF PutChar(GetChar())=lf
+         THEN
+            (* consume line feed *)
+            h := Add(h, GetChar(), i) ;
+            ch := PutChar(lf)
+         ELSIF PutChar(GetChar())=nul
+         THEN
+            ch := PutChar(nul) ;
+            ch := PutChar(lf)
+         ELSE
+            ch := PutChar(PutChar(GetChar()))
+         END
+      UNTIL GetChar()=lf
+   END ;
+   IF PutChar(GetChar())='%'
+   THEN
+      h := Add(h, nul, i) ;
+      ch := PutChar(' ') ;  (* to give the following token % a delimiter infront of it *)
+      AdvanceToken
+   ELSE
+      WarnError('expecting % to terminate code fragment, found end of file')
+   END
+END GetCodeFragment ;
+
+
+(*
+   WriteCodeHunkList - writes the CodeHunk list in the correct order.
+*)
+
+PROCEDURE WriteCodeHunkList (l: CodeHunk) ;
+BEGIN
+   IF l#NIL
+   THEN
+      OnLineStart := FALSE ;
+      (* recursion *)
+      WITH l^ DO
+         WriteCodeHunkList(next) ;
+         Output.WriteString(codetext)
+      END
+   END
+END WriteCodeHunkList ;
+
+
+(*
+   WriteIndent - writes, n, spaces.
+*)
+
+PROCEDURE WriteIndent (n: CARDINAL) ;
+BEGIN
+   WHILE n>0 DO
+      Output.Write(' ') ;
+      DEC(n)
+   END ;
+   OnLineStart := FALSE
+END WriteIndent ;
+
+
+(*
+   CheckWrite -
+*)
+
+PROCEDURE CheckWrite (ch: CHAR; VAR curpos: CARDINAL; left: CARDINAL; VAR seentext: BOOLEAN) ;
+BEGIN
+   IF ch=lf
+   THEN
+      NewLine(left) ;
+      curpos := 0 ;
+      seentext := FALSE
+   ELSE
+      Output.Write(ch) ;
+      INC(curpos)
+   END
+END CheckWrite ;
+
+
+(*
+   WriteStringIndent - writes a string but it will try and remove upto indent spaces
+                       if they exist.
+*)
+
+PROCEDURE WriteStringIndent (a: ARRAY OF CHAR; indent: CARDINAL;
+                             VAR curpos: CARDINAL;
+                             left: CARDINAL; VAR seentext: BOOLEAN) ;
+VAR
+   l, i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   l := StrLen(a) ;
+   WHILE i<l DO
+      IF seentext
+      THEN
+         CheckWrite(a[i], curpos, left, seentext)
+      ELSE
+         IF a[i]=' '
+         THEN
+            (* ignore space for now *)
+            INC(curpos)
+         ELSE
+            IF curpos>=indent
+            THEN
+               WriteIndent(curpos-indent)
+            END ;
+            seentext := TRUE ;
+            CheckWrite(a[i], curpos, left, seentext)
+         END
+      END ;
+      INC(i)
+   END
+END WriteStringIndent ;
+
+
+(*
+   WriteCodeHunkListIndent - writes the CodeHunk list in the correct order
+                             but it removes up to indent spaces if they exist.
+*)
+
+PROCEDURE WriteCodeHunkListIndent (l: CodeHunk; indent: CARDINAL;
+                                   VAR curpos: CARDINAL;
+                                   left: CARDINAL; VAR seentext: BOOLEAN) ;
+BEGIN
+   IF l#NIL
+   THEN
+      (* recursion *)
+      WITH l^ DO
+         WriteCodeHunkListIndent(next, indent, curpos, left, seentext) ;
+         WriteStringIndent(codetext, indent, curpos, left, seentext)
+      END
+   END
+END WriteCodeHunkListIndent ;
+
+
+(*
+   Add - adds a character to a code hunk and creates another code hunk if necessary.
+*)
+
+PROCEDURE Add (VAR p: CodeHunk; ch: CHAR; VAR i: CARDINAL) : CodeHunk ;
+VAR
+   q: CodeHunk ;
+BEGIN
+   IF (p=NIL) OR (i>MaxCodeHunkLength)
+   THEN
+      NEW(q) ;
+      q^.next := p ;
+      q^.codetext[0] := ch ;
+      i := 1 ;
+      RETURN( q )
+   ELSE
+      p^.codetext[i] := ch ;
+      INC(i) ;
+      RETURN( p )
+   END
+END Add ;
+
+
+(*
+   ConsHunk - combine two possible code hunks.
+*)
+
+PROCEDURE ConsHunk (VAR p: CodeHunk; q: CodeHunk) ;
+VAR
+   r: CodeHunk ;
+BEGIN
+   IF p#NIL
+   THEN
+      r := q ;
+      WHILE r^.next#NIL DO
+         r := r^.next
+      END ;
+      r^.next := p ;
+   END ;
+   p := q
+END ConsHunk ;
+
+
+(*
+   GetName - returns the next symbol which is checked for a legal name.
+*)
+
+PROCEDURE GetName () : Name ;
+VAR
+   name: Name ;
+BEGIN
+   IF IsReserved(GetCurrentToken())
+   THEN
+      WarnError('expecting a name and found a reserved word') ;
+      AdvanceToken ;  (* move on to another token *)
+      RETURN( NulName )
+   ELSE
+      name := GetCurrentToken() ;
+      AdvanceToken ;
+      RETURN( name )
+   END
+END GetName ;
+
+
+(* % rules *)
+
+(*
+    Note that all the code from here down to the end of the module as
+    delimited by the comment will all be hidden when the buildpg
+    script is invoked. Also be careful not to duplicate or remove these
+    critical comments below..
+    Check buildpg for sed details.
+*)
+
+(* StartNonErrorChecking *)
+
+(* actually these two are not strictly rules but hand built primitives *)
+
+
+(*
+   Ident - non error checking varient of Ident
+*)
+
+PROCEDURE Ident () : BOOLEAN ;
+BEGIN
+   IF GetCurrentTokenType()=identtok
+   THEN
+      NEW(CurrentIdent) ;
+      WITH CurrentIdent^ DO
+         definition := NIL ;
+         name       := GetName() ;
+         line       := GetCurrentLine()
+      END ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END Ident ;
+
+
+(*
+   Modula2Code - non error checking varient of Modula2Code
+*)
+
+PROCEDURE Modula2Code () : BOOLEAN ;
+VAR
+   p       : CodeHunk ;
+   i       : CARDINAL ;
+   quote   : BOOLEAN ;
+   line,
+   position: CARDINAL ;
+BEGIN
+   line := GetCurrentLine() ;
+   PushBackToken(GetCurrentToken()) ;
+   position := GetColumnPosition() ;
+   p := NIL ;
+   SkipWhite ;
+   WHILE (PutChar(GetChar())#'%') AND (PutChar(GetChar())#nul) DO
+      IF PutChar(GetChar())='"'
+      THEN
+         REPEAT
+            p := Add(p, GetChar(), i)
+         UNTIL (PutChar(GetChar())='"') OR (PutChar(GetChar())=nul) ;
+         p := Add(p, '"', i) ;
+         IF (PutChar(GetChar())='"') AND (GetChar()='"')
+         THEN
+         END
+      ELSIF PutChar(GetChar())="'"
+      THEN
+         REPEAT
+            p := Add(p, GetChar(), i)
+         UNTIL (PutChar(GetChar())="'") OR (PutChar(GetChar())=nul) ;
+         p := Add(p, "'", i) ;
+         IF (PutChar(GetChar())="'") AND (GetChar()="'")
+         THEN
+         END
+      ELSIF (PutChar(GetChar())='\') AND (GetChar()='\')
+      THEN
+         p := Add(p, GetChar(), i)
+      ELSIF PutChar(GetChar())#'%'
+      THEN
+         p := Add(p, GetChar(), i)
+      END
+   END ;
+   p := Add(p, nul, i) ;
+   WITH CurrentFactor^ DO
+      type := m2 ;
+      code := NewCodeDesc() ;
+      WITH code^ DO
+         code   := p ;
+         indent := position
+      END
+   END ;
+   IF PutChar(' ')=' '
+   THEN
+   END ;
+   AdvanceToken ;  (* read the next token ready for the parser *)
+   IF NOT WasNoError
+   THEN
+      WarnError1('error probably occurred before the start of inline code on line %d', line)
+   END ;
+   RETURN( TRUE )
+END Modula2Code ;
+
+
+(*
+   StartModName    := % ModuleName := GetName() ; (* ignore begintok *) CodeFragmentPrologue % =:
+*)
+
+PROCEDURE StartModName () : BOOLEAN ;
+BEGIN
+   ModuleName := GetName() ;
+   CodeFragmentPrologue ;
+   RETURN( TRUE )
+END StartModName ;
+
+(*
+   EndModName    :=
+*)
+
+PROCEDURE EndModName () : BOOLEAN ;
+BEGIN
+   IF ModuleName#GetName()
+   THEN
+      WarnError('expecting same module name at end as beginning')
+   END ;
+   (* ignore endtok as it consumes the token afterwards *)
+   CodeFragmentEpilogue ;
+   RETURN( TRUE )
+END EndModName ;
+
+(*
+   DoDeclaration := % CodeFragmentDeclaration % =:
+*)
+
+PROCEDURE DoDeclaration () : BOOLEAN ;
+BEGIN
+   IF ModuleName#GetName()
+   THEN
+      WarnError('expecting same module name in declaration as in the beginning')
+   END ;
+   (* ignore begintok as it consumes the token afterwards *)
+   CodeFragmentDeclaration ;
+   RETURN( TRUE )
+END DoDeclaration ;
+
+(* EndNonErrorChecking  now for the real ebnf rules *)
+
+TYPE
+   SetOfStop = SET OF TokenType ;
+
+(* **************************************************************************
+    E r r o r    R e c o v e r y    I d e n t    &    M o d u l a 2 C o d e
+   **************************************************************************
+
+(* StartErrorChecking *)
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stop: SetOfStop) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      WriteLn ;
+      WriteString('skipping token *** ')
+   END ;
+   WHILE NOT (GetCurrentTokenType() IN stop) DO
+      AdvanceToken
+   END ;
+   IF Debugging
+   THEN
+      WriteString(' ***') ; WriteLn
+   END ;
+   WasNoError := FALSE
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stop: SetOfStop) ;
+BEGIN
+   IF NOT (GetCurrentTokenType() IN stop)
+   THEN
+      SyntaxError(stop)
+   END
+END SyntaxCheck ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: TokenType; stop: SetOfStop) ;
+BEGIN
+   IF GetCurrentTokenType()=t
+   THEN
+      AdvanceToken
+   ELSE
+      SyntaxError(stop)
+   END ;
+   SyntaxCheck(stop)
+END Expect ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stop: SetOfStop) ;
+BEGIN
+   IF GetCurrentTokenType()=identtok
+   THEN
+      NEW(CurrentIdent) ;
+      WITH CurrentIdent^ DO
+         definition := NIL ;
+         name       := GetName() ;
+         line       := GetCurrentLine()
+      END ;
+   END
+END Ident ;
+
+
+(*
+   Modula2Code - error checking varient of Modula2Code
+*)
+
+PROCEDURE Modula2Code (stop: SetOfStop) ;
+VAR
+   p       : CodeHunk ;
+   i       : CARDINAL ;
+   quote   : BOOLEAN ;
+   line,
+   position: CARDINAL ;
+BEGIN
+   line := GetCurrentLine() ;
+   PushBackToken(GetCurrentToken()) ;
+   position := GetColumnPosition() ;
+   p := NIL ;
+   SkipWhite ;
+   WHILE (PutChar(GetChar())#'%') AND (PutChar(GetChar())#nul) DO
+      IF PutChar(GetChar())='"'
+      THEN
+         REPEAT
+            p := Add(p, GetChar(), i)
+         UNTIL (PutChar(GetChar())='"') OR (PutChar(GetChar())=nul) ;
+         p := Add(p, '"', i) ;
+         IF (PutChar(GetChar())='"') AND (GetChar()='"')
+         THEN
+         END
+      ELSIF PutChar(GetChar())="'"
+      THEN
+         REPEAT
+            p := Add(p, GetChar(), i)
+         UNTIL (PutChar(GetChar())="'") OR (PutChar(GetChar())=nul) ;
+         p := Add(p, "'", i) ;
+         IF (PutChar(GetChar())="'") AND (GetChar()="'")
+         THEN
+         END
+      ELSIF (PutChar(GetChar())='\') AND (GetChar()='\')
+      THEN
+         p := Add(p, GetChar(), i)
+      ELSIF PutChar(GetChar())#'%'
+      THEN
+         p := Add(p, GetChar(), i)
+      END
+   END ;
+   p := Add(p, nul, i) ;
+   WITH CurrentFactor^ DO
+      type := m2 ;
+      code := NewCodeDesc() ;
+      WITH code^ DO
+         code   := p ;
+         indent := position
+      END
+   END ;
+   IF PutChar(' ')=' '
+   THEN
+   END ;
+   AdvanceToken ;  (* read the next token ready for the parser *)
+   IF NOT WasNoError
+   THEN
+      WarnError1('error probably occurred before the start of inline code on line %d', line)
+   END
+END Modula2Code ;
+
+
+(*
+   StartModName    := % ModuleName := GetName() ; (* ignore begintok *) CodeFragmentPrologue % =:
+*)
+
+PROCEDURE StartModName (stop: SetOfStop) ;
+BEGIN
+   ModuleName := GetName() ;
+   CodeFragmentPrologue
+END StartModName ;
+
+
+(*
+   EndModName    :=
+*)
+
+PROCEDURE EndModName (stop: SetOfStop) ;
+BEGIN
+   IF ModuleName#GetName()
+   THEN
+      WarnError('expecting same module name at end as beginning')
+   END ;
+   (* ignore endtok as it consumes the token afterwards *)
+   CodeFragmentEpilogue
+END EndModName ;
+
+
+(*
+   DoDeclaration := % CodeFragmentDeclaration % =:
+*)
+
+PROCEDURE DoDeclaration (stop: SetOfStop) ;
+BEGIN
+   IF ModuleName#GetName()
+   THEN
+      WarnError('expecting same module name in declaration as in the beginning')
+   END ;
+   (* ignore begintok as it consumes the token afterwards *)
+   CodeFragmentDeclaration
+END DoDeclaration ;
+
+
+(* EndErrorChecking  now for the real ebnf rules *)
+
+*****************************************************************
+  l e a v e   a b o v e   c o d e   a l o n e   (f o r    S E D)
+***************************************************************** *)
+
+(* this code below will be recreated by ppg *)
+
+PROCEDURE DescribeError ;
+BEGIN
+   WarnError('syntax error')
+END DescribeError ;
+
+PROCEDURE Main () : BOOLEAN ;
+BEGIN
+   IF Header()
+   THEN
+      IF Decls()
+      THEN
+         IF Footer()
+         THEN
+            IF Rules()
+            THEN
+               RETURN( TRUE )
+            END
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END Main ;
+
+PROCEDURE Header () : BOOLEAN ;
+BEGIN
+   IF SymIs(codetok)
+   THEN
+      IF SymIs(moduletok)
+      THEN
+         ModuleName := GetName() ;
+         (* ignore the begintok as we are looking one symbol ahead and we dont want to move over MODULE *)
+         CodeFragmentPrologue ;
+         RETURN( TRUE )
+      ELSE
+         WarnError('expecting module')
+      END
+   END ;
+   RETURN( FALSE )
+END Header ;
+
+PROCEDURE Footer () : BOOLEAN ;
+BEGIN
+   IF SymIs(codetok)
+   THEN
+      IF SymIs(moduletok)
+      THEN
+         IF ModuleName#GetName()
+         THEN
+            WarnError('expecting same module name at end as beginning')
+         END ;
+         (* ignore endtok as it consumes the token afterwards *)
+         CodeFragmentEpilogue ;
+         RETURN( TRUE )
+      ELSE
+         WarnError('expecting module')
+      END
+   END ;
+   RETURN( FALSE )
+END Footer ;
+
+PROCEDURE Decls () : BOOLEAN ;
+BEGIN
+   IF SymIs(codetok)
+   THEN
+      IF SymIs(declarationtok)
+      THEN
+         RETURN( DoDeclaration() )
+      ELSE
+         WarnError('expecting declaration')
+      END
+   END ;
+   RETURN( FALSE )
+END Decls ;
+
+
+(*
+    Rules      := " % " " rules " { Defs } ExtBNF =:
+*)
+
+PROCEDURE Rules () : BOOLEAN ;
+BEGIN
+   IF SymIs(codetok)
+   THEN
+      IF SymIs(rulestok)
+      THEN
+         WHILE Defs() DO
+         END ;
+         IF ExtBNF()
+         THEN
+            RETURN( TRUE )
+         ELSE
+            WarnError('expecting some BNF rules to be present')
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END Rules ;
+
+
+(*
+   Defs       := " special " Special | " token " Token | " error " ErrorProcedures |
+                 "tokenfunc" TokenProcedure =:
+*)
+
+PROCEDURE Defs () : BOOLEAN ;
+BEGIN
+   IF SymIs(specialtok)
+   THEN
+      IF Special()
+      THEN
+         RETURN( TRUE )
+      END
+   ELSIF SymIs(tokentok)
+   THEN
+      IF Token()
+      THEN
+         RETURN( TRUE )
+      END
+   ELSIF SymIs(errortok)
+   THEN
+      IF ErrorProcedures()
+      THEN
+         RETURN( TRUE )
+      END
+   ELSIF SymIs(tfunctok)
+   THEN
+      IF TokenProcedure()
+      THEN
+         RETURN( TRUE )
+      END
+   ELSIF SymIs(symfunctok)
+   THEN
+      IF SymProcedure()
+      THEN
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END Defs ;
+
+
+(*
+   Special := Name First Follow [ "epsilon" ] =:
+*)
+
+PROCEDURE Special () : BOOLEAN ;
+VAR
+   p: ProductionDesc ;
+BEGIN
+   IF Ident()
+   THEN
+      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 ;
+      IF First()
+      THEN
+         IF Follow()
+         THEN
+            IF SymIs(epsilontok)
+            THEN
+               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
+            END ;
+            IF Literal()
+            THEN
+               p^.description := LastLiteral
+            END ;
+            RETURN( TRUE )
+         ELSE
+            WarnError('Follow - expected') ;
+            RETURN( FALSE )
+         END ;
+      ELSE
+         WarnError('First - expected') ;
+         RETURN( FALSE )
+      END
+   ELSE
+      RETURN( FALSE )
+   END
+END Special ;
+
+
+(*
+   First := 'first' '{' { LitOrTokenOrIdent % WITH LastSetDesc^ DO
+                                  next := HeadProduction^.first ;
+                               END ;
+                               TailProduction^.first := LastSetDesc ;
+                              %
+                           } '}'
+*)
+
+PROCEDURE First () : BOOLEAN ;
+BEGIN
+   IF SymIs(firsttok)
+   THEN
+      IF SymIs(lcparatok)
+      THEN
+         WHILE LitOrTokenOrIdent() DO
+            WITH CurrentSetDesc^ DO
+               next := TailProduction^.first ;
+            END ;
+            TailProduction^.first := CurrentSetDesc
+         END ;  (* while *)
+         IF SymIs(rcparatok)
+         THEN
+            RETURN( TRUE )
+         ELSE
+            WarnError("'}' - expected") ;
+            RETURN( FALSE )
+         END ;
+      ELSE
+         WarnError("'{' - expected") ;
+         RETURN( FALSE )
+      END ;
+   ELSE
+      RETURN( FALSE )
+   END ;
+END First ;
+
+
+(*
+   Follow := 'follow' '{' { LitOrTokenOrIdent  } '}'
+*)
+
+PROCEDURE Follow () : BOOLEAN ;
+BEGIN
+   IF SymIs(followtok)
+   THEN
+      IF SymIs(lcparatok)
+      THEN
+         WHILE LitOrTokenOrIdent() DO
+            WITH CurrentSetDesc^ DO
+               next := TailProduction^.followinfo^.follow ;
+            END ;
+            TailProduction^.followinfo^.follow := CurrentSetDesc
+         END ;  (* while *)
+         IF SymIs(rcparatok)
+         THEN
+            RETURN( TRUE )
+         ELSE
+            WarnError("'}' - expected") ;
+            RETURN( FALSE )
+         END ;
+      ELSE
+         WarnError("'{' - expected") ;
+         RETURN( FALSE )
+      END ;
+   ELSE
+      RETURN( FALSE )
+   END ;
+END Follow ;
+
+
+(*
+   LitOrTokenOrIdent := Literal % CurrentSetDesc := NewSetDesc() ;
+                               WITH CurrentSetDesc^ DO
+                                  type   := litel ;
+                                  string := LastLiteral ;
+                               END ;
+                              %
+                         | '<' % CurrentSetDesc := NewSetDesc() ;
+                           WITH CurrentSetDesc^ DO
+                              type   := tokel ;
+                              string := GetCurrentToken() ;
+                           END ;
+                           AdvanceToken() ;
+                          %
+                        '>'  | Ident % CurrentSetDesc := NewSetDesc() ;
+                               WITH CurrentSetDesc^ DO
+                                  type   := idel ;
+                                  ident  := CurrentIdent ;
+                               END ;
+                              %
+
+*)
+
+PROCEDURE LitOrTokenOrIdent () : BOOLEAN ;
+BEGIN
+   IF Literal()
+   THEN
+      CurrentSetDesc := NewSetDesc() ;
+      WITH CurrentSetDesc^ DO
+         type   := litel ;
+         string := LastLiteral
+      END ;
+      RETURN( TRUE )
+   ELSIF SymIs(lesstok)
+   THEN
+      CurrentSetDesc := NewSetDesc() ;
+      WITH CurrentSetDesc^ DO
+         type   := tokel ;
+         string := GetCurrentToken() ;
+      END ;
+      IF GetSymKey(Aliases, GetCurrentToken())=NulKey
+      THEN
+(*
+         PutSymKey(Values, GetCurrentToken(), LargestValue) ;
+         PutSymKey(Aliases, GetCurrentToken(), GetCurrentToken()) ;
+         PutSymKey(ReverseAliases, GetCurrentToken(), GetCurrentToken()) ;
+         INC(LargestValue) ;
+*)
+      END ;
+      AdvanceToken() ;
+      IF SymIs(gretok)
+      THEN
+         RETURN( TRUE )
+      ELSE
+         WarnError("'>' - expected") ;
+         RETURN( FALSE )
+      END ;
+   ELSIF Ident()
+   THEN
+      CurrentSetDesc := NewSetDesc() ;
+      WITH CurrentSetDesc^ DO
+         type   := idel ;
+         ident  := CurrentIdent ;
+      END ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END ;  (* elsif *)
+END LitOrTokenOrIdent ;
+
+
+(*
+   Literal -
+*)
+
+PROCEDURE Literal () : BOOLEAN ;
+BEGIN
+   IF SymIs(squotetok)
+   THEN
+      LastLiteral := GetCurrentToken() ;
+      AdvanceToken ;
+      IF SymIs(squotetok)
+      THEN
+         RETURN( TRUE )
+      END
+   ELSIF SymIs(dquotetok)
+   THEN
+      LastLiteral := GetCurrentToken() ;
+      AdvanceToken ;
+      IF SymIs(dquotetok)
+      THEN
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END Literal ;
+
+
+(*
+   Token      := Literal % VAR l: CARDINAL ;
+                        l := GetCurrentToken() ; %
+              Name % PutSymKey(Aliases, l, GetCurrentToken()) ; % =:
+*)
+
+PROCEDURE Token () : BOOLEAN ;
+BEGIN
+   IF Literal()
+   THEN
+      AddEntry(Aliases, LastLiteral, GetCurrentToken()) ;
+      AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ;
+      AddEntry(Values, GetCurrentToken(), LargestValue) ;
+      AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ;
+      INC(LargestValue) ;
+      AdvanceToken ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END Token ;
+
+
+(*
+   ErrorProcedures  := Literal % ErrorProcArray := LastLiteral %
+                       Literal % ErrorProcString := LastLiteral % =:
+*)
+
+PROCEDURE ErrorProcedures () : BOOLEAN ;
+BEGIN
+   IF Literal()
+   THEN
+      ErrorProcArray := LastLiteral ;
+      IF Literal()
+      THEN
+         ErrorProcString := LastLiteral ;
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END ErrorProcedures ;
+
+
+(*
+   TokenProcedure := Literal % TokenTypeProc := LastLiteral % =:
+*)
+
+PROCEDURE TokenProcedure () : BOOLEAN ;
+BEGIN
+   IF Literal()
+   THEN
+      TokenTypeProc := LastLiteral ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END TokenProcedure ;
+
+
+(*
+   SymProcedure := Literal % SymIsProc := LastLiteral % =:
+*)
+
+PROCEDURE SymProcedure () : BOOLEAN ;
+BEGIN
+   IF Literal()
+   THEN
+      SymIsProc := LastLiteral ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END SymProcedure ;
+
+
+(*
+   ExtBNF     := " BNF " { Production } " FNB " =:
+*)
+
+PROCEDURE ExtBNF () : BOOLEAN ;
+BEGIN
+   IF SymIs(BNFtok)
+   THEN
+      WHILE Production() DO
+      END ;
+      IF SymIs(FNBtok)
+      THEN
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END ExtBNF ;
+
+
+(*
+    Production := Statement =:
+*)
+
+PROCEDURE Production () : BOOLEAN ;
+BEGIN
+   IF Statement()
+   THEN
+      RETURN( TRUE )
+   END ;
+   RETURN( FALSE )
+END Production ;
+
+
+(*
+   Statement  := % VAR i: IdentDesc ; %
+                 Ident
+                 % i := CurrentIdent ; %
+                 " := "
+                 % VAR e: ExpressionDesc ;
+                   e := NewExpression() ; %
+                 Expression
+                 % WITH CurrentStatement^ DO
+                      ident := i ;
+                      expr  := e ;
+                      first := NIL ;
+                   END ;
+                 %
+                 " =: " =:
+*)
+
+PROCEDURE Statement () : BOOLEAN ;
+VAR
+   i: IdentDesc ;
+   s: StatementDesc ;
+   e: ExpressionDesc ;
+   p: ProductionDesc ;
+BEGIN
+   IF Ident()
+   THEN
+      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 ;
+      IF SymIs(lbecomestok)
+      THEN
+         e := NewExpression() ;
+         CurrentExpression := e ;
+         s := NewStatement() ;
+         WITH s^ DO
+            ident := i ;
+            expr  := e ;
+         END ;
+         IF Expression()
+         THEN
+            p^.statement := s ;
+            IF SymIs(rbecomestok)
+            THEN
+               RETURN( TRUE )
+            END
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END Statement ;
+
+
+(*
+    Expression := % CurrentTerm := NIL %
+                  Term { " | " % CurrentTerm := NewTerm() % Term } =:
+*)
+
+PROCEDURE Expression () : BOOLEAN ;
+VAR
+   t1, t2: TermDesc ;
+   e     : ExpressionDesc ;
+BEGIN
+   e := CurrentExpression ;
+   t1 := NewTerm() ;
+   CurrentTerm := t1 ;
+   IF Term()
+   THEN
+      e^.term := t1 ;
+      WHILE SymIs(bartok) DO
+         t2 := NewTerm() ;
+         CurrentTerm := t2 ;
+         IF Term()
+         THEN
+            t1^.next := t2 ;
+            t1 := t2
+         ELSE
+            WarnError('term expected')
+         END
+      END ;
+      RETURN( TRUE )
+   ELSE
+      (* DISPOSE(t1) ; *)
+      RETURN( FALSE )
+   END
+END Expression ;
+
+
+(*
+   Term       := Factor { Factor } =:
+*)
+
+PROCEDURE Term () : BOOLEAN ;
+VAR
+   t1: TermDesc ;
+   f1, f2: FactorDesc ;
+BEGIN
+   CurrentFactor := NewFactor() ;
+   f1 := CurrentFactor ;
+   t1 := CurrentTerm ;
+   IF Factor()
+   THEN
+      t1^.factor := f1 ;
+      f2 := NewFactor() ;
+      CurrentFactor := f2 ;
+      WHILE Factor() DO
+         f1^.next := f2 ;
+         f1 := f2 ;
+         f2 := NewFactor() ;
+         CurrentFactor := f2 ;
+      END ;
+      (* DISPOSE(f2) ; *)
+      RETURN( TRUE )
+   ELSE
+      (* DISPOSE(f1) ; *)
+      RETURN( FALSE )
+   END
+END Term ;
+
+
+(*
+   Factor     := " % " Modula2Code " % " % AssignCode ; % |
+                  ( Ident | Literal | " { " Expression " } " |
+                    " [ " Expression " ] " | " ( " Expression " ) " )  =:
+*)
+
+PROCEDURE Factor () : BOOLEAN ;
+BEGIN
+   IF SymIs(codetok)
+   THEN
+      IF Modula2Code()
+      THEN
+         IF SymIs(codetok)
+         THEN
+            RETURN( TRUE )
+         END
+      END
+   ELSE
+      IF Ident()
+      THEN
+         WITH CurrentFactor^ DO
+            type  := id ;
+            ident := CurrentIdent
+         END ;
+         RETURN( TRUE )
+      ELSIF Literal()
+      THEN
+         WITH CurrentFactor^ DO
+            type   := lit ;
+            string := LastLiteral ;
+            IF GetSymKey(Aliases, LastLiteral)=NulKey
+            THEN
+               WarnError1('no token defined for literal %s', LastLiteral)
+            END
+         END ;
+         RETURN( TRUE )
+      ELSIF SymIs(lcparatok)
+      THEN
+         WITH CurrentFactor^ DO
+            type := mult ;
+            expr := NewExpression() ;
+            CurrentExpression := expr ;
+            IF Expression()
+            THEN
+               IF SymIs(rcparatok)
+               THEN
+                  RETURN( TRUE )
+               ELSE
+                  WarnError('} expected')
+               END
+            END
+         END
+      ELSIF SymIs(lsparatok)
+      THEN
+         WITH CurrentFactor^ DO
+            type := opt ;
+            expr := NewExpression() ;
+            CurrentExpression := expr ;
+            IF Expression()
+            THEN
+               IF SymIs(rsparatok)
+               THEN
+                  RETURN( TRUE )
+               ELSE
+                  WarnError('] expected')
+               END
+            END
+         END
+      ELSIF SymIs(lparatok)
+      THEN
+         WITH CurrentFactor^ DO
+            type := sub ;
+            expr := NewExpression() ;
+            CurrentExpression := expr ;
+            IF Expression()
+            THEN
+               IF SymIs(rparatok)
+               THEN
+                  RETURN( TRUE )
+               ELSE
+                  WarnError(') expected')
+               END
+            END
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END Factor ;
+
+(* % module pg end *)
+
+
+(*
+   GetDefinitionName - returns the name of the rule inside, p.
+*)
+
+PROCEDURE GetDefinitionName (p: ProductionDesc) : Name ;
+BEGIN
+   IF p#NIL
+   THEN
+      WITH p^ DO
+         IF (statement#NIL) AND (statement^.ident#NIL)
+         THEN
+            RETURN( statement^.ident^.name )
+         END
+      END
+   END ;
+   RETURN( NulName )
+END GetDefinitionName ;
+
+
+(*
+   FindDefinition - searches and returns the rule which defines, n.
+*)
+
+PROCEDURE FindDefinition (n: Name) : ProductionDesc ;
+VAR
+   p, f: ProductionDesc ;
+BEGIN
+   p := HeadProduction ;
+   f := NIL ;
+   WHILE p#NIL DO
+      IF GetDefinitionName(p)=n
+      THEN
+         IF f=NIL
+         THEN
+            f := p
+         ELSE
+            WriteString('multiple definition for rule: ') ; WriteKey(n) ; WriteLn
+         END
+      END ;
+      p := p^.next
+   END ;
+   RETURN( f )
+END FindDefinition ;
+
+
+(*
+   BackPatchIdent - found an ident, i, we must look for the corresponding rule and
+                    set the definition accordingly.
+*)
+
+PROCEDURE BackPatchIdent (i: IdentDesc) ;
+BEGIN
+   IF i#NIL
+   THEN
+      WITH i^ DO
+         definition := FindDefinition(name) ;
+         IF definition=NIL
+         THEN
+            WarnError1('unable to find production %s', name) ;
+            WasNoError := FALSE
+         END
+      END
+   END
+END BackPatchIdent ;
+
+
+(*
+   BackPatchFactor - runs through the factor looking for an ident
+*)
+
+PROCEDURE BackPatchFactor (f: FactorDesc) ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  BackPatchIdent(ident) |
+         sub ,
+         opt ,
+         mult:  BackPatchExpression(expr)
+
+         ELSE
+         END
+      END ;
+      f := f^.next
+   END
+END BackPatchFactor ;
+
+
+(*
+   BackPatchTerm - runs through all terms to find idents.
+*)
+
+PROCEDURE BackPatchTerm (t: TermDesc) ;
+BEGIN
+   WHILE t#NIL DO
+      BackPatchFactor(t^.factor) ;
+      t := t^.next
+   END
+END BackPatchTerm ;
+
+
+(*
+   BackPatchExpression - runs through the term to find any idents.
+*)
+
+PROCEDURE BackPatchExpression (e: ExpressionDesc) ;
+BEGIN
+   IF e#NIL
+   THEN
+      BackPatchTerm(e^.term)
+   END
+END BackPatchExpression ;
+
+
+(*
+   BackPatchSet -
+*)
+
+PROCEDURE BackPatchSet (s: SetDesc) ;
+BEGIN
+   WHILE s#NIL DO
+      WITH s^ DO
+         CASE type OF
+
+         idel:  BackPatchIdent(ident)
+
+         ELSE
+         END
+      END ;
+      s := s^.next
+   END
+END BackPatchSet ;
+
+
+(*
+   BackPatchIdentToDefinitions - search through all the rules and add a link from any ident
+                                 to the definition.
+*)
+
+PROCEDURE BackPatchIdentToDefinitions (d: ProductionDesc) ;
+BEGIN
+   IF (d#NIL) AND (d^.statement#NIL)
+   THEN
+      BackPatchExpression(d^.statement^.expr)
+   END
+END BackPatchIdentToDefinitions ;
+
+
+(*
+   CalculateFirstAndFollow -
+*)
+
+PROCEDURE CalculateFirstAndFollow (p: ProductionDesc) ;
+BEGIN
+   IF Debugging
+   THEN
+      WriteLn ;
+      WriteKey(p^.statement^.ident^.name) ; WriteLn ;
+      WriteString('  calculating first')
+   END ;
+   CalcFirstProduction(p, p, p^.first) ;
+   BackPatchSet(p^.first) ;
+   IF Debugging
+   THEN
+      WriteString('  calculating follow set')
+   END ;
+   IF p^.followinfo^.follow=NIL
+   THEN
+      CalcFollowProduction(p)
+   END ;
+   BackPatchSet(p^.followinfo^.follow)
+END CalculateFirstAndFollow ;
+
+
+(*
+   ForeachRuleDo -
+*)
+
+PROCEDURE ForeachRuleDo (p: DoProcedure) ;
+BEGIN
+   CurrentProduction := HeadProduction ;
+   WHILE CurrentProduction#NIL DO
+      p(CurrentProduction) ;
+      CurrentProduction := CurrentProduction^.next
+   END
+END ForeachRuleDo ;
+
+
+(*
+   WhileNotCompleteDo -
+*)
+
+PROCEDURE WhileNotCompleteDo (p: DoProcedure) ;
+BEGIN
+   REPEAT
+      Finished := TRUE ;
+      ForeachRuleDo(p) ;
+   UNTIL Finished
+END WhileNotCompleteDo ;
+
+
+(*
+   NewLine - generate a newline and indent.
+*)
+
+PROCEDURE NewLine (Left: CARDINAL) ;
+BEGIN
+   Output.WriteLn ;
+   BeginningOfLine := TRUE ;
+   Indent := 0 ;
+   WHILE Indent<Left DO
+      Output.Write(' ') ;
+      INC(Indent)
+   END
+END NewLine ;
+
+
+(*
+   CheckNewLine -
+*)
+
+PROCEDURE CheckNewLine (Left: CARDINAL) ;
+BEGIN
+   IF Indent=Left
+   THEN
+      Left := BaseNewLine
+   END ;
+   IF Indent>BaseRightMargin
+   THEN
+      NewLine(Left)
+   END
+END CheckNewLine ;
+
+
+(*
+   IndentString - writes out a string with a preceeding indent.
+*)
+
+PROCEDURE IndentString (a: ARRAY OF CHAR) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE i<Indent DO
+      Output.Write(' ') ;
+      INC(i)
+   END ;
+   Output.WriteString(a) ;
+   LastLineNo := 0
+END IndentString ;
+
+
+(*
+   KeyWord - writes out a keywork with optional formatting directives.
+*)
+
+PROCEDURE KeyWord (n: Name) ;
+BEGIN
+   IF KeywordFormatting
+   THEN
+      Output.WriteString('{%K') ;
+      IF (n = MakeKey('}')) OR (n = MakeKey('{')) OR (n = MakeKey('%'))
+      THEN
+         Output.Write('%')   (* escape }, { or % *)
+      END ;
+      Output.WriteKey(n) ;
+      Output.Write('}')
+   ELSE
+      Output.WriteKey(n)
+   END
+END KeyWord ;
+
+
+(*
+   PrettyPara -
+*)
+
+PROCEDURE PrettyPara (c1, c2: ARRAY OF CHAR; e: ExpressionDesc; Left: CARDINAL) ;
+BEGIN
+   Output.WriteString(c1) ;
+   INC(Indent, StrLen(c1)) ;
+   Left := Indent ;
+   PrettyCommentExpression(e, Left) ;
+   Output.WriteString(c2) ;
+   INC(Indent, StrLen(c2))
+END PrettyPara ;
+
+
+(*
+   WriteKeyTexinfo -
+*)
+
+PROCEDURE WriteKeyTexinfo (s: Name) ;
+VAR
+   ds  : String ;
+   ch  : CHAR ;
+   i, l: CARDINAL ;
+BEGIN
+   IF Texinfo
+   THEN
+      ds := InitStringCharStar(KeyToCharStar(s)) ;
+      l := Length(ds) ;
+      i := 0 ;
+      WHILE i<l DO
+         ch := char(ds, i) ;
+         IF (ch='{') OR (ch='}')
+         THEN
+            Output.Write('@')
+         END ;
+         Output.Write(ch) ;
+         INC(i)
+      END
+   ELSE
+      Output.WriteKey(s)
+   END
+END WriteKeyTexinfo ;
+
+
+(*
+   PrettyCommentFactor -
+*)
+
+PROCEDURE PrettyCommentFactor (f: FactorDesc; Left: CARDINAL) ;
+VAR
+   curpos  : CARDINAL ;
+   seentext: BOOLEAN ;
+BEGIN
+   WHILE f#NIL DO
+      CheckNewLine(Left) ;
+      WITH f^ DO
+         CASE type OF
+
+         id  :  Output.WriteKey(ident^.name) ; Output.WriteString(' ') ;
+                INC(Indent, LengthKey(ident^.name)+1) |
+         lit :  IF MakeKey("'")=string
+                THEN
+                   Output.Write('"') ; WriteKeyTexinfo(string) ; Output.WriteString('" ')
+                ELSE
+                   Output.Write("'") ; WriteKeyTexinfo(string) ; Output.WriteString("' ")
+                END ;
+                INC(Indent, LengthKey(string)+3) |
+         sub:   PrettyPara('( ', ' ) ', expr, Left) |
+         opt:   PrettyPara('[ ', ' ] ', expr, Left) |
+         mult:  IF Texinfo
+                THEN
+                   PrettyPara('@{ ', ' @} ', expr, Left)
+                ELSE
+                   PrettyPara('{ ', ' } ', expr, Left)
+                END |
+         m2 :   IF EmitCode
+                THEN
+                   NewLine(Left) ; Output.WriteString('% ') ;
+                   seentext := FALSE ;
+                   curpos := 0 ;
+                   WriteCodeHunkListIndent(code^.code, code^.indent, curpos, Left+2, seentext) ;
+                   Output.WriteString(' %') ;
+                   NewLine(Left)
+                END
+
+         ELSE
+         END ;
+         PrettyFollow('<f:', ':f>', followinfo)
+      END ;
+      f := f^.next
+   END
+END PrettyCommentFactor ;
+
+
+(*
+   PeepTerm - returns the length of characters in term.
+*)
+
+PROCEDURE PeepTerm (t: TermDesc) : CARDINAL ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := 0 ;
+   WHILE t#NIL DO
+      INC(l, PeepFactor(t^.factor)) ;
+      IF t^.next#NIL
+      THEN
+         INC(l, 3)
+      END ;
+      t := t^.next
+   END ;
+   RETURN( l )
+END PeepTerm ;
+
+
+(*
+   PeepExpression - returns the length of the expression.
+*)
+
+PROCEDURE PeepExpression (e: ExpressionDesc) : CARDINAL ;
+BEGIN
+   IF e=NIL
+   THEN
+      RETURN( 0 )
+   ELSE
+      RETURN( PeepTerm(e^.term) )
+   END
+END PeepExpression ;
+
+
+(*
+   PeepFactor - returns the length of character in the factor
+*)
+
+PROCEDURE PeepFactor (f: FactorDesc) : CARDINAL ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := 0 ;
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  INC(l, LengthKey(ident^.name)+1) |
+         lit :  INC(l, LengthKey(string)+3) |
+         opt ,
+         mult,
+         sub :  INC(l, PeepExpression(expr)) |
+         m2  :  (* empty *)
+
+         ELSE
+         END
+      END ;
+      f := f^.next
+   END ;
+   RETURN( l )
+END PeepFactor ;
+
+
+(*
+   PrettyCommentTerm -
+*)
+
+PROCEDURE PrettyCommentTerm (t: TermDesc; Left: CARDINAL) ;
+BEGIN
+   WHILE t#NIL DO
+      CheckNewLine(Left) ;
+      PrettyCommentFactor(t^.factor, Left) ;
+      IF t^.next#NIL
+      THEN
+         Output.WriteString(' | ') ;
+         INC(Indent, 3) ;
+         IF PeepFactor(t^.factor)+Indent>BaseRightMargin
+         THEN
+            NewLine(Left)
+         END
+      END ;
+      PrettyFollow('<t:', ':t>', t^.followinfo) ;
+      t := t^.next
+   END
+END PrettyCommentTerm ;
+
+
+(*
+   PrettyCommentExpression -
+*)
+
+PROCEDURE PrettyCommentExpression (e: ExpressionDesc; Left: CARDINAL) ;
+BEGIN
+   IF e#NIL
+   THEN
+      PrettyCommentTerm(e^.term, Left) ;
+      PrettyFollow('<e:', ':e>', e^.followinfo)
+   END
+END PrettyCommentExpression ;
+
+
+(*
+   PrettyCommentStatement -
+*)
+
+PROCEDURE PrettyCommentStatement (s: StatementDesc; Left: CARDINAL) ;
+BEGIN
+   IF s#NIL
+   THEN
+      PrettyCommentExpression(s^.expr, Left) ;
+      PrettyFollow('<s:', ':s>', s^.followinfo)
+   END
+END PrettyCommentStatement ;
+
+
+(*
+   PrettyCommentProduction - generates the comment for rule, p.
+*)
+
+PROCEDURE PrettyCommentProduction (p: ProductionDesc) ;
+VAR
+   to: SetDesc ;
+BEGIN
+   IF p#NIL
+   THEN
+      BeginningOfLine := TRUE ;
+      Indent          := 0 ;
+      Output.WriteString('(*') ; NewLine(3) ;
+      Output.WriteKey(GetDefinitionName(p)) ;
+      Output.WriteString(' := ') ;
+      INC(Indent, LengthKey(GetDefinitionName(p))+4) ;
+      PrettyCommentStatement(p^.statement, Indent) ;
+      NewLine(0) ;
+      IF ErrorRecovery
+      THEN
+         NewLine(3) ;
+         Output.WriteString('first  symbols:') ;
+         EmitSet(p^.first, 0, 0) ;
+         NewLine(3) ;
+         PrettyFollow('<p:', ':p>', p^.followinfo) ;
+         NewLine(3) ;
+         CASE GetReachEnd(p^.followinfo) OF
+
+         true   :  Output.WriteString('reachend') |
+         false  :  Output.WriteString('cannot reachend') |
+         unknown:  Output.WriteString('unknown...')
+
+         ELSE
+         END ;
+         NewLine(0)
+      END ;
+      Output.WriteString('*)') ; NewLine(0) ;
+   END
+END PrettyCommentProduction ;
+
+
+(*
+   PrettyPrintProduction - pretty prints the ebnf rule, p.
+*)
+
+PROCEDURE PrettyPrintProduction (p: ProductionDesc) ;
+VAR
+   to: SetDesc ;
+BEGIN
+   IF p#NIL
+   THEN
+      BeginningOfLine := TRUE ;
+      Indent          := 0 ;
+      IF Texinfo
+      THEN
+         Output.WriteString('@example') ; NewLine(0)
+      ELSIF Sphinx
+      THEN
+         Output.WriteString('.. code-block:: ebnf') ; NewLine(0)
+      END ;
+      Output.WriteKey(GetDefinitionName(p)) ;
+      Output.WriteString(' := ') ;
+      INC(Indent, LengthKey(GetDefinitionName(p))+4) ;
+      PrettyCommentStatement(p^.statement, Indent) ;
+      IF p^.description#NulName
+      THEN
+         Output.WriteKey(p^.description)
+      END ;
+      NewLine(0) ;
+      WriteIndent(LengthKey(GetDefinitionName(p))+1) ;
+      Output.WriteString(' =: ') ;
+      NewLine(0) ;
+      IF Texinfo
+      THEN
+         Output.WriteString('@findex ') ; Output.WriteKey(GetDefinitionName(p)) ; Output.WriteString(' (ebnf)') ; NewLine(0) ;
+         Output.WriteString('@end example') ; NewLine(0)
+      ELSIF Sphinx
+      THEN
+         Output.WriteString('.. index::') ; NewLine(0) ;
+         Output.WriteString('  pair: ') ; Output.WriteKey(GetDefinitionName(p)) ; Output.WriteString('; (ebnf)') ; NewLine(0)
+      END ;
+      NewLine(0)
+   END
+END PrettyPrintProduction ;
+
+
+(*
+   EmitFileLineTag - emits a line and file tag using the C preprocessor syntax.
+*)
+
+PROCEDURE EmitFileLineTag (line: CARDINAL) ;
+BEGIN
+   IF (NOT SuppressFileLineTag) AND (line#LastLineNo)
+   THEN
+      LastLineNo := line ;
+      IF NOT OnLineStart
+      THEN
+         Output.WriteLn
+      END ;
+      Output.WriteString('# ') ; Output.WriteCard(line, 0) ; Output.WriteString(' "') ; Output.WriteString(FileName) ; Output.Write('"') ;
+      Output.WriteLn ;
+      OnLineStart := TRUE
+   END
+END EmitFileLineTag ;
+
+
+(*
+   EmitRule - generates a comment and code for rule, p.
+*)
+
+PROCEDURE EmitRule (p: ProductionDesc) ;
+BEGIN
+   IF PrettyPrint
+   THEN
+      PrettyPrintProduction(p)
+   ELSE
+      PrettyCommentProduction(p) ;
+      IF ErrorRecovery
+      THEN
+         RecoverProduction(p)
+      ELSE
+         CodeProduction(p)
+      END
+   END
+END EmitRule ;
+
+
+(*
+   CodeCondition -
+*)
+
+PROCEDURE CodeCondition (m: m2condition) ;
+BEGIN
+   CASE m OF
+
+   m2if,
+   m2none :  IndentString('IF ')    |
+   m2elsif:  IndentString('ELSIF ') |
+   m2while:  IndentString('WHILE ')
+
+   ELSE
+      Halt('unrecognised m2condition', __LINE__, __FILE__)
+   END
+END CodeCondition ;
+
+
+(*
+   CodeThenDo - codes a "THEN" or "DO" depending upon, m.
+*)
+
+PROCEDURE CodeThenDo (m: m2condition) ;
+BEGIN
+   CASE m OF
+
+   m2if,
+   m2none,
+   m2elsif:  IF LastLineNo=0
+             THEN
+                Output.WriteLn
+             END ;
+             IndentString('THEN') ;
+             Output.WriteLn |
+   m2while:  Output.WriteString(' DO') ;
+             Output.WriteLn
+
+   ELSE
+      Halt('unrecognised m2condition', __LINE__, __FILE__)
+   END ;
+   OnLineStart := TRUE
+END CodeThenDo ;
+
+
+(*
+   CodeElseEnd - builds an ELSE END statement using string, end.
+*)
+
+PROCEDURE CodeElseEnd (end: ARRAY OF CHAR; consumed: BOOLEAN; f: FactorDesc; inopt: BOOLEAN) ;
+BEGIN
+   Output.WriteLn ;
+   OnLineStart := TRUE ;
+   EmitFileLineTag(f^.line) ;
+   IF NOT inopt
+   THEN
+      IndentString('ELSE') ; WriteLn ;
+      INC(Indent, 3) ;
+      IF consumed
+      THEN
+         IndentString('') ;
+         Output.WriteKey(ErrorProcArray) ;
+         Output.Write('(') ;
+         WITH f^ DO
+            CASE type OF
+
+            id  :  Output.Write("'") ; Output.WriteKey(ident^.name) ; Output.WriteString(' - expected') ; Output.WriteString("') ;") |
+            lit :  IF MakeKey("'")=string
+                   THEN
+                      Output.Write('"') ;
+                      KeyWord(string) ;
+                      Output.WriteString(' - expected') ; Output.WriteString('") ;')
+                   ELSIF MakeKey('"')=string
+                   THEN
+                      Output.Write("'") ; KeyWord(string) ;
+                      Output.WriteString(' - expected') ; Output.WriteString("') ;")
+                   ELSE
+                      Output.Write('"') ; Output.Write("'") ; KeyWord(string) ; Output.WriteString("' - expected") ;
+                      Output.WriteString('") ;')
+                   END
+
+            ELSE
+            END
+         END ;
+         Output.WriteLn
+      END ;
+      IndentString('RETURN( FALSE )') ;
+      DEC(Indent, 3) ;
+      Output.WriteLn
+   END ;
+   IndentString(end) ;
+   Output.WriteLn ;
+   OnLineStart := TRUE
+END CodeElseEnd ;
+
+
+(*
+   CodeEnd - codes a "END" depending upon, m.
+*)
+
+PROCEDURE CodeEnd (m: m2condition; t: TermDesc; consumed: BOOLEAN; f: FactorDesc; inopt: BOOLEAN) ;
+BEGIN
+   DEC(Indent, 3) ;
+   Output.WriteLn ;
+   OnLineStart := TRUE ;
+   CASE m OF
+
+   m2none :  IF t=NIL
+             THEN
+                CodeElseEnd('END ;', consumed, f, inopt)
+             END |
+   m2if   :  IF t=NIL
+             THEN
+                CodeElseEnd('END ;  (* if *)', consumed, f, inopt)
+             END |
+   m2elsif:  IF t=NIL
+             THEN
+                CodeElseEnd('END ;  (* elsif *)', consumed, f, inopt)
+             END |
+   m2while:  IndentString('END ;  (* while *)')
+
+   ELSE
+      Halt('unrecognised m2condition', __LINE__, __FILE__)
+   END ;
+   OnLineStart := FALSE
+END CodeEnd ;
+
+
+(*
+   EmitNonVarCode - writes out, code, providing it is not a variable declaration.
+*)
+
+PROCEDURE EmitNonVarCode (code: CodeDesc; curpos, left: CARDINAL) ;
+VAR
+   i       : CARDINAL ;
+   t       : CodeHunk ;
+   seentext: BOOLEAN ;
+BEGIN
+   t := code^.code ;
+   IF (NOT FindStr(t, i, 'VAR')) AND EmitCode
+   THEN
+      seentext := FALSE ;
+      curpos := 0 ;
+      EmitFileLineTag(code^.line) ;
+      IndentString('') ;
+      WriteCodeHunkListIndent(code^.code, code^.indent, curpos, left, seentext) ;
+      Output.WriteString(' ;') ;
+      Output.WriteLn ;
+      OnLineStart := TRUE
+   END
+END EmitNonVarCode ;
+
+
+(*
+   ChainOn -
+*)
+
+PROCEDURE ChainOn (codeStack, f: FactorDesc) : FactorDesc ;
+VAR
+   s: FactorDesc ;
+BEGIN
+   f^.pushed := NIL ;
+   IF codeStack=NIL
+   THEN
+      RETURN( f )
+   ELSE
+      s := codeStack ;
+      WHILE s^.pushed#NIL DO
+         s := s^.pushed
+      END ;
+      s^.pushed := f ;
+      RETURN( codeStack )
+   END
+END ChainOn ;
+
+
+(*
+   FlushCode -
+*)
+
+PROCEDURE FlushCode (VAR codeStack: FactorDesc) ;
+BEGIN
+   IF codeStack#NIL
+   THEN
+      NewLine(Indent) ; Output.WriteString('(* begin flushing code *)') ;
+      OnLineStart := FALSE ;
+      WHILE codeStack#NIL DO
+         NewLine(Indent) ; EmitNonVarCode(codeStack^.code, 0, Indent) ; NewLine(Indent) ;
+         codeStack := codeStack^.pushed ;
+         IF codeStack#NIL
+         THEN
+            Output.WriteString(' (* again flushing code *)') ; Output.WriteLn ;
+            OnLineStart := TRUE
+         END
+      END ;
+      NewLine(Indent) ;
+      Output.WriteString('(* end flushing code *)') ;
+      OnLineStart := FALSE
+   END
+END FlushCode ;
+
+
+(*
+   CodeFactor -
+*)
+
+PROCEDURE CodeFactor (f: FactorDesc; t: TermDesc; l, n: m2condition; inopt, inwhile, consumed: BOOLEAN; codeStack: FactorDesc) ;
+BEGIN
+   IF f=NIL
+   THEN
+      IF (* ((l=m2elsif) OR (l=m2if) OR (l=m2none)) AND *) (NOT inwhile) AND (NOT inopt)
+      THEN
+         Output.WriteLn ;
+         IndentString('RETURN( TRUE )') ;
+         OnLineStart := FALSE
+      END
+   ELSE
+      WITH f^ DO
+         EmitFileLineTag(line) ;
+         CASE type OF
+
+         id  :  FlushCode(codeStack) ;
+                CodeCondition(n) ;
+                Output.WriteKey(ident^.name) ; Output.WriteString('()') ;
+                CodeThenDo(n) ;
+                INC(Indent, 3) ;
+                CodeFactor(f^.next, NIL, n, m2none, inopt, inwhile, TRUE, NIL) ;
+                CodeEnd(n, t, consumed, f, inopt) |
+         lit :  FlushCode(codeStack) ;
+                CodeCondition(n) ;
+                Output.WriteKey(SymIsProc) ; Output.Write('(') ;
+                Output.WriteKey(GetSymKey(Aliases, string)) ; Output.Write(')') ;
+                CodeThenDo(n) ;
+                INC(Indent, 3) ;
+                CodeFactor(f^.next, NIL, n, m2none, inopt, inwhile, TRUE, NIL) ;
+                CodeEnd(n, t, consumed, f, inopt) |
+         sub:   FlushCode(codeStack) ;
+                CodeExpression(expr, m2none, inopt, inwhile, consumed, NIL) ;
+                IF f^.next#NIL
+                THEN
+                   (*
+                    *  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, m2none, inopt, inwhile, TRUE, NIL)
+                END |
+         opt:   FlushCode(codeStack) ;
+                CodeExpression(expr, m2if, TRUE, inwhile, FALSE, NIL) ;
+                CodeFactor(f^.next, t, n, m2none, inopt, inwhile, consumed, NIL) |
+         mult:  FlushCode(codeStack) ;
+                CodeExpression(expr, m2while, FALSE, TRUE, consumed, NIL) ;
+                CodeFactor(f^.next, t, n, m2none, inopt, inwhile, consumed, NIL) |
+         m2 :   codeStack := ChainOn(codeStack, f) ;
+                IF consumed OR (f^.next=NIL)
+                THEN
+                   FlushCode(codeStack)
+                END ;
+                CodeFactor(f^.next, t, n, m2none, inopt, inwhile, consumed, codeStack)
+
+         ELSE
+         END
+      END
+   END
+END CodeFactor ;
+
+
+(*
+   CodeTerm -
+*)
+
+PROCEDURE CodeTerm (t: TermDesc; m: m2condition; inopt, inwhile, consumed: BOOLEAN; codeStack: FactorDesc) ;
+VAR
+   l: m2condition ;
+BEGIN
+   l := m ;
+   WHILE t#NIL DO
+      EmitFileLineTag(t^.line) ;
+      IF (t^.factor^.type=m2) AND (m=m2elsif)
+      THEN
+         m := m2if ;
+         IndentString('ELSE') ; Output.WriteLn ;
+         OnLineStart := TRUE ;
+         INC(Indent, 3) ;
+         CodeFactor(t^.factor, t^.next, m2none, m2none, inopt, inwhile, consumed, codeStack) ;
+         DEC(Indent, 3) ;
+         IndentString('END ;') ; Output.WriteLn ;
+         OnLineStart := TRUE
+      ELSE
+         CodeFactor(t^.factor, t^.next, m2none, m, inopt, inwhile, consumed, codeStack)
+      END ;
+      l := m ;
+      IF t^.next#NIL
+      THEN
+         m := m2elsif
+      END ;
+      t := t^.next
+   END
+END CodeTerm ;
+
+
+(*
+   CodeExpression -
+*)
+
+PROCEDURE CodeExpression (e: ExpressionDesc; m: m2condition; inopt, inwhile, consumed: BOOLEAN; codeStack: FactorDesc) ;
+BEGIN
+   IF e#NIL
+   THEN
+      EmitFileLineTag(e^.line) ;
+      CodeTerm(e^.term, m, inopt, inwhile, consumed, codeStack)
+   END
+END CodeExpression ;
+
+
+(*
+   CodeStatement -
+*)
+
+PROCEDURE CodeStatement (s: StatementDesc; m: m2condition) ;
+BEGIN
+   IF s#NIL
+   THEN
+      EmitFileLineTag(s^.line) ;
+      CodeExpression(s^.expr, m, FALSE, FALSE, FALSE, NIL)
+   END
+END CodeStatement ;
+
+
+(*
+   CodeProduction - only encode grammer rules which are not special.
+*)
+
+PROCEDURE CodeProduction (p: ProductionDesc) ;
+BEGIN
+   IF (p#NIL) AND ((NOT p^.firstsolved) OR ((p^.statement#NIL) AND (p^.statement^.expr#NIL)))
+   THEN
+      BeginningOfLine := TRUE ;
+      Indent          := 0 ;
+      Output.WriteLn ;
+      EmitFileLineTag(p^.line) ;
+      IndentString('PROCEDURE ') ;
+      Output.WriteKey(GetDefinitionName(p)) ;
+      Output.WriteString(' () : BOOLEAN ;') ;
+      VarProduction(p) ;
+      Output.WriteLn ;
+      OnLineStart := TRUE ;
+      EmitFileLineTag(p^.line) ;
+      IndentString('BEGIN') ; WriteLn ;
+      OnLineStart := FALSE ;
+      EmitFileLineTag(p^.line) ;
+      Indent := 3 ;
+      CodeStatement(p^.statement, m2none) ;
+      Output.WriteLn ;
+      Indent := 0 ;
+      IndentString('END ') ; WriteKey(GetDefinitionName(p)) ; Output.WriteString(' ;') ;
+      Output.WriteLn ;
+      Output.WriteLn ;
+      Output.WriteLn
+   END
+END CodeProduction ;
+
+
+(* and now for the production of code which will recover from syntax errors *)
+
+
+(*
+   RecoverCondition -
+*)
+
+PROCEDURE RecoverCondition (m: m2condition) ;
+BEGIN
+   CASE m OF
+
+   m2if   :  IndentString('IF ')    |
+   m2none :  IndentString('IF ')    |
+   m2elsif:  IndentString('ELSIF ') |
+   m2while:  IndentString('WHILE ')
+
+   ELSE
+      Halt('unrecognised m2condition', __LINE__, __FILE__)
+   END
+END RecoverCondition ;
+
+
+(*
+   ConditionIndent - returns the number of spaces indentation created via, m.
+*)
+
+PROCEDURE ConditionIndent (m: m2condition) : CARDINAL ;
+BEGIN
+   CASE m OF
+
+   m2if   :  RETURN( 3 ) |
+   m2none :  RETURN( 3 ) |
+   m2elsif:  RETURN( 6 ) |
+   m2while:  RETURN( 6 )
+
+   ELSE
+      Halt('unrecognised m2condition', __LINE__, __FILE__)
+   END
+END ConditionIndent ;
+
+
+(*
+   WriteGetTokenType - writes out the method of determining the token type.
+*)
+
+PROCEDURE WriteGetTokenType ;
+BEGIN
+   Output.WriteKey(TokenTypeProc)
+END WriteGetTokenType ;
+
+
+(*
+   NumberOfElements - returns the number of elements in set, to, which lie between low..high
+*)
+
+PROCEDURE NumberOfElements (to: SetDesc; low, high: WORD) : CARDINAL ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   n := 0 ;
+   WHILE to#NIL DO
+      WITH to^ DO
+         CASE type OF
+
+         tokel:  IF (high=0) OR IsBetween(string, low, high)
+                 THEN
+                    INC(n)
+                 END |
+         litel:  IF (high=0) OR IsBetween(GetSymKey(Aliases, string), low, high)
+                 THEN
+                    INC(n)
+                 END |
+         idel :  WarnError('not expecting ident in first symbol list') ;
+                 WasNoError := FALSE
+
+         ELSE
+            WarnError('unknown enuneration element') ;
+            WasNoError := FALSE
+         END
+      END ;
+      to := to^.next ;
+   END ;
+   RETURN( n )
+END NumberOfElements ;
+
+
+(*
+   WriteElement - writes the literal name for element, e.
+*)
+
+PROCEDURE WriteElement (e: WORD) ;
+BEGIN
+   Output.WriteKey(GetSymKey(ReverseValues, e))
+END WriteElement ;
+
+
+(*
+   EmitIsInSet - writes out the equivalent of GetTokenType() IN { toset }
+*)
+
+PROCEDURE EmitIsInSet (to: SetDesc; low, high: Name) ;
+BEGIN
+   IF NumberOfElements(to, low, high)=1
+   THEN
+      WriteGetTokenType ; Output.Write('=') ; EmitSet(to, low, high)
+   ELSE
+      WriteGetTokenType ;
+      Output.WriteString(' IN SetOfStop') ;
+      IF LargestValue > MaxElementsInSet
+      THEN
+         Output.WriteCard(CARDINAL(low) DIV MaxElementsInSet, 0)
+      END ;
+      Output.WriteString(' {') ; EmitSet(to, low, high) ; Output.WriteString('}')
+   END
+END EmitIsInSet ;
+
+
+(*
+   EmitIsInSubSet - writes out a test to see whether GetTokenype() is in { subset }
+*)
+
+PROCEDURE EmitIsInSubSet (to: SetDesc; low, high: WORD) ;
+BEGIN
+   IF NumberOfElements(to, low, high)=1
+   THEN
+      Output.Write('(') ; EmitIsInSet(to, low, high) ; Output.Write(')')
+   ELSIF low=0
+   THEN
+      (* no need to check whether GetTokenType > low *)
+      Output.WriteString('((') ; WriteGetTokenType ; Output.Write('<') ; WriteElement(INTEGER(high)+1) ;
+      Output.WriteString(') AND (') ; EmitIsInSet(to, low, high) ; Output.WriteString('))')
+   ELSIF CARDINAL(high)>LargestValue
+   THEN
+      (* no need to check whether GetTokenType < high *)
+      Output.WriteString('((') ; WriteGetTokenType ; Output.WriteString('>=') ; WriteElement(low) ;
+      Output.WriteString(') AND (') ; EmitIsInSet(to, low, high) ; Output.WriteString('))')
+   ELSE
+      Output.WriteString('((') ; WriteGetTokenType ; Output.WriteString('>=') ; WriteElement(low) ;
+      Output.WriteString(') AND (') ; WriteGetTokenType ; Output.Write('<') ; WriteElement(INTEGER(high)+1) ;
+      Output.WriteString(') AND (') ; EmitIsInSet(to, low, high) ;
+      Output.WriteString('))')
+   END
+END EmitIsInSubSet ;
+
+
+(*
+   EmitIsInFirst -
+*)
+
+PROCEDURE EmitIsInFirst (to: SetDesc; m: m2condition) ;
+VAR
+   i    : CARDINAL ;
+   first: BOOLEAN ;
+BEGIN
+   IF NumberOfElements(to, 0, 0)=1
+   THEN
+      (* only one element *)
+      WriteGetTokenType ;
+      Output.Write('=') ;
+      EmitSet(to, 0, 0)
+   ELSE
+      IF LargestValue<=MaxElementsInSet
+      THEN
+         Output.Write('(') ; WriteGetTokenType ; Output.WriteString(' IN ') ; EmitSetAsParameters(to) ; Output.WriteString(')')
+      ELSE
+         i     := 0 ;
+         first := TRUE ;
+         REPEAT
+            IF NOT IsEmptySet(to, i*MaxElementsInSet, (i+1)*MaxElementsInSet-1)
+            THEN
+               IF NOT first
+               THEN
+                  Output.WriteString(' OR') ;
+                  NewLine(Indent+ConditionIndent(m)) ;
+                  DEC(Indent, ConditionIndent(m))
+               END ;
+               EmitIsInSubSet(to, i*MaxElementsInSet, (i+1)*MaxElementsInSet-1) ;
+               first := FALSE
+            END ;
+            INC(i) ;
+         UNTIL i*MaxElementsInSet>LargestValue
+      END
+   END
+END EmitIsInFirst ;
+
+
+(*
+   FlushCode -
+*)
+
+PROCEDURE FlushRecoverCode (VAR codeStack: FactorDesc) ;
+BEGIN
+   IF codeStack#NIL
+   THEN
+      WHILE codeStack#NIL DO
+         EmitNonVarCode(codeStack^.code, 0, Indent) ;
+         codeStack := codeStack^.pushed
+      END
+   END
+END FlushRecoverCode ;
+
+
+(*
+   RecoverFactor -
+*)
+
+PROCEDURE RecoverFactor (f: FactorDesc; m: m2condition; codeStack: FactorDesc) ;
+VAR
+   to: SetDesc ;
+BEGIN
+   IF f=NIL
+   THEN
+   ELSE
+      EmitFileLineTag(f^.line) ;
+      WITH f^ DO
+         CASE type OF
+
+         id  :  to := NIL ;
+                CalcFirstFactor(f, NIL, to) ;
+                IF (to#NIL) AND (m#m2none)
+                THEN
+                   RecoverCondition(m) ;
+                   EmitIsInFirst(to, m) ;
+                   CodeThenDo(m) ;
+                   INC(Indent, 3)
+                END ;
+                FlushRecoverCode(codeStack) ;
+                IndentString('') ;
+                Output.WriteKey(ident^.name) ; Output.Write('(') ;
+                EmitStopParametersAndFollow(f, m) ; Output.WriteString(') ;') ; Output.WriteLn ;
+                RecoverFactor(f^.next, m2none, codeStack) ;
+                IF (to#NIL) AND (m#m2none)
+                THEN
+                   DEC(Indent, 3)
+                END |
+         lit :  IF m=m2none
+                THEN
+                   FlushRecoverCode(codeStack) ;
+                   IndentString('Expect(') ;
+                   Output.WriteKey(GetSymKey(Aliases, string)) ; Output.WriteString(', ') ;
+                   EmitStopParametersAndFollow(f, m) ; Output.WriteString(') ;') ; Output.WriteLn ;
+                   RecoverFactor(f^.next, m2none, codeStack)
+                ELSE
+                   RecoverCondition(m) ;
+                   WriteGetTokenType ;
+                   Output.Write('=') ;
+                   Output.WriteKey(GetSymKey(Aliases, string)) ;
+                   CodeThenDo(m) ;
+                   INC(Indent, 3) ;
+                   IndentString('Expect(') ;
+                   Output.WriteKey(GetSymKey(Aliases, string)) ; Output.WriteString(', ') ;
+                   EmitStopParametersAndFollow(f, m) ; Output.WriteString(') ;') ;
+                   Output.WriteLn ;
+                   FlushRecoverCode(codeStack) ;
+                   RecoverFactor(f^.next, m2none, codeStack) ;
+                   DEC(Indent, 3)
+                END |
+         sub:   FlushRecoverCode(codeStack) ;
+                RecoverExpression(expr, m2none, m) ;
+                RecoverFactor(f^.next, m2none, codeStack) |
+         opt:   FlushRecoverCode(codeStack) ;
+                IF OptExpSeen(f)
+                THEN
+                   to := NIL ;
+                   CalcFirstExpression(expr, NIL, to) ;
+                   RecoverCondition(m) ;
+                   EmitIsInFirst(to, m) ;
+                   CodeThenDo(m) ;
+                   INC(Indent, 3) ;
+                   IndentString('(* seen optional [ | ] expression *)') ; Output.WriteLn ;
+                   stop();
+                   RecoverExpression(expr, m2none, m2if) ;
+                   IndentString('(* end of optional [ | ] expression *)') ; Output.WriteLn ;
+                   DEC(Indent, 3) ;
+                   IndentString('END ;') ; Output.WriteLn
+                ELSE
+                   RecoverExpression(expr, m2if, m)
+                END ;
+                RecoverFactor(f^.next, m2none, codeStack) |
+         mult:  FlushRecoverCode(codeStack) ;
+                IF OptExpSeen(f) OR (m=m2if) OR (m=m2elsif)
+                THEN
+                   to := NIL ;
+                   CalcFirstExpression(expr, NIL, to) ;
+                   RecoverCondition(m) ;
+                   EmitIsInFirst(to, m) ;
+                   CodeThenDo(m) ;
+                   INC(Indent, 3) ;
+                   IndentString('(* seen optional { | } expression *)') ; Output.WriteLn ;
+                   RecoverCondition(m2while) ;
+                   EmitIsInFirst(to, m2while) ;
+                   CodeThenDo(m2while) ;
+                   INC(Indent, 3) ;
+                   RecoverExpression(expr, m2none, m2while) ;
+                   IndentString('(* end of optional { | } expression *)') ; Output.WriteLn ;
+                   DEC(Indent, 3) ;
+                   IndentString('END ;') ; Output.WriteLn ;
+                   DEC(Indent, 3) ;
+                   IF m=m2none
+                   THEN
+                      IndentString('END ;') ; Output.WriteLn ;
+                      DEC(Indent, 3)
+                   END
+                ELSE
+                   RecoverExpression(expr, m2while, m)
+                END ;
+                RecoverFactor(f^.next, m2none, codeStack) |
+         m2 :   codeStack := ChainOn(codeStack, f) ;
+                IF f^.next=NIL
+                THEN
+                   FlushRecoverCode(codeStack)
+                ELSE
+                   RecoverFactor(f^.next, m, codeStack)   (* was m2none *)
+                END
+
+         ELSE
+         END
+      END
+   END
+END RecoverFactor ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OptExpSeen (f: FactorDesc) : BOOLEAN ;
+BEGIN
+   IF f=NIL
+   THEN
+      RETURN( FALSE )
+   ELSE
+      WITH f^ DO
+         CASE type OF
+
+         id  ,
+         lit :   RETURN( FALSE ) |
+         sub :   RETURN( FALSE ) |  (* is this correct? *)
+         opt ,
+         mult:   RETURN( (expr#NIL) AND (expr^.term#NIL) AND (expr^.term^.next#NIL) ) |
+         m2  :   RETURN( TRUE )
+
+         ELSE
+         END
+      END
+   END ;
+   WarnError('all cases were not handled') ;
+   WasNoError := FALSE
+END OptExpSeen ;
+
+
+(*
+   RecoverTerm -
+*)
+
+PROCEDURE RecoverTerm (t: TermDesc; new, old: m2condition) ;
+VAR
+   LastWasM2Only,             (* does the factor only contain inline code? *)
+   alternative  : BOOLEAN ;
+   to           : SetDesc ;
+BEGIN
+   LastWasM2Only := (t^.factor^.type = m2) AND (t^.factor^.next = NIL) ;
+   to := NIL ;
+   CalcFirstTerm(t, NIL, to) ;
+   alternative := FALSE ;
+   IF t^.next#NIL
+   THEN
+      new := m2if
+   END ;
+   WHILE t#NIL DO
+      EmitFileLineTag(t^.line) ;
+      LastWasM2Only := (t^.factor^.type = m2) AND (t^.factor^.next = NIL) ;
+      IF (t^.factor^.type=m2) AND (new=m2elsif)
+      THEN
+         new := m2if ;
+         IndentString('ELSE') ; Output.WriteLn ;
+         INC(Indent, 3) ;
+         RecoverFactor(t^.factor, m2none, NIL) ;
+         alternative := FALSE
+      ELSE
+         RecoverFactor(t^.factor, new, NIL)
+      END ;
+      IF t^.next#NIL
+      THEN
+         new := m2elsif ;
+         alternative := TRUE
+      END ;
+      t := t^.next
+   END ;
+   IF (new=m2if) OR (new=m2elsif)
+   THEN
+      IF alternative AND (old#m2while)
+      THEN
+         IndentString('ELSE') ; Output.WriteLn ;
+         INC(Indent, 3) ;
+         IndentString('') ;
+         Output.WriteKey(ErrorProcArray) ;
+         Output.WriteString("('expecting one of: ") ;
+         EmitSetName(to, 0, 0) ;
+         Output.WriteString("')") ;
+         Output.WriteLn ;
+         DEC(Indent, 3)
+      ELSIF LastWasM2Only
+      THEN
+         DEC(Indent, 3)
+      END ;
+      IndentString('END ;') ; Output.WriteLn
+   ELSIF new=m2while
+   THEN
+      IndentString('END (* while *) ;') ; Output.WriteLn
+   ELSIF LastWasM2Only
+   THEN
+      DEC(Indent, 3)
+   END
+END RecoverTerm ;
+
+
+(*
+   RecoverExpression -
+*)
+
+PROCEDURE RecoverExpression (e: ExpressionDesc; new, old: m2condition) ;
+BEGIN
+   IF e#NIL
+   THEN
+      EmitFileLineTag(e^.line) ;
+      RecoverTerm(e^.term, new, old)
+   END
+END RecoverExpression ;
+
+
+(*
+   RecoverStatement -
+*)
+
+PROCEDURE RecoverStatement (s: StatementDesc; m: m2condition) ;
+BEGIN
+   IF s#NIL
+   THEN
+      EmitFileLineTag(s^.line) ;
+      RecoverExpression(s^.expr, m, m2none)
+   END
+END RecoverStatement ;
+
+
+(*
+   EmitFirstFactor - generate a list of all first tokens between the range: low..high.
+*)
+
+PROCEDURE EmitFirstFactor (f: FactorDesc; low, high: CARDINAL) ;
+BEGIN
+
+END EmitFirstFactor ;
+
+
+(*
+   EmitUsed -
+*)
+
+PROCEDURE EmitUsed (wordno: CARDINAL) ;
+BEGIN
+   IF NOT (wordno IN ParametersUsed)
+   THEN
+      Output.WriteString (" (* <* unused *> *) ")
+   END
+END EmitUsed ;
+
+
+(*
+   EmitStopParameters - generate the stop set.
+*)
+
+PROCEDURE EmitStopParameters (FormalParameters: BOOLEAN) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF LargestValue<=MaxElementsInSet
+   THEN
+      Output.WriteString('stopset') ;
+      IF FormalParameters
+      THEN
+         Output.WriteString(': SetOfStop') ;
+         EmitUsed (0)
+      ELSE
+         INCL (ParametersUsed, 0)
+      END
+   ELSE
+      i := 0 ;
+      REPEAT
+         Output.WriteString('stopset') ; Output.WriteCard(i, 0) ;
+         IF FormalParameters
+         THEN
+            Output.WriteString(': SetOfStop') ; Output.WriteCard(i, 0) ;
+            EmitUsed (i)
+         ELSE
+            INCL (ParametersUsed, i)
+         END ;
+         INC (i) ;
+         IF i*MaxElementsInSet<LargestValue
+         THEN
+            IF FormalParameters
+            THEN
+               Output.WriteString('; ')
+            ELSE
+               Output.WriteString(', ')
+            END
+         END
+      UNTIL i*MaxElementsInSet>=LargestValue ;
+   END
+END EmitStopParameters ;
+
+
+(*
+   IsBetween - returns TRUE if the value of the token, string, is
+               in the range: low..high
+*)
+
+PROCEDURE IsBetween (string: Name; low, high: WORD) : BOOLEAN ;
+BEGIN
+   RETURN( (GetSymKey(Values, string) >= low) AND (GetSymKey(Values, string) <= high) )
+END IsBetween ;
+
+
+(*
+   IsEmptySet - returns TRUE if no elements exist in set, to, with values, low..high.
+*)
+
+PROCEDURE IsEmptySet (to: SetDesc; low, high: WORD) : BOOLEAN ;
+BEGIN
+   WHILE to#NIL DO
+      WITH to^ DO
+         CASE type OF
+
+         tokel:  IF IsBetween(string, low, high)
+                 THEN
+                    RETURN( FALSE )
+                 END |
+         litel:  IF IsBetween(GetSymKey(Aliases, string), low, high)
+                 THEN
+                    RETURN( FALSE )
+                 END |
+         idel :  WarnError('not expecting ident in first symbol list') ;
+                 WasNoError := FALSE
+
+         ELSE
+            WarnError('unknown enuneration element') ;
+            WasNoError := FALSE
+         END
+      END ;
+      to := to^.next ;
+   END ;
+   RETURN( TRUE )
+END IsEmptySet ;
+
+
+(*
+   EmitSet - emits the tokens in the set, to, which have values low..high
+*)
+
+PROCEDURE EmitSet (to: SetDesc; low, high: WORD) ;
+VAR
+   first: BOOLEAN ;
+BEGIN
+   first := TRUE ;
+   WHILE to#NIL DO
+      WITH to^ DO
+         CASE type OF
+
+         tokel:  IF (high=0) OR IsBetween(string, low, high)
+                 THEN
+                    IF NOT first
+                    THEN
+                       Output.WriteString(', ')
+                    END ;
+                    Output.WriteKey(string) ;
+                    first := FALSE
+                 END |
+         litel:  IF (high=0) OR IsBetween(GetSymKey(Aliases, string), low, high)
+                 THEN
+                    IF NOT first
+                    THEN
+                       Output.WriteString(', ')
+                    END ;
+                    Output.WriteKey(GetSymKey(Aliases, string)) ;
+                    first := FALSE
+                 END |
+         idel :  WarnError('not expecting ident in first symbol list') ;
+                 WasNoError := FALSE
+
+         ELSE
+            WarnError('unknown enuneration element') ;
+            WasNoError := FALSE
+         END
+      END ;
+      to := to^.next
+   END
+END EmitSet ;
+
+
+(*
+   EmitSetName - emits the tokens in the set, to, which have values low..high, using
+                 their names.
+*)
+
+PROCEDURE EmitSetName (to: SetDesc; low, high: WORD) ;
+BEGIN
+   WHILE to#NIL DO
+      WITH to^ DO
+         CASE type OF
+
+         tokel:  IF (high=0) OR IsBetween(string, low, high)
+                 THEN
+                    IF MakeKey("'")=GetSymKey(ReverseAliases, string)
+                    THEN
+                       Output.WriteString('single quote')
+                    ELSE
+                       KeyWord(GetSymKey(ReverseAliases, string))
+                    END
+                 END |
+         litel:  IF (high=0) OR IsBetween(GetSymKey(Aliases, string), low, high)
+                 THEN
+                    Output.WriteKey(string)
+                 END |
+         idel :  WarnError('not expecting ident in first symbol list') ;
+                 WasNoError := FALSE
+
+         ELSE
+            WarnError('unknown enuneration element') ;
+            WasNoError := FALSE
+         END
+      END ;
+      to := to^.next ;
+      IF to#NIL
+      THEN
+         Output.Write(' ')
+      END
+   END
+END EmitSetName ;
+
+
+(*
+   EmitStopParametersAndSet - generates the stop parameters together with a set
+                              inclusion of all the symbols in set, to.
+*)
+
+PROCEDURE EmitStopParametersAndSet (to: SetDesc) ;
+VAR
+   i : CARDINAL ;
+BEGIN
+   IF LargestValue<=MaxElementsInSet
+   THEN
+      Output.WriteString('stopset') ;
+      INCL (ParametersUsed, 0) ;
+      IF (to#NIL) AND (NumberOfElements(to, 0, MaxElementsInSet-1)>0)
+      THEN
+         Output.WriteString(' + SetOfStop') ;
+         Output.Write('{') ;
+         EmitSet(to, 0, MaxElementsInSet-1) ;
+         Output.Write('}')
+      END
+   ELSE
+      i := 0 ;
+      REPEAT
+         Output.WriteString('stopset') ; Output.WriteCard(i, 0) ;
+         INCL (ParametersUsed, i) ;
+         IF (to#NIL) AND (NumberOfElements(to, i*MaxElementsInSet, (i+1)*MaxElementsInSet-1)>0)
+         THEN
+            Output.WriteString(' + SetOfStop') ; Output.WriteCard(i, 0) ;
+            Output.Write('{') ;
+            EmitSet(to, i*MaxElementsInSet, (i+1)*MaxElementsInSet-1) ;
+            Output.Write('}')
+         END ;
+         INC(i) ;
+         IF i*MaxElementsInSet<LargestValue
+         THEN
+            Output.WriteString(', ')
+         END
+      UNTIL i*MaxElementsInSet>=LargestValue
+   END
+END EmitStopParametersAndSet ;
+
+
+(*
+   EmitSetAsParameters - generates the first symbols as parameters to a set function.
+*)
+
+PROCEDURE EmitSetAsParameters (to: SetDesc) ;
+VAR
+   i : CARDINAL ;
+BEGIN
+   IF LargestValue<=MaxElementsInSet
+   THEN
+      Output.Write('{') ;
+      EmitSet(to, 0, MaxElementsInSet-1)
+   ELSE
+      i := 0 ;
+      REPEAT
+         Output.Write('{') ;
+         EmitSet(to, i*MaxElementsInSet, (i+1)*MaxElementsInSet-1) ;
+         INC(i) ;
+         IF (i+1)*MaxElementsInSet>LargestValue
+         THEN
+            Output.WriteString('}, ')
+         END
+      UNTIL (i+1)*MaxElementsInSet>=LargestValue ;
+   END ;
+   Output.Write('}')
+END EmitSetAsParameters ;
+
+
+(*
+   EmitStopParametersAndFollow - generates the stop parameters together with a set
+                                 inclusion of all the follow symbols for subsequent
+                                 sentances.
+*)
+
+PROCEDURE EmitStopParametersAndFollow (f: FactorDesc; m: m2condition) ;
+VAR
+   to: SetDesc ;
+BEGIN
+   to := NIL ;
+(*
+   IF m=m2while
+   THEN
+      CalcFirstFactor(f, NIL, to)
+   END ;
+*)
+   CollectFollow(to, f^.followinfo) ;
+   EmitStopParametersAndSet(to) ;
+   IF Debugging
+   THEN
+      Output.WriteLn ;
+      Output.WriteString('factor is: ') ;
+      PrettyCommentFactor(f, StrLen('factor is: ')) ;
+      Output.WriteLn ;
+      Output.WriteString('follow set:') ;
+      EmitSet(to, 0, 0) ;
+      Output.WriteLn
+   END
+END EmitStopParametersAndFollow ;
+
+
+(*
+   EmitFirstAsParameters -
+*)
+
+PROCEDURE EmitFirstAsParameters (f: FactorDesc) ;
+VAR
+   to: SetDesc ;
+BEGIN
+   to := NIL ;
+   CalcFirstFactor(f, NIL, to) ;
+   EmitSetAsParameters(to)
+END EmitFirstAsParameters ;
+
+
+(*
+   RecoverProduction - only encode grammer rules which are not special.
+                       Generate error recovery code.
+*)
+
+PROCEDURE RecoverProduction (p: ProductionDesc) ;
+VAR
+   s: String ;
+BEGIN
+   IF (p#NIL) AND ((NOT p^.firstsolved) OR ((p^.statement#NIL) AND (p^.statement^.expr#NIL)))
+   THEN
+      BeginningOfLine := TRUE ;
+      Indent := 0 ;
+      Output.WriteLn ;
+      OnLineStart := FALSE ;
+      EmitFileLineTag(p^.line) ;
+      IndentString('PROCEDURE ') ;
+      Output.WriteKey(GetDefinitionName(p)) ;
+      Output.WriteString(' (') ;
+      ParametersUsed := {} ;
+      Output.StartBuffer ;
+      Output.WriteString(') ;') ;
+      VarProduction(p) ;
+      Output.WriteLn ;
+      OnLineStart := FALSE ;
+      EmitFileLineTag(p^.line) ;
+      Indent := 0 ;
+      IndentString('BEGIN') ; Output.WriteLn ;
+      OnLineStart := FALSE ;
+      EmitFileLineTag(p^.line) ;
+      Indent := 3 ;
+      RecoverStatement(p^.statement, m2none) ;
+      Indent := 0 ;
+      IndentString('END ') ; Output.WriteKey(GetDefinitionName(p)) ; Output.WriteString(' ;') ;
+      Output.WriteLn ;
+      Output.WriteLn ;
+      Output.WriteLn ;
+      s := Output.EndBuffer () ;
+      EmitStopParameters (TRUE) ;
+      Output.KillWriteS (s)
+   END
+END RecoverProduction ;
+
+
+(*
+   IsWhite - returns TRUE if, ch, is a space or a tab.
+*)
+
+PROCEDURE IsWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( (ch=' ') OR (ch=tab) OR (ch=lf) )
+END IsWhite ;
+
+
+(*
+   FindStr - returns TRUE if, str, was seen inside the code hunk
+*)
+
+PROCEDURE FindStr (VAR code: CodeHunk; VAR i: CARDINAL; str: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   j, k: CARDINAL ;
+   t   : CodeHunk ;
+BEGIN
+   t := code ;
+   k := StrLen(code^.codetext)+1 ;
+   WHILE t#NIL DO
+      REPEAT
+         WHILE (k>0) AND IsWhite(t^.codetext[k-1]) DO
+            DEC(k)
+         END ;
+         IF k=0
+         THEN
+            t := t^.next ;
+            k := MaxCodeHunkLength+1
+         END
+      UNTIL (t=NIL) OR (NOT IsWhite(t^.codetext[k-1])) ;
+
+      (* found another word check it *)
+
+      IF t#NIL
+      THEN
+         j := StrLen(str) ;
+         i := k ;
+         WHILE (t#NIL) AND (j>0) AND ((str[j-1]=t^.codetext[k-1]) OR
+                                      (IsWhite(str[j-1]) AND IsWhite(t^.codetext[k-1]))) DO
+            DEC(j) ;
+            DEC(k) ;
+            IF j=0
+            THEN
+               (* found word remember position *)
+               code := t
+            END ;
+            IF k=0
+            THEN
+               t := t^.next ;
+               k := MaxCodeHunkLength+1
+            END
+         END ;
+         IF k>0
+         THEN
+            DEC(k)
+         ELSE
+            t := t^.next
+         END
+      END ;
+   END ;
+   RETURN( (t=NIL) AND (j=0) )
+END FindStr ;
+
+
+(*
+   WriteUpto -
+*)
+
+PROCEDURE WriteUpto (code, upto: CodeHunk; limit: CARDINAL) ;
+BEGIN
+   IF code#upto
+   THEN
+      WriteUpto(code^.next, upto, limit) ;
+      Output.WriteString(code^.codetext)
+   ELSE
+      WHILE (limit<=MaxCodeHunkLength) AND (code^.codetext[limit]#nul) DO
+         Output.Write(code^.codetext[limit]) ;
+         INC(limit)
+      END
+   END
+END WriteUpto ;
+
+
+(*
+   CheckForVar - checks for any local variables which need to be emitted during
+                 this production.
+*)
+
+PROCEDURE CheckForVar (code: CodeHunk) ;
+VAR
+   i: CARDINAL ;
+   t: CodeHunk ;
+BEGIN
+   t := code ;
+   IF FindStr(t, i, 'VAR') AND EmitCode
+   THEN
+      IF NOT EmittedVar
+      THEN
+         Output.WriteLn ;
+         Indent := 0 ;
+         IndentString('VAR') ;
+         INC(Indent, 3) ;
+         Output.WriteLn ;
+         EmittedVar := TRUE ;
+      END ;
+      WriteUpto(code, t, i)
+   END
+END CheckForVar ;
+
+
+(*
+   VarFactor -
+*)
+
+PROCEDURE VarFactor (f: FactorDesc) ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  |
+         lit :  |
+         sub ,
+         opt ,
+         mult:  VarExpression(expr) |
+         m2  :  CheckForVar(code^.code)
+
+         ELSE
+         END
+      END ;
+      f := f^.next
+   END
+END VarFactor ;
+
+
+(*
+   VarTerm -
+*)
+
+PROCEDURE VarTerm (t: TermDesc) ;
+BEGIN
+   WHILE t#NIL DO
+      VarFactor(t^.factor) ;
+      t := t^.next
+   END
+END VarTerm ;
+
+
+(*
+   VarExpression -
+*)
+
+PROCEDURE VarExpression (e: ExpressionDesc) ;
+BEGIN
+   IF e#NIL
+   THEN
+      VarTerm(e^.term)
+   END
+END VarExpression ;
+
+
+(*
+   VarStatement -
+*)
+
+PROCEDURE VarStatement (s: StatementDesc) ;
+BEGIN
+   IF s#NIL
+   THEN
+      VarExpression(s^.expr)
+   END
+END VarStatement ;
+
+
+(*
+   VarProduction - writes out all variable declarations.
+*)
+
+PROCEDURE VarProduction (p: ProductionDesc) ;
+BEGIN
+   EmittedVar := FALSE ;
+   IF p#NIL
+   THEN
+      VarStatement(p^.statement)
+   END
+END VarProduction ;
+
+
+(*
+   In - returns TRUE if token, s, is already in the set, to.
+*)
+
+PROCEDURE In (to: SetDesc; s: Name) : BOOLEAN ;
+BEGIN
+   WHILE to#NIL DO
+      WITH to^ DO
+         CASE type OF
+
+         idel  :  IF s=ident^.name
+                  THEN
+                     RETURN( TRUE )
+                  END |
+         tokel,
+         litel :  IF s=string
+                  THEN
+                     RETURN( TRUE )
+                  END
+
+         ELSE
+            WarnError('internal error CASE type not known') ;
+            WasNoError := FALSE
+         END
+      END ;
+      to := to^.next
+   END ;
+   RETURN( FALSE )
+END In ;
+
+
+(*
+   IntersectionIsNil - given two set lists, s1, s2, return TRUE if the
+                       s1 * s2 = {}
+*)
+
+PROCEDURE IntersectionIsNil (s1, s2: SetDesc) : BOOLEAN ;
+BEGIN
+   WHILE s1#NIL DO
+      WITH s1^ DO
+         CASE type OF
+
+         idel :  IF In(s2, ident^.name)
+                 THEN
+                    RETURN( FALSE )
+                 END |
+         tokel,
+         litel:  IF In(s2, string)
+                 THEN
+                    RETURN( FALSE )
+                 END
+
+         ELSE
+            WarnError('internal error CASE type not known') ;
+            WasNoError := FALSE
+         END
+      END ;
+      s1 := s1^.next
+   END ;
+   RETURN( TRUE )
+END IntersectionIsNil ;
+
+
+(*
+   AddSet - adds a first symbol to a production.
+*)
+
+PROCEDURE AddSet (VAR to: SetDesc; s: Name) ;
+VAR
+   d: SetDesc ;
+BEGIN
+   IF NOT In(to, s)
+   THEN
+      d := NewSetDesc() ;
+      WITH d^ DO
+         type   := tokel ;
+         string := s ;
+         next   := to ;
+      END ;
+      to := d ;
+      Finished := FALSE
+   END
+END AddSet ;
+
+
+(*
+   OrSet -
+*)
+
+PROCEDURE OrSet (VAR to: SetDesc; from: SetDesc) ;
+BEGIN
+   WHILE from#NIL DO
+      WITH from^ DO
+         CASE type OF
+
+         tokel:  AddSet(to, string) |
+         litel:  AddSet(to, GetSymKey(Aliases, string)) |
+         idel :  WarnError('not expecting ident in first symbol list') ;
+                 WasNoError := FALSE
+
+         ELSE
+            Halt('unknown element in enumeration type', __LINE__, __FILE__)
+         END
+      END ;
+      from := from^.next
+   END
+END OrSet ;
+
+
+(*
+   CalcFirstFactor -
+*)
+
+PROCEDURE CalcFirstFactor (f: FactorDesc; from: ProductionDesc; VAR to: SetDesc) ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  IF ident^.definition=NIL
+                THEN
+                   WarnError1("no rule found for an 'ident' called '%s'", ident^.name) ;
+                   HALT
+                END ;
+                OrSet(to, ident^.definition^.first) ;
+                IF GetReachEnd(ident^.definition^.followinfo)=false
+                THEN
+                   RETURN
+                END |
+         lit :  IF GetSymKey(Aliases, string)=NulKey
+                THEN
+                   WarnError1("unknown token for '%s'", string) ;
+                   WasNoError := FALSE
+                ELSE
+                   AddSet(to, GetSymKey(Aliases, string))
+                END ;
+                RETURN |
+         sub ,
+         opt ,
+         mult:  CalcFirstExpression(expr, from, to) |
+         m2  :
+
+         ELSE
+         END
+      END ;
+      f := f^.next
+   END
+END CalcFirstFactor ;
+
+
+(*
+   CalcFirstTerm -
+*)
+
+PROCEDURE CalcFirstTerm (t: TermDesc; from: ProductionDesc; VAR to: SetDesc) ;
+BEGIN
+   WHILE t#NIL DO
+      CalcFirstFactor(t^.factor, from, to) ;
+      t := t^.next
+   END
+END CalcFirstTerm ;
+
+
+(*
+   CalcFirstExpression -
+*)
+
+PROCEDURE CalcFirstExpression (e: ExpressionDesc; from: ProductionDesc; VAR to: SetDesc) ;
+BEGIN
+   IF e#NIL
+   THEN
+      CalcFirstTerm(e^.term, from, to)
+   END
+END CalcFirstExpression ;
+
+
+(*
+   CalcFirstStatement -
+*)
+
+PROCEDURE CalcFirstStatement (s: StatementDesc; from: ProductionDesc; VAR to: SetDesc) ;
+BEGIN
+   IF s#NIL
+   THEN
+      CalcFirstExpression(s^.expr, from, to)
+   END
+END CalcFirstStatement ;
+
+
+(*
+   CalcFirstProduction - calculates all of the first symbols for the grammer
+*)
+
+PROCEDURE CalcFirstProduction (p: ProductionDesc; from: ProductionDesc; VAR to: SetDesc) ;
+VAR
+   s: SetDesc ;
+BEGIN
+   IF p#NIL
+   THEN
+      IF p^.firstsolved
+      THEN
+         s := p^.first ;
+         WHILE s#NIL DO
+            CASE s^.type OF
+
+            idel :  CalcFirstProduction(s^.ident^.definition, from, to) |
+            tokel,
+            litel:  AddSet(to, s^.string)
+
+            ELSE
+            END ;
+            s := s^.next
+         END
+      ELSE
+         CalcFirstStatement(p^.statement, from, to)
+      END
+   END
+END CalcFirstProduction ;
+
+
+(*
+   WorkOutFollow -
+*)
+
+PROCEDURE WorkOutFollowFactor (f: FactorDesc; VAR followset: SetDesc; after: SetDesc) ;
+VAR
+   foundepsilon,
+   canreachend : TraverseResult ;
+BEGIN
+   foundepsilon := true ;
+   canreachend  := true ;
+   WHILE (f#NIL) AND (foundepsilon=true) DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  IF ident^.definition=NIL
+                THEN
+                   WarnError1("no rule found for an 'ident' called '%s'", ident^.name) ;
+                   HALT
+                END ;
+                OrSet(followset, ident^.definition^.first) |
+         lit :  AddSet(followset, GetSymKey(Aliases, string)) |
+         sub :  WorkOutFollowExpression(expr, followset, NIL) |
+         opt :  WorkOutFollowExpression(expr, followset, NIL) |
+         mult:  WorkOutFollowExpression(expr, followset, NIL) |
+         m2  :
+
+         ELSE
+         END
+      END ;
+      IF GetEpsilon(f^.followinfo)=unknown
+      THEN
+         WarnError('internal error: epsilon unknown') ;
+         PrettyCommentFactor(f, 3) ;
+         WasNoError := FALSE
+      END ;
+      foundepsilon := GetEpsilon(f^.followinfo) ;
+      canreachend := GetReachEnd(f^.followinfo) ;  (* only goes from FALSE -> TRUE *)
+      f := f^.next
+   END ;
+   IF canreachend=true
+   THEN
+      OrSet(followset, after)
+   END
+END WorkOutFollowFactor ;
+
+
+(*
+   WorkOutFollowTerm -
+*)
+
+PROCEDURE WorkOutFollowTerm (t: TermDesc; VAR followset: SetDesc; after: SetDesc) ;
+BEGIN
+   IF t#NIL
+   THEN
+      WHILE t#NIL DO
+         WITH t^ DO
+            WorkOutFollowFactor(factor, followset, after) ;   (*  { '|' Term } *)
+         END ;
+         t := t^.next
+      END
+   END
+END WorkOutFollowTerm ;
+
+
+(*
+   WorkOutFollowExpression -
+*)
+
+PROCEDURE WorkOutFollowExpression (e: ExpressionDesc; VAR followset: SetDesc; after: SetDesc) ;
+BEGIN
+   IF e#NIL
+   THEN
+      WITH e^ DO
+         WorkOutFollowTerm(term, followset, after)
+      END
+   END
+END WorkOutFollowExpression ;
+
+
+(*
+   CollectFollow - collects the follow set from, f, into, to.
+*)
+
+PROCEDURE CollectFollow (VAR to: SetDesc; f: FollowDesc) ;
+BEGIN
+   OrSet(to, f^.follow)
+END CollectFollow ;
+
+
+(*
+   CalcFollowFactor -
+*)
+
+PROCEDURE CalcFollowFactor (f: FactorDesc; after: SetDesc) ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  WorkOutFollowFactor(next, followinfo^.follow, after) |
+         lit :  WorkOutFollowFactor(next, followinfo^.follow, after) |
+         opt ,
+         sub :  CalcFirstFactor(next, NIL, followinfo^.follow) ;
+                IF (next=NIL) OR (GetReachEnd(next^.followinfo)=true)
+                THEN
+                   OrSet(followinfo^.follow, after) ;
+                   CalcFollowExpression(expr, followinfo^.follow)
+                ELSE
+                   CalcFollowExpression(expr, followinfo^.follow)
+                END |
+         mult:  CalcFirstFactor(f, NIL, followinfo^.follow) ;
+                (* include first as we may repeat this sentance *)
+                IF Debugging
+                THEN
+                   WriteLn ;
+                   WriteString('found mult: and first is: ') ; EmitSet(followinfo^.follow, 0, 0) ; WriteLn
+                END ;
+                IF (next=NIL) OR (GetReachEnd(next^.followinfo)=true)
+                THEN
+                   OrSet(followinfo^.follow, after) ;
+                   CalcFollowExpression(expr, followinfo^.follow)
+                ELSE
+                   CalcFollowExpression(expr, followinfo^.follow)
+                END
+
+         ELSE
+         END
+      END ;
+      f := f^.next
+   END
+END CalcFollowFactor ;
+
+
+(*
+   CalcFollowTerm -
+*)
+
+PROCEDURE CalcFollowTerm (t: TermDesc; after: SetDesc) ;
+BEGIN
+   IF t#NIL
+   THEN
+      WHILE t#NIL DO
+         WITH t^ DO
+            CalcFollowFactor(factor, after) ;   (*  { '|' Term } *)
+         END ;
+         t := t^.next
+      END
+   END
+END CalcFollowTerm ;
+
+
+(*
+   CalcFollowExpression -
+*)
+
+PROCEDURE CalcFollowExpression (e: ExpressionDesc; after: SetDesc) ;
+BEGIN
+   IF e#NIL
+   THEN
+      WITH e^ DO
+         CalcFollowTerm(term, after)
+      END
+   END
+END CalcFollowExpression ;
+
+
+(*
+   CalcFollowStatement - given a bnf statement generate the follow set.
+*)
+
+PROCEDURE CalcFollowStatement (s: StatementDesc) ;
+BEGIN
+   IF s#NIL
+   THEN
+      WITH s^ DO
+         CalcFollowExpression(expr, NIL)
+      END
+   END
+END CalcFollowStatement ;
+
+
+(*
+   CalcFollowProduction -
+*)
+
+PROCEDURE CalcFollowProduction (p: ProductionDesc) ;
+BEGIN
+   IF p#NIL
+   THEN
+      WITH p^ DO
+         CalcFollowStatement(statement)
+      END
+   END
+END CalcFollowProduction ;
+
+
+(*
+   CalcEpsilonFactor -
+*)
+
+PROCEDURE CalcEpsilonFactor (f: FactorDesc) ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  AssignEpsilon(GetEpsilon(ident^.definition^.followinfo)#unknown,
+                              followinfo, GetEpsilon(ident^.definition^.followinfo)) |
+         lit :  AssignEpsilon(TRUE, followinfo, false) |
+         sub :  CalcEpsilonExpression(expr) ;
+                AssignEpsilon(GetEpsilon(expr^.followinfo)#unknown,
+                              followinfo, GetEpsilon(expr^.followinfo)) |
+         m2  :  AssignEpsilon(TRUE, followinfo, true) |
+         opt ,
+         mult:  CalcEpsilonExpression(expr) ;
+                AssignEpsilon(TRUE, followinfo, true)
+
+         ELSE
+         END
+      END ;
+      f := f^.next
+   END
+END CalcEpsilonFactor ;
+
+
+(*
+   CalcEpsilonTerm -
+*)
+
+PROCEDURE CalcEpsilonTerm (t: TermDesc) ;
+BEGIN
+   IF t#NIL
+   THEN
+      WHILE t#NIL DO
+         WITH t^ DO
+            IF factor#NIL
+            THEN
+               CASE GetReachEnd(factor^.followinfo) OF
+
+               true :  AssignEpsilon(TRUE, followinfo, true) |
+               false:  AssignEpsilon(TRUE, followinfo, false) |
+               unknown:
+
+               ELSE
+               END
+            END ;
+            CalcEpsilonFactor(factor)    (*  { '|' Term } *)
+         END ;
+         t := t^.next
+      END
+   END
+END CalcEpsilonTerm ;
+
+
+(*
+   CalcEpsilonExpression -
+*)
+
+PROCEDURE CalcEpsilonExpression (e: ExpressionDesc) ;
+VAR
+   t     : TermDesc ;
+   result: TraverseResult ;
+BEGIN
+   IF e#NIL
+   THEN
+      CalcEpsilonTerm(e^.term) ;
+      IF GetEpsilon(e^.followinfo)=unknown
+      THEN
+         result := unknown ;
+         WITH e^ DO
+            t := term ;
+            WHILE t#NIL DO
+               IF GetEpsilon(t^.followinfo)#unknown
+               THEN
+                  stop
+               END ;
+               CASE GetEpsilon(t^.followinfo) OF
+
+               unknown: |
+               true   : result := true |
+               false  : IF result#true
+                        THEN
+                           result := false
+                        END
+
+               ELSE
+               END ;
+               t := t^.next
+            END
+         END ;
+         AssignEpsilon(result#unknown, e^.followinfo, result)
+      END
+   END
+END CalcEpsilonExpression ;
+
+
+(*
+   CalcEpsilonStatement - given a bnf statement generate the follow set.
+*)
+
+PROCEDURE CalcEpsilonStatement (s: StatementDesc) ;
+BEGIN
+   IF s#NIL
+   THEN
+      WITH s^ DO
+         IF expr#NIL
+         THEN
+            AssignEpsilon(GetEpsilon(expr^.followinfo)#unknown,
+                          followinfo, GetEpsilon(expr^.followinfo))
+         END ;
+         CalcEpsilonExpression(expr)
+      END
+   END
+END CalcEpsilonStatement ;
+
+
+(*
+   CalcEpsilonProduction -
+*)
+
+PROCEDURE CalcEpsilonProduction (p: ProductionDesc) ;
+BEGIN
+   IF p#NIL
+   THEN
+(*
+      IF p^.statement^.ident^.name=MakeKey('DefinitionModule')
+      THEN
+         stop
+      END ;
+*)
+
+      IF Debugging
+      THEN
+         WriteKey(p^.statement^.ident^.name) ;
+         WriteString('  calculating epsilon') ;
+         WriteLn
+      END ;
+
+      WITH p^ DO
+         AssignEpsilon(GetEpsilon(statement^.followinfo)#unknown,
+                       followinfo, GetEpsilon(statement^.followinfo)) ;
+         CalcEpsilonStatement(statement)
+      END
+   END
+END CalcEpsilonProduction ;
+
+
+(*
+   CalcReachEndFactor -
+*)
+
+PROCEDURE CalcReachEndFactor (f: FactorDesc) : TraverseResult ;
+VAR
+   canreachend,
+   result     : TraverseResult ;
+BEGIN
+   IF f=NIL
+   THEN
+      RETURN( true )   (* we have reached the end of this factor list *)
+   ELSE
+      WITH f^ DO
+         (* we need to traverse all factors even if we can short cut the answer to this list of factors *)
+         result := CalcReachEndFactor(next) ;
+         CASE type OF
+
+         id  :  IF ident^.definition=NIL
+                THEN
+                   WarnError1('definition for %s is absent (assuming epsilon is false for this production)', ident^.name) ;
+                   result := false
+                ELSIF result#false
+                THEN
+                   CASE GetReachEnd(ident^.definition^.followinfo) OF
+
+                   false  :  result := false |
+                   true   :  |
+                   unknown:  result := unknown
+
+                   ELSE
+                   END
+                END |
+         lit :  result := false |
+         sub :  CalcReachEndExpression(expr) ;
+                IF (expr#NIL) AND (result=true)
+                THEN
+                   result := GetReachEnd(expr^.followinfo)
+                END |
+         mult,
+         opt :  IF expr#NIL
+                THEN
+                   (* not interested in the result as expression is optional *)
+                   CalcReachEndExpression(expr)
+                END |
+         m2  :
+
+         ELSE
+         END ;
+         AssignReachEnd(result#unknown, followinfo, result)
+      END ;
+      RETURN( result )
+   END
+END CalcReachEndFactor ;
+
+
+(*
+   CalcReachEndTerm -
+*)
+
+PROCEDURE CalcReachEndTerm (t: TermDesc) : TraverseResult ;
+VAR
+   canreachend,
+   result     : TraverseResult ;
+BEGIN
+   IF t#NIL
+   THEN
+      canreachend := false ;
+      WHILE t#NIL DO
+         WITH t^ DO
+            result := CalcReachEndFactor(factor) ;
+            AssignReachEnd(result#unknown, followinfo, result) ;
+            CASE result OF
+
+            true   :  canreachend := true |
+            false  :  |
+            unknown:  IF canreachend=false
+                      THEN
+                         canreachend := unknown
+                      END
+
+            ELSE
+            END
+         END ;
+         t := t^.next    (*  { '|' Term } *)
+      END ;
+      RETURN( canreachend )
+   END
+END CalcReachEndTerm ;
+
+
+(*
+   CalcReachEndExpression -
+*)
+
+PROCEDURE CalcReachEndExpression (e: ExpressionDesc) ;
+VAR
+   result: TraverseResult ;
+BEGIN
+   IF e=NIL
+   THEN
+      (* no expression, thus reached the end of this sentance *)
+   ELSE
+      WITH e^ DO
+         result := CalcReachEndTerm(term) ;
+         AssignReachEnd(result#unknown, followinfo, result)
+      END
+   END
+END CalcReachEndExpression ;
+
+
+(*
+   CalcReachEndStatement -
+*)
+
+PROCEDURE CalcReachEndStatement (s: StatementDesc) ;
+BEGIN
+   IF s#NIL
+   THEN
+      WITH s^ DO
+         IF expr#NIL
+         THEN
+            CalcReachEndExpression(expr) ;
+            AssignReachEnd(GetReachEnd(expr^.followinfo)#unknown,
+                           followinfo, GetReachEnd(expr^.followinfo))
+         END
+      END
+   END
+END CalcReachEndStatement ;
+
+
+PROCEDURE stop ; BEGIN END stop ;
+
+(*
+   CalcReachEndProduction -
+*)
+
+PROCEDURE CalcReachEndProduction (p: ProductionDesc) ;
+BEGIN
+   IF p#NIL
+   THEN
+      WITH p^ DO
+         CalcReachEndStatement(statement) ;
+         IF GetReachEnd(followinfo)#unknown
+         THEN
+            IF Debugging
+            THEN
+               WriteString('already calculated reach end for: ') ;
+               WriteKey(p^.statement^.ident^.name) ; WriteString(' its value is ') ;
+               IF GetReachEnd(followinfo)=true
+               THEN
+                  WriteString('reachable')
+               ELSE
+                  WriteString('non reachable')
+               END ;
+               WriteLn
+            END
+         END ;
+         AssignReachEnd(GetReachEnd(statement^.followinfo)#unknown, followinfo, GetReachEnd(statement^.followinfo)) ;
+      END
+   END
+END CalcReachEndProduction ;
+
+
+(*
+   EmptyFactor -
+*)
+
+PROCEDURE EmptyFactor (f: FactorDesc) : BOOLEAN ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  IF NOT EmptyProduction(ident^.definition)
+                THEN
+                   RETURN( FALSE )
+                END |
+         lit :  RETURN( FALSE ) |
+         sub :  IF NOT EmptyExpression(expr)
+                THEN
+                   RETURN( FALSE )
+                END |
+         opt ,
+         mult:  RETURN( TRUE ) |
+         m2  :
+
+         ELSE
+         END
+      END ;
+      f := f^.next
+   END ;
+   RETURN( TRUE )
+END EmptyFactor ;
+
+
+(*
+   EmptyTerm - returns TRUE if the term maybe empty.
+*)
+
+PROCEDURE EmptyTerm (t: TermDesc) : BOOLEAN ;
+BEGIN
+   WHILE t#NIL DO
+      IF EmptyFactor(t^.factor)
+      THEN
+         RETURN( TRUE )
+      ELSE
+         t := t^.next
+      END
+   END ;
+   RETURN( FALSE )
+END EmptyTerm ;
+
+
+(*
+   EmptyExpression -
+*)
+
+PROCEDURE EmptyExpression (e: ExpressionDesc) : BOOLEAN ;
+BEGIN
+   IF e=NIL
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( EmptyTerm(e^.term) )
+   END
+END EmptyExpression ;
+
+
+(*
+   EmptyStatement - returns TRUE if statement, s, is empty.
+*)
+
+PROCEDURE EmptyStatement (s: StatementDesc) : BOOLEAN ;
+BEGIN
+   IF s=NIL
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( EmptyExpression(s^.expr) )
+   END
+END EmptyStatement ;
+
+
+(*
+   EmptyProduction - returns if production, p, maybe empty.
+*)
+
+PROCEDURE EmptyProduction (p: ProductionDesc) : BOOLEAN ;
+BEGIN
+   IF p=NIL
+   THEN
+      WarnError('unknown production') ;
+      RETURN( TRUE )
+   ELSIF (p^.firstsolved) AND (p^.first#NIL)
+   THEN
+      (* predefined but first set to something - thus not empty *)
+      RETURN( FALSE )
+   ELSE
+      RETURN( EmptyStatement(p^.statement) )
+   END
+END EmptyProduction ;
+
+
+(*
+   EmitFDLNotice -
+*)
+
+PROCEDURE EmitFDLNotice ;
+BEGIN
+   Output.WriteString('@c Copyright (C) 2000-2022 Free Software Foundation, Inc.') ; Output.WriteLn ;
+   Output.WriteLn ;
+   Output.WriteString('@c This file is part of GCC.') ; Output.WriteLn ;
+   Output.WriteString('@c Permission is granted to copy, distribute and/or modify this document') ; Output.WriteLn ;
+   Output.WriteString('@c under the terms of the GNU Free Documentation License, Version 1.2 or') ; Output.WriteLn ;
+   Output.WriteString('@c any later version published by the Free Software Foundation.') ; Output.WriteLn
+END EmitFDLNotice ;
+
+
+(*
+   EmitRules - generates the BNF rules.
+*)
+
+PROCEDURE EmitRules ;
+BEGIN
+   IF Texinfo AND FreeDocLicense
+   THEN
+      EmitFDLNotice
+   END ;
+   ForeachRuleDo(EmitRule)
+END EmitRules ;
+
+
+(*
+   DescribeElement -
+*)
+
+PROCEDURE DescribeElement (name: WORD) ;
+VAR
+   lit: Name ;
+BEGIN
+   IF InitialElement
+   THEN
+      InitialElement := FALSE
+   ELSE
+      Output.WriteString(' |')
+   END ;
+   Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('') ;
+   Output.WriteKey(name) ;
+   Output.WriteString(': ') ;
+   lit := GetSymKey(ReverseAliases, name) ;
+   IF MakeKey('"')=lit
+   THEN
+      Output.WriteString('str := ConCat(ConCatChar(ConCatChar(InitString("syntax error, found ') ;
+      Output.Write("'") ; Output.WriteString('"), ') ;
+      Output.Write("'") ; Output.Write('"') ; Output.Write("'") ; Output.WriteString("), ") ;
+      Output.Write('"') ; Output.Write("'") ; Output.Write('"') ; Output.WriteString("), Mark(str))")
+   ELSIF MakeKey("'")=lit
+   THEN
+     Output.WriteString("str := ConCat(ConCatChar(ConCatChar(InitString('syntax error, found ") ;
+     Output.Write('"') ; Output.WriteString("'), ") ;
+     Output.Write('"') ; Output.Write("'") ; Output.Write('"') ; Output.WriteString('), ') ;
+     Output.Write("'") ; Output.Write('"') ; Output.Write("'") ; Output.WriteString('), Mark(str))')
+   ELSE
+     Output.WriteString("str := ConCat(InitString(") ; Output.Write('"') ;
+     Output.WriteString("syntax error, found ") ; KeyWord(lit) ; Output.WriteString('"), Mark(str))')
+   END
+END DescribeElement ;
+
+
+(*
+   EmitInTestStop - construct a test for stop element, name.
+*)
+
+PROCEDURE EmitInTestStop (name: Name) ;
+VAR
+   i, value: CARDINAL ;
+BEGIN
+   IF LargestValue<=MaxElementsInSet
+   THEN
+      Output.WriteKey(name) ; Output.WriteString(' IN stopset') ;
+      INCL (ParametersUsed, 0)
+   ELSE
+      value := GetSymKey(Values, name) ;
+      i := value DIV MaxElementsInSet ;
+      Output.WriteKey(name) ; Output.WriteString(' IN stopset') ; Output.WriteCard(i, 0) ;
+      INCL (ParametersUsed, i)
+   END
+END EmitInTestStop ;
+
+
+(*
+   DescribeStopElement -
+*)
+
+PROCEDURE DescribeStopElement (name: WORD) ;
+VAR
+   lit: Name ;
+BEGIN
+   Indent := 3 ;
+   IndentString('IF ') ; EmitInTestStop(name) ; Output.WriteLn ;
+   IndentString('THEN') ; Output.WriteLn ;
+   Indent := 6 ;
+   lit := GetSymKey(ReverseAliases, name) ;
+   IF (lit=NulName) OR (lit=MakeKey(''))
+   THEN
+      IndentString('(* ') ;
+      Output.WriteKey(name) ;
+      Output.WriteString(' has no token name (needed to generate error messages) *)')
+   ELSIF MakeKey("'")=lit
+   THEN
+      IndentString('message := ConCatChar(ConCatChar(ConCatChar(ConCatChar(ConCatChar(message, ') ;
+      Output.WriteString("' '), ") ;
+      Output.Write("'") ; Output.Write('"') ; Output.WriteString("'), ") ;
+      Output.Write('"') ; Output.Write("'") ; Output.WriteString('"), ') ;
+      Output.Write("'") ; Output.Write('"') ; Output.WriteString("'), ',') ; INC(n) ; ")
+   ELSIF MakeKey('"')=lit
+   THEN
+      IndentString("message := ConCatChar(ConCatChar(ConCatChar(ConCatChar(ConCatChar(message, ") ;
+      Output.WriteString('" "), ') ;
+      Output.Write('"') ; Output.Write("`") ; Output.WriteString('"), ') ;
+      Output.Write("'") ; Output.Write('"') ; Output.WriteString("'), ") ;
+      Output.Write('"') ; Output.Write("'") ; Output.WriteString('"), ",") ; INC(n) ; ')
+   ELSE
+      IndentString("message := ConCat(ConCatChar(message, ' ") ; Output.WriteString("'), ") ;
+      Output.WriteString('Mark(InitString("') ; KeyWord(lit) ; Output.Write('"') ;
+      Output.WriteString('))) ; INC(n)')
+   END ;
+   Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('END ;') ; Output.WriteLn
+END DescribeStopElement ;
+
+
+(*
+   EmitDescribeStop -
+*)
+
+PROCEDURE EmitDescribeStop ;
+VAR
+   s: String ;
+BEGIN
+   Output.WriteLn ;
+   Indent := 0 ;
+   IndentString('(*') ;
+   Indent := 3 ;
+   Output.WriteLn ;
+   IndentString('DescribeStop - issues a message explaining what tokens were expected') ;
+   Output.WriteLn ;
+   Output.WriteString('*)') ;
+   Output.WriteLn ;
+   Output.WriteLn ;
+   Indent := 0 ;
+   IndentString('PROCEDURE DescribeStop (') ;
+   ParametersUsed := {} ;
+   Output.StartBuffer ;
+   Output.WriteString(') : String ;') ;
+   Output.WriteLn ;
+   IndentString('VAR') ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('n      : CARDINAL ;') ; Output.WriteLn ;
+   IndentString('str,') ; Output.WriteLn ;
+   IndentString('message: String ;') ; Output.WriteLn ;
+   Indent := 0 ;
+   IndentString('BEGIN') ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('n := 0 ;') ; Output.WriteLn ;
+   IndentString("message := InitString('') ;") ;
+   Output.WriteLn ;
+   ForeachNodeDo(Aliases, DescribeStopElement) ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('IF n=0') ; Output.WriteLn ;
+   IndentString('THEN') ; Output.WriteLn ;
+   Indent := 6 ;
+   IndentString("str := InitString(' syntax error') ; ") ; Output.WriteLn ;
+   IndentString('message := KillString(message) ; ') ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('ELSIF n=1') ; Output.WriteLn ;
+   IndentString('THEN') ; Output.WriteLn ;
+   Indent := 6 ;
+   IndentString("str := ConCat(message, Mark(InitString(' missing '))) ;") ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('ELSE') ; Output.WriteLn ;
+   Indent := 6 ;
+   IndentString("str := ConCat(InitString(' expecting one of'), message) ;") ; Output.WriteLn ;
+   IndentString("message := KillString(message) ;") ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('END ;') ; Output.WriteLn ;
+   IndentString('RETURN( str )') ; Output.WriteLn ;
+   Indent := 0 ;
+   IndentString('END DescribeStop ;') ; Output.WriteLn ;
+   Output.WriteLn ;
+   s := Output.EndBuffer () ;
+   EmitStopParameters(TRUE) ;
+   Output.KillWriteS (s)
+END EmitDescribeStop ;
+
+
+(*
+   EmitDescribeError -
+*)
+
+PROCEDURE EmitDescribeError ;
+BEGIN
+   Output.WriteLn ;
+   Indent := 0 ;
+   IndentString('(*') ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('DescribeError - issues a message explaining what tokens were expected') ; Output.WriteLn ;
+   Indent := 0 ;
+   IndentString('*)') ;
+   Output.WriteLn ;
+   Output.WriteLn ;
+   IndentString('PROCEDURE DescribeError ;') ;
+   Output.WriteLn ;
+   IndentString('VAR') ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('str: String ;') ; Output.WriteLn ;
+   Indent := 0 ;
+   IndentString('BEGIN') ; Output.WriteLn ;
+   Indent := 3 ;
+   IndentString("str := InitString('') ;") ; Output.WriteLn ;
+   (* was
+   IndentString('str := DescribeStop(') ; EmitStopParameters(FALSE) ; Output.WriteString(') ;') ; Output.WriteLn ;
+   *)
+   IndentString('CASE ') ; WriteGetTokenType ; Output.WriteString(' OF') ; NewLine(3) ;
+   InitialElement := TRUE ;
+   ForeachNodeDo(Aliases, DescribeElement) ;
+   Output.WriteLn ;
+   Indent := 3 ;
+   IndentString('ELSE') ; Output.WriteLn ;
+   IndentString('END ;') ; Output.WriteLn ;
+   IndentString('') ;
+   Output.WriteKey(ErrorProcString) ; Output.WriteString('(str) ;') ; Output.WriteLn ;
+   Indent := 0 ;
+   IndentString('END DescribeError ;') ; Output.WriteLn
+END EmitDescribeError ;
+
+
+(*
+   EmitSetTypes - write out the set types used during error recovery
+*)
+
+PROCEDURE EmitSetTypes ;
+VAR
+   i, j, m, n: CARDINAL ;
+BEGIN
+   Output.WriteString('(*') ; NewLine(3) ;
+   Output.WriteString('expecting token set defined as an enumerated type') ; NewLine(3) ;
+   Output.WriteString('(') ;
+   i := 0 ;
+   WHILE i<LargestValue DO
+      Output.WriteKey(GetSymKey(ReverseValues, WORD(i))) ;
+      INC(i) ;
+      IF i<LargestValue
+      THEN
+         Output.WriteString(', ')
+      END
+   END ;
+   Output.WriteString(') ;') ; NewLine(0) ;
+   Output.WriteString('*)') ; NewLine(0) ;
+   Output.WriteString('TYPE') ; NewLine(3) ;
+   IF LargestValue>MaxElementsInSet
+   THEN
+      i := 0 ;
+      n := LargestValue DIV MaxElementsInSet ;
+      WHILE i<=n DO
+         j := (i*MaxElementsInSet) ;
+         IF LargestValue<(i+1)*MaxElementsInSet-1
+         THEN
+            m := LargestValue-1
+         ELSE
+            m := (i+1)*MaxElementsInSet-1
+         END ;
+         Output.WriteString('stop') ; Output.WriteCard(i, 0) ;
+         Output.WriteString(' = [') ;
+         Output.WriteKey(GetSymKey(ReverseValues, WORD(j))) ;
+         Output.WriteString('..') ;
+         Output.WriteKey(GetSymKey(ReverseValues, WORD(m))) ;
+         Output.WriteString('] ;') ;
+         NewLine(3) ;
+         Output.WriteString('SetOfStop') ; Output.WriteCard(i, 0) ;
+         Output.WriteString(' = SET OF stop') ; Output.WriteCard(i, 0) ;
+         Output.WriteString(' ;') ;
+         NewLine(3) ;
+         INC(i)
+      END
+   ELSE
+      Output.WriteString('SetOfStop') ;
+      Output.WriteString(' = SET OF [') ;
+      Output.WriteKey(GetSymKey(ReverseValues, WORD(0))) ;
+      Output.WriteString('..') ;
+      Output.WriteKey(GetSymKey(ReverseValues, WORD(LargestValue-1))) ;
+      Output.WriteString('] ;')
+   END ;
+   NewLine(0)
+END EmitSetTypes ;
+
+
+(*
+   EmitSupport - generates the support routines.
+*)
+
+PROCEDURE EmitSupport ;
+BEGIN
+   IF ErrorRecovery
+   THEN
+      EmitSetTypes ;
+      EmitDescribeStop ;
+      EmitDescribeError
+   END
+END EmitSupport ;
+
+
+(*
+   DisposeSetDesc - dispose of the set list, s.
+*)
+
+PROCEDURE DisposeSetDesc (VAR s: SetDesc) ;
+VAR
+   h, n: SetDesc ;
+BEGIN
+   IF s#NIL
+   THEN
+      h := s ;
+      n := s^.next ;
+      REPEAT
+         DISPOSE(h) ;
+         h := n ;
+         IF n#NIL
+         THEN
+            n := n^.next
+         END
+      UNTIL h=NIL ;
+      s := NIL
+   END
+END DisposeSetDesc ;
+
+
+(*
+   OptionalFactor -
+*)
+
+PROCEDURE OptionalFactor (f: FactorDesc) : BOOLEAN ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  |
+         lit :  |
+         sub ,
+         opt ,
+         mult:  IF OptionalExpression(expr)
+                THEN
+                   RETURN( TRUE )
+                END |
+         m2  :
+
+         ELSE
+         END
+      END ;
+      f := f^.next
+   END ;
+   RETURN( FALSE )
+END OptionalFactor ;
+
+
+(*
+   OptionalTerm - returns TRUE if the term maybe empty.
+*)
+
+PROCEDURE OptionalTerm (t: TermDesc) : BOOLEAN ;
+VAR
+   u, v    : TermDesc ;
+   tov, tou: SetDesc ;
+BEGIN
+   u := t ;
+   WHILE u#NIL DO
+      IF OptionalFactor(u^.factor)
+      THEN
+         RETURN( TRUE )
+      END ;
+      v := t ;
+      tou := NIL ;
+      CalcFirstFactor(u^.factor, NIL, tou) ;
+      WHILE v#NIL DO
+         IF v#u
+         THEN
+            tov := NIL ;
+            CalcFirstFactor(v^.factor, NIL, tov) ;
+            IF IntersectionIsNil(tov, tou)
+            THEN
+               DisposeSetDesc(tov) ;
+            ELSE
+               WriteString('problem with two first sets. Set 1: ') ;
+               EmitSet(tou, 0, 0) ; WriteLn ;
+               WriteString('                             Set 2: ') ;
+               EmitSet(tov, 0, 0) ; WriteLn ;
+               DisposeSetDesc(tou) ;
+               DisposeSetDesc(tov) ;
+               RETURN( TRUE )
+            END
+         END ;
+         v := v^.next
+      END ;
+      DisposeSetDesc(tou) ;
+      u := u^.next
+   END ;
+   RETURN( FALSE )
+END OptionalTerm ;
+
+
+(*
+   OptionalExpression -
+*)
+
+PROCEDURE OptionalExpression (e: ExpressionDesc) : BOOLEAN ;
+BEGIN
+   IF e=NIL
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( OptionalTerm(e^.term) )
+   END
+END OptionalExpression ;
+
+
+(*
+   OptionalStatement - returns FALSE if statement, s, does not have a optional ambiguity.
+*)
+
+PROCEDURE OptionalStatement (s: StatementDesc) : BOOLEAN ;
+BEGIN
+   IF s=NIL
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( OptionalExpression(s^.expr) )
+   END
+END OptionalStatement ;
+
+
+(*
+   OptionalProduction -
+*)
+
+PROCEDURE OptionalProduction (p: ProductionDesc) : BOOLEAN ;
+BEGIN
+   IF p=NIL
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( OptionalStatement(p^.statement) )
+   END
+END OptionalProduction ;
+
+
+(*
+   CheckFirstFollow -
+*)
+
+PROCEDURE CheckFirstFollow (f: FactorDesc; after: FactorDesc) : BOOLEAN ;
+VAR
+   first, follow: SetDesc ;
+BEGIN
+   first := NIL ;
+   CalcFirstFactor(f, NIL, first) ;
+   follow := NIL ;
+   follow := GetFollow(f^.followinfo) ;
+   IF IntersectionIsNil(first, follow)
+   THEN
+      DisposeSetDesc(first) ;
+      DisposeSetDesc(follow) ;
+      RETURN( FALSE )
+   ELSE
+      PrettyCommentFactor(f, 3) ;
+      NewLine(3) ;
+      WriteString('first: ') ;
+      EmitSet(first, 0, 0) ;
+      NewLine(3) ;
+      WriteString('follow: ') ;
+      EmitSet(follow, 0, 0) ;
+      NewLine(3) ;
+      DisposeSetDesc(first) ;
+      DisposeSetDesc(follow) ;
+      RETURN( TRUE )
+   END
+END CheckFirstFollow ;
+
+
+(*
+   ConstrainedEmptyFactor -
+*)
+
+PROCEDURE ConstrainedEmptyFactor (f: FactorDesc) : BOOLEAN ;
+BEGIN
+   WHILE f#NIL DO
+      WITH f^ DO
+         CASE type OF
+
+         id  :  |
+         lit :  |
+         sub ,
+         opt ,
+         mult:  IF ConstrainedEmptyExpression(expr)
+                THEN
+                   RETURN( TRUE )
+                END |
+         m2  :
+
+         ELSE
+         END
+      END ;
+      IF (f^.type#m2) AND EmptyFactor(f) AND CheckFirstFollow(f, f^.next)
+      THEN
+         RETURN( TRUE )
+      END ;
+      f := f^.next
+   END ;
+   RETURN( FALSE )
+END ConstrainedEmptyFactor ;
+
+
+(*
+   ConstrainedEmptyTerm - returns TRUE if the term maybe empty.
+*)
+
+PROCEDURE ConstrainedEmptyTerm (t: TermDesc) : BOOLEAN ;
+VAR
+   first, follow: SetDesc ;
+BEGIN
+   WHILE t#NIL DO
+      IF ConstrainedEmptyFactor(t^.factor)
+      THEN
+         RETURN( TRUE )
+      ELSIF (t^.factor^.type#m2) AND EmptyFactor(t^.factor) AND CheckFirstFollow(t^.factor, t^.factor^.next)
+      THEN
+         RETURN( TRUE )
+      END ;
+      t := t^.next
+   END ;
+   RETURN( FALSE )
+END ConstrainedEmptyTerm ;
+
+
+(*
+   ConstrainedEmptyExpression -
+*)
+
+PROCEDURE ConstrainedEmptyExpression (e: ExpressionDesc) : BOOLEAN ;
+BEGIN
+   IF e=NIL
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( ConstrainedEmptyTerm(e^.term) )
+   END
+END ConstrainedEmptyExpression ;
+
+
+(*
+   ConstrainedEmptyStatement - returns FALSE if statement, s, does not have a optional ambiguity.
+*)
+
+PROCEDURE ConstrainedEmptyStatement (s: StatementDesc) : BOOLEAN ;
+BEGIN
+   IF s=NIL
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( ConstrainedEmptyExpression(s^.expr) )
+   END
+END ConstrainedEmptyStatement ;
+
+
+(*
+   ConstrainedEmptyProduction - returns TRUE if a problem exists with, p.
+*)
+
+PROCEDURE ConstrainedEmptyProduction (p: ProductionDesc) : BOOLEAN ;
+BEGIN
+   IF p=NIL
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( ConstrainedEmptyStatement(p^.statement) )
+   END
+END ConstrainedEmptyProduction ;
+
+
+(*
+   TestForLALR1 -
+*)
+
+PROCEDURE TestForLALR1 (p: ProductionDesc) ;
+BEGIN
+   IF OptionalProduction(p)
+   THEN
+      WarnError1('production %s has two optional sentances using | which both have the same start symbols',
+                 p^.statement^.ident^.name) ;
+      WasNoError := FALSE ;
+      PrettyCommentProduction(p)
+   END ;
+(*
+   IF ConstrainedEmptyProduction(p)
+   THEN
+      WarnError1('production %s has an empty sentance and the first and follow symbols intersect',
+                 p^.statement^.ident^.name) ;
+      WasNoError := FALSE
+   END
+*)
+END TestForLALR1 ;
+
+
+(*
+   DoEpsilon - runs the epsilon interrelated rules
+*)
+
+PROCEDURE DoEpsilon (p: ProductionDesc) ;
+BEGIN
+   CalcEpsilonProduction(p) ;
+   CalcReachEndProduction(p)
+END DoEpsilon ;
+
+
+(*
+   CheckComplete - checks that production, p, is complete.
+*)
+
+PROCEDURE CheckComplete (p: ProductionDesc) ;
+BEGIN
+   IF GetReachEnd(p^.followinfo)=unknown
+   THEN
+      PrettyCommentProduction(p) ;
+      WarnError1('cannot determine epsilon, probably a left recursive rule in %s and associated rules (hint rewrite using ebnf and eliminate left recursion)',
+                 p^.statement^.ident^.name) ;
+      WasNoError := FALSE
+   END
+END CheckComplete ;
+
+
+(*
+   PostProcessRules - backpatch the ident to rule definitions and emit comments and code.
+*)
+
+PROCEDURE PostProcessRules ;
+BEGIN
+   ForeachRuleDo(BackPatchIdentToDefinitions) ;
+   IF NOT WasNoError
+   THEN
+      HALT
+   END ;
+   WhileNotCompleteDo(DoEpsilon) ;
+   IF NOT WasNoError
+   THEN
+      HALT
+   END ;
+   ForeachRuleDo(CheckComplete) ;
+   IF NOT WasNoError
+   THEN
+      HALT
+   END ;
+   WhileNotCompleteDo(CalculateFirstAndFollow) ;
+   IF NOT WasNoError
+   THEN
+      HALT
+   END ;
+   ForeachRuleDo(TestForLALR1) ;
+   IF NOT WasNoError
+   THEN
+      ForeachRuleDo(PrettyCommentProduction)
+   END
+END PostProcessRules ;
+
+
+(*
+   DisplayHelp - display a summary help and then exit (0).
+*)
+
+PROCEDURE DisplayHelp ;
+BEGIN
+   WriteString('Usage: ppg [-l] [-c] [-d] [-e] [-k] [-t] [-k] [-p] [-x] [-f] [-o outputfile] filename') ; WriteLn ;
+   WriteString('   -l             suppress file and line source information') ; WriteLn ;
+   WriteString('   -c             do not generate any Modula-2 code within the parser rules') ; WriteLn ;
+   WriteString('   -h or --help   generate this help message') ; WriteLn ;
+   WriteString('   -e             do not generate a parser with error recovery') ; WriteLn ;
+   WriteString('   -k             generate keyword errors with GCC formatting directives') ; WriteLn ;
+   WriteString('   -d             generate internal debugging information') ; WriteLn ;
+   WriteString('   -p             only display the ebnf rules') ; WriteLn ;
+   WriteString('   -t             generate texinfo formating for pretty printing (-p)') ; WriteLn ;
+   WriteString('   -x             generate sphinx formating for pretty printing (-p)') ; WriteLn ;
+   WriteString('   -f             generate GNU Free Documentation header before pretty printing in texinfo') ; WriteLn ;
+   WriteString('   -o             write output to filename') ; WriteLn ;
+   exit (0)
+END DisplayHelp ;
+
+
+(*
+   ParseArgs -
+*)
+
+PROCEDURE ParseArgs ;
+VAR
+   n, i: CARDINAL ;
+BEGIN
+   ErrorRecovery     := TRUE ;  (* DefaultRecovery ; *)
+   Debugging         := FALSE ;
+   PrettyPrint       := FALSE ;
+   KeywordFormatting := FALSE ;
+   i := 1 ;
+   n := Narg() ;
+   WHILE i<n DO
+      IF GetArg(ArgName, i)
+      THEN
+         IF StrEqual(ArgName, '-e')
+         THEN
+            ErrorRecovery := FALSE
+         ELSIF StrEqual(ArgName, '-d')
+         THEN
+            Debugging := TRUE ;
+            SetDebugging(TRUE)
+         ELSIF StrEqual(ArgName, '-c')
+         THEN
+            EmitCode := FALSE
+         ELSIF StrEqual(ArgName, '-k')
+         THEN
+            KeywordFormatting := TRUE
+         ELSIF StrEqual(ArgName, '-l')
+         THEN
+            SuppressFileLineTag := TRUE
+         ELSIF StrEqual(ArgName, '-h') OR StrEqual(ArgName, '--help')
+         THEN
+            DisplayHelp
+         ELSIF StrEqual(ArgName, '-p')
+         THEN
+            PrettyPrint := TRUE
+         ELSIF StrEqual(ArgName, '-t')
+         THEN
+            Texinfo := TRUE
+         ELSIF StrEqual(ArgName, '-x')
+         THEN
+            Sphinx := TRUE
+         ELSIF StrEqual(ArgName, '-f')
+         THEN
+            FreeDocLicense := TRUE
+         ELSIF StrEqual(ArgName, '-o')
+         THEN
+            INC (i) ;
+            IF GetArg(ArgName, i)
+            THEN
+               IF NOT Output.Open (ArgName)
+               THEN
+                  WriteString('cannot open ') ; WriteString(ArgName) ;
+                  WriteString(' for writing') ; WriteLn ;
+                  exit (1)
+               END
+            END
+         ELSIF OpenSource(ArgName)
+         THEN
+            StrCopy (ArgName, FileName) ;
+            AdvanceToken
+         ELSE
+            WriteString('cannot open ') ; WriteString(ArgName) ;
+            WriteString(' for reading') ; WriteLn ;
+            exit (1)
+         END
+      END ;
+      INC (i)
+   END ;
+   IF n=1
+   THEN
+      DisplayHelp
+   END
+END ParseArgs ;
+
+
+(*
+   Init - initialize the modules data structures
+*)
+
+PROCEDURE Init ;
+BEGIN
+   WasNoError        := TRUE ;
+   Texinfo           := FALSE ;
+   Sphinx            := FALSE ;
+   FreeDocLicense    := FALSE ;
+   EmitCode          := TRUE ;
+   LargestValue      := 0 ;
+   HeadProduction    := NIL ;
+   CurrentProduction := NIL ;
+   InitTree(Aliases) ;
+   InitTree(ReverseAliases) ;
+   InitTree(Values) ;
+   InitTree(ReverseValues) ;
+   LastLineNo        := 0 ;
+   CodePrologue      := NIL ;
+   CodeEpilogue      := NIL ;
+   CodeDeclaration   := NIL ;
+   ErrorProcArray    := MakeKey('Error') ;
+   ErrorProcString   := MakeKey('ErrorS') ;
+   TokenTypeProc     := MakeKey('GetCurrentTokenType()') ;
+   SymIsProc         := MakeKey('SymIs') ;
+   OnLineStart       := TRUE ;
+   ParseArgs ;
+   WasNoError := Main() ;             (* this line will be manipulated by sed in buildpg *)
+   IF WasNoError
+   THEN
+      PostProcessRules ;
+      IF WasNoError
+      THEN
+         IF Debugging
+         THEN
+            EmitRules
+         ELSIF PrettyPrint
+         THEN
+            EmitRules
+         ELSE
+            Output.WriteString('(* it is advisable not to edit this file as it was automatically generated from the grammer file ') ;
+            Output.WriteString(FileName) ; Output.WriteString(' *)') ; Output.WriteLn ;
+            OnLineStart := FALSE ;
+            EmitFileLineTag(LinePrologue) ;
+            BeginningOfLine := TRUE ;
+            WriteCodeHunkList(CodePrologue) ;
+            EmitSupport ;
+            EmitFileLineTag(LineDeclaration) ;
+            WriteCodeHunkList(CodeDeclaration) ;
+            EmitRules ;
+            (* code rules *)
+            EmitFileLineTag(LineEpilogue) ;
+            WriteCodeHunkList(CodeEpilogue)
+         END
+      END
+   END ;
+   Output.Close
+END Init ;
+
+
+BEGIN
+   Init
+END ppg.
+(*
+ * Local variables:
+ *  compile-command: "gm2 -I../gm2-libs:. -fbounds -freturn -c -g ppg.mod"
+ * End:
+ *)
diff --git a/gcc/m2/gm2-gcc/README b/gcc/m2/gm2-gcc/README
new file mode 100644
index 00000000000..c671ac26778
--- /dev/null
+++ b/gcc/m2/gm2-gcc/README
@@ -0,0 +1,5 @@
+This directory contains the interface code between the Modula-2 front
+end and GCC.  In effect this is the Modula-2 compiler GCC Tree API.
+It is an internal API only.  Many of these filenames match their GCC C
+family counterparts.  So for example m2decl.def and m2decl.cc are the
+Modula-2 front end version of c-decl.cc.
diff --git a/gcc/m2/gm2-gcc/dynamicstrings.h b/gcc/m2/gm2-gcc/dynamicstrings.h
new file mode 100644
index 00000000000..4fe039c2aed
--- /dev/null
+++ b/gcc/m2/gm2-gcc/dynamicstrings.h
@@ -0,0 +1,38 @@
+/* dynamicstrings.h provides a minimal interface to a string library.
+
+Copyright (C) 2012-2022 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(dynamicstrings_h)
+
+#define dynamicstrings_h
+#if defined(dynamicstrings_c)
+#define EXTERN
+#else /* !dynamicstrings_c.  */
+#define EXTERN extern
+#endif /* !dynamicstrings_c.  */
+
+typedef void *dynamicstrings_string;
+
+EXTERN dynamicstrings_string DynamicStrings_Mark (dynamicstrings_string s);
+EXTERN dynamicstrings_string
+DynamicStrings_InitStringCharStar (dynamicstrings_string s);
+
+#undef EXTERN
+#endif  /* !dynamicstrings_h.  */
diff --git a/gcc/m2/gm2-gcc/gcc-consolidation.h b/gcc/m2/gm2-gcc/gcc-consolidation.h
new file mode 100644
index 00000000000..99f1c5b7455
--- /dev/null
+++ b/gcc/m2/gm2-gcc/gcc-consolidation.h
@@ -0,0 +1,92 @@
+/* gcc-consolidation.h provides a single header for required gcc headers.
+
+Copyright (C) 2012-2022 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 "coretypes.h"
+#include "realmpfr.h"
+#include "backend.h"
+#include "stringpool.h"
+#include "rtl.h"
+#include "tree.h"
+#include "predict.h"
+#include "df.h"
+#include "tm.h"
+#include "hash-set.h"
+#include "machmode.h"
+#include "vec.h"
+#include "double-int.h"
+#include "input.h"
+#include "alias.h"
+#include "symtab.h"
+#include "options.h"
+#include "wide-int.h"
+#include "inchash.h"
+#include "stor-layout.h"
+#include "attribs.h"
+#include "intl.h"
+#include "tree-iterator.h"
+#include "diagnostic.h"
+#include "wide-int-print.h"
+#include "real.h"
+#include "float.h"
+#include "spellcheck.h"
+#include "opt-suggestions.h"
+
+/* Utilize some of the C build routines.  */
+
+#include "fold-const.h"
+#include "varasm.h"
+#include "hashtab.h"
+#include "hard-reg-set.h"
+#include "function.h"
+
+#include "hash-map.h"
+#include "langhooks.h"
+#include "timevar.h"
+#include "dumpfile.h"
+#include "target.h"
+#include "dominance.h"
+#include "cfg.h"
+#include "cfganal.h"
+#include "predict.h"
+#include "basic-block.h"
+#include "df.h"
+#include "tree-ssa-alias.h"
+#include "internal-fn.h"
+#include "gimple-expr.h"
+#include "is-a.h"
+#include "gimple.h"
+#include "gimple-ssa.h"
+#include "gimplify.h"
+#include "stringpool.h"
+#include "tree-nested.h"
+#include "print-tree.h"
+#include "except.h"
+#include "toplev.h"
+#include "convert.h"
+#include "tree-dump.h"
+#include "plugin-api.h"
+#include "hard-reg-set.h"
+#include "function.h"
+#include "ipa-ref.h"
+#include "cgraph.h"
+#include "stmt.h"
diff --git a/gcc/m2/gm2-gcc/init.cc b/gcc/m2/gm2-gcc/init.cc
new file mode 100644
index 00000000000..8fa074e2894
--- /dev/null
+++ b/gcc/m2/gm2-gcc/init.cc
@@ -0,0 +1,196 @@
+/* init.cc initializes the modules of the GNU Modula-2 front end.
+
+Copyright (C) 2012-2022 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 "init.h"
+#include "config.h"
+#include "system.h"
+
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__  */
+#define EXTERN extern
+#endif /* !__GNUG__  */
+
+EXTERN void _M2_M2Bitset_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_Debug_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Defaults_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_Environment_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_RTExceptions_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2EXCEPTION_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2RTS_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Dependent_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_SysExceptions_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_DynamicStrings_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_Assertion_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_FormatStrings_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_FIO_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_SFIO_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_SArgs_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_Lists_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_UnixArgs_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_Args_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_wrapc_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_TimeString_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_IO_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_StdIO_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_CmdArgs_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Preprocess_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Error_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Search_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_Indexing_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_NameKey_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_NumberIO_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_FpuIO_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_SysStorage_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_Storage_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_StrIO_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Debug_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Batch_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_StrLib_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2ALU_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Options_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Comp_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2LexBuf_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_SymbolTable_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Base_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Quads_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_SymbolKey_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_FifoQueue_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Reserved_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Const_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_P1SymBuild_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_P2SymBuild_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_P3SymBuild_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2System_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2BasicBlock_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Pass_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Code_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2AsmUtil_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2FileName_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Students_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_StrCase_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_SymbolConversion_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2GCCDeclare_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2GenGCC_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Range_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Swig_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2MetaError_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2CaseList_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_PCSymBuild_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_PCBuild_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_Sets_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_dtoa_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_ldtoa_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Check_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2SSA_init (int argc, char *argv[], char *envp[]);
+EXTERN void exit (int);
+EXTERN void M2Comp_compile (const char *filename);
+EXTERN void RTExceptions_DefaultErrorCatch (void);
+
+
+/* FrontEndInit initialize the modules.  This is a global
+   initialization and it is called once.  */
+
+void
+init_FrontEndInit (void)
+{
+  _M2_Debug_init (0, NULL, NULL);
+  _M2_RTExceptions_init (0, NULL, NULL);
+  _M2_M2Defaults_init (0, NULL, NULL);
+  _M2_Environment_init (0, NULL, NULL);
+  _M2_M2EXCEPTION_init (0, NULL, NULL);
+  _M2_M2Dependent_init (0, NULL, NULL);
+  _M2_M2RTS_init (0, NULL, NULL);
+  _M2_SysExceptions_init (0, NULL, NULL);
+  _M2_DynamicStrings_init (0, NULL, NULL);
+  _M2_Assertion_init (0, NULL, NULL);
+  _M2_FormatStrings_init (0, NULL, NULL);
+  _M2_FIO_init (0, NULL, NULL);
+  _M2_SFIO_init (0, NULL, NULL);
+  _M2_SArgs_init (0, NULL, NULL);
+  _M2_Lists_init (0, NULL, NULL);
+  _M2_UnixArgs_init (0, NULL, NULL);
+  _M2_Args_init (0, NULL, NULL);
+  _M2_wrapc_init (0, NULL, NULL);
+  _M2_TimeString_init (0, NULL, NULL);
+  _M2_IO_init (0, NULL, NULL);
+  _M2_StdIO_init (0, NULL, NULL);
+  _M2_CmdArgs_init (0, NULL, NULL);
+  _M2_FpuIO_init (0, NULL, NULL);
+  _M2_SysStorage_init (0, NULL, NULL);
+  _M2_Storage_init (0, NULL, NULL);
+  _M2_StrIO_init (0, NULL, NULL);
+  _M2_StrLib_init (0, NULL, NULL);
+  _M2_dtoa_init (0, NULL, NULL);
+  _M2_ldtoa_init (0, NULL, NULL);
+  _M2_M2Search_init (0, NULL, NULL);
+  _M2_M2Options_init (0, NULL, NULL);
+}
+
+/* PerCompilationInit initialize the modules before compiling,
+   filename.  This is called every time we compile a new file.  */
+
+void
+init_PerCompilationInit (const char *filename)
+{
+  _M2_M2Bitset_init (0, NULL, NULL);
+  _M2_M2Preprocess_init (0, NULL, NULL);
+  _M2_M2Error_init (0, NULL, NULL);
+  _M2_Indexing_init (0, NULL, NULL);
+  _M2_NameKey_init (0, NULL, NULL);
+  _M2_NumberIO_init (0, NULL, NULL);
+  _M2_M2Debug_init (0, NULL, NULL);
+  _M2_M2Batch_init (0, NULL, NULL);
+  _M2_M2ALU_init (0, NULL, NULL);
+  _M2_M2Comp_init (0, NULL, NULL);
+  _M2_M2LexBuf_init (0, NULL, NULL);
+  _M2_SymbolTable_init (0, NULL, NULL);
+  _M2_M2Base_init (0, NULL, NULL);
+  _M2_M2Quads_init (0, NULL, NULL);
+  _M2_SymbolKey_init (0, NULL, NULL);
+  _M2_FifoQueue_init (0, NULL, NULL);
+  _M2_M2Reserved_init (0, NULL, NULL);
+  _M2_M2Const_init (0, NULL, NULL);
+  _M2_P1SymBuild_init (0, NULL, NULL);
+  _M2_P2SymBuild_init (0, NULL, NULL);
+  _M2_P3SymBuild_init (0, NULL, NULL);
+  _M2_M2System_init (0, NULL, NULL);
+  _M2_M2BasicBlock_init (0, NULL, NULL);
+  _M2_M2Pass_init (0, NULL, NULL);
+  _M2_M2Code_init (0, NULL, NULL);
+  _M2_M2AsmUtil_init (0, NULL, NULL);
+  _M2_M2FileName_init (0, NULL, NULL);
+  _M2_M2Students_init (0, NULL, NULL);
+  _M2_StrCase_init (0, NULL, NULL);
+  _M2_SymbolConversion_init (0, NULL, NULL);
+  _M2_M2GCCDeclare_init (0, NULL, NULL);
+  _M2_M2GenGCC_init (0, NULL, NULL);
+  _M2_M2Range_init (0, NULL, NULL);
+  _M2_M2Swig_init (0, NULL, NULL);
+  _M2_M2MetaError_init (0, NULL, NULL);
+  _M2_M2CaseList_init (0, NULL, NULL);
+  _M2_PCSymBuild_init (0, NULL, NULL);
+  _M2_PCBuild_init (0, NULL, NULL);
+  _M2_Sets_init (0, NULL, NULL);
+  _M2_M2SSA_init (0, NULL, NULL);
+  _M2_M2Check_init (0, NULL, NULL);
+  M2Comp_compile (filename);
+}
diff --git a/gcc/m2/gm2-gcc/init.def b/gcc/m2/gm2-gcc/init.def
new file mode 100644
index 00000000000..5c52999ace4
--- /dev/null
+++ b/gcc/m2/gm2-gcc/init.def
@@ -0,0 +1,43 @@
+(* init.def provides procedures for initialising the m2 front end.
+
+Copyright (C) 2012-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" init ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   FrontEndInit - initialise the modules, this is a global initialisation.
+                  This is called once.
+*)
+
+PROCEDURE FrontEndInit ;
+
+
+(*
+   PerCompilationInit - initialise the modules before compiling, filename.
+                        This is to be called every time we compile a new file.
+*)
+
+PROCEDURE PerCompilationInit (filename: ADDRESS) ;
+
+
+END init.
diff --git a/gcc/m2/gm2-gcc/init.h b/gcc/m2/gm2-gcc/init.h
new file mode 100644
index 00000000000..f5b3d2d2f7f
--- /dev/null
+++ b/gcc/m2/gm2-gcc/init.h
@@ -0,0 +1,35 @@
+/* init.h header file for init.cc.
+
+Copyright (C) 2012-2022 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(init_h)
+#define init_h
+
+#if defined(init_cpp)
+extern "C" {
+void init_FrontEndInit (void);
+void init_PerCompilationInit (const char *filename);
+}
+#else /* !init_cpp.  */
+void init_FrontEndInit (void);
+void init_PerCompilationInit (const char *filename);
+#endif /* !init_cpp.  */
+
+#endif /*! init_h.  */
diff --git a/gcc/m2/gm2-gcc/m2assert.cc b/gcc/m2/gm2-gcc/m2assert.cc
new file mode 100644
index 00000000000..f59fa92660a
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2assert.cc
@@ -0,0 +1,41 @@
+/* m2assert.cc provides a simple assertion for location.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2assert_c
+#include "m2assert.h"
+#include "m2options.h"
+
+void
+m2assert_AssertLocation (location_t location)
+{
+  /* Internally the compiler will use unknown location and
+     builtins_location so we ignore these values.  */
+  if (location == BUILTINS_LOCATION || location == UNKNOWN_LOCATION)
+    return;
+
+  if (M2Options_OverrideLocation (location) != location)
+    internal_error ("the location value is corrupt");
+}
diff --git a/gcc/m2/gm2-gcc/m2assert.h b/gcc/m2/gm2-gcc/m2assert.h
new file mode 100644
index 00000000000..6b379642851
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2assert.h
@@ -0,0 +1,68 @@
+/* m2assert.h header file for m2assert.cc and assertion macros.
+
+Copyright (C) 2012-2022 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(m2assert_h)
+#define m2assert_h
+#if defined(m2assert_c)
+#define EXTERN
+#else /* !m2assert_c.  */
+#define EXTERN extern
+#endif /* !m2assert_c.  */
+
+#if !defined(ASSERT)
+#define ASSERT(X, Y)                                                          \
+  {                                                                           \
+    if (!(X))                                                                 \
+      {                                                                       \
+        debug_tree (Y);                                                       \
+        internal_error ("%s:%d:condition %s failed", __FILE__, __LINE__,      \
+                        #X);                                                  \
+      }                                                                       \
+  }
+#endif
+
+#if !defined(ASSERT_BOOL)
+#define ASSERT_BOOL(X)                                                        \
+  {                                                                           \
+    if ((X != 0) && (X != 1))                                                 \
+      {                                                                       \
+        internal_error (                                                      \
+            "%s:%d:the value %s is not a BOOLEAN as the value is %d",         \
+            __FILE__, __LINE__, #X, X);                                       \
+      }                                                                       \
+  }
+#endif
+
+#if !defined(ASSERT_CONDITION)
+#define ASSERT_CONDITION(X)                                                   \
+  {                                                                           \
+    if (!(X))                                                                 \
+      {                                                                       \
+        internal_error ("%s:%d:condition %s failed", __FILE__, __LINE__,      \
+                        #X);                                                  \
+      }                                                                       \
+  }
+#endif
+
+EXTERN void m2assert_AssertLocation (location_t location);
+
+#undef EXTERN
+#endif  /* m2assert_h.  */
diff --git a/gcc/m2/gm2-gcc/m2block.cc b/gcc/m2/gm2-gcc/m2block.cc
new file mode 100644
index 00000000000..746aa67bdce
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2block.cc
@@ -0,0 +1,770 @@
+/* m2block.cc provides an interface to maintaining block structures.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#define m2block_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2decl.h"
+#include "m2options.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+
+/* For each binding contour we allocate a binding_level structure
+   which records the entities defined or declared in that contour.
+   Contours include:
+
+   the global one one for each subprogram definition
+
+   Binding contours are used to create GCC tree BLOCK nodes.  */
+
+struct GTY (()) binding_level
+{
+  /* The function associated with the scope.  This is NULL_TREE for the
+     global scope.  */
+  tree fndecl;
+
+  /* A chain of _DECL nodes for all variables, constants, functions,
+     and typedef types.  These are in the reverse of the order supplied.  */
+  tree names;
+
+  /* A boolean to indicate whether this is binding level is a global ie
+     outer module scope.  In which case fndecl will be NULL_TREE.  */
+  int is_global;
+
+  /* The context of the binding level, for a function binding level
+     this will be the same as fndecl, however for a global binding level
+     this is a translation_unit.  */
+  tree context;
+
+  /* The binding level below this one.  This field is only used when
+     the binding level has been pushed by pushFunctionScope.  */
+  struct binding_level *next;
+
+  /* All binding levels are placed onto this list.  */
+  struct binding_level *list;
+
+  /* A varray of trees, which represent the list of statement
+     sequences.  */
+  vec<tree, va_gc> *m2_statements;
+
+  /* A list of constants (only kept in the global binding level).
+     Constants need to be kept through the life of the compilation, as the
+     same constants can be used in any scope.  */
+  tree constants;
+
+  /* A list of inner module initialization functions.  */
+  tree init_functions;
+
+  /* A list of types created by M2GCCDeclare prior to code generation
+     and those which may not be specifically declared and saved via a
+     push_decl.  */
+  tree types;
+
+  /* A list of all DECL_EXPR created within this binding level.  This
+     will be prepended to the statement list once the binding level (scope
+     is finished).  */
+  tree decl;
+
+  /* A list of labels which have been created in this scope.  */
+  tree labels;
+
+  /* The number of times this level has been pushed.  */
+  int count;
+};
+
+/* The binding level currently in effect.  */
+
+static GTY (()) struct binding_level *current_binding_level;
+
+/* The outermost binding level, for names of file scope.  This is
+   created when the compiler is started and exists through the entire
+   run.  */
+
+static GTY (()) struct binding_level *global_binding_level;
+
+/* The head of the binding level lists.  */
+static GTY (()) struct binding_level *head_binding_level;
+
+/* The current statement tree.  */
+
+typedef struct stmt_tree_s *stmt_tree_t;
+
+#undef DEBUGGING
+
+static location_t pending_location;
+static int pending_statement = FALSE;
+
+/* assert_global_names asserts that the global_binding_level->names
+   can be chained.  */
+
+static void
+assert_global_names (void)
+{
+  tree p = global_binding_level->names;
+
+  while (p)
+    p = TREE_CHAIN (p);
+}
+
+/* lookupLabel return label tree in current scope, otherwise
+   NULL_TREE.  */
+
+static tree
+lookupLabel (tree id)
+{
+  tree t;
+
+  for (t = current_binding_level->labels; t != NULL_TREE; t = TREE_CHAIN (t))
+    {
+      tree l = TREE_VALUE (t);
+
+      if (id == DECL_NAME (l))
+        return l;
+    }
+  return NULL_TREE;
+}
+
+/* getLabel return the label name or create a label name in the
+   current scope.  */
+
+tree
+m2block_getLabel (location_t location, char *name)
+{
+  tree id = get_identifier (name);
+  tree label = lookupLabel (id);
+
+  if (label == NULL_TREE)
+    {
+      label = build_decl (location, LABEL_DECL, id, void_type_node);
+      current_binding_level->labels
+          = tree_cons (NULL_TREE, label, current_binding_level->labels);
+    }
+  if (DECL_CONTEXT (label) == NULL_TREE)
+    DECL_CONTEXT (label) = current_function_decl;
+  ASSERT ((DECL_CONTEXT (label) == current_function_decl),
+          current_function_decl);
+
+  DECL_MODE (label) = VOIDmode;
+  return label;
+}
+
+static void
+init_binding_level (struct binding_level *l)
+{
+  l->fndecl = NULL;
+  l->names = NULL;
+  l->is_global = 0;
+  l->context = NULL;
+  l->next = NULL;
+  l->list = NULL;
+  vec_alloc (l->m2_statements, 1);
+  l->constants = NULL;
+  l->init_functions = NULL;
+  l->types = NULL;
+  l->decl = NULL;
+  l->labels = NULL;
+  l->count = 0;
+}
+
+static struct binding_level *
+newLevel (void)
+{
+  struct binding_level *newlevel = ggc_alloc<binding_level> ();
+
+  init_binding_level (newlevel);
+
+  /* Now we a push_statement_list.  */
+  vec_safe_push (newlevel->m2_statements, m2block_begin_statement_list ());
+  return newlevel;
+}
+
+tree *
+m2block_cur_stmt_list_addr (void)
+{
+  ASSERT_CONDITION (current_binding_level != NULL);
+  int l = vec_safe_length (current_binding_level->m2_statements) - 1;
+
+  return &(*current_binding_level->m2_statements)[l];
+}
+
+tree
+m2block_cur_stmt_list (void)
+{
+  tree *t = m2block_cur_stmt_list_addr ();
+
+  return *t;
+}
+
+/* is_building_stmt_list returns TRUE if we are building a
+   statement list.  TRUE is returned if we are in a binding level and
+   a statement list is under construction.  */
+
+int
+m2block_is_building_stmt_list (void)
+{
+  ASSERT_CONDITION (current_binding_level != NULL);
+  return !vec_safe_is_empty (current_binding_level->m2_statements);
+}
+
+/* push_statement_list pushes the statement list t onto the
+   current binding level.  */
+
+tree
+m2block_push_statement_list (tree t)
+{
+  ASSERT_CONDITION (current_binding_level != NULL);
+  vec_safe_push (current_binding_level->m2_statements, t);
+  return t;
+}
+
+/* pop_statement_list pops and returns a statement list from the
+   current binding level.  */
+
+tree
+m2block_pop_statement_list (void)
+{
+  ASSERT_CONDITION (current_binding_level != NULL);
+  {
+    tree t = current_binding_level->m2_statements->pop ();
+
+    return t;
+  }
+}
+
+/* begin_statement_list starts a tree statement.  It pushes the
+   statement list and returns the list node.  */
+
+tree
+m2block_begin_statement_list (void)
+{
+  return alloc_stmt_list ();
+}
+
+/* findLevel returns the binding level associated with fndecl one
+   is created if there is no existing one on head_binding_level.  */
+
+static struct binding_level *
+findLevel (tree fndecl)
+{
+  struct binding_level *b;
+
+  if (fndecl == NULL_TREE)
+    return global_binding_level;
+
+  b = head_binding_level;
+  while ((b != NULL) && (b->fndecl != fndecl))
+    b = b->list;
+
+  if (b == NULL)
+    {
+      b = newLevel ();
+      b->fndecl = fndecl;
+      b->context = fndecl;
+      b->is_global = FALSE;
+      b->list = head_binding_level;
+      b->next = NULL;
+    }
+  return b;
+}
+
+/* pushFunctionScope push a binding level.  */
+
+void
+m2block_pushFunctionScope (tree fndecl)
+{
+  struct binding_level *n;
+  struct binding_level *b;
+
+#if defined(DEBUGGING)
+  if (fndecl != NULL)
+    printf ("pushFunctionScope\n");
+#endif
+
+  /* Allow multiple consecutive pushes of the same scope.  */
+
+  if (current_binding_level != NULL
+      && (current_binding_level->fndecl == fndecl))
+    {
+      current_binding_level->count++;
+      return;
+    }
+
+  /* Firstly check to see that fndecl is not already on the binding
+     stack.  */
+
+  for (b = current_binding_level; b != NULL; b = b->next)
+    /* Only allowed one instance of the binding on the stack at a time.  */
+    ASSERT_CONDITION (b->fndecl != fndecl);
+
+  n = findLevel (fndecl);
+
+  /* Add this level to the front of the stack.  */
+  n->next = current_binding_level;
+  current_binding_level = n;
+}
+
+/* popFunctionScope - pops a binding level, returning the function
+   associated with the binding level.  */
+
+tree
+m2block_popFunctionScope (void)
+{
+  tree fndecl = current_binding_level->fndecl;
+
+#if defined(DEBUGGING)
+  if (fndecl != NULL)
+    printf ("popFunctionScope\n");
+#endif
+
+  if (current_binding_level->count > 0)
+    {
+      /* Multiple pushes have occurred of the same function scope (and
+         ignored), pop them likewise.  */
+      current_binding_level->count--;
+      return fndecl;
+    }
+  ASSERT_CONDITION (current_binding_level->fndecl
+                    != NULL_TREE); /* Expecting local scope.  */
+
+  ASSERT_CONDITION (current_binding_level->constants
+                    == NULL_TREE); /* Should not be used.  */
+  ASSERT_CONDITION (current_binding_level->names
+                    == NULL_TREE); /* Should be cleared.  */
+  ASSERT_CONDITION (current_binding_level->decl
+                    == NULL_TREE); /* Should be cleared.  */
+
+  current_binding_level = current_binding_level->next;
+  return fndecl;
+}
+
+/* pushGlobalScope push the global scope onto the binding level
+   stack.  There can only ever be one instance of the global binding
+   level on the stack.  */
+
+void
+m2block_pushGlobalScope (void)
+{
+#if defined(DEBUGGING)
+  printf ("pushGlobalScope\n");
+#endif
+  m2block_pushFunctionScope (NULL_TREE);
+}
+
+/* popGlobalScope pops the current binding level, it expects this
+   binding level to be the global binding level.  */
+
+void
+m2block_popGlobalScope (void)
+{
+  ASSERT_CONDITION (
+      current_binding_level->is_global);  /* Expecting global scope.  */
+  ASSERT_CONDITION (current_binding_level == global_binding_level);
+
+  if (current_binding_level->count > 0)
+    {
+      current_binding_level->count--;
+      return;
+    }
+
+  current_binding_level = current_binding_level->next;
+#if defined(DEBUGGING)
+  printf ("popGlobalScope\n");
+#endif
+
+  assert_global_names ();
+}
+
+/* finishFunctionDecl removes declarations from the current binding
+   level and places them inside fndecl.  The current binding level is
+   then able to be destroyed by a call to popFunctionScope.
+
+   The extra tree nodes associated with fndecl will be created such
+   as BIND_EXPR, BLOCK and the initial STATEMENT_LIST containing the
+   DECL_EXPR is also created.  */
+
+void
+m2block_finishFunctionDecl (location_t location, tree fndecl)
+{
+  tree context = current_binding_level->context;
+  tree block = DECL_INITIAL (fndecl);
+  tree bind_expr = DECL_SAVED_TREE (fndecl);
+  tree i;
+
+  if (block == NULL_TREE)
+    {
+      block = make_node (BLOCK);
+      DECL_INITIAL (fndecl) = block;
+      TREE_USED (block) = TRUE;
+      BLOCK_SUBBLOCKS (block) = NULL_TREE;
+    }
+  BLOCK_SUPERCONTEXT (block) = context;
+
+  BLOCK_VARS (block)
+      = chainon (BLOCK_VARS (block), current_binding_level->names);
+  TREE_USED (fndecl) = TRUE;
+
+  if (bind_expr == NULL_TREE)
+    {
+      bind_expr
+          = build3 (BIND_EXPR, void_type_node, current_binding_level->names,
+                    current_binding_level->decl, block);
+      DECL_SAVED_TREE (fndecl) = bind_expr;
+    }
+  else
+    {
+      if (!chain_member (current_binding_level->names,
+                         BIND_EXPR_VARS (bind_expr)))
+        {
+          BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr),
+                                                current_binding_level->names);
+
+          if (current_binding_level->names != NULL_TREE)
+            {
+              for (i = current_binding_level->names; i != NULL_TREE;
+                   i = DECL_CHAIN (i))
+                append_to_statement_list_force (i,
+                                                &BIND_EXPR_BODY (bind_expr));
+
+            }
+        }
+    }
+  SET_EXPR_LOCATION (bind_expr, location);
+
+  current_binding_level->names = NULL_TREE;
+  current_binding_level->decl = NULL_TREE;
+}
+
+/* finishFunctionCode adds cur_stmt_list to fndecl.  The current
+   binding level is then able to be destroyed by a call to
+   popFunctionScope.  The cur_stmt_list is appended to the
+   STATEMENT_LIST.  */
+
+void
+m2block_finishFunctionCode (tree fndecl)
+{
+  tree bind_expr;
+  tree block;
+  tree statements = m2block_pop_statement_list ();
+  tree_stmt_iterator i;
+
+  ASSERT_CONDITION (DECL_SAVED_TREE (fndecl) != NULL_TREE);
+
+  bind_expr = DECL_SAVED_TREE (fndecl);
+  ASSERT_CONDITION (TREE_CODE (bind_expr) == BIND_EXPR);
+
+  block = DECL_INITIAL (fndecl);
+  ASSERT_CONDITION (TREE_CODE (block) == BLOCK);
+
+  if (current_binding_level->names != NULL_TREE)
+    {
+      BIND_EXPR_VARS (bind_expr)
+          = chainon (BIND_EXPR_VARS (bind_expr), current_binding_level->names);
+      current_binding_level->names = NULL_TREE;
+    }
+  if (current_binding_level->labels != NULL_TREE)
+    {
+      tree t;
+
+      for (t = current_binding_level->labels; t != NULL_TREE;
+           t = TREE_CHAIN (t))
+        {
+          tree l = TREE_VALUE (t);
+
+          BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr), l);
+        }
+      current_binding_level->labels = NULL_TREE;
+    }
+
+  BLOCK_VARS (block) = BIND_EXPR_VARS (bind_expr);
+
+  if (current_binding_level->decl != NULL_TREE)
+    for (i = tsi_start (current_binding_level->decl); !tsi_end_p (i);
+         tsi_next (&i))
+      append_to_statement_list_force (*tsi_stmt_ptr (i),
+                                      &BIND_EXPR_BODY (bind_expr));
+
+  for (i = tsi_start (statements); !tsi_end_p (i); tsi_next (&i))
+    append_to_statement_list_force (*tsi_stmt_ptr (i),
+                                    &BIND_EXPR_BODY (bind_expr));
+
+  current_binding_level->decl = NULL_TREE;
+}
+
+void
+m2block_finishGlobals (void)
+{
+  tree context = global_binding_level->context;
+  tree block = make_node (BLOCK);
+  tree p = global_binding_level->names;
+
+  BLOCK_SUBBLOCKS (block) = NULL;
+  TREE_USED (block) = 1;
+
+  BLOCK_VARS (block) = p;
+
+  DECL_INITIAL (context) = block;
+  BLOCK_SUPERCONTEXT (block) = context;
+}
+
+/* pushDecl pushes a declaration onto the current binding level.  */
+
+tree
+m2block_pushDecl (tree decl)
+{
+  /* External objects aren't nested, other objects may be.  */
+
+  if (decl != current_function_decl)
+    DECL_CONTEXT (decl) = current_binding_level->context;
+
+  /* Put the declaration on the list.  The list of declarations is in
+     reverse order.  The list will be reversed later if necessary.  This
+     needs to be this way for compatibility with the back-end.  */
+
+  TREE_CHAIN (decl) = current_binding_level->names;
+  current_binding_level->names = decl;
+
+  assert_global_names ();
+
+  return decl;
+}
+
+/* includeDecl pushes a declaration onto the current binding level
+   providing it is not already present.  */
+
+void
+m2block_includeDecl (tree decl)
+{
+  tree p = current_binding_level->names;
+
+  while (p != decl && p != NULL)
+    p = TREE_CHAIN (p);
+  if (p != decl)
+    m2block_pushDecl (decl);
+}
+
+/* addDeclExpr adds the DECL_EXPR node t to the statement list
+   current_binding_level->decl.  This allows us to order all
+   declarations at the beginning of the function.  */
+
+void
+m2block_addDeclExpr (tree t)
+{
+  append_to_statement_list_force (t, &current_binding_level->decl);
+}
+
+/* RememberType remember the type t in the ggc marked list.  */
+
+tree
+m2block_RememberType (tree t)
+{
+  global_binding_level->types
+      = tree_cons (NULL_TREE, t, global_binding_level->types);
+  return t;
+}
+
+/* global_constant returns t.  It chains t onto the
+   global_binding_level list of constants, if it is not already
+   present.  */
+
+tree
+m2block_global_constant (tree t)
+{
+  tree s;
+
+  if (global_binding_level->constants != NULL_TREE)
+    for (s = global_binding_level->constants; s != NULL_TREE;
+         s = TREE_CHAIN (s))
+      {
+        tree c = TREE_VALUE (s);
+
+        if (c == t)
+          return t;
+      }
+
+  global_binding_level->constants
+      = tree_cons (NULL_TREE, t, global_binding_level->constants);
+  return t;
+}
+
+/* RememberConstant adds a tree t onto the list of constants to
+   be marked whenever the ggc re-marks all used storage.  Constants
+   live throughout the whole compilation and they can be used by
+   many different functions if necessary.  */
+
+tree
+m2block_RememberConstant (tree t)
+{
+  if ((t != NULL) && (m2tree_IsAConstant (t)))
+    return m2block_global_constant (t);
+  return t;
+}
+
+/* DumpGlobalConstants displays all global constants and checks
+   none are poisoned.  */
+
+tree
+m2block_DumpGlobalConstants (void)
+{
+  tree s;
+
+  if (global_binding_level->constants != NULL_TREE)
+    for (s = global_binding_level->constants; TREE_CHAIN (s);
+         s = TREE_CHAIN (s))
+      debug_tree (s);
+  return NULL_TREE;
+}
+
+/* RememberInitModuleFunction records tree t in the global
+   binding level.  So that it will not be garbage collected.  In
+   theory the inner modules could be placed inside the
+   current_binding_level I suspect.  */
+
+tree
+m2block_RememberInitModuleFunction (tree t)
+{
+  global_binding_level->init_functions
+      = tree_cons (NULL_TREE, t, global_binding_level->init_functions);
+  return t;
+}
+
+/* toplevel return TRUE if we are in the global scope.  */
+
+int
+m2block_toplevel (void)
+{
+  if (current_binding_level == NULL)
+    return TRUE;
+  if (current_binding_level->fndecl == NULL)
+    return TRUE;
+  return FALSE;
+}
+
+/* GetErrorNode returns the gcc error_mark_node.  */
+
+tree
+m2block_GetErrorNode (void)
+{
+  return error_mark_node;
+}
+
+/* GetGlobals - returns a list of global variables, functions,
+   constants.  */
+
+tree
+m2block_GetGlobals (void)
+{
+  assert_global_names ();
+  return global_binding_level->names;
+}
+
+/* GetGlobalContext - returns the global context tree.  */
+
+tree
+m2block_GetGlobalContext (void)
+{
+  return global_binding_level->context;
+}
+
+/* do_add_stmt - t is a statement.  Add it to the statement-tree.  */
+
+static tree
+do_add_stmt (tree t)
+{
+  if (current_binding_level != NULL)
+    append_to_statement_list_force (t, m2block_cur_stmt_list_addr ());
+  return t;
+}
+
+/* flush_pending_note - flushes a pending_statement note if
+   necessary.  */
+
+static void
+flush_pending_note (void)
+{
+  if (pending_statement && (M2Options_GetM2g ()))
+    {
+#if 0
+      /* --fixme-- we need a machine independant way to generate a nop.  */
+      tree instr = m2decl_BuildStringConstant ("nop", 3);
+      tree string
+          = resolve_asm_operand_names (instr, NULL_TREE, NULL_TREE, NULL_TREE);
+      tree note = build_stmt (pending_location, ASM_EXPR, string, NULL_TREE,
+                              NULL_TREE, NULL_TREE, NULL_TREE);
+
+      ASM_INPUT_P (note) = FALSE;
+      ASM_VOLATILE_P (note) = FALSE;
+#else
+      tree note = build_empty_stmt (pending_location);
+#endif
+      pending_statement = FALSE;
+      do_add_stmt (note);
+    }
+}
+
+/* add_stmt t is a statement.  Add it to the statement-tree.  */
+
+tree
+m2block_add_stmt (location_t location, tree t)
+{
+  if ((CAN_HAVE_LOCATION_P (t)) && (!EXPR_HAS_LOCATION (t)))
+    SET_EXPR_LOCATION (t, location);
+
+  if (pending_statement && (pending_location != location))
+    flush_pending_note ();
+
+  pending_statement = FALSE;
+  return do_add_stmt (t);
+}
+
+/* addStmtNote remember this location represents the start of a
+   Modula-2 statement.  It is flushed if another different location
+   is generated or another tree is given to add_stmt.  */
+
+void
+m2block_addStmtNote (location_t location)
+{
+  if (pending_statement && (pending_location != location))
+    flush_pending_note ();
+
+  pending_statement = TRUE;
+  pending_location = location;
+}
+
+void
+m2block_removeStmtNote (void)
+{
+  pending_statement = FALSE;
+}
+
+/* init - initialize the data structures in this module.  */
+
+void
+m2block_init (void)
+{
+  global_binding_level = newLevel ();
+  global_binding_level->context = build_translation_unit_decl (NULL);
+  global_binding_level->is_global = TRUE;
+  current_binding_level = NULL;
+}
+
+#include "gt-m2-m2block.h"
diff --git a/gcc/m2/gm2-gcc/m2block.def b/gcc/m2/gm2-gcc/m2block.def
new file mode 100644
index 00000000000..e0c48d523d4
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2block.def
@@ -0,0 +1,225 @@
+(* m2block.def definition module for m2block.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2block ;
+
+
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+    init - initialise the data structures in this module.
+*)
+
+PROCEDURE init ;
+
+
+(*
+    toplevel - return TRUE if we are in the global scope.
+*)
+
+PROCEDURE toplevel () : BOOLEAN ;
+
+
+(*
+    global_constant - t is a constant, we keep a chain of all constants
+                      in the global binding level.
+*)
+
+PROCEDURE global_constant (t: Tree) : Tree ;
+
+
+(*
+    RememberInitModuleFunction - records tree, t, in the global binding level.
+                                 So that it will not be garbage collected.
+                                 In theory the inner modules could be placed
+                                 inside the current_binding_level I suspect.
+*)
+
+PROCEDURE RememberInitModuleFunction (t: Tree) : Tree ;
+
+
+(*
+    DumpGlobalConstants - displays all global constants and checks none are
+                          poisoned.
+*)
+
+PROCEDURE DumpGlobalConstants () : Tree ;
+
+
+(*
+    RememberConstant - adds a tree, t, onto the list of constants to be marked
+                       whenever the ggc re-marks all used storage.  Constants
+                       live throughout the whole compilation - and they
+                       can be used by many different functions if necessary.
+*)
+
+PROCEDURE RememberConstant (t: Tree) : Tree ;
+
+
+(*
+    RememberType - remember the type, t, in the ggc marked list.
+*)
+
+PROCEDURE RememberType (t: Tree) : Tree ;
+
+
+(*
+    pushDecl - pushes a declaration onto the current binding level.
+*)
+
+PROCEDURE pushDecl (decl: Tree) : Tree ;
+
+
+(*
+    popGlobalScope - pops the current binding level, it expects this binding level
+                     to be the global binding level.
+*)
+
+PROCEDURE popGlobalScope ;
+
+
+(*
+    pushGlobalScope - push the global scope onto the binding level stack.
+                      There can only ever be one instance of the global binding
+                      level on the stack.
+*)
+
+PROCEDURE pushGlobalScope ;
+
+
+(*
+    popFunctionScope - pops a binding level, returning the function associated with the
+                       binding level.
+*)
+
+PROCEDURE popFunctionScope () : Tree ;
+
+
+(*
+    pushFunctionScope - push a binding level.
+*)
+
+PROCEDURE pushFunctionScope (fndecl: Tree) ;
+
+
+(*
+   finishFunctionCode - adds cur_stmt_list to fndecl.  The current binding level
+                        is then able to be destroyed by a call to popFunctionScope.
+                        The cur_stmt_list is appended to the STATEMENT_LIST.
+*)
+
+PROCEDURE finishFunctionCode (fndecl: Tree) ;
+
+
+(*
+   finishFunctionDecl - removes declarations from the current binding level and places
+                        them inside fndecl.  The current binding level is then able to
+                        be destroyed by a call to popFunctionScope.
+
+                        The extra tree nodes associated with fndecl will be created
+                        such as BIND_EXPR, BLOCK and the initial STATEMENT_LIST
+                        containing the DECL_EXPR is also created.
+*)
+
+PROCEDURE finishFunctionDecl (location: location_t; fndecl: Tree) ;
+
+
+(*
+    getLabel - return the label, name, or create a label, name
+               in the current scope.
+*)
+
+PROCEDURE getLabel (location: location_t; name: ADDRESS) : Tree ;
+
+
+(*
+   GetErrorNode - returns the gcc error_mark_node.
+*)
+
+PROCEDURE GetErrorNode () : Tree ;
+
+
+(*
+   includeDecl - pushes a declaration onto the current binding level providing
+                 it is not already present.
+*)
+
+PROCEDURE includeDecl (decl: Tree) ;
+
+
+(*
+   GetGlobals - returns a list of global variables, functions, constants.
+*)
+
+PROCEDURE GetGlobals () : Tree ;
+
+
+(*
+   GetGlobalContext - returns the global context tree.
+*)
+
+PROCEDURE GetGlobalContext () : Tree ;
+
+
+(*
+   begin_statement_list - starts a tree statement.  It pushes the
+                          statement list and returns the list node.
+*)
+
+PROCEDURE begin_statement_list () : Tree ;
+
+
+(*
+   push_statement_list - pushes the statement list, t, onto the
+                         current binding level.
+*)
+
+PROCEDURE push_statement_list (t: Tree) : Tree ;
+
+
+(*
+   pop_statement_list - pops and returns a statement list from the
+                        current binding level.
+*)
+
+PROCEDURE pop_statement_list () : Tree ;
+
+
+(*
+   addStmtNote - remember this location represents the start of a Modula-2
+                 statement.  It is flushed if another different location is
+                 generated or another tree is given to add_stmt.
+*)
+
+PROCEDURE addStmtNote (location: location_t) ;
+
+
+(*
+   removeStmtNote - removes any pending stmt note.
+*)
+
+PROCEDURE removeStmtNote ;
+
+
+END m2block.
diff --git a/gcc/m2/gm2-gcc/m2block.h b/gcc/m2/gm2-gcc/m2block.h
new file mode 100644
index 00000000000..a44d8797b08
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2block.h
@@ -0,0 +1,77 @@
+/* m2block.h header file for m2block.cc.
+
+Copyright (C) 2012-2022 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(m2block_h)
+#define m2block_h
+#if defined(m2block_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2block_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !m2block_h.  */
+#define EXTERN extern
+#endif /* !m2block_c.  */
+#endif /* !m2block_h.  */
+
+EXTERN tree m2block_getLabel (location_t location, char *name);
+EXTERN void m2block_pushFunctionScope (tree fndecl);
+EXTERN tree m2block_popFunctionScope (void);
+EXTERN void m2block_pushGlobalScope (void);
+EXTERN void m2block_popGlobalScope (void);
+EXTERN tree m2block_pushDecl (tree decl);
+EXTERN void m2block_addDeclExpr (tree t);
+
+EXTERN tree m2block_begin_statement_list (void);
+EXTERN tree m2block_push_statement_list (tree t);
+EXTERN tree m2block_pop_statement_list (void);
+
+EXTERN void m2block_finishFunctionDecl (location_t location, tree fndecl);
+EXTERN void m2block_finishFunctionCode (tree fndecl);
+
+EXTERN tree m2block_RememberType (tree t);
+EXTERN tree m2block_RememberConstant (tree t);
+EXTERN tree m2block_DumpGlobalConstants (void);
+EXTERN tree m2block_RememberInitModuleFunction (tree t);
+EXTERN tree m2block_global_constant (tree t);
+EXTERN int m2block_toplevel (void);
+EXTERN tree m2block_GetErrorNode (void);
+
+EXTERN void m2block_addStmtNote (location_t location);
+
+EXTERN tree m2block_cur_stmt_list (void);
+EXTERN tree *m2block_cur_stmt_list_addr (void);
+EXTERN int m2block_is_building_stmt_list (void);
+EXTERN tree m2block_GetGlobals (void);
+EXTERN tree m2block_GetGlobalContext (void);
+EXTERN void m2block_finishGlobals (void);
+EXTERN void m2block_includeDecl (tree);
+EXTERN tree m2block_add_stmt (location_t location, tree t);
+EXTERN void m2block_addStmtNote (location_t location);
+EXTERN void m2block_removeStmtNote (void);
+
+EXTERN void m2block_init (void);
+
+#undef EXTERN
+#endif /* m2block_h.  */
diff --git a/gcc/m2/gm2-gcc/m2builtins.cc b/gcc/m2/gm2-gcc/m2builtins.cc
new file mode 100644
index 00000000000..bbfc605a36d
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2builtins.cc
@@ -0,0 +1,1330 @@
+/* m2builtins.cc provides an interface to the GCC builtins.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "m2block.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2statement.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+
+#define GM2
+#define GM2_BUG_REPORT                                                        \
+  "Please report this crash to the GNU Modula-2 mailing list "                \
+  "<gm2@nongnu.org>\n"
+
+#define ASSERT(X, Y)                                                          \
+  {                                                                           \
+    if (!(X))                                                                 \
+      {                                                                       \
+        debug_tree (Y);                                                       \
+        internal_error ("%s:%d:assertion of condition `%s' failed", __FILE__, __LINE__,  \
+                        #X);                                                  \
+      }                                                                       \
+  }
+#define ERROR(X)                                                              \
+  {                                                                           \
+    internal_error ("%s:%d:%s", __FILE__, __LINE__, X);                     \
+  }
+
+typedef enum {
+  BT_FN_NONE,
+  BT_FN_PTR_SIZE,
+  BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE,
+  BT_FN_FLOAT,
+  BT_FN_DOUBLE,
+  BT_FN_LONG_DOUBLE,
+  BT_FN_FLOAT_FLOAT,
+  BT_FN_DOUBLE_DOUBLE,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE,
+  BT_FN_STRING_CONST_STRING_INT,
+  BT_FN_INT_CONST_PTR_CONST_PTR_SIZE,
+  BT_FN_TRAD_PTR_PTR_INT_SIZE,
+  BT_FN_STRING_STRING_CONST_STRING,
+  BT_FN_STRING_STRING_CONST_STRING_SIZE,
+  BT_FN_INT_CONST_STRING_CONST_STRING,
+  BT_FN_INT_CONST_STRING_CONST_STRING_SIZE,
+  BT_FN_INT_CONST_STRING,
+  BT_FN_STRING_CONST_STRING_CONST_STRING,
+  BT_FN_SIZE_CONST_STRING_CONST_STRING,
+  BT_FN_PTR_UNSIGNED,
+  BT_FN_VOID_PTR_INT,
+  BT_FN_INT_PTR,
+  BT_FN_INT_FLOAT,
+  BT_FN_INT_DOUBLE,
+  BT_FN_INT_LONG_DOUBLE,
+  BT_FN_FLOAT_FCOMPLEX,
+  BT_FN_DOUBLE_DCOMPLEX,
+  BT_FN_LONG_DOUBLE_LDCOMPLEX,
+
+  BT_FN_FCOMPLEX_FCOMPLEX,
+  BT_FN_DCOMPLEX_DCOMPLEX,
+  BT_FN_LDCOMPLEX_LDCOMPLEX,
+
+  BT_FN_DCOMPLEX_DOUBLE_DCOMPLEX,
+  BT_FN_FCOMPLEX_FLOAT_FCOMPLEX,
+  BT_FN_LDCOMPLEX_LONG_DOUBLE_LDCOMPLEX,
+
+  BT_FN_FLOAT_FLOAT_FLOATPTR,
+  BT_FN_DOUBLE_DOUBLE_DOUBLEPTR,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLEPTR,
+
+  BT_FN_FLOAT_FLOAT_LONG_DOUBLE,
+  BT_FN_DOUBLE_DOUBLE_LONG_DOUBLE,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+
+  BT_FN_FLOAT_FLOAT_LONG,
+  BT_FN_DOUBLE_DOUBLE_LONG,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG,
+
+  BT_FN_FLOAT_FLOAT_INT,
+  BT_FN_DOUBLE_DOUBLE_INT,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE_INT,
+
+  BT_FN_FLOAT_FLOAT_FLOAT,
+  BT_FN_DOUBLE_DOUBLE_DOUBLE,
+} builtin_prototype;
+
+struct builtin_function_entry
+{
+  const char *name;
+  builtin_prototype defn;
+  int function_code;
+  enum built_in_class fclass;
+  const char *library_name;
+  tree function_node;
+  tree return_node;
+};
+
+/* Entries are added by examining gcc/builtins.def and copying those
+   functions which can be applied to Modula-2.  */
+
+static struct builtin_function_entry list_of_builtins[] = {
+  { "__builtin_alloca", BT_FN_PTR_SIZE, BUILT_IN_ALLOCA, BUILT_IN_NORMAL,
+    "alloca", NULL, NULL },
+  { "__builtin_memcpy", BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE, BUILT_IN_MEMCPY,
+    BUILT_IN_NORMAL, "memcpy", NULL, NULL },
+
+  { "__builtin_isfinite", BT_FN_INT_DOUBLE, BUILT_IN_ISFINITE, BUILT_IN_NORMAL,
+    "isfinite", NULL, NULL },
+
+  { "__builtin_sinf", BT_FN_FLOAT_FLOAT, BUILT_IN_SINF, BUILT_IN_NORMAL,
+    "sinf", NULL, NULL },
+  { "__builtin_sin", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SIN, BUILT_IN_NORMAL, "sin",
+    NULL, NULL },
+  { "__builtin_sinl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_SINL,
+    BUILT_IN_NORMAL, "sinl", NULL, NULL },
+  { "__builtin_cosf", BT_FN_FLOAT_FLOAT, BUILT_IN_SINF, BUILT_IN_NORMAL,
+    "cosf", NULL, NULL },
+  { "__builtin_cos", BT_FN_DOUBLE_DOUBLE, BUILT_IN_COS, BUILT_IN_NORMAL, "cos",
+    NULL, NULL },
+  { "__builtin_cosl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_COSL,
+    BUILT_IN_NORMAL, "cosl", NULL, NULL },
+  { "__builtin_sqrtf", BT_FN_FLOAT_FLOAT, BUILT_IN_SQRTF, BUILT_IN_NORMAL,
+    "sqrtf", NULL, NULL },
+  { "__builtin_sqrt", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SQRT, BUILT_IN_NORMAL,
+    "sqrt", NULL, NULL },
+  { "__builtin_sqrtl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_SQRTL,
+    BUILT_IN_NORMAL, "sqrtl", NULL, NULL },
+  { "__builtin_fabsf", BT_FN_FLOAT_FLOAT, BUILT_IN_FABSF, BUILT_IN_NORMAL,
+    "fabsf", NULL, NULL },
+  { "__builtin_fabs", BT_FN_DOUBLE_DOUBLE, BUILT_IN_FABS, BUILT_IN_NORMAL,
+    "fabs", NULL, NULL },
+  { "__builtin_fabsl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_FABSL,
+    BUILT_IN_NORMAL, "fabsl", NULL, NULL },
+  { "__builtin_logf", BT_FN_FLOAT_FLOAT, BUILT_IN_LOGF, BUILT_IN_NORMAL,
+    "logf", NULL, NULL },
+  { "__builtin_log", BT_FN_DOUBLE_DOUBLE, BUILT_IN_LOG, BUILT_IN_NORMAL, "log",
+    NULL, NULL },
+  { "__builtin_logl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_LOGL,
+    BUILT_IN_NORMAL, "logl", NULL, NULL },
+  { "__builtin_expf", BT_FN_FLOAT_FLOAT, BUILT_IN_EXPF, BUILT_IN_NORMAL,
+    "expf", NULL, NULL },
+  { "__builtin_exp", BT_FN_DOUBLE_DOUBLE, BUILT_IN_EXP, BUILT_IN_NORMAL, "exp",
+    NULL, NULL },
+  { "__builtin_expl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_EXPL,
+    BUILT_IN_NORMAL, "expl", NULL, NULL },
+  { "__builtin_log10f", BT_FN_FLOAT_FLOAT, BUILT_IN_LOG10F, BUILT_IN_NORMAL,
+    "log10f", NULL, NULL },
+  { "__builtin_log10", BT_FN_DOUBLE_DOUBLE, BUILT_IN_LOG10, BUILT_IN_NORMAL,
+    "log10", NULL, NULL },
+  { "__builtin_log10l", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_LOG10L,
+    BUILT_IN_NORMAL, "log10l", NULL, NULL },
+  { "__builtin_ilogbf", BT_FN_INT_FLOAT, BUILT_IN_ILOGBF, BUILT_IN_NORMAL,
+    "ilogbf", NULL, NULL },
+  { "__builtin_ilogb", BT_FN_INT_DOUBLE, BUILT_IN_ILOGB, BUILT_IN_NORMAL,
+    "ilogb", NULL, NULL },
+  { "__builtin_ilogbl", BT_FN_INT_LONG_DOUBLE, BUILT_IN_ILOGBL,
+    BUILT_IN_NORMAL, "ilogbl", NULL, NULL },
+
+  { "__builtin_atan2f", BT_FN_FLOAT_FLOAT_FLOAT, BUILT_IN_ATAN2F,
+    BUILT_IN_NORMAL, "atan2f", NULL, NULL },
+  { "__builtin_atan2", BT_FN_DOUBLE_DOUBLE_DOUBLE, BUILT_IN_ATAN2,
+    BUILT_IN_NORMAL, "atan2", NULL, NULL },
+  { "__builtin_atan2l", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_ATAN2L, BUILT_IN_NORMAL, "atan2l", NULL, NULL },
+
+  { "__builtin_signbit", BT_FN_INT_DOUBLE, BUILT_IN_SIGNBIT, BUILT_IN_NORMAL,
+    "signbit", NULL, NULL },
+  { "__builtin_signbitf", BT_FN_INT_FLOAT, BUILT_IN_SIGNBITF, BUILT_IN_NORMAL,
+    "signbitf", NULL, NULL },
+  { "__builtin_signbitl", BT_FN_INT_LONG_DOUBLE, BUILT_IN_SIGNBITL,
+    BUILT_IN_NORMAL, "signbitl", NULL, NULL },
+  { "__builtin_significand", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SIGNIFICAND,
+    BUILT_IN_NORMAL, "significand", NULL, NULL },
+  { "__builtin_significandf", BT_FN_FLOAT_FLOAT, BUILT_IN_SIGNIFICANDF,
+    BUILT_IN_NORMAL, "significandf", NULL, NULL },
+  { "__builtin_significandl", BT_FN_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_SIGNIFICANDL, BUILT_IN_NORMAL, "significandl", NULL, NULL },
+  { "__builtin_modf", BT_FN_DOUBLE_DOUBLE_DOUBLEPTR, BUILT_IN_MODF,
+    BUILT_IN_NORMAL, "modf", NULL, NULL },
+  { "__builtin_modff", BT_FN_FLOAT_FLOAT_FLOATPTR, BUILT_IN_MODFF,
+    BUILT_IN_NORMAL, "modff", NULL, NULL },
+  { "__builtin_modfl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLEPTR,
+    BUILT_IN_MODFL, BUILT_IN_NORMAL, "modfl", NULL, NULL },
+  { "__builtin_nextafter", BT_FN_DOUBLE_DOUBLE_DOUBLE, BUILT_IN_NEXTAFTER,
+    BUILT_IN_NORMAL, "nextafter", NULL, NULL },
+  { "__builtin_nextafterf", BT_FN_FLOAT_FLOAT_FLOAT, BUILT_IN_NEXTAFTERF,
+    BUILT_IN_NORMAL, "nextafterf", NULL, NULL },
+  { "__builtin_nextafterl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_NEXTAFTERL, BUILT_IN_NORMAL, "nextafterl", NULL, NULL },
+  { "__builtin_nexttoward", BT_FN_DOUBLE_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_NEXTTOWARD, BUILT_IN_NORMAL, "nexttoward", NULL, NULL },
+  { "__builtin_nexttowardf", BT_FN_FLOAT_FLOAT_LONG_DOUBLE,
+    BUILT_IN_NEXTTOWARDF, BUILT_IN_NORMAL, "nexttowardf", NULL, NULL },
+  { "__builtin_nexttowardl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_NEXTTOWARDL, BUILT_IN_NORMAL, "nexttowardl", NULL, NULL },
+  { "__builtin_scalb", BT_FN_DOUBLE_DOUBLE_DOUBLE, BUILT_IN_SCALB,
+    BUILT_IN_NORMAL, "scalb", NULL, NULL },
+  { "__builtin_scalbf", BT_FN_FLOAT_FLOAT_FLOAT, BUILT_IN_SCALBF,
+    BUILT_IN_NORMAL, "scalbf", NULL, NULL },
+  { "__builtin_scalbl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_SCALBL, BUILT_IN_NORMAL, "scalbl", NULL, NULL },
+  { "__builtin_scalbln", BT_FN_DOUBLE_DOUBLE_LONG, BUILT_IN_SCALBLN,
+    BUILT_IN_NORMAL, "scalbln", NULL, NULL },
+  { "__builtin_scalblnf", BT_FN_FLOAT_FLOAT_LONG, BUILT_IN_SCALBLNF,
+    BUILT_IN_NORMAL, "scalblnf", NULL, NULL },
+  { "__builtin_scalblnl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG,
+    BUILT_IN_SCALBLNL, BUILT_IN_NORMAL, "scalblnl", NULL, NULL },
+  { "__builtin_scalbn", BT_FN_DOUBLE_DOUBLE_INT, BUILT_IN_SCALBN,
+    BUILT_IN_NORMAL, "scalbln", NULL, NULL },
+  { "__builtin_scalbnf", BT_FN_FLOAT_FLOAT_INT, BUILT_IN_SCALBNF,
+    BUILT_IN_NORMAL, "scalblnf", NULL, NULL },
+  { "__builtin_scalbnl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_INT, BUILT_IN_SCALBNL,
+    BUILT_IN_NORMAL, "scalblnl", NULL, NULL },
+
+  /* Complex intrinsic functions.  */
+  { "__builtin_cabs", BT_FN_DOUBLE_DCOMPLEX, BUILT_IN_CABS, BUILT_IN_NORMAL,
+    "cabs", NULL, NULL },
+  { "__builtin_cabsf", BT_FN_FLOAT_FCOMPLEX, BUILT_IN_CABSF, BUILT_IN_NORMAL,
+    "cabsf", NULL, NULL },
+  { "__builtin_cabsl", BT_FN_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CABSL,
+    BUILT_IN_NORMAL, "cabsl", NULL, NULL },
+
+  { "__builtin_carg", BT_FN_DOUBLE_DCOMPLEX, BUILT_IN_CABS, BUILT_IN_NORMAL,
+    "carg", NULL, NULL },
+  { "__builtin_cargf", BT_FN_FLOAT_FCOMPLEX, BUILT_IN_CABSF, BUILT_IN_NORMAL,
+    "cargf", NULL, NULL },
+  { "__builtin_cargl", BT_FN_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CABSL,
+    BUILT_IN_NORMAL, "cargl", NULL, NULL },
+
+  { "__builtin_conj", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CONJ, BUILT_IN_NORMAL,
+    "carg", NULL, NULL },
+  { "__builtin_conjf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CONJF,
+    BUILT_IN_NORMAL, "conjf", NULL, NULL },
+  { "__builtin_conjl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CONJL,
+    BUILT_IN_NORMAL, "conjl", NULL, NULL },
+
+  { "__builtin_cpow", BT_FN_DCOMPLEX_DOUBLE_DCOMPLEX, BUILT_IN_CPOW,
+    BUILT_IN_NORMAL, "cpow", NULL, NULL },
+  { "__builtin_cpowf", BT_FN_FCOMPLEX_FLOAT_FCOMPLEX, BUILT_IN_CPOWF,
+    BUILT_IN_NORMAL, "cpowf", NULL, NULL },
+  { "__builtin_cpowl", BT_FN_LDCOMPLEX_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CPOWL,
+    BUILT_IN_NORMAL, "cpowl", NULL, NULL },
+
+  { "__builtin_csqrt", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CSQRT,
+    BUILT_IN_NORMAL, "csqrt", NULL, NULL },
+  { "__builtin_csqrtf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CSQRTF,
+    BUILT_IN_NORMAL, "csqrtf", NULL, NULL },
+  { "__builtin_csqrtl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CSQRTL,
+    BUILT_IN_NORMAL, "csqrtl", NULL, NULL },
+
+  { "__builtin_cexp", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CEXP, BUILT_IN_NORMAL,
+    "cexp", NULL, NULL },
+  { "__builtin_cexpf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CEXPF,
+    BUILT_IN_NORMAL, "cexpf", NULL, NULL },
+  { "__builtin_cexpl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CEXPL,
+    BUILT_IN_NORMAL, "cexpl", NULL, NULL },
+
+  { "__builtin_cln", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CLOG, BUILT_IN_NORMAL,
+    "cln", NULL, NULL },
+  { "__builtin_clnf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CLOGF, BUILT_IN_NORMAL,
+    "clnf", NULL, NULL },
+  { "__builtin_clnl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CLOGL,
+    BUILT_IN_NORMAL, "clnl", NULL, NULL },
+
+  { "__builtin_csin", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CSIN, BUILT_IN_NORMAL,
+    "csin", NULL, NULL },
+  { "__builtin_csinf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CSINF,
+    BUILT_IN_NORMAL, "csinf", NULL, NULL },
+  { "__builtin_csinl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CSINL,
+    BUILT_IN_NORMAL, "csinl", NULL, NULL },
+
+  { "__builtin_ccos", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CCOS, BUILT_IN_NORMAL,
+    "ccos", NULL, NULL },
+  { "__builtin_ccosf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CCOSF,
+    BUILT_IN_NORMAL, "ccosf", NULL, NULL },
+  { "__builtin_ccosl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CCOSL,
+    BUILT_IN_NORMAL, "ccosl", NULL, NULL },
+
+  { "__builtin_ctan", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CTAN, BUILT_IN_NORMAL,
+    "ctan", NULL, NULL },
+  { "__builtin_ctanf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CTANF,
+    BUILT_IN_NORMAL, "ctanf", NULL, NULL },
+  { "__builtin_ctanl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CTANL,
+    BUILT_IN_NORMAL, "ctanl", NULL, NULL },
+
+  { "__builtin_casin", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CASIN,
+    BUILT_IN_NORMAL, "casin", NULL, NULL },
+  { "__builtin_casinf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CASINF,
+    BUILT_IN_NORMAL, "casinf", NULL, NULL },
+  { "__builtin_casinl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CASINL,
+    BUILT_IN_NORMAL, "casinl", NULL, NULL },
+
+  { "__builtin_cacos", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CACOS,
+    BUILT_IN_NORMAL, "cacos", NULL, NULL },
+  { "__builtin_cacosf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CACOSF,
+    BUILT_IN_NORMAL, "cacosf", NULL, NULL },
+  { "__builtin_cacosl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CACOSL,
+    BUILT_IN_NORMAL, "cacosl", NULL, NULL },
+
+  { "__builtin_catan", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CATAN,
+    BUILT_IN_NORMAL, "catan", NULL, NULL },
+  { "__builtin_catanf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CATANF,
+    BUILT_IN_NORMAL, "catanf", NULL, NULL },
+  { "__builtin_catanl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CATANL,
+    BUILT_IN_NORMAL, "catanl", NULL, NULL },
+
+  { "__builtin_huge_val", BT_FN_DOUBLE, BUILT_IN_HUGE_VAL, BUILT_IN_NORMAL,
+    "huge_val", NULL, NULL },
+  { "__builtin_huge_valf", BT_FN_FLOAT, BUILT_IN_HUGE_VALF, BUILT_IN_NORMAL,
+    "huge_valf", NULL, NULL },
+  { "__builtin_huge_vall", BT_FN_LONG_DOUBLE, BUILT_IN_HUGE_VALL,
+    BUILT_IN_NORMAL, "huge_vall", NULL, NULL },
+
+  { "__builtin_index", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_INDEX,
+    BUILT_IN_NORMAL, "index", NULL, NULL },
+  { "__builtin_rindex", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_RINDEX,
+    BUILT_IN_NORMAL, "rindex", NULL, NULL },
+  { "__builtin_memcmp", BT_FN_INT_CONST_PTR_CONST_PTR_SIZE, BUILT_IN_MEMCMP,
+    BUILT_IN_NORMAL, "memcmp", NULL, NULL },
+  { "__builtin_memmove", BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE, BUILT_IN_MEMMOVE,
+    BUILT_IN_NORMAL, "memmove", NULL, NULL },
+  { "__builtin_memset", BT_FN_TRAD_PTR_PTR_INT_SIZE, BUILT_IN_MEMSET,
+    BUILT_IN_NORMAL, "memset", NULL, NULL },
+  { "__builtin_strcat", BT_FN_STRING_STRING_CONST_STRING, BUILT_IN_STRCAT,
+    BUILT_IN_NORMAL, "strcat", NULL, NULL },
+  { "__builtin_strncat", BT_FN_STRING_STRING_CONST_STRING_SIZE,
+    BUILT_IN_STRNCAT, BUILT_IN_NORMAL, "strncat", NULL, NULL },
+  { "__builtin_strcpy", BT_FN_STRING_STRING_CONST_STRING, BUILT_IN_STRCPY,
+    BUILT_IN_NORMAL, "strcpy", NULL, NULL },
+  { "__builtin_strncpy", BT_FN_STRING_STRING_CONST_STRING_SIZE,
+    BUILT_IN_STRNCPY, BUILT_IN_NORMAL, "strncpy", NULL, NULL },
+  { "__builtin_strcmp", BT_FN_INT_CONST_STRING_CONST_STRING, BUILT_IN_STRCMP,
+    BUILT_IN_NORMAL, "strcmp", NULL, NULL },
+  { "__builtin_strncmp", BT_FN_INT_CONST_STRING_CONST_STRING_SIZE,
+    BUILT_IN_STRNCMP, BUILT_IN_NORMAL, "strncmp", NULL, NULL },
+  { "__builtin_strlen", BT_FN_INT_CONST_STRING, BUILT_IN_STRLEN,
+    BUILT_IN_NORMAL, "strlen", NULL, NULL },
+  { "__builtin_strstr", BT_FN_STRING_CONST_STRING_CONST_STRING,
+    BUILT_IN_STRSTR, BUILT_IN_NORMAL, "strstr", NULL, NULL },
+  { "__builtin_strpbrk", BT_FN_STRING_CONST_STRING_CONST_STRING,
+    BUILT_IN_STRPBRK, BUILT_IN_NORMAL, "strpbrk", NULL, NULL },
+  { "__builtin_strspn", BT_FN_SIZE_CONST_STRING_CONST_STRING, BUILT_IN_STRSPN,
+    BUILT_IN_NORMAL, "strspn", NULL, NULL },
+  { "__builtin_strcspn", BT_FN_SIZE_CONST_STRING_CONST_STRING,
+    BUILT_IN_STRCSPN, BUILT_IN_NORMAL, "strcspn", NULL, NULL },
+  { "__builtin_strchr", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_STRCHR,
+    BUILT_IN_NORMAL, "strchr", NULL, NULL },
+  { "__builtin_strrchr", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_STRCHR,
+    BUILT_IN_NORMAL, "strrchr", NULL, NULL },
+  //{ "__builtin_constant_p", BT_FN_INT_VAR, BUILT_IN_CONSTANT_P,
+  //BUILT_IN_NORMAL, "constant_p", NULL, NULL},
+  { "__builtin_frame_address", BT_FN_PTR_UNSIGNED, BUILT_IN_FRAME_ADDRESS,
+    BUILT_IN_NORMAL, "frame_address", NULL, NULL },
+  { "__builtin_return_address", BT_FN_PTR_UNSIGNED, BUILT_IN_RETURN_ADDRESS,
+    BUILT_IN_NORMAL, "return_address", NULL, NULL },
+  //{ "__builtin_aggregate_incoming_address", BT_FN_PTR_VAR,
+  //BUILT_IN_AGGREGATE_INCOMING_ADDRESS, BUILT_IN_NORMAL,
+  //"aggregate_incoming_address", NULL, NULL},
+  { "__builtin_longjmp", BT_FN_VOID_PTR_INT, BUILT_IN_LONGJMP, BUILT_IN_NORMAL,
+    "longjmp", NULL, NULL },
+  { "__builtin_setjmp", BT_FN_INT_PTR, BUILT_IN_SETJMP, BUILT_IN_NORMAL,
+    "setjmp", NULL, NULL },
+  { NULL, BT_FN_NONE, 0, NOT_BUILT_IN, "", NULL, NULL }
+};
+
+struct builtin_type_info
+{
+  const char *name;
+  unsigned int returnType;
+  tree (*functionHandler) (location_t, tree);
+};
+
+static GTY (()) tree sizetype_endlink;
+static GTY (()) tree unsigned_endlink;
+static GTY (()) tree endlink;
+static GTY (()) tree math_endlink;
+static GTY (()) tree int_endlink;
+static GTY (()) tree ptr_endlink;
+static GTY (()) tree const_ptr_endlink;
+static GTY (()) tree double_ftype_void;
+static GTY (()) tree float_ftype_void;
+static GTY (()) tree ldouble_ftype_void;
+static GTY (()) tree float_ftype_float;
+static GTY (()) tree double_ftype_double;
+static GTY (()) tree ldouble_ftype_ldouble;
+static GTY (()) tree gm2_alloca_node;
+static GTY (()) tree gm2_memcpy_node;
+static GTY (()) tree gm2_isfinite_node;
+static GTY (()) tree gm2_huge_valf_node;
+static GTY (()) tree gm2_huge_val_node;
+static GTY (()) tree gm2_huge_vall_node;
+static GTY (()) tree long_doubleptr_type_node;
+static GTY (()) tree doubleptr_type_node;
+static GTY (()) tree floatptr_type_node;
+static GTY (()) tree builtin_ftype_int_var;
+
+/* Prototypes for locally defined functions.  */
+static tree DoBuiltinAlloca (location_t location, tree n);
+static tree DoBuiltinMemCopy (location_t location, tree dest, tree src,
+                              tree n);
+static tree DoBuiltinIsfinite (location_t location, tree value);
+static void create_function_prototype (location_t location,
+                                       struct builtin_function_entry *fe);
+static tree doradix (location_t location, tree type);
+static tree doplaces (location_t location, tree type);
+static tree doexponentmin (location_t location, tree type);
+static tree doexponentmax (location_t location, tree type);
+static tree dolarge (location_t location, tree type);
+static tree dosmall (location_t location, tree type);
+static tree doiec559 (location_t location, tree type);
+static tree dolia1 (location_t location, tree type);
+static tree doiso (location_t location, tree type);
+static tree doieee (location_t location, tree type);
+static tree dorounds (location_t location, tree type);
+static tree dogUnderflow (location_t location, tree type);
+static tree doexception (location_t location, tree type);
+static tree doextend (location_t location, tree type);
+static tree donModes (location_t location, tree type);
+/* Prototypes finish here.  */
+
+#define m2builtins_c
+#include "m2builtins.h"
+
+static struct builtin_type_info m2_type_info[] = {
+  { "radix", 2, doradix },
+  { "places", 2, doplaces },
+  { "expoMin", 2, doexponentmin },
+  { "expoMax", 2, doexponentmax },
+  { "large", 3, dolarge },
+  { "small", 3, dosmall },
+  { "IEC559", 1, doiec559 },
+  { "LIA1", 1, dolia1 },
+  { "ISO", 1, doiso },
+  { "IEEE", 1, doieee },
+  { "rounds", 1, dorounds },
+  { "gUnderflow", 1, dogUnderflow },
+  { "exception", 1, doexception },
+  { "extend", 1, doextend },
+  { "nModes", 2, donModes },
+  { NULL, 0, NULL },
+};
+
+/* Return a definition for a builtin function named NAME and whose
+data type is TYPE.  TYPE should be a function type with argument
+types.  FUNCTION_CODE tells later passes how to compile calls to this
+function.  See tree.h for its possible values.
+
+If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME, the
+name to be called if we can't opencode the function.  */
+
+tree
+builtin_function (location_t location, const char *name, tree type,
+                  int function_code, enum built_in_class fclass,
+                  const char *library_name, tree attrs)
+{
+  tree decl = add_builtin_function (name, type, function_code, fclass,
+                                    library_name, attrs);
+  DECL_SOURCE_LOCATION (decl) = location;
+
+  m2block_pushDecl (decl);
+  return decl;
+}
+
+/* GetBuiltinConst - returns the gcc tree of a builtin constant,
+   name.  NIL is returned if the constant is unknown.  */
+
+tree
+m2builtins_GetBuiltinConst (char *name)
+{
+  if (strcmp (name, "BITS_PER_UNIT") == 0)
+    return m2decl_BuildIntegerConstant (BITS_PER_UNIT);
+  if (strcmp (name, "BITS_PER_WORD") == 0)
+    return m2decl_BuildIntegerConstant (BITS_PER_WORD);
+  if (strcmp (name, "BITS_PER_CHAR") == 0)
+    return m2decl_BuildIntegerConstant (CHAR_TYPE_SIZE);
+  if (strcmp (name, "UNITS_PER_WORD") == 0)
+    return m2decl_BuildIntegerConstant (UNITS_PER_WORD);
+
+  return NULL_TREE;
+}
+
+/* GetBuiltinConstType - returns the type of a builtin constant,
+   name.  0 = unknown constant name 1 = integer 2 = real.  */
+
+unsigned int
+m2builtins_GetBuiltinConstType (char *name)
+{
+  if (strcmp (name, "BITS_PER_UNIT") == 0)
+    return 1;
+  if (strcmp (name, "BITS_PER_WORD") == 0)
+    return 1;
+  if (strcmp (name, "BITS_PER_CHAR") == 0)
+    return 1;
+  if (strcmp (name, "UNITS_PER_WORD") == 0)
+    return 1;
+
+  return 0;
+}
+
+/* GetBuiltinTypeInfoType - returns value: 0 is ident is unknown.  1
+   if ident is IEC559, LIA1, ISO, IEEE, rounds, underflow, exception,
+   extend.  2 if ident is radix, places, exponentmin, exponentmax,
+   noofmodes.  3 if ident is large, small.  */
+
+unsigned int
+m2builtins_GetBuiltinTypeInfoType (const char *ident)
+{
+  int i = 0;
+
+  while (m2_type_info[i].name != NULL)
+    if (strcmp (m2_type_info[i].name, ident) == 0)
+      return m2_type_info[i].returnType;
+    else
+      i++;
+  return 0;
+}
+
+/* GetBuiltinTypeInfo - returns value: NULL_TREE if ident is unknown.
+   boolean Tree if ident is IEC559, LIA1, ISO, IEEE, rounds,
+   underflow, exception, extend.  ZType Tree if ident is radix,
+   places, exponentmin, exponentmax, noofmodes.
+   RType Tree if ident is large, small.  */
+
+tree
+m2builtins_GetBuiltinTypeInfo (location_t location, tree type,
+                               const char *ident)
+{
+  int i = 0;
+
+  type = m2tree_skip_type_decl (type);
+  while (m2_type_info[i].name != NULL)
+    if (strcmp (m2_type_info[i].name, ident) == 0)
+      return (*m2_type_info[i].functionHandler) (location, type);
+    else
+      i++;
+  return NULL_TREE;
+}
+
+/* doradix - returns the radix of the floating point, type.  */
+
+static tree
+doradix (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      enum machine_mode mode = TYPE_MODE (type);
+      int radix = REAL_MODE_FORMAT (mode)->b;
+      return m2decl_BuildIntegerConstant (radix);
+    }
+  else
+    return NULL_TREE;
+}
+
+/* doplaces - returns the whole number value of the number of radix
+   places used to store values of the corresponding real number type.  */
+
+static tree
+doplaces (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      /* Taken from c-family/c-cppbuiltin.cc.  */
+      /* The number of decimal digits, q, such that any floating-point
+         number with q decimal digits can be rounded into a
+         floating-point number with p radix b digits and back again
+         without change to the q decimal digits, p log10 b if b is a
+         power of 10 floor((p - 1) log10 b) otherwise.  */
+      enum machine_mode mode = TYPE_MODE (type);
+      const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+      const double log10_2 = .30102999566398119521;
+      double log10_b = log10_2;
+      int digits = (fmt->p - 1) * log10_b;
+      return m2decl_BuildIntegerConstant (digits);
+    }
+  else
+    return NULL_TREE;
+}
+
+/* doexponentmin - returns the whole number of the exponent minimum.  */
+
+static tree
+doexponentmin (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      enum machine_mode mode = TYPE_MODE (type);
+      int emin = REAL_MODE_FORMAT (mode)->emin;
+      return m2decl_BuildIntegerConstant (emin);
+    }
+  else
+    return NULL_TREE;
+}
+
+/* doexponentmax - returns the whole number of the exponent maximum.  */
+
+static tree
+doexponentmax (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      enum machine_mode mode = TYPE_MODE (type);
+      int emax = REAL_MODE_FORMAT (mode)->emax;
+      return m2decl_BuildIntegerConstant (emax);
+    }
+  else
+    return NULL_TREE;
+}
+
+static tree
+computeLarge (tree type)
+{
+  enum machine_mode mode = TYPE_MODE (type);
+  const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+  REAL_VALUE_TYPE real;
+  char buf[128];
+
+  /* Shamelessly taken from c-cppbuiltin.cc:builtin_define_float_constants.  */
+
+  /* Since, for the supported formats, B is always a power of 2, we
+  construct the following numbers directly as a hexadecimal constants.  */
+
+  get_max_float (fmt, buf, sizeof (buf), false);
+  real_from_string (&real, buf);
+  return build_real (type, real);
+}
+
+/* dolarge - return the largest value of the corresponding real type.  */
+
+static tree
+dolarge (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    return computeLarge (type);
+  return NULL_TREE;
+}
+
+static tree
+computeSmall (tree type)
+{
+  enum machine_mode mode = TYPE_MODE (type);
+  const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+  REAL_VALUE_TYPE real;
+  char buf[128];
+
+  /* The minimum normalized positive floating-point number,
+  b**(emin-1).  */
+
+  sprintf (buf, "0x1p%d", fmt->emin - 1);
+  real_from_string (&real, buf);
+  return build_real (type, real);
+}
+
+/* dosmall - return the smallest positive value of the corresponding
+   real type.  */
+
+static tree
+dosmall (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    return computeSmall (type);
+  return NULL_TREE;
+}
+
+/* doiec559 - a boolean value that is true if and only if the
+   implementation of the corresponding real number type conforms to
+   IEC 559:1989 (also known as IEEE 754:1987) in all regards.  */
+
+static tree
+doiec559 (location_t location, tree type)
+{
+  if (m2expr_IsTrue (m2expr_BuildEqualTo (location,
+                                          m2decl_BuildIntegerConstant (32),
+                                          m2expr_GetSizeOfInBits (type))))
+    return m2type_GetBooleanTrue ();
+  if (m2expr_IsTrue (m2expr_BuildEqualTo (location,
+                                          m2decl_BuildIntegerConstant (64),
+                                          m2expr_GetSizeOfInBits (type))))
+    return m2type_GetBooleanTrue ();
+  return m2type_GetBooleanFalse ();
+}
+
+/* dolia1 - returns TRUE if using ieee (currently always TRUE).  */
+
+static tree
+dolia1 (location_t location, tree type)
+{
+  return doieee (location, type);
+}
+
+/* doiso - returns TRUE if using ieee (--fixme--).  */
+
+static tree
+doiso (location_t location, tree type)
+{
+  return doieee (location, type);
+}
+
+/* doieee - returns TRUE if ieee arithmetic is being used.  */
+
+static tree
+doieee (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  /* --fixme-- maybe we should look for the -mno-ieee flag and return this
+     result.  */
+  return m2type_GetBooleanTrue ();
+}
+
+/* dorounds - returns TRUE if and only if each operation produces a
+   result that is one of the values of the corresponding real number
+   type nearest to the mathematical result.  */
+
+static tree
+dorounds (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  if (FLT_ROUNDS)
+    return m2type_GetBooleanTrue ();
+  else
+    return m2type_GetBooleanFalse ();
+}
+
+/* dogUnderflow - returns TRUE if and only if there are values of the
+   corresponding real number type between 0.0 and small.  */
+
+static tree
+dogUnderflow (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      enum machine_mode mode = TYPE_MODE (type);
+      const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+      if (fmt->has_denorm)
+        return m2type_GetBooleanTrue ();
+      else
+        return m2type_GetBooleanFalse ();
+    }
+  return NULL_TREE;
+}
+
+/* doexception - */
+
+static tree
+doexception (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  return m2type_GetBooleanTrue ();
+}
+
+/* doextend - */
+
+static tree
+doextend (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  return m2type_GetBooleanTrue ();
+}
+
+/* donModes - */
+
+static tree
+donModes (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  return m2decl_BuildIntegerConstant (1);
+}
+
+/* BuiltInMemCopy - copy n bytes of memory efficiently from address
+   src to dest.  */
+
+tree
+m2builtins_BuiltInMemCopy (location_t location, tree dest, tree src, tree n)
+{
+  return DoBuiltinMemCopy (location, dest, src, n);
+}
+
+/* BuiltInAlloca - given an expression, n, allocate, n, bytes on the
+   stack for the life of the current function.  */
+
+tree
+m2builtins_BuiltInAlloca (location_t location, tree n)
+{
+  return DoBuiltinAlloca (location, n);
+}
+
+/* BuiltInIsfinite - return integer 1 if the real expression is
+   finite otherwise return integer 0.  */
+
+tree
+m2builtins_BuiltInIsfinite (location_t location, tree expression)
+{
+  return DoBuiltinIsfinite (location, expression);
+}
+
+/* BuiltinExists - returns TRUE if the builtin function, name, exists
+   for this target architecture.  */
+
+int
+m2builtins_BuiltinExists (char *name)
+{
+  struct builtin_function_entry *fe;
+
+  for (fe = &list_of_builtins[0]; fe->name != NULL; fe++)
+    if (strcmp (name, fe->name) == 0)
+      return TRUE;
+
+  return FALSE;
+}
+
+/* BuildBuiltinTree - returns a Tree containing the builtin function,
+   name.  */
+
+tree
+m2builtins_BuildBuiltinTree (location_t location, char *name)
+{
+  struct builtin_function_entry *fe;
+  tree t;
+
+  m2statement_SetLastFunction (NULL_TREE);
+  for (fe = &list_of_builtins[0]; fe->name != NULL; fe++)
+    if (strcmp (name, fe->name) == 0)
+      {
+        tree functype = TREE_TYPE (fe->function_node);
+        tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype),
+                               fe->function_node);
+
+        m2statement_SetLastFunction (m2treelib_DoCall (
+            location, fe->return_node, funcptr, m2statement_GetParamList ()));
+        m2statement_SetParamList (NULL_TREE);
+        t = m2statement_GetLastFunction ();
+        if (fe->return_node == void_type_node)
+          m2statement_SetLastFunction (NULL_TREE);
+        return t;
+      }
+
+  m2statement_SetParamList (NULL_TREE);
+  return m2statement_GetLastFunction ();
+}
+
+static tree
+DoBuiltinMemCopy (location_t location, tree dest, tree src, tree bytes)
+{
+  tree functype = TREE_TYPE (gm2_memcpy_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_memcpy_node);
+  tree call
+      = m2treelib_DoCall3 (location, ptr_type_node, funcptr, dest, src, bytes);
+  return call;
+}
+
+static tree
+DoBuiltinAlloca (location_t location, tree bytes)
+{
+  tree functype = TREE_TYPE (gm2_alloca_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_alloca_node);
+  tree call = m2treelib_DoCall1 (location, ptr_type_node, funcptr, bytes);
+
+  return call;
+}
+
+static tree
+DoBuiltinIsfinite (location_t location, tree value)
+{
+  tree functype = TREE_TYPE (gm2_isfinite_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_isfinite_node);
+  tree call = m2treelib_DoCall1 (location, ptr_type_node, funcptr, value);
+
+  return call;
+}
+
+tree
+m2builtins_BuiltInHugeVal (location_t location)
+{
+  tree functype = TREE_TYPE (gm2_huge_val_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_huge_val_node);
+  tree call = m2treelib_DoCall0 (location, ptr_type_node, funcptr);
+  return call;
+}
+
+tree
+m2builtins_BuiltInHugeValShort (location_t location)
+{
+  tree functype = TREE_TYPE (gm2_huge_valf_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_huge_valf_node);
+  tree call = m2treelib_DoCall0 (location, ptr_type_node, funcptr);
+  return call;
+}
+
+tree
+m2builtins_BuiltInHugeValLong (location_t location)
+{
+  tree functype = TREE_TYPE (gm2_huge_vall_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_huge_vall_node);
+  tree call = m2treelib_DoCall0 (location, ptr_type_node, funcptr);
+  return call;
+}
+
+static void
+create_function_prototype (location_t location,
+                           struct builtin_function_entry *fe)
+{
+  tree ftype;
+
+  switch (fe->defn)
+    {
+
+    case BT_FN_PTR_SIZE:
+      ftype = build_function_type (ptr_type_node, sizetype_endlink);
+      fe->return_node = ptr_type_node;
+      break;
+
+    case BT_FN_STRING_STRING_CONST_STRING_SIZE:
+    case BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE:
+      ftype = build_function_type (
+          ptr_type_node, tree_cons (NULL_TREE, ptr_type_node,
+                                    tree_cons (NULL_TREE, const_ptr_type_node,
+                                               sizetype_endlink)));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_FLOAT:
+      ftype = float_ftype_void;
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE:
+      ftype = double_ftype_void;
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE:
+      ftype = ldouble_ftype_void;
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT:
+      ftype = float_ftype_float;
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE:
+      ftype = double_ftype_double;
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE:
+      ftype = ldouble_ftype_ldouble;
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_STRING_CONST_STRING_INT:
+      ftype = build_function_type (
+          ptr_type_node, tree_cons (NULL_TREE, ptr_type_node, int_endlink));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_INT_CONST_PTR_CONST_PTR_SIZE:
+      ftype = build_function_type (
+          integer_type_node,
+          tree_cons (NULL_TREE, const_ptr_type_node,
+                     tree_cons (NULL_TREE, const_ptr_type_node, int_endlink)));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_TRAD_PTR_PTR_INT_SIZE:
+      ftype = build_function_type (
+          ptr_type_node, tree_cons (NULL_TREE, ptr_type_node,
+                                    tree_cons (NULL_TREE, integer_type_node,
+                                               sizetype_endlink)));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_STRING_STRING_CONST_STRING:
+      ftype = build_function_type (
+          ptr_type_node, tree_cons (NULL_TREE, ptr_type_node, ptr_endlink));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_INT_CONST_STRING_CONST_STRING:
+      ftype = build_function_type (
+          integer_type_node,
+          tree_cons (NULL_TREE, const_ptr_type_node, ptr_endlink));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_CONST_STRING_CONST_STRING_SIZE:
+      ftype = build_function_type (
+          integer_type_node,
+          tree_cons (
+              NULL_TREE, const_ptr_type_node,
+              tree_cons (NULL_TREE, const_ptr_type_node, sizetype_endlink)));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_CONST_STRING:
+      ftype = build_function_type (integer_type_node, ptr_endlink);
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_STRING_CONST_STRING_CONST_STRING:
+      ftype = build_function_type (
+          ptr_type_node,
+          tree_cons (NULL_TREE, const_ptr_type_node, const_ptr_endlink));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_SIZE_CONST_STRING_CONST_STRING:
+      ftype = build_function_type (
+          sizetype,
+          tree_cons (NULL_TREE, const_ptr_type_node, const_ptr_endlink));
+      fe->return_node = sizetype;
+      break;
+    case BT_FN_PTR_UNSIGNED:
+      ftype = build_function_type (ptr_type_node, unsigned_endlink);
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_VOID_PTR_INT:
+      ftype = build_function_type (
+          void_type_node, tree_cons (NULL_TREE, ptr_type_node, int_endlink));
+      fe->return_node = void_type_node;
+      break;
+    case BT_FN_INT_PTR:
+      ftype = build_function_type (integer_type_node, ptr_endlink);
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_FLOAT:
+      ftype = build_function_type (
+          integer_type_node, tree_cons (NULL_TREE, float_type_node, endlink));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_DOUBLE:
+      ftype = build_function_type (
+          integer_type_node, tree_cons (NULL_TREE, double_type_node, endlink));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_LONG_DOUBLE:
+      ftype = build_function_type (
+          integer_type_node,
+          tree_cons (NULL_TREE, long_double_type_node, endlink));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_FLOAT_FCOMPLEX:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, complex_float_type_node, endlink));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DCOMPLEX:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, complex_double_type_node, endlink));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LDCOMPLEX:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (NULL_TREE, complex_long_double_type_node, endlink));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FCOMPLEX_FCOMPLEX:
+      ftype = build_function_type (
+          complex_float_type_node,
+          tree_cons (NULL_TREE, complex_float_type_node, endlink));
+      fe->return_node = complex_float_type_node;
+      break;
+    case BT_FN_DCOMPLEX_DCOMPLEX:
+      ftype = build_function_type (
+          complex_double_type_node,
+          tree_cons (NULL_TREE, complex_double_type_node, endlink));
+      fe->return_node = complex_double_type_node;
+      break;
+    case BT_FN_LDCOMPLEX_LDCOMPLEX:
+      ftype = build_function_type (
+          complex_long_double_type_node,
+          tree_cons (NULL_TREE, complex_long_double_type_node, endlink));
+      fe->return_node = complex_long_double_type_node;
+      break;
+    case BT_FN_DCOMPLEX_DOUBLE_DCOMPLEX:
+      ftype = build_function_type (
+          complex_double_type_node,
+          tree_cons (NULL_TREE, complex_double_type_node,
+                     tree_cons (NULL_TREE, double_type_node, endlink)));
+      fe->return_node = complex_double_type_node;
+      break;
+    case BT_FN_FCOMPLEX_FLOAT_FCOMPLEX:
+      ftype = build_function_type (
+          complex_float_type_node,
+          tree_cons (NULL_TREE, complex_float_type_node,
+                     tree_cons (NULL_TREE, float_type_node, endlink)));
+      fe->return_node = complex_float_type_node;
+      break;
+    case BT_FN_LDCOMPLEX_LONG_DOUBLE_LDCOMPLEX:
+      ftype = build_function_type (
+          complex_long_double_type_node,
+          tree_cons (NULL_TREE, complex_long_double_type_node,
+                     tree_cons (NULL_TREE, long_double_type_node, endlink)));
+      fe->return_node = complex_long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_FLOATPTR:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, floatptr_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_DOUBLEPTR:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, doubleptr_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLEPTR:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (
+              NULL_TREE, long_double_type_node,
+              tree_cons (NULL_TREE, long_doubleptr_type_node, endlink)));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_LONG_DOUBLE:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, long_double_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_LONG_DOUBLE:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, long_double_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (NULL_TREE, long_double_type_node,
+                     tree_cons (NULL_TREE, long_double_type_node, endlink)));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_LONG:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, long_integer_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_LONG:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, long_integer_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (NULL_TREE, long_double_type_node,
+                     tree_cons (NULL_TREE, long_integer_type_node, endlink)));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_INT:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, integer_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_INT:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, integer_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE_INT:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (NULL_TREE, long_double_type_node,
+                     tree_cons (NULL_TREE, integer_type_node, endlink)));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_FLOAT:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, float_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_DOUBLE:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, double_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    default:
+      ERROR ("enum has no case");
+    }
+  fe->function_node
+      = builtin_function (location, fe->name, ftype, fe->function_code,
+                          fe->fclass, fe->library_name, NULL);
+}
+
+static tree
+find_builtin_tree (const char *name)
+{
+  struct builtin_function_entry *fe;
+
+  for (fe = &list_of_builtins[0]; fe->name != NULL; fe++)
+    if (strcmp (name, fe->name) == 0)
+      return fe->function_node;
+
+  ERROR ("cannot find builtin function");
+  return NULL_TREE;
+}
+
+
+static void
+set_decl_built_in_class (tree decl, built_in_class c)
+{
+  FUNCTION_DECL_CHECK (decl)->function_decl.built_in_class = c;
+}
+
+
+static void
+set_decl_function_code (tree decl, built_in_function f)
+{
+  tree_function_decl &fndecl = FUNCTION_DECL_CHECK (decl)->function_decl;
+  fndecl.function_code = f;
+}
+
+/* Define a single builtin.  */
+static void
+define_builtin (enum built_in_function val, const char *name, tree type,
+                const char *libname, int flags)
+{
+  tree decl;
+
+  decl = build_decl (BUILTINS_LOCATION, FUNCTION_DECL, get_identifier (name),
+                     type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  SET_DECL_ASSEMBLER_NAME (decl, get_identifier (libname));
+  m2block_pushDecl (decl);
+  set_decl_built_in_class (decl, BUILT_IN_NORMAL);
+  set_decl_function_code (decl, val);
+  set_call_expr_flags (decl, flags);
+
+  set_builtin_decl (val, decl, true);
+}
+
+void
+m2builtins_init (location_t location)
+{
+  int i;
+
+  m2block_pushGlobalScope ();
+  endlink = void_list_node;
+  sizetype_endlink = tree_cons (NULL_TREE, sizetype, endlink);
+  math_endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+  int_endlink = tree_cons (NULL_TREE, integer_type_node, NULL_TREE);
+  ptr_endlink = tree_cons (NULL_TREE, ptr_type_node, NULL_TREE);
+  const_ptr_endlink = tree_cons (NULL_TREE, const_ptr_type_node, NULL_TREE);
+  unsigned_endlink = tree_cons (NULL_TREE, unsigned_type_node, NULL_TREE);
+
+  float_ftype_void = build_function_type (float_type_node, math_endlink);
+  double_ftype_void = build_function_type (double_type_node, math_endlink);
+  ldouble_ftype_void
+      = build_function_type (long_double_type_node, math_endlink);
+
+  long_doubleptr_type_node = build_pointer_type (long_double_type_node);
+  doubleptr_type_node = build_pointer_type (double_type_node);
+  floatptr_type_node = build_pointer_type (float_type_node);
+
+  float_ftype_float = build_function_type (
+      float_type_node, tree_cons (NULL_TREE, float_type_node, math_endlink));
+
+  double_ftype_double = build_function_type (
+      double_type_node, tree_cons (NULL_TREE, double_type_node, math_endlink));
+
+  ldouble_ftype_ldouble = build_function_type (
+      long_double_type_node,
+      tree_cons (NULL_TREE, long_double_type_node, endlink));
+
+  builtin_ftype_int_var = build_function_type (
+      integer_type_node, tree_cons (NULL_TREE, double_type_node, endlink));
+
+  for (i = 0; list_of_builtins[i].name != NULL; i++)
+    create_function_prototype (location, &list_of_builtins[i]);
+
+  define_builtin (BUILT_IN_TRAP, "__builtin_trap",
+                  build_function_type_list (void_type_node, NULL_TREE),
+                  "__builtin_trap", ECF_NOTHROW | ECF_LEAF | ECF_NORETURN);
+  define_builtin (BUILT_IN_ISGREATER, "isgreater", builtin_ftype_int_var,
+                  "__builtin_isgreater", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISGREATEREQUAL, "isgreaterequal",
+                  builtin_ftype_int_var, "__builtin_isgreaterequal",
+                  ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISLESS, "isless", builtin_ftype_int_var,
+                  "__builtin_isless", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISLESSEQUAL, "islessequal", builtin_ftype_int_var,
+                  "__builtin_islessequal", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISLESSGREATER, "islessgreater",
+                  builtin_ftype_int_var, "__builtin_islessgreater",
+                  ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISUNORDERED, "isunordered", builtin_ftype_int_var,
+                  "__builtin_isunordered", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+
+  gm2_alloca_node = find_builtin_tree ("__builtin_alloca");
+  gm2_memcpy_node = find_builtin_tree ("__builtin_memcpy");
+  gm2_huge_valf_node = find_builtin_tree ("__builtin_huge_valf");
+  gm2_huge_val_node = find_builtin_tree ("__builtin_huge_val");
+  gm2_huge_vall_node = find_builtin_tree ("__builtin_huge_vall");
+  gm2_isfinite_node = find_builtin_tree ("__builtin_isfinite");
+  m2block_popGlobalScope ();
+}
+
+#include "gt-m2-m2builtins.h"
+
+/* END m2builtins.  */
diff --git a/gcc/m2/gm2-gcc/m2builtins.def b/gcc/m2/gm2-gcc/m2builtins.def
new file mode 100644
index 00000000000..d995e2ba7c1
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2builtins.def
@@ -0,0 +1,121 @@
+(* m2builtins.def definition module for m2builtins.cc.
+
+Copyright (C) 2003-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2builtins ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+
+EXPORT QUALIFIED GetBuiltinConst, GetBuiltinConstType,
+                 GetBuiltinTypeInfoType, GetBuiltinTypeInfo,
+                 BuiltinExists, BuildBuiltinTree,
+                 BuiltInMemCopy, BuiltInAlloca,
+		 BuiltInIsfinite ;
+
+
+(*
+   GetBuiltinConst - returns the gcc tree of a built in constant, name.
+                     NIL is returned if the constant is unknown.
+*)
+
+PROCEDURE GetBuiltinConst (name: ADDRESS) : Tree ;
+
+
+(*
+   GetBuiltinConstType - returns the type of a builtin constant, name.
+
+                         0 = unknown constant name
+                         1 = integer
+                         2 = real
+*)
+
+PROCEDURE GetBuiltinConstType (name: ADDRESS) : CARDINAL ;
+
+
+
+(*
+   GetBuiltinTypeInfoType - returns value:
+                            0    is ident is unknown.
+                            1    if ident is IEC559, LIA1, ISO, IEEE, rounds, underflow,
+                                             exception, extend.
+                            2    if ident is radix, places, exponentmin, exponentmax,
+                                             noofmodes.
+                            3    if ident is large, small.
+*)
+
+PROCEDURE GetBuiltinTypeInfoType (ident: ADDRESS) : CARDINAL ;
+
+
+(*
+   GetBuiltinTypeInfo - returns a Tree value:
+
+                        NULL_TREE        if ident is unknown.
+                        boolean Tree     if ident is IEC559, LIA1, ISO, IEEE, rounds, underflow,
+                                         exception, extend.
+                        ZType Tree       if ident is radix, places, exponentmin, exponentmax,
+                                         noofmodes.
+                        RType Tree       if ident is large, small.
+*)
+
+PROCEDURE GetBuiltinTypeInfo (location: location_t; type: Tree; ident: ADDRESS) : Tree ;
+
+
+(*
+   BuiltinExists - returns TRUE if the builtin function, name, exists
+                   for this target architecture.
+*)
+
+PROCEDURE BuiltinExists (name: ADDRESS) : BOOLEAN ;
+
+
+(*
+   BuildBuiltinTree - returns a Tree containing the builtin function, name.
+*)
+
+PROCEDURE BuildBuiltinTree (location: location_t; name: ADDRESS) : Tree ;
+
+
+(*
+   BuiltinMemCopy and BuiltinAlloca - are called by M2GenGCC to implement open arrays.
+*)
+
+PROCEDURE BuiltInMemCopy (location: location_t; dest, src, n: Tree) : Tree ;
+
+
+(*
+   BuiltInAlloca - given an expression, n, allocate, n, bytes on the stack for the life
+                   of the current function.
+*)
+
+PROCEDURE BuiltInAlloca (location: location_t; n: Tree) : Tree ;
+
+
+(*
+   BuiltInIsfinite - given an expression, e, return an integer Tree of 1 if the
+                     value is finite.  Return an integer Tree 0 if the value is
+                     not finite.
+*)
+
+PROCEDURE BuiltInIsfinite (location: location_t; e: Tree) : Tree ;
+
+
+END m2builtins.
diff --git a/gcc/m2/gm2-gcc/m2builtins.h b/gcc/m2/gm2-gcc/m2builtins.h
new file mode 100644
index 00000000000..db65ab461ca
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2builtins.h
@@ -0,0 +1,56 @@
+/* m2builtins.h header file for m2builtins.cc.
+
+Copyright (C) 2012-2022 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(m2builtins_h)
+
+#define m2builtins_h
+#if defined(m2builtins_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2builtins_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2builtins_c.  */
+
+EXTERN tree m2builtins_GetBuiltinConst (char *name);
+EXTERN unsigned int m2builtins_GetBuiltinConstType (char *name);
+EXTERN unsigned int m2builtins_GetBuiltinTypeInfoType (const char *ident);
+EXTERN tree m2builtins_GetBuiltinTypeInfo (location_t location, tree type,
+                                           const char *ident);
+EXTERN tree m2builtins_BuiltInMemCopy (location_t location, tree dest,
+                                       tree src, tree n);
+EXTERN tree m2builtins_BuiltInAlloca (location_t location, tree n);
+EXTERN tree m2builtins_BuiltInIsfinite (location_t location, tree e);
+EXTERN int m2builtins_BuiltinExists (char *name);
+EXTERN tree m2builtins_BuildBuiltinTree (location_t location, char *name);
+EXTERN tree m2builtins_BuiltInHugeVal (location_t location);
+EXTERN tree m2builtins_BuiltInHugeValShort (location_t location);
+EXTERN tree m2builtins_BuiltInHugeValLong (location_t location);
+EXTERN void m2builtins_init (location_t location);
+
+#undef EXTERN
+#endif /* m2builtins_h.  */
diff --git a/gcc/m2/gm2-gcc/m2color.cc b/gcc/m2/gm2-gcc/m2color.cc
new file mode 100644
index 00000000000..c73d6ccaf58
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2color.cc
@@ -0,0 +1,66 @@
+/* m2color.cc interface to gcc colorization.
+
+Copyright (C) 2019-2022 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 m2color_c
+#include "m2color.h"
+
+#include "gcc-consolidation.h"
+#include "diagnostic-color.h"
+
+
+char *
+m2color_colorize_start (bool show_color, char *name, unsigned int name_len)
+{
+  return const_cast<char*> (colorize_start (show_color, name, name_len));
+}
+
+
+char *
+m2color_colorize_stop (bool show_color)
+{
+  return const_cast<char*> (colorize_stop (show_color));
+}
+
+
+char *
+m2color_open_quote (void)
+{
+  return const_cast<char*> (open_quote);
+}
+
+
+char *
+m2color_close_quote (void)
+{
+  return const_cast<char*> (close_quote);
+}
+
+
+void
+_M2_m2color_init ()
+{
+}
+
+
+void
+_M2_m2color_finish ()
+{
+}
diff --git a/gcc/m2/gm2-gcc/m2color.def b/gcc/m2/gm2-gcc/m2color.def
new file mode 100644
index 00000000000..619191ebac6
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2color.def
@@ -0,0 +1,57 @@
+(* m2color.def interface to gcc colorization.
+
+Copyright (C) 2019-2022 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/>.  *)
+
+DEFINITION MODULE m2color ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   PtrToChar = POINTER TO CHAR ;
+
+
+(* colorize_start returns a C string containing the color escape sequences
+   mapped onto, name.  See diagnostic-color.c for the definitive
+   list of GCC colors.  The name list includes: error, warning,
+   note, range1, range2, quote, locus, fixit-insert, fixit-delete,
+   diff-filename, diff-hunk, diff-delete, diff-insert, type-diff.  *)
+
+PROCEDURE colorize_start (show_color: BOOLEAN;
+                          name: ARRAY OF CHAR; name_len: CARDINAL) : PtrToChar ;
+
+(* colorize_stop return a C string containing the escape sequences to
+   stop text colorization.  *)
+
+PROCEDURE colorize_stop (show_color: BOOLEAN) : PtrToChar ;
+
+
+(* open_quote return a C string containing the open quote character which
+   might be a UTF-8 character if on a UTF-8 supporting host.  *)
+
+PROCEDURE open_quote () : PtrToChar ;
+
+
+(* close_quote return a C string containing the close quote character which
+   might be a UTF-8 character if on a UTF-8 supporting host.  *)
+
+PROCEDURE close_quote () : PtrToChar ;
+
+
+END m2color.
diff --git a/gcc/m2/gm2-gcc/m2color.h b/gcc/m2/gm2-gcc/m2color.h
new file mode 100644
index 00000000000..0cbd551697b
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2color.h
@@ -0,0 +1,52 @@
+/* m2color.h interface to gcc colorization.
+
+Copyright (C) 2019-2022 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(m2color_h)
+#define m2color_h
+#if defined(m2color_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2color_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2color_c.  */
+
+
+EXTERN char *
+m2color_colorize_start (bool show_color, char *name, unsigned int name_len);
+
+EXTERN char *m2color_colorize_stop (bool show_color);
+
+EXTERN char *m2color_open_quote (void);
+
+EXTERN char *m2color_close_quote (void);
+
+EXTERN void _M2_m2color_init ();
+EXTERN void _M2_m2color_finish ();
+
+
+#endif
diff --git a/gcc/m2/gm2-gcc/m2configure.cc b/gcc/m2/gm2-gcc/m2configure.cc
new file mode 100644
index 00000000000..6b40fcb0680
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2configure.cc
@@ -0,0 +1,101 @@
+/* m2configure.cc provides an interface to some configuration values.
+
+Copyright (C) 2022 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 "libiberty.h"
+
+#include "config.h"
+#include "system.h"
+#include "libiberty.h"
+
+#include "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+#include "m2convert.h"
+
+/* Prototypes.  */
+
+#define m2configure_c
+
+#include "m2assert.h"
+#include "m2builtins.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2options.h"
+#include "m2configure.h"
+
+#include "m2/gm2version.h"
+#include "m2/gm2config.h"
+
+#define CPPPROGRAM  "cc1"
+
+
+/* gen_gm2_libexec returns a string containing libexec /
+   DEFAULT_TARGET_MACHINE string / DEFAULT_TARGET_MACHINE.  */
+
+static char *
+gen_gm2_libexec (const char *libexec)
+{
+  int l = strlen (libexec) + 1 + strlen (DEFAULT_TARGET_MACHINE) + 1
+          + strlen (DEFAULT_TARGET_VERSION) + 1;
+  char *s = (char *)xmalloc (l);
+  char dir_sep[2];
+
+  dir_sep[0] = DIR_SEPARATOR;
+  dir_sep[1] = (char)0;
+
+  strcpy (s, libexec);
+  strcat (s, dir_sep);
+  strcat (s, DEFAULT_TARGET_MACHINE);
+  strcat (s, dir_sep);
+  strcat (s, DEFAULT_TARGET_VERSION);
+  return s;
+}
+
+/* FullPathCPP returns the fullpath and program name to cpp.  */
+
+char *
+m2configure_FullPathCPP (void)
+{
+  if (M2Options_GetCpp ())
+    {
+      char *path = (char *) M2Options_GetB ();
+
+      if (path == NULL)
+	path = gen_gm2_libexec (STANDARD_LIBEXEC_PREFIX);
+
+      if (strcmp (path, "") == 0)
+	return xstrdup (CPPPROGRAM);
+
+      char *full = (char *)xmalloc (strlen (path) + 1 + strlen (CPPPROGRAM) + 1);
+      strcpy (full, path);
+      char *sep = (char *)alloca (2);
+      sep[0] = DIR_SEPARATOR;
+      sep[1] = (char)0;
+      strcat (full, sep);
+      strcat (full, CPPPROGRAM);
+      return full;
+    }
+  return NULL;
+}
diff --git a/gcc/m2/gm2-gcc/m2configure.def b/gcc/m2/gm2-gcc/m2configure.def
new file mode 100644
index 00000000000..64ce20f9977
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2configure.def
@@ -0,0 +1,44 @@
+(* m2configure.def exports configuration constants.
+
+Copyright (C) 2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2configure ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED UseUnderscoreForC, FullPathCPP ;
+
+
+CONST
+(*
+   UseUnderscoreForC - true if gcc places an underscore in front of global functions.
+*)
+   UseUnderscoreForC = FALSE ;
+
+
+(*
+   FullPathCPP - return a string to the full path of the C preprocessor cpp.
+                 It checks the -B option (if provided) otherwise it uses
+                 the STANDARD_LIBEXEC_PREFIX.
+*)
+
+PROCEDURE FullPathCPP () : ADDRESS ;
+
+
+END m2configure.
diff --git a/gcc/m2/gm2-gcc/m2configure.h b/gcc/m2/gm2-gcc/m2configure.h
new file mode 100644
index 00000000000..3e8942f00c3
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2configure.h
@@ -0,0 +1,44 @@
+/* m2configure.h header file for m2configure.cc.
+
+Copyright (C) 2022 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(m2configure_h)
+
+#define m2configure_h
+#if defined(m2configure_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2configure_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2configure_c.  */
+
+#include "input.h"
+
+EXTERN char *m2configure_FullPathCPP (void);
+
+#undef EXTERN
+#endif /* m2configure_h.  */
diff --git a/gcc/m2/gm2-gcc/m2convert.cc b/gcc/m2/gm2-gcc/m2convert.cc
new file mode 100644
index 00000000000..e6bf75bd953
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2convert.cc
@@ -0,0 +1,659 @@
+/* m2convert.cc provides GCC tree conversion for the Modula-2 language.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2convert_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2expr.h"
+#include "m2statement.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+
+static tree const_to_ISO_type (location_t location, tree expr, tree iso_type);
+static tree const_to_ISO_aggregate_type (location_t location, tree expr,
+                                         tree iso_type);
+
+/* These enumerators are possible types of unsafe conversions.
+   SAFE_CONVERSION The conversion is safe UNSAFE_OTHER Another type of
+   conversion with problems UNSAFE_SIGN Conversion between signed and
+   unsigned integers which are all warned about immediately, so this is
+   unused UNSAFE_REAL Conversions that reduce the precision of reals
+   including conversions from reals to integers.  */
+enum conversion_safety
+{
+  SAFE_CONVERSION = 0,
+  UNSAFE_OTHER,
+  UNSAFE_SIGN,
+  UNSAFE_REAL
+};
+
+/* ConvertString - converts string, expr, into a string of type,
+   type.  */
+
+tree
+m2convert_ConvertString (tree type, tree expr)
+{
+  const char *str = TREE_STRING_POINTER (expr);
+  int len = TREE_STRING_LENGTH (expr);
+  return m2decl_BuildStringConstantType (len, str, type);
+}
+
+
+/* (Taken from c-common.cc and trimmed for Modula-2)
+
+   Checks if expression EXPR of real/integer type cannot be converted to
+   the real/integer type TYPE.  Function returns non-zero when:
+   EXPR is a constant which cannot be exactly converted to TYPE.
+   EXPR is not a constant and size of EXPR's type > than size of
+   TYPE, for EXPR type and TYPE being both integers or both real.
+   EXPR is not a constant of real type and TYPE is an integer.
+   EXPR is not a constant of integer type which cannot be exactly
+   converted to real type.  Function allows conversions between types
+   of different signedness and can return SAFE_CONVERSION (zero) in
+   that case.  Function can produce signedness warnings if
+   PRODUCE_WARNS is true.  */
+
+enum conversion_safety
+unsafe_conversion_p (location_t loc, tree type, tree expr, bool produce_warns)
+{
+  enum conversion_safety give_warning = SAFE_CONVERSION; /* Is 0 or false.  */
+  tree expr_type = TREE_TYPE (expr);
+
+  if (TREE_CODE (expr) == REAL_CST || TREE_CODE (expr) == INTEGER_CST)
+    {
+
+      /* Warn for real constant that is not an exact integer converted to
+         integer type.  */
+      if (TREE_CODE (expr_type) == REAL_TYPE
+          && TREE_CODE (type) == INTEGER_TYPE)
+        {
+          if (!real_isinteger (TREE_REAL_CST_PTR (expr),
+                               TYPE_MODE (expr_type)))
+            give_warning = UNSAFE_REAL;
+        }
+      /* Warn for an integer constant that does not fit into integer type.  */
+      else if (TREE_CODE (expr_type) == INTEGER_TYPE
+               && TREE_CODE (type) == INTEGER_TYPE
+               && !int_fits_type_p (expr, type))
+        {
+          if (TYPE_UNSIGNED (type) && !TYPE_UNSIGNED (expr_type)
+              && tree_int_cst_sgn (expr) < 0)
+            {
+              if (produce_warns)
+                warning_at (loc, OPT_Wsign_conversion,
+                            "negative integer"
+                            " implicitly converted to unsigned type");
+            }
+          else if (!TYPE_UNSIGNED (type) && TYPE_UNSIGNED (expr_type))
+            {
+              if (produce_warns)
+                warning_at (loc, OPT_Wsign_conversion,
+                            "conversion of unsigned"
+                            " constant value to negative integer");
+            }
+          else
+            give_warning = UNSAFE_OTHER;
+        }
+      else if (TREE_CODE (type) == REAL_TYPE)
+        {
+          /* Warn for an integer constant that does not fit into real type.  */
+          if (TREE_CODE (expr_type) == INTEGER_TYPE)
+            {
+              REAL_VALUE_TYPE a = real_value_from_int_cst (0, expr);
+              if (!exact_real_truncate (TYPE_MODE (type), &a))
+                give_warning = UNSAFE_REAL;
+            }
+
+          /* Warn for a real constant that does not fit into a smaller real
+          type.  */
+          else if (TREE_CODE (expr_type) == REAL_TYPE
+                   && TYPE_PRECISION (type) < TYPE_PRECISION (expr_type))
+            {
+              REAL_VALUE_TYPE a = TREE_REAL_CST (expr);
+              if (!exact_real_truncate (TYPE_MODE (type), &a))
+                give_warning = UNSAFE_REAL;
+            }
+        }
+    }
+  else
+    {
+      /* Warn for real types converted to integer types.  */
+      if (TREE_CODE (expr_type) == REAL_TYPE
+          && TREE_CODE (type) == INTEGER_TYPE)
+        give_warning = UNSAFE_REAL;
+
+    }
+
+  return give_warning;
+}
+
+/* (Taken from c-common.cc and trimmed for Modula-2)
+
+   Warns if the conversion of EXPR to TYPE may alter a value.  This is
+   a helper function for warnings_for_convert_and_check.  */
+
+static void
+conversion_warning (location_t loc, tree type, tree expr)
+{
+  tree expr_type = TREE_TYPE (expr);
+  enum conversion_safety conversion_kind;
+
+  if (!warn_conversion && !warn_sign_conversion && !warn_float_conversion)
+    return;
+
+  switch (TREE_CODE (expr))
+    {
+    case EQ_EXPR:
+    case NE_EXPR:
+    case LE_EXPR:
+    case GE_EXPR:
+    case LT_EXPR:
+    case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case TRUTH_XOR_EXPR:
+    case TRUTH_NOT_EXPR:
+
+      /* Conversion from boolean to a signed:1 bit-field (which only can
+	 hold the values 0 and -1) doesn't lose information - but it does
+	 change the value.  */
+      if (TYPE_PRECISION (type) == 1 && !TYPE_UNSIGNED (type))
+        warning_at (loc, OPT_Wconversion,
+                    "conversion to %qT from boolean expression", type);
+      return;
+
+    case REAL_CST:
+    case INTEGER_CST:
+      conversion_kind = unsafe_conversion_p (loc, type, expr, true);
+      if (conversion_kind == UNSAFE_REAL)
+        warning_at (loc, OPT_Wfloat_conversion,
+                    "conversion to %qT alters %qT constant value", type,
+                    expr_type);
+      else if (conversion_kind)
+        warning_at (loc, OPT_Wconversion,
+                    "conversion to %qT alters %qT constant value", type,
+                    expr_type);
+      return;
+
+    case COND_EXPR:
+      {
+
+        /* In case of COND_EXPR, we do not care about the type of COND_EXPR,
+	   only about the conversion of each operand.  */
+        tree op1 = TREE_OPERAND (expr, 1);
+        tree op2 = TREE_OPERAND (expr, 2);
+
+        conversion_warning (loc, type, op1);
+        conversion_warning (loc, type, op2);
+        return;
+      }
+
+    default:  /* 'expr' is not a constant.  */
+      conversion_kind = unsafe_conversion_p (loc, type, expr, true);
+      if (conversion_kind == UNSAFE_REAL)
+        warning_at (loc, OPT_Wfloat_conversion,
+                    "conversion to %qT from %qT may alter its value", type,
+                    expr_type);
+      else if (conversion_kind)
+        warning_at (loc, OPT_Wconversion,
+                    "conversion to %qT from %qT may alter its value", type,
+                    expr_type);
+    }
+}
+
+/* (Taken from c-common.cc and trimmed for Modula-2)
+
+   Produce warnings after a conversion.  RESULT is the result of
+   converting EXPR to TYPE.  This is a helper function for
+   convert_and_check and cp_convert_and_check.  */
+
+void
+warnings_for_convert_and_check (location_t loc, tree type, tree expr,
+                                tree result)
+{
+  if (TREE_CODE (expr) == INTEGER_CST && (TREE_CODE (type) == INTEGER_TYPE
+                                          || TREE_CODE (type) == ENUMERAL_TYPE)
+      && !int_fits_type_p (expr, type))
+    {
+
+      /* Do not diagnose overflow in a constant expression merely because a
+	 conversion overflowed.  */
+      if (TREE_OVERFLOW (result))
+        TREE_OVERFLOW (result) = TREE_OVERFLOW (expr);
+
+      if (TYPE_UNSIGNED (type))
+        {
+
+          /* This detects cases like converting -129 or 256 to unsigned
+	     char.  */
+          if (!int_fits_type_p (expr, m2type_gm2_signed_type (type)))
+            warning_at (loc, OPT_Woverflow,
+                        "large integer implicitly truncated to unsigned type");
+          else
+            conversion_warning (loc, type, expr);
+        }
+      else if (!int_fits_type_p (expr, m2type_gm2_unsigned_type (type)))
+        warning_at (loc, OPT_Woverflow,
+                    "overflow in implicit constant conversion");
+      /* No warning for converting 0x80000000 to int.  */
+      else if (pedantic && (TREE_CODE (TREE_TYPE (expr)) != INTEGER_TYPE
+                            || TYPE_PRECISION (TREE_TYPE (expr))
+                                   != TYPE_PRECISION (type)))
+        warning_at (loc, OPT_Woverflow,
+                    "overflow in implicit constant conversion");
+
+      else
+        conversion_warning (loc, type, expr);
+    }
+  else if ((TREE_CODE (result) == INTEGER_CST
+            || TREE_CODE (result) == FIXED_CST)
+           && TREE_OVERFLOW (result))
+    warning_at (loc, OPT_Woverflow,
+                "overflow in implicit constant conversion");
+  else
+    conversion_warning (loc, type, expr);
+}
+
+/* (Taken from c-common.cc and trimmed for Modula-2)
+
+   Convert EXPR to TYPE, warning about conversion problems with
+   constants.  Invoke this function on every expression that is
+   converted implicitly, i.e.  because of language rules and not
+   because of an explicit cast.  */
+
+static tree
+convert_and_check (location_t loc, tree type, tree expr)
+{
+  tree result;
+  tree expr_for_warning;
+
+  /* Convert from a value with possible excess precision rather than
+     via the semantic type, but do not warn about values not fitting
+     exactly in the semantic type.  */
+  if (TREE_CODE (expr) == EXCESS_PRECISION_EXPR)
+    {
+      tree orig_type = TREE_TYPE (expr);
+      expr = TREE_OPERAND (expr, 0);
+      expr_for_warning = convert (orig_type, expr);
+      if (orig_type == type)
+        return expr_for_warning;
+    }
+  else
+    expr_for_warning = expr;
+
+  if (TREE_TYPE (expr) == type)
+    return expr;
+
+  result = convert_loc (loc, type, expr);
+
+  if (!TREE_OVERFLOW_P (expr) && result != error_mark_node)
+    warnings_for_convert_and_check (loc, type, expr_for_warning, result);
+
+  return result;
+}
+
+
+static tree
+doOrdinal (tree value)
+{
+  if (TREE_CODE (value) == STRING_CST && (m2expr_StringLength (value) <= 1))
+    {
+      const char *p = TREE_STRING_POINTER (value);
+      int i = p[0];
+
+      return m2decl_BuildIntegerConstant (i);
+    }
+  return value;
+}
+
+static int
+same_size_types (location_t location, tree t1, tree t2)
+{
+  tree n1 = m2expr_GetSizeOf (location, t1);
+  tree n2 = m2expr_GetSizeOf (location, t2);
+
+  return m2expr_CompareTrees (n1, n2) == 0;
+}
+
+static int
+converting_ISO_generic (location_t location, tree type, tree value,
+                        tree generic_type, tree *result)
+{
+  tree value_type = m2tree_skip_type_decl (TREE_TYPE (value));
+
+  if (value_type == type)
+    /* We let the caller deal with this.  */
+    return FALSE;
+
+  if ((TREE_CODE (value) == INTEGER_CST) && (type == generic_type))
+    {
+      *result = const_to_ISO_type (location, value, generic_type);
+      return TRUE;
+    }
+
+  if (same_size_types (location, type, value_type))
+    {
+      if (value_type == generic_type)
+        {
+          tree pt = build_pointer_type (type);
+          tree a = build1 (ADDR_EXPR, pt, value);
+          tree t = build1 (INDIRECT_REF, type, a);
+          *result = build1 (NOP_EXPR, type, t);
+          return TRUE;
+        }
+      else if (type == generic_type)
+        {
+          tree pt = build_pointer_type (type);
+          tree a = build1 (ADDR_EXPR, pt, value);
+          tree t = build1 (INDIRECT_REF, type, a);
+          *result = build1 (NOP_EXPR, type, t);
+          return TRUE;
+        }
+    }
+  return FALSE;
+}
+
+/* convert_char_to_array - convert a single char, value, into an
+   type.  The type will be array [..] of char.  The array type
+   returned will have nuls appended to pad the single char to the
+   correct array length.  */
+
+static tree
+convert_char_to_array (location_t location, tree type, tree value)
+{
+  tree i = m2decl_BuildIntegerConstant (0);
+  struct struct_constructor *c
+      = (struct struct_constructor *)m2type_BuildStartArrayConstructor (type);
+  tree n = m2type_GetArrayNoOfElements (location, type);
+  char nul[1];
+
+  nul[0] = (char)0;
+
+  /* Store the initial char.  */
+  m2type_BuildArrayConstructorElement (c, value, i);
+  i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1), FALSE);
+
+  /* Now pad out the remaining elements with nul chars.  */
+  while (m2expr_CompareTrees (i, n) < 0)
+    {
+      m2type_BuildArrayConstructorElement (
+          c, m2type_BuildCharConstant (location, &nul[0]), i);
+      i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
+                           FALSE);
+    }
+  return m2type_BuildEndArrayConstructor (c);
+}
+
+/* convert_string_to_array - convert a STRING_CST into an array type.
+   array [..] of char.  The array constant returned will have nuls
+   appended to pad the contents to the correct length.  */
+
+static tree
+convert_string_to_array (location_t location, tree type, tree value)
+{
+  tree n = m2type_GetArrayNoOfElements (location, type);
+
+  return m2type_BuildArrayStringConstructor (location, type, value, n);
+}
+
+/* BuildConvert - build and return tree VAL (type, value).
+   checkOverflow determines whether we should suppress overflow
+   checking.  */
+
+tree
+m2convert_BuildConvert (location_t location, tree type, tree value,
+                        int checkOverflow)
+{
+  type = m2tree_skip_type_decl (type);
+  tree t;
+
+  value = fold (value);
+  STRIP_NOPS (value);
+  value = m2expr_FoldAndStrip (value);
+
+  if (TREE_CODE (value) == STRING_CST && (m2expr_StringLength (value) <= 1)
+      && (m2tree_IsOrdinal (type)))
+    value = doOrdinal (value);
+  else if (TREE_CODE (value) == FUNCTION_DECL && TREE_TYPE (value) != type)
+    value = m2expr_BuildAddr (0, value, FALSE);
+
+  if (converting_ISO_generic (location, type, value, m2type_GetByteType (), &t)
+      || converting_ISO_generic (location, type, value,
+                                 m2type_GetISOLocType (), &t)
+      || converting_ISO_generic (location, type, value,
+                                 m2type_GetISOByteType (), &t)
+      || converting_ISO_generic (location, type, value,
+                                 m2type_GetISOWordType (), &t)
+      || converting_ISO_generic (location, type, value, m2type_GetM2Word16 (),
+                                 &t)
+      || converting_ISO_generic (location, type, value, m2type_GetM2Word32 (),
+                                 &t)
+      || converting_ISO_generic (location, type, value, m2type_GetM2Word64 (),
+                                 &t))
+    return t;
+
+  if (TREE_CODE (type) == ARRAY_TYPE
+      && TREE_TYPE (type) == m2type_GetM2CharType ())
+    {
+      if (TREE_TYPE (value) == m2type_GetM2CharType ())
+
+        /* Passing a const char to an array [..] of char.  So we convert
+	   const char into the correct length string.  */
+        return convert_char_to_array (location, type, value);
+      if (TREE_CODE (value) == STRING_CST)
+        /* Convert a string into an array constant, padding with zeros if
+           necessary.  */
+        return convert_string_to_array (location, type, value);
+    }
+
+  if (checkOverflow)
+    return convert_and_check (location, type, value);
+  else
+    return convert (type, value);
+}
+
+/* const_to_ISO_type - perform VAL (iso_type, expr).  */
+
+static tree
+const_to_ISO_type (location_t location, tree expr, tree iso_type)
+{
+  tree n = m2expr_GetSizeOf (location, iso_type);
+
+  if ((m2expr_CompareTrees (n, m2decl_BuildIntegerConstant (1)) == 0)
+      && (iso_type == m2type_GetByteType ()
+          || iso_type == m2type_GetISOLocType ()
+          || iso_type == m2type_GetISOByteType ()))
+    return build1 (NOP_EXPR, iso_type, expr);
+  return const_to_ISO_aggregate_type (location, expr, iso_type);
+}
+
+/* const_to_ISO_aggregate_type - perform VAL (iso_type, expr).  The
+   iso_type will be declared by the SYSTEM module as: TYPE iso_type =
+   ARRAY [0..n] OF LOC
+
+   this function will store a constant into the iso_type in the correct
+   endian order.  It converts the expr into a unsigned int or signed
+   int and then strips it a byte at a time.  */
+
+static tree
+const_to_ISO_aggregate_type (location_t location, tree expr, tree iso_type)
+{
+  tree byte;
+  m2type_Constructor c;
+  tree i = m2decl_BuildIntegerConstant (0);
+  tree n = m2expr_GetSizeOf (location, iso_type);
+  tree max_uint = m2decl_BuildIntegerConstant (256);
+
+  while (m2expr_CompareTrees (i, n) < 0)
+    {
+      max_uint = m2expr_BuildMult (location, max_uint,
+                                   m2decl_BuildIntegerConstant (256), FALSE);
+      i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
+                           FALSE);
+    }
+  max_uint = m2expr_BuildDivFloor (location, max_uint,
+                                   m2decl_BuildIntegerConstant (2), FALSE);
+
+  if (m2expr_CompareTrees (expr, m2decl_BuildIntegerConstant (0)) < 0)
+    expr = m2expr_BuildAdd (location, expr, max_uint, FALSE);
+
+  i = m2decl_BuildIntegerConstant (0);
+  c = m2type_BuildStartArrayConstructor (iso_type);
+  while (m2expr_CompareTrees (i, n) < 0)
+    {
+      byte = m2expr_BuildModTrunc (location, expr,
+                                   m2decl_BuildIntegerConstant (256), FALSE);
+      if (BYTES_BIG_ENDIAN)
+        m2type_BuildArrayConstructorElement (
+            c, m2convert_ToLoc (location, byte),
+            m2expr_BuildSub (location, m2expr_BuildSub (location, n, i, FALSE),
+                             m2decl_BuildIntegerConstant (1), FALSE));
+      else
+        m2type_BuildArrayConstructorElement (
+            c, m2convert_ToLoc (location, byte), i);
+
+      i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
+                           FALSE);
+      expr = m2expr_BuildDivFloor (location, expr,
+                                   m2decl_BuildIntegerConstant (256), FALSE);
+    }
+
+  return m2type_BuildEndArrayConstructor (c);
+}
+
+/* ConvertConstantAndCheck - in Modula-2 sementics: RETURN( VAL(type,
+   expr) ).  Only to be used for a constant expr, overflow checking
+   is performed.  */
+
+tree
+m2convert_ConvertConstantAndCheck (location_t location, tree type, tree expr)
+{
+  tree etype;
+  expr = fold (expr);
+  STRIP_NOPS (expr);
+  expr = m2expr_FoldAndStrip (expr);
+  etype = TREE_TYPE (expr);
+
+  m2assert_AssertLocation (location);
+  if (etype == type)
+    return expr;
+
+  if (TREE_CODE (expr) == FUNCTION_DECL)
+    expr = m2expr_BuildAddr (location, expr, FALSE);
+
+  type = m2tree_skip_type_decl (type);
+  if (type == m2type_GetByteType () || type == m2type_GetISOLocType ()
+      || type == m2type_GetISOByteType () || type == m2type_GetISOWordType ()
+      || type == m2type_GetM2Word16 () || type == m2type_GetM2Word32 ()
+      || type == m2type_GetM2Word64 ())
+    return const_to_ISO_type (location, expr, type);
+
+  return convert_and_check (location, type, m2expr_FoldAndStrip (expr));
+}
+
+/* ToWord - converts an expression (Integer or Ordinal type) into a
+   WORD.  */
+
+tree
+m2convert_ToWord (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetWordType (), expr, FALSE);
+}
+
+/* ToCardinal - convert an expression, expr, to a CARDINAL.  */
+
+tree
+m2convert_ToCardinal (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetCardinalType (), expr,
+                                 FALSE);
+}
+
+/* convertToPtr - if the type of tree, t, is not a ptr_type_node then
+   convert it.  */
+
+tree
+m2convert_convertToPtr (location_t location, tree type)
+{
+  if (TREE_CODE (TREE_TYPE (type)) == POINTER_TYPE)
+    return type;
+  else
+    return m2convert_BuildConvert (location, m2type_GetPointerType (), type,
+                                   FALSE);
+}
+
+/* ToInteger - convert an expression, expr, to an INTEGER.  */
+
+tree
+m2convert_ToInteger (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetIntegerType (), expr,
+                                 FALSE);
+}
+
+/* ToBitset - convert an expression, expr, to a BITSET type.  */
+
+tree
+m2convert_ToBitset (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetBitsetType (), expr,
+                                 FALSE);
+}
+
+/* ToLoc - convert an expression, expr, to a LOC.  */
+
+tree
+m2convert_ToLoc (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetISOByteType (), expr,
+                                 FALSE);
+}
+
+/* GenericToType - converts, expr, into, type, providing that expr is
+   a generic system type (byte, word etc).  Otherwise expr is
+   returned unaltered.  */
+
+tree
+m2convert_GenericToType (location_t location, tree type, tree expr)
+{
+  tree etype = TREE_TYPE (expr);
+
+  type = m2tree_skip_type_decl (type);
+  if (type == etype)
+    return expr;
+
+  if (type == m2type_GetISOWordType () || type == m2type_GetM2Word16 ()
+      || type == m2type_GetM2Word32 () || type == m2type_GetM2Word64 ())
+    return const_to_ISO_type (location, expr, type);
+
+  return expr;
+}
diff --git a/gcc/m2/gm2-gcc/m2convert.def b/gcc/m2/gm2-gcc/m2convert.def
new file mode 100644
index 00000000000..e91c1e6e492
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2convert.def
@@ -0,0 +1,98 @@
+(* m2convert.def definition module for m2convert.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2convert ;
+
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+
+
+(*
+   ToWord - converts an expression (Integer or Ordinal type) into
+            a WORD.
+*)
+
+PROCEDURE ToWord (location: location_t; expr: Tree) : Tree ;
+
+
+(*
+   ToCardinal - convert an expression, expr, to a CARDINAL.
+*)
+
+PROCEDURE ToCardinal (location: location_t; expr: Tree) : Tree ;
+
+
+(*
+   ToInteger - convert an expression, expr, to an INTEGER.
+*)
+
+PROCEDURE ToInteger (location: location_t; expr: Tree) : Tree ;
+
+
+(*
+   ToBitset - convert an expression, expr, to a BITSET.
+*)
+
+PROCEDURE ToBitset (location: location_t; expr: Tree) : Tree ;
+
+
+(*
+   ConvertToPtr - convert an expression to a void *.
+*)
+
+PROCEDURE ConvertToPtr (p: Tree) : Tree ;
+
+
+(*
+    BuildConvert - build and return tree VAL(type, value)
+                   checkOverflow determines whether we
+                   should suppress overflow checking.
+*)
+
+PROCEDURE BuildConvert (location: location_t; type: Tree; value: Tree; checkOverflow: BOOLEAN) : Tree ;
+
+
+(*
+   ConvertConstantAndCheck - in Modula-2 sementics: return( VAL(type, expr) )
+                             Only to be used for a constant expr,
+                             overflow checking is performed.
+*)
+
+PROCEDURE ConvertConstantAndCheck (location: location_t; type: Tree; expr: Tree) : Tree ;
+
+
+(*
+   ConvertString - converts string, expr, into a string of type, type.
+*)
+
+PROCEDURE ConvertString (type, expr: Tree) : Tree ;
+
+
+(*
+   GenericToType - converts, expr, into, type, providing that expr is
+                   a generic system type (byte, word etc).  Otherwise
+                   expr is returned unaltered.
+*)
+
+PROCEDURE GenericToType (location: location_t; type, expr: Tree) : Tree ;
+
+
+END m2convert.
diff --git a/gcc/m2/gm2-gcc/m2convert.h b/gcc/m2/gm2-gcc/m2convert.h
new file mode 100644
index 00000000000..8dbc574405e
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2convert.h
@@ -0,0 +1,54 @@
+/* m2convert.h header file for m2convert.cc.
+
+Copyright (C) 2012-2022 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(m2convert_h)
+#define m2convert_h
+#if defined(m2convert_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* m2convert_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* m2convert_c.  */
+
+EXTERN tree m2convert_BuildConvert (location_t location, tree type, tree value,
+                                    int checkOverflow);
+EXTERN tree m2convert_ConvertToPtr (location_t location_t, tree p);
+EXTERN tree m2convert_ConvertString (tree type, tree expr);
+EXTERN tree m2convert_ConvertConstantAndCheck (location_t location, tree type,
+                                               tree expr);
+EXTERN tree m2convert_convertToPtr (location_t location, tree type);
+EXTERN tree m2convert_ToCardinal (location_t location, tree expr);
+EXTERN tree m2convert_ToInteger (location_t location, tree expr);
+EXTERN tree m2convert_ToWord (location_t location, tree expr);
+EXTERN tree m2convert_ToBitset (location_t location, tree expr);
+EXTERN tree m2convert_ToLoc (location_t location, tree expr);
+EXTERN tree m2convert_GenericToType (location_t location, tree type,
+                                     tree expr);
+
+#undef EXTERN
+#endif /* m2convert_h.  */
diff --git a/gcc/m2/gm2-gcc/m2decl.cc b/gcc/m2/gm2-gcc/m2decl.cc
new file mode 100644
index 00000000000..62bfefd2530
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2decl.cc
@@ -0,0 +1,453 @@
+/* m2decl.cc provides an interface to GCC decl trees.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2decl_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+#include "m2convert.h"
+
+extern GTY (()) tree current_function_decl;
+
+/* Used in BuildStartFunctionType.  */
+static GTY (()) tree param_type_list;
+static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
+                                                call/define a function.  */
+
+tree
+m2decl_DeclareM2linkStaticInitialization (location_t location,
+					  int ScaffoldStatic)
+{
+  m2block_pushGlobalScope ();
+  /* Generate: int M2LINK_StaticInitialization = ScaffoldStatic;  */
+  tree init = m2decl_BuildIntegerConstant (ScaffoldStatic);
+  tree static_init = m2decl_DeclareKnownVariable (location, "M2LINK_StaticInitialization",
+						  integer_type_node,
+						  TRUE, FALSE, FALSE, TRUE, NULL_TREE, init);
+  m2block_popGlobalScope ();
+  return static_init;
+}
+
+
+tree
+m2decl_DeclareM2linkForcedModuleInitOrder (location_t location,
+					   const char *RuntimeOverride)
+{
+  m2block_pushGlobalScope ();
+  /* Generate: const char *ForcedModuleInitOrder = RuntimeOverride;  */
+  tree ptr_to_char = build_pointer_type (char_type_node);
+  TYPE_READONLY (ptr_to_char) = TRUE;
+  tree init = m2decl_BuildPtrToTypeString (location, RuntimeOverride, ptr_to_char);
+  tree forced_order = m2decl_DeclareKnownVariable (location, "M2LINK_ForcedModuleInitOrder",
+						   ptr_to_char,
+						   TRUE, FALSE, FALSE, TRUE, NULL_TREE, init);
+  m2block_popGlobalScope ();
+  return forced_order;
+}
+
+
+/* DeclareKnownVariable declares a variable to GCC.  */
+
+tree
+m2decl_DeclareKnownVariable (location_t location, const char *name, tree type,
+                             int exported, int imported, int istemporary,
+                             int isglobal, tree scope, tree initial)
+{
+  tree id;
+  tree decl;
+
+  m2assert_AssertLocation (location);
+  ASSERT (m2tree_is_type (type), type);
+  ASSERT_BOOL (isglobal);
+
+  id = get_identifier (name);
+  type = m2tree_skip_type_decl (type);
+  decl = build_decl (location, VAR_DECL, id, type);
+
+  DECL_SOURCE_LOCATION (decl) = location;
+
+  DECL_EXTERNAL (decl) = imported;
+  TREE_STATIC (decl) = isglobal;
+  TREE_PUBLIC (decl) = exported || imported;
+
+  gcc_assert ((istemporary == 0) || (istemporary == 1));
+
+  /* The variable was not declared by GCC, but by the front end.  */
+  DECL_ARTIFICIAL (decl) = istemporary;
+  /* If istemporary then we don't want debug info for it.  */
+  DECL_IGNORED_P (decl) = istemporary;
+  /* If istemporary we don't want even the fancy names of those printed in
+     -fdump-final-insns= dumps.  */
+  DECL_NAMELESS (decl) = istemporary;
+
+  /* Make the variable writable.  */
+  TREE_READONLY (decl) = 0;
+
+  DECL_CONTEXT (decl) = scope;
+
+  if (initial)
+    DECL_INITIAL (decl) = initial;
+
+  m2block_pushDecl (decl);
+
+  if (DECL_SIZE (decl) == 0)
+    error ("storage size of %qD has not been resolved", decl);
+
+  if ((TREE_PUBLIC (decl) == 0) && DECL_EXTERNAL (decl))
+    internal_error ("inconsistant because %qs",
+		    "PUBLIC_DECL(decl) == 0 && DECL_EXTERNAL(decl) == 1");
+
+  m2block_addDeclExpr (build_stmt (location, DECL_EXPR, decl));
+
+  return decl;
+}
+
+/* DeclareKnownConstant - given a constant, value, of, type, create a
+   constant in the GCC symbol table.  Note that the name of the
+   constant is not used as _all_ constants are declared in the global
+   scope.  The front end deals with scoping rules - here we declare
+   all constants with no names in the global scope.  This allows
+   M2SubExp and constant folding routines the liberty of operating
+   with quadruples which all assume constants can always be
+   referenced.  */
+
+tree
+m2decl_DeclareKnownConstant (location_t location, tree type, tree value)
+{
+  tree id = make_node (IDENTIFIER_NODE); /* Ignore the name of the constant. */
+  tree decl;
+
+  m2assert_AssertLocation (location);
+  m2expr_ConstantExpressionWarning (value);
+  type = m2tree_skip_type_decl (type);
+  layout_type (type);
+
+  decl = build_decl (location, CONST_DECL, id, type);
+
+  DECL_INITIAL (decl) = value;
+  TREE_TYPE (decl) = type;
+
+  decl = m2block_global_constant (decl);
+
+  return decl;
+}
+
+/* BuildParameterDeclaration - creates and returns one parameter
+   from, name, and, type.  It appends this parameter to the internal
+   param_type_list.  */
+
+tree
+m2decl_BuildParameterDeclaration (location_t location, char *name, tree type,
+                                  int isreference)
+{
+  tree parm_decl;
+
+  m2assert_AssertLocation (location);
+  ASSERT_BOOL (isreference);
+  type = m2tree_skip_type_decl (type);
+  layout_type (type);
+  if (isreference)
+    type = build_reference_type (type);
+
+  if (name == NULL)
+    parm_decl = build_decl (location, PARM_DECL, NULL, type);
+  else
+    parm_decl = build_decl (location, PARM_DECL, get_identifier (name), type);
+  DECL_ARG_TYPE (parm_decl) = type;
+  if (isreference)
+    TREE_READONLY (parm_decl) = TRUE;
+
+  param_list = chainon (parm_decl, param_list);
+  layout_type (type);
+  param_type_list = tree_cons (NULL_TREE, type, param_type_list);
+  return parm_decl;
+}
+
+/* BuildStartFunctionDeclaration - initializes global variables ready
+   for building a function.  */
+
+void
+m2decl_BuildStartFunctionDeclaration (int uses_varargs)
+{
+  if (uses_varargs)
+    param_type_list = NULL_TREE;
+  else
+    param_type_list = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+  param_list = NULL_TREE; /* Ready for when we define a function.  */
+}
+
+/* BuildEndFunctionDeclaration - build a function which will return a
+   value of returntype.  The arguments have been created by
+   BuildParameterDeclaration.  */
+
+tree
+m2decl_BuildEndFunctionDeclaration (location_t location_begin,
+                                    location_t location_end, const char *name,
+                                    tree returntype, int isexternal,
+                                    int isnested, int ispublic)
+{
+  tree fntype;
+  tree fndecl;
+
+  m2assert_AssertLocation (location_begin);
+  m2assert_AssertLocation (location_end);
+  ASSERT_BOOL (isexternal);
+  ASSERT_BOOL (isnested);
+  ASSERT_BOOL (ispublic);
+  returntype = m2tree_skip_type_decl (returntype);
+  /* The function type depends on the return type and type of args,
+     both of which we have created in BuildParameterDeclaration */
+  if (returntype == NULL_TREE)
+    returntype = void_type_node;
+  else if (TREE_CODE (returntype) == FUNCTION_TYPE)
+    returntype = ptr_type_node;
+
+  fntype = build_function_type (returntype, param_type_list);
+  fndecl = build_decl (location_begin, FUNCTION_DECL, get_identifier (name),
+                       fntype);
+
+  if (isexternal)
+    ASSERT_CONDITION (ispublic);
+
+  DECL_EXTERNAL (fndecl) = isexternal;
+  TREE_PUBLIC (fndecl) = ispublic;
+  TREE_STATIC (fndecl) = (!isexternal);
+  DECL_ARGUMENTS (fndecl) = param_list;
+  DECL_RESULT (fndecl)
+      = build_decl (location_end, RESULT_DECL, NULL_TREE, returntype);
+  DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+  TREE_TYPE (fndecl) = fntype;
+
+  DECL_SOURCE_LOCATION (fndecl) = location_begin;
+
+  /* Prevent the optimizer from removing it if it is public.  */
+  if (TREE_PUBLIC (fndecl))
+    gm2_mark_addressable (fndecl);
+
+  m2block_pushDecl (fndecl);
+
+  rest_of_decl_compilation (fndecl, 1, 0);
+  param_list
+      = NULL_TREE; /* Ready for the next time we call/define a function.  */
+  return fndecl;
+}
+
+/* BuildModuleCtor creates the per module constructor used as part of
+   the dynamic linking scaffold.  */
+
+void
+m2decl_BuildModuleCtor (tree module_ctor)
+{
+  decl_init_priority_insert (module_ctor, DEFAULT_INIT_PRIORITY);
+}
+
+/* DeclareModuleCtor configures the function to be used as a ctor.  */
+
+tree
+m2decl_DeclareModuleCtor (tree decl)
+{
+  /* Declare module_ctor ().  */
+  TREE_PUBLIC (decl) = 1;
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN;
+  DECL_VISIBILITY_SPECIFIED (decl) = 1;
+  DECL_STATIC_CONSTRUCTOR (decl) = 1;
+  return decl;
+}
+
+
+/* DetermineSizeOfConstant - given, str, and, base, fill in needsLong
+   and needsUnsigned appropriately.  */
+
+void
+m2decl_DetermineSizeOfConstant (location_t location,
+				const char *str, unsigned int base,
+                                int *needsLong, int *needsUnsigned)
+{
+  unsigned int ulow;
+  int high;
+  int overflow = m2expr_interpret_m2_integer (str, base, &ulow, &high,
+					      needsLong, needsUnsigned);
+  if (overflow)
+    error_at (location, "constant %qs is too large", str);
+}
+
+/* BuildConstLiteralNumber - returns a GCC TREE built from the
+   string, str.  It assumes that, str, represents a legal number in
+   Modula-2.  It always returns a positive value.  */
+
+tree
+m2decl_BuildConstLiteralNumber (location_t location, const char *str, unsigned int base)
+{
+  tree value, type;
+  unsigned HOST_WIDE_INT low;
+  HOST_WIDE_INT high;
+  HOST_WIDE_INT ival[3];
+  int overflow = m2expr_interpret_integer (str, base, &low, &high);
+  int needLong, needUnsigned;
+
+  ival[0] = low;
+  ival[1] = high;
+  ival[2] = 0;
+
+  widest_int wval = widest_int::from_array (ival, 3);
+
+  m2decl_DetermineSizeOfConstant (location, str, base, &needLong, &needUnsigned);
+
+  if (needUnsigned && needLong)
+    type = m2type_GetM2LongCardType ();
+  else
+    type = m2type_GetM2LongIntType ();
+
+  value = wide_int_to_tree (type, wval);
+
+  if (overflow || m2expr_TreeOverflow (value))
+    error_at (location, "constant %qs is too large", str);
+
+  return m2block_RememberConstant (value);
+}
+
+/* BuildCStringConstant - creates a string constant given a, string,
+   and, length.  */
+
+tree
+m2decl_BuildCStringConstant (const char *string, int length)
+{
+  tree elem, index, type;
+
+  /* +1 ensures that we always nul terminate our strings.  */
+  elem = build_type_variant (char_type_node, 1, 0);
+  index = build_index_type (build_int_cst (integer_type_node, length + 1));
+  type = build_array_type (elem, index);
+  return m2decl_BuildStringConstantType (length + 1, string, type);
+}
+
+/* BuildStringConstant - creates a string constant given a, string,
+   and, length.  */
+
+tree
+m2decl_BuildStringConstant (const char *string, int length)
+{
+  tree elem, index, type;
+
+  elem = build_type_variant (char_type_node, 1, 0);
+  index = build_index_type (build_int_cst (integer_type_node, length));
+  type = build_array_type (elem, index);
+  return m2decl_BuildStringConstantType (length, string, type);
+  // maybe_wrap_with_location
+}
+
+
+tree
+m2decl_BuildPtrToTypeString (location_t location, const char *string, tree type)
+{
+  if ((string == NULL) || (strlen (string) == 0))
+    return m2convert_BuildConvert (location, type,
+				   m2decl_BuildIntegerConstant (0),
+				   FALSE);
+  return build_string_literal (strlen (string), string);
+}
+
+
+/* BuildIntegerConstant - return a tree containing the integer value.  */
+
+tree
+m2decl_BuildIntegerConstant (int value)
+{
+  switch (value)
+    {
+
+    case 0:
+      return integer_zero_node;
+    case 1:
+      return integer_one_node;
+
+    default:
+      return m2block_RememberConstant (
+          build_int_cst (integer_type_node, value));
+    }
+}
+
+/* BuildStringConstantType - builds a string constant with a type.  */
+
+tree
+m2decl_BuildStringConstantType (int length, const char *string, tree type)
+{
+  tree id = build_string (length, string);
+
+  TREE_TYPE (id) = type;
+  TREE_CONSTANT (id) = TRUE;
+  TREE_READONLY (id) = TRUE;
+  TREE_STATIC (id) = TRUE;
+
+  return m2block_RememberConstant (id);
+}
+
+/* GetBitsPerWord - returns the number of bits in a WORD.  */
+
+int
+m2decl_GetBitsPerWord (void)
+{
+  return BITS_PER_WORD;
+}
+
+/* GetBitsPerInt - returns the number of bits in a INTEGER.  */
+
+int
+m2decl_GetBitsPerInt (void)
+{
+  return INT_TYPE_SIZE;
+}
+
+/* GetBitsPerBitset - returns the number of bits in a BITSET.  */
+
+int
+m2decl_GetBitsPerBitset (void)
+{
+  return SET_WORD_SIZE;
+}
+
+/* GetBitsPerUnit - returns the number of bits in a UNIT.  */
+
+int
+m2decl_GetBitsPerUnit (void)
+{
+  return BITS_PER_UNIT;
+}
+
+/* m2decl_GetDeclContext - returns the DECL_CONTEXT of tree, t.  */
+
+tree
+m2decl_GetDeclContext (tree t)
+{
+  return DECL_CONTEXT (t);
+}
+
+#include "gt-m2-m2decl.h"
diff --git a/gcc/m2/gm2-gcc/m2decl.def b/gcc/m2/gm2-gcc/m2decl.def
new file mode 100644
index 00000000000..0f924dd1309
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2decl.def
@@ -0,0 +1,203 @@
+(* m2decl.def definition module for m2decl.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE m2decl ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+
+
+(*
+   BuildModuleCtor creates the per module constructor used as part of
+   the dynamic linking scaffold.
+*)
+
+PROCEDURE BuildModuleCtor (moduleCtor: Tree) ;
+
+
+(*
+   DeclareModuleCtor configures the function to be used as a ctor.
+*)
+
+PROCEDURE DeclareModuleCtor (decl: Tree) : Tree ;
+
+
+
+(*
+
+*)
+
+PROCEDURE DeclareM2linkForcedModuleInitOrder (location: location_t;
+                                              RuntimeOverride: ADDRESS) : Tree ;
+
+
+PROCEDURE DeclareM2linkStaticInitialization (location: location_t;
+                                             ScaffoldStatic: INTEGER) : Tree ;
+
+PROCEDURE BuildPtrToTypeString (location: location_t; string: ADDRESS; type: Tree) : Tree ;
+
+
+(*
+    GetBitsPerBitset - returns the number of bits in a BITSET.
+*)
+
+PROCEDURE GetBitsPerBitset () : INTEGER ;
+
+
+(*
+    GetBitsPerInt - returns the number of bits in a INTEGER.
+*)
+
+PROCEDURE GetBitsPerInt () : INTEGER ;
+
+
+(*
+    GetBitsPerUnit - returns the number of bits in a UNIT.
+*)
+
+PROCEDURE GetBitsPerUnit () : INTEGER ;
+
+
+(*
+    GetBitsPerWord - returns the number of bits in a WORD.
+*)
+
+PROCEDURE GetBitsPerWord () : INTEGER ;
+
+
+(*
+    BuildIntegerConstant - return a tree containing the integer value.
+*)
+
+PROCEDURE BuildIntegerConstant (value: INTEGER) : Tree ;
+
+
+(*
+    BuildStringConstantType - builds a string constant with a type.
+*)
+
+PROCEDURE BuildStringConstantType (length: INTEGER; string: ADDRESS; type: Tree) : Tree ;
+
+
+(*
+    DeclareKnownVariable - declares a variable in scope,
+                           funcscope. Note that the global variable,
+                           current_function_decl, is altered if
+                           isglobal is TRUE.
+*)
+
+PROCEDURE DeclareKnownVariable (location: location_t; name: ADDRESS; type: Tree;
+                                exported, imported, istemporary, isglobal: BOOLEAN;
+                                scope, initial: Tree) : Tree ;
+
+
+(*
+    DeclareKnownConstant - given a constant, value, of, type, create a constant in the GCC
+                           symbol table. Note that the name of the constant is not used
+                           as _all_ constants are declared in the global scope. The front end
+                           deals with scoping rules - here we declare all constants with no names
+                           in the global scope. This allows M2SubExp and constant folding routines
+                           the liberty of operating with quadruples which all assume constants can
+                           always be referenced.
+*)
+
+PROCEDURE DeclareKnownConstant (location: location_t; type: Tree; value: Tree) : Tree ;
+
+
+(*
+    BuildParameterDeclaration - creates and returns one parameter from, name, and, type.
+                                It appends this parameter to the internal param_type_list.
+                                If name is nul then we assume we are creating a function
+                                type declaration and we ignore names.
+*)
+
+PROCEDURE BuildParameterDeclaration (location: location_t; name: ADDRESS; type: Tree;
+                                     isreference: BOOLEAN) : Tree ;
+
+
+(*
+    BuildStartFunctionDeclaration - initializes global variables ready
+                                    for building a function.
+*)
+
+PROCEDURE BuildStartFunctionDeclaration (uses_varargs: BOOLEAN) ;
+
+
+(*
+    BuildEndFunctionDeclaration - build a function which will return a value of returntype.
+                                  The arguments have been created by BuildParameterDeclaration.
+*)
+
+PROCEDURE BuildEndFunctionDeclaration (location_begin, location_end: location_t;
+                                       name: ADDRESS; returntype: Tree;
+                                       isexternal, isnested, ispublic: BOOLEAN) : Tree ;
+
+
+(*
+    RememberVariables -
+*)
+
+PROCEDURE RememberVariables (l: Tree) ;
+
+
+(*
+    DetermineSizeOfConstant - given, str, and, base, fill in
+                              needsLong and needsUnsigned appropriately.
+*)
+
+PROCEDURE DetermineSizeOfConstant (location: location_t;
+                                   str: ADDRESS; base: CARDINAL;
+                                   VAR needsLong, needsUnsigned: BOOLEAN) ;
+
+
+(*
+    BuildConstLiteralNumber - returns a GCC TREE built from the string, str.
+                              It assumes that, str, represents a legal
+                              number in Modula-2. It always returns a
+                              positive value.
+*)
+
+PROCEDURE BuildConstLiteralNumber (location: location_t;
+                                   str: ADDRESS; base: CARDINAL) : Tree ;
+
+
+(*
+    BuildStringConstant - creates a string constant given a, string,
+                          and, length.
+*)
+
+PROCEDURE BuildStringConstant (string: ADDRESS; length: INTEGER) : Tree ;
+
+
+(*
+    BuildCStringConstant - creates a string constant given a, string,
+                           and, length.
+*)
+
+PROCEDURE BuildCStringConstant (string: ADDRESS; length: INTEGER) : Tree ;
+
+
+
+PROCEDURE GetDeclContext (t: Tree) : Tree ;
+
+
+END m2decl.
diff --git a/gcc/m2/gm2-gcc/m2decl.h b/gcc/m2/gm2-gcc/m2decl.h
new file mode 100644
index 00000000000..187569484a4
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2decl.h
@@ -0,0 +1,82 @@
+/* m2decl.h header file for m2decl.cc.
+
+Copyright (C) 2012-2022 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(m2decl_h)
+
+#define m2decl_h
+#if defined(m2decl_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2decl_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2decl_c.  */
+
+
+EXTERN tree m2decl_DeclareM2linkStaticInitialization (location_t location,
+						      int ScaffoldStatic);
+EXTERN tree m2decl_DeclareM2linkForcedModuleInitOrder (location_t location,
+						       const char *RuntimeOverride);
+EXTERN tree m2decl_BuildPtrToTypeString (location_t location, const char *string, tree type);
+EXTERN void m2decl_BuildModuleCtor (tree module_ctor);
+EXTERN tree m2decl_DeclareModuleCtor (tree decl);
+EXTERN tree m2decl_GetDeclContext (tree t);
+EXTERN tree m2decl_BuildStringConstant (const char *string, int length);
+EXTERN tree m2decl_BuildCStringConstant (const char *string, int length);
+EXTERN tree m2decl_BuildConstLiteralNumber (location_t location,
+					    const char *str,
+                                            unsigned int base);
+EXTERN void m2decl_DetermineSizeOfConstant (location_t location,
+					    const char *str, unsigned int base,
+                                            int *needsLong,
+                                            int *needsUnsigned);
+EXTERN void m2decl_RememberVariables (tree l);
+
+EXTERN tree m2decl_BuildEndFunctionDeclaration (
+    location_t location_begin, location_t location_end, const char *name,
+    tree returntype, int isexternal, int isnested, int ispublic);
+EXTERN void m2decl_BuildStartFunctionDeclaration (int uses_varargs);
+EXTERN tree m2decl_BuildParameterDeclaration (location_t location, char *name,
+                                              tree type, int isreference);
+EXTERN tree m2decl_DeclareKnownConstant (location_t location, tree type,
+                                         tree value);
+EXTERN tree m2decl_DeclareKnownVariable (location_t location, const char *name,
+                                         tree type, int exported, int imported,
+                                         int istemporary, int isglobal,
+                                         tree scope, tree initial);
+
+EXTERN tree m2decl_BuildStringConstantType (int length, const char *string,
+                                            tree type);
+EXTERN tree m2decl_BuildIntegerConstant (int value);
+
+EXTERN int m2decl_GetBitsPerWord (void);
+EXTERN int m2decl_GetBitsPerUnit (void);
+EXTERN int m2decl_GetBitsPerInt (void);
+EXTERN int m2decl_GetBitsPerBitset (void);
+
+#undef EXTERN
+#endif /* m2decl_h.  */
diff --git a/gcc/m2/gm2-gcc/m2except.cc b/gcc/m2/gm2-gcc/m2except.cc
new file mode 100644
index 00000000000..bc0f3a99076
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2except.cc
@@ -0,0 +1,623 @@
+/* m2except.cc implements the construction of exception trees.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../m2-tree.h"
+
+#define GM2
+#define GM2_BUG_REPORT                                                        \
+  "Please report this crash to the GNU Modula-2 mailing list "                \
+  "<gm2@nongnu.org>\n"
+
+/* External functions.  */
+
+#define m2except_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2statement.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+
+/* Local prototypes.  */
+
+#include "m2except.h"
+
+static tree build_exc_ptr (location_t location);
+static tree do_begin_catch (location_t location);
+static tree do_end_catch (location_t location);
+static tree begin_handler (location_t location);
+static void finish_handler (location_t location, tree handler);
+static tree finish_handler_parms (location_t location, tree handler);
+static void finish_handler_sequence (tree try_block);
+static tree begin_try_block (location_t location);
+static tree finish_expr_stmt (location_t location, tree expr);
+static tree maybe_cleanup_point_expr_void (tree expr);
+static tree build_target_expr_with_type (location_t location, tree init,
+                                         tree type);
+static tree get_target_expr (location_t location, tree init);
+static tree build_eh_type_type (location_t location, tree type);
+static tree get_tinfo_decl_m2 (location_t location);
+static tree eh_type_info (location_t location, tree type);
+static tree build_address (tree t);
+
+void _M2_gm2except_init (void);
+void _M2_gm2except_finally (void);
+
+/* Exception handling library functions.  */
+
+static GTY (()) tree fn_begin_catch_tree = NULL_TREE;
+static GTY (()) tree fn_end_catch_tree = NULL_TREE;
+static GTY (()) tree fn_throw_tree = NULL_TREE;
+static GTY (()) tree fn_rethrow_tree = NULL_TREE;
+static GTY (()) tree cleanup_type = NULL_TREE;
+static GTY (()) tree fn_allocate_exception_tree = NULL_TREE;
+static GTY (()) tree fn_free_exception_tree = NULL_TREE;
+static GTY (()) tree gm2_eh_int_type = NULL_TREE;
+
+/* Modula-2 linker fodder.  */
+
+void
+_M2_gm2except_init (void)
+{
+}
+void
+_M2_gm2except_finally (void)
+{
+}
+
+/* InitExceptions - initialize this module, it declares the external
+   functions and assigns them to the appropriate global tree
+   variables.  */
+
+void
+m2except_InitExceptions (location_t location)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+  m2block_pushGlobalScope ();
+  flag_exceptions = 1;
+  init_eh ();
+
+  m2decl_BuildStartFunctionDeclaration (FALSE);
+  fn_rethrow_tree = m2decl_BuildEndFunctionDeclaration (
+      location, location, "__cxa_rethrow", void_type_node, TRUE, FALSE, TRUE);
+  TREE_NOTHROW (fn_rethrow_tree) = 0;
+
+  m2decl_BuildStartFunctionDeclaration (FALSE);
+  m2decl_BuildParameterDeclaration (location, NULL, ptr_type_node, FALSE);
+  fn_begin_catch_tree = m2decl_BuildEndFunctionDeclaration (
+      location, location, "__cxa_begin_catch", ptr_type_node, TRUE, FALSE,
+      TRUE);
+  m2decl_BuildStartFunctionDeclaration (FALSE);
+  fn_end_catch_tree = m2decl_BuildEndFunctionDeclaration (
+      location, location, "__cxa_end_catch", void_type_node, TRUE, FALSE,
+      TRUE);
+  /* This can throw if the destructor for the exception throws.  */
+  TREE_NOTHROW (fn_end_catch_tree) = 0;
+
+  /* The CLEANUP_TYPE is the internal type of a destructor.  */
+  t = void_list_node;
+  t = tree_cons (NULL_TREE, ptr_type_node, t);
+  t = build_function_type (void_type_node, t);
+  cleanup_type = build_pointer_type (t);
+
+  /* Declare void __cxa_throw (void*, void*, void (*)(void*)).  */
+  m2decl_BuildStartFunctionDeclaration (FALSE);
+  m2decl_BuildParameterDeclaration (location, NULL, cleanup_type, FALSE);
+  m2decl_BuildParameterDeclaration (location, NULL, ptr_type_node, FALSE);
+  m2decl_BuildParameterDeclaration (location, NULL, ptr_type_node, FALSE);
+  fn_throw_tree = m2decl_BuildEndFunctionDeclaration (
+      location, location, "__cxa_throw", void_type_node, TRUE, FALSE, TRUE);
+
+  /* Declare void __cxa_rethrow (void).  */
+  m2decl_BuildStartFunctionDeclaration (FALSE);
+  fn_rethrow_tree = m2decl_BuildEndFunctionDeclaration (
+      location, location, "__cxa_rethrow", void_type_node, TRUE, FALSE, TRUE);
+
+  /* Declare void *__cxa_allocate_exception (size_t).  */
+  m2decl_BuildStartFunctionDeclaration (FALSE);
+  m2decl_BuildParameterDeclaration (location, NULL, size_type_node, FALSE);
+  fn_allocate_exception_tree = m2decl_BuildEndFunctionDeclaration (
+      location, location, "__cxa_allocate_exception", ptr_type_node, TRUE,
+      FALSE, TRUE);
+
+  /* Declare void *__cxa_free_exception (void *).  */
+  m2decl_BuildStartFunctionDeclaration (FALSE);
+  m2decl_BuildParameterDeclaration (location, NULL, ptr_type_node, FALSE);
+  fn_free_exception_tree = m2decl_BuildEndFunctionDeclaration (
+      location, location, "__cxa_free_exception", ptr_type_node, TRUE, FALSE,
+      TRUE);
+
+  /* Define integer type exception type which will match C++ int type
+     in the C++ runtime library.  */
+  gm2_eh_int_type = build_eh_type_type (location, integer_type_node);
+  m2block_popGlobalScope ();
+
+  MARK_TS_TYPED (TRY_BLOCK);
+  MARK_TS_TYPED (THROW_EXPR);
+  MARK_TS_TYPED (HANDLER);
+  MARK_TS_TYPED (EXPR_STMT);
+}
+
+/* do_call0 - return a tree containing: call builtin_function ().  */
+
+static tree
+do_call0 (location_t location, tree builtin_function)
+{
+  tree function = build_address (builtin_function);
+  tree fntype = TREE_TYPE (TREE_TYPE (function));
+  tree result_type = TREE_TYPE (fntype);
+
+  m2assert_AssertLocation (location);
+  return build_call_array_loc (location, result_type, function, 0, NULL);
+}
+
+/* do_call1 - return a tree containing: call builtin_function
+   (param1).  */
+
+static tree
+do_call1 (location_t location, tree builtin_function, tree param1)
+{
+  tree *argarray = XALLOCAVEC (tree, 1);
+  tree function = build_address (builtin_function);
+  tree fntype = TREE_TYPE (TREE_TYPE (function));
+  tree result_type = TREE_TYPE (fntype);
+
+  m2assert_AssertLocation (location);
+  argarray[0] = param1;
+  return build_call_array_loc (location, result_type, function, 1, argarray);
+}
+
+/* do_call3 - return a tree containing: call builtin_function
+   (param1, param2, param3).  */
+
+static tree
+do_call3 (location_t location, tree builtin_function, tree param1, tree param2,
+          tree param3)
+{
+  tree *argarray = XALLOCAVEC (tree, 3);
+  tree function = build_address (builtin_function);
+  tree fntype = TREE_TYPE (TREE_TYPE (function));
+  tree result_type = TREE_TYPE (fntype);
+
+  m2assert_AssertLocation (location);
+  argarray[0] = param1;
+  argarray[1] = param2;
+  argarray[2] = param3;
+  return build_call_array_loc (location, result_type, function, 3, argarray);
+}
+
+/* build_exc_ptr - creates the GCC internal type, pointer to
+   exception control block.  */
+
+static tree
+build_exc_ptr (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return do_call1 (location, builtin_decl_explicit (BUILT_IN_EH_POINTER),
+                   integer_zero_node);
+}
+
+static tree
+get_tinfo_decl_m2 (location_t location)
+{
+  tree t = build_decl (location, VAR_DECL, get_identifier ("_ZTIi"),
+                       ptr_type_node);
+
+  m2assert_AssertLocation (location);
+  TREE_STATIC (t) = 1;
+  DECL_EXTERNAL (t) = 1;
+  TREE_PUBLIC (t) = 1;
+  DECL_ARTIFICIAL (t) = 1;
+  DECL_IGNORED_P (t) = 1;
+  m2block_pushDecl (t);
+  make_decl_rtl (t);
+  return t;
+}
+
+/* Return the type info for TYPE as used by EH machinery.  */
+
+static tree
+eh_type_info (location_t location, tree type)
+{
+  m2assert_AssertLocation (location);
+  if (type == NULL_TREE || type == error_mark_node)
+    return type;
+
+  return get_tinfo_decl_m2 (location);
+}
+
+/* Return an ADDR_EXPR giving the address of T.  This function
+   attempts no optimizations or simplifications; it is a low-level
+   primitive.  */
+
+static tree
+build_address (tree t)
+{
+  tree addr = build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (t)), t);
+
+  return addr;
+}
+
+/* Build the address of a typeinfo decl for use in the runtime
+   matching field of the exception model.  */
+
+static tree
+build_eh_type_type (location_t location, tree type)
+{
+  tree exp = eh_type_info (location, type);
+
+  m2assert_AssertLocation (location);
+  if (!exp)
+    return NULL;
+
+  TREE_USED (exp) = 1;
+
+  return convert (ptr_type_node, build_address (exp));
+}
+
+/* Build a TARGET_EXPR, initializing the DECL with the VALUE.  */
+
+static tree
+build_target_expr (tree decl, tree value)
+{
+  tree t = build4 (TARGET_EXPR, TREE_TYPE (decl), decl, value, NULL_TREE,
+                   NULL_TREE);
+
+  /* We always set TREE_SIDE_EFFECTS so that expand_expr does not
+     ignore the TARGET_EXPR.  If there really turn out to be no
+     side-effects, then the optimizer should be able to get rid of
+     whatever code is generated anyhow.  */
+  TREE_SIDE_EFFECTS (t) = 1;
+
+  return t;
+}
+
+/* Return an undeclared local temporary of type TYPE for use in
+   building a TARGET_EXPR.  */
+
+static tree
+build_local_temp (location_t location, tree type)
+{
+  tree slot = build_decl (location, VAR_DECL, NULL_TREE, type);
+
+  m2assert_AssertLocation (location);
+  DECL_ARTIFICIAL (slot) = 1;
+  DECL_IGNORED_P (slot) = 1;
+  DECL_CONTEXT (slot) = current_function_decl;
+  layout_decl (slot, 0);
+  return slot;
+}
+
+/* Build a TARGET_EXPR using INIT to initialize a new temporary of
+   the indicated TYPE.  */
+
+static tree
+build_target_expr_with_type (location_t location, tree init, tree type)
+{
+  tree slot;
+
+  m2assert_AssertLocation (location);
+  gcc_assert (!VOID_TYPE_P (type));
+
+  if (TREE_CODE (init) == TARGET_EXPR)
+    return init;
+
+  slot = build_local_temp (location, type);
+  return build_target_expr (slot, init);
+}
+
+/* Like build_target_expr_with_type, but use the type of INIT.  */
+
+static tree
+get_target_expr (location_t location, tree init)
+{
+  m2assert_AssertLocation (location);
+  return build_target_expr_with_type (location, init, TREE_TYPE (init));
+}
+
+/* do_allocate_exception - returns a tree which calls
+   allocate_exception (sizeof (type)); */
+
+static tree
+do_allocate_exception (location_t location, tree type)
+{
+  return do_call1 (location, fn_allocate_exception_tree, size_in_bytes (type));
+}
+
+/* Call __cxa_free_exception from a cleanup.  This is never invoked
+   directly, but see the comment for stabilize_throw_expr.  */
+
+static tree
+do_free_exception (location_t location, tree ptr)
+{
+  return do_call1 (location, fn_free_exception_tree, ptr);
+}
+
+/* do_throw - returns tree for a call to throw (ptr, gm2_eh_int_type,
+   0).  */
+
+static tree
+do_throw (location_t location, tree ptr)
+{
+  return do_call3 (location, fn_throw_tree, ptr,
+                   unshare_expr (gm2_eh_int_type),
+                   build_int_cst (cleanup_type, 0));
+}
+
+/* do_rethrow - returns a tree containing the call to rethrow ().  */
+
+static tree
+do_rethrow (location_t location)
+{
+  return do_call0 (location, fn_rethrow_tree);
+}
+
+/* gm2_build_throw - build a GCC throw expression tree which looks
+   identical to the C++ front end.  */
+
+static tree
+gm2_build_throw (location_t location, tree exp)
+{
+  m2assert_AssertLocation (location);
+
+  if (exp == NULL_TREE)
+    /* Rethrow the current exception.  */
+    exp = build1 (THROW_EXPR, void_type_node, do_rethrow (location));
+  else
+    {
+      tree object, ptr;
+      tree allocate_expr;
+      tree tmp;
+
+      exp = m2expr_FoldAndStrip (
+          convert (m2type_GetIntegerType (), m2expr_FoldAndStrip (exp)));
+      exp = m2expr_GetIntegerOne (location);
+
+      /* Allocate the space for the exception.  */
+      allocate_expr = do_allocate_exception (location, TREE_TYPE (exp));
+      allocate_expr = get_target_expr (location, allocate_expr);
+      ptr = TARGET_EXPR_SLOT (allocate_expr);
+      TARGET_EXPR_CLEANUP (allocate_expr) = do_free_exception (location, ptr);
+      CLEANUP_EH_ONLY (allocate_expr) = 1;
+
+      object = build1 (NOP_EXPR, build_pointer_type (TREE_TYPE (exp)), ptr);
+      object = m2expr_BuildIndirect (location, object, TREE_TYPE (exp));
+
+      /* And initialize the exception object.  */
+      exp = build2 (INIT_EXPR, TREE_TYPE (object), object, exp);
+
+      /* Prepend the allocation.  */
+      exp = build2 (COMPOUND_EXPR, TREE_TYPE (exp), allocate_expr, exp);
+
+      /* Force all the cleanups to be evaluated here so that we don't have
+      to do them during unwinding.  */
+      exp = build1 (CLEANUP_POINT_EXPR, void_type_node, exp);
+
+      tmp = do_throw (location, ptr);
+
+      /* Tack on the initialization stuff.  */
+      exp = build2 (COMPOUND_EXPR, TREE_TYPE (tmp), exp, tmp);
+      exp = build1 (THROW_EXPR, void_type_node, exp);
+    }
+
+  SET_EXPR_LOCATION (exp, location);
+  return exp;
+}
+
+/* gccgm2_BuildThrow - builds a throw expression and return the tree.  */
+
+tree
+m2except_BuildThrow (location_t location, tree expr)
+{
+  return gm2_build_throw (location, expr);
+}
+
+/* Build up a call to __cxa_begin_catch, to tell the runtime that the
+   exception has been handled.  */
+
+static tree
+do_begin_catch (location_t location)
+{
+  return do_call1 (location, fn_begin_catch_tree, build_exc_ptr (location));
+}
+
+/* Build up a call to __cxa_end_catch, to destroy the exception
+   object for the current catch block if no others are currently using
+   it.  */
+
+static tree
+do_end_catch (location_t location)
+{
+  tree cleanup = do_call0 (location, fn_end_catch_tree);
+
+  m2assert_AssertLocation (location);
+  TREE_NOTHROW (cleanup) = 1;
+  return cleanup;
+}
+
+/* BuildTryBegin - returns a tree representing the 'try' block.  */
+
+tree
+m2except_BuildTryBegin (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return begin_try_block (location);
+}
+
+/* BuildTryEnd - builds the end of the Try block and prepares for the
+   catch handlers.  */
+
+void
+m2except_BuildTryEnd (tree try_block)
+{
+  TRY_STMTS (try_block) = m2block_pop_statement_list ();
+  TRY_HANDLERS (try_block) = m2block_begin_statement_list ();
+
+  /* Now ensure that all successive add_stmts adds to this statement
+     sequence.  */
+  m2block_push_statement_list (TRY_HANDLERS (try_block));
+}
+
+/* BuildCatchBegin - creates a handler tree for the C++ statement
+   'catch (...) {'.  It returns the handler tree.  */
+
+tree
+m2except_BuildCatchBegin (location_t location)
+{
+  tree handler = begin_handler (location);
+
+  m2assert_AssertLocation (location);
+  return finish_handler_parms (location, handler);
+}
+
+/* BuildCatchEnd - completes a try catch block.  It returns the,
+   try_block, tree.  It creates the C++ statement
+   '}' which matches the catch above.  */
+
+tree
+m2except_BuildCatchEnd (location_t location, tree handler, tree try_block)
+{
+  m2assert_AssertLocation (location);
+  finish_handler (location, handler);
+  finish_handler_sequence (try_block);
+  return try_block;
+}
+
+/* Begin a handler.  Returns a HANDLER if appropriate.  */
+
+static tree
+begin_handler (location_t location)
+{
+  tree r;
+
+  m2assert_AssertLocation (location);
+  r = build_stmt (location, HANDLER, NULL_TREE, NULL_TREE);
+  add_stmt (location, r);
+
+  HANDLER_BODY (r) = m2block_begin_statement_list ();
+
+  /* Now ensure that all successive add_stmts adds to this
+     statement sequence.  */
+  m2block_push_statement_list (HANDLER_BODY (r));
+  return r;
+}
+
+/* Finish a handler, which may be given by HANDLER.  The BLOCKs are
+   the return value from the matching call to finish_handler_parms.  */
+
+static void
+finish_handler (location_t location, tree handler)
+{
+  /* We might need to rethrow the exception if we reach the end.
+     use this code:  finish_expr_stmt (build_throw (NULL_TREE));  */
+  tree body = m2block_pop_statement_list ();
+
+  m2assert_AssertLocation (location);
+  HANDLER_BODY (handler) = body;
+  HANDLER_BODY (handler) = build2 (TRY_FINALLY_EXPR, void_type_node, body,
+                                   do_end_catch (location));
+}
+
+/* Finish the handler-parameters for a handler, which may be given by
+   HANDLER.  */
+
+static tree
+finish_handler_parms (location_t location, tree handler)
+{
+  m2assert_AssertLocation (location);
+  /* Equivalent to C++ catch (...).  */
+  finish_expr_stmt (location, do_begin_catch (location));
+
+  HANDLER_TYPE (handler) = NULL_TREE;
+  return handler;
+}
+
+/* Finish a handler-sequence for a try-block, which may be given by
+   TRY_BLOCK.  */
+
+static void
+finish_handler_sequence (tree try_block)
+{
+  TRY_HANDLERS (try_block) = m2block_pop_statement_list ();
+}
+
+/* Begin a try-block.  Returns a newly-created TRY_BLOCK if
+   appropriate.  */
+
+static tree
+begin_try_block (location_t location)
+{
+  tree r = build_stmt (location, TRY_BLOCK, NULL_TREE, NULL_TREE);
+
+  m2assert_AssertLocation (location);
+  TRY_STMTS (r) = m2block_begin_statement_list ();
+
+  /* Now ensure that all successive add_stmts adds to this statement
+     sequence.  */
+  m2block_push_statement_list (TRY_STMTS (r));
+  return r;
+}
+
+/* Finish an expression-statement, whose EXPRESSION is as indicated.  */
+
+static tree
+finish_expr_stmt (location_t location, tree expr)
+{
+  tree r = NULL_TREE;
+
+  m2assert_AssertLocation (location);
+  if (expr != NULL_TREE)
+    {
+      expr = build1 (CONVERT_EXPR, void_type_node, expr);
+
+      /* Simplification of inner statement expressions, compound exprs, etc
+         can result in us already having an EXPR_STMT.  */
+      if (TREE_CODE (expr) != CLEANUP_POINT_EXPR)
+        {
+          if (TREE_CODE (expr) != EXPR_STMT)
+            expr = build_stmt (location, EXPR_STMT, expr);
+          expr = maybe_cleanup_point_expr_void (expr);
+        }
+      r = add_stmt (location, expr);
+    }
+
+  return r;
+}
+
+/* Like maybe_cleanup_point_expr except have the type of the new
+   expression be void so we don't need to create a temporary variable to
+   hold the inner expression.  The reason why we do this is because the
+   original type might be an aggregate and we cannot create a temporary
+   variable for that type.  */
+
+static tree
+maybe_cleanup_point_expr_void (tree expr)
+{
+  return fold_build_cleanup_point_expr (void_type_node, expr);
+}
+
+#include "gt-m2-m2except.h"
diff --git a/gcc/m2/gm2-gcc/m2except.def b/gcc/m2/gm2-gcc/m2except.def
new file mode 100644
index 00000000000..c32d3811e60
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2except.def
@@ -0,0 +1,79 @@
+(* m2except.def provides an interface to build exception trees.
+
+Copyright (C) 2008-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2except ;
+
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+
+
+(*
+   InitExceptions - initialize this module, it declares the
+                    external functions and assigns them to
+                    the appropriate global tree variables.
+*)
+
+PROCEDURE InitExceptions (location: location_t) ;
+
+
+(*
+   BuildThrow - builds a throw statement and return the tree.
+*)
+
+PROCEDURE BuildThrow (location: location_t; t: Tree) : Tree ;
+
+
+(*
+    BuildTryBegin - returns a tree representing the 'try' block.
+*)
+
+PROCEDURE BuildTryBegin (location: location_t) : Tree ;
+
+
+(*
+   BuildTryEnd - builds the end of the Try block and prepares
+                 for the catch handlers.
+*)
+
+PROCEDURE BuildTryEnd (tryBlock: Tree) ;
+
+
+(*
+   BuildCatchBegin - creates a handler tree for the C++
+                     statement 'catch (...) {'.
+                     It returns the handler tree.
+*)
+
+PROCEDURE BuildCatchBegin (location: location_t) : Tree ;
+
+
+(*
+   BuildCatchEnd - completes a try catch block.
+                   It returns the, try_block, tree.
+                   It creates the C++ statement
+
+                   '}' which matches the catch above.
+*)
+
+PROCEDURE BuildCatchEnd (location: location_t; handler, tryBlock: Tree) : Tree ;
+
+
+END m2except.
diff --git a/gcc/m2/gm2-gcc/m2except.h b/gcc/m2/gm2-gcc/m2except.h
new file mode 100644
index 00000000000..c58d8623bf7
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2except.h
@@ -0,0 +1,70 @@
+/* m2except.h header file for m2except.cc.
+
+Copyright (C) 2012-2022 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(m2except_h)
+#define m2except_h
+#if defined(m2except_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2except_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2except_c.  */
+
+/* InitExceptions - initialize this module, it declares the external
+   functions and assigns them to the appropriate global tree
+   variables.  */
+
+EXTERN void m2except_InitExceptions (location_t location);
+
+/* BuildThrow - builds a throw statement and return the tree.  */
+
+EXTERN tree m2except_BuildThrow (location_t location, tree exp);
+
+/* BuildTryBegin - returns a tree representing the 'try' block.  */
+
+EXTERN tree m2except_BuildTryBegin (location_t location);
+
+/* BuildTryEnd - builds the end of the Try block and prepares for the
+   catch handlers.  */
+
+EXTERN void m2except_BuildTryEnd (tree tryBlock);
+
+/* BuildCatchBegin - creates a handler tree for the C++ statement
+   'catch (...) {'.  It returns the handler tree.  */
+
+EXTERN tree m2except_BuildCatchBegin (location_t location);
+
+/* BuildCatchEnd - completes a try catch block.  It returns the,
+   try_block, tree.  It creates the C++ statement
+
+'}' which matches the catch above.  */
+
+EXTERN tree m2except_BuildCatchEnd (location_t location, tree handler,
+                                    tree tryBlock);
+
+#endif  /* m2except_h.  */
diff --git a/gcc/m2/gm2-gcc/m2expr.cc b/gcc/m2/gm2-gcc/m2expr.cc
new file mode 100644
index 00000000000..4616835ba0d
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2expr.cc
@@ -0,0 +1,4286 @@
+/* m2expr.cc provides an interface to GCC expression trees.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+#include "m2convert.h"
+
+/* Prototypes.  */
+
+#define m2expr_c
+#include "m2assert.h"
+#include "m2builtins.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2options.h"
+#include "m2range.h"
+#include "m2statement.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+
+static void m2expr_checkRealOverflow (location_t location, enum tree_code code,
+                                      tree result);
+static tree checkWholeNegateOverflow (location_t location, tree i, tree lowest,
+                                      tree min, tree max);
+// static tree m2expr_Build4LogicalAnd (location_t location, tree a, tree b,
+// tree c, tree d);
+static tree m2expr_Build4LogicalOr (location_t location, tree a, tree b,
+                                    tree c, tree d);
+static tree m2expr_Build4TruthOrIf (location_t location, tree a, tree b,
+                                    tree c, tree d);
+static tree m2expr_Build4TruthAndIf (location_t location, tree a, tree b,
+                                     tree c, tree d);
+
+static int label_count = 0;
+static GTY (()) tree set_full_complement;
+
+/* CompareTrees returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2.  */
+
+int
+m2expr_CompareTrees (tree e1, tree e2)
+{
+  return tree_int_cst_compare (m2expr_FoldAndStrip (e1),
+                               m2expr_FoldAndStrip (e2));
+}
+
+/* FoldAndStrip return expression, t, after it has been folded (if
+   possible).  */
+
+tree
+m2expr_FoldAndStrip (tree t)
+{
+  if (t != NULL)
+    {
+      t = fold (t);
+      if (TREE_CODE (t) == CONST_DECL)
+        return m2expr_FoldAndStrip (DECL_INITIAL (t));
+    }
+
+  return t;
+}
+
+/* StringLength returns an unsigned int which is the length of, string.  */
+
+unsigned int
+m2expr_StringLength (tree string)
+{
+  return TREE_STRING_LENGTH (string);
+}
+
+/* CheckAddressToCardinal if op is a pointer convert it to the ADDRESS type.  */
+
+static tree
+CheckAddressToCardinal (location_t location, tree op)
+{
+  if (m2type_IsAddress (TREE_TYPE (op)))
+    return m2convert_BuildConvert (location, m2type_GetCardinalAddressType (),
+                                   op, FALSE);
+  return op;
+}
+
+/* BuildTruthAndIf return TRUE if a && b.  Retain order left to right.  */
+
+static tree
+m2expr_BuildTruthAndIf (location_t location, tree a, tree b)
+{
+  return m2expr_build_binary_op (location, TRUTH_ANDIF_EXPR, a, b, FALSE);
+}
+
+/* BuildTruthOrIf return TRUE if a || b.  Retain order left to right.  */
+
+static tree
+m2expr_BuildTruthOrIf (location_t location, tree a, tree b)
+{
+  return m2expr_build_binary_op (location, TRUTH_ORIF_EXPR, a, b, FALSE);
+}
+
+/* BuildTruthNotIf inverts the boolean value of expr and returns the result.  */
+
+static tree
+m2expr_BuildTruthNot (location_t location, tree expr)
+{
+  return m2expr_build_unary_op (location, TRUTH_NOT_EXPR, expr, FALSE);
+}
+
+/* BuildPostInc builds a post increment tree, the second operand is
+   always one.  */
+
+static tree
+m2expr_BuildPostInc (location_t location, tree op)
+{
+  return m2expr_BuildAdd (location, op, build_int_cst (TREE_TYPE (op), 1), FALSE);
+}
+
+/* BuildPostDec builds a post decrement tree, the second operand is
+   always one.  */
+
+static tree
+m2expr_BuildPostDec (location_t location, tree op)
+{
+  return m2expr_BuildSub (location, op, build_int_cst (TREE_TYPE (op), 1), FALSE);
+}
+
+/* BuildAddCheck builds an addition tree.  */
+
+tree
+m2expr_BuildAddCheck (location_t location, tree op1, tree op2, tree lowest,
+                      tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, PLUS_EXPR, op1, op2, FALSE,
+                                    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildAdd builds an addition tree.  */
+
+tree
+m2expr_BuildAdd (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op (location, PLUS_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildSubCheck builds a subtraction tree.  */
+
+tree
+m2expr_BuildSubCheck (location_t location, tree op1, tree op2, tree lowest,
+                      tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, MINUS_EXPR, op1, op2, FALSE,
+                                    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildSub builds a subtraction tree.  */
+
+tree
+m2expr_BuildSub (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op (location, MINUS_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildDivTrunc builds a trunc division tree.  */
+
+tree
+m2expr_BuildDivTrunc (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op (location, TRUNC_DIV_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildDivTruncCheck builds a trunc division tree.  */
+
+tree
+m2expr_BuildDivTruncCheck (location_t location, tree op1, tree op2, tree lowest,
+			   tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, TRUNC_DIV_EXPR, op1, op2, FALSE,
+				    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildModTruncCheck builds a trunc modulus tree.  */
+
+tree
+m2expr_BuildModTruncCheck (location_t location, tree op1, tree op2, tree lowest,
+			   tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, TRUNC_MOD_EXPR, op1, op2, FALSE,
+				    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildModTrunc builds a trunc modulus tree.  */
+
+tree
+m2expr_BuildModTrunc (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op (location, TRUNC_MOD_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildModCeilCheck builds a ceil modulus tree.  */
+
+tree
+m2expr_BuildModCeilCheck (location_t location, tree op1, tree op2, tree lowest,
+			  tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, CEIL_MOD_EXPR, op1, op2, FALSE,
+				    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildModFloorCheck builds a trunc modulus tree.  */
+
+tree
+m2expr_BuildModFloorCheck (location_t location, tree op1, tree op2, tree lowest,
+			   tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, FLOOR_MOD_EXPR, op1, op2, FALSE,
+				    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildDivCeil builds a ceil division tree.  */
+
+tree
+m2expr_BuildDivCeil (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op (location, CEIL_DIV_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildDivCeilCheck builds a check ceil division tree.  */
+
+tree
+m2expr_BuildDivCeilCheck (location_t location, tree op1, tree op2, tree lowest,
+			  tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, CEIL_DIV_EXPR, op1, op2, FALSE,
+				    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildModCeil builds a ceil modulus tree.  */
+
+tree
+m2expr_BuildModCeil (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op (location, CEIL_MOD_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildDivFloor builds a floor division tree.  */
+
+tree
+m2expr_BuildDivFloor (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op (location, FLOOR_DIV_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildDivFloorCheck builds a check floor division tree.  */
+
+tree
+m2expr_BuildDivFloorCheck (location_t location, tree op1, tree op2, tree lowest,
+			   tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, FLOOR_DIV_EXPR, op1, op2, FALSE,
+				    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildRDiv builds a division tree (this should only be used for
+   REAL and COMPLEX types and NEVER for integer based types).  */
+
+tree
+m2expr_BuildRDiv (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  t = m2expr_build_binary_op (location, RDIV_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildModFloor builds a modulus tree.  */
+
+tree
+m2expr_BuildModFloor (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op (location, FLOOR_MOD_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildLSL builds and returns tree (op1 << op2).  */
+
+tree
+m2expr_BuildLSL (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  t = m2expr_build_binary_op (location, LSHIFT_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildLSR builds and returns tree (op1 >> op2).  */
+
+tree
+m2expr_BuildLSR (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  t = m2expr_build_binary_op (location, RSHIFT_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* createUniqueLabel returns a unique label which has been alloc'ed.  */
+
+static char *
+createUniqueLabel (void)
+{
+  int size, i;
+  char *label;
+
+  label_count++;
+  i = label_count;
+  size = strlen (".LSHIFT") + 2;
+  while (i > 0)
+    {
+      i /= 10;
+      size++;
+    }
+  label = (char *)ggc_alloc_atomic (size);
+  sprintf (label, ".LSHIFT%d", label_count);
+  return label;
+}
+
+/* BuildLogicalShift builds the ISO Modula-2 SHIFT operator for a
+   fundamental data type.  */
+
+void
+m2expr_BuildLogicalShift (location_t location, tree op1, tree op2, tree op3,
+                          tree nBits ATTRIBUTE_UNUSED, int needconvert)
+{
+  tree res;
+
+  m2assert_AssertLocation (location);
+  op2 = m2expr_FoldAndStrip (op2);
+  op3 = m2expr_FoldAndStrip (op3);
+  if (TREE_CODE (op3) == INTEGER_CST)
+    {
+      op2 = m2convert_ToWord (location, op2);
+      if (tree_int_cst_sgn (op3) < 0)
+        res = m2expr_BuildLSR (
+            location, op2,
+            m2convert_ToWord (location,
+                              m2expr_BuildNegate (location, op3, needconvert)),
+            needconvert);
+      else
+        res = m2expr_BuildLSL (location, op2, m2convert_ToWord (location, op3),
+                               needconvert);
+      res = m2convert_BuildConvert (
+          location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, FALSE);
+      m2statement_BuildAssignmentTree (location, op1, res);
+    }
+  else
+    {
+      char *labelElseName = createUniqueLabel ();
+      char *labelEndName = createUniqueLabel ();
+      tree is_less = m2expr_BuildLessThan (location,
+                                           m2convert_ToInteger (location, op3),
+                                           m2expr_GetIntegerZero (location));
+
+      m2statement_DoJump (location, is_less, NULL, labelElseName);
+      op2 = m2convert_ToWord (location, op2);
+      op3 = m2convert_ToWord (location, op3);
+      res = m2expr_BuildLSL (location, op2, op3, needconvert);
+      res = m2convert_BuildConvert (
+          location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, FALSE);
+      m2statement_BuildAssignmentTree (location, op1, res);
+      m2statement_BuildGoto (location, labelEndName);
+      m2statement_DeclareLabel (location, labelElseName);
+      res = m2expr_BuildLSR (location, op2,
+                             m2expr_BuildNegate (location, op3, needconvert),
+                             needconvert);
+      res = m2convert_BuildConvert (
+          location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, FALSE);
+      m2statement_BuildAssignmentTree (location, op1, res);
+      m2statement_DeclareLabel (location, labelEndName);
+    }
+}
+
+/* BuildLRL builds and returns tree (op1 rotate left by op2 bits).  */
+
+tree
+m2expr_BuildLRL (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  t = m2expr_build_binary_op (location, LROTATE_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildLRR builds and returns tree (op1 rotate right by op2 bits).  */
+
+tree
+m2expr_BuildLRR (location_t location, tree op1, tree op2, int needconvert)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  t = m2expr_build_binary_op (location, RROTATE_EXPR, op1, op2, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* m2expr_BuildMask returns a tree for the mask of a set of nBits.
+   It assumes nBits is <= TSIZE (WORD).  */
+
+tree
+m2expr_BuildMask (location_t location, tree nBits, int needconvert)
+{
+  tree mask = m2expr_BuildLSL (location, m2expr_GetIntegerOne (location),
+                               nBits, needconvert);
+  m2assert_AssertLocation (location);
+  return m2expr_BuildSub (location, mask, m2expr_GetIntegerOne (location),
+                          needconvert);
+}
+
+/* m2expr_BuildLRotate returns a tree in which op1 has been left
+   rotated by nBits.  It assumes nBits is <= TSIZE (WORD).  */
+
+tree
+m2expr_BuildLRotate (location_t location, tree op1, tree nBits,
+                     int needconvert)
+{
+  tree t;
+
+  op1 = m2expr_FoldAndStrip (op1);
+  nBits = m2expr_FoldAndStrip (nBits);
+  t = m2expr_build_binary_op (location, LROTATE_EXPR, op1, nBits, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* m2expr_BuildRRotate returns a tree in which op1 has been left
+   rotated by nBits.  It assumes nBits is <= TSIZE (WORD).  */
+
+tree
+m2expr_BuildRRotate (location_t location, tree op1, tree nBits,
+                     int needconvert)
+{
+  tree t;
+
+  op1 = m2expr_FoldAndStrip (op1);
+  nBits = m2expr_FoldAndStrip (nBits);
+  t = m2expr_build_binary_op (location, RROTATE_EXPR, op1, nBits, needconvert);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildLRLn builds and returns tree (op1 rotate left by op2 bits) it
+   rotates a set of size, nBits.  */
+
+tree
+m2expr_BuildLRLn (location_t location, tree op1, tree op2, tree nBits,
+                  int needconvert)
+{
+  tree op2min;
+
+  m2assert_AssertLocation (location);
+
+  /* Ensure we wrap the rotate.  */
+
+  op2min = m2expr_BuildModTrunc (
+      location, m2convert_ToCardinal (location, op2),
+      m2convert_ToCardinal (location, nBits), needconvert);
+
+  /* Optimize if we are we going to rotate a TSIZE(BITSET) set.  */
+
+  if (m2expr_CompareTrees (
+          m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits)
+      == 0)
+    return m2expr_BuildLRotate (location, op1, op2min, needconvert);
+  else
+    {
+      tree mask = m2expr_BuildMask (location, nBits, needconvert);
+      tree left, right;
+
+      /* Make absolutely sure there are no high order bits lying around.  */
+
+      op1 = m2expr_BuildLogicalAnd (location, op1, mask, needconvert);
+      left = m2expr_BuildLSL (location, op1, op2min, needconvert);
+      left = m2expr_BuildLogicalAnd (location, left, mask, needconvert);
+      right = m2expr_BuildLSR (
+          location, op1,
+          m2expr_BuildSub (location, m2convert_ToCardinal (location, nBits),
+                           op2min, needconvert),
+          needconvert);
+      return m2expr_BuildLogicalOr (location, left, right, needconvert);
+    }
+}
+
+/* BuildLRRn builds and returns tree (op1 rotate right by op2 bits).
+   It rotates a set of size, nBits.  */
+
+tree
+m2expr_BuildLRRn (location_t location, tree op1, tree op2, tree nBits,
+                  int needconvert)
+{
+  tree op2min;
+
+  m2assert_AssertLocation (location);
+
+  /* Ensure we wrap the rotate.  */
+
+  op2min = m2expr_BuildModTrunc (
+      location, m2convert_ToCardinal (location, op2),
+      m2convert_ToCardinal (location, nBits), needconvert);
+  /* Optimize if we are we going to rotate a TSIZE(BITSET) set.  */
+
+  if (m2expr_CompareTrees (
+          m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits)
+      == 0)
+    return m2expr_BuildRRotate (location, op1, op2min, needconvert);
+  else
+    {
+      tree mask = m2expr_BuildMask (location, nBits, needconvert);
+      tree left, right;
+
+      /* Make absolutely sure there are no high order bits lying around.  */
+
+      op1 = m2expr_BuildLogicalAnd (location, op1, mask, needconvert);
+      right = m2expr_BuildLSR (location, op1, op2min, needconvert);
+      left = m2expr_BuildLSL (
+          location, op1,
+          m2expr_BuildSub (location, m2convert_ToCardinal (location, nBits),
+                           op2min, needconvert),
+          needconvert);
+      left = m2expr_BuildLogicalAnd (location, left, mask, needconvert);
+      return m2expr_BuildLogicalOr (location, left, right, needconvert);
+    }
+}
+
+/* BuildLogicalRotate build the ISO Modula-2 ROTATE operator for a
+   fundamental data type.  */
+
+void
+m2expr_BuildLogicalRotate (location_t location, tree op1, tree op2, tree op3,
+                           tree nBits, int needconvert)
+{
+  tree res;
+
+  m2assert_AssertLocation (location);
+  op2 = m2expr_FoldAndStrip (op2);
+  op3 = m2expr_FoldAndStrip (op3);
+  if (TREE_CODE (op3) == INTEGER_CST)
+    {
+      if (tree_int_cst_sgn (op3) < 0)
+        res = m2expr_BuildLRRn (
+            location, op2, m2expr_BuildNegate (location, op3, needconvert),
+            nBits, needconvert);
+      else
+        res = m2expr_BuildLRLn (location, op2, op3, nBits, needconvert);
+      m2statement_BuildAssignmentTree (location, op1, res);
+    }
+  else
+    {
+      char *labelElseName = createUniqueLabel ();
+      char *labelEndName = createUniqueLabel ();
+      tree is_less = m2expr_BuildLessThan (location,
+                                           m2convert_ToInteger (location, op3),
+                                           m2expr_GetIntegerZero (location));
+
+      m2statement_DoJump (location, is_less, NULL, labelElseName);
+      res = m2expr_BuildLRLn (location, op2, op3, nBits, needconvert);
+      m2statement_BuildAssignmentTree (location, op1, res);
+      m2statement_BuildGoto (location, labelEndName);
+      m2statement_DeclareLabel (location, labelElseName);
+      res = m2expr_BuildLRRn (location, op2,
+                              m2expr_BuildNegate (location, op3, needconvert),
+                              nBits, needconvert);
+      m2statement_BuildAssignmentTree (location, op1, res);
+      m2statement_DeclareLabel (location, labelEndName);
+    }
+}
+
+/* buildUnboundedArrayOf construct an unbounded struct and returns
+   the gcc tree.  The two fields of the structure are initialized to
+   contentsPtr and high.  */
+
+static tree
+buildUnboundedArrayOf (tree unbounded, tree contentsPtr, tree high)
+{
+  tree fields = TYPE_FIELDS (unbounded);
+  tree field_list = NULL_TREE;
+  tree constructor;
+
+  field_list = tree_cons (fields, contentsPtr, field_list);
+  fields = TREE_CHAIN (fields);
+
+  field_list = tree_cons (fields, high, field_list);
+
+  constructor = build_constructor_from_list (unbounded, nreverse (field_list));
+  TREE_CONSTANT (constructor) = 0;
+  TREE_STATIC (constructor) = 0;
+
+  return constructor;
+}
+
+/* BuildBinarySetDo if the size of the set is <= TSIZE(WORD) then op1
+   := binop(op2, op3) else call m2rtsprocedure(op1, op2, op3).  */
+
+void
+m2expr_BuildBinarySetDo (location_t location, tree settype, tree op1, tree op2,
+                         tree op3, void (*binop) (location_t, tree, tree, tree,
+                                                  tree, int),
+                         int is_op1lvalue, int is_op2lvalue, int is_op3lvalue,
+                         tree nBits, tree unbounded, tree varproc,
+                         tree leftproc, tree rightproc)
+{
+  tree size = m2expr_GetSizeOf (location, settype);
+  int is_const = FALSE;
+  int is_left = FALSE;
+
+  m2assert_AssertLocation (location);
+
+  ASSERT_BOOL (is_op1lvalue);
+  ASSERT_BOOL (is_op2lvalue);
+  ASSERT_BOOL (is_op3lvalue);
+
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    (*binop) (location,
+              m2treelib_get_rvalue (location, op1, settype, is_op1lvalue),
+              m2treelib_get_rvalue (location, op2, settype, is_op2lvalue),
+              m2treelib_get_rvalue (location, op3, settype, is_op3lvalue),
+              nBits, FALSE);
+  else
+    {
+      tree result;
+      tree high = m2expr_BuildSub (
+          location,
+          m2convert_ToCardinal (
+              location,
+              m2expr_BuildDivTrunc (
+                  location, size,
+                  m2expr_GetSizeOf (location, m2type_GetBitsetType ()),
+                  FALSE)),
+          m2expr_GetCardinalOne (location), FALSE);
+
+      /* If op3 is constant then make op3 positive and remember which
+      direction we are shifting.  */
+
+      op3 = m2tree_skip_const_decl (op3);
+      if (TREE_CODE (op3) == INTEGER_CST)
+        {
+          is_const = TRUE;
+          if (tree_int_cst_sgn (op3) < 0)
+            op3 = m2expr_BuildNegate (location, op3, FALSE);
+          else
+            is_left = TRUE;
+          op3 = m2convert_BuildConvert (location, m2type_GetM2CardinalType (),
+                                        op3, FALSE);
+        }
+
+      /* These parameters must match the prototypes of the procedures:
+	 ShiftLeft, ShiftRight, ShiftVal, RotateLeft, RotateRight, RotateVal
+	 inside gm2-iso/SYSTEM.mod.  */
+
+      /* Remember we must build the parameters in reverse.  */
+
+      /* Parameter 4 amount.  */
+      m2statement_BuildParam (
+          location,
+          m2convert_BuildConvert (
+              location, m2type_GetM2IntegerType (),
+              m2treelib_get_rvalue (location, op3,
+                                    m2tree_skip_type_decl (TREE_TYPE (op3)),
+                                    is_op3lvalue),
+              FALSE));
+
+      /* Parameter 3 nBits.  */
+      m2statement_BuildParam (
+          location,
+          m2convert_BuildConvert (location, m2type_GetM2CardinalType (),
+                                  m2expr_FoldAndStrip (nBits), FALSE));
+
+      /* Parameter 2 destination set.  */
+      m2statement_BuildParam (
+          location,
+          buildUnboundedArrayOf (
+              unbounded,
+              m2treelib_get_set_address (location, op1, is_op1lvalue), high));
+
+      /* Parameter 1 source set.  */
+      m2statement_BuildParam (
+          location,
+          buildUnboundedArrayOf (
+              unbounded,
+              m2treelib_get_set_address (location, op2, is_op2lvalue), high));
+
+      /* Now call the appropriate procedure inside SYSTEM.mod.  */
+      if (is_const)
+        if (is_left)
+          result = m2statement_BuildProcedureCallTree (location, leftproc,
+                                                       NULL_TREE);
+        else
+          result = m2statement_BuildProcedureCallTree (location, rightproc,
+                                                       NULL_TREE);
+      else
+        result = m2statement_BuildProcedureCallTree (location, varproc,
+                                                     NULL_TREE);
+      add_stmt (location, result);
+    }
+}
+
+/* Print a warning if a constant expression had overflow in folding.
+   Invoke this function on every expression that the language requires
+   to be a constant expression.  */
+
+void
+m2expr_ConstantExpressionWarning (tree value)
+{
+  if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST
+       || TREE_CODE (value) == FIXED_CST || TREE_CODE (value) == VECTOR_CST
+       || TREE_CODE (value) == COMPLEX_CST)
+      && TREE_OVERFLOW (value))
+    pedwarn (input_location, OPT_Woverflow, "overflow in constant expression");
+}
+
+/* TreeOverflow return TRUE if the contant expression, t, has caused
+   an overflow.  No error message or warning is emitted and no
+   modification is made to, t.  */
+
+int
+m2expr_TreeOverflow (tree t)
+{
+  if ((TREE_CODE (t) == INTEGER_CST
+       || (TREE_CODE (t) == COMPLEX_CST
+           && TREE_CODE (TREE_REALPART (t)) == INTEGER_CST))
+      && TREE_OVERFLOW (t))
+    return TRUE;
+  else if ((TREE_CODE (t) == REAL_CST
+            || (TREE_CODE (t) == COMPLEX_CST
+                && TREE_CODE (TREE_REALPART (t)) == REAL_CST))
+           && TREE_OVERFLOW (t))
+    return TRUE;
+  else
+    return FALSE;
+}
+
+/* RemoveOverflow if tree, t, is a constant expression it removes any
+   overflow flag and returns, t.  */
+
+tree
+m2expr_RemoveOverflow (tree t)
+{
+  if (TREE_CODE (t) == INTEGER_CST
+      || (TREE_CODE (t) == COMPLEX_CST
+          && TREE_CODE (TREE_REALPART (t)) == INTEGER_CST))
+    TREE_OVERFLOW (t) = 0;
+  else if (TREE_CODE (t) == REAL_CST
+           || (TREE_CODE (t) == COMPLEX_CST
+               && TREE_CODE (TREE_REALPART (t)) == REAL_CST))
+    TREE_OVERFLOW (t) = 0;
+  return t;
+}
+
+/* BuildCoerce return a tree containing the expression, expr, after
+   it has been coersed to, type.  */
+
+tree
+m2expr_BuildCoerce (location_t location, tree des, tree type, tree expr)
+{
+  tree copy = copy_node (expr);
+  TREE_TYPE (copy) = type;
+
+  m2assert_AssertLocation (location);
+
+  return m2treelib_build_modify_expr (location, des, NOP_EXPR, copy);
+}
+
+/* BuildTrunc return an integer expression from a REAL or LONGREAL op1.  */
+
+tree
+m2expr_BuildTrunc (tree op1)
+{
+  return convert_to_integer (m2type_GetIntegerType (),
+                             m2expr_FoldAndStrip (op1));
+}
+
+/* checkUnaryWholeOverflow decide if we can check this unary expression.  */
+
+tree
+m2expr_checkUnaryWholeOverflow (location_t location, enum tree_code code,
+                                tree arg, tree lowest, tree min, tree max)
+{
+  if (M2Options_GetWholeValueCheck () && (min != NULL))
+    {
+      lowest = m2tree_skip_type_decl (lowest);
+      arg = fold_convert_loc (location, lowest, arg);
+
+      switch (code)
+        {
+        case NEGATE_EXPR:
+          return checkWholeNegateOverflow (location, arg, lowest, min, max);
+        default:
+	  return NULL;
+        }
+    }
+  return NULL;
+}
+
+/* build_unary_op return a unary tree node.  */
+
+tree
+m2expr_build_unary_op_check (location_t location, enum tree_code code,
+                             tree arg, tree lowest, tree min, tree max)
+{
+  tree argtype = TREE_TYPE (arg);
+  tree result;
+  tree check = NULL;
+
+  m2assert_AssertLocation (location);
+
+  arg = m2expr_FoldAndStrip (arg);
+
+  if ((TREE_CODE (argtype) != REAL_TYPE) && (min != NULL))
+    check = m2expr_checkUnaryWholeOverflow (location, code, arg, lowest, min, max);
+
+  result = build1 (code, argtype, arg);
+  protected_set_expr_location (result, location);
+
+  if (check != NULL)
+    result = build2 (COMPOUND_EXPR, argtype, check, result);
+
+  if (TREE_CODE (argtype) == REAL_TYPE)
+    m2expr_checkRealOverflow (location, code, result);
+
+  return m2expr_FoldAndStrip (result);
+}
+
+/* build_unary_op return a unary tree node.  */
+
+tree
+m2expr_build_unary_op (location_t location, enum tree_code code, tree arg,
+                       int flag ATTRIBUTE_UNUSED)
+{
+  tree argtype = TREE_TYPE (arg);
+  tree result;
+
+  m2assert_AssertLocation (location);
+
+  arg = m2expr_FoldAndStrip (arg);
+  result = build1 (code, argtype, arg);
+  protected_set_expr_location (result, location);
+
+  return m2expr_FoldAndStrip (result);
+}
+
+/* build_binary_op is a heavily pruned version of the one found in
+   c-typeck.cc.  The Modula-2 expression rules are much more restricted
+   than C.  */
+
+tree
+build_binary_op (location_t location, enum tree_code code, tree op1, tree op2,
+                 int convert ATTRIBUTE_UNUSED)
+{
+  tree type1 = TREE_TYPE (op1);
+  tree result;
+
+  m2assert_AssertLocation (location);
+
+  /* Strip NON_LVALUE_EXPRs, etc., since we aren't using as an lvalue.  */
+  STRIP_TYPE_NOPS (op1);
+  STRIP_TYPE_NOPS (op2);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  result = build2 (code, type1, op1, op2);
+  protected_set_expr_location (result, location);
+
+  return m2expr_FoldAndStrip (result);
+}
+
+/* BuildLessThanZero - returns a tree containing (< value 0).  It
+   checks the min and max value to ensure that the test can be safely
+   achieved and will short circuit the result otherwise.  */
+
+tree
+m2expr_BuildLessThanZero (location_t location, tree value, tree type, tree min,
+                          tree max)
+{
+  if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) >= 0)
+    /* min is greater than or equal to zero therefore value will always
+       be >= 0.  */
+    return m2expr_GetIntegerZero (location);
+  else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) == -1)
+    /* max is less than zero therefore value will always be < 0.  */
+    return m2expr_GetIntegerOne (location);
+  /* We now know 0 lies in the range min..max so we can safely cast
+     zero to type.  */
+  return m2expr_BuildLessThan (
+      location, value,
+      fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
+}
+
+/* BuildGreaterThanZero - returns a tree containing (> value 0).  It
+   checks the min and max value to ensure that the test can be safely
+   achieved and will short circuit the result otherwise.  */
+
+tree
+m2expr_BuildGreaterThanZero (location_t location, tree value, tree type,
+                             tree min, tree max)
+{
+  if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
+    /* min is greater than zero therefore value will always be > 0.  */
+    return m2expr_GetIntegerOne (location);
+  else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) <= 0)
+    /* max is less than or equal to zero therefore value will always be
+       <= 0.  */
+    return m2expr_GetIntegerZero (location);
+  /* We now know 0 lies in the range min..max so we can safely cast
+     zero to type.  */
+  return m2expr_BuildGreaterThan (
+      location, value,
+      fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
+}
+
+/* BuildEqualToZero - returns a tree containing (= value 0).  It
+   checks the min and max value to ensure that the test can be safely
+   achieved and will short circuit the result otherwise.  */
+
+tree
+m2expr_BuildEqualToZero (location_t location, tree value, tree type, tree min,
+                         tree max)
+{
+  if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
+    /* min is greater than zero therefore value will always be > 0.  */
+    return m2expr_GetIntegerZero (location);
+  else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
+    /* max is less than or equal to zero therefore value will always be <
+       0.  */
+    return m2expr_GetIntegerZero (location);
+  /* We now know 0 lies in the range min..max so we can safely cast
+     zero to type.  */
+  return m2expr_BuildEqualTo (
+      location, value,
+      fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
+}
+
+/* BuildNotEqualToZero - returns a tree containing (# value 0).  It
+   checks the min and max value to ensure that the test can be safely
+   achieved and will short circuit the result otherwise.  */
+
+tree
+m2expr_BuildNotEqualToZero (location_t location, tree value, tree type,
+                            tree min, tree max)
+{
+  if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
+    /* min is greater than zero therefore value will always be true.  */
+    return m2expr_GetIntegerOne (location);
+  else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
+    /* max is less than or equal to zero therefore value will always be
+       true.  */
+    return m2expr_GetIntegerOne (location);
+  /* We now know 0 lies in the range min..max so we can safely cast
+     zero to type.  */
+  return m2expr_BuildNotEqualTo (
+      location, value,
+      fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
+}
+
+
+/* BuildGreaterThanOrEqualZero - returns a tree containing (>= value 0).  It
+   checks the min and max value to ensure that the test can be safely
+   achieved and will short circuit the result otherwise.  */
+
+tree
+m2expr_BuildGreaterThanOrEqualZero (location_t location, tree value, tree type,
+				    tree min, tree max)
+{
+  if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) >= 0)
+    /* min is greater than or equal to zero therefore value will always be >= 0.  */
+    return m2expr_GetIntegerOne (location);
+  else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
+    /* max is less than zero therefore value will always be < 0.  */
+    return m2expr_GetIntegerZero (location);
+  /* We now know 0 lies in the range min..max so we can safely cast
+     zero to type.  */
+  return m2expr_BuildGreaterThan (
+      location, value,
+      fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
+}
+
+
+/* BuildLessThanOrEqualZero - returns a tree containing (<= value 0).  It
+   checks the min and max value to ensure that the test can be safely
+   achieved and will short circuit the result otherwise.  */
+
+tree
+m2expr_BuildLessThanOrEqualZero (location_t location, tree value, tree type,
+				 tree min, tree max)
+{
+  if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) > 0)
+    /* min is greater than zero therefore value will always be > 0.  */
+    return m2expr_GetIntegerZero (location);
+  else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) <= 0)
+    /* max is less than or equal to zero therefore value will always be <= 0.  */
+    return m2expr_GetIntegerOne (location);
+  /* We now know 0 lies in the range min..max so we can safely cast
+     zero to type.  */
+  return m2expr_BuildLessThanOrEqual (
+      location, value,
+      fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
+}
+
+
+/* get_current_function_name, return the name of the current function if
+   it currently exists.  NULL is returned if we are not inside a function.  */
+
+static const char *
+get_current_function_name (void)
+{
+  if (current_function_decl != NULL
+      && (DECL_NAME (current_function_decl) != NULL)
+      && (IDENTIFIER_POINTER (DECL_NAME (current_function_decl)) != NULL))
+    return IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
+  return NULL;
+}
+
+/* checkWholeNegateOverflow - check to see whether -arg will overflow
+   an integer.
+
+PROCEDURE sneg (i: INTEGER) ;
+BEGIN
+   IF i = MIN(INTEGER)
+   THEN
+      'integer overflow'
+   END
+END sneg ;
+
+general purpose subrange type, i, is currently legal, min is
+   MIN(type) and max is MAX(type).
+
+PROCEDURE sneg (i: type) ;
+BEGIN
+   max := MAX (type) ;
+   min := MIN (type) ;
+   (* cannot overflow if i is 0 *)
+   IF (i#0) AND
+     (* will overflow if entire range is positive.  *)
+     ((min >= 0) OR
+      (* will overflow if entire range is negative.  *)
+      (max <= 0) OR
+      (* c7 and c8 and c9 and c10 -> c17 more units positive.  *)
+      ((min < 0) AND (max > 0) AND ((min + max) > 0) AND (i > -min)) OR
+      (* c11 and c12 and c13 and c14 -> c18 more units negative.  *)
+      ((min < 0) AND (max > 0) AND ((min + max) < 0) AND (i < -max)))
+   THEN
+      'type overflow'
+   END
+END sneg ; */
+
+static tree
+checkWholeNegateOverflow (location_t location,
+			  tree i, tree type, tree min,
+                          tree max)
+{
+  tree a1
+      = m2expr_BuildNotEqualToZero (location, i, type, min, max); /* i # 0.  */
+  tree c1 = m2expr_BuildGreaterThanZero (location, min, type, min,
+                                         max); /* min > 0.  */
+  tree c2 = m2expr_BuildEqualToZero (location, min, type, min,
+                                     max); /* min == 0.  */
+  tree c4 = m2expr_BuildLessThanZero (location, max, type, min,
+                                      max); /* max < 0.  */
+  tree c5 = m2expr_BuildEqualToZero (location, max, type, min,
+                                     max); /* max == 0.  */
+  tree c7 = m2expr_BuildLessThanZero (location, min, type, min,
+                                      max); /* min < 0.  */
+  tree c8 = m2expr_BuildGreaterThanZero (location, max, type, min,
+                                         max); /* max > 0.  */
+  tree c9 = m2expr_BuildGreaterThanZero (
+      location, m2expr_BuildAdd (location, min, max, FALSE), type, min,
+      max); /* min + max > 0.  */
+  tree c10 = m2expr_BuildGreaterThan (
+      location, i, m2expr_BuildNegate (location, min, FALSE)); /* i > -min.  */
+  tree c11 = m2expr_BuildLessThanZero (
+      location, m2expr_BuildAdd (location, min, max, FALSE), type, min,
+      max); /* min + max < 0.  */
+  tree c12 = m2expr_BuildLessThan (
+      location, i, m2expr_BuildNegate (location, max, FALSE)); /* i < -max.  */
+
+  tree b1 = m2expr_BuildTruthOrIf (location, c1, c2);
+  tree b2 = m2expr_BuildTruthOrIf (location, c8, c5);
+  tree o1 = m2expr_BuildTruthAndIf (location, b1, b2);
+
+  tree b3 = m2expr_BuildTruthOrIf (location, c7, c2);
+  tree b4 = m2expr_BuildTruthOrIf (location, c4, c5);
+  tree o2 = m2expr_BuildTruthAndIf (location, b3, b4);
+
+  tree o3 = m2expr_Build4TruthAndIf (location, c7, c8, c9, c10);
+  tree o4 = m2expr_Build4TruthAndIf (location, c7, c8, c11, c12);
+
+  tree a2 = m2expr_Build4TruthOrIf (location, o1, o2, o3, o4);
+  tree condition
+      = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, a1, a2));
+
+  tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value unary minus will cause range overflow");
+  return t;
+}
+
+/* checkWholeAddOverflow - check to see whether op1 + op2 will
+   overflow an integer.
+
+PROCEDURE sadd (i, j: INTEGER) ;
+BEGIN
+   IF ((j>0) AND (i > MAX(INTEGER)-j)) OR ((j<0) AND (i < MIN(INTEGER)-j))
+   THEN
+      'signed addition overflow'
+   END
+END sadd.  */
+
+static tree
+checkWholeAddOverflow (location_t location, tree i, tree j, tree lowest,
+                       tree min, tree max)
+{
+  tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
+  tree i_gt_max_sub_j = m2expr_BuildGreaterThan (
+      location, i, m2expr_BuildSub (location, max, j, FALSE));
+  tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
+  tree i_lt_min_sub_j = m2expr_BuildLessThan (location, i,
+					      m2expr_BuildSub (location, min, j, FALSE));
+  tree lhs_or = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, j_gt_zero, i_gt_max_sub_j));
+  tree rhs_or = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, j_lt_zero, i_lt_min_sub_j));
+  tree condition
+      = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, lhs_or, rhs_or));
+  tree result = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value addition will cause a range overflow");
+  return result;
+}
+
+/* checkWholeSubOverflow - check to see whether op1 - op2 will
+   overflow an integer.
+
+PROCEDURE ssub (i, j: INTEGER) ;
+BEGIN
+   IF ((j>0) AND (i < MIN(INTEGER)+j)) OR ((j<0) AND (i > MAX(INTEGER)+j))
+   THEN
+      'signed subtraction overflow'
+   END
+END ssub.  */
+
+static tree
+checkWholeSubOverflow (location_t location, tree i, tree j, tree lowest,
+                       tree min, tree max)
+{
+  tree c1 = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
+  tree c2 = m2expr_BuildLessThan (location, i,
+                                  m2expr_BuildAdd (location, min, j, FALSE));
+  tree c3 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
+  tree c4 = m2expr_BuildGreaterThan (location, i,
+				     m2expr_BuildAdd (location, max, j, FALSE));
+  tree c5 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, c1, c2));
+  tree c6 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, c3, c4));
+  tree condition
+      = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, c5, c6));
+  tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value subtraction will cause a range overflow");
+  return t;
+}
+
+/* Build4TruthAndIf - return TRUE if a && b && c && d.  Retain order left to
+ * right.  */
+
+static tree
+m2expr_Build4TruthAndIf (location_t location, tree a, tree b, tree c, tree d)
+{
+  tree t1 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, a, b));
+  tree t2 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t1, c));
+  return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t2, d));
+}
+
+/* Build3TruthAndIf - return TRUE if a && b && c.  Retain order left to right.
+ */
+
+static tree
+m2expr_Build3TruthAndIf (location_t location, tree op1, tree op2, tree op3)
+{
+  tree t = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, op1, op2));
+  return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t, op3));
+}
+
+/* Build3TruthOrIf - return TRUE if a || b || c.  Retain order left to right.
+ */
+
+static tree
+m2expr_Build3TruthOrIf (location_t location, tree op1, tree op2, tree op3)
+{
+  tree t = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, op1, op2));
+  return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t, op3));
+}
+
+/* Build4TruthOrIf - return TRUE if op1 || op2 || op3 || op4.  Retain order
+   left to right.  */
+
+static tree
+m2expr_Build4TruthOrIf (location_t location, tree op1, tree op2, tree op3,
+                        tree op4)
+{
+  tree t1 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, op1, op2));
+  tree t2 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t1, op3));
+  return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t2, op4));
+}
+
+/* Build4LogicalOr - return TRUE if op1 || op2 || op3 || op4.  */
+
+static tree
+m2expr_Build4LogicalOr (location_t location, tree op1, tree op2, tree op3,
+                        tree op4)
+{
+  tree t1 = m2expr_FoldAndStrip (
+      m2expr_BuildLogicalOr (location, op1, op2, FALSE));
+  tree t2
+      = m2expr_FoldAndStrip (m2expr_BuildLogicalOr (location, t1, op3, FALSE));
+  return m2expr_FoldAndStrip (
+      m2expr_BuildLogicalOr (location, t2, op4, FALSE));
+}
+
+/* checkWholeMultOverflow - check to see whether i * j will overflow
+   an integer.
+
+PROCEDURE smult (lhs, rhs: INTEGER) ;
+BEGIN
+   IF ((lhs > 0) AND (rhs > 0) AND (lhs > max DIV rhs)) OR
+      ((lhs > 0) AND (rhs < 0) AND (rhs < min DIV lhs)) OR
+      ((lhs < 0) AND (rhs > 0) AND (lhs < min DIV rhs)) OR
+      ((lhs < 0) AND (rhs < 0) AND (lhs < max DIV rhs))
+   THEN
+      error ('signed multiplication overflow')
+   END
+END smult ;
+
+ if ((c1 && c3 && c4)
+   || (c1 && c5 && c6)
+   || (c2 && c3 && c7)
+   || (c2 && c5 && c8))
+   error ('signed subtraction overflow').  */
+
+static tree
+testWholeMultOverflow (location_t location, tree lhs, tree rhs,
+		       tree lowest, tree min, tree max)
+{
+  tree c1 = m2expr_BuildGreaterThanZero (location, lhs, lowest, min, max);
+  tree c2 = m2expr_BuildLessThanZero (location, lhs, lowest, min, max);
+
+  tree c3 = m2expr_BuildGreaterThanZero (location, rhs, lowest, min, max);
+  tree c4 = m2expr_BuildGreaterThan (
+      location, lhs, m2expr_BuildDivTrunc (location, max, rhs, FALSE));
+
+  tree c5 = m2expr_BuildLessThanZero (location, rhs, lowest, min, max);
+  tree c6 = m2expr_BuildLessThan (
+      location, rhs, m2expr_BuildDivTrunc (location, min, lhs, FALSE));
+  tree c7 = m2expr_BuildLessThan (
+      location, lhs, m2expr_BuildDivTrunc (location, min, rhs, FALSE));
+  tree c8 = m2expr_BuildLessThan (
+      location, lhs, m2expr_BuildDivTrunc (location, max, rhs, FALSE));
+
+  tree c9 = m2expr_Build3TruthAndIf (location, c1, c3, c4);
+  tree c10 = m2expr_Build3TruthAndIf (location, c1, c5, c6);
+  tree c11 = m2expr_Build3TruthAndIf (location, c2, c3, c7);
+  tree c12 = m2expr_Build3TruthAndIf (location, c2, c5, c8);
+
+  tree condition = m2expr_Build4LogicalOr (location, c9, c10, c11, c12);
+  return condition;
+}
+
+
+static tree
+checkWholeMultOverflow (location_t location, tree i, tree j, tree lowest,
+                        tree min, tree max)
+{
+  tree condition = testWholeMultOverflow (location, i, j, lowest, min, max);
+  tree result = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+						    get_current_function_name (),
+               "whole value multiplication will cause a range overflow");
+  return result;
+}
+
+
+static tree
+divMinUnderflow (location_t location, tree value, tree lowest, tree min, tree max)
+{
+  tree min2 = m2expr_BuildMult (location, min, min, FALSE);
+  tree rhs = m2expr_BuildGreaterThanOrEqual (location, value, min2);
+  tree lhs = testWholeMultOverflow (location, min, min, lowest, min, max);
+  return m2expr_BuildTruthAndIf (location, lhs, rhs);
+}
+
+/*
+   divexpr - returns true if a DIV_TRUNC b will overflow.
+ */
+
+/* checkWholeDivOverflow - check to see whether i DIV_TRUNC j will overflow
+   an integer.  The Modula-2 implementation of the GCC trees follows:
+
+PROCEDURE divtruncexpr (a, b: INTEGER) : BOOLEAN ;
+BEGIN
+   (* Firstly catch division by 0.  *)
+   RETURN ((b = 0) OR
+           (* Case 2 range is always negative.  *)
+           (* In which case a division will be illegal as result will be positive.  *)
+           (max < 0) OR
+           (* Case 1 both min / max are positive, check for underflow.  *)
+           ((min >= 0) AND (max >= 0) AND (multMinOverflow (b) OR (a < b * min))) OR
+           (* Case 1 both min / max are positive, check for overflow.  *)
+           ((min >= 0) AND (max >= 0) AND (divMinUnderflow (a) OR (b > a DIV min))) OR
+           (* Case 3 mixed range, need to check underflow.  *)
+           ((min < 0) AND (max >= 0) AND (a < 0) AND (b < 0) AND (b >= a DIV min)) OR
+           ((min < 0) AND (max >= 0) AND (a < 0) AND (b > 0) AND (b <= a DIV max)) OR
+           ((min < 0) AND (max >= 0) AND (a >= 0) AND (b < 0) AND (a DIV b < min)))
+END divtruncexpr ;
+
+s1 -> a DIV min
+s2 -> a DIV max
+s3 -> a DIV b
+
+b4 -> (min >= 0) AND (max >= 0)
+b5 -> (min < 0) AND (max >= 0)
+a_lt_b_mult_min -> (a < b * min)
+b_mult_min_overflow -> testWholeMultOverflow (location, b, min, lowest, min, max)
+b6 -> (b_mult_min_overflow OR a_lt_b_mult_min)
+b_gt_s1 -> (b > s1)
+a_div_min_overflow -> divMinUnderflow (location, a, min, lowest, min, max)
+b7 -> (a_div_min_overflow OR b_gt_s1)
+b8 -> (a < 0)
+b9 -> (b < 0)
+b10 -> (b > 0)
+b11 -> (b >= s1)
+b12 -> (b <= s2)
+b13 -> (s3 < min)
+b14 -> a >= 0
+
+c1 -> (b = 0)
+c2 -> (max < 0)
+c3 -> (b4 AND b6)
+c4 -> (b4 AND b7)
+c5 -> (b5 AND b8 AND b9 AND b11)
+c6 -> (b5 AND b8 AND b10 AND b12)
+c7 -> (b5 AND b14 AND b9 AND b13)
+
+ if (c1 || c2 || c3 || c4 || c5 || c6 || c7)
+   error ('signed div trunc overflow').  */
+
+static tree
+checkWholeDivTruncOverflow (location_t location, tree i, tree j, tree lowest,
+			    tree min, tree max)
+{
+  tree b4a = m2expr_BuildGreaterThanOrEqualZero (location, min, lowest, min, max);
+  tree b4b = m2expr_BuildGreaterThanOrEqualZero (location, max, lowest, min, max);
+  tree b4 = m2expr_BuildTruthAndIf (location, b4a, b4b);
+  tree b5a = m2expr_BuildLessThanZero (location, min, lowest, min, max);
+  tree b5 = m2expr_BuildTruthAndIf (location, b5a, b4b);
+  tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
+  tree c2 = m2expr_BuildLessThanZero (location, max, lowest, min, max);
+  tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, m2expr_BuildMult (location, j, min, FALSE));
+  tree j_mult_min_overflow = testWholeMultOverflow (location, j, min, lowest, min, max);
+  tree b6 = m2expr_BuildTruthOrIf (location, j_mult_min_overflow, i_lt_j_mult_min);
+  tree c3 = m2expr_BuildTruthAndIf (location, b4, b6);
+  tree s1 = m2expr_BuildDivTrunc (location, i, min, FALSE);
+  tree s2 = m2expr_BuildDivTrunc (location, i, max, FALSE);
+  tree s3 = m2expr_BuildDivTrunc (location, i, j, FALSE);
+
+  tree j_gt_s1 = m2expr_BuildGreaterThan (location, j, s1);
+  tree i_div_min_overflow = divMinUnderflow (location, i, lowest, min, max);
+  tree b7 = m2expr_BuildTruthOrIf (location, i_div_min_overflow, j_gt_s1);
+  tree c4 = m2expr_BuildTruthAndIf (location, b4, b7);
+  tree b8 = m2expr_BuildLessThanZero (location, i, lowest, min, max);
+  tree b9 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
+  tree b10 = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
+  tree b11 = m2expr_BuildGreaterThanOrEqual (location, j, s1);
+  tree b12 = m2expr_BuildLessThanOrEqual (location, j, s2);
+  tree b13 = m2expr_BuildLessThan (location, s3, min);
+  tree b14 = m2expr_BuildGreaterThanOrEqualZero (location, i, lowest, min, max);
+  tree c5 = m2expr_Build4TruthAndIf (location, b5, b8, b9, b11);
+  tree c6 = m2expr_Build4TruthAndIf (location, b5, b8, b10, b12);
+  tree c7 = m2expr_Build4TruthAndIf (location, b5, b14, b9, b13);
+  tree c8 = m2expr_Build4TruthOrIf (location, c1, c2, c3, c4);
+  tree condition = m2expr_Build4TruthOrIf (location, c5, c6, c7, c8);
+  tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value truncated division will cause a range overflow");
+  return t;
+}
+
+#if 0
+(*
+   divexpr - returns true if a DIV_CEIL b will overflow.
+ *)
+
+(* checkWholeDivCeilOverflow - check to see whether i DIV_CEIL j will overflow
+   an integer.  *)
+
+PROCEDURE divceilexpr (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN ((j = 0) OR     (* division by zero.  *)
+           (maxT < 0) OR  (* both inputs are < 0 and max is < 0,
+                             therefore error.  *)
+           ((i # 0) AND   (* first operand is legally zero,
+                             result is also legally zero.  *)
+            divCeilOverflowCases (i, j)))
+END divceilexpr ;
+
+
+(*
+   divCeilOverflowCases - precondition:  i, j are in range values.
+                          postcondition:  TRUE is returned if i divceil will
+                                          result in an overflow/underflow.
+*)
+
+PROCEDURE divCeilOverflowCases (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
+           ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
+           ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
+           ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
+END divCeilOverflowCases ;
+
+
+(*
+   divCeilOverflowPosPos - precondition:  i, j are legal and are both >= 0.
+                           postcondition:  TRUE is returned if i divceil will
+                                           result in an overflow/underflow.
+*)
+
+PROCEDURE divCeilOverflowPosPos (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN (((i MOD j = 0) AND (i < j * minT)) OR
+           (((i MOD j # 0) AND (i < j * minT + 1))))
+END divCeilOverflowPosPos ;
+
+
+(*
+   divCeilOverflowNegNeg - precondition:  i, j are in range values and both < 0.
+                           postcondition:  TRUE is returned if i divceil will
+                                           result in an overflow/underflow.
+*)
+
+PROCEDURE divCeilOverflowNegNeg (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN ((maxT <= 0) OR           (* signs will cause overflow.  *)
+           (* check for underflow.  *)
+           ((ABS (i) MOD ABS (j) = 0) AND (i >= j * minT)) OR
+           ((ABS (i) MOD ABS (j) # 0) AND (i >= j * minT - 1)) OR
+           (* check for overflow.  *)
+           (((ABS (i) MOD maxT) = 0) AND (ABS (i) DIV maxT > ABS (j))) OR
+           (((ABS (i) MOD maxT) # 0) AND (ABS (i) DIV maxT > ABS (j) + 1)))
+END divCeilOverflowNegNeg ;
+
+
+(*
+   divCeilOverflowNegPos - precondition:  i, j are in range values.  i < 0, j >= 0.
+                           postcondition:  TRUE is returned if i divceil will
+                                           result in an overflow/underflow.
+*)
+
+PROCEDURE divCeilOverflowNegPos (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   (* easier than might be initially expected.  We know minT < 0 and maxT > 0.
+      We know the result will be negative and therefore we only need to test
+      against minT.  *)
+   RETURN (((ABS (i) MOD j = 0) AND (i < j * minT)) OR
+           ((ABS (i) MOD j # 0) AND (i < j * minT - 1)))
+END divCeilOverflowNegPos ;
+
+
+(*
+   divCeilOverflowPosNeg - precondition:  i, j are in range values.  i >= 0, j < 0.
+                           postcondition:  TRUE is returned if i divceil will
+                                           result in an overflow/underflow.
+*)
+
+PROCEDURE divCeilOverflowPosNeg (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   (* easier than might be initially expected.  We know minT < 0 and maxT > 0.
+      We know the result will be negative and therefore we only need to test
+      against minT.  *)
+   RETURN (((i MOD ABS (j) = 0) AND (i > j * minT)) OR
+           ((i MOD ABS (j) # 0) AND (i > j * minT - 1)))
+END divCeilOverflowPosNeg ;
+#endif
+
+/* divCeilOverflowPosPos, precondition:  lhs, rhs are legal and are both >= 0.
+   Postcondition:  TRUE is returned if lhs divceil rhs will result
+   in an overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN (((lhs MOD rhs = 0) AND (min >= 0) AND (lhs < rhs * min)) OR       (* check for underflow, no remainder.   *)
+                                                  lhs_lt_rhs_mult_min
+           (((lhs MOD rhs # 0) AND (lhs < rhs * min + 1))))   (* check for underflow with remainder.  *)
+                                   ((lhs > min) AND (lhs - 1 > rhs * min))
+                                                  lhs_gt_rhs_mult_min
+
+   a -> (lhs MOD rhs = 0) AND (lhs < rhs * min)
+   b -> (lhs MOD rhs # 0) AND (lhs < rhs * min + 1)
+   RETURN a OR b.  */
+
+static tree
+divCeilOverflowPosPos (location_t location, tree i, tree j, tree lowest,
+		       tree min, tree max)
+{
+  tree i_mod_j = m2expr_BuildModTrunc (location, i, j, FALSE);
+  tree i_mod_j_eq_zero = m2expr_BuildEqualToZero (location, i_mod_j, lowest, min, max);
+  tree i_mod_j_ne_zero = m2expr_BuildNotEqualToZero (location, i_mod_j, lowest, min, max);
+  tree j_min = m2expr_BuildMult (location, j, min, FALSE);
+  tree j_min_1 = m2expr_BuildAdd (location, j_min, m2expr_GetIntegerOne (location), FALSE);
+  tree i_lt_j_min = m2expr_BuildLessThan (location, i, j_min);
+  tree i_lt_j_min_1 = m2expr_BuildLessThan (location, i, j_min_1);
+  tree a = m2expr_BuildTruthAndIf (location, i_mod_j_eq_zero, i_lt_j_min);
+  tree b = m2expr_BuildTruthAndIf (location, i_mod_j_ne_zero, i_lt_j_min_1);
+  return m2expr_BuildTruthOrIf (location, a, b);
+}
+
+
+/* divCeilOverflowPosNeg precondition:  i, j are in range values and i >=0, j < 0.
+   Postcondition:  TRUE is returned if i divceil j will result in an
+   overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN (((i MOD ABS (j) = 0) AND (i > j * min)) OR
+           ((i MOD ABS (j) # 0) AND (i > j * min - 1)))
+
+   abs_j -> (ABS (j))
+   i_mod_abs_j -> (i MOD abs_j)
+   i_mod_abs_j_eq_0 -> (i_mod_abs_j = 0)
+   i_mod_abs_j_ne_0 -> (i_mod_abs_j # 0)
+   j_mult_min -> (j * min)
+   j_mult_min_1 -> (j_mult_min - 1)
+   i_gt_j_mult_min -> (i > j_mult_min)
+   i_gt_j_mult_min_1 -> (i > j_mult_min_1)
+   a -> (i_mod_abs_j_eq_0 AND i_gt_j_mult_min)
+   b -> (i_mod_abs_j_ne_0 AND i_gt_j_mult_min_1)
+   c -> (a OR b).  */
+
+static tree
+divCeilOverflowPosNeg (location_t location, tree i, tree j, tree lowest, tree min, tree max)
+{
+  tree abs_j = m2expr_BuildAbs (location, j);
+  tree i_mod_abs_j = m2expr_BuildModFloor (location, i, abs_j, FALSE);
+  tree i_mod_abs_j_eq_0 = m2expr_BuildEqualToZero (location, i_mod_abs_j, lowest, min, max);
+  tree i_mod_abs_j_ne_0 = m2expr_BuildNotEqualToZero (location, i_mod_abs_j, lowest, min, max);
+  tree j_mult_min = m2expr_BuildMult (location, j, min, FALSE);
+  tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
+  tree i_gt_j_mult_min = m2expr_BuildGreaterThan (location, i, j_mult_min);
+  tree i_gt_j_mult_min_1 = m2expr_BuildGreaterThan (location, i, j_mult_min_1);
+  tree a = m2expr_BuildTruthAndIf (location, i_mod_abs_j_eq_0, i_gt_j_mult_min);
+  tree b = m2expr_BuildTruthAndIf (location, i_mod_abs_j_ne_0, i_gt_j_mult_min_1);
+  tree c = m2expr_BuildTruthOrIf (location, a, b);
+  return c;
+}
+
+
+/* divCeilOverflowNegPos precondition:  i, j are in range values and i < 0, j >= 0.
+   Postcondition:  TRUE is returned if i divceil j will result in an
+   overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN (((ABS (i) MOD j = 0) AND (i < j * min)) OR
+           ((ABS (i) MOD j # 0) AND (i < j * min - 1)))
+
+   abs_i -> (ABS (i))
+   abs_i_mod_j -> (abs_i MOD j)
+   abs_i_mod_j_eq_0 -> (abs_i_mod_j = 0)
+   abs_i_mod_j_ne_0 -> (abs_i_mod_j # 0)
+   j_mult_min -> (j * min)
+   j_mult_min_1 -> (j_mult_min - 1)
+   i_lt_j_mult_min -> (i < j_mult_min)
+   i_lt_j_mult_min_1 -> (i < j_mult_min_1)
+   a = (abs_i_mod_j_eq_0 AND i_lt_j_mult_min)
+   b = (abs_i_mod_j_ne_0 AND i_lt_j_mult_min_1)
+   c -> (a OR b).  */
+
+static tree
+divCeilOverflowNegPos (location_t location, tree i, tree j, tree lowest, tree min, tree max)
+{
+  tree abs_i = m2expr_BuildAbs (location, i);
+  tree abs_i_mod_j = m2expr_BuildModFloor (location, abs_i, j, FALSE);
+  tree abs_i_mod_j_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_j, lowest, min, max);
+  tree abs_i_mod_j_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_j, lowest, min, max);
+  tree j_mult_min = m2expr_BuildMult (location, j, min, FALSE);
+  tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
+  tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
+  tree i_lt_j_mult_min_1 = m2expr_BuildLessThan (location, i, j_mult_min_1);
+  tree a = m2expr_BuildTruthAndIf (location, abs_i_mod_j_eq_0, i_lt_j_mult_min);
+  tree b = m2expr_BuildTruthAndIf (location, abs_i_mod_j_ne_0, i_lt_j_mult_min_1);
+  tree c = m2expr_BuildTruthOrIf (location, a, b);
+  return c;
+}
+
+
+/* divCeilOverflowNegNeg precondition:  i, j are in range values and both < 0.
+   Postcondition:  TRUE is returned if i divceil j will result in an
+   overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN ((max <= 0) OR           (* signs will cause overflow.  *)
+           (* check for underflow.  *)
+           ((ABS (i) MOD ABS (j) = 0) AND (i >= j * min)) OR
+           ((ABS (i) MOD ABS (j) # 0) AND (i >= j * min - 1)) OR
+           (* check for overflow.  *)
+           (((ABS (i) MOD max) = 0) AND (ABS (i) DIV max > ABS (j))) OR
+           (((ABS (i) MOD max) # 0) AND (ABS (i) DIV max > ABS (j) + 1)))
+
+  max_lte_0 -> (max <= 0)
+  abs_i -> (ABS (i))
+  abs_j -> (ABS (j))
+  abs_i_mod_abs_j -> (abs_i MOD abs_j)
+  abs_i_mod_abs_j_eq_0 -> (abs_i_mod_abs_j = 0)
+  abs_i_mod_abs_j_ne_0 -> (abs_i_mod_abs_j # 0)
+  j_mult_min -> (j * min)
+  j_mult_min_1 -> (j_mult_min - 1)
+  i_ge_j_mult_min -> (i >= j_mult_min)
+  i_ge_j_mult_min_1 -> (i >= j_mult_min_1)
+  abs_i_mod_max -> (abs_i mod max)
+  abs_i_div_max -> (abs_i DIVfloor max)
+  abs_j_1 -> (abs_j + 1)
+  abs_i_mod_max_eq_0 -> (abs_i_mod_max = 0)
+  abs_i_mod_max_ne_0 -> (abs_i_mod_max # 0)
+  abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
+  abs_i_div_max_gt_abs_j_1 -> (abs_i_div_max > abs_j_1)
+
+  a -> (abs_i_mod_abs_j_eq_0 AND i_ge_j_mult_min)
+  b -> (abs_i_mod_abs_j_ne_0 AND i_ge_j_mult_min_1)
+  c -> (abs_i_mod_max_eq_0 AND abs_i_div_max_gt_abs_j)
+  d -> (abs_i_mod_max_ne_0 AND abs_i_div_max_gt_abs_j_1)
+  e -> (a OR b OR c OR d)
+  return max_lte_0 OR e.  */
+
+static tree
+divCeilOverflowNegNeg (location_t location, tree i, tree j, tree lowest,
+		       tree min, tree max)
+{
+  tree max_lte_0 = m2expr_BuildLessThanOrEqualZero (location, max, lowest, min, max);
+  tree abs_i = m2expr_BuildAbs (location, i);
+  tree abs_j = m2expr_BuildAbs (location, j);
+  tree abs_i_mod_abs_j = m2expr_BuildModFloor (location, abs_i, abs_j, FALSE);
+  tree abs_i_mod_abs_j_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_abs_j,
+						       lowest, min, max);
+  tree abs_i_mod_abs_j_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_abs_j,
+							  lowest, min, max);
+  tree j_mult_min = m2expr_BuildMult (location, j, min, FALSE);
+  tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
+  tree i_ge_j_mult_min = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min);
+  tree i_ge_j_mult_min_1 = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min_1);
+  tree abs_i_mod_max = m2expr_BuildModFloor (location, abs_i, max, FALSE);
+  tree abs_i_div_max = m2expr_BuildDivFloor (location, abs_i, max, FALSE);
+  tree abs_j_1 = m2expr_BuildPostInc (location, abs_j);
+  tree abs_i_mod_max_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_max, lowest, min, max);
+  tree abs_i_mod_max_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_max, lowest, min, max);
+  tree abs_i_div_max_gt_abs_j = m2expr_BuildGreaterThan (location,  abs_i_div_max, abs_j);
+  tree abs_i_div_max_gt_abs_j_1 = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j_1);
+
+  tree a = m2expr_BuildTruthAndIf (location, abs_i_mod_abs_j_eq_0, i_ge_j_mult_min);
+  tree b = m2expr_BuildTruthAndIf (location, abs_i_mod_abs_j_ne_0, i_ge_j_mult_min_1);
+  tree c = m2expr_BuildTruthAndIf (location, abs_i_mod_max_eq_0, abs_i_div_max_gt_abs_j);
+  tree d = m2expr_BuildTruthAndIf (location, abs_i_mod_max_ne_0, abs_i_div_max_gt_abs_j_1);
+  tree e = m2expr_Build4TruthOrIf (location, a, b, c, d);
+  return m2expr_BuildTruthOrIf (location, max_lte_0, e);
+}
+
+
+/* divCeilOverflowCases, precondition:  i, j are in range values.
+   Postcondition:  TRUE is returned if i divceil will result in an
+   overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
+           ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
+           ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
+           ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
+
+   a -> ((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j))
+   b -> ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j))
+   c -> ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j))
+   d -> ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j))
+
+   RETURN a AND b AND c AND d.  */
+
+static tree
+divCeilOverflowCases (location_t location, tree i, tree j, tree lowest,
+		      tree min, tree max)
+{
+  tree i_gt_zero = m2expr_BuildGreaterThanZero (location, i, lowest, min, max);
+  tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
+  tree i_lt_zero = m2expr_BuildLessThanZero (location, i, lowest, min, max);
+  tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
+  tree a = m2expr_Build3TruthAndIf (location, i_gt_zero, j_gt_zero,
+				    divCeilOverflowPosPos (location, i, j, lowest, min, max));
+  tree b = m2expr_Build3TruthAndIf (location, i_lt_zero, j_lt_zero,
+				    divCeilOverflowNegNeg (location, i, j, lowest, min, max));
+  tree c = m2expr_Build3TruthAndIf (location, i_gt_zero, j_lt_zero,
+				    divCeilOverflowPosNeg (location, i, j, lowest, min, max));
+  tree d = m2expr_Build3TruthAndIf (location, i_lt_zero, j_gt_zero,
+				    divCeilOverflowNegPos (location, i, j, lowest, min, max));
+  return m2expr_Build4TruthOrIf (location, a, b, c, d);
+}
+
+
+/* checkWholeDivCeilOverflow check to see whether i DIV_CEIL j will overflow
+   an integer.  A handbuilt expression of trees implementing:
+
+   RETURN ((j = 0) OR     (* division by zero.  *)
+           (maxT < 0) OR  (* both inputs are < 0 and max is < 0,
+                             therefore error.  *)
+           ((i # 0) AND   (* first operand is legally zero,
+                             result is also legally zero.  *)
+            divCeilOverflowCases (i, j)))
+
+   using the following subexpressions:
+
+   j_eq_zero -> (j == 0)
+   max_lt_zero -> (max < 0)
+   i_ne_zero -> (i # 0).  */
+
+static tree
+checkWholeDivCeilOverflow (location_t location, tree i, tree j, tree lowest,
+			   tree min, tree max)
+{
+  tree j_eq_zero = m2expr_BuildEqualToZero (location, j, lowest, min, max);
+  tree max_lt_zero = m2expr_BuildLessThanZero (location, max, lowest, min, max);
+  tree i_ne_zero = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
+  tree j_lt_zero;
+  tree rhs = m2expr_BuildTruthAndIf (location,
+				     i_ne_zero,
+				     divCeilOverflowCases (location,
+							   i, j, lowest, min, max));
+
+  if (M2Options_GetISO ())
+    j_lt_zero = m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location, j, lowest, min, max));
+  else
+    j_lt_zero = m2expr_GetIntegerZero (location);
+  j_eq_zero = m2expr_FoldAndStrip (j_eq_zero);
+  max_lt_zero = m2expr_FoldAndStrip (max_lt_zero);
+  i_ne_zero = m2expr_FoldAndStrip (i_ne_zero);
+  rhs = m2expr_FoldAndStrip (rhs);
+
+  tree condition = m2expr_Build4TruthOrIf (location, j_eq_zero, max_lt_zero, rhs, j_lt_zero);
+  tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value ceil division will cause a range overflow");
+  return t;
+}
+
+
+/* checkWholeModTruncOverflow, the GCC tree.def defines TRUNC_MOD_EXPR to return
+   the remainder which has the same sign as the dividend.  In ISO Modula-2 the
+   divisor must never be negative (or zero).  The pseudo code for implementing these
+   checks is given below:
+
+   IF j = 0
+   THEN
+      RETURN TRUE   (* division by zero.  *)
+   ELSIF j < 0
+   THEN
+      RETURN TRUE   (* modulus and division by negative (rhs) not allowed in ISO Modula-2.  *)
+   ELSIF i = 0
+   THEN
+      RETURN FALSE  (* must be legal as result is same as operand.  *)
+   ELSIF i > 0
+   THEN
+      (* test for:  i MOD j < minT  *)
+      IF j > i
+      THEN
+         RETURN FALSE
+      END ;
+      RETURN i - ((i DIV j) * j) < minT
+   ELSIF i < 0
+   THEN
+      (* the result will always be positive and less than i, given that j is less than zero
+         we know that minT must be < 0 as well and therefore the result of i MOD j will
+         never underflow.  *)
+      RETURN FALSE
+   END ;
+   RETURN FALSE
+
+   which can be converted into a large expression:
+
+   RETURN (j = 0) OR ((j < 0) AND ISO) OR
+          ((i # 0) AND (j <= i) AND (i - ((i DIVtrunc j) * j) < minT)
+
+   and into GCC trees:
+
+   c1 ->  (j = 0)
+   c2 ->  (j < 0)  (* only called from ISO or PIM4 or -fpositive-mod-floor  *)
+   c3 ->  (i # 0)
+   c4 ->  (j <= i)
+   c6 ->  (i DIVtrunc j)
+   c7 ->  (i - (c6 * j))
+   c5 ->  c7 < minT
+
+   t -> (c1 OR c2 OR
+        (c3 AND c4 AND c5)).  */
+
+static tree
+checkWholeModTruncOverflow (location_t location, tree i, tree j, tree lowest,
+			    tree min, tree max)
+{
+  tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
+  tree c2 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
+  tree c3 = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
+  tree c4 = m2expr_BuildLessThanOrEqual (location, j, i);
+  tree c6 = m2expr_BuildDivTrunc (location, i, j, FALSE);
+  tree c7 = m2expr_BuildSub (location, i, m2expr_BuildMult (location, c6, j, FALSE), FALSE);
+  tree c5 = m2expr_BuildLessThan (location, c7, min);
+  tree c8 = m2expr_Build3TruthAndIf (location, c3, c4, c5);
+  tree condition = m2expr_Build3TruthOrIf (location, c1, c2, c8);
+  tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value trunc modulus will cause a range overflow");
+  return t;
+}
+
+
+/* checkWholeModCeilOverflow, the GCC tree.def defines CEIL_MOD_EXPR to return
+   the remainder which has the same opposite of the divisor.  In gm2 this is
+   only called when the divisor is negative.  The pseudo code for implementing
+   these checks is given below:
+
+   IF j = 0
+   THEN
+      RETURN TRUE   (* division by zero.  *)
+   END ;
+   t := i - j * divceil (i, j) ;
+   printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
+           t, i, j, i, j, divceil (i, j));
+   RETURN NOT ((t >= minT) AND (t <= maxT))
+
+   which can be converted into the expression:
+
+   t := i - j * divceil (i, j) ;
+   RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
+
+   and into GCC trees:
+
+   c1 ->  (j = 0)
+   c2 ->  (i - j)
+   c3 ->  (i DIVceil j)
+   t ->   (c2 * c3)
+   c4 ->  (t >= minT)
+   c5 ->  (t <= maxT)
+   c6 ->  (c4 AND c5)
+   c7 ->  (NOT c6)
+   c8 ->  (c1 OR c7)
+   return c8.  */
+
+static tree
+checkWholeModCeilOverflow (location_t location,
+			   tree i, tree j, tree lowest,
+			   tree min, tree max)
+{
+  tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
+  tree c2 = m2expr_BuildSub (location, i, j, FALSE);
+  tree c3 = m2expr_BuildDivCeil (location, i, j, FALSE);
+  tree t  = m2expr_BuildMult (location, c2, c3, FALSE);
+  tree c4 = m2expr_BuildGreaterThanOrEqual (location, t, min);
+  tree c5 = m2expr_BuildLessThanOrEqual (location, t, max);
+  tree c6 = m2expr_BuildTruthAndIf (location, c4, c5);
+  tree c7 = m2expr_BuildTruthNot (location, c6);
+  tree condition = m2expr_BuildTruthOrIf (location, c1, c7);
+  tree s = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value ceil modulus will cause a range overflow");
+  return s;
+}
+
+
+/* checkWholeModFloorOverflow, the GCC tree.def defines FLOOR_MOD_EXPR to return
+   the remainder which has the same sign as the divisor.  In gm2 this is
+   only called when the divisor is positive.  The pseudo code for implementing
+   these checks is given below:
+
+   IF j = 0
+   THEN
+      RETURN TRUE   (* division by zero.  *)
+   END ;
+   t := i - j * divfloor (i, j) ;
+   printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
+           t, i, j, i, j, divfloor (i, j));
+   RETURN NOT ((t >= minT) AND (t <= maxT))
+
+   which can be converted into the expression:
+
+   t := i - j * divfloor (i, j) ;
+   RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
+
+   and into GCC trees:
+
+   c1 ->  (j = 0)
+   c2 ->  (i - j)
+   c3 ->  (i DIVfloor j)
+   t ->   (c2 * c3)
+   c4 ->  (t >= minT)
+   c5 ->  (t <= maxT)
+   c6 ->  (c4 AND c5)
+   c7 ->  (NOT c6)
+   c8 ->  (c1 OR c7)
+   return c8.  */
+
+static tree
+checkWholeModFloorOverflow (location_t location,
+			    tree i, tree j, tree lowest,
+			    tree min, tree max)
+{
+  tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
+  tree c2 = m2expr_BuildSub (location, i, j, FALSE);
+  tree c3 = m2expr_BuildDivFloor (location, i, j, FALSE);
+  tree t  = m2expr_BuildMult (location, c2, c3, FALSE);
+  tree c4 = m2expr_BuildGreaterThanOrEqual (location, t, min);
+  tree c5 = m2expr_BuildLessThanOrEqual (location, t, max);
+  tree c6 = m2expr_BuildTruthAndIf (location, c4, c5);
+  tree c7 = m2expr_BuildTruthNot (location, c6);
+  tree condition = m2expr_BuildTruthOrIf (location, c1, c7);
+  tree s = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value floor modulus will cause a range overflow");
+  return s;
+}
+
+
+#if 0
+/*  The following is a Modula-2 implementation of the C tree node code
+    this code has been hand translated into GCC trees.  */
+
+(*
+   divFloorOverflow2 - returns TRUE if an overflow will occur
+                       if i divfloor j is performed.
+*)
+
+PROCEDURE divFloorOverflow (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN ((j = 0) OR     (* division by zero.  *)
+           (maxT < 0) OR  (* both inputs are < 0 and max is < 0,
+                             therefore error.  *)
+                          (* --fixme-- remember here to also check
+                             if ISO M2 dialect and j < 0
+                             which will also generate an error.  *)
+           ((i # 0) AND   (* first operand is legally zero,
+                             result is also legally zero.  *)
+            divFloorOverflowCases (i, j)))
+END divFloorOverflow ;
+
+
+(*
+   divFloorOverflowCases - precondition:  i, j are in range values.
+                           postcondition:  TRUE is returned if i divfloor will
+                                           result in an overflow/underflow.
+*)
+
+PROCEDURE divFloorOverflowCases (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
+           ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
+           ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
+           ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
+END divFloorOverflowCases ;
+
+
+(*
+   divFloorOverflowPosPos - precondition:  lhs, rhs are legal and are both >= 0.
+                            postcondition:  TRUE is returned if lhs divfloor rhs will
+                                            result in an overflow/underflow.
+*)
+
+PROCEDURE divFloorOverflowPosPos (lhs, rhs: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN multMinOverflow (rhs) OR (lhs < rhs * min)
+END divFloorOverflowPosPos ;
+
+
+(*
+   divFloorOverflowNegNeg - precondition:  i, j are in range values and both < 0.
+                            postcondition:  TRUE is returned if i divfloor will
+                                            result in an overflow/underflow.
+*)
+
+PROCEDURE divFloorOverflowNegNeg (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN ((maxT <= 0) OR           (* signs will cause overflow.  *)
+           (* check for underflow.  *)
+           (i >= j * minT) OR
+           (* check for overflow.  *)
+           (ABS (i) DIV maxT > ABS (j)))
+END divFloorOverflowNegNeg ;
+
+
+(*
+   divFloorOverflowNegPos - precondition:  i, j are in range values.  i < 0, j >= 0.
+                            postcondition:  TRUE is returned if i divfloor will
+                                            result in an overflow/underflow.
+*)
+
+PROCEDURE divFloorOverflowNegPos (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   (* easier than might be initially expected.  We know minT < 0 and maxT > 0.
+      We know the result will be negative and therefore we only need to test
+      against minT.  *)
+   RETURN i < j * minT
+END divFloorOverflowNegPos ;
+
+
+(*
+   divFloorOverflowPosNeg - precondition:  i, j are in range values.  i >= 0, j < 0.
+                           postcondition:  TRUE is returned if i divfloor will
+                                           result in an overflow/underflow.
+*)
+
+PROCEDURE divFloorOverflowPosNeg (i, j: INTEGER) : BOOLEAN ;
+BEGIN
+   (* easier than might be initially expected.  We know minT < 0 and maxT > 0.
+      We know the result will be negative and therefore we only need to test
+      against minT.  *)
+   RETURN i >= j * minT - j  (* is safer than i > j * minT -1 *)
+END divFloorOverflowPosNeg ;
+#endif
+
+
+/* divFloorOverflowPosPos, precondition:  i, j are legal and are both >= 0.
+   Postcondition:  TRUE is returned if i divfloor will result in an overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN i < j * min
+
+   j_mult_min -> (j * min)
+   RETURN i < j_mult_min.  */
+
+static tree
+divFloorOverflowPosPos (location_t location, tree i, tree j, tree min)
+{
+  tree j_mult_min = m2expr_BuildMult (location, j, min, FALSE);
+  tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
+  return i_lt_j_mult_min;
+}
+
+
+/* divFloorOverflowNegNeg precondition:  i, j are in range values and both < 0.
+   Postcondition:  TRUE is returned if i divfloor j will result in an
+   overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN ((maxT <= 0) OR           (* signs will cause overflow.  *)
+           (* check for underflow.  *)
+           (i >= j * min) OR
+           (* check for overflow.  *)
+           (ABS (i) DIV max > ABS (j)))
+
+  max_lte_0 -> (max <= 0)
+  abs_i -> (ABS (i))
+  abs_j -> (ABS (j))
+  j_mult_min -> (j * min)
+  i_ge_j_mult_min -> (i >= j_mult_min)
+  abs_i_div_max -> (abs_i divfloor max)
+  abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
+
+  return max_lte_0 OR
+         i_ge_j_mult_min OR
+         abs_i_div_max_gt_abs_j.  */
+
+static tree
+divFloorOverflowNegNeg (location_t location, tree i, tree j, tree lowest,
+			tree min, tree max)
+{
+  tree max_lte_0 = m2expr_BuildLessThanOrEqualZero (location, max, lowest, min, max);
+  tree abs_i = m2expr_BuildAbs (location, i);
+  tree abs_j = m2expr_BuildAbs (location, j);
+  tree j_mult_min = m2expr_BuildMult (location, j, min, FALSE);
+  tree i_ge_j_mult_min = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min);
+  tree abs_i_div_max = m2expr_BuildDivFloor (location, abs_i, max, FALSE);
+  tree abs_i_div_max_gt_abs_j = m2expr_BuildGreaterThan (location,  abs_i_div_max, abs_j);
+
+  return m2expr_Build3TruthOrIf (location, max_lte_0, i_ge_j_mult_min, abs_i_div_max_gt_abs_j);
+}
+
+
+/* divFloorOverflowPosNeg precondition:  i, j are in range values and i >=0, j < 0.
+   Postcondition:  TRUE is returned if i divfloor j will result in an
+   overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN i >= j * min - j  (* is safer than i > j * min -1 *)
+
+   j_mult_min -> (j * min)
+   j_mult_min_sub_j -> (j_mult_min - j)
+   i_ge_j_mult_min_sub_j -> (i >= j_mult_min_sub_j)
+
+   return i_ge_j_mult_min_sub_j.  */
+
+static tree
+divFloorOverflowPosNeg (location_t location, tree i, tree j, tree min)
+{
+  tree j_mult_min = m2expr_BuildMult (location, j, min, FALSE);
+  tree j_mult_min_sub_j = m2expr_BuildSub (location, j_mult_min, j, FALSE);
+  tree i_ge_j_mult_min_sub_j = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min_sub_j);
+  return i_ge_j_mult_min_sub_j;
+}
+
+
+/* divFloorOverflowNegPos precondition:  i, j are in range values and i < 0, j > 0.
+   Postcondition:  TRUE is returned if i divfloor j will result in an
+   overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN i < j * min
+
+   j_mult_min -> (j * min)
+   RETURN i < j_mult_min.  */
+
+static tree
+divFloorOverflowNegPos (location_t location, tree i, tree j, tree min)
+{
+  tree j_mult_min = m2expr_BuildMult (location, j, min, FALSE);
+  tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
+  return i_lt_j_mult_min;
+}
+
+
+/* divFloorOverflowCases, precondition:  i, j are in range values.
+   Postcondition:  TRUE is returned if i divfloor will result in an
+   overflow/underflow.
+
+   A handbuilt expression of trees implementing:
+
+   RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
+           ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
+           ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
+           ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
+
+   a -> ((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j))
+   b -> ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j))
+   c -> ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j))
+   d -> ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j))
+
+   RETURN a AND b AND c AND d.  */
+
+static tree
+divFloorOverflowCases (location_t location, tree i, tree j, tree lowest,
+		      tree min, tree max)
+{
+  tree i_gt_zero = m2expr_BuildGreaterThanZero (location, i, lowest, min, max);
+  tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
+  tree i_lt_zero = m2expr_BuildLessThanZero (location, i, lowest, min, max);
+  tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
+  tree a = m2expr_Build3TruthAndIf (location, i_gt_zero, j_gt_zero,
+				    divFloorOverflowPosPos (location, i, j, min));
+  tree b = m2expr_Build3TruthAndIf (location, i_lt_zero, j_lt_zero,
+				    divFloorOverflowNegNeg (location, i, j, lowest, min, max));
+  tree c = m2expr_Build3TruthAndIf (location, i_gt_zero, j_lt_zero,
+				    divFloorOverflowPosNeg (location, i, j, min));
+  tree d = m2expr_Build3TruthAndIf (location, i_lt_zero, j_gt_zero,
+				    divFloorOverflowNegPos (location, i, j, min));
+  return m2expr_Build4TruthOrIf (location, a, b, c, d);
+}
+
+
+/* checkWholeDivFloorOverflow check to see whether i DIV_FLOOR j will overflow
+   an integer.  A handbuilt expression of trees implementing:
+
+   RETURN ((j = 0) OR     (* division by zero.  *)
+           (maxT < 0) OR  (* both inputs are < 0 and max is < 0,
+                             therefore error.  *)
+                          (* we also check
+                             if ISO M2 dialect and j < 0
+                             which will also generate an error.  *)
+           ((i # 0) AND   (* first operand is legally zero,
+                             result is also legally zero.  *)
+            divFloorOverflowCases (i, j)))
+
+  using the following subexpressions:
+
+   j_eq_zero -> (j == 0)
+   max_lt_zero -> (max < 0)
+   i_ne_zero -> (i # 0).  */
+
+static tree
+checkWholeDivFloorOverflow (location_t location, tree i, tree j, tree lowest,
+			    tree min, tree max)
+{
+  tree j_eq_zero = m2expr_BuildEqualToZero (location, j, lowest, min, max);
+  tree max_lt_zero = m2expr_BuildLessThanZero (location, max, lowest, min, max);
+  tree i_ne_zero = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
+  tree j_lt_zero;
+  tree rhs = m2expr_BuildTruthAndIf (location,
+				     i_ne_zero,
+				     divFloorOverflowCases (location,
+							    i, j, lowest, min, max));
+
+  if (M2Options_GetISO ())
+    /* ISO Modula-2 raises an exception if the right hand operand is < 0.  */
+    j_lt_zero = m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location, j, lowest, min, max));
+  else
+    j_lt_zero = m2expr_GetIntegerZero (location);
+  j_eq_zero = m2expr_FoldAndStrip (j_eq_zero);
+  max_lt_zero = m2expr_FoldAndStrip (max_lt_zero);
+  i_ne_zero = m2expr_FoldAndStrip (i_ne_zero);
+  rhs = m2expr_FoldAndStrip (rhs);
+
+  tree condition = m2expr_Build4TruthOrIf (location, j_eq_zero, max_lt_zero, rhs, j_lt_zero);
+  tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
+					       get_current_function_name (),
+               "whole value floor division will cause a range overflow");
+  return t;
+}
+
+/* checkWholeOverflow check to see if the binary operators will overflow
+   ordinal types.  */
+
+static tree
+m2expr_checkWholeOverflow (location_t location, enum tree_code code, tree op1,
+                           tree op2, tree lowest, tree min, tree max)
+{
+  if (M2Options_GetWholeValueCheck () && (min != NULL))
+    {
+      lowest = m2tree_skip_type_decl (lowest);
+      op1 = fold_convert_loc (location, lowest, op1);
+      op2 = fold_convert_loc (location, lowest, op2);
+
+      switch (code)
+        {
+        case PLUS_EXPR:
+          return checkWholeAddOverflow (location, op1, op2, lowest, min, max);
+        case MINUS_EXPR:
+          return checkWholeSubOverflow (location, op1, op2, lowest, min, max);
+        case MULT_EXPR:
+          return checkWholeMultOverflow (location, op1, op2, lowest, min, max);
+	case TRUNC_DIV_EXPR:
+	  return checkWholeDivTruncOverflow (location, op1, op2, lowest, min, max);
+	case CEIL_DIV_EXPR:
+	  return checkWholeDivCeilOverflow (location, op1, op2, lowest, min, max);
+	case FLOOR_DIV_EXPR:
+	  return checkWholeDivFloorOverflow (location, op1, op2, lowest, min, max);
+	case TRUNC_MOD_EXPR:
+	  return checkWholeModTruncOverflow (location, op1, op2, lowest, min, max);
+	case CEIL_MOD_EXPR:
+	  return checkWholeModCeilOverflow (location, op1, op2, lowest, min, max);
+	case FLOOR_MOD_EXPR:
+	  return checkWholeModFloorOverflow (location, op1, op2, lowest, min, max);
+        default:
+	  return NULL;
+        }
+    }
+  return NULL;
+}
+
+/* checkRealOverflow if we have enabled real value checking then
+   generate an overflow check appropriate to the tree code being used.  */
+
+static void
+m2expr_checkRealOverflow (location_t location, enum tree_code code,
+                          tree result)
+{
+  if (M2Options_GetFloatValueCheck ())
+    {
+      tree condition = m2expr_BuildEqualTo (
+          location, m2builtins_BuiltInIsfinite (location, result),
+          m2expr_GetIntegerZero (location));
+      switch (code)
+        {
+        case PLUS_EXPR:
+          m2type_AddStatement (location,
+                               M2Range_BuildIfCallRealHandlerLoc (
+				   location, condition,
+				   get_current_function_name (),
+		   "floating point + has caused an overflow"));
+          break;
+        case MINUS_EXPR:
+          m2type_AddStatement (location,
+                               M2Range_BuildIfCallRealHandlerLoc (
+                                   location, condition,
+				   get_current_function_name (),
+		   "floating point - has caused an overflow"));
+          break;
+        case RDIV_EXPR:
+        case FLOOR_DIV_EXPR:
+        case CEIL_DIV_EXPR:
+        case TRUNC_DIV_EXPR:
+          m2type_AddStatement (location,
+                               M2Range_BuildIfCallRealHandlerLoc (
+                                   location, condition,
+				   get_current_function_name (),
+		   "floating point / has caused an overflow"));
+          break;
+        case MULT_EXPR:
+          m2type_AddStatement (location,
+                               M2Range_BuildIfCallRealHandlerLoc (
+                                   location, condition,
+				   get_current_function_name (),
+		   "floating point * has caused an overflow"));
+          break;
+        case NEGATE_EXPR:
+          m2type_AddStatement (
+              location, M2Range_BuildIfCallRealHandlerLoc (
+                            location, condition,
+			    get_current_function_name (),
+		   "floating point unary - has caused an overflow"));
+        default:
+          break;
+        }
+    }
+}
+
+/* build_binary_op, a wrapper for the lower level build_binary_op
+   above.  */
+
+tree
+m2expr_build_binary_op_check (location_t location, enum tree_code code,
+                              tree op1, tree op2, int needconvert, tree lowest,
+                              tree min, tree max)
+{
+  tree type1, type2, result;
+  tree check = NULL;
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  type1 = m2tree_skip_type_decl (TREE_TYPE (op1));
+  type2 = m2tree_skip_type_decl (TREE_TYPE (op2));
+
+  m2assert_AssertLocation (location);
+
+  if (code == PLUS_EXPR)
+    {
+      if (POINTER_TYPE_P (type1))
+        {
+          op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
+          return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
+                                  op1, op2);
+        }
+      else if (POINTER_TYPE_P (type2))
+        {
+          op1 = fold_convert_loc (location, sizetype, unshare_expr (op1));
+          return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op2),
+                                  op2, op1);
+        }
+    }
+  if (code == MINUS_EXPR)
+    {
+      if (POINTER_TYPE_P (type1))
+        {
+          op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
+          op2 = fold_build1_loc (location, NEGATE_EXPR, sizetype, op2);
+          return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
+                                  op1, op2);
+        }
+      else if (POINTER_TYPE_P (type2))
+        {
+          op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
+          op2 = fold_build1_loc (location, NEGATE_EXPR, sizetype, op2);
+          op1 = fold_convert_loc (location, sizetype, unshare_expr (op1));
+          return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op2),
+                                  op2, op1);
+        }
+    }
+
+  if ((code != LSHIFT_EXPR) && (code != RSHIFT_EXPR) && (code != LROTATE_EXPR)
+      && (code == RROTATE_EXPR))
+    if (type1 != type2)
+      error_at (location, "not expecting different types to binary operator");
+
+  if ((TREE_CODE (type1) != REAL_TYPE) && (min != NULL))
+    check = m2expr_checkWholeOverflow (location, code, op1, op2, lowest, min, max);
+
+  result = build_binary_op (location, code, op1, op2, needconvert);
+  if (check != NULL)
+    result = build2 (COMPOUND_EXPR, TREE_TYPE (result), check, result);
+
+  if (TREE_CODE (type1) == REAL_TYPE)
+    m2expr_checkRealOverflow (location, code, result);
+  return result;
+}
+
+/* build_binary_op, a wrapper for the lower level build_binary_op
+   above.  */
+
+tree
+m2expr_build_binary_op (location_t location, enum tree_code code, tree op1,
+                        tree op2, int convert)
+{
+  return m2expr_build_binary_op_check (location, code, op1, op2, convert, NULL,
+                                       NULL, NULL);
+}
+
+/* BuildAddAddress return an expression op1+op2 where op1 is a
+   pointer type and op2 is not a pointer type.  */
+
+tree
+m2expr_BuildAddAddress (location_t location, tree op1, tree op2)
+{
+  tree type1, type2;
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  type1 = m2tree_skip_type_decl (TREE_TYPE (op1));
+  type2 = m2tree_skip_type_decl (TREE_TYPE (op2));
+
+  m2assert_AssertLocation (location);
+  ASSERT_CONDITION (POINTER_TYPE_P (type1));
+  ASSERT_CONDITION (!POINTER_TYPE_P (type2));
+
+  op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
+  return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
+                          m2expr_FoldAndStrip (op1),
+                          m2expr_FoldAndStrip (op2));
+}
+
+/* BuildNegateCheck builds a negate tree.  */
+
+tree
+m2expr_BuildNegateCheck (location_t location, tree arg, tree lowest, tree min,
+                         tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  arg = m2expr_FoldAndStrip (arg);
+  arg = CheckAddressToCardinal (location, arg);
+
+  t = m2expr_build_unary_op_check (location, NEGATE_EXPR, arg, lowest, min,
+                                   max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* BuildNegate build a negate expression and returns the tree.  */
+
+tree
+m2expr_BuildNegate (location_t location, tree op1, int needconvert)
+{
+  m2assert_AssertLocation (location);
+  op1 = m2expr_FoldAndStrip (op1);
+  op1 = CheckAddressToCardinal (location, op1);
+
+  return m2expr_build_unary_op (location, NEGATE_EXPR, op1, needconvert);
+}
+
+/* BuildSetNegate build a set negate expression and returns the tree.  */
+
+tree
+m2expr_BuildSetNegate (location_t location, tree op1, int needconvert)
+{
+  m2assert_AssertLocation (location);
+
+  return m2expr_build_binary_op (
+      location, BIT_XOR_EXPR,
+      m2convert_BuildConvert (location, m2type_GetWordType (),
+                              m2expr_FoldAndStrip (op1), FALSE),
+      set_full_complement, needconvert);
+}
+
+/* BuildMult build a multiplication tree.  */
+
+tree
+m2expr_BuildMult (location_t location, tree op1, tree op2, int needconvert)
+{
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  m2assert_AssertLocation (location);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  return m2expr_build_binary_op (location, MULT_EXPR, op1, op2, needconvert);
+}
+
+/* BuildMultCheck builds a multiplication tree.  */
+
+tree
+m2expr_BuildMultCheck (location_t location, tree op1, tree op2, tree lowest,
+                       tree min, tree max)
+{
+  tree t;
+
+  m2assert_AssertLocation (location);
+
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+
+  op1 = CheckAddressToCardinal (location, op1);
+  op2 = CheckAddressToCardinal (location, op2);
+
+  t = m2expr_build_binary_op_check (location, MULT_EXPR, op1, op2, FALSE,
+                                    lowest, min, max);
+  return m2expr_FoldAndStrip (t);
+}
+
+/* testLimits return the number of bits required to represent:
+   min..max if it matches the, type.  Otherwise NULL_TREE is returned.  */
+
+static tree
+testLimits (location_t location, tree type, tree min, tree max)
+{
+  m2assert_AssertLocation (location);
+
+  if ((m2expr_CompareTrees (TYPE_MAX_VALUE (type), max) == 0)
+      && (m2expr_CompareTrees (TYPE_MIN_VALUE (type), min) == 0))
+    return m2expr_BuildMult (location, m2expr_GetSizeOf (location, type),
+                             m2decl_BuildIntegerConstant (BITS_PER_UNIT),
+                             FALSE);
+  return NULL_TREE;
+}
+
+/* noBitsRequired return the number of bits required to contain, values.  */
+
+static tree
+noBitsRequired (tree values)
+{
+  int bits = tree_floor_log2 (values);
+
+  if (integer_pow2p (values))
+    return m2decl_BuildIntegerConstant (bits + 1);
+  else
+    return m2decl_BuildIntegerConstant (bits + 1);
+}
+
+/* getMax return the result of max(a, b).  */
+
+static tree
+getMax (tree a, tree b)
+{
+  if (m2expr_CompareTrees (a, b) > 0)
+    return a;
+  else
+    return b;
+}
+
+/* calcNbits return the smallest number of bits required to
+   represent: min..max.  */
+
+static tree
+calcNbits (location_t location, tree min, tree max)
+{
+  int negative = FALSE;
+  tree t = testLimits (location, m2type_GetIntegerType (), min, max);
+
+  m2assert_AssertLocation (location);
+
+  if (t == NULL)
+    t = testLimits (location, m2type_GetCardinalType (), min, max);
+
+  if (t == NULL)
+    {
+      if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) < 0)
+        {
+          min = m2expr_BuildAdd (location, min,
+                                 m2expr_GetIntegerOne (location), FALSE);
+          min = fold (m2expr_BuildNegate (location, min, FALSE));
+          negative = TRUE;
+        }
+      if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
+        {
+          max = fold (m2expr_BuildNegate (location, max, FALSE));
+          negative = TRUE;
+        }
+      t = noBitsRequired (getMax (min, max));
+      if (negative)
+        t = m2expr_BuildAdd (location, t, m2expr_GetIntegerOne (location),
+                             FALSE);
+    }
+  return t;
+}
+
+/* BuildTBitSize return the minimum number of bits to represent, type.  */
+
+tree
+m2expr_BuildTBitSize (location_t location, tree type)
+{
+  enum tree_code code = TREE_CODE (type);
+  tree min;
+  tree max;
+  m2assert_AssertLocation (location);
+
+  switch (code)
+    {
+
+    case TYPE_DECL:
+      return m2expr_BuildTBitSize (location, TREE_TYPE (type));
+    case INTEGER_TYPE:
+    case ENUMERAL_TYPE:
+      max = m2convert_BuildConvert (location, m2type_GetIntegerType (),
+                                    TYPE_MAX_VALUE (type), FALSE);
+      min = m2convert_BuildConvert (location, m2type_GetIntegerType (),
+                                    TYPE_MIN_VALUE (type), FALSE);
+      return calcNbits (location, min, max);
+    case BOOLEAN_TYPE:
+      return m2expr_GetIntegerOne (location);
+    default:
+      return m2expr_BuildMult (location, m2expr_GetSizeOf (location, type),
+                               m2decl_BuildIntegerConstant (BITS_PER_UNIT),
+                               FALSE);
+    }
+}
+
+/* BuildSize build a SIZE function expression and returns the tree.  */
+
+tree
+m2expr_BuildSize (location_t location, tree op1,
+                  int needconvert ATTRIBUTE_UNUSED)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_GetSizeOf (location, op1);
+}
+
+/* BuildAddr return an expression which calculates the address of op1
+   and returns the tree.  If use_generic is TRUE then create a generic
+   pointer type.  */
+
+tree
+m2expr_BuildAddr (location_t location, tree op1, int use_generic)
+{
+  tree type = m2tree_skip_type_decl (TREE_TYPE (op1));
+  tree ptrType = build_pointer_type (type);
+  tree result;
+
+  m2assert_AssertLocation (location);
+
+  if (!gm2_mark_addressable (op1))
+    error_at (location, "cannot take the address of this expression");
+
+  if (use_generic)
+    result = build1 (ADDR_EXPR, m2type_GetPointerType (), op1);
+  else
+    result = build1 (ADDR_EXPR, ptrType, op1);
+  protected_set_expr_location (result, location);
+  return result;
+}
+
+/* BuildOffset1 build and return an expression containing the number
+   of bytes the field is offset from the start of the record structure.
+   This function is the same as the above, except that it derives the
+   record from the field and then calls BuildOffset.  */
+
+tree
+m2expr_BuildOffset1 (location_t location, tree field,
+                     int needconvert ATTRIBUTE_UNUSED)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_BuildOffset (location, DECL_CONTEXT (field), field,
+                             needconvert);
+}
+
+/* determinePenultimateField return the field associated with the
+   DECL_CONTEXT (field) within a record or varient.  The record, is a
+   record/varient but it maybe an outer nested record to the field that
+   we are searching.  Ie:
+
+   record = RECORD x: CARDINAL ; y: RECORD field: CARDINAL ; END END ;
+
+   determinePenultimateField (record, field) returns, y.  We are
+   assurred that the chain of records leading to field will be unique as
+   they are built on the fly to implement varient records.  */
+
+static tree
+determinePenultimateField (tree record, tree field)
+{
+  tree fieldlist = TYPE_FIELDS (record);
+  tree x, r;
+
+  for (x = fieldlist; x; x = TREE_CHAIN (x))
+    {
+      if (DECL_CONTEXT (field) == TREE_TYPE (x))
+        return x;
+      switch (TREE_CODE (TREE_TYPE (x)))
+        {
+        case RECORD_TYPE:
+        case UNION_TYPE:
+          r = determinePenultimateField (TREE_TYPE (x), field);
+          if (r != NULL)
+            return r;
+          break;
+        default:
+          break;
+        }
+    }
+  return NULL_TREE;
+}
+
+/* BuildOffset builds an expression containing the number of bytes
+the field is offset from the start of the record structure.  The
+expression is returned.  */
+
+tree
+m2expr_BuildOffset (location_t location, tree record, tree field,
+                    int needconvert ATTRIBUTE_UNUSED)
+{
+  m2assert_AssertLocation (location);
+
+  if (DECL_CONTEXT (field) == record)
+    return m2convert_BuildConvert (
+        location, m2type_GetIntegerType (),
+        m2expr_BuildAdd (
+            location, DECL_FIELD_OFFSET (field),
+            m2expr_BuildDivTrunc (location, DECL_FIELD_BIT_OFFSET (field),
+                                  m2decl_BuildIntegerConstant (BITS_PER_UNIT),
+                                  FALSE),
+            FALSE),
+        FALSE);
+  else
+    {
+      tree r1 = DECL_CONTEXT (field);
+      tree r2 = determinePenultimateField (record, field);
+      return m2convert_BuildConvert (
+          location, m2type_GetIntegerType (),
+          m2expr_BuildAdd (
+              location, m2expr_BuildOffset (location, r1, field, needconvert),
+              m2expr_BuildOffset (location, record, r2, needconvert), FALSE),
+          FALSE);
+    }
+}
+
+/* BuildLogicalOrAddress build a logical or expressions and return the tree. */
+
+tree
+m2expr_BuildLogicalOrAddress (location_t location, tree op1, tree op2,
+                              int needconvert)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (location, BIT_IOR_EXPR, op1, op2,
+                                 needconvert);
+}
+
+/* BuildLogicalOr build a logical or expressions and return the tree.  */
+
+tree
+m2expr_BuildLogicalOr (location_t location, tree op1, tree op2,
+                       int needconvert)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (
+      location, BIT_IOR_EXPR,
+      m2convert_BuildConvert (location, m2type_GetWordType (), op1, FALSE),
+      m2convert_BuildConvert (location, m2type_GetWordType (), op2, FALSE),
+      needconvert);
+}
+
+/* BuildLogicalAnd build a logical and expression and return the tree.  */
+
+tree
+m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2,
+                        int needconvert)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (
+      location, BIT_AND_EXPR,
+      m2convert_BuildConvert (location, m2type_GetWordType (), op1, FALSE),
+      m2convert_BuildConvert (location, m2type_GetWordType (), op2, FALSE),
+      needconvert);
+}
+
+/* BuildSymmetricalDifference build a logical xor expression and return the
+ * tree.  */
+
+tree
+m2expr_BuildSymmetricDifference (location_t location, tree op1, tree op2,
+                                 int needconvert)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (
+      location, BIT_XOR_EXPR,
+      m2convert_BuildConvert (location, m2type_GetWordType (), op1, FALSE),
+      m2convert_BuildConvert (location, m2type_GetWordType (), op2, FALSE),
+      needconvert);
+}
+
+/* BuildLogicalDifference build a logical difference expression and
+return the tree.  (op1 and (not op2)).  */
+
+tree
+m2expr_BuildLogicalDifference (location_t location, tree op1, tree op2,
+                               int needconvert)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (
+      location, BIT_AND_EXPR,
+      m2convert_BuildConvert (location, m2type_GetWordType (), op1, FALSE),
+      m2expr_BuildSetNegate (location, op2, needconvert), needconvert);
+}
+
+/* base_type returns the base type of an ordinal subrange, or the
+type itself if it is not a subrange.  */
+
+static tree
+base_type (tree type)
+{
+  if (type == error_mark_node)
+    return error_mark_node;
+
+  /* Check for ordinal subranges.  */
+  if (m2tree_IsOrdinal (type) && TREE_TYPE (type))
+    type = TREE_TYPE (type);
+  return TYPE_MAIN_VARIANT (type);
+}
+
+/* boolean_enum_to_unsigned convert a BOOLEAN_TYPE, t, or
+   ENUMERAL_TYPE to an unsigned type.  */
+
+static tree
+boolean_enum_to_unsigned (location_t location, tree t)
+{
+  tree type = TREE_TYPE (t);
+
+  if (TREE_CODE (base_type (type)) == BOOLEAN_TYPE)
+    return m2convert_BuildConvert (location, unsigned_type_node, t, FALSE);
+  else if (TREE_CODE (base_type (type)) == ENUMERAL_TYPE)
+    return m2convert_BuildConvert (location, unsigned_type_node, t, FALSE);
+  else
+    return t;
+}
+
+/* check_for_comparison check to see if, op, is of type, badType.  If
+   so then it returns op after it has been cast to, goodType.  op will
+   be an array so we take the address and cast the contents.  */
+
+static tree
+check_for_comparison (location_t location, tree op, tree badType,
+                      tree goodType)
+{
+  m2assert_AssertLocation (location);
+  if (m2tree_skip_type_decl (TREE_TYPE (op)) == badType)
+    /* Cannot compare array contents in m2expr_build_binary_op.  */
+    return m2expr_BuildIndirect (
+        location, m2expr_BuildAddr (location, op, FALSE), goodType);
+  return op;
+}
+
+/* convert_for_comparison return a tree which can be used as an
+   argument during a comparison.  */
+
+static tree
+convert_for_comparison (location_t location, tree op)
+{
+  m2assert_AssertLocation (location);
+  op = boolean_enum_to_unsigned (location, op);
+
+  op = check_for_comparison (location, op, m2type_GetISOWordType (),
+                             m2type_GetWordType ());
+  op = check_for_comparison (location, op, m2type_GetM2Word16 (),
+                             m2type_GetM2Cardinal16 ());
+  op = check_for_comparison (location, op, m2type_GetM2Word32 (),
+                             m2type_GetM2Cardinal32 ());
+  op = check_for_comparison (location, op, m2type_GetM2Word64 (),
+                             m2type_GetM2Cardinal64 ());
+
+  return op;
+}
+
+/* BuildLessThan return a tree which computes <.  */
+
+tree
+m2expr_BuildLessThan (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (
+      location, LT_EXPR, boolean_enum_to_unsigned (location, op1),
+      boolean_enum_to_unsigned (location, op2), TRUE);
+}
+
+/* BuildGreaterThan return a tree which computes >.  */
+
+tree
+m2expr_BuildGreaterThan (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (
+      location, GT_EXPR, boolean_enum_to_unsigned (location, op1),
+      boolean_enum_to_unsigned (location, op2), TRUE);
+}
+
+/* BuildLessThanOrEqual return a tree which computes <.  */
+
+tree
+m2expr_BuildLessThanOrEqual (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (
+      location, LE_EXPR, boolean_enum_to_unsigned (location, op1),
+      boolean_enum_to_unsigned (location, op2), TRUE);
+}
+
+/* BuildGreaterThanOrEqual return a tree which computes >=.  */
+
+tree
+m2expr_BuildGreaterThanOrEqual (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (
+      location, GE_EXPR, boolean_enum_to_unsigned (location, op1),
+      boolean_enum_to_unsigned (location, op2), TRUE);
+}
+
+/* BuildEqualTo return a tree which computes =.  */
+
+tree
+m2expr_BuildEqualTo (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (location, EQ_EXPR,
+                                 convert_for_comparison (location, op1),
+                                 convert_for_comparison (location, op2), TRUE);
+}
+
+/* BuildEqualNotTo return a tree which computes #.  */
+
+tree
+m2expr_BuildNotEqualTo (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_build_binary_op (location, NE_EXPR,
+                                 convert_for_comparison (location, op1),
+                                 convert_for_comparison (location, op2), TRUE);
+}
+
+/* BuildIsSuperset return a tree which computes:  op1 & op2 == op2.  */
+
+tree
+m2expr_BuildIsSuperset (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_BuildEqualTo (
+      location, op2, m2expr_BuildLogicalAnd (location, op1, op2, FALSE));
+}
+
+/* BuildIsNotSuperset return a tree which computes: op1 & op2 != op2.  */
+
+tree
+m2expr_BuildIsNotSuperset (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_BuildNotEqualTo (
+      location, op2, m2expr_BuildLogicalAnd (location, op1, op2, FALSE));
+}
+
+/* BuildIsSubset return a tree which computes:  op1 & op2 == op1.  */
+
+tree
+m2expr_BuildIsSubset (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_BuildEqualTo (
+      location, op1, m2expr_BuildLogicalAnd (location, op1, op2, FALSE));
+}
+
+/* BuildIsNotSubset return a tree which computes: op1 & op2 != op1.  */
+
+tree
+m2expr_BuildIsNotSubset (location_t location, tree op1, tree op2)
+{
+  m2assert_AssertLocation (location);
+  return m2expr_BuildNotEqualTo (
+      location, op1, m2expr_BuildLogicalAnd (location, op1, op2, FALSE));
+}
+
+/* BuildIfConstInVar generates: if constel in varset then goto label.  */
+
+void
+m2expr_BuildIfConstInVar (location_t location, tree type, tree varset,
+                          tree constel, int is_lvalue, int fieldno,
+                          char *label)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+  m2assert_AssertLocation (location);
+
+  ASSERT_BOOL (is_lvalue);
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    m2treelib_do_jump_if_bit (
+        location, NE_EXPR,
+        m2treelib_get_rvalue (location, varset, type, is_lvalue), constel,
+        label);
+  else
+    {
+      tree fieldlist = TYPE_FIELDS (type);
+      tree field;
+
+      for (field = fieldlist; (field != NULL) && (fieldno > 0);
+           field = TREE_CHAIN (field))
+        fieldno--;
+
+      m2treelib_do_jump_if_bit (
+          location, NE_EXPR,
+          m2treelib_get_set_field_rhs (location, varset, field), constel,
+          label);
+    }
+}
+
+/* BuildIfConstInVar generates: if not (constel in varset) then goto label.  */
+
+void
+m2expr_BuildIfNotConstInVar (location_t location, tree type, tree varset,
+                             tree constel, int is_lvalue, int fieldno,
+                             char *label)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+
+  m2assert_AssertLocation (location);
+
+  ASSERT_BOOL (is_lvalue);
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    m2treelib_do_jump_if_bit (
+        location, EQ_EXPR,
+        m2treelib_get_rvalue (location, varset, type, is_lvalue), constel,
+        label);
+  else
+    {
+      tree fieldlist = TYPE_FIELDS (type);
+      tree field;
+
+      for (field = fieldlist; (field != NULL) && (fieldno > 0);
+           field = TREE_CHAIN (field))
+        fieldno--;
+
+      m2treelib_do_jump_if_bit (
+          location, EQ_EXPR,
+          m2treelib_get_set_field_rhs (location, varset, field), constel,
+          label);
+    }
+}
+
+/* BuildIfVarInVar generates: if varel in varset then goto label.  */
+
+void
+m2expr_BuildIfVarInVar (location_t location, tree type, tree varset,
+                        tree varel, int is_lvalue, tree low,
+                        tree high ATTRIBUTE_UNUSED, char *label)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+  /* Calculate the index from the first bit, ie bit 0 represents low value.  */
+  tree index = m2expr_BuildSub (
+      location, m2convert_BuildConvert (location, m2type_GetIntegerType (),
+                                        varel, FALSE),
+      m2convert_BuildConvert (location, m2type_GetIntegerType (), low, FALSE),
+      FALSE);
+
+  m2assert_AssertLocation (location);
+
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    m2treelib_do_jump_if_bit (
+        location, NE_EXPR,
+        m2treelib_get_rvalue (location, varset, type, is_lvalue), index,
+        label);
+  else
+    {
+      tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
+      /* Which word do we need to fetch?  */
+      tree word_index = m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
+          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
+          FALSE));
+      /* Calculate the bit in this word.  */
+      tree offset_into_word = m2expr_FoldAndStrip (m2expr_BuildModTrunc (
+          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
+          FALSE));
+      tree p2 = m2expr_FoldAndStrip (m2expr_BuildMult (
+          location, word_index,
+          m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT), FALSE));
+
+      /* Calculate the address of the word we are interested in.  */
+      p1 = m2expr_BuildAddAddress (location,
+                                   m2convert_convertToPtr (location, p1), p2);
+
+      /* Fetch the word, extract the bit and test for != 0.  */
+      m2treelib_do_jump_if_bit (
+          location, NE_EXPR,
+          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
+          offset_into_word, label);
+    }
+}
+
+/* BuildIfNotVarInVar generates: if not (varel in varset) then goto label.  */
+
+void
+m2expr_BuildIfNotVarInVar (location_t location, tree type, tree varset,
+                           tree varel, int is_lvalue, tree low,
+                           tree high ATTRIBUTE_UNUSED, char *label)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+  /* Calculate the index from the first bit, ie bit 0 represents low value.  */
+  tree index = m2expr_BuildSub (
+      location, m2convert_BuildConvert (location, m2type_GetIntegerType (),
+                                        m2expr_FoldAndStrip (varel), FALSE),
+      m2convert_BuildConvert (location, m2type_GetIntegerType (),
+                              m2expr_FoldAndStrip (low), FALSE),
+      FALSE);
+
+  index = m2expr_FoldAndStrip (index);
+  m2assert_AssertLocation (location);
+
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    m2treelib_do_jump_if_bit (
+        location, EQ_EXPR,
+        m2treelib_get_rvalue (location, varset, type, is_lvalue), index,
+        label);
+  else
+    {
+      tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
+      /* Calculate the index from the first bit.  */
+
+      /* Which word do we need to fetch?  */
+      tree word_index = m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
+          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
+          FALSE));
+      /* Calculate the bit in this word.  */
+      tree offset_into_word = m2expr_FoldAndStrip (m2expr_BuildModTrunc (
+          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
+          FALSE));
+      tree p2 = m2expr_FoldAndStrip (m2expr_BuildMult (
+          location, word_index,
+          m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT), FALSE));
+
+      /* Calculate the address of the word we are interested in.  */
+      p1 = m2expr_BuildAddAddress (location, p1, p2);
+
+      /* Fetch the word, extract the bit and test for == 0.  */
+      m2treelib_do_jump_if_bit (
+          location, EQ_EXPR,
+          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
+          offset_into_word, label);
+    }
+}
+
+/* BuildForeachWordInSetDoIfExpr foreach word in set, type, compute
+   the expression, expr, and if true goto label.  */
+
+void
+m2expr_BuildForeachWordInSetDoIfExpr (location_t location, tree type, tree op1,
+                                      tree op2, int is_op1lvalue,
+                                      int is_op2lvalue, int is_op1const,
+                                      int is_op2const,
+                                      tree (*expr) (location_t, tree, tree),
+                                      char *label)
+{
+  tree p1 = m2treelib_get_set_address_if_var (location, op1, is_op1lvalue,
+                                              is_op1const);
+  tree p2 = m2treelib_get_set_address_if_var (location, op2, is_op2lvalue,
+                                              is_op2const);
+  unsigned int fieldNo = 0;
+  tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
+  tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
+
+  m2assert_AssertLocation (location);
+  ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op1)) == RECORD_TYPE);
+  ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op2)) == RECORD_TYPE);
+
+  while (field1 != NULL && field2 != NULL)
+    {
+      m2statement_DoJump (
+          location,
+          (*expr) (location,
+                   m2treelib_get_set_value (location, p1, field1, is_op1const,
+                                            is_op1lvalue, op1, fieldNo),
+                   m2treelib_get_set_value (location, p2, field2, is_op2const,
+                                            is_op2lvalue, op2, fieldNo)),
+          NULL, label);
+      fieldNo++;
+      field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
+      field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
+    }
+}
+
+/* BuildIfInRangeGoto returns a tree containing if var is in the
+   range low..high then goto label.  */
+
+void
+m2expr_BuildIfInRangeGoto (location_t location, tree var, tree low, tree high,
+                           char *label)
+{
+  m2assert_AssertLocation (location);
+
+  if (m2expr_CompareTrees (low, high) == 0)
+    m2statement_DoJump (location, m2expr_BuildEqualTo (location, var, low),
+                        NULL, label);
+  else
+    m2statement_DoJump (
+        location,
+        m2expr_build_binary_op (
+            location, TRUTH_ANDIF_EXPR,
+            m2expr_BuildGreaterThanOrEqual (location, var, low),
+            m2expr_BuildLessThanOrEqual (location, var, high), FALSE),
+        NULL, label);
+}
+
+/* BuildIfNotInRangeGoto returns a tree containing if var is not in
+   the range low..high then goto label.  */
+
+void
+m2expr_BuildIfNotInRangeGoto (location_t location, tree var, tree low,
+                              tree high, char *label)
+{
+  m2assert_AssertLocation (location);
+
+  if (m2expr_CompareTrees (low, high) == 0)
+    m2statement_DoJump (location, m2expr_BuildNotEqualTo (location, var, low),
+                        NULL, label);
+  else
+    m2statement_DoJump (
+        location, m2expr_build_binary_op (
+                      location, TRUTH_ORIF_EXPR,
+                      m2expr_BuildLessThan (location, var, low),
+                      m2expr_BuildGreaterThan (location, var, high), FALSE),
+        NULL, label);
+}
+
+/* BuildArray - returns a tree which accesses array[index] given,
+   lowIndice.  */
+
+tree
+m2expr_BuildArray (location_t location, tree type, tree array, tree index,
+                   tree low_indice)
+{
+  tree array_type = m2tree_skip_type_decl (TREE_TYPE (array));
+  tree index_type = TYPE_DOMAIN (array_type);
+  type = m2tree_skip_type_decl (type);
+// ASSERT_CONDITION (low_indice == TYPE_MIN_VALUE (index_type));
+
+  low_indice
+      = m2convert_BuildConvert (location, index_type, low_indice, FALSE);
+  return build4_loc (location, ARRAY_REF, type, array, index, low_indice,
+                     NULL_TREE);
+}
+
+/* BuildComponentRef - build a component reference tree which
+   accesses record.field.  If field does not belong to record it
+   calls BuildComponentRef on the penultimate field.  */
+
+tree
+m2expr_BuildComponentRef (location_t location, tree record, tree field)
+{
+  tree recordType = m2tree_skip_reference_type (
+      m2tree_skip_type_decl (TREE_TYPE (record)));
+
+  if (DECL_CONTEXT (field) == recordType)
+    return build3 (COMPONENT_REF, TREE_TYPE (field), record, field, NULL_TREE);
+  else
+    {
+      tree f = determinePenultimateField (recordType, field);
+      return m2expr_BuildComponentRef (
+          location, m2expr_BuildComponentRef (location, record, f), field);
+    }
+}
+
+/* BuildIndirect - build: (*target) given that the object to be
+   copied is of, type.  */
+
+tree
+m2expr_BuildIndirect (location_t location ATTRIBUTE_UNUSED, tree target,
+                      tree type)
+{
+  /* Note that the second argument to build1 is:
+
+     TYPE_QUALS is a list of modifiers such as const or volatile to apply
+     to the pointer type, represented as identifiers.
+
+     it also determines the type of arithmetic and size of the object to
+     be indirectly moved.  */
+
+  tree t1 = m2tree_skip_type_decl (type);
+  tree t2 = build_pointer_type (t1);
+
+  m2assert_AssertLocation (location);
+
+  return build1 (INDIRECT_REF, t1,
+                 m2convert_BuildConvert (location, t2, target, FALSE));
+}
+
+/* IsTrue - returns TRUE if, t, is known to be TRUE.  */
+
+int
+m2expr_IsTrue (tree t)
+{
+  return (m2expr_FoldAndStrip (t) == m2type_GetBooleanTrue ());
+}
+
+/* IsFalse - returns FALSE if, t, is known to be FALSE.  */
+
+int
+m2expr_IsFalse (tree t)
+{
+  return (m2expr_FoldAndStrip (t) == m2type_GetBooleanFalse ());
+}
+
+/* AreConstantsEqual - maps onto tree.cc (tree_int_cst_equal).  It
+   returns TRUE if the value of e1 is the same as e2.  */
+
+int
+m2expr_AreConstantsEqual (tree e1, tree e2)
+{
+  return tree_int_cst_equal (e1, e2) != 0;
+}
+
+/* AreRealOrComplexConstantsEqual - returns TRUE if constants, e1 and
+   e2 are equal according to IEEE rules.  This does not perform bit
+   equivalence for example IEEE states that -0 == 0 and NaN != NaN.  */
+
+int
+m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2)
+{
+  if (TREE_CODE (e1) == COMPLEX_CST)
+    return (m2expr_AreRealOrComplexConstantsEqual (TREE_REALPART (e1),
+                                                   TREE_REALPART (e2))
+            && m2expr_AreRealOrComplexConstantsEqual (TREE_IMAGPART (e1),
+                                                      TREE_IMAGPART (e2)));
+  else
+    return real_compare (EQ_EXPR, &TREE_REAL_CST (e1), &TREE_REAL_CST (e2));
+}
+
+/* DetermineSign, returns -1 if e<0 0 if e==0 1 if e>0
+   an unsigned constant will never return -1.  */
+
+int
+m2expr_DetermineSign (tree e)
+{
+  return tree_int_cst_sgn (e);
+}
+
+/* Similar to build_int_2 () but allows you to specify the type of
+   the integer constant that you are creating.  */
+
+static tree
+build_int_2_type (HOST_WIDE_INT low, HOST_WIDE_INT hi, tree type)
+{
+  tree value;
+  HOST_WIDE_INT ival[3];
+
+  ival[0] = low;
+  ival[1] = hi;
+  ival[2] = 0;
+
+  widest_int wval = widest_int::from_array (ival, 3);
+  value = wide_int_to_tree (type, wval);
+
+  return value;
+}
+
+/* BuildCap - builds the Modula-2 function CAP(t) and returns the
+   result in a gcc Tree.  */
+
+tree
+m2expr_BuildCap (location_t location, tree t)
+{
+  tree tt;
+  tree out_of_range, less_than, greater_than, translated;
+
+  m2assert_AssertLocation (location);
+
+  t = fold (t);
+  if (t == error_mark_node)
+    return error_mark_node;
+
+  tt = TREE_TYPE (t);
+
+  t = fold (convert (m2type_GetM2CharType (), t));
+
+  if (TREE_CODE (tt) == INTEGER_TYPE)
+    {
+      less_than = fold (m2expr_build_binary_op (
+          location, LT_EXPR, t,
+          build_int_2_type ('a', 0, m2type_GetM2CharType ()), 0));
+      greater_than = fold (m2expr_build_binary_op (
+          location, GT_EXPR, t,
+          build_int_2_type ('z', 0, m2type_GetM2CharType ()), 0));
+      out_of_range = fold (m2expr_build_binary_op (
+          location, TRUTH_ORIF_EXPR, less_than, greater_than, 0));
+
+      translated = fold (convert (
+          m2type_GetM2CharType (),
+          m2expr_build_binary_op (
+              location, MINUS_EXPR, t,
+              build_int_2_type ('a' - 'A', 0, m2type_GetM2CharType ()), 0)));
+
+      return fold_build3 (COND_EXPR, m2type_GetM2CharType (), out_of_range, t,
+                          translated);
+    }
+
+  error_at (location,
+            "argument to CAP is not a constant or variable of type CHAR");
+  return error_mark_node;
+}
+
+/* BuildDivM2 if iso or pim4 then build and return ((op2 < 0) : (op1
+   divceil op2) ?  (op1 divfloor op2)) otherwise use divtrunc.  */
+
+tree
+m2expr_BuildDivM2 (location_t location, tree op1, tree op2,
+                   unsigned int needsconvert)
+{
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+  ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
+  if (M2Options_GetPIM4 () || M2Options_GetISO ()
+      || M2Options_GetPositiveModFloor ())
+    return fold_build3 (
+        COND_EXPR, TREE_TYPE (op1),
+        m2expr_BuildLessThan (
+            location, op2,
+            m2convert_BuildConvert (location, TREE_TYPE (op2),
+                                    m2expr_GetIntegerZero (location), FALSE)),
+        m2expr_BuildDivCeil (location, op1, op2, needsconvert),
+        m2expr_BuildDivFloor (location, op1, op2, needsconvert));
+  else
+    return m2expr_BuildDivTrunc (location, op1, op2, needsconvert);
+}
+
+/* BuildDivM2Check - build and
+   return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
+   when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
+   return op1 div trunc op2.  Use the checking div equivalents.  */
+
+tree
+m2expr_BuildDivM2Check (location_t location, tree op1, tree op2,
+			tree lowest, tree min, tree max)
+{
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+  ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
+  if (M2Options_GetISO ()
+      || M2Options_GetPIM4 () || M2Options_GetPositiveModFloor ())
+    return fold_build3 (
+        COND_EXPR, TREE_TYPE (op1),
+        m2expr_BuildLessThan (
+            location, op2,
+            m2convert_BuildConvert (location, TREE_TYPE (op2),
+                                    m2expr_GetIntegerZero (location), FALSE)),
+        m2expr_BuildDivCeilCheck (location, op1, op2, lowest, min, max),
+        m2expr_BuildDivFloorCheck (location, op1, op2, lowest, min, max));
+  else
+    return m2expr_BuildDivTruncCheck (location, op1, op2, lowest, min, max);
+}
+
+static
+tree
+m2expr_BuildISOModM2Check (location_t location,
+			   tree op1, tree op2, tree lowest, tree min, tree max)
+{
+  tree cond = m2expr_BuildLessThan (location, op2,
+				    m2convert_BuildConvert (location, TREE_TYPE (op2),
+							    m2expr_GetIntegerZero (location), FALSE));
+
+  /* Return the result of the modulus.  */
+  return fold_build3 (COND_EXPR, TREE_TYPE (op1), cond,
+		      /* op2 < 0.  */
+		      m2expr_BuildModCeilCheck (location, op1, op2, lowest, min, max),
+		      /* op2 >= 0.  */
+		      m2expr_BuildModFloorCheck (location, op1, op2, lowest, min, max));
+}
+
+
+/* BuildModM2Check if iso or pim4 then build and return ((op2 < 0) : (op1
+   modceil op2) ?  (op1 modfloor op2)) otherwise use modtrunc.
+   Use the checking mod equivalents.  */
+
+tree
+m2expr_BuildModM2Check (location_t location, tree op1, tree op2,
+			tree lowest, tree min, tree max)
+{
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+  ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
+  if (M2Options_GetPIM4 () || M2Options_GetISO ()
+      || M2Options_GetPositiveModFloor ())
+    return m2expr_BuildISOModM2Check (location, op1, op2, lowest, min, max);
+  else
+    return m2expr_BuildModTruncCheck (location, op1, op2, lowest, min, max);
+}
+
+/* BuildModM2 if iso or pim4 then build and return ((op2 < 0) : (op1
+   modceil op2) ?  (op1 modfloor op2)) otherwise use modtrunc.  */
+
+tree
+m2expr_BuildModM2 (location_t location, tree op1, tree op2,
+                   unsigned int needsconvert)
+{
+  op1 = m2expr_FoldAndStrip (op1);
+  op2 = m2expr_FoldAndStrip (op2);
+  ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
+  if (M2Options_GetPIM4 () || M2Options_GetISO ()
+      || M2Options_GetPositiveModFloor ())
+    return fold_build3 (
+        COND_EXPR, TREE_TYPE (op1),
+        m2expr_BuildLessThan (
+            location, op2,
+            m2convert_BuildConvert (location, TREE_TYPE (op2),
+                                    m2expr_GetIntegerZero (location), FALSE)),
+        m2expr_BuildModCeil (location, op1, op2, needsconvert),
+        m2expr_BuildModFloor (location, op1, op2, needsconvert));
+  else
+    return m2expr_BuildModTrunc (location, op1, op2, needsconvert);
+}
+
+/* BuildAbs build the Modula-2 function ABS(t) and return the result
+   in a gcc Tree.  */
+
+tree
+m2expr_BuildAbs (location_t location, tree t)
+{
+  m2assert_AssertLocation (location);
+
+  return m2expr_build_unary_op (location, ABS_EXPR, t, 0);
+}
+
+/* BuildRe build an expression for the function RE.  */
+
+tree
+m2expr_BuildRe (tree op1)
+{
+  op1 = m2expr_FoldAndStrip (op1);
+  if (TREE_CODE (op1) == COMPLEX_CST)
+    return fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
+  else
+    return build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
+}
+
+/* BuildIm build an expression for the function IM.  */
+
+tree
+m2expr_BuildIm (tree op1)
+{
+  op1 = m2expr_FoldAndStrip (op1);
+  if (TREE_CODE (op1) == COMPLEX_CST)
+    return fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
+  else
+    return build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
+}
+
+/* BuildCmplx build an expression for the function CMPLX.  */
+
+tree
+m2expr_BuildCmplx (location_t location, tree type, tree real, tree imag)
+{
+  tree scalor;
+  real = m2expr_FoldAndStrip (real);
+  imag = m2expr_FoldAndStrip (imag);
+  type = m2tree_skip_type_decl (type);
+  scalor = TREE_TYPE (type);
+
+  if (scalor != TREE_TYPE (real))
+    real = m2convert_BuildConvert (location, scalor, real, FALSE);
+  if (scalor != TREE_TYPE (imag))
+    imag = m2convert_BuildConvert (location, scalor, imag, FALSE);
+
+  if ((TREE_CODE (real) == REAL_CST) && (TREE_CODE (imag) == REAL_CST))
+    return build_complex (type, real, imag);
+  else
+    return build2 (COMPLEX_EXPR, type, real, imag);
+}
+
+/* BuildBinaryForeachWordDo implements the large set operators.  Each
+   word of the set can be calculated by binop.  This function runs along
+   each word of the large set invoking the binop.  */
+
+void
+m2expr_BuildBinaryForeachWordDo (location_t location, tree type, tree op1,
+                                 tree op2, tree op3,
+                                 tree (*binop) (location_t, tree, tree, int),
+                                 int is_op1lvalue, int is_op2lvalue,
+                                 int is_op3lvalue, int is_op1const,
+                                 int is_op2const, int is_op3const)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+
+  m2assert_AssertLocation (location);
+
+  ASSERT_BOOL (is_op1lvalue);
+  ASSERT_BOOL (is_op2lvalue);
+  ASSERT_BOOL (is_op3lvalue);
+  ASSERT_BOOL (is_op1const);
+  ASSERT_BOOL (is_op2const);
+  ASSERT_BOOL (is_op3const);
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    m2statement_BuildAssignmentTree (
+        location, m2treelib_get_rvalue (location, op1, type, is_op1lvalue),
+        (*binop) (
+            location, m2treelib_get_rvalue (location, op2, type, is_op2lvalue),
+            m2treelib_get_rvalue (location, op3, type, is_op3lvalue), FALSE));
+  else
+    {
+      /* Large set size > TSIZE(WORD).  */
+
+      tree p2 = m2treelib_get_set_address_if_var (location, op2, is_op2lvalue,
+                                                  is_op2const);
+      tree p3 = m2treelib_get_set_address_if_var (location, op3, is_op3lvalue,
+                                                  is_op3const);
+      unsigned int fieldNo = 0;
+      tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
+      tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
+      tree field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
+
+      if (is_op1const)
+        error_at (
+            location,
+            "internal error: not expecting operand1 to be a constant set");
+
+      while (field1 != NULL && field2 != NULL && field3 != NULL)
+        {
+          m2statement_BuildAssignmentTree (
+              location, m2treelib_get_set_field_des (location, op1, field1),
+              (*binop) (
+                  location,
+                  m2treelib_get_set_value (location, p2, field2, is_op2const,
+                                           is_op2lvalue, op2, fieldNo),
+                  m2treelib_get_set_value (location, p3, field3, is_op3const,
+                                           is_op3lvalue, op3, fieldNo),
+                  FALSE));
+          fieldNo++;
+          field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
+          field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
+          field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
+        }
+    }
+}
+
+/* Append DIGIT to NUM, a number of PRECISION bits being read in base
+   BASE.  */
+
+static int
+append_digit (unsigned HOST_WIDE_INT *low, HOST_WIDE_INT *high,
+              unsigned int digit, unsigned int base)
+{
+  unsigned int shift;
+  int overflow;
+  HOST_WIDE_INT add_high, res_high, test_high;
+  unsigned HOST_WIDE_INT add_low, res_low, test_low;
+
+  switch (base)
+    {
+
+    case 2:
+      shift = 1;
+      break;
+    case 8:
+      shift = 3;
+      break;
+    case 10:
+      shift = 3;
+      break;
+    case 16:
+      shift = 4;
+      break;
+
+    default:
+      shift = 3;
+      error ("internal error: not expecting this base value for a constant");
+    }
+
+  /* Multiply by 2, 8 or 16.  Catching this overflow here means we
+     don't need to worry about add_high overflowing.  */
+  if (((*high) >> (INT_TYPE_SIZE - shift)) == 0)
+    overflow = FALSE;
+  else
+    overflow = TRUE;
+
+  res_high = *high << shift;
+  res_low = *low << shift;
+  res_high |= (*low) >> (INT_TYPE_SIZE - shift);
+
+  if (base == 10)
+    {
+      add_low = (*low) << 1;
+      add_high = ((*high) << 1) + ((*low) >> (INT_TYPE_SIZE - 1));
+    }
+  else
+    add_high = add_low = 0;
+
+  test_low = add_low + digit;
+  if (test_low < add_low)
+    add_high++;
+  add_low += digit;
+
+  test_low = res_low + add_low;
+  if (test_low < res_low)
+    add_high++;
+  test_high = res_high + add_high;
+  if (test_high < res_high)
+    overflow = TRUE;
+
+  *low = res_low + add_low;
+  *high = res_high + add_high;
+
+  return overflow;
+}
+
+/* interpret_integer convert an integer constant into two integer
+   constants.  Heavily borrowed from gcc/cppexp.cc.  */
+
+int
+m2expr_interpret_integer (const char *str, unsigned int base,
+                          unsigned HOST_WIDE_INT *low, HOST_WIDE_INT *high)
+{
+  unsigned const char *p, *end;
+  int overflow = FALSE;
+  int len;
+
+  *low = 0;
+  *high = 0;
+  p = (unsigned const char *)str;
+  len = strlen (str);
+  end = p + len;
+
+  /* Common case of a single digit.  */
+  if (len == 1)
+    *low = p[0] - '0';
+  else
+    {
+      unsigned int c = 0;
+
+      /* We can add a digit to numbers strictly less than this without
+	 needing the precision and slowness of double integers.  */
+
+      unsigned HOST_WIDE_INT max = ~(unsigned HOST_WIDE_INT)0;
+      max = (max - base + 1) / base + 1;
+
+      for (; p < end; p++)
+        {
+          c = *p;
+
+          if (ISDIGIT (c) || (base == 16 && ISXDIGIT (c)))
+            c = hex_value (c);
+          else
+            return overflow;
+
+          /* Strict inequality for when max is set to zero.  */
+          if (*low < max)
+            *low = (*low) * base + c;
+          else
+            {
+              overflow = append_digit (low, high, c, base);
+              max = 0;  /* From now on we always use append_digit.  */
+            }
+        }
+    }
+  return overflow;
+}
+
+/* Append DIGIT to NUM, a number of PRECISION bits being read in base
+   BASE.  */
+
+static int
+append_m2_digit (unsigned int *low, int *high, unsigned int digit,
+                 unsigned int base, int *needsUnsigned)
+{
+  unsigned int shift;
+  int overflow;
+  int add_high, res_high, test_high;
+  unsigned int add_low, res_low, test_low;
+  unsigned int add_uhigh, res_uhigh, test_uhigh;
+
+  switch (base)
+    {
+
+    case 2:
+      shift = 1;
+      break;
+    case 8:
+      shift = 3;
+      break;
+    case 10:
+      shift = 3;
+      break;
+    case 16:
+      shift = 4;
+      break;
+
+    default:
+      shift = 3;
+      error ("internal error: not expecting this base value for a constant");
+    }
+
+  /* Multiply by 2, 8 or 16.  Catching this overflow here means we
+     don't need to worry about add_high overflowing.  */
+  if (((*high) >> (INT_TYPE_SIZE - shift)) == 0)
+    overflow = FALSE;
+  else
+    overflow = TRUE;
+
+  res_high = *high << shift;
+  res_low = *low << shift;
+  res_high |= (*low) >> (INT_TYPE_SIZE - shift);
+
+  if (base == 10)
+    {
+      add_low = (*low) << 1;
+      add_high = ((*high) << 1) + ((*low) >> (INT_TYPE_SIZE - 1));
+    }
+  else
+    add_high = add_low = 0;
+
+  test_low = add_low + digit;
+  if (test_low < add_low)
+    add_high++;
+  add_low += digit;
+
+  test_low = res_low + add_low;
+  if (test_low < res_low)
+    add_high++;
+  test_high = res_high + add_high;
+  if (test_high < res_high)
+    {
+      res_uhigh = res_high;
+      add_uhigh = add_high;
+      test_uhigh = res_uhigh + add_uhigh;
+      if (test_uhigh < res_uhigh)
+	overflow = TRUE;
+      else
+	*needsUnsigned = TRUE;
+    }
+
+  *low = res_low + add_low;
+  *high = res_high + add_high;
+
+  return overflow;
+}
+
+/* interpret_m2_integer convert an integer constant into two integer
+   constants.  Heavily borrowed from gcc/cppexp.cc.  Note that this is a
+   copy of the above code except that it uses `int' rather than
+   HOST_WIDE_INT to allow gm2 to determine what Modula-2 base type to
+   use for this constant and it also sets needsLong and needsUnsigned
+   if an overflow can be avoided by using these techniques.  */
+
+int
+m2expr_interpret_m2_integer (const char *str, unsigned int base,
+                             unsigned int *low, int *high,
+			     int *needsLong, int *needsUnsigned)
+{
+  const unsigned char *p, *end;
+  int len;
+  *needsLong = FALSE;
+  *needsUnsigned = FALSE;
+
+  *low = 0;
+  *high = 0;
+  p = (unsigned const char *)str;
+  len = strlen (str);
+  end = p + len;
+
+  /* Common case of a single digit.  */
+  if (len == 1)
+    *low = p[0] - '0';
+  else
+    {
+      unsigned int c = 0;
+
+      /* We can add a digit to numbers strictly less than this without
+	 needing the precision and slowness of double integers.  */
+
+      unsigned int max = ~(unsigned int)0;
+      max = (max - base + 1) / base + 1;
+
+      for (; p < end; p++)
+        {
+          c = *p;
+
+          if (ISDIGIT (c) || (base == 16 && ISXDIGIT (c)))
+            c = hex_value (c);
+          else
+            return FALSE;  /* End of string and no overflow found.  */
+
+          /* Strict inequality for when max is set to zero.  */
+          if (*low < max)
+            *low = (*low) * base + c;
+          else
+            {
+	      *needsLong = TRUE;
+	      if (append_m2_digit (low, high, c, base,
+				   needsUnsigned))
+		return TRUE;  /* We have overflowed so bail out.  */
+              max = 0;  /* From now on we always use append_digit.  */
+            }
+        }
+    }
+  return FALSE;
+}
+
+/* GetSizeOfInBits return the number of bits used to contain, type.  */
+
+tree
+m2expr_GetSizeOfInBits (tree type)
+{
+  enum tree_code code = TREE_CODE (type);
+
+  if (code == FUNCTION_TYPE)
+    return m2expr_GetSizeOfInBits (ptr_type_node);
+
+  if (code == VOID_TYPE)
+    {
+      error ("%qs applied to a void type", "sizeof");
+      return size_one_node;
+    }
+
+  if (code == VAR_DECL)
+    return m2expr_GetSizeOfInBits (TREE_TYPE (type));
+
+  if (code == PARM_DECL)
+    return m2expr_GetSizeOfInBits (TREE_TYPE (type));
+
+  if (code == TYPE_DECL)
+    return m2expr_GetSizeOfInBits (TREE_TYPE (type));
+
+  if (code == COMPONENT_REF)
+    return m2expr_GetSizeOfInBits (TREE_TYPE (type));
+
+  if (code == ERROR_MARK)
+    return size_one_node;
+
+  if (!COMPLETE_TYPE_P (type))
+    {
+      error ("%qs applied to an incomplete type", "sizeof");
+      return size_zero_node;
+    }
+
+  return m2decl_BuildIntegerConstant (TYPE_PRECISION (type));
+}
+
+/* GetSizeOf taken from c-typeck.cc (c_sizeof).  */
+
+tree
+m2expr_GetSizeOf (location_t location, tree type)
+{
+  enum tree_code code = TREE_CODE (type);
+  m2assert_AssertLocation (location);
+
+  if (code == FUNCTION_TYPE)
+    return m2expr_GetSizeOf (location, m2type_GetPointerType ());
+
+  if (code == VOID_TYPE)
+    return size_one_node;
+
+  if (code == VAR_DECL)
+    return m2expr_GetSizeOf (location, TREE_TYPE (type));
+
+  if (code == PARM_DECL)
+    return m2expr_GetSizeOf (location, TREE_TYPE (type));
+
+  if (code == TYPE_DECL)
+    return m2expr_GetSizeOf (location, TREE_TYPE (type));
+
+  if (code == ERROR_MARK)
+    return size_one_node;
+
+  if (code == CONSTRUCTOR)
+    return m2expr_GetSizeOf (location, TREE_TYPE (type));
+
+  if (code == FIELD_DECL)
+    return m2expr_GetSizeOf (location, TREE_TYPE (type));
+
+  if (code == COMPONENT_REF)
+    return m2expr_GetSizeOf (location, TREE_TYPE (type));
+
+  if (!COMPLETE_TYPE_P (type))
+    {
+      error_at (location, "%qs applied to an incomplete type", "sizeof");
+      return size_zero_node;
+    }
+
+  /* Convert in case a char is more than one unit.  */
+  return size_binop_loc (
+      location, CEIL_DIV_EXPR, TYPE_SIZE_UNIT (type),
+      size_int (TYPE_PRECISION (char_type_node) / BITS_PER_UNIT));
+}
+
+tree
+m2expr_GetIntegerZero (location_t location ATTRIBUTE_UNUSED)
+{
+  return integer_zero_node;
+}
+
+tree
+m2expr_GetIntegerOne (location_t location ATTRIBUTE_UNUSED)
+{
+  return integer_one_node;
+}
+
+tree
+m2expr_GetCardinalOne (location_t location)
+{
+  return m2convert_ToCardinal (location, integer_one_node);
+}
+
+tree
+m2expr_GetCardinalZero (location_t location)
+{
+  return m2convert_ToCardinal (location, integer_zero_node);
+}
+
+tree
+m2expr_GetWordZero (location_t location)
+{
+  return m2convert_ToWord (location, integer_zero_node);
+}
+
+tree
+m2expr_GetWordOne (location_t location)
+{
+  return m2convert_ToWord (location, integer_one_node);
+}
+
+tree
+m2expr_GetPointerZero (location_t location)
+{
+  return m2convert_convertToPtr (location, integer_zero_node);
+}
+
+tree
+m2expr_GetPointerOne (location_t location)
+{
+  return m2convert_convertToPtr (location, integer_one_node);
+}
+
+/* build_set_full_complement return a word size value with all bits
+set to one.  */
+
+static tree
+build_set_full_complement (location_t location)
+{
+  tree value = integer_zero_node;
+  int i;
+
+  m2assert_AssertLocation (location);
+
+  for (i = 0; i < SET_WORD_SIZE; i++)
+    {
+      value = m2expr_BuildLogicalOr (
+          location, value,
+          m2expr_BuildLSL (
+              location, m2expr_GetWordOne (location),
+              m2convert_BuildConvert (location, m2type_GetWordType (),
+                                      m2decl_BuildIntegerConstant (i), FALSE),
+              FALSE),
+          FALSE);
+    }
+  return value;
+}
+
+/* init initialise this module.  */
+
+void
+m2expr_init (location_t location)
+{
+  m2assert_AssertLocation (location);
+
+  set_full_complement = build_set_full_complement (location);
+}
+
+#include "gt-m2-m2expr.h"
diff --git a/gcc/m2/gm2-gcc/m2expr.def b/gcc/m2/gm2-gcc/m2expr.def
new file mode 100644
index 00000000000..e622d31d09b
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2expr.def
@@ -0,0 +1,700 @@
+(* m2expr.def definition module for m2expr.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2expr  ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+
+
+TYPE
+   BuildBinCheckProcedure   = PROCEDURE (location_t, Tree, Tree, Tree, Tree, Tree) : Tree ;
+   BuildBinProcedure        = PROCEDURE (location_t, Tree, Tree, BOOLEAN) : Tree ;
+   BuildUnaryProcedure      = PROCEDURE (location_t, Tree, BOOLEAN) : Tree ;
+   BuildUnaryCheckProcedure = PROCEDURE (location_t, Tree, Tree, Tree, Tree) : Tree ;
+   BuildExprProcedure       = PROCEDURE (location_t, Tree, Tree) : Tree ;
+   BuildSetProcedure        = PROCEDURE (location_t, Tree, Tree, Tree, Tree, BOOLEAN) ;
+   BuildUnarySetProcedure   = PROCEDURE (location_t, Tree, BOOLEAN) ;
+   BuildUnarySetFunction    = PROCEDURE (location_t, Tree, BOOLEAN) : Tree ;
+
+
+(*
+    init - initialise this module.
+*)
+
+PROCEDURE init (location: location_t) ;
+
+
+(*
+   CompareTrees - returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2.
+*)
+
+PROCEDURE CompareTrees (e1: Tree; e2: Tree) : INTEGER ;
+
+
+PROCEDURE GetPointerOne (location: location_t) : Tree ;
+
+
+PROCEDURE GetPointerZero (location: location_t) : Tree ;
+
+
+PROCEDURE GetWordOne (location: location_t) : Tree ;
+
+
+PROCEDURE GetWordZero (location: location_t) : Tree ;
+
+
+PROCEDURE GetIntegerOne (location: location_t) : Tree ;
+
+
+PROCEDURE GetIntegerZero (location: location_t) : Tree ;
+
+
+PROCEDURE GetCardinalOne (location: location_t) : Tree ;
+
+
+PROCEDURE GetCardinalZero (location: location_t) : Tree ;
+
+
+PROCEDURE GetSizeOfInBits (type: Tree) : Tree ;
+
+
+PROCEDURE GetSizeOf (location: location_t; type: Tree) : Tree ;
+
+
+(*
+    BuildLogicalRotate - builds the ISO Modula-2 ROTATE operator
+                         for a fundamental data type.
+*)
+
+PROCEDURE BuildLogicalRotate (location: location_t; op1: Tree; op2: Tree; op3: Tree; nBits: Tree; needconvert: BOOLEAN) ;
+
+
+(*
+    BuildLRRn - builds and returns tree (op1 rotate right by op2 bits)
+                it rotates a set of size, nBits.
+*)
+
+PROCEDURE BuildLRRn (location: location_t; op1: Tree; op2: Tree; nBits: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLRLn - builds and returns tree (op1 rotate left by op2 bits)
+                it rotates a set of size, nBits.
+*)
+
+PROCEDURE BuildLRLn (location: location_t; op1: Tree; op2: Tree; nBits: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+
+PROCEDURE BuildMask (location: location_t; nBits: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildMult - builds a multiplication tree.
+*)
+
+PROCEDURE BuildMult (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildMultCheck - builds a multiplication tree after checking for overflow.
+*)
+
+PROCEDURE BuildMultCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;
+
+
+(*
+    BuildLRR - builds and returns tree (op1 rotate right by op2 bits)
+*)
+
+PROCEDURE BuildLRR (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLRL - builds and returns tree (op1 rotate left by op2 bits)
+*)
+
+PROCEDURE BuildLRL (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLogicalShift - builds the ISO Modula-2 SHIFT operator
+                        for a fundamental data type.
+*)
+
+PROCEDURE BuildLogicalShift (location: location_t; op1: Tree; op2: Tree; op3: Tree; nBits: Tree; needconvert: BOOLEAN) ;
+
+
+(*
+    BuildLSR - builds and returns tree (op1 >> op2)
+*)
+
+PROCEDURE BuildLSR (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLSL - builds and returns tree (op1 << op2)
+*)
+
+PROCEDURE BuildLSL (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+   BuildDivM2 - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
+                when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
+                return op1 div trunc op2
+*)
+
+PROCEDURE BuildDivM2 (location: location_t; op1, op2: Tree; needsconvert: BOOLEAN) : Tree ;
+
+
+(*
+   BuildDivM2Check - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
+                     when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
+                     return op1 div trunc op2.  Use the checking div equivalents.
+*)
+
+PROCEDURE BuildDivM2Check (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;
+
+
+(*
+   BuildModM2 - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
+                when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
+                return op1 div trunc op2
+*)
+
+PROCEDURE BuildModM2 (location: location_t; op1, op2: Tree; needsconvert: BOOLEAN) : Tree ;
+
+
+(*
+   BuildModM2Check - if iso or pim4 then build and return ((op2 < 0) : (op1
+                     modceil op2) ?  (op1 modfloor op2)) otherwise use modtrunc.
+                     Use the checking mod equivalents.
+                     build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
+                     when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
+                     return op1 div trunc op2.  Use the checking div equivalents.
+*)
+
+PROCEDURE BuildModM2Check (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;
+
+
+(*
+    BuildModFloor - builds a modulus tree.
+*)
+
+PROCEDURE BuildModFloor (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildDivCeil - builds a division tree.
+*)
+
+PROCEDURE BuildDivCeil (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildModCeil - builds a modulus tree.
+*)
+
+PROCEDURE BuildModCeil (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildDivFloor - builds a division tree.
+*)
+
+PROCEDURE BuildDivFloor (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildModTrunc - builds a modulus tree.
+*)
+
+PROCEDURE BuildModTrunc (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildDivTrunc - builds a division tree.
+*)
+
+PROCEDURE BuildDivTrunc (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildDivTruncCheck - builds a division tree after checking for overflow.
+*)
+
+PROCEDURE BuildDivTruncCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;
+
+
+(*
+   BuildRDiv - builds a division tree (this should only be used for REAL and COMPLEX
+               types and NEVER for integer based types).
+*)
+
+PROCEDURE BuildRDiv (location: location_t; op1, op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildSubCheck - builds a subtraction tree after checking for overflow.
+*)
+
+PROCEDURE BuildSubCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;
+
+
+(*
+    BuildAddCheck - builds an addition tree after checking for overflow.
+*)
+
+PROCEDURE BuildAddCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;
+
+
+(*
+    BuildSub - builds a subtraction tree.
+*)
+
+PROCEDURE BuildSub (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildAdd - builds an addition tree.
+*)
+
+PROCEDURE BuildAdd (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    FoldAndStrip - return expression, t, after it has been folded (if possible).
+*)
+
+PROCEDURE FoldAndStrip (t: Tree) : Tree ;
+
+
+(*
+    StringLength - returns an unsigned int which is the length
+                   of, string.
+*)
+
+PROCEDURE StringLength (string: Tree) : CARDINAL ;
+
+
+(*
+   TreeOverflow - returns TRUE if the contant expression, t, has
+                  caused an overflow. No error message or warning
+                  is emitted and no modification is made to, t.
+*)
+
+PROCEDURE TreeOverflow (t: Tree) : BOOLEAN ;
+
+
+(*
+    RemoveOverflow - if tree, t, is a constant expression it removes
+                     any overflow flag and returns, t.
+*)
+
+PROCEDURE RemoveOverflow (t: Tree) : Tree ;
+
+
+(*
+    BuildCoerce - returns a tree containing the expression, expr, after
+                  it has been coersed to, type.
+*)
+
+PROCEDURE BuildCoerce (location: location_t; des: Tree; type: Tree; expr: Tree) : Tree ;
+
+
+(*
+    BuildTrunc - returns an integer expression from a REAL or LONGREAL op1.
+*)
+
+PROCEDURE BuildTrunc (op1: Tree) : Tree ;
+
+
+(*
+    BuildNegate - builds a negate expression and returns the tree.
+*)
+
+PROCEDURE BuildNegate (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildNegateCheck - builds a negate expression and returns the tree.
+*)
+
+PROCEDURE BuildNegateCheck (location: location_t; arg, lowest, min, max: Tree) : Tree ;
+
+
+(*
+    BuildSetNegate - builds a set negate expression and returns the tree.
+*)
+
+PROCEDURE BuildSetNegate (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildTBitSize - returns the minimum number of bits to represent, type.
+*)
+
+PROCEDURE BuildTBitSize (location: location_t; type: Tree) : Tree ;
+
+
+(*
+    BuildSize - builds a SIZE function expression and returns the tree.
+*)
+
+PROCEDURE BuildSize (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildAddr - builds an expression which calculates the address of
+                op1 and returns the tree.
+*)
+
+PROCEDURE BuildAddr (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildOffset1 - builds an expression containing the number of bytes the field
+                   is offset from the start of the record structure.
+                   This function is the same as the above, except that it
+                   derives the record from the field and then calls BuildOffset.
+                   The expression is returned.
+*)
+
+PROCEDURE BuildOffset1 (location: location_t; field: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildOffset - builds an expression containing the number of bytes the field
+                  is offset from the start of the record structure.
+                  The expression is returned.
+*)
+
+PROCEDURE BuildOffset (location: location_t; record: Tree; field: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLogicalOrAddress - build a logical or expressions and return the tree.
+*)
+
+PROCEDURE BuildLogicalOrAddress (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLogicalOr - build a logical or expressions and return the tree.
+*)
+
+PROCEDURE BuildLogicalOr (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLogicalAnd - build a logical and expression and return the tree.
+*)
+
+PROCEDURE BuildLogicalAnd (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+
+PROCEDURE BuildSymmetricDifference (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLogicalDifference - build a logical difference expression and
+                             return the tree.
+                             (op1 and (not op2))
+*)
+
+PROCEDURE BuildLogicalDifference (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;
+
+
+(*
+    BuildLessThan - return a tree which computes <
+*)
+
+PROCEDURE BuildLessThan (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildGreaterThan - return a tree which computes >
+*)
+
+PROCEDURE BuildGreaterThan (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildLessThanOrEqual - return a tree which computes <
+*)
+
+PROCEDURE BuildLessThanOrEqual (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildGreaterThanOrEqual - return a tree which computes >=
+*)
+
+PROCEDURE BuildGreaterThanOrEqual (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildEqualTo - return a tree which computes =
+*)
+
+PROCEDURE BuildEqualTo (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+
+PROCEDURE BuildNotEqualTo (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildIsSuperset - return a tree which computes:  op1 & op2 == op2
+*)
+
+PROCEDURE BuildIsSuperset (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildIsNotSuperset - return a tree which computes: op1 & op2 != op2
+*)
+
+PROCEDURE BuildIsNotSuperset (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildIsSubset - return a tree which computes:  op1 & op2 == op1
+*)
+
+PROCEDURE BuildIsSubset (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildIsNotSubset - return a tree which computes: op1 & op2 != op1
+*)
+
+PROCEDURE BuildIsNotSubset (location: location_t; op1: Tree; op2: Tree) : Tree ;
+
+
+(*
+    BuildIfConstInVar - generates: if constel in varset then goto label.
+*)
+
+PROCEDURE BuildIfConstInVar (location: location_t; type: Tree; varset: Tree; constel: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER; label: ADDRESS) ;
+
+
+
+PROCEDURE BuildIfNotConstInVar (location: location_t; type: Tree; varset: Tree; constel: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER; label: ADDRESS) ;
+
+
+(*
+    BuildIfVarInVar - generates: if varel in varset then goto label
+*)
+
+PROCEDURE BuildIfVarInVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree; high: Tree; label: ADDRESS) ;
+
+
+(*
+    BuildIfNotVarInVar - generates: if not (varel in varset) then goto label
+*)
+
+PROCEDURE BuildIfNotVarInVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree; high: Tree; label: ADDRESS) ;
+
+
+(*
+    BuildForeachWordInSetDoIfExpr - foreach word in set, type, compute the expression, expr, and if true
+                                    goto label.
+*)
+
+PROCEDURE BuildForeachWordInSetDoIfExpr (location: location_t;
+                                         type, op1, op2: Tree;
+				         is_op1lvalue, is_op2lvalue,
+				         is_op1const, isop2const: BOOLEAN;
+                                         expr: BuildExprProcedure; label: ADDRESS) ;
+
+
+(*
+    BuildIfInRangeGoto - if var is in the range low..high then goto label
+*)
+
+PROCEDURE BuildIfInRangeGoto (location: location_t; var: Tree; low: Tree; high: Tree; label: ADDRESS) ;
+
+
+(*
+    BuildIfNotInRangeGoto - if var is not in the range low..high then goto label
+*)
+
+PROCEDURE BuildIfNotInRangeGoto (location: location_t; var: Tree; low: Tree; high: Tree; label: ADDRESS) ;
+
+
+(*
+    BuildArray - returns a tree which accesses array[index]
+                 given, lowIndice.
+*)
+
+PROCEDURE BuildArray (location: location_t; type: Tree; array: Tree; index: Tree; lowIndice: Tree) : Tree ;
+
+
+(*
+   BuildComponentRef - build a component reference tree which accesses record.field.
+                       If field does not belong to record it calls
+                       BuildComponentRef on the penultimate field.
+*)
+
+PROCEDURE BuildComponentRef (location: location_t; record: Tree; field: Tree) : Tree ;
+
+
+(*
+    BuildIndirect - build: ( *target) given that the object to be copied is of, type.
+*)
+
+PROCEDURE BuildIndirect (location: location_t; target: Tree; type: Tree) : Tree ;
+
+
+(*
+    IsTrue - returns TRUE if, t, is known to be TRUE.
+*)
+
+PROCEDURE IsTrue (t: Tree) : BOOLEAN ;
+
+
+(*
+    IsFalse - returns FALSE if, t, is known to be FALSE.
+*)
+
+PROCEDURE IsFalse (t: Tree) : BOOLEAN ;
+
+
+(*
+    AreConstantsEqual - maps onto tree.c (tree_int_cst_equal). It returns
+                        TRUE if the value of e1 is the same as e2.
+*)
+
+PROCEDURE AreConstantsEqual (e1: Tree; e2: Tree) : BOOLEAN ;
+
+
+(*
+    AreRealOrComplexConstantsEqual - returns TRUE if constants,
+                                     e1 and e2 are equal according
+                                     to IEEE rules.  This does not
+                                     perform bit equivalence for
+                                     example IEEE states that
+                                     -0 == 0 and NaN != NaN.
+*)
+
+PROCEDURE AreRealOrComplexConstantsEqual (e1: Tree; e2: Tree) : BOOLEAN ;
+
+
+(*
+    DetermineSign - returns -1 if e<0
+                             0 if e==0
+                             1 if e>0
+
+                    an unsigned constant will never return -1
+*)
+
+PROCEDURE DetermineSign (e: Tree) : INTEGER ;
+
+
+(*
+    BuildCap - builds the Modula-2 function CAP(t) and returns
+               the result in a gcc Tree.
+*)
+
+PROCEDURE BuildCap (location: location_t; t: Tree) : Tree ;
+
+
+(*
+    BuildAbs - builds the Modula-2 function ABS(t) and returns
+               the result in a gcc Tree.
+*)
+
+PROCEDURE BuildAbs (location: location_t; t: Tree) : Tree ;
+
+
+(*
+    BuildRe - builds an expression for the function RE.
+*)
+
+PROCEDURE BuildRe (op1: Tree) : Tree ;
+
+
+(*
+    BuildIm - builds an expression for the function IM.
+*)
+
+PROCEDURE BuildIm (op1: Tree) : Tree ;
+
+
+(*
+    BuildCmplx - builds an expression for the function CMPLX.
+*)
+
+PROCEDURE BuildCmplx (location: location_t; type: Tree; real: Tree; imag: Tree) : Tree ;
+
+
+(*
+    BuildBinaryForeachWordDo - provides the large set operators. Each word
+                               (or less) of the set can be calculated by binop.
+                               This procedure runs along each word of the
+                               large set invoking the binop.
+*)
+
+PROCEDURE BuildBinaryForeachWordDo (location: location_t;
+                                    type, op1, op2, op3: Tree;
+                                    binop: BuildBinProcedure;
+                                    is_op1lvalue,
+                                    is_op2lvalue,
+                                    is_op3lvalue,
+                                    is_op1_const,
+                                    is_op2_const,
+                                    is_op3_const: BOOLEAN) ;
+
+(*
+   BuildBinarySetDo - if the size of the set is <= TSIZE(WORD) then
+                         op1 := binop(op2, op3)
+                      else
+                         call m2rtsprocedure(op1, op2, op3)
+*)
+
+PROCEDURE BuildBinarySetDo (location: location_t;
+                            settype, op1, op2, op3: Tree;
+                            binop: BuildSetProcedure;
+                            is_op1lvalue, is_op2lvalue, is_op3lvalue: BOOLEAN;
+                            nBits, unbounded: Tree;
+                            varproc, leftproc, rightproc: Tree) ;
+
+(*
+   ConstantExpressionWarning - issue a warning if the constant has overflowed.
+*)
+
+PROCEDURE ConstantExpressionWarning (value: Tree) ;
+
+
+(*
+   BuildAddAddress - returns an expression op1+op2 where op1 is a pointer type
+                     and op2 is not a pointer type.
+*)
+
+PROCEDURE BuildAddAddress (location: location_t; op1, op2: Tree) : Tree ;
+
+
+END m2expr.
diff --git a/gcc/m2/gm2-gcc/m2expr.h b/gcc/m2/gm2-gcc/m2expr.h
new file mode 100644
index 00000000000..a2156e1bc32
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2expr.h
@@ -0,0 +1,244 @@
+/* m2expr.h header file for m2expr.cc.
+
+Copyright (C) 2012-2022 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(m2expr_h)
+#define m2expr_h
+#if defined(m2expr_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2expr_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2expr_c.  */
+
+EXTERN void m2expr_BuildBinaryForeachWordDo (
+    location_t location, tree type, tree op1, tree op2, tree op3,
+    tree (*binop) (location_t, tree, tree, int), int is_op1lvalue,
+    int is_op2lvalue, int is_op3lvalue, int is_op1const, int is_op2const,
+    int is_op3const);
+EXTERN tree m2expr_BuildCmplx (location_t location, tree type, tree real,
+                               tree imag);
+EXTERN tree m2expr_BuildIm (tree op1);
+EXTERN tree m2expr_BuildRe (tree op1);
+EXTERN tree m2expr_BuildAbs (location_t location, tree t);
+EXTERN tree m2expr_BuildCap (location_t location, tree t);
+EXTERN int m2expr_DetermineSign (tree e);
+EXTERN int m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2);
+EXTERN int m2expr_AreConstantsEqual (tree e1, tree e2);
+EXTERN int m2expr_IsFalse (tree t);
+EXTERN int m2expr_IsTrue (tree t);
+EXTERN tree m2expr_BuildIndirect (location_t location, tree target, tree type);
+EXTERN tree m2expr_BuildComponentRef (location_t location, tree record,
+                                      tree field);
+EXTERN tree m2expr_BuildArray (location_t location, tree type, tree array,
+                               tree index, tree lowIndice);
+EXTERN void m2expr_BuildIfNotInRangeGoto (location_t location, tree var,
+                                          tree low, tree high, char *label);
+EXTERN void m2expr_BuildIfInRangeGoto (location_t location, tree var, tree low,
+                                       tree high, char *label);
+EXTERN void m2expr_BuildForeachWordInSetDoIfExpr (
+    location_t location, tree type, tree op1, tree op2, int is_op1lvalue,
+    int is_op2lvalue, int is_op1const, int is_op2const,
+    tree (*expr) (location_t, tree, tree), char *label);
+EXTERN void m2expr_BuildIfNotVarInVar (location_t location, tree type,
+                                       tree varset, tree varel, int is_lvalue,
+                                       tree low, tree high ATTRIBUTE_UNUSED,
+                                       char *label);
+EXTERN void m2expr_BuildIfVarInVar (location_t location, tree type,
+                                    tree varset, tree varel, int is_lvalue,
+                                    tree low, tree high ATTRIBUTE_UNUSED,
+                                    char *label);
+EXTERN void m2expr_BuildIfNotConstInVar (location_t location, tree type,
+                                         tree varset, tree constel,
+                                         int is_lvalue, int fieldno,
+                                         char *label);
+EXTERN void m2expr_BuildIfConstInVar (location_t location, tree type,
+                                      tree varset, tree constel, int is_lvalue,
+                                      int fieldno, char *label);
+EXTERN tree m2expr_BuildIsNotSubset (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildIsSubset (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildIsNotSuperset (location_t location, tree op1,
+                                       tree op2);
+EXTERN tree m2expr_BuildIsSuperset (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildNotEqualTo (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildEqualTo (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildGreaterThanOrEqual (location_t location, tree op1,
+                                            tree op2);
+EXTERN tree m2expr_BuildLessThanOrEqual (location_t location, tree op1,
+                                         tree op2);
+EXTERN tree m2expr_BuildGreaterThan (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildLessThan (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildLogicalDifference (location_t location, tree op1,
+                                           tree op2, int needconvert);
+EXTERN tree m2expr_BuildSymmetricDifference (location_t location, tree op1,
+                                             tree op2, int needconvert);
+EXTERN tree m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2,
+                                    int needconvert);
+EXTERN tree m2expr_BuildLogicalOr (location_t location, tree op1, tree op2,
+                                   int needconvert);
+EXTERN tree m2expr_BuildLogicalOrAddress (location_t location, tree op1,
+                                          tree op2, int needconvert);
+EXTERN tree m2expr_BuildOffset (location_t location, tree record, tree field,
+                                int needconvert ATTRIBUTE_UNUSED);
+EXTERN tree m2expr_BuildOffset1 (location_t location, tree field,
+                                 int needconvert ATTRIBUTE_UNUSED);
+EXTERN tree m2expr_BuildAddr (location_t location, tree op1, int needconvert);
+EXTERN tree m2expr_BuildSize (location_t location, tree op1,
+                              int needconvert ATTRIBUTE_UNUSED);
+EXTERN tree m2expr_BuildTBitSize (location_t location, tree type);
+EXTERN tree m2expr_BuildSetNegate (location_t location, tree op1,
+                                   int needconvert);
+EXTERN tree m2expr_BuildNegate (location_t location, tree op1,
+                                int needconvert);
+EXTERN tree m2expr_BuildNegateCheck (location_t location, tree arg,
+                                     tree lowest, tree min, tree max);
+EXTERN tree m2expr_BuildTrunc (tree op1);
+EXTERN tree m2expr_BuildCoerce (location_t location, tree des, tree type,
+                                tree expr);
+EXTERN tree m2expr_RemoveOverflow (tree t);
+EXTERN int m2expr_TreeOverflow (tree t);
+
+EXTERN unsigned int m2expr_StringLength (tree string);
+EXTERN tree m2expr_FoldAndStrip (tree t);
+EXTERN int m2expr_interpret_integer (const char *str, unsigned int base,
+                                     unsigned HOST_WIDE_INT *low,
+                                     HOST_WIDE_INT *high);
+EXTERN int m2expr_interpret_m2_integer (const char *str, unsigned int base,
+                                        unsigned int *low, int *high,
+					int *needsLong, int *needsUnsigned);
+
+EXTERN tree m2expr_BuildAddCheck (location_t location, tree op1, tree op2,
+                                  tree lowest, tree min, tree max);
+EXTERN tree m2expr_BuildSubCheck (location_t location, tree op1, tree op2,
+                                  tree lowest, tree min, tree max);
+EXTERN tree m2expr_BuildMultCheck (location_t location, tree op1, tree op2,
+                                   tree lowest, tree min, tree max);
+
+EXTERN tree m2expr_BuildAdd (location_t location, tree op1, tree op2,
+                             int needconvert);
+EXTERN tree m2expr_BuildSub (location_t location, tree op1, tree op2,
+                             int needconvert);
+EXTERN tree m2expr_BuildDivTrunc (location_t location, tree op1, tree op2,
+                                  int needconvert);
+EXTERN tree m2expr_BuildDivTruncCheck (location_t location, tree op1, tree op2,
+				       tree lowest, tree min, tree max);
+EXTERN tree m2expr_BuildModTrunc (location_t location, tree op1, tree op2,
+                                  int needconvert);
+
+EXTERN tree m2expr_BuildDivCeil (location_t location, tree op1, tree op2,
+                                 int needconvert);
+EXTERN tree m2expr_BuildModCeil (location_t location, tree op1, tree op2,
+                                 int needconvert);
+
+EXTERN tree m2expr_BuildDivFloor (location_t location, tree op1, tree op2,
+                                  int needconvert);
+EXTERN tree m2expr_BuildModFloor (location_t location, tree op1, tree op2,
+                                  int needconvert);
+
+EXTERN tree m2expr_BuildDivM2 (location_t location, tree op1, tree op2,
+                               unsigned int needsconvert);
+EXTERN tree m2expr_BuildModM2 (location_t location, tree op1, tree op2,
+                               unsigned int needsconvert);
+EXTERN tree m2expr_BuildDivM2Check (location_t location, tree op1, tree op2,
+			            tree lowest, tree min, tree max);
+
+EXTERN tree m2expr_BuildModM2Check (location_t location, tree op1, tree op2,
+                                  tree lowest, tree min, tree max);
+
+EXTERN tree m2expr_BuildLSL (location_t location, tree op1, tree op2,
+                             int needconvert);
+
+EXTERN tree m2expr_BuildLSR (location_t location, tree op1, tree op2,
+                             int needconvert);
+
+EXTERN void m2expr_BuildLogicalShift (location_t location, tree op1, tree op2,
+                                      tree op3, tree nBits ATTRIBUTE_UNUSED,
+                                      int needconvert);
+
+EXTERN tree m2expr_BuildLRL (location_t location, tree op1, tree op2,
+                             int needconvert);
+
+EXTERN tree m2expr_BuildLRR (location_t location, tree op1, tree op2,
+                             int needconvert);
+EXTERN tree m2expr_BuildMult (location_t location, tree op1, tree op2,
+                              int needconvert);
+
+EXTERN tree m2expr_BuildRRotate (location_t location, tree op1, tree nBits,
+                                 int needconvert);
+EXTERN tree m2expr_BuildLRotate (location_t location, tree op1, tree nBits,
+                                 int needconvert);
+
+EXTERN tree m2expr_BuildMask (location_t location, tree nBits,
+                              int needconvert);
+EXTERN tree m2expr_BuildLRLn (location_t location, tree op1, tree op2,
+                              tree nBits, int needconvert);
+EXTERN tree m2expr_BuildLRRn (location_t location, tree op1, tree op2,
+                              tree nBits, int needconvert);
+EXTERN void m2expr_BuildLogicalRotate (location_t location, tree op1, tree op2,
+                                       tree op3, tree nBits, int needconvert);
+EXTERN void m2expr_BuildBinarySetDo (
+    location_t location, tree settype, tree op1, tree op2, tree op3,
+    void (*binop) (location_t, tree, tree, tree, tree, int), int is_op1lvalue,
+    int is_op2lvalue, int is_op3lvalue, tree nBits, tree unbounded,
+    tree varproc, tree leftproc, tree rightproc);
+
+EXTERN tree m2expr_GetSizeOf (location_t location, tree type);
+EXTERN tree m2expr_GetSizeOfInBits (tree type);
+
+EXTERN tree m2expr_GetCardinalZero (location_t location);
+EXTERN tree m2expr_GetCardinalOne (location_t location);
+EXTERN tree m2expr_GetIntegerZero (location_t location);
+EXTERN tree m2expr_GetIntegerOne (location_t location);
+EXTERN tree m2expr_GetWordZero (location_t location);
+EXTERN tree m2expr_GetWordOne (location_t location);
+EXTERN tree m2expr_GetPointerZero (location_t location);
+EXTERN tree m2expr_GetPointerOne (location_t location);
+
+#if 0
+EXTERN tree m2expr_GetBooleanTrue (void);
+EXTERN tree m2expr_GetBooleanFalse (void);
+#endif
+
+EXTERN int m2expr_CompareTrees (tree e1, tree e2);
+EXTERN tree m2expr_build_unary_op (location_t location ATTRIBUTE_UNUSED,
+                                   enum tree_code code, tree arg,
+                                   int flag ATTRIBUTE_UNUSED);
+EXTERN tree m2expr_build_binary_op (location_t location, enum tree_code code,
+                                    tree op1, tree op2, int convert);
+EXTERN tree m2expr_build_binary_op_check (location_t location,
+                                          enum tree_code code, tree op1,
+                                          tree op2, int needconvert,
+                                          tree lowest, tree min, tree max);
+EXTERN void m2expr_ConstantExpressionWarning (tree value);
+EXTERN tree m2expr_BuildAddAddress (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildRDiv (location_t location, tree op1, tree op2,
+                              int needconvert);
+
+EXTERN void m2expr_init (location_t location);
+
+#undef EXTERN
+#endif  /* m2expr_h.  */
diff --git a/gcc/m2/gm2-gcc/m2linemap.cc b/gcc/m2/gm2-gcc/m2linemap.cc
new file mode 100644
index 00000000000..c1c6e2b58a6
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2linemap.cc
@@ -0,0 +1,254 @@
+/* m2linemap.cc provides an interface to GCC linemaps.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+/* Utilize some of the C build routines */
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2options.h"
+#include "m2tree.h"
+#include "m2type.h"
+#define m2linemap_c
+#include "m2linemap.h"
+
+static int inFile = FALSE;
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+/* Start getting locations from a new file.  */
+
+EXTERN
+void
+m2linemap_StartFile (void *filename, unsigned int linebegin)
+{
+  if (inFile)
+    m2linemap_EndFile ();
+  linemap_add (line_table, LC_ENTER, false,
+               xstrdup (reinterpret_cast<char *> (filename)), linebegin);
+  inFile = TRUE;
+}
+
+/* Tell the line table the file has ended.  */
+
+EXTERN
+void
+m2linemap_EndFile (void)
+{
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
+  inFile = FALSE;
+}
+
+/* Indicate that there is a new source file line number with a
+   maximum width.  */
+
+EXTERN
+void
+m2linemap_StartLine (unsigned int linenumber, unsigned int linesize)
+{
+  linemap_line_start (line_table, linenumber, linesize);
+}
+
+/* GetLocationColumn, returns a location_t based on the current line
+   number and column.  */
+
+EXTERN
+location_t
+m2linemap_GetLocationColumn (unsigned int column)
+{
+  return linemap_position_for_column (line_table, column);
+}
+
+/* GetLocationRange, returns a location based on the start column
+   and end column.  */
+
+EXTERN
+location_t
+m2linemap_GetLocationRange (unsigned int start, unsigned int end)
+{
+  location_t caret = m2linemap_GetLocationColumn (start);
+
+  source_range where;
+  where.m_start = linemap_position_for_column (line_table, start);
+  where.m_finish = linemap_position_for_column (line_table, end);
+  return make_location (caret, where);
+}
+
+
+static
+int
+isSrcLocation (location_t location)
+{
+  return (location != BUILTINS_LOCATION) && (location != UNKNOWN_LOCATION);
+}
+
+
+/* GetLocationBinary, returns a location based on the expression
+   start caret finish locations.  */
+
+EXTERN
+location_t
+m2linemap_GetLocationBinary (location_t caret, location_t start, location_t finish)
+{
+  if (isSrcLocation (start) && isSrcLocation (finish) && isSrcLocation (caret)
+    && (m2linemap_GetFilenameFromLocation (start) != NULL))
+    {
+      linemap_add (line_table, LC_ENTER, false, xstrdup (m2linemap_GetFilenameFromLocation (start)), 1);
+      gcc_assert (inFile);
+      location_t location = make_location (caret, start, finish);
+      return location;
+    }
+  return caret;
+}
+
+/* GetLineNoFromLocation - returns the lineno given a location.  */
+
+EXTERN
+int
+m2linemap_GetLineNoFromLocation (location_t location)
+{
+  if (isSrcLocation (location) && (!M2Options_GetCpp ()))
+    {
+      expanded_location xl = expand_location (location);
+      return xl.line;
+    }
+  return 0;
+}
+
+/* GetColumnNoFromLocation - returns the columnno given a location.  */
+
+EXTERN
+int
+m2linemap_GetColumnNoFromLocation (location_t location)
+{
+  if (isSrcLocation (location) && (!M2Options_GetCpp ()))
+    {
+      expanded_location xl = expand_location (location);
+      return xl.column;
+    }
+  return 0;
+}
+
+/* GetFilenameFromLocation - returns the filename given a location.  */
+
+EXTERN
+const char *
+m2linemap_GetFilenameFromLocation (location_t location)
+{
+  if (isSrcLocation (location) && (!M2Options_GetCpp ()))
+    {
+      expanded_location xl = expand_location (location);
+      return xl.file;
+    }
+  return NULL;
+}
+
+/* ErrorAt - issue an error message.  */
+
+EXTERN
+void
+m2linemap_ErrorAt (location_t location, char *message)
+{
+  error_at (location, message);
+}
+
+/* m2linemap_ErrorAtf - wraps up an error message.  */
+
+void
+m2linemap_ErrorAtf (location_t location, const char *message, ...)
+{
+  diagnostic_info diagnostic;
+  va_list ap;
+  rich_location richloc (line_table, location);
+
+  va_start (ap, message);
+  diagnostic_set_info (&diagnostic, message, &ap, &richloc, DK_ERROR);
+  diagnostic_report_diagnostic (global_dc, &diagnostic);
+  va_end (ap);
+}
+
+/* m2linemap_WarningAtf - wraps up a warning message.  */
+
+void
+m2linemap_WarningAtf (location_t location, const char *message, ...)
+{
+  diagnostic_info diagnostic;
+  va_list ap;
+  rich_location richloc (line_table, location);
+
+  va_start (ap, message);
+  diagnostic_set_info (&diagnostic, message, &ap, &richloc, DK_WARNING);
+  diagnostic_report_diagnostic (global_dc, &diagnostic);
+  va_end (ap);
+}
+
+/* m2linemap_NoteAtf - wraps up a note message.  */
+
+void
+m2linemap_NoteAtf (location_t location, const char *message, ...)
+{
+  diagnostic_info diagnostic;
+  va_list ap;
+  rich_location richloc (line_table, location);
+
+  va_start (ap, message);
+  diagnostic_set_info (&diagnostic, message, &ap, &richloc, DK_NOTE);
+  diagnostic_report_diagnostic (global_dc, &diagnostic);
+  va_end (ap);
+}
+
+/* m2linemap_internal_error - allow Modula-2 to use the GCC internal error.  */
+
+void
+m2linemap_internal_error (const char *message)
+{
+  internal_error (message);
+}
+
+/* UnknownLocation - return the predefined location representing an
+   unknown location.  */
+
+EXTERN
+location_t
+m2linemap_UnknownLocation (void)
+{
+  return UNKNOWN_LOCATION;
+}
+
+/* BuiltinsLocation - return the predefined location representing a
+   builtin.  */
+
+EXTERN
+location_t
+m2linemap_BuiltinsLocation (void)
+{
+  return BUILTINS_LOCATION;
+}
diff --git a/gcc/m2/gm2-gcc/m2linemap.def b/gcc/m2/gm2-gcc/m2linemap.def
new file mode 100644
index 00000000000..2c5d11d1b01
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2linemap.def
@@ -0,0 +1,61 @@
+(* m2linemap.def provides access to GCC location_t.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2linemap ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED StartFile, EndFile, StartLine, GetLocationColumn, GetLocationRange,
+                 GetLocationBinary, UnknownLocation, BuiltinsLocation,
+                 GetLineNoFromLocation, GetColumnNoFromLocation,
+                 GetFilenameFromLocation, ErrorAt, ErrorAtf,
+                 WarningAtf, NoteAtf, internal_error, location_t ;
+
+TYPE
+   location_t = INTEGER ;
+
+
+PROCEDURE StartFile (filename: ADDRESS; linebegin: CARDINAL) ;
+PROCEDURE EndFile ;
+PROCEDURE StartLine (linenumber: CARDINAL; linesize: CARDINAL) ;
+PROCEDURE GetLocationColumn (column: CARDINAL) : location_t ;
+PROCEDURE GetLocationRange (start, end: CARDINAL) : location_t ;
+PROCEDURE GetLocationBinary (caret, left, right: location_t) : location_t ;
+
+PROCEDURE UnknownLocation () : location_t ;
+PROCEDURE BuiltinsLocation () : location_t ;
+
+PROCEDURE GetLineNoFromLocation (location: location_t) : INTEGER ;
+PROCEDURE GetColumnNoFromLocation (location: location_t) : INTEGER ;
+PROCEDURE GetFilenameFromLocation (location: location_t) : ADDRESS ;
+PROCEDURE ErrorAt (location: location_t; message: ADDRESS) ;
+(*
+PROCEDURE ErrorAtf (location: location_t; message: ADDRESS; ...) ;
+PROCEDURE WarningAtf (location: location_t; message: ADDRESS; ...) ;
+PROCEDURE NoteAtf (location: location_t; message: ADDRESS; ...) ;
+*)
+PROCEDURE ErrorAtf (location: location_t; message: ADDRESS) ;
+PROCEDURE WarningAtf (location: location_t; message: ADDRESS) ;
+PROCEDURE NoteAtf (location: location_t; message: ADDRESS) ;
+PROCEDURE internal_error (message: ADDRESS) ;
+
+
+END m2linemap.
diff --git a/gcc/m2/gm2-gcc/m2linemap.h b/gcc/m2/gm2-gcc/m2linemap.h
new file mode 100644
index 00000000000..5de5c2665c9
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2linemap.h
@@ -0,0 +1,72 @@
+/* m2linemap.h header file for m2linemap.cc.
+
+Copyright (C) 2012-2022 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(m2linemap_h)
+
+#include "input.h"
+
+#define m2linemap_h
+#if defined(m2linemap_c)
+#if (__cplusplus)
+#define EXTERN extern "C"
+#else /* !__cplusplus.  */
+#define EXTERN
+#endif /*!__cplusplus.  */
+#else /* !m2linemap_c.  */
+#if (__cplusplus)
+#define EXTERN extern "C"
+#else /* !__cplusplus.  */
+#define EXTERN extern
+#endif /* !__cplusplus.  */
+#endif /* !m2linemap_c.  */
+
+EXTERN void m2linemap_StartFile (void *filename, unsigned int linebegin);
+EXTERN void m2linemap_EndFile (void);
+EXTERN void m2linemap_StartLine (unsigned int linenumber,
+                                 unsigned int linesize);
+EXTERN location_t m2linemap_GetLocationColumn (unsigned int column);
+EXTERN location_t m2linemap_GetLocationRange (unsigned int start, unsigned int end);
+EXTERN location_t m2linemap_GetLocationBinary (location_t caret,
+					       location_t start, location_t finish);
+
+EXTERN location_t m2linemap_UnknownLocation (void);
+EXTERN location_t m2linemap_BuiltinsLocation (void);
+
+EXTERN location_t m2linemap_GetLocationColumn (unsigned int column);
+EXTERN int m2linemap_GetLineNoFromLocation (location_t location);
+EXTERN int m2linemap_GetColumnNoFromLocation (location_t location);
+EXTERN const char *m2linemap_GetFilenameFromLocation (location_t location);
+EXTERN void m2linemap_ErrorAt (location_t location, char *message);
+EXTERN void m2linemap_ErrorAtf (location_t location, const char *message, ...);
+EXTERN void m2linemap_WarningAtf (location_t location, const char *message, ...);
+EXTERN void m2linemap_NoteAtf (location_t location, const char *message, ...);
+EXTERN void m2linemap_internal_error (const char *message);
+
+
+EXTERN location_t UnknownLocation (void);
+EXTERN location_t BuiltinsLocation (void);
+EXTERN void ErrorAt (location_t location, char *message);
+EXTERN void ErrorAtf (location_t location, const char *message, ...);
+EXTERN void WarningAtf (location_t location, const char *message, ...);
+EXTERN void NoteAtf (location_t location, const char *message, ...);
+
+#undef EXTERN
+#endif /* m2linemap_h.  */
diff --git a/gcc/m2/gm2-gcc/m2misc.cc b/gcc/m2/gm2-gcc/m2misc.cc
new file mode 100644
index 00000000000..f1e42bdf67d
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2misc.cc
@@ -0,0 +1,56 @@
+/* m2misc.cc miscellaneous tree debugging functions.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../m2-tree.h"
+#include "tree-iterator.h"
+
+#define m2misc_c
+#include "m2block.h"
+#include "m2misc.h"
+#include "m2tree.h"
+
+/* DebugTree - display the tree, t.  */
+
+void
+m2misc_DebugTree (tree t)
+{
+  debug_tree (t);
+}
+
+/* DebugTree - display the tree, t.  */
+
+void
+m2misc_DebugTreeChain (tree t)
+{
+  for (; (t != NULL); t = TREE_CHAIN (t))
+    debug_tree (t);
+}
+
+/* DebugTree - display the tree, t.  */
+
+void
+m2misc_printStmt (void)
+{
+  if (m2block_cur_stmt_list () != NULL)
+    debug_tree (m2block_cur_stmt_list ());
+}
diff --git a/gcc/m2/gm2-gcc/m2misc.def b/gcc/m2/gm2-gcc/m2misc.def
new file mode 100644
index 00000000000..9accb389a17
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2misc.def
@@ -0,0 +1,29 @@
+(* m2misc.def definition module for m2misc.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2misc ;
+
+FROM m2tree IMPORT Tree ;
+
+PROCEDURE DebugTree (t: Tree) ;
+
+
+END m2misc.
diff --git a/gcc/m2/gm2-gcc/m2misc.h b/gcc/m2/gm2-gcc/m2misc.h
new file mode 100644
index 00000000000..f6f08799b5c
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2misc.h
@@ -0,0 +1,44 @@
+/* m2misc.h header file for m2misc.cc.
+
+Copyright (C) 2012-2022 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(m2misc_h)
+
+#define m2misc_h
+#if defined(m2misc_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else  /* !m2misc_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif  /* !m2misc_c.  */
+
+EXTERN void m2misc_DebugTree (tree t);
+EXTERN void m2misc_printStmt (void);
+EXTERN void m2misc_DebugTreeChain (tree t);
+
+#undef EXTERN
+#endif /* m2misc_h.  */
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
new file mode 100644
index 00000000000..4b32c911b09
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -0,0 +1,126 @@
+/* m2options.h header file for M2Options.mod.
+
+Copyright (C) 2012-2022 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(m2options_h)
+
+#define m2options_h
+#if defined(m2options_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2options_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2options_c.  */
+
+#include "input.h"
+
+EXTERN void M2Options_SetMakeIncludePath (const char *arg);
+EXTERN void M2Options_SetSearchPath (const char *arg);
+EXTERN void M2Options_setdefextension (const char *arg);
+EXTERN void M2Options_setmodextension (const char *arg);
+
+EXTERN void M2Options_SetISO (int value);
+EXTERN void M2Options_SetPIM (int value);
+EXTERN void M2Options_SetPIM2 (int value);
+EXTERN void M2Options_SetPIM3 (int value);
+EXTERN void M2Options_SetPIM4 (int value);
+EXTERN void M2Options_SetFloatValueCheck (int value);
+EXTERN void M2Options_SetWholeValueCheck (int value);
+
+EXTERN int M2Options_GetISO (void);
+EXTERN int M2Options_GetPIM (void);
+EXTERN int M2Options_GetPIM2 (void);
+EXTERN int M2Options_GetPIM3 (void);
+EXTERN int M2Options_GetPIM4 (void);
+EXTERN int M2Options_GetPositiveModFloor (void);
+EXTERN int M2Options_GetFloatValueCheck (void);
+EXTERN int M2Options_GetWholeValueCheck (void);
+
+EXTERN void M2Options_Setc (int value);
+EXTERN int M2Options_Getc (void);
+
+EXTERN void M2Options_SetUselist (int value, const char *filename);
+EXTERN void M2Options_SetAutoInit (int value);
+EXTERN void M2Options_SetPositiveModFloor (int value);
+EXTERN void M2Options_SetNilCheck (int value);
+EXTERN void M2Options_SetWholeDiv (int value);
+EXTERN void M2Options_SetIndex (int value);
+EXTERN void M2Options_SetRange (int value);
+EXTERN void M2Options_SetReturnCheck (int value);
+EXTERN void M2Options_SetCaseCheck (int value);
+EXTERN void M2Options_SetCheckAll (int value);
+EXTERN void M2Options_SetExceptions (int value);
+EXTERN void M2Options_SetStyle (int value);
+EXTERN void M2Options_SetPedantic (int value);
+EXTERN void M2Options_SetPedanticParamNames (int value);
+EXTERN void M2Options_SetPedanticCast (int value);
+EXTERN void M2Options_SetExtendedOpaque (int value);
+EXTERN void M2Options_SetVerboseUnbounded (int value);
+EXTERN void M2Options_SetXCode (int value);
+EXTERN void M2Options_SetCompilerDebugging (int value);
+EXTERN void M2Options_SetQuadDebugging (int value);
+EXTERN void M2Options_SetDebugTraceQuad (int value);
+EXTERN void M2Options_SetDebugTraceAPI (int value);
+EXTERN void M2Options_SetSources (int value);
+EXTERN void M2Options_SetUnboundedByReference (int value);
+EXTERN void M2Options_SetDumpSystemExports (int value);
+EXTERN void M2Options_SetOptimizing (int value);
+EXTERN void M2Options_SetQuiet (int value);
+EXTERN void M2Options_SetCC1Quiet (int value);
+EXTERN void M2Options_SetCpp (int value);
+EXTERN void M2Options_SetSwig (int value);
+EXTERN void M2Options_SetForcedLocation (location_t location);
+EXTERN location_t M2Options_OverrideLocation (location_t location);
+EXTERN void M2Options_SetStatistics (int on);
+EXTERN void M2Options_CppProg (const char *program);
+EXTERN void M2Options_CppArg (const char *opt, const char *arg, int joined);
+EXTERN void M2Options_SetWholeProgram (int value);
+EXTERN void M2Options_FinaliseOptions (void);
+EXTERN void M2Options_SetDebugFunctionLineNumbers (int value);
+EXTERN void M2Options_SetGenerateStatementNote (int value);
+EXTERN int M2Options_GetCpp (void);
+EXTERN int M2Options_GetM2g (void);
+EXTERN void M2Options_SetM2g (int value);
+EXTERN void M2Options_SetLowerCaseKeywords (int value);
+EXTERN void M2Options_SetUnusedVariableChecking (int value);
+EXTERN void M2Options_SetUnusedParameterChecking (int value);
+EXTERN void M2Options_SetStrictTypeChecking (int value);
+EXTERN void M2Options_SetWall (int value);
+EXTERN void M2Options_SetSaveTemps (int value);
+EXTERN void M2Options_SetSaveTempsDir (const char *arg);
+EXTERN int M2Options_GetSaveTemps (void);
+EXTERN void M2Options_SetScaffoldStatic (int value);
+EXTERN void M2Options_SetScaffoldDynamic (int value);
+EXTERN void M2Options_SetScaffoldMain (int value);
+EXTERN void M2Options_SetRuntimeModuleOverride (const char *override);
+EXTERN void M2Options_SetGenModuleList (int value, const char *filename);
+EXTERN void M2Options_SetShared (int value);
+EXTERN void M2Options_SetB (const char *arg);
+EXTERN char *M2Options_GetB (void);
+
+#undef EXTERN
+#endif /* m2options_h.  */
diff --git a/gcc/m2/gm2-gcc/m2range.h b/gcc/m2/gm2-gcc/m2range.h
new file mode 100644
index 00000000000..2cb61d6fc05
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2range.h
@@ -0,0 +1,40 @@
+/* m2range.h header file for M2Range.mod.
+
+Copyright (C) 2012-2022 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(m2range_h)
+#define m2range_h
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+
+EXTERN tree M2Range_BuildIfCallWholeHandlerLoc (location_t location,
+                                                tree condition,
+						const char *scope,
+                                                const char *message);
+EXTERN tree M2Range_BuildIfCallRealHandlerLoc (location_t location,
+                                               tree condition,
+					       const char *scope,
+                                               const char *message);
+
+#undef EXTERN
+#endif /* m2range_h.  */
diff --git a/gcc/m2/gm2-gcc/m2search.h b/gcc/m2/gm2-gcc/m2search.h
new file mode 100644
index 00000000000..d58e97f531d
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2search.h
@@ -0,0 +1,35 @@
+/* m2search.h header file for m2search.c.
+
+Copyright (C) 2012-2022 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(m2search_h)
+
+#define m2search_h
+#if defined(m2search_h)
+#define EXTERN
+#else /* !m2search_h.  */
+#define EXTERN extern
+#endif /* !m2search_h.  */
+
+#include "dynamicstrings.h"
+
+EXTERN void M2Search_PrependSearchPath (dynamicstrings_string *s);
+
+#endif /* m2search_c.  */
diff --git a/gcc/m2/gm2-gcc/m2statement.cc b/gcc/m2/gm2-gcc/m2statement.cc
new file mode 100644
index 00000000000..7462a83f2e5
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2statement.cc
@@ -0,0 +1,955 @@
+/* m2statement.cc provides an interface to GCC statement trees.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+/* Prototypes.  */
+
+#define m2statement_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2statement.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+#include "m2convert.h"
+
+static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
+                                                call/define a function.  */
+static GTY (()) tree last_function = NULL_TREE;
+
+
+/* BuildStartFunctionCode - generate function entry code.  */
+
+void
+m2statement_BuildStartFunctionCode (location_t location, tree fndecl,
+                                    int isexported, int isinline)
+{
+  tree param_decl;
+
+  ASSERT_BOOL (isexported);
+  ASSERT_BOOL (isinline);
+  /* Announce we are compiling this function.  */
+  announce_function (fndecl);
+
+  /* Set up to compile the function and enter it.  */
+
+  DECL_INITIAL (fndecl) = NULL_TREE;
+
+  current_function_decl = fndecl;
+  m2block_pushFunctionScope (fndecl);
+  m2statement_SetBeginLocation (location);
+
+  ASSERT_BOOL ((cfun != NULL));
+  /* Initialize the RTL code for the function.  */
+  allocate_struct_function (fndecl, false);
+  /* Begin the statement tree for this function.  */
+  DECL_SAVED_TREE (fndecl) = NULL_TREE;
+
+  /* Set the context of these parameters to this function.  */
+  for (param_decl = DECL_ARGUMENTS (fndecl); param_decl;
+       param_decl = TREE_CHAIN (param_decl))
+    DECL_CONTEXT (param_decl) = fndecl;
+
+  /* This function exists in static storage.  (This does not mean
+  `static' in the C sense!) */
+  TREE_STATIC (fndecl) = 1;
+  TREE_PUBLIC (fndecl) = isexported;
+  /* We could do better here by detecting ADR
+     or type PROC used on this function.  --fixme--  */
+  TREE_ADDRESSABLE (fndecl) = 1;
+  DECL_DECLARED_INLINE_P (fndecl) = 0; /* isinline;  */
+}
+
+static void
+gm2_gimplify_function_node (tree fndecl)
+{
+  /* Convert all nested functions to GIMPLE now.  We do things in this
+     order so that items like VLA sizes are expanded properly in the
+     context of the correct function.  */
+  struct cgraph_node *cgn;
+
+  dump_function (TDI_original, fndecl);
+  gimplify_function_tree (fndecl);
+
+  cgn = cgraph_node::get_create (fndecl);
+  for (cgn = first_nested_function (cgn);
+       cgn != NULL; cgn = next_nested_function (cgn))
+    gm2_gimplify_function_node (cgn->decl);
+}
+
+/* BuildEndFunctionCode - generates the function epilogue.  */
+
+void
+m2statement_BuildEndFunctionCode (location_t location, tree fndecl, int nested)
+{
+  tree block = DECL_INITIAL (fndecl);
+
+  BLOCK_SUPERCONTEXT (block) = fndecl;
+
+  /* Must mark the RESULT_DECL as being in this function.  */
+  DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+
+  /* And attach it to the function.  */
+  DECL_INITIAL (fndecl) = block;
+
+  m2block_finishFunctionCode (fndecl);
+  m2statement_SetEndLocation (location);
+
+  gm2_genericize (fndecl);
+  if (nested)
+    (void)cgraph_node::get_create (fndecl);
+  else
+    cgraph_node::finalize_function (fndecl, false);
+
+  m2block_popFunctionScope ();
+
+  /* We're leaving the context of this function, so zap cfun.  It's
+     still in DECL_STRUCT_FUNCTION, and we'll restore it in
+     tree_rest_of_compilation.  */
+  set_cfun (NULL);
+  current_function_decl = NULL;
+}
+
+/* BuildPushFunctionContext - pushes the current function context.
+   Maps onto push_function_context in ../function.cc.  */
+
+void
+m2statement_BuildPushFunctionContext (void)
+{
+  push_function_context ();
+}
+
+/* BuildPopFunctionContext - pops the current function context.  Maps
+   onto pop_function_context in ../function.cc.  */
+
+void
+m2statement_BuildPopFunctionContext (void)
+{
+  pop_function_context ();
+}
+
+void
+m2statement_SetBeginLocation (location_t location)
+{
+  if (cfun != NULL)
+    cfun->function_start_locus = location;
+}
+
+void
+m2statement_SetEndLocation (location_t location)
+{
+  if (cfun != NULL)
+    cfun->function_end_locus = location;
+}
+
+/* BuildAssignmentTree builds the assignment of, des, and, expr.
+   It returns, des.  */
+
+tree
+m2statement_BuildAssignmentTree (location_t location, tree des, tree expr)
+{
+  tree result;
+
+  m2assert_AssertLocation (location);
+  STRIP_TYPE_NOPS (expr);
+
+  if (TREE_CODE (expr) == FUNCTION_DECL)
+    result = build2 (MODIFY_EXPR, TREE_TYPE (des), des,
+                     m2expr_BuildAddr (location, expr, FALSE));
+  else
+    {
+      gcc_assert (TREE_CODE (TREE_TYPE (des)) != TYPE_DECL);
+      if (TREE_TYPE (expr) == TREE_TYPE (des))
+        result = build2 (MODIFY_EXPR, TREE_TYPE (des), des, expr);
+      else
+        result = build2 (
+            MODIFY_EXPR, TREE_TYPE (des), des,
+            m2convert_BuildConvert (location, TREE_TYPE (des), expr, FALSE));
+    }
+
+  TREE_SIDE_EFFECTS (result) = 1;
+  add_stmt (location, result);
+  return des;
+}
+
+/* BuildAssignmentStatement builds the assignment of, des, and, expr.  */
+
+void
+m2statement_BuildAssignmentStatement (location_t location, tree des, tree expr)
+{
+  m2statement_BuildAssignmentTree (location, des, expr);
+}
+
+/* BuildGoto builds a goto operation.  */
+
+void
+m2statement_BuildGoto (location_t location, char *name)
+{
+  tree label = m2block_getLabel (location, name);
+
+  m2assert_AssertLocation (location);
+  TREE_USED (label) = 1;
+  add_stmt (location, build1 (GOTO_EXPR, void_type_node, label));
+}
+
+/* DeclareLabel - create a label, name.  */
+
+void
+m2statement_DeclareLabel (location_t location, char *name)
+{
+  tree label = m2block_getLabel (location, name);
+
+  m2assert_AssertLocation (location);
+  add_stmt (location, build1 (LABEL_EXPR, void_type_node, label));
+}
+
+/* BuildParam - build a list of parameters, ready for a subsequent
+   procedure call.  */
+
+void
+m2statement_BuildParam (location_t location, tree param)
+{
+  m2assert_AssertLocation (location);
+
+  if (TREE_CODE (param) == FUNCTION_DECL)
+    param = m2expr_BuildAddr (location, param, FALSE);
+
+  param_list = chainon (build_tree_list (NULL_TREE, param), param_list);
+}
+
+/* nCount - return the number of chained tree nodes in list, t.  */
+
+static int
+nCount (tree t)
+{
+  int i = 0;
+
+  while (t != NULL)
+    {
+      i++;
+      t = TREE_CHAIN (t);
+    }
+  return i;
+}
+
+/* BuildProcedureCallTree - creates a procedure call from a procedure
+   and parameter list and the return type, rettype.  */
+
+tree
+m2statement_BuildProcedureCallTree (location_t location, tree procedure,
+                                    tree rettype)
+{
+  tree functype = TREE_TYPE (procedure);
+  tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype), procedure);
+  tree call;
+  int n = nCount (param_list);
+  tree *argarray = XALLOCAVEC (tree, n);
+  tree t = param_list;
+  int i;
+
+  m2assert_AssertLocation (location);
+  ASSERT_CONDITION (
+      last_function
+      == NULL_TREE); /* Previous function value has not been collected.  */
+  TREE_USED (procedure) = TRUE;
+
+  for (i = 0; i < n; i++)
+    {
+      argarray[i] = TREE_VALUE (t);
+      t = TREE_CHAIN (t);
+    }
+
+  if (rettype == NULL_TREE)
+    {
+      rettype = void_type_node;
+      call = build_call_array_loc (location, rettype, funcptr, n, argarray);
+      TREE_USED (call) = TRUE;
+      TREE_SIDE_EFFECTS (call) = TRUE;
+
+#if defined(DEBUG_PROCEDURE_CALLS)
+      fprintf (stderr, "built the modula-2 call, here is the tree\n");
+      fflush (stderr);
+      debug_tree (call);
+#endif
+
+      param_list
+          = NULL_TREE; /* Ready for the next time we call a procedure.  */
+      last_function = NULL_TREE;
+      return call;
+    }
+  else
+    {
+      last_function = build_call_array_loc (
+          location, m2tree_skip_type_decl (rettype), funcptr, n, argarray);
+      TREE_USED (last_function) = TRUE;
+      TREE_SIDE_EFFECTS (last_function) = TRUE;
+      param_list
+          = NULL_TREE; /* Ready for the next time we call a procedure.  */
+      return last_function;
+    }
+}
+
+/* BuildIndirectProcedureCallTree - creates a procedure call from a
+   procedure and parameter list and the return type, rettype.  */
+
+tree
+m2statement_BuildIndirectProcedureCallTree (location_t location,
+                                            tree procedure, tree rettype)
+{
+  tree call;
+  int n = nCount (param_list);
+  tree *argarray = XALLOCAVEC (tree, n);
+  tree t = param_list;
+  int i;
+
+  m2assert_AssertLocation (location);
+  TREE_USED (procedure) = TRUE;
+  TREE_SIDE_EFFECTS (procedure) = TRUE;
+
+  for (i = 0; i < n; i++)
+    {
+      argarray[i] = TREE_VALUE (t);
+      t = TREE_CHAIN (t);
+    }
+
+  if (rettype == NULL_TREE)
+    {
+      rettype = void_type_node;
+      call = build_call_array_loc (location, rettype, procedure, n, argarray);
+      TREE_USED (call) = TRUE;
+      TREE_SIDE_EFFECTS (call) = TRUE;
+
+#if defined(DEBUG_PROCEDURE_CALLS)
+      fprintf (stderr, "built the modula-2 call, here is the tree\n");
+      fflush (stderr);
+      debug_tree (call);
+#endif
+
+      last_function = NULL_TREE;
+      param_list
+          = NULL_TREE; /* Ready for the next time we call a procedure.  */
+      return call;
+    }
+  else
+    {
+      last_function = build_call_array_loc (
+          location, m2tree_skip_type_decl (rettype), procedure, n, argarray);
+      TREE_USED (last_function) = TRUE;
+      TREE_SIDE_EFFECTS (last_function) = TRUE;
+      param_list
+          = NULL_TREE; /* Ready for the next time we call a procedure.  */
+      return last_function;
+    }
+}
+
+/* BuildFunctValue - generates code for value :=
+   last_function(foobar); */
+
+tree
+m2statement_BuildFunctValue (location_t location, tree value)
+{
+  tree assign
+      = m2treelib_build_modify_expr (location, value, NOP_EXPR, last_function);
+
+  m2assert_AssertLocation (location);
+  ASSERT_CONDITION (
+      last_function
+      != NULL_TREE); /* No value available, possible used before.  */
+
+  TREE_SIDE_EFFECTS (assign) = TRUE;
+  TREE_USED (assign) = TRUE;
+  last_function = NULL_TREE;
+  return assign;
+}
+
+/* BuildCall2 - builds a tree representing: function (arg1, arg2).  */
+
+tree
+m2statement_BuildCall2 (location_t location, tree function, tree rettype,
+                        tree arg1, tree arg2)
+{
+  m2assert_AssertLocation (location);
+  ASSERT_CONDITION (param_list == NULL_TREE);
+
+  param_list = chainon (build_tree_list (NULL_TREE, arg2), param_list);
+  param_list = chainon (build_tree_list (NULL_TREE, arg1), param_list);
+  return m2statement_BuildProcedureCallTree (location, function, rettype);
+}
+
+/* BuildCall3 - builds a tree representing: function (arg1, arg2,
+   arg3).  */
+
+tree
+m2statement_BuildCall3 (location_t location, tree function, tree rettype,
+                        tree arg1, tree arg2, tree arg3)
+{
+  m2assert_AssertLocation (location);
+  ASSERT_CONDITION (param_list == NULL_TREE);
+
+  param_list = chainon (build_tree_list (NULL_TREE, arg3), param_list);
+  param_list = chainon (build_tree_list (NULL_TREE, arg2), param_list);
+  param_list = chainon (build_tree_list (NULL_TREE, arg1), param_list);
+  return m2statement_BuildProcedureCallTree (location, function, rettype);
+}
+
+/* BuildFunctionCallTree - creates a procedure function call from
+   a procedure and parameter list and the return type, rettype.
+   No tree is returned as the tree is held in the last_function global
+   variable.  It is expected the BuildFunctValue is to be called after
+   a call to BuildFunctionCallTree.  */
+
+void
+m2statement_BuildFunctionCallTree (location_t location, tree procedure,
+                                   tree rettype)
+{
+  m2statement_BuildProcedureCallTree (location, procedure, rettype);
+}
+
+/* SetLastFunction - assigns last_function to, t.  */
+
+void
+m2statement_SetLastFunction (tree t)
+{
+  last_function = t;
+}
+
+/* SetParamList - assigns param_list to, t.  */
+
+void
+m2statement_SetParamList (tree t)
+{
+  param_list = t;
+}
+
+/* GetLastFunction - returns, last_function.  */
+
+tree
+m2statement_GetLastFunction (void)
+{
+  return last_function;
+}
+
+/* GetParamList - returns, param_list.  */
+
+tree
+m2statement_GetParamList (void)
+{
+  return param_list;
+}
+
+/* GetCurrentFunction - returns the current_function.  */
+
+tree
+m2statement_GetCurrentFunction (void)
+{
+  return current_function_decl;
+}
+
+/* GetParamTree - return parameter, i.  */
+
+tree
+m2statement_GetParamTree (tree call, unsigned int i)
+{
+  return CALL_EXPR_ARG (call, i);
+}
+
+/* BuildTryFinally - returns a TRY_FINALL_EXPR with the call and
+   cleanups attached.  */
+
+tree
+m2statement_BuildTryFinally (location_t location, tree call, tree cleanups)
+{
+  return build_stmt (location, TRY_FINALLY_EXPR, call, cleanups);
+}
+
+/* BuildCleanUp - return a CLEANUP_POINT_EXPR which will clobber,
+   param.  */
+
+tree
+m2statement_BuildCleanUp (tree param)
+{
+  tree clobber = build_constructor (TREE_TYPE (param), NULL);
+  TREE_THIS_VOLATILE (clobber) = 1;
+  return build2 (MODIFY_EXPR, TREE_TYPE (param), param, clobber);
+}
+
+/* BuildAsm - generates an inline assembler instruction.  */
+
+void
+m2statement_BuildAsm (location_t location, tree instr, int isVolatile,
+                      int isSimple, tree inputs, tree outputs, tree trash,
+                      tree labels)
+{
+  tree string = resolve_asm_operand_names (instr, outputs, inputs, labels);
+  tree args = build_stmt (location, ASM_EXPR, string, outputs, inputs, trash,
+                          labels);
+
+  m2assert_AssertLocation (location);
+
+  /* ASM statements without outputs, including simple ones, are treated
+     as volatile.  */
+  ASM_INPUT_P (args) = isSimple;
+  ASM_VOLATILE_P (args) = isVolatile;
+
+  add_stmt (location, args);
+}
+
+/* BuildUnaryForeachWordDo - provides the large set operators.  Each
+   word (or less) of the set can be calculated by unop.  This
+   procedure runs along each word of the large set invoking the unop.  */
+
+void
+m2statement_BuildUnaryForeachWordDo (location_t location, tree type, tree op1,
+                                     tree op2,
+                                     tree (*unop) (location_t, tree, int),
+                                     int is_op1lvalue, int is_op2lvalue,
+                                     int is_op1const, int is_op2const)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+
+  m2assert_AssertLocation (location);
+  ASSERT_BOOL (is_op1lvalue);
+  ASSERT_BOOL (is_op2lvalue);
+  ASSERT_BOOL (is_op1const);
+  ASSERT_BOOL (is_op2const);
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    m2statement_BuildAssignmentTree (
+        location, m2treelib_get_rvalue (location, op1, type, is_op1lvalue),
+        (*unop) (location,
+                 m2treelib_get_rvalue (location, op2, type, is_op2lvalue),
+                 FALSE));
+  else
+    {
+      /* Large set size > TSIZE(WORD).  */
+      unsigned int fieldNo = 0;
+      tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
+      tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
+
+      if (is_op1const)
+        error ("internal error: not expecting operand1 to be a constant set");
+
+      while (field1 != NULL && field2 != NULL)
+        {
+          m2statement_BuildAssignmentTree (
+              location, m2treelib_get_set_field_des (location, op1, field1),
+              (*unop) (location,
+                       m2treelib_get_set_field_rhs (location, op2, field2),
+                       FALSE));
+          fieldNo++;
+          field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
+          field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
+        }
+    }
+}
+
+/* BuildExcludeVarConst - builds the EXCL(op1, 1<<op2) operation for
+   a small sets.  Large sets call this routine to exclude the bit in
+   the particular word.  op2 is a constant.  */
+
+void
+m2statement_BuildExcludeVarConst (location_t location, tree type, tree op1,
+                                  tree op2, int is_lvalue, int fieldno)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+
+  m2assert_AssertLocation (location);
+  ASSERT_BOOL (is_lvalue);
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    {
+      /* Small set size <= TSIZE(WORD).  */
+      m2statement_BuildAssignmentTree (
+          location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
+          m2expr_BuildLogicalAnd (
+              location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
+              m2expr_BuildSetNegate (
+                  location,
+                  m2expr_BuildLSL (location, m2expr_GetWordOne (location), op2,
+                                   FALSE),
+                  FALSE),
+              FALSE));
+    }
+  else
+    {
+      tree fieldlist = TYPE_FIELDS (type);
+      tree field;
+
+      for (field = fieldlist; (field != NULL) && (fieldno > 0);
+           field = TREE_CHAIN (field))
+        fieldno--;
+
+      m2statement_BuildAssignmentTree (
+          location, m2treelib_get_set_field_des (location, op1, field),
+          m2expr_BuildLogicalAnd (
+              location, m2treelib_get_set_field_rhs (location, op1, field),
+              m2expr_BuildSetNegate (
+                  location,
+                  m2expr_BuildLSL (location, m2expr_GetWordOne (location), op2,
+                                   FALSE),
+                  FALSE),
+              FALSE));
+    }
+}
+
+/* BuildExcludeVarVar - builds the EXCL(varset, 1<<varel) operation
+   for a small and large sets.  varel is a variable.  */
+
+void
+m2statement_BuildExcludeVarVar (location_t location, tree type, tree varset,
+                                tree varel, int is_lvalue, tree low)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+
+  m2assert_AssertLocation (location);
+  ASSERT_BOOL (is_lvalue);
+  /* Calculate the index from the first bit, ie bit 0 represents low value.  */
+  tree index
+      = m2expr_BuildSub (location, m2convert_ToInteger (location, varel),
+                         m2convert_ToInteger (location, low), FALSE);
+
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    m2statement_BuildAssignmentTree (
+        location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
+        m2expr_BuildLogicalAnd (
+            location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
+            m2expr_BuildSetNegate (
+                location,
+                m2expr_BuildLSL (location, m2expr_GetWordOne (location),
+                                 m2convert_ToWord (location, index), FALSE),
+                FALSE),
+            FALSE));
+  else
+    {
+      tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
+      /* Calculate the index from the first bit.  */
+
+      /* Which word do we need to fetch?  */
+      tree word_index = m2expr_BuildDivTrunc (
+          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), FALSE);
+      /* Calculate the bit in this word.  */
+      tree offset_into_word = m2expr_BuildModTrunc (
+          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), FALSE);
+
+      tree v1;
+
+      /* Calculate the address of the word we are interested in.  */
+      p1 = m2expr_BuildAddAddress (
+          location, m2convert_convertToPtr (location, p1),
+          m2expr_BuildMult (
+              location, word_index,
+              m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT),
+              FALSE));
+
+      v1 = m2expr_BuildLogicalAnd (
+          location,
+          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
+          m2expr_BuildSetNegate (
+              location,
+              m2expr_BuildLSL (location, m2expr_GetWordOne (location),
+                               m2convert_ToWord (location, offset_into_word),
+                               FALSE),
+              FALSE),
+          FALSE);
+
+      /* Set bit offset_into_word within the word pointer at by p1.  */
+      m2statement_BuildAssignmentTree (
+          location,
+          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
+          m2convert_ToBitset (location, v1));
+    }
+}
+
+/* BuildIncludeVarConst - builds the INCL(op1, 1<<op2) operation for
+   a small sets.  Large sets call this routine to include the bit in
+   the particular word.  op2 is a constant.  */
+
+void
+m2statement_BuildIncludeVarConst (location_t location, tree type, tree op1,
+                                  tree op2, int is_lvalue, int fieldno)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+
+  m2assert_AssertLocation (location);
+  ASSERT_BOOL (is_lvalue);
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    {
+      /* Small set size <= TSIZE(WORD).  */
+      m2statement_BuildAssignmentTree (
+          location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
+          m2expr_BuildLogicalOr (
+              location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
+              m2expr_BuildLSL (location, m2expr_GetWordOne (location),
+                               m2convert_ToWord (location, op2), FALSE),
+              FALSE));
+    }
+  else
+    {
+      tree fieldlist = TYPE_FIELDS (type);
+      tree field;
+
+      for (field = fieldlist; (field != NULL) && (fieldno > 0);
+           field = TREE_CHAIN (field))
+        fieldno--;
+
+      m2statement_BuildAssignmentTree (
+          location,
+          /* Would like to use: m2expr_BuildComponentRef (location, p, field)
+             but strangely we have to take the address of the field and
+             dereference it to satify the gimplifier.  See
+             testsuite/gm2/pim/pass/timeio?.mod for testcases.  */
+          m2treelib_get_set_field_des (location, op1, field),
+          m2expr_BuildLogicalOr (
+              location, m2treelib_get_set_field_rhs (location, op1, field),
+              m2expr_BuildLSL (location, m2expr_GetWordOne (location),
+                               m2convert_ToWord (location, op2), FALSE),
+              FALSE));
+    }
+}
+
+/* BuildIncludeVarVar - builds the INCL(varset, 1<<varel) operation
+   for a small and large sets.  op2 is a variable.  */
+
+void
+m2statement_BuildIncludeVarVar (location_t location, tree type, tree varset,
+                                tree varel, int is_lvalue, tree low)
+{
+  tree size = m2expr_GetSizeOf (location, type);
+
+  m2assert_AssertLocation (location);
+  ASSERT_BOOL (is_lvalue);
+  /* Calculate the index from the first bit, ie bit 0 represents low value.  */
+  tree index
+      = m2expr_BuildSub (location, m2convert_ToInteger (location, varel),
+                         m2convert_ToInteger (location, low), FALSE);
+  tree indexw = m2convert_ToWord (location, index);
+
+  if (m2expr_CompareTrees (
+          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
+      <= 0)
+    /* Small set size <= TSIZE(WORD).  */
+    m2statement_BuildAssignmentTree (
+        location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
+        m2convert_ToBitset (
+            location,
+            m2expr_BuildLogicalOr (
+                location,
+                m2treelib_get_rvalue (location, varset, type, is_lvalue),
+                m2expr_BuildLSL (location, m2expr_GetWordOne (location),
+                                 indexw, FALSE),
+                FALSE)));
+  else
+    {
+      tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
+      /* Which word do we need to fetch?  */
+      tree word_index = m2expr_BuildDivTrunc (
+          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), FALSE);
+      /* Calculate the bit in this word.  */
+      tree offset_into_word = m2convert_BuildConvert (
+          location, m2type_GetWordType (),
+          m2expr_BuildModTrunc (location, index,
+                                m2decl_BuildIntegerConstant (SET_WORD_SIZE),
+                                FALSE),
+          FALSE);
+      tree v1;
+
+      /* Calculate the address of the word we are interested in.  */
+      p1 = m2expr_BuildAddAddress (
+          location, m2convert_convertToPtr (location, p1),
+          m2expr_BuildMult (
+              location, word_index,
+              m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT),
+              FALSE));
+      v1 = m2expr_BuildLogicalOr (
+          location,
+          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
+          m2convert_ToBitset (location,
+                              m2expr_BuildLSL (location,
+                                               m2expr_GetWordOne (location),
+                                               offset_into_word, FALSE)),
+          FALSE);
+
+      /* Set bit offset_into_word within the word pointer at by p1.  */
+      m2statement_BuildAssignmentTree (
+          location,
+          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
+          m2convert_ToBitset (location, v1));
+    }
+}
+
+/* BuildStart - creates a module initialization function.  We make
+   this function public if it is not an inner module.  The linker
+   will create a call list for all linked modules which determines
+   the initialization sequence for all modules.  */
+
+tree
+m2statement_BuildStart (location_t location, char *name, int inner_module)
+{
+  tree fntype;
+  tree fndecl;
+
+  m2assert_AssertLocation (location);
+  /* The function type depends on the return type and type of args.  */
+  fntype = build_function_type (integer_type_node, NULL_TREE);
+  fndecl = build_decl (location, FUNCTION_DECL, get_identifier (name), fntype);
+
+  DECL_EXTERNAL (fndecl) = 0;
+  if (inner_module)
+    TREE_PUBLIC (fndecl) = 0;
+  else
+    TREE_PUBLIC (fndecl) = 1;
+
+  TREE_STATIC (fndecl) = 1;
+  DECL_RESULT (fndecl)
+      = build_decl (location, RESULT_DECL, NULL_TREE, integer_type_node);
+  DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+
+  /* Prevent the optimizer from removing it if it is public.  */
+  if (TREE_PUBLIC (fndecl))
+    gm2_mark_addressable (fndecl);
+
+  m2statement_BuildStartFunctionCode (location, fndecl, !inner_module,
+                                      inner_module);
+  return fndecl;
+}
+
+/* BuildEnd - complete the initialization function for this module.  */
+
+void
+m2statement_BuildEnd (location_t location, tree fndecl, int nested)
+{
+  m2statement_BuildEndFunctionCode (location, fndecl, nested);
+  current_function_decl = NULL;
+  set_cfun (NULL);
+}
+
+/* BuildCallInner - call the inner module function.  It has no
+   parameters and no return value.  */
+
+void
+m2statement_BuildCallInner (location_t location, tree fndecl)
+{
+  m2assert_AssertLocation (location);
+  param_list = NULL_TREE;
+  add_stmt (location,
+            m2statement_BuildProcedureCallTree (location, fndecl, NULL_TREE));
+}
+
+
+/* BuildIfThenDoEnd - returns a tree which will only execute
+   statement, s, if, condition, is true.  */
+
+tree
+m2statement_BuildIfThenDoEnd (tree condition, tree then_block)
+{
+  if (then_block == NULL_TREE)
+    return NULL_TREE;
+  else
+    return fold_build3 (COND_EXPR, void_type_node, condition, then_block,
+                        alloc_stmt_list ());
+}
+
+/* BuildIfThenElseEnd - returns a tree which will execute then_block
+   or else_block depending upon, condition.  */
+
+tree
+m2statement_BuildIfThenElseEnd (tree condition, tree then_block,
+                                tree else_block)
+{
+  if (then_block == NULL_TREE)
+    return NULL_TREE;
+  else
+    return fold_build3 (COND_EXPR, void_type_node, condition, then_block,
+                        else_block);
+}
+
+/* BuildReturnValueCode - generates the code associated with: RETURN(
+   value ) */
+
+void
+m2statement_BuildReturnValueCode (location_t location, tree fndecl, tree value)
+{
+  tree ret_stmt;
+  tree t;
+
+  m2assert_AssertLocation (location);
+  t = build2 (
+      MODIFY_EXPR, TREE_TYPE (DECL_RESULT (fndecl)), DECL_RESULT (fndecl),
+      m2convert_BuildConvert (
+          location, m2tree_skip_type_decl (TREE_TYPE (DECL_RESULT (fndecl))),
+          value, FALSE));
+
+  ret_stmt = build_stmt (location, RETURN_EXPR, t);
+  add_stmt (location, ret_stmt);
+}
+
+/* DoJump - jump to the appropriate label depending whether result of
+   the expression is TRUE or FALSE.  */
+
+void
+m2statement_DoJump (location_t location, tree exp, char *falselabel,
+                    char *truelabel)
+{
+  tree c = NULL_TREE;
+
+  m2assert_AssertLocation (location);
+  if (TREE_CODE (TREE_TYPE (exp)) != BOOLEAN_TYPE)
+    exp = convert_loc (location, m2type_GetBooleanType (), exp);
+
+  if ((falselabel != NULL) && (truelabel == NULL))
+    {
+      m2block_push_statement_list (m2block_begin_statement_list ());
+
+      m2statement_BuildGoto (location, falselabel);
+      c = build3 (COND_EXPR, void_type_node, exp,
+                  m2block_pop_statement_list (),
+                  alloc_stmt_list ());
+    }
+  else if ((falselabel == NULL) && (truelabel != NULL))
+    {
+      m2block_push_statement_list (m2block_begin_statement_list ());
+
+      m2statement_BuildGoto (location, truelabel);
+      c = build3 (COND_EXPR, void_type_node, exp,
+                  m2block_pop_statement_list (),
+                  alloc_stmt_list ());
+    }
+  else
+    error_at (location, "expecting one and only one label to be declared");
+  if (c != NULL_TREE)
+    add_stmt (location, c);
+}
+
+#include "gt-m2-m2statement.h"
diff --git a/gcc/m2/gm2-gcc/m2statement.def b/gcc/m2/gm2-gcc/m2statement.def
new file mode 100644
index 00000000000..774d772cd7f
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2statement.def
@@ -0,0 +1,312 @@
+(* m2statement.def definition module for m2statement.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2statement ;
+
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+FROM m2expr IMPORT BuildUnarySetFunction ;
+
+
+(*
+   DoJump - jump to the appropriate label depending whether
+            result of the expression is TRUE or FALSE.
+*)
+
+PROCEDURE DoJump (location: location_t; exp: Tree; falselabel: ADDRESS; truelabel: ADDRESS) ;
+
+
+(*
+   BuildStartFunctionCode - generate function entry code.
+*)
+
+PROCEDURE BuildStartFunctionCode (location: location_t; fndecl: Tree; isexported: BOOLEAN; isinline: BOOLEAN) ;
+
+
+(*
+   BuildEndFunctionCode - generates the function epilogue.
+*)
+
+PROCEDURE BuildEndFunctionCode (location: location_t; fndecl: Tree; nested: BOOLEAN) ;
+
+
+(*
+   BuildReturnValueCode - generates the code associated with: RETURN( value )
+*)
+
+PROCEDURE BuildReturnValueCode (location: location_t; fndecl: Tree; value: Tree) ;
+
+
+(*
+   BuildPushFunctionContext - pushes the current function context.
+                              Maps onto push_function_context in ../function.c
+*)
+
+PROCEDURE BuildPushFunctionContext ;
+
+
+(*
+   BuildPopFunctionContext - pops the current function context.
+                             Maps onto pop_function_context in ../function.c
+*)
+
+PROCEDURE BuildPopFunctionContext ;
+
+
+(*
+   BuildAssignmentTree - builds the assignment of, des, and, expr.
+                         It returns, des.
+*)
+
+PROCEDURE BuildAssignmentTree (location: location_t; des, expr: Tree) : Tree ;
+
+
+(*
+   BuildAssignmentStatement builds the assignment of, des, and, expr.
+*)
+
+PROCEDURE BuildAssignmentStatement (location: location_t; des, expr: Tree) ;
+
+
+(*
+   BuildGoto - builds a goto operation.
+*)
+
+PROCEDURE BuildGoto (location: location_t; name: ADDRESS) ;
+
+
+(*
+   DeclareLabel - create a label, name.
+*)
+
+PROCEDURE DeclareLabel (location: location_t; name: ADDRESS) ;
+
+
+(*
+   BuildIfThenDoEnd - returns a tree which will only execute
+                      statement, s, if, condition, is true.
+*)
+
+PROCEDURE BuildIfThenDoEnd (condition: Tree; then_block: Tree) : Tree ;
+
+
+(*
+   BuildIfThenElseEnd - returns a tree which will execute
+                        then_block or else_block depending upon,
+                        condition.
+*)
+
+PROCEDURE BuildIfThenElseEnd (condition: Tree; then_block: Tree; else_block: Tree) : Tree ;
+
+
+(*
+   BuildParam - build a list of parameters, ready for a subsequent procedure call.
+*)
+
+PROCEDURE BuildParam (location: location_t; param: Tree) ;
+
+
+(*
+   BuildFunctionCallTree - creates a procedure function call from
+                           a procedure and parameter list and the
+                           return type, rettype.  No tree is returned
+                           as the tree is held in the last_function
+                           global variable.  It is expected the
+                           BuildFunctValue is to be called after
+                           a call to BuildFunctionCallTree.
+*)
+
+PROCEDURE BuildFunctionCallTree (location: location_t; procedure: Tree; rettype: Tree) ;
+
+
+(*
+   BuildProcedureCallTree - creates a procedure call from a procedure and
+                            parameter list and the return type, rettype.
+*)
+
+PROCEDURE BuildProcedureCallTree (location: location_t; procedure: Tree; rettype: Tree) : Tree ;
+
+
+(*
+   BuildIndirectProcedureCallTree - creates a procedure call from a procedure and
+                                    parameter list and the return type, rettype.
+*)
+
+PROCEDURE BuildIndirectProcedureCallTree (location: location_t; procedure: Tree; rettype: Tree) : Tree ;
+
+
+(*
+   BuildFunctValue - generates code for value := last_function(foobar);
+*)
+
+PROCEDURE BuildFunctValue (location: location_t; value: Tree) : Tree ;
+
+
+(*
+   BuildCall2 - builds a tree representing:  function(arg1, arg2).
+*)
+
+PROCEDURE BuildCall2 (location: location_t;
+                      function, rettype, arg1, arg2: Tree) : Tree ;
+
+
+(*
+   BuildCall3 - builds a tree representing:  function(arg1, arg2, arg3).
+*)
+
+PROCEDURE BuildCall3 (location: location_t;
+                      function, rettype, arg1, arg2, arg3: Tree) : Tree ;
+
+
+(*
+   SetLastFunction - set the last_function to, t.
+*)
+
+PROCEDURE SetLastFunction (t: Tree) ;
+
+
+(*
+   GetLastFunction - returns, last_function.
+*)
+
+PROCEDURE GetLastFunction () : Tree ;
+
+
+(*
+   GetParamTree - return parameter, i.
+*)
+
+PROCEDURE GetParamTree (call: Tree; i: CARDINAL) : Tree ;
+
+
+(*
+   BuildTryFinally - returns a TRY_FINALL_EXPR with the call and cleanups
+                     attached.
+*)
+
+PROCEDURE BuildTryFinally (location: location_t; call: Tree; cleanups: Tree) : Tree ;
+
+
+(*
+   BuildCleanUp - return a CLEANUP_POINT_EXPR which will clobber, param.
+*)
+
+PROCEDURE BuildCleanUp (param: Tree) : Tree ;
+
+
+(*
+    BuildAsm - generates an inline assembler instruction.
+*)
+
+PROCEDURE BuildAsm (location: location_t; instr: Tree;
+                    isVolatile: BOOLEAN; isSimple: BOOLEAN;
+                    inputs: Tree; outputs: Tree; trash: Tree; labels: Tree) ;
+
+
+(*
+    BuildUnaryForeachWordDo - provides the large set operators.
+                              Each word (or less) of the set can be
+                              calculated by unop.
+                              This procedure iterates over each word
+                              of the large set invoking the unop.
+*)
+
+PROCEDURE BuildUnaryForeachWordDo (location: location_t; type: Tree; op1: Tree; op2: Tree;
+                                   unop: BuildUnarySetFunction;
+                                   is_op1lvalue, is_op2lvalue, is_op1const, is_op2const: BOOLEAN) ;
+
+
+(*
+    BuildExcludeVarConst - builds the EXCL(op1, 1<<op2) operation for a small sets. Large
+                           sets call this routine to exclude the bit in the particular word.
+                           op2 is a constant.
+*)
+
+PROCEDURE BuildExcludeVarConst (location: location_t; type: Tree; op1: Tree; op2: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER) ;
+
+
+(*
+    BuildExcludeVarVar - builds the EXCL(varset, 1<<varel) operation for a small and large sets.
+                         varel is a variable.
+*)
+
+PROCEDURE BuildExcludeVarVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree) ;
+
+
+(*
+    BuildIncludeVarConst - builds the INCL(op1, 1<<op2) operation for a small sets. Large
+                           sets call this routine to include the bit in the particular word.
+                           op2 is a constant.
+*)
+
+PROCEDURE BuildIncludeVarConst (location: location_t; type: Tree; op1: Tree; op2: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER) ;
+
+
+(*
+    BuildIncludeVarVar - builds the INCL(varset, 1<<varel) operation for a small and large sets.
+                         op2 is a variable.
+*)
+
+PROCEDURE BuildIncludeVarVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree) ;
+
+
+(*
+    BuildStart - creates a module initialization function. We make
+                 this function public if it is not an inner module.
+                 The linker will create a call list for all linked
+                 modules which determines the initialization
+                 sequence for all modules.
+*)
+
+PROCEDURE BuildStart (location: location_t; name: ADDRESS; inner_module: BOOLEAN) : Tree ;
+
+
+(*
+    BuildEnd - complete the initialisation function for this module.
+*)
+
+PROCEDURE BuildEnd (location: location_t; fndecl: Tree; nested: BOOLEAN) ;
+
+
+(*
+    BuildCallInner - call the inner module function.  It has no parameters and no return value.
+*)
+
+PROCEDURE BuildCallInner (location: location_t; fndecl: Tree) ;
+
+
+(*
+   SetBeginLocation - sets the begin location for the function to obtain good debugging info.
+*)
+
+PROCEDURE SetBeginLocation (location: location_t) ;
+
+
+(*
+   SetEndLocation - sets the end location for the function to obtain good debugging info.
+*)
+
+PROCEDURE SetEndLocation (location: location_t) ;
+
+
+END m2statement.
diff --git a/gcc/m2/gm2-gcc/m2statement.h b/gcc/m2/gm2-gcc/m2statement.h
new file mode 100644
index 00000000000..48240768bf5
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2statement.h
@@ -0,0 +1,111 @@
+/* m2statement.h header file for m2statement.cc.
+
+Copyright (C) 2012-2022 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(m2statement_h)
+#define m2statement_h
+#if defined(m2statement_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2statement_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2statement_c.  */
+
+EXTERN void m2statement_BuildCallInner (location_t location, tree fndecl);
+EXTERN void m2statement_BuildEnd (location_t location, tree fndecl,
+                                  int nested);
+EXTERN tree m2statement_BuildStart (location_t location, char *name,
+                                    int inner_module);
+EXTERN void m2statement_BuildIncludeVarVar (location_t location, tree type,
+                                            tree varset, tree varel,
+                                            int is_lvalue, tree low);
+EXTERN void m2statement_BuildIncludeVarConst (location_t location, tree type,
+                                              tree op1, tree op2,
+                                              int is_lvalue, int fieldno);
+EXTERN void m2statement_BuildExcludeVarVar (location_t location, tree type,
+                                            tree varset, tree varel,
+                                            int is_lvalue, tree low);
+EXTERN void m2statement_BuildExcludeVarConst (location_t location, tree type,
+                                              tree op1, tree op2,
+                                              int is_lvalue, int fieldno);
+EXTERN void m2statement_BuildUnaryForeachWordDo (
+    location_t location, tree type, tree op1, tree op2,
+    tree (*unop) (location_t, tree, int), int is_op1lvalue, int is_op2lvalue,
+    int is_op1const, int is_op2const);
+EXTERN void m2statement_BuildAsm (location_t location, tree instr,
+                                  int isVolatile, int isSimple, tree inputs,
+                                  tree outputs, tree trash, tree labels);
+EXTERN tree m2statement_BuildFunctValue (location_t location, tree value);
+EXTERN tree m2statement_BuildIndirectProcedureCallTree (location_t location,
+                                                        tree procedure,
+                                                        tree rettype);
+EXTERN tree m2statement_BuildProcedureCallTree (location_t location,
+                                                tree procedure, tree rettype);
+EXTERN void m2statement_BuildFunctionCallTree (location_t location,
+					       tree procedure, tree rettype);
+EXTERN void m2statement_BuildParam (location_t location, tree param);
+
+EXTERN tree m2statement_BuildIfThenElseEnd (tree condition, tree then_block,
+                                            tree else_block);
+EXTERN tree m2statement_BuildIfThenDoEnd (tree condition, tree then_block);
+
+EXTERN void m2statement_DeclareLabel (location_t location, char *name);
+EXTERN void m2statement_BuildGoto (location_t location, char *name);
+EXTERN tree m2statement_BuildAssignmentTree (location_t location, tree des,
+                                             tree expr);
+EXTERN void m2statement_BuildAssignmentStatement (location_t location, tree des,
+						  tree expr);
+EXTERN void m2statement_BuildPopFunctionContext (void);
+EXTERN void m2statement_BuildPushFunctionContext (void);
+EXTERN void m2statement_BuildReturnValueCode (location_t location, tree fndecl,
+                                              tree value);
+EXTERN void m2statement_BuildEndFunctionCode (location_t location, tree fndecl,
+                                              int nested);
+EXTERN void m2statement_BuildStartFunctionCode (location_t location,
+                                                tree fndecl, int isexported,
+                                                int isinline);
+EXTERN void m2statement_DoJump (location_t location, tree exp,
+                                char *falselabel, char *truelabel);
+EXTERN tree m2statement_BuildCall2 (location_t location, tree function,
+                                    tree rettype, tree arg1, tree arg2);
+EXTERN tree m2statement_BuildCall3 (location_t location, tree function,
+                                    tree rettype, tree arg1, tree arg2,
+                                    tree arg3);
+EXTERN void m2statement_SetLastFunction (tree t);
+EXTERN tree m2statement_GetLastFunction (void);
+EXTERN void m2statement_SetParamList (tree t);
+EXTERN tree m2statement_GetParamList (void);
+EXTERN tree m2statement_GetCurrentFunction (void);
+EXTERN void m2statement_SetBeginLocation (location_t location);
+EXTERN void m2statement_SetEndLocation (location_t location);
+EXTERN tree m2statement_GetParamTree (tree call, unsigned int i);
+EXTERN tree m2statement_BuildTryFinally (location_t location, tree call,
+                                         tree cleanups);
+EXTERN tree m2statement_BuildCleanUp (tree param);
+
+#undef EXTERN
+#endif /* m2statement_h.  */
diff --git a/gcc/m2/gm2-gcc/m2top.cc b/gcc/m2/gm2-gcc/m2top.cc
new file mode 100644
index 00000000000..1aee0e5db7b
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2top.cc
@@ -0,0 +1,65 @@
+/* m2top.cc provides top level scoping functions.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2tree.h"
+#include "m2type.h"
+#define m2top_c
+#include "m2top.h"
+
+/* StartGlobalContext - initializes a dummy function for the global
+   scope.  */
+
+void
+m2top_StartGlobalContext (void)
+{
+}
+
+/* EndGlobalContext - ends the dummy function for the global scope.  */
+
+void
+m2top_EndGlobalContext (void)
+{
+}
+
+/* FinishBackend - flushes all outstanding functions held in the GCC
+   backend out to the assembly file.  */
+
+void
+m2top_FinishBackend (void)
+{
+}
+
+/* SetFlagUnitAtATime - sets GCC flag_unit_at_a_time to b.  */
+
+void
+m2top_SetFlagUnitAtATime (int b)
+{
+  flag_unit_at_a_time = b;
+}
diff --git a/gcc/m2/gm2-gcc/m2top.def b/gcc/m2/gm2-gcc/m2top.def
new file mode 100644
index 00000000000..ec36db31ab8
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2top.def
@@ -0,0 +1,46 @@
+(* m2top.def definition module for m2top.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2top ;
+
+
+(*
+   SetFlagUnitAtATime - sets GCC flag_unit_at_a_time to b.
+*)
+
+PROCEDURE SetFlagUnitAtATime (b: BOOLEAN) ;
+
+
+(*
+   StartGlobalContext - initializes a dummy function for the global scope.
+*)
+
+PROCEDURE StartGlobalContext ;
+
+
+(*
+   EndGlobalContext - ends the dummy function for the global scope.
+*)
+
+PROCEDURE EndGlobalContext ;
+
+
+END m2top.
diff --git a/gcc/m2/gm2-gcc/m2top.h b/gcc/m2/gm2-gcc/m2top.h
new file mode 100644
index 00000000000..a1f9e3015b1
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2top.h
@@ -0,0 +1,44 @@
+/* m2top.h header file for m2top.cc.
+
+Copyright (C) 2012-2022 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(m2top_h)
+
+#define m2top_h
+#if defined(m2top_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2top_c.  */
+
+EXTERN void m2top_StartGlobalContext (void);
+EXTERN void m2top_EndGlobalContext (void);
+EXTERN void m2top_SetFlagUnitAtATime (int b);
+
+#undef EXTERN
+#endif /* m2top_h.  */
diff --git a/gcc/m2/gm2-gcc/m2tree.cc b/gcc/m2/gm2-gcc/m2tree.cc
new file mode 100644
index 00000000000..f3730d0c9b7
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2tree.cc
@@ -0,0 +1,132 @@
+/* m2tree.cc provides a simple interface to GCC tree queries and skips.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../m2-tree.h"
+
+#define m2tree_c
+#include "m2tree.h"
+
+int
+m2tree_is_var (tree var)
+{
+  return TREE_CODE (var) == VAR_DECL;
+}
+
+int
+m2tree_is_array (tree array)
+{
+  return TREE_CODE (array) == ARRAY_TYPE;
+}
+
+int
+m2tree_is_type (tree type)
+{
+  switch (TREE_CODE (type))
+    {
+
+    case TYPE_DECL:
+    case ARRAY_TYPE:
+    case RECORD_TYPE:
+    case SET_TYPE:
+    case ENUMERAL_TYPE:
+    case POINTER_TYPE:
+    case INTEGER_TYPE:
+    case REAL_TYPE:
+    case UNION_TYPE:
+    case BOOLEAN_TYPE:
+    case COMPLEX_TYPE:
+      return TRUE;
+    default:
+      return FALSE;
+    }
+}
+
+tree
+m2tree_skip_type_decl (tree type)
+{
+  if (type == error_mark_node)
+    return error_mark_node;
+
+  if (type == NULL_TREE)
+    return NULL_TREE;
+
+  if (TREE_CODE (type) == TYPE_DECL)
+    return m2tree_skip_type_decl (TREE_TYPE (type));
+  return type;
+}
+
+tree
+m2tree_skip_const_decl (tree exp)
+{
+  if (exp == error_mark_node)
+    return error_mark_node;
+
+  if (exp == NULL_TREE)
+    return NULL_TREE;
+
+  if (TREE_CODE (exp) == CONST_DECL)
+    return DECL_INITIAL (exp);
+  return exp;
+}
+
+/* m2tree_skip_reference_type - skips all POINTER_TYPE and
+   REFERENCE_TYPEs.  Otherwise return exp.  */
+
+tree
+m2tree_skip_reference_type (tree exp)
+{
+  if (TREE_CODE (exp) == REFERENCE_TYPE)
+    return m2tree_skip_reference_type (TREE_TYPE (exp));
+  if (TREE_CODE (exp) == POINTER_TYPE)
+    return m2tree_skip_reference_type (TREE_TYPE (exp));
+  return exp;
+}
+
+/* m2tree_IsOrdinal - return TRUE if code is an INTEGER, BOOLEAN or
+   ENUMERAL type.  */
+
+int
+m2tree_IsOrdinal (tree type)
+{
+  enum tree_code code = TREE_CODE (type);
+
+  return (code == INTEGER_TYPE || (code) == BOOLEAN_TYPE
+          || (code) == ENUMERAL_TYPE);
+}
+
+/* is_a_constant - returns TRUE if tree, t, is a constant.  */
+
+int
+m2tree_IsAConstant (tree t)
+{
+  return (TREE_CODE (t) == INTEGER_CST) || (TREE_CODE (t) == REAL_CST)
+         || (TREE_CODE (t) == REAL_CST) || (TREE_CODE (t) == COMPLEX_CST)
+         || (TREE_CODE (t) == STRING_CST);
+}
+
+
+void
+m2tree_debug_tree (tree t)
+{
+  debug_tree (t);
+}
diff --git a/gcc/m2/gm2-gcc/m2tree.def b/gcc/m2/gm2-gcc/m2tree.def
new file mode 100644
index 00000000000..4e2c6c80008
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2tree.def
@@ -0,0 +1,41 @@
+(* m2tree.def definition module for m2tree.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2tree ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   Tree = ADDRESS ;
+
+
+PROCEDURE IsAConstant (t: Tree) : BOOLEAN ;
+PROCEDURE IsOrdinal (type: Tree) : BOOLEAN ;
+PROCEDURE IsTreeOverflow (value: Tree) : BOOLEAN ;
+PROCEDURE skip_const_decl (exp: Tree) : Tree ;
+PROCEDURE skip_type_decl (type: Tree) : Tree ;
+PROCEDURE is_type (type: Tree) : BOOLEAN ;
+PROCEDURE is_array (array: Tree) : BOOLEAN ;
+PROCEDURE is_var (var: Tree) : BOOLEAN ;
+PROCEDURE debug_tree (t: Tree) ;
+
+
+END m2tree.
diff --git a/gcc/m2/gm2-gcc/m2tree.h b/gcc/m2/gm2-gcc/m2tree.h
new file mode 100644
index 00000000000..82852396239
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2tree.h
@@ -0,0 +1,58 @@
+/* m2tree.h header file for m2tree.cc.
+
+Copyright (C) 2012-2022 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(m2tree_h)
+#define m2tree_h
+#if defined(m2tree_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* m2tree_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* m2tree_c.  */
+
+#include "input.h"
+
+EXTERN int m2tree_is_var (tree var);
+EXTERN int m2tree_is_array (tree array);
+EXTERN int m2tree_is_type (tree type);
+EXTERN tree m2tree_skip_type_decl (tree type);
+EXTERN tree m2tree_skip_const_decl (tree exp);
+EXTERN int m2tree_IsTreeOverflow (tree value);
+EXTERN int m2tree_IsOrdinal (tree type);
+EXTERN int m2tree_IsAConstant (tree t);
+EXTERN void m2tree_debug_tree (tree t);
+EXTERN tree m2tree_skip_reference_type (tree exp);
+
+
+#ifndef SET_WORD_SIZE
+/* gross hack.  */
+#define SET_WORD_SIZE INT_TYPE_SIZE
+#endif /* SET_WORD_SIZE.  */
+
+#undef EXTERN
+#endif /* m2tree_h.  */
diff --git a/gcc/m2/gm2-gcc/m2treelib.cc b/gcc/m2/gm2-gcc/m2treelib.cc
new file mode 100644
index 00000000000..8f463e2c3d1
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2treelib.cc
@@ -0,0 +1,430 @@
+/* m2treelib.cc provides call trees, modify_expr and miscelaneous.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2treelib_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2statement.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2treelib.h"
+#include "m2type.h"
+
+/* do_jump_if_bit - tests bit in word against integer zero using
+   operator, code.  If the result is true then jump to label.  */
+
+void
+m2treelib_do_jump_if_bit (location_t location, enum tree_code code, tree word,
+                          tree bit, char *label)
+{
+  word = m2convert_ToWord (location, word);
+  bit = m2convert_ToWord (location, bit);
+  m2statement_DoJump (
+      location,
+      m2expr_build_binary_op (
+          location, code,
+          m2expr_build_binary_op (
+              location, BIT_AND_EXPR, word,
+              m2expr_BuildLSL (location, m2expr_GetWordOne (location), bit,
+                               FALSE),
+              FALSE),
+          m2expr_GetWordZero (location), FALSE),
+      NULL, label);
+}
+
+/* build_modify_expr - taken from c-typeck.cc and heavily pruned.
+
+   Build an assignment expression of lvalue LHS from value RHS.  If
+   LHS_ORIGTYPE is not NULL, it is the original type of LHS, which
+   may differ from TREE_TYPE (LHS) for an enum bitfield.  MODIFYCODE
+   is the code for a binary operator that we use to combine the old
+   value of LHS with RHS to get the new value.  Or else MODIFYCODE is
+   NOP_EXPR meaning do a simple assignment.  If RHS_ORIGTYPE is not
+   NULL_TREE, it is the original type of RHS, which may differ from
+   TREE_TYPE (RHS) for an enum value.
+
+   LOCATION is the location of the MODIFYCODE operator.  RHS_LOC is the
+   location of the RHS.  */
+
+static tree
+build_modify_expr (location_t location, tree lhs, enum tree_code modifycode,
+                   tree rhs)
+{
+  tree result;
+  tree newrhs;
+  tree rhs_semantic_type = NULL_TREE;
+  tree lhstype = TREE_TYPE (lhs);
+  tree olhstype = lhstype;
+
+  ASSERT_CONDITION (modifycode == NOP_EXPR);
+
+  if (TREE_CODE (rhs) == EXCESS_PRECISION_EXPR)
+    {
+      rhs_semantic_type = TREE_TYPE (rhs);
+      rhs = TREE_OPERAND (rhs, 0);
+    }
+
+  newrhs = rhs;
+
+  /* If storing into a structure or union member, it has probably been
+     given type `int'.  Compute the type that would go with the actual
+     amount of storage the member occupies.  */
+
+  if (TREE_CODE (lhs) == COMPONENT_REF
+      && (TREE_CODE (lhstype) == INTEGER_TYPE
+          || TREE_CODE (lhstype) == BOOLEAN_TYPE
+          || TREE_CODE (lhstype) == REAL_TYPE
+          || TREE_CODE (lhstype) == ENUMERAL_TYPE))
+    lhstype = TREE_TYPE (get_unwidened (lhs, 0));
+
+  /* If storing in a field that is in actuality a short or narrower
+     than one, we must store in the field in its actual type.  */
+
+  if (lhstype != TREE_TYPE (lhs))
+    {
+      lhs = copy_node (lhs);
+      TREE_TYPE (lhs) = lhstype;
+    }
+
+  newrhs = fold (newrhs);
+
+  if (rhs_semantic_type)
+    newrhs = build1 (EXCESS_PRECISION_EXPR, rhs_semantic_type, newrhs);
+
+  /* Scan operands.  */
+
+  result = build2 (MODIFY_EXPR, lhstype, lhs, newrhs);
+  TREE_SIDE_EFFECTS (result) = 1;
+  protected_set_expr_location (result, location);
+
+  /* If we got the LHS in a different type for storing in, convert the
+     result back to the nominal type of LHS so that the value we return
+     always has the same type as the LHS argument.  */
+
+  ASSERT_CONDITION (olhstype == TREE_TYPE (result));
+  /* In Modula-2 I'm assuming this will be true this maybe wrong, but
+     at least I'll know about it soon.  If true then we do not need to
+     implement convert_for_assignment - which is a huge win.  */
+
+  return result;
+}
+
+/* m2treelib_build_modify_expr - wrapper function for
+   build_modify_expr.  */
+
+tree
+m2treelib_build_modify_expr (location_t location, tree des,
+                             enum tree_code modifycode, tree copy)
+{
+  return build_modify_expr (location, des, modifycode, copy);
+}
+
+/* nCount - return the number of trees chained on, t.  */
+
+static int
+nCount (tree t)
+{
+  int i = 0;
+
+  while (t != NULL)
+    {
+      i++;
+      t = TREE_CHAIN (t);
+    }
+  return i;
+}
+
+/* DoCall - build a call tree arranging the parameter list as a
+   vector.  */
+
+tree
+m2treelib_DoCall (location_t location, tree rettype, tree funcptr,
+                  tree param_list)
+{
+  int n = nCount (param_list);
+  tree *argarray = XALLOCAVEC (tree, n);
+  tree l = param_list;
+  int i;
+
+  for (i = 0; i < n; i++)
+    {
+      argarray[i] = TREE_VALUE (l);
+      l = TREE_CHAIN (l);
+    }
+  return build_call_array_loc (location, rettype, funcptr, n, argarray);
+}
+
+/* DoCall0 - build a call tree with no parameters.  */
+
+tree
+m2treelib_DoCall0 (location_t location, tree rettype, tree funcptr)
+{
+  tree *argarray = XALLOCAVEC (tree, 1);
+
+  argarray[0] = NULL_TREE;
+
+  return build_call_array_loc (location, rettype, funcptr, 0, argarray);
+}
+
+/* DoCall1 - build a call tree with 1 parameter.  */
+
+tree
+m2treelib_DoCall1 (location_t location, tree rettype, tree funcptr, tree arg0)
+{
+  tree *argarray = XALLOCAVEC (tree, 1);
+
+  argarray[0] = arg0;
+
+  return build_call_array_loc (location, rettype, funcptr, 1, argarray);
+}
+
+/* DoCall2 - build a call tree with 2 parameters.  */
+
+tree
+m2treelib_DoCall2 (location_t location, tree rettype, tree funcptr, tree arg0,
+                   tree arg1)
+{
+  tree *argarray = XALLOCAVEC (tree, 2);
+
+  argarray[0] = arg0;
+  argarray[1] = arg1;
+
+  return build_call_array_loc (location, rettype, funcptr, 2, argarray);
+}
+
+/* DoCall3 - build a call tree with 3 parameters.  */
+
+tree
+m2treelib_DoCall3 (location_t location, tree rettype, tree funcptr, tree arg0,
+                   tree arg1, tree arg2)
+{
+  tree *argarray = XALLOCAVEC (tree, 3);
+
+  argarray[0] = arg0;
+  argarray[1] = arg1;
+  argarray[2] = arg2;
+
+  return build_call_array_loc (location, rettype, funcptr, 3, argarray);
+}
+
+/* get_rvalue - returns the rvalue of t.  The, type, is the object
+   type to be copied upon indirection.  */
+
+tree
+m2treelib_get_rvalue (location_t location, tree t, tree type, int is_lvalue)
+{
+  if (is_lvalue)
+    return m2expr_BuildIndirect (location, t, type);
+  else
+    return t;
+}
+
+/* get_field_no - returns the field no for, op.  The, op, is either a
+   constructor or a variable of type record.  If, op, is a
+   constructor (a set constant in GNU Modula-2) then this function is
+   essentially a no-op and it returns op.  Else we iterate over the
+   field list and return the appropriate field number.  */
+
+tree
+m2treelib_get_field_no (tree type, tree op, int is_const, unsigned int fieldNo)
+{
+  ASSERT_BOOL (is_const);
+  if (is_const)
+    return op;
+  else
+    {
+      tree list = TYPE_FIELDS (type);
+      while (fieldNo > 0 && list != NULL_TREE)
+        {
+          list = TREE_CHAIN (list);
+          fieldNo--;
+        }
+      return list;
+    }
+}
+
+/* get_set_value - returns the value indicated by, field, in the set.
+   Either p->field or the constant(op.fieldNo) is returned.  */
+
+tree
+m2treelib_get_set_value (location_t location, tree p, tree field, int is_const,
+                         int is_lvalue, tree op, unsigned int fieldNo)
+{
+  tree value;
+  constructor_elt *ce;
+
+  ASSERT_BOOL (is_const);
+  ASSERT_BOOL (is_lvalue);
+  if (is_const)
+    {
+      ASSERT_CONDITION (is_lvalue == FALSE);
+      gcc_assert (!vec_safe_is_empty (CONSTRUCTOR_ELTS (op)));
+      unsigned int size = vec_safe_length (CONSTRUCTOR_ELTS (op));
+      if (size < fieldNo)
+        internal_error ("field number exceeds definition of set");
+      if (vec_safe_iterate (CONSTRUCTOR_ELTS (op), fieldNo, &ce))
+        value = ce->value;
+      else
+        internal_error (
+            "field number out of range trying to access set element");
+    }
+  else if (is_lvalue)
+    {
+      if (TREE_CODE (TREE_TYPE (p)) == POINTER_TYPE)
+        value = m2expr_BuildComponentRef (
+            location, m2expr_BuildIndirect (location, p, TREE_TYPE (p)),
+            field);
+      else
+        {
+          ASSERT_CONDITION (TREE_CODE (TREE_TYPE (p)) == REFERENCE_TYPE);
+          value = m2expr_BuildComponentRef (location, p, field);
+        }
+    }
+  else
+    {
+      tree type = TREE_TYPE (op);
+      enum tree_code code = TREE_CODE (type);
+
+      ASSERT_CONDITION (code == RECORD_TYPE
+                        || (code == POINTER_TYPE
+                            && (TREE_CODE (TREE_TYPE (type)) == RECORD_TYPE)));
+      value = m2expr_BuildComponentRef (location, op, field);
+    }
+  value = m2convert_ToBitset (location, value);
+  return value;
+}
+
+/* get_set_address - returns the address of op1.  */
+
+tree
+m2treelib_get_set_address (location_t location, tree op1, int is_lvalue)
+{
+  if (is_lvalue)
+    return op1;
+  else
+    return m2expr_BuildAddr (location, op1, FALSE);
+}
+
+/* get_set_field_lhs - returns the address of p->field.  */
+
+tree
+m2treelib_get_set_field_lhs (location_t location, tree p, tree field)
+{
+  return m2expr_BuildAddr (
+      location, m2convert_ToBitset (
+                    location, m2expr_BuildComponentRef (location, p, field)),
+      FALSE);
+}
+
+/* get_set_field_rhs - returns the value of p->field.  */
+
+tree
+m2treelib_get_set_field_rhs (location_t location, tree p, tree field)
+{
+  return m2convert_ToBitset (location,
+                             m2expr_BuildComponentRef (location, p, field));
+}
+
+/* get_set_field_des - returns the p->field ready to be a (rhs)
+   designator.  */
+
+tree
+m2treelib_get_set_field_des (location_t location, tree p, tree field)
+{
+  return m2expr_BuildIndirect (
+      location,
+      m2expr_BuildAddr (location,
+                        m2expr_BuildComponentRef (location, p, field), FALSE),
+      m2type_GetBitsetType ());
+}
+
+/* get_set_address_if_var - returns the address of, op, providing it
+   is not a constant.  NULL is returned if, op, is a constant.  */
+
+tree
+m2treelib_get_set_address_if_var (location_t location, tree op, int is_lvalue,
+                                  int is_const)
+{
+  if (is_const)
+    return NULL;
+  else
+    return m2treelib_get_set_address (location, op, is_lvalue);
+}
+
+/* add_stmt - t is a statement.  Add it to the statement-tree.  */
+
+tree
+add_stmt (location_t location, tree t)
+{
+  return m2block_add_stmt (location, t);
+}
+
+/* taken from gcc/c-semantics.cc.  */
+
+/* Build a generic statement based on the given type of node and
+   arguments.  Similar to `build_nt', except that we set EXPR_LOCATION
+   to LOC.  */
+
+tree
+build_stmt (location_t loc, enum tree_code code, ...)
+{
+  tree ret;
+  int length, i;
+  va_list p;
+  bool side_effects;
+
+  m2assert_AssertLocation (loc);
+  /* This function cannot be used to construct variably-sized nodes.  */
+  gcc_assert (TREE_CODE_CLASS (code) != tcc_vl_exp);
+
+  va_start (p, code);
+
+  ret = make_node (code);
+  TREE_TYPE (ret) = void_type_node;
+  length = TREE_CODE_LENGTH (code);
+  SET_EXPR_LOCATION (ret, loc);
+
+  /* TREE_SIDE_EFFECTS will already be set for statements with implicit
+     side effects.  Here we make sure it is set for other expressions by
+     checking whether the parameters have side effects.  */
+
+  side_effects = false;
+  for (i = 0; i < length; i++)
+    {
+      tree t = va_arg (p, tree);
+      if (t && !TYPE_P (t))
+        side_effects |= TREE_SIDE_EFFECTS (t);
+      TREE_OPERAND (ret, i) = t;
+    }
+
+  TREE_SIDE_EFFECTS (ret) |= side_effects;
+
+  va_end (p);
+  return ret;
+}
diff --git a/gcc/m2/gm2-gcc/m2treelib.def b/gcc/m2/gm2-gcc/m2treelib.def
new file mode 100644
index 00000000000..a8208954124
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2treelib.def
@@ -0,0 +1,109 @@
+(* m2treelib.def definition module for m2treelib.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2treelib ;
+
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   tree_code = INTEGER ;
+
+
+(*
+    get_set_address_if_var - returns the address of, op, providing
+                             it is not a constant.
+                             NULL is returned if, op, is a constant.
+*)
+
+PROCEDURE get_set_address_if_var (location: location_t; op: Tree; is_lvalue: INTEGER; is_const: INTEGER) : Tree ;
+
+
+(*
+    get_set_field_rhs - returns the value of p->field.
+*)
+
+PROCEDURE get_set_field_rhs (location: location_t; p: Tree; field: Tree) : Tree ;
+
+
+(*
+    get_set_field_lhs - returns the address of p->field.
+*)
+
+PROCEDURE get_set_field_lhs (location: location_t; p: Tree; field: Tree) : Tree ;
+
+
+(*
+    get_set_address - returns the address of op1.
+*)
+
+PROCEDURE get_set_address (location: location_t; op1: Tree; is_lvalue: INTEGER) : Tree ;
+
+
+(*
+    get_set_value - returns the value indicated by, field, in the set.
+                    Either p->field or the constant(op.fieldNo) is returned.
+*)
+
+PROCEDURE get_set_value (location: location_t; p: Tree; field: Tree; is_const: INTEGER; op: Tree; fieldNo: CARDINAL) : Tree ;
+
+
+(*
+    get_field_no - returns the field no for, op.  The, op, is either
+                   a constructor or a variable of type record.
+                   If, op, is a constructor (a set constant in GNU Modula-2)
+                   then this function is essentially a no-op and it returns op.
+                   Else we iterate over the field list and return the
+                   appropriate field number.
+*)
+
+PROCEDURE get_field_no (type: Tree; op: Tree; is_const: INTEGER; fieldNo: CARDINAL) : Tree ;
+
+
+(*
+    get_rvalue - returns the rvalue of t. The, type, is the object type to be
+                 copied upon indirection.
+*)
+
+PROCEDURE get_rvalue (location: location_t; t: Tree; type: Tree; is_lvalue: INTEGER) : Tree ;
+
+
+(*
+    DoCall - build a call tree arranging the parameter list as a vector.
+*)
+
+PROCEDURE DoCall (location: location_t; rettype: Tree; funcptr: Tree; param_list: Tree) : Tree ;
+
+
+
+PROCEDURE build_modify_expr (location: location_t; des: Tree; modifycode: tree_code; copy: Tree) : Tree ;
+
+
+(*
+    do_jump_if_bit - tests bit in word against integer zero using operator, code.
+                     If the result is true then jump to label.
+*)
+
+PROCEDURE do_jump_if_bit (location: location_t; code: tree_code; word: Tree; bit: Tree; label: ADDRESS) ;
+
+
+END m2treelib.
diff --git a/gcc/m2/gm2-gcc/m2treelib.h b/gcc/m2/gm2-gcc/m2treelib.h
new file mode 100644
index 00000000000..b37fa17c044
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2treelib.h
@@ -0,0 +1,66 @@
+/* m2treelib.h header file for m2treelib.cc.
+
+Copyright (C) 2012-2022 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(m2treelib_h)
+#define m2treelib_h
+#if defined(m2treelib_c)
+#define EXTERN
+#else /* !m2treelib_c.  */
+#define EXTERN extern
+#endif /* !m2treelib_c.  */
+
+EXTERN void m2treelib_do_jump_if_bit (location_t location, enum tree_code code,
+                                      tree word, tree bit, char *label);
+EXTERN tree m2treelib_build_modify_expr (location_t location, tree des,
+                                         enum tree_code modifycode, tree copy);
+EXTERN tree m2treelib_DoCall (location_t location, tree rettype, tree funcptr,
+                              tree param_list);
+EXTERN tree m2treelib_DoCall0 (location_t location, tree rettype,
+                               tree funcptr);
+EXTERN tree m2treelib_DoCall1 (location_t location, tree rettype, tree funcptr,
+                               tree arg0);
+EXTERN tree m2treelib_DoCall2 (location_t location, tree rettype, tree funcptr,
+                               tree arg0, tree arg1);
+EXTERN tree m2treelib_DoCall3 (location_t location, tree rettype, tree funcptr,
+                               tree arg0, tree arg1, tree arg2);
+EXTERN tree m2treelib_get_rvalue (location_t location, tree t, tree type,
+                                  int is_lvalue);
+EXTERN tree m2treelib_get_field_no (tree type, tree op, int is_const,
+                                    unsigned int fieldNo);
+EXTERN tree m2treelib_get_set_value (location_t location, tree p, tree field,
+                                     int is_const, int is_lvalue, tree op,
+                                     unsigned int fieldNo);
+EXTERN tree m2treelib_get_set_address (location_t location, tree op1,
+                                       int is_lvalue);
+EXTERN tree m2treelib_get_set_field_lhs (location_t location, tree p,
+                                         tree field);
+EXTERN tree m2treelib_get_set_field_rhs (location_t location, tree p,
+                                         tree field);
+EXTERN tree m2treelib_get_set_address_if_var (location_t location, tree op,
+                                              int is_lvalue, int is_const);
+EXTERN tree m2treelib_get_set_field_des (location_t location, tree p,
+                                         tree field);
+
+EXTERN tree add_stmt (location_t location, tree t);
+EXTERN tree build_stmt (location_t loc, enum tree_code code, ...);
+
+#undef EXTERN
+#endif /* m2treelib_h.  */
diff --git a/gcc/m2/gm2-gcc/m2type.cc b/gcc/m2/gm2-gcc/m2type.cc
new file mode 100644
index 00000000000..5342033117b
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2type.cc
@@ -0,0 +1,3092 @@
+/* m2type.cc provides an interface to GCC type trees.
+
+Copyright (C) 2012-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2type_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2builtins.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2except.h"
+#include "m2expr.h"
+#include "m2linemap.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+
+#undef USE_BOOLEAN
+static int broken_set_debugging_info = TRUE;
+
+
+struct GTY (()) struct_constructor
+{
+  /* Constructor_type, the type that we are constructing.  */
+  tree GTY ((skip (""))) constructor_type;
+  /* Constructor_fields, the list of fields belonging to
+     constructor_type.  Used by SET and RECORD constructors.  */
+  tree GTY ((skip (""))) constructor_fields;
+  /* Constructor_element_list, the list of constants used by SET and
+     RECORD constructors.  */
+  tree GTY ((skip (""))) constructor_element_list;
+  /* Constructor_elements, used by an ARRAY initializer all elements
+     are held in reverse order.  */
+  vec<constructor_elt, va_gc> *constructor_elements;
+  /* Level, the next level down in the constructor stack.  */
+  struct struct_constructor *level;
+};
+
+static GTY (()) struct struct_constructor *top_constructor = NULL;
+
+typedef struct GTY (()) array_desc
+{
+  int type;
+  tree index;
+  tree array;
+  struct array_desc *next;
+} array_desc;
+
+static GTY (()) array_desc *list_of_arrays = NULL;
+/* Used in BuildStartFunctionType.  */
+static GTY (()) tree param_type_list;
+
+static GTY (()) tree proc_type_node;
+static GTY (()) tree bitset_type_node;
+static GTY (()) tree bitnum_type_node;
+static GTY (()) tree m2_char_type_node;
+static GTY (()) tree m2_integer_type_node;
+static GTY (()) tree m2_cardinal_type_node;
+static GTY (()) tree m2_short_real_type_node;
+static GTY (()) tree m2_real_type_node;
+static GTY (()) tree m2_long_real_type_node;
+static GTY (()) tree m2_long_int_type_node;
+static GTY (()) tree m2_long_card_type_node;
+static GTY (()) tree m2_short_int_type_node;
+static GTY (()) tree m2_short_card_type_node;
+static GTY (()) tree m2_z_type_node;
+static GTY (()) tree m2_iso_loc_type_node;
+static GTY (()) tree m2_iso_byte_type_node;
+static GTY (()) tree m2_iso_word_type_node;
+static GTY (()) tree m2_integer8_type_node;
+static GTY (()) tree m2_integer16_type_node;
+static GTY (()) tree m2_integer32_type_node;
+static GTY (()) tree m2_integer64_type_node;
+static GTY (()) tree m2_cardinal8_type_node;
+static GTY (()) tree m2_cardinal16_type_node;
+static GTY (()) tree m2_cardinal32_type_node;
+static GTY (()) tree m2_cardinal64_type_node;
+static GTY (()) tree m2_word16_type_node;
+static GTY (()) tree m2_word32_type_node;
+static GTY (()) tree m2_word64_type_node;
+static GTY (()) tree m2_bitset8_type_node;
+static GTY (()) tree m2_bitset16_type_node;
+static GTY (()) tree m2_bitset32_type_node;
+static GTY (()) tree m2_real32_type_node;
+static GTY (()) tree m2_real64_type_node;
+static GTY (()) tree m2_real96_type_node;
+static GTY (()) tree m2_real128_type_node;
+static GTY (()) tree m2_complex_type_node;
+static GTY (()) tree m2_long_complex_type_node;
+static GTY (()) tree m2_short_complex_type_node;
+static GTY (()) tree m2_c_type_node;
+static GTY (()) tree m2_complex32_type_node;
+static GTY (()) tree m2_complex64_type_node;
+static GTY (()) tree m2_complex96_type_node;
+static GTY (()) tree m2_complex128_type_node;
+static GTY (()) tree m2_packed_boolean_type_node;
+static GTY (()) tree m2_cardinal_address_type_node;
+
+/* gm2_canonicalize_array - returns a unique array node based on
+   index_type and type.  */
+
+static tree
+gm2_canonicalize_array (tree index_type, int type)
+{
+  array_desc *l = list_of_arrays;
+
+  while (l != NULL)
+    {
+      if (l->type == type && l->index == index_type)
+        return l->array;
+      else
+        l = l->next;
+    }
+  l = ggc_alloc<array_desc> ();
+  l->next = list_of_arrays;
+  l->type = type;
+  l->index = index_type;
+  l->array = make_node (ARRAY_TYPE);
+  TREE_TYPE (l->array) = NULL_TREE;
+  TYPE_DOMAIN (l->array) = index_type;
+  list_of_arrays = l;
+  return l->array;
+}
+
+/* BuildStartArrayType - creates an array with an indextype and
+   elttype.  The front end symbol type is also passed to allow the
+   gccgm2 to return the canonical edition of the array type even if
+   the GCC elttype is NULL_TREE.  */
+
+tree
+m2type_BuildStartArrayType (tree index_type, tree elt_type, int type)
+{
+  tree t;
+
+  elt_type = m2tree_skip_type_decl (elt_type);
+  ASSERT_CONDITION (index_type != NULL_TREE);
+  if (elt_type == NULL_TREE)
+    {
+      /* Cannot use GCC canonicalization routines yet, so we use our front
+         end version based on the front end type.  */
+      return gm2_canonicalize_array (index_type, type);
+    }
+  t = gm2_canonicalize_array (index_type, type);
+  if (TREE_TYPE (t) == NULL_TREE)
+    TREE_TYPE (t) = elt_type;
+  else
+    ASSERT_CONDITION (TREE_TYPE (t) == elt_type);
+
+  return t;
+}
+
+/* PutArrayType assignes TREE_TYPE (array) to the skipped type.  */
+
+void
+m2type_PutArrayType (tree array, tree type)
+{
+  TREE_TYPE (array) = m2tree_skip_type_decl (type);
+}
+
+/* gccgm2_GetArrayNoOfElements returns the number of elements in
+   arraytype.  */
+
+tree
+m2type_GetArrayNoOfElements (location_t location, tree arraytype)
+{
+  tree index_type = TYPE_DOMAIN (m2tree_skip_type_decl (arraytype));
+  tree min = TYPE_MIN_VALUE (index_type);
+  tree max = TYPE_MAX_VALUE (index_type);
+
+  m2assert_AssertLocation (location);
+  return m2expr_FoldAndStrip (m2expr_BuildSub (location, max, min, FALSE));
+}
+
+/* gm2_finish_build_array_type complete building the partially
+   created array type, arrayType.  The arrayType is now known to be
+   declared as: ARRAY index_type OF elt_type.  There will only ever
+   be one gcc tree type for this array definition.  The third
+   parameter type is a front end type and this is necessary so that
+   the canonicalization creates unique array types for each type.  */
+
+static tree
+gm2_finish_build_array_type (tree arrayType, tree elt_type, tree index_type,
+                             int type)
+{
+  tree old = arrayType;
+
+  elt_type = m2tree_skip_type_decl (elt_type);
+  ASSERT_CONDITION (index_type != NULL_TREE);
+  if (TREE_CODE (elt_type) == FUNCTION_TYPE)
+    {
+      error ("arrays of functions are not meaningful");
+      elt_type = integer_type_node;
+    }
+
+  TREE_TYPE (arrayType) = elt_type;
+  TYPE_DOMAIN (arrayType) = index_type;
+
+  arrayType = gm2_canonicalize_array (index_type, type);
+  if (arrayType != old)
+    internal_error ("array declaration canonicalization has failed");
+
+  if (!COMPLETE_TYPE_P (arrayType))
+    layout_type (arrayType);
+  return arrayType;
+}
+
+/* BuildEndArrayType returns a type which is an array indexed by
+   IndexType and which has ElementType elements.  */
+
+tree
+m2type_BuildEndArrayType (tree arraytype, tree elementtype, tree indextype,
+                          int type)
+{
+  elementtype = m2tree_skip_type_decl (elementtype);
+  ASSERT (indextype == TYPE_DOMAIN (arraytype), indextype);
+
+  if (TREE_CODE (elementtype) == FUNCTION_TYPE)
+    return gm2_finish_build_array_type (arraytype, ptr_type_node, indextype,
+                                        type);
+  else
+    return gm2_finish_build_array_type (
+        arraytype, m2tree_skip_type_decl (elementtype), indextype, type);
+}
+
+/* gm2_build_array_type returns a type which is an array indexed by
+   IndexType and which has ElementType elements.  */
+
+static tree
+gm2_build_array_type (tree elementtype, tree indextype, int fetype)
+{
+  tree arrayType = m2type_BuildStartArrayType (indextype, elementtype, fetype);
+  return m2type_BuildEndArrayType (arrayType, elementtype, indextype, fetype);
+}
+
+/* ValueInTypeRange returns TRUE if the constant, value, lies within
+   the range of type.  */
+
+int
+m2type_ValueInTypeRange (tree type, tree value)
+{
+  tree low_type = m2tree_skip_type_decl (type);
+  tree min_value = TYPE_MIN_VALUE (low_type);
+  tree max_value = TYPE_MAX_VALUE (low_type);
+
+  value = m2expr_FoldAndStrip (value);
+  return ((tree_int_cst_compare (min_value, value) <= 0)
+          && (tree_int_cst_compare (value, max_value) <= 0));
+}
+
+/* ValueOutOfTypeRange returns TRUE if the constant, value, exceeds
+   the range of type.  */
+
+int
+m2type_ValueOutOfTypeRange (tree type, tree value)
+{
+  return (!m2type_ValueInTypeRange (type, value));
+}
+
+/* ExceedsTypeRange return TRUE if low or high exceed the range of
+   type.  */
+
+int
+m2type_ExceedsTypeRange (tree type, tree low, tree high)
+{
+  return (m2type_ValueOutOfTypeRange (type, low)
+          || m2type_ValueOutOfTypeRange (type, high));
+}
+
+/* WithinTypeRange return TRUE if low and high are within the range
+   of type.  */
+
+int
+m2type_WithinTypeRange (tree type, tree low, tree high)
+{
+  return (m2type_ValueInTypeRange (type, low)
+          && m2type_ValueInTypeRange (type, high));
+}
+
+/* BuildArrayIndexType creates an integer index which accesses an
+   array.  low and high are the min, max elements of the array.  GCC
+   insists we access an array with an integer indice.  */
+
+tree
+m2type_BuildArrayIndexType (tree low, tree high)
+{
+  tree sizelow = convert (m2type_GetIntegerType (), m2expr_FoldAndStrip (low));
+  tree sizehigh
+      = convert (m2type_GetIntegerType (), m2expr_FoldAndStrip (high));
+
+  if (m2expr_TreeOverflow (sizelow))
+    error ("low bound for the array is outside the ztype limits");
+  if (m2expr_TreeOverflow (sizehigh))
+    error ("high bound for the array is outside the ztype limits");
+
+  return build_range_type (m2type_GetIntegerType (),
+                           m2expr_FoldAndStrip (sizelow),
+                           m2expr_FoldAndStrip (sizehigh));
+}
+
+/* build_m2_type_node_by_array builds a ISO Modula-2 word type from
+   ARRAY [low..high] OF arrayType.  This matches the front end data
+   type fetype which is only used during canonicalization.  */
+
+static tree
+build_m2_type_node_by_array (tree arrayType, tree low, tree high, int fetype)
+{
+  return gm2_build_array_type (arrayType,
+                               m2type_BuildArrayIndexType (low, high), fetype);
+}
+
+/* build_m2_word16_type_node build an ISO 16 bit word as an ARRAY
+   [0..1] OF loc.  */
+
+static tree
+build_m2_word16_type_node (location_t location, int loc)
+{
+  return build_m2_type_node_by_array (m2type_GetISOLocType (),
+                                      m2expr_GetIntegerZero (location),
+                                      m2expr_GetIntegerOne (location), loc);
+}
+
+/* build_m2_word32_type_node build an ISO 32 bit word as an ARRAY
+   [0..3] OF loc.  */
+
+static tree
+build_m2_word32_type_node (location_t location, int loc)
+{
+  return build_m2_type_node_by_array (m2type_GetISOLocType (),
+                                      m2expr_GetIntegerZero (location),
+                                      m2decl_BuildIntegerConstant (3), loc);
+}
+
+/* build_m2_word64_type_node build an ISO 32 bit word as an ARRAY
+   [0..7] OF loc.  */
+
+static tree
+build_m2_word64_type_node (location_t location, int loc)
+{
+  return build_m2_type_node_by_array (m2type_GetISOLocType (),
+                                      m2expr_GetIntegerZero (location),
+                                      m2decl_BuildIntegerConstant (7), loc);
+}
+
+/* GetM2Complex32 return the fixed size complex type.  */
+
+tree
+m2type_GetM2Complex32 (void)
+{
+  return m2_complex32_type_node;
+}
+
+/* GetM2Complex64 return the fixed size complex type.  */
+
+tree
+m2type_GetM2Complex64 (void)
+{
+  return m2_complex64_type_node;
+}
+
+/* GetM2Complex96 return the fixed size complex type.  */
+
+tree
+m2type_GetM2Complex96 (void)
+{
+  return m2_complex96_type_node;
+}
+
+/* GetM2Complex128 return the fixed size complex type.  */
+
+tree
+m2type_GetM2Complex128 (void)
+{
+  return m2_complex128_type_node;
+}
+
+/* GetM2CType a test function.  */
+
+tree
+m2type_GetM2CType (void)
+{
+  return m2_c_type_node;
+}
+
+/* GetM2ShortComplexType return the short complex type.  */
+
+tree
+m2type_GetM2ShortComplexType (void)
+{
+  return m2_short_complex_type_node;
+}
+
+/* GetM2LongComplexType return the long complex type.  */
+
+tree
+m2type_GetM2LongComplexType (void)
+{
+  return m2_long_complex_type_node;
+}
+
+/* GetM2ComplexType return the complex type.  */
+
+tree
+m2type_GetM2ComplexType (void)
+{
+  return m2_complex_type_node;
+}
+
+/* GetM2Real128 return the real 128 bit type.  */
+
+tree
+m2type_GetM2Real128 (void)
+{
+  return m2_real128_type_node;
+}
+
+/* GetM2Real96 return the real 96 bit type.  */
+
+tree
+m2type_GetM2Real96 (void)
+{
+  return m2_real96_type_node;
+}
+
+/* GetM2Real64 return the real 64 bit type.  */
+
+tree
+m2type_GetM2Real64 (void)
+{
+  return m2_real64_type_node;
+}
+
+/* GetM2Real32 return the real 32 bit type.  */
+
+tree
+m2type_GetM2Real32 (void)
+{
+  return m2_real32_type_node;
+}
+
+/* GetM2Bitset32 return the bitset 32 bit type.  */
+
+tree
+m2type_GetM2Bitset32 (void)
+{
+  return m2_bitset32_type_node;
+}
+
+/* GetM2Bitset16 return the bitset 16 bit type.  */
+
+tree
+m2type_GetM2Bitset16 (void)
+{
+  return m2_bitset16_type_node;
+}
+
+/* GetM2Bitset8 return the bitset 8 bit type.  */
+
+tree
+m2type_GetM2Bitset8 (void)
+{
+  return m2_bitset8_type_node;
+}
+
+/* GetM2Word64 return the word 64 bit type.  */
+
+tree
+m2type_GetM2Word64 (void)
+{
+  return m2_word64_type_node;
+}
+
+/* GetM2Word32 return the word 32 bit type.  */
+
+tree
+m2type_GetM2Word32 (void)
+{
+  return m2_word32_type_node;
+}
+
+/* GetM2Word16 return the word 16 bit type.  */
+
+tree
+m2type_GetM2Word16 (void)
+{
+  return m2_word16_type_node;
+}
+
+/* GetM2Cardinal64 return the cardinal 64 bit type.  */
+
+tree
+m2type_GetM2Cardinal64 (void)
+{
+  return m2_cardinal64_type_node;
+}
+
+/* GetM2Cardinal32 return the cardinal 32 bit type.  */
+
+tree
+m2type_GetM2Cardinal32 (void)
+{
+  return m2_cardinal32_type_node;
+}
+
+/* GetM2Cardinal16 return the cardinal 16 bit type.  */
+
+tree
+m2type_GetM2Cardinal16 (void)
+{
+  return m2_cardinal16_type_node;
+}
+
+/* GetM2Cardinal8 return the cardinal 8 bit type.  */
+
+tree
+m2type_GetM2Cardinal8 (void)
+{
+  return m2_cardinal8_type_node;
+}
+
+/* GetM2Integer64 return the integer 64 bit type.  */
+
+tree
+m2type_GetM2Integer64 (void)
+{
+  return m2_integer64_type_node;
+}
+
+/* GetM2Integer32 return the integer 32 bit type.  */
+
+tree
+m2type_GetM2Integer32 (void)
+{
+  return m2_integer32_type_node;
+}
+
+/* GetM2Integer16 return the integer 16 bit type.  */
+
+tree
+m2type_GetM2Integer16 (void)
+{
+  return m2_integer16_type_node;
+}
+
+/* GetM2Integer8 return the integer 8 bit type.  */
+
+tree
+m2type_GetM2Integer8 (void)
+{
+  return m2_integer8_type_node;
+}
+
+/* GetM2RType return the ISO R data type, the longest real
+   datatype.  */
+
+tree
+m2type_GetM2RType (void)
+{
+  return long_double_type_node;
+}
+
+/* GetM2ZType return the ISO Z data type, the longest int datatype.  */
+
+tree
+m2type_GetM2ZType (void)
+{
+  return m2_z_type_node;
+}
+
+/* GetShortCardType return the C short unsigned data type.  */
+
+tree
+m2type_GetShortCardType (void)
+{
+  return short_unsigned_type_node;
+}
+
+/* GetM2ShortCardType return the m2 short cardinal data type.  */
+
+tree
+m2type_GetM2ShortCardType (void)
+{
+  return m2_short_card_type_node;
+}
+
+/* GetShortIntType return the C short int data type.  */
+
+tree
+m2type_GetShortIntType (void)
+{
+  return short_integer_type_node;
+}
+
+/* GetM2ShortIntType return the m2 short integer data type.  */
+
+tree
+m2type_GetM2ShortIntType (void)
+{
+  return m2_short_int_type_node;
+}
+
+/* GetM2LongCardType return the m2 long cardinal data type.  */
+
+tree
+m2type_GetM2LongCardType (void)
+{
+  return m2_long_card_type_node;
+}
+
+/* GetM2LongIntType return the m2 long integer data type.  */
+
+tree
+m2type_GetM2LongIntType (void)
+{
+  return m2_long_int_type_node;
+}
+
+/* GetM2LongRealType return the m2 long real data type.  */
+
+tree
+m2type_GetM2LongRealType (void)
+{
+  return m2_long_real_type_node;
+}
+
+/* GetM2RealType return the m2 real data type.  */
+
+tree
+m2type_GetM2RealType (void)
+{
+  return m2_real_type_node;
+}
+
+/* GetM2ShortRealType return the m2 short real data type.  */
+
+tree
+m2type_GetM2ShortRealType (void)
+{
+  return m2_short_real_type_node;
+}
+
+/* GetM2CardinalType return the m2 cardinal data type.  */
+
+tree
+m2type_GetM2CardinalType (void)
+{
+  return m2_cardinal_type_node;
+}
+
+/* GetM2IntegerType return the m2 integer data type.  */
+
+tree
+m2type_GetM2IntegerType (void)
+{
+  return m2_integer_type_node;
+}
+
+/* GetM2CharType return the m2 char data type.  */
+
+tree
+m2type_GetM2CharType (void)
+{
+  return m2_char_type_node;
+}
+
+/* GetProcType return the m2 proc data type.  */
+
+tree
+m2type_GetProcType (void)
+{
+  return proc_type_node;
+}
+
+/* GetISOWordType return the m2 iso word data type.  */
+
+tree
+m2type_GetISOWordType (void)
+{
+  return m2_iso_word_type_node;
+}
+
+/* GetISOByteType return the m2 iso byte data type.  */
+
+tree
+m2type_GetISOByteType (void)
+{
+  return m2_iso_byte_type_node;
+}
+
+/* GetISOLocType return the m2 loc word data type.  */
+
+tree
+m2type_GetISOLocType (void)
+{
+  return m2_iso_loc_type_node;
+}
+
+/* GetWordType return the C unsigned data type.  */
+
+tree
+m2type_GetWordType (void)
+{
+  return unsigned_type_node;
+}
+
+/* GetLongIntType return the C long int data type.  */
+
+tree
+m2type_GetLongIntType (void)
+{
+  return long_integer_type_node;
+}
+
+/* GetShortRealType return the C float data type.  */
+
+tree
+m2type_GetShortRealType (void)
+{
+  return float_type_node;
+}
+
+/* GetLongRealType return the C long double data type.  */
+
+tree
+m2type_GetLongRealType (void)
+{
+  return long_double_type_node;
+}
+
+/* GetRealType returns the C double_type_node.  */
+
+tree
+m2type_GetRealType (void)
+{
+  return double_type_node;
+}
+
+/* GetBitnumType return the ISO bitnum type.  */
+
+tree
+m2type_GetBitnumType (void)
+{
+  return bitnum_type_node;
+}
+
+/* GetBitsetType return the bitset type.  */
+
+tree
+m2type_GetBitsetType (void)
+{
+  return bitset_type_node;
+}
+
+/* GetCardinalType return the cardinal type.  */
+
+tree
+m2type_GetCardinalType (void)
+{
+  return unsigned_type_node;
+}
+
+/* GetPointerType return the GCC ptr type node.  Equivalent to
+   (void *).  */
+
+tree
+m2type_GetPointerType (void)
+{
+  return ptr_type_node;
+}
+
+/* GetVoidType return the C void type.  */
+
+tree
+m2type_GetVoidType (void)
+{
+  return void_type_node;
+}
+
+/* GetByteType return the byte type node.  */
+
+tree
+m2type_GetByteType (void)
+{
+  return unsigned_char_type_node;
+}
+
+/* GetCharType return the char type node.  */
+
+tree
+m2type_GetCharType (void)
+{
+  return char_type_node;
+}
+
+/* GetIntegerType return the integer type node.  */
+
+tree
+m2type_GetIntegerType (void)
+{
+  return integer_type_node;
+}
+
+/* GetCSizeTType return a type representing, size_t on this system.  */
+
+tree
+m2type_GetCSizeTType (void)
+{
+  return sizetype;
+}
+
+/* GetCSSizeTType return a type representing, size_t on this
+   system.  */
+
+tree
+m2type_GetCSSizeTType (void)
+{
+  return ssizetype;
+}
+
+/* GetPackedBooleanType return the packed boolean data type node.  */
+
+tree
+m2type_GetPackedBooleanType (void)
+{
+  return m2_packed_boolean_type_node;
+}
+
+/* GetBooleanTrue return modula-2 TRUE.  */
+
+tree
+m2type_GetBooleanTrue (void)
+{
+#if defined(USE_BOOLEAN)
+  return boolean_true_node;
+#else /* !USE_BOOLEAN  */
+  return m2expr_GetIntegerOne (m2linemap_BuiltinsLocation ());
+#endif /* !USE_BOOLEAN  */
+}
+
+/* GetBooleanFalse return modula-2 FALSE.  */
+
+tree
+m2type_GetBooleanFalse (void)
+{
+#if defined(USE_BOOLEAN)
+  return boolean_false_node;
+#else /* !USE_BOOLEAN  */
+  return m2expr_GetIntegerZero (m2linemap_BuiltinsLocation ());
+#endif /* !USE_BOOLEAN  */
+}
+
+/* GetBooleanType return the modula-2 BOOLEAN type.  */
+
+tree
+m2type_GetBooleanType (void)
+{
+#if defined(USE_BOOLEAN)
+  return boolean_type_node;
+#else /* !USE_BOOLEAN  */
+  return integer_type_node;
+#endif /* !USE_BOOLEAN  */
+}
+
+/* GetCardinalAddressType returns the internal data type for
+   computing binary arithmetic upon the ADDRESS datatype.  */
+
+tree
+m2type_GetCardinalAddressType (void)
+{
+  return m2_cardinal_address_type_node;
+}
+
+/* noBitsRequired returns the number of bits required to contain,
+   values.  How many bits are required to represent all numbers
+   between: 0..values-1 */
+
+static tree
+noBitsRequired (tree values)
+{
+  int bits = tree_floor_log2 (values);
+
+  if (integer_pow2p (values))
+    /* remember we start counting from zero.  */
+    return m2decl_BuildIntegerConstant (bits);
+  else
+    return m2decl_BuildIntegerConstant (bits + 1);
+}
+
+#if 0
+/* build_set_type creates a set type from the, domain, [low..high].
+   The values low..high all have type, range_type.  */
+
+static tree
+build_set_type (tree domain, tree range_type, int allow_void, int ispacked)
+{
+  tree type;
+
+  if (!m2tree_IsOrdinal (domain)
+      && !(allow_void && TREE_CODE (domain) == VOID_TYPE))
+    {
+      error ("set base type must be an ordinal type");
+      return NULL;
+    }
+
+  if (TYPE_SIZE (range_type) == 0)
+    layout_type (range_type);
+
+  if (TYPE_SIZE (domain) == 0)
+    layout_type (domain);
+
+  type = make_node (SET_TYPE);
+  TREE_TYPE (type) = range_type;
+  TYPE_DOMAIN (type) = domain;
+  TYPE_PACKED (type) = ispacked;
+
+  return type;
+}
+
+
+/* convert_type_to_range does the conversion and copies the range
+   type */
+
+static tree
+convert_type_to_range (tree type)
+{
+  tree min, max;
+  tree itype;
+
+  if (!m2tree_IsOrdinal (type))
+    {
+      error ("ordinal type expected");
+      return error_mark_node;
+    }
+
+  min = TYPE_MIN_VALUE (type);
+  max = TYPE_MAX_VALUE (type);
+
+  if (TREE_TYPE (min) != TREE_TYPE (max))
+    {
+      error ("range limits are not of the same type");
+      return error_mark_node;
+    }
+
+  itype = build_range_type (TREE_TYPE (min), min, max);
+
+  if (TREE_TYPE (type) == NULL_TREE)
+    {
+      layout_type (type);
+      TREE_TYPE (itype) = type;
+    }
+  else
+    {
+      layout_type (TREE_TYPE (type));
+      TREE_TYPE (itype) = TREE_TYPE (type);
+    }
+
+  layout_type (itype);
+  return itype;
+}
+#endif
+
+/* build_bitset_type builds the type BITSET which is exported from
+   SYSTEM.  It also builds BITNUM (the subrange from which BITSET is
+   created).  */
+
+static tree
+build_bitset_type (location_t location)
+{
+  m2assert_AssertLocation (location);
+  bitnum_type_node = build_range_type (
+      m2tree_skip_type_decl (m2type_GetCardinalType ()),
+      m2decl_BuildIntegerConstant (0),
+      m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset () - 1));
+  layout_type (bitnum_type_node);
+
+#if 1
+  if (broken_set_debugging_info)
+    return unsigned_type_node;
+#endif
+
+  ASSERT ((COMPLETE_TYPE_P (bitnum_type_node)), bitnum_type_node);
+
+  return m2type_BuildSetTypeFromSubrange (
+      location, NULL, bitnum_type_node, m2decl_BuildIntegerConstant (0),
+      m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset () - 1), FALSE);
+}
+
+/* BuildSetTypeFromSubrange constructs a set type from a
+   subrangeType.  --fixme-- revisit once gdb/gcc supports dwarf-5 set type.  */
+
+tree
+m2type_BuildSetTypeFromSubrange (location_t location,
+				 char *name __attribute__ ((unused)),
+                                 tree subrangeType __attribute__ ((unused)),
+				 tree lowval, tree highval, int ispacked)
+{
+  m2assert_AssertLocation (location);
+  lowval = m2expr_FoldAndStrip (lowval);
+  highval = m2expr_FoldAndStrip (highval);
+
+#if 0
+  if (broken_set_debugging_info)
+    return unsigned_type_node;
+  else
+#endif
+    if (ispacked)
+    {
+      tree noelements = m2expr_BuildAdd (
+	  location, m2expr_BuildSub (location, highval, lowval, FALSE),
+          integer_one_node, FALSE);
+      highval = m2expr_FoldAndStrip (m2expr_BuildSub (
+            location, m2expr_BuildLSL (location, m2expr_GetWordOne (location),
+                                       noelements, FALSE),
+            m2expr_GetIntegerOne (location), FALSE));
+      lowval = m2expr_GetIntegerZero (location);
+      return m2type_BuildSmallestTypeRange (location, lowval, highval);
+    }
+  else
+    return unsigned_type_node;
+}
+
+/* build_m2_size_set_type build and return a set type with
+   precision bits.  */
+
+static tree
+build_m2_size_set_type (location_t location, int precision)
+{
+  tree bitnum_type_node
+      = build_range_type (m2tree_skip_type_decl (m2type_GetCardinalType ()),
+                          m2decl_BuildIntegerConstant (0),
+                          m2decl_BuildIntegerConstant (precision - 1));
+  layout_type (bitnum_type_node);
+  m2assert_AssertLocation (location);
+
+  if (broken_set_debugging_info)
+    return unsigned_type_node;
+
+  ASSERT ((COMPLETE_TYPE_P (bitnum_type_node)), bitnum_type_node);
+
+  return m2type_BuildSetTypeFromSubrange (
+      location, NULL, bitnum_type_node, m2decl_BuildIntegerConstant (0),
+      m2decl_BuildIntegerConstant (precision - 1), FALSE);
+}
+
+/* build_m2_specific_size_type build a specific data type matching
+   number of bits precision whether it is_signed.  It creates a
+   set type if base == SET_TYPE or returns the already created real,
+   if REAL_TYPE is specified.  */
+
+static tree
+build_m2_specific_size_type (location_t location, enum tree_code base,
+                             int precision, int is_signed)
+{
+  tree c;
+
+  m2assert_AssertLocation (location);
+
+  c = make_node (base);
+  TYPE_PRECISION (c) = precision;
+
+  if (base == REAL_TYPE)
+    {
+      if (!float_mode_for_size (TYPE_PRECISION (c)).exists ())
+        return NULL;
+      layout_type (c);
+    }
+  else if (base == SET_TYPE)
+    return build_m2_size_set_type (location, precision);
+  else
+    {
+      TYPE_SIZE (c) = 0;
+
+      if (is_signed)
+        {
+          fixup_signed_type (c);
+          TYPE_UNSIGNED (c) = FALSE;
+        }
+      else
+        {
+          fixup_unsigned_type (c);
+          TYPE_UNSIGNED (c) = TRUE;
+        }
+    }
+
+  return c;
+}
+
+/* BuildSmallestTypeRange returns the smallest INTEGER_TYPE which
+   is sufficient to contain values: low..high.  */
+
+tree
+m2type_BuildSmallestTypeRange (location_t location, tree low, tree high)
+{
+  tree bits;
+
+  m2assert_AssertLocation (location);
+  low = fold (low);
+  high = fold (high);
+  bits = fold (noBitsRequired (
+      m2expr_BuildAdd (location, m2expr_BuildSub (location, high, low, FALSE),
+                       m2expr_GetIntegerOne (location), FALSE)));
+  return build_m2_specific_size_type (location, INTEGER_TYPE,
+                                      TREE_INT_CST_LOW (bits),
+                                      tree_int_cst_sgn (low) < 0);
+}
+
+/* GetTreeType returns TREE_TYPE (t).  */
+
+tree
+m2type_GetTreeType (tree t)
+{
+  return TREE_TYPE (t);
+}
+
+/* finish_build_pointer_type finish building a POINTER_TYPE node.
+   necessary to solve self references in procedure types.  */
+
+/* Code taken from tree.cc:build_pointer_type_for_mode.  */
+
+static tree
+finish_build_pointer_type (tree t, tree to_type, enum machine_mode mode,
+                           bool can_alias_all)
+{
+  TREE_TYPE (t) = to_type;
+  SET_TYPE_MODE (t, mode);
+  TYPE_REF_CAN_ALIAS_ALL (t) = can_alias_all;
+  TYPE_NEXT_PTR_TO (t) = TYPE_POINTER_TO (to_type);
+  TYPE_POINTER_TO (to_type) = t;
+
+  /* Lay out the type.  */
+  /* layout_type (t);  */
+  layout_type (t);
+
+  return t;
+}
+
+/* BuildParameterDeclaration creates and returns one parameter
+   from, name, and, type.  It appends this parameter to the internal
+   param_type_list.  */
+
+tree
+m2type_BuildProcTypeParameterDeclaration (location_t location, tree type,
+                                          int isreference)
+{
+  m2assert_AssertLocation (location);
+  ASSERT_BOOL (isreference);
+  type = m2tree_skip_type_decl (type);
+  if (isreference)
+    type = build_reference_type (type);
+
+  param_type_list = tree_cons (NULL_TREE, type, param_type_list);
+  return type;
+}
+
+/* BuildEndFunctionType build a function type which would return a,
+   value.  The arguments have been created by
+   BuildParameterDeclaration.  */
+
+tree
+m2type_BuildEndFunctionType (tree func, tree return_type, int uses_varargs)
+{
+  tree last;
+
+  if (return_type == NULL_TREE)
+    return_type = void_type_node;
+  else
+    return_type = m2tree_skip_type_decl (return_type);
+
+  if (uses_varargs)
+    {
+      if (param_type_list != NULL_TREE)
+        {
+          param_type_list = nreverse (param_type_list);
+          last = param_type_list;
+          param_type_list = nreverse (param_type_list);
+          gcc_assert (last != void_list_node);
+        }
+    }
+  else if (param_type_list == NULL_TREE)
+    param_type_list = void_list_node;
+  else
+    {
+      param_type_list = nreverse (param_type_list);
+      last = param_type_list;
+      param_type_list = nreverse (param_type_list);
+      TREE_CHAIN (last) = void_list_node;
+    }
+  param_type_list = build_function_type (return_type, param_type_list);
+
+  func = finish_build_pointer_type (func, param_type_list, ptr_mode, false);
+  TYPE_SIZE (func) = 0;
+  layout_type (func);
+  return func;
+}
+
+/* BuildStartFunctionType creates a pointer type, necessary to
+   create a function type.  */
+
+tree
+m2type_BuildStartFunctionType (location_t location ATTRIBUTE_UNUSED,
+                               char *name ATTRIBUTE_UNUSED)
+{
+  tree n = make_node (POINTER_TYPE);
+
+  m2assert_AssertLocation (location);
+  return n;
+}
+
+/* InitFunctionTypeParameters resets the current function type
+   parameter list.  */
+
+void
+m2type_InitFunctionTypeParameters (void)
+{
+  param_type_list = NULL_TREE;
+}
+
+/* gm2_finish_decl finishes VAR, TYPE and FUNCTION declarations.  */
+
+static void
+gm2_finish_decl (location_t location, tree decl)
+{
+  tree type = TREE_TYPE (decl);
+  int was_incomplete = (DECL_SIZE (decl) == 0);
+
+  m2assert_AssertLocation (location);
+  if (TREE_CODE (decl) == VAR_DECL)
+    {
+      if (DECL_SIZE (decl) == 0 && TREE_TYPE (decl) != error_mark_node
+          && COMPLETE_TYPE_P (TREE_TYPE (decl)))
+        layout_decl (decl, 0);
+
+      if (DECL_SIZE (decl) == 0
+          /* Don't give an error if we already gave one earlier.  */
+          && TREE_TYPE (decl) != error_mark_node)
+        {
+          error_at (location, "storage size of %q+D isn%'t known", decl);
+          TREE_TYPE (decl) = error_mark_node;
+        }
+
+      if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl))
+          && DECL_SIZE (decl) != 0)
+        {
+          if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
+            m2expr_ConstantExpressionWarning (DECL_SIZE (decl));
+          else
+            error_at (location, "storage size of %q+D isn%'t constant", decl);
+        }
+
+      if (TREE_USED (type))
+        TREE_USED (decl) = 1;
+    }
+
+  /* Output the assembler code and/or RTL code for variables and
+     functions, unless the type is an undefined structure or union.  If
+     not, it will get done when the type is completed.  */
+
+  if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL)
+    {
+      if (DECL_FILE_SCOPE_P (decl))
+        {
+          if (DECL_INITIAL (decl) == NULL_TREE
+              || DECL_INITIAL (decl) == error_mark_node)
+
+            /* Don't output anything when a tentative file-scope definition is
+	       seen.  But at end of compilation, do output code for them.  */
+            DECL_DEFER_OUTPUT (decl) = 1;
+          rest_of_decl_compilation (decl, true, 0);
+        }
+
+      if (!DECL_FILE_SCOPE_P (decl))
+        {
+
+          /* Recompute the RTL of a local array now if it used to be an
+	     incomplete type.  */
+          if (was_incomplete && !TREE_STATIC (decl) && !DECL_EXTERNAL (decl))
+            {
+              /* If we used it already as memory, it must stay in memory.  */
+              TREE_ADDRESSABLE (decl) = TREE_USED (decl);
+              /* If it's still incomplete now, no init will save it.  */
+              if (DECL_SIZE (decl) == 0)
+                DECL_INITIAL (decl) = 0;
+            }
+        }
+    }
+
+  if (TREE_CODE (decl) == TYPE_DECL)
+    {
+      if (!DECL_FILE_SCOPE_P (decl)
+          && variably_modified_type_p (TREE_TYPE (decl), NULL_TREE))
+        m2block_pushDecl (build_stmt (location, DECL_EXPR, decl));
+
+      rest_of_decl_compilation (decl, DECL_FILE_SCOPE_P (decl), 0);
+    }
+}
+
+/* BuildVariableArrayAndDeclare creates a variable length array.
+   high is the maximum legal elements (which is a runtime variable).
+   This creates and array index, array type and local variable.  */
+
+tree
+m2type_BuildVariableArrayAndDeclare (location_t location, tree elementtype,
+                                     tree high, char *name, tree scope)
+{
+  tree indextype = build_index_type (variable_size (high));
+  tree arraytype = build_array_type (elementtype, indextype);
+  tree id = get_identifier (name);
+  tree decl;
+
+  m2assert_AssertLocation (location);
+  decl = build_decl (location, VAR_DECL, id, arraytype);
+
+  DECL_EXTERNAL (decl) = FALSE;
+  TREE_PUBLIC (decl) = TRUE;
+  DECL_CONTEXT (decl) = scope;
+  TREE_USED (arraytype) = TRUE;
+  TREE_USED (decl) = TRUE;
+
+  m2block_pushDecl (decl);
+
+  gm2_finish_decl (location, indextype);
+  gm2_finish_decl (location, arraytype);
+  add_stmt (location, build_stmt (location, DECL_EXPR, decl));
+
+  return decl;
+}
+
+static tree
+build_m2_iso_word_node (location_t location, int loc)
+{
+  tree c;
+
+  m2assert_AssertLocation (location);
+  /* Define `WORD' as specified in ISO m2
+
+     WORD = ARRAY [0..SizeOfWord / SizeOfLoc] OF LOC ; */
+
+  if (m2decl_GetBitsPerInt () == BITS_PER_UNIT)
+    c = m2type_GetISOLocType ();
+  else
+    c = gm2_build_array_type (
+        m2type_GetISOLocType (),
+        m2type_BuildArrayIndexType (
+            m2expr_GetIntegerZero (location),
+            (m2expr_BuildSub (location,
+                              m2decl_BuildIntegerConstant (
+                                  m2decl_GetBitsPerInt () / BITS_PER_UNIT),
+                              m2expr_GetIntegerOne (location), FALSE))),
+        loc);
+  return c;
+}
+
+static tree
+build_m2_iso_byte_node (location_t location, int loc)
+{
+  tree c;
+
+  /* Define `BYTE' as specified in ISO m2
+
+     BYTE = ARRAY [0..SizeOfByte / SizeOfLoc] OF LOC ; */
+
+  if (BITS_PER_UNIT == 8)
+    c = m2type_GetISOLocType ();
+  else
+    c = gm2_build_array_type (
+        m2type_GetISOLocType (),
+        m2type_BuildArrayIndexType (
+            m2expr_GetIntegerZero (location),
+            m2decl_BuildIntegerConstant (BITS_PER_UNIT / 8)),
+        loc);
+  return c;
+}
+
+/* m2type_InitSystemTypes initialise loc and word derivatives.  */
+
+void
+m2type_InitSystemTypes (location_t location, int loc)
+{
+  m2assert_AssertLocation (location);
+
+  m2_iso_word_type_node = build_m2_iso_word_node (location, loc);
+  m2_iso_byte_type_node = build_m2_iso_byte_node (location, loc);
+
+  m2_word16_type_node = build_m2_word16_type_node (location, loc);
+  m2_word32_type_node = build_m2_word32_type_node (location, loc);
+  m2_word64_type_node = build_m2_word64_type_node (location, loc);
+}
+
+static tree
+build_m2_integer_node (void)
+{
+  return m2type_GetIntegerType ();
+}
+
+static tree
+build_m2_cardinal_node (void)
+{
+  return m2type_GetCardinalType ();
+}
+
+static tree
+build_m2_char_node (void)
+{
+  tree c;
+
+  /* Define `CHAR', to be an unsigned char.  */
+
+  c = make_unsigned_type (CHAR_TYPE_SIZE);
+  layout_type (c);
+  return c;
+}
+
+static tree
+build_m2_short_real_node (void)
+{
+  tree c;
+
+  /* Define `REAL'.  */
+
+  c = make_node (REAL_TYPE);
+  TYPE_PRECISION (c) = FLOAT_TYPE_SIZE;
+  layout_type (c);
+
+  return c;
+}
+
+static tree
+build_m2_real_node (void)
+{
+  tree c;
+
+  /* Define `REAL'.  */
+
+  c = make_node (REAL_TYPE);
+  TYPE_PRECISION (c) = DOUBLE_TYPE_SIZE;
+  layout_type (c);
+
+  return c;
+}
+
+static tree
+build_m2_long_real_node (void)
+{
+  tree c;
+
+  /* Define `LONGREAL'.  */
+
+  c = make_node (REAL_TYPE);
+  TYPE_PRECISION (c) = LONG_DOUBLE_TYPE_SIZE;
+  layout_type (c);
+
+  return c;
+}
+
+static tree
+build_m2_long_int_node (void)
+{
+  tree c;
+
+  /* Define `LONGINT'.  */
+
+  c = make_signed_type (LONG_LONG_TYPE_SIZE);
+  layout_type (c);
+
+  return c;
+}
+
+static tree
+build_m2_long_card_node (void)
+{
+  tree c;
+
+  /* Define `LONGCARD'.  */
+
+  c = make_unsigned_type (LONG_LONG_TYPE_SIZE);
+  layout_type (c);
+
+  return c;
+}
+
+static tree
+build_m2_short_int_node (void)
+{
+  tree c;
+
+  /* Define `SHORTINT'.  */
+
+  c = make_signed_type (SHORT_TYPE_SIZE);
+  layout_type (c);
+
+  return c;
+}
+
+static tree
+build_m2_short_card_node (void)
+{
+  tree c;
+
+  /* Define `SHORTCARD'.  */
+
+  c = make_unsigned_type (SHORT_TYPE_SIZE);
+  layout_type (c);
+
+  return c;
+}
+
+static tree
+build_m2_iso_loc_node (void)
+{
+  tree c;
+
+  /* Define `LOC' as specified in ISO m2.  */
+
+  c = make_node (INTEGER_TYPE);
+  TYPE_PRECISION (c) = BITS_PER_UNIT;
+  TYPE_SIZE (c) = 0;
+
+  fixup_unsigned_type (c);
+  TYPE_UNSIGNED (c) = 1;
+
+  return c;
+}
+
+static tree
+build_m2_integer8_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, INTEGER_TYPE, 8, TRUE);
+}
+
+static tree
+build_m2_integer16_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, INTEGER_TYPE, 16, TRUE);
+}
+
+static tree
+build_m2_integer32_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, INTEGER_TYPE, 32, TRUE);
+}
+
+static tree
+build_m2_integer64_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, INTEGER_TYPE, 64, TRUE);
+}
+
+static tree
+build_m2_cardinal8_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, INTEGER_TYPE, 8, FALSE);
+}
+
+static tree
+build_m2_cardinal16_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, INTEGER_TYPE, 16, FALSE);
+}
+
+static tree
+build_m2_cardinal32_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, INTEGER_TYPE, 32, FALSE);
+}
+
+static tree
+build_m2_cardinal64_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, INTEGER_TYPE, 64, FALSE);
+}
+
+static tree
+build_m2_bitset8_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  if (broken_set_debugging_info)
+    return build_m2_specific_size_type (location, INTEGER_TYPE, 8, FALSE);
+  else
+    return build_m2_specific_size_type (location, SET_TYPE, 8, FALSE);
+}
+
+static tree
+build_m2_bitset16_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  if (broken_set_debugging_info)
+    return build_m2_specific_size_type (location, INTEGER_TYPE, 16, FALSE);
+  else
+    return build_m2_specific_size_type (location, SET_TYPE, 16, FALSE);
+}
+
+static tree
+build_m2_bitset32_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  if (broken_set_debugging_info)
+    return build_m2_specific_size_type (location, INTEGER_TYPE, 32, FALSE);
+  else
+    return build_m2_specific_size_type (location, SET_TYPE, 32, FALSE);
+}
+
+static tree
+build_m2_real32_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, REAL_TYPE, 32, TRUE);
+}
+
+static tree
+build_m2_real64_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, REAL_TYPE, 64, TRUE);
+}
+
+static tree
+build_m2_real96_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, REAL_TYPE, 96, TRUE);
+}
+
+static tree
+build_m2_real128_type_node (location_t location)
+{
+  m2assert_AssertLocation (location);
+  return build_m2_specific_size_type (location, REAL_TYPE, 128, TRUE);
+}
+
+static tree
+build_m2_complex_type_from (tree scalar_type)
+{
+  tree new_type;
+
+  if (scalar_type == NULL)
+    return NULL;
+  if (scalar_type == float_type_node)
+    return complex_float_type_node;
+  if (scalar_type == double_type_node)
+    return complex_double_type_node;
+  if (scalar_type == long_double_type_node)
+    return complex_long_double_type_node;
+
+  new_type = make_node (COMPLEX_TYPE);
+  TREE_TYPE (new_type) = scalar_type;
+  layout_type (new_type);
+  return new_type;
+}
+
+static tree
+build_m2_complex_type_node (void)
+{
+  return build_m2_complex_type_from (m2_real_type_node);
+}
+
+static tree
+build_m2_long_complex_type_node (void)
+{
+  return build_m2_complex_type_from (m2_long_real_type_node);
+}
+
+static tree
+build_m2_short_complex_type_node (void)
+{
+  return build_m2_complex_type_from (m2_short_real_type_node);
+}
+
+static tree
+build_m2_complex32_type_node (void)
+{
+  return build_m2_complex_type_from (m2_real32_type_node);
+}
+
+static tree
+build_m2_complex64_type_node (void)
+{
+  return build_m2_complex_type_from (m2_real64_type_node);
+}
+
+static tree
+build_m2_complex96_type_node (void)
+{
+  return build_m2_complex_type_from (m2_real96_type_node);
+}
+
+static tree
+build_m2_complex128_type_node (void)
+{
+  return build_m2_complex_type_from (m2_real128_type_node);
+}
+
+static tree
+build_m2_cardinal_address_type_node (location_t location)
+{
+  tree size = size_in_bytes (ptr_type_node);
+  int bits = TREE_INT_CST_LOW (size) * BITS_PER_UNIT;
+
+  return build_m2_specific_size_type (location, INTEGER_TYPE, bits, FALSE);
+}
+
+/* InitBaseTypes create the Modula-2 base types.  */
+
+void
+m2type_InitBaseTypes (location_t location)
+{
+  m2assert_AssertLocation (location);
+  m2block_init ();
+
+  ptr_type_node = build_pointer_type (void_type_node);
+
+  proc_type_node
+      = build_pointer_type (build_function_type (void_type_node, NULL_TREE));
+
+  bitset_type_node = build_bitset_type (location);
+  m2_char_type_node = build_m2_char_node ();
+  m2_integer_type_node = build_m2_integer_node ();
+  m2_cardinal_type_node = build_m2_cardinal_node ();
+  m2_short_real_type_node = build_m2_short_real_node ();
+  m2_real_type_node = build_m2_real_node ();
+  m2_long_real_type_node = build_m2_long_real_node ();
+  m2_long_int_type_node = build_m2_long_int_node ();
+  m2_long_card_type_node = build_m2_long_card_node ();
+  m2_short_int_type_node = build_m2_short_int_node ();
+  m2_short_card_type_node = build_m2_short_card_node ();
+  m2_z_type_node = build_m2_long_int_node ();
+  m2_integer8_type_node = build_m2_integer8_type_node (location);
+  m2_integer16_type_node = build_m2_integer16_type_node (location);
+  m2_integer32_type_node = build_m2_integer32_type_node (location);
+  m2_integer64_type_node = build_m2_integer64_type_node (location);
+  m2_cardinal8_type_node = build_m2_cardinal8_type_node (location);
+  m2_cardinal16_type_node = build_m2_cardinal16_type_node (location);
+  m2_cardinal32_type_node = build_m2_cardinal32_type_node (location);
+  m2_cardinal64_type_node = build_m2_cardinal64_type_node (location);
+  m2_bitset8_type_node = build_m2_bitset8_type_node (location);
+  m2_bitset16_type_node = build_m2_bitset16_type_node (location);
+  m2_bitset32_type_node = build_m2_bitset32_type_node (location);
+  m2_real32_type_node = build_m2_real32_type_node (location);
+  m2_real64_type_node = build_m2_real64_type_node (location);
+  m2_real96_type_node = build_m2_real96_type_node (location);
+  m2_real128_type_node = build_m2_real128_type_node (location);
+  m2_complex_type_node = build_m2_complex_type_node ();
+  m2_long_complex_type_node = build_m2_long_complex_type_node ();
+  m2_short_complex_type_node = build_m2_short_complex_type_node ();
+  m2_c_type_node = build_m2_long_complex_type_node ();
+  m2_complex32_type_node = build_m2_complex32_type_node ();
+  m2_complex64_type_node = build_m2_complex64_type_node ();
+  m2_complex96_type_node = build_m2_complex96_type_node ();
+  m2_complex128_type_node = build_m2_complex128_type_node ();
+  m2_iso_loc_type_node = build_m2_iso_loc_node ();
+
+  m2_cardinal_address_type_node
+      = build_m2_cardinal_address_type_node (location);
+
+  m2_packed_boolean_type_node = build_nonstandard_integer_type (1, TRUE);
+
+  m2builtins_init (location);
+  m2except_InitExceptions (location);
+  m2expr_init (location);
+}
+
+/* BuildStartType given a, type, with a, name, return a GCC
+   declaration of this type.  TYPE name = foo ;
+
+   the type, foo, maybe a partially created type (which has
+   yet to be 'gm2_finish_decl'ed).  */
+
+tree
+m2type_BuildStartType (location_t location, char *name, tree type)
+{
+  tree id = get_identifier (name);
+  tree decl, tem;
+
+  m2assert_AssertLocation (location);
+  ASSERT (m2tree_is_type (type), type);
+  type = m2tree_skip_type_decl (type);
+  decl = build_decl (location, TYPE_DECL, id, type);
+
+  tem = m2block_pushDecl (decl);
+  ASSERT (tem == decl, decl);
+  ASSERT (m2tree_is_type (decl), decl);
+
+  return tem;
+}
+
+/* BuildEndType finish declaring, type, and return, type.  */
+
+tree
+m2type_BuildEndType (location_t location, tree type)
+{
+  m2assert_AssertLocation (location);
+  layout_type (TREE_TYPE (type));
+  gm2_finish_decl (location, type);
+  return type;
+}
+
+/* DeclareKnownType given a, type, with a, name, return a GCC
+   declaration of this type.  TYPE name = foo ; */
+
+tree
+m2type_DeclareKnownType (location_t location, char *name, tree type)
+{
+  m2assert_AssertLocation (location);
+  return m2type_BuildEndType (location,
+                              m2type_BuildStartType (location, name, type));
+}
+
+/* GetDefaultType given a, type, with a, name, return a GCC
+   declaration of this type.  Checks to see whether the type name has
+   already been declared as a default type and if so it returns this
+   declaration.  Otherwise it declares the type.  In Modula-2 this is
+   equivalent to:
+
+   TYPE name = type ;
+
+   We need this function during gm2 initialization as it allows
+   gm2 to access default types before creating Modula-2 types.  */
+
+tree
+m2type_GetDefaultType (location_t location, char *name, tree type)
+{
+  tree id = maybe_get_identifier (name);
+
+  m2assert_AssertLocation (location);
+  if (id == NULL)
+    {
+      tree prev = type;
+      tree t;
+
+      while (prev != NULL)
+        {
+          if (TYPE_NAME (prev) == NULL)
+            TYPE_NAME (prev) = get_identifier (name);
+          prev = TREE_TYPE (prev);
+        }
+      t = m2type_DeclareKnownType (location, name, type);
+      return t;
+    }
+  else
+    return id;
+}
+
+tree
+do_min_real (tree type)
+{
+  REAL_VALUE_TYPE r;
+  char buf[128];
+  enum machine_mode mode = TYPE_MODE (type);
+
+  get_max_float (REAL_MODE_FORMAT (mode), buf, sizeof (buf), false);
+  real_from_string (&r, buf);
+  return build1 (NEGATE_EXPR, type, build_real (type, r));
+}
+
+/* GetMinFrom given a, type, return a constant representing the
+   minimum legal value.  */
+
+tree
+m2type_GetMinFrom (location_t location, tree type)
+{
+  m2assert_AssertLocation (location);
+
+  if (type == m2_real_type_node || type == m2type_GetRealType ())
+    return do_min_real (type);
+  if (type == m2_long_real_type_node || type == m2type_GetLongRealType ())
+    return do_min_real (type);
+  if (type == m2_short_real_type_node || type == m2type_GetShortRealType ())
+    return do_min_real (type);
+  if (type == ptr_type_node)
+    return m2expr_GetPointerZero (location);
+
+  return TYPE_MIN_VALUE (m2tree_skip_type_decl (type));
+}
+
+tree
+do_max_real (tree type)
+{
+  REAL_VALUE_TYPE r;
+  char buf[128];
+  enum machine_mode mode = TYPE_MODE (type);
+
+  get_max_float (REAL_MODE_FORMAT (mode), buf, sizeof (buf), false);
+  real_from_string (&r, buf);
+  return build_real (type, r);
+}
+
+/* GetMaxFrom given a, type, return a constant representing the
+   maximum legal value.  */
+
+tree
+m2type_GetMaxFrom (location_t location, tree type)
+{
+  m2assert_AssertLocation (location);
+
+  if (type == m2_real_type_node || type == m2type_GetRealType ())
+    return do_max_real (type);
+  if (type == m2_long_real_type_node || type == m2type_GetLongRealType ())
+    return do_max_real (type);
+  if (type == m2_short_real_type_node || type == m2type_GetShortRealType ())
+    return do_max_real (type);
+  if (type == ptr_type_node)
+    return fold (m2expr_BuildSub (location, m2expr_GetPointerZero (location),
+                                  m2expr_GetPointerOne (location), FALSE));
+
+  return TYPE_MAX_VALUE (m2tree_skip_type_decl (type));
+}
+
+/* BuildTypeDeclaration adds the, type, to the current statement
+   list.  */
+
+void
+m2type_BuildTypeDeclaration (location_t location, tree type)
+{
+  enum tree_code code = TREE_CODE (type);
+
+  m2assert_AssertLocation (location);
+  if (code == TYPE_DECL || code == RECORD_TYPE || code == POINTER_TYPE)
+    {
+      m2block_pushDecl (build_decl (location, TYPE_DECL, NULL, type));
+    }
+  else if (code == VAR_DECL)
+    {
+      m2type_BuildTypeDeclaration (location, TREE_TYPE (type));
+      m2block_pushDecl (
+          build_stmt (location, DECL_EXPR,
+                      type));  /* Is this safe?  --fixme--.  */
+    }
+}
+
+/* Begin compiling the definition of an enumeration type.  NAME is
+   its name (or null if anonymous).  Returns the type object, as yet
+   incomplete.  Also records info about it so that build_enumerator may
+   be used to declare the individual values as they are read.  */
+
+static tree
+gm2_start_enum (location_t location, tree name, int ispacked)
+{
+  tree enumtype = make_node (ENUMERAL_TYPE);
+
+  m2assert_AssertLocation (location);
+  if (TYPE_VALUES (enumtype) != 0)
+    {
+      /* This enum is a named one that has been declared already.  */
+      error_at (location, "redeclaration of enum %qs",
+                IDENTIFIER_POINTER (name));
+
+      /* Completely replace its old definition.  The old enumerators remain
+	 defined, however.  */
+      TYPE_VALUES (enumtype) = 0;
+    }
+
+  TYPE_PACKED (enumtype) = ispacked;
+  TREE_TYPE (enumtype) = m2type_GetIntegerType ();
+
+  /* This is required as rest_of_type_compilation will use this field
+     when called from gm2_finish_enum.
+
+     Create a fake NULL-named TYPE_DECL node whose TREE_TYPE will be the
+     tagged type we just added to the current scope.  This fake NULL-named
+     TYPE_DECL node helps dwarfout.cc to know when it needs to output a
+     representation of a tagged type, and it also gives us a convenient
+     place to record the "scope start" address for the tagged type.  */
+
+  TYPE_STUB_DECL (enumtype) = m2block_pushDecl (
+      build_decl (location, TYPE_DECL, NULL_TREE, enumtype));
+
+  return enumtype;
+}
+
+/* After processing and defining all the values of an enumeration
+   type, install their decls in the enumeration type and finish it off.
+   ENUMTYPE is the type object, VALUES a list of decl-value pairs, and
+   ATTRIBUTES are the specified attributes.  Returns ENUMTYPE.  */
+
+static tree
+gm2_finish_enum (location_t location, tree enumtype, tree values)
+{
+  tree pair, tem;
+  tree minnode = 0, maxnode = 0;
+  int precision;
+  signop sign;
+
+  /* Calculate the maximum value of any enumerator in this type.  */
+
+  if (values == error_mark_node)
+    minnode = maxnode = integer_zero_node;
+  else
+    {
+      minnode = maxnode = TREE_VALUE (values);
+      for (pair = TREE_CHAIN (values); pair; pair = TREE_CHAIN (pair))
+        {
+          tree value = TREE_VALUE (pair);
+          if (tree_int_cst_lt (maxnode, value))
+            maxnode = value;
+          if (tree_int_cst_lt (value, minnode))
+            minnode = value;
+        }
+    }
+
+  /* Construct the final type of this enumeration.  It is the same as
+     one of the integral types the narrowest one that fits, except that
+     normally we only go as narrow as int and signed iff any of the
+     values are negative.  */
+  sign = (tree_int_cst_sgn (minnode) >= 0) ? UNSIGNED : SIGNED;
+  precision = MAX (tree_int_cst_min_precision (minnode, sign),
+                   tree_int_cst_min_precision (maxnode, sign));
+
+  if (precision > TYPE_PRECISION (integer_type_node))
+    {
+      warning (0, "enumeration values exceed range of integer");
+      tem = long_long_integer_type_node;
+    }
+  else if (TYPE_PACKED (enumtype))
+    tem = m2type_BuildSmallestTypeRange (location, minnode, maxnode);
+  else
+    tem = sign == UNSIGNED ? unsigned_type_node : integer_type_node;
+
+  TYPE_MIN_VALUE (enumtype) = TYPE_MIN_VALUE (tem);
+  TYPE_MAX_VALUE (enumtype) = TYPE_MAX_VALUE (tem);
+  TYPE_UNSIGNED (enumtype) = TYPE_UNSIGNED (tem);
+  TYPE_SIZE (enumtype) = 0;
+
+  /* If the precision of the type was specific with an attribute and it
+     was too small, give an error.  Otherwise, use it.  */
+  if (TYPE_PRECISION (enumtype))
+    {
+      if (precision > TYPE_PRECISION (enumtype))
+        error ("specified mode too small for enumerated values");
+    }
+  else
+    TYPE_PRECISION (enumtype) = TYPE_PRECISION (tem);
+
+  layout_type (enumtype);
+
+  if (values != error_mark_node)
+    {
+
+      /* Change the type of the enumerators to be the enum type.  We need
+         to do this irrespective of the size of the enum, for proper type
+         checking.  Replace the DECL_INITIALs of the enumerators, and the
+         value slots of the list, with copies that have the enum type; they
+         cannot be modified in place because they may be shared (e.g.
+         integer_zero_node) Finally, change the purpose slots to point to the
+         names of the decls.  */
+      for (pair = values; pair; pair = TREE_CHAIN (pair))
+        {
+          tree enu = TREE_PURPOSE (pair);
+          tree ini = DECL_INITIAL (enu);
+
+          TREE_TYPE (enu) = enumtype;
+
+          if (TREE_TYPE (ini) != integer_type_node)
+            ini = convert (enumtype, ini);
+
+          DECL_INITIAL (enu) = ini;
+          TREE_PURPOSE (pair) = DECL_NAME (enu);
+          TREE_VALUE (pair) = ini;
+        }
+
+      TYPE_VALUES (enumtype) = values;
+    }
+
+  /* Fix up all variant types of this enum type.  */
+  for (tem = TYPE_MAIN_VARIANT (enumtype); tem; tem = TYPE_NEXT_VARIANT (tem))
+    {
+      if (tem == enumtype)
+        continue;
+      TYPE_VALUES (tem) = TYPE_VALUES (enumtype);
+      TYPE_MIN_VALUE (tem) = TYPE_MIN_VALUE (enumtype);
+      TYPE_MAX_VALUE (tem) = TYPE_MAX_VALUE (enumtype);
+      TYPE_SIZE (tem) = TYPE_SIZE (enumtype);
+      TYPE_SIZE_UNIT (tem) = TYPE_SIZE_UNIT (enumtype);
+      SET_TYPE_MODE (tem, TYPE_MODE (enumtype));
+      TYPE_PRECISION (tem) = TYPE_PRECISION (enumtype);
+      SET_TYPE_ALIGN (tem, TYPE_ALIGN (enumtype));
+      TYPE_USER_ALIGN (tem) = TYPE_USER_ALIGN (enumtype);
+      TYPE_UNSIGNED (tem) = TYPE_UNSIGNED (enumtype);
+      TYPE_LANG_SPECIFIC (tem) = TYPE_LANG_SPECIFIC (enumtype);
+    }
+
+  /* Finish debugging output for this type.  */
+  rest_of_type_compilation (enumtype, m2block_toplevel ());
+  return enumtype;
+}
+
+/* BuildStartEnumeration create an enumerated type in gcc.  */
+
+tree
+m2type_BuildStartEnumeration (location_t location, char *name, int ispacked)
+{
+  tree id;
+
+  m2assert_AssertLocation (location);
+  if ((name == NULL) || (strcmp (name, "") == 0))
+    id = NULL_TREE;
+  else
+    id = get_identifier (name);
+
+  return gm2_start_enum (location, id, ispacked);
+}
+
+/* BuildEndEnumeration finish building the enumeration, it uses the
+   enum list, enumvalues, and returns a enumeration type tree.  */
+
+tree
+m2type_BuildEndEnumeration (location_t location, tree enumtype,
+                            tree enumvalues)
+{
+  tree finished ATTRIBUTE_UNUSED
+      = gm2_finish_enum (location, enumtype, enumvalues);
+  return enumtype;
+}
+
+/* Build and install a CONST_DECL for one value of the current
+   enumeration type (one that was begun with start_enum).  Return a
+   tree-list containing the CONST_DECL and its value.  Assignment of
+   sequential values by default is handled here.  */
+
+static tree
+gm2_build_enumerator (location_t location, tree name, tree value)
+{
+  tree decl, type;
+
+  m2assert_AssertLocation (location);
+  /* Remove no-op casts from the value.  */
+  if (value)
+    STRIP_TYPE_NOPS (value);
+
+  /* Now create a declaration for the enum value name.  */
+
+  type = TREE_TYPE (value);
+
+  decl = build_decl (location, CONST_DECL, name, type);
+  DECL_INITIAL (decl) = convert (type, value);
+  m2block_pushDecl (decl);
+
+  return tree_cons (decl, value, NULL_TREE);
+}
+
+/* BuildEnumerator build an enumerator and add it to the,
+   enumvalues, list.  It returns a copy of the value.  */
+
+tree
+m2type_BuildEnumerator (location_t location, char *name, tree value,
+                        tree *enumvalues)
+{
+  tree id = get_identifier (name);
+  tree copy_of_value = copy_node (value);
+  tree gccenum = gm2_build_enumerator (location, id, copy_of_value);
+
+  m2assert_AssertLocation (location);
+  /* Choose copy_of_value for enum value.  */
+  *enumvalues = chainon (gccenum, *enumvalues);
+  return copy_of_value;
+}
+
+/* BuildPointerType returns a type which is a pointer to, totype.  */
+
+tree
+m2type_BuildPointerType (tree totype)
+{
+  return build_pointer_type (m2tree_skip_type_decl (totype));
+}
+
+/* BuildConstPointerType returns a type which is a const pointer
+   to, totype.  */
+
+tree
+m2type_BuildConstPointerType (tree totype)
+{
+  tree t = build_pointer_type (m2tree_skip_type_decl (totype));
+  TYPE_READONLY (t) = TRUE;
+  return t;
+}
+
+/* BuildSetType creates a SET OF [lowval..highval].  */
+
+tree
+m2type_BuildSetType (location_t location, char *name, tree type, tree lowval,
+                     tree highval, int ispacked)
+{
+  tree range = build_range_type (m2tree_skip_type_decl (type),
+                                 m2expr_FoldAndStrip (lowval),
+                                 m2expr_FoldAndStrip (highval));
+
+  TYPE_PACKED (range) = ispacked;
+  m2assert_AssertLocation (location);
+  return m2type_BuildSetTypeFromSubrange (location, name, range,
+                                          m2expr_FoldAndStrip (lowval),
+                                          m2expr_FoldAndStrip (highval),
+					  ispacked);
+}
+
+/* push_constructor returns a new compound constructor frame.  */
+
+static struct struct_constructor *
+push_constructor (void)
+{
+  struct struct_constructor *p = ggc_alloc<struct_constructor> ();
+
+  p->level = top_constructor;
+  top_constructor = p;
+  return p;
+}
+
+/* pop_constructor throws away the top constructor frame on the
+   stack.  */
+
+static void
+pop_constructor (struct struct_constructor *p)
+{
+  ASSERT_CONDITION (p
+                    == top_constructor); /* p should be the top_constructor.  */
+  top_constructor = top_constructor->level;
+}
+
+/* BuildStartSetConstructor starts to create a set constant.
+   Remember that type is really a record type.  */
+
+void *
+m2type_BuildStartSetConstructor (tree type)
+{
+  struct struct_constructor *p = push_constructor ();
+
+  type = m2tree_skip_type_decl (type);
+  layout_type (type);
+  p->constructor_type = type;
+  p->constructor_fields = TYPE_FIELDS (type);
+  p->constructor_element_list = NULL_TREE;
+  vec_alloc (p->constructor_elements, 1);
+  return (void *)p;
+}
+
+/* BuildSetConstructorElement adds, value, to the
+   constructor_element_list.  */
+
+void
+m2type_BuildSetConstructorElement (void *p, tree value)
+{
+  struct struct_constructor *c = (struct struct_constructor *)p;
+
+  if (value == NULL_TREE)
+    {
+      internal_error ("set type cannot be initialized with a %qs",
+		      "NULL_TREE");
+      return;
+    }
+
+  if (c->constructor_fields == NULL)
+    {
+      internal_error ("set type does not take another integer value");
+      return;
+    }
+
+  c->constructor_element_list
+      = tree_cons (c->constructor_fields, value, c->constructor_element_list);
+  c->constructor_fields = TREE_CHAIN (c->constructor_fields);
+}
+
+/* BuildEndSetConstructor finishes building a set constant.  */
+
+tree
+m2type_BuildEndSetConstructor (void *p)
+{
+  tree constructor;
+  tree link;
+  struct struct_constructor *c = (struct struct_constructor *)p;
+
+  for (link = c->constructor_element_list; link; link = TREE_CHAIN (link))
+    {
+      tree field = TREE_PURPOSE (link);
+      DECL_SIZE (field) = bitsize_int (SET_WORD_SIZE);
+      DECL_BIT_FIELD (field) = 1;
+    }
+
+  constructor = build_constructor_from_list (
+      c->constructor_type, nreverse (c->constructor_element_list));
+  TREE_CONSTANT (constructor) = 1;
+  TREE_STATIC (constructor) = 1;
+
+  pop_constructor (c);
+
+  return constructor;
+}
+
+/* BuildStartRecordConstructor initializes a record compound
+   constructor frame.  */
+
+void *
+m2type_BuildStartRecordConstructor (tree type)
+{
+  struct struct_constructor *p = push_constructor ();
+
+  type = m2tree_skip_type_decl (type);
+  layout_type (type);
+  p->constructor_type = type;
+  p->constructor_fields = TYPE_FIELDS (type);
+  p->constructor_element_list = NULL_TREE;
+  vec_alloc (p->constructor_elements, 1);
+  return (void *)p;
+}
+
+/* BuildEndRecordConstructor returns a tree containing the record
+   compound literal.  */
+
+tree
+m2type_BuildEndRecordConstructor (void *p)
+{
+  struct struct_constructor *c = (struct struct_constructor *)p;
+  tree constructor = build_constructor_from_list (
+      c->constructor_type, nreverse (c->constructor_element_list));
+  TREE_CONSTANT (constructor) = 1;
+  TREE_STATIC (constructor) = 1;
+
+  pop_constructor (c);
+
+  return constructor;
+}
+
+/* BuildRecordConstructorElement adds, value, to the
+   constructor_element_list.  */
+
+void
+m2type_BuildRecordConstructorElement (void *p, tree value)
+{
+  m2type_BuildSetConstructorElement (p, value);
+}
+
+/* BuildStartArrayConstructor initializes an array compound
+   constructor frame.  */
+
+void *
+m2type_BuildStartArrayConstructor (tree type)
+{
+  struct struct_constructor *p = push_constructor ();
+
+  type = m2tree_skip_type_decl (type);
+  layout_type (type);
+  p->constructor_type = type;
+  p->constructor_fields = TREE_TYPE (type);
+  p->constructor_element_list = NULL_TREE;
+  vec_alloc (p->constructor_elements, 1);
+  return (void *)p;
+}
+
+/* BuildEndArrayConstructor returns a tree containing the array
+   compound literal.  */
+
+tree
+m2type_BuildEndArrayConstructor (void *p)
+{
+  struct struct_constructor *c = (struct struct_constructor *)p;
+  tree constructor;
+
+  constructor
+      = build_constructor (c->constructor_type, c->constructor_elements);
+  TREE_CONSTANT (constructor) = TRUE;
+  TREE_STATIC (constructor) = TRUE;
+
+  pop_constructor (c);
+
+  return constructor;
+}
+
+/* BuildArrayConstructorElement adds, value, to the
+   constructor_element_list.  */
+
+void
+m2type_BuildArrayConstructorElement (void *p, tree value, tree indice)
+{
+  struct struct_constructor *c = (struct struct_constructor *)p;
+  constructor_elt celt;
+
+  if (value == NULL_TREE)
+    {
+      internal_error ("array cannot be initialized with a %qs", "NULL_TREE");
+      return;
+    }
+
+  if (c->constructor_fields == NULL_TREE)
+    {
+      internal_error ("array type must be initialized");
+      return;
+    }
+
+  if (c->constructor_fields != TREE_TYPE (value))
+    {
+      internal_error (
+          "array element value must be the same type as its declaration");
+      return;
+    }
+
+  celt.index = indice;
+  celt.value = value;
+  vec_safe_push (c->constructor_elements, celt);
+}
+
+/* BuildArrayStringConstructor creates an array constructor for,
+   arrayType, consisting of the character elements defined by, str,
+   of, length, characters.  */
+
+tree
+m2type_BuildArrayStringConstructor (location_t location, tree arrayType,
+                                    tree str, tree length)
+{
+  tree n;
+  tree val;
+  int i = 0;
+  const char *p = TREE_STRING_POINTER (str);
+  tree type = m2tree_skip_type_decl (TREE_TYPE (arrayType));
+  struct struct_constructor *c
+      = (struct struct_constructor *)m2type_BuildStartArrayConstructor (
+          arrayType);
+  char nul[1];
+  int len = strlen (p);
+
+  nul[0] = (char)0;
+
+  m2assert_AssertLocation (location);
+  n = m2expr_GetIntegerZero (location);
+  while (m2expr_CompareTrees (n, length) < 0)
+    {
+      if (i < len)
+        val = m2convert_BuildConvert (
+            location, type, m2type_BuildCharConstant (location, &p[i]), FALSE);
+      else
+        val = m2type_BuildCharConstant (location, &nul[0]);
+      m2type_BuildArrayConstructorElement (c, val, n);
+      i += 1;
+      n = m2expr_BuildAdd (location, n, m2expr_GetIntegerOne (location),
+                           FALSE);
+    }
+  return m2type_BuildEndArrayConstructor (c);
+}
+
+/* BuildSubrangeType creates a subrange of, type, with, lowval,
+   highval.  */
+
+tree
+m2type_BuildSubrangeType (location_t location, char *name, tree type,
+                          tree lowval, tree highval)
+{
+  tree range_type;
+
+  m2assert_AssertLocation (location);
+  type = m2tree_skip_type_decl (type);
+
+  lowval = m2expr_FoldAndStrip (lowval);
+  highval = m2expr_FoldAndStrip (highval);
+
+  if (m2expr_TreeOverflow (lowval))
+    error ("low bound for the subrange has overflowed");
+  if (m2expr_TreeOverflow (highval))
+    error ("high bound for the subrange has overflowed");
+
+  /* First build a type with the base range.  */
+  range_type = build_range_type (type, TYPE_MIN_VALUE (type),
+				 TYPE_MAX_VALUE (type));
+
+  TYPE_UNSIGNED (range_type) = TYPE_UNSIGNED (type);
+#if 0
+  /* Then set the actual range.  */
+  SET_TYPE_RM_MIN_VALUE (range_type, lowval);
+  SET_TYPE_RM_MAX_VALUE (range_type, highval);
+#endif
+
+  if ((name != NULL) && (strcmp (name, "") != 0))
+    {
+      /* Declared as TYPE foo = [x..y];  */
+      range_type = m2type_DeclareKnownType (location, name, range_type);
+      layout_type (m2tree_skip_type_decl (range_type));
+    }
+
+  return range_type;
+}
+
+/* BuildCharConstantChar creates a character constant given a character, ch.  */
+
+tree
+m2type_BuildCharConstantChar (location_t location, char ch)
+{
+  tree id = build_int_cst (char_type_node, (int) ch);
+  id = m2convert_BuildConvert (location, m2type_GetM2CharType (), id, FALSE);
+  return m2block_RememberConstant (id);
+}
+
+/* BuildCharConstant creates a character constant given a, string.  */
+
+tree
+m2type_BuildCharConstant (location_t location, const char *string)
+{
+  return m2type_BuildCharConstantChar (location, string[0]);
+}
+
+/* RealToTree convert a real number into a Tree.  */
+
+tree
+m2type_RealToTree (char *name)
+{
+  return build_real (
+      m2type_GetLongRealType (),
+      REAL_VALUE_ATOF (name, TYPE_MODE (m2type_GetLongRealType ())));
+}
+
+/* gm2_start_struct start to create a struct.  */
+
+static tree
+gm2_start_struct (location_t location, enum tree_code code, char *name)
+{
+  tree s = make_node (code);
+  tree id;
+
+  m2assert_AssertLocation (location);
+  if ((name == NULL) || (strcmp (name, "") == 0))
+    id = NULL_TREE;
+  else
+    id = get_identifier (name);
+
+  TYPE_PACKED (s) = FALSE; /* This maybe set TRUE later if necessary.  */
+
+  m2block_pushDecl (build_decl (location, TYPE_DECL, id, s));
+  return s;
+}
+
+/* BuildStartRecord return a RECORD tree.  */
+
+tree
+m2type_BuildStartRecord (location_t location, char *name)
+{
+  m2assert_AssertLocation (location);
+  return gm2_start_struct (location, RECORD_TYPE, name);
+}
+
+/* BuildStartUnion return a union tree.  */
+
+tree
+m2type_BuildStartUnion (location_t location, char *name)
+{
+  m2assert_AssertLocation (location);
+  return gm2_start_struct (location, UNION_TYPE, name);
+}
+
+/* m2type_BuildStartVarient builds a varient record.  It creates a
+   record field which has a, name, and whose type is a union.  */
+
+tree
+m2type_BuildStartVarient (location_t location, char *name)
+{
+  tree varient = m2type_BuildStartUnion (location, name);
+  tree field = m2type_BuildStartFieldRecord (location, name, varient);
+  m2assert_AssertLocation (location);
+  return field;
+}
+
+/* m2type_BuildEndVarient finish the varientField by calling
+   decl_finish and also finish the type of varientField (which is a
+   union).  */
+
+tree
+m2type_BuildEndVarient (location_t location, tree varientField,
+                        tree varientList, int isPacked)
+{
+  tree varient = TREE_TYPE (varientField);
+  m2assert_AssertLocation (location);
+  varient = m2type_BuildEndRecord (location, varient, varientList, isPacked);
+  gm2_finish_decl (location, varientField);
+  return varientField;
+}
+
+/* m2type_BuildStartFieldVarient builds a field varient record.  It
+   creates a record field which has a, name, and whose type is a
+   record.  */
+
+tree
+m2type_BuildStartFieldVarient (location_t location, char *name)
+{
+  tree record = m2type_BuildStartRecord (location, name);
+  tree field = m2type_BuildStartFieldRecord (location, name, record);
+  m2assert_AssertLocation (location);
+  return field;
+}
+
+/* BuildEndRecord a heavily pruned finish_struct from c-decl.cc.  It
+   sets the context for each field to, t, propagates isPacked
+   throughout the fields in the structure.  */
+
+tree
+m2type_BuildEndRecord (location_t location, tree record, tree fieldlist,
+                       int isPacked)
+{
+  tree x, d;
+
+  m2assert_AssertLocation (location);
+
+  /* If this type was previously laid out as a forward reference, make
+     sure we lay it out again.  */
+
+  TYPE_SIZE (record) = 0;
+
+  /* Install struct as DECL_CONTEXT of each field decl.  Also process
+     specified field sizes, found in the DECL_INITIAL, storing 0 there
+     after the type has been changed to precision equal to its width,
+     rather than the precision of the specified standard type.  (Correct
+     layout requires the original type to have been preserved until now).  */
+
+  for (x = fieldlist; x; x = TREE_CHAIN (x))
+    {
+      DECL_CONTEXT (x) = record;
+
+      if (TYPE_PACKED (record) && TYPE_ALIGN (TREE_TYPE (x)) > BITS_PER_UNIT)
+        DECL_PACKED (x) = 1;
+
+      if (isPacked)
+        {
+          DECL_PACKED (x) = 1;
+          DECL_BIT_FIELD (x) = 1;
+        }
+    }
+
+  /* Now we have the nearly final fieldlist.  Record it, then lay out
+     the structure or union (including the fields).  */
+
+  TYPE_FIELDS (record) = fieldlist;
+  layout_type (record);
+
+  /* Now we have the truly final field list.  Store it in this type and
+     in the variants.  */
+
+  for (x = TYPE_MAIN_VARIANT (record); x; x = TYPE_NEXT_VARIANT (x))
+    {
+      TYPE_FIELDS (x) = TYPE_FIELDS (record);
+      TYPE_LANG_SPECIFIC (x) = TYPE_LANG_SPECIFIC (record);
+      SET_TYPE_ALIGN (x, TYPE_ALIGN (record));
+      TYPE_USER_ALIGN (x) = TYPE_USER_ALIGN (record);
+    }
+
+  d = build_decl (location, TYPE_DECL, NULL, record);
+  TYPE_STUB_DECL (record) = d;
+
+  /* Finish debugging output for this type.  This must be done after we have
+     called build_decl.  */
+  rest_of_type_compilation (record, m2block_toplevel ());
+
+  return record;
+}
+
+/* m2type_BuildEndFieldVarient finish the varientField by calling
+   decl_finish and also finish the type of varientField (which is a
+   record).  */
+
+tree
+m2type_BuildEndFieldVarient (location_t location, tree varientField,
+                             tree varientList, int isPacked)
+{
+  tree record = TREE_TYPE (varientField);
+
+  m2assert_AssertLocation (location);
+  record = m2type_BuildEndRecord (location, record, varientList, isPacked);
+  gm2_finish_decl (location, varientField);
+  return varientField;
+}
+
+/* m2type_BuildStartFieldRecord starts building a field record.  It
+   returns the field which must be completed by calling
+   gm2_finish_decl.  */
+
+tree
+m2type_BuildStartFieldRecord (location_t location, char *name, tree type)
+{
+  tree field, declarator;
+
+  m2assert_AssertLocation (location);
+  if ((name == NULL) || (strcmp (name, "") == 0))
+    declarator = NULL_TREE;
+  else
+    declarator = get_identifier (name);
+
+  field = build_decl (location, FIELD_DECL, declarator,
+                      m2tree_skip_type_decl (type));
+  return field;
+}
+
+/* Build a record field with name (name maybe NULL), returning the
+   new field declaration, FIELD_DECL.
+
+   This is done during the parsing of the struct declaration.  The
+   FIELD_DECL nodes are chained together and the lot of them are
+   ultimately passed to `build_struct' to make the RECORD_TYPE node.  */
+
+tree
+m2type_BuildFieldRecord (location_t location, char *name, tree type)
+{
+  tree field = m2type_BuildStartFieldRecord (location, name, type);
+
+  m2assert_AssertLocation (location);
+  gm2_finish_decl (location, field);
+  return field;
+}
+
+/* ChainOn interface so that Modula-2 can also create chains of
+   declarations.  */
+
+tree
+m2type_ChainOn (tree t1, tree t2)
+{
+  return chainon (t1, t2);
+}
+
+/* ChainOnParamValue adds a list node {{name, str}, value} into the
+   tree list.  */
+
+tree
+m2type_ChainOnParamValue (tree list, tree name, tree str, tree value)
+{
+  return chainon (list, build_tree_list (build_tree_list (name, str), value));
+}
+
+/* AddStringToTreeList adds, string, to list.  */
+
+tree
+m2type_AddStringToTreeList (tree list, tree string)
+{
+  return tree_cons (NULL_TREE, string, list);
+}
+
+/* SetAlignment sets the alignment of a, node, to, align.  It
+   duplicates the, node, and sets the alignment to prevent alignment
+   effecting behaviour elsewhere.  */
+
+tree
+m2type_SetAlignment (tree node, tree align)
+{
+  tree type = NULL_TREE;
+  tree decl = NULL_TREE;
+  int is_type = FALSE;
+  int i;
+
+  if (DECL_P (node))
+    {
+      decl = node;
+      is_type = (TREE_CODE (node) == TYPE_DECL);
+      type = TREE_TYPE (decl);
+    }
+  else if (TYPE_P (node))
+    {
+      is_type = 1;
+      type = node;
+    }
+
+  if (TREE_CODE (align) != INTEGER_CST)
+    error ("requested alignment is not a constant");
+  else if ((i = tree_log2 (align)) == -1)
+    error ("requested alignment is not a power of 2");
+  else if (i > HOST_BITS_PER_INT - 2)
+    error ("requested alignment is too large");
+  else if (is_type)
+    {
+
+      /* If we have a TYPE_DECL, then copy the type, so that we don't
+         accidentally modify a builtin type.  See pushdecl.  */
+      if (decl && TREE_TYPE (decl) != error_mark_node
+          && DECL_ORIGINAL_TYPE (decl) == NULL_TREE)
+        {
+          tree tt = TREE_TYPE (decl);
+          type = build_variant_type_copy (type);
+          DECL_ORIGINAL_TYPE (decl) = tt;
+          TYPE_NAME (type) = decl;
+          TREE_USED (type) = TREE_USED (decl);
+          TREE_TYPE (decl) = type;
+        }
+
+      SET_TYPE_ALIGN (type, (1 << i) * BITS_PER_UNIT);
+      TYPE_USER_ALIGN (type) = 1;
+
+      if (decl)
+        {
+          SET_DECL_ALIGN (decl, (1 << i) * BITS_PER_UNIT);
+          DECL_USER_ALIGN (decl) = 1;
+        }
+    }
+  else if (TREE_CODE (decl) != VAR_DECL && TREE_CODE (decl) != FIELD_DECL)
+    error ("alignment may not be specified for %qD", decl);
+  else
+    {
+      SET_DECL_ALIGN (decl, (1 << i) * BITS_PER_UNIT);
+      DECL_USER_ALIGN (decl) = 1;
+    }
+  return node;
+}
+
+/* SetDeclPacked sets the packed bit in decl TREE, node.  It
+   returns the node.  */
+
+tree
+m2type_SetDeclPacked (tree node)
+{
+  DECL_PACKED (node) = 1;
+  return node;
+}
+
+/* SetTypePacked sets the packed bit in type TREE, node.  It
+   returns the node.  */
+
+tree
+m2type_SetTypePacked (tree node)
+{
+  TYPE_PACKED (node) = 1;
+  return node;
+}
+
+/* SetRecordFieldOffset returns field after the byteOffset and
+   bitOffset has been applied to it.  */
+
+tree
+m2type_SetRecordFieldOffset (tree field, tree byteOffset, tree bitOffset,
+                             tree fieldtype, tree nbits)
+{
+  DECL_FIELD_OFFSET (field) = byteOffset;
+  DECL_FIELD_BIT_OFFSET (field) = bitOffset;
+  TREE_TYPE (field) = m2tree_skip_type_decl (fieldtype);
+  DECL_SIZE (field) = bitsize_int (TREE_INT_CST_LOW (nbits));
+  return field;
+}
+
+/* BuildPackedFieldRecord builds a packed field record of, name,
+   and, fieldtype.  */
+
+tree
+m2type_BuildPackedFieldRecord (location_t location, char *name, tree fieldtype)
+{
+  m2assert_AssertLocation (location);
+  return m2type_BuildFieldRecord (location, name, fieldtype);
+}
+
+/* BuildNumberOfArrayElements returns the number of elements in an
+   arrayType.  */
+
+tree
+m2type_BuildNumberOfArrayElements (location_t location, tree arrayType)
+{
+  tree index = TYPE_DOMAIN (arrayType);
+  tree high = TYPE_MAX_VALUE (index);
+  tree low = TYPE_MIN_VALUE (index);
+  tree elements = m2expr_BuildAdd (
+      location, m2expr_BuildSub (location, high, low, FALSE),
+      m2expr_GetIntegerOne (location), FALSE);
+  m2assert_AssertLocation (location);
+  return elements;
+}
+
+/* AddStatement maps onto add_stmt.  */
+
+void
+m2type_AddStatement (location_t location, tree t)
+{
+  if (t != NULL_TREE)
+    add_stmt (location, t);
+}
+
+/* MarkFunctionReferenced marks a function as referenced.  */
+
+void
+m2type_MarkFunctionReferenced (tree f)
+{
+  if (f != NULL_TREE)
+    if (TREE_CODE (f) == FUNCTION_DECL)
+      mark_decl_referenced (f);
+}
+
+/* GarbageCollect force gcc to garbage collect.  */
+
+void
+m2type_GarbageCollect (void)
+{
+  ggc_collect ();
+}
+
+/* gm2_type_for_size return an integer type with BITS bits of
+   precision, that is unsigned if UNSIGNEDP is nonzero, otherwise
+   signed.  */
+
+tree
+m2type_gm2_type_for_size (unsigned int bits, int unsignedp)
+{
+  if (bits == TYPE_PRECISION (integer_type_node))
+    return unsignedp ? unsigned_type_node : integer_type_node;
+
+  if (bits == TYPE_PRECISION (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+  if (bits == TYPE_PRECISION (short_integer_type_node))
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+  if (bits == TYPE_PRECISION (long_integer_type_node))
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+  if (bits == TYPE_PRECISION (long_long_integer_type_node))
+    return (unsignedp ? long_long_unsigned_type_node
+                      : long_long_integer_type_node);
+
+  if (bits <= TYPE_PRECISION (intQI_type_node))
+    return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
+
+  if (bits <= TYPE_PRECISION (intHI_type_node))
+    return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
+
+  if (bits <= TYPE_PRECISION (intSI_type_node))
+    return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
+
+  if (bits <= TYPE_PRECISION (intDI_type_node))
+    return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
+
+  return 0;
+}
+
+/* gm2_unsigned_type return an unsigned type the same as TYPE in
+   other respects.  */
+
+tree
+m2type_gm2_unsigned_type (tree type)
+{
+  tree type1 = TYPE_MAIN_VARIANT (type);
+  if (type1 == signed_char_type_node || type1 == char_type_node)
+    return unsigned_char_type_node;
+  if (type1 == integer_type_node)
+    return unsigned_type_node;
+  if (type1 == short_integer_type_node)
+    return short_unsigned_type_node;
+  if (type1 == long_integer_type_node)
+    return long_unsigned_type_node;
+  if (type1 == long_long_integer_type_node)
+    return long_long_unsigned_type_node;
+
+#if HOST_BITS_PER_WIDE_INT >= 64
+  if (type1 == intTI_type_node)
+    return unsigned_intTI_type_node;
+#endif
+  if (type1 == intDI_type_node)
+    return unsigned_intDI_type_node;
+  if (type1 == intSI_type_node)
+    return unsigned_intSI_type_node;
+  if (type1 == intHI_type_node)
+    return unsigned_intHI_type_node;
+  if (type1 == intQI_type_node)
+    return unsigned_intQI_type_node;
+
+  return m2type_gm2_signed_or_unsigned_type (TRUE, type);
+}
+
+/* gm2_signed_type return a signed type the same as TYPE in other
+   respects.  */
+
+tree
+m2type_gm2_signed_type (tree type)
+{
+  tree type1 = TYPE_MAIN_VARIANT (type);
+  if (type1 == unsigned_char_type_node || type1 == char_type_node)
+    return signed_char_type_node;
+  if (type1 == unsigned_type_node)
+    return integer_type_node;
+  if (type1 == short_unsigned_type_node)
+    return short_integer_type_node;
+  if (type1 == long_unsigned_type_node)
+    return long_integer_type_node;
+  if (type1 == long_long_unsigned_type_node)
+    return long_long_integer_type_node;
+
+#if HOST_BITS_PER_WIDE_INT >= 64
+  if (type1 == unsigned_intTI_type_node)
+    return intTI_type_node;
+#endif
+  if (type1 == unsigned_intDI_type_node)
+    return intDI_type_node;
+  if (type1 == unsigned_intSI_type_node)
+    return intSI_type_node;
+  if (type1 == unsigned_intHI_type_node)
+    return intHI_type_node;
+  if (type1 == unsigned_intQI_type_node)
+    return intQI_type_node;
+
+  return m2type_gm2_signed_or_unsigned_type (FALSE, type);
+}
+
+/* check_type if the precision of baseType and type are the same
+   then return true and set the signed or unsigned type in result
+   else return false.  */
+
+static int
+check_type (tree baseType, tree type, int unsignedp, tree baseu, tree bases,
+            tree *result)
+{
+  if (TYPE_PRECISION (baseType) == TYPE_PRECISION (type))
+    {
+      if (unsignedp)
+        *result = baseu;
+      else
+        *result = bases;
+      return TRUE;
+    }
+  return FALSE;
+}
+
+/* gm2_signed_or_unsigned_type return a type the same as TYPE
+   except unsigned or signed according to UNSIGNEDP.  */
+
+tree
+m2type_gm2_signed_or_unsigned_type (int unsignedp, tree type)
+{
+  tree result;
+
+  if (!INTEGRAL_TYPE_P (type) || TYPE_UNSIGNED (type) == unsignedp)
+    return type;
+
+  /* For INTEGER_TYPEs we must check the precision as well, so as to
+     yield correct results for bit-field types.  */
+
+  if (check_type (signed_char_type_node, type, unsignedp,
+                  unsigned_char_type_node, signed_char_type_node, &result))
+    return result;
+  if (check_type (integer_type_node, type, unsignedp, unsigned_type_node,
+                  integer_type_node, &result))
+    return result;
+  if (check_type (short_integer_type_node, type, unsignedp,
+                  short_unsigned_type_node, short_integer_type_node, &result))
+    return result;
+  if (check_type (long_integer_type_node, type, unsignedp,
+                  long_unsigned_type_node, long_integer_type_node, &result))
+    return result;
+  if (check_type (long_long_integer_type_node, type, unsignedp,
+                  long_long_unsigned_type_node, long_long_integer_type_node,
+                  &result))
+    return result;
+
+#if HOST_BITS_PER_WIDE_INT >= 64
+  if (check_type (intTI_type_node, type, unsignedp, unsigned_intTI_type_node,
+                  intTI_type_node, &result))
+    return result;
+#endif
+  if (check_type (intDI_type_node, type, unsignedp, unsigned_intDI_type_node,
+                  intDI_type_node, &result))
+    return result;
+  if (check_type (intSI_type_node, type, unsignedp, unsigned_intSI_type_node,
+                  intSI_type_node, &result))
+    return result;
+  if (check_type (intHI_type_node, type, unsignedp, unsigned_intHI_type_node,
+                  intHI_type_node, &result))
+    return result;
+  if (check_type (intQI_type_node, type, unsignedp, unsigned_intQI_type_node,
+                  intQI_type_node, &result))
+    return result;
+#undef TYPE_OK
+
+  return type;
+}
+
+/* IsAddress returns TRUE if the type is an ADDRESS.  */
+
+int
+m2type_IsAddress (tree type)
+{
+  return type == ptr_type_node;
+}
+
+#include "gt-m2-m2type.h"
diff --git a/gcc/m2/gm2-gcc/m2type.def b/gcc/m2/gm2-gcc/m2type.def
new file mode 100644
index 00000000000..dc617ecd46c
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2type.def
@@ -0,0 +1,986 @@
+(* m2type.def definition module for m2type.cc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" m2type ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM m2tree IMPORT Tree ;
+FROM m2linemap IMPORT location_t ;
+
+
+TYPE
+   Constructor = ADDRESS ;
+
+
+(*
+   ValueInTypeRange - returns TRUE if the constant, value, lies in the range
+                      of, type.
+*)
+
+PROCEDURE ValueInTypeRange (type: Tree; value: Tree) : BOOLEAN ;
+
+
+(*
+   ValueOutOfTypeRange - returns TRUE if the constant, value, exceed the range
+                         of, type.
+*)
+
+PROCEDURE ValueOutOfTypeRange (type: Tree; value: Tree) : BOOLEAN ;
+
+
+(*
+   ExceedsTypeRange - return TRUE if low or high exceed the range of, type.
+*)
+
+PROCEDURE ExceedsTypeRange (type: Tree; low, high: Tree) : BOOLEAN ;
+
+
+(*
+   WithinTypeRange - return TRUE if low and high are within the range of, type.
+*)
+
+PROCEDURE WithinTypeRange (type: Tree; low, high: Tree) : BOOLEAN ;
+
+
+(*
+    BuildSubrangeType - creates a subrange of, type, with, lowval, highval.
+*)
+
+PROCEDURE BuildSubrangeType (location: location_t; name: ADDRESS; type: Tree; lowval: Tree; highval: Tree) : Tree ;
+
+
+(*
+    BuildCharConstant - creates a character constant given a, string.
+*)
+
+PROCEDURE BuildCharConstant (location: location_t; string: ADDRESS) : Tree ;
+
+
+(*
+   BuildCharConstantChar - creates a character constant given a character, ch.
+*)
+
+PROCEDURE BuildCharConstantChar (location: location_t; ch: CHAR) : Tree ;
+
+
+(*
+    BuildArrayConstructorElement - adds, value, to the constructor_element_list.
+*)
+
+PROCEDURE BuildArrayConstructorElement (p: ADDRESS; value: Tree; indice: Tree) ;
+
+
+(*
+    BuildEndArrayConstructor - returns a tree containing the array
+                               compound literal.
+*)
+
+PROCEDURE BuildEndArrayConstructor (p: Constructor) : Tree ;
+
+
+(*
+   BuildEndArrayConstructor - returns a tree containing the array
+                              compound literal.
+*)
+
+PROCEDURE BuildStartArrayConstructor (type: Tree) : Constructor ;
+
+
+(*
+    BuildRecordConstructorElement - adds, value, to the constructor_element_list.
+*)
+
+PROCEDURE BuildRecordConstructorElement (p: Constructor; value: Tree) ;
+
+
+(*
+    BuildEndRecordConstructor - returns a tree containing the record compound literal.
+*)
+
+PROCEDURE BuildEndRecordConstructor (p: Constructor) : Tree ;
+
+
+(*
+   BuildStartRecordConstructor - initializes a record compound
+                                 constructor frame.
+*)
+
+PROCEDURE BuildStartRecordConstructor (type: Tree) : Constructor ;
+
+
+(*
+    BuildEndSetConstructor - finishes building a set constant.
+*)
+
+PROCEDURE BuildEndSetConstructor (p: Constructor) : Tree ;
+
+
+(*
+    BuildSetConstructorElement - adds, value, to the constructor_element_list.
+*)
+
+PROCEDURE BuildSetConstructorElement (p: Constructor; value: Tree) ;
+
+
+(*
+   BuildStartSetConstructor - starts to create a set constant.
+                              Remember that type is really a record type.
+*)
+
+PROCEDURE BuildStartSetConstructor (type: Tree) : Constructor ;
+
+
+(*
+    BuildSetType - creates a SET OF [lowval..highval]
+*)
+
+PROCEDURE BuildSetType (location: location_t; name: ADDRESS; type: Tree; lowval: Tree; highval: Tree; ispacked: BOOLEAN) : Tree ;
+
+
+(*
+    BuildConstPointerType - returns a type which is a const pointer to, totype.
+*)
+
+PROCEDURE BuildConstPointerType (totype: Tree) : Tree ;
+
+
+(*
+    BuildPointerType - returns a type which is a pointer to, totype.
+*)
+
+PROCEDURE BuildPointerType (totype: Tree) : Tree ;
+
+
+(*
+    BuildEnumerator - build an enumerator and add it to the, enumvalues, list.
+                      It returns a copy of the value.  --fixme-- why do this?
+*)
+
+PROCEDURE BuildEnumerator (location: location_t; name: ADDRESS; value: Tree;
+                           VAR enumvalues: Tree) : Tree ;
+
+
+(*
+    BuildEndEnumeration - finish building the enumeration, it uses the enum
+                          list, enumvalues, and returns a enumeration type tree.
+*)
+
+PROCEDURE BuildEndEnumeration (location: location_t; type: Tree; enumvalues: Tree) : Tree ;
+
+
+(*
+    BuildStartEnumeration - create an enumerated type in gcc.
+*)
+
+PROCEDURE BuildStartEnumeration (location: location_t; name: ADDRESS; ispacked: BOOLEAN) : Tree ;
+
+
+(*
+    BuildTypeDeclaration - adds the, type, to the current statement list.
+*)
+
+PROCEDURE BuildTypeDeclaration (location: location_t; type: Tree) ;
+
+
+(*
+    GetMaxFrom - given a, type, return a constant representing the maximum
+                 legal value.
+*)
+
+PROCEDURE GetMaxFrom (location: location_t; type: Tree) : Tree ;
+
+
+(*
+    GetMinFrom - given a, type, return a constant representing the minimum
+                 legal value.
+*)
+
+PROCEDURE GetMinFrom (location: location_t; type: Tree) : Tree ;
+
+
+(*
+    GetDefaultType - given a, type, with a, name, return a GCC declaration of this type.
+                     Checks to see whether the type name has already been declared as a
+                     default type and if so it returns this declaration. Otherwise it
+                     declares the type. In Modula-2 this is equivalent to:
+
+                     TYPE
+                        name = type ;
+
+                     We need this function as the initialization to gccgm2.c will
+                     declare C default types and _some_ M2 default types.
+*)
+
+PROCEDURE GetDefaultType (location: location_t; name: ADDRESS; type: Tree) : Tree ;
+
+
+(*
+    BuildEndType - finish declaring, type, and return, type.
+*)
+
+PROCEDURE BuildEndType (location: location_t; type: Tree) : Tree ;
+
+
+(*
+    BuildStartType - given a, type, with a, name, return a GCC declaration of this type.
+                     TYPE
+                        name = foo ;
+
+                     the type, foo, maybe a partially created type (which has
+                     yet to be 'gm2_finish_decl'ed.
+*)
+
+PROCEDURE BuildStartType (location: location_t; name: ADDRESS; type: Tree) : Tree ;
+
+
+(*
+   InitSystemTypes -
+*)
+
+PROCEDURE InitSystemTypes (location: location_t; loc: INTEGER) ;
+
+
+(*
+   InitBaseTypes -
+*)
+
+PROCEDURE InitBaseTypes (location: location_t) ;
+
+
+(*
+    BuildVariableArrayAndDeclare - creates a variable length array.
+                                   high is the maximum legal elements (which is a runtime variable).
+                                   This creates and array index, array type and local variable.
+*)
+
+PROCEDURE BuildVariableArrayAndDeclare (location: location_t; elementtype: Tree; high: Tree; name: ADDRESS; scope: Tree) : Tree ;
+
+
+(*
+    InitFunctionTypeParameters - resets the current function type parameter list.
+*)
+
+PROCEDURE InitFunctionTypeParameters ;
+
+
+(*
+   BuildProcTypeParameterDeclaration - creates and returns one parameter from, name, and, type.
+                                       It appends this parameter to the internal param_type_list.
+*)
+
+PROCEDURE BuildProcTypeParameterDeclaration (location: location_t; type: Tree; isreference: BOOLEAN) : Tree ;
+
+
+(*
+    BuildStartFunctionType - creates a pointer type, necessary to
+                             create a function type.
+*)
+
+PROCEDURE BuildStartFunctionType (location: location_t; name: ADDRESS) : Tree ;
+
+
+(*
+    BuildEndFunctionType - build a function type which would return a, value.
+                           The arguments have been created by BuildParameterDeclaration.
+*)
+
+PROCEDURE BuildEndFunctionType (func: Tree; type: Tree; usesvarags: BOOLEAN) : Tree ;
+
+
+(*
+    GetTreeType - returns TREE_TYPE (t).
+*)
+
+PROCEDURE GetTreeType (type: Tree) : Tree ;
+
+
+(*
+    DeclareKnownType - given a, type, with a, name, return a GCC declaration of this type.
+                       TYPE
+                          name = foo ;
+*)
+
+PROCEDURE DeclareKnownType (location: location_t; name: ADDRESS; type: Tree) : Tree ;
+
+
+(*
+    GetM2ZType - return the ISO Z data type, the longest int datatype.
+*)
+
+PROCEDURE GetM2ZType () : Tree ;
+
+
+(*
+    GetM2RType - return the ISO R data type, the longest real datatype.
+*)
+
+PROCEDURE GetM2RType () : Tree ;
+
+
+(*
+    BuildSetTypeFromSubrange - constructs a set type from a subrangeType.
+*)
+
+PROCEDURE BuildSetTypeFromSubrange (location: location_t; name: ADDRESS;
+                                    subrangeType: Tree;
+                                    lowval: Tree; highval: Tree;
+                                    ispacked: BOOLEAN) : Tree ;
+
+
+(*
+    BuildSmallestTypeRange - returns the smallest INTEGER_TYPE which is
+                             sufficient to contain values: low..high.
+*)
+
+PROCEDURE BuildSmallestTypeRange (location: location_t; low: Tree; high: Tree) : Tree ;
+
+
+(*
+    GetBooleanType -
+*)
+
+PROCEDURE GetBooleanType () : Tree ;
+
+
+(*
+    GetBooleanFalse -
+*)
+
+PROCEDURE GetBooleanFalse () : Tree ;
+
+
+(*
+    GetBooleanTrue -
+*)
+
+PROCEDURE GetBooleanTrue () : Tree ;
+
+
+(*
+    GetPackedBooleanType - return the packed boolean data type node.
+*)
+
+PROCEDURE GetPackedBooleanType () : Tree ;
+
+
+(*
+    GetCharType - return the char type node.
+*)
+
+PROCEDURE GetCharType () : Tree ;
+
+
+(*
+    GetByteType - return the byte type node.
+*)
+
+PROCEDURE GetByteType () : Tree ;
+
+
+(*
+    GetVoidType - return the C void type.
+*)
+
+PROCEDURE GetVoidType () : Tree ;
+
+
+(*
+    GetBitnumType - return the ISO bitnum type.
+*)
+
+PROCEDURE GetBitnumType () : Tree ;
+
+
+(*
+    GetRealType -
+*)
+
+PROCEDURE GetRealType () : Tree ;
+
+
+(*
+    GetLongRealType - return the C long double data type.
+*)
+
+PROCEDURE GetLongRealType () : Tree ;
+
+
+(*
+    GetShortRealType - return the C float data type.
+*)
+
+PROCEDURE GetShortRealType () : Tree ;
+
+
+(*
+    GetLongIntType - return the C long int data type.
+*)
+
+PROCEDURE GetLongIntType () : Tree ;
+
+
+(*
+    GetPointerType - return the GCC ptr type node.  Equivalent to (void * ).
+*)
+
+PROCEDURE GetPointerType () : Tree ;
+
+
+(*
+    GetCardinalType - return the cardinal type.
+*)
+
+PROCEDURE GetCardinalType () : Tree ;
+
+
+(*
+    GetIntegerType - return the integer type node.
+*)
+
+PROCEDURE GetIntegerType () : Tree ;
+
+
+(*
+    GetWordType - return the C unsigned data type.
+*)
+
+PROCEDURE GetWordType () : Tree ;
+
+
+(*
+    GetM2CardinalType - return the m2 cardinal data type.
+*)
+
+PROCEDURE GetM2CardinalType () : Tree ;
+
+
+(*
+    GetBitsetType - return the bitset type.
+*)
+
+PROCEDURE GetBitsetType () : Tree ;
+
+
+(*
+    GetM2CType - a test function.
+*)
+
+PROCEDURE GetM2CType () : Tree ;
+
+
+(*
+    GetProcType - return the m2 proc data type.
+*)
+
+PROCEDURE GetProcType () : Tree ;
+
+
+(*
+    GetM2ComplexType - return the complex type.
+*)
+
+PROCEDURE GetM2ComplexType () : Tree ;
+
+
+(*
+    GetM2LongComplexType - return the long complex type.
+*)
+
+PROCEDURE GetM2LongComplexType () : Tree ;
+
+
+(*
+    GetM2ShortComplexType - return the short complex type.
+*)
+
+PROCEDURE GetM2ShortComplexType () : Tree ;
+
+
+(*
+    GetM2Complex128Type - return the fixed size complex type.
+*)
+
+PROCEDURE GetM2Complex128 () : Tree ;
+
+
+(*
+    GetM2Complex96 - return the fixed size complex type.
+*)
+
+PROCEDURE GetM2Complex96 () : Tree ;
+
+
+(*
+    GetM2Complex64 - return the fixed size complex type.
+*)
+
+PROCEDURE GetM2Complex64 () : Tree ;
+
+
+(*
+    GetM2Complex32 - return the fixed size complex type.
+*)
+
+PROCEDURE GetM2Complex32 () : Tree ;
+
+
+(*
+    GetM2Real128 - return the real 128 bit type.
+*)
+
+PROCEDURE GetM2Real128 () : Tree ;
+
+
+(*
+    GetM2Real96 - return the real 96 bit type.
+*)
+
+PROCEDURE GetM2Real96 () : Tree ;
+
+
+(*
+    GetM2Real64 - return the real 64 bit type.
+*)
+
+PROCEDURE GetM2Real64 () : Tree ;
+
+
+(*
+    GetM2Real32 - return the real 32 bit type.
+*)
+
+PROCEDURE GetM2Real32 () : Tree ;
+
+
+(*
+    GetM2Bitset32 - return the bitset 32 bit type.
+*)
+
+PROCEDURE GetM2Bitset32 () : Tree ;
+
+
+(*
+    GetM2Bitset16 - return the bitset 16 bit type.
+*)
+
+PROCEDURE GetM2Bitset16 () : Tree ;
+
+
+(*
+    GetM2Bitset8 - return the bitset 8 bit type.
+*)
+
+PROCEDURE GetM2Bitset8 () : Tree ;
+
+
+(*
+    GetM2Word64 - return the word 64 bit type.
+*)
+
+PROCEDURE GetM2Word64 () : Tree ;
+
+
+(*
+    GetM2Word32 - return the word 32 bit type.
+*)
+
+PROCEDURE GetM2Word32 () : Tree ;
+
+
+(*
+    GetM2Word16 - return the word 16 bit type.
+*)
+
+PROCEDURE GetM2Word16 () : Tree ;
+
+
+(*
+    GetM2Cardinal64 - return the cardinal 64 bit type.
+*)
+
+PROCEDURE GetM2Cardinal64 () : Tree ;
+
+
+(*
+    GetM2Cardinal32 - return the cardinal 32 bit type.
+*)
+
+PROCEDURE GetM2Cardinal32 () : Tree ;
+
+
+(*
+    GetM2Cardinal16 - return the cardinal 16 bit type.
+*)
+
+PROCEDURE GetM2Cardinal16 () : Tree ;
+
+
+(*
+    GetM2Cardinal8 - return the cardinal 8 bit type.
+*)
+
+PROCEDURE GetM2Cardinal8 () : Tree ;
+
+
+(*
+    GetM2Integer64 - return the integer 64 bit type.
+*)
+
+PROCEDURE GetM2Integer64 () : Tree ;
+
+
+(*
+    GetM2Integer32 - return the integer 32 bit type.
+*)
+
+PROCEDURE GetM2Integer32 () : Tree ;
+
+
+(*
+    GetM2Integer16 - return the integer 16 bit type.
+*)
+
+PROCEDURE GetM2Integer16 () : Tree ;
+
+
+(*
+    GetM2Integer8 - return the integer 8 bit type.
+*)
+
+PROCEDURE GetM2Integer8 () : Tree ;
+
+
+(*
+    GetISOLocType - return the m2 loc word data type.
+*)
+
+PROCEDURE GetISOLocType () : Tree ;
+
+
+(*
+    GetISOByteType - return the m2 iso byte data type.
+*)
+
+PROCEDURE GetISOByteType () : Tree ;
+
+
+(*
+    GetISOWordType - return the m2 iso word data type.
+*)
+
+PROCEDURE GetISOWordType () : Tree ;
+
+
+(*
+    GetShortCardType - return the C short unsigned data type.
+*)
+
+PROCEDURE GetShortCardType () : Tree ;
+
+
+(*
+    GetM2ShortCardType - return the m2 short cardinal data type.
+*)
+
+PROCEDURE GetM2ShortCardType () : Tree ;
+
+
+(*
+    GetShortIntType - return the C short int data type.
+*)
+
+PROCEDURE GetShortIntType () : Tree ;
+
+
+(*
+    GetM2ShortIntType - return the m2 short integer data type.
+*)
+
+PROCEDURE GetM2ShortIntType () : Tree ;
+
+
+(*
+    GetM2LongCardType - return the m2 long cardinal data type.
+*)
+
+PROCEDURE GetM2LongCardType () : Tree ;
+
+
+(*
+    GetM2LongIntType - return the m2 long integer data type.
+*)
+
+PROCEDURE GetM2LongIntType () : Tree ;
+
+
+(*
+    GetM2LongRealType - return the m2 long real data type.
+*)
+
+PROCEDURE GetM2LongRealType () : Tree ;
+
+
+(*
+    GetM2RealType - return the m2 real data type.
+*)
+
+PROCEDURE GetM2RealType () : Tree ;
+
+
+(*
+    GetM2ShortRealType - return the m2 short real data type.
+*)
+
+PROCEDURE GetM2ShortRealType () : Tree ;
+
+
+(*
+    GetM2IntegerType - return the m2 integer data type.
+*)
+
+PROCEDURE GetM2IntegerType () : Tree ;
+
+
+(*
+    GetM2CharType - return the m2 char data type.
+*)
+
+PROCEDURE GetM2CharType () : Tree ;
+
+
+(*
+   GetCSizeTType - return a type representing, size_t on this system.
+*)
+
+PROCEDURE GetCSizeTType () : Tree ;
+
+
+(*
+   GetCSSizeTType - return a type representing, ssize_t on this system.
+*)
+
+PROCEDURE GetCSSizeTType () : Tree ;
+
+
+(*
+    BuildArrayStringConstructor - creates an array constructor for, arrayType,
+                                  consisting of the character elements
+                                  defined by, str, of, length, characters.
+*)
+
+PROCEDURE BuildArrayStringConstructor (location: location_t; arrayType: Tree; str: Tree; length: Tree) : Tree ;
+
+
+(*
+    RealToTree - convert a real number into a Tree.
+*)
+
+PROCEDURE RealToTree (name: ADDRESS) : Tree ;
+
+
+(*
+    BuildStartRecord - return a RECORD tree.
+*)
+
+PROCEDURE BuildStartRecord (location: location_t; name: ADDRESS) : Tree ;
+
+
+(*
+    BuildStartUnion - return a union tree.
+*)
+
+PROCEDURE BuildStartUnion (location: location_t; name: ADDRESS) : Tree ;
+
+
+
+PROCEDURE BuildStartVarient (location: location_t; name: ADDRESS) : Tree ;
+
+
+
+PROCEDURE BuildEndVarient (location: location_t; varientField: Tree; varientList: Tree; isPacked: BOOLEAN) : Tree ;
+
+
+
+PROCEDURE BuildStartFieldVarient (location: location_t; name: ADDRESS) : Tree ;
+
+
+
+PROCEDURE BuildEndFieldVarient (location: location_t; varientField: Tree; varientList: Tree; isPacked: BOOLEAN) : Tree ;
+
+
+
+PROCEDURE BuildStartFieldRecord (location: location_t; name: ADDRESS; type: Tree) : Tree ;
+
+
+
+PROCEDURE BuildFieldRecord (location: location_t; name: ADDRESS; type: Tree) : Tree ;
+
+
+(*
+    ChainOn - interface so that Modula-2 can also create chains of
+              declarations.
+*)
+
+PROCEDURE ChainOn (t1: Tree; t2: Tree) : Tree ;
+
+
+(*
+    ChainOnParamValue - adds a list node {{name, str}, value} into the tree list.
+*)
+
+PROCEDURE ChainOnParamValue (list: Tree; name: Tree; str: Tree; value: Tree) : Tree ;
+
+
+(*
+   AddStringToTreeList - adds, string, to list.
+*)
+
+PROCEDURE AddStringToTreeList (list: Tree; string: Tree) : Tree ;
+
+
+(*
+    BuildEndRecord - a heavily pruned finish_struct from c-decl.c.
+                     It sets the context for each field to, t,
+                     propagates isPacked throughout the fields in
+                     the structure.
+*)
+
+PROCEDURE BuildEndRecord (location: location_t; record: Tree; fieldlist: Tree; isPacked: BOOLEAN) : Tree ;
+
+
+(*
+    SetAlignment - sets the alignment of a, node, to, align.
+                   It duplicates the, node, and sets the alignment
+                   to prevent alignment effecting behaviour elsewhere.
+*)
+
+PROCEDURE SetAlignment (node: Tree; align: Tree) : Tree ;
+
+
+(*
+    SetDeclPacked - sets the packed bit in decl TREE, node.
+                    It returns the node.
+*)
+
+PROCEDURE SetDeclPacked (node: Tree) : Tree ;
+
+
+(*
+    SetTypePacked - sets the packed bit in type TREE, node.
+                    It returns the node.
+*)
+
+PROCEDURE SetTypePacked (node: Tree) : Tree ;
+
+
+(*
+    SetRecordFieldOffset - returns field after the byteOffset and bitOffset
+                           has been applied to it.
+*)
+
+PROCEDURE SetRecordFieldOffset (field: Tree; byteOffset: Tree; bitOffset: Tree; fieldtype: Tree; nbits: Tree) : Tree ;
+
+
+(*
+    BuildPackedFieldRecord - builds a packed field record of,
+                             name, and, fieldtype.
+*)
+
+PROCEDURE BuildPackedFieldRecord (location: location_t; name: ADDRESS; fieldtype: Tree) : Tree ;
+
+
+(*
+    BuildNumberOfArrayElements - returns the number of elements in an
+                                 arrayType.
+*)
+
+PROCEDURE BuildNumberOfArrayElements (location: location_t; arrayType: Tree) : Tree ;
+
+
+(*
+    AddStatement - maps onto add_stmt.
+*)
+
+PROCEDURE AddStatement (location: location_t; t: Tree) ;
+
+
+(*
+    MarkFunctionReferenced - marks a function as referenced.
+*)
+
+PROCEDURE MarkFunctionReferenced (f: Tree) ;
+
+
+(*
+    GarbageCollect - force gcc to garbage collect.
+*)
+
+PROCEDURE GarbageCollect ;
+
+
+(*
+   BuildArrayIndexType - creates an integer index which accesses an array.
+                         low and high are the min, max elements of the array.
+*)
+
+PROCEDURE BuildArrayIndexType (low: Tree; high: Tree) : Tree ;
+
+
+(*
+   GetArrayNoOfElements - returns the number of elements in, arraytype.
+*)
+
+PROCEDURE GetArrayNoOfElements (location: location_t; arraytype: Tree) : Tree ;
+
+
+(*
+   BuildEndArrayType - returns a type which is an array indexed by IndexType
+                       and which has ElementType elements.
+*)
+
+PROCEDURE BuildEndArrayType (arraytype: Tree; elementtype: Tree; indextype: Tree; type: INTEGER) : Tree ;
+
+
+(*
+    PutArrayType -
+*)
+
+PROCEDURE PutArrayType (array: Tree; type: Tree) ;
+
+
+(*
+    BuildStartArrayType - creates an array with an indextype and elttype.  The front end
+                          symbol, type, is also passed to allow the gccgm2 to return the
+                          canonical edition of the array type even if the GCC elttype is
+                          NULL_TREE.
+*)
+
+PROCEDURE BuildStartArrayType (index_type: Tree; elt_type: Tree; type: INTEGER) : Tree ;
+
+
+(*
+   IsAddress - return TRUE if the type is an ADDRESS.
+*)
+
+PROCEDURE IsAddress (type: Tree) : BOOLEAN ;
+
+
+END m2type.
diff --git a/gcc/m2/gm2-gcc/m2type.h b/gcc/m2/gm2-gcc/m2type.h
new file mode 100644
index 00000000000..35f96972803
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2type.h
@@ -0,0 +1,222 @@
+/* m2type.h header file for m2type.cc.
+
+Copyright (C) 2012-2022 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(m2type_h)
+#define m2type_h
+#if defined(m2type_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN
+#endif /* !__GNUG__.  */
+#else /* !m2type_c.  */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__.  */
+#define EXTERN extern
+#endif /* !__GNUG__.  */
+#endif /* !m2type_c.  */
+
+typedef void *m2type_Constructor;
+
+EXTERN int m2type_ValueInTypeRange (tree type, tree value);
+EXTERN int m2type_ExceedsTypeRange (tree type, tree low, tree high);
+EXTERN int m2type_ValueOutOfTypeRange (tree type, tree value);
+EXTERN int m2type_WithinTypeRange (tree type, tree low, tree high);
+EXTERN tree m2type_BuildStartArrayType (tree index_type, tree elt_type,
+                                        int type);
+EXTERN void m2type_PutArrayType (tree array, tree type);
+EXTERN tree m2type_BuildEndArrayType (tree arraytype, tree elementtype,
+                                      tree indextype, int type);
+EXTERN tree m2type_GetArrayNoOfElements (location_t location, tree arraytype);
+EXTERN tree m2type_BuildArrayIndexType (tree low, tree high);
+EXTERN void m2type_GarbageCollect (void);
+EXTERN void m2type_MarkFunctionReferenced (tree f);
+EXTERN void m2type_AddStatement (location_t location, tree t);
+EXTERN tree m2type_BuildNumberOfArrayElements (location_t location,
+                                               tree arrayType);
+EXTERN tree m2type_BuildPackedFieldRecord (location_t location, char *name,
+                                           tree fieldtype);
+EXTERN tree m2type_SetRecordFieldOffset (tree field, tree byteOffset,
+                                         tree bitOffset, tree fieldtype,
+                                         tree nbits);
+EXTERN tree m2type_SetTypePacked (tree node);
+EXTERN tree m2type_SetDeclPacked (tree node);
+EXTERN tree m2type_SetAlignment (tree node, tree align);
+EXTERN tree m2type_BuildEndRecord (location_t location, tree record,
+                                   tree fieldlist, int isPacked);
+EXTERN tree m2type_AddStringToTreeList (tree list, tree string);
+EXTERN tree m2type_ChainOnParamValue (tree list, tree name, tree str,
+                                      tree value);
+EXTERN tree m2type_ChainOn (tree t1, tree t2);
+EXTERN tree m2type_BuildFieldRecord (location_t location, char *name,
+                                     tree type);
+EXTERN tree m2type_BuildStartFieldRecord (location_t location, char *name,
+                                          tree type);
+EXTERN tree m2type_BuildEndFieldVarient (location_t location,
+                                         tree varientField, tree varientList,
+                                         int isPacked);
+EXTERN tree m2type_BuildStartFieldVarient (location_t location, char *name);
+EXTERN tree m2type_BuildEndVarient (location_t location, tree varientField,
+                                    tree varientList, int isPacked);
+EXTERN tree m2type_BuildStartVarient (location_t location, char *name);
+EXTERN tree m2type_BuildStartUnion (location_t location, char *name);
+EXTERN tree m2type_BuildStartRecord (location_t location, char *name);
+EXTERN tree m2type_RealToTree (char *name);
+EXTERN tree m2type_BuildArrayStringConstructor (location_t location,
+                                                tree arrayType, tree str,
+                                                tree length);
+
+#if 0
+EXTERN tree m2type_GetPointerOne (void);
+EXTERN tree m2type_GetPointerZero (void);
+EXTERN tree m2type_GetWordOne (void);
+EXTERN tree m2type_GetWordZero (void);
+#endif
+
+EXTERN tree m2type_GetM2CharType (void);
+EXTERN tree m2type_GetM2IntegerType (void);
+EXTERN tree m2type_GetM2ShortRealType (void);
+EXTERN tree m2type_GetM2RealType (void);
+EXTERN tree m2type_GetM2LongRealType (void);
+EXTERN tree m2type_GetM2LongIntType (void);
+EXTERN tree m2type_GetM2LongCardType (void);
+EXTERN tree m2type_GetM2ShortIntType (void);
+EXTERN tree m2type_GetShortIntType (void);
+EXTERN tree m2type_GetM2ShortCardType (void);
+EXTERN tree m2type_GetShortCardType (void);
+EXTERN tree m2type_GetISOWordType (void);
+EXTERN tree m2type_GetISOByteType (void);
+EXTERN tree m2type_GetISOLocType (void);
+EXTERN tree m2type_GetM2Integer8 (void);
+EXTERN tree m2type_GetM2Integer16 (void);
+EXTERN tree m2type_GetM2Integer32 (void);
+EXTERN tree m2type_GetM2Integer64 (void);
+EXTERN tree m2type_GetM2Cardinal8 (void);
+EXTERN tree m2type_GetM2Cardinal16 (void);
+EXTERN tree m2type_GetM2Cardinal32 (void);
+EXTERN tree m2type_GetM2Cardinal64 (void);
+EXTERN tree m2type_GetM2Word16 (void);
+EXTERN tree m2type_GetM2Word32 (void);
+EXTERN tree m2type_GetM2Word64 (void);
+EXTERN tree m2type_GetM2Bitset8 (void);
+EXTERN tree m2type_GetM2Bitset16 (void);
+EXTERN tree m2type_GetM2Bitset32 (void);
+EXTERN tree m2type_GetM2Real32 (void);
+EXTERN tree m2type_GetM2Real64 (void);
+EXTERN tree m2type_GetM2Real96 (void);
+EXTERN tree m2type_GetM2Real128 (void);
+EXTERN tree m2type_GetM2Complex32 (void);
+EXTERN tree m2type_GetM2Complex64 (void);
+EXTERN tree m2type_GetM2Complex96 (void);
+EXTERN tree m2type_GetM2Complex128 (void);
+EXTERN tree m2type_GetM2ShortComplexType (void);
+EXTERN tree m2type_GetM2LongComplexType (void);
+EXTERN tree m2type_GetM2ComplexType (void);
+EXTERN tree m2type_GetShortCardType (void);
+EXTERN tree m2type_GetProcType (void);
+EXTERN tree m2type_GetCSizeTType (void);
+EXTERN tree m2type_GetCSSizeTType (void);
+
+EXTERN tree m2type_GetM2CType (void);
+
+EXTERN tree m2type_GetBitsetType (void);
+EXTERN tree m2type_GetM2CardinalType (void);
+EXTERN tree m2type_GetWordType (void);
+EXTERN tree m2type_GetIntegerType (void);
+EXTERN tree m2type_GetCardinalType (void);
+EXTERN tree m2type_GetPointerType (void);
+EXTERN tree m2type_GetLongIntType (void);
+EXTERN tree m2type_GetShortRealType (void);
+EXTERN tree m2type_GetLongRealType (void);
+EXTERN tree m2type_GetRealType (void);
+EXTERN tree m2type_GetBitnumType (void);
+EXTERN tree m2type_GetVoidType (void);
+EXTERN tree m2type_GetByteType (void);
+EXTERN tree m2type_GetCharType (void);
+EXTERN tree m2type_GetPackedBooleanType (void);
+EXTERN tree m2type_GetBooleanTrue (void);
+EXTERN tree m2type_GetBooleanFalse (void);
+EXTERN tree m2type_GetBooleanType (void);
+EXTERN tree m2type_BuildSmallestTypeRange (location_t location, tree low,
+                                           tree high);
+EXTERN tree m2type_BuildSetTypeFromSubrange (location_t location, char *name,
+                                             tree subrangeType, tree lowval,
+                                             tree highval, int ispacked);
+EXTERN int m2type_GetBitsPerBitset (void);
+EXTERN tree m2type_GetM2RType (void);
+EXTERN tree m2type_GetM2ZType (void);
+
+EXTERN tree m2type_DeclareKnownType (location_t location, char *name,
+                                     tree type);
+EXTERN tree m2type_GetTreeType (tree type);
+EXTERN tree m2type_BuildEndFunctionType (tree func, tree type,
+                                         int uses_varargs);
+EXTERN tree m2type_BuildStartFunctionType (
+    location_t location ATTRIBUTE_UNUSED, char *name ATTRIBUTE_UNUSED);
+EXTERN void m2type_InitFunctionTypeParameters (void);
+EXTERN tree m2type_BuildVariableArrayAndDeclare (location_t location,
+                                                 tree elementtype, tree high,
+                                                 char *name, tree scope);
+EXTERN void m2type_InitSystemTypes (location_t location, int loc);
+EXTERN void m2type_InitBaseTypes (location_t location);
+EXTERN tree m2type_BuildStartType (location_t location, char *name, tree type);
+EXTERN tree m2type_BuildEndType (location_t location, tree type);
+EXTERN tree m2type_GetDefaultType (location_t location, char *name, tree type);
+EXTERN tree m2type_GetMinFrom (location_t location, tree type);
+EXTERN tree m2type_GetMaxFrom (location_t location, tree type);
+EXTERN void m2type_BuildTypeDeclaration (location_t location, tree type);
+EXTERN tree m2type_BuildStartEnumeration (location_t location, char *name,
+                                          int ispacked);
+EXTERN tree m2type_BuildEndEnumeration (location_t location, tree enumtype,
+                                        tree enumvalues);
+EXTERN tree m2type_BuildEnumerator (location_t location, char *name,
+                                    tree value, tree *enumvalues);
+EXTERN tree m2type_BuildPointerType (tree totype);
+EXTERN tree m2type_BuildConstPointerType (tree totype);
+EXTERN tree m2type_BuildSetType (location_t location, char *name, tree type,
+                                 tree lowval, tree highval, int ispacked);
+EXTERN void *m2type_BuildStartSetConstructor (tree type);
+EXTERN void m2type_BuildSetConstructorElement (void *p, tree value);
+EXTERN tree m2type_BuildEndSetConstructor (void *p);
+EXTERN void *m2type_BuildStartRecordConstructor (tree type);
+EXTERN tree m2type_BuildEndRecordConstructor (void *p);
+EXTERN void m2type_BuildRecordConstructorElement (void *p, tree value);
+EXTERN void *m2type_BuildStartArrayConstructor (tree type);
+EXTERN tree m2type_BuildEndArrayConstructor (void *p);
+EXTERN void m2type_BuildArrayConstructorElement (void *p, tree value,
+                                                 tree indice);
+EXTERN tree m2type_BuildCharConstant (location_t location, const char *string);
+EXTERN tree m2type_BuildCharConstantChar (location_t location, char ch);
+EXTERN tree m2type_BuildSubrangeType (location_t location, char *name,
+                                      tree type, tree lowval, tree highval);
+EXTERN tree m2type_gm2_unsigned_type (tree type);
+EXTERN tree m2type_gm2_signed_type (tree type);
+EXTERN tree m2type_gm2_signed_or_unsigned_type (int unsignedp, tree type);
+EXTERN tree m2type_gm2_type_for_size (unsigned int bits, int unsignedp);
+EXTERN tree m2type_BuildProcTypeParameterDeclaration (location_t location,
+                                                      tree type,
+                                                      int isreference);
+EXTERN int m2type_IsAddress (tree type);
+EXTERN tree m2type_GetCardinalAddressType (void);
+
+#undef EXTERN
+#endif /* m2type_h  */
diff --git a/gcc/m2/gm2-gcc/rtegraph.cc b/gcc/m2/gm2-gcc/rtegraph.cc
new file mode 100644
index 00000000000..dcb75b6bd1c
--- /dev/null
+++ b/gcc/m2/gm2-gcc/rtegraph.cc
@@ -0,0 +1,527 @@
+/* rtegraph.cc graph and nodes used by m2rte.
+
+Copyright (C) 2019-2022 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 "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#include "langhooks-def.h" /* FIXME: for lhd_set_decl_assembler_name.  */
+#include "tree-pass.h"     /* FIXME: only for PROP_gimple_any.  */
+#include "toplev.h"
+#include "debug.h"
+
+#include "opts.h"
+#include "mpfr.h"
+
+#undef DEBUGGING
+
+struct GTY (()) rtenode
+{
+  bool constructor_reachable;   /* Is this guarenteed to be reachable by a constructor?  */
+  bool export_reachable;  /* Is this reachable via exported functions?  */
+  bool exception_routine;   /* Is this an exception routine?  */
+  bool constructor_final;   /* Have we walked this rtenode during constructor testing?  */
+  bool export_final;   /* Walked this rtenode during exported testing?  */
+  bool is_call;    /* Is this a function call?  */
+  gimple *grtenode;
+  tree func;
+  rtenode *reachable_src;  /* If this is reachable which src function will call us?  */
+
+  vec<rtenode *, va_gc> *function_call;
+  vec<rtenode *, va_gc> *rts_call;
+  void dump (void);
+  void dump_vec (const char *title, vec<rtenode *, va_gc> *list);
+
+  void propagate_constructor_reachable (rtenode *);
+  void propagate_export_reachable (rtenode *);
+  void error_message (void);
+  void warning_message (void);
+  void note_message (void);
+  const char *get_func_name (void);
+  const char *create_message (const char *with_name, const char *without_name);
+};
+
+
+typedef vec<rtenode *, va_gc> rtevec;
+
+static GTY (()) rtevec *allnodes;
+static GTY (()) rtevec *candidates;
+static GTY (()) rtevec *externs;
+static GTY (()) rtevec *constructors;
+
+
+static void determine_reachable (void);
+static void issue_messages (void);
+void rtegraph_dump (void);
+
+
+static GTY (()) rtenode *rtegraph_current_function = NULL;
+
+
+/* rtegraph_get_func returns the function associated with the rtenode.  */
+
+tree
+rtegraph_get_func (rtenode *n)
+{
+  return n->func;
+}
+
+/* rtegraph_set_current_function assigns rtegraph_current_function with func.  */
+
+void
+rtegraph_set_current_function (rtenode *func)
+{
+  rtegraph_current_function = func;
+}
+
+/* rtegraph_include_rtscall mark func as an exception routine and remember
+   that it is called from rtegraph_current_function in the rts_call array.  */
+
+void rtegraph_include_rtscall (rtenode *func)
+{
+  /* This is a runtime exception, mark it as such.  */
+  func->exception_routine = true;
+  /* And remember it.  */
+  vec_safe_push (rtegraph_current_function->rts_call, func);
+}
+
+
+/* rtegraph_include_rtscall remember that rtegraph_current_function calls
+   func.  */
+
+void rtegraph_include_function_call (rtenode *func)
+{
+  vec_safe_push (rtegraph_current_function->function_call, func);
+}
+
+
+/* rtegraph_discover performs the main work, called by m2rte.cc analyse_graph.
+   It determines which function calls a reachable and then issues any warning
+   message if a reachable function is a call to a runtime exception handler.  */
+
+void rtegraph_discover (void)
+{
+  determine_reachable ();
+#if defined (DEBUGGING)
+  rtegraph_dump ();
+#endif
+  issue_messages ();
+}
+
+/* rtegraph_candidates_include include node n in the array of candidates.  */
+
+void rtegraph_candidates_include (rtenode *n)
+{
+  unsigned int len = vec_safe_length (candidates);
+
+  for (unsigned int i = 0; i < len; i++)
+    if ((*candidates)[i] == n)
+      return;
+  vec_safe_push (candidates, n);
+}
+
+/* rtegraph_allnodes_include include node n in the array of allnodes.  */
+
+void rtegraph_allnodes_include (rtenode *n)
+{
+  unsigned int len = vec_safe_length (allnodes);
+
+  for (unsigned int i = 0; i < len; i++)
+    if ((*allnodes)[i] == n)
+      return;
+  vec_safe_push (allnodes, n);
+}
+
+/* rtegraph_externs_include include node n in the array of externs.  */
+
+void rtegraph_externs_include (rtenode *n)
+{
+  unsigned int len = vec_safe_length (externs);
+
+  for (unsigned int i = 0; i < len; i++)
+    if ((*externs)[i] == n)
+      return;
+  vec_safe_push (externs, n);
+}
+
+/* rtegraph_constructors_include include node n in the array of constructors.  */
+
+void rtegraph_constructors_include (rtenode *n)
+{
+  unsigned int len = vec_safe_length (constructors);
+
+  for (unsigned int i = 0; i < len; i++)
+    if ((*constructors)[i] == n)
+      return;
+  vec_safe_push (constructors, n);
+}
+
+/* determine_reachable mark modules constructors as reachable and
+   also mark the exported functions as also reachable.  */
+
+void determine_reachable (void)
+{
+  unsigned int len = vec_safe_length (constructors);
+  for (unsigned int i = 0; i < len; i++)
+    (*constructors)[i]->propagate_constructor_reachable ((*constructors)[i]);
+  len = vec_safe_length (externs);
+  for (unsigned int i = 0; i < len; i++)
+    (*externs)[i]->propagate_export_reachable ((*externs)[i]);
+}
+
+/* issue_messages for every candidate which is constructor reachable issue
+   an error.  For each candidate which is reachable via an external call
+   issue a warning, for any other candidate (of a local procedure) issue
+   a note.  */
+
+void issue_messages (void)
+{
+  unsigned int len = vec_safe_length (candidates);
+  for (unsigned int i = 0; i < len; i++)
+    {
+      if ((*candidates)[i]->constructor_reachable)
+	(*candidates)[i]->error_message ();
+      else if ((*candidates)[i]->export_reachable)
+	(*candidates)[i]->warning_message ();
+      else
+	(*candidates)[i]->note_message ();
+    }
+}
+
+
+#if defined (DEBUGGING)
+/* rtegraph_dump_vec display the contents of a vector array.  */
+
+void
+rtegraph_dump_vec (const char *title, vec<rtenode *, va_gc> *list)
+{
+  unsigned int len = vec_safe_length (list);
+  printf ("%s (length = %d)\n", title, len);
+  for (unsigned int i = 0; i < len; i++)
+    {
+      printf ("[%d]: rtenode %p ", i, (*list)[i]);
+      (*list)[i]->dump ();
+    }
+  printf ("end\n");
+}
+
+/* rtegraph_dump display the contents of each vector array.  */
+
+void rtegraph_dump (void)
+{
+  rtegraph_dump_vec ("allnodes", allnodes);
+  rtegraph_dump_vec ("candidates", candidates);
+  rtegraph_dump_vec ("externs", externs);
+  rtegraph_dump_vec ("constructors", constructors);
+}
+#endif
+
+/* rtegraph_init_rtenode create and return a new rtenode.  */
+
+rtenode *
+rtegraph_init_rtenode (gimple *g, tree fndecl, bool is_func_call)
+{
+  rtenode *n = ggc_alloc<rtenode> ();
+
+  n->constructor_reachable = false;
+  n->export_reachable = false;
+  n->constructor_final = false;
+  n->export_final = false;
+  n->is_call = is_func_call;
+  n->grtenode = g;
+  n->func = fndecl;
+  n->reachable_src = NULL;
+
+  vec_alloc (n->function_call, 0);
+  // n->function_call = ggc_alloc<rtevec> ();
+  gcc_assert (vec_safe_length (n->function_call) == 0);
+  vec_alloc (n->rts_call, 0);
+  // n->rts_call = ggc_alloc<rtevec> ();
+  gcc_assert (vec_safe_length (n->rts_call) == 0);
+  return n;
+}
+
+/* rtegraph_lookup attempts to lookup a rtenode associated with a fndecl
+   which is a function call from node g.  */
+
+rtenode *
+rtegraph_lookup (gimple *g, tree fndecl, bool is_call)
+{
+  unsigned int len = vec_safe_length (allnodes);
+  for (unsigned int i = 0; i < len; i++)
+    if ((*allnodes)[i]->grtenode == g
+	&& (*allnodes)[i]->func == fndecl
+	&& (*allnodes)[i]->is_call == is_call)
+      return (*allnodes)[i];
+  rtenode *n = rtegraph_init_rtenode (g, fndecl, is_call);
+  vec_safe_push (allnodes, n);
+#if defined (DEBUGGING)
+  rtegraph_dump ();
+#endif
+  return n;
+}
+
+/* rte_error_at - wraps up an error message.  */
+
+static void
+rte_error_at (location_t location, diagnostic_t kind, const char *message, ...)
+{
+  diagnostic_info diagnostic;
+  va_list ap;
+  rich_location richloc (line_table, location);
+
+  va_start (ap, message);
+  diagnostic_set_info (&diagnostic, message, &ap, &richloc, kind);
+  diagnostic_report_diagnostic (global_dc, &diagnostic);
+  va_end (ap);
+}
+
+/* access_int return true if the tree t contains a constant integer, if so then
+   its value is assigned to *value.  */
+
+static bool
+access_int (tree t, int *value)
+{
+  enum tree_code code = TREE_CODE (t);
+
+  if (code == SSA_NAME)
+    return access_int (SSA_NAME_VAR (t), value);
+  if (code == INTEGER_CST)
+    {
+      *value = TREE_INT_CST_LOW (t);
+      return true;
+    }
+  if ((code == VAR_DECL || code == PARM_DECL)
+      && DECL_HAS_VALUE_EXPR_P (t))
+    return access_int (DECL_VALUE_EXPR (t), value);
+  return false;
+}
+
+/* access_string return true if the tree t contains a constant string, if so then
+   its value is assigned to *value.  */
+
+static bool
+access_string (tree t, const char **value)
+{
+  if (TREE_CODE (t) == ADDR_EXPR)
+    {
+      if (TREE_CODE (TREE_OPERAND (t, 0)) == STRING_CST)
+	{
+	  *value = TREE_STRING_POINTER (TREE_OPERAND (t, 0));
+	  return true;
+	}
+    }
+  return false;
+}
+
+/* generate an error using the parameters of the M2RTS exception handler to
+   locate the source code.  We dont use location, as the error_at function will
+   give the function context which might be misleading if this is inlined.  */
+
+static void
+generate_report (gimple *stmt, const char *report, diagnostic_t kind)
+{
+  if (gimple_call_num_args (stmt) == 5)
+    {
+      tree s0 = gimple_call_arg (stmt, 0);
+      tree i1 = gimple_call_arg (stmt, 1);
+      tree i2 = gimple_call_arg (stmt, 2);
+      tree s1 = gimple_call_arg (stmt, 3);
+      tree s2 = gimple_call_arg (stmt, 4);
+      const char *file;
+      int line;
+      int col;
+      const char *scope;
+      const char *message;
+
+      if (access_string (s0, &file)
+	  && access_int (i1, &line)
+	  && access_int (i2, &col)
+	  && access_string (s1, &scope)
+	  && access_string (s2, &message))
+	{
+	  /* Continue to use scope as this will survive any
+	     optimization transforms.  */
+	  location_t location = gimple_location (stmt);
+	  rte_error_at (location, kind, "In %s\n%s, %s",
+			scope, report, message);
+	}
+    }
+}
+
+/* get_func_name returns the name of the function associated with rtenode.  */
+
+const char *rtenode::get_func_name (void)
+{
+  if (func != NULL && (DECL_NAME (func) != NULL))
+    return IDENTIFIER_POINTER (DECL_NAME (func));
+  return NULL;
+}
+
+/* create_message if the current rtenode has a named function associated with it then
+   create a new message using with_name and the function name, otherwise
+   return without_name.  */
+
+const char *rtenode::create_message (const char *with_name, const char *without_name)
+{
+  const char *name = get_func_name ();
+  if (name == NULL)
+    return without_name;
+
+  int len = strlen (with_name) + 1 + strlen (name);
+  char *message = XNEWVEC (char, len);
+  snprintf (message, len, with_name, name);
+  return message;
+}
+
+/* error_message issue an DK_ERROR from grtenode.  */
+
+void rtenode::error_message (void)
+{
+  if (grtenode != NULL)
+    generate_report (grtenode, "runtime error will occur", DK_ERROR);
+}
+
+/* warning_message issue an DK_WARNING from grtenode.  */
+
+void rtenode::warning_message (void)
+{
+  const char *message = reachable_src->create_message
+    ("runtime error will occur if an exported procedure is called from %s",
+     "runtime error will occur if an exported procedure is called");
+  if (grtenode != NULL)
+    generate_report (grtenode, message, DK_WARNING);
+}
+
+/* note_message issue an DK_NOTE from grtenode.  */
+
+void rtenode::note_message (void)
+{
+  if (grtenode != NULL)
+    generate_report (grtenode, "runtime will occur if this procedure is called", DK_NOTE);
+}
+
+/* dump_vec display contents of vector array list.  */
+#if defined (DEBUGGING)
+void
+rtenode::dump_vec (const char *title, vec<rtenode *, va_gc> *list)
+{
+  printf ("  %s (length = %d)\n", title, vec_safe_length (list));
+  for (unsigned int i = 0; i < vec_safe_length (list); i++)
+    printf ("   [%d]: rtenode %p\n", i, (*list)[i]);
+}
+#endif
+
+/* dump display all vector arrays associated with rtenode.  */
+
+void
+rtenode::dump (void)
+{
+#if defined (DEBUGGING)
+  printf ("rtenode::dump:");
+  if (func != NULL && (DECL_NAME (func) != NULL))
+    {
+      const char *n = IDENTIFIER_POINTER (DECL_NAME (func));
+      printf ("%s", n);
+    }
+  if (constructor_reachable)
+    printf (", constructor_reachable");
+  if (export_reachable)
+    printf (", export_reachable");
+  if (constructor_final)
+    printf (", constructor_final");
+  if (export_final)
+    printf (", export_final");
+  if (is_call)
+    printf (", is_call");
+  else
+    printf (", decl");
+  printf (", grtenode %p, func = %p\n", grtenode, func);
+  dump_vec ("function_call", function_call);
+  dump_vec ("rts_call", rts_call);
+#endif
+}
+
+/* propagate_constructor_reachable for every function which is reachable from
+   rtenode call the callee rtenode and mark it as reachable from a
+   constructor.  */
+
+void rtenode::propagate_constructor_reachable (rtenode *src)
+{
+  if (constructor_final)
+    return;
+  constructor_final = true;
+  constructor_reachable = true;
+  reachable_src = src;
+  for (unsigned int i = 0; i < vec_safe_length (function_call); i++)
+    (*function_call)[i]->propagate_constructor_reachable (src);
+  for (unsigned int i = 0; i < vec_safe_length (rts_call); i++)
+    (*rts_call)[i]->propagate_constructor_reachable (src);
+}
+
+/* propagate_export_reachable for every function which is reachable
+   from rtenode call the callee rtenode and mark it as reachable from
+   an exported function.  */
+
+void rtenode::propagate_export_reachable (rtenode *src)
+{
+  if (export_final)
+    return;
+  export_final = true;
+  export_reachable = true;
+  reachable_src = src;
+  for (unsigned int i = 0; i < vec_safe_length (function_call); i++)
+    (*function_call)[i]->propagate_export_reachable (src);
+  for (unsigned int i = 0; i < vec_safe_length (rts_call); i++)
+    (*rts_call)[i]->propagate_export_reachable (src);
+}
+
+/* rtegraph_init initialize the data structures (vec arrays) in this
+   file.  */
+
+void rtegraph_init (void)
+{
+  vec_alloc (allnodes, 0);
+  gcc_assert (vec_safe_length (allnodes) == 0);
+  vec_alloc (candidates, 0);
+  gcc_assert (vec_safe_length (candidates) == 0);
+  vec_alloc (externs, 0);
+  gcc_assert (vec_safe_length (externs) == 0);
+  vec_alloc (constructors, 0);
+  gcc_assert (vec_safe_length (constructors) == 0);
+#if defined (DEBUGGING)
+  rtegraph_dump ();
+#endif
+}
+
+/* rtegraph_finish deallocate all vec arrays in this file.  */
+
+void rtegraph_finish (void)
+{
+  rtegraph_current_function = NULL;
+  vec_free (allnodes);
+  vec_free (candidates);
+  vec_free (externs);
+  vec_free (constructors);
+}
+
+#include "gt-m2-rtegraph.h"
diff --git a/gcc/m2/gm2-gcc/rtegraph.h b/gcc/m2/gm2-gcc/rtegraph.h
new file mode 100644
index 00000000000..9fe44b74778
--- /dev/null
+++ b/gcc/m2/gm2-gcc/rtegraph.h
@@ -0,0 +1,42 @@
+/* rtegraph.h runtime exception graph header.
+
+Copyright (C) 2019-2022 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/>.  */
+
+#ifndef RTEGRAPH_H
+#define RTEGRAPH_H
+
+struct rtenode;
+
+extern rtenode *rtegraph_init_rtenode (gimple *g, tree fndecl, bool is_func_call);
+extern rtenode *rtegraph_lookup (gimple *g, tree fndecl, bool is_call);
+extern void rtegraph_candidates_include (rtenode *n);
+extern void rtegraph_allnodes_include (rtenode *n);
+extern void rtegraph_externs_include (rtenode *n);
+extern void rtegraph_constructors_include (rtenode *n);
+extern void rtegraph_include_rtscall (rtenode *func);
+extern void rtegraph_include_function_call (rtenode *func);
+extern void rtegraph_set_current_function (rtenode *func);
+extern tree rtegraph_get_func (rtenode *func);
+
+extern void rtegraph_discover (void);
+extern void rtegraph_init (void);
+extern void rtegraph_finish (void);
+
+#endif  /* RTEGRAPH_H.  */
diff --git a/gcc/m2/gm2-ici/M2Emit.mod b/gcc/m2/gm2-ici/M2Emit.mod
new file mode 100644
index 00000000000..04ca43574df
--- /dev/null
+++ b/gcc/m2/gm2-ici/M2Emit.mod
@@ -0,0 +1,179 @@
+(* M2Emit.mod issue errors to the gm2 tools substructure.
+
+Copyright (C) 2019-2021 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/>.  *)
+
+IMPLEMENTATION MODULE M2Emit ;
+
+FROM M2ColorString IMPORT filenameColor, endColor, errorColor, warningColor, noteColor,
+                          range1Color, range2Color ;
+
+FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToColumnNo, GetTokenNo,
+                     UnknownTokenNo, BuiltinTokenNo;
+
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, ConCat, ConCatChar, Mark, string, KillString, Dup ;
+
+FROM ASCII IMPORT nul, nl ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ;
+FROM FIO IMPORT StdOut, WriteNBytes, Close, FlushBuffer ;
+FROM M2Printf IMPORT printf0, printf1, printf2 ;
+FROM M2Options IMPORT Xcode ;
+FROM StrLib IMPORT StrLen ;
+FROM libc IMPORT abort ;
+
+IMPORT StdIO, StrIO ;
+
+CONST
+   Debugging  =  TRUE ;
+
+
+
+(*
+   EmitError - pass the error to GCC.
+*)
+
+PROCEDURE EmitError (error, note: BOOLEAN; token: CARDINAL; message: String) ;
+BEGIN
+   IF error
+   THEN
+      message := ConCat (errorColor (InitString (' error ')), endColor (message))
+   ELSIF note
+   THEN
+      message := ConCat (noteColor (InitString (' note ')), endColor (message))
+   ELSE
+      message := ConCat (warningColor (InitString (' warning ')), endColor (message))
+   END ;
+   OutString (FindFileNameFromToken (token, 0),
+              TokenToLineNo (token, 0), TokenToColumnNo (token, 0), message)
+END EmitError ;
+
+
+(*
+   OutString - writes the contents of String to stdout.
+               The string, s, is destroyed.
+*)
+
+PROCEDURE OutString (file: String; line, col: CARDINAL; s: String) ;
+VAR
+   leader : String ;
+   p, q   : POINTER TO CHAR ;
+   space,
+   newline: BOOLEAN ;
+BEGIN
+   file := ConCat(filenameColor(InitString('')), file) ;
+   file := endColor(file) ;
+   INC(col) ;
+   leader := ConCatChar(file, ':') ;
+   leader := range1Color(leader) ;
+   leader := ConCat(leader, Sprintf1(Mark(InitString('%d')), line)) ;
+   leader := endColor(leader) ;
+   leader := ConCatChar(leader, ':') ;
+   IF NOT Xcode
+   THEN
+      leader := range2Color(leader) ;
+      leader := ConCat(leader, Sprintf1(Mark(InitString('%d')), col)) ;
+      leader := endColor(leader) ;
+      leader := ConCatChar(leader, ':')
+   END ;
+   p := string(s) ;
+   newline := TRUE ;
+   space := FALSE ;
+   WHILE (p#NIL) AND (p^#nul) DO
+      IF newline
+      THEN
+         q := string(leader) ;
+         WHILE (q#NIL) AND (q^#nul) DO
+            StdIO.Write(q^) ;
+            INC(q)
+         END
+      END ;
+      newline := (p^=nl) ;
+      space := (p^=' ') ;
+      IF newline AND Xcode
+      THEN
+         printf1('(pos: %d)', col)
+      END ;
+      StdIO.Write(p^) ;
+      INC(p)
+   END ;
+   IF NOT newline
+   THEN
+      IF Xcode
+      THEN
+         IF NOT space
+         THEN
+            StdIO.Write(' ')
+         END ;
+         printf1('(pos: %d)', col)
+      END ;
+      StdIO.Write(nl)
+   END ;
+   FlushBuffer(StdOut) ;
+   IF NOT Debugging
+   THEN
+      s      := KillString(s) ;
+      leader := KillString(leader)
+   END
+END OutString ;
+
+
+(*
+   InternalError -
+*)
+
+PROCEDURE InternalError (message: ARRAY OF CHAR) ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   StrIO.WriteString ('internal error: ') ;
+   h := StrLen (message) ;
+   i := 0 ;
+   WHILE i<h DO
+      StdIO.Write (message[i]) ;
+      INC (i)
+   END ;
+   StdIO.Write(nl) ;
+   FlushBuffer(StdOut) ;
+   abort
+END InternalError ;
+
+
+(*
+   UnknownLocation - return the unknown location (using GCC linemap for cc1gm2)
+                     and constants for gm2l and gm2m.
+*)
+
+PROCEDURE UnknownLocation () : location_t ;
+BEGIN
+   RETURN UnknownTokenNo
+END UnknownLocation ;
+
+
+(*
+   BuiltinsLocation - return the builtins location (using GCC linemap for cc1gm2)
+                      and constants for gm2l and gm2m.
+*)
+
+PROCEDURE BuiltinsLocation () : location_t ;
+BEGIN
+   RETURN BuiltinTokenNo
+END BuiltinsLocation ;
+
+
+END M2Emit.
diff --git a/gcc/m2/gm2-ici/README b/gcc/m2/gm2-ici/README
new file mode 100644
index 00000000000..2b9fef0aca9
--- /dev/null
+++ b/gcc/m2/gm2-ici/README
@@ -0,0 +1,3 @@
+This subdirectory contains modules which provide a dummy internal
+compatibility interface to enable m2 tools (gm2l, gm2lgen, gm2lcc,
+gm2lorder, gm2m) to share modules with the cc1gm2 compiler.
\ No newline at end of file
diff --git a/gcc/m2/gm2-ici/m2linemap.c b/gcc/m2/gm2-ici/m2linemap.c
new file mode 100644
index 00000000000..e2af672f73e
--- /dev/null
+++ b/gcc/m2/gm2-ici/m2linemap.c
@@ -0,0 +1,38 @@
+/* m2linemap.c dummy module to allow tools to linking with M2LexBuf.
+
+Copyright (C) 2005-2021 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
+m2linemap_GetLocationBinary (void)
+{
+  fprintf (stderr, "GetLocationBinary should not be called\n");
+  exit (1);
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/gm2-internals.texi b/gcc/m2/gm2-internals.texi
new file mode 100644
index 00000000000..b72b7835b85
--- /dev/null
+++ b/gcc/m2/gm2-internals.texi
@@ -0,0 +1,1067 @@
+@c gm2-internals.texi describes the internals of gm2.
+@c Copyright @copyright{} 2000-2022 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+@chapter GNU Modula-2 Internals
+
+This document is a small step in the long journey of documenting the GNU
+Modula-2 compiler and how it integrates with GCC.
+The document is still in it's infancy.
+
+@menu
+* History::                 How GNU Modula-2 came about.
+* Overview::                Overview of the structure of GNU Modula-2.
+* Integrating::             How the front end integrates with gcc.
+* Passes::                  What gets processed during each pass.
+* Run time::                Integration of run time modules with the compiler.
+* Scope rules::             Clarification of some the scope rules.
+* Done list::               Progression of the GNU Modula-2 project.
+* To do list::              Outstanding issues.
+@end menu
+
+@node History, Overview, , Internals
+@section History
+
+This document is out of date and needs to be rewritten.
+
+The Modula-2 compiler sources have come from the m2f compiler which
+runs under GNU/Linux.  The original m2f compiler was written in Modula-2
+and was bootstrapped via a modified version of p2c 1.20.  The m2f
+compiler was a recursive descent which generated quadruples as
+intermediate code. It also used C style calling convention wherever
+possible and utilized a C structure for dynamic arrays.
+
+@node Overview, Integrating, History, Internals
+@section Overview
+
+GNU Modula-2 uses flex and a machine generated recursive descent
+parser. Most of the source code is written in Modula-2 and
+bootstrapping is achieved via a modified version of p2c-1.20.
+The modified p2c-1.20 is contained in the GNU Modula-2 source
+tree as are a number of other tools necessary for bootstrapping.
+
+The changes to p2c include:
+
+@itemize @bullet
+@item
+allowing @code{DEFINITION MODULE FOR "C"}
+@item
+fixes to abstract data types.
+@item
+making p2c understand the 2nd Edition dialect of Modula-2.
+@item
+introducing the @code{UNQUALIFIED} keyword.
+@item
+allowing varargs (@code{...}) inside @code{DEFINITION MODULE FOR "C"} modules.
+@item
+fixing the parser to understand commented @code{FORWARD} prototypes,
+which are ignored by GNU Modula-2.
+@item
+fixes to the @code{CASE} syntax for 2nd Edition Modula-2.
+@item
+fixes to a @code{FOR} loop counting down to zero using a @code{CARDINAL}.
+@item
+introducing an initialization section for each implementation module.
+@item
+various porting improvements and general tidying up so that
+it compiles with the gcc option @code{-Wall}.
+@end itemize
+
+GNU Modula-2 comes with PIM and ISO style libraries. The compiler
+is built using PIM libraries and the source of the compiler
+complies with the PIM dialect together with a few @code{C}
+library calling extensions.
+
+The compiler is a four pass compiler. The first pass tokenizes
+the source code, creates scope and enumeration type symbols.
+All tokens are placed into a dynamic buffer and subsequent passes reread
+tokens and build types, quadruples and resolve hidden types.
+@xref{Passes, , ,}.
+
+GNU Modula-2 uses a technique of double book keeping @footnote{See the
+excellent tutorial by Joachim Nadler translated by Tim Josling}.
+@xref{Back end Access to Symbol Table, , , gcc}.
+The front end builds a complete symbol table and a list of quadruples.
+Each symbol is translated into a @code{gcc} equivalent after which
+each quadruple is translated into a @code{gcc} @code{tree}.
+
+@node Integrating, Passes, Overview, Internals
+@section How the front end integrates with gcc
+
+The M2Base and M2System
+modules contain base types and system types respectively they
+map onto GCC back-end data types.
+
+@node Passes, Run time, Integrating, Internals
+@section Passes
+
+This section describes the general actions of each pass.  The key to
+building up the symbol table correctly is to ensure that the symbols
+are only created in the scope where they were declared.  This may seem
+obvious (and easy) but it is complicated by two issues: firstly GNU
+Modula-2 does not generate @code{.sym} files and so all imported
+definition modules are parsed after the module is parsed; secondly the
+import/export rules might mean that you can see and use a symbol
+before it is declared in a completely different scope.
+
+Here is a brief description of the lists of symbols maintained within
+@code{DefImp} and @code{Module} symbols. It is these lists and actions
+at each pass which manipulate these lists which solve the scoping and
+visability of all symbols.
+
+The @code{DefImp} symbol maintains the: @code{ExportQualified},
+@code{ExportUnQualified}, @code{ExportRequest}, @code{IncludeList},
+@code{ImportTree}, @code{ExportUndeclared},
+@code{NeedToBeImplemented}, @code{LocalSymbols},
+@code{EnumerationScopeList}, @code{Unresolved}, @code{ListOfVars},
+@code{ListOfProcs} and @code{ListOfModules} lists.
+
+The @code{Module} symbol maintains the: @code{LocalSymbols},
+@code{ExportTree}, @code{IncludeList}, @code{ImportTree},
+@code{ExportUndeclared}, @code{EnumerationScopeList},
+@code{Unresolved}, @code{ListOfVars}, @code{ListOfProcs} and
+@code{ListOfModules} lists.
+
+Initially we discuss the lists which are common to both @code{DefImp}
+and @code{Module} symbols, thereafter the lists peculiar to @code{DefImp}
+and @code{Module} symbols are discussed.
+
+The @code{ListOfVars}, @code{ListOfProcs} and @code{ListOfModules}
+lists (common to both symbols) and simply contain a list of
+variables, procedures and inner modules which are declared with this
+definition/implementation or program module.
+
+The @code{LocalSymbols} list (common to both symbols) contains a
+complete list of symbols visible in this modules scope. The symbols in
+this list may have been imported or exported from an inner module.
+
+The @code{EnumerationScope} list (common to both symbols) defines all
+visible enumeration symbols.  When this module is parsed the contents
+of these enumeration types are marked as visible. Internally to GNU
+Modula-2 these form a pseudo scope (rather like a @code{WITH}
+statement which temporarily makes the fields of the record visible).
+
+The @code{ExportUndeclared} list (common to both symbols) contains a
+list of all symbols marked as exported but are as yet undeclared.
+
+The @code{IncludeList} is (common to both symbols) contains a list of
+all modules imported by the @code{IMPORT modulename ;} construct.
+
+The @code{ImportTree} (common to both symbols) contains a tree of all
+imported identifiers.
+
+The @code{ExportQualified} and @code{ExportUnQualified} trees (only
+present in the @code{DefImp} symbol) contain identifiers which are
+marked as @code{EXPORT QUALIFIED} and @code{EXPORT UNQUALIFIED}
+respectively.
+
+The @code{NeedToBeImplemented} list (only present in the @code{DefImp}
+symbol) and contains a list of all unresolved symbols which are exported.
+
+@subsection Pass 1
+
+During pass 1 each @code{DefImp} and @code{Module} symbol is
+created. These are also placed into a list of outstanding sources to
+be parsed.  The import and export lists are recorded and each object
+imported is created in the module from whence it is exported and added
+into the imported list of the current module. Any exported objects are
+placed into the export list and marked as qualified or unqualified.
+
+Inner module symbols are also created and their import and export
+lists are also processed. An import list will result in a symbol being
+fetched (or created if it does not exist) from the outer scope and
+placed into the scope of the inner module. An export list results in
+each symbol being fetched or created in the current inner scope and
+added to the outer scope. If the symbol has not yet been declared then
+it is added to the current modules @code{ExportUndeclared} list.
+
+Procedure symbols are created (the parameters are parsed but no more
+symbols are created). Enumerated types are created, hidden types in
+the definition modules are marked as such. All the rest of the Modula-2
+syntax is parsed but no symbols are created.
+
+@subsection Pass 2
+
+This section discuss varient records and their representation within
+the front end @file{gm2/gm2-compiler/SymbolTable.mod}. Records and
+varient records are declared in pass 2.
+
+Ordinary records are represented by the following symbol table entries:
+
+@example
+TYPE
+   this = RECORD
+             foo: CARDINAL ;
+             bar: CHAR ;
+          END ;
+
+
+    SymRecord [1]
+   +-------------+
+   | Name = this |        SymRecordField [2]
+   | ListOfSons  |       +-------------------+
+   |    +--------|       | Name = foo        |
+   |    | [2] [3]|       | Parent = [1]      |
+   +-------------+       | Type = [Cardinal] |
+   | LocalSymbols|       +-------------------+
+   | +-----------+
+   | | foo bar   |
+   | +-----------+
+   +-------------+
+
+
+    SymRecordField [3]
+   +-------------------+
+   | Name = bar        |
+   | Parent = [1]      |
+   | Type = [Cardinal] |
+   +-------------------+
+@end example
+
+Whereas varient records are represented by the following symbol table
+entries:
+
+@example
+TYPE
+   this = RECORD
+             CASE tag: CHAR OF
+             'a': foo: CARDINAL ;
+                  bar: CHAR |
+             'b': an:  REAL |
+             ELSE
+             END
+          END ;
+
+
+    SymRecord [1]
+   +-------------+
+   | Name = this |        SymRecordField [2]
+   | ListOfSons  |       +-------------------+
+   |    +--------|       | Name = tag        |
+   |    | [2] [3]|       | Parent = [1]      |
+   |    +--------+       | Type = [CHAR]     |
+   | LocalSymbols|       +-------------------+
+   | +-----------+
+   | | tag foo   |
+   | | bar an    |
+   | +-----------+
+   +-------------+
+
+    SymVarient [3]          SymFieldVarient [4]
+   +-------------------+   +-------------------+
+   | Parent = [1]      |   | Parent = [1]      |
+   | ListOfSons        |   | ListOfSons        |
+   |    +--------------|   |    +--------------|
+   |    | [4] [5]      |   |    | [6] [7]      |
+   +-------------------+   +-------------------+
+
+    SymFieldVarient [5]
+   +-------------------+
+   | Parent = [1]      |
+   | ListOfSons        |
+   |    +--------------|
+   |    | [8]          |
+   +-------------------+
+
+    SymRecordField [6]      SymRecordField [7]
+   +-------------------+   +-------------------+
+   | Name = foo        |   | Name = bar        |
+   | Parent = [1]      |   | Parent = [1]      |
+   | Type = [CARDINAL] |   | Type = [CHAR]     |
+   +-------------------+   +-------------------+
+
+    SymRecordField [8]
+   +-------------------+
+   | Name = an         |
+   | Parent = [1]      |
+   | Type = [REAL]     |
+   +-------------------+
+@end example
+
+Varient records which have nested @code{CASE} statements are
+represented by the following symbol table entries:
+
+@example
+TYPE
+   this = RECORD
+             CASE tag: CHAR OF
+             'a': foo: CARDINAL ;
+                  CASE bar: BOOLEAN OF
+                  TRUE : bt: INTEGER |
+                  FALSE: bf: CARDINAL
+                  END |
+             'b': an:  REAL |
+             ELSE
+             END
+          END ;
+
+
+    SymRecord [1]
+   +-------------+
+   | Name = this |        SymRecordField [2]
+   | ListOfSons  |       +-------------------+
+   |    +--------|       | Name = tag        |
+   |    | [2] [3]|       | Parent = [1]      |
+   |    +--------+       | Type = [CHAR]     |
+   | LocalSymbols|       +-------------------+
+   | +-----------+
+   | | tag foo   |
+   | | bar bt bf |
+   | | an        |
+   | +-----------+
+   +-------------+
+
+      ('1st CASE')            ('a' selector)
+    SymVarient [3]          SymFieldVarient [4]
+   +-------------------+   +-------------------+
+   | Parent = [1]      |   | Parent = [1]      |
+   | ListOfSons        |   | ListOfSons        |
+   |    +--------------|   |    +--------------|
+   |    | [4] [5]      |   |    | [6] [7] [8]  |
+   +-------------------+   +-------------------+
+
+     ('b' selector)
+    SymFieldVarient [5]
+   +-------------------+
+   | Parent = [1]      |
+   | ListOfSons        |
+   |    +--------------|
+   |    | [9]          |
+   +-------------------+
+
+    SymRecordField [6]      SymRecordField [7]
+   +-------------------+   +-------------------+
+   | Name = foo        |   | Name = bar        |
+   | Parent = [1]      |   | Parent = [1]      |
+   | Type = [CARDINAL] |   | Type = [BOOLEAN]  |
+   +-------------------+   +-------------------+
+
+      ('2nd CASE')
+    SymVarient [8]
+   +-------------------+
+   | Parent = [1]      |
+   | ListOfSons        |
+   |    +--------------|
+   |    | [12] [13]    |
+   +-------------------+
+
+    SymRecordField [9]
+   +-------------------+
+   | Name = an         |
+   | Parent = [1]      |
+   | Type = [REAL]     |
+   +-------------------+
+
+    SymRecordField [10]     SymRecordField [11]
+   +-------------------+   +-------------------+
+   | Name = bt         |   | Name = bf         |
+   | Parent = [1]      |   | Parent = [1]      |
+   | Type = [REAL]     |   | Type = [REAL]     |
+   +-------------------+   +-------------------+
+
+    (TRUE selector)            (FALSE selector)
+    SymFieldVarient [12]    SymFieldVarient [13]
+   +-------------------+   +-------------------+
+   | Parent = [1]      |   | Parent = [1]      |
+   | ListOfSons        |   | ListOfSons        |
+   |    +--------------|   |    +--------------|
+   |    | [10]         |   |    | [11]         |
+   +-------------------+   +-------------------+
+@end example
+
+@subsection Pass 3
+
+To do
+
+@subsection Pass H
+
+To do
+
+@subsection Declaration ordering
+
+This section gives a few stress testing examples and walks though
+the mechanics of the passes and how the lists of symbols are created.
+
+The first example contains a nested module in which an enumeration
+type is created and exported. A procedure declared before the nested
+module uses the enumeration type.
+
+@example
+MODULE colour ;
+
+   PROCEDURE make (VAR c: colours) ;
+   BEGIN
+      c := yellow
+   END make ;
+
+   MODULE inner ;
+   EXPORT colours ;
+
+   TYPE
+      colours = (red, blue, yellow, white) ;
+   END inner ;
+
+VAR
+   g: colours
+BEGIN
+   make(g)
+END colour.
+@end example
+
+@node Run time, Scope rules, Passes, Internals
+@section Run time
+
+This section describes how the GNU Modula-2 compiler interfaces with
+the run time system.  The modules which must be common to all library
+collections are @code{M2RTS} and @code{SYSTEM}. In the PIM library
+collection an implementation of @code{M2RTS} and @code{SYSTEM} exist;
+likewise in the ISO library and ULM library collection these modules
+also exist.
+
+The @code{M2RTS} module contains many of the base runtime features
+required by the GNU Modula-2 compiler. For example @code{M2RTS}
+contains the all the low level exception handling routines.  These
+include exception handlers for run time range checks for: assignments,
+increments, decrements, static array access, dynamic array access, for
+loop begin, for loop to, for loop increment, pointer via nil, function
+without return, case value not specified and no exception.  The
+@code{M2RTS} module also contains the @code{HALT} and @code{LENGTH}
+procedure. The ISO @code{SYSTEM} module contains a number of
+@code{SHIFT} and @code{ROTATE} procedures which GNU Modula-2 will call
+when wishing to shift and rotate multi-word set types.
+
+@subsection Exception handling
+
+This section describes how exception handling is implemented in GNU
+Modula-2.  We begin by including a simple Modula-2 program which uses
+exception handling and provide the same program written in C++.  The
+compiler will translate the Modula-2 into the equivalent trees, just
+like the C++ frontend.  This ensures that the Modula-2 frontend will
+not do anything that the middle and backend cannot process, which
+ensures that migration through the later gcc releases will be smooth.
+
+Here is an example of Modula-2 using exception handling:
+
+@example
+MODULE except ;
+
+FROM libc IMPORT printf ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+PROCEDURE fly ;
+BEGIN
+   printf("fly main body\n") ;
+   IF 4 DIV ip^ = 4
+   THEN
+      printf("yes it worked\n")
+   ELSE
+      printf("no it failed\n")
+   END
+END fly ;
+
+PROCEDURE tryFlying ;
+BEGIN
+   printf("tryFlying main body\n");
+   fly ;
+EXCEPT
+   printf("inside tryFlying exception routine\n") ;
+   IF (ip#NIL) AND (ip^=0)
+   THEN
+      ip^ := 1 ;
+      RETRY
+   END
+END tryFlying ;
+
+PROCEDURE keepFlying ;
+BEGIN
+   printf("keepFlying main body\n") ;
+   tryFlying ;
+EXCEPT
+   printf("inside keepFlying exception routine\n") ;
+   IF ip=NIL
+   THEN
+      NEW(ip) ;
+      ip^ := 0 ;
+      RETRY
+   END
+END keepFlying ;
+
+VAR
+   ip: POINTER TO INTEGER ;
+BEGIN
+   ip := NIL ;
+   keepFlying ;
+   printf("all done\n")
+END except.
+@end example
+
+Now the same program implemented in GNU C++
+
+@example
+#include <stdio.h>
+#include <stdlib.h>
+
+// a c++ example of Modula-2 exception handling
+
+static int *ip = NULL;
+
+void fly (void)
+@{
+  printf("fly main body\n") ;
+  if (ip == NULL)
+    throw;
+  if (*ip == 0)
+    throw;
+  if (4 / (*ip) == 4)
+    printf("yes it worked\n");
+  else
+    printf("no it failed\n");
+@}
+
+/*
+ *   a C++ version of the Modula-2 example given in the ISO standard.
+ */
+
+void tryFlying (void)
+@{
+ again_tryFlying:
+  printf("tryFlying main body\n");
+  try @{
+    fly() ;
+  @}
+  catch (...) @{
+    printf("inside tryFlying exception routine\n") ;
+    if ((ip != NULL) && ((*ip) == 0)) @{
+      *ip = 1;
+      // retry
+      goto again_tryFlying;
+    @}
+    printf("did't handle exception here so we will call the next exception routine\n") ;
+    throw;  // unhandled therefore call previous exception handler
+  @}
+@}
+
+void keepFlying (void)
+@{
+ again_keepFlying:
+  printf("keepFlying main body\n") ;
+  try @{
+    tryFlying();
+  @}
+  catch (...) @{
+    printf("inside keepFlying exception routine\n");
+    if (ip == NULL) @{
+      ip = (int *)malloc(sizeof(int));
+      *ip = 0;
+      goto again_keepFlying;
+    @}
+    throw;  // unhandled therefore call previous exception handler
+  @}
+@}
+
+main ()
+@{
+  keepFlying();
+  printf("all done\n");
+@}
+@end example
+
+The equivalent program in GNU C is given below.  However the
+use of @code{setjmp} and @code{longjmp} in creating an exception
+handler mechanism is not used used by GNU C++ and GNU Java.
+The GNU exception handling ABI uses @code{TRY_CATCH_EXPR} tree
+nodes.  Thus GNU Modula-2 generates trees which model the C++
+code above, rather than the C code shown below.  The code here
+serves as a mental model (for readers who are familiar with C
+but not of C++) of what is happening in the C++ code above.
+
+@example
+#include <setjmp.h>
+#include <malloc.h>
+#include <stdio.h>
+
+typedef enum jmpstatus @{
+  jmp_normal,
+  jmp_retry,
+  jmp_exception,
+@} jmp_status;
+
+struct setjmp_stack @{
+  jmp_buf  env;
+  struct setjmp_stack *next;
+@} *head = NULL;
+
+void pushsetjmp (void)
+@{
+  struct setjmp_stack *p = (struct setjmp_stack *)
+                           malloc (sizeof (struct setjmp_stack));
+
+  p->next = head;
+  head = p;
+@}
+
+void exception (void)
+@{
+  printf("invoking exception handler\n");
+  longjmp (head->env, jmp_exception);
+@}
+
+void retry (void)
+@{
+  printf("retry\n");
+  longjmp (head->env, jmp_retry);
+@}
+
+void popsetjmp (void)
+@{
+  struct setjmp_stack *p = head;
+
+  head = head->next;
+  free (p);
+@}
+
+static int *ip = NULL;
+
+void fly (void)
+@{
+  printf("fly main body\n");
+  if (ip == NULL) @{
+    printf("ip == NULL\n");
+    exception();
+  @}
+  if ((*ip) == 0) @{
+    printf("*ip == 0\n");
+    exception();
+  @}
+  if ((4 / (*ip)) == 4)
+    printf("yes it worked\n");
+  else
+    printf("no it failed\n");
+@}
+
+void tryFlying (void)
+@{
+  void tryFlying_m2_exception () @{
+    printf("inside tryFlying exception routine\n");
+    if ((ip != NULL) && ((*ip) == 0)) @{
+      (*ip) = 1;
+      retry();
+    @}
+  @}
+
+  int t;
+
+  pushsetjmp ();
+  do @{
+    t = setjmp (head->env);
+  @} while (t == jmp_retry);
+
+  if (t == jmp_exception) @{
+    /* exception called */
+    tryFlying_m2_exception ();
+    /* exception has not been handled, invoke previous handler */
+    printf("exception not handled here\n");
+    popsetjmp();
+    exception();
+  @}
+
+  printf("tryFlying main body\n");
+  fly();
+  popsetjmp();
+@}
+
+void keepFlying (void)
+@{
+  void keepFlying_m2_exception () @{
+    printf("inside keepFlying exception routine\n");
+    if (ip == NULL) @{
+      ip = (int *)malloc (sizeof (int));
+      *ip = 0;
+      retry();
+    @}
+  @}
+  int t;
+
+  pushsetjmp ();
+  do @{
+    t = setjmp (head->env);
+  @} while (t == jmp_retry);
+
+  if (t == jmp_exception) @{
+    /* exception called */
+    keepFlying_m2_exception ();
+    /* exception has not been handled, invoke previous handler */
+    popsetjmp();
+    exception();
+  @}
+  printf("keepFlying main body\n");
+  tryFlying();
+  popsetjmp();
+@}
+
+main ()
+@{
+  keepFlying();
+  printf("all done\n");
+@}
+@end example
+
+@node Scope rules, Done list, Run time, Internals
+@section Scope rules
+
+This section describes my understanding of the Modula-2 scope rules
+with respect to enumerated types.  If they are incorrect please
+correct me by email @email{gaius@@gnu.org}. They also serve to
+document the behaviour of GNU Modula-2 in these cirumstances.
+
+In GNU Modula-2 the syntax for a type declaration is defined as:
+
+@example
+TypeDeclaration := Ident "=" Type =:
+
+Type :=  SimpleType | ArrayType
+          | RecordType
+          | SetType
+          | PointerType
+          | ProcedureType
+      =:
+
+SimpleType := Qualident | Enumeration | SubrangeType =:
+
+@end example
+
+If the @code{TypeDeclaration} rule is satisfied by
+@code{SimpleType} and @code{Qualident} ie:
+
+@example
+TYPE
+   foo = bar ;
+@end example
+
+then @code{foo} is said to be equivalent to @code{bar}. Thus
+variables, parameters and record fields declared with either type will
+be compatible with each other.
+
+If, however, the @code{TypeDeclaration} rule is satisfied by any
+alternative clause @code{ArrayType}, @code{RecordType},
+@code{SetType}, @code{PointerType}, @code{ProcedureType},
+@code{Enumeration} or @code{SubrangeType} then in these cases a new
+type is created which is distinct from all other types.  It will be
+incompatible with all other user defined types.
+
+It also has furthur consequences in that if bar was defined as an
+enumerated type and foo is imported by another module then the
+enumerated values are also visible in this module.
+
+Consider the following modules:
+
+@example
+DEFINITION MODULE impc ;
+
+TYPE
+   C = (red, blue, green) ;
+
+END impc.
+@end example
+
+@example
+DEFINITION MODULE impb ;
+
+IMPORT impc ;
+
+TYPE
+   C = impc.C ;
+
+END impb.
+@end example
+
+@example
+MODULE impa ;
+
+FROM impb IMPORT C ;
+
+VAR
+   a: C ;
+BEGIN
+   a := red
+END impa.
+@end example
+
+Here we see that the type @code{C} defined in module @code{impb} is
+equivalent to the type @code{C} in module @code{impc}. Module
+@code{impa} imports the type @code{C} from module @code{impb}
+and at that point the enumeration values @code{red, blue, green}
+(declared in module @code{impc}) are also visible.
+
+The ISO Standand (p.41) in section 6.1.8 Import Lists states:
+
+``Following the module heading, a module may have a sequence of import
+lists. An import list includes a list of the identifiers that are to
+be explicitly imported into the module. Explicit import of an
+enumeration type identifier implicitly imports the enumeration
+constant identifiers of the enumeration type.
+
+Imported identifiers are introduced into the module, thus extending
+their scope, but they have a defining occurrence that appears elsewhere.
+
+Every kind of module may include a sequence of import lists, whether it
+is a program module, a definition module, an implementation module or
+a local module. In the case of any other kind of module, the imported
+identifiers may be used in the block of the module.''
+
+These statements confirm that the previous example is legal. But it
+prompts the question, what about implicit imports othersise known
+as qualified references.
+
+In section 6.10 Implicit Import and Export of the ISO Modula-2 standard
+it says:
+
+``The set of identifiers that is imported or exported if an identifier
+is explicitly imported or exported is called the (import and export)
+closure of that identifier. Normally, the closure includes only the
+explicitly imported or exported identifier. However, in the case
+of the explicit import or export of an identifier of an enumeration
+type, the closure also includes the identifiers of the values of that
+type.
+
+Implicit export applies to the identifiers that are exported (qualified)
+from separate modules, by virtue of their being the subject of a
+definition module, as well as to export from a local module that
+uses an export list.''
+
+Clearly this means that the following is legal:
+
+@example
+MODULE impd ;
+
+IMPORT impc ;
+
+VAR
+   a: impc.C ;
+BEGIN
+   a := impc.red
+END impd.
+@end example
+
+It also means that the following code is legal:
+
+@example
+MODULE impe ;
+
+IMPORT impb ;
+
+VAR
+   a: impb.C ;
+BEGIN
+   a := impb.red
+END impe.
+@end example
+
+And also this code is legal:
+
+@example
+MODULE impf ;
+
+FROM impb IMPORT C ;
+
+VAR
+   a: C ;
+BEGIN
+   a := red
+END impf.
+@end example
+
+And also that this code is legal:
+
+@example
+DEFINITION MODULE impg ;
+
+IMPORT impc;
+
+TYPE
+   C = impc.C ;
+
+END impg.
+@end example
+
+@example
+IMPLEMENTATION MODULE impg ;
+
+VAR
+   t: C ;
+BEGIN
+   t := red
+END impg.
+@end example
+
+Furthermore the following code is also legal as the new type, @code{C}
+is declared and exported. Once exported all its enumerated fields
+are also exported.
+
+@example
+DEFINITION MODULE imph;
+
+IMPORT impc;
+TYPE
+   C = impc.C;
+
+END imph.
+@end example
+
+Here we see that the current scope is populated with the enumeration
+fields @code{red, blue, green} and also it is possible to reference
+these values via a qualified identifier.
+
+@example
+IMPLEMENTATION MODULE imph;
+
+IMPORT impc;
+
+VAR
+   a: C ;
+   b: impc.C ;
+BEGIN
+   a := impc.red ;
+   b := red ;
+   a := b ;
+   b := a
+END imph.
+@end example
+
+
+@node Done list, To do list, Scope rules, Internals
+@section Done list
+
+What has been done:
+
+@itemize @bullet
+
+@item
+Coroutines have been implemented. The @code{SYSTEM} module in
+PIM-[234] now includes @code{TRANSFER}, @code{IOTRANSFER} and
+@code{NEWPROCESS}. This module is available in the directory
+@file{gm2/gm2-libs-coroutines}.  Users of this module also have to
+link with GNU Pthreads @code{-lpth}.
+
+@item
+GM2 now works on the @code{opteron} 64 bit architecture. @code{make
+gm2.paranoid} and @code{make check-gm2} pass.
+
+@item
+GM2 can now be built as a cross compiler to the MinGW platform under
+GNU/Linux i386.
+
+@item
+GM2 now works on the @code{sparc} architecture. @code{make
+gm2.paranoid} and @code{make check-gm2} pass.
+
+@item
+converted the regression test suite into the GNU dejagnu format.
+In turn this can be grafted onto the GCC testsuite and can be
+invoked as @code{make check-gm2}. GM2 should now pass all
+regression tests.
+
+@item
+provided access to a few compiler built-in constants
+and twenty seven built-in C functions.
+
+@item
+definition modules no longer have to @code{EXPORT QUALIFIED}
+objects (as per PIM-3, PIM-4 and ISO).
+
+@item
+implemented ISO Modula-2 sets. Large sets are now allowed,
+no limits imposed. The comparison operators
+@code{# = <= >= < >} all behave as per ISO standard.
+The obvious use for large sets is
+@code{SET OF CHAR}. These work well with gdb once it has been
+patched to understand Modula-2 sets.
+
+@item
+added @code{DEFINITION MODULE FOR "C"} method of linking
+to C. Also added varargs handling in C definition modules.
+
+@item
+cpp can be run on definition and implementation modules.
+
+@item
+@samp{-fmakell} generates a temporary @code{Makefile} and
+will build all dependant modules.
+
+@item
+compiler will bootstrap itself and three generations of the
+compiler all produce the same code.
+
+@item
+the back end will generate code and assembly declarations for
+modules containing global variables of all types. Procedure
+prologue/epilogue is created.
+
+@item
+all loop constructs, if then else, case statements and expressions.
+
+@item
+nested module initialization.
+
+@item
+pointers, arrays, procedure calls, nested procedures.
+
+@item
+front end @samp{gm2} can now compile and link modules.
+
+@item
+the ability to insert gnu asm statements within GNU Modula-2.
+
+@item
+inbuilt functions, @code{SIZE}, @code{ADR}, @code{TSIZE}, @code{HIGH} etc
+
+@item
+block becomes and complex procedure parameters (unbounded arrays, strings).
+
+@item
+the front end now utilizes GCC tree constants and types and is no
+longer tied to a 32 bit architecture, but reflects the 'configure'
+target machine description.
+
+@item
+fixed all C compiler warnings when gcc compiles the p2c generated C
+with -Wall.
+
+@item
+built a new parser which implements error recovery.
+
+@item
+added mechanism to invoke cpp to support conditional compilation if required.
+
+@item
+all @samp{Makefile}s are generated via @samp{./configure}
+
+@end itemize
+
+@node To do list, , Done list, Internals
+@section To do list
+
+What needs to be done:
+
+@itemize @bullet
+
+@item
+ISO library implementation needs to be completed and debugged.
+
+@item
+Easy access to other libraries using @code{-flibs=} so that libraries
+can be added into the @file{/usr/.../gcc-lib/gm2/...} structure.
+
+@item
+improve documentation, specifically this document which should
+also include a synopsis of 2nd Edition Modula-2.
+
+@item
+modifying @file{SymbolTable.mod} to make all the data structures dynamic.
+
+@item
+testing and fixing bugs
+
+@end itemize
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
new file mode 100644
index 00000000000..5814ebf4db6
--- /dev/null
+++ b/gcc/m2/gm2-lang.cc
@@ -0,0 +1,892 @@
+/* gm2-lang.cc language-dependent hooks for GNU Modula-2.
+
+Copyright (C) 2002-2022 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 COPYING.  If not, write to the
+Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
+
+#include "gm2-gcc/gcc-consolidation.h"
+
+#include "langhooks-def.h" /* FIXME: for lhd_set_decl_assembler_name.  */
+#include "tree-pass.h"     /* FIXME: only for PROP_gimple_any.  */
+#include "toplev.h"
+#include "debug.h"
+
+#include "opts.h"
+
+#define GM2_LANG_C
+#include "gm2-lang.h"
+#include "m2block.h"
+#include "dynamicstrings.h"
+#include "m2options.h"
+#include "m2convert.h"
+#include "m2linemap.h"
+#include "init.h"
+#include "m2-tree.h"
+#include "convert.h"
+#include "rtegraph.h"
+
+static void write_globals (void);
+
+static int insideCppArgs = FALSE;
+
+#define EXPR_STMT_EXPR(NODE) TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0)
+
+/* start of new stuff.  */
+
+/* Language-dependent contents of a type.  */
+
+struct GTY (()) lang_type
+{
+  char dummy;
+};
+
+/* Language-dependent contents of a decl.  */
+
+struct GTY (()) lang_decl
+{
+  char dummy;
+};
+
+/* Language-dependent contents of an identifier.  This must include a
+   tree_identifier.  */
+
+struct GTY (()) lang_identifier
+{
+  struct tree_identifier common;
+};
+
+/* The resulting tree type.  */
+
+union GTY ((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
+            chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), "
+                        "TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN "
+                        "(&%h.generic)) : NULL"))) lang_tree_node
+{
+  union tree_node GTY ((tag ("0"),
+                        desc ("tree_node_structure (&%h)"))) generic;
+  struct lang_identifier GTY ((tag ("1"))) identifier;
+};
+
+struct GTY (()) language_function
+{
+
+  /* While we are parsing the function, this contains information about
+  the statement-tree that we are building.  */
+  /* struct stmt_tree_s stmt_tree;  */
+  tree stmt_tree;
+};
+
+/* Language hooks.  */
+
+bool
+gm2_langhook_init (void)
+{
+  build_common_tree_nodes (false);
+  build_common_builtin_nodes ();
+
+  /* The default precision for floating point numbers.  This is used
+     for floating point constants with abstract type.  This may eventually
+     be controllable by a command line option.  */
+  mpfr_set_default_prec (256);
+
+  /* GNU Modula-2 uses exceptions.  */
+  using_eh_for_cleanups ();
+  return true;
+}
+
+/* The option mask.  */
+
+static unsigned int
+gm2_langhook_option_lang_mask (void)
+{
+  return CL_ModulaX2;
+}
+
+/* Initialize the options structure.  */
+
+static void
+gm2_langhook_init_options_struct (struct gcc_options *opts)
+{
+  /* Default to avoiding range issues for complex multiply and divide.  */
+  opts->x_flag_complex_method = 2;
+
+  /* The builtin math functions should not set errno.  */
+  opts->x_flag_errno_math = 0;
+  opts->frontend_set_flag_errno_math = true;
+
+  /* Exceptions are used.  */
+  opts->x_flag_exceptions = 1;
+  init_FrontEndInit ();
+}
+
+/* Infrastructure for a VEC of bool values.  */
+
+/* This array determines whether the filename is associated with the
+   C preprocessor.  */
+
+static vec<bool> filename_cpp;
+
+void
+gm2_langhook_init_options (unsigned int decoded_options_count,
+                           struct cl_decoded_option *decoded_options)
+{
+  unsigned int i;
+  bool in_cpp_args = false;
+
+  for (i = 1; i < decoded_options_count; i++)
+    {
+      switch (decoded_options[i].opt_index)
+        {
+        case OPT_fcpp_begin:
+          in_cpp_args = true;
+          break;
+        case OPT_fcpp_end:
+          in_cpp_args = false;
+          break;
+        case OPT_SPECIAL_input_file:
+        case OPT_SPECIAL_program_name:
+          filename_cpp.safe_push (in_cpp_args);
+        }
+    }
+  filename_cpp.safe_push (false);
+}
+
+static bool
+is_cpp_filename (unsigned int i)
+{
+  gcc_assert (i < filename_cpp.length ());
+  return filename_cpp[i];
+}
+
+/* Handle gm2 specific options.  Return 0 if we didn't do anything.  */
+
+bool
+gm2_langhook_handle_option (
+    size_t scode, const char *arg, HOST_WIDE_INT value, int kind ATTRIBUTE_UNUSED,
+    location_t loc ATTRIBUTE_UNUSED,
+    const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
+{
+  enum opt_code code = (enum opt_code)scode;
+
+  /* ignore file names.  */
+  if (code == N_OPTS)
+    return 1;
+
+  switch (code)
+    {
+    case OPT_B:
+      M2Options_SetB (arg);
+      return 1;
+    case OPT_c:
+      M2Options_Setc (value);
+      return 1;
+    case OPT_I:
+      if (insideCppArgs)
+        {
+          const struct cl_option *option = &cl_options[scode];
+          const char *opt = (const char *)option->opt_text;
+          M2Options_CppArg (opt, arg, TRUE);
+        }
+      else
+        M2Options_SetSearchPath (arg);
+      return 1;
+    case OPT_fiso:
+      M2Options_SetISO (value);
+      return 1;
+    case OPT_fpim:
+      M2Options_SetPIM (value);
+      return 1;
+    case OPT_fpim2:
+      M2Options_SetPIM2 (value);
+      return 1;
+    case OPT_fpim3:
+      M2Options_SetPIM3 (value);
+      return 1;
+    case OPT_fpim4:
+      M2Options_SetPIM4 (value);
+      return 1;
+    case OPT_fpositive_mod_floor_div:
+      M2Options_SetPositiveModFloor (value);
+      return 1;
+    case OPT_flibs_:
+      /* handled in the gm2 driver.  */
+      return 1;
+    case OPT_fgen_module_list_:
+      M2Options_SetGenModuleList (value, arg);
+      return 1;
+    case OPT_fnil:
+      M2Options_SetNilCheck (value);
+      return 1;
+    case OPT_fwholediv:
+      M2Options_SetWholeDiv (value);
+      return 1;
+    case OPT_findex:
+      M2Options_SetIndex (value);
+      return 1;
+    case OPT_frange:
+      M2Options_SetRange (value);
+      return 1;
+    case OPT_ffloatvalue:
+      M2Options_SetFloatValueCheck (value);
+      return 1;
+    case OPT_fwholevalue:
+      M2Options_SetWholeValueCheck (value);
+      return 1;
+    case OPT_freturn:
+      M2Options_SetReturnCheck (value);
+      return 1;
+    case OPT_fcase:
+      M2Options_SetCaseCheck (value);
+      return 1;
+    case OPT_fd:
+      M2Options_SetCompilerDebugging (value);
+      return 1;
+    case OPT_fdebug_trace_quad:
+      M2Options_SetDebugTraceQuad (value);
+      return 1;
+    case OPT_fdebug_trace_api:
+      M2Options_SetDebugTraceAPI (value);
+      return 1;
+    case OPT_fdebug_function_line_numbers:
+      M2Options_SetDebugFunctionLineNumbers (value);
+      return 1;
+    case OPT_fauto_init:
+      M2Options_SetAutoInit (value);
+      return 1;
+    case OPT_fsoft_check_all:
+      M2Options_SetCheckAll (value);
+      return 1;
+    case OPT_fexceptions:
+      M2Options_SetExceptions (value);
+      return 1;
+    case OPT_Wstyle:
+      M2Options_SetStyle (value);
+      return 1;
+    case OPT_Wpedantic:
+      M2Options_SetPedantic (value);
+      return 1;
+    case OPT_Wpedantic_param_names:
+      M2Options_SetPedanticParamNames (value);
+      return 1;
+    case OPT_Wpedantic_cast:
+      M2Options_SetPedanticCast (value);
+      return 1;
+    case OPT_fextended_opaque:
+      M2Options_SetExtendedOpaque (value);
+      return 1;
+    case OPT_Wverbose_unbounded:
+      M2Options_SetVerboseUnbounded (value);
+      return 1;
+    case OPT_Wunused_variable:
+      M2Options_SetUnusedVariableChecking (value);
+      return 1;
+    case OPT_Wunused_parameter:
+      M2Options_SetUnusedParameterChecking (value);
+      return 1;
+    case OPT_fm2_strict_type:
+      M2Options_SetStrictTypeChecking (value);
+      return 1;
+    case OPT_Wall:
+      M2Options_SetWall (value);
+      return 1;
+#if 0
+    /* Not yet implemented.  */
+    case OPT_fxcode:
+      M2Options_SetXCode (value);
+      return 1;
+#endif
+    case OPT_fm2_lower_case:
+      M2Options_SetLowerCaseKeywords (value);
+      return 1;
+    case OPT_fuse_list_:
+      M2Options_SetUselist (value, arg);
+      return 1;
+    case OPT_fruntime_modules_:
+      M2Options_SetRuntimeModuleOverride (arg);
+      return 1;
+    case OPT_fpthread:
+      /* Handled in the driver.  */
+      return 1;
+    case OPT_fm2_plugin:
+      /* Handled in the driver.  */
+      return 1;
+    case OPT_fscaffold_dynamic:
+      M2Options_SetScaffoldDynamic (value);
+      return 1;
+    case OPT_fscaffold_static:
+      M2Options_SetScaffoldStatic (value);
+      return 1;
+    case OPT_fscaffold_main:
+      M2Options_SetScaffoldMain (value);
+      return 1;
+    case OPT_fcpp:
+      M2Options_SetCpp (value);
+      return 1;
+    case OPT_fcpp_begin:
+      insideCppArgs = TRUE;
+      return 1;
+    case OPT_fcpp_end:
+      insideCppArgs = FALSE;
+      return 1;
+    case OPT_fq:
+      M2Options_SetQuadDebugging (value);
+      return 1;
+    case OPT_fsources:
+      M2Options_SetSources (value);
+      return 1;
+    case OPT_funbounded_by_reference:
+      M2Options_SetUnboundedByReference (value);
+      return 1;
+    case OPT_fdef_:
+      M2Options_setdefextension (arg);
+      return 1;
+    case OPT_fmod_:
+      M2Options_setmodextension (arg);
+      return 1;
+    case OPT_fdump_system_exports:
+      M2Options_SetDumpSystemExports (value);
+      return 1;
+    case OPT_fswig:
+      M2Options_SetSwig (value);
+      return 1;
+    case OPT_fshared:
+      M2Options_SetShared (value);
+      return 1;
+    case OPT_fm2_statistics:
+      M2Options_SetStatistics (value);
+      return 1;
+    case OPT_fm2_g:
+      M2Options_SetM2g (value);
+      return 1;
+    case OPT_O:
+      M2Options_SetOptimizing (value);
+      return 1;
+    case OPT_quiet:
+      M2Options_SetQuiet (value);
+      return 1;
+    case OPT_fm2_whole_program:
+      M2Options_SetWholeProgram (value);
+      return 1;
+    case OPT_flocation_:
+      if (strcmp (arg, "builtins") == 0)
+        {
+          M2Options_SetForcedLocation (BUILTINS_LOCATION);
+          return 1;
+        }
+      else if (strcmp (arg, "unknown") == 0)
+        {
+          M2Options_SetForcedLocation (UNKNOWN_LOCATION);
+          return 1;
+        }
+      else if ((arg != NULL) && (ISDIGIT (arg[0])))
+        {
+          M2Options_SetForcedLocation (atoi (arg));
+          return 1;
+        }
+      else
+        return 0;
+    case OPT_save_temps:
+      M2Options_SetSaveTemps (value);
+      return 1;
+    case OPT_save_temps_:
+      M2Options_SetSaveTempsDir (arg);
+      return 1;
+    default:
+      if (insideCppArgs)
+        {
+          const struct cl_option *option = &cl_options[scode];
+          const char *opt = (const char *)option->opt_text;
+
+          M2Options_CppArg (opt, arg, TRUE);
+          return 1;
+        }
+      return 0;
+    }
+  return 0;
+}
+
+/* Run after parsing options.  */
+
+static bool
+gm2_langhook_post_options (const char **pfilename)
+{
+  const char *filename = *pfilename;
+  flag_excess_precision = EXCESS_PRECISION_FAST;
+  M2Options_SetCC1Quiet (quiet_flag);
+  M2Options_FinaliseOptions ();
+  main_input_filename = filename;
+
+  /* Returning false means that the backend should be used.  */
+  return false;
+}
+
+/* Call the compiler for every source filename on the command line.  */
+
+static void
+gm2_parse_input_files (const char **filenames, unsigned int filename_count)
+{
+  unsigned int i;
+  gcc_assert (filename_count > 0);
+
+  for (i = 0; i < filename_count; i++)
+    if (!is_cpp_filename (i))
+      {
+	main_input_filename = filenames[i];
+	init_PerCompilationInit (filenames[i]);
+      }
+}
+
+static void
+gm2_langhook_parse_file (void)
+{
+  gm2_parse_input_files (in_fnames, num_in_fnames);
+  write_globals ();
+}
+
+static tree
+gm2_langhook_type_for_size (unsigned int bits, int unsignedp)
+{
+  return gm2_type_for_size (bits, unsignedp);
+}
+
+static tree
+gm2_langhook_type_for_mode (machine_mode mode, int unsignedp)
+{
+  tree type;
+
+  for (int i = 0; i < NUM_INT_N_ENTS; i ++)
+    if (int_n_enabled_p[i]
+	&& mode == int_n_data[i].m)
+      return (unsignedp ? int_n_trees[i].unsigned_type
+	      : int_n_trees[i].signed_type);
+
+  if (VECTOR_MODE_P (mode))
+    {
+      tree inner;
+
+      inner = gm2_langhook_type_for_mode (GET_MODE_INNER (mode), unsignedp);
+      if (inner != NULL_TREE)
+        return build_vector_type_for_mode (inner, mode);
+      return NULL_TREE;
+    }
+
+  scalar_int_mode imode;
+  if (is_int_mode (mode, &imode))
+    return gm2_langhook_type_for_size (GET_MODE_BITSIZE (imode), unsignedp);
+
+  if (mode == TYPE_MODE (float_type_node))
+    return float_type_node;
+
+  if (mode == TYPE_MODE (double_type_node))
+    return double_type_node;
+
+  if (mode == TYPE_MODE (long_double_type_node))
+    return long_double_type_node;
+
+  if (COMPLEX_MODE_P (mode))
+    {
+      if (mode == TYPE_MODE (complex_float_type_node))
+	return complex_float_type_node;
+      if (mode == TYPE_MODE (complex_double_type_node))
+	return complex_double_type_node;
+      if (mode == TYPE_MODE (complex_long_double_type_node))
+	return complex_long_double_type_node;
+    }
+
+#if HOST_BITS_PER_WIDE_INT >= 64
+  /* The middle-end and some backends rely on TImode being supported
+  for 64-bit HWI.  */
+  if (mode == TImode)
+    {
+      type = build_nonstandard_integer_type (GET_MODE_BITSIZE (TImode),
+                                             unsignedp);
+      if (type && TYPE_MODE (type) == TImode)
+        return type;
+    }
+#endif
+  return NULL_TREE;
+}
+
+/* Record a builtin function.  We just ignore builtin functions.  */
+
+static tree
+gm2_langhook_builtin_function (tree decl)
+{
+  return decl;
+}
+
+/* Return true if we are in the global binding level.  */
+
+static bool
+gm2_langhook_global_bindings_p (void)
+{
+  return current_function_decl == NULL_TREE;
+}
+
+/* Unused langhook.  */
+
+static tree
+gm2_langhook_pushdecl (tree decl ATTRIBUTE_UNUSED)
+{
+  gcc_unreachable ();
+}
+
+/* This hook is used to get the current list of declarations as trees.
+   We don't support that; instead we use write_globals.  This can't
+   simply crash because it is called by -gstabs.  */
+
+static tree
+gm2_langhook_getdecls (void)
+{
+  return NULL;
+}
+
+/* m2_write_global_declarations writes out globals creating an array
+   of the declarations and calling wrapup_global_declarations.  */
+
+static void
+m2_write_global_declarations (tree globals)
+{
+  auto_vec<tree> global_decls;
+  tree decl = globals;
+  int n = 0;
+
+  while (decl != NULL)
+    {
+      global_decls.safe_push (decl);
+      decl = TREE_CHAIN (decl);
+      n++;
+    }
+  wrapup_global_declarations (global_decls.address (), n);
+}
+
+/* Write out globals.  */
+
+static void
+write_globals (void)
+{
+  tree t;
+  unsigned i;
+
+  m2block_finishGlobals ();
+
+  /* Process all file scopes in this compilation, and the
+     external_scope, through wrapup_global_declarations and
+     check_global_declarations.  */
+  FOR_EACH_VEC_ELT (*all_translation_units, i, t)
+  m2_write_global_declarations (BLOCK_VARS (DECL_INITIAL (t)));
+}
+
+
+/* Gimplify an EXPR_STMT node.  */
+
+static void
+gimplify_expr_stmt (tree *stmt_p)
+{
+  gcc_assert (EXPR_STMT_EXPR (*stmt_p) != NULL_TREE);
+  *stmt_p = EXPR_STMT_EXPR (*stmt_p);
+}
+
+/* Genericize a TRY_BLOCK.  */
+
+static void
+genericize_try_block (tree *stmt_p)
+{
+  tree body = TRY_STMTS (*stmt_p);
+  tree cleanup = TRY_HANDLERS (*stmt_p);
+
+  *stmt_p = build2 (TRY_CATCH_EXPR, void_type_node, body, cleanup);
+}
+
+/* Genericize a HANDLER by converting to a CATCH_EXPR.  */
+
+static void
+genericize_catch_block (tree *stmt_p)
+{
+  tree type = HANDLER_TYPE (*stmt_p);
+  tree body = HANDLER_BODY (*stmt_p);
+
+  /* FIXME should the caught type go in TREE_TYPE?  */
+  *stmt_p = build2 (CATCH_EXPR, void_type_node, type, body);
+}
+
+/* Convert the tree representation of FNDECL from m2 frontend trees
+   to GENERIC.  */
+
+extern void pf (tree);
+
+void
+gm2_genericize (tree fndecl)
+{
+  tree t;
+  struct cgraph_node *cgn;
+
+#if 0
+  pf (fndecl);
+#endif
+  /* Fix up the types of parms passed by invisible reference.  */
+  for (t = DECL_ARGUMENTS (fndecl); t; t = DECL_CHAIN (t))
+    if (TREE_ADDRESSABLE (TREE_TYPE (t)))
+      {
+
+        /* If a function's arguments are copied to create a thunk, then
+	   DECL_BY_REFERENCE will be set -- but the type of the argument will be
+	   a pointer type, so we will never get here.  */
+        gcc_assert (!DECL_BY_REFERENCE (t));
+        gcc_assert (DECL_ARG_TYPE (t) != TREE_TYPE (t));
+        TREE_TYPE (t) = DECL_ARG_TYPE (t);
+        DECL_BY_REFERENCE (t) = 1;
+        TREE_ADDRESSABLE (t) = 0;
+        relayout_decl (t);
+      }
+
+  /* Dump all nested functions now.  */
+  cgn = cgraph_node::get_create (fndecl);
+  for (cgn = first_nested_function (cgn);
+       cgn != NULL; cgn = next_nested_function (cgn))
+    gm2_genericize (cgn->decl);
+}
+
+/* gm2 gimplify expression, currently just change THROW in the same
+   way as C++ */
+
+static int
+gm2_langhook_gimplify_expr (tree *expr_p, gimple_seq *pre_p ATTRIBUTE_UNUSED,
+                            gimple_seq *post_p ATTRIBUTE_UNUSED)
+{
+  enum tree_code code = TREE_CODE (*expr_p);
+
+  switch (code)
+    {
+    case THROW_EXPR:
+
+      /* FIXME communicate throw type to back end, probably by moving
+      THROW_EXPR into ../tree.def.  */
+      *expr_p = TREE_OPERAND (*expr_p, 0);
+      return GS_OK;
+
+    case EXPR_STMT:
+      gimplify_expr_stmt (expr_p);
+      return GS_OK;
+
+    case TRY_BLOCK:
+      genericize_try_block (expr_p);
+      return GS_OK;
+
+    case HANDLER:
+      genericize_catch_block (expr_p);
+      return GS_OK;
+
+    default:
+      return GS_UNHANDLED;
+    }
+}
+
+static GTY(()) tree gm2_eh_personality_decl;
+
+static tree
+gm2_langhook_eh_personality (void)
+{
+  if (!gm2_eh_personality_decl)
+    gm2_eh_personality_decl = build_personality_function ("gxx");
+
+  return gm2_eh_personality_decl;
+}
+
+/* Functions called directly by the generic backend.  */
+
+tree
+convert_loc (location_t location, tree type, tree expr)
+{
+  if (type == error_mark_node || expr == error_mark_node
+      || TREE_TYPE (expr) == error_mark_node)
+    return error_mark_node;
+
+  if (type == TREE_TYPE (expr))
+    return expr;
+
+  gcc_assert (TYPE_MAIN_VARIANT (type) != NULL);
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
+    return fold_convert (type, expr);
+
+  expr = m2convert_GenericToType (location, type, expr);
+  switch (TREE_CODE (type))
+    {
+    case VOID_TYPE:
+    case BOOLEAN_TYPE:
+      return fold_convert (type, expr);
+    case INTEGER_TYPE:
+      return fold (convert_to_integer (type, expr));
+    case POINTER_TYPE:
+      return fold (convert_to_pointer (type, expr));
+    case REAL_TYPE:
+      return fold (convert_to_real (type, expr));
+    case COMPLEX_TYPE:
+      return fold (convert_to_complex (type, expr));
+    case ENUMERAL_TYPE:
+      return fold (convert_to_integer (type, expr));
+    default:
+      error_at (location, "cannot convert expression, only base types can be converted");
+      break;
+    }
+  return error_mark_node;
+}
+
+/* Functions called directly by the generic backend.  */
+
+tree
+convert (tree type, tree expr)
+{
+  return convert_loc (m2linemap_UnknownLocation (), type, expr);
+}
+
+/* Mark EXP saying that we need to be able to take the address of it;
+   it should not be allocated in a register.  Returns true if
+   successful.  */
+
+bool
+gm2_mark_addressable (tree exp)
+{
+  tree x = exp;
+
+  while (TRUE)
+    switch (TREE_CODE (x))
+      {
+      case COMPONENT_REF:
+	if (DECL_PACKED (TREE_OPERAND (x, 1)))
+	  return false;
+	x = TREE_OPERAND (x, 0);
+	break;
+
+      case ADDR_EXPR:
+      case ARRAY_REF:
+      case REALPART_EXPR:
+      case IMAGPART_EXPR:
+        x = TREE_OPERAND (x, 0);
+        break;
+
+      case COMPOUND_LITERAL_EXPR:
+      case CONSTRUCTOR:
+      case STRING_CST:
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+      case FUNCTION_DECL:
+        TREE_ADDRESSABLE (x) = 1;
+        return true;
+      default:
+        return true;
+      }
+  /* Never reach here.  */
+  gcc_unreachable ();
+}
+
+/* Return an integer type with BITS bits of precision, that is
+   unsigned if UNSIGNEDP is nonzero, otherwise signed.  */
+
+tree
+gm2_type_for_size (unsigned int bits, int unsignedp)
+{
+  tree type;
+
+  if (unsignedp)
+    {
+      if (bits == INT_TYPE_SIZE)
+        type = unsigned_type_node;
+      else if (bits == CHAR_TYPE_SIZE)
+        type = unsigned_char_type_node;
+      else if (bits == SHORT_TYPE_SIZE)
+        type = short_unsigned_type_node;
+      else if (bits == LONG_TYPE_SIZE)
+        type = long_unsigned_type_node;
+      else if (bits == LONG_LONG_TYPE_SIZE)
+        type = long_long_unsigned_type_node;
+      else
+	type = build_nonstandard_integer_type (bits,
+					       unsignedp);
+    }
+  else
+    {
+      if (bits == INT_TYPE_SIZE)
+        type = integer_type_node;
+      else if (bits == CHAR_TYPE_SIZE)
+        type = signed_char_type_node;
+      else if (bits == SHORT_TYPE_SIZE)
+        type = short_integer_type_node;
+      else if (bits == LONG_TYPE_SIZE)
+        type = long_integer_type_node;
+      else if (bits == LONG_LONG_TYPE_SIZE)
+        type = long_long_integer_type_node;
+      else
+	type = build_nonstandard_integer_type (bits,
+					       unsignedp);
+    }
+  return type;
+}
+
+/* Allow the analyzer to understand Storage ALLOCATE/DEALLOCATE.  */
+
+bool
+gm2_langhook_new_dispose_storage_substitution (void)
+{
+  return true;
+}
+
+#undef LANG_HOOKS_NAME
+#undef LANG_HOOKS_INIT
+#undef LANG_HOOKS_INIT_OPTIONS
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#undef LANG_HOOKS_INIT_OPTIONS_STRUCT
+#undef LANG_HOOKS_HANDLE_OPTION
+#undef LANG_HOOKS_POST_OPTIONS
+#undef LANG_HOOKS_PARSE_FILE
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#undef LANG_HOOKS_BUILTIN_FUNCTION
+#undef LANG_HOOKS_GLOBAL_BINDINGS_P
+#undef LANG_HOOKS_PUSHDECL
+#undef LANG_HOOKS_GETDECLS
+#undef LANG_HOOKS_GIMPLIFY_EXPR
+#undef LANG_HOOKS_EH_PERSONALITY
+#undef LANG_HOOKS_NEW_DISPOSE_STORAGE_SUBSTITUTION
+
+#define LANG_HOOKS_NAME "GNU Modula-2"
+#define LANG_HOOKS_INIT gm2_langhook_init
+#define LANG_HOOKS_INIT_OPTIONS gm2_langhook_init_options
+#define LANG_HOOKS_OPTION_LANG_MASK gm2_langhook_option_lang_mask
+#define LANG_HOOKS_INIT_OPTIONS_STRUCT gm2_langhook_init_options_struct
+#define LANG_HOOKS_HANDLE_OPTION gm2_langhook_handle_option
+#define LANG_HOOKS_POST_OPTIONS gm2_langhook_post_options
+#define LANG_HOOKS_PARSE_FILE gm2_langhook_parse_file
+#define LANG_HOOKS_TYPE_FOR_MODE gm2_langhook_type_for_mode
+#define LANG_HOOKS_TYPE_FOR_SIZE gm2_langhook_type_for_size
+#define LANG_HOOKS_BUILTIN_FUNCTION gm2_langhook_builtin_function
+#define LANG_HOOKS_GLOBAL_BINDINGS_P gm2_langhook_global_bindings_p
+#define LANG_HOOKS_PUSHDECL gm2_langhook_pushdecl
+#define LANG_HOOKS_GETDECLS gm2_langhook_getdecls
+#define LANG_HOOKS_GIMPLIFY_EXPR gm2_langhook_gimplify_expr
+#define LANG_HOOKS_EH_PERSONALITY gm2_langhook_eh_personality
+#define LANG_HOOKS_NEW_DISPOSE_STORAGE_SUBSTITUTION \
+  gm2_langhook_new_dispose_storage_substitution
+
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+#include "gt-m2-gm2-lang.h"
+#include "gtype-m2.h"
diff --git a/gcc/m2/gm2-lang.h b/gcc/m2/gm2-lang.h
new file mode 100644
index 00000000000..431e0156d42
--- /dev/null
+++ b/gcc/m2/gm2-lang.h
@@ -0,0 +1,56 @@
+/* Language-dependent hooks for GNU Modula-2.
+   Copyright (C) 2003-2022 Free Software Foundation, Inc.
+   Contributed by Gaius Mulley <gaius@glam.ac.uk>
+
+This file is part of GNU CC.
+
+GNU CC 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 CC 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 CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#if !defined(GM2_LANG_H)
+#  define GM2_LANG_H
+
+#if defined(GM2_LANG_C)
+#  define EXTERN
+#else
+#  define EXTERN extern
+#endif
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+#include "coretypes.h"
+#include "opts.h"
+#include "tree.h"
+#include "gimple.h"
+
+
+EXTERN enum gimplify_status  gm2_gimplify_expr (tree *, tree *, tree *);
+EXTERN bool gm2_mark_addressable (tree);
+EXTERN tree gm2_type_for_size             (unsigned int bits, int unsignedp);
+EXTERN tree gm2_type_for_mode             (enum machine_mode mode, int unsignedp);
+EXTERN bool gm2_langhook_init (void);
+EXTERN bool gm2_langhook_handle_option (size_t scode, const char *arg,
+					int value,
+					int kind ATTRIBUTE_UNUSED,
+					location_t loc ATTRIBUTE_UNUSED,
+					const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED);
+EXTERN void gm2_langhook_init_options (unsigned int decoded_options_count,
+					   struct cl_decoded_option *decoded_options);
+EXTERN void gm2_genericize (tree fndecl);
+EXTERN tree convert_loc (location_t location, tree type, tree expr);
+
+
+#undef EXTERN
+#endif
diff --git a/gcc/m2/gm2-libiberty/README b/gcc/m2/gm2-libiberty/README
new file mode 100644
index 00000000000..3bc0796b278
--- /dev/null
+++ b/gcc/m2/gm2-libiberty/README
@@ -0,0 +1,2 @@
+This directory contains a minimal number of DEFINITION MODULEs
+to allow the cc1gm2 and tools to access some of the gcc modules.
diff --git a/gcc/m2/gm2-libiberty/choosetemp.def b/gcc/m2/gm2-libiberty/choosetemp.def
new file mode 100644
index 00000000000..6238f685c12
--- /dev/null
+++ b/gcc/m2/gm2-libiberty/choosetemp.def
@@ -0,0 +1,34 @@
+(* choosetemp.def provides a definition module for choose-temp.c in libiberty.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE choosetemp ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED make_temp_file ;
+
+
+(* Return a temporary file name (as a string) or NIL if unable to create
+   one.  *)
+
+PROCEDURE make_temp_file (suffix: ADDRESS) : ADDRESS ;
+
+
+END choosetemp.
diff --git a/gcc/m2/gm2-libiberty/pexecute.def b/gcc/m2/gm2-libiberty/pexecute.def
new file mode 100644
index 00000000000..59426e82152
--- /dev/null
+++ b/gcc/m2/gm2-libiberty/pexecute.def
@@ -0,0 +1,82 @@
+(* pexecute.def provides an interface to libiberty pexecute.c
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" pexecute ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT UNQUALIFIED pexecute ;
+
+(*
+   PROGRAM and ARGV are the arguments to execv/execvp.
+
+   THIS_PNAME is name of the calling program (i.e. argv[0]).
+
+   TEMP_BASE is the path name, sans suffix, of a temporary file to use
+   if needed.  This is currently only needed for MSDOS ports that don't use
+   GO32 (do any still exist?).  Ports that don't need it can pass NULL.
+
+   (FLAGS & PEXECUTE_SEARCH) is non-zero if $PATH should be searched
+   (??? It's not clear that GCC passes this flag correctly).
+   (FLAGS & PEXECUTE_FIRST) is nonzero for the first process in chain.
+   (FLAGS & PEXECUTE_FIRST) is nonzero for the last process in chain.
+   FIRST_LAST could be simplified to only mark the last of a chain of processes
+   but that requires the caller to always mark the last one (and not give up
+   early if some error occurs).  It's more robust to require the caller to
+   mark both ends of the chain.
+
+   The result is the pid on systems like Unix where we fork/exec and on systems
+   like WIN32 and OS2 where we use spawn.  It is up to the caller to wait for
+   the child.
+
+   The result is the WEXITSTATUS on systems like MSDOS where we spawn and wait
+   for the child here.
+
+   Upon failure, ERRMSG_FMT and ERRMSG_ARG are set to the text of the error
+   message with an optional argument (if not needed, ERRMSG_ARG is set to
+   NULL), and -1 is returned.  `errno' is available to the caller to use.
+
+   pwait: cover function for wait.
+
+   PID is the process id of the task to wait for.
+   STATUS is the `status' argument to wait.
+   FLAGS is currently unused (allows future enhancement without breaking
+   upward compatibility).  Pass 0 for now.
+
+   The result is the pid of the child reaped,
+   or -1 for failure (errno says why).
+
+   On systems that don't support waiting for a particular child, PID is
+   ignored.  On systems like MSDOS that don't really multitask pwait
+   is just a mechanism to provide a consistent interface for the caller.
+
+   pfinish: finish generation of script
+
+   pfinish is necessary for systems like MPW where a script is generated that
+   runs the requested programs.
+*)
+
+PROCEDURE pexecute (program: ADDRESS; argv: ADDRESS; this_pname: ADDRESS;
+                    temp_base: ADDRESS;
+                    VAR errmsg_fmt, errmsg_arg: ADDRESS; flags: CARDINAL) : INTEGER ;
+
+
+END pexecute.
diff --git a/gcc/m2/gm2-libs-ch/M2LINK.c b/gcc/m2/gm2-libs-ch/M2LINK.c
new file mode 100644
index 00000000000..70b4c3d889a
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/M2LINK.c
@@ -0,0 +1,44 @@
+/* M2LINK.c provide a bootstrap minimal definitions.
+
+Copyright (C) 2022 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"
+#include "ansidecl.h"
+#include "math.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+  /* These definitions are only used during bootstrap to disable the dynamic
+     initialization features of M2RTS.  */
+
+  char *M2LINK_ForcedModuleInitOrder = NULL;
+  int M2LINK_StaticInitialization = 1;
+
+}
diff --git a/gcc/m2/gm2-libs-ch/README b/gcc/m2/gm2-libs-ch/README
new file mode 100644
index 00000000000..a783aa7eb6c
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/README
@@ -0,0 +1,3 @@
+This directory contains a small number of C files which provide an
+interface between the host operating system and the Modula-2 library
+source found in gm2-libs and gm2-libs-iso.
\ No newline at end of file
diff --git a/gcc/m2/gm2-libs-ch/RTcodummy.c b/gcc/m2/gm2-libs-ch/RTcodummy.c
new file mode 100644
index 00000000000..d397a27db11
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/RTcodummy.c
@@ -0,0 +1,136 @@
+/* RTcodummy.c provides dummy access to thread primitives.
+
+Copyright (C) 2019-2022 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/>.  */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+void
+RTco_wait (__attribute__ ((unused)) int sid)
+{
+}
+
+
+void
+RTco_signal (__attribute__ ((unused)) int sid)
+{
+}
+
+
+int
+RTco_init (void)
+{
+  return 0;
+}
+
+
+int
+RTco_initSemaphore (__attribute__ ((unused)) int value)
+{
+  return 0;
+}
+
+
+/* signalThread signal the semaphore associated with thread tid.  */
+
+void
+RTco_signalThread (__attribute__ ((unused)) int tid)
+{
+}
+
+
+/* waitThread wait on the semaphore associated with thread tid.  */
+
+void
+RTco_waitThread (__attribute__ ((unused)) int tid)
+{
+}
+
+
+int
+RTco_currentThread (void)
+{
+  return 0;
+}
+
+
+int
+RTco_initThread (__attribute__ ((unused)) void (*proc)(void),
+		 __attribute__ ((unused)) unsigned int stackSize,
+		 __attribute__ ((unused)) unsigned int interruptLevel)
+{
+  return 0;
+}
+
+
+void
+RTco_transfer (__attribute__ ((unused)) int *p1, __attribute__ ((unused)) int p2)
+{
+}
+
+
+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;
+}
+
+
+unsigned int
+RTco_currentInterruptLevel (void)
+{
+  return 0;
+}
+
+
+/* turninterrupts returns the old interrupt level and assigns the interrupt level
+   to newLevel.  */
+
+unsigned int
+RTco_turnInterrupts (unsigned int newLevel)
+{
+  return 0;
+}
+
+void
+_M2_RTco_init (void)
+{
+}
+
+void
+_M2_RTco_finish (void)
+{
+}
+
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/gm2-libs-ch/RTintdummy.c b/gcc/m2/gm2-libs-ch/RTintdummy.c
new file mode 100644
index 00000000000..6e718cb7302
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/RTintdummy.c
@@ -0,0 +1,50 @@
+/* RTintdummy.c provides dummy access to interrupt primitives.
+
+Copyright (C) 2019-2022 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/>.  */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void
+RTint_Init (void)
+{
+}
+
+#if 0
+void
+_M2_RTint_init (void)
+{
+}
+
+void
+_M2_RTint_finish (void)
+{
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/gm2-libs-ch/Selective.c b/gcc/m2/gm2-libs-ch/Selective.c
new file mode 100644
index 00000000000..6ed0009dedc
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/Selective.c
@@ -0,0 +1,246 @@
+/* Selective.c provide access to timeval and select.
+
+Copyright (C) 2005-2022 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"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if defined(HAVE_SELECT)
+# define FDSET_T fd_set
+#else
+# define FDSET_T void
+#endif
+
+
+#if defined(HAVE_SELECT)
+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
+int Selective_Select (int nooffds,
+		      void *readfds,
+		      void *writefds,
+		      void *exceptfds,
+		      void *timeout)
+{
+  return 0;
+}
+#endif
+
+/* InitTime initialises a timeval structure and returns a pointer to it.  */
+
+#if defined(HAVE_SELECT)
+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;
+}
+
+void Selective_GetTime (struct timeval *t,
+			unsigned int *sec, unsigned int *usec)
+{
+  *sec = (unsigned int) t->tv_sec;
+  *usec = (unsigned int) t->tv_usec;
+}
+
+void Selective_SetTime (struct timeval *t,
+			unsigned int sec, unsigned int usec)
+{
+  t->tv_sec = sec;
+  t->tv_usec = usec;
+}
+
+/* KillTime frees the timeval structure and returns NULL.  */
+
+struct timeval *Selective_KillTime (struct timeval *t)
+{
+  free (t);
+  return NULL;
+}
+
+/* InitSet returns a pointer to a FD_SET.  */
+
+fd_set *Selective_InitSet (void)
+{
+  fd_set *s = (fd_set *) malloc (sizeof (fd_set));
+
+  return s;
+}
+
+/* KillSet frees the FD_SET and returns NULL.  */
+
+fd_set *Selective_KillSet (fd_set *s)
+{
+  free (s);
+  return NULL;
+}
+
+/* FdZero generate an empty set.  */
+
+void Selective_FdZero (fd_set *s)
+{
+  FD_ZERO (s);
+}
+
+/* FS_Set include an element, fd, into set, s.  */
+
+void Selective_FdSet (int fd, fd_set *s)
+{
+  FD_SET (fd, s);
+}
+
+
+/* FdClr exclude an element, fd, from the set, s.  */
+
+void Selective_FdClr (int fd, fd_set *s)
+{
+  FD_CLR (fd, s);
+}
+
+
+/* FdIsSet return TRUE if, fd, is present in set, s.  */
+
+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).  */
+
+int Selective_GetTimeOfDay (struct timeval *t)
+{
+  return gettimeofday (t, NULL);
+}
+#else
+
+void *Selective_InitTime (unsigned int sec, unsigned int usec)
+{
+  return NULL;
+}
+
+void *Selective_KillTime (void *t)
+{
+  return NULL;
+}
+
+void Selective_GetTime (struct timeval *t,
+			unsigned int *sec, unsigned int *usec)
+{
+}
+
+void Selective_SetTime (struct timeval *t,
+			unsigned int sec, unsigned int usec)
+{
+}
+
+fd_set *Selective_InitSet (void)
+{
+  return NULL;
+}
+
+void Selective_FdZero (void *s)
+{
+}
+
+void Selective_FdSet (int fd, void *s)
+{
+}
+
+void Selective_FdClr (int fd, void *s)
+{
+}
+
+int Selective_FdIsSet (int fd, void *s)
+{
+  return 0;
+}
+
+int Selective_GetTimeOfDay (struct timeval *t)
+{
+    return -1;
+}
+#endif
+
+
+/* MaxFdsPlusOne returns max (a + 1, b + 1).  */
+
+int Selective_MaxFdsPlusOne (int a, int b)
+{
+  if (a > b)
+    return a+1;
+  else
+    return b+1;
+}
+
+
+/* WriteCharRaw writes a single character to the file descriptor.  */
+
+void Selective_WriteCharRaw (int fd, char ch)
+{
+  write (fd, &ch, 1);
+}
+
+
+/* ReadCharRaw read and return a single char from file descriptor, fd.  */
+
+char Selective_ReadCharRaw (int fd)
+{
+  char ch;
+
+  read (fd, &ch, 1);
+  return ch;
+}
+
+
+void
+_M2_Selective_init ()
+{
+}
+
+void
+_M2_Selective_finish ()
+{
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/gm2-libs-ch/SysExceptions.c b/gcc/m2/gm2-libs-ch/SysExceptions.c
new file mode 100644
index 00000000000..ffe41f31708
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/SysExceptions.c
@@ -0,0 +1,243 @@
+/* SysExceptions.c connect signal handlers to exceptions.
+
+Copyright (C) 2010-2022 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"
+#include "ansidecl.h"
+#include "gm2-libs-host.h"
+
+#if defined(HAVE_SIGNAL_H)
+#include <signal.h>
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#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
+
+/* note 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");
+    }
+}
+
+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
+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.  */
+
+void
+_M2_SysExceptions_init (void)
+{
+}
+
+void
+_M2_SysExceptions_finish (void)
+{
+}
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/gm2-libs-ch/UnixArgs.cc b/gcc/m2/gm2-libs-ch/UnixArgs.cc
new file mode 100644
index 00000000000..1180f351b24
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/UnixArgs.cc
@@ -0,0 +1,91 @@
+/* UnixArgs.cc record argc, argv as global variables.
+
+Copyright (C) 2009-2022 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 "m2rts.h"
+
+
+extern "C" int UnixArgs_GetArgC (void);
+extern "C" char **UnixArgs_GetArgV (void);
+extern "C" char **UnixArgs_GetEnvV (void);
+
+static int UnixArgs_ArgC;
+static char **UnixArgs_ArgV;
+static char **UnixArgs_EnvV;
+
+
+/* GetArgC returns argc.  */
+
+extern "C" int
+UnixArgs_GetArgC (void)
+{
+  return UnixArgs_ArgC;
+}
+
+
+/* GetArgV returns argv.  */
+
+extern "C" char **
+UnixArgs_GetArgV (void)
+{
+  return UnixArgs_ArgV;
+}
+
+
+/* GetEnvV returns envv.  */
+
+extern "C" char **
+UnixArgs_GetEnvV (void)
+{
+  return UnixArgs_EnvV;
+}
+
+
+extern "C" void
+_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+{
+  UnixArgs_ArgC = argc;
+  UnixArgs_ArgV = argv;
+  UnixArgs_EnvV = envp;
+}
+
+extern "C" void
+_M2_UnixArgs_finish (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_UnixArgs_dep (void)
+{
+}
+
+struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
+
+_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
+{
+  M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_finish,
+			_M2_UnixArgs_dep);
+}
diff --git a/gcc/m2/gm2-libs-ch/cgetopt.c b/gcc/m2/gm2-libs-ch/cgetopt.c
new file mode 100644
index 00000000000..b59d666706b
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/cgetopt.c
@@ -0,0 +1,163 @@
+/* getopt.c provide access to the C getopt library.
+
+Copyright (C) 2017-2022 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"
+#include "ansi-decl.h"
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+char *cgetopt_optarg;
+int cgetopt_optind;
+int cgetopt_opterr;
+int cgetopt_optopt;
+
+
+char
+cgetopt_getopt (int argc, char *argv[], char *optstring)
+{
+  char r = getopt (argc, argv, optstring);
+
+  cgetopt_optarg = optarg;
+  cgetopt_optind = optind;
+  cgetopt_opterr = opterr;
+  cgetopt_optopt = optopt;
+
+  if (r == (char)-1)
+    return (char)0;
+  return r;
+}
+
+
+int
+cgetopt_cgetopt_long (int argc, char *argv[], char *optstring, const struct option *longopts,
+                    int *longindex)
+{
+  int r = cgetopt_long (argc, argv, optstring, longopts, longindex);
+
+  cgetopt_optarg = optarg;
+  cgetopt_optind = optind;
+  cgetopt_opterr = opterr;
+  cgetopt_optopt = optopt;
+
+  return r;
+}
+
+
+int
+cgetopt_cgetopt_long_only (int argc, char *argv[], char *optstring,
+                         const struct option *longopts, int *longindex)
+{
+  int r = cgetopt_long_only (argc, argv, optstring, longopts, longindex);
+
+  cgetopt_optarg = optarg;
+  cgetopt_optind = optind;
+  cgetopt_opterr = opterr;
+  cgetopt_optopt = optopt;
+
+  return r;
+}
+
+
+typedef struct cgetopt_Options_s {
+  struct option *cinfo;
+  unsigned int high;
+} cgetopt_Options;
+
+
+/* InitOptions a constructor for Options.  */
+
+cgetopt_Options *
+cgetopt_InitOptions (void)
+{
+  cgetopt_Options *o = (cgetopt_Options *) malloc (sizeof (cgetopt_Options));
+  o->cinfo = (struct option *) malloc (sizeof (struct option));
+  o->high = 0;
+  return o;
+}
+
+
+/* KillOptions a deconstructor for Options.  Returns NULL after freeing
+   up all allocated memory associated with o.  */
+
+cgetopt_Options *
+cgetopt_KillOptions (cgetopt_Options *o)
+{
+  free (o->cinfo);
+  free (o);
+  return NULL;
+}
+
+
+/* SetOption set option[index] with {name, has_arg, flag, val}.  */
+
+void
+cgetopt_SetOption (cgetopt_Options *o, unsigned int index,
+		  char *name, unsigned int has_arg,
+		  int *flag, int val)
+{
+  if (index > o->high)
+    {
+      o->cinfo = (struct option *) malloc (sizeof (struct option) * (index + 1));
+      o->high = index + 1;
+    }
+  o->cinfo[index].name = name;
+  o->cinfo[index].has_arg = has_arg;
+  o->cinfo[index].flag = flag;
+  o->cinfo[index].val = val;
+}
+
+
+/* GetLongOptionArray returns a pointer to the C array containing all
+   long options.  */
+
+struct option *
+cgetopt_GetLongOptionArray (cgetopt_Options *o)
+{
+  return o->cinfo;
+}
+
+
+/* GNU Modula-2 linking fodder.  */
+
+void
+_M2_cgetopt_init (void)
+{
+}
+
+
+void
+_M2_cgetopt_finish (void)
+{
+}
+
+#   ifdef __cplusplus
+}
+#   endif
diff --git a/gcc/m2/gm2-libs-ch/choosetemp.c b/gcc/m2/gm2-libs-ch/choosetemp.c
new file mode 100644
index 00000000000..24b2582e68e
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/choosetemp.c
@@ -0,0 +1,58 @@
+/* choosetemp.c provide access to temporary file creation.
+
+Copyright (C) 2005-2022 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"
+#include "libiberty.h"
+#include "Gchoosetemp.h"
+
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+
+/* Return a temporary file name (as a string) or NIL if unable to
+create one.  */
+
+void *
+choosetemp_make_temp_file (void *suffix)
+{
+  return (void *)make_temp_file ((const char *)suffix);
+}
+
+/* to satisfy the GM2 linker.  */
+void
+_M2_choosetemp_init (void)
+{
+}
+
+/* to satisfy the GM2 linker.  */
+void
+_M2_choosetemp_finish (void)
+{
+}
+#   ifdef __cplusplus
+}
+#   endif
diff --git a/gcc/m2/gm2-libs-ch/dtoa.cc b/gcc/m2/gm2-libs-ch/dtoa.cc
new file mode 100644
index 00000000000..57317588ba1
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/dtoa.cc
@@ -0,0 +1,206 @@
+/* dtoa.c provide floating point string conversion routines.
+
+Copyright (C) 2009-2022 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"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+#include "m2rts.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 ();
+    }
+}
+
+/* GNU Modula-2 hooks */
+
+void
+_M2_dtoa_init (int, char **, char **)
+{
+}
+
+void
+_M2_dtoa_finish (int, char **, char **)
+{
+}
+
+void
+_M2_dtoa_dep (void)
+{
+}
+
+#ifdef __cplusplus
+}
+
+struct _M2_dtoa_ctor { _M2_dtoa_ctor (); } _M2_dtoa_ctor;
+
+_M2_dtoa_ctor::_M2_dtoa_ctor (void)
+{
+  M2RTS_RegisterModule ("dtoa", _M2_dtoa_init, _M2_dtoa_finish,
+			_M2_dtoa_dep);
+}
+
+#else
+void
+_M2_dtoa_ctor (void)
+{
+}
+
+#endif
diff --git a/gcc/m2/gm2-libs-ch/errno.c b/gcc/m2/gm2-libs-ch/errno.c
new file mode 100644
index 00000000000..fb8002e5111
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/errno.c
@@ -0,0 +1,59 @@
+/* errno.c provide access to errno.
+
+Copyright (C) 2009-2022 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"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+
+int
+errno_geterrno (void)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+  return errno;
+#else
+  return -1;
+#endif
+}
+
+void
+_M2_errno_init (void)
+{
+}
+
+void
+_M2_errno_finish (void)
+{
+}
+
+#   ifdef __cplusplus
+}
+#   endif
diff --git a/gcc/m2/gm2-libs-ch/host.c b/gcc/m2/gm2-libs-ch/host.c
new file mode 100644
index 00000000000..9d691d8e478
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/host.c
@@ -0,0 +1,64 @@
+/* host.c supply missing math routines.
+
+Copyright (C) 2010-2022 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"
+#include "ansidecl.h"
+#include "math.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if !defined(HAVE_EXP10)
+double
+exp10 (double x)
+{
+  return exp (x * M_LN10);
+}
+#endif
+
+#if !defined(HAVE_EXP10F)
+float
+exp10f (float x)
+{
+  return expf (x * M_LN10);
+}
+#endif
+
+#if !defined(HAVE_EXP10L)
+long double
+exp10l (long double x)
+{
+  return expl (x * M_LN10);
+}
+#endif
+
+#   ifdef __cplusplus
+}
+#   endif
diff --git a/gcc/m2/gm2-libs-ch/ldtoa.cc b/gcc/m2/gm2-libs-ch/ldtoa.cc
new file mode 100644
index 00000000000..ac14297ec24
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/ldtoa.cc
@@ -0,0 +1,135 @@
+/* ldtoa.c provide long double floating point string conversion routines.
+
+Copyright (C) 2009-2022 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"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+#include "m2rts.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 (int, char **, char **)
+{
+}
+
+void
+_M2_ldtoa_finish (int, char **, char **)
+{
+}
+
+void
+_M2_ldtoa_dep (void)
+{
+}
+
+#   ifdef __cplusplus
+}
+
+struct _M2_ldtoa_ctor { _M2_ldtoa_ctor (); } _M2_ldtoa_ctor;
+
+_M2_ldtoa_ctor::_M2_ldtoa_ctor (void)
+{
+  M2RTS_RegisterModule ("ldtoa", _M2_ldtoa_init, _M2_ldtoa_finish,
+			_M2_ldtoa_dep);
+}
+
+#else
+void
+_M2_ldtoa_ctor (void)
+{
+}
+
+#   endif
diff --git a/gcc/m2/gm2-libs-ch/m2rts.h b/gcc/m2/gm2-libs-ch/m2rts.h
new file mode 100644
index 00000000000..57e6e90d94d
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/m2rts.h
@@ -0,0 +1,41 @@
+/* m2rts.h provides a C interface to M2RTS.mod.
+
+Copyright (C) 2019-2022 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/>.  */
+
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
+extern "C" void M2RTS_RegisterModule (const char *modulename,
+				      proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void _M2_M2RTS_init (void);
+
+extern "C" void M2RTS_ConstructModules (const char *,
+					int argc, char *argv[], char *envp[]);
+extern "C" void M2RTS_Terminate (void);
+extern "C" void M2RTS_DeconstructModules (void);
+
+extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn));
diff --git a/gcc/m2/gm2-libs-ch/termios.c b/gcc/m2/gm2-libs-ch/termios.c
new file mode 100644
index 00000000000..7075d25bb98
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/termios.c
@@ -0,0 +1,1936 @@
+/* termios.c provide access to termios.
+
+Copyright (C) 2010-2022 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"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef TERMIOS_NEEDS_XOPEN_SOURCE
+#define _XOPEN_SOURCE
+#endif
+
+#if defined(HAVE_TERMIOS_H)
+#include <termios.h>
+#endif
+
+#define EXPORT(X) termios##_##X
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+typedef enum {
+  vintr,
+  vquit,
+  verase,
+  vkill,
+  veof,
+  vtime,
+  vmin,
+  vswtc,
+  vstart,
+  vstop,
+  vsusp,
+  veol,
+  vreprint,
+  vdiscard,
+  vwerase,
+  vlnext,
+  veol2
+} ControlChar;
+
+typedef enum {
+  /* input flag bits.  */
+  ignbrk,
+  ibrkint,
+  ignpar,
+  iparmrk,
+  inpck,
+  istrip,
+  inlcr,
+  igncr,
+  icrnl,
+  iuclc,
+  ixon,
+  ixany,
+  ixoff,
+  imaxbel,
+  /* output flag bits.  */
+  opost,
+  olcuc,
+  onlcr,
+  ocrnl,
+  onocr,
+  onlret,
+  ofill,
+  ofdel,
+  onl0,
+  onl1,
+  ocr0,
+  ocr1,
+  ocr2,
+  ocr3,
+  otab0,
+  otab1,
+  otab2,
+  otab3,
+  obs0,
+  obs1,
+  off0,
+  off1,
+  ovt0,
+  ovt1,
+  /* baud rate.  */
+  b0,
+  b50,
+  b75,
+  b110,
+  b135,
+  b150,
+  b200,
+  b300,
+  b600,
+  b1200,
+  b1800,
+  b2400,
+  b4800,
+  b9600,
+  b19200,
+  b38400,
+  b57600,
+  b115200,
+  b240400,
+  b460800,
+  b500000,
+  b576000,
+  b921600,
+  b1000000,
+  b1152000,
+  b1500000,
+  b2000000,
+  b2500000,
+  b3000000,
+  b3500000,
+  b4000000,
+  maxbaud,
+  crtscts,
+  /* character size.  */
+  cs5,
+  cs6,
+  cs7,
+  cs8,
+  cstopb,
+  cread,
+  parenb,
+  parodd,
+  hupcl,
+  clocal,
+  /* local flags.  */
+  lisig,
+  licanon,
+  lxcase,
+  lecho,
+  lechoe,
+  lechok,
+  lechonl,
+  lnoflsh,
+  ltopstop,
+  lechoctl,
+  lechoprt,
+  lechoke,
+  lflusho,
+  lpendin,
+  liexten
+} Flag;
+
+/* prototypes.  */
+void *EXPORT (InitTermios) (void);
+void *EXPORT (KillTermios) (struct termios *p);
+int EXPORT (cfgetospeed) (struct termios *t);
+int EXPORT (cfgetispeed) (struct termios *t);
+int EXPORT (cfsetospeed) (struct termios *t, unsigned int b);
+int EXPORT (cfsetispeed) (struct termios *t, unsigned int b);
+int EXPORT (cfsetspeed) (struct termios *t, unsigned int b);
+int EXPORT (tcgetattr) (int fd, struct termios *t);
+int EXPORT (tcsetattr) (int fd, int option, struct termios *t);
+void EXPORT (cfmakeraw) (struct termios *t);
+int EXPORT (tcsendbreak) (int fd, int duration);
+int EXPORT (tcdrain) (int fd);
+int EXPORT (tcflushi) (int fd);
+int EXPORT (tcflusho) (int fd);
+int EXPORT (tcflushio) (int fd);
+int EXPORT (tcflowoni) (int fd);
+int EXPORT (tcflowoffi) (int fd);
+int EXPORT (tcflowono) (int fd);
+int EXPORT (tcflowoffo) (int fd);
+int EXPORT (GetFlag) (struct termios *t, Flag f, int *b);
+int EXPORT (SetFlag) (struct termios *t, Flag f, int b);
+int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch);
+int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch);
+int EXPORT (tcsnow) (void);
+int EXPORT (tcsflush) (void);
+int EXPORT (tcsdrain) (void);
+int doSetUnset (tcflag_t *bitset, unsigned int mask, int value);
+void _M2_termios_init (void);
+void _M2_termios_finish (void);
+
+/* InitTermios - new data structure.  */
+
+void *EXPORT (InitTermios) (void)
+{
+  struct termios *p = (struct termios *)malloc (sizeof (struct termios));
+
+  memset (p, 0, sizeof (struct termios));
+  return p;
+}
+
+/* KillTermios - delete data structure.  */
+
+void *EXPORT (KillTermios) (struct termios *p)
+{
+  free (p);
+  return NULL;
+}
+
+/* tcsnow - return the value of TCSANOW.  */
+
+int EXPORT (tcsnow) (void) { return TCSANOW; }
+
+/* tcsdrain - return the value of TCSADRAIN.  */
+
+int EXPORT (tcsdrain) (void) { return TCSADRAIN; }
+
+/* tcsflush - return the value of TCSAFLUSH.  */
+
+int EXPORT (tcsflush) (void) { return TCSAFLUSH; }
+
+/* cfgetospeed - return output baud rate.  */
+
+int EXPORT (cfgetospeed) (struct termios *t) { return cfgetospeed (t); }
+
+/* cfgetispeed - return input baud rate.  */
+
+int EXPORT (cfgetispeed) (struct termios *t) { return cfgetispeed (t); }
+
+/* cfsetospeed - set output baud rate.  */
+
+int EXPORT (cfsetospeed) (struct termios *t, unsigned int b)
+{
+  return cfsetospeed (t, b);
+}
+
+/* cfsetispeed - set input baud rate.  */
+
+int EXPORT (cfsetispeed) (struct termios *t, unsigned int b)
+{
+  return cfsetispeed (t, b);
+}
+
+/* cfsetspeed - set input and output baud rate.  */
+
+int EXPORT (cfsetspeed) (struct termios *t, unsigned int b)
+{
+  int val = cfsetispeed (t, b);
+  if (val == 0)
+    return cfsetospeed (t, b);
+  cfsetospeed (t, b);
+  return val;
+}
+
+/* tcgetattr - get state of, fd, into, t.  */
+
+int EXPORT (tcgetattr) (int fd, struct termios *t)
+{
+  return tcgetattr (fd, t);
+}
+
+/* tcsetattr - set state of, fd, to, t, using option.  */
+
+int EXPORT (tcsetattr) (int fd, int option, struct termios *t)
+{
+  return tcsetattr (fd, option, t);
+}
+
+/* cfmakeraw - sets the terminal to raw mode.  */
+
+void EXPORT (cfmakeraw) (struct termios *t)
+{
+#if defined(HAVE_CFMAKERAW)
+  return cfmakeraw (t);
+#endif
+}
+
+/* tcsendbreak - send zero bits for duration.  */
+
+int EXPORT (tcsendbreak) (int fd, int duration)
+{
+  return tcsendbreak (fd, duration);
+}
+
+/* tcdrain - waits for pending output to be written on, fd.  */
+
+int EXPORT (tcdrain) (int fd) { return tcdrain (fd); }
+
+/* tcflushi - flush input.  */
+
+int EXPORT (tcflushi) (int fd)
+{
+#if defined(TCIFLUSH)
+  return tcflush (fd, TCIFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflusho - flush output.  */
+
+int EXPORT (tcflusho) (int fd)
+{
+#if defined(TCOFLUSH)
+  return tcflush (fd, TCOFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflushio - flush input and output.  */
+
+int EXPORT (tcflushio) (int fd)
+{
+#if defined(TCIOFLUSH)
+  return tcflush (fd, TCIOFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoni - restart input on, fd.  */
+
+int EXPORT (tcflowoni) (int fd)
+{
+#if defined(TCION)
+  return tcflow (fd, TCION);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoffi - stop input on, fd.  */
+
+int EXPORT (tcflowoffi) (int fd)
+{
+#if defined(TCIOFF)
+  return tcflow (fd, TCIOFF);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowono - restart output on, fd.  */
+
+int EXPORT (tcflowono) (int fd)
+{
+#if defined(TCOON)
+  return tcflow (fd, TCOON);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoffo - stop output on, fd.  */
+
+int EXPORT (tcflowoffo) (int fd)
+{
+#if defined(TCOOFF)
+  return tcflow (fd, TCOOFF);
+#else
+  return 1;
+#endif
+}
+
+/* doSetUnset - applies mask or undoes mask depending upon value.  */
+
+int
+doSetUnset (tcflag_t *bitset, unsigned int mask, int value)
+{
+  if (value)
+    (*bitset) |= mask;
+  else
+    (*bitset) &= (~mask);
+  return 1;
+}
+
+/* GetFlag - sets a flag value from, t, in, b, and returns TRUE if,
+   t, supports, f.  */
+
+int EXPORT (GetFlag) (struct termios *t, Flag f, int *b)
+{
+  switch (f)
+    {
+
+    case ignbrk:
+#if defined(IGNBRK)
+      *b = ((t->c_iflag & IGNBRK) == IGNBRK);
+      return 1;
+#else
+      return 0;
+#endif
+    case ibrkint:
+#if defined(BRKINT)
+      *b = ((t->c_iflag & BRKINT) == BRKINT);
+      return 1;
+#else
+      return 0;
+#endif
+    case ignpar:
+#if defined(IGNPAR)
+      *b = ((t->c_iflag & IGNPAR) == IGNPAR);
+      return 1;
+#else
+      return 0;
+#endif
+    case iparmrk:
+#if defined(PARMRK)
+      *b = ((t->c_iflag & PARMRK) == PARMRK);
+      return 1;
+#else
+      return 0;
+#endif
+    case inpck:
+#if defined(INPCK)
+      *b = ((t->c_iflag & INPCK) == INPCK);
+      return 1;
+#else
+      return 0;
+#endif
+    case istrip:
+#if defined(ISTRIP)
+      *b = ((t->c_iflag & ISTRIP) == ISTRIP);
+      return 1;
+#else
+      return 0;
+#endif
+    case inlcr:
+#if defined(INLCR)
+      *b = ((t->c_iflag & INLCR) == INLCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case igncr:
+#if defined(IGNCR)
+      *b = ((t->c_iflag & IGNCR) == IGNCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case icrnl:
+#if defined(ICRNL)
+      *b = ((t->c_iflag & ICRNL) == ICRNL);
+      return 1;
+#else
+      return 0;
+#endif
+    case iuclc:
+#if defined(IUCLC)
+      *b = ((t->c_iflag & IUCLC) == IUCLC);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixon:
+#if defined(IXON)
+      *b = ((t->c_iflag & IXON) == IXON);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixany:
+#if defined(IXANY)
+      *b = ((t->c_iflag & IXANY) == IXANY);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixoff:
+#if defined(IXOFF)
+      *b = ((t->c_iflag & IXOFF) == IXOFF);
+      return 1;
+#else
+      return 0;
+#endif
+    case imaxbel:
+#if defined(IMAXBEL)
+      *b = ((t->c_iflag & IMAXBEL) == IMAXBEL);
+      return 1;
+#else
+      return 0;
+#endif
+    case opost:
+#if defined(OPOST)
+      *b = ((t->c_oflag & OPOST) == OPOST);
+      return 1;
+#else
+      return 0;
+#endif
+    case olcuc:
+#if defined(OLCUC)
+      *b = ((t->c_oflag & OLCUC) == OLCUC);
+      return 1;
+#else
+      return 0;
+#endif
+    case onlcr:
+#if defined(ONLCR)
+      *b = ((t->c_oflag & ONLCR) == ONLCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocrnl:
+#if defined(OCRNL)
+      *b = ((t->c_oflag & OCRNL) == OCRNL);
+      return 1;
+#else
+      return 0;
+#endif
+    case onocr:
+#if defined(ONOCR)
+      *b = ((t->c_oflag & ONOCR) == ONOCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case onlret:
+#if defined(ONLRET)
+      *b = ((t->c_oflag & ONLRET) == ONLRET);
+      return 1;
+#else
+      return 0;
+#endif
+    case ofill:
+#if defined(OFILL)
+      *b = ((t->c_oflag & OFILL) == OFILL);
+      return 1;
+#else
+      return 0;
+#endif
+    case ofdel:
+#if defined(OFDEL)
+      *b = ((t->c_oflag & OFDEL) == OFDEL);
+      return 1;
+#else
+      return 0;
+#endif
+    case onl0:
+#if defined(NL0)
+      *b = ((t->c_oflag & NL0) == NL0);
+      return 1;
+#else
+      return 0;
+#endif
+    case onl1:
+#if defined(NL1)
+      *b = ((t->c_oflag & NL1) == NL1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr0:
+#if defined(CR0)
+      *b = ((t->c_oflag & CR0) == CR0);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr1:
+#if defined(CR1)
+      *b = ((t->c_oflag & CR1) == CR1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr2:
+#if defined(CR2)
+      *b = ((t->c_oflag & CR2) == CR2);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr3:
+#if defined(CR3)
+      *b = ((t->c_oflag & CR3) == CR3);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab0:
+#if defined(TAB0)
+      *b = ((t->c_oflag & TAB0) == TAB0);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab1:
+#if defined(TAB1)
+      *b = ((t->c_oflag & TAB1) == TAB1);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab2:
+#if defined(TAB2)
+      *b = ((t->c_oflag & TAB2) == TAB2);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab3:
+#if defined(TAB3)
+      *b = ((t->c_oflag & TAB3) == TAB3);
+      return 1;
+#else
+      return 0;
+#endif
+    case obs0:
+#if defined(BS0)
+      *b = ((t->c_oflag & BS0) == BS0);
+      return 1;
+#else
+      return 0;
+#endif
+    case obs1:
+#if defined(BS1)
+      *b = ((t->c_oflag & BS1) == BS1);
+      return 1;
+#else
+      return 0;
+#endif
+    case off0:
+#if defined(FF0)
+      *b = ((t->c_oflag & FF0) == FF0);
+      return 1;
+#else
+      return 0;
+#endif
+    case off1:
+#if defined(FF1)
+      *b = ((t->c_oflag & FF1) == FF1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ovt0:
+#if defined(VT0)
+      *b = ((t->c_oflag & VT0) == VT0);
+      return 1;
+#else
+      return 0;
+#endif
+    case ovt1:
+#if defined(VT1)
+      *b = ((t->c_oflag & VT1) == VT1);
+      return 1;
+#else
+      return 0;
+#endif
+    case b0:
+#if defined(B0)
+      *b = ((t->c_cflag & B0) == B0);
+      return 1;
+#else
+      return 0;
+#endif
+    case b50:
+#if defined(B50)
+      *b = ((t->c_cflag & B50) == B50);
+      return 1;
+#else
+      return 0;
+#endif
+    case b75:
+#if defined(B75)
+      *b = ((t->c_cflag & B75) == B75);
+      return 1;
+#else
+      return 0;
+#endif
+    case b110:
+#if defined(B110)
+      *b = ((t->c_cflag & B110) == B110);
+      return 1;
+#else
+      return 0;
+#endif
+    case b135:
+#if defined(B134)
+      *b = ((t->c_cflag & B134) == B134);
+      return 1;
+#else
+      return 0;
+#endif
+    case b150:
+#if defined(B150)
+      *b = ((t->c_cflag & B150) == B150);
+      return 1;
+#else
+      return 0;
+#endif
+    case b200:
+#if defined(B200)
+      *b = ((t->c_cflag & B200) == B200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b300:
+#if defined(B300)
+      *b = ((t->c_cflag & B300) == B300);
+      return 1;
+#else
+      return 0;
+#endif
+    case b600:
+#if defined(B600)
+      *b = ((t->c_cflag & B600) == B600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1200:
+#if defined(B1200)
+      *b = ((t->c_cflag & B1200) == B1200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1800:
+#if defined(B1800)
+      *b = ((t->c_cflag & B1800) == B1800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2400:
+#if defined(B2400)
+      *b = ((t->c_cflag & B2400) == B2400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b4800:
+#if defined(B4800)
+      *b = ((t->c_cflag & B4800) == B4800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b9600:
+#if defined(B9600)
+      *b = ((t->c_cflag & B9600) == B9600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b19200:
+#if defined(B19200)
+      *b = ((t->c_cflag & B19200) == B19200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b38400:
+#if defined(B38400)
+      *b = ((t->c_cflag & B38400) == B38400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b57600:
+#if defined(B57600)
+      *b = ((t->c_cflag & B57600) == B57600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b115200:
+#if defined(B115200)
+      *b = ((t->c_cflag & B115200) == B115200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b240400:
+#if defined(B230400)
+      *b = ((t->c_cflag & B230400) == B230400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b460800:
+#if defined(B460800)
+      *b = ((t->c_cflag & B460800) == B460800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b500000:
+#if defined(B500000)
+      *b = ((t->c_cflag & B500000) == B500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b576000:
+#if defined(B576000)
+      *b = ((t->c_cflag & B576000) == B576000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b921600:
+#if defined(B921600)
+      *b = ((t->c_cflag & B921600) == B921600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1000000:
+#if defined(B1000000)
+      *b = ((t->c_cflag & B1000000) == B1000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1152000:
+#if defined(B1152000)
+      *b = ((t->c_cflag & B1152000) == B1152000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1500000:
+#if defined(B1500000)
+      *b = ((t->c_cflag & B1500000) == B1500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2000000:
+#if defined(B2000000)
+      *b = ((t->c_cflag & B2000000) == B2000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2500000:
+#if defined(B2500000)
+      *b = ((t->c_cflag & B2500000) == B2500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b3000000:
+#if defined(B3000000)
+      *b = ((t->c_cflag & B3000000) == B3000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b3500000:
+#if defined(B3500000)
+      *b = ((t->c_cflag & B3500000) == B3500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b4000000:
+#if defined(B4000000)
+      *b = ((t->c_cflag & B4000000) == B4000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case maxbaud:
+#if defined(__MAX_BAUD)
+      *b = ((t->c_cflag & __MAX_BAUD) == __MAX_BAUD);
+      return 1;
+#else
+      return 0;
+#endif
+    case crtscts:
+#if defined(CRTSCTS)
+      *b = ((t->c_cflag & CRTSCTS) == CRTSCTS);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs5:
+#if defined(CS5)
+      *b = ((t->c_cflag & CS5) == CS5);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs6:
+#if defined(CS6)
+      *b = ((t->c_cflag & CS6) == CS6);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs7:
+#if defined(CS7)
+      *b = ((t->c_cflag & CS7) == CS7);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs8:
+#if defined(CS8)
+      *b = ((t->c_cflag & CS8) == CS8);
+      return 1;
+#else
+      return 0;
+#endif
+    case cstopb:
+#if defined(CSTOPB)
+      *b = ((t->c_cflag & CSTOPB) == CSTOPB);
+      return 1;
+#else
+      return 0;
+#endif
+    case cread:
+#if defined(CREAD)
+      *b = ((t->c_cflag & CREAD) == CREAD);
+      return 1;
+#else
+      return 0;
+#endif
+    case parenb:
+#if defined(PARENB)
+      *b = ((t->c_cflag & PARENB) == PARENB);
+      return 1;
+#else
+      return 0;
+#endif
+    case parodd:
+#if defined(PARODD)
+      *b = ((t->c_cflag & PARODD) == PARODD);
+      return 1;
+#else
+      return 0;
+#endif
+    case hupcl:
+#if defined(HUPCL)
+      *b = ((t->c_cflag & HUPCL) == HUPCL);
+      return 1;
+#else
+      return 0;
+#endif
+    case clocal:
+#if defined(CLOCAL)
+      *b = ((t->c_cflag & CLOCAL) == CLOCAL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lisig:
+#if defined(ISIG)
+      *b = ((t->c_lflag & ISIG) == ISIG);
+      return 1;
+#else
+      return 0;
+#endif
+    case licanon:
+#if defined(ICANON)
+      *b = ((t->c_lflag & ICANON) == ICANON);
+      return 1;
+#else
+      return 0;
+#endif
+    case lxcase:
+#if defined(XCASE)
+      *b = ((t->c_lflag & XCASE) == XCASE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lecho:
+#if defined(ECHO)
+      *b = ((t->c_lflag & ECHO) == ECHO);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoe:
+#if defined(ECHOE)
+      *b = ((t->c_lflag & ECHOE) == ECHOE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechok:
+#if defined(ECHOK)
+      *b = ((t->c_lflag & ECHOK) == ECHOK);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechonl:
+#if defined(ECHONL)
+      *b = ((t->c_lflag & ECHONL) == ECHONL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lnoflsh:
+#if defined(NOFLSH)
+      *b = ((t->c_lflag & NOFLSH) == NOFLSH);
+      return 1;
+#else
+      return 0;
+#endif
+    case ltopstop:
+#if defined(TOSTOP)
+      *b = ((t->c_lflag & TOSTOP) == TOSTOP);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoctl:
+#if defined(ECHOCTL)
+      *b = ((t->c_lflag & ECHOCTL) == ECHOCTL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoprt:
+#if defined(ECHOPRT)
+      *b = ((t->c_lflag & ECHOPRT) == ECHOPRT);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoke:
+#if defined(ECHOKE)
+      *b = ((t->c_lflag & ECHOKE) == ECHOKE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lflusho:
+#if defined(FLUSHO)
+      *b = ((t->c_lflag & FLUSHO) == FLUSHO);
+      return 1;
+#else
+      return 0;
+#endif
+    case lpendin:
+#if defined(PENDIN)
+      *b = ((t->c_lflag & PENDIN) == PENDIN);
+      return 1;
+#else
+      return 0;
+#endif
+    case liexten:
+#if defined(IEXTEN)
+      *b = ((t->c_lflag & IEXTEN) == IEXTEN);
+      return 1;
+#else
+      return 0;
+#endif
+    }
+  return 0;
+}
+
+/* SetFlag - sets a flag value in, t, to, b, and returns TRUE if this
+   flag value is supported.  */
+
+int EXPORT (SetFlag) (struct termios *t, Flag f, int b)
+{
+  switch (f)
+    {
+
+    case ignbrk:
+#if defined(IGNBRK)
+      return doSetUnset (&t->c_iflag, IGNBRK, b);
+#else
+      return 0;
+#endif
+    case ibrkint:
+#if defined(BRKINT)
+      return doSetUnset (&t->c_iflag, BRKINT, b);
+#else
+      return 0;
+#endif
+    case ignpar:
+#if defined(IGNPAR)
+      return doSetUnset (&t->c_iflag, IGNPAR, b);
+#else
+      return 0;
+#endif
+    case iparmrk:
+#if defined(PARMRK)
+      return doSetUnset (&t->c_iflag, PARMRK, b);
+#else
+      return 0;
+#endif
+    case inpck:
+#if defined(INPCK)
+      return doSetUnset (&t->c_iflag, INPCK, b);
+#else
+      return 0;
+#endif
+    case istrip:
+#if defined(ISTRIP)
+      return doSetUnset (&t->c_iflag, ISTRIP, b);
+#else
+      return 0;
+#endif
+    case inlcr:
+#if defined(INLCR)
+      return doSetUnset (&t->c_iflag, INLCR, b);
+#else
+      return 0;
+#endif
+    case igncr:
+#if defined(IGNCR)
+      return doSetUnset (&t->c_iflag, IGNCR, b);
+#else
+      return 0;
+#endif
+    case icrnl:
+#if defined(ICRNL)
+      return doSetUnset (&t->c_iflag, ICRNL, b);
+#else
+      return 0;
+#endif
+    case iuclc:
+#if defined(IUCLC)
+      return doSetUnset (&t->c_iflag, IUCLC, b);
+#else
+      return 0;
+#endif
+    case ixon:
+#if defined(IXON)
+      return doSetUnset (&t->c_iflag, IXON, b);
+#else
+      return 0;
+#endif
+    case ixany:
+#if defined(IXANY)
+      return doSetUnset (&t->c_iflag, IXANY, b);
+#else
+      return 0;
+#endif
+    case ixoff:
+#if defined(IXOFF)
+      return doSetUnset (&t->c_iflag, IXOFF, b);
+#else
+      return 0;
+#endif
+    case imaxbel:
+#if defined(IMAXBEL)
+      return doSetUnset (&t->c_iflag, IMAXBEL, b);
+#else
+      return 0;
+#endif
+    case opost:
+#if defined(OPOST)
+      return doSetUnset (&t->c_oflag, OPOST, b);
+#else
+      return 0;
+#endif
+    case olcuc:
+#if defined(OLCUC)
+      return doSetUnset (&t->c_oflag, OLCUC, b);
+#else
+      return 0;
+#endif
+    case onlcr:
+#if defined(ONLCR)
+      return doSetUnset (&t->c_oflag, ONLCR, b);
+#else
+      return 0;
+#endif
+    case ocrnl:
+#if defined(OCRNL)
+      return doSetUnset (&t->c_oflag, OCRNL, b);
+#else
+      return 0;
+#endif
+    case onocr:
+#if defined(ONOCR)
+      return doSetUnset (&t->c_oflag, ONOCR, b);
+#else
+      return 0;
+#endif
+    case onlret:
+#if defined(ONLRET)
+      return doSetUnset (&t->c_oflag, ONLRET, b);
+#else
+      return 0;
+#endif
+    case ofill:
+#if defined(OFILL)
+      return doSetUnset (&t->c_oflag, OFILL, b);
+#else
+      return 0;
+#endif
+    case ofdel:
+#if defined(OFDEL)
+      return doSetUnset (&t->c_oflag, OFDEL, b);
+#else
+      return 0;
+#endif
+    case onl0:
+#if defined(NL0)
+      return doSetUnset (&t->c_oflag, NL0, b);
+#else
+      return 0;
+#endif
+    case onl1:
+#if defined(NL1)
+      return doSetUnset (&t->c_oflag, NL1, b);
+#else
+      return 0;
+#endif
+    case ocr0:
+#if defined(CR0)
+      return doSetUnset (&t->c_oflag, CR0, b);
+#else
+      return 0;
+#endif
+    case ocr1:
+#if defined(CR1)
+      return doSetUnset (&t->c_oflag, CR1, b);
+#else
+      return 0;
+#endif
+    case ocr2:
+#if defined(CR2)
+      return doSetUnset (&t->c_oflag, CR2, b);
+#else
+      return 0;
+#endif
+    case ocr3:
+#if defined(CR3)
+      return doSetUnset (&t->c_oflag, CR3, b);
+#else
+      return 0;
+#endif
+    case otab0:
+#if defined(TAB0)
+      return doSetUnset (&t->c_oflag, TAB0, b);
+#else
+      return 0;
+#endif
+    case otab1:
+#if defined(TAB1)
+      return doSetUnset (&t->c_oflag, TAB1, b);
+#else
+      return 0;
+#endif
+    case otab2:
+#if defined(TAB2)
+      return doSetUnset (&t->c_oflag, TAB2, b);
+#else
+      return 0;
+#endif
+    case otab3:
+#if defined(TAB3)
+      return doSetUnset (&t->c_oflag, TAB3, b);
+#else
+      return 0;
+#endif
+    case obs0:
+#if defined(BS0)
+      return doSetUnset (&t->c_oflag, BS0, b);
+#else
+      return 0;
+#endif
+    case obs1:
+#if defined(BS1)
+      return doSetUnset (&t->c_oflag, BS1, b);
+#else
+      return 0;
+#endif
+    case off0:
+#if defined(FF0)
+      return doSetUnset (&t->c_oflag, FF0, b);
+#else
+      return 0;
+#endif
+    case off1:
+#if defined(FF1)
+      return doSetUnset (&t->c_oflag, FF1, b);
+#else
+      return 0;
+#endif
+    case ovt0:
+#if defined(VT0)
+      return doSetUnset (&t->c_oflag, VT0, b);
+#else
+      return 0;
+#endif
+    case ovt1:
+#if defined(VT1)
+      return doSetUnset (&t->c_oflag, VT1, b);
+#else
+      return 0;
+#endif
+    case b0:
+#if defined(B0)
+      return doSetUnset (&t->c_cflag, B0, b);
+#else
+      return 0;
+#endif
+    case b50:
+#if defined(B50)
+      return doSetUnset (&t->c_cflag, B50, b);
+#else
+      return 0;
+#endif
+    case b75:
+#if defined(B75)
+      return doSetUnset (&t->c_cflag, B75, b);
+#else
+      return 0;
+#endif
+    case b110:
+#if defined(B110)
+      return doSetUnset (&t->c_cflag, B110, b);
+#else
+      return 0;
+#endif
+    case b135:
+#if defined(B134)
+      return doSetUnset (&t->c_cflag, B134, b);
+#else
+      return 0;
+#endif
+    case b150:
+#if defined(B150)
+      return doSetUnset (&t->c_cflag, B150, b);
+#else
+      return 0;
+#endif
+    case b200:
+#if defined(B200)
+      return doSetUnset (&t->c_cflag, B200, b);
+#else
+      return 0;
+#endif
+    case b300:
+#if defined(B300)
+      return doSetUnset (&t->c_cflag, B300, b);
+#else
+      return 0;
+#endif
+    case b600:
+#if defined(B600)
+      return doSetUnset (&t->c_cflag, B600, b);
+#else
+      return 0;
+#endif
+    case b1200:
+#if defined(B1200)
+      return doSetUnset (&t->c_cflag, B1200, b);
+#else
+      return 0;
+#endif
+    case b1800:
+#if defined(B1800)
+      return doSetUnset (&t->c_cflag, B1800, b);
+#else
+      return 0;
+#endif
+    case b2400:
+#if defined(B2400)
+      return doSetUnset (&t->c_cflag, B2400, b);
+#else
+      return 0;
+#endif
+    case b4800:
+#if defined(B4800)
+      return doSetUnset (&t->c_cflag, B4800, b);
+#else
+      return 0;
+#endif
+    case b9600:
+#if defined(B9600)
+      return doSetUnset (&t->c_cflag, B9600, b);
+#else
+      return 0;
+#endif
+    case b19200:
+#if defined(B19200)
+      return doSetUnset (&t->c_cflag, B19200, b);
+#else
+      return 0;
+#endif
+    case b38400:
+#if defined(B38400)
+      return doSetUnset (&t->c_cflag, B38400, b);
+#else
+      return 0;
+#endif
+    case b57600:
+#if defined(B57600)
+      return doSetUnset (&t->c_cflag, B57600, b);
+#else
+      return 0;
+#endif
+    case b115200:
+#if defined(B115200)
+      return doSetUnset (&t->c_cflag, B115200, b);
+#else
+      return 0;
+#endif
+    case b240400:
+#if defined(B230400)
+      return doSetUnset (&t->c_cflag, B230400, b);
+#else
+      return 0;
+#endif
+    case b460800:
+#if defined(B460800)
+      return doSetUnset (&t->c_cflag, B460800, b);
+#else
+      return 0;
+#endif
+    case b500000:
+#if defined(B500000)
+      return doSetUnset (&t->c_cflag, B500000, b);
+#else
+      return 0;
+#endif
+    case b576000:
+#if defined(B576000)
+      return doSetUnset (&t->c_cflag, B576000, b);
+#else
+      return 0;
+#endif
+    case b921600:
+#if defined(B921600)
+      return doSetUnset (&t->c_cflag, B921600, b);
+#else
+      return 0;
+#endif
+    case b1000000:
+#if defined(B1000000)
+      return doSetUnset (&t->c_cflag, B1000000, b);
+#else
+      return 0;
+#endif
+    case b1152000:
+#if defined(B1152000)
+      return doSetUnset (&t->c_cflag, B1152000, b);
+#else
+      return 0;
+#endif
+    case b1500000:
+#if defined(B1500000)
+      return doSetUnset (&t->c_cflag, B1500000, b);
+#else
+      return 0;
+#endif
+    case b2000000:
+#if defined(B2000000)
+      return doSetUnset (&t->c_cflag, B2000000, b);
+#else
+      return 0;
+#endif
+    case b2500000:
+#if defined(B2500000)
+      return doSetUnset (&t->c_cflag, B2500000, b);
+#else
+      return 0;
+#endif
+    case b3000000:
+#if defined(B3000000)
+      return doSetUnset (&t->c_cflag, B3000000, b);
+#else
+      return 0;
+#endif
+    case b3500000:
+#if defined(B3500000)
+      return doSetUnset (&t->c_cflag, B3500000, b);
+#else
+      return 0;
+#endif
+    case b4000000:
+#if defined(B4000000)
+      return doSetUnset (&t->c_cflag, B4000000, b);
+#else
+      return 0;
+#endif
+    case maxbaud:
+#if defined(__MAX_BAUD)
+      return doSetUnset (&t->c_cflag, __MAX_BAUD, b);
+#else
+      return 0;
+#endif
+    case crtscts:
+#if defined(CRTSCTS)
+      return doSetUnset (&t->c_cflag, CRTSCTS, b);
+#else
+      return 0;
+#endif
+    case cs5:
+#if defined(CS5)
+      return doSetUnset (&t->c_cflag, CS5, b);
+#else
+      return 0;
+#endif
+    case cs6:
+#if defined(CS6)
+      return doSetUnset (&t->c_cflag, CS6, b);
+#else
+      return 0;
+#endif
+    case cs7:
+#if defined(CS7)
+      return doSetUnset (&t->c_cflag, CS7, b);
+#else
+      return 0;
+#endif
+    case cs8:
+#if defined(CS8)
+      return doSetUnset (&t->c_cflag, CS8, b);
+#else
+      return 0;
+#endif
+    case cstopb:
+#if defined(CSTOPB)
+      return doSetUnset (&t->c_cflag, CSTOPB, b);
+#else
+      return 0;
+#endif
+    case cread:
+#if defined(CREAD)
+      return doSetUnset (&t->c_cflag, CREAD, b);
+#else
+      return 0;
+#endif
+    case parenb:
+#if defined(PARENB)
+      return doSetUnset (&t->c_cflag, PARENB, b);
+#else
+      return 0;
+#endif
+    case parodd:
+#if defined(PARODD)
+      return doSetUnset (&t->c_cflag, PARODD, b);
+#else
+      return 0;
+#endif
+    case hupcl:
+#if defined(HUPCL)
+      return doSetUnset (&t->c_cflag, HUPCL, b);
+#else
+      return 0;
+#endif
+    case clocal:
+#if defined(CLOCAL)
+      return doSetUnset (&t->c_cflag, CLOCAL, b);
+#else
+      return 0;
+#endif
+    case lisig:
+#if defined(ISIG)
+      return doSetUnset (&t->c_lflag, ISIG, b);
+#else
+      return 0;
+#endif
+    case licanon:
+#if defined(ICANON)
+      return doSetUnset (&t->c_lflag, ICANON, b);
+#else
+      return 0;
+#endif
+    case lxcase:
+#if defined(XCASE)
+      return doSetUnset (&t->c_lflag, XCASE, b);
+#else
+      return 0;
+#endif
+    case lecho:
+#if defined(ECHO)
+      return doSetUnset (&t->c_lflag, ECHO, b);
+#else
+      return 0;
+#endif
+    case lechoe:
+#if defined(ECHOE)
+      return doSetUnset (&t->c_lflag, ECHOE, b);
+#else
+      return 0;
+#endif
+    case lechok:
+#if defined(ECHOK)
+      return doSetUnset (&t->c_lflag, ECHOK, b);
+#else
+      return 0;
+#endif
+    case lechonl:
+#if defined(ECHONL)
+      return doSetUnset (&t->c_lflag, ECHONL, b);
+#else
+      return 0;
+#endif
+    case lnoflsh:
+#if defined(NOFLSH)
+      return doSetUnset (&t->c_lflag, NOFLSH, b);
+#else
+      return 0;
+#endif
+    case ltopstop:
+#if defined(TOSTOP)
+      return doSetUnset (&t->c_lflag, TOSTOP, b);
+#else
+      return 0;
+#endif
+    case lechoctl:
+#if defined(ECHOCTL)
+      return doSetUnset (&t->c_lflag, ECHOCTL, b);
+#else
+      return 0;
+#endif
+    case lechoprt:
+#if defined(ECHOPRT)
+      return doSetUnset (&t->c_lflag, ECHOPRT, b);
+#else
+      return 0;
+#endif
+    case lechoke:
+#if defined(ECHOKE)
+      return doSetUnset (&t->c_lflag, ECHOKE, b);
+#else
+      return 0;
+#endif
+    case lflusho:
+#if defined(FLUSHO)
+      return doSetUnset (&t->c_lflag, FLUSHO, b);
+#else
+      return 0;
+#endif
+    case lpendin:
+#if defined(PENDIN)
+      return doSetUnset (&t->c_lflag, PENDIN, b);
+#else
+      return 0;
+#endif
+    case liexten:
+#if defined(IEXTEN)
+      return doSetUnset (&t->c_lflag, IEXTEN, b);
+#else
+      return 0;
+#endif
+    }
+  return 0;
+}
+
+/* GetChar - sets a CHAR, ch, value from, t, and returns TRUE if this
+   value is supported.  */
+
+int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch)
+{
+  switch (c)
+    {
+
+    case vintr:
+#if defined(VINTR)
+      *ch = t->c_cc[VINTR];
+      return 1;
+#else
+      return 0;
+#endif
+    case vquit:
+#if defined(VQUIT)
+      *ch = t->c_cc[VQUIT];
+      return 1;
+#else
+      return 0;
+#endif
+    case verase:
+#if defined(VERASE)
+      *ch = t->c_cc[VERASE];
+      return 1;
+#else
+      return 0;
+#endif
+    case vkill:
+#if defined(VKILL)
+      *ch = t->c_cc[VKILL];
+      return 1;
+#else
+      return 0;
+#endif
+    case veof:
+#if defined(VEOF)
+      *ch = t->c_cc[VEOF];
+      return 1;
+#else
+      return 0;
+#endif
+    case vtime:
+#if defined(VTIME)
+      *ch = t->c_cc[VTIME];
+      return 1;
+#else
+      return 0;
+#endif
+    case vmin:
+#if defined(VMIN)
+      *ch = t->c_cc[VMIN];
+      return 1;
+#else
+      return 0;
+#endif
+    case vswtc:
+#if defined(VSWTC)
+      *ch = t->c_cc[VSWTC];
+      return 1;
+#else
+      return 0;
+#endif
+    case vstart:
+#if defined(VSTART)
+      *ch = t->c_cc[VSTART];
+      return 1;
+#else
+      return 0;
+#endif
+    case vstop:
+#if defined(VSTOP)
+      *ch = t->c_cc[VSTOP];
+      return 1;
+#else
+      return 0;
+#endif
+    case vsusp:
+#if defined(VSUSP)
+      *ch = t->c_cc[VSUSP];
+      return 1;
+#else
+      return 0;
+#endif
+    case veol:
+#if defined(VEOL)
+      *ch = t->c_cc[VEOL];
+      return 1;
+#else
+      return 0;
+#endif
+    case vreprint:
+#if defined(VREPRINT)
+      *ch = t->c_cc[VREPRINT];
+      return 1;
+#else
+      return 0;
+#endif
+    case vdiscard:
+#if defined(VDISCARD)
+      *ch = t->c_cc[VDISCARD];
+      return 1;
+#else
+      return 0;
+#endif
+    case vwerase:
+#if defined(VWERASE)
+      *ch = t->c_cc[VWERASE];
+      return 1;
+#else
+      return 0;
+#endif
+    case vlnext:
+#if defined(VLNEXT)
+      *ch = t->c_cc[VLNEXT];
+      return 1;
+#else
+      return 0;
+#endif
+    case veol2:
+#if defined(VEOL2)
+      *ch = t->c_cc[VEOL2];
+      return 1;
+#else
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+
+/* SetChar - sets a CHAR value in, t, and returns TRUE if, c, is
+   supported.  */
+
+int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch)
+{
+  switch (c)
+    {
+
+    case vintr:
+#if defined(VINTR)
+      t->c_cc[VINTR] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vquit:
+#if defined(VQUIT)
+      t->c_cc[VQUIT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case verase:
+#if defined(VERASE)
+      t->c_cc[VERASE] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vkill:
+#if defined(VKILL)
+      t->c_cc[VKILL] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veof:
+#if defined(VEOF)
+      t->c_cc[VEOF] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vtime:
+#if defined(VTIME)
+      t->c_cc[VTIME] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vmin:
+#if defined(VMIN)
+      t->c_cc[VMIN] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vswtc:
+#if defined(VSWTC)
+      t->c_cc[VSWTC] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vstart:
+#if defined(VSTART)
+      t->c_cc[VSTART] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vstop:
+#if defined(VSTOP)
+      t->c_cc[VSTOP] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vsusp:
+#if defined(VSUSP)
+      t->c_cc[VSUSP] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veol:
+#if defined(VEOL)
+      t->c_cc[VEOL] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vreprint:
+#if defined(VREPRINT)
+      t->c_cc[VREPRINT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vdiscard:
+#if defined(VDISCARD)
+      t->c_cc[VDISCARD] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vwerase:
+#if defined(VWERASE)
+      t->c_cc[VWERASE] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vlnext:
+#if defined(VLNEXT)
+      t->c_cc[VLNEXT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veol2:
+#if defined(VEOL2)
+      t->c_cc[VEOL2] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+
+void
+_M2_termios_init (void)
+{
+}
+
+void
+_M2_termios_finish (void)
+{
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/gm2-libs-ch/tools.c b/gcc/m2/gm2-libs-ch/tools.c
new file mode 100644
index 00000000000..da9fad47141
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/tools.c
@@ -0,0 +1,36 @@
+/* tools.c provide routines for the tools for stage2 build.
+
+Copyright (C) 2010-2022 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"
+#include "ansidecl.h"
+
+void
+fancy_abort (char const*, int, char const*)
+{
+  fprintf (stderr, "fancy_abort called\n");
+  exit (1);
+}
diff --git a/gcc/m2/gm2-libs-ch/wrapc.c b/gcc/m2/gm2-libs-ch/wrapc.c
new file mode 100644
index 00000000000..37d327fc7d2
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/wrapc.c
@@ -0,0 +1,242 @@
+/* wrapc.c provide access to miscellaneous C library functions.
+
+Copyright (C) 2005-2022 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"
+#include "ansidecl.h"
+#include "math.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;
+}
+
+/* fileinode - returns the inode associated with a file, f.  */
+
+#if defined(HAVE_SYS_STAT_H)
+ino_t
+wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
+{
+  struct stat s;
+
+  if (fstat (f, (struct stat *)&s) == 0)
+    {
+      *low = (unsigned int)s.st_ino;
+      *high = (unsigned int)(s.st_ino >> (sizeof (unsigned int) * 8));
+      return 0;
+    }
+  else
+    return -1;
+}
+#else
+int
+wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
+{
+#error we need stat
+  *low = 0;
+  *high = 0;
+  return -1;
+}
+#endif
+
+/* 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
+}
+
+/* isfinite - provide non builtin alternative to the gcc builtin
+   isfinite.  Returns 1 if x is finite and 0 if it is not.  */
+
+int
+wrapc_isfinite (double x)
+{
+  return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
+}
+
+/* isfinitel - provide non builtin alternative to the gcc builtin
+   isfinite.  Returns 1 if x is finite and 0 if it is not.  */
+
+int
+wrapc_isfinitel (long double x)
+{
+  return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
+}
+
+/* isfinitef - provide non builtin alternative to the gcc builtin
+   isfinite.  Returns 1 if x is finite and 0 if it is not.  */
+
+int
+wrapc_isfinitef (float x)
+{
+  return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
+}
+
+/* init - init/finish functions for the module */
+
+void
+_M2_wrapc_init ()
+{
+}
+
+void
+_M2_wrapc_finish ()
+{
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/gm2-libs-ch/xlibc.c b/gcc/m2/gm2-libs-ch/xlibc.c
new file mode 100644
index 00000000000..5d6c7482aef
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/xlibc.c
@@ -0,0 +1,48 @@
+/* xlibc.c allow access to some poisoned functions.
+
+Copyright (C) 2010-2022 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"
+#include "ansidecl.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+char *
+xstrdup (char *src)
+{
+  char *dst = (char *) malloc (strlen (src) + 1);
+
+  if (dst == NULL)
+    return NULL;
+  strcpy (dst, src);
+  return dst;
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/gm2-libs-coroutines/Debug.def b/gcc/m2/gm2-libs-coroutines/Debug.def
new file mode 100644
index 00000000000..b3a86ac7fe8
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/Debug.def
@@ -0,0 +1,79 @@
+(* Debug.def provides some simple debugging routines.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+DEFINITION MODULE Debug ;
+
+(*
+    Title      : Debug
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Sat Aug 13 19:41:57 1994
+    Last edit  : Sat Aug 13 19:41:57 1994
+    Description: provides some simple debugging routines.
+*)
+
+EXPORT QUALIFIED Halt, DebugString, PushOutput ;
+
+TYPE
+   WriteP = PROCEDURE (CHAR) ;
+
+
+(*
+   Halt - writes a message in the format:
+          Module:Line:Message
+
+          It then terminates by calling HALT.
+*)
+
+PROCEDURE Halt (File    : ARRAY OF CHAR;
+                LineNo  : CARDINAL;
+                Function,
+                Message : ARRAY OF CHAR) ;
+
+
+(*
+   DebugString - writes a string to the debugging device (Scn.Write).
+                 It interprets \n as carriage return, linefeed.
+*)
+
+PROCEDURE DebugString (a: ARRAY OF CHAR) ;
+
+
+(*
+   PushOutput - pushes the output procedure, p, which is used Debug.
+*)
+
+PROCEDURE PushOutput (p: WriteP) ;
+
+
+(*
+   PopOutput - pops the current output procedure from the stack.
+*)
+
+PROCEDURE PopOutput ;
+
+
+END Debug.
diff --git a/gcc/m2/gm2-libs-coroutines/Debug.mod b/gcc/m2/gm2-libs-coroutines/Debug.mod
new file mode 100644
index 00000000000..2f0337496b2
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/Debug.mod
@@ -0,0 +1,180 @@
+(* Debug.mod provides some simple debugging routines.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+IMPLEMENTATION MODULE Debug ;
+
+
+FROM ASCII IMPORT cr, nul, lf ;
+FROM NumberIO IMPORT CardToStr ;
+FROM libc IMPORT exit, write ;
+FROM SYSTEM IMPORT ADR ;
+
+
+CONST
+   MaxStack = 10 ;
+
+VAR
+   Stack: ARRAY [1..MaxStack] OF WriteP ;
+   Ptr  : CARDINAL ;
+
+
+PROCEDURE Write (ch: CHAR) ;
+BEGIN
+   IF Ptr>0
+   THEN
+      Stack[Ptr](ch)
+   ELSE
+      LocalWrite(ch)
+   END
+END Write ;
+
+
+PROCEDURE LocalWrite (ch: CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   r := write(2, ADR(ch), 1)
+END LocalWrite ;
+
+
+(*
+   PushOutput - pushes the output procedure, p, which is used Debug.
+*)
+
+PROCEDURE PushOutput (p: WriteP) ;
+BEGIN
+   IF Ptr=MaxStack
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__, 'stack exceeded')
+   ELSE
+      INC(Ptr) ;
+      Stack[Ptr] := p
+   END
+END PushOutput ;
+
+
+(*
+   PopOutput - pops the current output procedure from the stack.
+*)
+
+PROCEDURE PopOutput ;
+BEGIN
+   IF Ptr>1
+   THEN
+      DEC(Ptr)
+   END
+END PopOutput ;
+
+
+(*
+   Halt - writes a message in the format:
+          Module:Line:Message
+
+          It then terminates by calling HALT.
+*)
+
+PROCEDURE Halt (File    : ARRAY OF CHAR;
+                LineNo  : CARDINAL;
+                Function,
+                Message : ARRAY OF CHAR) ;
+CONST
+   MaxNoOfDigits = 12 ;  (* should be large enough for most source files.. *)
+VAR
+   No               : ARRAY [0..MaxNoOfDigits] OF CHAR ;
+BEGIN
+   DebugString(File) ;
+   CardToStr(LineNo, 0, No) ;
+   DebugString(':') ;
+   DebugString(No) ;
+   DebugString(':') ;
+   DebugString(Function) ;
+   DebugString(':') ;
+   DebugString(Message) ;
+   DebugString('\n') ;
+   HALT
+END Halt ;
+
+
+(*
+   DebugString - writes a string to the debugging device (Scn.Write).
+                 It interprets \n as carriage return, linefeed.
+*)
+
+PROCEDURE DebugString (a: ARRAY OF CHAR) ;
+VAR
+   n, high: CARDINAL ;
+BEGIN
+   high := HIGH( a ) ;
+   n := 0 ;
+   WHILE (n <= high) AND (a[n] # nul) DO
+      IF a[n]='\'
+      THEN
+         IF n+1<=high
+         THEN
+            IF a[n+1]='n'
+            THEN
+               WriteLn ;
+               INC(n)
+            ELSIF a[n+1]='\'
+            THEN
+               Write('\') ;
+               INC(n)
+            END
+         END
+      ELSE
+         Write( a[n] )
+      END ;
+      INC( n )
+   END
+END DebugString ;
+
+
+(*
+   WriteLn - writes a carriage return and a newline
+             character.
+*)
+
+PROCEDURE WriteLn ;
+BEGIN
+   Write(cr) ;
+   Write(lf)
+END WriteLn ;
+
+
+(*
+   Init - initialises this module.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   Ptr := 0 ;
+   PushOutput(LocalWrite)
+END Init ;
+
+
+BEGIN
+   Init
+END Debug.
diff --git a/gcc/m2/gm2-libs-coroutines/Executive.def b/gcc/m2/gm2-libs-coroutines/Executive.def
new file mode 100644
index 00000000000..d8eef70438c
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/Executive.def
@@ -0,0 +1,152 @@
+(* Executive.def provides a simple multitasking executive.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+DEFINITION MODULE Executive ;
+
+EXPORT QUALIFIED SEMAPHORE, DESCRIPTOR,
+                 InitProcess, KillProcess, Resume, Suspend, InitSemaphore,
+                 Wait, Signal, WaitForIO, Ps, GetCurrentProcess,
+                 RotateRunQueue, ProcessName, DebugProcess ;
+
+TYPE
+   SEMAPHORE ;         (* defines Dijkstra's semaphores *)
+   DESCRIPTOR ;        (* handle onto a process         *)
+
+
+(*
+   InitProcess - initializes a process which is held in the suspended
+                 state. When the process is resumed it will start executing
+                 procedure, p. The process has a maximum stack size of,
+                 StackSize, bytes and its textual name is, Name.
+                 The StackSize should be at least 5000 bytes.
+*)
+
+PROCEDURE InitProcess (p: PROC; StackSize: CARDINAL;
+                       Name: ARRAY OF CHAR) : DESCRIPTOR ;
+
+
+(*
+   KillProcess - kills the current process. Notice that if InitProcess
+                 is called again, it might reuse the DESCRIPTOR of the
+                 killed process. It is the responsibility of the caller
+                 to ensure all other processes understand this process
+                 is different.
+*)
+
+PROCEDURE KillProcess ;
+
+
+(*
+   Resume - resumes a suspended process. If all is successful then the process, p,
+            is returned. If it fails then NIL is returned.
+*)
+
+PROCEDURE Resume (d: DESCRIPTOR) : DESCRIPTOR ;
+
+
+(*
+   Suspend - suspend the calling process.
+             The process can only continue running if another process
+             Resumes it.
+*)
+
+PROCEDURE Suspend ;
+
+
+(*
+   InitSemaphore - creates a semaphore whose initial value is, v, and
+                   whose name is, Name.
+*)
+
+PROCEDURE InitSemaphore (v: CARDINAL; Name: ARRAY OF CHAR) : SEMAPHORE ;
+
+
+(*
+   Wait - performs dijkstra's P operation on a semaphore.
+          A process which calls this procedure will
+          wait until the value of the semaphore is > 0
+          and then it will decrement this value.
+*)
+
+PROCEDURE Wait (s: SEMAPHORE) ;
+
+
+(*
+   Signal - performs dijkstra's V operation on a semaphore.
+            A process which calls the procedure will increment
+            the semaphores value.
+*)
+
+PROCEDURE Signal (s: SEMAPHORE) ;
+
+
+(*
+   WaitForIO - waits for an interrupt to occur on vector, VectorNo.
+*)
+
+PROCEDURE WaitForIO (VectorNo: CARDINAL) ;
+
+
+(*
+   Ps - displays a process list together with process status.
+*)
+
+PROCEDURE Ps ;
+
+
+(*
+   GetCurrentProcess - returns the descriptor of the current running
+                       process.
+*)
+
+PROCEDURE GetCurrentProcess () : DESCRIPTOR ;
+
+
+(*
+   RotateRunQueue - rotates the process run queue.
+                    It does not call the scheduler.
+*)
+
+PROCEDURE RotateRunQueue ;
+
+
+(*
+   ProcessName - displays the name of process, d, through
+                 DebugString.
+*)
+
+PROCEDURE ProcessName (d: DESCRIPTOR) ;
+
+
+(*
+   DebugProcess - gdb debug handle to enable users to debug deadlocked
+                  semaphore processes.
+*)
+
+PROCEDURE DebugProcess (d: DESCRIPTOR) ;
+
+
+END Executive.
diff --git a/gcc/m2/gm2-libs-coroutines/Executive.mod b/gcc/m2/gm2-libs-coroutines/Executive.mod
new file mode 100644
index 00000000000..be95b82bc33
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/Executive.mod
@@ -0,0 +1,962 @@
+(* Executive.mod provides a simple multitasking executive.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+IMPLEMENTATION MODULE Executive[MAX(PROTECTION)] ;
+
+FROM SYSTEM IMPORT ADDRESS, PROCESS, LISTEN, ADR,
+                   NEWPROCESS, TRANSFER, IOTRANSFER, ListenLoop,
+                   TurnInterrupts ;
+
+FROM COROUTINES IMPORT PROTECTION ;
+FROM SysStorage IMPORT ALLOCATE, DEALLOCATE ;
+FROM StrLib IMPORT StrCopy ;
+FROM StrLib IMPORT StrLen ;
+FROM NumberIO IMPORT CardToStr ;
+FROM Debug IMPORT DebugString, Halt ;
+
+
+(* IMPORT gdb ; *)
+
+
+CONST
+   MaxCharsInName = 15 ;
+   IdleStackSize  = 16 * 1024 * 1024 ;
+
+TYPE
+   SEMAPHORE = POINTER TO Semaphore ;         (* defines dijkstra's semaphores *)
+   Semaphore = RECORD
+                  Value  : CARDINAL ;         (* semaphore value               *)
+                  SemName: EntityName ;       (* semaphore name for debugging  *)
+                  Who    : DESCRIPTOR ;       (* queue of waiting processes    *)
+                  ExistsQ: SemQueue ;         (* list of existing semaphores   *)
+               END ;
+
+   DESCRIPTOR= POINTER TO Descriptor ;        (* handle onto a process         *)
+   Descriptor= RECORD
+                  Volatiles  : PROCESS ;      (* process volatile environment  *)
+                  ReadyQ     : DesQueue ;     (* queue of ready processes      *)
+                  ExistsQ    : DesQueue ;     (* queue of existing processes   *)
+                  SemaphoreQ : DesQueue ;     (* queue of waiting processes    *)
+                  Which      : SEMAPHORE ;    (* which semaphore are we waiting*)
+                  RunName    : EntityName ;   (* process name for debugging    *)
+                  Status     : State ;        (* state of process              *)
+                  RunPriority: Priority ;     (* runtime priority of process   *)
+                  Size       : CARDINAL ;     (* Maximum stack size            *)
+                  Start      : ADDRESS ;      (* Stack start                   *)
+                  Debugged   : BOOLEAN ;      (* Does user want to debug a     *)
+                                              (* deadlocked process?           *)
+               END ;
+
+   DesQueue  = RECORD
+                  Right,
+                  Left : DESCRIPTOR ;
+               END ;
+
+   SemQueue  = RECORD
+                  Right,
+                  Left : SEMAPHORE ;
+               END ;
+
+   EntityName= ARRAY [0..MaxCharsInName] OF CHAR ;
+
+   Priority  = (idle, lo, hi) ;               (* process run priority          *)
+
+   State     = (Runnable, Suspended, WaitOnSem, WaitOnInt) ;
+
+VAR
+   ExistsQueue   : DESCRIPTOR ;               (* List of existing processes    *)
+   RunQueue      : ARRAY Priority OF DESCRIPTOR ;
+                                              (* List of runnable processes    *)
+   CurrentProcess: DESCRIPTOR ;
+   AllSemaphores : SEMAPHORE ;                (* List of all semaphores        *)
+   GarbageItem   : DESCRIPTOR ;               (* Descriptor destined to free   *)
+
+
+(*
+   Assert -
+*)
+
+PROCEDURE Assert (c: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL;
+                  function: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT c
+   THEN
+      Ps ;
+      Halt(file, line, function, 'assert failed')
+   END
+END Assert ;
+
+
+(*
+   InitProcess - initializes a process which is held in the suspended
+                 state. When the process is resumed it will start executing
+                 procedure, p. The process has a maximum stack size of,
+                 StackSize, bytes and its textual name is, Name.
+                 The StackSize should be at least 5000 bytes.
+*)
+
+PROCEDURE InitProcess (p: PROC;
+                       StackSize: CARDINAL;
+                       Name: ARRAY OF CHAR) : DESCRIPTOR ;
+VAR
+   d         : DESCRIPTOR ;
+   ToOldState: PROTECTION ;
+   db        : ARRAY [0..80] OF CHAR ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   NEW(d) ;
+   WITH d^ DO
+      Size        := StackSize ;
+                                 (* allocate space for this processes stack *)
+      ALLOCATE(Start, StackSize) ;
+      NEWPROCESS(p, Start, StackSize, Volatiles) ;  (* create volatiles     *)
+      InitQueue(ReadyQ) ;        (* not on the ready queue as suspended     *)
+      AddToExists(d) ;           (* add process to the exists queue         *)
+      InitQueue(SemaphoreQ) ;    (* not on a semaphore queue yet            *)
+      Which       := NIL ;       (* not on a semaphore queue yet            *)
+      StrCopy(Name, RunName) ;   (* copy name into descriptor for debugging *)
+      Status      := Suspended ; (* this process will be suspended          *)
+      RunPriority := lo ;        (* all processes start off at lo priority  *)
+      Debugged    := FALSE ;     (* no need to debug deadlock yet!          *)
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN( d )                   (* and return a descriptor to the caller   *)
+END InitProcess ;
+
+
+(*
+   KillProcess - kills the current process. Notice that if InitProcess
+                 is called again, it might reuse the DESCRIPTOR of the
+                 killed process. It is the responsibility of the caller
+                 to ensure all other processes understand this process
+                 is different.
+*)
+
+PROCEDURE KillProcess ;
+VAR
+   ToOldState: PROTECTION ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;    (* disable interrupts *) *)
+   SubFromReady(CurrentProcess) ;
+   SubFromExists(ExistsQueue, CurrentProcess) ;
+   GarbageItem := CurrentProcess ;
+   Reschedule ;
+(* ToOldState := TurnInterrupts(ToOldState)         (* restore interrupts *) *)
+END KillProcess ;
+
+
+(*
+   Resume - resumes a suspended process. If all is successful then the process, p,
+            is returned. If it fails then NIL is returned.
+*)
+
+PROCEDURE Resume (d: DESCRIPTOR) : DESCRIPTOR ;
+VAR
+   ToOldState: PROTECTION ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+
+   (* your code needs to go here *)
+   WITH d^ DO                                                                  (* remove for student *)
+      IF Status=Suspended                                                      (* remove for student *)
+      THEN                                                                     (* remove for student *)
+         (* legal state transition *)                                          (* remove for student *)
+         Status := Runnable ;                         (* change status      *) (* remove for student *)
+         AddToReady(d) ;                              (* add to run queue   *) (* remove for student *)
+         RunQueue[RunPriority] := d ;                 (* make d at top of q *) (* remove for student *)
+         Reschedule (* check whether this process has a higher run priority *) (* remove for student *)
+      ELSE                                                                     (* remove for student *)
+         (* we are trying to Resume a process which is *)                      (* remove for student *)
+         Halt(__FILE__, __LINE__, __FUNCTION__,                                (* remove for student *)
+              'trying to resume a process which is not suspended') ;           (* remove for student *)
+         RETURN( NIL )        (* not held in a Suspended state - error      *) (* remove for student *)
+      END                                                                      (* remove for student *)
+   END ;                                                                       (* remove for student *)
+(* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN( d )
+END Resume ;
+
+
+(*
+   Suspend - suspend the calling process.
+             The process can only continue running if another process
+             Resumes it.
+*)
+
+PROCEDURE Suspend ;
+VAR
+   ToOldState: PROTECTION ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   WITH CurrentProcess^ DO
+      Status := Suspended
+   END ;
+   SubFromReady(CurrentProcess) ;
+   Reschedule ;
+(* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
+END Suspend ;
+
+
+(*
+   InitSemaphore - creates a semaphore whose initial value is, v, and
+                   whose name is, Name.
+*)
+
+PROCEDURE InitSemaphore (v: CARDINAL; Name: ARRAY OF CHAR) : SEMAPHORE ;
+VAR
+   s         : SEMAPHORE ;
+   ToOldState: PROTECTION ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   NEW(s) ;
+   WITH s^ DO
+      Value := v ;                  (* initial value of semaphore           *)
+      StrCopy(Name, SemName) ;      (* save the name for future debugging   *)
+      Who := NIL ;                  (* no one waiting on this semaphore yet *)
+      AddToSemaphoreExists(s) ;     (* add semaphore to exists list         *)
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN( s )
+END InitSemaphore ;
+
+
+(*
+   Wait - performs dijkstra's P operation on a semaphore.
+          A process which calls this procedure will
+          wait until the value of the semaphore is > 0
+          and then it will decrement this value.
+*)
+
+PROCEDURE Wait (s: SEMAPHORE) ;
+VAR
+   ToOldState: PROTECTION ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+
+   (* your code needs to go here *)
+   WITH s^ DO                                                                  (* remove for student *)
+      IF Value>0                                                               (* remove for student *)
+      THEN                                                                     (* remove for student *)
+         DEC( Value )                                                          (* remove for student *)
+      ELSE                                                                     (* remove for student *)
+         SubFromReady(CurrentProcess) ;               (* remove from run q  *) (* remove for student *)
+         IF Who=CurrentProcess
+         THEN
+            Ps ;
+            Halt(__FILE__, __LINE__, __FUNCTION__, 'we are already on sem')
+         END ;
+         AddToSemaphore(Who, CurrentProcess) ;        (* add to semaphore q *) (* remove for student *)
+         CurrentProcess^.Status := WaitOnSem ;        (* set new status     *) (* remove for student *)
+         CurrentProcess^.Which := s ;                 (* debugging aid      *) (* remove for student *)
+         Reschedule                                   (* find next process  *) (* remove for student *)
+      END                                                                      (* remove for student *)
+   END ;                                                                       (* remove for student *)
+(* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
+END Wait ;
+
+
+(*
+   Signal - performs dijkstra's V operation on a semaphore.
+            A process which calls the procedure will increment
+            the semaphores value.
+*)
+
+PROCEDURE Signal (s: SEMAPHORE) ;
+VAR
+   ToOldState: PROTECTION ;
+   d         : DESCRIPTOR ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   WITH s^ DO
+      IF Who=NIL
+      THEN
+         INC( Value )                                 (* no process waiting *)
+      ELSE
+         d := SubFromSemaphoreTop(Who) ; (* remove process from semaphore q *)
+         d^.Which := NIL ;              (* no longer waiting on semaphore   *)
+         d^.Status := Runnable ;        (* set new status                   *)
+         AddToReady(d) ;                (* add process to the run queue     *)
+         Reschedule                     (* find out whether there is a      *)
+                                        (* higher priority to run.          *)
+      END
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
+END Signal ;
+
+
+(*
+   WaitForIO - waits for an interrupt to occur on vector, VectorNo.
+*)
+
+PROCEDURE WaitForIO (VectorNo: CARDINAL) ;
+VAR
+   Calling   : DESCRIPTOR ;
+   Next      : PROCESS ;
+   ToOldState: PROTECTION ;
+   r         : INTEGER ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
+(*
+   DebugString('inside WaitForIO ') ;
+   DebugString(CurrentProcess^.RunName) ;
+   DebugString('\n') ;
+*)
+   Assert(CurrentProcess^.Status=Runnable,
+          __FILE__, __LINE__, __FUNCTION__) ;
+   SubFromReady(CurrentProcess) ;   (* remove process from run queue *)
+   (*
+      alter run priority to hi as all processes waiting for an interrupt
+      are scheduled to run at the highest priority.
+   *)
+   WITH CurrentProcess^ DO
+      Status := WaitOnInt ;   (* it will be blocked waiting for an interrupt.  *)
+      RunPriority := hi ;     (* this (hopefully) allows it to run as soon as  *)
+                              (* the interrupt occurs.                         *)
+   END ;
+   Calling := CurrentProcess ;      (* process which called WaitForIO          *)
+   CurrentProcess := NextReady() ;  (* find next process to run while we wait  *)
+   Next := CurrentProcess^.Volatiles ;
+   (*
+      This is quite complicated. We transfer control to the next process saving
+      our volatile environment into the Calling process descriptor volatiles.
+      When an interrupt occurs the calling process will be resumed and the
+      interrupted process volatiles will be placed into Next.
+   *)
+   IOTRANSFER(Calling^.Volatiles, Next, VectorNo) ;
+
+   (*
+      At this point the interrupt has just occurred and the volatiles of
+      the interrupted process are in Next. Next is the current process
+      and so we must save them before picking up the Calling descriptor.
+   *)
+
+   CurrentProcess^.Volatiles := Next ;             (* carefully stored away *)
+   CurrentProcess := Calling ;                     (* update CurrentProcess *)
+(*
+   DebugString(CurrentProcess^.RunName) ;
+*)
+   CurrentProcess^.Status := Runnable ;            (* add to run queue      *)
+   AddToReady(CurrentProcess) ;
+(*
+   DebugString(' finishing WaitForIO\n') ;
+*)
+
+(* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
+END WaitForIO ;
+
+
+(*
+   Ps - displays a process list together with relevant their status.
+*)
+
+PROCEDURE Ps ;
+VAR
+   ToOldState: PROTECTION ;
+   p         : DESCRIPTOR ;
+   s         : SEMAPHORE ;
+   a         : ARRAY [0..5] OF CHAR ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   p := ExistsQueue ;
+   IF p#NIL
+   THEN
+      REPEAT
+         DisplayProcess(p) ;
+         p := p^.ExistsQ.Right
+      UNTIL p=ExistsQueue
+   END ;
+   s := AllSemaphores ;
+   IF s#NIL
+   THEN
+      REPEAT
+         WITH s^ DO
+            DebugString(SemName) ;
+            WriteNSpaces(MaxCharsInName-StrLen(SemName)) ;
+            CardToStr(Value, 0, a) ;
+            DebugString(a) ;
+            DebugString('\n')
+         END ;
+         s := s^.ExistsQ.Right
+      UNTIL s=AllSemaphores
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
+END Ps ;
+
+
+(*
+   DisplayProcess - displays the process, p, together with its status.
+*)
+
+PROCEDURE DisplayProcess (p: DESCRIPTOR) ;
+VAR
+   a: ARRAY [0..4] OF CHAR ;
+BEGIN
+   WITH p^ DO
+      DebugString(RunName) ; WriteNSpaces(MaxCharsInName-StrLen(RunName)) ;
+      CASE RunPriority OF
+
+      idle: DebugString(' idle ') |
+      lo  : DebugString(' lo   ') |
+      hi  : DebugString(' hi   ')
+
+      END ;
+      CASE Status OF
+
+      Runnable : DebugString('runnable ') |
+      Suspended: DebugString('suspended') |
+      WaitOnSem: DebugString('waitonsem   (') ;
+                 DebugString(Which^.SemName) ;
+                 DebugString(')') |
+      WaitOnInt: DebugString('waitonint')
+
+      END ;
+      DebugString('\n')
+   END
+END DisplayProcess ;
+
+
+(*
+   WriteNSpaces - writes, n, spaces.
+*)
+
+PROCEDURE WriteNSpaces (n: CARDINAL) ;
+BEGIN
+   WHILE n>0 DO
+      DebugString(' ') ;
+      DEC(n)
+   END
+END WriteNSpaces ;
+
+
+(*
+   GetCurrentProcess - returns the descriptor of the current running
+                       process.
+*)
+
+PROCEDURE GetCurrentProcess () : DESCRIPTOR ;
+VAR
+   ToOldState: PROTECTION ;
+   p         : DESCRIPTOR ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;      (* disable interrupts *) *)
+   p := CurrentProcess ;
+(* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN( p )
+END GetCurrentProcess ;
+
+
+(*
+   RotateRunQueue - rotates the process run queue.
+*)
+
+PROCEDURE RotateRunQueue ;
+VAR
+   ToOldState: PROTECTION ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   (* we only need to rotate the lo priority processes as:
+      idle - should only have one process (the idle process)
+      hi   - are the device drivers which most of the time are performing
+             WaitForIO
+   *)
+   IF RunQueue[lo]#NIL
+   THEN
+      RunQueue[lo] := RunQueue[lo]^.ReadyQ.Right
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState)           (* restore interrupts *) *)
+END RotateRunQueue ;
+
+
+(*
+   ProcessName - displays the name of process, d, through
+                 DebugString.
+*)
+
+PROCEDURE ProcessName (d: DESCRIPTOR) ;
+BEGIN
+   DebugString(d^.RunName)
+END ProcessName ;
+
+
+(*
+   DebugProcess -
+*)
+
+PROCEDURE DebugProcess (d: DESCRIPTOR) ;
+VAR
+   ToOldState: PROTECTION ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
+   WITH d^ DO
+      IF Status=WaitOnSem
+      THEN
+         DebugString('debugging process (') ;
+         DebugString(RunName) ;
+         DebugString(') was waiting on semaphore (') ;
+         DebugString(Which^.SemName) ;
+         DebugString(')\n') ;
+         SubFromSemaphore(Which^.Who, d) ;
+         AddToReady(d) ;
+         Status := Runnable ;
+         Debugged := TRUE ;
+         Reschedule
+      ELSE
+         DebugString('can only debug deadlocked processes (') ;
+         DebugString(RunName) ;
+         DebugString(') which are waiting on a semaphore\n')
+      END
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState) *)
+END DebugProcess ;
+
+
+(*
+   CheckDebugged - checks to see whether the debugged flag has
+                   been set by the debugger.
+                   TRUE  is returned if the process was debugged.
+                   FALSE is returned if the process was not debugged.
+*)
+
+PROCEDURE CheckDebugged () : BOOLEAN ;
+BEGIN
+   WITH CurrentProcess^ DO
+      IF Debugged
+      THEN
+         (*
+            You will see this comment after you have enabled a
+            deadlocked process to continue via the gdb command:
+
+            print Executive_DebugProcess(d)
+
+            debugger caused deadlocked process to continue
+         *)
+         (* gdb.breakpoint ; *)
+         Debugged := FALSE ;
+         SubFromReady(CurrentProcess) ;
+         AddToSemaphore(Which^.Who, CurrentProcess) ;
+                                           (* add it back to the queue sem *)
+         Status := WaitOnSem ;
+
+         RETURN( TRUE )
+      END
+   END ;
+   RETURN( FALSE )
+END CheckDebugged ;
+
+
+(*
+   Reschedule - reschedules to the highest runnable process.
+*)
+
+PROCEDURE Reschedule ;
+BEGIN
+   (*
+      the repeat loop allows us to debug a process even when it is
+      technically waiting on a semaphore. We run the process into
+      a breakpoint and then back into this schedule routine.
+      This is really useful when trying to find out why processes have
+      deadlocked.
+   *)
+   REPEAT
+      ScheduleProcess
+   UNTIL NOT CheckDebugged()
+END Reschedule ;
+
+
+(*
+   ScheduleProcess - finds the highest priority Runnable process and
+                     then transfers control to it.
+*)
+
+PROCEDURE ScheduleProcess ;
+VAR
+   From,
+   Highest: DESCRIPTOR ;
+BEGIN
+   Highest := NextReady() ;
+
+   (* rotate ready Q to ensure fairness *)
+   RunQueue[Highest^.RunPriority] := Highest^.ReadyQ.Right ;
+
+   (* no need to transfer if Highest=CurrentProcess *)
+   IF Highest#CurrentProcess
+   THEN
+      From := CurrentProcess ;
+(*
+      DebugString('context switching from ') ; DebugString(From^.RunName) ;
+*)
+      (* alter CurrentProcess before we TRANSFER *)
+      CurrentProcess := Highest ;
+(*
+      DebugString(' to ') ; DebugString(CurrentProcess^.RunName) ;
+*)
+
+      TRANSFER(From^.Volatiles, Highest^.Volatiles) ;
+(*
+      ; DebugString(' (') ; DebugString(CurrentProcess^.RunName) ;
+      DebugString(')\n') ;
+*)
+      CheckGarbageCollect
+   END
+END ScheduleProcess ;
+
+
+(*
+   NextReady - returns the highest priority Runnable process.
+*)
+
+PROCEDURE NextReady () : DESCRIPTOR ;
+VAR
+   Highest: DESCRIPTOR ;
+   Pri    : Priority ;
+BEGIN
+   Highest := NIL ;
+   FOR Pri := idle TO hi DO
+      IF RunQueue[Pri]#NIL
+      THEN
+         Highest := RunQueue[Pri]
+      END
+   END ;
+   Assert(Highest#NIL, __FILE__, __LINE__, __FUNCTION__) ;
+   RETURN( Highest )
+END NextReady ;
+
+
+(*
+   CheckGarbageCollect - checks to see whether GarbageItem is set
+                         and if so it deallocates storage associated
+                         with this descriptor.
+*)
+
+PROCEDURE CheckGarbageCollect ;
+BEGIN
+   IF GarbageItem#NIL
+   THEN
+      WITH GarbageItem^ DO
+         DEALLOCATE(Start, Size)
+      END ;
+      DISPOSE(GarbageItem) ;
+      GarbageItem := NIL
+   END
+END CheckGarbageCollect ;
+
+
+(*
+   AddToExists - adds item, Item, to the exists queue.
+*)
+
+PROCEDURE AddToExists (Item: DESCRIPTOR) ;
+BEGIN
+   IF ExistsQueue=NIL
+   THEN
+      ExistsQueue := Item ;                  (* Head is empty therefore make *)
+      Item^.ExistsQ.Left := Item ;           (* Item the only entry on this  *)
+      Item^.ExistsQ.Right := Item            (* queue.                       *)
+   ELSE
+      Item^.ExistsQ.Right := ExistsQueue ;   (* Add Item to the end of queue *)
+      Item^.ExistsQ.Left  := ExistsQueue^.ExistsQ.Left ;
+      ExistsQueue^.ExistsQ.Left^.ExistsQ.Right := Item ;
+      ExistsQueue^.ExistsQ.Left := Item
+   END
+END AddToExists ;
+
+
+(*
+   SubFromExists - removes a process, Item, from the exists queue, Head.
+*)
+
+PROCEDURE SubFromExists (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
+BEGIN
+   IF (Item^.ExistsQ.Right=Head) AND (Item=Head)
+   THEN
+      Head := NIL
+   ELSE
+      IF Head=Item
+      THEN
+         Head := Head^.ExistsQ.Right
+      END ;
+      Item^.ExistsQ.Left^.ExistsQ.Right := Item^.ExistsQ.Right ;
+      Item^.ExistsQ.Right^.ExistsQ.Left := Item^.ExistsQ.Left
+   END
+END SubFromExists ;
+
+
+(*
+   AddToSemaphore - adds item, Item, to the semaphore queue defined by Head.
+*)
+
+PROCEDURE AddToSemaphore (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
+BEGIN
+   IF Head=NIL
+   THEN
+      Head := Item ;                         (* Head is empty therefore make *)
+      Item^.SemaphoreQ.Left := Item ;        (* Item the only entry on this  *)
+      Item^.SemaphoreQ.Right := Item         (* queue.                       *)
+   ELSE
+      Item^.SemaphoreQ.Right := Head ;       (* Add Item to the end of queue *)
+      Item^.SemaphoreQ.Left  := Head^.SemaphoreQ.Left ;
+      Head^.SemaphoreQ.Left^.SemaphoreQ.Right := Item ;
+      Head^.SemaphoreQ.Left := Item
+   END
+END AddToSemaphore ;
+
+
+(*
+   AddToSemaphoreExists - adds item, Item, to the semaphore exists queue.
+*)
+
+PROCEDURE AddToSemaphoreExists (Item: SEMAPHORE) ;
+BEGIN
+   IF AllSemaphores=NIL
+   THEN
+      AllSemaphores := Item ;                (* Head is empty therefore make *)
+      Item^.ExistsQ.Left := Item ;           (* Item the only entry on this  *)
+      Item^.ExistsQ.Right := Item            (* queue.                       *)
+   ELSE
+      Item^.ExistsQ.Right := AllSemaphores ;
+                                             (* Add Item to the end of queue *)
+      Item^.ExistsQ.Left  := AllSemaphores^.ExistsQ.Left ;
+      AllSemaphores^.ExistsQ.Left^.ExistsQ.Right := Item ;
+      AllSemaphores^.ExistsQ.Left := Item
+   END
+END AddToSemaphoreExists ;
+
+
+(*
+   AddToReady - adds item, Item, to the ready queue.
+*)
+
+PROCEDURE AddToReady (Item: DESCRIPTOR) ;
+BEGIN
+   AddToReadyQ(RunQueue[Item^.RunPriority], Item)
+END AddToReady ;
+
+
+(*
+   AddToReadyQ - adds item, Item, to the ready queue defined by Head.
+*)
+
+PROCEDURE AddToReadyQ (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
+BEGIN
+   IF Head=NIL
+   THEN
+      Head := Item ;                         (* Head is empty therefore make *)
+      Item^.ReadyQ.Left := Item ;            (* Item the only entry on this  *)
+      Item^.ReadyQ.Right := Item             (* queue.                       *)
+   ELSE
+      Item^.ReadyQ.Right := Head ;           (* Add Item to the end of queue *)
+      Item^.ReadyQ.Left  := Head^.ReadyQ.Left ;
+      Head^.ReadyQ.Left^.ReadyQ.Right := Item ;
+      Head^.ReadyQ.Left := Item
+   END
+END AddToReadyQ ;
+
+
+(*
+   SubFromReady - subtract process descriptor, Item, from the Ready queue.
+*)
+
+PROCEDURE SubFromReady (Item: DESCRIPTOR) ;
+BEGIN
+   SubFromReadyQ(RunQueue[Item^.RunPriority], Item)
+END SubFromReady ;
+
+
+(*
+   SubFromReadyQ - removes a process, Item, from a queue, Head.
+*)
+
+PROCEDURE SubFromReadyQ (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
+BEGIN
+   IF (Item^.ReadyQ.Right=Head) AND (Item=Head)
+   THEN
+      Head := NIL
+   ELSE
+      IF Head=Item
+      THEN
+         Head := Head^.ReadyQ.Right
+      END ;
+      Item^.ReadyQ.Left^.ReadyQ.Right := Item^.ReadyQ.Right ;
+      Item^.ReadyQ.Right^.ReadyQ.Left := Item^.ReadyQ.Left
+   END
+END SubFromReadyQ ;
+
+
+(*
+   SubFromSemaphoreTop - returns the first descriptor in the
+                         semaphore queue.
+*)
+
+PROCEDURE SubFromSemaphoreTop (VAR Head: DESCRIPTOR) : DESCRIPTOR ;
+VAR
+   Top: DESCRIPTOR ;
+BEGIN
+   Top := Head ;
+   SubFromSemaphore(Head, Top) ;
+   RETURN( Top )
+END SubFromSemaphoreTop ;
+
+
+(*
+   SubFromSemaphore - removes a process, Item, from a queue, Head.
+*)
+
+PROCEDURE SubFromSemaphore (VAR Head: DESCRIPTOR; Item: DESCRIPTOR) ;
+BEGIN
+   IF (Item^.SemaphoreQ.Right=Head) AND (Item=Head)
+   THEN
+      Head := NIL
+   ELSE
+      IF Head=Item
+      THEN
+         Head := Head^.SemaphoreQ.Right
+      END ;
+      Item^.SemaphoreQ.Left^.SemaphoreQ.Right := Item^.SemaphoreQ.Right ;
+      Item^.SemaphoreQ.Right^.SemaphoreQ.Left := Item^.SemaphoreQ.Left
+   END
+END SubFromSemaphore ;
+
+
+(*
+   Idle - this process is only run whenever there is no other Runnable
+          process. It should never be removed from the run queue.
+*)
+
+PROCEDURE Idle ;
+VAR
+   ToOldState: PROTECTION ;
+BEGIN
+   ToOldState := TurnInterrupts(MIN(PROTECTION)) ;    (* enable interrupts *)
+   LOOP
+      (*
+         Listen for interrupts.
+         We could solve chess endgames here or calculate PI etc.
+         We forever wait for an interrupt since there is nothing else
+         to do...
+      *)
+      ListenLoop
+   END
+   (* we must NEVER exit from the above loop *)
+END Idle ;
+
+
+(*
+   InitIdleProcess - creates an idle process descriptor which
+                     is run whenever no other process is Runnable.
+                     The Idle process should be the only process which
+                     has the priority idle.
+*)
+
+VAR
+   IdleProcess: DESCRIPTOR ;              (* Idle process always runnable  *)
+
+PROCEDURE InitIdleProcess ;
+VAR
+   db         : ARRAY [0..80] OF CHAR ;
+BEGIN
+   NEW(IdleProcess) ;
+   WITH IdleProcess^ DO
+      ALLOCATE(Start, IdleStackSize) ;
+      Size := IdleStackSize ;
+      NEWPROCESS(Idle, Start, IdleStackSize, Volatiles) ;
+      InitQueue(SemaphoreQ) ;             (* not on a semaphore queue     *)
+      Which      := NIL ;                 (* at all.                      *)
+      StrCopy('Idle', RunName) ;          (* idle process's name          *)
+      Status := Runnable ;                (* should always be idle        *)
+      RunPriority := idle ;               (* lowest priority possible     *)
+      Debugged    := FALSE ;              (* should never be debugging    *)
+   END ;
+   AddToReady(IdleProcess) ;              (* should be the only           *)
+                                          (* process at this run priority *)
+   AddToExists(IdleProcess)               (* process now exists..         *)
+END InitIdleProcess ;
+
+
+(*
+   InitInitProcess - creates a descriptor for this running environment
+                     so it too can be manipulated by Reschedule.
+
+                     This concept is important to understand.
+                     InitInitProcess is called by the startup code to this
+                     module. It ensures that the current stack and processor
+                     volatiles can be "housed" in a process descriptor and
+                     therefore it can be manipulated just like any other
+                     process.
+*)
+
+PROCEDURE InitInitProcess ;
+BEGIN
+   NEW(CurrentProcess) ;
+   WITH CurrentProcess^ DO
+      Size := 0 ;              (* we dont know the size of main stack  *)
+      Start := NIL ;           (* we don't need to know where it is.   *)
+      InitQueue(ReadyQ) ;      (* assign queues to NIL                 *)
+      InitQueue(ExistsQ) ;
+      InitQueue(SemaphoreQ) ;  (* not waiting on a semaphore queue yet *)
+      Which       := NIL ;     (* at all.                              *)
+      StrCopy('Init', RunName) ;  (* name for debugging purposes       *)
+      Status      := Runnable ;   (* currently running                 *)
+      RunPriority := lo ;         (* default status                    *)
+      Debugged    := FALSE ;      (* not deadlock debugging yet        *)
+   END ;
+   AddToExists(CurrentProcess) ;
+   AddToReady(CurrentProcess)
+END InitInitProcess ;
+
+
+(*
+   InitQueue - initializes a queue, q, to empty.
+*)
+
+PROCEDURE InitQueue (VAR q: DesQueue) ;
+BEGIN
+   WITH q DO
+      Right := NIL ;
+      Left  := NIL
+   END
+END InitQueue ;
+
+
+(*
+   Init - initializes all the global variables.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   ExistsQueue := NIL ;
+   RunQueue[lo] := NIL ;
+   RunQueue[hi] := NIL ;
+   RunQueue[idle] := NIL ;
+   AllSemaphores := NIL ;
+   GarbageItem := NIL ;
+   InitInitProcess ;
+   InitIdleProcess
+END Init ;
+
+
+BEGIN
+   Init
+END Executive.
diff --git a/gcc/m2/gm2-libs-coroutines/KeyBoardLEDs.def b/gcc/m2/gm2-libs-coroutines/KeyBoardLEDs.def
new file mode 100644
index 00000000000..70054567d96
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/KeyBoardLEDs.def
@@ -0,0 +1,63 @@
+(* KeyBoardLEDs.def provides access to the keyboard LEDs under Linux.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+DEFINITION MODULE KeyBoardLEDs ;
+
+
+EXPORT QUALIFIED SwitchLeds,
+                 SwitchScroll, SwitchNum, SwitchCaps ;
+
+
+(*
+   SwitchLeds - switch the keyboard LEDs to the state defined
+                by the BOOLEAN variables. TRUE = ON.
+*)
+
+PROCEDURE SwitchLeds (NumLock, CapsLock, ScrollLock: BOOLEAN) ;
+
+
+(*
+   SwitchScroll - switchs the scroll LED on or off.
+*)
+
+PROCEDURE SwitchScroll (Scroll: BOOLEAN) ;
+
+
+(*
+   SwitchNum - switches the Num LED on or off.
+*)
+
+PROCEDURE SwitchNum (Num: BOOLEAN) ;
+
+
+(*
+   SwitchCaps - switches the Caps LED on or off.
+*)
+
+PROCEDURE SwitchCaps (Caps: BOOLEAN) ;
+
+
+END KeyBoardLEDs.
diff --git a/gcc/m2/gm2-libs-coroutines/README.texi b/gcc/m2/gm2-libs-coroutines/README.texi
new file mode 100644
index 00000000000..72a1db3b043
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/README.texi
@@ -0,0 +1,8 @@
+@c README.texi describes the PIM coroutine libraries.
+@c Copyright @copyright{} 2000-2022 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+This directory contains a PIM @code{SYSTEM} containing the
+@code{PROCESS} primitives built on top of @code{gthread}s.
diff --git a/gcc/m2/gm2-libs-coroutines/SYSTEM.def b/gcc/m2/gm2-libs-coroutines/SYSTEM.def
new file mode 100644
index 00000000000..d5650b60d01
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/SYSTEM.def
@@ -0,0 +1,278 @@
+(* SYSTEM.def provides access to COROUTINE primitives and underlying system.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+DEFINITION MODULE SYSTEM ;
+
+(* This module is designed to be used on a native operating system
+   rather than an embedded system as it implements the coroutine
+   primitives TRANSFER, IOTRANSFER and
+   NEWPROCESS through the GNU Pthread library.  *)
+
+FROM COROUTINES IMPORT PROTECTION ;
+
+EXPORT QUALIFIED (* the following are built into the compiler: *)
+                 ADDRESS, WORD, BYTE, CSIZE_T, CSSIZE_T, (* @SYSTEM_DATATYPES@ *)
+                 ADR, TSIZE, ROTATE, SHIFT, THROW, TBITSIZE,
+                 (* SIZE is exported depending upon -fpim2 and
+                    -fpedantic.  *)
+                 (* The rest are implemented in SYSTEM.mod.  *)
+                 PROCESS, TRANSFER, NEWPROCESS, IOTRANSFER,
+                 LISTEN,
+                 ListenLoop, TurnInterrupts,
+                 (* Internal GM2 compiler functions.  *)
+                 ShiftVal, ShiftLeft, ShiftRight,
+                 RotateVal, RotateLeft, RotateRight ;
+
+
+TYPE
+   PROCESS  = RECORD
+                 context: INTEGER ;
+              END ;
+
+(* Note that the full list of system and sized datatypes include:
+   LOC, WORD, BYTE, ADDRESS,
+
+   (and the non language standard target types)
+
+   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+   WORD16, WORD32, WORD64, BITSET8, BITSET16,
+   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
+   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.
+
+   Also note that the non-standard data types will
+   move into another module in the future.  *)
+
+(* The following types are supported on this target:
+   @SYSTEM_TYPES@
+*)
+
+
+(*
+   TRANSFER - save the current volatile environment into, p1.
+              Restore the volatile environment from, p2.
+*)
+
+PROCEDURE TRANSFER (VAR p1: PROCESS; p2: PROCESS) ;
+
+
+(*
+   NEWPROCESS - p is a parameterless procedure, a, is the origin of
+                the workspace used for the process stack and containing
+                the volatile environment of the process.  StackSize, is
+                the maximum size of the stack in bytes which can be used
+                by this process.  new, is the new process.
+*)
+
+PROCEDURE NEWPROCESS (p: PROC; a: ADDRESS; StackSize: CARDINAL; VAR new: PROCESS) ;
+
+
+(*
+   IOTRANSFER - saves the current volatile environment into, First,
+                and restores volatile environment, Second.
+                When an interrupt, InterruptNo, is encountered then
+                the reverse takes place.  (The then current volatile
+                environment is shelved onto Second and First is resumed).
+
+                NOTE: that upon interrupt the Second might not be the
+                      same process as that before the original call to
+                      IOTRANSFER.
+*)
+
+PROCEDURE IOTRANSFER (VAR First, Second: PROCESS; InterruptNo: CARDINAL) ;
+
+
+(*
+   LISTEN - briefly listen for any interrupts.
+*)
+
+PROCEDURE LISTEN ;
+
+
+(*
+   ListenLoop - should be called instead of users writing:
+
+                LOOP
+                   LISTEN
+                END
+
+                It performs the same function but yields
+                control back to the underlying operating system
+                via a call to pth_select.
+                It also checks for deadlock.
+                This function returns when an interrupt occurs ie
+                a file descriptor becomes ready or a time event
+                expires.  See the module RTint.
+*)
+
+PROCEDURE ListenLoop ;
+
+
+(*
+   TurnInterrupts - switches processor interrupts to the protection
+                    level, to.  It returns the old value.
+*)
+
+PROCEDURE TurnInterrupts (to: PROTECTION) : PROTECTION ;
+
+
+(*
+   all the functions below are declared internally to gm2
+   ====================================================
+
+PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
+  (* Returns the address of variable v. *)
+
+PROCEDURE SIZE (v: <type>) : ZType;
+  (* Returns the number of BYTES used to store a v of
+     any specified <type>.  Only available if -fpim2 is used.
+  *)
+
+PROCEDURE TSIZE (<type>) : CARDINAL;
+  (* Returns the number of BYTES used to store a value of the
+     specified <type>.
+  *)
+
+PROCEDURE ROTATE (val: <a set type>;
+                  num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by rotating up or down
+     (left or right) by the absolute value of num.  The direction is
+     down if the sign of num is negative, otherwise the direction is up.
+  *)
+
+PROCEDURE SHIFT (val: <a set type>;
+                 num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by shifting up or down
+     (left or right) by the absolute value of num, introducing
+     zeros as necessary.  The direction is down if the sign of
+     num is negative, otherwise the direction is up.
+  *)
+
+PROCEDURE THROW (i: INTEGER) ;
+  (*
+     THROW is a GNU extension and was not part of the PIM or ISO
+     standards.  It throws an exception which will be caught by the EXCEPT
+     block (assuming it exists).  This is a compiler builtin function which
+     interfaces to the GCC exception handling runtime system.
+     GCC uses the term throw, hence the naming distinction between
+     the GCC builtin and the Modula-2 runtime library procedure Raise.
+     The later library procedure Raise will call SYSTEM.THROW after
+     performing various housekeeping activities.
+  *)
+
+PROCEDURE TBITSIZE (<type>) : CARDINAL ;
+  (* Returns the minimum number of bits necessary to represent
+     <type>.  This procedure function is only useful for determining
+     the number of bits used for any type field within a packed RECORD.
+     It is not particularly useful elsewhere since <type> might be
+     optimized for speed, for example a BOOLEAN could occupy a WORD.
+  *)
+*)
+
+(* The following procedures are invoked by GNU Modula-2 to
+   shift non word sized set types.  They are not strictly part
+   of the core PIM Modula-2, however they are used
+   to implement the SHIFT procedure defined above,
+   which are in turn used by the Logitech compatible libraries.
+
+   Users will access these procedures by using the procedure
+   SHIFT above and GNU Modula-2 will map SHIFT onto one of
+   the following procedures.
+*)
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will
+              only call this routine for larger sets.
+*)
+
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*)
+
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM.  GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for
+               larger sets.
+*)
+
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known
+                at compile time.
+*)
+
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*)
+
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+
+
+END SYSTEM.
diff --git a/gcc/m2/gm2-libs-coroutines/SYSTEM.mod b/gcc/m2/gm2-libs-coroutines/SYSTEM.mod
new file mode 100644
index 00000000000..213ed872cbd
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/SYSTEM.mod
@@ -0,0 +1,484 @@
+(* SYSTEM.mod provides access to COROUTINE primitives and underlying system.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+IMPLEMENTATION MODULE SYSTEM ;
+
+FROM RTco IMPORT init, initThread, transfer, currentThread, turnInterrupts ;
+
+FROM RTint IMPORT Listen, AttachVector,
+                  IncludeVector, ExcludeVector ;
+
+IMPORT RTint ;
+
+FROM Storage IMPORT ALLOCATE ;
+FROM M2RTS IMPORT Halt ;
+FROM libc IMPORT printf, memcpy, memcpy, memset ;
+
+
+CONST
+   BitsPerBitset = MAX (BITSET) +1 ;
+
+TYPE
+   PtrToIOTransferState = POINTER TO IOTransferState ;
+   IOTransferState      = RECORD
+                             ptrToFirst,
+                             ptrToSecond: POINTER TO PROCESS ;
+                             next       : PtrToIOTransferState ;
+                          END ;
+
+VAR
+   initMain,
+   initGTh        : BOOLEAN ;
+
+
+(*
+   TRANSFER - save the current volatile environment into, p1.
+              Restore the volatile environment from, p2.
+*)
+
+PROCEDURE TRANSFER (VAR p1: PROCESS; p2: PROCESS) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   localMain (p1) ;
+   IF p1.context=p2.context
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__,
+           'error when attempting to context switch to the same process')
+   END ;
+   transfer (p1.context, p2.context)
+END TRANSFER ;
+
+
+(*
+   NEWPROCESS - p is a parameterless procedure, a, is the origin of
+                the workspace used for the process stack and containing
+                the volatile environment of the process.  StackSize, is
+                the maximum size of the stack in bytes which can be used
+                by this process.  new, is the new process.
+*)
+
+PROCEDURE NEWPROCESS (p: PROC; a: ADDRESS; StackSize: CARDINAL; VAR new: PROCESS) ;
+BEGIN
+   localInit ;
+   WITH new DO
+      context := initThread (p, StackSize, MAX(PROTECTION))
+   END
+END NEWPROCESS ;
+
+
+(*
+   IOTRANSFER - saves the current volatile environment into, First,
+                and restores volatile environment, Second.
+                When an interrupt, InterruptNo, is encountered then
+                the reverse takes place. (The then current volatile
+                environment is shelved onto Second and First is resumed).
+
+                NOTE: that upon interrupt the Second might not be the
+                      same process as that before the original call to
+                      IOTRANSFER.
+*)
+
+PROCEDURE IOTRANSFER (VAR First, Second: PROCESS; InterruptNo: CARDINAL) ;
+VAR
+   p: IOTransferState ;
+   l: POINTER TO IOTransferState ;
+BEGIN
+   localMain (First) ;
+   WITH p DO
+      ptrToFirst  := ADR (First) ;
+      ptrToSecond := ADR (Second) ;
+      next        := AttachVector (InterruptNo, ADR (p))
+   END ;
+   IncludeVector (InterruptNo) ;
+   TRANSFER (First, Second)
+END IOTRANSFER ;
+
+
+(*
+   IOTransferHandler - handles interrupts related to a pending IOTRANSFER.
+*)
+
+PROCEDURE IOTransferHandler (InterruptNo: CARDINAL;
+                             Priority: CARDINAL ;
+                             l: PtrToIOTransferState) ;
+VAR
+   old: PtrToIOTransferState ;
+BEGIN
+   IF l=NIL
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            'no processes attached to this interrupt vector which is associated with IOTRANSFER')
+   ELSE
+      WITH l^ DO
+         old := AttachVector (InterruptNo, next) ;
+         IF old#l
+         THEN
+            Halt (__FILE__, __LINE__, __FUNCTION__,
+                  'inconsistancy of return result')
+         END ;
+         IF next=NIL
+         THEN
+            ExcludeVector (InterruptNo)
+         ELSE
+            printf ('odd vector has been chained\n')
+         END ;
+         TRANSFER (ptrToSecond^, ptrToFirst^)
+      END
+   END
+END IOTransferHandler ;
+
+
+(*
+   LISTEN - briefly listen for any interrupts.
+*)
+
+PROCEDURE LISTEN ;
+BEGIN
+   localInit ;
+   Listen (FALSE, IOTransferHandler, MIN (PROTECTION))
+END LISTEN ;
+
+
+(*
+   ListenLoop - should be called instead of users writing:
+
+                LOOP
+                   LISTEN
+                END
+
+                It performs the same function but yields
+                control back to the underlying operating system.
+                It also checks for deadlock.
+                This function returns when an interrupt occurs.
+                (File descriptor becomes ready or time event expires).
+*)
+
+PROCEDURE ListenLoop ;
+BEGIN
+   localInit ;
+   LOOP
+      Listen (TRUE, IOTransferHandler, MIN (PROTECTION))
+   END
+END ListenLoop ;
+
+
+(*
+   TurnInterrupts - switches processor interrupts to the
+                    protection level, to.  It returns the old value.
+*)
+
+PROCEDURE TurnInterrupts (to: PROTECTION) : PROTECTION ;
+VAR
+   old: PROTECTION ;
+BEGIN
+   localInit ;
+   old := VAL (PROTECTION, turnInterrupts (VAL (CARDINAL, to))) ;
+   Listen (FALSE, IOTransferHandler, to) ;
+   (* printf ("interrupt level is %d\n", currentIntValue); *)
+   RETURN old
+END TurnInterrupts ;
+
+
+(*
+   Finished - generates an error message. Modula-2 processes should never
+              terminate.
+*)
+
+PROCEDURE Finished (p: ADDRESS) ;
+BEGIN
+   Halt(__FILE__, __LINE__, __FUNCTION__, 'process terminated illegally')
+END Finished ;
+
+
+(*
+   localInit - checks to see whether we need to initialize pthread
+*)
+
+PROCEDURE localInit ;
+BEGIN
+   IF NOT initGTh
+   THEN
+      initGTh := TRUE ;
+      IF init () # 0
+      THEN
+         Halt (__FILE__, __LINE__, __FUNCTION__, "gthr did not initialize")
+      END ;
+      RTint.Init
+   END
+END localInit ;
+
+
+(*
+   localMain - creates the holder for the main process.
+*)
+
+PROCEDURE localMain (VAR mainProcess: PROCESS) ;
+BEGIN
+   IF NOT initMain
+   THEN
+      initMain := TRUE ;
+      WITH mainProcess DO
+         context := currentThread ()
+      END
+   END
+END localMain ;
+
+
+(*
+   Max - returns the maximum of a and b.
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a > b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Max ;
+
+
+(*
+   Min - returns the minimum of a and b.
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a < b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Min ;
+
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   IF ShiftCount>0
+   THEN
+      ShiftCount := ShiftCount MOD VAL(INTEGER, SetSizeInBits) ;
+      ShiftLeft (s, d, SetSizeInBits, ShiftCount)
+   ELSIF ShiftCount<0
+   THEN
+      ShiftCount := (-ShiftCount) MOD VAL(INTEGER, SetSizeInBits) ;
+      ShiftRight (s, d, SetSizeInBits, ShiftCount)
+   ELSE
+      a := memcpy (ADR (d), ADR (s), (HIGH (d) + 1) * SIZE (BITSET))
+   END
+END ShiftVal ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at compile
+               time.
+*)
+
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   i, j, h: CARDINAL ;
+   a      : ADDRESS ;
+BEGIN
+   h := HIGH(s)+1 ;
+   IF ShiftCount MOD BitsPerBitset=0
+   THEN
+      i := ShiftCount DIV BitsPerBitset ;
+      a := ADR (d[i]) ;
+      a := memcpy (a, ADR (s), (h-i) * SIZE (BITSET)) ;
+      a := memset (ADR (d), 0, i * SIZE (BITSET))
+   ELSE
+      i := h ;
+      WHILE i>0 DO
+         DEC (i) ;
+         lo := SHIFT (s[i], ShiftCount MOD BitsPerBitset) ;
+         hi := SHIFT (s[i], -(BitsPerBitset - (ShiftCount MOD BitsPerBitset))) ;
+         d[i] := BITSET{} ;
+         j := i + ShiftCount DIV BitsPerBitset ;
+         IF j<h
+         THEN
+            d[j] := d[j] + lo ;
+            INC(j) ;
+            IF j<h
+            THEN
+               d[j] := d[j] + hi
+            END
+         END
+      END
+   END
+END ShiftLeft ;
+
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at compile
+                time.
+*)
+
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      ShiftCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   j, i, h: INTEGER ;
+   a      : ADDRESS ;
+BEGIN
+   h := HIGH (s) + 1 ;
+   IF ShiftCount MOD BitsPerBitset=0
+   THEN
+      i := ShiftCount DIV BitsPerBitset ;
+      a := ADR (s[i]) ;
+      j := h-i ;
+      a := memcpy (ADR (d), a, j * VAL (INTEGER, SIZE(BITSET))) ;
+      a := ADR (d[j]) ;
+      a := memset (a, 0, i * VAL (INTEGER, SIZE(BITSET)))
+   ELSE
+      i := 0 ;
+      WHILE i<h DO
+         lo := SHIFT(s[i], BitsPerBitset - (ShiftCount MOD BitsPerBitset)) ;
+         hi := SHIFT(s[i], -(ShiftCount MOD BitsPerBitset)) ;
+         d[i] := BITSET{} ;
+         j := i - VAL(INTEGER, ShiftCount DIV BitsPerBitset) ;
+         IF j>=0
+         THEN
+            d[j] := d[j] + hi ;
+            DEC(j) ;
+            IF j>=0
+            THEN
+               d[j] := d[j] + lo
+            END
+         END ;
+         INC(i)
+      END
+   END
+END ShiftRight ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger sets.
+*)
+
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   IF RotateCount>0
+   THEN
+      RotateLeft(s, d, SetSizeInBits, RotateCount)
+   ELSIF RotateCount<0
+   THEN
+      RotateRight(s, d, SetSizeInBits, -RotateCount)
+   ELSE
+      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
+   END
+END RotateVal ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at compile
+                time.
+*)
+
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   b, i, j, h: CARDINAL ;
+BEGIN
+   h := HIGH(s) ;
+   (* firstly we set d := {} *)
+   i := 0 ;
+   WHILE i<=h DO
+      d[i] := BITSET{} ;
+      INC(i)
+   END ;
+   i := h+1 ;
+   RotateCount := RotateCount MOD SetSizeInBits ;
+   b := SetSizeInBits MOD BitsPerBitset ;
+   IF b=0
+   THEN
+      b := BitsPerBitset
+   END ;
+   WHILE i>0 DO
+      DEC(i) ;
+      lo := SHIFT(s[i], RotateCount MOD BitsPerBitset) ;
+      hi := SHIFT(s[i], -(b - (RotateCount MOD BitsPerBitset))) ;
+      j := ((i*BitsPerBitset + RotateCount) MOD
+            SetSizeInBits) DIV BitsPerBitset ;
+      d[j] := d[j] + lo ;
+      j := (((i+1)*BitsPerBitset + RotateCount) MOD
+            SetSizeInBits) DIV BitsPerBitset ;
+      d[j] := d[j] + hi ;
+      b := BitsPerBitset
+   END
+END RotateLeft ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at compile
+                 time.
+*)
+
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+BEGIN
+   RotateLeft(s, d, SetSizeInBits, SetSizeInBits-RotateCount)
+END RotateRight ;
+
+
+BEGIN
+   initGTh := FALSE ;
+   initMain := FALSE
+END SYSTEM.
diff --git a/gcc/m2/gm2-libs-coroutines/TimerHandler.def b/gcc/m2/gm2-libs-coroutines/TimerHandler.def
new file mode 100644
index 00000000000..395a9aed7b7
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/TimerHandler.def
@@ -0,0 +1,102 @@
+(* TimerHandler.def provides a simple timer handler for the Executive.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+DEFINITION MODULE TimerHandler ;
+
+(* It also provides the Executive with a basic round robin scheduler.  *)
+
+EXPORT QUALIFIED TicksPerSecond, GetTicks,
+                 EVENT,
+                 Sleep, ArmEvent, WaitOn, Cancel, ReArmEvent ;
+
+
+CONST
+   TicksPerSecond =   25 ;  (* Number of ticks per second.  *)
+
+TYPE
+   EVENT ;
+
+
+(*
+   GetTicks - returns the number of ticks since boottime.
+*)
+
+PROCEDURE GetTicks () : CARDINAL ;
+
+
+(*
+   Sleep - suspends the current process for a time, t.
+           The time is measured in ticks.
+*)
+
+PROCEDURE Sleep (t: CARDINAL) ;
+
+
+(*
+   ArmEvent - initializes an event, e, to occur at time, t.
+              The time, t, is measured in ticks.
+              The event is NOT placed onto the event queue.
+*)
+
+PROCEDURE ArmEvent (t: CARDINAL) : EVENT ;
+
+
+(*
+   WaitOn - places event, e, onto the event queue and then the calling
+            process suspends. It is resumed up by either the event
+            expiring or the event, e, being cancelled.
+            TRUE is returned if the event was cancelled
+            FALSE is returned if the event expires.
+            The event, e, is always assigned to NIL when the function
+            finishes.
+*)
+
+PROCEDURE WaitOn (VAR e: EVENT) : BOOLEAN ;
+
+
+(*
+   Cancel - cancels the event, e, on the event queue and makes
+            the appropriate process runnable again.
+            TRUE is returned if the event was cancelled and
+            FALSE is returned is the event was not found or
+                  no process was waiting on this event.
+*)
+
+PROCEDURE Cancel (e: EVENT) : BOOLEAN ;
+
+
+(*
+   ReArmEvent - removes an event, e, from the event queue. A new time
+                is given to this event and it is then re-inserted onto the
+                event queue in the correct place.
+                TRUE is returned if this occurred
+                FALSE is returned if the event was not found.
+*)
+
+PROCEDURE ReArmEvent (e: EVENT; t: CARDINAL) : BOOLEAN ;
+
+
+END TimerHandler.
diff --git a/gcc/m2/gm2-libs-coroutines/TimerHandler.mod b/gcc/m2/gm2-libs-coroutines/TimerHandler.mod
new file mode 100644
index 00000000000..d9ae7bf14aa
--- /dev/null
+++ b/gcc/m2/gm2-libs-coroutines/TimerHandler.mod
@@ -0,0 +1,758 @@
+(* TimerHandler.mod provides a simple timer handler for the Executive.
+
+Copyright (C) 2002-2022 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/>.  *)
+
+IMPLEMENTATION MODULE TimerHandler[MAX(PROTECTION)] ;
+
+
+FROM COROUTINES IMPORT PROTECTION ;
+FROM SysStorage IMPORT ALLOCATE ;
+FROM NumberIO IMPORT CardToStr ;
+FROM Debug IMPORT Halt, DebugString ;
+FROM KeyBoardLEDs IMPORT SwitchScroll ;
+FROM RTint IMPORT ReArmTimeVector, GetTimeVector, InitTimeVector ;
+FROM Executive IMPORT DESCRIPTOR, Suspend, Resume, GetCurrentProcess,
+                      WaitForIO, InitProcess, RotateRunQueue,
+                      ProcessName, Ps ;
+
+CONST
+   MaxQuantum     =     4 ;   (* Maximum ticks a process may consume    *)
+                              (* before being rescheduled.              *)
+   BaseTicks      = 1000000 ; (* Max resolution of clock ticks per sec  *)
+   TimerStackSize = 100000H ; (* Reasonable sized stack for a process  *)
+   Debugging      =  FALSE ;  (* Do you want lots of debugging info?   *)
+
+TYPE
+   EVENT = POINTER TO RECORD
+                         EventQ      : Queue ;
+                         WhichQ      : QueueType ;
+                         Process     : DESCRIPTOR ;
+                         NoOfTicks   : CARDINAL ;
+                         WasCancelled: BOOLEAN ;
+                      END ;
+
+   (* the queue types are either:
+
+      active queue which has a list of outstanding events
+      dead queue which is essentially the free list
+      solo which is no queue and the event is in limbo
+   *)
+
+   QueueType = (active, dead, solo) ;
+
+   Queue  = RECORD
+               Right,
+               Left : EVENT ;
+            END ;
+
+VAR
+   TotalTicks    : CARDINAL ;   (* System up time tick count            *)
+   CurrentQuanta : CARDINAL ;   (* Currentprocess time quanta allowance *)
+   ActiveQueue,                 (* Queue of outstanding timer requests  *)
+   DeadQueue     : EVENT ;      (* Free list of events.                 *)
+
+
+(*
+   GetTicks - returns the number of ticks since boottime.
+*)
+
+PROCEDURE GetTicks () : CARDINAL ;
+VAR
+   ToOldState : PROTECTION ;
+   CopyOfTicks: CARDINAL ;
+BEGIN
+(*   ToOldState := TurnInterrupts(MAX(PROTECTION)) ;      (* disable interrupts *) *)
+   CopyOfTicks := TotalTicks ;
+(*   ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN( CopyOfTicks )
+END GetTicks ;
+
+
+(*
+   Sleep - suspends the current process for a time, t.
+           The time is measured in ticks.
+*)
+
+PROCEDURE Sleep (t: CARDINAL) ;
+VAR
+   ToOldState: PROTECTION ;
+   e         : EVENT ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;               (* disable interrupts *) *)
+   e := ArmEvent (t) ;
+   IF WaitOn (e)
+   THEN
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState)          (* restore interrupts *) *)
+END Sleep ;
+
+
+(*
+   More lower system calls to the timer procedures follow,
+   they are necessary to allow handling multiple events.
+*)
+
+
+(*
+   ArmEvent - initializes an event, e, to occur at time, t.
+              The time, t, is measured in ticks.
+              The event is NOT placed onto the event queue.
+*)
+
+PROCEDURE ArmEvent (t: CARDINAL) : EVENT ;
+VAR
+   e         : EVENT ;
+   ToOldState: PROTECTION ;
+   Ticks     : CARDINAL ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   e := CreateSolo() ;
+
+   (* your code needs to go here *)
+   WITH e^ DO                                                                       (* remove for student *)
+      InitQueue(EventQ) ;           (* not on a queue yet                   *)      (* remove for student *)
+      WhichQ       := solo ;        (* and set the queue state accordingly  *)      (* remove for student *)
+      Process      := NIL ;         (* no process waiting event yet         *)      (* remove for student *)
+      NoOfTicks    := t ;           (* absolute number of ticks             *)      (* remove for student *)
+      WasCancelled := FALSE ;       (* has not been cancelled               *)      (* remove for student *)
+   END ;                                                                            (* remove for student *)
+
+(* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN( e )
+END ArmEvent ;
+
+
+(*
+   WaitOn - places event, e, onto the event queue and then the calling
+            process suspends. It is resumed up by either the event
+            expiring or the event, e, being cancelled.
+            TRUE is returned if the event was cancelled
+            FALSE is returned if the event expires.
+            The event, e, is always assigned to NIL when the function
+            finishes.
+*)
+
+PROCEDURE WaitOn (VAR e: EVENT) : BOOLEAN ;
+VAR
+   ToOldState: PROTECTION ;
+   Cancelled : BOOLEAN ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   IF e=NIL
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__,
+           'event should never be NIL')
+   ELSE
+      WITH e^ DO
+         (* we will just check to see whether someone has cancelled this    *)
+         (* event before it ever got to the queue...                        *)
+         IF NOT WasCancelled
+         THEN
+            (* right so it wasn't cancelled. Lets place it on the queue and *)
+            (* go to sleep.                                                 *)
+            Process := GetCurrentProcess() ;  (* so we know who is waiting  *)
+            OnActiveQueue(e) ;                (* add to the queue and then  *)
+
+            IF Debugging
+            THEN
+               DisplayActive ;  (* debugging *)
+            END ;
+
+            Suspend                           (* wait for Resume (we sleep) *)
+         END ;
+         (* At this point we have either been cancelled or not. We must     *)
+         (* check the event again as we might have been sleeping (Suspend)  *)
+         Cancelled := WasCancelled
+      END
+   END ;
+   OnDeadQueue(e) ;              (* now it is safe to throw this event away *)
+   e := NIL ;
+(* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN Cancelled
+END WaitOn ;
+
+
+(*
+   Cancel - cancels the event, e, on the event queue and makes
+            the appropriate process runnable again.
+            TRUE is returned if the event was cancelled and
+            FALSE is returned is the event was not found or
+                  no process was waiting on this event.
+*)
+
+PROCEDURE Cancel (e: EVENT) : BOOLEAN ;
+VAR
+   ToOldState: PROTECTION ;
+   Cancelled : BOOLEAN ;
+   Private   : DESCRIPTOR ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   IF IsOnActiveQueue(e)
+   THEN
+      WITH e^ DO
+         Cancelled := NOT WasCancelled ;
+         IF WasCancelled
+         THEN
+            Halt(__FILE__, __LINE__, __FUNCTION__,
+                 'inconsistancy event has been cancelled and it is on queue')
+         END ;
+         OnSoloQueue(e) ;
+         WasCancelled := TRUE ;
+         IF Process#NIL                (* double check that it has not     *)
+                                       (* already been cancelled           *)
+         THEN
+            Private := Process ;       (* we use our own Private variable  *)
+            Process := NIL ;           (* as we need to set Process to NIL *)
+            Process := Resume(Private) (* before we Resume. Otherwise      *)
+                                       (* there is the possibility that it *)
+                                       (* might be reused before we := NIL *)
+                                       (* (because when we touch Resume    *)
+                                       (* another process could run and..) *)
+         END
+      END
+   ELSE
+      Cancelled := FALSE
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN( Cancelled )
+END Cancel ;
+
+
+(*
+   ReArmEvent - removes an event, e, from the event queue. A new time
+                is given to this event and it is then re-inserted onto the
+                event queue in the correct place.
+                TRUE is returned if this occurred
+                FALSE is returned if the event was not found.
+*)
+
+PROCEDURE ReArmEvent (e: EVENT; t: CARDINAL) : BOOLEAN ;
+VAR
+   ToOldState: PROTECTION ;
+   ReArmed   : BOOLEAN ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ;                (* disable interrupts *) *)
+   WITH e^ DO
+      IF WasCancelled
+      THEN
+         ReArmed := FALSE
+      ELSIF IsOnActiveQueue(e) OR IsOnSoloQueue(e)
+      THEN
+         ReArmed := TRUE ;
+         OnSoloQueue(e) ;                             (* remove from queue  *)
+         NoOfTicks := t ;                             (* give it a new time *)
+         OnActiveQueue(e)                             (* back on queue      *)
+      ELSE
+         Halt(__FILE__, __LINE__, __FUNCTION__,
+              'ReArm should not be asked to ReArm a dead event')
+      END
+   END ;
+(* ToOldState := TurnInterrupts(ToOldState) ;         (* restore interrupts *) *)
+   RETURN( ReArmed )
+END ReArmEvent ;
+
+
+(*
+   StartClock - ticks is milli seconds.
+*)
+
+PROCEDURE StartClock (vec: CARDINAL; ticks: CARDINAL) ;
+BEGIN
+   ReArmTimeVector (vec, ticks MOD BaseTicks, ticks DIV BaseTicks)
+END StartClock ;
+
+
+(*
+   LoadClock - returns the number of milli seconds.
+*)
+
+PROCEDURE LoadClock (vec: CARDINAL) : CARDINAL ;
+VAR
+   micro, secs: CARDINAL ;
+BEGIN
+   GetTimeVector (vec, micro, secs) ;
+   RETURN secs * BaseTicks + micro
+END LoadClock ;
+
+
+(*
+   Timer  - is a process which serves the clock interrupt.
+            Its function is fourfold:
+
+            (i)   to maintain the timer event queue
+            (ii)  to give some fairness to processes via round robin scheduling
+            (iii) to keep a count of the total ticks so far  (time of day)
+            (iv)  provide a heartbeat sign of life via the scroll lock LED
+*)
+
+PROCEDURE Timer ;
+VAR
+   CurrentCount: CARDINAL ;
+   ToOldState  : PROTECTION ;
+   ScrollLED   : BOOLEAN ;
+   TimerIntNo  : CARDINAL ;
+   r           : INTEGER ;
+BEGIN
+(* ToOldState := TurnInterrupts(MAX(PROTECTION)) ; *)
+   ScrollLED := FALSE ;
+   TimerIntNo := InitTimeVector ((BaseTicks DIV TicksPerSecond) MOD BaseTicks,
+                                 (BaseTicks DIV TicksPerSecond) DIV BaseTicks,
+                                 MAX (PROTECTION)) ;
+   LOOP
+      WaitForIO (TimerIntNo) ;
+
+      (* Get current clock count *)
+      CurrentCount := (* LoadClock(TimerIntNo) ; *) 0 ;
+      (* Now compenstate for lost ticks *)
+      StartClock (TimerIntNo, CurrentCount + (BaseTicks DIV TicksPerSecond)) ;
+
+      (* your code needs to go here *)
+      INC (TotalTicks) ;                                     (* (iii) *)    (* remove for student *)
+      (* now pulse scroll LED *)                                            (* remove for student *)
+      IF (TotalTicks MOD TicksPerSecond) = 0                                (* remove for student *)
+      THEN                                                                  (* remove for student *)
+         ScrollLED := NOT ScrollLED ;                                       (* remove for student *)
+         (* r := printf("<scroll %d>", TotalTicks); *)
+         SwitchScroll(ScrollLED)                             (* (iv)  *)    (* remove for student *)
+      END ;                                                                 (* remove for student *)
+      IF (TotalTicks MOD MaxQuantum) = 0                                    (* remove for student *)
+      THEN                                                                  (* remove for student *)
+         RotateRunQueue                                      (* (ii)  *)    (* remove for student *)
+      END ;                                                                 (* remove for student *)
+
+      CheckActiveQueue                                       (* (i)   *)    (* remove for student *)
+   END
+END Timer ;
+
+
+(*
+   CheckActiveQueue - purpose is:
+
+                      (i)   to remove all events which have expired
+                      (ii)  resume all processes waiting on these events
+                      (iii) decrement the first event with a non zero NoOfTicks
+*)
+
+PROCEDURE CheckActiveQueue ;
+VAR
+   e      : EVENT ;
+   Private: DESCRIPTOR ;
+BEGIN
+   IF Debugging
+   THEN
+      DebugString('inside CheckActiveQueue\n') ;
+      DisplayActive
+   END ;
+   WHILE (ActiveQueue#NIL) AND (ActiveQueue^.NoOfTicks=0) DO    (* (i)  *)
+      e := ActiveQueue ;
+      OnSoloQueue(e) ;
+      (* note we do not put it onto the dead queue. The process
+         waiting for the event will place, e, onto the dead queue *)
+      WITH e^ DO
+         IF (NOT WasCancelled) AND (Process#NIL)
+         THEN
+            Private := Process ;    (* we use our own Private variable  *)
+            Process := NIL ;        (* as we might context switch in    *)
+            Process := Resume(Private) ;  (* resume.               (ii) *)
+            IF Debugging
+            THEN
+               Ps
+            END
+         END
+      END
+   END ;
+   IF ActiveQueue#NIL
+   THEN
+      DEC(ActiveQueue^.NoOfTicks)                              (* (iii) *)
+   END ;
+   IF Debugging
+   THEN
+      DebugString('after CheckActiveQueue\n') ;
+      DisplayActive
+   END ;
+END CheckActiveQueue ;
+
+
+(*
+   CreateSolo - create a new event. It does this by either getting an event from
+                the dead queue or (if the dead queue is empty) an event is created
+                by using NEW.
+*)
+
+PROCEDURE CreateSolo () : EVENT ;
+VAR
+   e: EVENT ;
+BEGIN
+   IF DeadQueue=NIL
+   THEN
+      NEW(e)
+   ELSE
+      e := DeadQueue ;
+      SubFrom(DeadQueue, e)
+   END ;
+   e^.WhichQ := solo ;
+   RETURN( e )
+END CreateSolo ;
+
+
+(*
+   RemoveFromDead - removes event, e, from the dead queue.
+*)
+
+PROCEDURE RemoveFromDead (e: EVENT) ;
+BEGIN
+   SubFrom(DeadQueue, e)
+END RemoveFromDead ;
+
+
+(*
+   OnDeadQueue - places an event onto the dead queue.
+*)
+
+PROCEDURE OnDeadQueue (e: EVENT) ;
+BEGIN
+   IF e#NIL
+   THEN
+      OnSoloQueue(e) ;                   (* put on solo queue first       *)
+      AddTo(DeadQueue, e) ;              (* now safe to put on dead queue *)
+      e^.WhichQ := dead
+   END
+END OnDeadQueue ;
+
+
+(*
+   OnSoloQueue - places an event onto the solo queue.
+*)
+
+PROCEDURE OnSoloQueue (e: EVENT) ;
+BEGIN
+   IF e#NIL
+   THEN
+      IF IsOnActiveQueue(e)
+      THEN
+         RemoveFromActive(e)
+      ELSIF IsOnDeadQueue(e)
+      THEN
+         RemoveFromDead(e)
+      END ;
+      e^.WhichQ := solo
+   END
+END OnSoloQueue ;
+
+
+(*
+   OnActiveQueue - places an event onto the active queue.
+*)
+
+PROCEDURE OnActiveQueue (e: EVENT) ;
+BEGIN
+   IF e#NIL
+   THEN
+      IF IsOnDeadQueue(e)
+      THEN
+         Halt(__FILE__, __LINE__, __FUNCTION__, 'illegal state change')
+      ELSIF IsOnSoloQueue(e)
+      THEN
+         RelativeAddToActive(e) ;
+         e^.WhichQ := active
+      END
+   END
+END OnActiveQueue ;
+
+
+(*
+   IsOnSoloQueue - returns TRUE if event, e, is on the solo queue.
+*)
+
+PROCEDURE IsOnSoloQueue (e: EVENT) : BOOLEAN ;
+BEGIN
+   RETURN( (e#NIL) AND (e^.WhichQ=solo) )
+END IsOnSoloQueue ;
+
+
+(*
+   IsOnDeadQueue - returns TRUE if event, e, is on the dead queue.
+*)
+
+PROCEDURE IsOnDeadQueue (e: EVENT) : BOOLEAN ;
+BEGIN
+   RETURN( (e#NIL) AND (e^.WhichQ=dead) )
+END IsOnDeadQueue ;
+
+
+(*
+   IsOnActiveQueue - returns TRUE if event, e, is on the active queue.
+*)
+
+PROCEDURE IsOnActiveQueue (e: EVENT) : BOOLEAN ;
+BEGIN
+   RETURN( (e#NIL) AND (e^.WhichQ=active) )
+END IsOnActiveQueue ;
+
+
+(*
+   RemoveFromActive - removes an event, e, from the active queue.
+*)
+
+PROCEDURE RemoveFromActive (e: EVENT) ;
+BEGIN
+   IF ActiveQueue=e
+   THEN
+      SubFrom(ActiveQueue, e) ;
+      (* providing that the ActiveQueue is non empty we need to
+         modify first event ticks as we have removed the first event, e. *)
+      IF ActiveQueue#NIL
+      THEN
+         INC(ActiveQueue^.NoOfTicks, e^.NoOfTicks)
+      END
+   ELSE
+      (* providing that event, e, is not the last event on the list then
+         update the next event by the time of, e. *)
+      IF e^.EventQ.Right#ActiveQueue
+      THEN
+         INC(e^.EventQ.Right^.NoOfTicks, e^.NoOfTicks)
+      END ;
+      SubFrom(ActiveQueue, e)
+   END
+END RemoveFromActive ;
+
+
+(*
+   InsertBefore - insert an event, new, on a circular event queue BEFORE
+                  event, pos.
+*)
+
+PROCEDURE InsertBefore (VAR Head: EVENT; pos, new: EVENT) ;
+BEGIN
+   IF Head=NIL
+   THEN
+      (* empty queue *)
+      Head := new ;
+      new^.EventQ.Right := new ;
+      new^.EventQ.Left := new
+   ELSIF Head=pos
+   THEN
+      (* insert before the first element on the queue *)
+      new^.EventQ.Right := pos ;
+      new^.EventQ.Left := pos^.EventQ.Left ;
+      pos^.EventQ.Left^.EventQ.Right := new ;
+      pos^.EventQ.Left := new ;
+      Head := new
+   ELSE
+      (* insert before any other element *)
+      new^.EventQ.Right := pos ;
+      new^.EventQ.Left := pos^.EventQ.Left ;
+      pos^.EventQ.Left^.EventQ.Right := new ;
+      pos^.EventQ.Left := new
+   END
+END InsertBefore ;
+
+
+(*
+   InsertAfter - place an event, new, AFTER the event pos on any circular event queue.
+*)
+
+PROCEDURE InsertAfter (pos, new: EVENT) ;
+BEGIN
+   new^.EventQ.Right := pos^.EventQ.Right ;
+   new^.EventQ.Left := pos ;
+   pos^.EventQ.Right^.EventQ.Left := new ;
+   pos^.EventQ.Right := new
+END InsertAfter ;
+
+
+(*
+   RelativeAddToActive - the active event queue is an ordered queue of
+                         relative time events.
+                         The event, e, is inserted at the appropriate
+                         position in the queue. The event, e, enters
+                         this routine with an absolute NoOfTicks field which
+                         is then used to work out the relative position
+                         of the event. After the position is found then
+                         the absolute NoOfTicks field is altered to a
+                         relative value and inserted on the queue.
+*)
+
+PROCEDURE RelativeAddToActive (e: EVENT) ;
+VAR
+   t  : EVENT ;
+   sum: CARDINAL ;
+BEGIN
+   IF ActiveQueue = NIL
+   THEN
+      (* simple as the queue is empty (relative=absolute) *)
+      InsertBefore (ActiveQueue, ActiveQueue, e)
+   ELSE
+      (* at the end of the while loop sum will contain the total of all
+         events up to but not including, t.
+         If the value of sum is <  e^.NoOfTicks then e must be placed at the end
+                                >= e^.NoOfTicks then e needs to be placed in the middle
+      *)
+
+      sum := ActiveQueue^.NoOfTicks ;
+      t := ActiveQueue^.EventQ.Right ;      (* second event *)
+      WHILE (sum < e^.NoOfTicks) AND (t # ActiveQueue) DO
+         INC (sum, t^.NoOfTicks) ;
+         t := t^.EventQ.Right
+      END ;
+      IF sum < e^.NoOfTicks
+      THEN
+         (* e will occur after all the current ActiveQueue has expired therefore
+            we must add it to the end of the ActiveQueue. *)
+         DEC (e^.NoOfTicks, sum) ;
+         InsertAfter (ActiveQueue^.EventQ.Left, e)
+      ELSE
+         (* as sum >= e^.NoOfTicks we know that e is scheduled to occur
+            in the middle of the queue but before t^.Left
+         *)
+         DEC (e^.NoOfTicks, sum-t^.EventQ.Left^.NoOfTicks) ;
+         InsertBefore (ActiveQueue, t^.EventQ.Left, e)
+      END ;
+      (* the first event after e must have its relative NoOfTicks altered *)
+      IF e^.EventQ.Right # ActiveQueue
+      THEN
+         DEC (e^.EventQ.Right^.NoOfTicks, e^.NoOfTicks)
+      END
+   END
+END RelativeAddToActive ;
+
+
+(*
+   AddTo - adds an event to a specified queue.
+*)
+
+PROCEDURE AddTo (VAR Head: EVENT; e: EVENT) ;
+BEGIN
+   IF Head=NIL
+   THEN
+      Head := e ;
+      e^.EventQ.Left := e ;
+      e^.EventQ.Right := e
+   ELSE
+      e^.EventQ.Right := Head ;
+      e^.EventQ.Left := Head^.EventQ.Left ;
+      Head^.EventQ.Left^.EventQ.Right := e ;
+      Head^.EventQ.Left := e
+   END
+END AddTo ;
+
+
+(*
+   SubFrom - removes an event from a queue.
+*)
+
+PROCEDURE SubFrom (VAR Head: EVENT; e: EVENT) ;
+BEGIN
+   IF (e^.EventQ.Left = Head) AND (e = Head)
+   THEN
+      Head := NIL
+   ELSE
+      IF Head = e
+      THEN
+         Head := Head^.EventQ.Right
+      END ;
+      e^.EventQ.Left^.EventQ.Right := e^.EventQ.Right ;
+      e^.EventQ.Right^.EventQ.Left := e^.EventQ.Left
+   END
+END SubFrom ;
+
+
+(*
+   DisplayActive - display the active queue.
+*)
+
+PROCEDURE DisplayActive ;
+VAR
+   e: EVENT ;
+BEGIN
+   e := ActiveQueue ;
+   IF e#NIL
+   THEN
+      REPEAT
+         DisplayEvent(e) ;
+         e := e^.EventQ.Right
+      UNTIL e=ActiveQueue
+   END
+END DisplayActive ;
+
+
+(*
+   DisplayEvent - display a single event, e.
+*)
+
+PROCEDURE DisplayEvent (e: EVENT) ;
+VAR
+   a: ARRAY [0..20] OF CHAR ;
+BEGIN
+   WITH e^ DO
+      CardToStr(NoOfTicks, 6, a) ;
+      DebugString(a) ;
+      DebugString('  process (') ;
+      IF Process=NIL
+      THEN
+         DebugString('is NIL') ;
+      ELSE
+         ProcessName(Process)
+      END ;
+      DebugString(')') ;
+      IF WasCancelled
+      THEN
+         DebugString('  has been cancelled')
+      END
+   END ;
+   DebugString('\n')
+END DisplayEvent ;
+
+
+(*
+   InitQueue -
+*)
+
+PROCEDURE InitQueue (VAR q: Queue) ;
+BEGIN
+   q.Right := NIL ;
+   q.Left  := NIL
+END InitQueue ;
+
+
+(*
+   Init - starts the timer process and initializes some queues.
+*)
+
+PROCEDURE Init ;
+VAR
+   d: DESCRIPTOR ;
+BEGIN
+   TotalTicks := 0 ;
+   CurrentQuanta := 0 ;
+   ActiveQueue := NIL ;
+   DeadQueue := NIL ;
+   d := Resume(InitProcess(Timer, TimerStackSize, 'Timer'))
+END Init ;
+
+
+BEGIN
+   Init
+END TimerHandler.
diff --git a/gcc/m2/gm2-libs-iso/COROUTINES.def b/gcc/m2/gm2-libs-iso/COROUTINES.def
new file mode 100644
index 00000000000..3f099704f2a
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/COROUTINES.def
@@ -0,0 +1,112 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE COROUTINES;
+
+(* Facilities for coroutines and the handling of interrupts *)
+
+IMPORT SYSTEM ;
+
+
+CONST
+  UnassignedPriority = 0 ;
+
+TYPE
+  COROUTINE ; (* Values of this type are created dynamically by NEWCOROUTINE
+                 and identify the coroutine in subsequent operations *)
+  INTERRUPTSOURCE = CARDINAL ;
+  PROTECTION = [UnassignedPriority..7] ;
+
+
+PROCEDURE NEWCOROUTINE (procBody: PROC;
+                        workspace: SYSTEM.ADDRESS;
+                        size: CARDINAL;
+                        VAR cr: COROUTINE;
+                        [initProtection: PROTECTION = UnassignedPriority]);
+  (* Creates a new coroutine whose body is given by procBody, and
+     returns the identity of the coroutine in cr. workspace is a
+     pointer to the work space allocated to the coroutine; size
+     specifies the size of this workspace in terms of SYSTEM.LOC.
+
+     The optarg, initProtection, may contain a single parameter which
+     specifies the initial protection level of the coroutine.
+  *)
+
+PROCEDURE TRANSFER (VAR from: COROUTINE; to: COROUTINE);
+  (* Returns the identity of the calling coroutine in from, and
+     transfers control to the coroutine specified by to.
+  *)
+
+PROCEDURE IOTRANSFER (VAR from: COROUTINE; to: COROUTINE);
+  (* Returns the identity of the calling coroutine in from and
+     transfers control to the coroutine specified by to.  On
+     occurrence of an interrupt, associated with the caller, control
+     is transferred back to the caller, and the identity of the
+     interrupted coroutine is returned in from.  The calling coroutine
+     must be associated with a source of interrupts.
+  *)
+
+PROCEDURE ATTACH (source: INTERRUPTSOURCE);
+  (* Associates the specified source of interrupts with the calling
+     coroutine. *)
+
+PROCEDURE DETACH (source: INTERRUPTSOURCE);
+  (* Dissociates the specified source of interrupts from the calling
+     coroutine. *)
+
+PROCEDURE IsATTACHED (source: INTERRUPTSOURCE): BOOLEAN;
+  (* Returns TRUE if and only if the specified source of interrupts is
+     currently associated with a coroutine; otherwise returns FALSE.
+  *)
+
+PROCEDURE HANDLER (source: INTERRUPTSOURCE): COROUTINE;
+  (* Returns the coroutine, if any, that is associated with the source
+     of interrupts. The result is undefined if IsATTACHED(source) =
+     FALSE.
+  *)
+
+PROCEDURE CURRENT (): COROUTINE;
+  (* Returns the identity of the calling coroutine. *)
+
+PROCEDURE LISTEN (p: PROTECTION);
+  (* Momentarily changes the protection of the calling coroutine to
+     p. *)
+
+PROCEDURE PROT (): PROTECTION;
+  (* Returns the protection of the calling coroutine. *)
+
+
+(*
+   TurnInterrupts - switches processor interrupts to the protection
+                    level, to.  It returns the old value.
+*)
+
+PROCEDURE TurnInterrupts (to: PROTECTION) : PROTECTION ;
+
+
+(*
+   ListenLoop - should be called instead of users writing:
+
+                LOOP
+                   LISTEN
+                END
+
+                It performs the same function but yields
+                control back to the underlying operating system.
+                It also checks for deadlock.
+                Note that this function does return when an interrupt occurs.
+                (File descriptor becomes ready or time event expires).
+*)
+
+PROCEDURE ListenLoop ;
+
+
+END COROUTINES.
diff --git a/gcc/m2/gm2-libs-iso/COROUTINES.mod b/gcc/m2/gm2-libs-iso/COROUTINES.mod
new file mode 100644
index 00000000000..d3b4afcf80e
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/COROUTINES.mod
@@ -0,0 +1,600 @@
+(* COROUTINES.mod implement the ISO COROUTINES specification.
+
+Copyright (C) 2002-2021 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/>.  *)
+
+IMPLEMENTATION MODULE COROUTINES ;
+
+FROM RTco IMPORT init, initThread, transfer, initSemaphore,
+                 wait, signal, currentThread, turnInterrupts,
+                 currentInterruptLevel ;
+
+FROM RTExceptions IMPORT EHBlock, InitExceptionBlock,
+                         SetExceptionBlock, GetExceptionBlock,
+                         SetExceptionState, IsInExceptionState,
+                         SetExceptionSource, GetExceptionSource ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM EXCEPTIONS IMPORT ExceptionSource ;
+FROM RTint IMPORT Listen, AttachVector, IncludeVector, ExcludeVector ;
+FROM Storage IMPORT ALLOCATE ;
+FROM Assertion IMPORT Assert ;
+FROM M2RTS IMPORT Halt ;
+FROM libc IMPORT printf ;
+FROM Processes IMPORT displayProcesses ;
+
+IMPORT RTint ;
+
+
+CONST
+   MinStack  = 16 * 1024 * 1024 ;
+   Debugging = FALSE ;
+
+TYPE
+   Status = (suspended, ready, new, running) ;
+
+   COROUTINE = POINTER TO RECORD
+                             context   : INTEGER ;
+                             ehblock   : EHBlock ;
+                             inexcept  : BOOLEAN ;
+                             source    : ExceptionSource ;
+                             wspace    : SYSTEM.ADDRESS ;
+                             nLocs     : CARDINAL ;
+                             status    : Status ;
+                             attached  : SourceList ;
+                             next      : COROUTINE ;
+                          END ;
+
+   SourceList = POINTER TO RECORD
+                              next     : SourceList ;    (* next in the list of vectors which are      *)
+                                                         (* attached to this coroutine.                *)
+                              vec      : INTERRUPTSOURCE ;  (* the interrupt vector (source)           *)
+                              curco    : COROUTINE ;     (* the coroutine which is waiting on this vec *)
+                              chain    : SourceList ;    (* the next coroutine waiting on this vec     *)
+                              ptrToTo,
+                              ptrToFrom: POINTER TO COROUTINE ;
+                           END ;
+
+
+VAR
+   freeList         : SourceList ;
+   head             : COROUTINE ;
+   previous,
+   currentCoRoutine : COROUTINE ;
+   illegalFinish    : ADDRESS ;
+   initMain,
+   initCo           : BOOLEAN ;
+   lock             : INTEGER ;    (* semaphore protecting module data structures.  *)
+
+
+PROCEDURE NEWCOROUTINE (procBody: PROC;
+                        workspace: SYSTEM.ADDRESS;
+                        size: CARDINAL;
+                        VAR cr: COROUTINE;
+                        [initProtection: PROTECTION]);
+
+  (* Creates a new coroutine whose body is given by procBody, and
+     returns the identity of the coroutine in cr. workspace is a
+     pointer to the work space allocated to the coroutine; size
+     specifies the size of this workspace in terms of SYSTEM.LOC.
+
+     The optarg, initProtection, may contain a single parameter
+     which specifies the initial protection level of the coroutine.
+  *)
+VAR
+   tp : INTEGER ;
+   old: PROTECTION ;
+BEGIN
+   localInit ;
+   old := TurnInterrupts (MAX (PROTECTION)) ;
+   IF initProtection = UnassignedPriority
+   THEN
+      initProtection := PROT ()
+   END ;
+   tp := initThread (procBody, size, initProtection) ;
+   IF tp = -1
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__, 'unable to create a new thread')
+   END ;
+   NEW (cr) ;
+   WITH cr^ DO
+      context    := tp ;
+      ehblock    := InitExceptionBlock () ;
+      inexcept   := FALSE ;
+      source     := NIL ;
+      wspace     := workspace ;
+      nLocs      := size ;
+      status     := new ;
+      attached   := NIL ;
+      next       := head
+   END ;
+   head := cr ;
+   old := TurnInterrupts (old)
+END NEWCOROUTINE ;
+
+
+PROCEDURE TRANSFER (VAR from: COROUTINE; to: COROUTINE);
+  (* Returns the identity of the calling coroutine in from, and
+     transfers control to the coroutine specified by to.
+  *)
+VAR
+   old: PROTECTION ;
+BEGIN
+   localInit ;
+   old := TurnInterrupts (MAX (PROTECTION)) ;
+   (* wait (lock) ; *)
+   Transfer (from, to) ;
+   (* signal (lock) ; *)
+   old := TurnInterrupts (old)
+END TRANSFER ;
+
+
+(*
+   Transfer -
+*)
+
+PROCEDURE Transfer (VAR from: COROUTINE; to: COROUTINE) ;
+BEGIN
+   IF Debugging
+   THEN
+      printf ("TRANSFER\n");
+      printf ("current coroutine is: %d\n", currentCoRoutine^.context);
+      IF previous # NIL
+      THEN
+         printf ("previous coroutine is: %d\n", previous^.context)
+      END ;
+      printf ("wishes to context switch to: %d\n", to^.context);
+   END ;
+   previous := currentCoRoutine ;
+   from := currentCoRoutine ;
+   IF to^.context = from^.context
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            'error when attempting to context switch to the same process')
+   END ;
+   from^.inexcept := SetExceptionState (to^.inexcept) ;
+   from^.source := GetExceptionSource () ;
+   currentCoRoutine := to ;
+   SetExceptionBlock (currentCoRoutine^.ehblock) ;
+   SetExceptionSource (currentCoRoutine^.source) ;
+   transfer (from^.context, to^.context)
+END Transfer ;
+
+
+(*
+   localMain - creates the holder for the main process.
+*)
+
+PROCEDURE localMain ;
+VAR
+   old: PROTECTION ;
+BEGIN
+   IF NOT initMain
+   THEN
+      initMain := TRUE ;
+      lock := initSemaphore (1) ;
+      wait (lock) ;
+      NEW (currentCoRoutine) ;
+      WITH currentCoRoutine^ DO
+         context    := currentThread () ;
+         ehblock    := GetExceptionBlock () ;
+         inexcept   := IsInExceptionState () ;
+         source     := GetExceptionSource () ;
+         wspace     := NIL ;
+         nLocs      := 0 ;
+         status     := running ;
+         attached   := NIL ;
+         next       := head
+      END ;
+      head := currentCoRoutine ;
+      old := turnInterrupts (MAX (PROTECTION)) ;    (* was UnassignedPriority *)
+      signal (lock)
+   END
+END localMain ;
+
+
+(*
+   localInit - checks to see whether we need to initialize our interface to pthreads.
+*)
+
+PROCEDURE localInit ;
+BEGIN
+   IF NOT initCo
+   THEN
+      Init ;
+      IF init () # 0
+      THEN
+         Halt (__FILE__, __LINE__, __FUNCTION__,
+               'failed to initialize RTco')
+      END ;
+      RTint.Init ;
+      initCo := TRUE
+   END ;
+   localMain
+END localInit ;
+
+
+PROCEDURE IOTRANSFER (VAR from: COROUTINE; to: COROUTINE);
+  (* Returns the identity of the calling coroutine in from and
+     transfers control to the coroutine specified by to.  On
+     occurrence of an interrupt, associated with the caller, control
+     is transferred back to the caller, and the identity of the
+     interrupted coroutine is returned in from.  The calling coroutine
+     must be associated with a source of interrupts.
+  *)
+VAR
+   prev,
+   l   : SourceList ;
+   old : PROTECTION ;
+BEGIN
+   localInit ;
+   old := TurnInterrupts (MAX (PROTECTION)) ;
+   IF from = to
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            "error IOTRANSFER cannot transfer control to the running COROUTINE")
+   END ;
+   wait (lock) ;
+   l := currentCoRoutine^.attached ;
+   IF l=NIL
+   THEN
+      printf ("no source of interrupts associated with coroutine\n")
+   END ;
+   WHILE l # NIL DO
+      WITH l^ DO
+         ptrToFrom := ADR (from) ;
+         ptrToTo   := ADR (to) ;
+         curco := currentCoRoutine ;
+         Assert (currentCoRoutine # NIL) ;
+         prev := AttachVector (vec, l) ;
+         Assert (from # to) ;
+         IF (prev # NIL) AND (prev # l)
+         THEN
+            printf ("not expecting multiple COROUTINES to be waiting on a single interrupt source\n")
+         END ;
+         IncludeVector (vec)
+      END ;
+      l := l^.next
+   END ;
+   signal (lock) ;
+   Transfer (from, to) ;
+   from := previous ;
+   old := TurnInterrupts (old)
+END IOTRANSFER ;
+
+
+(*
+   New - assigns, l, to a new SourceList.
+*)
+
+PROCEDURE New (VAR l: SourceList) ;
+BEGIN
+   IF freeList=NIL
+   THEN
+      NEW (l)
+   ELSE
+      l := freeList ;
+      freeList := freeList^.next
+   END
+END New ;
+
+
+(*
+   Dispose - returns, l, to the freeList.
+*)
+
+PROCEDURE Dispose (l: SourceList) ;
+BEGIN
+   l^.next := freeList ;
+   freeList := l
+END Dispose ;
+
+
+PROCEDURE ATTACH (source: INTERRUPTSOURCE);
+  (* Associates the specified source of interrupts with the calling
+     coroutine. *)
+VAR
+   l: SourceList ;
+BEGIN
+   localInit ;
+   wait (lock) ;
+   l := currentCoRoutine^.attached ;
+   WHILE l#NIL DO
+      IF l^.vec = source
+      THEN
+         l^.curco := currentCoRoutine ;
+         signal (lock) ;
+         RETURN
+      ELSE
+         l := l^.next
+      END
+   END ;
+   New (l) ;
+   WITH l^ DO
+      next := currentCoRoutine^.attached ;
+      vec := source ;
+      curco := currentCoRoutine ;
+      chain := NIL ;
+   END ;
+   currentCoRoutine^.attached := l ;
+   IF AttachVector (source, l) # NIL
+   THEN
+      printf ("ATTACH implementation restriction only one coroutine may be attached to a specific interrupt source\n")
+   END ;
+   signal (lock)
+END ATTACH ;
+
+
+PROCEDURE DETACH (source: INTERRUPTSOURCE);
+  (* Dissociates the specified source of interrupts from the calling
+     coroutine. *)
+VAR
+   l, prev: SourceList ;
+BEGIN
+   localInit ;
+   wait (lock) ;
+   l := currentCoRoutine^.attached ;
+   prev := NIL ;
+   WHILE l # NIL DO
+      IF l^.vec = source
+      THEN
+         IF prev = NIL
+         THEN
+            Assert (l = currentCoRoutine^.attached) ;
+            currentCoRoutine^.attached := currentCoRoutine^.attached^.next ;
+         ELSE
+            prev^.next := l^.next
+         END ;
+         Dispose (l) ;
+         signal (lock) ;
+         RETURN
+      ELSE
+         prev := l ;
+         l := l^.next
+      END
+   END ;
+   signal (lock)
+END DETACH ;
+
+
+(*
+   getAttached - returns the first COROUTINE associated with, source.
+                 It returns NIL is no COROUTINE is associated with, source.
+*)
+
+PROCEDURE getAttached (source: INTERRUPTSOURCE) : COROUTINE ;
+VAR
+   l: SourceList ;
+   c: COROUTINE ;
+BEGIN
+   localInit ;
+   c := head ;
+   WHILE c # NIL DO
+      l := c^.attached ;
+      WHILE l#NIL DO
+         IF l^.vec = source
+         THEN
+            RETURN c
+         ELSE
+            l := l^.next
+         END
+      END ;
+      c := c^.next
+   END ;
+   RETURN NIL
+END getAttached ;
+
+
+PROCEDURE IsATTACHED (source: INTERRUPTSOURCE): BOOLEAN;
+  (* Returns TRUE if and only if the specified source of interrupts is
+     currently associated with a coroutine; otherwise returns FALSE.
+  *)
+VAR
+   result: BOOLEAN ;
+BEGIN
+   localInit ;
+   wait (lock) ;
+   result := getAttached (source) # NIL ;
+   signal (lock) ;
+   RETURN result
+END IsATTACHED ;
+
+
+PROCEDURE HANDLER (source: INTERRUPTSOURCE) : COROUTINE;
+  (* Returns the coroutine, if any, that is associated with the source
+     of interrupts. The result is undefined if IsATTACHED(source) =
+     FALSE.
+  *)
+VAR
+   co: COROUTINE ;
+BEGIN
+   localInit ;
+   wait (lock) ;
+   co := getAttached (source) ;
+   signal (lock) ;
+   RETURN co
+END HANDLER ;
+
+
+PROCEDURE CURRENT () : COROUTINE ;
+  (* Returns the identity of the calling coroutine. *)
+BEGIN
+   localInit ;
+   RETURN currentCoRoutine
+END CURRENT ;
+
+
+PROCEDURE LISTEN (p: PROTECTION) ;
+  (* Momentarily changes the protection of the calling coroutine to p. *)
+BEGIN
+   localInit ;
+   Listen (FALSE, IOTransferHandler, p)
+END LISTEN ;
+
+
+(*
+   ListenLoop - should be called instead of users writing:
+
+                LOOP
+                   LISTEN
+                END
+
+                It performs the same function but yields
+                control back to the underlying operating system.
+                It also checks for deadlock.
+                This function returns when an interrupt occurs.
+                (File descriptor becomes ready or time event expires).
+*)
+
+PROCEDURE ListenLoop ;
+BEGIN
+   localInit ;
+   Listen (TRUE, IOTransferHandler, MIN (PROTECTION))
+END ListenLoop ;
+
+
+(*
+   removeAttached - removes all sources of interrupt from COROUTINE, c.
+*)
+
+PROCEDURE removeAttached (c: COROUTINE) ;
+VAR
+   l: SourceList ;
+BEGIN
+   localInit ;
+   l := c^.attached ;
+   WHILE l#NIL DO
+      ExcludeVector (l^.vec) ;
+      l := l^.next
+   END
+END removeAttached ;
+
+
+(*
+   IOTransferHandler - handles interrupts related to a pending IOTRANSFER.
+*)
+
+PROCEDURE IOTransferHandler (InterruptNo: CARDINAL;
+                             Priority: CARDINAL ;
+                             l: SourceList) ;
+VAR
+   ourself: SourceList ;
+BEGIN
+   IF Debugging
+   THEN
+      printf ("IOTransferHandler called\n") ;
+      displayProcesses ("IOTransferHandler") ;
+      printf ("IOTransferHandler vec %d coroutine: %d\n", l^.vec, l^.curco^.context);
+      printf ("localInit\n");
+   END ;
+   localInit ;
+   IF l = NIL
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            'no coroutine attached to this interrupt vector which was initiated by IOTRANSFER')
+   ELSE
+      IF Debugging
+      THEN
+         printf ("IOTransferHandler called\n");
+         printf ("before wait (lock)\n");
+      END ;
+      wait (lock) ;
+      IF Debugging
+      THEN
+         printf ("IOTransferHandler vec %d coroutine 0x%x\n", l^.vec, l^.curco);
+         printf ("current coroutine is: %d\n", currentCoRoutine^.context);
+         IF previous # NIL
+         THEN
+            printf ("previous coroutine is: %d\n", previous^.context)
+         END ;
+         printf ("handler wants to context switch to:  %d\n", l^.curco^.context);
+         displayProcesses ("IOTransferHandler")
+      END ;
+      WITH l^ DO
+         (*
+         ourself := AttachVector (InterruptNo, chain) ;
+         IF ourself # l
+         THEN
+            Halt (__FILE__, __LINE__, __FUNCTION__,
+                  'inconsistancy of return result')
+         END ;
+         IF chain = NIL
+         THEN
+            removeAttached (curco)
+         ELSE
+            printf ('odd vector has been chained\n')
+         END ;
+         *)
+         removeAttached (curco) ;   (* remove all sources of interrupt for l^.curco.  *)
+         ptrToFrom^ := currentCoRoutine ;
+         previous := currentCoRoutine ;
+         previous^.inexcept := SetExceptionState (curco^.inexcept) ;
+         previous^.source := GetExceptionSource () ;
+         currentCoRoutine := curco ;
+         SetExceptionBlock (currentCoRoutine^.ehblock) ;
+         SetExceptionSource (currentCoRoutine^.source) ;
+         signal (lock) ;
+         transfer (previous^.context, currentCoRoutine^.context)
+      END
+   END
+END IOTransferHandler ;
+
+
+PROCEDURE PROT () : PROTECTION;
+  (* Returns the protection of the calling coroutine. *)
+BEGIN
+   localInit ;
+   RETURN currentInterruptLevel ()
+END PROT ;
+
+
+(*
+   TurnInterrupts - switches processor interrupts to the protection
+                    level, to.  It returns the old value.
+*)
+
+PROCEDURE TurnInterrupts (to: PROTECTION) : PROTECTION ;
+VAR
+   old: PROTECTION ;
+BEGIN
+   localInit ;
+   old := turnInterrupts (to) ;
+   Listen (FALSE, IOTransferHandler, to) ;
+   RETURN old
+END TurnInterrupts ;
+
+
+(*
+   Init - initialize the global data structures.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   freeList := NIL ;
+   initMain := FALSE ;
+   currentCoRoutine := NIL
+END Init ;
+
+
+END COROUTINES.
diff --git a/gcc/m2/gm2-libs-iso/ChanConsts.def b/gcc/m2/gm2-libs-iso/ChanConsts.def
new file mode 100644
index 00000000000..3ff1721a256
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ChanConsts.def
@@ -0,0 +1,64 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE ChanConsts;
+
+  (* Common types and values for channel open requests and results *)
+
+TYPE
+  ChanFlags =        (* Request flags possibly given when a channel is opened *)
+  ( readFlag,        (* input operations are requested/available *)
+    writeFlag,       (* output operations are requested/available *)
+    oldFlag,         (* a file may/must/did exist before the channel is opened *)
+    textFlag,        (* text operations are requested/available *)
+    rawFlag,         (* raw operations are requested/available *)
+    interactiveFlag, (* interactive use is requested/applies *)
+    echoFlag         (* echoing by interactive device on removal of characters from input
+                        stream requested/applies *)
+  );
+
+  FlagSet = SET OF ChanFlags;
+
+  (* Singleton values of FlagSet, to allow for example, read + write *)
+
+CONST
+  read = FlagSet{readFlag};   (* input operations are requested/available *)
+  write = FlagSet{writeFlag}; (* output operations are requested/available *)
+  old = FlagSet{oldFlag};     (* a file may/must/did exist before the channel is opened *)
+  text = FlagSet{textFlag};   (* text operations are requested/available *)
+  raw = FlagSet{rawFlag};     (* raw operations are requested/available *)
+  interactive = FlagSet{interactiveFlag}; (* interactive use is requested/applies *)
+  echo = FlagSet{echoFlag};   (* echoing by interactive device on removal of characters from
+                                 input stream requested/applies *)
+
+TYPE
+  OpenResults =        (* Possible results of open requests *)
+    (opened,           (* the open succeeded as requested *)
+     wrongNameFormat,  (* given name is in the wrong format for the implementation *)
+     wrongFlags,       (* given flags include a value that does not apply to the device *)
+     tooManyOpen,      (* this device cannot support any more open channels *)
+     outOfChans,       (* no more channels can be allocated *)
+     wrongPermissions, (* file or directory permissions do not allow request *)
+     noRoomOnDevice,   (* storage limits on the device prevent the open *)
+     noSuchFile,       (* a needed file does not exist *)
+     fileExists,       (* a file of the given name already exists when a new one is required *)
+     wrongFileType,    (* the file is of the wrong type to support the required operations *)
+     noTextOperations, (* text operations have been requested, but are not supported *)
+     noRawOperations,  (* raw operations have been requested, but are not supported *)
+     noMixedOperations,(* text and raw operations have been requested, but they
+                          are not supported in combination *)
+     alreadyOpen,      (* the source/destination is already open for operations not supported
+                          in combination with the requested operations *)
+     otherProblem      (* open failed for some other reason *)
+    );
+
+END ChanConsts.
+
diff --git a/gcc/m2/gm2-libs-iso/ChanConsts.h b/gcc/m2/gm2-libs-iso/ChanConsts.h
new file mode 100644
index 00000000000..e166187d5e0
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ChanConsts.h
@@ -0,0 +1,47 @@
+/* ChanConsts.h define enum to be used by C components.
+
+Copyright (C) 2001-2021 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/>.  */
+
+/* These must match ChanConsts.def.   */
+
+typedef enum openResults {
+  opened,           /* the open succeeded as requested */
+  wrongNameFormat,  /* given name is in the wrong format for the implementation */
+  wrongFlags,       /* given flags include a value that does not apply to the device */
+  tooManyOpen,      /* this device cannot support any more open channels */
+  outOfChans,       /* no more channels can be allocated */
+  wrongPermissions, /* file or directory permissions do not allow request */
+  noRoomOnDevice,   /* storage limits on the device prevent the open */
+  noSuchFile,       /* a needed file does not exist */
+  fileExists,       /* a file of the given name already exists when a new one is required */
+  wrongFileType,    /* the file is of the wrong type to support the required operations */
+  noTextOperations, /* text operations have been requested, but are not supported */
+  noRawOperations,  /* raw operations have been requested, but are not supported */
+  noMixedOperations,/* text and raw operations have been requested, but they
+		       are not supported in combination */
+  alreadyOpen,      /* the source/destination is already open for operations not supported
+		       in combination with the requested operations */
+  otherProblem      /* open failed for some other reason */
+} openResults;
diff --git a/gcc/m2/gm2-libs-iso/ChanConsts.mod b/gcc/m2/gm2-libs-iso/ChanConsts.mod
new file mode 100644
index 00000000000..22190f79cff
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ChanConsts.mod
@@ -0,0 +1,29 @@
+(* ChanConsts.mod common types and values for channels.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ChanConsts ;
+
+END ChanConsts.
diff --git a/gcc/m2/gm2-libs-iso/CharClass.def b/gcc/m2/gm2-libs-iso/CharClass.def
new file mode 100644
index 00000000000..e7bba0778fd
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/CharClass.def
@@ -0,0 +1,35 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE CharClass;
+
+  (* Classification of values of the type CHAR *)
+
+PROCEDURE IsNumeric (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch is classified as a numeric character *)
+
+PROCEDURE IsLetter (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch is classified as a letter *)
+
+PROCEDURE IsUpper (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch is classified as an upper case letter *)
+
+PROCEDURE IsLower (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch is classified as a lower case letter *)
+
+PROCEDURE IsControl (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch represents a control function *)
+
+PROCEDURE IsWhiteSpace (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch represents a space character or a format effector *)
+
+END CharClass.
+
diff --git a/gcc/m2/gm2-libs-iso/CharClass.mod b/gcc/m2/gm2-libs-iso/CharClass.mod
new file mode 100644
index 00000000000..fce2782d7df
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/CharClass.mod
@@ -0,0 +1,81 @@
+(* CharClass.mod implement the ISO CharClass specification.
+
+Copyright (C) 2002-2021 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/>.  *)
+
+IMPLEMENTATION MODULE CharClass ;
+
+FROM ASCII IMPORT lf, cr, tab ;
+
+(* Classification of values of the type CHAR *)
+
+(* Returns TRUE if and only if ch is classified as a numeric character *)
+
+PROCEDURE IsNumeric (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch>='0') AND (ch<='9')
+END IsNumeric ;
+
+
+(* Returns TRUE if and only if ch is classified as a letter *)
+
+PROCEDURE IsLetter (ch: CHAR): BOOLEAN;
+BEGIN
+   RETURN ((ch>='a') AND (ch<='z')) OR ((ch>='A') AND (ch<='Z'))
+END IsLetter ;
+
+
+(* Returns TRUE if and only if ch is classified as an upper case letter *)
+
+PROCEDURE IsUpper (ch: CHAR): BOOLEAN;
+BEGIN
+   RETURN (ch>='A') AND (ch<='Z')
+END IsUpper ;
+
+
+(* Returns TRUE if and only if ch is classified as a lower case letter *)
+
+PROCEDURE IsLower (ch: CHAR): BOOLEAN;
+BEGIN
+   RETURN (ch>='a') AND (ch<='z')
+END IsLower ;
+
+
+(* Returns TRUE if and only if ch represents a control function *)
+
+PROCEDURE IsControl (ch: CHAR): BOOLEAN;
+BEGIN
+   RETURN (ch<' ')
+END IsControl ;
+
+
+(* Returns TRUE if and only if ch represents a space character or a format effector *)
+
+PROCEDURE IsWhiteSpace (ch: CHAR): BOOLEAN;
+BEGIN
+   RETURN (ch=' ') OR (ch=cr) OR (ch=lf) OR (ch=tab)
+END IsWhiteSpace ;
+
+
+END CharClass.
diff --git a/gcc/m2/gm2-libs-iso/ClientSocket.def b/gcc/m2/gm2-libs-iso/ClientSocket.def
new file mode 100644
index 00000000000..fb840939c29
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ClientSocket.def
@@ -0,0 +1,59 @@
+(* ClientSocket.def provides a client TCP interface for ChanId's.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE ClientSocket ;
+
+FROM IOChan IMPORT ChanId ;
+FROM ChanConsts IMPORT FlagSet, OpenResults ;
+
+
+(*
+   OpenSocket - opens a TCP client connection to host:port.
+*)
+
+PROCEDURE OpenSocket (VAR cid: ChanId;
+                      host: ARRAY OF CHAR; port: CARDINAL;
+                      f: FlagSet; VAR res: OpenResults) ;
+
+(*
+   Close - if the channel identified by cid is not open to
+           a socket stream, the exception wrongDevice is
+           raised; otherwise closes the channel, and assigns
+           the value identifying the invalid channel to cid.
+*)
+
+PROCEDURE Close (VAR cid: ChanId) ;
+
+
+(*
+   IsSocket - tests if the channel identified by cid is open as
+              a client socket stream.
+*)
+
+PROCEDURE IsSocket (cid: ChanId) : BOOLEAN ;
+
+
+END ClientSocket.
diff --git a/gcc/m2/gm2-libs-iso/ClientSocket.mod b/gcc/m2/gm2-libs-iso/ClientSocket.mod
new file mode 100644
index 00000000000..5f26896a6d9
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ClientSocket.mod
@@ -0,0 +1,468 @@
+(* ClientSocket.mod provides a client TCP interface for ChanId's.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ClientSocket ;
+
+
+FROM ASCII IMPORT nul, lf, cr ;
+FROM ChanConsts IMPORT OpenResults, ChanFlags ;
+FROM RTio IMPORT GetDeviceId ;
+FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
+FROM RTdata IMPORT ModuleId, MakeModuleId, InitData, GetData, KillData ;
+FROM IOChan IMPORT ChanExceptions, InvalidChan, CurrentFlags ;
+FROM IOConsts IMPORT ReadResults ;
+
+FROM IOLink IMPORT DeviceId, DeviceTable, DeviceTablePtr, DeviceTablePtrValue, IsDevice,
+                   AllocateDeviceId, RAISEdevException, MakeChan, UnMakeChan ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Strings IMPORT Append ;
+FROM SYSTEM IMPORT ADDRESS, ADR, LOC ;
+FROM libc IMPORT read, write, close ;
+FROM errno IMPORT geterrno ;
+FROM ErrnoCategory IMPORT GetOpenResults ;
+FROM WholeStr IMPORT IntToStr ;
+
+FROM RTgen IMPORT ChanDev, DeviceType, InitChanDev,
+                  doLook, doSkip, doSkipLook, doWriteLn,
+                  doReadText, doWriteText, doReadLocs, doWriteLocs,
+                  checkErrno ;
+
+FROM wrapsock IMPORT clientInfo, clientOpen, clientOpenIP, getClientPortNo,
+                     getClientSocketFd, getClientIP, getSizeOfClientInfo,
+                     getPushBackChar, setPushBackChar, getClientHostname ;
+
+
+TYPE
+   PtrToLoc   = POINTER TO LOC ;
+   ClientInfo = ADDRESS ;
+VAR
+   mid           : ModuleId ;
+   did           : DeviceId ;
+   dev           : ChanDev ;
+   ClientInfoSize: CARDINAL ;
+
+
+PROCEDURE look (d: DeviceTablePtr;
+                VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doLook(dev, d, ch, r)
+END look ;
+
+
+PROCEDURE skip (d: DeviceTablePtr) ;
+BEGIN
+   doSkip(dev, d)
+END skip ;
+
+
+PROCEDURE skiplook (d: DeviceTablePtr;
+                    VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doSkipLook(dev, d, ch, r)
+END skiplook ;
+
+
+PROCEDURE lnwrite (d: DeviceTablePtr) ;
+BEGIN
+   doWriteLn(dev, d)
+END lnwrite ;
+
+
+PROCEDURE textread (d: DeviceTablePtr;
+                    to: ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+BEGIN
+   doReadText(dev, d, to, maxChars, charsRead)
+END textread ;
+
+
+PROCEDURE textwrite (d: DeviceTablePtr;
+                     from: ADDRESS;
+                     charsToWrite: CARDINAL);
+BEGIN
+   doWriteText(dev, d, from, charsToWrite)
+END textwrite ;
+
+
+PROCEDURE rawread (d: DeviceTablePtr;
+                   to: ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+BEGIN
+   doReadLocs(dev, d, to, maxLocs, locsRead)
+END rawread ;
+
+
+PROCEDURE rawwrite (d: DeviceTablePtr;
+                    from: ADDRESS;
+                    locsToWrite: CARDINAL) ;
+BEGIN
+   doWriteLocs(dev, d, from, locsToWrite)
+END rawwrite ;
+
+
+(*
+   doreadchar - returns a CHAR from the file associated with, g.
+*)
+
+PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+VAR
+   i : INTEGER ;
+   fd: INTEGER ;
+   c : ClientInfo ;
+   ch: CHAR ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH d^ DO
+      fd := getClientSocketFd(c) ;
+      IF NOT getPushBackChar(c, ch)
+      THEN
+         REPEAT
+            i := read(fd, ADR(ch), SIZE(ch))
+         UNTIL i#0 ;
+         IF i<0
+         THEN
+            errNum := geterrno()
+         END
+      END ;
+      RETURN( ch )
+   END
+END doreadchar ;
+
+
+(*
+   dounreadchar - pushes a CHAR back onto the file associated with, g.
+*)
+
+PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+VAR
+   fd: INTEGER ;
+   c : ClientInfo ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH d^ DO
+      fd := getClientSocketFd(c) ;
+      IF NOT setPushBackChar(c, ch)
+      THEN
+         RAISEdevException(cid, did, notAvailable,
+                           'ClientSocket.dounreadchar: number of characters pushed back exceeds buffer')
+      END ;
+      RETURN( ch )
+   END
+END dounreadchar ;
+
+
+(*
+   dogeterrno - returns the errno relating to the generic device.
+*)
+
+PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+BEGIN
+   RETURN geterrno()
+END dogeterrno ;
+
+
+(*
+   dorbytes - reads upto, max, bytes setting, actual, and
+              returning FALSE if an error (not due to eof)
+              occurred.
+*)
+
+PROCEDURE dorbytes (g: GenDevIF; d: DeviceTablePtr;
+                    to: ADDRESS;
+                    max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   fd: INTEGER ;
+   c : ClientInfo ;
+   p : PtrToLoc ;
+   i : INTEGER ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH d^ DO
+      IF max>0
+      THEN
+         p := to ;
+         IF getPushBackChar(c, p^)
+         THEN
+            actual := 1 ;
+            RETURN( TRUE )
+         END ;
+         fd := getClientSocketFd(c) ;
+         i := read(fd, p, max) ;
+         IF i>=0
+         THEN
+            actual := i ;
+            RETURN( TRUE )
+         ELSE
+            errNum := geterrno() ;
+            actual := 0 ;
+            RETURN( FALSE )
+         END
+      END
+   END
+END dorbytes ;
+
+
+(*
+   dowbytes -
+*)
+
+PROCEDURE dowbytes (g: GenDevIF; d: DeviceTablePtr;
+                    from: ADDRESS;
+                    nBytes: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   fd: INTEGER ;
+   c : ClientInfo ;
+   i : INTEGER ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH d^ DO
+      fd := getClientSocketFd(c) ;
+      i := write(fd, from, nBytes) ;
+      IF i>=0
+      THEN
+         actual := i ;
+         RETURN( TRUE )
+      ELSE
+         errNum := geterrno() ;
+         actual := 0 ;
+         RETURN( FALSE )
+      END
+   END
+END dowbytes ;
+
+
+(*
+   dowriteln - attempt to write an end of line marker to the
+               file and returns TRUE if successful.
+*)
+
+PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   a: ARRAY [0..1] OF CHAR ;
+   i: CARDINAL ;
+BEGIN
+   a[0] := cr ;
+   a[1] := lf ;
+   RETURN( dowbytes(g, d, ADR(a), SIZE(a), i) AND (i=SIZE(a)) )
+END dowriteln ;
+
+
+(*
+   iseof - returns TRUE if end of file is seen.
+*)
+
+PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := doreadchar(g, d) ;
+   WITH d^ DO
+      IF errNum=0
+      THEN
+         ch := dounreadchar(g, d, ch) ;
+         RETURN( FALSE )
+      ELSE
+         RETURN( TRUE )
+      END
+   END
+END iseof ;
+
+
+(*
+   iseoln - returns TRUE if end of line is seen.
+*)
+
+PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := doreadchar(g, d) ;
+   WITH d^ DO
+      IF errNum=0
+      THEN
+         ch := dounreadchar(g, d, ch) ;
+         RETURN( ch=lf )
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END iseoln ;
+
+
+(*
+   iserror - returns TRUE if an error was seen on the device.
+*)
+
+PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RETURN( d^.errNum#0 )
+END iserror ;
+
+
+PROCEDURE getname (d: DeviceTablePtr;
+                   VAR a: ARRAY OF CHAR) ;
+VAR
+   c: ClientInfo ;
+   b: ARRAY [0..6] OF CHAR ;
+BEGIN
+   c := GetData(d, mid) ;
+   getClientHostname(c, ADR(a), HIGH(a)) ;
+   Append(':', a) ;
+   IntToStr(getClientPortNo(c) , b) ;
+   Append(b, a)
+END getname ;
+
+
+(*
+   freeData - disposes of, c.
+*)
+
+PROCEDURE freeData (c: ClientInfo) ;
+BEGIN
+   DEALLOCATE(c, ClientInfoSize) ;
+END freeData ;
+
+
+(*
+   handlefree -
+*)
+
+PROCEDURE handlefree (d: DeviceTablePtr) ;
+VAR
+   c : ClientInfo ;
+   fd: INTEGER ;
+   i : INTEGER ;
+BEGIN
+   c := GetData(d, mid) ;
+   fd := getClientSocketFd(c) ;
+   i := close(fd) ;
+   checkErrno(dev, d) ;
+   KillData(d, mid)
+END handlefree ;
+
+
+(*
+   OpenSocket - opens a TCP client connection to host:port.
+*)
+
+PROCEDURE OpenSocket (VAR cid: ChanId;
+                      host: ARRAY OF CHAR; port: CARDINAL;
+                      f: FlagSet; VAR res: OpenResults) ;
+VAR
+   d: DeviceTablePtr ;
+   c: ClientInfo ;
+   e: INTEGER ;
+BEGIN
+   MakeChan(did, cid) ;              (* create new channel *)
+   ALLOCATE(c, ClientInfoSize) ;     (* allocate client socket memory *)
+   d := DeviceTablePtrValue(cid, did) ;
+   InitData(d, mid, c, freeData) ;   (* attach memory to device and module *)
+   res := clientOpen(c, ADR(host), LENGTH(host), port) ;
+   IF res=opened
+   THEN
+      e := 0
+   ELSE
+      e := geterrno()
+   END ;
+   WITH d^ DO
+      flags := f ;
+      errNum := e ;
+      doLook := look ;
+      doSkip := skip ;
+      doSkipLook := skiplook ;
+      doLnWrite := lnwrite ;
+      doTextRead := textread ;
+      doTextWrite := textwrite ;
+      doRawRead := rawread ;
+      doRawWrite := rawwrite ;
+      doGetName := getname ;
+      doFree := handlefree
+   END
+END OpenSocket ;
+
+
+(*
+   IsSocket - tests if the channel identified by cid is open as
+              a client socket stream.
+*)
+
+PROCEDURE IsSocket (cid: ChanId) : BOOLEAN ;
+BEGIN
+   RETURN( (cid # NIL) AND (InvalidChan() # cid) AND
+           (IsDevice(cid, did)) AND
+           ((readFlag IN CurrentFlags(cid)) OR
+            (writeFlag IN CurrentFlags(cid))) )
+END IsSocket ;
+
+
+(*
+   Close - if the channel identified by cid is not open to a socket
+           stream, the exception wrongDevice is raised; otherwise
+           closes the channel, and assigns the value identifying
+           the invalid channel to cid.
+*)
+
+PROCEDURE Close (VAR cid: ChanId) ;
+BEGIN
+   IF IsSocket(cid)
+   THEN
+      UnMakeChan(did, cid) ;
+      cid := InvalidChan()
+   ELSE
+      RAISEdevException(cid, did, wrongDevice,
+                        'ClientSocket.' + __FUNCTION__ +
+                        ': channel is not a socket stream')
+   END
+END Close ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+VAR
+   gen: GenDevIF ;
+BEGIN
+   MakeModuleId(mid) ;
+   ClientInfoSize := getSizeOfClientInfo() ;
+   AllocateDeviceId(did) ;
+   gen := InitGenDevIF(did, doreadchar, dounreadchar,
+                       dogeterrno, dorbytes, dowbytes,
+                       dowriteln,
+                       iseof, iseoln, iserror) ;
+   dev := InitChanDev(streamfile, did, gen)
+END Init ;
+
+
+BEGIN
+   Init
+END ClientSocket.
diff --git a/gcc/m2/gm2-libs-iso/ComplexMath.def b/gcc/m2/gm2-libs-iso/ComplexMath.def
new file mode 100644
index 00000000000..bc3d32e151b
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ComplexMath.def
@@ -0,0 +1,73 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE ComplexMath;
+
+  (* Mathematical functions for the type COMPLEX *)
+
+CONST
+  i =    CMPLX (0.0, 1.0);
+  one =  CMPLX (1.0, 0.0);
+  zero = CMPLX (0.0, 0.0);
+
+PROCEDURE __BUILTIN__ abs (z: COMPLEX): REAL;
+  (* Returns the length of z *)
+
+PROCEDURE __BUILTIN__ arg (z: COMPLEX): REAL;
+  (* Returns the angle that z subtends to the positive real axis *)
+
+PROCEDURE __BUILTIN__ conj (z: COMPLEX): COMPLEX;
+  (* Returns the complex conjugate of z *)
+
+PROCEDURE __BUILTIN__ power (base: COMPLEX; exponent: REAL): COMPLEX;
+  (* Returns the value of the number base raised to the power exponent *)
+
+PROCEDURE __BUILTIN__ sqrt (z: COMPLEX): COMPLEX;
+  (* Returns the principal square root of z *)
+
+PROCEDURE __BUILTIN__ exp (z: COMPLEX): COMPLEX;
+  (* Returns the complex exponential of z *)
+
+PROCEDURE __BUILTIN__ ln (z: COMPLEX): COMPLEX;
+  (* Returns the principal value of the natural logarithm of z *)
+
+PROCEDURE __BUILTIN__ sin (z: COMPLEX): COMPLEX;
+  (* Returns the sine of z *)
+
+PROCEDURE __BUILTIN__ cos (z: COMPLEX): COMPLEX;
+  (* Returns the cosine of z *)
+
+PROCEDURE __BUILTIN__ tan (z: COMPLEX): COMPLEX;
+  (* Returns the tangent of z *)
+
+PROCEDURE __BUILTIN__ arcsin (z: COMPLEX): COMPLEX;
+  (* Returns the arcsine of z *)
+
+PROCEDURE __BUILTIN__ arccos (z: COMPLEX): COMPLEX;
+  (* Returns the arccosine of z *)
+
+PROCEDURE __BUILTIN__ arctan (z: COMPLEX): COMPLEX;
+  (* Returns the arctangent of z *)
+
+PROCEDURE polarToComplex (abs, arg: REAL): COMPLEX;
+  (* Returns the complex number with the specified polar coordinates *)
+
+PROCEDURE scalarMult (scalar: REAL; z: COMPLEX): COMPLEX;
+  (* Returns the scalar product of scalar with z *)
+
+PROCEDURE IsCMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in a
+     routine from this module; otherwise returns FALSE.
+  *)
+
+END ComplexMath.
+
diff --git a/gcc/m2/gm2-libs-iso/ComplexMath.mod b/gcc/m2/gm2-libs-iso/ComplexMath.mod
new file mode 100644
index 00000000000..104fdc25d90
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ComplexMath.mod
@@ -0,0 +1,164 @@
+(* ComplexMath.mod implement the ISO ComplexMath specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ComplexMath ;
+
+IMPORT cbuiltin ;
+
+
+(* Returns the length of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cabs)) abs (z: COMPLEX): REAL;
+BEGIN
+   RETURN cbuiltin.cabs (z)
+END abs ;
+
+
+(* Returns the angle that z subtends to the positive real axis *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carg)) arg (z: COMPLEX): REAL;
+BEGIN
+   RETURN cbuiltin.carg (z)
+END arg ;
+
+
+(* Returns the complex conjugate of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_conj)) conj (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.conj (z)
+END conj ;
+
+
+(* Returns the value of the number base raised to the power exponent *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cpower)) power (base: COMPLEX; exponent: REAL): COMPLEX;
+BEGIN
+   RETURN cbuiltin.cpow (base, exponent)
+END power ;
+
+
+(* Returns the principal square root of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csqrt)) sqrt (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.csqrt (z)
+END sqrt ;
+
+
+(* Returns the complex exponential of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cexp)) exp (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.cexp (z)
+END exp ;
+
+
+(* Returns the principal value of the natural logarithm of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cln)) ln (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.clog (z)
+END ln ;
+
+
+(* Returns the sine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csin)) sin (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.csin (z)
+END sin ;
+
+
+(* Returns the cosine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ccos)) cos (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.ccos (z)
+END cos ;
+
+
+(* Returns the tangent of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ctan)) tan (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.ctan (z)
+END tan ;
+
+
+(* Returns the arcsine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carcsin)) arcsin (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.casin (z)
+END arcsin ;
+
+
+(* Returns the arccosine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carccos)) arccos (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.cacos (z)
+END arccos ;
+
+
+(* Returns the arctangent of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carctan)) arctan (z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN cbuiltin.catan (z)
+END arctan ;
+
+
+(* Returns the complex number with the specified polar coordinates *)
+
+PROCEDURE polarToComplex (abs, arg: REAL): COMPLEX;
+BEGIN
+   RETURN CMPLX (abs*cbuiltin.cos(arg), abs*cbuiltin.sin(arg))
+END polarToComplex ;
+
+
+(* Returns the scalar product of scalar with z *)
+
+PROCEDURE scalarMult (scalar: REAL; z: COMPLEX): COMPLEX;
+BEGIN
+   RETURN CMPLX (RE(z)*scalar, IM(z)*scalar)
+END scalarMult ;
+
+
+(* Returns TRUE if the current coroutine is in the exceptional
+   execution state because of the raising of an exception in a
+   routine from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsCMathException (): BOOLEAN;
+BEGIN
+   (* --fixme-- we should really attempt to catch sigfpe in these procedures *)
+   RETURN( FALSE )
+END IsCMathException ;
+
+
+END ComplexMath.
diff --git a/gcc/m2/gm2-libs-iso/ConvStringLong.def b/gcc/m2/gm2-libs-iso/ConvStringLong.def
new file mode 100644
index 00000000000..0b592ca15e8
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ConvStringLong.def
@@ -0,0 +1,60 @@
+(* ConvStringLong.def converts floating point numbers to Strings.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE ConvStringLong ;
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   RealToFloatString - converts a real with, sigFigs, into a string
+                       and returns the result as a string.
+*)
+
+PROCEDURE RealToFloatString (real: LONGREAL; sigFigs: CARDINAL) : String ;
+
+
+(*
+   RealToEngString - converts the value of real to floating-point
+                     string form, with sigFigs significant figures.
+                     The number is scaled with one to three digits
+                     in the whole number part and with an exponent
+                     that is a multiple of three.
+*)
+
+PROCEDURE RealToEngString (real: LONGREAL; sigFigs: CARDINAL) : String ;
+
+
+(*
+   RealToFixedString - returns the number of characters in the fixed-point
+                       string representation of real rounded to the given
+                       place relative to the decimal point.
+*)
+
+PROCEDURE RealToFixedString (real: LONGREAL; place: INTEGER) : String ;
+
+
+END ConvStringLong.
diff --git a/gcc/m2/gm2-libs-iso/ConvStringLong.mod b/gcc/m2/gm2-libs-iso/ConvStringLong.mod
new file mode 100644
index 00000000000..7f2ab3541d2
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ConvStringLong.mod
@@ -0,0 +1,292 @@
+(* ConvStringLong.mod converts floating point numbers to Strings.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ConvStringLong ;
+
+FROM DynamicStrings IMPORT InitString, KillString, ConCat, ConCatChar,
+                           Slice, Length, Mult, Mark, InitStringCharStar,
+                           InitStringChar, Index, char ;
+FROM StringConvert IMPORT IntegerToString, ToSigFig ;
+FROM ldtoa IMPORT ldtoa, Mode ;
+FROM libc IMPORT free ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   IsDigit - returns TRUE if, ch, lies between '0'..'9'.
+*)
+
+PROCEDURE IsDigit (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch>='0') AND (ch<='9')
+END IsDigit ;
+
+
+(*
+   RealToFloatString - converts a real with, sigFigs, into a string
+                       and returns the result as a string.
+*)
+
+PROCEDURE RealToFloatString (real: LONGREAL; sigFigs: CARDINAL) : String ;
+VAR
+   point, l,
+   powerOfTen: INTEGER ;
+   s         : String ;
+   r         : ADDRESS ;
+   sign      : BOOLEAN ;
+BEGIN
+   r := ldtoa(real, maxsignificant, 100, point, sign) ;
+   s := InitStringCharStar(r) ;
+   free(r) ;
+   IF sigFigs>0
+   THEN
+      l := Length(s) ;
+      IF (l>0) AND IsDigit(char(s, 0))
+      THEN
+         IF VAL(INTEGER, sigFigs)<l
+         THEN
+            s := Slice(ToSigFig(s, sigFigs), 0, sigFigs)
+         ELSE
+            (* add '0's to make up significant figures *)
+            s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, sigFigs))))
+         END ;
+         l := Length(s) ;
+         (*
+          *  we reassign point to 1 and adjust the exponent
+          *  accordingly, so we can achieve the format X.XXXE+X
+          *)
+         powerOfTen := point-1 ;
+         point := 1 ;
+
+         IF (point<l) AND (point<VAL(INTEGER, sigFigs))
+         THEN
+            s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                        Slice(s, point, 0))
+         END ;
+
+         IF powerOfTen#0
+         THEN
+            s := ConCat(ConCatChar(s, 'E'),
+                        IntegerToString(powerOfTen, 0, ' ', TRUE, 10, FALSE))
+         END
+      END ;
+      IF sign
+      THEN
+         s := ConCat(InitStringChar('-'), Mark(s))
+      END
+   END ;
+   RETURN( s )
+END RealToFloatString ;
+
+
+(*
+   RealToEngString - converts the value of real to floating-point
+                     string form, with sigFigs significant figures.
+                     The number is scaled with one to three digits
+                     in the whole number part and with an exponent
+                     that is a multiple of three.
+*)
+
+PROCEDURE RealToEngString (real: LONGREAL; sigFigs: CARDINAL) : String ;
+VAR
+   offset,
+   point,
+   powerOfTen: INTEGER ;
+   s         : String ;
+   l         : CARDINAL ;
+   r         : ADDRESS ;
+   sign      : BOOLEAN ;
+BEGIN
+   r := ldtoa(real, maxsignificant, 100, point, sign) ;
+   s := InitStringCharStar(r) ;
+   free(r) ;
+   IF sigFigs>0
+   THEN
+      l := Length(s) ;
+      IF (l>0) AND IsDigit(char(s, 0))
+      THEN
+         IF sigFigs<l
+         THEN
+            s := Slice(ToSigFig(s, sigFigs), 0, sigFigs)
+         ELSE
+            (* add '0's to make up significant figures *)
+            s := ConCat(s, Mark(Mult(InitStringChar('0'), l-sigFigs)))
+         END ;
+         l := Length(s) ;
+         IF (point>0) AND (point<=2)
+         THEN
+            (* current range is fine, no need for a exponent *)
+            powerOfTen := 0 ;
+            IF point>VAL(INTEGER, sigFigs)
+            THEN
+               (* add '0's to make up required mantissa length *)
+               s := ConCat(s, Mark(Mult(InitStringChar('0'), point-VAL(INTEGER, sigFigs)))) ;
+               l := Length(s)
+            END
+         ELSE
+            (*
+             *  desire a value of point which lies between 1..3
+             *  this allows the mantissa to have the format
+             *  X.XXX  or  XX.XX  or XXX.X
+             *)
+            powerOfTen := point-VAL(INTEGER, l) ;
+            point := point-powerOfTen ;
+            offset := 0 ;
+            IF point>3
+            THEN
+               offset := (point DIV 3) * 3 ;
+               point := point-offset ;
+               powerOfTen := powerOfTen+offset
+            ELSIF point<0
+            THEN
+               offset := (ABS(point) DIV 3) * 3 ;
+               point := point+offset ;
+               powerOfTen := powerOfTen-offset
+            END ;
+            IF powerOfTen<0
+            THEN
+               IF ABS(powerOfTen) MOD 3#0
+               THEN
+                  offset := 3-(ABS(powerOfTen) MOD 3)
+               END
+            ELSE
+               (* at this stage, point >= sigFigs *)
+               IF powerOfTen MOD 3#0
+               THEN
+                  offset := -(3-(powerOfTen MOD 3))
+               END
+            END ;
+            IF offset+point>VAL(INTEGER, sigFigs)
+            THEN
+               (* add '0's to make up required mantissa length *)
+               s := ConCat(s, Mark(Mult(InitStringChar('0'), offset+point-VAL(INTEGER, sigFigs)))) ;
+               l := Length(s)
+            END ;
+            (* now adjust point and powerOfTen by offset *)
+            point := point + offset ;
+            powerOfTen := powerOfTen - offset
+         END ;
+
+         IF point<0
+         THEN
+            s := ConCat(ConCat(InitString('0.'), Mult(InitStringChar('0'), -point)), s)
+         ELSIF (point>0) AND (point<VAL(INTEGER, l)) AND (point<VAL(INTEGER, sigFigs))
+         THEN
+            s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                        Slice(s, point, 0))
+         END ;
+
+         IF powerOfTen#0
+         THEN
+            s := ConCat(ConCatChar(s, 'E'),
+                        IntegerToString(powerOfTen, 0, ' ', TRUE, 10, FALSE))
+         END
+      END ;
+      IF sign
+      THEN
+         s := ConCat(InitStringChar('-'), Mark(s))
+      END
+   END ;
+   RETURN( s )
+END RealToEngString ;
+
+
+(*
+   RealToFixedString - returns the number of characters in the fixed-point
+                       string representation of real rounded to the given
+                       place relative to the decimal point.
+*)
+
+PROCEDURE RealToFixedString (real: LONGREAL; place: INTEGER) : String ;
+VAR
+   l,
+   point: INTEGER ;
+   sign : BOOLEAN ;
+   r    : ADDRESS ;
+   s    : String ;
+BEGIN
+   r := ldtoa(real, maxsignificant, 100, point, sign) ;
+   s := InitStringCharStar(r) ;
+   free(r) ;
+   l := Length(s) ;
+   IF (l>0) AND IsDigit(char(s, 0))
+   THEN
+      IF point+place>=0
+      THEN
+         (* add decimal point at correct position *)
+         IF point<0
+         THEN
+            s := ConCat(ConCat(InitString('0.'), Mult(InitStringChar('0'), -point)), s)
+         ELSIF point=0
+         THEN
+            s := ConCat(InitString('0.'), Mark(s))
+         ELSIF point<l
+         THEN
+            s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                        Slice(s, point, 0))
+         END ;
+         IF place<0
+         THEN
+            s := ToSigFig(s, point+place+1)
+         ELSE
+            s := ToSigFig(s, point+place)
+         END ;
+         l := Length(s) ;
+         IF place>=0
+         THEN
+            IF Index(s, '.', 0)<0
+            THEN
+               s := ConCatChar(s, '.') ;
+               s := ConCat(s, Mark(Mult(InitStringChar('0'), place)))
+            ELSE
+               point := Index(s, '.', 0) ;
+               IF l-point<place
+               THEN
+                  s := ConCat(s, Mark(Mult(InitStringChar('0'), l-point-place)))
+               END
+            END
+         END
+      ELSE
+         IF place<0
+         THEN
+            s := InitString('0')
+         ELSIF place=0
+         THEN
+            s := InitString('0.')
+         ELSE
+            s := InitString('0.0')
+         END
+      END
+   END ;
+   IF sign
+   THEN
+      s := ConCat(InitStringChar('-'), Mark(s))
+   END ;
+   RETURN( s )
+END RealToFixedString ;
+
+
+END ConvStringLong.
diff --git a/gcc/m2/gm2-libs-iso/ConvStringReal.def b/gcc/m2/gm2-libs-iso/ConvStringReal.def
new file mode 100644
index 00000000000..66465a43016
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ConvStringReal.def
@@ -0,0 +1,60 @@
+(* ConvStringReal.def translate floating point numbers to Strings.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE ConvStringReal ;
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   RealToFloatString - converts a real with, sigFigs, into a string
+                       and returns the result as a string.
+*)
+
+PROCEDURE RealToFloatString (real: REAL; sigFigs: CARDINAL) : String ;
+
+
+(*
+   RealToEngString - converts the value of real to floating-point
+                     string form, with sigFigs significant figures.
+                     The number is scaled with one to three digits
+                     in the whole number part and with an exponent
+                     that is a multiple of three.
+*)
+
+PROCEDURE RealToEngString (real: REAL; sigFigs: CARDINAL) : String ;
+
+
+(*
+   RealToFixedString - returns the number of characters in the fixed-point
+                       string representation of real rounded to the given
+                       place relative to the decimal point.
+*)
+
+PROCEDURE RealToFixedString (real: REAL; place: INTEGER) : String ;
+
+
+END ConvStringReal.
diff --git a/gcc/m2/gm2-libs-iso/ConvStringReal.mod b/gcc/m2/gm2-libs-iso/ConvStringReal.mod
new file mode 100644
index 00000000000..9bd7592d3b0
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ConvStringReal.mod
@@ -0,0 +1,299 @@
+(* ConvStringReal.mod translate floating point numbers to Strings.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ConvStringReal ;
+
+FROM DynamicStrings IMPORT InitString, KillString, ConCat, ConCatChar,
+                           Slice, Length, Mult, Mark, InitStringCharStar,
+                           InitStringChar, Index, char ;
+FROM StringConvert IMPORT IntegerToString, ToSigFig ;
+FROM dtoa IMPORT dtoa, Mode ;
+FROM libc IMPORT free, printf ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+CONST
+   Debugging = FALSE ;
+
+
+(*
+   IsDigit - returns TRUE if, ch, lies between '0'..'9'.
+*)
+
+PROCEDURE IsDigit (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch>='0') AND (ch<='9')
+END IsDigit ;
+
+
+(*
+   RealToFloatString - converts a real with, sigFigs, into a string
+                       and returns the result as a string.
+*)
+
+PROCEDURE RealToFloatString (real: REAL; sigFigs: CARDINAL) : String ;
+VAR
+   point, l,
+   powerOfTen: INTEGER ;
+   s         : String ;
+   r         : ADDRESS ;
+   sign      : BOOLEAN ;
+BEGIN
+   r := dtoa(real, maxsignificant, 100, point, sign) ;
+   s := InitStringCharStar(r) ;
+   free(r) ;
+   IF sigFigs>0
+   THEN
+      l := Length(s) ;
+      IF (l>0) AND IsDigit(char(s, 0))
+      THEN
+         IF VAL(INTEGER, sigFigs)<l
+         THEN
+            s := Slice(ToSigFig(s, sigFigs), 0, sigFigs)
+         ELSE
+            (* add '0's to make up significant figures *)
+            s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, sigFigs))))
+         END ;
+         l := Length(s) ;
+         (*
+          *  we reassign point to 1 and adjust the exponent
+          *  accordingly, so we can achieve the format X.XXXE+X
+          *)
+         powerOfTen := point-1 ;
+         point := 1 ;
+
+         IF (point<l) AND (point<VAL(INTEGER, sigFigs))
+         THEN
+            s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                        Slice(s, point, 0))
+         END ;
+
+         IF powerOfTen#0
+         THEN
+            s := ConCat(ConCatChar(s, 'E'),
+                        IntegerToString(powerOfTen, 0, ' ', TRUE, 10, FALSE))
+         END
+      END ;
+      IF sign
+      THEN
+         s := ConCat(InitStringChar('-'), Mark(s))
+      END
+   END ;
+   RETURN( s )
+END RealToFloatString ;
+
+
+(*
+   RealToEngString - converts the value of real to floating-point
+                     string form, with sigFigs significant figures.
+                     The number is scaled with one to three digits
+                     in the whole number part and with an exponent
+                     that is a multiple of three.
+*)
+
+PROCEDURE RealToEngString (real: REAL; sigFigs: CARDINAL) : String ;
+VAR
+   offset,
+   point,
+   powerOfTen: INTEGER ;
+   s         : String ;
+   l         : CARDINAL ;
+   r         : ADDRESS ;
+   sign      : BOOLEAN ;
+BEGIN
+   r := dtoa(real, maxsignificant, 100, point, sign) ;
+   s := InitStringCharStar(r) ;
+   free(r) ;
+   IF sigFigs>0
+   THEN
+      l := Length(s) ;
+      IF (l>0) AND IsDigit(char(s, 0))
+      THEN
+         IF sigFigs<l
+         THEN
+            s := Slice(ToSigFig(s, sigFigs), 0, sigFigs)
+         ELSE
+            (* add '0's to make up significant figures *)
+            s := ConCat(s, Mark(Mult(InitStringChar('0'), l-sigFigs)))
+         END ;
+         l := Length(s) ;
+         IF (point>0) AND (point<=2)
+         THEN
+            (* current range is fine, no need for a exponent *)
+            powerOfTen := 0 ;
+            IF point>VAL(INTEGER, sigFigs)
+            THEN
+               (* add '0's to make up required mantissa length *)
+               s := ConCat(s, Mark(Mult(InitStringChar('0'), point-VAL(INTEGER, sigFigs)))) ;
+               l := Length(s)
+            END
+         ELSE
+            (*
+             *  desire a value of point which lies between 1..3
+             *  this allows the mantissa to have the format
+             *  X.XXX  or  XX.XX  or XXX.X
+             *)
+            powerOfTen := point-VAL(INTEGER, l) ;
+            point := point-powerOfTen ;
+            offset := 0 ;
+            IF point>3
+            THEN
+               offset := (point DIV 3) * 3 ;
+               point := point-offset ;
+               powerOfTen := powerOfTen+offset
+            ELSIF point<0
+            THEN
+               offset := (ABS(point) DIV 3) * 3 ;
+               point := point+offset ;
+               powerOfTen := powerOfTen-offset
+            END ;
+            IF powerOfTen<0
+            THEN
+               IF ABS(powerOfTen) MOD 3#0
+               THEN
+                  offset := 3-(ABS(powerOfTen) MOD 3)
+               END
+            ELSE
+               (* at this stage, point >= sigFigs *)
+               IF powerOfTen MOD 3#0
+               THEN
+                  offset := -(3-(powerOfTen MOD 3))
+               END
+            END ;
+            IF offset+point>VAL(INTEGER, sigFigs)
+            THEN
+               (* add '0's to make up required mantissa length *)
+               s := ConCat(s, Mark(Mult(InitStringChar('0'), offset+point-VAL(INTEGER, sigFigs)))) ;
+               l := Length(s)
+            END ;
+            (* now adjust point and powerOfTen by offset *)
+            point := point + offset ;
+            powerOfTen := powerOfTen - offset
+         END ;
+
+         IF point<0
+         THEN
+            s := ConCat(ConCat(InitString('0.'), Mult(InitStringChar('0'), -point)), s)
+         ELSIF (point>0) AND (point<VAL(INTEGER, l)) AND (point<VAL(INTEGER, sigFigs))
+         THEN
+            s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                        Slice(s, point, 0))
+         END ;
+
+         IF powerOfTen#0
+         THEN
+            s := ConCat(ConCatChar(s, 'E'),
+                        IntegerToString(powerOfTen, 0, ' ', TRUE, 10, FALSE))
+         END
+      END ;
+      IF sign
+      THEN
+         s := ConCat(InitStringChar('-'), Mark(s))
+      END
+   END ;
+   RETURN( s )
+END RealToEngString ;
+
+
+(*
+   RealToFixedString - returns the number of characters in the fixed-point
+                       string representation of real rounded to the given
+                       place relative to the decimal point.
+*)
+
+PROCEDURE RealToFixedString (real: REAL; place: INTEGER) : String ;
+VAR
+   l,
+   point: INTEGER ;
+   sign : BOOLEAN ;
+   r    : ADDRESS ;
+   s    : String ;
+BEGIN
+   r := dtoa(real, maxsignificant, 100, point, sign) ;
+   s := InitStringCharStar(r) ;
+   free(r) ;
+   l := Length(s) ;
+   IF Debugging
+   THEN
+      printf("length of string returned is %d decimal point at position %d\n", l, point)
+   END ;
+   IF (l>0) AND IsDigit(char(s, 0))
+   THEN
+      IF point+place>=0
+      THEN
+         (* add decimal point at correct position *)
+         IF point<0
+         THEN
+            s := ConCat(ConCat(InitString('0.'), Mult(InitStringChar('0'), -point)), s)
+         ELSIF point=0
+         THEN
+            s := ConCat(InitString('0.'), Mark(s))
+         ELSIF point<l
+         THEN
+            s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                        Slice(s, point, 0))
+         END ;
+         IF place<0
+         THEN
+            s := ToSigFig(s, point+place+1)
+         ELSE
+            s := ToSigFig(s, point+place)
+         END ;
+         l := Length(s) ;
+         IF place>=0
+         THEN
+            IF Index(s, '.', 0)<0
+            THEN
+               s := ConCatChar(s, '.') ;
+               s := ConCat(s, Mark(Mult(InitStringChar('0'), place)))
+            ELSE
+               point := Index(s, '.', 0) ;
+               IF l-point<place
+               THEN
+                  s := ConCat(s, Mark(Mult(InitStringChar('0'), l-point-place)))
+               END
+            END
+         END
+      ELSE
+         IF place<0
+         THEN
+            s := InitString('0')
+         ELSIF place=0
+         THEN
+            s := InitString('0.')
+         ELSE
+            s := InitString('0.0')
+         END
+      END
+   END ;
+   IF sign
+   THEN
+      s := ConCat(InitStringChar('-'), Mark(s))
+   END ;
+   RETURN( s )
+END RealToFixedString ;
+
+
+END ConvStringReal.
diff --git a/gcc/m2/gm2-libs-iso/ConvTypes.def b/gcc/m2/gm2-libs-iso/ConvTypes.def
new file mode 100644
index 00000000000..87bce3ef954
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ConvTypes.def
@@ -0,0 +1,37 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE ConvTypes;
+
+  (* Common types used in the string conversion modules *)
+
+TYPE
+  ConvResults =     (* Values of this type are used to express the format of a string *)
+  (
+    strAllRight,    (* the string format is correct for the corresponding conversion *)
+    strOutOfRange,  (* the string is well-formed but the value cannot be represented *)
+    strWrongFormat, (* the string is in the wrong format for the conversion *)
+    strEmpty        (* the given string is empty *)
+  );
+
+  ScanClass =  (* Values of this type are used to classify input to finite state scanners *)
+  (
+    padding,   (* a leading or padding character at this point in the scan - ignore it *)
+    valid,     (* a valid character at this point in the scan - accept it *)
+    invalid,   (* an invalid character at this point in the scan - reject it *)
+    terminator (* a terminating character at this point in the scan (not part of token) *)
+  );
+
+  ScanState =  (* The type of lexical scanning control procedures *)
+    PROCEDURE (CHAR, VAR ScanClass, VAR ScanState);
+
+END ConvTypes.
+
diff --git a/gcc/m2/gm2-libs-iso/ConvTypes.mod b/gcc/m2/gm2-libs-iso/ConvTypes.mod
new file mode 100644
index 00000000000..d579861b332
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ConvTypes.mod
@@ -0,0 +1,29 @@
+(* ConvTypes.mod implement the ISO ConvTypes specification.
+
+Copyright (C) 2002-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ConvTypes ;
+
+END ConvTypes.
diff --git a/gcc/m2/gm2-libs-iso/EXCEPTIONS.def b/gcc/m2/gm2-libs-iso/EXCEPTIONS.def
new file mode 100644
index 00000000000..40d6aa59a31
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/EXCEPTIONS.def
@@ -0,0 +1,58 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE EXCEPTIONS;
+
+(* Provides facilities for raising user exceptions
+   and for making enquiries concerning the current execution state.
+*)
+
+TYPE
+  ExceptionSource;   (* values of this type are used within library
+                        modules to identify the source of raised
+                        exceptions *)
+  ExceptionNumber = CARDINAL;
+
+PROCEDURE AllocateSource(VAR newSource: ExceptionSource);
+  (* Allocates a unique value of type ExceptionSource *)
+
+PROCEDURE RAISE (source: ExceptionSource;
+                 number: ExceptionNumber; message: ARRAY OF CHAR);
+  (* Associates the given values of source, number and message with
+     the current context and raises an exception.
+  *)
+
+PROCEDURE CurrentNumber (source: ExceptionSource): ExceptionNumber;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from source, returns
+     the corresponding number, and otherwise raises an exception.
+  *)
+
+PROCEDURE GetMessage (VAR text: ARRAY OF CHAR);
+  (* If the current coroutine is in the exceptional execution state,
+     returns the possibly truncated string associated with the
+     current context.  Otherwise, in normal execution state,
+     returns the empty string.
+  *)
+
+PROCEDURE IsCurrentSource (source: ExceptionSource): BOOLEAN;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from source, returns
+     TRUE, and otherwise returns FALSE.
+  *)
+
+PROCEDURE IsExceptionalExecution (): BOOLEAN;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception, returns TRUE, and
+     otherwise returns FALSE.
+  *)
+
+END EXCEPTIONS.
diff --git a/gcc/m2/gm2-libs-iso/EXCEPTIONS.mod b/gcc/m2/gm2-libs-iso/EXCEPTIONS.mod
new file mode 100644
index 00000000000..0aeda62dcc2
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/EXCEPTIONS.mod
@@ -0,0 +1,138 @@
+(* EXCEPTIONS.mod implement the ISO EXCEPTIONS specification.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+IMPLEMENTATION MODULE EXCEPTIONS ;
+
+IMPORT RTExceptions ;
+IMPORT M2EXCEPTION ;
+IMPORT M2RTS ;
+IMPORT ASCII ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM Storage IMPORT ALLOCATE ;
+
+
+TYPE
+   ExceptionSource = POINTER TO RECORD
+                                   eh: RTExceptions.EHBlock ;
+                                END ;
+   (* values of this type are used within library modules to
+      identify the source of raised exceptions *)
+
+
+PROCEDURE AllocateSource (VAR newSource: ExceptionSource) ;
+  (* Allocates a unique value of type ExceptionSource *)
+BEGIN
+   NEW(newSource) ;
+   WITH newSource^ DO
+      eh := RTExceptions.InitExceptionBlock()
+   END
+END AllocateSource ;
+
+
+PROCEDURE RAISE (source: ExceptionSource;
+                 number: ExceptionNumber;
+                 message: ARRAY OF CHAR) ;
+  (* Associates the given values of source, number and message with
+     the current context and raises an exception.
+  *)
+BEGIN
+   RTExceptions.SetExceptionSource(source) ;
+   RTExceptions.SetExceptionBlock(source^.eh) ;
+   RTExceptions.Raise(number, ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__), ADR(message)) ;
+   (* we should never reach here as Raise should jump to the exception handler *)
+   M2RTS.Halt(__FILE__, __LINE__, __FUNCTION__, 'should never return from RTException.Raise')
+END RAISE ;
+
+
+PROCEDURE CurrentNumber (source: ExceptionSource) : ExceptionNumber ;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from source, returns the
+     corresponding number, and otherwise raises an exception.
+  *)
+BEGIN
+   IF RTExceptions.IsInExceptionState()
+   THEN
+      RETURN( RTExceptions.GetNumber(source^.eh) )
+   ELSE
+      RTExceptions.Raise(ORD(M2EXCEPTION.coException),
+                         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+                         ADR('current coroutine is not in the exceptional execution state'))
+   END
+END CurrentNumber ;
+
+
+PROCEDURE GetMessage (VAR text: ARRAY OF CHAR) ;
+  (* If the current coroutine is in the exceptional execution state,
+     returns the possibly truncated string associated with the
+     current context.  Otherwise, in normal execution state,
+     returns the empty string.
+  *)
+VAR
+   p   : POINTER TO CHAR ;
+   i, h: CARDINAL ;
+BEGIN
+   IF RTExceptions.IsInExceptionState()
+   THEN
+      h := HIGH(text) ;
+      i := 0 ;
+      p := RTExceptions.GetTextBuffer(RTExceptions.GetExceptionBlock()) ;
+      WHILE (p#NIL) AND (p^#ASCII.nul) DO
+         text[i] := p^ ;
+         INC(i) ;
+         INC(p)
+      END ;
+      IF i<=h
+      THEN
+         text[i] := ASCII.nul
+      END
+   ELSE
+      text[0] := ASCII.nul
+   END
+END GetMessage ;
+
+
+PROCEDURE IsCurrentSource (source: ExceptionSource) : BOOLEAN ;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from source, returns TRUE,
+     and otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN( RTExceptions.IsInExceptionState() AND (source=RTExceptions.GetExceptionSource()) )
+END IsCurrentSource ;
+
+
+PROCEDURE IsExceptionalExecution () : BOOLEAN ;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception, returns TRUE,
+     and otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN( RTExceptions.IsInExceptionState() )
+END IsExceptionalExecution ;
+
+
+END EXCEPTIONS.
diff --git a/gcc/m2/gm2-libs-iso/ErrnoCategory.def b/gcc/m2/gm2-libs-iso/ErrnoCategory.def
new file mode 100644
index 00000000000..1de109027c3
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ErrnoCategory.def
@@ -0,0 +1,74 @@
+(* ErrnoCategory.def provides an interface to errno.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE ErrnoCategory ;
+
+(*
+   provides an interface to errno (if the system
+   supports it) which determines whether the current
+   errno is a hard or soft error.  These distinctions
+   are needed by the ISO Modula-2 libraries.  Not all
+   errno values are tested, only those which could be
+   related to a device.
+*)
+
+IMPORT ChanConsts ;
+
+
+(*
+   IsErrnoHard - returns TRUE if the value of errno is associated with
+                 a hard device error.
+*)
+
+PROCEDURE IsErrnoHard (e: INTEGER) : BOOLEAN ;
+
+
+(*
+   IsErrnoSoft - returns TRUE if the value of errno is associated with
+                 a soft device error.
+*)
+
+PROCEDURE IsErrnoSoft (e: INTEGER) : BOOLEAN ;
+
+
+(*
+   UnAvailable - returns TRUE if the value of errno indicates that
+                 the resource or device is unavailable for some
+                 reason.
+*)
+
+PROCEDURE UnAvailable (e: INTEGER) : BOOLEAN ;
+
+
+(*
+   GetOpenResults - maps errno onto the ISO Modula-2 enumerated
+                    type, OpenResults.
+*)
+
+PROCEDURE GetOpenResults (e: INTEGER) : ChanConsts.OpenResults ;
+
+
+END ErrnoCategory.
diff --git a/gcc/m2/gm2-libs-iso/GeneralUserExceptions.def b/gcc/m2/gm2-libs-iso/GeneralUserExceptions.def
new file mode 100644
index 00000000000..9a0e342b7fa
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/GeneralUserExceptions.def
@@ -0,0 +1,36 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE GeneralUserExceptions;
+
+(* Provides facilities for general user-defined exceptions *)
+
+TYPE
+  GeneralExceptions = (problem, disaster);
+
+PROCEDURE RaiseGeneralException (exception: GeneralExceptions;
+                                 text: ARRAY OF CHAR);
+  (* Raises exception using text as the associated message *)
+  
+PROCEDURE IsGeneralException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception from
+     GeneralExceptions; otherwise returns FALSE.
+  *)
+
+PROCEDURE GeneralException(): GeneralExceptions;
+  (* If the current coroutine is in the exceptional execution
+     state because of the raising of an exception from
+     GeneralExceptions, returns the corresponding enumeration value,
+     and otherwise raises an exception.
+  *)
+
+END GeneralUserExceptions.
diff --git a/gcc/m2/gm2-libs-iso/GeneralUserExceptions.mod b/gcc/m2/gm2-libs-iso/GeneralUserExceptions.mod
new file mode 100644
index 00000000000..63cf770f784
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/GeneralUserExceptions.mod
@@ -0,0 +1,87 @@
+(* GeneralUserExceptions.mod implement the ISO GeneralUserExceptions.
+
+Copyright (C) 2002-2021 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/>.  *)
+
+IMPLEMENTATION MODULE GeneralUserExceptions ;
+
+FROM EXCEPTIONS IMPORT ExceptionSource, RAISE, AllocateSource, CurrentNumber,
+                       IsCurrentSource, IsExceptionalExecution ;
+
+FROM M2RTS IMPORT NoException ;
+FROM SYSTEM IMPORT ADR ;
+
+
+VAR
+   general: ExceptionSource ;
+
+
+(*
+   RaiseGeneralException - raises exception using text as the associated
+                           message.
+*)
+
+PROCEDURE RaiseGeneralException (exception: GeneralExceptions; text: ARRAY OF CHAR) ;
+BEGIN
+   RAISE (general, ORD (exception), text)
+END RaiseGeneralException ;
+
+
+(*
+   IsGeneralException - returns TRUE if the current coroutine is in the
+                        exceptional execution state because of the raising
+                        of an exception from GeneralExceptions; otherwise
+                        returns FALSE.
+*)
+
+PROCEDURE IsGeneralException () : BOOLEAN ;
+BEGIN
+   RETURN IsExceptionalExecution () AND IsCurrentSource (general)
+END IsGeneralException ;
+
+
+(*
+   GeneralException - if the current coroutine is in the exceptional
+                      execution state because of the raising of an
+                      exception from GeneralExceptions, returns the
+                      corresponding enumeration value, and otherwise
+                      raises an exception.
+*)
+
+PROCEDURE GeneralException () : GeneralExceptions;
+BEGIN
+   IF IsGeneralException ()
+   THEN
+      RETURN VAL (GeneralExceptions, CurrentNumber (general))
+   ELSE
+      NoException (ADR (__FILE__), __LINE__,
+                   __COLUMN__, ADR (__FUNCTION__),
+      ADR ("not in the exceptional execution state"))
+   END
+END GeneralException ;
+
+
+BEGIN
+   AllocateSource (general)
+END GeneralUserExceptions.
diff --git a/gcc/m2/gm2-libs-iso/IOChan.def b/gcc/m2/gm2-libs-iso/IOChan.def
new file mode 100644
index 00000000000..81580ca4703
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/IOChan.def
@@ -0,0 +1,177 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE IOChan;
+
+  (* Types and procedures forming the interface to channels for
+     device-independent data transfer modules
+  *)
+
+IMPORT IOConsts, ChanConsts, SYSTEM;
+
+TYPE
+  ChanId; (* Values of this type are used to identify channels *)
+
+  (* There is one pre-defined value identifying an invalid channel
+     on which no data transfer operations are available.  It may
+     be used to initialize variables of type ChanId.
+  *)
+
+PROCEDURE InvalidChan (): ChanId;
+  (* Returns the value identifying the invalid channel. *)
+
+  (* For each of the following operations, if the device supports
+     the operation on the channel, the behaviour of the procedure
+     conforms with the description below.  The full behaviour is
+     defined for each device module.  If the device does not
+     support the operation on the channel, the behaviour of the
+     procedure is to raise the exception notAvailable.
+  *)
+
+  (* Text operations - these perform any required translation between the
+     internal and external representation of text.
+  *)
+
+PROCEDURE Look (cid: ChanId; VAR ch: CHAR; VAR res: IOConsts.ReadResults);
+  (* If there is a character as the next item in the input stream
+     cid, assigns its value to ch without removing it from the stream;
+     otherwise the value of ch is not defined.  res (and the stored
+     read result) are set to the value allRight, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE Skip (cid: ChanId);
+  (* If the input stream cid has ended, the exception skipAtEnd
+     is raised; otherwise the next character or line mark in cid is
+     removed, and the stored read result is set to the value
+     allRight.
+  *)
+
+PROCEDURE SkipLook (cid: ChanId; VAR ch: CHAR; VAR res: IOConsts.ReadResults);
+  (* If the input stream cid has ended, the exception skipAtEnd is
+     raised; otherwise the next character or line mark in cid is
+     removed.  If there is a character as the next item in cid
+     stream, assigns its value to ch without removing it from the
+     stream.  Otherwise, the value of ch is not defined.  res
+     (and the stored read result) are set to the value allRight,
+     endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteLn (cid: ChanId);
+  (* Writes a line mark over the channel cid. *)
+
+PROCEDURE TextRead (cid: ChanId; to: SYSTEM.ADDRESS; maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL);
+  (* Reads at most maxChars characters from the current line in cid,
+     and assigns corresponding values to successive components of
+     an ARRAY OF CHAR variable for which the address of the first
+     component is to. The number of characters read is assigned to charsRead.
+     The stored read result is set to allRight, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE TextWrite (cid: ChanId; from: SYSTEM.ADDRESS;
+                     charsToWrite: CARDINAL);
+  (* Writes a number of characters given by the value of charsToWrite,
+     from successive components of an ARRAY OF CHAR variable for which
+     the address of the first component is from, to the channel cid.
+  *)
+
+  (* Direct raw operations  - these do not effect translation between
+     the internal and external representation of data
+  *)
+
+PROCEDURE RawRead (cid: ChanId; to: SYSTEM.ADDRESS; maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL);
+  (* Reads at most maxLocs items from cid, and assigns corresponding
+     values to successive components of an ARRAY OF LOC variable for
+     which the address of the first component is to. The number of
+     characters read is assigned to charsRead. The stored read result
+     is set to the value allRight, or endOfInput.
+  *)
+
+PROCEDURE RawWrite (cid: ChanId; from: SYSTEM.ADDRESS; locsToWrite: CARDINAL);
+  (* Writes a number of items given by the value of charsToWrite,
+     from successive components of an ARRAY OF LOC variable for
+     which the address of the first component is from, to the channel cid.
+  *)
+
+  (* Common operations *)
+
+PROCEDURE GetName (cid: ChanId; VAR s: ARRAY OF CHAR);
+  (* Copies to s a name associated with the channel cid, possibly truncated
+     (depending on the capacity of s).
+  *)
+
+PROCEDURE Reset (cid: ChanId);
+  (* Resets the channel cid to a state defined by the device module. *)
+
+PROCEDURE Flush (cid: ChanId);
+  (* Flushes any data buffered by the device module out to the channel cid. *)
+
+  (* Access to read results *)
+
+PROCEDURE SetReadResult (cid: ChanId; res: IOConsts.ReadResults);
+  (* Sets the read result value for the channel cid to the value res. *)
+
+PROCEDURE ReadResult (cid: ChanId): IOConsts.ReadResults;
+  (* Returns the stored read result value for the channel cid.
+     (This is initially the value notKnown).
+  *)
+
+  (* Users can discover which flags actually apply to a channel *)
+
+PROCEDURE CurrentFlags (cid: ChanId): ChanConsts.FlagSet;
+  (* Returns the set of flags that currently apply to the channel cid. *)
+
+  (* The following exceptions are defined for this module and its clients *)
+
+TYPE
+  ChanExceptions =
+    (wrongDevice,      (* device specific operation on wrong device *)
+     notAvailable,     (* operation attempted that is not available on that
+                          channel *)
+     skipAtEnd,        (* attempt to skip data from a stream that has ended *)
+     softDeviceError,  (* device specific recoverable error *)
+     hardDeviceError,  (* device specific non-recoverable error *)
+     textParseError,   (* input data does not correspond to a character or
+                          line mark - optional detection *)
+     notAChannel       (* given value does not identify a channel -
+                          optional detection *)
+    );
+
+PROCEDURE IsChanException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception from
+     ChanExceptions; otherwise returns FALSE.
+  *)
+
+PROCEDURE ChanException (): ChanExceptions;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from ChanExceptions,
+     returns the corresponding enumeration value, and otherwise
+     raises an exception.
+  *)
+
+  (* When a device procedure detects a device error, it raises the
+     exception softDeviceError or hardDeviceError.  If these
+     exceptions are handled, the following facilities may be
+     used to discover an implementation-defined error number for
+     the channel.
+  *)
+
+TYPE
+  DeviceErrNum = INTEGER;
+
+PROCEDURE DeviceError (cid: ChanId): DeviceErrNum;
+  (* If a device error exception has been raised for the channel cid,
+     returns the error number stored by the device module.
+  *)
+
+END IOChan.
diff --git a/gcc/m2/gm2-libs-iso/IOChan.mod b/gcc/m2/gm2-libs-iso/IOChan.mod
new file mode 100644
index 00000000000..b5cb7467e61
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/IOChan.mod
@@ -0,0 +1,550 @@
+(* IOChan.mod implement the ISO IOChan specification.
+
+Copyright (C) 2002-2021 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/>.  *)
+
+IMPLEMENTATION MODULE IOChan ;
+
+IMPORT FIO, EXCEPTIONS, M2EXCEPTION, RTio, IOConsts,
+       RTentity, errno, ErrnoCategory, IOLink, StdChans, M2RTS ;
+
+FROM EXCEPTIONS IMPORT ExceptionSource, RAISE, AllocateSource,
+                       IsCurrentSource, IsExceptionalExecution ;
+FROM Storage IMPORT ALLOCATE ;
+
+
+TYPE
+   ChanId = RTio.ChanId ;
+
+VAR
+   iochan :  ExceptionSource ;
+   invalid:  ChanId ;
+
+
+PROCEDURE InvalidChan () : ChanId ;
+  (* Returns the value identifying the invalid channel. *)
+BEGIN
+   RETURN( invalid )
+END InvalidChan ;
+
+
+PROCEDURE CheckValid (cid: ChanId) ;
+  (* internal routine to check whether we have a valid channel *)
+BEGIN
+   IF cid=InvalidChan()
+   THEN
+      RAISE(iochan, ORD(notAChannel), 'IOChan: ChanId specified is invalid')
+   END
+END CheckValid ;
+
+
+  (* For each of the following operations, if the device supports the
+     operation on the channel, the behaviour of the procedure conforms
+     with the description below.  The full behaviour is defined for
+     each device module.  If the device does not support the operation
+     on the channel, the behaviour of the procedure is to raise the
+     exception notAvailable.
+  *)
+
+  (* Text operations - these perform any required translation
+     between the internal and external representation of text.
+  *)
+
+PROCEDURE Look (cid: ChanId; VAR ch: CHAR; VAR res: IOConsts.ReadResults) ;
+  (* If there is a character as the next item in the input stream cid,
+     assigns its value to ch without removing it from the stream;
+     otherwise the value of ch is not defined.
+     res (and the stored read result) are set to the value
+     allRight, endOfLine, or endOfInput.
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.Look: device table ptr is NIL')
+   ELSE
+      WITH dtp^ DO
+         IF cid=StdChans.NullChan()
+         THEN
+            result := IOConsts.endOfInput
+         ELSIF (ChanConsts.readFlag IN flags) AND (ChanConsts.textFlag IN flags)
+         THEN
+            doLook(dtp, ch, res)
+         ELSE
+            res := IOConsts.wrongFormat
+         END ;
+         result := res
+      END
+   END
+END Look ;
+
+
+PROCEDURE Skip (cid: ChanId) ;
+  (* If the input stream cid has ended, the exception skipAtEnd is raised;
+     otherwise the next character or line mark in cid is removed,
+     and the stored read result is set to the value allRight.
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.Skip: device table ptr is NIL')
+   ELSE
+      WITH dtp^ DO
+         IF (cid=StdChans.NullChan()) OR (result=IOConsts.endOfInput)
+         THEN
+            RAISE(iochan, ORD(skipAtEnd),
+                  'IOChan.Skip: attempt to skip data from a stream that has ended')
+         ELSIF (ChanConsts.readFlag IN flags) AND (ChanConsts.textFlag IN flags)
+         THEN
+            doSkip(dtp) ;
+            result := IOConsts.allRight
+         ELSE
+            RAISE(iochan, ORD(notAvailable),
+                  'IOChan.Skip: attempt to skip data from a channel which is not configured as read and text')
+         END
+      END
+   END
+END Skip ;
+
+
+PROCEDURE SkipLook (cid: ChanId;
+                    VAR ch: CHAR;
+                    VAR res: IOConsts.ReadResults) ;
+  (* If the input stream cid has ended, the exception skipAtEnd is raised;
+     otherwise the next character or line mark in cid is removed.
+     If there is a character as the next item in cid stream,
+     assigns its value to ch without removing it from the stream.
+     Otherwise, the value of ch is not defined.
+     res (and the stored read result) are set to the value allRight,
+     endOfLine, or endOfInput.
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.SkipLook: device table ptr is NIL')
+   ELSE
+      WITH dtp^ DO
+         IF (cid=StdChans.NullChan()) OR (result=IOConsts.endOfInput)
+         THEN
+            RAISE(iochan, ORD(skipAtEnd),
+                  'IOChan.SkipLook: attempt to skip data from a stream that has ended')
+         ELSIF (ChanConsts.readFlag IN flags) AND (ChanConsts.textFlag IN flags)
+         THEN
+            doSkipLook(dtp, ch, result)
+         ELSE
+            RAISE(iochan, ORD(notAvailable),
+                  'IOChan.SkipLook: attempt to skip data from a channel which is not configured as read and text')
+         END ;
+         res := result
+      END
+   END
+END SkipLook ;
+
+
+PROCEDURE WriteLn (cid: ChanId) ;
+  (* Writes a line mark over the channel cid. *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.WriteLn: device table ptr is NIL')
+   ELSE
+      WITH dtp^ DO
+         IF cid=StdChans.NullChan()
+         THEN
+            (* do nothing *)
+         ELSIF (ChanConsts.writeFlag IN flags) AND (ChanConsts.textFlag IN flags)
+         THEN
+            dtp^.doLnWrite(dtp)
+         ELSE
+            RAISE(iochan, ORD(notAvailable),
+                  'IOChan.WriteLn: attempting to write to a channel which is not configured as write and text')
+         END
+      END
+   END
+END WriteLn ;
+
+
+PROCEDURE TextRead (cid: ChanId;
+                    to: SYSTEM.ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+  (* Reads at most maxChars characters from the current line in cid,
+     and assigns corresponding values to successive components of an
+     ARRAY OF CHAR variable for which the address of the first
+     component is to. The number of characters read is assigned
+     to charsRead. The stored read result is set to allRight,
+     endOfLine, or endOfInput.
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.TextRead: device table ptr is NIL')
+   ELSE
+      WITH dtp^ DO
+         IF (cid=StdChans.NullChan()) OR (result=IOConsts.endOfInput)
+         THEN
+            charsRead := 0 ;
+            result := IOConsts.endOfInput
+         ELSIF (ChanConsts.readFlag IN flags) AND (ChanConsts.textFlag IN flags)
+         THEN
+            doTextRead(dtp, to, maxChars, charsRead)
+         ELSE
+            RAISE(iochan, ORD(notAvailable),
+                  'IOChan.TextRead: attempt to read data from a channel which is not configured as read and text')
+         END
+      END
+   END
+END TextRead ;
+
+
+PROCEDURE TextWrite (cid: ChanId;
+                     from: SYSTEM.ADDRESS;
+                     charsToWrite: CARDINAL) ;
+  (* Writes a number of characters given by the value of charsToWrite,
+     from successive components of an ARRAY OF CHAR variable for which
+     the address of the first component is from, to the channel cid.
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.TextWrite: device table ptr is NIL')
+   ELSE
+      WITH dtp^ DO
+         IF cid=StdChans.NullChan()
+         THEN
+            (* do nothing *)
+         ELSIF (ChanConsts.writeFlag IN flags) AND (ChanConsts.textFlag IN flags)
+         THEN
+            doTextWrite(dtp, from, charsToWrite)
+         ELSE
+            RAISE(iochan, ORD(notAvailable),
+                  'IOChan.TextWrite: attempt to write data to a channel which is not configured as write and text')
+         END
+      END
+   END
+END TextWrite ;
+
+
+  (* Direct raw operations - these do not effect translation between
+     the internal and external representation of data
+  *)
+
+PROCEDURE RawRead (cid: ChanId;
+                   to: SYSTEM.ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+  (* Reads at most maxLocs items from cid, and assigns corresponding
+     values to successive components of an ARRAY OF LOC variable for
+     which the address of the first component is to. The number of
+     characters read is assigned to locsRead. The stored read result
+     is set to the value allRight, or endOfInput.
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.RawRead: device table ptr is NIL')
+   ELSE
+      WITH dtp^ DO
+         IF (cid=StdChans.NullChan()) OR (result=IOConsts.endOfInput)
+         THEN
+            locsRead := 0 ;
+            result := IOConsts.endOfInput
+         ELSIF (ChanConsts.readFlag IN flags) AND (ChanConsts.rawFlag IN flags)
+         THEN
+            doRawRead(dtp, to, maxLocs, locsRead)
+         ELSE
+            RAISE(iochan, ORD(notAvailable),
+                  'IOChan.RawRead: attempt to read data from a channel which is not configured as read and raw')
+         END
+      END
+   END
+END RawRead ;
+
+
+PROCEDURE RawWrite (cid: ChanId; from: SYSTEM.ADDRESS; locsToWrite: CARDINAL) ;
+  (* Writes a number of items given by the value of charsToWrite,
+     from successive components of an ARRAY OF LOC variable for
+     which the address of the first component is from, to the channel cid.
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.RawWrite: device table ptr is NIL')
+   ELSE
+      WITH dtp^ DO
+         IF (cid=StdChans.NullChan()) OR (result=IOConsts.endOfInput)
+         THEN
+            result := IOConsts.endOfInput
+         ELSIF (ChanConsts.writeFlag IN flags) AND (ChanConsts.rawFlag IN flags)
+         THEN
+            doRawWrite(dtp, from, locsToWrite)
+         ELSE
+            RAISE(iochan, ORD(notAvailable),
+                  'IOChan.RawWrite: attempt to write data to a channel which is not configured as write and raw')
+         END
+      END
+   END
+END RawWrite ;
+
+
+  (* Common operations *)
+
+PROCEDURE GetName (cid: ChanId; VAR s: ARRAY OF CHAR) ;
+  (* Copies to s a name associated with the channel cid, possibly truncated
+     (depending on the capacity of s).
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.GetName: device table ptr is NIL')
+   ELSE
+      dtp^.doGetName(dtp, s)
+   END
+END GetName ;
+
+
+PROCEDURE Reset (cid: ChanId) ;
+  (* Resets the channel cid to a state defined by the device module. *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.Reset: device table ptr is NIL')
+   ELSE
+      dtp^.doReset(dtp)
+   END
+END Reset ;
+
+
+PROCEDURE Flush (cid: ChanId) ;
+  (* Flushes any data buffered by the device module out to the channel cid. *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.Flush: device table ptr is NIL')
+   ELSE
+      dtp^.doFlush(dtp)
+   END
+END Flush ;
+
+
+  (* Access to read results *)
+
+PROCEDURE SetReadResult (cid: ChanId; res: IOConsts.ReadResults) ;
+  (* Sets the read result value for the channel cid to the value res. *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.SetReadResult: device table ptr is NIL')
+   ELSE
+      dtp^.result := res
+   END
+END SetReadResult ;
+
+
+PROCEDURE ReadResult (cid: ChanId) : IOConsts.ReadResults ;
+  (* Returns the stored read result value for the channel cid.
+     (This is initially the value notKnown).
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.SetReadResult: device table ptr is NIL')
+   ELSE
+      RETURN( dtp^.result )
+   END
+END ReadResult ;
+
+
+  (* Users can discover which flags actually apply to a channel *)
+
+PROCEDURE CurrentFlags (cid: ChanId) : ChanConsts.FlagSet ;
+  (* Returns the set of flags that currently apply to the channel cid. *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.SetReadResult: device table ptr is NIL')
+   ELSE
+      RETURN( dtp^.flags )
+   END
+END CurrentFlags ;
+
+
+  (* The following exceptions are defined for this module and its clients *)
+
+PROCEDURE IsChanException () : BOOLEAN ;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception from
+     ChanExceptions; otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN( IsExceptionalExecution() AND IsCurrentSource(iochan) )
+END IsChanException ;
+
+
+PROCEDURE ChanException () : ChanExceptions ;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from ChanExceptions,
+     returns the corresponding enumeration value, and otherwise
+     raises an exception.
+  *)
+BEGIN
+   IF IsChanException()
+   THEN
+      RETURN( VAL(ChanExceptions, EXCEPTIONS.CurrentNumber(iochan)) )
+   ELSE
+      M2RTS.NoException (SYSTEM.ADR(__FILE__), __LINE__,
+                        __COLUMN__, SYSTEM.ADR(__FUNCTION__),
+                        SYSTEM.ADR ("not in the exceptional execution state"))
+   END
+END ChanException ;
+
+
+  (* When a device procedure detects a device error, it raises the
+     exception softDeviceError or hardDeviceError.  If these exceptions
+     are handled, the following facilities may be used to discover
+     an implementation-defined error number for the channel.
+  *)
+
+PROCEDURE DeviceError (cid: ChanId) : DeviceErrNum ;
+  (* If a device error exception has been raised for the channel cid,
+     returns the error number stored by the device module.
+  *)
+VAR
+   did: IOLink.DeviceId ;
+   dtp: IOLink.DeviceTablePtr ;
+BEGIN
+   CheckValid(cid) ;
+   did := RTio.GetDeviceId(cid) ;
+   dtp := IOLink.DeviceTablePtrValue(cid, did) ;
+   IF dtp=NIL
+   THEN
+      RAISE(iochan, ORD(hardDeviceError),
+            'IOChan.DeviceError: device table ptr is NIL')
+   ELSE
+      RETURN( dtp^.errNum )
+   END
+END DeviceError ;
+
+
+BEGIN
+   AllocateSource(iochan) ;
+   invalid := ChanId(RTio.InitChanId())
+END IOChan.
diff --git a/gcc/m2/gm2-libs-iso/IOConsts.def b/gcc/m2/gm2-libs-iso/IOConsts.def
new file mode 100644
index 00000000000..c536984ed30
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/IOConsts.def
@@ -0,0 +1,28 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE IOConsts;
+
+  (* Types and constants for input/output modules *)
+
+TYPE
+  ReadResults =  (* This type is used to classify the result of an input operation *)
+  (
+    notKnown,    (* no read result is set *)
+    allRight,    (* data is as expected or as required *)
+    outOfRange,  (* data cannot be represented *)
+    wrongFormat, (* data not in expected format *)
+    endOfLine,   (* end of line seen before expected data *)
+    endOfInput   (* end of input seen before expected data *)
+  );
+
+END IOConsts.
+
diff --git a/gcc/m2/gm2-libs-iso/IOConsts.mod b/gcc/m2/gm2-libs-iso/IOConsts.mod
new file mode 100644
index 00000000000..6923f5f0658
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/IOConsts.mod
@@ -0,0 +1,29 @@
+(* IOConsts.mod implement the ISO IOConsts specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE IOConsts ;
+
+END IOConsts.
diff --git a/gcc/m2/gm2-libs-iso/IOLink.def b/gcc/m2/gm2-libs-iso/IOLink.def
new file mode 100644
index 00000000000..f8c4c36cce4
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/IOLink.def
@@ -0,0 +1,142 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE IOLink;
+
+(* Types and procedures for the standard implementation of channels *)
+
+IMPORT IOChan, IOConsts, ChanConsts, SYSTEM;
+
+TYPE
+  DeviceId;
+    (* Values of this type are used to identify new device modules,
+       and are normally obtained by them during their initialization.
+    *)
+
+PROCEDURE AllocateDeviceId (VAR did: DeviceId);
+  (* Allocates a unique value of type DeviceId, and assigns this
+     value to did. *)
+
+PROCEDURE MakeChan (did: DeviceId; VAR cid: IOChan.ChanId);
+  (* Attempts to make a new channel for the device module identified
+     by did. If no more channels can be made, the identity of
+     the invalid channel is assigned to cid.  Otherwise, the identity
+     of a new channel is assigned to cid.
+  *)
+
+PROCEDURE UnMakeChan (did: DeviceId; VAR cid: IOChan.ChanId);
+  (* If the device module identified by did is not the module that
+     made the channel identified by cid, the exception wrongDevice is
+     raised; otherwise the channel is deallocated, and the value
+     identifying the invalid channel is assigned to cid.
+  *)
+
+TYPE
+  DeviceTablePtr = POINTER TO DeviceTable;
+    (* Values of this type are used to refer to device tables *)
+
+TYPE
+  LookProc      = PROCEDURE (DeviceTablePtr, VAR CHAR, VAR IOConsts.ReadResults) ;
+  SkipProc      = PROCEDURE (DeviceTablePtr) ;
+  SkipLookProc  = PROCEDURE (DeviceTablePtr, VAR CHAR, VAR IOConsts.ReadResults) ;
+  WriteLnProc   = PROCEDURE (DeviceTablePtr) ;
+  TextReadProc  = PROCEDURE (DeviceTablePtr, SYSTEM.ADDRESS, CARDINAL, VAR CARDINAL) ;
+  TextWriteProc = PROCEDURE (DeviceTablePtr, SYSTEM.ADDRESS, CARDINAL) ;
+  RawReadProc   = PROCEDURE (DeviceTablePtr, SYSTEM.ADDRESS, CARDINAL, VAR CARDINAL) ;
+  RawWriteProc  = PROCEDURE (DeviceTablePtr, SYSTEM.ADDRESS, CARDINAL) ;
+  GetNameProc   = PROCEDURE (DeviceTablePtr, VAR ARRAY OF CHAR) ;
+  ResetProc     = PROCEDURE (DeviceTablePtr) ;
+  FlushProc     = PROCEDURE (DeviceTablePtr) ;
+  FreeProc      = PROCEDURE (DeviceTablePtr) ;
+     (* Carry out the operations involved in closing the corresponding
+        channel, including flushing buffers, but do not unmake the
+        channel.
+     *)
+
+
+TYPE
+  DeviceData = SYSTEM.ADDRESS;
+
+  DeviceTable =
+    RECORD                         (* Initialized by MakeChan to: *)
+      cd: DeviceData;              (* the value NIL *)
+      did: DeviceId;               (* the value given in the call of MakeChan *)
+      cid: IOChan.ChanId;          (* the identity of the channel *)
+      result: IOConsts.ReadResults;(* the value notKnown *)
+      errNum: IOChan.DeviceErrNum; (* undefined *)
+      flags: ChanConsts.FlagSet;   (* ChanConsts.FlagSet{} *)
+      doLook: LookProc;            (* raise exception notAvailable *)
+      doSkip: SkipProc;            (* raise exception notAvailable *)
+      doSkipLook: SkipLookProc;    (* raise exception notAvailable *)
+      doLnWrite: WriteLnProc;      (* raise exception notAvailable *)
+      doTextRead: TextReadProc;    (* raise exception notAvailable *)
+      doTextWrite: TextWriteProc;  (* raise exception notAvailable *)
+      doRawRead: RawReadProc;      (* raise exception notAvailable *)
+      doRawWrite: RawWriteProc;    (* raise exception notAvailable *)
+      doGetName: GetNameProc;      (* return the empty string *)
+      doReset: ResetProc;          (* do nothing *)
+      doFlush: FlushProc;          (* do nothing *)
+      doFree: FreeProc;            (* do nothing *)
+    END;
+
+
+  (* The pointer to the device table for a channel is obtained using the
+     following procedure: *)
+
+(*
+   If the device module identified by did is not the module that made
+   the channel identified by cid, the exception wrongDevice is raised.
+*)
+
+PROCEDURE DeviceTablePtrValue (cid: IOChan.ChanId; did: DeviceId): DeviceTablePtr;
+
+
+(*
+   Tests if the device module identified by did is the module
+   that made the channel identified by cid.
+*)
+
+PROCEDURE IsDevice (cid: IOChan.ChanId; did: DeviceId) : BOOLEAN;
+
+
+TYPE
+  DevExceptionRange = IOChan.ChanExceptions;
+
+(*
+  ISO standard states defines
+
+  DevExceptionRange = [IOChan.notAvailable ..  IOChan.textParseError];
+
+  however this must be a bug as other modules need to raise
+  IOChan.wrongDevice exceptions.
+*)
+
+PROCEDURE RAISEdevException (cid: IOChan.ChanId; did: DeviceId;
+                             x: DevExceptionRange; s: ARRAY OF CHAR);
+
+  (* If the device module identified by did is not the module that made the channel
+     identified by cid, the exception wrongDevice is raised; otherwise the given exception
+     is raised, and the string value in s is included in the exception message.
+  *)
+
+PROCEDURE IsIOException () : BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising af an exception from ChanExceptions;
+     otherwise FALSE.
+  *)
+
+PROCEDURE IOException () : IOChan.ChanExceptions;
+  (* If the current coroutine is in the exceptional execution state because of the 
+     raising af an exception from ChanExceptions, returns the corresponding
+     enumeration value, and otherwise raises an exception.
+  *)
+
+END IOLink.
diff --git a/gcc/m2/gm2-libs-iso/IOLink.mod b/gcc/m2/gm2-libs-iso/IOLink.mod
new file mode 100644
index 00000000000..1bf29f35d25
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/IOLink.mod
@@ -0,0 +1,373 @@
+(* IOLink.mod implement the ISO IOLink specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE IOLink ;
+
+IMPORT RTio, RTentity, EXCEPTIONS, IOChan, M2RTS, SYSTEM, ASCII ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+
+(*
+   Values of this type are used to identify new device modules,
+   and are normally obtained by them during their initialization.
+*)
+
+TYPE
+   DeviceId = POINTER TO RECORD
+                            cids:  RTentity.Group ;
+                         END ;
+   resourceState = (allocated, deallocated) ;
+
+
+VAR
+   dids  :  RTentity.Group ;
+   iolink:  EXCEPTIONS.ExceptionSource ;
+
+
+(*
+   checkValidDevice - checks to see that the, did, is
+                      known to exist.
+*)
+
+PROCEDURE checkValidDevice (did: DeviceId) ;
+BEGIN
+   IF NOT RTentity.IsIn(dids, did)
+   THEN
+      EXCEPTIONS.RAISE(iolink, ORD(IOChan.wrongDevice),
+                       'IOLink: device id specified does not exist')
+   END
+END checkValidDevice ;
+
+
+(*
+   Allocates a unique value of type DeviceId, and assigns this
+   value to did.
+*)
+
+PROCEDURE AllocateDeviceId (VAR did: DeviceId) ;
+BEGIN
+   NEW(did) ;
+   IF did=NIL
+   THEN
+      EXCEPTIONS.RAISE(iolink, ORD(IOChan.hardDeviceError),
+                       'IOLink.AllocateDeviceId: out of memory error')
+   ELSE
+      RTentity.PutKey(dids, did, ORD(allocated)) ;
+      WITH did^ DO
+         cids := RTentity.InitGroup()
+      END
+   END
+END AllocateDeviceId ;
+
+
+PROCEDURE defaultLook (d: DeviceTablePtr;
+                       VAR ch: CHAR;
+                       VAR r : IOConsts.ReadResults) ;
+BEGIN
+   EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable),
+                    'IOLink:Look operation on device is not available')
+END defaultLook ;
+
+
+PROCEDURE defaultSkip (d: DeviceTablePtr) ;
+BEGIN
+   EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable),
+                    'IOLink:Skip operation on device is not available')
+END defaultSkip ;
+
+
+PROCEDURE defaultSkipLook (d: DeviceTablePtr;
+                           VAR ch: CHAR;
+                           VAR r : IOConsts.ReadResults) ;
+BEGIN
+   EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable),
+                    'IOLink:SkipLook operation on device is not available')
+END defaultSkipLook ;
+
+
+PROCEDURE defaultWriteLn (d: DeviceTablePtr) ;
+BEGIN
+   EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable),
+                    'IOLink:WriteLn operation on device is not available')
+END defaultWriteLn ;
+
+
+PROCEDURE defaultTextRead (d: DeviceTablePtr; a: SYSTEM.ADDRESS; n: CARDINAL; VAR r: CARDINAL) ;
+BEGIN
+   EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable),
+                    'IOLink:TextRead operation on device is not available')
+END defaultTextRead ;
+
+
+PROCEDURE defaultTextWrite (d: DeviceTablePtr; a: SYSTEM.ADDRESS; n: CARDINAL) ;
+BEGIN
+   EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable),
+                    'IOLink:TextWrite operation on device is not available')
+END defaultTextWrite ;
+
+
+PROCEDURE defaultRawRead (d: DeviceTablePtr; a: SYSTEM.ADDRESS; n: CARDINAL; VAR r: CARDINAL) ;
+BEGIN
+   EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable),
+                    'IOLink:TextRawRead operation on device is not available')
+END defaultRawRead ;
+
+
+PROCEDURE defaultRawWrite (d: DeviceTablePtr; a: SYSTEM.ADDRESS; n: CARDINAL) ;
+BEGIN
+   EXCEPTIONS.RAISE(iolink, ORD(IOChan.notAvailable),
+                    'IOLink:TextRawWrite operation on device is not available')
+END defaultRawWrite ;
+
+
+PROCEDURE defaultGetName (d: DeviceTablePtr; VAR a: ARRAY OF CHAR) ;
+BEGIN
+   a[0] := ASCII.nul
+END defaultGetName ;
+
+
+PROCEDURE defaultReset (d: DeviceTablePtr) ;
+BEGIN
+   (* do nothing *)
+END defaultReset ;
+
+
+PROCEDURE defaultFlush (d: DeviceTablePtr) ;
+BEGIN
+   (* do nothing *)
+END defaultFlush ;
+
+
+PROCEDURE defaultFree (d: DeviceTablePtr) ;
+BEGIN
+   (* do nothing *)
+END defaultFree ;
+
+
+(*
+   InitDtp - creates a new DeviceTablePtr and initializes the
+             fields to their defaults.
+*)
+
+PROCEDURE InitDtp (d: DeviceId; c: IOChan.ChanId) : DeviceTablePtr ;
+VAR
+   p: DeviceTablePtr ;
+BEGIN
+   NEW(p) ;
+   WITH p^ DO
+      cd  := NIL ;
+      did := d ;
+      cid := c ;
+      result := IOConsts.notKnown ;
+      errNum := 0 ;
+      flags := ChanConsts.FlagSet{} ;
+      doLook := defaultLook ;
+      doSkip := defaultSkip ;
+      doSkipLook := defaultSkipLook ;
+      doLnWrite := defaultWriteLn ;
+      doTextRead := defaultTextRead ;
+      doTextWrite := defaultTextWrite ;
+      doRawRead := defaultRawRead ;
+      doRawWrite := defaultRawWrite ;
+      doGetName := defaultGetName ;
+      doReset := defaultReset ;
+      doFlush := defaultFlush ;
+      doFree := defaultFree ;
+   END ;
+   RETURN( p )
+END InitDtp ;
+
+
+(*
+   KillDtp - deallocate, p, and any associated resource.
+*)
+
+PROCEDURE KillDtp (p: DeviceTablePtr) : DeviceTablePtr ;
+BEGIN
+   WITH p^ DO
+      doFlush(p) ;
+      doFree(p)
+   END ;
+   DISPOSE(p) ;
+   RETURN( NIL )
+END KillDtp ;
+
+
+(*
+   Attempts to make a new channel for the device module identified
+   by did. If no more channels can be made, the identity of
+   the invalid channel is assigned to cid.  Otherwise, the identity
+   of a new channel is assigned to cid.
+*)
+
+PROCEDURE MakeChan (did: DeviceId; VAR cid: IOChan.ChanId) ;
+BEGIN
+   checkValidDevice(did) ;
+   cid := IOChan.ChanId(RTio.InitChanId()) ;
+   IF cid=NIL
+   THEN
+      cid := IOChan.InvalidChan()
+   ELSE
+      WITH did^ DO
+         RTentity.PutKey(cids, cid, ORD(allocated))
+      END ;
+      RTio.SetDeviceId(cid, did) ;
+      RTio.SetDevicePtr(cid, InitDtp(did, cid))
+   END
+END MakeChan ;
+
+
+(*
+   If the device module identified by did is not the module that
+   made the channel identified by cid, the exception wrongDevice is
+   raised; otherwise the channel is deallocated, and the value
+   identifying the invalid channel is assigned to cid.
+*)
+
+PROCEDURE UnMakeChan (did: DeviceId; VAR cid: IOChan.ChanId) ;
+BEGIN
+   checkValidDevice(did) ;
+   WITH did^ DO
+      IF RTentity.IsIn(cids, cid)
+      THEN
+         RTio.SetDevicePtr(cid, KillDtp(RTio.GetDevicePtr(cid))) ;
+         RTentity.DelKey(cids, cid) ;
+         cid := IOChan.ChanId(RTio.KillChanId(cid)) ;
+         cid := IOChan.InvalidChan()
+      ELSE
+         EXCEPTIONS.RAISE(iolink, ORD(IOChan.wrongDevice),
+                         'IOLink.UnMakeChan: channel does not belong to device')
+      END
+   END
+END UnMakeChan ;
+
+
+(*
+   The pointer to the device table for a channel is obtained using the
+   following procedure:
+
+   If the device module identified by did is not the module that made
+   the channel identified by cid, the exception wrongDevice is raised.
+*)
+
+PROCEDURE DeviceTablePtrValue (cid: IOChan.ChanId;
+                               did: DeviceId) : DeviceTablePtr ;
+BEGIN
+   checkValidDevice(did) ;
+   WITH did^ DO
+      IF RTentity.IsIn(cids, cid)
+      THEN
+         RETURN( RTio.GetDevicePtr(cid) )
+      ELSE
+         EXCEPTIONS.RAISE(iolink, ORD(IOChan.wrongDevice),
+                          'IOLink.DeviceTablePtrValue: channel does belong to device')
+      END
+   END
+END DeviceTablePtrValue ;
+
+
+PROCEDURE IsDevice (cid: IOChan.ChanId; did: DeviceId) : BOOLEAN ;
+  (* Tests if the device module identified by did is the module
+     that made the channel identified by cid.
+  *)
+BEGIN
+   IF RTentity.IsIn(dids, did)
+   THEN
+      WITH did^ DO
+         RETURN( RTentity.IsIn(cids, cid) )
+      END
+   END ;
+   RETURN( FALSE )
+END IsDevice ;
+
+
+PROCEDURE RAISEdevException (cid: IOChan.ChanId; did: DeviceId;
+                             x: DevExceptionRange; s: ARRAY OF CHAR) ;
+(* If the device module identified by did is not the module
+   that made the channel identified by cid, the exception
+   wrongDevice is raised; otherwise the given exception
+   is raised, and the string value in s is included in the
+   exception message.
+*)
+BEGIN
+   checkValidDevice(did) ;
+   WITH did^ DO
+      IF RTentity.IsIn(cids, cid)
+      THEN
+         EXCEPTIONS.RAISE(iolink, ORD(x), s)
+      ELSE
+         EXCEPTIONS.RAISE(iolink, ORD(IOChan.wrongDevice),
+                          'IOLink.RAISEdevException: channel does not belong to device')
+      END
+   END
+END RAISEdevException ;
+
+
+PROCEDURE IsIOException () : BOOLEAN ;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising af an exception from
+     ChanExceptions; otherwise FALSE.
+  *)
+BEGIN
+   RETURN( EXCEPTIONS.IsExceptionalExecution() AND
+           EXCEPTIONS.IsCurrentSource(iolink) )
+END IsIOException ;
+
+
+PROCEDURE IOException () : IOChan.ChanExceptions ;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from ChanExceptions,
+     returns the corresponding enumeration value, and otherwise
+     raises an exception.
+  *)
+BEGIN
+   IF IsIOException()
+   THEN
+      RETURN( VAL(IOChan.ChanExceptions,
+                  EXCEPTIONS.CurrentNumber(iolink)) )
+   ELSE
+      M2RTS.NoException(SYSTEM.ADR(__FILE__), __LINE__,
+                        __COLUMN__, SYSTEM.ADR(__FUNCTION__),
+                        SYSTEM.ADR ("not in the exceptional execution state"))
+   END
+END IOException ;
+
+
+(*
+   Init - initialise global variables.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   EXCEPTIONS.AllocateSource(iolink) ;
+   dids := RTentity.InitGroup()
+END Init ;
+
+
+BEGIN
+   Init
+END IOLink.
diff --git a/gcc/m2/gm2-libs-iso/IOResult.def b/gcc/m2/gm2-libs-iso/IOResult.def
new file mode 100644
index 00000000000..380c722ceef
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/IOResult.def
@@ -0,0 +1,37 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE IOResult;
+
+  (* Read results for specified channels *)
+
+IMPORT IOConsts, IOChan;
+
+TYPE
+  ReadResults = IOConsts.ReadResults;
+
+  (*
+    ReadResults =  (* This type is used to classify the result of an input operation *)
+    (
+      notKnown,    (* no read result is set *)
+      allRight,    (* data is as expected or as required *)
+      outOfRange,  (* data cannot be represented *)
+      wrongFormat, (* data not in expected format *)
+      endOfLine,   (* end of line seen before expected data *)
+      endOfInput   (* end of input seen before expected data *)
+    );
+  *)
+
+PROCEDURE ReadResult (cid: IOChan.ChanId): ReadResults;
+  (* Returns the result for the last read operation on the channel cid. *)
+
+END IOResult.
+
diff --git a/gcc/m2/gm2-libs-iso/IOResult.mod b/gcc/m2/gm2-libs-iso/IOResult.mod
new file mode 100644
index 00000000000..ceecd54c57b
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/IOResult.mod
@@ -0,0 +1,37 @@
+(* IOResult.mod implement the ISO IOResult specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE IOResult ;
+
+IMPORT IOChan ;
+
+PROCEDURE ReadResult (cid: IOChan.ChanId): ReadResults;
+  (* Returns the result for the last read operation on the channel cid. *)
+BEGIN
+   RETURN IOChan.ReadResult(cid)
+END ReadResult ;
+
+END IOResult.
diff --git a/gcc/m2/gm2-libs-iso/LongComplexMath.def b/gcc/m2/gm2-libs-iso/LongComplexMath.def
new file mode 100644
index 00000000000..cf092d4532a
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongComplexMath.def
@@ -0,0 +1,73 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE LongComplexMath;
+
+  (* Mathematical functions for the type LONGCOMPLEX *)
+
+CONST
+  i =    CMPLX (0.0, 1.0);
+  one =  CMPLX (1.0, 0.0);
+  zero = CMPLX (0.0, 0.0);
+
+PROCEDURE abs (z: LONGCOMPLEX): LONGREAL;
+  (* Returns the length of z *)
+
+PROCEDURE arg (z: LONGCOMPLEX): LONGREAL;
+  (* Returns the angle that z subtends to the positive real axis *)
+
+PROCEDURE conj (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the complex conjugate of z *)
+
+PROCEDURE power (base: LONGCOMPLEX; exponent: LONGREAL): LONGCOMPLEX;
+  (* Returns the value of the number base raised to the power exponent *)
+
+PROCEDURE sqrt (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the principal square root of z *)
+
+PROCEDURE exp (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the complex exponential of z *)
+
+PROCEDURE ln (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the principal value of the natural logarithm of z *)
+
+PROCEDURE sin (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the sine of z *)
+
+PROCEDURE cos (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the cosine of z *)
+
+PROCEDURE tan (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the tangent of z *)
+
+PROCEDURE arcsin (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the arcsine of z *)
+
+PROCEDURE arccos (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the arccosine of z *)
+
+PROCEDURE arctan (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the arctangent of z *)
+
+PROCEDURE polarToComplex (abs, arg: LONGREAL): LONGCOMPLEX;
+  (* Returns the complex number with the specified polar coordinates *)
+
+PROCEDURE scalarMult (scalar: LONGREAL; z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the scalar product of scalar with z *)
+
+PROCEDURE IsCMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END LongComplexMath.
+
diff --git a/gcc/m2/gm2-libs-iso/LongComplexMath.mod b/gcc/m2/gm2-libs-iso/LongComplexMath.mod
new file mode 100644
index 00000000000..48a428a0ad3
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongComplexMath.mod
@@ -0,0 +1,164 @@
+(* LongComplexMath.mod implement the ISO LongComplexMath specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LongComplexMath ;
+
+IMPORT cbuiltin ;
+
+
+(* Returns the length of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cabsl)) abs (z: LONGCOMPLEX): LONGREAL;
+BEGIN
+   RETURN cbuiltin.cabsl (z)
+END abs ;
+
+
+(* Returns the angle that z subtends to the positive real axis *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cargl)) arg (z: LONGCOMPLEX): LONGREAL;
+BEGIN
+   RETURN cbuiltin.cargl (z)
+END arg ;
+
+
+(* Returns the complex conjugate of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_conjl)) conj (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.conjl (z)
+END conj ;
+
+
+(* Returns the value of the number base raised to the power exponent *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cpowerl)) power (base: LONGCOMPLEX; exponent: LONGREAL): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.cpowl (base, exponent)
+END power ;
+
+
+(* Returns the principal square root of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csqrtl)) sqrt (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.csqrtl (z)
+END sqrt ;
+
+
+(* Returns the complex exponential of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cexpl)) exp (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.cexpl (z)
+END exp ;
+
+
+(* Returns the principal value of the natural logarithm of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_clnl)) ln (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.clogl (z)
+END ln ;
+
+
+(* Returns the sine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csinl)) sin (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.csinl (z)
+END sin ;
+
+
+(* Returns the cosine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ccosl)) cos (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.ccosl (z)
+END cos ;
+
+
+(* Returns the tangent of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ctanl)) tan (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.ctanl (z)
+END tan ;
+
+
+(* Returns the arcsine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carcsinl)) arcsin (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.casinl (z)
+END arcsin ;
+
+
+(* Returns the arccosine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carccosl)) arccos (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.cacosl (z)
+END arccos ;
+
+
+(* Returns the arctangent of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carctanl)) arctan (z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN cbuiltin.catanl (z)
+END arctan ;
+
+
+(* Returns the complex number with the specified polar coordinates *)
+
+PROCEDURE polarToComplex (abs, arg: LONGREAL): LONGCOMPLEX;
+BEGIN
+   RETURN CMPLX (abs*cbuiltin.cosl(arg), abs*cbuiltin.sinl(arg))
+END polarToComplex ;
+
+
+(* Returns the scalar product of scalar with z *)
+
+PROCEDURE scalarMult (scalar: LONGREAL; z: LONGCOMPLEX): LONGCOMPLEX;
+BEGIN
+   RETURN CMPLX (RE(z)*scalar, IM(z)*scalar)
+END scalarMult ;
+
+
+(* Returns TRUE if the current coroutine is in the exceptional
+   execution state because of the raising of an exception in a
+   routine from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsCMathException (): BOOLEAN;
+BEGIN
+   (* --fixme-- we should really attempt to catch sigfpe in these procedures *)
+   RETURN( FALSE )
+END IsCMathException ;
+
+
+END LongComplexMath.
diff --git a/gcc/m2/gm2-libs-iso/LongConv.def b/gcc/m2/gm2-libs-iso/LongConv.def
new file mode 100644
index 00000000000..24ee0357188
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongConv.def
@@ -0,0 +1,61 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE LongConv;
+
+  (* Low-level LONGREAL/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+  ConvResults = ConvTypes.ConvResults; (* strAllRight, strOutOfRange,
+                                          strWrongFormat, strEmpty *)
+
+PROCEDURE ScanReal (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState);
+  (* Represents the start state of a finite state scanner for real
+     numbers - assigns class of inputCh to chClass and a procedure
+     representing the next state to nextState.
+  *)
+
+PROCEDURE FormatReal (str: ARRAY OF CHAR): ConvResults;
+  (* Returns the format of the string value for conversion to LONGREAL. *)
+
+PROCEDURE ValueReal (str: ARRAY OF CHAR): LONGREAL;
+  (* Returns the value corresponding to the real number string value
+     str if str is well-formed; otherwise raises the LongConv exception.
+  *)
+
+PROCEDURE LengthFloatReal (real: LONGREAL; sigFigs: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the floating-point string
+     representation of real with sigFigs significant figures.
+  *)
+
+PROCEDURE LengthEngReal (real: LONGREAL; sigFigs: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the floating-point engineering
+     string representation of real with sigFigs significant figures.
+  *)
+
+PROCEDURE LengthFixedReal (real: LONGREAL; place: INTEGER): CARDINAL;
+  (* Returns the number of characters in the fixed-point string
+     representation of real rounded to the given place relative to the
+     decimal point.
+  *)
+
+PROCEDURE IsRConvException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in a
+     routine from this module; otherwise returns FALSE.
+  *)
+
+END LongConv.
+
diff --git a/gcc/m2/gm2-libs-iso/LongConv.mod b/gcc/m2/gm2-libs-iso/LongConv.mod
new file mode 100644
index 00000000000..80a1f142696
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongConv.mod
@@ -0,0 +1,350 @@
+(* LongConv.mod implement the ISO LongConv specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LongConv ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM ConvTypes IMPORT ScanClass ;
+FROM CharClass IMPORT IsNumeric, IsWhiteSpace ;
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, KillString, Length, Slice, Mark, Index, string ;
+FROM ldtoa IMPORT strtold ;
+FROM ConvStringLong IMPORT RealToFloatString, RealToEngString, RealToFixedString ;
+FROM M2RTS IMPORT Halt ;
+FROM libc IMPORT free ;
+IMPORT EXCEPTIONS ;
+
+
+TYPE
+   RealConvException = (noException, invalid, outofrange) ;
+
+VAR
+   realConv:  EXCEPTIONS.ExceptionSource ;
+
+
+(* Low-level LONGREAL/string conversions *)
+
+(* Represents the start state of a finite state scanner for real
+   numbers - assigns class of inputCh to chClass and a procedure
+   representing the next state to nextState.
+*)
+
+PROCEDURE ScanReal (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanSecondDigit ;
+      chClass := valid
+   ELSIF (inputCh='+') OR (inputCh='-')
+   THEN
+      nextState := scanFirstDigit ;
+      chClass := valid
+   ELSIF IsWhiteSpace(inputCh)
+   THEN
+      nextState := ScanReal ;
+      chClass := padding
+   ELSE
+      nextState := ScanReal ;
+      chClass := invalid
+   END
+END ScanReal ;
+
+
+(*
+   scanFirstDigit -
+*)
+
+PROCEDURE scanFirstDigit (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                          VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanSecondDigit ;
+      chClass := valid
+   ELSE
+      nextState := scanFirstDigit ;
+      chClass := invalid
+   END
+END scanFirstDigit ;
+
+
+(*
+   scanSecondDigit -
+*)
+
+PROCEDURE scanSecondDigit (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                           VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanSecondDigit ;
+      chClass := valid
+   ELSIF inputCh='.'
+   THEN
+      nextState := scanFixed ;
+      chClass := valid
+   ELSIF inputCh='E'
+   THEN
+      nextState := scanScientific ;
+      chClass := valid
+   ELSE
+      nextState := noOpFinished ;
+      chClass := terminator
+   END
+END scanSecondDigit ;
+
+
+(*
+   scanFixed -
+*)
+
+PROCEDURE scanFixed (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                     VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanFixed ;
+      chClass := valid
+   ELSIF inputCh='E'
+   THEN
+      nextState := scanScientific ;
+      chClass := valid
+   ELSE
+      nextState := noOpFinished ;
+      chClass := terminator
+   END
+END scanFixed ;
+
+
+(*
+   scanScientific -
+*)
+
+PROCEDURE scanScientific (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                          VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanScientificSecond ;
+      chClass := valid
+   ELSIF (inputCh='-') OR (inputCh='+')
+   THEN
+      nextState := scanScientificSign ;
+      chClass := valid
+   ELSE
+      nextState := scanScientific ;
+      chClass := invalid
+   END
+END scanScientific ;
+
+
+(*
+   scanScientificSign -
+*)
+
+PROCEDURE scanScientificSign (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                              VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanScientificSecond ;
+      chClass := valid
+   ELSE
+      nextState := scanScientificSign ;
+      chClass := invalid
+   END
+END scanScientificSign ;
+
+
+(*
+   scanScientificSecond -
+*)
+
+PROCEDURE scanScientificSecond (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                                VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanScientificSecond ;
+      chClass := valid
+   ELSE
+      nextState := noOpFinished ;
+      chClass := terminator
+   END
+END scanScientificSecond ;
+
+
+(*
+   noOpFinished -
+*)
+
+PROCEDURE noOpFinished (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                        VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   nextState := noOpFinished ;
+   chClass := terminator ;
+   (* should we raise an exception here? *)
+END noOpFinished ;
+
+
+(* Returns the format of the string value for conversion to LONGREAL. *)
+
+PROCEDURE FormatReal (str: ARRAY OF CHAR) : ConvResults ;
+VAR
+   proc   : ConvTypes.ScanState ;
+   chClass: ConvTypes.ScanClass ;
+   i, h   : CARDINAL ;
+BEGIN
+   i := 1 ;
+   h := LENGTH(str) ;
+   ScanReal(str[0], chClass, proc) ;
+   WHILE (i<h) AND (chClass=padding) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+
+   IF chClass=terminator
+   THEN
+      RETURN( strEmpty )
+   END ;
+   WHILE (i<h) AND (chClass=valid) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+   CASE chClass OF
+
+   padding   :  RETURN( strWrongFormat ) |
+   terminator,
+   valid     :  RETURN( strAllRight ) |
+   invalid   :  RETURN( strWrongFormat )
+
+   END
+END FormatReal ;
+
+
+(* Returns the value corresponding to the real number string value
+   str if str is well-formed; otherwise raises the RealConv
+   exception.
+*)
+
+PROCEDURE ValueReal (str: ARRAY OF CHAR) : LONGREAL ;
+BEGIN
+   IF FormatReal(str)=strAllRight
+   THEN
+      RETURN( doValueReal(str) )
+   ELSE
+      EXCEPTIONS.RAISE(realConv, ORD(invalid),
+                       'LongConv.' + __FUNCTION__ + ': real number is invalid')
+   END
+END ValueReal ;
+
+
+(*
+   doValueReal - str, is a well-formed real number and its
+                 value is returned.
+*)
+
+PROCEDURE doValueReal (str: ARRAY OF CHAR) : LONGREAL ;
+VAR
+   r    : LONGREAL ;
+   error: BOOLEAN ;
+   s    : String ;
+BEGIN
+   s := InitString(str) ;
+   r := strtold(string(s), error) ;
+   s := KillString(s) ;
+   IF error
+   THEN
+      EXCEPTIONS.RAISE(realConv, ORD(outofrange),
+                       'LongConv.' + __FUNCTION__ + ': real number is out of range')
+   END ;
+   RETURN( r )
+END doValueReal ;
+
+
+(* Returns the number of characters in the floating-point string
+   representation of real with sigFigs significant figures.
+*)
+
+PROCEDURE LengthFloatReal (real: LONGREAL; sigFigs: CARDINAL) : CARDINAL ;
+VAR
+   s: String ;
+   l: CARDINAL ;
+BEGIN
+   s := RealToFloatString(real, sigFigs) ;
+   l := Length(s) ;
+   s := KillString(s) ;
+   RETURN( l )
+END LengthFloatReal ;
+
+
+(* Returns the number of characters in the floating-point engineering
+   string representation of real with sigFigs significant figures.
+*)
+
+PROCEDURE LengthEngReal (real: LONGREAL; sigFigs: CARDINAL) : CARDINAL ;
+VAR
+   s: String ;
+   l: CARDINAL ;
+BEGIN
+   s := RealToEngString(real, sigFigs) ;
+   l := Length(s) ;
+   s := KillString(s) ;
+   RETURN( l )
+END LengthEngReal ;
+
+
+(* Returns the number of characters in the fixed-point string
+   representation of real rounded to the given place relative to the
+   decimal point.
+*)
+
+PROCEDURE LengthFixedReal (real: LONGREAL; place: INTEGER) : CARDINAL ;
+VAR
+   s: String ;
+   l: CARDINAL ;
+BEGIN
+   s := RealToFixedString(real, place) ;
+   l := Length(s) ;
+   s := KillString(s) ;
+   RETURN( l )
+END LengthFixedReal ;
+
+
+(* Returns TRUE if the current coroutine is in the exceptional
+   execution state because of the raising of an exception in a
+   routine from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsRConvException () : BOOLEAN ;
+BEGIN
+   RETURN( EXCEPTIONS.IsCurrentSource(realConv) )
+END IsRConvException ;
+
+
+BEGIN
+   EXCEPTIONS.AllocateSource(realConv)
+END LongConv.
diff --git a/gcc/m2/gm2-libs-iso/LongIO.def b/gcc/m2/gm2-libs-iso/LongIO.def
new file mode 100644
index 00000000000..02865bf3217
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongIO.def
@@ -0,0 +1,68 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE LongIO;
+
+  (* Input and output of long real numbers in decimal text form
+     over specified channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit}, [".",
+       {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: LONGREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed fixed or floating
+     point number.  The value of this number is assigned to real.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: LONGREAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to cid in floating-point text form,
+     with sigFigs significant figures, in a field of the given
+     minimum width.
+  *)
+
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: LONGREAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: LONGREAL;
+                      place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to cid in fixed-point text form,
+     rounded to the given place relative to the decimal point,
+     in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteReal (cid: IOChan.ChanId; real: LONGREAL;
+                     width: CARDINAL);
+  (* Writes the value of real to cid, as WriteFixed if the
+     sign and magnitude can be shown in the given width, or
+     otherwise as WriteFloat.  The number of places or
+     significant digits depends on the given width.
+  *)
+
+END LongIO.
+
diff --git a/gcc/m2/gm2-libs-iso/LongIO.mod b/gcc/m2/gm2-libs-iso/LongIO.mod
new file mode 100644
index 00000000000..dd62e32cb4e
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongIO.mod
@@ -0,0 +1,172 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+IMPLEMENTATION MODULE LongIO;
+
+  (* Input and output of real numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+FROM TextIO IMPORT WriteChar, ReadChar ;
+FROM StringChan IMPORT writeString ;
+FROM IOChan IMPORT SetReadResult ;
+FROM IOConsts IMPORT ReadResults ;
+
+FROM ConvStringLong IMPORT RealToFixedString, RealToFloatString,
+                           RealToEngString ;
+
+FROM ConvTypes IMPORT ScanClass, ScanState ;
+FROM TextIO IMPORT WriteChar, ReadChar ;
+FROM DynamicStrings IMPORT String, char, KillString, Length, InitString, ConCatChar, string ;
+FROM LongConv IMPORT ScanReal ;
+FROM StringChan IMPORT writeString, writeFieldWidth ;
+FROM ldtoa IMPORT strtold ;
+
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: LONGREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed fixed or floating
+     point number.  The value of this number is assigned to real.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+VAR
+   chClass  : ScanClass ;
+   nextState: ScanState ;
+   ch       : CHAR ;
+   s        : String ;
+   error    : BOOLEAN ;
+BEGIN
+   ReadChar(cid, ch) ;
+   nextState := ScanReal ;
+   REPEAT
+      nextState(ch, chClass, nextState) ;
+      IF chClass=padding
+      THEN
+         ReadChar(cid, ch)
+      END
+   UNTIL chClass#padding ;
+   IF chClass=valid
+   THEN
+      s := InitString('') ;
+      WHILE chClass=valid DO
+         s := ConCatChar(s, ch) ;
+         ReadChar(cid, ch) ;
+         nextState(ch, chClass, nextState)
+      END ;
+      real := strtold(string(s), error) ;
+      s := KillString(s) ;
+      IF error
+      THEN
+         SetReadResult(cid, outOfRange)
+      ELSE
+         SetReadResult(cid, allRight)
+      END
+   ELSE
+      SetReadResult(cid, wrongFormat)
+   END
+END ReadReal ;
+
+
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: LONGREAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to cid in floating-point text form,
+     with sigFigs significant figures, in a field of the given
+     minimum width.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToFloatString(real, sigFigs) ;
+   writeFieldWidth(cid, s, width) ;
+   s := KillString(s)
+END WriteFloat ;
+
+
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: LONGREAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToEngString(real, sigFigs) ;
+   writeFieldWidth(cid, s, width) ;
+   s := KillString(s)
+END WriteEng ;
+
+
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: LONGREAL;
+                      place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to cid in fixed-point text form,
+     rounded to the given place relative to the decimal point,
+     in a field of the given minimum width.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToFixedString(real, place) ;
+   writeFieldWidth(cid, s, width) ;
+   s := KillString(s)
+END WriteFixed ;
+
+
+PROCEDURE WriteReal (cid: IOChan.ChanId;
+                     real: LONGREAL; width: CARDINAL);
+  (* Writes the value of real to cid, as WriteFixed if the sign
+     and magnitude can be shown in the given width, or otherwise
+     as WriteFloat.  The number of places or significant digits
+     depends on the given width.
+  *)
+VAR
+   sigFigs: CARDINAL ;
+   s      : String ;
+BEGIN
+   sigFigs := width ;
+   WHILE sigFigs>1 DO
+      s := RealToFixedString(real, sigFigs) ;
+      IF Length(s)<=width
+      THEN
+         writeFieldWidth(cid, s, width) ;
+         s := KillString(s) ;
+         RETURN
+      END ;
+      s := KillString(s) ;
+      DEC(sigFigs)
+   END ;
+   sigFigs := width ;
+   WHILE sigFigs#0 DO
+      s := RealToFloatString(real, sigFigs) ;
+      IF Length(s)<=width
+      THEN
+         writeFieldWidth(cid, s, width) ;
+         s := KillString(s) ;
+         RETURN
+      END ;
+      s := KillString(s) ;
+      DEC(sigFigs)
+   END
+END WriteReal ;
+
+
+END LongIO.
diff --git a/gcc/m2/gm2-libs-iso/LongMath.def b/gcc/m2/gm2-libs-iso/LongMath.def
new file mode 100644
index 00000000000..31d50e4de5e
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongMath.def
@@ -0,0 +1,62 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE LongMath;
+
+  (* Mathematical functions for the type LONGREAL *)
+
+CONST
+  pi   = 3.1415926535897932384626433832795028841972;
+  exp1 = 2.7182818284590452353602874713526624977572;
+
+PROCEDURE __BUILTIN__ sqrt (x: LONGREAL): LONGREAL;
+  (* Returns the positive square root of x *)
+
+PROCEDURE __BUILTIN__ exp (x: LONGREAL): LONGREAL;
+  (* Returns the exponential of x *)
+
+PROCEDURE __BUILTIN__ ln (x: LONGREAL): LONGREAL;
+  (* Returns the natural logarithm of x *)
+
+  (* The angle in all trigonometric functions is measured in radians *)
+
+PROCEDURE __BUILTIN__ sin (x: LONGREAL): LONGREAL;
+  (* Returns the sine of x *)
+
+PROCEDURE __BUILTIN__ cos (x: LONGREAL): LONGREAL;
+  (* Returns the cosine of x *)
+
+PROCEDURE tan (x: LONGREAL): LONGREAL;
+  (* Returns the tangent of x *)
+
+PROCEDURE arcsin (x: LONGREAL): LONGREAL;
+  (* Returns the arcsine of x *)
+
+PROCEDURE arccos (x: LONGREAL): LONGREAL;
+  (* Returns the arccosine of x *)
+
+PROCEDURE arctan (x: LONGREAL): LONGREAL;
+  (* Returns the arctangent of x *)
+
+PROCEDURE power (base, exponent: LONGREAL): LONGREAL;
+  (* Returns the value of the number base raised to the power exponent *)
+
+PROCEDURE round (x: LONGREAL): INTEGER;
+  (* Returns the value of x rounded to the nearest integer *)
+
+PROCEDURE IsRMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in a
+     routine from this module; otherwise returns FALSE.
+  *)
+
+END LongMath.
+
diff --git a/gcc/m2/gm2-libs-iso/LongMath.mod b/gcc/m2/gm2-libs-iso/LongMath.mod
new file mode 100644
index 00000000000..5e066b87536
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongMath.mod
@@ -0,0 +1,110 @@
+(* LongMath.mod implement the ISO LongMath specification.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LongMath ;
+
+IMPORT libm ;
+IMPORT cbuiltin ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sqrtl)) sqrt (x: LONGREAL): LONGREAL;
+  (* Returns the positive square root of x *)
+BEGIN
+   RETURN cbuiltin.sqrtl(x)
+END sqrt ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_expl)) exp (x: LONGREAL): LONGREAL;
+  (* Returns the exponential of x *)
+BEGIN
+   RETURN cbuiltin.expl(x)
+END exp ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_logl)) ln (x: LONGREAL): LONGREAL;
+  (* Returns the natural logarithm of x *)
+BEGIN
+   RETURN cbuiltin.logl(x)
+END ln ;
+
+  (* The angle in all trigonometric functions is measured in radians *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sinl)) sin (x: LONGREAL): LONGREAL;
+  (* Returns the sine of x *)
+BEGIN
+   RETURN cbuiltin.sinl(x)
+END sin ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cosl)) cos (x: LONGREAL): LONGREAL;
+  (* Returns the cosine of x *)
+BEGIN
+   RETURN cbuiltin.cosl(x)
+END cos ;
+
+PROCEDURE tan (x: LONGREAL): LONGREAL;
+  (* Returns the tangent of x *)
+BEGIN
+   RETURN libm.tanl(x)
+END tan ;
+
+PROCEDURE arcsin (x: LONGREAL): LONGREAL;
+  (* Returns the arcsine of x *)
+BEGIN
+   RETURN libm.asinl(x)
+END arcsin ;
+
+PROCEDURE arccos (x: LONGREAL): LONGREAL;
+  (* Returns the arccosine of x *)
+BEGIN
+   RETURN libm.acosl(x)
+END arccos ;
+
+PROCEDURE arctan (x: LONGREAL): LONGREAL;
+  (* Returns the arctangent of x *)
+BEGIN
+   RETURN libm.atanl(x)
+END arctan ;
+
+PROCEDURE power (base, exponent: LONGREAL): LONGREAL;
+  (* Returns the value of the number base raised to the power exponent *)
+BEGIN
+   RETURN libm.powl(base, exponent)
+END power ;
+
+PROCEDURE round (x: LONGREAL) : INTEGER;
+  (* Returns the value of x rounded to the nearest integer *)
+BEGIN
+   RETURN TRUNC(x)
+END round ;
+
+PROCEDURE IsRMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the
+     exceptional execution state because of the raising
+     of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+BEGIN
+   RETURN FALSE
+END IsRMathException ;
+
+END LongMath.
diff --git a/gcc/m2/gm2-libs-iso/LongStr.def b/gcc/m2/gm2-libs-iso/LongStr.def
new file mode 100644
index 00000000000..33e892681de
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongStr.def
@@ -0,0 +1,73 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE LongStr;
+
+  (* LONGREAL/string conversions *)
+
+IMPORT
+   ConvTypes;
+
+TYPE
+   (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+   ConvResults = ConvTypes.ConvResults;
+
+(* the string form of a signed fixed-point real number is
+     ["+" | "-"], decimal digit, {decimal digit}, [".",
+     {decimal digit}]
+*)
+
+(* the string form of a signed floating-point real number is
+     signed fixed-point real number, "E", ["+" | "-"],
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE StrToReal (str: ARRAY OF CHAR; VAR real: LONGREAL;
+                     VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent characters
+     in str are in the format of a signed real number, assigns a
+     corresponding value to real.  Assigns a value indicating the
+     format of str to res.
+  *)
+
+PROCEDURE RealToFloat (real: LONGREAL; sigFigs: CARDINAL;
+                       VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.
+  *)
+
+PROCEDURE RealToEng (real: LONGREAL; sigFigs: CARDINAL;
+                     VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str. The number is scaled with one to three digits
+     in the whole number part and with an exponent that is a
+     multiple of three.
+  *)
+
+PROCEDURE RealToFixed (real: LONGREAL; place: INTEGER;
+                       VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to fixed-point string form, rounded
+     to the given place relative to the decimal point, and copies
+     the possibly truncated result to str.
+  *)
+
+PROCEDURE RealToStr (real: LONGREAL; VAR str: ARRAY OF CHAR);
+  (* Converts the value of real as RealToFixed if the sign and
+     magnitude can be shown within the capacity of str, or
+     otherwise as RealToFloat, and copies the possibly truncated
+     result to str. The number of places or significant digits
+     depend on the capacity of str.
+  *)
+
+END LongStr.
+
diff --git a/gcc/m2/gm2-libs-iso/LongStr.mod b/gcc/m2/gm2-libs-iso/LongStr.mod
new file mode 100644
index 00000000000..31b980d079c
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongStr.mod
@@ -0,0 +1,150 @@
+(* LongStr.mod implement the ISO LongStr specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LongStr;
+
+(* REAL/string conversions *)
+
+IMPORT LongConv ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Length, CopyOut ;
+
+FROM ConvStringLong IMPORT RealToFixedString, RealToFloatString,
+                           RealToEngString ;
+
+
+(* the string form of a signed fixed-point real number is
+     ["+" | "-"], decimal digit, {decimal digit}, [".",
+     {decimal digit}]
+*)
+
+(* the string form of a signed floating-point real number is
+     signed fixed-point real number, "E", ["+" | "-"],
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE StrToReal (str: ARRAY OF CHAR; VAR real: LONGREAL;
+                     VAR res: ConvResults) ;
+  (* Ignores any leading spaces in str. If the subsequent characters
+     in str are in the format of a signed real number, assigns a
+     corresponding value to real.  Assigns a value indicating the
+     format of str to res.
+  *)
+BEGIN
+   res := LongConv.FormatReal(str) ;
+   IF res=strAllRight
+   THEN
+      real := LongConv.ValueReal(str)
+   END
+END StrToReal ;
+
+
+PROCEDURE RealToFloat (real: LONGREAL; sigFigs: CARDINAL;
+                       VAR str: ARRAY OF CHAR) ;
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToFloatString(real, sigFigs) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END RealToFloat ;
+
+
+PROCEDURE RealToEng (real: LONGREAL; sigFigs: CARDINAL;
+                     VAR str: ARRAY OF CHAR) ;
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.  The number is scaled with one to three digits
+     in the whole number part and with an exponent that is a multiple
+     of three.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToEngString(real, sigFigs) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END RealToEng ;
+
+
+PROCEDURE RealToFixed (real: LONGREAL; place: INTEGER;
+                       VAR str: ARRAY OF CHAR) ;
+  (* Converts the value of real to fixed-point string form, rounded
+     to the given place relative to the decimal point, and copies
+     the possibly truncated result to str.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToFixedString(real, place) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END RealToFixed ;
+
+
+PROCEDURE RealToStr (real: LONGREAL; VAR str: ARRAY OF CHAR) ;
+  (* Converts the value of real as RealToFixed if the sign and
+     magnitude can be shown within the capacity of str, or
+     otherwise as RealToFloat, and copies the possibly truncated
+     result to str.  The number of places or significant digits
+     are implementation-defined.
+  *)
+VAR
+   s      : String ;
+   sigFigs: CARDINAL ;
+BEGIN
+   sigFigs := HIGH(str) ;
+   WHILE sigFigs>1 DO
+      s := RealToFixedString(real, sigFigs) ;
+      IF Length(s)<=HIGH(str)
+      THEN
+         CopyOut(str, s) ;
+         s := KillString(s) ;
+         RETURN
+      END ;
+      s := KillString(s) ;
+      DEC(sigFigs)
+   END ;
+   sigFigs := HIGH(str) ;
+   WHILE sigFigs#0 DO
+      s := RealToFloatString(real, sigFigs) ;
+      IF Length(s)<=HIGH(str)
+      THEN
+         CopyOut(str, s) ;
+         s := KillString(s) ;
+         RETURN
+      END ;
+      s := KillString(s) ;
+      DEC(sigFigs)
+   END
+END RealToStr ;
+
+
+END LongStr.
diff --git a/gcc/m2/gm2-libs-iso/LongWholeIO.def b/gcc/m2/gm2-libs-iso/LongWholeIO.def
new file mode 100644
index 00000000000..7a48594f543
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongWholeIO.def
@@ -0,0 +1,69 @@
+(* LongWholeIO.def provides a WholeIO interface for gm2 LONGINT/LONGCARD.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE LongWholeIO;
+
+  (* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, {decimal digit}
+
+     The text form of an unsigned whole number is
+       decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: LONGINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: LONGINT;
+                    width: CARDINAL);
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: LONGCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: LONGCARD;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+
+END LongWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/LongWholeIO.mod b/gcc/m2/gm2-libs-iso/LongWholeIO.mod
new file mode 100644
index 00000000000..4e396dd1115
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LongWholeIO.mod
@@ -0,0 +1,175 @@
+(* LongWholeIO.mod provides a WholeIO interface for gm2 LONGINT/LONGCARD.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LongWholeIO ;
+
+FROM ConvTypes IMPORT ScanClass, ScanState ;
+FROM TextIO IMPORT WriteChar, ReadChar ;
+FROM DynamicStrings IMPORT String, char, KillString, Length ;
+FROM StringConvert IMPORT LongIntegerToString, LongCardinalToString ;
+FROM WholeConv IMPORT ScanInt, ScanCard ;
+FROM StringChan IMPORT writeString ;
+FROM IOConsts IMPORT ReadResults ;
+
+
+(* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+*)
+
+IMPORT IOChan;
+
+(* The text form of a signed whole number is
+     ["+" | "-"], decimal digit, {decimal digit}
+
+   The text form of an unsigned whole number is
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: LONGINT) ;
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+VAR
+   chClass  : ScanClass ;
+   nextState: ScanState ;
+   c        : LONGCARD ;
+   ch       : CHAR ;
+   negative : BOOLEAN ;
+BEGIN
+   ReadChar(cid, ch) ;
+   negative := FALSE ;
+   c := 0 ;
+   nextState := ScanInt ;
+   REPEAT
+      nextState(ch, chClass, nextState) ;
+      IF chClass=valid
+      THEN
+         IF ch='+'
+         THEN
+            (* ignore *)
+         ELSIF ch='-'
+         THEN
+            negative := NOT negative
+         ELSE
+            c := c*10+VAL(LONGCARD, ORD(ch)-ORD('0'))
+         END ;
+         ReadChar(cid, ch)
+      ELSIF chClass=padding
+      THEN
+         ReadChar(cid, ch)
+      END
+   UNTIL (chClass=invalid) OR (chClass=terminator) ;
+   IF chClass=terminator
+   THEN
+      IF negative
+      THEN
+         IF c=VAL(LONGCARD, MAX(LONGINT))+1
+         THEN
+            int := MIN(LONGINT)
+         ELSIF c<=VAL(LONGCARD, MAX(LONGINT))
+         THEN
+            int := -VAL(LONGINT, c)
+         ELSE
+            (* overflow *)
+            IOChan.SetReadResult(cid, outOfRange)
+         END
+      ELSE
+         int := c
+      END
+   END
+END ReadInt ;
+
+
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: LONGINT;
+                    width: CARDINAL) ;
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+VAR
+   s: String ;
+BEGIN
+   s := LongIntegerToString(int, width, ' ', TRUE, 10, FALSE) ;
+   writeString(cid, s) ;
+   s := KillString(s)
+END WriteInt ;
+
+
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: LONGCARD) ;
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+VAR
+   chClass  : ScanClass ;
+   nextState: ScanState ;
+   ch       : CHAR ;
+   c        : LONGCARD ;
+BEGIN
+   ReadChar(cid, ch) ;
+   c := 0 ;
+   nextState := ScanCard ;
+   REPEAT
+      nextState(ch, chClass, nextState) ;
+      IF chClass=valid
+      THEN
+         IF ch='+'
+         THEN
+            (* ignore *)
+         ELSE
+            c := c*10+VAL(LONGCARD, ORD(ch)-ORD('0'))
+         END ;
+         ReadChar(cid, ch)
+      ELSIF chClass=padding
+      THEN
+         ReadChar(cid, ch)
+      END
+   UNTIL (chClass=invalid) OR (chClass=terminator) ;
+   IF chClass=terminator
+   THEN
+      card := c
+   END
+END ReadCard ;
+
+
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: LONGCARD;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+VAR
+   s: String ;
+BEGIN
+   s := LongCardinalToString(card, width, ' ', 10, FALSE) ;
+   writeString(cid, s) ;
+   s := KillString(s)
+END WriteCard ;
+
+
+END LongWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/LowLong.def b/gcc/m2/gm2-libs-iso/LowLong.def
new file mode 100644
index 00000000000..b14f70a88e1
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LowLong.def
@@ -0,0 +1,85 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE LowLong;
+
+  (* Access to underlying properties of the type LONGREAL *)
+
+CONST
+  radix      = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, radix> )) ;      (* ZType *)
+  places     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, places> )) ;     (* ZType *)
+  expoMin    = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, expoMin> )) ;    (* ZType *)
+  expoMax    = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, expoMax> )) ;    (* ZType *)
+  large      = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, large> )) ;      (* RType *)
+  small      = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, small> )) ;      (* RType *)
+  IEC559     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, IEC559> )) ;     (* BOOLEAN *)
+  LIA1       = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, LIA1> )) ;       (* BOOLEAN *)
+  ISO        = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, ISO> )) ;        (* BOOLEAN *)
+  IEEE       = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, IEEE> )) ;       (* BOOLEAN *)
+  rounds     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, rounds> )) ;     (* BOOLEAN *)
+  gUnderflow = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, gUnderflow> )) ; (* BOOLEAN *)
+  exception  = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, exception> )) ;  (* BOOLEAN *)
+  extend     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, extend> )) ;     (* BOOLEAN *)
+  nModes     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, nModes> )) ;     (* ZType *)
+
+TYPE
+  Modes = PACKEDSET OF [0 .. nModes-1];
+
+PROCEDURE exponent (x: LONGREAL): INTEGER;
+  (* Returns the exponent value of x *)
+
+PROCEDURE fraction (x: LONGREAL): LONGREAL;
+  (* Returns the significand (or significant part) of x *)
+
+PROCEDURE sign (x: LONGREAL): LONGREAL;
+  (* Returns the signum of x *)
+
+PROCEDURE succ (x: LONGREAL): LONGREAL;
+  (* Returns the next value of the type LONGREAL greater than x *)
+
+PROCEDURE ulp (x: LONGREAL): LONGREAL;
+  (* Returns the value of a unit in the last place of x *)
+
+PROCEDURE pred (x: LONGREAL): LONGREAL;
+  (* Returns the previous value of the type LONGREAL less than x *)
+
+PROCEDURE intpart (x: LONGREAL): LONGREAL;
+  (* Returns the integer part of x *)
+
+PROCEDURE fractpart (x: LONGREAL): LONGREAL;
+  (* Returns the fractional part of x *)
+
+PROCEDURE scale (x: LONGREAL; n: INTEGER): LONGREAL;
+  (* Returns the value of x * radix ** n *)
+
+PROCEDURE trunc (x: LONGREAL; n: INTEGER): LONGREAL;
+  (* Returns the value of the first n places of x *)
+
+PROCEDURE round (x: LONGREAL; n: INTEGER): LONGREAL;
+  (* Returns the value of x rounded to the first n places *)
+
+PROCEDURE synthesize (expart: INTEGER; frapart: LONGREAL): LONGREAL;
+  (* Returns a value of the type LONGREAL constructed from the given expart and frapart *)
+
+PROCEDURE setMode (m: Modes);
+  (* Sets status flags appropriate to the underlying implementation of the type LONGREAL *)
+
+PROCEDURE currentMode (): Modes;
+  (* Returns the current status flags in the form set by setMode *)
+
+PROCEDURE IsLowException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END LowLong.
+
diff --git a/gcc/m2/gm2-libs-iso/LowLong.mod b/gcc/m2/gm2-libs-iso/LowLong.mod
new file mode 100644
index 00000000000..74f7ca923f8
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LowLong.mod
@@ -0,0 +1,299 @@
+(* LowLong.mod implement ISO LowLong specification.
+
+Copyright (C) 2010-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LowLong ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Builtins IMPORT ilogbl, significandl, modfl, signbitl, scalbnl, huge_vall, nextafterl ;
+FROM dtoa IMPORT Mode, strtod, dtoa ;
+FROM libc IMPORT free ;
+FROM RealMath IMPORT power ;
+FROM ConvStringReal IMPORT RealToFloatString ;
+FROM StringConvert IMPORT ToSigFig ;
+
+FROM EXCEPTIONS IMPORT ExceptionSource, AllocateSource, RAISE, CurrentNumber,
+                       IsCurrentSource, IsExceptionalExecution ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Slice, Mark,
+                           Mult, InitStringCharStar, Length, ConCat,
+                           ConCatChar, InitStringChar, string ;
+
+TYPE
+   FloatingPointExceptions = (badparam) ;
+
+VAR
+   currentmode: Modes ;
+
+
+(*
+   exponent - returns the exponent value of x
+*)
+
+PROCEDURE exponent (x: LONGREAL) : INTEGER ;
+BEGIN
+   RETURN ilogbl(x)
+END exponent ;
+
+
+(*
+   fraction - returns the significand (or significant part) of x
+*)
+
+PROCEDURE fraction (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN significandl(x)
+END fraction ;
+
+
+(*
+   sign - returns the signum of x.  sign(x) = 1.0  for all x>0.0
+          sign(x) = -1.0  for all x<0.0.
+          may be either -1.0 or 1.0 if x = 0.0
+*)
+
+PROCEDURE sign (x: LONGREAL) : LONGREAL ;
+BEGIN
+   IF signbitl(x)=0
+   THEN
+      RETURN 1.0
+   ELSE
+      RETURN -1.0
+   END
+END sign ;
+
+
+(*
+   succ - returns the next value of the type REAL greater than x
+*)
+
+PROCEDURE succ (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN nextafterl(x, huge_vall())
+END succ ;
+
+
+(*
+   ulp - returns the value of a unit in the last place of x.
+         So either:
+
+         ulp(x) = succ(x)-x     or
+         ulp(x) = x-pred(x)     or both are true.
+
+         if the value does not exist then an exception is raised.
+*)
+
+PROCEDURE ulp (x: LONGREAL) : LONGREAL ;
+BEGIN
+   IF x<huge_vall()
+   THEN
+      RETURN succ(x)-x
+   ELSE
+      RETURN x-pred(x)
+   END
+END ulp ;
+
+
+(*
+   pred - returns the previous value of the type REAL less than x.
+*)
+
+PROCEDURE pred (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN nextafterl(x, -huge_vall())
+END pred ;
+
+
+(*
+   intpart - returns the integer part of x
+*)
+
+PROCEDURE intpart (x: LONGREAL) : LONGREAL ;
+VAR
+   y, z: LONGREAL ;
+BEGIN
+   z := modfl(x, y) ;
+   RETURN y
+END intpart ;
+
+
+(*
+   fractpart - returns the fractional part of x
+*)
+
+PROCEDURE fractpart (x: LONGREAL) : LONGREAL ;
+VAR
+   y: LONGREAL ;
+BEGIN
+   RETURN modfl(x, y)
+END fractpart ;
+
+
+(*
+   scale - returns the value of x * radix ** n
+
+           The following holds true:
+
+           x = synthesize(exponent(x),fraction(x))
+           x = scale(fraction(x), exponent(x))
+*)
+
+PROCEDURE scale (x: LONGREAL; n: INTEGER) : LONGREAL ;
+BEGIN
+   RETURN scalbnl(x, n)
+END scale ;
+
+
+(*
+   trunc - returns the value of the first n places of x.
+*)
+
+PROCEDURE trunc (x: LONGREAL; n: INTEGER) : LONGREAL ;
+VAR
+   y         : LONGREAL ;
+   sign,
+   error     : BOOLEAN ;
+   s         : String ;
+   r         : ADDRESS ;
+   point, l,
+   powerOfTen: INTEGER ;
+BEGIN
+   IF n<0
+   THEN
+      (* exception raised *)
+      RAISE(except, ORD(badparam),
+            'LowLong.trunc: cannot truncate to a negative number of digits') ;
+      RETURN x
+   ELSE
+      r := dtoa(x, maxsignificant, 100, point, sign) ;
+      s := InitStringCharStar(r) ;
+      free(r) ;
+      l := Length(s) ;
+      IF VAL(INTEGER, n)<l
+      THEN
+         s := Slice(ToSigFig(s, n), 0, n)
+      ELSE
+         (* add '0's to make up significant figures *)
+         s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, n))))
+      END ;
+      powerOfTen := point-1 ;
+      point := 1 ;
+
+      IF (point<l) AND (point<VAL(INTEGER, n))
+      THEN
+         s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                     Slice(s, point, 0))
+      END ;
+      y := strtod(string(s), error) ;
+      IF powerOfTen#0
+      THEN
+         y := power(y, FLOATL(powerOfTen))
+      END ;
+      s := KillString(s) ;
+      RETURN y
+   END
+END trunc ;
+
+
+(*
+   round - returns the value of x rounded to the first n places.
+           n significant figures.
+*)
+
+PROCEDURE round (x: LONGREAL; n: INTEGER) : LONGREAL ;
+VAR
+   y    : LONGREAL ;
+   error: BOOLEAN ;
+   s    : String ;
+BEGIN
+   IF n<0
+   THEN
+      (* exception raised *)
+      RAISE(except, ORD(badparam),
+            'LowLong.round: cannot round to a negative number of digits') ;
+      RETURN x
+   ELSE
+      s := RealToFloatString(x, n) ;
+      y := strtod(string(s), error) ;
+      s := KillString(s) ;
+      RETURN y
+   END
+END round ;
+
+
+(*
+   synthesize - returns a value of the type REAL constructed from
+                the given expart and frapart.
+
+                The following holds true:
+
+                x = synthesize(exponent(x),fraction(x))
+                x = scale(fraction(x), exponent(x))
+*)
+
+PROCEDURE synthesize (expart: INTEGER; frapart: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN scalbnl(frapart, expart)
+END synthesize ;
+
+
+(*
+   setMode - sets status flags appropriate to the underlying implementation
+             of the type REAL.
+*)
+
+PROCEDURE setMode (m: Modes) ;
+BEGIN
+   currentmode := m
+END setMode ;
+
+
+(*
+   currentMode - returns the current status flags in the form set by setMode
+*)
+
+PROCEDURE currentMode () : Modes ;
+BEGIN
+   RETURN currentmode
+END currentMode ;
+
+
+(*
+   IsLowException - returns TRUE if the current coroutine is in the exceptional
+                    execution state because of the raising of an exception in a
+                    routine from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsLowException () : BOOLEAN ;
+BEGIN
+   RETURN( IsExceptionalExecution() AND IsCurrentSource(except) )
+END IsLowException ;
+
+
+VAR
+   except: ExceptionSource ;
+BEGIN
+   AllocateSource(except)
+END LowLong.
diff --git a/gcc/m2/gm2-libs-iso/LowReal.def b/gcc/m2/gm2-libs-iso/LowReal.def
new file mode 100644
index 00000000000..3dc43909f3b
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LowReal.def
@@ -0,0 +1,85 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE LowReal;
+
+  (* Access to underlying properties of the type REAL *)
+
+CONST
+  radix      = __ATTRIBUTE__ __BUILTIN__ (( <REAL, radix> )) ;      (* ZType *)
+  places     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, places> )) ;     (* ZType *)
+  expoMin    = __ATTRIBUTE__ __BUILTIN__ (( <REAL, expoMin> )) ;    (* ZType *)
+  expoMax    = __ATTRIBUTE__ __BUILTIN__ (( <REAL, expoMax> )) ;    (* ZType *)
+  large      = __ATTRIBUTE__ __BUILTIN__ (( <REAL, large> )) ;      (* RType *)
+  small      = __ATTRIBUTE__ __BUILTIN__ (( <REAL, small> )) ;      (* RType *)
+  IEC559     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, IEC559> )) ;     (* BOOLEAN *)
+  LIA1       = __ATTRIBUTE__ __BUILTIN__ (( <REAL, LIA1> )) ;       (* BOOLEAN *)
+  ISO        = __ATTRIBUTE__ __BUILTIN__ (( <REAL, ISO> )) ;        (* BOOLEAN *)
+  IEEE       = __ATTRIBUTE__ __BUILTIN__ (( <REAL, IEEE> )) ;       (* BOOLEAN *)
+  rounds     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, rounds> )) ;     (* BOOLEAN *)
+  gUnderflow = __ATTRIBUTE__ __BUILTIN__ (( <REAL, gUnderflow> )) ; (* BOOLEAN *)
+  exception  = __ATTRIBUTE__ __BUILTIN__ (( <REAL, exception> )) ;  (* BOOLEAN *)
+  extend     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, extend> )) ;     (* BOOLEAN *)
+  nModes     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, nModes> )) ;     (* ZType *)
+
+TYPE
+  Modes = PACKEDSET OF [0..nModes-1];
+
+PROCEDURE exponent (x: REAL): INTEGER;
+  (* Returns the exponent value of x *)
+
+PROCEDURE fraction (x: REAL): REAL;
+  (* Returns the significand (or significant part) of x *)
+
+PROCEDURE sign (x: REAL): REAL;
+  (* Returns the signum of x *)
+
+PROCEDURE succ (x: REAL): REAL;
+  (* Returns the next value of the type REAL greater than x *)
+
+PROCEDURE ulp (x: REAL): REAL;
+  (* Returns the value of a unit in the last place of x *)
+
+PROCEDURE pred (x: REAL): REAL;
+  (* Returns the previous value of the type REAL less than x *)
+
+PROCEDURE intpart (x: REAL): REAL;
+  (* Returns the integer part of x *)
+
+PROCEDURE fractpart (x: REAL): REAL;
+  (* Returns the fractional part of x *)
+
+PROCEDURE scale (x: REAL; n: INTEGER): REAL;
+  (* Returns the value of x * radix ** n *)
+
+PROCEDURE trunc (x: REAL; n: INTEGER): REAL;
+  (* Returns the value of the first n places of x *)
+
+PROCEDURE round (x: REAL; n: INTEGER): REAL;
+  (* Returns the value of x rounded to the first n places *)
+
+PROCEDURE synthesize (expart: INTEGER; frapart: REAL): REAL;
+  (* Returns a value of the type REAL constructed from the given expart and frapart *)
+
+PROCEDURE setMode (m: Modes);
+  (* Sets status flags appropriate to the underlying implementation of the type REAL *)
+
+PROCEDURE currentMode (): Modes;
+  (* Returns the current status flags in the form set by setMode *)
+
+PROCEDURE IsLowException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END LowReal.
+
diff --git a/gcc/m2/gm2-libs-iso/LowReal.mod b/gcc/m2/gm2-libs-iso/LowReal.mod
new file mode 100644
index 00000000000..cc74f6564dc
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LowReal.mod
@@ -0,0 +1,299 @@
+(* LowReal.mod implements ISO LowReal.def  Copyright (C) 2008-2019 Free Software Foundation, Inc.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LowReal ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Builtins IMPORT ilogb, significand, modf, signbit, scalbn, huge_val, nextafter ;
+FROM dtoa IMPORT Mode, strtod, dtoa ;
+FROM libc IMPORT free ;
+FROM RealMath IMPORT power ;
+FROM ConvStringReal IMPORT RealToFloatString ;
+FROM StringConvert IMPORT ToSigFig ;
+
+FROM EXCEPTIONS IMPORT ExceptionSource, AllocateSource, RAISE, CurrentNumber,
+                       IsCurrentSource, IsExceptionalExecution ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Slice, Mark,
+                           Mult, InitStringCharStar, Length, ConCat,
+                           ConCatChar, InitStringChar, string ;
+
+TYPE
+   FloatingPointExceptions = (badparam) ;
+
+VAR
+   currentmode: Modes ;
+
+
+(*
+   exponent - returns the exponent value of x
+*)
+
+PROCEDURE exponent (x: REAL) : INTEGER ;
+BEGIN
+   RETURN ilogb(x)
+END exponent ;
+
+
+(*
+   fraction - returns the significand (or significant part) of x
+*)
+
+PROCEDURE fraction (x: REAL) : REAL ;
+BEGIN
+   RETURN significand(x)
+END fraction ;
+
+
+(*
+   sign - returns the signum of x.  sign(x) = 1.0  for all x>0.0
+          sign(x) = -1.0  for all x<0.0.
+          may be either -1.0 or 1.0 if x = 0.0
+*)
+
+PROCEDURE sign (x: REAL) : REAL ;
+BEGIN
+   IF signbit(x)=0
+   THEN
+      RETURN 1.0
+   ELSE
+      RETURN -1.0
+   END
+END sign ;
+
+
+(*
+   succ - returns the next value of the type REAL greater than x
+*)
+
+PROCEDURE succ (x: REAL) : REAL ;
+BEGIN
+   RETURN nextafter(x, huge_val())
+END succ ;
+
+
+(*
+   ulp - returns the value of a unit in the last place of x.
+         So either:
+
+         ulp(x) = succ(x)-x     or
+         ulp(x) = x-pred(x)     or both are true.
+
+         if the value does not exist then an exception is raised.
+*)
+
+PROCEDURE ulp (x: REAL) : REAL ;
+BEGIN
+   IF x<huge_val()
+   THEN
+      RETURN succ(x)-x
+   ELSE
+      RETURN x-pred(x)
+   END
+END ulp ;
+
+
+(*
+   pred - returns the previous value of the type REAL less than x.
+*)
+
+PROCEDURE pred (x: REAL) : REAL ;
+BEGIN
+   RETURN nextafter(x, -huge_val())
+END pred ;
+
+
+(*
+   intpart - returns the integer part of x
+*)
+
+PROCEDURE intpart (x: REAL) : REAL ;
+VAR
+   y, z: REAL ;
+BEGIN
+   z := modf(x, y) ;
+   RETURN y
+END intpart ;
+
+
+(*
+   fractpart - returns the fractional part of x
+*)
+
+PROCEDURE fractpart (x: REAL) : REAL ;
+VAR
+   y: REAL ;
+BEGIN
+   RETURN modf(x, y)
+END fractpart ;
+
+
+(*
+   scale - returns the value of x * radix ** n
+
+           The following holds true:
+
+           x = synthesize(exponent(x),fraction(x))
+           x = scale(fraction(x), exponent(x))
+*)
+
+PROCEDURE scale (x: REAL; n: INTEGER) : REAL ;
+BEGIN
+   RETURN scalbn(x, n)
+END scale ;
+
+
+(*
+   trunc - returns the value of the first n places of x.
+*)
+
+PROCEDURE trunc (x: REAL; n: INTEGER) : REAL ;
+VAR
+   y         : REAL ;
+   sign,
+   error     : BOOLEAN ;
+   s         : String ;
+   r         : ADDRESS ;
+   point, l,
+   powerOfTen: INTEGER ;
+BEGIN
+   IF n<0
+   THEN
+      (* exception raised *)
+      RAISE(except, ORD(badparam),
+            'LowReal.trunc: cannot truncate to a negative number of digits') ;
+      RETURN x
+   ELSE
+      r := dtoa(x, maxsignificant, 100, point, sign) ;
+      s := InitStringCharStar(r) ;
+      free(r) ;
+      l := Length(s) ;
+      IF VAL(INTEGER, n)<l
+      THEN
+         s := Slice(ToSigFig(s, n), 0, n)
+      ELSE
+         (* add '0's to make up significant figures *)
+         s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, n))))
+      END ;
+      powerOfTen := point-1 ;
+      point := 1 ;
+
+      IF (point<l) AND (point<VAL(INTEGER, n))
+      THEN
+         s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                     Slice(s, point, 0))
+      END ;
+      y := strtod(string(s), error) ;
+      IF powerOfTen#0
+      THEN
+         y := power(y, FLOAT(powerOfTen))
+      END ;
+      s := KillString(s) ;
+      RETURN y
+   END
+END trunc ;
+
+
+(*
+   round - returns the value of x rounded to the first n places.
+           n significant figures.
+*)
+
+PROCEDURE round (x: REAL; n: INTEGER) : REAL ;
+VAR
+   y    : REAL ;
+   error: BOOLEAN ;
+   s    : String ;
+BEGIN
+   IF n<0
+   THEN
+      (* exception raised *)
+      RAISE(except, ORD(badparam),
+            'LowReal.round: cannot round to a negative number of digits') ;
+      RETURN x
+   ELSE
+      s := RealToFloatString(x, n) ;
+      y := strtod(string(s), error) ;
+      s := KillString(s) ;
+      RETURN y
+   END
+END round ;
+
+
+(*
+   synthesize - returns a value of the type REAL constructed from
+                the given expart and frapart.
+
+                The following holds true:
+
+                x = synthesize(exponent(x),fraction(x))
+                x = scale(fraction(x), exponent(x))
+*)
+
+PROCEDURE synthesize (expart: INTEGER; frapart: REAL) : REAL ;
+BEGIN
+   RETURN scalbn(frapart, expart)
+END synthesize ;
+
+
+(*
+   setMode - sets status flags appropriate to the underlying implementation
+             of the type REAL.
+*)
+
+PROCEDURE setMode (m: Modes) ;
+BEGIN
+   currentmode := m
+END setMode ;
+
+
+(*
+   currentMode - returns the current status flags in the form set by setMode
+*)
+
+PROCEDURE currentMode () : Modes ;
+BEGIN
+   RETURN currentmode
+END currentMode ;
+
+
+(*
+   IsLowException - returns TRUE if the current coroutine is in the exceptional
+                    execution state because of the raising of an exception in a
+                    routine from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsLowException () : BOOLEAN ;
+BEGIN
+   RETURN( IsExceptionalExecution() AND IsCurrentSource(except) )
+END IsLowException ;
+
+
+VAR
+   except: ExceptionSource ;
+BEGIN
+   AllocateSource(except)
+END LowReal.
diff --git a/gcc/m2/gm2-libs-iso/LowShort.def b/gcc/m2/gm2-libs-iso/LowShort.def
new file mode 100644
index 00000000000..4605f1bb42c
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LowShort.def
@@ -0,0 +1,99 @@
+(* LowShort.def provides access to limits of the gm2 SHORTREAL.
+
+Copyright (C) 2010-2021 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/>.  *)
+
+DEFINITION MODULE LowShort;
+
+  (* Access to underlying properties of the type SHORTREAL *)
+
+CONST
+  radix      = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, radix> )) ;      (* ZType *)
+  places     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, places> )) ;     (* ZType *)
+  expoMin    = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, expoMin> )) ;    (* ZType *)
+  expoMax    = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, expoMax> )) ;    (* ZType *)
+  large      = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, large> )) ;      (* RType *)
+  small      = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, small> )) ;      (* RType *)
+  IEC559     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, IEC559> )) ;     (* BOOLEAN *)
+  LIA1       = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, LIA1> )) ;       (* BOOLEAN *)
+  ISO        = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, ISO> )) ;        (* BOOLEAN *)
+  IEEE       = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, IEEE> )) ;       (* BOOLEAN *)
+  rounds     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, rounds> )) ;     (* BOOLEAN *)
+  gUnderflow = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, gUnderflow> )) ; (* BOOLEAN *)
+  exception  = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, exception> )) ;  (* BOOLEAN *)
+  extend     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, extend> )) ;     (* BOOLEAN *)
+  nModes     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, nModes> )) ;     (* ZType *)
+
+TYPE
+  Modes = PACKEDSET OF [0 .. nModes-1];
+
+PROCEDURE exponent (x: SHORTREAL): INTEGER;
+  (* Returns the exponent value of x *)
+
+PROCEDURE fraction (x: SHORTREAL): SHORTREAL;
+  (* Returns the significand (or significant part) of x *)
+
+PROCEDURE sign (x: SHORTREAL): SHORTREAL;
+  (* Returns the signum of x *)
+
+PROCEDURE succ (x: SHORTREAL): SHORTREAL;
+  (* Returns the next value of the type SHORTREAL greater than x *)
+
+PROCEDURE ulp (x: SHORTREAL): SHORTREAL;
+  (* Returns the value of a unit in the last place of x *)
+
+PROCEDURE pred (x: SHORTREAL): SHORTREAL;
+  (* Returns the previous value of the type SHORTREAL less than x *)
+
+PROCEDURE intpart (x: SHORTREAL): SHORTREAL;
+  (* Returns the integer part of x *)
+
+PROCEDURE fractpart (x: SHORTREAL): SHORTREAL;
+  (* Returns the fractional part of x *)
+
+PROCEDURE scale (x: SHORTREAL; n: INTEGER): SHORTREAL;
+  (* Returns the value of x * radix ** n *)
+
+PROCEDURE trunc (x: SHORTREAL; n: INTEGER): SHORTREAL;
+  (* Returns the value of the first n places of x *)
+
+PROCEDURE round (x: SHORTREAL; n: INTEGER): SHORTREAL;
+  (* Returns the value of x rounded to the first n places *)
+
+PROCEDURE synthesize (expart: INTEGER; frapart: SHORTREAL): SHORTREAL;
+  (* Returns a value of the type SHORTREAL constructed from the given expart and frapart *)
+
+PROCEDURE setMode (m: Modes);
+  (* Sets status flags appropriate to the underlying implementation of the type SHORTREAL *)
+
+PROCEDURE currentMode (): Modes;
+  (* Returns the current status flags in the form set by setMode *)
+
+PROCEDURE IsLowException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END LowShort.
diff --git a/gcc/m2/gm2-libs-iso/LowShort.mod b/gcc/m2/gm2-libs-iso/LowShort.mod
new file mode 100644
index 00000000000..892198233e4
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/LowShort.mod
@@ -0,0 +1,299 @@
+(* LowShort.mod provides access to limits of the gm2 SHORTREAL.
+
+Copyright (C) 2010-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LowShort ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Builtins IMPORT ilogbf, significandf, modff, signbitf, scalbnf, huge_valf, nextafterf ;
+FROM dtoa IMPORT Mode, strtod, dtoa ;
+FROM libc IMPORT free ;
+FROM RealMath IMPORT power ;
+FROM ConvStringReal IMPORT RealToFloatString ;
+FROM StringConvert IMPORT ToSigFig ;
+
+FROM EXCEPTIONS IMPORT ExceptionSource, AllocateSource, RAISE, CurrentNumber,
+                       IsCurrentSource, IsExceptionalExecution ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Slice, Mark,
+                           Mult, InitStringCharStar, Length, ConCat,
+                           ConCatChar, InitStringChar, string ;
+
+TYPE
+   FloatingPointExceptions = (badparam) ;
+
+VAR
+   currentmode: Modes ;
+
+
+(*
+   exponent - returns the exponent value of x
+*)
+
+PROCEDURE exponent (x: SHORTREAL) : INTEGER ;
+BEGIN
+   RETURN ilogbf(x)
+END exponent ;
+
+
+(*
+   fraction - returns the significand (or significant part) of x
+*)
+
+PROCEDURE fraction (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN significandf(x)
+END fraction ;
+
+
+(*
+   sign - returns the signum of x.  sign(x) = 1.0  for all x>0.0
+          sign(x) = -1.0  for all x<0.0.
+          may be either -1.0 or 1.0 if x = 0.0
+*)
+
+PROCEDURE sign (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   IF signbitf(x)=0
+   THEN
+      RETURN 1.0
+   ELSE
+      RETURN -1.0
+   END
+END sign ;
+
+
+(*
+   succ - returns the next value of the type REAL greater than x
+*)
+
+PROCEDURE succ (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN nextafterf(x, huge_valf())
+END succ ;
+
+
+(*
+   ulp - returns the value of a unit in the last place of x.
+         So either:
+
+         ulp(x) = succ(x)-x     or
+         ulp(x) = x-pred(x)     or both are true.
+
+         if the value does not exist then an exception is raised.
+*)
+
+PROCEDURE ulp (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   IF x<huge_valf()
+   THEN
+      RETURN succ(x)-x
+   ELSE
+      RETURN x-pred(x)
+   END
+END ulp ;
+
+
+(*
+   pred - returns the previous value of the type REAL less than x.
+*)
+
+PROCEDURE pred (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN nextafterf(x, -huge_valf())
+END pred ;
+
+
+(*
+   intpart - returns the integer part of x
+*)
+
+PROCEDURE intpart (x: SHORTREAL) : SHORTREAL ;
+VAR
+   y, z: SHORTREAL ;
+BEGIN
+   z := modff(x, y) ;
+   RETURN y
+END intpart ;
+
+
+(*
+   fractpart - returns the fractional part of x
+*)
+
+PROCEDURE fractpart (x: SHORTREAL) : SHORTREAL ;
+VAR
+   y: SHORTREAL ;
+BEGIN
+   RETURN modff(x, y)
+END fractpart ;
+
+
+(*
+   scale - returns the value of x * radix ** n
+
+           The following holds true:
+
+           x = synthesize(exponent(x),fraction(x))
+           x = scale(fraction(x), exponent(x))
+*)
+
+PROCEDURE scale (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+BEGIN
+   RETURN scalbnf(x, n)
+END scale ;
+
+
+(*
+   trunc - returns the value of the first n places of x.
+*)
+
+PROCEDURE trunc (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+VAR
+   y         : SHORTREAL ;
+   sign,
+   error     : BOOLEAN ;
+   s         : String ;
+   r         : ADDRESS ;
+   point, l,
+   powerOfTen: INTEGER ;
+BEGIN
+   IF n<0
+   THEN
+      (* exception raised *)
+      RAISE(except, ORD(badparam),
+            'LowLong.trunc: cannot truncate to a negative number of digits') ;
+      RETURN x
+   ELSE
+      r := dtoa(x, maxsignificant, 100, point, sign) ;
+      s := InitStringCharStar(r) ;
+      free(r) ;
+      l := Length(s) ;
+      IF VAL(INTEGER, n)<l
+      THEN
+         s := Slice(ToSigFig(s, n), 0, n)
+      ELSE
+         (* add '0's to make up significant figures *)
+         s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, n))))
+      END ;
+      powerOfTen := point-1 ;
+      point := 1 ;
+
+      IF (point<l) AND (point<VAL(INTEGER, n))
+      THEN
+         s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
+                     Slice(s, point, 0))
+      END ;
+      y := strtod(string(s), error) ;
+      IF powerOfTen#0
+      THEN
+         y := power(y, FLOATS(powerOfTen))
+      END ;
+      s := KillString(s) ;
+      RETURN y
+   END
+END trunc ;
+
+
+(*
+   round - returns the value of x rounded to the first n places.
+           n significant figures.
+*)
+
+PROCEDURE round (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+VAR
+   y    : SHORTREAL ;
+   error: BOOLEAN ;
+   s    : String ;
+BEGIN
+   IF n<0
+   THEN
+      (* exception raised *)
+      RAISE(except, ORD(badparam),
+            'LowLong.round: cannot round to a negative number of digits') ;
+      RETURN x
+   ELSE
+      s := RealToFloatString(x, n) ;
+      y := strtod(string(s), error) ;
+      s := KillString(s) ;
+      RETURN y
+   END
+END round ;
+
+
+(*
+   synthesize - returns a value of the type SHORTREAL constructed from
+                the given expart and frapart.
+
+                The following holds true:
+
+                x = synthesize(exponent(x),fraction(x))
+                x = scale(fraction(x), exponent(x))
+*)
+
+PROCEDURE synthesize (expart: INTEGER; frapart: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN scalbnf(frapart, expart)
+END synthesize ;
+
+
+(*
+   setMode - sets status flags appropriate to the underlying implementation
+             of the type REAL.
+*)
+
+PROCEDURE setMode (m: Modes) ;
+BEGIN
+   currentmode := m
+END setMode ;
+
+
+(*
+   currentMode - returns the current status flags in the form set by setMode
+*)
+
+PROCEDURE currentMode () : Modes ;
+BEGIN
+   RETURN currentmode
+END currentMode ;
+
+
+(*
+   IsLowException - returns TRUE if the current coroutine is in the exceptional
+                    execution state because of the raising of an exception in a
+                    routine from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsLowException () : BOOLEAN ;
+BEGIN
+   RETURN( IsExceptionalExecution() AND IsCurrentSource(except) )
+END IsLowException ;
+
+
+VAR
+   except: ExceptionSource ;
+BEGIN
+   AllocateSource(except)
+END LowShort.
diff --git a/gcc/m2/gm2-libs-iso/M2EXCEPTION.def b/gcc/m2/gm2-libs-iso/M2EXCEPTION.def
new file mode 100644
index 00000000000..5ada8842e1a
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/M2EXCEPTION.def
@@ -0,0 +1,35 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE M2EXCEPTION;
+
+(* Provides facilities for identifying language exceptions *)
+
+TYPE
+  M2Exceptions =
+    (indexException,     rangeException,         caseSelectException,  invalidLocation,
+     functionException,  wholeValueException,    wholeDivException,    realValueException,
+     realDivException,   complexValueException,  complexDivException,  protException,
+     sysException,       coException,            exException
+    );
+
+PROCEDURE M2Exception (): M2Exceptions;
+  (* If the current coroutine is in the exceptional execution state because of the raising
+     of a language exception, returns the corresponding enumeration value, and otherwise
+     raises an exception.
+  *)
+
+PROCEDURE IsM2Exception (): BOOLEAN;
+  (* If the current coroutine is in the exceptional execution state because of the raising
+     of a language exception, returns TRUE, and otherwise returns FALSE.
+  *)
+
+END M2EXCEPTION.
diff --git a/gcc/m2/gm2-libs-iso/M2EXCEPTION.mod b/gcc/m2/gm2-libs-iso/M2EXCEPTION.mod
new file mode 100644
index 00000000000..d993d63a8e9
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/M2EXCEPTION.mod
@@ -0,0 +1,62 @@
+(* M2EXCEPTION.mod implements access to the exception state.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+IMPLEMENTATION MODULE M2EXCEPTION ;
+
+IMPORT RTExceptions ;
+FROM SYSTEM IMPORT ADR ;
+
+
+PROCEDURE M2Exception () : M2Exceptions ;
+  (* If the current coroutine is in the exceptional execution state because of the raising
+     of a language exception, returns the corresponding enumeration value, and otherwise
+     raises an exception.
+  *)
+BEGIN
+   IF IsM2Exception()
+   THEN
+      RETURN( VAL(M2Exceptions, RTExceptions.GetNumber(RTExceptions.GetExceptionBlock())) )
+   ELSE
+      RTExceptions.Raise(ORD(exException),
+                         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+                         ADR('current coroutine is not in the exceptional execution state'))
+   END
+END M2Exception ;
+
+
+PROCEDURE IsM2Exception () : BOOLEAN ;
+  (* If the current coroutine is in the exceptional execution state because of the raising
+     of a language exception, returns TRUE, and otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN(
+          RTExceptions.IsInExceptionState() AND
+          (RTExceptions.GetBaseExceptionBlock()=RTExceptions.GetExceptionBlock())
+         )
+END IsM2Exception ;
+
+
+END M2EXCEPTION.
diff --git a/gcc/m2/gm2-libs-iso/M2RTS.def b/gcc/m2/gm2-libs-iso/M2RTS.def
new file mode 100644
index 00000000000..929e4eb81a9
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/M2RTS.def
@@ -0,0 +1,193 @@
+(* M2RTS.def provides access to the exception handlers.
+
+Copyright (C) 2010-2021 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/>.  *)
+
+DEFINITION MODULE M2RTS ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+   ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+
+(*
+   ExecuteTerminationProcedures - calls each installed termination
+                                  procedure in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+
+
+(*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE is the
+                                 procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   ExecuteInitialProcedures - executes the initial procedures installed
+                              by InstallInitialProcedure.
+*)
+
+PROCEDURE ExecuteInitialProcedures ;
+
+
+(*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the main
+                             program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE HALT ([exitcode: INTEGER = -1]) ;
+
+
+(*
+   Halt - provides a more user friendly version of HALT, which takes
+          four parameters to aid debugging.
+*)
+
+PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+                function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
+
+
+(*
+   ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*)
+
+PROCEDURE ExitOnHalt (e: INTEGER) ;
+
+
+(*
+   ErrorMessage - emits an error message to stderr and then calls exit (1).
+*)
+
+PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
+                        file: ARRAY OF CHAR;
+                        line: CARDINAL;
+                        function: ARRAY OF CHAR) ;
+
+
+(*
+   IsTerminating - Returns true if any coroutine has started program termination
+                   and false otherwise.
+*)
+
+PROCEDURE IsTerminating () : BOOLEAN ;
+
+
+(*
+   HasHalted - Returns true if a call to HALT has been made and false
+               otherwise.
+*)
+
+PROCEDURE HasHalted () : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Length (a: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   The following are the runtime exception handler routines.
+*)
+
+PROCEDURE AssignmentException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE IncException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE DecException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE InclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ExclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ShiftException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE RotateException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE StaticArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE DynamicArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ForLoopBeginException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ForLoopToException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ForLoopEndException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE PointerNilException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE NoReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE CaseException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeNonPosDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeNonPosModException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeZeroDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeZeroRemException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE RealValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ParameterException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE NoException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+
+
+END M2RTS.
diff --git a/gcc/m2/gm2-libs-iso/M2RTS.mod b/gcc/m2/gm2-libs-iso/M2RTS.mod
new file mode 100644
index 00000000000..c76f8431441
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/M2RTS.mod
@@ -0,0 +1,616 @@
+(* M2RTS.mod implements access to the exception handlers.
+
+Copyright (C) 2010-2021 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/>.  *)
+
+IMPLEMENTATION MODULE M2RTS ;
+
+
+FROM libc IMPORT abort, exit, write, getenv, printf ;
+(* FROM Builtins IMPORT strncmp, strcmp ;  not available during bootstrap.  *)
+FROM NumberIO IMPORT CardToStr ;
+FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM ASCII IMPORT nl, nul ;
+FROM Storage IMPORT ALLOCATE ;
+
+IMPORT RTExceptions ;
+IMPORT M2EXCEPTION ;
+IMPORT M2Dependent ;
+
+TYPE
+   PtrToChar = POINTER TO CHAR ;
+
+   ProcedureChain = POINTER TO RECORD
+                                  p   : PROC ;
+                                  prev,
+                                  next: ProcedureChain ;
+                                END ;
+
+   ProcedureList = RECORD
+                      head, tail: ProcedureChain
+                   END ;
+
+
+VAR
+   InitialProc,
+   TerminateProc      : ProcedureList ;
+   ExitValue          : INTEGER ;
+   isTerminating,
+   isHalting,
+   Initialized,
+   CallExit           : BOOLEAN ;
+
+
+(*
+   ConstructModules - resolve dependencies and then call each
+                      module constructor in turn.
+*)
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+BEGIN
+   M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+END ConstructModules ;
+
+
+(*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*)
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+BEGIN
+   M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+END DeconstructModules ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+BEGIN
+   M2Dependent.RegisterModule (name, init, fini, dependencies)
+END RegisterModule ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+   M2Dependent.RequestDependant (modulename, dependantmodule)
+END RequestDependant ;
+
+
+(*
+   ExecuteReverse - execute the procedure associated with procptr
+                    and then proceed to try and execute all previous
+                    procedures in the chain.
+*)
+
+PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
+BEGIN
+   WHILE procptr # NIL DO
+      procptr^.p ;  (* Invoke the procedure.  *)
+      procptr := procptr^.prev
+   END
+END ExecuteReverse ;
+
+
+(*
+   ExecuteTerminationProcedures - calls each installed termination procedure
+                                  in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+   ExecuteReverse (TerminateProc.tail)
+END ExecuteTerminationProcedures ;
+
+
+(*
+   ExecuteInitialProcedures - executes the initial procedures installed by
+                              InstallInitialProcedure.
+*)
+
+PROCEDURE ExecuteInitialProcedures ;
+BEGIN
+   ExecuteReverse (InitialProc.tail)
+END ExecuteInitialProcedures ;
+
+
+(*
+   AppendProc - append proc to the end of the procedure list
+                defined by proclist.
+*)
+
+PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
+VAR
+   pdes: ProcedureChain ;
+BEGIN
+   NEW (pdes) ;
+   WITH pdes^ DO
+      p := proc ;
+      prev := proclist.tail ;
+      next := NIL
+   END ;
+   IF proclist.head = NIL
+   THEN
+      proclist.head := pdes
+   END ;
+   proclist.tail := pdes ;
+   RETURN TRUE
+END AppendProc ;
+
+
+(*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE if the
+                                 procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+   RETURN AppendProc (TerminateProc, p)
+END InstallTerminationProcedure ;
+
+
+(*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the
+                             main program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+   RETURN AppendProc (InitialProc, p)
+END InstallInitialProcedure ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE HALT ([exitcode: INTEGER = -1]) <* noreturn *> ;
+BEGIN
+   IF exitcode#-1
+   THEN
+      CallExit := TRUE ;
+      ExitValue := exitcode
+   END ;
+   IF isHalting
+   THEN
+      (* double HALT found *)
+      exit(-1)
+   ELSE
+      isHalting := TRUE ;
+      ExecuteTerminationProcedures ;
+   END ;
+   IF CallExit
+   THEN
+      exit(ExitValue)
+   ELSE
+      abort
+   END
+END HALT ;
+
+
+(*
+   Terminate - provides compatibility for pim.  It call exit with
+               the exitcode provided in a prior call to ExitOnHalt
+               (or zero if ExitOnHalt was never called).  It does
+               not call ExecuteTerminationProcedures.
+*)
+
+PROCEDURE Terminate <* noreturn *> ;
+BEGIN
+   exit (ExitValue)
+END Terminate ;
+
+
+(*
+   ErrorString - writes a string to stderr.
+*)
+
+PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
+VAR
+   n: INTEGER ;
+BEGIN
+   n := write (2, ADR (a), StrLen (a))
+END ErrorString ;
+
+
+(*
+   ErrorMessage - emits an error message to stderr and then calls exit (1).
+*)
+
+PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
+                        file: ARRAY OF CHAR;
+                        line: CARDINAL;
+                        function: ARRAY OF CHAR) <* noreturn *> ;
+VAR
+   LineNo: ARRAY [0..10] OF CHAR ;
+BEGIN
+   ErrorString (file) ; ErrorString(':') ;
+   CardToStr (line, 0, LineNo) ;
+   ErrorString (LineNo) ; ErrorString(':') ;
+   IF NOT StrEqual (function, '')
+   THEN
+      ErrorString ('in ') ;
+      ErrorString (function) ;
+      ErrorString (' has caused ') ;
+   END ;
+   ErrorString (message) ;
+   LineNo[0] := nl ; LineNo[1] := nul ;
+   ErrorString (LineNo) ;
+   exit (1)
+END ErrorMessage ;
+
+
+(*
+   Halt - provides a more user friendly version of HALT, which takes
+          four parameters to aid debugging.
+*)
+
+PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+                function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
+BEGIN
+   ErrorMessage (description, file, line, function) ;
+   HALT
+END Halt ;
+
+
+(*
+   IsTerminating - Returns true if any coroutine has started program termination
+                   and false otherwise.
+*)
+
+PROCEDURE IsTerminating () : BOOLEAN ;
+BEGIN
+   RETURN isTerminating
+END IsTerminating ;
+
+
+(*
+   HasHalted - Returns true if a call to HALT has been made and false
+               otherwise.
+*)
+
+PROCEDURE HasHalted () : BOOLEAN ;
+BEGIN
+   RETURN isHalting
+END HasHalted ;
+
+
+(*
+   ErrorCharStar -
+*)
+
+PROCEDURE ErrorCharStar (a: ADDRESS) ;
+VAR
+   p: POINTER TO CHAR ;
+   n: INTEGER ;
+BEGIN
+   p := a ;
+   n := 0 ;
+   WHILE (p#NIL) AND (p^#nul) DO
+      INC(n) ;
+      INC(p)
+   END ;
+   IF n>0
+   THEN
+      n := write(2, a, n)
+   END
+END ErrorCharStar ;
+
+
+(*
+   ErrorMessageColumn - emits an error message to the stderr
+*)
+
+PROCEDURE ErrorMessageColumn (filename, scope, message: ADDRESS;
+                              line, column: CARDINAL) ;
+VAR
+   LineNo: ARRAY [0..10] OF CHAR ;
+BEGIN
+   ErrorCharStar(filename) ; ErrorString(':') ;
+   CardToStr(line, 0, LineNo) ;
+   ErrorString(LineNo) ; ErrorString(':') ;
+   CardToStr(column, 0, LineNo) ;
+   ErrorString(LineNo) ; ErrorString(':') ;
+   ErrorCharStar(scope) ; ErrorString(':') ;
+   ErrorCharStar(message) ;
+   LineNo[0] := nl ; LineNo[1] := nul ;
+   ErrorString(LineNo) ;
+   exit(1)
+END ErrorMessageColumn ;
+
+
+(*
+   ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*)
+
+PROCEDURE ExitOnHalt (e: INTEGER) ;
+BEGIN
+   ExitValue := e ;
+   CallExit := TRUE
+END ExitOnHalt ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Length (a: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   l, h: CARDINAL ;
+BEGIN
+   l := 0 ;
+   h := HIGH(a) ;
+   WHILE (l<=h) AND (a[l]#nul) DO
+      INC(l)
+   END ;
+   RETURN( l )
+END Length ;
+
+
+(*
+   The following are the runtime exception handler routines.
+*)
+
+PROCEDURE AssignmentException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END AssignmentException ;
+
+
+PROCEDURE ReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ReturnException ;
+
+
+PROCEDURE IncException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END IncException ;
+
+
+PROCEDURE DecException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END DecException ;
+
+
+PROCEDURE InclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END InclException ;
+
+
+PROCEDURE ExclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ExclException ;
+
+
+PROCEDURE ShiftException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ShiftException ;
+
+
+PROCEDURE RotateException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END RotateException ;
+
+
+PROCEDURE StaticArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise(ORD (M2EXCEPTION.indexException),
+                      filename, line, column, scope, message)
+END StaticArraySubscriptException ;
+
+
+PROCEDURE DynamicArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.indexException),
+                       filename, line, column, scope, message)
+END DynamicArraySubscriptException ;
+
+
+PROCEDURE ForLoopBeginException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ForLoopBeginException ;
+
+
+PROCEDURE ForLoopToException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ForLoopToException ;
+
+
+PROCEDURE ForLoopEndException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ForLoopEndException ;
+
+
+PROCEDURE PointerNilException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.invalidLocation),
+                       filename, line, column, scope, message)
+END PointerNilException ;
+
+
+PROCEDURE NoReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.functionException),
+                       filename, line, column, scope, message)
+END NoReturnException ;
+
+
+PROCEDURE CaseException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.caseSelectException),
+                       filename, line, column, scope, message)
+END CaseException ;
+
+
+PROCEDURE WholeNonPosDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeDivException),
+                       filename, line, column, scope, message)
+END WholeNonPosDivException ;
+
+
+PROCEDURE WholeNonPosModException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeDivException),
+                       filename, line, column, scope, message)
+END WholeNonPosModException ;
+
+
+PROCEDURE WholeZeroDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeDivException),
+                       filename, line, column, scope, message)
+END WholeZeroDivException ;
+
+
+PROCEDURE WholeZeroRemException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeDivException),
+                       filename, line, column, scope, message)
+END WholeZeroRemException ;
+
+
+PROCEDURE WholeValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeValueException),
+                       filename, line, column, scope, message)
+END WholeValueException ;
+
+
+PROCEDURE RealValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.realValueException),
+                       filename, line, column, scope, message)
+END RealValueException ;
+
+
+PROCEDURE ParameterException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ParameterException ;
+
+
+PROCEDURE NoException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.exException),
+                       filename, line, column, scope, message)
+END NoException ;
+
+
+(*
+   InitProcList - initialize the head and tail pointers to NIL.
+*)
+
+PROCEDURE InitProcList (VAR p: ProcedureList) ;
+BEGIN
+   p.head := NIL ;
+   p.tail := NIL
+END InitProcList ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   InitProcList (InitialProc) ;
+   InitProcList (TerminateProc) ;
+   ExitValue := 0 ;
+   isHalting := FALSE ;
+   CallExit := FALSE ;  (* default by calling abort *)
+   isTerminating := FALSE
+END Init ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE CheckInitialized ;
+BEGIN
+   IF NOT Initialized
+   THEN
+      Initialized := TRUE ;
+      Init
+   END
+END CheckInitialized ;
+
+
+BEGIN
+   (* Initialized := FALSE ;  is achieved though setting the bss section to zero.  *)
+   CheckInitialized
+END M2RTS.
diff --git a/gcc/m2/gm2-libs-iso/MemStream.def b/gcc/m2/gm2-libs-iso/MemStream.def
new file mode 100644
index 00000000000..6c6be6fdad9
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/MemStream.def
@@ -0,0 +1,120 @@
+(* MemStream.def provide a memory stream channel.
+
+Copyright (C) 2015-2021 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/>.  *)
+
+DEFINITION MODULE MemStream ;
+
+(*
+    Title      : MemStream
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Wed Jan 28 16:44:30 2015
+    Revision   : $Version$
+    Description: provides an ISO module which can write to a memory
+                 buffer or read from a memory buffer.
+*)
+
+FROM IOChan IMPORT ChanId ;
+FROM ChanConsts IMPORT FlagSet, OpenResults ;
+FROM SYSTEM IMPORT ADDRESS, LOC ;
+
+
+(*
+   Attempts to obtain and open a channel connected to a contigeous
+   buffer in memory.  The write flag is implied; without the raw
+   flag, text is implied.  If successful, assigns to cid the identity of
+   the opened channel, assigns the value opened to res.
+   If a channel cannot be opened as required,
+   the value of res indicates the reason, and cid identifies the
+   invalid channel.
+
+   The parameters, buffer, length and used maybe updated as
+   data is written.  The buffer maybe reallocated
+   and its address might alter, however the parameters will
+   always reflect the current active buffer.  When this
+   channel is closed the buffer is deallocated and
+   buffer will be set to NIL, length and used will be set to
+   zero.
+*)
+
+PROCEDURE OpenWrite (VAR cid: ChanId; flags: FlagSet;
+                     VAR res: OpenResults;
+                     VAR buffer: ADDRESS;
+                     VAR length: CARDINAL;
+                     VAR used: CARDINAL;
+                     deallocOnClose: BOOLEAN) ;
+
+
+(*
+   Attempts to obtain and open a channel connected to a contigeous
+   buffer in memory.  The read and old flags are implied; without
+   the raw flag, text is implied.  If successful, assigns to cid the
+   identity of the opened channel, assigns the value opened to res, and
+   selects input mode, with the read position corresponding to the start
+   of the buffer.  If a channel cannot be opened as required, the value of
+   res indicates the reason, and cid identifies the invalid channel.
+*)
+
+PROCEDURE OpenRead (VAR cid: ChanId; flags: FlagSet;
+                    VAR res: OpenResults;
+                    buffer: ADDRESS; length: CARDINAL;
+                    deallocOnClose: BOOLEAN) ;
+
+
+(*
+   Close - if the channel identified by cid is not open to
+           a memory stream, the exception wrongDevice is
+           raised; otherwise closes the channel, and assigns
+           the value identifying the invalid channel to cid.
+*)
+
+PROCEDURE Close (VAR cid: ChanId) ;
+
+
+(*
+   Rewrite - assigns the buffer index to zero.  Subsequent
+             writes will overwrite the previous buffer contents.
+*)
+
+PROCEDURE Rewrite (cid: ChanId) ;
+
+
+(*
+   Reread - assigns the buffer index to zero.  Subsequent
+            reads will read the previous buffer contents.
+*)
+
+PROCEDURE Reread (cid: ChanId) ;
+
+
+(*
+   IsMem - tests if the channel identified by cid is open as
+           a memory stream.
+*)
+
+PROCEDURE IsMem (cid: ChanId) : BOOLEAN ;
+
+
+END MemStream.
diff --git a/gcc/m2/gm2-libs-iso/MemStream.mod b/gcc/m2/gm2-libs-iso/MemStream.mod
new file mode 100644
index 00000000000..8e8c1da8e56
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/MemStream.mod
@@ -0,0 +1,748 @@
+(* MemStream.mod provide a memory stream channel.
+
+Copyright (C) 2015-2021 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/>.  *)
+
+IMPLEMENTATION MODULE MemStream ;
+
+
+FROM RTgen IMPORT ChanDev, DeviceType,
+                  InitChanDev, doLook, doSkip, doSkipLook, doWriteLn,
+                  doReadText, doWriteText, doReadLocs, doWriteLocs,
+                  checkErrno ;
+
+FROM RTdata IMPORT ModuleId, MakeModuleId, InitData, GetData, KillData ;
+
+FROM IOLink IMPORT DeviceId, DeviceTablePtr, IsDevice, MakeChan, UnMakeChan,
+                   DeviceTablePtrValue, RAISEdevException, AllocateDeviceId,
+                   ResetProc ;
+
+FROM Builtins IMPORT memcpy ;
+FROM Assertion IMPORT Assert ;
+FROM Strings IMPORT Assign ;
+FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
+FROM FIO IMPORT File ;
+FROM IOConsts IMPORT ReadResults ;
+FROM ChanConsts IMPORT readFlag, writeFlag ;
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM ASCII IMPORT nl, nul ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE, REALLOCATE ;
+FROM libc IMPORT printf ;
+
+IMPORT SYSTEM, RTio, errno, ErrnoCategory, ChanConsts, IOChan ;
+
+
+CONST
+   InitialLength = 128 ;
+   Debugging     = FALSE ;
+
+TYPE
+   PtrToLoc      = POINTER TO LOC ;
+   PtrToChar     = POINTER TO CHAR ;
+   PtrToAddress  = POINTER TO ADDRESS ;
+   PtrToCardinal = POINTER TO CARDINAL ;
+   MemInfo       = POINTER TO RECORD
+                                 buffer: ADDRESS ;
+                                 length: CARDINAL ;
+                                 index : CARDINAL ;
+                                 pBuffer: PtrToAddress ;
+                                 pLength: PtrToCardinal ;
+                                 pUsed  : PtrToCardinal ;
+                                 dealloc: BOOLEAN ;
+                                 eof    : BOOLEAN ;
+                                 eoln   : BOOLEAN ;
+                              END ;
+
+VAR
+   dev: ChanDev ;
+   did: DeviceId ;
+   mid: ModuleId ;
+
+
+(*
+   Min -
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+PROCEDURE look (d: DeviceTablePtr;
+                VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doLook(dev, d, ch, r)
+END look ;
+
+
+PROCEDURE skip (d: DeviceTablePtr) ;
+BEGIN
+   doSkip(dev, d)
+END skip ;
+
+
+PROCEDURE skiplook (d: DeviceTablePtr;
+                    VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doSkipLook(dev, d, ch, r)
+END skiplook ;
+
+
+PROCEDURE lnwrite (d: DeviceTablePtr) ;
+BEGIN
+   doWriteLn(dev, d)
+END lnwrite ;
+
+
+PROCEDURE textread (d: DeviceTablePtr;
+                    to: SYSTEM.ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+BEGIN
+   doReadText(dev, d, to, maxChars, charsRead)
+END textread ;
+
+
+PROCEDURE textwrite (d: DeviceTablePtr;
+                     from: SYSTEM.ADDRESS;
+                     charsToWrite: CARDINAL);
+BEGIN
+   doWriteText(dev, d, from, charsToWrite)
+END textwrite ;
+
+
+PROCEDURE rawread (d: DeviceTablePtr;
+                   to: SYSTEM.ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+BEGIN
+   doReadLocs(dev, d, to, maxLocs, locsRead)
+END rawread ;
+
+
+PROCEDURE rawwrite (d: DeviceTablePtr;
+                    from: SYSTEM.ADDRESS;
+                    locsToWrite: CARDINAL) ;
+BEGIN
+   doWriteLocs(dev, d, from, locsToWrite)
+END rawwrite ;
+
+
+PROCEDURE getname (d: DeviceTablePtr;
+                   VAR a: ARRAY OF CHAR) ;
+BEGIN
+   Assign('memstream', a)
+END getname ;
+
+
+PROCEDURE flush (d: DeviceTablePtr) ;
+BEGIN
+   (* nothing to do *)
+END flush ;
+
+
+(*
+   doreadchar - returns a CHAR from the file associated with, g.
+*)
+
+PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+VAR
+   m : MemInfo ;
+   pc: PtrToChar ;
+BEGIN
+   WITH d^ DO
+      m := GetData(d, mid) ;
+      WITH m^ DO
+         IF index<length
+         THEN
+            pc := buffer ;
+            INC(pc, index) ;
+            INC(index) ;
+            AssignIndex(m, index) ;
+            eoln := (pc^=nl) ;
+            eof := FALSE ;
+            RETURN( pc^ )
+         ELSE
+            eof := TRUE ;
+            eoln := FALSE ;
+            RETURN( nul )
+         END
+      END
+   END
+END doreadchar ;
+
+
+(*
+   dounreadchar - pushes a CHAR back onto the file associated with, g.
+*)
+
+PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+VAR
+   m : MemInfo ;
+   pc: PtrToChar ;
+BEGIN
+   WITH d^ DO
+      m := GetData(d, mid) ;
+      WITH m^ DO
+         IF index>0
+         THEN
+            DEC(index) ;
+            AssignIndex(m, index) ;
+            eof := FALSE ;
+            pc := buffer ;
+            INC(pc, index) ;
+            eoln := (ch=nl) ;
+            Assert(pc^=ch)    (* expecting to be pushing characters in exactly the reverse order *)
+         ELSE
+            Assert(FALSE) ;  (* expecting to be pushing characters in exactly the reverse order *)
+         END
+      END ;
+      RETURN( ch )
+   END
+END dounreadchar ;
+
+
+(*
+   dogeterrno - always return 0 as the memstream device never invokes errno.
+*)
+
+PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+BEGIN
+   RETURN 0
+END dogeterrno ;
+
+
+(*
+   dorbytes - reads upto, max, bytes setting, actual, and
+              returning FALSE if an error (not due to eof)
+              occurred.
+*)
+
+PROCEDURE dorbytes (g: GenDevIF; d: DeviceTablePtr;
+                    to: ADDRESS;
+                    max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   m : MemInfo ;
+   pl: PtrToLoc ;
+BEGIN
+   WITH d^ DO
+      m := GetData(d, mid) ;
+      WITH m^ DO
+         pl := buffer ;
+         INC(pl, index) ;
+         actual := Min(max, length-index) ;
+         to := memcpy(to, pl, actual) ;
+         INC(index, actual) ;
+         AssignIndex(m, index) ;
+         eof := FALSE ;
+         eoln := FALSE
+      END ;
+      RETURN( TRUE )
+   END
+END dorbytes ;
+
+
+(*
+   dowbytes -
+*)
+
+PROCEDURE dowbytes (g: GenDevIF; d: DeviceTablePtr;
+                    from: ADDRESS;
+                    nBytes: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   m : MemInfo ;
+   pl: PtrToLoc ;
+BEGIN
+   WITH d^ DO
+      m := GetData(d, mid) ;
+      WITH m^ DO
+         IF index+nBytes>length
+         THEN
+            WHILE index+nBytes>length DO
+               (* buffer needs to grow *)
+               length := length*2
+            END ;
+            REALLOCATE(buffer, length) ;
+            AssignLength(m, length) ;
+            AssignBuffer(m, buffer)
+         END ;
+         pl := buffer ;
+         INC(pl, index) ;
+         actual := Min(nBytes, length-index) ;
+         pl := memcpy(pl, from, actual) ;
+         INC(index, actual) ;
+         AssignIndex(m, index)
+      END ;
+      RETURN( TRUE )
+   END
+END dowbytes ;
+
+
+(*
+   dowriteln - attempt to write an end of line marker to the
+               file and returns TRUE if successful.
+*)
+
+PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   ch: CHAR ;
+   n : CARDINAL ;
+BEGIN
+   ch := nl ;
+   RETURN( dowbytes(g, d, ADR(ch), SIZE(ch), n) )
+END dowriteln ;
+
+
+(*
+   iseof - returns TRUE if end of file has been seen.
+*)
+
+PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   m: MemInfo ;
+BEGIN
+   IF Debugging
+   THEN
+      printf ("mid = %p, d = %p\n", mid, d)
+   END ;
+   WITH d^ DO
+      IF Debugging
+      THEN
+         printf ("mid = %p, d = %p\n", mid, d)
+      END ;
+      m := GetData(d, mid) ;
+      RETURN( m^.eof )
+   END
+END iseof ;
+
+
+(*
+   iseoln - returns TRUE if end of line is seen.
+*)
+
+PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   m: MemInfo ;
+BEGIN
+   WITH d^ DO
+      m := GetData(d, mid) ;
+      RETURN( m^.eoln )
+   END
+END iseoln ;
+
+
+(*
+   iserror - returns TRUE if an error was seen on the device.
+*)
+
+PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RETURN( FALSE )
+END iserror ;
+
+
+(*
+   AssignLength -
+*)
+
+PROCEDURE AssignLength (m: MemInfo; l: CARDINAL) ;
+BEGIN
+   WITH m^ DO
+      length := l ;
+      IF pLength#NIL
+      THEN
+         pLength^ := l
+      END
+   END
+END AssignLength ;
+
+
+(*
+   AssignBuffer -
+*)
+
+PROCEDURE AssignBuffer (m: MemInfo; b: ADDRESS) ;
+BEGIN
+   WITH m^ DO
+      buffer := b ;
+      IF pBuffer#NIL
+      THEN
+         pBuffer^ := b
+      END
+   END
+END AssignBuffer ;
+
+
+(*
+   AssignIndex -
+*)
+
+PROCEDURE AssignIndex (m: MemInfo; i: CARDINAL) ;
+BEGIN
+   WITH m^ DO
+      index := i ;
+      IF pUsed#NIL
+      THEN
+         pUsed^ := i
+      END
+   END
+END AssignIndex ;
+
+
+(*
+   newCidWrite - returns a ChanId which represents the opened file, name.
+                 res is set appropriately on return.
+*)
+
+PROCEDURE newCidWrite (f: FlagSet;
+                       VAR res: OpenResults;
+                       VAR buffer: ADDRESS;
+                       VAR length: CARDINAL;
+                       VAR used: CARDINAL;
+                       deallocOnClose: BOOLEAN) : ChanId ;
+VAR
+   c: ChanId ;
+   d: DeviceTablePtr ;
+   m: MemInfo ;
+BEGIN
+   MakeChan(did, c) ;
+   d := DeviceTablePtrValue(c, did) ;
+   NEW(m) ;
+   m^.pBuffer := ADR(buffer) ;
+   m^.pLength := ADR(length) ;
+   m^.pUsed := ADR(used) ;
+   m^.dealloc := deallocOnClose ;
+   ALLOCATE(m^.buffer, InitialLength) ;
+   AssignBuffer(m, m^.buffer) ;
+   AssignLength(m, InitialLength) ;
+   AssignIndex(m, 0) ;
+   InitData(d, mid, m, freeMemInfo) ;
+   WITH d^ DO
+      flags := f ;
+      errNum := 0 ;
+      doLook := look ;
+      doSkip := skip ;
+      doSkipLook := skiplook ;
+      doLnWrite := lnwrite ;
+      doTextRead := textread ;
+      doTextWrite := textwrite ;
+      doRawRead := rawread ;
+      doRawWrite := rawwrite ;
+      doGetName := getname ;
+      doReset := resetWrite ;
+      doFlush := flush ;
+      doFree := handlefree
+   END ;
+   res := opened ;
+   RETURN( c )
+END newCidWrite ;
+
+
+(*
+   Attempts to obtain and open a channel connected to a contigeous
+   buffer in memory.  The write flag is implied; without the raw
+   flag, text is implied.  If successful, assigns to cid the identity of
+   the opened channel, assigns the value opened to res.
+   If a channel cannot be opened as required,
+   the value of res indicates the reason, and cid identifies the
+   invalid channel.
+
+   The parameters, buffer, length and used maybe updated as
+   data is written.  The buffer maybe reallocated
+   and its address might alter, however the parameters will
+   always reflect the current active buffer.  When this
+   channel is closed the buffer is deallocated and
+   buffer will be set to NIL, length and used will be set to
+   zero.
+*)
+
+PROCEDURE OpenWrite (VAR cid: ChanId; flags: FlagSet;
+                     VAR res: OpenResults;
+                     VAR buffer: ADDRESS;
+                     VAR length: CARDINAL;
+                     VAR used: CARDINAL;
+                     deallocOnClose: BOOLEAN) ;
+BEGIN
+   IF Debugging
+   THEN
+      printf ("OpenWrite called\n")
+   END ;
+   INCL(flags, ChanConsts.writeFlag) ;
+   IF NOT (ChanConsts.rawFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.textFlag)
+   END ;
+   cid := newCidWrite(flags, res, buffer, length, used, deallocOnClose)
+END OpenWrite ;
+
+
+(*
+   newCidRead - returns a ChanId which represents the opened file, name.
+                res is set appropriately on return.
+*)
+
+PROCEDURE newCidRead (f: FlagSet;
+                      VAR res: OpenResults;
+                      buffer: ADDRESS;
+                      length: CARDINAL;
+                      deallocOnClose: BOOLEAN) : ChanId ;
+VAR
+   c: ChanId ;
+   d: DeviceTablePtr ;
+   m: MemInfo ;
+BEGIN
+   MakeChan(did, c) ;
+   d := DeviceTablePtrValue(c, did) ;
+   NEW(m) ;
+   m^.pBuffer := NIL ;
+   m^.pLength := NIL ;
+   m^.pUsed := NIL ;
+   m^.dealloc := deallocOnClose ;
+   AssignBuffer(m, buffer) ;
+   AssignLength(m, length) ;
+   AssignIndex(m, 0) ;
+   InitData(d, mid, m, freeMemInfo) ;
+   WITH d^ DO
+      flags := f ;
+      errNum := 0 ;
+      doLook := look ;
+      doSkip := skip ;
+      doSkipLook := skiplook ;
+      doLnWrite := lnwrite ;
+      doTextRead := textread ;
+      doTextWrite := textwrite ;
+      doRawRead := rawread ;
+      doRawWrite := rawwrite ;
+      doGetName := getname ;
+      doReset := resetRead ;
+      doFlush := flush ;
+      doFree := handlefree
+   END ;
+   res := opened ;
+   RETURN( c )
+END newCidRead ;
+
+
+(*
+   freeMemInfo -
+*)
+
+PROCEDURE freeMemInfo (a: ADDRESS) ;
+VAR
+   m: MemInfo ;
+BEGIN
+   DEALLOCATE(a, SIZE(m^))
+END freeMemInfo ;
+
+
+(*
+   Attempts to obtain and open a channel connected to a contigeous
+   buffer in memory.  The read and old flags are implied; without
+   the raw flag, text is implied.  If successful, assigns to cid the
+   identity of the opened channel, assigns the value opened to res, and
+   selects input mode, with the read position corresponding to the start
+   of the buffer.  If a channel cannot be opened as required, the value of
+   res indicates the reason, and cid identifies the invalid channel.
+*)
+
+PROCEDURE OpenRead (VAR cid: ChanId; flags: FlagSet;
+                    VAR res: OpenResults;
+                    buffer: ADDRESS; length: CARDINAL;
+                    deallocOnClose: BOOLEAN) ;
+BEGIN
+   flags := flags + ChanConsts.read + ChanConsts.old ;
+   IF NOT (ChanConsts.rawFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.textFlag)
+   END ;
+   cid := newCidRead(flags, res, buffer, length, deallocOnClose)
+END OpenRead ;
+
+
+(*
+   resetRead - wrap a call to Reread.
+*)
+
+PROCEDURE resetRead (d: DeviceTablePtr) ;
+BEGIN
+   Reread(d^.cid)
+END resetRead ;
+
+
+(*
+   resetWrite - wrap a call to Rewrite.
+*)
+
+PROCEDURE resetWrite (d: DeviceTablePtr) ;
+BEGIN
+   Rewrite(d^.cid)
+END resetWrite ;
+
+
+(*
+   Reread - if the channel identified by cid is not open
+            to a memory stream, the exception
+            wrongDevice is raised; otherwise it sets the
+            index to 0.  Subsequent reads will read the
+            previous buffer contents.
+*)
+
+PROCEDURE Reread (cid: ChanId) ;
+VAR
+   d: DeviceTablePtr ;
+   m: MemInfo ;
+BEGIN
+   IF IsMem(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      WITH d^ DO
+         EXCL(flags, writeFlag) ;
+         IF readFlag IN flags
+         THEN
+            m := GetData(d, mid) ;
+            AssignIndex(m, 0)
+         ELSE
+            EXCL(flags, readFlag)
+         END
+      END
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'MemStream.' + __FUNCTION__ +
+                        ': channel is not a memory stream')
+   END
+END Reread ;
+
+
+(*
+   Rewrite - if the channel identified by cid is not open to a
+             memory stream, the exception wrongDevice
+             is raised; otherwise, it sets the index to 0.
+             Subsequent writes will overwrite the previous buffer
+             contents.
+*)
+
+PROCEDURE Rewrite (cid: ChanId) ;
+VAR
+   d: DeviceTablePtr ;
+   m: MemInfo ;
+BEGIN
+   IF IsMem(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      WITH d^ DO
+         EXCL(flags, readFlag) ;
+         IF writeFlag IN flags
+         THEN
+            m := GetData(d, mid) ;
+            AssignIndex(m, 0)
+         ELSE
+            EXCL(flags, writeFlag)
+         END
+      END
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'MemStream.' + __FUNCTION__ +
+                        ': channel is not a memory stream')
+   END
+END Rewrite ;
+
+
+(*
+   handlefree -
+*)
+
+PROCEDURE handlefree (d: DeviceTablePtr) ;
+BEGIN
+END handlefree ;
+
+
+(*
+   Close - if the channel identified by cid is not open to a sequential
+           stream, the exception wrongDevice is raised; otherwise
+           closes the channel, and assigns the value identifying
+           the invalid channel to cid.
+*)
+
+PROCEDURE Close (VAR cid: ChanId) ;
+BEGIN
+   printf ("Close called\n");
+   IF IsMem(cid)
+   THEN
+      UnMakeChan(did, cid) ;
+      cid := IOChan.InvalidChan()
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'MemStream.' + __FUNCTION__ +
+                        ': channel is not a sequential file')
+   END
+END Close ;
+
+
+(*
+   IsMem - tests if the channel identified by cid is open as
+           a memory stream.
+*)
+
+PROCEDURE IsMem (cid: ChanId) : BOOLEAN ;
+BEGIN
+   RETURN( (cid # NIL) AND (IOChan.InvalidChan() # cid) AND
+           (IsDevice(cid, did)) AND
+           ((ChanConsts.readFlag IN IOChan.CurrentFlags(cid)) OR
+            (ChanConsts.writeFlag IN IOChan.CurrentFlags(cid))) )
+END IsMem ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+VAR
+   gen: GenDevIF ;
+BEGIN
+   MakeModuleId(mid) ;
+   IF Debugging
+   THEN
+      printf ("mid = %d\n", mid)
+   END ;
+   AllocateDeviceId(did) ;
+   gen := InitGenDevIF(did, doreadchar, dounreadchar,
+                       dogeterrno, dorbytes, dowbytes,
+                       dowriteln,
+                       iseof, iseoln, iserror) ;
+   dev := InitChanDev(streamfile, did, gen)
+END Init ;
+
+
+BEGIN
+   Init
+END MemStream.
diff --git a/gcc/m2/gm2-libs-iso/Preemptive.def b/gcc/m2/gm2-libs-iso/Preemptive.def
new file mode 100644
index 00000000000..6750dcefe3f
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Preemptive.def
@@ -0,0 +1,38 @@
+(* Preemptive.def provides the Processes module with a premptive scheduler.
+
+Copyright (C) 2020-2021 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/>.  *)
+
+DEFINITION MODULE Preemptive ;
+
+
+(*
+   initPreemptive - if microsecs > 0 then turn on preemptive scheduling.
+                    if microsecs = 0 then preemptive scheduling is turned off.
+*)
+
+PROCEDURE initPreemptive (seconds, microsecs: CARDINAL) ;
+
+
+END Preemptive.
diff --git a/gcc/m2/gm2-libs-iso/Preemptive.mod b/gcc/m2/gm2-libs-iso/Preemptive.mod
new file mode 100644
index 00000000000..59940b6bae8
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Preemptive.mod
@@ -0,0 +1,125 @@
+(* Premptive.mod provides the Processes module with a premptive scheduler.
+
+Copyright (C) 2020 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/>.  *)
+
+IMPLEMENTATION MODULE Preemptive ;
+
+FROM COROUTINES IMPORT TurnInterrupts, PROTECTION ;
+FROM Processes IMPORT Wait, Attach, Detach, Create, ProcessId, Urgency, Activate, SuspendMe ;
+FROM RTint IMPORT InitTimeVector, ReArmTimeVector, IncludeVector, ExcludeVector ;
+FROM libc IMPORT printf ;
+
+CONST
+   debugging = FALSE ;
+
+(*
+   timer - the timer process which runs at maximum scheduling priority with
+           interrupts off.  It sleeps for a time quantum, performs a Wait
+           which will rotate the ready queue and then Waits again.
+*)
+
+PROCEDURE timer ;
+VAR
+   vec,
+   currentUsec,
+   currentSec : CARDINAL ;
+   old        : PROTECTION ;
+BEGIN
+   IF debugging
+   THEN
+      printf ("timer\n");
+   END ;
+   old := TurnInterrupts (MAX (PROTECTION)) ;
+   vec := InitTimeVector (timeSliceUsec, timeSliceSec, MAX (PROTECTION)) ;
+   IF debugging
+   THEN
+      printf ("attach\n");
+   END ;
+   Attach (vec) ;  (* attach vector to this process.  *)
+   IF debugging
+   THEN
+      printf ("include vec\n");
+   END ;
+   IncludeVector (vec) ;
+   LOOP
+      currentSec := timeSliceSec ;
+      currentUsec := timeSliceUsec ;
+      IF debugging
+      THEN
+         printf ("timer process about to Wait\n");
+      END ;
+      Wait ;
+      (*
+      printf ("yes 2 seconds elapsed, suspending\n");
+      SuspendMe ;
+      *)
+      IF debugging
+      THEN
+         printf ("timer process wakes up, now calling ReArmTimeVector\n");
+      END ;
+      ReArmTimeVector (vec, timeSliceUsec, timeSliceSec) ;
+      IF debugging
+      THEN
+         printf ("ReArmTimeVector complete\n");
+         printf ("attach\n");
+      END ;
+      Attach (vec) ;  (* attach vector to this process.  *)
+      IF debugging
+      THEN
+         printf ("finished attach, now include vec\n");
+      END ;
+      IncludeVector (vec) ;
+   END
+END timer ;
+
+
+(*
+   initPreemptive - if millisecs > 0 then turn on preemptive scheduling.
+                    if millisecs = 0 then preemptive scheduling is turned off.
+*)
+
+PROCEDURE initPreemptive (seconds, microsecs: CARDINAL) ;
+BEGIN
+   timeSliceUsec := microsecs ;
+   timeSliceSec := seconds ;
+   IF NOT init
+   THEN
+      init := TRUE ;
+      Create (timer, 10000000, MAX (Urgency), NIL, timerId) ;
+      Activate (timerId)
+   END
+END initPreemptive ;
+
+
+VAR
+   init        : BOOLEAN ;
+   timerId     : ProcessId ;
+   timeSliceSec,
+   timeSliceUsec: CARDINAL ;
+BEGIN
+   init := FALSE ;
+   timeSliceSec := 0 ;
+   timeSliceUsec := 0
+END Preemptive.
diff --git a/gcc/m2/gm2-libs-iso/Processes.def b/gcc/m2/gm2-libs-iso/Processes.def
new file mode 100644
index 00000000000..7a4b48fa461
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Processes.def
@@ -0,0 +1,159 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE Processes;
+
+  (* This module allows concurrent algorithms to be expressed using
+     processes. A process is a unit of a program that has the
+     potential to run in parallel with other processes.
+  *)
+
+IMPORT SYSTEM;
+
+TYPE
+  ProcessId;                      (* Used to identify processes *)
+  Parameter     = SYSTEM.ADDRESS; (* Used to pass data between processes *)
+  Body          = PROC;           (* Used as the type of a process body *)
+  Urgency       = INTEGER;        (* Used by the internal scheduler *)
+  Sources       = CARDINAL;       (* Used to identify event sources *)
+  ProcessesExceptions =           (* Exceptions raised by this module *)
+    (passiveProgram, processError);
+
+(* The following procedures create processes and switch control between
+   them. *)
+
+PROCEDURE Create (procBody: Body; extraSpace: CARDINAL; procUrg: Urgency;
+                  procParams: Parameter; VAR procId: ProcessId);
+  (* Creates a new process with procBody as its body, and with urgency
+     and parameters given by procUrg and procParams.  At least as
+     much workspace (in units of SYSTEM.LOC) as is specified by
+     extraSpace is allocated to the process.
+     An identity for the new process is returned in procId.
+     The process is created in the passive state; it will not run
+     until activated.
+  *)
+
+PROCEDURE Start (procBody: Body; extraSpace: CARDINAL; procUrg: Urgency;
+                 procParams: Parameter; VAR procId: ProcessId);
+  (* Creates a new process, with parameters as for Create.
+     The process is created in the ready state; it is eligible to
+     run immediately.
+  *)
+
+PROCEDURE StopMe ();
+  (* Terminates the calling process.
+     The process must not be associated with a source of events.
+  *)
+
+PROCEDURE SuspendMe ();
+  (* Causes the calling process to enter the passive state.  The
+     procedure only returns when the calling process is again
+     activated by another process.
+  *)
+
+PROCEDURE Activate (procId: ProcessId);
+  (* Causes the process identified by procId to enter the ready
+     state, and thus to become eligible to run again.
+  *)
+
+PROCEDURE SuspendMeAndActivate (procId: ProcessId);
+  (* Executes an atomic sequence of SuspendMe() and
+     Activate(procId). *)
+
+PROCEDURE Switch (procId: ProcessId; VAR info: Parameter);
+  (* Causes the calling process to enter the passive state; the
+     process identified by procId becomes the currently executing
+     process.  info is used to pass parameter information from the
+     calling to the activated process.  On return, info will
+     contain information from the process that chooses to switch
+     back to this one (or will be NIL if Activate or
+     SuspendMeAndActivate are used instead of Switch).
+  *)
+
+PROCEDURE Wait ();
+  (* Causes the calling process to enter the waiting state.
+     The procedure will return when the calling process is
+     activated by another process, or when one of its associated
+     eventSources has generated an event.
+  *)
+
+(* The following procedures allow the association of processes
+   with sources of external events.
+*)
+
+PROCEDURE Attach (eventSource: Sources);
+  (* Associates the specified eventSource with the calling
+     process. *)
+
+PROCEDURE Detach (eventSource: Sources);
+  (* Dissociates the specified eventSource from the program. *)
+
+PROCEDURE IsAttached (eventSource: Sources): BOOLEAN;
+  (* Returns TRUE if and only if the specified eventSource is
+     currently associated with one of the processes of the
+     program.
+  *)
+
+PROCEDURE Handler (eventSource: Sources): ProcessId;
+  (* Returns the identity of the process, if any, that is
+     associated with the specified eventSource.
+  *)
+
+(* The following procedures allow processes to obtain their
+   identity, parameters, and urgency.
+*)
+
+PROCEDURE Me (): ProcessId;
+  (* Returns the identity of the calling process (as assigned
+     when the process was first created).
+  *)
+
+PROCEDURE MyParam (): Parameter;
+  (* Returns the value specified as procParams when the calling
+     process was created. *)
+
+PROCEDURE UrgencyOf (procId: ProcessId): Urgency;
+  (* Returns the urgency established when the process identified
+     by procId was first created.
+  *)
+
+(* The following procedure provides facilities for exception
+   handlers. *)
+
+PROCEDURE ProcessesException (): ProcessesExceptions;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of a language exception, returns the
+     corresponding enumeration value, and otherwise raises an
+     exception.
+  *)
+
+PROCEDURE IsProcessesException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in
+     a routine from this module; otherwise returns FALSE.
+  *)
+
+(*
+   Reschedule - rotates the ready queue and transfers to the process
+                with the highest run priority.
+*)
+
+PROCEDURE Reschedule ;
+
+
+(*
+   displayProcesses -
+*)
+
+PROCEDURE displayProcesses (message: ARRAY OF CHAR) ;
+
+
+END Processes.
diff --git a/gcc/m2/gm2-libs-iso/Processes.mod b/gcc/m2/gm2-libs-iso/Processes.mod
new file mode 100644
index 00000000000..4eb5fbf1d42
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Processes.mod
@@ -0,0 +1,730 @@
+(* Processes.mod implement the ISO Processes specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Processes ;
+
+FROM Assertion IMPORT Assert ;
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM COROUTINES IMPORT COROUTINE, NEWCOROUTINE, TRANSFER, IOTRANSFER, CURRENT, ATTACH, DETACH, IsATTACHED, HANDLER, LISTEN, ListenLoop ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM RTExceptions IMPORT IsInExceptionState, GetExceptionBlock, GetNumber, Raise ;
+FROM M2EXCEPTION IMPORT M2Exceptions ;
+FROM M2RTS IMPORT NoException ;
+
+FROM EXCEPTIONS IMPORT ExceptionSource, RAISE, AllocateSource, CurrentNumber,
+                       IsCurrentSource, IsExceptionalExecution ;
+
+FROM libc IMPORT printf ;
+
+
+CONST
+   defaultSpace = 1024 * 1024 * 8 ;
+   debugging    = FALSE ;
+
+
+(* The following procedures create processes and switch control between
+   them. *)
+
+TYPE
+   ProcessId = POINTER TO RECORD
+                             body       : Body ;
+                             workSpace  : CARDINAL ;
+                             stack      : ADDRESS ;
+                             urgency    : Urgency ;
+                             context    : COROUTINE ;
+                             params     : Parameter ;
+                             state      : Status ;
+                             right, left: ProcessId ;
+                          END ;
+
+   Status = (ready, waiting, passive, dead) ;
+
+VAR
+   process  : ExceptionSource ;
+   pQueue   : ARRAY Status OF ProcessId ;
+   free,
+   idleId,
+   currentId: ProcessId ;
+
+
+(*
+   New - assigns, p, to a new ProcessId.
+*)
+
+PROCEDURE New (VAR p: ProcessId) ;
+BEGIN
+   IF free=NIL
+   THEN
+      NEW (p)
+   ELSE
+      p := free ;
+      free := free^.right
+   END
+END New ;
+
+
+(*
+   Dispose - returns, p, to the free list.
+*)
+
+PROCEDURE Dispose (VAR p: ProcessId) ;
+BEGIN
+   p^.right := free ;
+   free := p
+END Dispose ;
+
+
+(*
+   add - adds process, p, to queue, head.
+*)
+
+PROCEDURE add (VAR head: ProcessId; p: ProcessId) ;
+BEGIN
+   IF head=NIL
+   THEN
+      head := p ;
+      p^.left := p ;
+      p^.right := p
+   ELSE
+      p^.right := head ;
+      p^.left := head^.left ;
+      head^.left^.right := p ;
+      head^.left := p
+   END
+END add ;
+
+
+(*
+   sub - subtracts process, p, from queue, head.
+*)
+
+PROCEDURE sub (VAR head: ProcessId; p: ProcessId) ;
+BEGIN
+   IF (p^.left=head) AND (p=head)
+   THEN
+      head := NIL
+   ELSE
+      IF head=p
+      THEN
+         head := head^.right
+      END ;
+      p^.left^.right := p^.right ;
+      p^.right^.left := p^.left
+   END
+END sub ;
+
+
+(*
+   Add - adds, p, to the appropriate queue.
+*)
+
+PROCEDURE Add (p: ProcessId) ;
+BEGIN
+   add (pQueue[p^.state], p)
+END Add ;
+
+
+(*
+   Remove - remove, p, from the appropriate queue.
+*)
+
+PROCEDURE Remove (p: ProcessId) ;
+BEGIN
+   sub (pQueue[p^.state], p)
+END Remove ;
+
+
+(*
+   OnDeadQueue - removes process, p, from the queue and adds it
+                 to the dead queue.
+*)
+
+PROCEDURE OnDeadQueue (p: ProcessId) ;
+BEGIN
+   Remove (p) ;
+   p^.state := dead ;
+   Add (p)
+END OnDeadQueue ;
+
+
+(*
+   OnReadyQueue - removes process, p, from the queue and adds it
+                  to the ready queue.
+*)
+
+PROCEDURE OnReadyQueue (p: ProcessId) ;
+BEGIN
+   Remove (p) ;
+   p^.state := ready ;
+   Add (p)
+END OnReadyQueue ;
+
+
+(*
+   OnPassiveQueue - removes process, p, from the queue and adds it
+                    to the passive queue.
+*)
+
+PROCEDURE OnPassiveQueue (p: ProcessId) ;
+BEGIN
+   Remove (p) ;
+   p^.state := passive ;
+   Add (p)
+END OnPassiveQueue ;
+
+
+(*
+   OnWaitingQueue - removes process, p, from the queue and adds it
+                    to the waiting queue.
+*)
+
+PROCEDURE OnWaitingQueue (p: ProcessId) ;
+BEGIN
+   Remove (p) ;
+   p^.state := waiting ;
+   Add (p)
+END OnWaitingQueue ;
+
+
+(*
+   checkDead - check to see if any processes are on the dead queue
+               and if they are not the current process deallocate
+               resources.
+*)
+
+PROCEDURE checkDead ;
+VAR
+   p: ProcessId ;
+BEGIN
+   p := pQueue[dead] ;
+   WHILE (p#NIL) AND (p#currentId) DO
+      Remove (p) ;
+      WITH p^ DO
+         IF stack#NIL
+         THEN
+            DEALLOCATE (stack, workSpace)
+         END
+      END ;
+      Dispose (p) ;
+      p := pQueue[dead]
+   END
+END checkDead ;
+
+
+(*
+   RotateReady - rotate the ready queue, as an attempt to introduce some scheduling fairness.
+*)
+
+PROCEDURE RotateReady ;
+BEGIN
+   IF pQueue[ready] # NIL
+   THEN
+      pQueue[ready] := pQueue[ready]^.right
+   END
+END RotateReady ;
+
+
+(*
+   chooseProcess -
+*)
+
+PROCEDURE chooseProcess () : ProcessId ;
+VAR
+   p,
+   best,
+   head: ProcessId ;
+BEGIN
+   head := pQueue[ready] ;
+   best := NIL ;
+   p := head ;
+   REPEAT
+      IF (best = NIL) OR (p^.urgency >= best^.urgency)
+      THEN
+         best := p
+      END ;
+      p := p^.right
+   UNTIL p=head ;
+   Assert (best # NIL) ;
+   Assert (best^.state = ready) ;
+   RETURN best
+END chooseProcess ;
+
+
+(*
+   Reschedule - rotates the ready queue and transfers to the process with the highest
+                run priority.
+*)
+
+PROCEDURE Reschedule ;
+VAR
+   p,
+   best: ProcessId ;
+BEGIN
+   checkDead ;
+   RotateReady ;
+   best := chooseProcess () ;
+   IF best#currentId
+   THEN
+      IF debugging
+      THEN
+         displayProcesses ("Reschedule")
+      END ;
+      (* the best process to run is different to the current process, so switch.  *)
+      p := currentId ;
+      currentId := best ;
+      TRANSFER (p^.context, currentId^.context)
+   END
+END Reschedule ;
+
+
+(*
+   Create - creates a new process with procBody as its body,
+            and with urgency and parameters given by procUrg
+            and procParams.  At least as much workspace (in
+            units of SYSTEM.LOC) as is specified by extraSpace
+            is allocated to the process.  An identity for the
+            new process is returned in procId.  The process is
+            created in the passive state; it will not run
+            until activated.
+*)
+
+PROCEDURE Create (procBody: Body; extraSpace: CARDINAL; procUrg: Urgency;
+                  procParams: Parameter; VAR procId: ProcessId) ;
+BEGIN
+   New (procId) ;
+   WITH procId^ DO
+      body      := procBody ;
+      workSpace := extraSpace + defaultSpace ;
+      urgency   := procUrg ;
+      ALLOCATE (stack, workSpace) ;
+      NEWCOROUTINE (procBody, stack, workSpace, context) ;
+      params    := procParams ;
+      state     := passive ;
+      right     := NIL ;
+      left      := NIL
+   END ;
+   Add (procId)
+END Create ;
+
+
+(*
+   Creates a new process, with parameters as for Create.
+   The process is created in the ready state; it is eligible to
+   run immediately.
+*)
+
+PROCEDURE Start (procBody: Body; extraSpace: CARDINAL; procUrg: Urgency;
+                 procParams: Parameter; VAR procId: ProcessId) ;
+BEGIN
+   Create (procBody, extraSpace, procUrg, procParams, procId) ;
+   Activate (procId)
+END Start ;
+
+
+(*
+   StopMe - terminates the calling process.
+            The process must not be associated with a source
+            of events.
+*)
+
+PROCEDURE StopMe ;
+BEGIN
+   OnDeadQueue (Me ()) ;
+   Reschedule
+END StopMe ;
+
+
+(*
+   SuspendMe - causes the calling process to enter the passive state.
+               The procedure only returns when the calling process
+               is again activated by another process.
+*)
+
+PROCEDURE SuspendMe ;
+BEGIN
+   IF debugging
+   THEN
+      displayProcesses ("SuspendMe")
+   END ;
+   OnPassiveQueue (Me ()) ;
+   Reschedule
+END SuspendMe ;
+
+
+(*
+   doActivate - activate procId and pass, info, in the parameter field.
+*)
+
+PROCEDURE doActivate (procId: ProcessId; info: Parameter) ;
+BEGIN
+   procId^.params := info ;
+   OnReadyQueue (procId) ;
+   Reschedule
+END doActivate ;
+
+
+(*
+   Activate - causes the process identified by procId to enter the ready
+              state, and thus to become eligible to run again.
+*)
+
+PROCEDURE Activate (procId: ProcessId) ;
+BEGIN
+   doActivate (procId, NIL)
+END Activate ;
+
+
+(*
+   SuspendMeAndActivate - executes an atomic sequence of SuspendMe() and
+                          Activate(procId).
+*)
+
+PROCEDURE SuspendMeAndActivate (procId: ProcessId) ;
+BEGIN
+   OnPassiveQueue (Me ()) ;
+   doActivate (procId, NIL)
+END SuspendMeAndActivate ;
+
+
+(*
+   Switch - causes the calling process to enter the passive state; the
+            process identified by procId becomes the currently executing
+            process.  info is used to pass parameter information from the
+            calling to the activated process.  On return, info will
+            contain information from the process that chooses to switch
+            back to this one (or will be NIL if Activate or
+            SuspendMeAndActivate are used instead of Switch).
+*)
+
+PROCEDURE Switch (procId: ProcessId; VAR info: Parameter) ;
+VAR
+   p: ProcessId ;
+BEGIN
+   OnPassiveQueue (Me ()) ;
+   doActivate (procId, info) ;
+   p := Me () ;
+   info := p^.params
+END Switch ;
+
+
+(*
+   Wait - causes the calling process to enter the waiting state.
+          The procedure will return when the calling process is
+          activated by another process, or when one of its
+          associated eventSources has generated an event.
+*)
+
+PROCEDURE Wait ;
+VAR
+   calling,
+   best   : ProcessId ;
+   from   : COROUTINE ;
+BEGIN
+   IF debugging
+   THEN
+      displayProcesses ("Wait start")
+   END ;
+   calling := currentId ;
+   OnWaitingQueue (calling) ;
+   best := chooseProcess () ;
+   currentId := best ;
+   from := calling^.context ;
+   IF debugging
+   THEN
+      displayProcesses ("Wait about to perform IOTRANSFER")
+   END ;
+   IOTRANSFER (from, currentId^.context) ;
+   IF debugging
+   THEN
+      displayProcesses ("Wait after IOTRANSFER")
+   END ;
+   currentId^.context := from ;
+   currentId := calling ;
+   OnReadyQueue (calling) ;
+   IF debugging
+   THEN
+      displayProcesses ("Wait end")
+   END
+END Wait ;
+
+
+(*
+   displayQueue -
+*)
+
+PROCEDURE displayQueue (name: ARRAY OF CHAR; status: Status) ;
+VAR
+   p: ProcessId ;
+BEGIN
+   printf (name) ; printf (" queue\n");
+   p := pQueue[status] ;
+   IF pQueue[status] = NIL
+   THEN
+      printf ("  empty queue\n")
+   ELSE
+      printf ("  ");
+      REPEAT
+         printf ("[pid %d, urg %d", p^.context^.context, p^.urgency) ;
+         IF p = currentId
+         THEN
+            printf (", currentId")
+         END ;
+         IF p = idleId
+         THEN
+            printf (", idleId")
+         END ;
+         printf ("]") ;
+         p := p^.right ;
+         IF p # pQueue[status]
+         THEN
+            printf (", ")
+         END
+      UNTIL p = pQueue[status] ;
+      printf ("\n")
+   END
+END displayQueue ;
+
+
+(*
+   displayProcesses -
+*)
+
+PROCEDURE displayProcesses (message: ARRAY OF CHAR) ;
+BEGIN
+   printf ("display processes:  %s\n", ADR (message)) ;
+   displayQueue ("ready", ready) ;
+   displayQueue ("passive", passive) ;
+   displayQueue ("waiting", waiting)
+END displayProcesses ;
+
+
+(* The following procedures allow the association of processes
+   with sources of external events.
+*)
+
+(*
+   Attach - associates the specified eventSource with the calling
+            process.
+*)
+
+PROCEDURE Attach (eventSource: Sources) ;
+BEGIN
+   ATTACH (eventSource)
+END Attach ;
+
+
+(*
+   Detach - dissociates the specified eventSource from the program.
+*)
+
+PROCEDURE Detach (eventSource: Sources) ;
+BEGIN
+   DETACH (eventSource)
+END Detach ;
+
+
+(*
+   IsAttached - returns TRUE if and only if the specified eventSource is
+                currently associated with one of the processes of the
+                program.
+*)
+
+PROCEDURE IsAttached (eventSource: Sources) : BOOLEAN ;
+BEGIN
+   RETURN Handler (eventSource) # NIL
+END IsAttached ;
+
+
+(*
+   Handler - returns the identity of the process, if any, that is
+             associated with the specified eventSource.
+*)
+
+PROCEDURE Handler (eventSource: Sources) : ProcessId ;
+VAR
+   c: COROUTINE ;
+   p: ProcessId ;
+   s: Status ;
+BEGIN
+   c := HANDLER (eventSource) ;
+   FOR s := MIN (Status) TO MAX (Status) DO
+      p := pQueue[s] ;
+      IF p#NIL
+      THEN
+         REPEAT
+            IF p^.context=c
+            THEN
+               RETURN p
+            ELSE
+               p := p^.right
+            END
+         UNTIL p=pQueue[s]
+      END
+   END ;
+   RETURN NIL
+END Handler ;
+
+
+(* The following procedures allow processes to obtain their
+   identity, parameters, and urgency.
+*)
+
+
+(*
+   Me - returns the identity of the calling process (as assigned
+        when the process was first created).
+*)
+
+PROCEDURE Me () : ProcessId ;
+BEGIN
+   RETURN currentId
+END Me ;
+
+
+(*
+   MyParam - returns the value specified as procParams when the
+             calling process was created.
+*)
+
+PROCEDURE MyParam () : Parameter ;
+BEGIN
+   RETURN currentId^.params
+END MyParam ;
+
+
+(*
+   UrgencyOf - returns the urgency established when the process identified
+               by procId was first created.
+*)
+
+PROCEDURE UrgencyOf (procId: ProcessId) : Urgency ;
+BEGIN
+   RETURN currentId^.urgency
+END UrgencyOf ;
+
+
+(* The following procedure provides facilities for exception
+   handlers. *)
+
+
+(*
+   ProcessException - if the current coroutine is in the exceptional
+                      execution state because of the raising of a language
+                      exception, returns the corresponding enumeration value,
+                      and otherwise raises an exception.
+*)
+
+PROCEDURE ProcessesException () : ProcessesExceptions ;
+BEGIN
+   IF IsProcessesException ()
+   THEN
+      RETURN VAL (ProcessesExceptions, CurrentNumber (process))
+   ELSE
+      NoException (ADR (__FILE__), __LINE__,
+                   __COLUMN__, ADR(__FUNCTION__),
+                   ADR ("not in the exceptional execution state"))
+   END
+END ProcessesException ;
+
+
+(*
+   IsProcessException - returns TRUE if the current coroutine is
+                        in the exceptional execution state because
+                        of the raising of an exception in
+                        a routine from this module; otherwise returns
+                        FALSE.
+*)
+
+PROCEDURE IsProcessesException () : BOOLEAN ;
+BEGIN
+   RETURN IsExceptionalExecution () AND IsCurrentSource (process)
+END IsProcessesException ;
+
+
+(*
+   setupCurrentId - sets up the initial process.
+*)
+
+PROCEDURE setupCurrentId ;
+BEGIN
+   NEW (currentId) ;
+   WITH currentId^ DO
+      workSpace := 0 ;
+      stack     := NIL ;
+      urgency   := 0 ;
+      context   := CURRENT () ;
+      params    := NIL ;
+      state     := ready ;
+      right     := NIL ;
+      left      := NIL
+   END ;
+   Add (currentId)
+END setupCurrentId ;
+
+
+(*
+   idleProcess - the idle process which listens for an interrupt.
+*)
+
+PROCEDURE idleProcess ;
+BEGIN
+   LOOP
+      ListenLoop
+   END
+END idleProcess ;
+
+
+(*
+   setupIdleId - sets up the idle process.
+*)
+
+PROCEDURE setupIdle ;
+BEGIN
+   Create (idleProcess, 0, MIN (Urgency), NIL, idleId) ;
+   Activate (idleId)
+END setupIdle ;
+
+
+(*
+   Init - sets up all the module data structures.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   AllocateSource (process) ;
+   free := NIL ;
+   pQueue[ready] := NIL ;
+   pQueue[waiting] := NIL ;
+   pQueue[passive] := NIL ;
+   pQueue[dead] := NIL ;
+   setupCurrentId ;
+   setupIdle
+END Init ;
+
+
+BEGIN
+   Init
+END Processes.
diff --git a/gcc/m2/gm2-libs-iso/ProgramArgs.def b/gcc/m2/gm2-libs-iso/ProgramArgs.def
new file mode 100644
index 00000000000..40413d4f56e
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ProgramArgs.def
@@ -0,0 +1,39 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE ProgramArgs;
+ 
+  (* Access to program arguments *)
+ 
+IMPORT IOChan;
+ 
+TYPE
+  ChanId = IOChan.ChanId;
+ 
+PROCEDURE ArgChan (): ChanId;
+  (* Returns a value that identifies a channel for reading
+     program arguments *)
+ 
+PROCEDURE IsArgPresent (): BOOLEAN;
+  (* Tests if there is a current argument to read from.  If not,
+     read <= IOChan.CurrentFlags() will be FALSE, and attempting
+     to read from the argument channel will raise the exception
+     notAvailable.
+  *)
+ 
+PROCEDURE NextArg ();
+  (* If there is another argument, causes subsequent input from the
+     argument device to come from the start of the next argument.
+     Otherwise there is no argument to read from, and a call of
+     IsArgPresent will return FALSE.
+  *)
+ 
+END ProgramArgs.
diff --git a/gcc/m2/gm2-libs-iso/ProgramArgs.mod b/gcc/m2/gm2-libs-iso/ProgramArgs.mod
new file mode 100644
index 00000000000..f25e1e92578
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ProgramArgs.mod
@@ -0,0 +1,482 @@
+(* ProgramArgs.mod implement the ISO ProgramArgs specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ProgramArgs ;
+
+FROM RTgen IMPORT ChanDev, InitChanDev, DeviceType, doLook, doSkip, doSkipLook,
+                  doReadText, doReadLocs ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM UnixArgs IMPORT GetArgC, GetArgV ;
+FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
+FROM RTdata IMPORT ModuleId, MakeModuleId, InitData, GetData ;
+FROM IOLink IMPORT DeviceId, DeviceTablePtr, DeviceTablePtrValue, AllocateDeviceId, MakeChan, RAISEdevException ;
+FROM IOChan IMPORT ChanExceptions ;
+FROM IOConsts IMPORT ReadResults ;
+FROM ChanConsts IMPORT read, text ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM ASCII IMPORT nul, lf ;
+
+
+TYPE
+   PtrToChar = POINTER TO CHAR ;
+   ArgInfo   = POINTER TO RECORD
+                           currentPtr: PtrToChar ;
+                           currentPos: CARDINAL ;
+                           currentArg: CARDINAL ;
+                           argLength : CARDINAL ;
+                           argc      : CARDINAL ;
+                        END ;
+
+
+VAR
+   mid      : ModuleId ;
+   did      : DeviceId ;
+   cid      : ChanId ;
+   ArgData  : PtrToChar ;
+   ArgLength: CARDINAL ;
+   gen      : GenDevIF ;
+   dev      : ChanDev ;
+
+
+PROCEDURE look (d: DeviceTablePtr;
+                VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doLook(dev, d, ch, r)
+END look ;
+
+
+PROCEDURE skip (d: DeviceTablePtr) ;
+BEGIN
+   doSkip(dev, d)
+END skip ;
+
+
+PROCEDURE skiplook (d: DeviceTablePtr;
+                    VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doSkipLook(dev, d, ch, r)
+END skiplook ;
+
+
+PROCEDURE textread (d: DeviceTablePtr;
+                    to: ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+BEGIN
+   doReadText(dev, d, to, maxChars, charsRead)
+END textread ;
+
+
+PROCEDURE rawread (d: DeviceTablePtr;
+                   to: ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+BEGIN
+   doReadLocs(dev, d, to, maxLocs, locsRead)
+END rawread ;
+
+
+PROCEDURE getname (d: DeviceTablePtr;
+                   VAR a: ARRAY OF CHAR) ;
+BEGIN
+   d^.doGetName(d, a)
+END getname ;
+
+
+PROCEDURE flush (d: DeviceTablePtr) ;
+BEGIN
+END flush ;
+
+
+PROCEDURE handlefree (d: DeviceTablePtr) ;
+BEGIN
+END handlefree ;
+
+
+PROCEDURE reset (d: DeviceTablePtr) ;
+VAR
+   a : ArgInfo ;
+BEGIN
+   a := GetData(d, mid) ;
+   WITH a^ DO
+      currentPtr := ArgData ;
+      currentPos := 0 ;
+      currentArg := 0 ;
+      argLength := strlen(currentPtr)+1 ;
+      argc := GetArgC ()
+   END
+END reset ;
+
+
+(*
+   doreadchar - returns a CHAR from the file associated with, g.
+*)
+
+PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+VAR
+   a : ArgInfo ;
+   ch: CHAR ;
+BEGIN
+   d := DeviceTablePtrValue(cid, did) ;
+   a := GetData(d, mid) ;
+   WITH a^ DO
+      IF currentPos<argLength
+      THEN
+         ch := currentPtr^ ;
+         INC(currentPtr) ;
+         INC(currentPos) ;
+         d^.result := allRight ;
+         RETURN( ch )
+      ELSE
+         d^.result := endOfInput ;
+         RETURN( nul )
+      END
+   END
+END doreadchar ;
+
+
+(*
+   dounreadchar - pushes a CHAR back onto the file associated with, g.
+*)
+
+PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+VAR
+   a: ArgInfo ;
+BEGIN
+   d := DeviceTablePtrValue(cid, did) ;
+   a := GetData(d, mid) ;
+   WITH a^ DO
+      IF currentPos>0
+      THEN
+         DEC(currentPtr) ;
+         DEC(currentPos)
+      END
+   END ;
+   RETURN( ch )
+END dounreadchar ;
+
+
+(*
+   dogeterrno - returns the errno relating to the generic device.
+*)
+
+PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+BEGIN
+   RETURN 0
+END dogeterrno ;
+
+
+(*
+   dorbytes - reads upto, max, bytes setting, actual, and
+              returning FALSE if an error (not due to eof)
+              occurred.
+*)
+
+PROCEDURE dorbytes (g: GenDevIF; d: DeviceTablePtr;
+                    to: ADDRESS;
+                    max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   p: PtrToChar ;
+   i: CARDINAL ;
+BEGIN
+   WITH d^ DO
+      p := to ;
+      i := 0 ;
+      WHILE (i<max) AND ((result=notKnown) OR (result=allRight) OR (result=endOfLine)) DO
+         p^ := doreadchar(g, d) ;
+         INC(i) ;
+         INC(p)
+      END ;
+      RETURN( TRUE )
+   END
+END dorbytes ;
+
+
+(*
+   dowbytes - 
+*)
+
+PROCEDURE dowbytes (g: GenDevIF; d: DeviceTablePtr;
+                    from: ADDRESS;
+                    nBytes: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+BEGIN
+   RAISEdevException(cid, did, notAvailable,
+                     'ProgramArgs.dowbytes:  not allowed to write to this channel') ;
+   RETURN( FALSE )
+END dowbytes ;
+
+
+(*
+   dowriteln - attempt to write an end of line marker to the
+               file and returns TRUE if successful.
+*)
+
+PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RAISEdevException(cid, did, notAvailable,
+                     'ProgramArgs.dowbytes:  not allowed to write to this channel') ;
+   RETURN( FALSE )
+END dowriteln ;
+
+
+(*
+   iseof - returns TRUE if end of file is seen.
+*)
+
+PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   a: ArgInfo ;
+BEGIN
+   d := DeviceTablePtrValue(cid, did) ;
+   a := GetData(d, mid) ;
+   WITH a^ DO
+      RETURN( currentPos=ArgLength )
+   END
+END iseof ;
+
+
+(*
+   iseoln - returns TRUE if end of line is seen.
+*)
+
+PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   ch: CHAR ;
+BEGIN
+   IF iseof(g, d)
+   THEN
+      RETURN( FALSE )
+   ELSE
+      ch := doreadchar(g, d) ;
+      IF ch#dounreadchar(g, d, ch)
+      THEN
+         RAISEdevException(cid, did, hardDeviceError,
+                           'ProgramArgs.iseoln:  internal inconsistancy error')
+      END ;
+      RETURN( ch=lf )
+   END
+END iseoln ;
+
+
+(*
+   iserror - returns TRUE if an error was seen on the device.
+*)
+
+PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RETURN( FALSE )
+END iserror ;
+
+
+(*
+   strlen - returns the number characters in string at this point.
+*)
+
+PROCEDURE strlen (p: PtrToChar) : CARDINAL ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   n := 0 ;
+   WHILE p^#nul DO
+      INC(n) ;
+      INC(p)
+   END ;
+   RETURN( n )
+END strlen ;
+
+
+(*
+   ArgChan - returns a value that identifies a channel for
+             reading program arguments.
+*)
+
+PROCEDURE ArgChan () : ChanId ;
+BEGIN
+   RETURN( cid )
+END ArgChan ;
+
+
+(*
+   IsArgPresent - tests if there is a current argument to
+                  read from.  If not,
+                  read <= IOChan.CurrentFlags() will be FALSE,
+                  and attempting to read from the argument
+                  channel will raise the exception
+                  notAvailable.
+*)
+
+PROCEDURE IsArgPresent () : BOOLEAN ;
+VAR
+   d: DeviceTablePtr ;
+   a: ArgInfo ;
+BEGIN
+   d := DeviceTablePtrValue(cid, did) ;
+   a := GetData(d, mid) ;
+   WITH a^ DO
+      RETURN( currentArg<argc )
+   END
+END IsArgPresent ;
+
+
+(*
+   NextArg - if there is another argument, causes subsequent
+             input from the argument device to come from the
+             start of the next argument.  Otherwise there is
+             no argument to read from, and a call of
+             IsArgPresent will return FALSE.
+*)
+ 
+PROCEDURE NextArg ;
+VAR
+   d: DeviceTablePtr ;
+   a: ArgInfo ;
+   p: PtrToChar ;
+BEGIN
+   d := DeviceTablePtrValue(cid, did) ;
+   a := GetData(d, mid) ;
+   WITH a^ DO
+      IF currentArg<argc
+      THEN
+         INC(currentArg) ;
+         WHILE (currentPos<argLength) AND (currentPtr^#nul) DO
+            INC(currentPos) ;
+            INC(currentPtr)
+         END ;
+         INC(currentPtr) ;  (* move over nul onto first char of next arg *)
+         argLength := strlen(currentPtr)+1 ;
+         currentPos := 0
+      END
+   END
+END NextArg ;
+
+
+(*
+   collectArgs - 
+*)
+
+PROCEDURE collectArgs ;
+VAR
+   i   : INTEGER ;
+   n   : CARDINAL ;
+   pp  : POINTER TO PtrToChar ;
+   p, q: PtrToChar ;
+BEGIN
+   (* count the number of bytes necessary to remember all arg data *)
+   n := 0 ;
+   i := 0 ;
+   pp := GetArgV () ;
+   WHILE i < GetArgC () DO
+      p := pp^ ;
+      WHILE p^#nul DO
+         INC(p) ;
+         INC(n)
+      END ;
+      INC(n) ;
+      INC(pp, SIZE(ADDRESS)) ;
+      INC(i)
+   END ;
+   ArgLength := n ;
+   (* now allocate correct amount of memory and copy the data *)
+   ALLOCATE(ArgData, ArgLength) ;
+   i := 0 ;
+   pp := GetArgV () ;
+   q := ArgData ;
+   WHILE i < GetArgC () DO
+      p := pp^ ;
+      WHILE p^#nul DO
+         q^ := p^ ;
+         INC(q) ;
+         INC(p)
+      END ;
+      q^ := p^ ;
+      INC(q) ;
+      INC(pp, SIZE(ADDRESS)) ;
+      INC(i)
+   END
+END collectArgs ;
+
+
+(*
+   freeData - deallocates, a.
+*)
+
+PROCEDURE freeData (a: ArgInfo) ;
+BEGIN
+   DISPOSE(a)
+END freeData ;
+
+
+(*
+   Init - 
+*)
+
+PROCEDURE Init ;
+VAR
+   d: DeviceTablePtr ;
+   a: ArgInfo ;
+BEGIN
+   MakeModuleId(mid) ;
+   AllocateDeviceId(did) ;
+   MakeChan(did, cid) ;
+   collectArgs ;
+   NEW(a) ;
+   WITH a^ DO
+      currentPtr := ArgData ;
+      currentPos := 0 ;
+      currentArg := 0 ;
+      argLength := strlen(currentPtr)+1 ;
+      argc := GetArgC ()
+   END ;
+   d := DeviceTablePtrValue(cid, did) ;
+   InitData(d, mid, a, freeData) ;
+   gen := InitGenDevIF(did,
+                       doreadchar, dounreadchar,
+                       dogeterrno, dorbytes, dowbytes,
+                       dowriteln,
+                       iseof, iseoln, iserror) ;
+   dev := InitChanDev(programargs, did, gen) ;
+   WITH d^ DO
+      flags := read + text ;
+      errNum := 0 ;
+      doLook := look ;
+      doSkip := skip ;
+      doSkipLook := skiplook ;
+      doTextRead := textread ;
+      doRawRead := rawread ;
+      doGetName := getname ;
+      doReset := reset ;
+      doFlush := flush ;
+      doFree := handlefree
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END ProgramArgs.
diff --git a/gcc/m2/gm2-libs-iso/README.texi b/gcc/m2/gm2-libs-iso/README.texi
new file mode 100644
index 00000000000..99bb758f056
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/README.texi
@@ -0,0 +1,79 @@
+@c README.texi describes the ISO libraries.
+@c Copyright @copyright{} 2000-2022 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+This directory contains the ISO definition modules and some
+corresponding implementation modules.  The definition files:
+@file{ChanConsts.def}, @file{CharClass.def}, @file{ComplexMath.def},
+@file{ConvStringLong.def}, @file{ConvStringReal.def},
+@file{ConvTypes.def}, @file{COROUTINES.def}, @file{EXCEPTIONS.def},
+@file{GeneralUserExceptions.def}, @file{IOChan.def},
+@file{IOConsts.def}, @file{IOLink.def}, @file{IOLink.def},
+@file{IOResult.def}, @file{LongComplexMath.def}, @file{LongConv.def},
+@file{LongIO.def}, @file{LongMath.def}, @file{LongStr.def},
+@file{LowLong.def}, @file{LowReal.def}, @file{M2EXCEPTION.def},
+@file{Processes.def}, @file{ProgramArgs.def}, @file{RawIO.def},
+@file{RealConv.def}, @file{RealIO.def}, @file{RealMath.def},
+@file{RealStr.def}, @file{RndFile.def}, @file{Semaphores.def},
+@file{SeqFile.def}, @file{SIOResult.def}, @file{SLongIO.def},
+@file{SRawIO.def}, @file{SRealIO.def}, @file{StdChans.def},
+@file{STextIO.def}, @file{Storage.def}, @file{StreamFile.def},
+@file{Strings.def}, @file{SWholeIO.def}, @file{SysClock.def},
+@file{SYSTEM.def}, @file{TERMINATION.def}, @file{TextIO.def},
+@file{WholeConv.def}, @file{WholeIO.def} and @file{WholeStr.def}
+were defined by the International Standard
+Information technology - programming languages BS ISO/IEC
+10514-1:1996E Part 1: Modula-2, Base Language.
+
+The Copyright to the definition files @file{ChanConsts.def},
+@file{CharClass.def}, @file{ComplexMath.def},
+@file{ConvStringLong.def}, @file{ConvStringReal.def},
+@file{ConvTypes.def}, @file{COROUTINES.def}, @file{EXCEPTIONS.def},
+@file{GeneralUserExceptions.def}, @file{IOChan.def},
+@file{IOConsts.def}, @file{IOLink.def}, @file{IOLink.def},
+@file{IOResult.def}, @file{LongComplexMath.def}, @file{LongConv.def},
+@file{LongIO.def}, @file{LongMath.def}, @file{LongStr.def},
+@file{LowLong.def}, @file{LowReal.def}, @file{M2EXCEPTION.def},
+@file{Processes.def}, @file{ProgramArgs.def}, @file{RawIO.def},
+@file{RealConv.def}, @file{RealIO.def}, @file{RealMath.def},
+@file{RealStr.def}, @file{RndFile.def}, @file{Semaphores.def},
+@file{SeqFile.def}, @file{SIOResult.def}, @file{SLongIO.def},
+@file{SRawIO.def}, @file{SRealIO.def}, @file{StdChans.def},
+@file{STextIO.def}, @file{Storage.def}, @file{StreamFile.def},
+@file{Strings.def}, @file{SWholeIO.def}, @file{SysClock.def},
+@file{SYSTEM.def}, @file{TERMINATION.def}, @file{TextIO.def},
+@file{WholeConv.def}, @file{WholeIO.def} and @file{WholeStr.def}
+belong to ISO/IEC (International Organization for Standardization and
+International Electrotechnical Commission).  The licence allows them
+to be distributed with the compiler (as described on page
+707 of the Information technology - Programming languages Part 1:
+Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).
+
+All implementation modules and @file{ClientSocket.def},
+@file{LongWholeIO.def}, @file{M2RTS.def}, @file{MemStream.def},
+@file{pth.def}, @file{RandomNumber.def}, @file{RTdata.def},
+@file{RTentity.def}, @file{RTfio.def}, @file{RTio.def},
+@file{ShortComplexMath.def}, @file{ShortIO.def},
+@file{ShortWholeIO.def}, @file{SimpleCipher.def},
+@file{SLongWholeIO.def}, @file{SShortIO.def},
+@file{SShortWholeIO.def}, @file{StringChan.def} and
+@file{wraptime.def} are Copyright of the FSF and are held under the
+GPLv3 with runtime exceptions.
+
+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
+@url{http://www.gnu.org/licenses/}.
+
+Notice that GNU Modula-2 contains additional libraries for
+input/output of @code{SHORTREAL}, @code{SHORTCARD}, @code{SHORTINT},
+@code{LONGCARD}, @code{LONGINT} data types.  It also provides a
+@code{RandomNumber}, @code{SimpleCipher} and @code{ClientSocket}
+modules as well as low level modules which allow the IO libraries to
+coexist with their PIM counterparts.
diff --git a/gcc/m2/gm2-libs-iso/RTco.def b/gcc/m2/gm2-libs-iso/RTco.def
new file mode 100644
index 00000000000..a1580faa55e
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTco.def
@@ -0,0 +1,76 @@
+(* RTco.def provides minimal access to thread primitives.
+
+Copyright (C) 2019-2021 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/>.  *)
+
+DEFINITION MODULE RTco ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(* init initializes the module and allows the application to lazily invoke threads.  *)
+
+PROCEDURE init () : INTEGER ;
+
+PROCEDURE initThread (p: PROC; stackSize: CARDINAL; interruptLevel: CARDINAL) : INTEGER ;
+
+PROCEDURE initSemaphore (value: CARDINAL) : INTEGER ;
+
+PROCEDURE wait (semaphore: INTEGER) ;
+
+PROCEDURE signal (semaphore: INTEGER) ;
+
+PROCEDURE transfer (VAR p1: INTEGER; p2: INTEGER) ;
+
+PROCEDURE waitThread (tid: INTEGER) ;
+
+PROCEDURE signalThread (tid: INTEGER) ;
+
+PROCEDURE currentThread () : INTEGER ;
+
+
+(* currentInterruptLevel returns the interrupt level of the current thread.  *)
+
+PROCEDURE currentInterruptLevel () : CARDINAL ;
+
+
+(* turninterrupts returns the old interrupt level and assigns the interrupt level
+   to newLevel.  *)
+
+PROCEDURE turnInterrupts (newLevel: CARDINAL) : CARDINAL ;
+
+
+(*
+   select access to the select system call which will be thread safe.
+   This is typically called from the idle process to wait for an interrupt.
+*)
+
+PROCEDURE select (p1: INTEGER;
+                  p2: ADDRESS;
+                  p3: ADDRESS;
+                  p4: ADDRESS;
+                  p5: ADDRESS) : INTEGER ;
+
+
+END RTco.
diff --git a/gcc/m2/gm2-libs-iso/RTdata.def b/gcc/m2/gm2-libs-iso/RTdata.def
new file mode 100644
index 00000000000..f97c400f36c
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTdata.def
@@ -0,0 +1,79 @@
+(* RTdata.def provides a mechanism whereby devices can attach data.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE RTdata ;
+
+(*
+    Title      : RTdata
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Sep 26 17:19:15 2008
+    Revision   : $Version$ 
+    Description: provides a mechanism whereby devices can store
+                 data attached to a device.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM IOLink IMPORT DeviceTablePtr ;
+
+TYPE
+   ModuleId ;
+   FreeProcedure = PROCEDURE (ADDRESS) ;
+
+
+(*
+   MakeModuleId - creates a unique module Id.
+*)
+
+PROCEDURE MakeModuleId (VAR m: ModuleId) ;
+
+
+(*
+   InitData - adds, datum, to the device, d.  The datum
+              is associated with ModuleID, m.
+*)
+
+PROCEDURE InitData (d: DeviceTablePtr; m: ModuleId;
+                    datum: ADDRESS; f: FreeProcedure) ;
+
+
+(*
+   GetData - returns the datum assocated with ModuleId, m.
+*)
+
+PROCEDURE GetData (d: DeviceTablePtr; m: ModuleId) : ADDRESS ;
+
+
+(*
+   KillData - destroys the datum associated with ModuleId, m,
+              in device, d.  It invokes the free procedure
+              given during InitData.
+*)
+
+PROCEDURE KillData (d: DeviceTablePtr; m: ModuleId) ;
+
+
+END RTdata.
diff --git a/gcc/m2/gm2-libs-iso/RTdata.mod b/gcc/m2/gm2-libs-iso/RTdata.mod
new file mode 100644
index 00000000000..510fd998d86
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTdata.mod
@@ -0,0 +1,167 @@
+(* RTdata.mod implements a mechanism whereby devices can attach data.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RTdata ;
+
+FROM IOLink IMPORT DeviceTablePtr, RAISEdevException ;
+FROM RTentity IMPORT Group, InitGroup, PutKey, IsIn, DelKey ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+IMPORT IOChan ;
+
+TYPE
+   key = (allocated, deallocated) ;
+
+   (* each module can register one of these *)
+   ModuleId = POINTER TO RECORD
+                            id: CARDINAL ;
+                         END ;
+
+   (* each device can contain multiple of the these *)
+   ModuleData = POINTER TO RECORD
+                              mid  : ModuleId ;
+                              data : ADDRESS ;
+                              free : FreeProcedure ;
+                              right: ModuleData ;
+                           END ;
+
+
+(*
+   MakeModuleId - creates a unique module Id.
+*)
+
+PROCEDURE MakeModuleId (VAR m: ModuleId) ;
+BEGIN
+   INC(lastId) ;
+   NEW(m) ;
+   WITH m^ DO
+      id := lastId
+   END ;
+   PutKey(mids, m, ORD(allocated))
+END MakeModuleId ;
+
+
+(*
+   verifyModuleId - verifies that, m, has not been deallocated.
+*)
+
+PROCEDURE verifyModuleId (m: ModuleId; d: DeviceTablePtr) ;
+BEGIN
+   IF NOT IsIn(mids, m)
+   THEN
+      WITH d^ DO
+         RAISEdevException(cid, did, IOChan.hardDeviceError,
+                           'RTdata: invalid module id')
+      END
+   END
+END verifyModuleId ;
+
+
+(*
+   InitData - adds, datum, to the device, d.  The datum
+              is associated with ModuleID, m.
+*)
+
+PROCEDURE InitData (d: DeviceTablePtr; m: ModuleId;
+                    datum: ADDRESS; f: FreeProcedure) ;
+VAR
+   md: ModuleData ;
+BEGIN
+   NEW(md) ;
+   WITH md^ DO
+      mid := m ;
+      data := datum ;
+      free := f ;
+      right := d^.cd
+   END ;
+   d^.cd := md
+END InitData ;
+
+
+(*
+   GetData - returns the datum assocated with ModuleId, m.
+*)
+
+PROCEDURE GetData (d: DeviceTablePtr; m: ModuleId) : ADDRESS ;
+VAR
+   md: ModuleData ;
+BEGIN
+   verifyModuleId(m, d) ;
+   md := d^.cd ;
+   WHILE md#NIL DO
+      IF md^.mid=m
+      THEN
+         RETURN( md^.data )
+      ELSE
+         md := md^.right
+      END
+   END ;
+   RETURN( md )
+END GetData ;
+
+
+(*
+   KillData - destroys the datum associated with ModuleId, m,
+              in device, d.  It invokes the free procedure
+              given during InitData.
+*)
+
+PROCEDURE KillData (d: DeviceTablePtr; m: ModuleId) ;
+VAR
+   last,
+   md  : ModuleData ;
+BEGIN
+   verifyModuleId(m, d) ;
+   last := NIL ;
+   md := d^.cd ;
+   WHILE md#NIL DO
+      IF md^.mid=m
+      THEN
+         IF last=NIL
+         THEN
+            d^.cd := md^.right
+         ELSE
+            last^.right := md^.right
+         END ;
+         DelKey(mids, m) ;
+         md^.free(md^.data) ;
+         md^.data := NIL ;
+         DISPOSE(md)
+      ELSE
+         last := md ;
+         md := md^.right
+      END
+   END
+END KillData ;
+
+
+VAR
+   mids  : Group ;
+   lastId: CARDINAL ;
+BEGIN
+   mids := InitGroup() ;
+   lastId := 0
+END RTdata.
diff --git a/gcc/m2/gm2-libs-iso/RTentity.def b/gcc/m2/gm2-libs-iso/RTentity.def
new file mode 100644
index 00000000000..37b0b1ecb1f
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTentity.def
@@ -0,0 +1,58 @@
+(* RTentity.def maintains a grouping of different opaque types.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE RTentity ;
+
+(*
+    Title      : RTentity
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon Sep 15 15:40:56 2008
+    Revision   : $Version$ 
+    Description: provides a set of routines for maintaining an
+                 efficient mechanism to group opaque (or pointer)
+                 data structures together.  Internally the
+                 entities are grouped together using a binary
+                 tree.  It does not use Storage - and instead
+                 uses malloc, free from libc as Storage uses the
+                 module to detect erroneous deallocations.
+*)
+
+IMPORT SYSTEM ;
+
+TYPE
+   Group ;
+
+
+PROCEDURE InitGroup () : Group ;
+PROCEDURE KillGroup (g: Group) : Group ;
+PROCEDURE GetKey (g: Group; a: SYSTEM.ADDRESS) : CARDINAL ;
+PROCEDURE PutKey (g: Group; a: SYSTEM.ADDRESS; key: CARDINAL) ;
+PROCEDURE DelKey (g: Group; a: SYSTEM.ADDRESS) ;
+PROCEDURE IsIn (g: Group; a: SYSTEM.ADDRESS) : BOOLEAN ;
+
+
+END RTentity.
diff --git a/gcc/m2/gm2-libs-iso/RTentity.mod b/gcc/m2/gm2-libs-iso/RTentity.mod
new file mode 100644
index 00000000000..b304e27e8b9
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTentity.mod
@@ -0,0 +1,300 @@
+(* RTentity.mod implements a grouping of different opaque types.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RTentity ;
+
+FROM libc IMPORT malloc, free ;
+FROM M2RTS IMPORT Halt ;
+FROM RTco IMPORT init, initSemaphore, wait, signal ;
+
+TYPE
+   Group = POINTER TO RECORD
+                         left, right:  Group ;
+                         entity     :  SYSTEM.ADDRESS ;
+                         entityKey  :  CARDINAL ;
+                      END ;
+
+
+PROCEDURE InitGroup () : Group ;
+VAR
+   g: Group ;
+BEGIN
+   checkInitialized ;
+   wait (mutex) ;
+   g := malloc (SIZE (g^)) ;
+   WITH g^ DO
+      left := NIL ;
+      right := NIL ;
+      entity := NIL ;
+      entityKey := 0
+   END ;
+   signal (mutex) ;
+   RETURN g
+END InitGroup ;
+
+
+(*
+   killGroup -
+*)
+
+PROCEDURE killGroup (g: Group) : Group ;
+BEGIN
+   IF g # NIL
+   THEN
+      WITH g^ DO
+         left := killGroup (left) ;
+         right := killGroup (right)
+      END ;
+      free (g)
+   END ;
+   RETURN NIL
+END killGroup ;
+
+
+
+PROCEDURE KillGroup (g: Group) : Group ;
+BEGIN
+   wait (mutex) ;
+   g := killGroup (g) ;
+   signal (mutex) ;
+   RETURN g
+END KillGroup ;
+
+
+PROCEDURE GetKey (g: Group; a: SYSTEM.ADDRESS) : CARDINAL ;
+VAR
+   parent,
+   child : Group ;
+BEGIN
+   assert (initialized) ;
+   wait (mutex) ;
+   findChildAndParent (g, a, child, parent) ;
+   signal (mutex) ;
+   IF child = NIL
+   THEN
+      RETURN 0
+   ELSE
+      RETURN child^.entityKey
+   END
+END GetKey ;
+
+
+PROCEDURE PutKey (g: Group; a: SYSTEM.ADDRESS; key: CARDINAL) ;
+VAR
+   parent,
+   child : Group ;
+BEGIN
+   assert (initialized) ;
+   wait (mutex) ;
+   findChildAndParent (g, a, child, parent) ;
+   IF child = NIL
+   THEN
+      (* no child found, now is, a, less than parent or greater? *)
+      IF parent = g
+      THEN
+         (* empty tree, add it to the left branch of t *)
+         child := malloc (SIZE (child^)) ;
+         parent^.left := child
+      ELSE
+         (* parent is a leaf node *)
+         IF a < parent^.entity
+         THEN
+            child := malloc (SIZE (child^)) ;
+            parent^.left := child
+         ELSIF a > parent^.entity
+         THEN
+            child := malloc (SIZE (child^)) ;
+            parent^.right := child
+         END
+      END ;
+      WITH child^ DO
+         right     := NIL ;
+         left      := NIL ;
+         entity    := a ;
+         entityKey := key
+      END
+   ELSE
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            'internal runtime error, entity already stored')
+   END ;
+   signal (mutex)
+END PutKey ;
+
+
+PROCEDURE IsIn (g: Group; a: SYSTEM.ADDRESS) : BOOLEAN ;
+VAR
+   child, parent: Group ;
+BEGIN
+   assert (initialized) ;
+   wait (mutex) ;
+   findChildAndParent (g, a, child, parent) ;
+   signal (mutex) ;
+   RETURN child # NIL
+END IsIn ;
+
+
+(*
+   DelKey - deletes an entry in the binary tree.
+
+            NB in order for this to work we must
+            ensure that the InitGroup sets
+            both left and right to NIL.
+*)
+
+PROCEDURE DelKey (g: Group; a: SYSTEM.ADDRESS) ;
+VAR
+   i, child, parent: Group ;
+BEGIN
+   assert (initialized) ;
+   wait (mutex) ;
+   (* find parent and child of the node *)
+   findChildAndParent (g, a, child, parent) ;
+   IF (child # NIL) AND (child^.entity = a)
+   THEN
+      (* Have found the node to be deleted *)
+      IF parent^.right = child
+      THEN
+         (* Node is child and this is greater than the parent. *)
+         (* Greater being on the right.                        *)
+         (* Connect child^.left onto the parent^.right.        *)
+         (* Connect child^.right onto the end of the right     *)
+         (* most branch of child^.left.                        *)
+         IF child^.left # NIL
+         THEN
+            (* Scan for right most node of child^.left *)
+            i := child^.left ;
+            WHILE i^.right # NIL DO
+               i := i^.right
+            END ;
+            i^.right      := child^.right ;
+            parent^.right := child^.left
+         ELSE
+            (* No child^.left node therefore link over child   *)
+            (* (as in a single linked list) to child^.right    *)
+            parent^.right := child^.right
+         END ;
+         free (child)
+      ELSE
+         (* assert that parent^.left=child will always be true *)
+         (* Perform exactly the mirror image of the above code *)
+
+         (* Connect child^.right onto the parent^.left.        *)
+         (* Connect child^.left onto the end of the left most  *)
+         (* branch of child^.right                             *)
+         IF child^.right # NIL
+         THEN
+            (* Scan for left most node of child^.right *)
+            i := child^.right ;
+            WHILE i^.left # NIL DO
+               i := i^.left
+            END ;
+            i^.left      := child^.left ;
+            parent^.left := child^.right
+         ELSE
+            (* No child^.right node therefore link over c      *)
+            (* (as in a single linked list) to child^.left.    *)
+            parent^.left := child^.left
+         END ;
+         free (child)
+      END
+   ELSE
+      Halt(__FILE__, __LINE__, __FUNCTION__,
+           'internal runtime error, trying to delete an entity which is not in the tree')
+   END ;
+   signal (mutex)
+END DelKey ;
+
+
+(*
+   findChildAndParent - 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.
+*)
+
+PROCEDURE findChildAndParent (t: Group; a: SYSTEM.ADDRESS;
+                              VAR child, parent: Group) ;
+BEGIN
+   (* remember to skip the sentinal value and assign parent and child *)
+   parent := t ;
+   IF t = NIL
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            'internal runtime error, RTentity is either corrupt or the module storage has not been initialized yet')
+   END ;
+   child := t^.left ;
+   IF child # NIL
+   THEN
+      REPEAT
+         IF a < child^.entity
+         THEN
+            parent := child ;
+            child := child^.left
+         ELSIF a > child^.entity
+         THEN
+            parent := child ;
+            child := child^.right
+         END
+      UNTIL (child = NIL) OR (a = child^.entity)
+   END
+END findChildAndParent ;
+
+
+(*
+   assert - simple assertion procedure.
+*)
+
+PROCEDURE assert (condition: BOOLEAN) ;
+BEGIN
+   IF NOT condition
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            'internal runtime error, RTentity is either corrupt or the module storage has not been initialized yet')
+   END
+END assert ;
+
+
+(*
+   checkInitialized -
+*)
+
+PROCEDURE checkInitialized ;
+VAR
+   result: INTEGER ;
+BEGIN
+   IF NOT initialized
+   THEN
+      initialized := TRUE ;
+      result := init () ;
+      mutex := initSemaphore (1)
+   END
+END checkInitialized ;
+
+
+VAR
+   initialized: BOOLEAN ;  (* Set to FALSE when the bss is created.  *)
+   mutex      : INTEGER ;
+
+END RTentity.
diff --git a/gcc/m2/gm2-libs-iso/RTfio.def b/gcc/m2/gm2-libs-iso/RTfio.def
new file mode 100644
index 00000000000..6f896879c8f
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTfio.def
@@ -0,0 +1,123 @@
+(* RTfio.def provide default FIO based methods.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE RTfio ;
+
+(*
+    Title      : RTfio
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Wed Sep 24 11:54:58 2008
+    Revision   : $Version$
+    Description: provides default FIO based methods for the RTgenif
+                 procedures.  These will be used by StreamFile,
+                 SeqFile, StdChans, TermFile and RndFile.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM IOLink IMPORT DeviceTablePtr;
+FROM RTgenif IMPORT GenDevIF ;
+
+
+(*
+   doreadchar - returns a CHAR from the file associated with, g.
+*)
+
+PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+
+
+(*
+   dounreadchar - pushes a CHAR back onto the file associated
+                  with, g.
+*)
+
+PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+
+
+(*
+   dogeterrno - returns the errno relating to the generic device.
+*)
+
+PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+
+
+(*
+   dorbytes - reads upto, max, bytes setting, actual, and
+              returning FALSE if an error (not due to eof)
+              occurred.
+*)
+
+PROCEDURE dorbytes (g: GenDevIF;
+                    d: DeviceTablePtr;
+                    to: ADDRESS;
+                    max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+
+(*
+   dowbytes - writes up to, nBytes.  It returns FALSE
+              if an error occurred and it sets actual
+              to the amount of data written.
+*)
+
+PROCEDURE dowbytes (g: GenDevIF;
+                    d: DeviceTablePtr;
+                    from: ADDRESS;
+                    nBytes: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+
+
+(*
+   dowriteln - attempt to write an end of line marker to the
+               file and returns TRUE if successful.
+*)
+
+PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   iseof - returns TRUE if end of file has been seen.
+*)
+
+PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   iseoln - returns TRUE if end of line has been seen.
+*)
+
+PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   iserror - returns TRUE if an error was seen on the device.
+             Note that reaching EOF is not classified as an
+             error.
+*)
+
+PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+END RTfio.
diff --git a/gcc/m2/gm2-libs-iso/RTfio.mod b/gcc/m2/gm2-libs-iso/RTfio.mod
new file mode 100644
index 00000000000..9a9c5626a2c
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTfio.mod
@@ -0,0 +1,178 @@
+(* RTfio.mod implement default FIO based methods.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RTfio ;
+
+FROM IOLink IMPORT DeviceTablePtr ;
+FROM RTio IMPORT GetFile ;
+FROM errno IMPORT geterrno ;
+
+FROM FIO IMPORT File, ReadChar, UnReadChar, WriteChar, ReadNBytes, WriteNBytes, IsActive,
+                WriteLine, EOF, WasEOLN, IsNoError ;
+
+
+(*
+   doreadchar - returns a CHAR from the file associated with, g.
+*)
+
+PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      f := GetFile(cid) ;
+      RETURN( ReadChar(f) )
+   END
+END doreadchar ;
+
+
+(*
+   dounreadchar - pushes a CHAR back onto the file associated with, g.
+*)
+
+PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      f := GetFile(cid) ;
+      UnReadChar(f, ch) ;
+      RETURN( ch )
+   END
+END dounreadchar ;
+
+
+(*
+   dogeterrno - returns the errno relating to the generic device.
+*)
+
+PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+BEGIN
+   RETURN geterrno()
+END dogeterrno ;
+
+
+(*
+   dorbytes - reads upto, max, bytes setting, actual, and
+              returning FALSE if an error (not due to eof)
+              occurred.
+*)
+
+PROCEDURE dorbytes (g: GenDevIF; d: DeviceTablePtr;
+                    to: ADDRESS;
+                    max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      f := GetFile(cid) ;
+      actual := ReadNBytes(f, max, to) ;
+      RETURN( IsNoError(f) )
+   END
+END dorbytes ;
+
+
+(*
+   dowbytes - 
+*)
+
+PROCEDURE dowbytes (g: GenDevIF; d: DeviceTablePtr;
+                    from: ADDRESS;
+                    nBytes: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      f := GetFile(cid) ;
+      actual := WriteNBytes(f, nBytes, from) ;
+      RETURN( IsNoError(f) )
+   END
+END dowbytes ;
+
+
+(*
+   dowriteln - attempt to write an end of line marker to the
+               file and returns TRUE if successful.
+*)
+
+PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   f: File ;
+BEGIN
+   f := GetFile(d^.cid) ;
+   WriteLine(f) ;
+   RETURN( IsNoError(f) )
+END dowriteln ;
+
+
+(*
+   iseof - returns TRUE if end of file has been seen.
+*)
+
+PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      f := GetFile(cid) ;
+      RETURN( EOF(f) )
+   END
+END iseof ;
+
+
+(*
+   iseoln - returns TRUE if end of line is seen.
+*)
+
+PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      f := GetFile(cid) ;
+      RETURN( WasEOLN(f) )
+   END
+END iseoln ;
+
+
+(*
+   iserror - returns TRUE if an error was seen on the device.
+*)
+
+PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      f := GetFile(cid) ;
+      RETURN( IsActive(f) AND (NOT IsNoError(f)) )
+   END
+END iserror ;
+
+
+END RTfio.
diff --git a/gcc/m2/gm2-libs-iso/RTgen.def b/gcc/m2/gm2-libs-iso/RTgen.def
new file mode 100644
index 00000000000..76949732a3c
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTgen.def
@@ -0,0 +1,129 @@
+(* RTgen.def provide a generic device interface used by ISO.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE RTgen ;
+
+(*
+    Title      : RTgen
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon Sep 22 18:15:35 2008
+    Revision   : $Version$ 
+    Description: provides a generic device interface between
+                 ISO channels and the underlying PIM style
+                 FIO procedure calls.
+*)
+
+FROM RTgenif IMPORT GenDevIF ;
+FROM IOLink IMPORT DeviceId, DeviceTablePtr;
+FROM IOConsts IMPORT ReadResults ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+   ChanDev ;
+   DeviceType = (seqfile, streamfile, programargs, stdchans, term, socket, rndfile) ;
+
+
+(*
+   InitChanDev - initialize and return a ChanDev.
+*)
+
+PROCEDURE InitChanDev (t: DeviceType; d: DeviceId; g: GenDevIF) : ChanDev ;
+
+
+(*
+   KillChanDev - deallocates, g.
+*)
+
+PROCEDURE KillChanDev (g: GenDevIF) : GenDevIF ;
+
+
+(*
+   RaiseEOFinLook - returns TRUE if the Look procedure
+                    should raise an exception if it
+                    sees end of file.
+*)
+
+PROCEDURE RaiseEOFinLook (g: ChanDev) : BOOLEAN ;
+
+
+(*
+   RaiseEOFinSkip - returns TRUE if the Skip procedure
+                    should raise an exception if it
+                    sees end of file.
+*)
+
+PROCEDURE RaiseEOFinSkip (g: ChanDev) : BOOLEAN ;
+
+
+PROCEDURE doLook (g: ChanDev;
+                  d: DeviceTablePtr;
+                  VAR ch: CHAR;
+                  VAR r: ReadResults) ;
+
+PROCEDURE doSkip (g: ChanDev;
+                  d: DeviceTablePtr) ;
+
+PROCEDURE doSkipLook (g: ChanDev;
+                      d: DeviceTablePtr;
+                      VAR ch: CHAR;
+                      VAR r: ReadResults) ;
+
+PROCEDURE doWriteLn (g: ChanDev;
+                     d: DeviceTablePtr) ;
+
+PROCEDURE doReadText (g: ChanDev;
+                      d: DeviceTablePtr;
+                      to: ADDRESS;
+                      maxChars: CARDINAL;
+                      VAR charsRead: CARDINAL) ;
+
+PROCEDURE doWriteText (g: ChanDev;
+                       d: DeviceTablePtr;
+                       from: ADDRESS;
+                       charsToWrite: CARDINAL) ;
+
+PROCEDURE doReadLocs (g: ChanDev;
+                      d: DeviceTablePtr;
+                      to: ADDRESS;
+                      maxLocs: CARDINAL;
+                      VAR locsRead: CARDINAL) ;
+
+PROCEDURE doWriteLocs (g: ChanDev;
+                       d: DeviceTablePtr;
+                       from: ADDRESS;
+                       locsToWrite: CARDINAL) ;
+
+(*
+   checkErrno - checks a number of errno conditions and raises
+                appropriate ISO exceptions if they occur.
+*)
+
+PROCEDURE checkErrno (g: ChanDev; d: DeviceTablePtr) ;
+
+
+END RTgen.
diff --git a/gcc/m2/gm2-libs-iso/RTgen.mod b/gcc/m2/gm2-libs-iso/RTgen.mod
new file mode 100644
index 00000000000..522ee245fb9
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTgen.mod
@@ -0,0 +1,483 @@
+(* RTgen.mod implement a generic device interface used by ISO.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RTgen ;
+
+
+FROM IOChan IMPORT ChanId, InvalidChan, ChanExceptions ;
+
+FROM IOLink IMPORT DeviceTablePtr, DeviceTablePtrValue,
+                   RAISEdevException ;
+
+IMPORT ChanConsts ;
+IMPORT IOConsts ;
+IMPORT ErrnoCategory ;
+IMPORT RTgen ;
+
+FROM RTgenif IMPORT GenDevIF, getDID,
+                    doReadChar, doUnReadChar, doGetErrno,
+                    doRBytes, doWBytes,
+                    doWBytes, doWrLn,
+                    isEOF, isError, isEOLN ;
+
+FROM ChanConsts IMPORT FlagSet, readFlag, writeFlag, rawFlag,
+                       textFlag, read, write, raw, text ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+
+TYPE
+   ChanDev = POINTER TO RECORD
+                           type : DeviceType ;
+                           did  : DeviceId ;
+                           genif: GenDevIF ;
+                        END ;
+
+   deviceExceptions = ARRAY DeviceType OF BOOLEAN ;
+
+VAR
+   raiseEofInLook,
+   raiseEofInSkip: deviceExceptions ;
+
+
+(*
+   InitChanDev - initialize and return a ChanDev.
+*)
+
+PROCEDURE InitChanDev (t: DeviceType; d: DeviceId; g: GenDevIF) : ChanDev ;
+VAR
+   c: ChanDev ;
+BEGIN
+   NEW(c) ;
+   WITH c^ DO
+      type := t ;
+      did := d ;
+      genif := g
+   END ;
+   RETURN( c )
+END InitChanDev ;
+
+
+(*
+   KillChanDev - deallocates, g.
+*)
+
+PROCEDURE KillChanDev (g: GenDevIF) : GenDevIF ;
+BEGIN
+   DISPOSE(g) ;
+   RETURN( NIL )
+END KillChanDev ;
+
+
+(* internal routine to check whether we have a valid channel *)
+
+PROCEDURE checkValid (g: ChanDev; d: DeviceTablePtr) ;
+BEGIN
+   WITH d^ DO
+      IF getDID(g^.genif)#did
+      THEN
+         RAISEdevException(cid, did, wrongDevice,
+                           'operation attempted on an invalid channel')
+      END ;
+      IF (cid=InvalidChan()) OR (cid=NIL)
+      THEN
+         RAISEdevException(cid, did, wrongDevice,
+                           'operation attempted on an invalid channel')
+      END ;
+      IF d#DeviceTablePtrValue(cid, did)
+      THEN
+         RAISEdevException(cid, did, wrongDevice,
+                           'operation attempted on an invalid channel')
+      END
+   END
+END checkValid ;
+
+
+(*
+   checkErrno - checks a number of errno conditions and raises
+                appropriate ISO exceptions if they occur.
+*)
+
+PROCEDURE checkErrno (g: ChanDev; d: DeviceTablePtr) ;
+BEGIN
+   WITH d^ DO
+      IF isError(g^.genif, d)
+      THEN
+         errNum := doGetErrno(g^.genif, d) ;
+         IF ErrnoCategory.IsErrnoHard(errNum)
+         THEN
+            RAISEdevException(cid, did, notAvailable,
+                              'unrecoverable (errno)')
+         ELSIF ErrnoCategory.UnAvailable(errNum)
+         THEN
+            RAISEdevException(cid, did, notAvailable,
+                              'unavailable (errno)')
+         ELSIF errNum>0
+         THEN
+            RAISEdevException(cid, did, notAvailable,
+                              'recoverable (errno)')
+         END
+      END
+   END
+END checkErrno ;
+
+
+PROCEDURE checkPreRead (g: ChanDev;
+                        d: DeviceTablePtr;
+                        raise, raw: BOOLEAN) ;
+BEGIN
+   WITH d^ DO
+      IF isEOF(g^.genif, d)
+      THEN
+         result := IOConsts.endOfInput ;
+         IF raise
+         THEN
+            RAISEdevException(cid, did, skipAtEnd,
+                              'attempting to read beyond end of file')
+         END
+      ELSIF (NOT raw) AND isEOLN(g^.genif, d)
+      THEN
+         result := IOConsts.endOfLine
+      ELSE
+         result := IOConsts.allRight
+      END
+   END
+END checkPreRead ;
+
+
+(*
+   checkPostRead - checks whether an error occurred and sets
+                   the result status.  This must only be called
+                   after a read.
+*)
+
+PROCEDURE checkPostRead (g: ChanDev; d: DeviceTablePtr) ;
+BEGIN
+   checkErrno(g, d) ;
+   setReadResult(g, d)
+END checkPostRead ;
+
+
+(*
+   setReadResult -
+*)
+
+PROCEDURE setReadResult (g: ChanDev; d: DeviceTablePtr) ;
+BEGIN
+   WITH d^ DO
+      IF isEOF(g^.genif, d)
+      THEN
+         result := IOConsts.endOfInput
+      ELSIF isEOLN(g^.genif, d)
+      THEN
+         result := IOConsts.endOfLine
+      ELSE
+         result := IOConsts.allRight
+      END
+   END
+END setReadResult ;
+
+
+PROCEDURE checkPreWrite (g: ChanDev; d: DeviceTablePtr) ;
+BEGIN
+   (* nothing to do *)
+END checkPreWrite ;
+
+
+PROCEDURE checkPostWrite (g: ChanDev; d: DeviceTablePtr) ;
+BEGIN
+   checkErrno(g, d)
+END checkPostWrite ;
+
+
+(*
+   checkFlags - checks read/write  raw/text consistancy flags.
+*)
+
+PROCEDURE checkFlags (f: FlagSet; d: DeviceTablePtr) ;
+BEGIN
+   WITH d^ DO
+      IF (readFlag IN f) AND (NOT (readFlag IN flags))
+      THEN
+         RAISEdevException(cid, did, wrongDevice,
+                           'attempting to read from a channel which was configured to write')
+      END ;
+      IF (writeFlag IN f) AND (NOT (writeFlag IN flags))
+      THEN
+         RAISEdevException(cid, did, wrongDevice,
+                           'attempting to write to a channel which was configured to read')
+      END ;
+      IF (rawFlag IN f) AND (NOT (rawFlag IN flags))
+      THEN
+         IF readFlag IN flags
+         THEN
+            RAISEdevException(cid, did, notAvailable,
+                              'attempting to read raw LOCs from a channel which was configured to read text')
+         ELSE
+            RAISEdevException(cid, did, notAvailable,
+                              'attempting to write raw LOCs from a channel which was configured to write text')
+         END
+      END
+   END
+END checkFlags ;
+
+
+(*
+   RaiseEOFinLook - returns TRUE if the Look procedure
+                    should raise an exception if it
+                    sees end of file.
+*)
+
+PROCEDURE RaiseEOFinLook (g: ChanDev) : BOOLEAN ;
+BEGIN
+   RETURN( raiseEofInLook[g^.type] )
+END RaiseEOFinLook ;
+
+
+(*
+   RaiseEOFinSkip - returns TRUE if the Skip procedure
+                    should raise an exception if it
+                    sees end of file.
+*)
+
+PROCEDURE RaiseEOFinSkip (g: ChanDev) : BOOLEAN ;
+BEGIN
+   RETURN( raiseEofInSkip[g^.type] )
+END RaiseEOFinSkip ;
+
+
+(*
+   doLook - if there is a character as the next item in
+            the input stream then it assigns its value
+            to ch without removing it from the stream;
+            otherwise the value of ch is not defined.
+            r and result are set to the value allRight,
+            endOfLine, or endOfInput.
+*)
+
+PROCEDURE doLook (g: ChanDev;
+                  d: DeviceTablePtr;
+                  VAR ch: CHAR;
+                  VAR r: ReadResults) ;
+VAR
+   old: ReadResults ;
+BEGIN
+   checkValid(g, d) ;
+   WITH d^ DO
+      checkErrno(g, d) ;
+      checkPreRead(g, d, RaiseEOFinLook(g), ChanConsts.rawFlag IN flags) ;
+      IF (result=IOConsts.allRight) OR (result=IOConsts.notKnown) OR
+         (result=IOConsts.endOfLine) 
+      THEN
+         old := result ;
+         ch := doReadChar(g^.genif, d) ;
+         setReadResult(g, d) ;
+         r := result ;
+         ch := doUnReadChar(g^.genif, d, ch) ;
+         result := old
+      END
+   END
+END doLook ;
+
+
+(*
+   doSkip - 
+*)
+
+PROCEDURE doSkip (g: ChanDev;
+                  d: DeviceTablePtr) ;
+VAR
+   ch: CHAR ;
+BEGIN
+   checkValid(g, d) ;
+   WITH d^ DO
+      checkPreRead(g, d, RaiseEOFinSkip(g), ChanConsts.rawFlag IN flags) ;
+      ch := doReadChar(g^.genif, d) ;
+      checkPostRead(g, d)
+   END
+END doSkip ;
+
+
+(*
+   doSkipLook - read a character, ignore it.  Read another and unread it
+                return the new character.
+*)
+
+PROCEDURE doSkipLook (g: ChanDev;
+                      d: DeviceTablePtr;
+                      VAR ch: CHAR;
+                      VAR r: ReadResults) ;
+BEGIN
+   doSkip(g, d) ;
+   doLook(g, d, ch, r)
+END doSkipLook ;
+
+
+PROCEDURE doWriteLn (g: ChanDev;
+                     d: DeviceTablePtr) ;
+BEGIN
+   checkValid(g, d) ;
+   WITH d^ DO
+      checkPreWrite(g, d) ;
+      IF doWrLn(g^.genif, d)
+      THEN
+      END ;
+      checkPostWrite(g, d)
+   END
+END doWriteLn ;
+
+
+PROCEDURE doReadText (g: ChanDev;
+                      d: DeviceTablePtr;
+                      to: ADDRESS;
+                      maxChars: CARDINAL;
+                      VAR charsRead: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   checkValid(g, d) ;
+   checkFlags(read+text, d) ;
+   IF maxChars>0
+   THEN
+      WITH d^ DO
+         INCL(flags, textFlag) ;
+         checkPreRead(g, d, FALSE, FALSE) ;
+         charsRead := 0 ;
+         REPEAT
+            IF doRBytes(g^.genif, d, to, maxChars, i)
+            THEN
+               INC(charsRead, i) ;
+               INC(to, i) ;
+               DEC(maxChars, i)
+            ELSE
+               checkErrno(g, d) ;
+               (* if our target system does not support errno then we *)
+               RAISEdevException(cid, did, notAvailable,
+                                 'textread unrecoverable errno')
+            END
+         UNTIL (maxChars=0) OR isEOF(g^.genif, d) ;
+         checkPostRead(g, d)
+      END
+   END
+END doReadText ;
+
+
+PROCEDURE doWriteText (g: ChanDev;
+                       d: DeviceTablePtr;
+                       from: ADDRESS;
+                       charsToWrite: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   checkValid(g, d) ;
+   checkFlags(write+text, d) ;
+   WITH d^ DO
+      checkPreWrite(g, d) ;
+      INCL(flags, textFlag) ;
+      WHILE (charsToWrite>0) AND doWBytes(g^.genif, d, from, charsToWrite, i) DO
+         INC(from, i) ;
+         DEC(charsToWrite, i)
+      END ;
+      IF isError(g^.genif, d)
+      THEN
+         checkErrno(g, d) ;
+         (* if our target system does not support errno then we *)
+         RAISEdevException(cid, did, notAvailable,
+                           'textwrite unrecoverable errno')
+      END ;
+      checkPostWrite(g, d)
+   END
+END doWriteText ;
+
+
+PROCEDURE doReadLocs (g: ChanDev;
+                      d: DeviceTablePtr;
+                      to: ADDRESS;
+                      maxLocs: CARDINAL;
+                      VAR locsRead: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   checkValid(g, d) ;
+   checkFlags(read+raw, d) ;
+   IF maxLocs>0
+   THEN
+      WITH d^ DO
+         INCL(flags, rawFlag) ;
+         checkPreRead(g, d, FALSE, TRUE) ;
+         locsRead := 0 ;
+         REPEAT
+            IF doRBytes(g^.genif, d, to, maxLocs, i)
+            THEN
+               INC(locsRead, i) ;
+               INC(to, i) ;
+               DEC(maxLocs, i)
+            ELSE
+               checkErrno(g, d) ;
+               (* if our target system does not support errno then we *)
+               RAISEdevException(cid, did, notAvailable,
+                                 'rawread unrecoverable errno')
+            END
+         UNTIL (maxLocs=0) OR isEOF(g^.genif, d) ;
+         checkPostRead(g, d)
+      END
+   END
+END doReadLocs ;
+
+
+PROCEDURE doWriteLocs (g: ChanDev;
+                       d: DeviceTablePtr;
+                       from: ADDRESS;
+                       locsToWrite: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   checkValid(g, d) ;
+   checkFlags(write+raw, d) ;
+   WITH d^ DO
+      checkPreWrite(g, d) ;
+      INCL(flags, rawFlag) ;
+      WHILE doWBytes(g^.genif, d, from, locsToWrite, i) AND (i<locsToWrite) DO
+         INC(from, i) ;
+         DEC(locsToWrite, i)
+      END ;
+      IF isError(g^.genif, d)
+      THEN
+         checkErrno(g, d) ;
+         (* if our target system does not support errno then we *)
+         RAISEdevException(cid, did, notAvailable,
+                           'rawwrite unrecoverable errno')
+      END ;
+      checkPostWrite(g, d)
+   END
+END doWriteLocs ;
+
+
+BEGIN
+   (*                                 seqfile, streamfile, programargs, stdchans, term , socket, rndfile *)
+   raiseEofInLook := deviceExceptions{ FALSE  , FALSE     , FALSE      , FALSE   , FALSE, FALSE , FALSE };
+   raiseEofInSkip := deviceExceptions{ TRUE   , TRUE      , TRUE       , TRUE    , TRUE , TRUE  , TRUE };
+END RTgen.
diff --git a/gcc/m2/gm2-libs-iso/RTgenif.def b/gcc/m2/gm2-libs-iso/RTgenif.def
new file mode 100644
index 00000000000..ef95038de6b
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTgenif.def
@@ -0,0 +1,159 @@
+(* RTgenif.def provide a generic device interface mechanism used by RTgen.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE RTgenif ;
+
+(*
+    Title      : RTgenif
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon Sep 22 17:13:45 2008
+    Revision   : $Version$ 
+    Description: provides a generic interface mechanism used
+                 by RTgen.  This is not an ISO module but rather
+                 a runtime support module.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM IOLink IMPORT DeviceId, DeviceTablePtr ;
+
+TYPE
+   GenDevIF ;
+   readchar   = PROCEDURE (GenDevIF, DeviceTablePtr) : CHAR ;
+   unreadchar = PROCEDURE (GenDevIF, DeviceTablePtr, CHAR) : CHAR ;
+   geterrno   = PROCEDURE (GenDevIF, DeviceTablePtr) : INTEGER ;
+   readbytes  = PROCEDURE (GenDevIF, DeviceTablePtr, ADDRESS, CARDINAL, VAR CARDINAL) : BOOLEAN ;
+   writebytes = PROCEDURE (GenDevIF, DeviceTablePtr, ADDRESS, CARDINAL, VAR CARDINAL) : BOOLEAN ;
+   writeln    = PROCEDURE (GenDevIF, DeviceTablePtr) : BOOLEAN ;
+   iseof      = PROCEDURE (GenDevIF, DeviceTablePtr) : BOOLEAN ;
+   iseoln     = PROCEDURE (GenDevIF, DeviceTablePtr) : BOOLEAN ;
+   iserror    = PROCEDURE (GenDevIF, DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   InitGenDevIF - initializes a generic device.
+*)
+
+PROCEDURE InitGenDevIF (d     : DeviceId;
+                        rc    : readchar;
+                        urc   : unreadchar;
+                        geterr: geterrno;
+                        rbytes: readbytes;
+                        wbytes: writebytes;
+                        wl    : writeln;
+                        eof   : iseof;
+                        eoln  : iseoln;
+                        iserr : iserror) : GenDevIF ;
+
+
+(*
+   getDID - returns the device id this generic interface.
+*)
+
+PROCEDURE getDID (g: GenDevIF) : DeviceId ;
+
+
+(*
+   doReadChar - returns the next character from the generic
+                device.
+*)
+
+PROCEDURE doReadChar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+
+
+(*
+   doUnReadChar - pushes back a character to the generic device.
+*)
+
+PROCEDURE doUnReadChar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+
+
+(*
+   doGetErrno - returns the errno relating to the generic device.
+*)
+
+PROCEDURE doGetErrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+
+
+(*
+   doRBytes - attempts to read, n, bytes from the generic device.
+              It set the actual amount read and returns a boolean
+              to determine whether an error occurred.
+*)
+
+PROCEDURE doRBytes (g: GenDevIF; d: DeviceTablePtr;
+                    to: ADDRESS; max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+
+
+(*
+   doWBytes - attempts to write, n, bytes to the generic device.
+              It sets the actual amount written and returns a
+              boolean to determine whether an error occurred.
+*)
+
+PROCEDURE doWBytes (g: GenDevIF; d: DeviceTablePtr;
+                    from: ADDRESS; max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+
+
+(*
+   doWrLn - writes an end of line marker and returns
+            TRUE if successful.
+*)
+
+PROCEDURE doWrLn (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   isEOF - returns true if the end of file was reached.
+*)
+
+PROCEDURE isEOF (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   isEOLN - returns true if the end of line was reached.
+*)
+
+PROCEDURE isEOLN (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   isError - returns true if an error was seen in the device.
+*)
+
+PROCEDURE isError (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   KillGenDevIF - deallocates a generic device.
+*)
+
+PROCEDURE KillGenDevIF (g: GenDevIF) : GenDevIF ;
+
+
+END RTgenif.
diff --git a/gcc/m2/gm2-libs-iso/RTgenif.mod b/gcc/m2/gm2-libs-iso/RTgenif.mod
new file mode 100644
index 00000000000..a732ad3c72b
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTgenif.mod
@@ -0,0 +1,200 @@
+(* RTgenif.mod implement a generic device interface mechanism used by RTgen.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RTgenif ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+TYPE
+   GenDevIF = POINTER TO RECORD
+                            did       : DeviceId ;
+                            dorc      : readchar ;
+                            dourc     : unreadchar ;
+                            dogeterrno: geterrno ;
+                            dorbytes  : readbytes ;
+                            dowbytes  : writebytes ;
+                            dowrln    : writeln;
+                            doeof     : iseof ;
+                            doeoln    : iseoln ;
+                            doerror   : iserror ;
+                         END ;
+
+
+(*
+   InitGenDev - initializes a generic device.
+*)
+
+PROCEDURE InitGenDevIF (d     : DeviceId;
+                        rc    : readchar;
+                        urc   : unreadchar;
+                        geterr: geterrno;
+                        rbytes: readbytes;
+                        wbytes: writebytes;
+                        wl    : writeln;
+                        eof   : iseof;
+                        eoln  : iseoln;
+                        iserr : iserror) : GenDevIF ;
+VAR
+   g: GenDevIF ;
+BEGIN
+   NEW(g) ;
+   WITH g^ DO
+      did := d ;
+      dorc := rc ;
+      dourc := urc ;
+      dogeterrno := geterr ;
+      dorbytes := rbytes ;
+      dowbytes := wbytes ;
+      dowrln := wl ;
+      doeof := eof ;
+      doeoln := eoln ;
+      doerror := iserr
+   END ;
+   RETURN( g )
+END InitGenDevIF ;
+
+
+(*
+   getDID - returns the device id belonging to this generic interface.
+*)
+
+PROCEDURE getDID (g: GenDevIF) : DeviceId ;
+BEGIN
+   RETURN( g^.did )
+END getDID ;
+
+
+(*
+   doReadChar - returns the next character from the generic device.
+*)
+
+PROCEDURE doReadChar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+BEGIN
+   RETURN( g^.dorc(g, d) )
+END doReadChar ;
+
+
+(*
+   doUnReadChar - pushes back a character to the generic device.
+*)
+
+PROCEDURE doUnReadChar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+BEGIN
+   RETURN( g^.dourc(g, d, ch) )
+END doUnReadChar ;
+
+
+(*
+   doGetErrno - returns the errno relating to the generic device.
+*)
+
+PROCEDURE doGetErrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+BEGIN
+   RETURN( g^.dogeterrno(g, d) )
+END doGetErrno ;
+
+
+(*
+   doRBytes - attempts to read, n, bytes from the generic device.
+              It set the actual amount read and returns a boolean
+              to determine whether an error occurred.
+*)
+
+PROCEDURE doRBytes (g: GenDevIF; d: DeviceTablePtr;
+                    to: ADDRESS; max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( g^.dorbytes(g, d, to, max, actual) )
+END doRBytes ;
+
+
+(*
+   doWBytes - attempts to write, n, bytes to the generic device.
+              It sets the actual amount written and returns a
+              boolean to determine whether an error occurred.
+*)
+
+PROCEDURE doWBytes (g: GenDevIF; d: DeviceTablePtr;
+                    from: ADDRESS; max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( g^.dowbytes(g, d, from, max, actual) )
+END doWBytes ;
+
+
+(*
+   doWrLn - writes an end of line marker and returns
+            TRUE if successful.
+*)
+
+PROCEDURE doWrLn (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RETURN( g^.dowrln(g, d) )
+END doWrLn ;
+
+
+(*
+   isEOF - returns true if the end of file was reached.
+*)
+
+PROCEDURE isEOF (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RETURN( g^.doeof(g, d) )
+END isEOF ;
+
+
+(*
+   isEOLN - returns true if the end of line was reached.
+*)
+
+PROCEDURE isEOLN (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RETURN( g^.doeoln(g, d) )
+END isEOLN ;
+
+
+(*
+   isError - returns true if an error was seen in the device.
+*)
+
+PROCEDURE isError (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RETURN( g^.doerror(g, d) )
+END isError ;   
+
+
+(*
+   KillGenDevIF - deallocates a generic device.
+*)
+
+PROCEDURE KillGenDevIF (g: GenDevIF) : GenDevIF ;
+BEGIN
+   DISPOSE(g) ;
+   RETURN( NIL )
+END KillGenDevIF ;
+
+
+END RTgenif.
diff --git a/gcc/m2/gm2-libs-iso/RTio.def b/gcc/m2/gm2-libs-iso/RTio.def
new file mode 100644
index 00000000000..4b7e18155ea
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTio.def
@@ -0,0 +1,110 @@
+(* RTio.def provides low level routines for creating and destroying ChanIds.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE RTio ;
+
+(*
+    Title      : RTio
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Sun Sep  7 16:32:48 2008
+    Revision   : $Version$ 
+    Description: provides low level routines for creating and destroying
+                 ChanIds.  This is necessary to allow multiple modules
+                 to create, ChanId values, where ChanId is an opaque
+                 type.
+*)
+
+IMPORT FIO, IOLink ;
+
+TYPE
+   ChanId ;
+
+
+(*
+   InitChanId - return a new ChanId.
+*)
+
+PROCEDURE InitChanId () : ChanId ;
+
+
+(*
+   KillChanId - deallocate a ChanId.
+*)
+
+PROCEDURE KillChanId (c: ChanId) : ChanId ;
+
+
+(*
+   NilChanId - return a NIL pointer.
+*)
+
+PROCEDURE NilChanId () : ChanId ;
+
+
+(*
+   GetDeviceId - returns the device id, from, c.
+*)
+
+PROCEDURE GetDeviceId (c: ChanId) : IOLink.DeviceId ;
+
+
+(*
+   SetDeviceId - sets the device id in, c.
+*)
+
+PROCEDURE SetDeviceId (c: ChanId; d: IOLink.DeviceId) ;
+
+
+(*
+   GetDevicePtr - returns the device table ptr, from, c.
+*)
+
+PROCEDURE GetDevicePtr (c: ChanId) : IOLink.DeviceTablePtr ;
+
+
+(*
+   SetDevicePtr - sets the device table ptr in, c.
+*)
+
+PROCEDURE SetDevicePtr (c: ChanId; p: IOLink.DeviceTablePtr) ;
+
+
+(*
+   GetFile - returns the file field from, c.
+*)
+
+PROCEDURE GetFile (c: ChanId) : FIO.File ;
+
+
+(*
+   SetFile - sets the file field in, c.
+*)
+
+PROCEDURE SetFile (c: ChanId; f: FIO.File) ;
+
+
+END RTio.
diff --git a/gcc/m2/gm2-libs-iso/RTio.mod b/gcc/m2/gm2-libs-iso/RTio.mod
new file mode 100644
index 00000000000..3d1919b78bc
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RTio.mod
@@ -0,0 +1,133 @@
+(* RTio.mod implements low level routines for creating and destroying ChanIds.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RTio ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+
+TYPE
+   ChanId = POINTER TO RECORD
+                          did  : IOLink.DeviceId ;
+                          dtp  : IOLink.DeviceTablePtr ;
+                          file : FIO.File ;
+                       END ;
+
+
+(*
+   InitChanId - return a new ChanId.
+*)
+
+PROCEDURE InitChanId () : ChanId ;
+VAR
+   c: ChanId ;
+BEGIN
+   NEW(c) ;
+   RETURN( c )
+END InitChanId ;
+
+
+(*
+   InitChanId - deallocate a ChanId.
+*)
+
+PROCEDURE KillChanId (c: ChanId) : ChanId ;
+BEGIN
+   DISPOSE(c) ;
+   RETURN( NIL )
+END KillChanId ;
+
+
+(*
+   NilChanId - return a NIL pointer.
+*)
+
+PROCEDURE NilChanId () : ChanId ;
+BEGIN
+   RETURN( NIL )
+END NilChanId ;
+
+
+(*
+   GetDeviceId - returns the device id, from, c.
+*)
+
+PROCEDURE GetDeviceId (c: ChanId) : IOLink.DeviceId ;
+BEGIN
+   RETURN( c^.did )
+END GetDeviceId ;
+
+
+(*
+   SetDeviceId - returns the device id, from, c.
+*)
+
+PROCEDURE SetDeviceId (c: ChanId; d: IOLink.DeviceId) ;
+BEGIN
+   c^.did := d
+END SetDeviceId ;
+
+
+(*
+   GetDevicePtr - returns the device table ptr, from, c.
+*)
+
+PROCEDURE GetDevicePtr (c: ChanId) : IOLink.DeviceTablePtr ;
+BEGIN
+   RETURN( c^.dtp )
+END GetDevicePtr ;
+
+(*
+   SetDevicePtr - sets the device table ptr in, c.
+*)
+
+PROCEDURE SetDevicePtr (c: ChanId; p: IOLink.DeviceTablePtr) ;
+BEGIN
+   c^.dtp := p
+END SetDevicePtr ;
+
+
+(*
+   GetFile - returns the file field from, c.
+*)
+
+PROCEDURE GetFile (c: ChanId) : FIO.File ;
+BEGIN
+   RETURN( c^.file )
+END GetFile ;
+
+
+(*
+   SetFile - sets the file field in, c.
+*)
+
+PROCEDURE SetFile (c: ChanId; f: FIO.File) ;
+BEGIN
+   c^.file := f
+END SetFile ;
+
+
+END RTio.
diff --git a/gcc/m2/gm2-libs-iso/RandomNumber.def b/gcc/m2/gm2-libs-iso/RandomNumber.def
new file mode 100644
index 00000000000..7c0dd65f231
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RandomNumber.def
@@ -0,0 +1,131 @@
+(* RandomNumber.def provide a set of random number procedures for pervasive types.
+
+Copyright (C) 2012-2021 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/>.  *)
+
+DEFINITION MODULE RandomNumber ;
+
+(*
+    Title      : Random
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Wed Nov 26 15:38:01 2012
+    Revision   : $Version$ 
+    Description: provides primitives for obtaining random numbers on
+                 pervasive data types.
+*)
+
+FROM SYSTEM IMPORT BYTE ;
+EXPORT QUALIFIED Randomize, RandomInit, RandomBytes,
+                 RandomCard, RandomShortCard, RandomLongCard,
+                 RandomInt, RandomShortInt, RandomLongInt,
+                 RandomReal, RandomLongReal, RandomShortReal ;
+
+
+(*
+   Randomize - initialize the random number generator with a seed
+               based on the microseconds.
+*)
+
+PROCEDURE Randomize ;
+
+
+(*
+   RandomInit - initialize the random number generator with value, seed.
+*)
+
+PROCEDURE RandomInit (seed: CARDINAL) ;
+
+
+(*
+   RandomBytes - fills in an array with random values.
+*)
+
+PROCEDURE RandomBytes (VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   RandomInt - return an INTEGER in the range [low .. high].
+*)
+
+PROCEDURE RandomInt (low, high: INTEGER) : INTEGER ;
+
+
+(*
+   RandomShortInt - return an SHORTINT in the range [low..high].
+*)
+
+PROCEDURE RandomShortInt (low, high: SHORTINT) : SHORTINT ;
+
+
+(*
+   RandomLongInt - return an LONGINT in the range [low..high].
+*)
+
+PROCEDURE RandomLongInt (low, high: LONGINT) : LONGINT ;
+
+
+(*
+   RandomShortCard - return a SHORTCARD in the range [low..high].
+*)
+
+PROCEDURE RandomShortCard (low, high: CARDINAL) : CARDINAL ;
+
+
+(*
+   RandomCard - return a CARDINAL in the range [low..high].
+*)
+
+PROCEDURE RandomCard (low, high: CARDINAL) : CARDINAL ;
+
+
+(*
+   RandomLongCard - return an LONGCARD in the range [low..high].
+*)
+
+PROCEDURE RandomLongCard (low, high: LONGCARD) : LONGCARD ;
+
+
+(*
+   RandomReal - return a REAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomReal () : REAL ;
+
+
+(*
+   RandomShortReal - return a SHORTREAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomShortReal () : SHORTREAL ;
+
+
+(*
+   RandomLongReal - return a LONGREAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomLongReal () : LONGREAL ;
+
+
+END RandomNumber.
diff --git a/gcc/m2/gm2-libs-iso/RandomNumber.mod b/gcc/m2/gm2-libs-iso/RandomNumber.mod
new file mode 100644
index 00000000000..d4667434ef3
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RandomNumber.mod
@@ -0,0 +1,200 @@
+(* RandomNumber.mod implement a set of random number procedures for pervasive types.
+
+Copyright (C) 2012-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RandomNumber ;
+
+
+FROM libc IMPORT rand, srand ;
+FROM Selective IMPORT Timeval, InitTime, KillTime, GetTime, GetTimeOfDay ;
+
+
+(*
+   Randomize - initialize the random number generator with a seed
+               based on the microseconds.
+*)
+
+PROCEDURE Randomize ;
+VAR
+   t        : Timeval ;
+   sec, usec: CARDINAL ;
+BEGIN
+   t := InitTime(0, 0) ;
+   IF GetTimeOfDay(t)=0
+   THEN
+   END ;
+   GetTime(t, sec, usec) ;
+   RandomInit(usec) ;
+   t := KillTime(t)
+END Randomize ;
+
+
+(*
+   RandomInit - initialize the random number generator with value, seed.
+*)
+
+PROCEDURE RandomInit (seed: CARDINAL) ;
+BEGIN
+   srand(seed)
+END RandomInit ;
+
+
+(*
+   RandomBytes - fills in an array with random values.
+*)
+
+PROCEDURE RandomBytes (VAR a: ARRAY OF BYTE) ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   h := HIGH(a) ;
+   i := 0 ;
+   WHILE i<=h DO
+      a[i] := VAL(BYTE, rand()) ;
+      INC(i)
+   END
+END RandomBytes ;
+
+
+(*
+   RandomInt - return an INTEGER in the range [low .. high].
+*)
+
+PROCEDURE RandomInt (low, high: INTEGER) : INTEGER ;
+BEGIN
+   RETURN VAL(INTEGER, RandomLongInt(low, high))
+END RandomInt ;
+
+
+(*
+   RandomShortInt - return an SHORTINT in the range [low..high].
+*)
+
+PROCEDURE RandomShortInt (low, high: SHORTINT) : SHORTINT ;
+BEGIN
+   RETURN VAL(SHORTINT, RandomInt(low, high))
+END RandomShortInt ;
+
+
+(*
+   RandomLongInt - return an LONGINT in the range [low..high].
+*)
+
+PROCEDURE RandomLongInt (low, high: LONGINT) : LONGINT ;
+VAR
+   random: LONGINT ;
+   values,
+   number: LONGCARD ;
+BEGIN
+   RandomBytes(number) ;
+   IF (low=0) AND (high=0)
+   THEN
+      RETURN number
+   ELSE
+      values := high-low;
+      random := number MOD (values+1) ;
+      RETURN random+low
+   END
+END RandomLongInt ;
+
+
+(*
+   RandomLongCard - return an LONGCARD in the range [low..high].
+*)
+
+PROCEDURE RandomLongCard (low, high: LONGCARD) : LONGCARD ;
+VAR
+   random,
+   values,
+   number: LONGCARD ;
+BEGIN
+   RandomBytes(number) ;
+   IF (low=0) AND (high=0)
+   THEN
+      RETURN number
+   ELSE
+      values := high-low;
+      random := number MOD (values+1) ;
+      RETURN random+low
+   END
+END RandomLongCard ;
+
+
+(*
+   RandomCard - return a CARDINAL in the range [low..high].
+*)
+
+PROCEDURE RandomCard (low, high: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN RandomLongCard(low, high)
+END RandomCard ;
+
+
+(*
+   RandomShortCard - return a SHORTCARD in the range [low..high].
+*)
+
+PROCEDURE RandomShortCard (low, high: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN RandomLongCard(low, high)
+END RandomShortCard ;
+
+
+(*
+   RandomReal - return a REAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomReal () : REAL ;
+BEGIN
+   RETURN RandomLongReal()
+END RandomReal ;
+
+
+(*
+   RandomLongReal - return a LONGREAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomLongReal () : LONGREAL ;
+VAR
+   l: LONGCARD ;
+BEGIN
+   RandomBytes(l) ;
+   RETURN VAL(LONGREAL, l)/VAL(LONGREAL, MAX(LONGCARD))
+END RandomLongReal ;
+
+
+(*
+   RandomShortReal - return a SHORTREAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomShortReal () : SHORTREAL ;
+BEGIN
+   RETURN RandomLongReal()
+END RandomShortReal ;
+
+
+BEGIN
+   Randomize
+END RandomNumber.
diff --git a/gcc/m2/gm2-libs-iso/RawIO.def b/gcc/m2/gm2-libs-iso/RawIO.def
new file mode 100644
index 00000000000..c98914879be
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RawIO.def
@@ -0,0 +1,32 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE RawIO;
+
+  (* Reading and writing data over specified channels using raw
+     operations, that is, with no conversion or interpretation.
+     The read result is of the type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan, SYSTEM;
+
+PROCEDURE Read (cid: IOChan.ChanId; VAR to: ARRAY OF SYSTEM.LOC);
+  (* Reads storage units from cid, and assigns them to
+     successive components of to. The read result is set
+     to the value allRight, wrongFormat, or endOfInput.
+  *)
+
+PROCEDURE Write (cid: IOChan.ChanId; from: ARRAY OF SYSTEM.LOC);
+  (* Writes storage units to cid from successive components
+     of from. *)
+
+END RawIO.
+
diff --git a/gcc/m2/gm2-libs-iso/RawIO.mod b/gcc/m2/gm2-libs-iso/RawIO.mod
new file mode 100644
index 00000000000..7b67b111afc
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RawIO.mod
@@ -0,0 +1,108 @@
+(* RawIO.mod implement the ISO RawIO specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RawIO ;
+
+FROM IOChan IMPORT RawWrite, RawRead, ReadResult ;
+FROM IOConsts IMPORT ReadResults ;
+FROM libc IMPORT printf ;
+FROM FIO IMPORT FlushOutErr ;
+
+
+(* Reading and writing data over specified channels using raw
+   operations, that is, with no conversion or interpretation.
+   The read result is of the type IOConsts.ReadResults.
+*)
+
+(*
+   Read - storage units from cid, and assigns them to successive
+          components of to.  The read result is set to the value
+          allRight, wrongFormat, or endOfInput.
+*)
+
+PROCEDURE Read (cid: IOChan.ChanId; VAR to: ARRAY OF SYSTEM.LOC) ;
+VAR
+   i, n: CARDINAL ;
+   a   : SYSTEM.ADDRESS ;
+BEGIN
+   FlushOutErr ;
+   a := SYSTEM.ADR(to) ;
+   n := HIGH(to)+1 ;
+   LOOP
+      RawRead(cid, a, n, i) ;
+      IF (n=0) OR
+         (ReadResult(cid)=wrongFormat) OR
+         (ReadResult(cid)=endOfInput)
+      THEN
+         EXIT
+      ELSE
+         INC(a, i) ;
+         DEC(n, i)
+      END
+   END
+END Read ;
+
+
+(*
+   memDump - 
+*)
+
+PROCEDURE memDump (a: SYSTEM.ADDRESS; len: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+   p   : POINTER TO SYSTEM.LOC ;
+BEGIN
+   p := a ;
+   j := 0 ;
+   FOR i := 0 TO len DO
+      IF j MOD 16 = 0
+      THEN
+         printf ("\n%p  %02x", p, VAL(CARDINAL, p^))
+      ELSE
+         printf (" %02x", VAL(CARDINAL, p^))
+      END ;
+      INC(p) ;
+      INC(j)
+   END ;
+   printf ("\n")
+END memDump ;
+
+
+(*
+   Write - storage units to cid from successive components of from.
+*)
+
+PROCEDURE Write (cid: IOChan.ChanId; from: ARRAY OF SYSTEM.LOC);
+BEGIN
+(*
+   printf ("in RawIO.mod ");
+   memDump (SYSTEM.ADR(from), HIGH(from)+1) ;
+*)
+   RawWrite(cid, SYSTEM.ADR(from), HIGH(from)+1)
+END Write ;
+
+
+END RawIO.
diff --git a/gcc/m2/gm2-libs-iso/RealConv.def b/gcc/m2/gm2-libs-iso/RealConv.def
new file mode 100644
index 00000000000..e5edfac6ced
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RealConv.def
@@ -0,0 +1,61 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE RealConv;
+
+  (* Low-level REAL/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+  (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+  ConvResults = ConvTypes.ConvResults;
+
+PROCEDURE ScanReal (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState);
+  (* Represents the start state of a finite state scanner for real
+     numbers - assigns class of inputCh to chClass and a procedure
+     representing the next state to nextState.
+   *)
+
+PROCEDURE FormatReal (str: ARRAY OF CHAR): ConvResults;
+  (* Returns the format of the string value for conversion to REAL. *)
+
+PROCEDURE ValueReal (str: ARRAY OF CHAR): REAL;
+  (* Returns the value corresponding to the real number string value
+     str if str is well-formed; otherwise raises the RealConv
+     exception.
+  *)
+
+PROCEDURE LengthFloatReal (real: REAL; sigFigs: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the floating-point string
+     representation of real with sigFigs significant figures.
+  *)
+
+PROCEDURE LengthEngReal (real: REAL; sigFigs: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the floating-point engineering
+     string representation of real with sigFigs significant figures.
+  *)
+
+PROCEDURE LengthFixedReal (real: REAL; place: INTEGER): CARDINAL;
+  (* Returns the number of characters in the fixed-point string
+     representation of real rounded to the given place relative to the
+     decimal point.
+  *)
+
+PROCEDURE IsRConvException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in a
+     routine from this module; otherwise returns FALSE.
+  *)
+
+END RealConv.
diff --git a/gcc/m2/gm2-libs-iso/RealConv.mod b/gcc/m2/gm2-libs-iso/RealConv.mod
new file mode 100644
index 00000000000..15838553d2f
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RealConv.mod
@@ -0,0 +1,349 @@
+(* RealConv.mod implement the ISO RealConv specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RealConv ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM ConvTypes IMPORT ScanClass ;
+FROM CharClass IMPORT IsNumeric, IsWhiteSpace ;
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, KillString, Length, Slice, Mark, Index, string ;
+FROM dtoa IMPORT strtod ;
+FROM ConvStringReal IMPORT RealToFloatString, RealToEngString, RealToFixedString ;
+FROM M2RTS IMPORT Halt ;
+FROM libc IMPORT free ;
+IMPORT EXCEPTIONS ;
+
+
+TYPE
+   RealConvException = (noException, invalid, outofrange) ;
+
+VAR
+   realConv:  EXCEPTIONS.ExceptionSource ;
+
+
+(* Low-level REAL/string conversions *)
+
+(* Represents the start state of a finite state scanner for real
+   numbers - assigns class of inputCh to chClass and a procedure
+   representing the next state to nextState.
+*)
+
+PROCEDURE ScanReal (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanSecondDigit ;
+      chClass := valid
+   ELSIF (inputCh='+') OR (inputCh='-')
+   THEN
+      nextState := scanFirstDigit ;
+      chClass := valid
+   ELSIF IsWhiteSpace(inputCh)
+   THEN
+      nextState := ScanReal ;
+      chClass := padding
+   ELSE
+      nextState := ScanReal ;
+      chClass := invalid
+   END
+END ScanReal ;
+
+
+(*
+   scanFirstDigit - 
+*)
+
+PROCEDURE scanFirstDigit (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                          VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanSecondDigit ;
+      chClass := valid
+   ELSE
+      nextState := scanFirstDigit ;
+      chClass := invalid
+   END
+END scanFirstDigit ;
+
+
+(*
+   scanSecondDigit - 
+*)
+
+PROCEDURE scanSecondDigit (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                           VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanSecondDigit ;
+      chClass := valid
+   ELSIF inputCh='.'
+   THEN
+      nextState := scanFixed ;
+      chClass := valid
+   ELSIF inputCh='E'
+   THEN
+      nextState := scanScientific ;
+      chClass := valid
+   ELSE
+      nextState := noOpFinished ;
+      chClass := terminator
+   END
+END scanSecondDigit ;
+
+
+(*
+   scanFixed - 
+*)
+
+PROCEDURE scanFixed (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                     VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanFixed ;
+      chClass := valid
+   ELSIF inputCh='E'
+   THEN
+      nextState := scanScientific ;
+      chClass := valid
+   ELSE
+      nextState := noOpFinished ;
+      chClass := terminator
+   END
+END scanFixed ;
+
+
+(*
+   scanScientific - 
+*)
+
+PROCEDURE scanScientific (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                          VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanScientificSecond ;
+      chClass := valid
+   ELSIF (inputCh='-') OR (inputCh='+')
+   THEN
+      nextState := scanScientificSign ;
+      chClass := valid
+   ELSE
+      nextState := scanScientific ;
+      chClass := invalid
+   END
+END scanScientific ;
+
+
+(*
+   scanScientificSign - 
+*)
+
+PROCEDURE scanScientificSign (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                              VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanScientificSecond ;
+      chClass := valid
+   ELSE
+      nextState := scanScientificSign ;
+      chClass := invalid
+   END
+END scanScientificSign ;
+
+
+(*
+   scanScientificSecond - 
+*)
+
+PROCEDURE scanScientificSecond (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                                VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanScientificSecond ;
+      chClass := valid
+   ELSE
+      nextState := noOpFinished ;
+      chClass := terminator
+   END
+END scanScientificSecond ;
+
+
+(*
+   noOpFinished - 
+*)
+
+PROCEDURE noOpFinished (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                        VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   nextState := noOpFinished ;
+   chClass := terminator ;
+   (* should we raise an exception here? *)
+END noOpFinished ;
+
+
+(* Returns the format of the string value for conversion to REAL. *)
+
+PROCEDURE FormatReal (str: ARRAY OF CHAR) : ConvResults ;
+VAR
+   proc   : ConvTypes.ScanState ;
+   chClass: ConvTypes.ScanClass ;
+   i, h   : CARDINAL ;
+BEGIN
+   i := 1 ;
+   h := LENGTH(str) ;
+   ScanReal(str[0], chClass, proc) ;
+   WHILE (i<h) AND (chClass=padding) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+   IF chClass=terminator
+   THEN
+      RETURN( strEmpty )
+   END ;
+   WHILE (i<h) AND (chClass=valid) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+   CASE chClass OF
+
+   padding   :  RETURN( strWrongFormat ) |
+   terminator,
+   valid     :  RETURN( strAllRight ) |
+   invalid   :  RETURN( strWrongFormat )
+
+   END
+END FormatReal ;
+
+
+(* Returns the value corresponding to the real number string value
+   str if str is well-formed; otherwise raises the RealConv
+   exception.
+*)
+
+PROCEDURE ValueReal (str: ARRAY OF CHAR) : REAL ;
+BEGIN
+   IF FormatReal(str)=strAllRight
+   THEN
+      RETURN( doValueReal(str) )
+   ELSE
+      EXCEPTIONS.RAISE(realConv, ORD(invalid),
+                       'RealConv.' + __FUNCTION__ + ': real number is invalid')
+   END
+END ValueReal ;
+
+
+(*
+   doValueReal - str, is a well-formed real number and its
+                 value is returned.
+*)
+
+PROCEDURE doValueReal (str: ARRAY OF CHAR) : REAL ;
+VAR
+   r    : REAL ;
+   error: BOOLEAN ;
+   s    : String ;
+BEGIN
+   s := InitString(str) ;
+   r := strtod(string(s), error) ;
+   s := KillString(s) ;
+   IF error
+   THEN
+      EXCEPTIONS.RAISE(realConv, ORD(outofrange),
+                       'RealConv.' + __FUNCTION__ + ': real number is out of range')
+   END ;
+   RETURN( r )
+END doValueReal ;
+
+
+(* Returns the number of characters in the floating-point string
+   representation of real with sigFigs significant figures.
+*)
+
+PROCEDURE LengthFloatReal (real: REAL; sigFigs: CARDINAL) : CARDINAL ;
+VAR
+   s: String ;
+   l: CARDINAL ;
+BEGIN
+   s := RealToFloatString(real, sigFigs) ;
+   l := Length(s) ;
+   s := KillString(s) ;
+   RETURN( l )
+END LengthFloatReal ;
+
+
+(* Returns the number of characters in the floating-point engineering
+   string representation of real with sigFigs significant figures.
+*)
+
+PROCEDURE LengthEngReal (real: REAL; sigFigs: CARDINAL) : CARDINAL ;
+VAR
+   s: String ;
+   l: CARDINAL ;
+BEGIN
+   s := RealToEngString(real, sigFigs) ;
+   l := Length(s) ;
+   s := KillString(s) ;
+   RETURN( l )
+END LengthEngReal ;
+
+
+(* Returns the number of characters in the fixed-point string
+   representation of real rounded to the given place relative to the
+   decimal point.
+*)
+
+PROCEDURE LengthFixedReal (real: REAL; place: INTEGER) : CARDINAL ;
+VAR
+   s: String ;
+   l: CARDINAL ;
+BEGIN
+   s := RealToFixedString(real, place) ;
+   l := Length(s) ;
+   s := KillString(s) ;
+   RETURN( l )
+END LengthFixedReal ;
+
+
+(* Returns TRUE if the current coroutine is in the exceptional
+   execution state because of the raising of an exception in a
+   routine from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsRConvException () : BOOLEAN ;
+BEGIN
+   RETURN( EXCEPTIONS.IsCurrentSource(realConv) )
+END IsRConvException ;
+
+
+BEGIN
+   EXCEPTIONS.AllocateSource(realConv)
+END RealConv.
diff --git a/gcc/m2/gm2-libs-iso/RealIO.def b/gcc/m2/gm2-libs-iso/RealIO.def
new file mode 100644
index 00000000000..d968b165e54
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RealIO.def
@@ -0,0 +1,67 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE RealIO;
+
+  (* Input and output of real numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: REAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed fixed or floating
+     point number.  The value of this number is assigned to real.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: REAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to cid in floating-point text form,
+     with sigFigs significant figures, in a field of the given
+     minimum width.
+  *)
+
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: REAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: REAL;
+                      place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to cid in fixed-point text form,
+     rounded to the given place relative to the decimal point,
+     in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteReal (cid: IOChan.ChanId;
+                     real: REAL; width: CARDINAL);
+  (* Writes the value of real to cid, as WriteFixed if the sign
+     and magnitude can be shown in the given width, or otherwise
+     as WriteFloat.  The number of places or significant digits
+     depends on the given width.
+  *)
+
+END RealIO.
diff --git a/gcc/m2/gm2-libs-iso/RealIO.mod b/gcc/m2/gm2-libs-iso/RealIO.mod
new file mode 100644
index 00000000000..cf94487550d
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RealIO.mod
@@ -0,0 +1,172 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+IMPLEMENTATION MODULE RealIO;
+
+  (* Input and output of real numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+FROM TextIO IMPORT WriteChar, ReadChar ;
+FROM StringChan IMPORT writeString ;
+FROM IOChan IMPORT SetReadResult ;
+FROM IOConsts IMPORT ReadResults ;
+
+FROM ConvStringReal IMPORT RealToFixedString, RealToFloatString,
+                           RealToEngString ;
+
+FROM ConvTypes IMPORT ScanClass, ScanState ;
+FROM TextIO IMPORT WriteChar, ReadChar ;
+FROM DynamicStrings IMPORT String, char, KillString, Length, InitString, ConCatChar, string ;
+FROM RealConv IMPORT ScanReal ;
+FROM StringChan IMPORT writeString, writeFieldWidth ;
+FROM dtoa IMPORT strtod ;
+
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: REAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed fixed or floating
+     point number.  The value of this number is assigned to real.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+VAR
+   chClass  : ScanClass ;
+   nextState: ScanState ;
+   ch       : CHAR ;
+   s        : String ;
+   error    : BOOLEAN ;
+BEGIN
+   ReadChar(cid, ch) ;
+   nextState := ScanReal ;
+   REPEAT
+      nextState(ch, chClass, nextState) ;
+      IF chClass=padding
+      THEN
+         ReadChar(cid, ch)
+      END
+   UNTIL chClass#padding ;
+   IF chClass=valid
+   THEN
+      s := InitString('') ;
+      WHILE chClass=valid DO
+         s := ConCatChar(s, ch) ;
+         ReadChar(cid, ch) ;
+         nextState(ch, chClass, nextState)
+      END ;
+      real := strtod(string(s), error) ;
+      s := KillString(s) ;
+      IF error
+      THEN
+         SetReadResult(cid, outOfRange)
+      ELSE
+         SetReadResult(cid, allRight)
+      END
+   ELSE
+      SetReadResult(cid, wrongFormat)
+   END
+END ReadReal ;
+
+
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: REAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to cid in floating-point text form,
+     with sigFigs significant figures, in a field of the given
+     minimum width.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToFloatString(real, sigFigs) ;
+   writeFieldWidth(cid, s, width) ;
+   s := KillString(s)
+END WriteFloat ;
+
+
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: REAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToEngString(real, sigFigs) ;
+   writeFieldWidth(cid, s, width) ;
+   s := KillString(s)
+END WriteEng ;
+
+
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: REAL;
+                      place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to cid in fixed-point text form,
+     rounded to the given place relative to the decimal point,
+     in a field of the given minimum width.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToFixedString(real, place) ;
+   writeFieldWidth(cid, s, width) ;
+   s := KillString(s)
+END WriteFixed ;
+
+
+PROCEDURE WriteReal (cid: IOChan.ChanId;
+                     real: REAL; width: CARDINAL);
+  (* Writes the value of real to cid, as WriteFixed if the sign
+     and magnitude can be shown in the given width, or otherwise
+     as WriteFloat.  The number of places or significant digits
+     depends on the given width.
+  *)
+VAR
+   sigFigs: CARDINAL ;
+   s      : String ;
+BEGIN
+   sigFigs := width ;
+   WHILE sigFigs>1 DO
+      s := RealToFixedString(real, sigFigs) ;
+      IF Length(s)<=width
+      THEN
+         writeFieldWidth(cid, s, width) ;
+         s := KillString(s) ;
+         RETURN
+      END ;
+      s := KillString(s) ;
+      DEC(sigFigs)
+   END ;
+   sigFigs := width ;
+   WHILE sigFigs#0 DO
+      s := RealToFloatString(real, sigFigs) ;
+      IF Length(s)<=width
+      THEN
+         writeFieldWidth(cid, s, width) ;
+         s := KillString(s) ;
+         RETURN
+      END ;
+      s := KillString(s) ;
+      DEC(sigFigs)
+   END
+END WriteReal ;
+
+
+END RealIO.
diff --git a/gcc/m2/gm2-libs-iso/RealMath.def b/gcc/m2/gm2-libs-iso/RealMath.def
new file mode 100644
index 00000000000..6235d408753
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RealMath.def
@@ -0,0 +1,62 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE RealMath;
+
+  (* Mathematical functions for the type REAL *)
+
+CONST
+  pi   = 3.1415926535897932384626433832795028841972;
+  exp1 = 2.7182818284590452353602874713526624977572;
+
+PROCEDURE __BUILTIN__ sqrt (x: REAL): REAL;
+  (* Returns the positive square root of x *)
+
+PROCEDURE __BUILTIN__ exp (x: REAL): REAL;
+  (* Returns the exponential of x *)
+
+PROCEDURE __BUILTIN__ ln (x: REAL): REAL;
+  (* Returns the natural logarithm of x *)
+
+  (* The angle in all trigonometric functions is measured in radians *)
+
+PROCEDURE __BUILTIN__ sin (x: REAL): REAL;
+  (* Returns the sine of x *)
+
+PROCEDURE __BUILTIN__ cos (x: REAL): REAL;
+  (* Returns the cosine of x *)
+
+PROCEDURE tan (x: REAL): REAL;
+  (* Returns the tangent of x *)
+
+PROCEDURE arcsin (x: REAL): REAL;
+  (* Returns the arcsine of x *)
+
+PROCEDURE arccos (x: REAL): REAL;
+  (* Returns the arccosine of x *)
+
+PROCEDURE arctan (x: REAL): REAL;
+  (* Returns the arctangent of x *)
+
+PROCEDURE power (base, exponent: REAL) : REAL;
+  (* Returns the value of the number base raised to the power exponent *)
+
+PROCEDURE round (x: REAL) : INTEGER;
+  (* Returns the value of x rounded to the nearest integer *)
+
+PROCEDURE IsRMathException () : BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END RealMath.
+
diff --git a/gcc/m2/gm2-libs-iso/RealMath.mod b/gcc/m2/gm2-libs-iso/RealMath.mod
new file mode 100644
index 00000000000..17b52fde9e1
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RealMath.mod
@@ -0,0 +1,109 @@
+(* RealMath.mod implement the ISO RealMath specification.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RealMath ;
+
+IMPORT libm ;
+IMPORT cbuiltin ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sqrt)) sqrt (x: REAL): REAL;
+  (* Returns the positive square root of x *)
+BEGIN
+   RETURN cbuiltin.sqrt(x)
+END sqrt ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_exp)) exp (x: REAL): REAL;
+  (* Returns the exponential of x *)
+BEGIN
+   RETURN cbuiltin.exp(x)
+END exp ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_log)) ln (x: REAL): REAL;
+  (* Returns the natural logarithm of x *)
+BEGIN
+   RETURN cbuiltin.log(x)
+END ln ;
+
+  (* The angle in all trigonometric functions is measured in radians *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sin)) sin (x: REAL): REAL;
+  (* Returns the sine of x *)
+BEGIN
+   RETURN cbuiltin.sin(x)
+END sin ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cos)) cos (x: REAL): REAL;
+  (* Returns the cosine of x *)
+BEGIN
+   RETURN cbuiltin.cos(x)
+END cos ;
+
+PROCEDURE tan (x: REAL): REAL;
+  (* Returns the tangent of x *)
+BEGIN
+   RETURN libm.tan(x)
+END tan ;
+
+PROCEDURE arcsin (x: REAL): REAL;
+  (* Returns the arcsine of x *)
+BEGIN
+   RETURN libm.asin(x)
+END arcsin ;
+
+PROCEDURE arccos (x: REAL): REAL;
+  (* Returns the arccosine of x *)
+BEGIN
+   RETURN libm.acos(x)
+END arccos ;
+
+PROCEDURE arctan (x: REAL): REAL;
+  (* Returns the arctangent of x *)
+BEGIN
+   RETURN libm.atan(x)
+END arctan ;
+
+PROCEDURE power (base, exponent: REAL): REAL;
+  (* Returns the value of the number base raised to the power exponent *)
+BEGIN
+   RETURN libm.pow(base, exponent)
+END power ;
+
+PROCEDURE round (x: REAL): INTEGER;
+  (* Returns the value of x rounded to the nearest integer *)
+BEGIN
+   RETURN TRUNC(x)  (* hmm we could provide access to the GNU Modula-2 built-in *)
+END round ;
+
+PROCEDURE IsRMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+BEGIN
+   RETURN FALSE
+END IsRMathException ;
+
+END RealMath.
diff --git a/gcc/m2/gm2-libs-iso/RealStr.def b/gcc/m2/gm2-libs-iso/RealStr.def
new file mode 100644
index 00000000000..d1296c543a3
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RealStr.def
@@ -0,0 +1,73 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE RealStr;
+
+  (* REAL/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+  (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+  ConvResults = ConvTypes.ConvResults;
+
+(* the string form of a signed fixed-point real number is
+     ["+" | "-"], decimal digit, {decimal digit}, [".",
+     {decimal digit}]
+*)
+
+(* the string form of a signed floating-point real number is
+     signed fixed-point real number, "E", ["+" | "-"],
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE StrToReal (str: ARRAY OF CHAR; VAR real: REAL;
+                     VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent characters
+     in str are in the format of a signed real number, assigns a
+     corresponding value to real.  Assigns a value indicating the
+     format of str to res.
+  *)
+
+PROCEDURE RealToFloat (real: REAL; sigFigs: CARDINAL;
+                       VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.
+  *)
+
+PROCEDURE RealToEng (real: REAL; sigFigs: CARDINAL;
+                     VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.  The number is scaled with one to three digits
+     in the whole number part and with an exponent that is a multiple
+     of three.
+  *)
+
+PROCEDURE RealToFixed (real: REAL; place: INTEGER;
+                       VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to fixed-point string form, rounded
+     to the given place relative to the decimal point, and copies
+     the possibly truncated result to str.
+  *)
+
+PROCEDURE RealToStr (real: REAL; VAR str: ARRAY OF CHAR);
+  (* Converts the value of real as RealToFixed if the sign and
+     magnitude can be shown within the capacity of str, or
+     otherwise as RealToFloat, and copies the possibly truncated
+     result to str. The number of places or significant digits are
+     implementation-defined.
+  *)
+
+END RealStr.
+
diff --git a/gcc/m2/gm2-libs-iso/RealStr.mod b/gcc/m2/gm2-libs-iso/RealStr.mod
new file mode 100644
index 00000000000..40dc2a1e157
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RealStr.mod
@@ -0,0 +1,150 @@
+(* RealStr.mod implement the ISO RealStr specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RealStr;
+
+(* REAL/string conversions *)
+
+IMPORT RealConv ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Length, CopyOut ;
+
+FROM ConvStringReal IMPORT RealToFixedString, RealToFloatString,
+                           RealToEngString ;
+
+
+(* the string form of a signed fixed-point real number is
+     ["+" | "-"], decimal digit, {decimal digit}, [".",
+     {decimal digit}]
+*)
+
+(* the string form of a signed floating-point real number is
+     signed fixed-point real number, "E", ["+" | "-"],
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE StrToReal (str: ARRAY OF CHAR; VAR real: REAL;
+                     VAR res: ConvResults) ;
+  (* Ignores any leading spaces in str. If the subsequent characters
+     in str are in the format of a signed real number, assigns a
+     corresponding value to real.  Assigns a value indicating the
+     format of str to res.
+  *)
+BEGIN
+   res := RealConv.FormatReal(str) ;
+   IF res=strAllRight
+   THEN
+      real := RealConv.ValueReal(str)
+   END
+END StrToReal ;
+
+
+PROCEDURE RealToFloat (real: REAL; sigFigs: CARDINAL;
+                       VAR str: ARRAY OF CHAR) ;
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToFloatString(real, sigFigs) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END RealToFloat ;
+
+
+PROCEDURE RealToEng (real: REAL; sigFigs: CARDINAL;
+                     VAR str: ARRAY OF CHAR) ;
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.  The number is scaled with one to three digits
+     in the whole number part and with an exponent that is a multiple
+     of three.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToEngString(real, sigFigs) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END RealToEng ;
+
+
+PROCEDURE RealToFixed (real: REAL; place: INTEGER;
+                       VAR str: ARRAY OF CHAR) ;
+  (* Converts the value of real to fixed-point string form, rounded
+     to the given place relative to the decimal point, and copies
+     the possibly truncated result to str.
+  *)
+VAR
+   s: String ;
+BEGIN
+   s := RealToFixedString(real, place) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END RealToFixed ;
+
+
+PROCEDURE RealToStr (real: REAL; VAR str: ARRAY OF CHAR) ;
+  (* Converts the value of real as RealToFixed if the sign and
+     magnitude can be shown within the capacity of str, or
+     otherwise as RealToFloat, and copies the possibly truncated
+     result to str.  The number of places or significant digits
+     are implementation-defined.
+  *)
+VAR
+   s      : String ;
+   sigFigs: CARDINAL ;
+BEGIN
+   sigFigs := HIGH(str) ;
+   WHILE sigFigs>1 DO
+      s := RealToFixedString(real, sigFigs) ;
+      IF Length(s)<=HIGH(str)
+      THEN
+         CopyOut(str, s) ;
+         s := KillString(s) ;
+         RETURN
+      END ;
+      s := KillString(s) ;
+      DEC(sigFigs)
+   END ;
+   sigFigs := HIGH(str) ;
+   WHILE sigFigs#0 DO
+      s := RealToFloatString(real, sigFigs) ;
+      IF Length(s)<=HIGH(str)
+      THEN
+         CopyOut(str, s) ;
+         s := KillString(s) ;
+         RETURN
+      END ;
+      s := KillString(s) ;
+      DEC(sigFigs)
+   END
+END RealToStr ;
+
+
+END RealStr.
diff --git a/gcc/m2/gm2-libs-iso/RndFile.def b/gcc/m2/gm2-libs-iso/RndFile.def
new file mode 100644
index 00000000000..0ed92ab1ded
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RndFile.def
@@ -0,0 +1,116 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE RndFile;
+
+  (* Random access files *)
+
+IMPORT IOChan, ChanConsts, SYSTEM;
+
+TYPE
+   ChanId = IOChan.ChanId;
+   FlagSet = ChanConsts.FlagSet;
+   OpenResults = ChanConsts.OpenResults;
+
+   (* Accepted singleton values of FlagSet *)
+
+CONST
+   (* input operations are requested/available *)
+   read = FlagSet{ChanConsts.readFlag};
+   (* output operations are requested/available *)
+   write = FlagSet{ChanConsts.writeFlag};
+   (* a file may/must/did exist before the channel is opened *)
+   old = FlagSet{ChanConsts.oldFlag};
+   (* text operations are requested/available *)
+   text = FlagSet{ChanConsts.textFlag};
+   (* raw operations are requested/available *)
+   raw = FlagSet{ChanConsts.rawFlag};
+
+PROCEDURE OpenOld (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
+                   VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a stored random
+     access file of the given name.
+     The old flag is implied; without the write flag, read is implied;
+     without the text flag, raw is implied.
+     If successful, assigns to cid the identity of the opened channel,
+     assigns the value opened to res, and sets the read/write position
+     to the start of the file.
+     If a channel cannot be opened as required, the value of res indicates
+     the reason, and cid identifies the invalid channel.
+  *)
+
+PROCEDURE OpenClean (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
+                     VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a stored random
+     access file of the given name.
+     The write flag is implied; without the text flag, raw is implied.
+     If successful, assigns to cid the identity of the opened channel,
+     assigns the value opened to res, and truncates the file to zero length.
+     If a channel cannot be opened as required, the value of res indicates
+     the reason, and cid identifies the invalid channel.
+  *)
+
+PROCEDURE IsRndFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to a random access file. *)
+
+PROCEDURE IsRndFileException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution
+     state because of the raising of a RndFile exception; otherwise returns
+     FALSE.
+  *)
+
+CONST
+   FilePosSize = SIZE(LONGINT) ;
+   (* <implementation-defined whole number greater than zero>; *)
+
+TYPE
+   FilePos = LONGINT ;  (* ARRAY [1 .. FilePosSize] OF SYSTEM.LOC; *)
+
+PROCEDURE StartPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position of
+     the start of the file.
+  *)
+
+PROCEDURE CurrentPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position
+     of the current read/write position.
+  *)
+
+PROCEDURE EndPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the first
+     position after which there have been no writes.
+  *)
+
+PROCEDURE NewPos (cid: ChanId; chunks: INTEGER; chunkSize: CARDINAL;
+                  from: FilePos): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position
+     (chunks * chunkSize) relative to the position given by from, or
+     raises the exception posRange if the required position cannot be
+     represented as a value of type FilePos.
+  *)
+
+PROCEDURE SetPos (cid: ChanId; pos: FilePos);
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise sets the read/write
+     position to the value given by pos.
+  *)
+
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise closes the channel,
+     and assigns the value identifying the invalid channel to cid.
+  *)
+
+END RndFile.
diff --git a/gcc/m2/gm2-libs-iso/RndFile.mod b/gcc/m2/gm2-libs-iso/RndFile.mod
new file mode 100644
index 00000000000..ba6c9d22e5e
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/RndFile.mod
@@ -0,0 +1,511 @@
+(* RndFile.mod implement the ISO RndFile specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RndFile ;
+
+
+FROM RTgen IMPORT ChanDev, DeviceType,
+                  InitChanDev, doLook, doSkip, doSkipLook, doWriteLn,
+                  doReadText, doWriteText, doReadLocs, doWriteLocs,
+                  checkErrno ;
+
+FROM RTfio IMPORT doreadchar, dounreadchar, dogeterrno, dorbytes,
+                  dowbytes, dowriteln, iseof, iseoln, iserror ;
+
+FROM IOLink IMPORT DeviceId, DeviceTablePtr, IsDevice, MakeChan, UnMakeChan,
+                   DeviceTablePtrValue, RAISEdevException, AllocateDeviceId,
+                   ResetProc ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
+FROM FIO IMPORT File ;
+FROM libc IMPORT memcpy ;
+FROM errno IMPORT geterrno ;
+FROM IOConsts IMPORT ReadResults ;
+FROM ChanConsts IMPORT readFlag, writeFlag ;
+
+FROM EXCEPTIONS IMPORT ExceptionNumber, RAISE,
+                       AllocateSource, ExceptionSource, IsCurrentSource,
+                       IsExceptionalExecution ;
+
+IMPORT FIO, SYSTEM, RTio, errno, ErrnoCategory ;
+
+
+VAR
+   dev             : ChanDev ;
+   did             : DeviceId ;
+   rndfileException: ExceptionSource ;
+
+
+PROCEDURE look (d: DeviceTablePtr;
+                VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   checkRW(FALSE, d) ;
+   doLook(dev, d, ch, r)
+END look ;
+
+
+PROCEDURE skip (d: DeviceTablePtr) ;
+BEGIN
+   doSkip(dev, d)
+END skip ;
+
+
+PROCEDURE skiplook (d: DeviceTablePtr;
+                    VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   checkRW(FALSE, d) ;
+   doSkipLook(dev, d, ch, r)
+END skiplook ;
+
+
+PROCEDURE lnwrite (d: DeviceTablePtr) ;
+BEGIN
+   checkRW(TRUE, d) ;
+   doWriteLn(dev, d)
+END lnwrite ;
+
+
+PROCEDURE textread (d: DeviceTablePtr;
+                    to: SYSTEM.ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+BEGIN
+   checkRW(FALSE, d) ;
+   doReadText(dev, d, to, maxChars, charsRead)
+END textread ;
+
+
+PROCEDURE textwrite (d: DeviceTablePtr;
+                     from: SYSTEM.ADDRESS;
+                     charsToWrite: CARDINAL);
+BEGIN
+   checkRW(TRUE, d) ;
+   doWriteText(dev, d, from, charsToWrite)
+END textwrite ;
+
+
+PROCEDURE rawread (d: DeviceTablePtr;
+                   to: SYSTEM.ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+BEGIN
+   checkRW(FALSE, d) ;
+   doReadLocs(dev, d, to, maxLocs, locsRead)
+END rawread ;
+
+
+PROCEDURE rawwrite (d: DeviceTablePtr;
+                    from: SYSTEM.ADDRESS;
+                    locsToWrite: CARDINAL) ;
+BEGIN
+   checkRW(TRUE, d) ;
+   doWriteLocs(dev, d, from, locsToWrite)
+END rawwrite ;
+
+
+PROCEDURE getname (d: DeviceTablePtr;
+                   VAR a: ARRAY OF CHAR) ;
+BEGIN
+   FIO.GetFileName(RTio.GetFile(d^.cid), a)
+END getname ;
+
+
+PROCEDURE flush (d: DeviceTablePtr) ;
+BEGIN
+   FIO.FlushBuffer(RTio.GetFile(d^.cid))
+END flush ;
+
+
+(*
+   checkOpenErrno - assigns, e, and, res, depending upon file result of opening,
+                    file.
+*)
+
+PROCEDURE checkOpenErrno (file: FIO.File; VAR e: INTEGER; VAR res: OpenResults) ;
+BEGIN
+   IF FIO.IsNoError(file)
+   THEN
+      e := 0 ;
+   ELSE
+      e := errno.geterrno()
+   END ;
+   res := ErrnoCategory.GetOpenResults(e)
+END checkOpenErrno ;
+
+
+(*
+   checkRW - ensures that the file attached to, p, has been opened, towrite.
+*)
+
+PROCEDURE checkRW (towrite: BOOLEAN; p: DeviceTablePtr) ;
+VAR
+   pb      : POINTER TO BOOLEAN ;
+   fp      : FilePos ;
+   file    : File ;
+   name    : SYSTEM.ADDRESS ;
+   size    : CARDINAL ;
+   contents: SYSTEM.ADDRESS ;
+BEGIN
+   pb := p^.cd ;
+   IF pb^#towrite
+   THEN
+      WITH p^ DO
+         pb^ := towrite ;
+         fp := CurrentPos(cid) ;
+         file := RTio.GetFile(RTio.ChanId(cid)) ;
+         name := FIO.getFileName(file) ;
+         size := FIO.getFileNameLength(file) ;
+         ALLOCATE(contents, size+1) ;
+         contents := memcpy(contents, name, size) ;
+         FIO.Close(file) ;
+         file := FIO.openForRandom(contents, size, towrite, FALSE) ;
+         RTio.SetFile(cid, file) ;
+         SetPos(cid, fp) ;
+         DEALLOCATE(contents, size+1)
+      END
+   END
+END checkRW ;
+
+
+(*
+   newCid - returns a ChanId which represents the opened file, name.
+            res is set appropriately on return.
+*)
+
+PROCEDURE newCid (fname: ARRAY OF CHAR;
+                  f: FlagSet;
+                  VAR res: OpenResults;
+                  toWrite, newfile: BOOLEAN;
+                  whichreset: ResetProc) : ChanId ;
+VAR
+   c   : RTio.ChanId ;
+   file: FIO.File ;
+   e   : INTEGER ;
+   p   : DeviceTablePtr ;
+   pb  : POINTER TO BOOLEAN ;
+BEGIN
+   file := FIO.OpenForRandom(fname, toWrite, newfile) ;
+   checkOpenErrno(file, e, res) ;
+
+   IF FIO.IsNoError(file)
+   THEN
+      NEW(pb) ;
+      pb^ := toWrite ;
+      MakeChan(did, c) ;
+      RTio.SetFile(c, file) ;
+      p := DeviceTablePtrValue(c, did) ;
+      WITH p^ DO
+         cd := pb ;
+         flags := f ;
+         errNum := e ;
+         doLook := look ;
+         doSkip := skip ;
+         doSkipLook := skiplook ;
+         doLnWrite := lnwrite ;
+         doTextRead := textread ;
+         doTextWrite := textwrite ;
+         doRawRead := rawread ;
+         doRawWrite := rawwrite ;
+         doGetName := getname ;
+         doReset := whichreset ;
+         doFlush := flush ;
+         doFree := handlefree
+      END ;
+      RETURN( c )
+   ELSE
+      RETURN( IOChan.InvalidChan() )
+   END
+END newCid ;
+
+
+(*
+   handlefree -
+*)
+
+PROCEDURE handlefree (d: DeviceTablePtr) ;
+VAR
+   f : File ;
+   pb: POINTER TO BOOLEAN ;
+BEGIN
+   WITH d^ DO
+      doFlush(d) ;
+      checkErrno(dev, d) ;
+      f := RTio.GetFile(RTio.ChanId(cid)) ;
+      IF FIO.IsNoError(f)
+      THEN
+         FIO.Close(f) ;
+      END ;
+      checkErrno(dev, d) ;
+      pb := cd ;
+      DISPOSE(pb) ;
+      cd := NIL
+   END
+END handlefree ;
+
+
+PROCEDURE resetRandom (d: DeviceTablePtr) ;
+BEGIN
+   WITH d^ DO
+      IF IsRndFile(cid)
+      THEN
+         (* --fixme --, finish this *)
+      ELSE
+         RAISEdevException(cid, did, IOChan.wrongDevice,
+                           'RndFile.' + __FUNCTION__ +
+                           ': channel is not a random file')
+      END
+   END
+END resetRandom ;
+
+
+PROCEDURE OpenOld (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
+                   VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a stored random
+     access file of the given name.
+     The old flag is implied; without the write flag, read is implied;
+     without the text flag, raw is implied.
+     If successful, assigns to cid the identity of the opened channel,
+     assigns the value opened to res, and sets the read/write position
+     to the start of the file.
+     If a channel cannot be opened as required, the value of res indicates
+     the reason, and cid identifies the invalid channel.
+  *)
+BEGIN
+   INCL(flags, ChanConsts.oldFlag) ;
+   IF NOT (ChanConsts.writeFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.readFlag)
+   END ;
+   IF NOT (ChanConsts.textFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.rawFlag)
+   END ;
+   cid := newCid(name, flags, res, FALSE, FALSE, resetRandom)
+END OpenOld ;
+
+
+PROCEDURE OpenClean (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
+                     VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a stored random
+     access file of the given name.
+     The write flag is implied; without the text flag, raw is implied.
+     If successful, assigns to cid the identity of the opened channel,
+     assigns the value opened to res, and truncates the file to zero length.
+     If a channel cannot be opened as required, the value of res indicates
+     the reason, and cid identifies the invalid channel.
+  *)
+BEGIN
+   INCL(flags, ChanConsts.writeFlag) ;
+   IF NOT (ChanConsts.textFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.rawFlag)
+   END ;
+   cid := newCid(name, flags, res, TRUE, TRUE, resetRandom)
+END OpenClean ;
+
+
+PROCEDURE IsRndFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to a random access file. *)
+BEGIN
+   RETURN( (cid # NIL) AND (IOChan.InvalidChan() # cid) AND
+           (IsDevice(cid, did)) AND
+           ((ChanConsts.readFlag IN IOChan.CurrentFlags(cid)) OR
+            (ChanConsts.writeFlag IN IOChan.CurrentFlags(cid))) )
+END IsRndFile ;
+
+
+PROCEDURE IsRndFileException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution
+     state because of the raising of a RndFile exception; otherwise returns
+     FALSE.
+  *)
+BEGIN
+   RETURN( IsCurrentSource (rndfileException) )
+END IsRndFileException ;
+
+
+
+PROCEDURE StartPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position of
+     the start of the file.
+  *)
+VAR
+   d: DeviceTablePtr ;
+BEGIN
+   IF IsRndFile(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      RETURN( 0 )
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'RndFile.' + __FUNCTION__ +
+                        ': channel is not a random file')
+   END
+END StartPos ;
+
+
+PROCEDURE CurrentPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position
+     of the current read/write position.
+  *)
+VAR
+   d: DeviceTablePtr ;
+BEGIN
+   IF IsRndFile(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      WITH d^ DO
+         RETURN( FIO.FindPosition(RTio.GetFile(cid)) )
+      END
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'RndFile.' + __FUNCTION__ +
+                        ': channel is not a random file')
+   END
+END CurrentPos ;
+
+
+PROCEDURE EndPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the first
+     position after which there have been no writes.
+  *)
+VAR
+   d  : DeviceTablePtr ;
+   end,
+   old: FilePos ;
+BEGIN
+   IF IsRndFile(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      old := CurrentPos(cid) ;
+      WITH d^ DO
+         old := CurrentPos(cid) ;
+         FIO.SetPositionFromEnd(RTio.GetFile(cid), 0) ;
+         checkErrno(dev, d) ;
+         end := CurrentPos(cid) ;
+         FIO.SetPositionFromBeginning(RTio.GetFile(cid), old) ;
+         RETURN( end )
+      END
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'RndFile.' + __FUNCTION__ +
+                        ': channel is not a random file')
+   END
+END EndPos ;
+
+
+PROCEDURE NewPos (cid: ChanId; chunks: INTEGER; chunkSize: CARDINAL;
+                  from: FilePos): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position
+     (chunks * chunkSize) relative to the position given by from, or
+     raises the exception posRange if the required position cannot be
+     represented as a value of type FilePos.
+  *)
+VAR
+   d: DeviceTablePtr ;
+BEGIN
+   IF IsRndFile(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      WITH d^ DO
+         RETURN( from+VAL(FilePos, chunks*VAL(INTEGER, chunkSize))-
+                 CurrentPos(cid) )
+      END
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'RndFile.' + __FUNCTION__ +
+                        ': channel is not a random file')
+   END
+END NewPos ;
+
+
+PROCEDURE SetPos (cid: ChanId; pos: FilePos);
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise sets the read/write
+     position to the value given by pos.
+  *)
+VAR
+   d: DeviceTablePtr ;
+BEGIN
+   IF IsRndFile(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      WITH d^ DO
+         FIO.SetPositionFromBeginning(RTio.GetFile(cid), pos) ;
+         checkErrno(dev, d)
+      END
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'RndFile.' + __FUNCTION__ +
+                        ': channel is not a random file')
+   END
+END SetPos ;
+
+
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise closes the channel,
+     and assigns the value identifying the invalid channel to cid.
+  *)
+BEGIN
+   IF IsRndFile(cid)
+   THEN
+      UnMakeChan(did, cid) ;
+      cid := IOChan.InvalidChan()
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'RndFile.' + __FUNCTION__ +
+                        ': channel is not a random file')
+   END
+END Close ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+VAR
+   gen: GenDevIF ;
+BEGIN
+   AllocateDeviceId(did) ;
+   gen := InitGenDevIF(did, doreadchar, dounreadchar,
+                       dogeterrno, dorbytes, dowbytes,
+                       dowriteln,
+                       iseof, iseoln, iserror) ;
+   dev := InitChanDev(streamfile, did, gen) ;
+   AllocateSource (rndfileException)
+END Init ;
+
+
+BEGIN
+   Init
+END RndFile.
diff --git a/gcc/m2/gm2-libs-iso/SIOResult.def b/gcc/m2/gm2-libs-iso/SIOResult.def
new file mode 100644
index 00000000000..9b0b9ce4b11
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SIOResult.def
@@ -0,0 +1,37 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE SIOResult;
+
+  (* Read results for the default input channel *)
+
+IMPORT IOConsts;
+
+TYPE
+  ReadResults = IOConsts.ReadResults;
+
+  (*
+    ReadResults =   (* This type is used to classify the result of an input operation *)
+    (
+      notKnown,     (* no read result is set *)
+      allRight,     (* data is as expected or as required *)
+      outOfRange,   (* data cannot be represented *)
+      wrongFormat,  (* data not in expected format *)
+      endOfLine,    (* end of line seen before expected data *)
+      endOfInput    (* end of input seen before expected data *)
+    );
+  *)
+
+PROCEDURE ReadResult (): ReadResults;
+  (* Returns the result for the last read operation on the default input channel. *)
+
+END SIOResult.
+
diff --git a/gcc/m2/gm2-libs-iso/SIOResult.mod b/gcc/m2/gm2-libs-iso/SIOResult.mod
new file mode 100644
index 00000000000..d2a6a487d0c
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SIOResult.mod
@@ -0,0 +1,37 @@
+(* SIOResult.mod implement the ISO SIOResult specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SIOResult ;
+
+IMPORT IOChan, StdChans ;
+
+PROCEDURE ReadResult (): ReadResults;
+  (* Returns the result for the last read operation on the channel cid. *)
+BEGIN
+   RETURN IOChan.ReadResult(StdChans.StdInChan())
+END ReadResult ;
+
+END SIOResult.
diff --git a/gcc/m2/gm2-libs-iso/SLongIO.def b/gcc/m2/gm2-libs-iso/SLongIO.def
new file mode 100644
index 00000000000..218db9e0a85
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SLongIO.def
@@ -0,0 +1,65 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE SLongIO;
+
+  (* Input and output of long real numbers in decimal text form
+     using default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (VAR real: LONGREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteFloat (real: LONGREAL; sigFigs: CARDINAL;
+                      width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteEng (real: LONGREAL; sigFigs: CARDINAL;
+                    width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+PROCEDURE WriteFixed (real: LONGREAL; place: INTEGER;
+                      width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteReal (real: LONGREAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+
+END SLongIO.
+
diff --git a/gcc/m2/gm2-libs-iso/SLongIO.mod b/gcc/m2/gm2-libs-iso/SLongIO.mod
new file mode 100644
index 00000000000..1126e767e25
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SLongIO.mod
@@ -0,0 +1,93 @@
+(* SLongIO.mod implement the ISO SLongIO specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SLongIO ;
+
+IMPORT StdChans, LongIO ;
+
+  (* Input and output of real numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (VAR real: LONGREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   LongIO.ReadReal(StdChans.StdInChan(), real)
+END ReadReal ;
+
+PROCEDURE WriteFloat (real: LONGREAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+BEGIN
+   LongIO.WriteFloat(StdChans.StdOutChan(), real, sigFigs, width)
+END WriteFloat ;
+
+PROCEDURE WriteEng (real: LONGREAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with one to
+     three digits in the whole number part, and with an exponent that
+     is a multiple of three.
+  *)
+BEGIN
+   LongIO.WriteFloat(StdChans.StdOutChan(), real, sigFigs, width)
+END WriteEng ;
+
+PROCEDURE WriteFixed (real: LONGREAL; place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+BEGIN
+   LongIO.WriteFixed(StdChans.StdOutChan(), real, place, width)
+END WriteFixed ;
+
+PROCEDURE WriteReal (real: LONGREAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+BEGIN
+   LongIO.WriteReal(StdChans.StdOutChan(), real, width)
+END WriteReal ;
+
+END SLongIO.
diff --git a/gcc/m2/gm2-libs-iso/SLongWholeIO.def b/gcc/m2/gm2-libs-iso/SLongWholeIO.def
new file mode 100644
index 00000000000..c73c64ee7fb
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SLongWholeIO.def
@@ -0,0 +1,67 @@
+(* SLongWholeIO.def provides input/output of LONGINT/LONGCARD over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+DEFINITION MODULE SLongWholeIO;
+ 
+  (* Input and output of whole numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+ 
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, {decimal digit}
+ 
+     The text form of an unsigned whole number is
+       decimal digit, {decimal digit}
+  *)
+ 
+PROCEDURE ReadInt (VAR int: LONGINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     whole number.  The value of this number is assigned
+     to int.  The read result is set to the value allRight,
+     outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+ 
+PROCEDURE WriteInt (int: LONGINT; width: CARDINAL);
+  (* Writes the value of int to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+ 
+PROCEDURE ReadCard (VAR card: LONGCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of an
+     unsigned whole number.  The value of this number is
+     assigned to card.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+ 
+PROCEDURE WriteCard (card: LONGCARD; width: CARDINAL);
+  (* Writes the value of card to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+ 
+END SLongWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/SLongWholeIO.mod b/gcc/m2/gm2-libs-iso/SLongWholeIO.mod
new file mode 100644
index 00000000000..47606a5f083
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SLongWholeIO.mod
@@ -0,0 +1,78 @@
+(* SLongWholeIO.mod implements input/output of LONGINT/LONGCARD over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SLongWholeIO;
+
+IMPORT StdChans, LongWholeIO ;
+
+  (* Input and output of whole numbers in decimal text form over
+     default channels. The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+PROCEDURE ReadInt (VAR int: LONGINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input stream that form part of a signed
+     whole number.  The value of this number is assigned to int.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   LongWholeIO.ReadInt(StdChans.StdInChan(), int)
+END ReadInt ;
+
+
+PROCEDURE ReadCard (VAR card: LONGCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input stream that form part of an unsigned
+     whole number.  The value of this number is assigned to card.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   LongWholeIO.ReadCard(StdChans.StdInChan(), card)
+END ReadCard ;
+
+
+  (* Output procedures *)
+
+PROCEDURE WriteInt (int: LONGINT; width: CARDINAL);
+  (* Writes the value of int to the default output stream in
+     text form, in a field of the given minimum width. *)
+BEGIN
+   LongWholeIO.WriteInt(StdChans.StdOutChan(), int, width)
+END WriteInt ;
+
+
+PROCEDURE WriteCard (card: LONGCARD; width: CARDINAL);
+  (* Writes the value of card to the default output stream in
+     text form, in a field of the given minimum width. *)
+BEGIN
+   LongWholeIO.WriteCard(StdChans.StdOutChan(), card, width)
+END WriteCard ;
+
+
+END SLongWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/SRawIO.def b/gcc/m2/gm2-libs-iso/SRawIO.def
new file mode 100644
index 00000000000..41640573944
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SRawIO.def
@@ -0,0 +1,31 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE SRawIO;
+
+  (* Reading and writing data over default channels using raw operations, that is, with no
+     conversion or interpretation. The read result is of the type IOConsts.ReadResults.
+  *)
+
+IMPORT SYSTEM;
+
+PROCEDURE Read (VAR to: ARRAY OF SYSTEM.LOC);
+  (* Reads storage units from the default input channel, and assigns them to successive
+     components of to.  The read result is set to the value allRight, wrongFormat, or
+     endOfInput.
+  *)
+
+PROCEDURE Write (from: ARRAY OF SYSTEM.LOC);
+  (* Writes storage units to the default output channel from successive components of from.
+  *)
+
+END SRawIO.
+
diff --git a/gcc/m2/gm2-libs-iso/SRawIO.mod b/gcc/m2/gm2-libs-iso/SRawIO.mod
new file mode 100644
index 00000000000..e1e7a91e5fe
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SRawIO.mod
@@ -0,0 +1,55 @@
+(* SRawIO.mod implement the ISO SRawIO specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SRawIO ;
+
+IMPORT StdChans, RawIO ;
+
+(*
+   Read - reads storage units from the default input channel, and
+          assigns them to successive components of to.  The read
+          result is set to the value allRight, wrongFormat, or
+          endOfInput.
+*)
+
+PROCEDURE Read (VAR to: ARRAY OF SYSTEM.LOC) ;
+BEGIN
+   RawIO.Read(StdChans.StdInChan(), to)
+END Read ;
+
+
+(*
+   Write - writes storage units to the default output channel from
+           successive components of from.
+*)
+
+PROCEDURE Write (from: ARRAY OF SYSTEM.LOC) ;
+BEGIN
+   RawIO.Write(StdChans.StdOutChan(), from)   
+END Write ;
+
+
+END SRawIO.
diff --git a/gcc/m2/gm2-libs-iso/SRealIO.def b/gcc/m2/gm2-libs-iso/SRealIO.def
new file mode 100644
index 00000000000..5eace42e96d
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SRealIO.def
@@ -0,0 +1,62 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE SRealIO;
+
+  (* Input and output of real numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (VAR real: REAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteFloat (real: REAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteEng (real: REAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with one to
+     three digits in the whole number part, and with an exponent that
+     is a multiple of three.
+  *)
+
+PROCEDURE WriteFixed (real: REAL; place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteReal (real: REAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+
+END SRealIO.
+
diff --git a/gcc/m2/gm2-libs-iso/SRealIO.mod b/gcc/m2/gm2-libs-iso/SRealIO.mod
new file mode 100644
index 00000000000..a77b18d2ae7
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SRealIO.mod
@@ -0,0 +1,93 @@
+(* SRealIO.mod implement the ISO SRealIO specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SRealIO ;
+
+IMPORT StdChans, RealIO ;
+
+  (* Input and output of real numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (VAR real: REAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   RealIO.ReadReal(StdChans.StdInChan(), real)
+END ReadReal ;
+
+PROCEDURE WriteFloat (real: REAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+BEGIN
+   RealIO.WriteFloat(StdChans.StdOutChan(), real, sigFigs, width)
+END WriteFloat ;
+
+PROCEDURE WriteEng (real: REAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with one to
+     three digits in the whole number part, and with an exponent that
+     is a multiple of three.
+  *)
+BEGIN
+   RealIO.WriteFloat(StdChans.StdOutChan(), real, sigFigs, width)
+END WriteEng ;
+
+PROCEDURE WriteFixed (real: REAL; place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+BEGIN
+   RealIO.WriteFixed(StdChans.StdOutChan(), real, place, width)
+END WriteFixed ;
+
+PROCEDURE WriteReal (real: REAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+BEGIN
+   RealIO.WriteReal(StdChans.StdOutChan(), real, width)
+END WriteReal ;
+
+END SRealIO.
diff --git a/gcc/m2/gm2-libs-iso/SShortIO.def b/gcc/m2/gm2-libs-iso/SShortIO.def
new file mode 100644
index 00000000000..d2f444f0db0
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SShortIO.def
@@ -0,0 +1,80 @@
+(* SShortIO.def provides input/output of SHORTREAL over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+DEFINITION MODULE SShortIO;
+
+  (* Input and output of short real numbers in decimal text form
+     using default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (VAR real: SHORTREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteFloat (real: SHORTREAL; sigFigs: CARDINAL;
+                      width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteEng (real: SHORTREAL; sigFigs: CARDINAL;
+                    width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+PROCEDURE WriteFixed (real: SHORTREAL; place: INTEGER;
+                      width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteReal (real: SHORTREAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+
+END SShortIO.
+
diff --git a/gcc/m2/gm2-libs-iso/SShortIO.mod b/gcc/m2/gm2-libs-iso/SShortIO.mod
new file mode 100644
index 00000000000..531d061d6dd
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SShortIO.mod
@@ -0,0 +1,93 @@
+(* SShortIO.mod implements input/output of SHORTREAL over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SShortIO ;
+
+IMPORT StdChans, ShortIO ;
+
+  (* Input and output of real numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (VAR real: SHORTREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   ShortIO.ReadReal(StdChans.StdInChan(), real)
+END ReadReal ;
+
+PROCEDURE WriteFloat (real: SHORTREAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+BEGIN
+   ShortIO.WriteFloat(StdChans.StdOutChan(), real, sigFigs, width)
+END WriteFloat ;
+
+PROCEDURE WriteEng (real: SHORTREAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with one to
+     three digits in the whole number part, and with an exponent that
+     is a multiple of three.
+  *)
+BEGIN
+   ShortIO.WriteFloat(StdChans.StdOutChan(), real, sigFigs, width)
+END WriteEng ;
+
+PROCEDURE WriteFixed (real: SHORTREAL; place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+BEGIN
+   ShortIO.WriteFixed(StdChans.StdOutChan(), real, place, width)
+END WriteFixed ;
+
+PROCEDURE WriteReal (real: SHORTREAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+BEGIN
+   ShortIO.WriteReal(StdChans.StdOutChan(), real, width)
+END WriteReal ;
+
+END SShortIO.
diff --git a/gcc/m2/gm2-libs-iso/SShortWholeIO.def b/gcc/m2/gm2-libs-iso/SShortWholeIO.def
new file mode 100644
index 00000000000..f491e76ca20
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SShortWholeIO.def
@@ -0,0 +1,67 @@
+(* SShortWholeIO.def provides input/output of SHORTINT/SHORTCARD over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+DEFINITION MODULE SShortWholeIO;
+ 
+  (* Input and output of whole numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+ 
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, {decimal digit}
+ 
+     The text form of an unsigned whole number is
+       decimal digit, {decimal digit}
+  *)
+ 
+PROCEDURE ReadInt (VAR int: SHORTINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     whole number.  The value of this number is assigned
+     to int.  The read result is set to the value allRight,
+     outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+ 
+PROCEDURE WriteInt (int: SHORTINT; width: CARDINAL);
+  (* Writes the value of int to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+ 
+PROCEDURE ReadCard (VAR card: SHORTCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of an
+     unsigned whole number.  The value of this number is
+     assigned to card.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+ 
+PROCEDURE WriteCard (card: SHORTCARD; width: CARDINAL);
+  (* Writes the value of card to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+ 
+END SShortWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/SShortWholeIO.mod b/gcc/m2/gm2-libs-iso/SShortWholeIO.mod
new file mode 100644
index 00000000000..d823fdd3c12
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SShortWholeIO.mod
@@ -0,0 +1,78 @@
+(* SShortWholeIO.mod implements input/output of SHORTINT/SHORTCARD over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SShortWholeIO;
+
+IMPORT StdChans, ShortWholeIO ;
+
+  (* Input and output of whole numbers in decimal text form over
+     default channels. The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+PROCEDURE ReadInt (VAR int: SHORTINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input stream that form part of a signed
+     whole number.  The value of this number is assigned to int.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   ShortWholeIO.ReadInt(StdChans.StdInChan(), int)
+END ReadInt ;
+
+
+PROCEDURE ReadCard (VAR card: SHORTCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input stream that form part of an unsigned
+     whole number.  The value of this number is assigned to card.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   ShortWholeIO.ReadCard(StdChans.StdInChan(), card)
+END ReadCard ;
+
+
+  (* Output procedures *)
+
+PROCEDURE WriteInt (int: SHORTINT; width: CARDINAL);
+  (* Writes the value of int to the default output stream in
+     text form, in a field of the given minimum width. *)
+BEGIN
+   ShortWholeIO.WriteInt(StdChans.StdOutChan(), int, width)
+END WriteInt ;
+
+
+PROCEDURE WriteCard (card: SHORTCARD; width: CARDINAL);
+  (* Writes the value of card to the default output stream in
+     text form, in a field of the given minimum width. *)
+BEGIN
+   ShortWholeIO.WriteCard(StdChans.StdOutChan(), card, width)
+END WriteCard ;
+
+
+END SShortWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/STextIO.def b/gcc/m2/gm2-libs-iso/STextIO.def
new file mode 100644
index 00000000000..8baf3cf4b86
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/STextIO.def
@@ -0,0 +1,65 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE STextIO;
+
+  (* Input and output of character and string types over default channels. The read result
+     is of the type IOConsts.ReadResults.
+  *)
+
+  (* The following procedures do not read past line marks *)
+
+PROCEDURE ReadChar (VAR ch: CHAR);
+  (* If possible, removes a character from the default input stream, and assigns the
+     corresponding value to ch.  The read result is set to allRight, endOfLine or
+     endOfInput.
+  *)
+
+PROCEDURE ReadRestLine (VAR s: ARRAY OF CHAR);
+  (* Removes any remaining characters from the default input stream before the next line
+     mark, copying to s as many as can be accommodated as a string value.  The read result
+     is set to the value allRight, outOfRange, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR);
+  (* Removes only those characters from the default input stream before the next line mark
+     that can be accommodated in s as a string value, and copies them to s. The read result
+     is set to the value allRight, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE ReadToken (VAR s: ARRAY OF CHAR);
+  (* Skips leading spaces, and then removes characters from the default input stream before
+     the next space or line mark, copying to s as many as can be accommodated as a string
+     value.  The read result is set to the value allRight, outOfRange, endOfLine, or
+     endOfInput.
+  *)
+
+  (* The following procedure reads past the next line mark *)
+
+PROCEDURE SkipLine;
+  (* Removes successive items from the default input stream up to and including the next
+     line mark or until the end of input is reached. The read result is set to the value
+     allRight, or endOfInput.
+  *)
+
+
+  (* Output procedures *)
+
+PROCEDURE WriteChar (ch: CHAR);
+  (* Writes the value of ch to the default output stream. *)
+
+PROCEDURE WriteLn;
+  (* Writes a line mark to the default output stream. *)
+
+PROCEDURE WriteString (s: ARRAY OF CHAR);
+  (* Writes the string value of s to the default output stream. *)
+
+END STextIO.
diff --git a/gcc/m2/gm2-libs-iso/STextIO.mod b/gcc/m2/gm2-libs-iso/STextIO.mod
new file mode 100644
index 00000000000..a6f401fe744
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/STextIO.mod
@@ -0,0 +1,118 @@
+(* STextIO.mod implement the ISO STextIO specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE STextIO;
+
+IMPORT StdChans, TextIO ;
+
+  (* Input and output of character and string types over default channels. The read result
+     is of the type IOConsts.ReadResults.
+  *)
+
+  (* The following procedures do not read past line marks *)
+
+PROCEDURE ReadChar (VAR ch: CHAR);
+  (* If possible, removes a character from the default input
+     stream, and assigns the corresponding value to ch.
+     The read result is set to allRight, endOfLine or endOfInput.
+  *)
+BEGIN
+   TextIO.ReadChar(StdChans.StdInChan(), ch)
+END ReadChar ;
+
+
+PROCEDURE ReadRestLine (VAR s: ARRAY OF CHAR);
+  (* Removes any remaining characters from the default input
+     stream before the next line mark, copying to s as many
+     as can be accommodated as a string value.  The read result
+     is set to the value allRight, outOfRange, endOfLine, or
+     endOfInput.
+  *)
+BEGIN
+   TextIO.ReadRestLine(StdChans.StdInChan(), s)
+END ReadRestLine ;
+
+
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR);
+  (* Removes only those characters from the default input stream
+     before the next line mark that can be accommodated in s as
+     a string value, and copies them to s. The read result
+     is set to the value allRight, endOfLine, or endOfInput.
+  *)
+BEGIN
+   TextIO.ReadString(StdChans.StdInChan(), s)
+END ReadString ;
+
+
+PROCEDURE ReadToken (VAR s: ARRAY OF CHAR);
+  (* Skips leading spaces, and then removes characters from the
+     default input stream before the next space or line mark,
+     copying to s as many as can be accommodated as a string
+     value.  The read result is set to the value allRight,
+     outOfRange, endOfLine, or endOfInput.
+  *)
+BEGIN
+   TextIO.ReadToken(StdChans.StdInChan(), s)
+END ReadToken ;
+
+
+  (* The following procedure reads past the next line mark *)
+
+PROCEDURE SkipLine;
+  (* Removes successive items from the default input stream up
+     to and including the next line mark or until the end of
+     input is reached. The read result is set to the value
+     allRight, or endOfInput.
+  *)
+BEGIN
+   TextIO.SkipLine(StdChans.StdInChan())
+END SkipLine ;
+
+
+  (* Output procedures *)
+
+PROCEDURE WriteChar (ch: CHAR);
+  (* Writes the value of ch to the default output stream. *)
+BEGIN
+   TextIO.WriteChar(StdChans.StdOutChan(), ch)
+END WriteChar ;
+
+
+PROCEDURE WriteLn;
+  (* Writes a line mark to the default output stream. *)
+BEGIN
+   TextIO.WriteLn(StdChans.StdOutChan())
+END WriteLn ;
+
+
+PROCEDURE WriteString (s: ARRAY OF CHAR);
+  (* Writes the string value of s to the default output stream. *)
+BEGIN
+   TextIO.WriteString(StdChans.StdOutChan(), s)
+END WriteString ;
+
+
+END STextIO.
diff --git a/gcc/m2/gm2-libs-iso/SWholeIO.def b/gcc/m2/gm2-libs-iso/SWholeIO.def
new file mode 100644
index 00000000000..9fdb6f984c2
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SWholeIO.def
@@ -0,0 +1,52 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE SWholeIO;
+ 
+  (* Input and output of whole numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+ 
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, {decimal digit}
+ 
+     The text form of an unsigned whole number is
+       decimal digit, {decimal digit}
+  *)
+ 
+PROCEDURE ReadInt (VAR int: INTEGER);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     whole number.  The value of this number is assigned
+     to int.  The read result is set to the value allRight,
+     outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+ 
+PROCEDURE WriteInt (int: INTEGER; width: CARDINAL);
+  (* Writes the value of int to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+ 
+PROCEDURE ReadCard (VAR card: CARDINAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of an
+     unsigned whole number.  The value of this number is
+     assigned to card.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+ 
+PROCEDURE WriteCard (card: CARDINAL; width: CARDINAL);
+  (* Writes the value of card to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+ 
+END SWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/SWholeIO.mod b/gcc/m2/gm2-libs-iso/SWholeIO.mod
new file mode 100644
index 00000000000..fe72b63124a
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SWholeIO.mod
@@ -0,0 +1,78 @@
+(* SWholeIO.mod implement the ISO SWholeIO specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SWholeIO;
+
+IMPORT StdChans, WholeIO ;
+
+  (* Input and output of whole numbers in decimal text form over
+     default channels. The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+PROCEDURE ReadInt (VAR int: INTEGER);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input stream that form part of a signed
+     whole number.  The value of this number is assigned to int.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   WholeIO.ReadInt(StdChans.StdInChan(), int)
+END ReadInt ;
+
+
+PROCEDURE ReadCard (VAR card: CARDINAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input stream that form part of an unsigned
+     whole number.  The value of this number is assigned to card.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+BEGIN
+   WholeIO.ReadCard(StdChans.StdInChan(), card)
+END ReadCard ;
+
+
+  (* Output procedures *)
+
+PROCEDURE WriteInt (int: INTEGER; width: CARDINAL);
+  (* Writes the value of int to the default output stream in
+     text form, in a field of the given minimum width. *)
+BEGIN
+   WholeIO.WriteInt(StdChans.StdOutChan(), int, width)
+END WriteInt ;
+
+
+PROCEDURE WriteCard (card: CARDINAL; width: CARDINAL);
+  (* Writes the value of card to the default output stream in
+     text form, in a field of the given minimum width. *)
+BEGIN
+   WholeIO.WriteCard(StdChans.StdOutChan(), card, width)
+END WriteCard ;
+
+
+END SWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/SYSTEM.def b/gcc/m2/gm2-libs-iso/SYSTEM.def
new file mode 100644
index 00000000000..716793b706f
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SYSTEM.def
@@ -0,0 +1,235 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE SYSTEM;
+
+  (* Gives access to system programming facilities that are probably
+     non portable. *)
+
+  (* The constants and types define underlying properties of storage *)
+
+EXPORT QUALIFIED BITSPERLOC, LOCSPERWORD,
+                 LOC, BYTE, WORD, ADDRESS, CSIZE_T, CSSIZE_T, (* @SYSTEM_DATATYPES@  *)
+                 ADDADR, SUBADR, DIFADR, MAKEADR, ADR, ROTATE,
+                 SHIFT, CAST, TSIZE,
+
+                 (* Internal GM2 compiler functions *)
+                 ShiftVal, ShiftLeft, ShiftRight,
+                 RotateVal, RotateLeft, RotateRight,
+                 THROW, TBITSIZE ;
+
+CONST
+                  (* <implementation-defined constant> ; *)
+  BITSPERLOC    = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
+                  (* <implementation-defined constant> ; *)
+  LOCSPERWORD   = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
+                  (* <implementation-defined constant> ; *)
+  LOCSPERBYTE = 8 DIV BITSPERLOC ;
+
+(* Note that the full list of system and sized datatypes include:
+   LOC, WORD, BYTE, ADDRESS,
+
+   (and the non language standard target types)
+
+   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+   WORD16, WORD32, WORD64, BITSET8, BITSET16,
+   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
+   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.
+
+   Also note that the non-standard data types will
+   move into another module in the future.  *)
+
+(*
+   All the data types and procedures below are declared internally.
+   ===============================================================
+
+TYPE
+   @SYSTEM_TYPES@
+
+TYPE
+  LOC; (* A system basic type. Values are the uninterpreted
+          contents of the smallest addressable unit of storage *)
+  ADDRESS = POINTER TO LOC;
+  WORD = ARRAY [0 .. LOCSPERWORD-1] OF LOC;
+
+  (* BYTE and LOCSPERBYTE are provided if appropriate for machine *)
+
+TYPE
+  BYTE = ARRAY [0 .. LOCSPERBYTE-1] OF LOC;
+
+PROCEDURE ADDADR (addr: ADDRESS; offset: CARDINAL): ADDRESS;
+  (* Returns address given by (addr + offset), or may raise
+     an exception if this address is not valid.
+  *)
+
+PROCEDURE SUBADR (addr: ADDRESS; offset: CARDINAL): ADDRESS;
+  (* Returns address given by (addr - offset), or may raise an
+     exception if this address is not valid.
+  *)
+
+PROCEDURE DIFADR (addr1, addr2: ADDRESS): INTEGER;
+  (* Returns the difference between addresses (addr1 - addr2),
+     or may raise an exception if the arguments are invalid
+     or address space is non-contiguous.
+  *)
+
+PROCEDURE MAKEADR (high: <some type>; ...): ADDRESS;
+  (* Returns an address constructed from a list of values whose
+     types are implementation-defined, or may raise an
+     exception if this address is not valid.
+
+     In GNU Modula-2, MAKEADR can take any number of arguments
+     which are mapped onto the type ADDRESS. The first parameter
+     maps onto the high address bits and subsequent parameters map
+     onto lower address bits. For example:
+
+     a := MAKEADR(BYTE(0FEH), BYTE(0DCH), BYTE(0BAH), BYTE(098H),
+                  BYTE(076H), BYTE(054H), BYTE(032H), BYTE(010H)) ;
+
+     then the value of, a, on a 64 bit machine is: 0FEDCBA9876543210H
+
+     The parameters do not have to be the same type, but constants
+     _must_ be typed.
+  *)
+
+PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
+  (* Returns the address of variable v. *)
+
+PROCEDURE ROTATE (val: <a packedset type>;
+                  num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by rotating up/right
+     or down/right by the absolute value of num.  The direction is
+     down/right if the sign of num is negative, otherwise the direction
+     is up/left.
+  *)
+
+PROCEDURE SHIFT (val: <a packedset type>;
+                 num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by shifting up/left
+     or down/right by the absolute value of num, introducing
+     zeros as necessary.  The direction is down/right if the sign of
+     num is negative, otherwise the direction is up/left.
+  *)
+
+PROCEDURE CAST (<targettype>; val: <anytype>): <targettype>;
+  (* CAST is a type transfer function.  Given the expression
+     denoted by val, it returns a value of the type <targettype>.
+     An invalid value for the target value or a
+     physical address alignment problem may raise an exception.
+  *)
+
+PROCEDURE TSIZE (<type>; ... ): CARDINAL;
+  (* Returns the number of LOCS used to store a value of the
+     specified <type>.   The extra parameters, if present,
+     are used to distinguish variants in a variant record.
+  *)
+
+PROCEDURE THROW (i: INTEGER) ;
+  (*
+     THROW is a GNU extension and was not part of the PIM or ISO
+     standards.  It throws an exception which will be caught by the
+     EXCEPT block (assuming it exists).  This is a compiler builtin
+     function which interfaces to the GCC exception handling runtime
+     system.
+     GCC uses the term throw, hence the naming distinction between
+     the GCC builtin and the Modula-2 runtime library procedure Raise.
+     The later library procedure Raise will call SYSTEM.THROW after
+     performing various housekeeping activities.
+  *)
+
+PROCEDURE TBITSIZE (<type>) : CARDINAL ;
+  (* Returns the minimum number of bits necessary to represent
+     <type>.  This procedure function is only useful for determining
+     the number of bits used for any type field within a packed RECORD.
+     It is not particularly useful elsewhere since <type> might be
+     optimized for speed, for example a BOOLEAN could occupy a WORD.
+  *)
+*)
+
+
+(* The following procedures are invoked by GNU Modula-2 to
+   shift non word set types. They are not part of ISO Modula-2
+   but are used to implement the SHIFT procedure defined above. *)
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*)
+
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger
+               sets.
+*)
+
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*)
+
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+
+
+END SYSTEM.
diff --git a/gcc/m2/gm2-libs-iso/SYSTEM.mod b/gcc/m2/gm2-libs-iso/SYSTEM.mod
new file mode 100644
index 00000000000..d26d1e0f0d5
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SYSTEM.mod
@@ -0,0 +1,273 @@
+(* SYSTEM.mod implement the ISO SYSTEM specification.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SYSTEM ;
+
+FROM libc IMPORT memcpy, memcpy, memset ;
+
+CONST
+   BitsPerBitset = MAX(BITSET)+1 ;
+
+
+(*
+   Max - returns the maximum of a and b.
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a>b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Max ;
+
+
+(*
+   Min - returns the minimum of a and b.
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Min ;
+
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   IF ShiftCount>0
+   THEN
+      ShiftCount := ShiftCount MOD VAL(INTEGER, SetSizeInBits) ;
+      ShiftLeft(s, d, SetSizeInBits, ShiftCount)
+   ELSIF ShiftCount<0
+   THEN
+      ShiftCount := (-ShiftCount) MOD VAL(INTEGER, SetSizeInBits) ;
+      ShiftRight(s, d, SetSizeInBits, ShiftCount)
+   ELSE
+      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
+   END
+END ShiftVal ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at compile
+               time.
+*)
+
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   i, j, h: CARDINAL ;
+   a      : ADDRESS ;
+BEGIN
+   h := HIGH(s)+1 ;
+   IF ShiftCount MOD BitsPerBitset=0
+   THEN
+      i := ShiftCount DIV BitsPerBitset ;
+      a := ADR(d[i]) ;
+      a := memcpy(a, ADR(s), (h-i)*SIZE(BITSET)) ;
+      a := memset(ADR(d), 0, i*SIZE(BITSET))
+   ELSE
+      i := h ;
+      WHILE i>0 DO
+         DEC(i) ;
+         lo := SHIFT(s[i], ShiftCount MOD BitsPerBitset) ;
+         hi := SHIFT(s[i], -(BitsPerBitset - (ShiftCount MOD BitsPerBitset))) ;
+         d[i] := BITSET{} ;
+         j := i + ShiftCount DIV BitsPerBitset ;
+         IF j<h
+         THEN
+            d[j] := d[j] + lo ;
+            INC(j) ;
+            IF j<h
+            THEN
+               d[j] := d[j] + hi
+            END
+         END
+      END
+   END
+END ShiftLeft ;
+
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at compile
+                time.
+*)
+
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      ShiftCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   j, i, h: INTEGER ;
+   a      : ADDRESS ;
+BEGIN
+   h := HIGH(s)+1 ;
+   IF ShiftCount MOD BitsPerBitset=0
+   THEN
+      i := ShiftCount DIV BitsPerBitset ;
+      a := ADR(s[i]) ;
+      j := h-i ;
+      a := memcpy(ADR(d), a, j * VAL (INTEGER, SIZE (BITSET))) ;
+      a := ADR(d[j]) ;
+      a := memset(a, 0, i * VAL (INTEGER, SIZE (BITSET)))
+   ELSE
+      i := 0 ;
+      WHILE i<h DO
+         lo := SHIFT(s[i], BitsPerBitset - (ShiftCount MOD BitsPerBitset)) ;
+         hi := SHIFT(s[i], -(ShiftCount MOD BitsPerBitset)) ;
+         d[i] := BITSET{} ;
+         j := i - VAL(INTEGER, ShiftCount DIV BitsPerBitset) ;
+         IF j>=0
+         THEN
+            d[j] := d[j] + hi ;
+            DEC(j) ;
+            IF j>=0
+            THEN
+               d[j] := d[j] + lo
+            END
+         END ;
+         INC(i)
+      END
+   END
+END ShiftRight ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger sets.
+*)
+
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   IF RotateCount>0
+   THEN
+      RotateCount := RotateCount MOD VAL(INTEGER, SetSizeInBits)
+   ELSIF RotateCount<0
+   THEN
+      RotateCount := -VAL(INTEGER, VAL(CARDINAL, -RotateCount) MOD SetSizeInBits)
+   END ;
+   IF RotateCount>0
+   THEN
+      RotateLeft(s, d, SetSizeInBits, RotateCount)
+   ELSIF RotateCount<0
+   THEN
+      RotateRight(s, d, SetSizeInBits, -RotateCount)
+   ELSE
+      (* no rotate required, but we must copy source to dest.  *)
+      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
+   END
+END RotateVal ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at compile
+                time.
+*)
+
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   b, i, j, h: CARDINAL ;
+BEGIN
+   h := HIGH(s) ;
+   (* firstly we set d := {} *)
+   i := 0 ;
+   WHILE i<=h DO
+      d[i] := BITSET{} ;
+      INC(i)
+   END ;
+   i := h+1 ;
+   RotateCount := RotateCount MOD SetSizeInBits ;
+   b := SetSizeInBits MOD BitsPerBitset ;
+   IF b=0
+   THEN
+      b := BitsPerBitset
+   END ;
+   WHILE i>0 DO
+      DEC(i) ;
+      lo := SHIFT(s[i], RotateCount MOD BitsPerBitset) ;
+      hi := SHIFT(s[i], -(b - (RotateCount MOD BitsPerBitset))) ;
+      j := ((i*BitsPerBitset + RotateCount) MOD
+            SetSizeInBits) DIV BitsPerBitset ;
+      d[j] := d[j] + lo ;
+      j := (((i+1)*BitsPerBitset + RotateCount) MOD
+            SetSizeInBits) DIV BitsPerBitset ;
+      d[j] := d[j] + hi ;
+      b := BitsPerBitset
+   END
+END RotateLeft ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at compile
+                 time.
+*)
+
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+BEGIN
+   RotateLeft(s, d, SetSizeInBits, SetSizeInBits-RotateCount)
+END RotateRight ;
+
+
+END SYSTEM.
diff --git a/gcc/m2/gm2-libs-iso/Semaphores.def b/gcc/m2/gm2-libs-iso/Semaphores.def
new file mode 100644
index 00000000000..c2144aba784
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Semaphores.def
@@ -0,0 +1,51 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE Semaphores;
+
+  (* Provides mutual exclusion facilities for use by processes. *)
+
+TYPE
+  SEMAPHORE;
+
+PROCEDURE Create (VAR s: SEMAPHORE; initialCount: CARDINAL );
+  (* Creates and returns s as the identity of a new semaphore that
+     has its associated count initialized to initialCount, and has
+     no processes yet waiting on it.
+  *)
+
+PROCEDURE Destroy (VAR s: SEMAPHORE);
+  (* Recovers the resources used to implement the semaphore s,
+     provided that no process is waiting for s to become free.
+  *)
+
+PROCEDURE Claim (s: SEMAPHORE);
+  (* If the count associated with the semaphore s is non-zero,
+     decrements this count and allows the calling process to
+     continue; otherwise suspends the calling process until
+     s is released.
+  *)
+
+PROCEDURE Release (s: SEMAPHORE);
+  (* If there are any processes waiting on the semaphore s,
+     allows one of them to enter the ready state; otherwise
+     increments the count associated with s.
+  *)
+
+PROCEDURE CondClaim (s: SEMAPHORE): BOOLEAN;
+  (* Returns FALSE if the call Claim(s) would cause the calling
+     process to be suspended; in this case the count associated
+     with s is not changed. Otherwise returns TRUE and the
+     associated count is decremented.
+  *)
+
+END Semaphores.
+
diff --git a/gcc/m2/gm2-libs-iso/Semaphores.mod b/gcc/m2/gm2-libs-iso/Semaphores.mod
new file mode 100644
index 00000000000..7d8621ee5a3
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Semaphores.mod
@@ -0,0 +1,287 @@
+(* Semaphores.mod implement the ISO Semaphores specification.
+
+Copyright (C) 2010-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Semaphores ;
+
+(* Provides mutual exclusion facilities for use by processes. *)
+
+FROM Storage IMPORT ALLOCATE ;
+FROM Processes IMPORT ProcessId, Me, SuspendMe, Activate, UrgencyOf ;
+
+
+TYPE
+   SEMAPHORE = POINTER TO RECORD
+                             value: CARDINAL ;
+                             next : SEMAPHORE ;
+                             head : ProcessList ;
+                          END ;
+
+   ProcessList = POINTER TO RECORD
+                               waiting: ProcessId ;
+                               right,
+                               left   : ProcessList ;
+                            END ;
+
+VAR
+   freeSem        :  SEMAPHORE ;
+   freeProcessList:  ProcessList ;
+
+
+(*
+   Create - creates and returns s as the identity of a new
+            semaphore that has its associated count initialized
+            to initialCount, and has no processes yet waiting on it.
+*)
+
+PROCEDURE Create (VAR s: SEMAPHORE; initialCount: CARDINAL) ;
+BEGIN
+   s := newSemaphore () ;
+   WITH s^ DO
+      value := initialCount ;
+      next  := NIL ;
+      head  := NIL
+   END
+END Create ;
+
+
+(*
+   Destroy - recovers the resources used to implement the semaphore s,
+             provided that no process is waiting for s to become free.
+*)
+
+PROCEDURE Destroy (VAR s: SEMAPHORE) ;
+BEGIN
+   WITH s^ DO
+      IF head=NIL
+      THEN
+         next := freeSem ;
+         freeSem := s
+      ELSE
+         (* raise exception? *)
+      END
+   END
+END Destroy ;
+
+
+(*
+   newSemaphore -
+*)
+
+PROCEDURE newSemaphore () : SEMAPHORE ;
+VAR
+   s: SEMAPHORE ;
+BEGIN
+   IF freeSem=NIL
+   THEN
+      NEW (s)
+   ELSE
+      s := freeSem ;
+      freeSem := freeSem^.next
+   END ;
+   RETURN s
+END newSemaphore ;
+
+
+(*
+   newProcessList - returns a new ProcessList.
+*)
+
+PROCEDURE newProcessList () : ProcessList ;
+VAR
+   l: ProcessList ;
+BEGIN
+   IF freeProcessList=NIL
+   THEN
+      NEW (l)
+   ELSE
+      l := freeProcessList ;
+      freeProcessList := freeProcessList^.right
+   END ;
+   RETURN l
+END newProcessList ;
+
+
+(*
+   add - adds process, p, to queue, head.
+*)
+
+PROCEDURE add (VAR head: ProcessList; p: ProcessList) ;
+BEGIN
+   IF head=NIL
+   THEN
+      head := p ;
+      p^.left := p ;
+      p^.right := p
+   ELSE
+      p^.right := head ;
+      p^.left := head^.left ;
+      head^.left^.right := p ;
+      head^.left := p
+   END
+END add ;
+
+
+(*
+   sub - subtracts process, p, from queue, head.
+*)
+
+PROCEDURE sub (VAR head: ProcessList; p: ProcessList) ;
+BEGIN
+   IF (p^.left=head) AND (p=head)
+   THEN
+      head := NIL
+   ELSE
+      IF head=p
+      THEN
+         head := head^.right
+      END ;
+      p^.left^.right := p^.right ;
+      p^.right^.left := p^.left
+   END
+END sub ;
+
+
+(*
+   addProcess - adds the current process to the semaphore list.
+                Remove the current process from the ready queue.
+*)
+
+PROCEDURE addProcess (VAR head: ProcessList) ;
+VAR
+   l: ProcessList ;
+BEGIN
+   l := newProcessList() ;
+   WITH l^ DO
+      waiting := Me () ;
+      right := NIL ;
+      left := NIL
+   END ;
+   add (head, l) ;
+   SuspendMe
+END addProcess ;
+
+
+(*
+   chooseProcess -
+*)
+
+PROCEDURE chooseProcess (head: ProcessList) : ProcessList ;
+VAR
+   best, l: ProcessList ;
+BEGIN
+   best := head ;
+   l := head^.right ;
+   WHILE l#head DO
+      IF UrgencyOf (l^.waiting) > UrgencyOf (best^.waiting)
+      THEN
+         best := l
+      END ;
+      l := l^.right
+   END ;
+   RETURN best
+END chooseProcess ;
+
+
+(*
+   removeProcess - removes process, l, from the list and adds it to the
+                   ready queue.
+*)
+
+PROCEDURE removeProcess (VAR head: ProcessList; l: ProcessList) ;
+BEGIN
+   sub (head, l) ;
+   WITH l^ DO
+      right := freeProcessList ;
+      freeProcessList := l ;
+      Activate (waiting)
+   END
+END removeProcess ;
+
+
+(*
+   Claim - if the count associated with the semaphore s is non-zero,
+           decrements this count and allows the calling process to
+           continue; otherwise suspends the calling process until
+           s is released.
+*)
+
+PROCEDURE Claim (s: SEMAPHORE) ;
+BEGIN
+   WITH s^ DO
+      IF value>0
+      THEN
+         DEC (value)
+      ELSE
+         addProcess (head)
+      END
+   END
+END Claim ;
+
+
+(*
+   Release - if there are any processes waiting on the semaphore s,
+             allows one of them to enter the ready state; otherwise
+             increments the count associated with s.
+*)
+
+PROCEDURE Release (s: SEMAPHORE) ;
+BEGIN
+   WITH s^ DO
+      IF head=NIL
+      THEN
+         INC (value)
+      ELSE
+         removeProcess (head, chooseProcess (head))
+      END
+   END
+END Release ;
+
+
+(*
+   CondClaim - returns FALSE if the call Claim(s) would cause the calling
+               process to be suspended; in this case the count associated
+               with s is not changed. Otherwise returns TRUE and the
+               associated count is decremented.
+*)
+
+PROCEDURE CondClaim (s: SEMAPHORE) : BOOLEAN ;
+BEGIN
+   WITH s^ DO
+      IF value>0
+      THEN
+         DEC (value) ;
+         RETURN TRUE
+      ELSE
+         RETURN FALSE
+      END
+   END
+END CondClaim ;
+
+
+BEGIN
+   freeSem := NIL ;
+   freeProcessList := NIL
+END Semaphores.
diff --git a/gcc/m2/gm2-libs-iso/SeqFile.def b/gcc/m2/gm2-libs-iso/SeqFile.def
new file mode 100644
index 00000000000..4a761861995
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SeqFile.def
@@ -0,0 +1,115 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE SeqFile;
+
+  (* Rewindable sequential files *)
+
+IMPORT IOChan, ChanConsts;
+
+TYPE
+  ChanId = IOChan.ChanId;
+  FlagSet = ChanConsts.FlagSet;
+  OpenResults = ChanConsts.OpenResults;
+
+  (* Accepted singleton values of FlagSet *)
+
+CONST
+  (* input operations are requested/available *)
+  read = FlagSet{ChanConsts.readFlag};
+
+  (* output operations are requested/available *)
+  write = FlagSet{ChanConsts.writeFlag};
+
+  (* a file may/must/did exist before the channel is opened *)
+  old = FlagSet{ChanConsts.oldFlag};
+
+  (* text operations are requested/available *)
+  text = FlagSet{ChanConsts.textFlag};
+
+  (* raw operations are requested/available *)
+  raw = FlagSet{ChanConsts.rawFlag};
+
+PROCEDURE OpenWrite (VAR cid: ChanId; name: ARRAY OF CHAR;
+                     flags: FlagSet; VAR res: OpenResults);
+  (*
+     Attempts to obtain and open a channel connected to a stored
+     rewindable file of the given name.
+     The write flag is implied; without the raw flag, text is
+     implied.  If successful, assigns to cid the identity of
+     the opened channel, assigns the value opened to res, and
+     selects output mode, with the write position at the start
+     of the file (i.e. the file is of zero length).
+     If a channel cannot be opened as required, the value of
+     res indicates the reason, and cid identifies the invalid
+     channel.
+  *)
+
+PROCEDURE OpenAppend (VAR cid: ChanId; name: ARRAY OF CHAR;
+                      flags: FlagSet; VAR res: OpenResults);
+  (*
+     Attempts to obtain and open a channel connected to a stored
+     rewindable file of the given name.  The write and old flags
+     are implied; without the raw flag, text is implied.  If
+     successful, assigns to cid the identity of the opened channel,
+     assigns the value opened to res, and selects output mode,
+     with the write position corresponding to the length of the
+     file.  If a channel cannot be opened as required, the value
+     of res indicates the reason, and cid identifies the invalid
+     channel.
+  *)
+
+PROCEDURE OpenRead (VAR cid: ChanId; name: ARRAY OF CHAR;
+                    flags: FlagSet; VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a stored
+     rewindable file of the given name.
+     The read and old flags are implied; without the raw flag,
+     text is implied.  If successful, assigns to cid the
+     identity of the opened channel, assigns the value opened to
+     res, and selects input mode, with the read position
+     corresponding to the start of the file.
+     If a channel cannot be opened as required, the value of
+     res indicates the reason, and cid identifies the invalid
+     channel.
+  *)
+
+PROCEDURE IsSeqFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to a
+     rewindable sequential file. *)
+
+PROCEDURE Reread (cid: ChanId);
+  (* If the channel identified by cid is not open to a rewindable
+     sequential file, the exception wrongDevice is raised;
+     otherwise attempts to set the read position to the
+     start of the file, and to select input mode.
+     If the operation cannot be performed (perhaps because of
+     insufficient permissions) neither input mode nor output
+     mode is selected.
+  *)
+
+PROCEDURE Rewrite (cid: ChanId);
+  (* If the channel identified by cid is not open to a
+     rewindable sequential file, the exception wrongDevice is
+     raised; otherwise, attempts to truncate the file to zero
+     length, and to select output mode.  If the operation
+     cannot be performed (perhaps because of insufficient
+     permissions) neither input mode nor output mode is selected.
+  *)
+
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to a rewindable
+     sequential file, the exception wrongDevice is raised;
+     otherwise closes the channel, and assigns the value
+     identifying the invalid channel to cid.
+  *)
+
+END SeqFile.
+
diff --git a/gcc/m2/gm2-libs-iso/SeqFile.mod b/gcc/m2/gm2-libs-iso/SeqFile.mod
new file mode 100644
index 00000000000..8a49c6e2859
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SeqFile.mod
@@ -0,0 +1,455 @@
+(* SeqFile.mod implement the ISO SeqFile specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SeqFile ;
+
+FROM RTgen IMPORT ChanDev, DeviceType,
+                  InitChanDev, doLook, doSkip, doSkipLook, doWriteLn,
+                  doReadText, doWriteText, doReadLocs, doWriteLocs,
+                  checkErrno ;
+
+FROM RTfio IMPORT doreadchar, dounreadchar, dogeterrno, dorbytes,
+                  dowbytes, dowriteln, iseof, iseoln, iserror ;
+
+FROM IOLink IMPORT DeviceId, DeviceTablePtr, IsDevice, MakeChan, UnMakeChan,
+                   DeviceTablePtrValue, RAISEdevException, AllocateDeviceId,
+                   ResetProc ;
+
+FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
+FROM FIO IMPORT File ;
+FROM errno IMPORT geterrno ;
+FROM IOConsts IMPORT ReadResults ;
+FROM ChanConsts IMPORT readFlag, writeFlag ;
+
+IMPORT FIO, SYSTEM, RTio, errno, ErrnoCategory ;
+
+
+VAR
+   dev: ChanDev ;
+   did: DeviceId ;
+
+
+PROCEDURE look (d: DeviceTablePtr;
+                VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doLook(dev, d, ch, r)
+END look ;
+
+
+PROCEDURE skip (d: DeviceTablePtr) ;
+BEGIN
+   doSkip(dev, d)
+END skip ;
+
+
+PROCEDURE skiplook (d: DeviceTablePtr;
+                    VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doSkipLook(dev, d, ch, r)
+END skiplook ;
+
+
+PROCEDURE lnwrite (d: DeviceTablePtr) ;
+BEGIN
+   doWriteLn(dev, d)
+END lnwrite ;
+
+
+PROCEDURE textread (d: DeviceTablePtr;
+                    to: SYSTEM.ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+BEGIN
+   doReadText(dev, d, to, maxChars, charsRead)
+END textread ;
+
+
+PROCEDURE textwrite (d: DeviceTablePtr;
+                     from: SYSTEM.ADDRESS;
+                     charsToWrite: CARDINAL);
+BEGIN
+   doWriteText(dev, d, from, charsToWrite)
+END textwrite ;
+
+
+PROCEDURE rawread (d: DeviceTablePtr;
+                   to: SYSTEM.ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+BEGIN
+   doReadLocs(dev, d, to, maxLocs, locsRead)
+END rawread ;
+
+
+PROCEDURE rawwrite (d: DeviceTablePtr;
+                    from: SYSTEM.ADDRESS;
+                    locsToWrite: CARDINAL) ;
+BEGIN
+   doWriteLocs(dev, d, from, locsToWrite)
+END rawwrite ;
+
+
+PROCEDURE getname (d: DeviceTablePtr;
+                   VAR a: ARRAY OF CHAR) ;
+BEGIN
+   FIO.GetFileName(RTio.GetFile(d^.cid), a)
+END getname ;
+
+
+PROCEDURE flush (d: DeviceTablePtr) ;
+BEGIN
+   FIO.FlushBuffer(RTio.GetFile(d^.cid))
+END flush ;
+
+
+(*
+   checkOpenErrno - assigns, e, and, res, depending upon file result of opening,
+                    file.
+*)
+
+PROCEDURE checkOpenErrno (file: FIO.File; VAR e: INTEGER; VAR res: OpenResults) ;
+BEGIN
+   IF FIO.IsNoError(file)
+   THEN
+      e := 0 ;
+   ELSE
+      e := errno.geterrno()
+   END ;
+   res := ErrnoCategory.GetOpenResults(e)
+END checkOpenErrno ;
+
+
+(*
+   newCid - returns a ChanId which represents the opened file, name.
+            res is set appropriately on return.
+*)
+
+PROCEDURE newCid (fname: ARRAY OF CHAR;
+                  f: FlagSet;
+                  VAR res: OpenResults;
+                  toRead: BOOLEAN;
+                  whichreset: ResetProc) : ChanId ;
+VAR
+   c   : RTio.ChanId ;
+   file: FIO.File ;
+   e   : INTEGER ;
+   p   : DeviceTablePtr ;
+BEGIN
+   IF toRead
+   THEN
+      file := FIO.OpenToRead(fname)
+   ELSE
+      file := FIO.OpenToWrite(fname)
+   END ;
+   checkOpenErrno(file, e, res) ;
+
+   IF FIO.IsNoError(file)
+   THEN
+      MakeChan(did, c) ;
+      RTio.SetFile(c, file) ;
+      p := DeviceTablePtrValue(c, did) ;
+      WITH p^ DO
+         flags := f ;
+         errNum := e ;
+         doLook := look ;
+         doSkip := skip ;
+         doSkipLook := skiplook ;
+         doLnWrite := lnwrite ;
+         doTextRead := textread ;
+         doTextWrite := textwrite ;
+         doRawRead := rawread ;
+         doRawWrite := rawwrite ;
+         doGetName := getname ;
+         doReset := whichreset ;
+         doFlush := flush ;
+         doFree := handlefree
+      END ;
+      RETURN( c )
+   ELSE
+      RETURN( IOChan.InvalidChan() )
+   END
+END newCid ;
+
+
+(*
+   Attempts to obtain and open a channel connected to a stored rewindable
+   file of the given name.  The write flag is implied; without the raw
+   flag, text is implied.  If successful, assigns to cid the identity of
+   the opened channel, assigns the value opened to res, and selects
+   output mode, with the write position at the start of the file (i.e.
+   the file is of zero length).  If a channel cannot be opened as required,
+   the value of res indicates the reason, and cid identifies the
+   invalid channel.
+*)
+
+PROCEDURE OpenWrite (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
+                     VAR res: OpenResults) ;
+BEGIN
+   INCL(flags, ChanConsts.writeFlag) ;
+   IF NOT (ChanConsts.rawFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.textFlag)
+   END ;
+   cid := newCid(name, flags, res, FALSE, resetWrite)
+END OpenWrite ;
+
+
+(*
+   Attempts to obtain and open a channel connected to a stored rewindable
+   file of the given name.  The read and old flags are implied; without
+   the raw flag, text is implied.  If successful, assigns to cid the
+   identity of the opened channel, assigns the value opened to res, and
+   selects input mode, with the read position corresponding to the start
+   of the file.  If a channel cannot be opened as required, the value of
+   res indicates the reason, and cid identifies the invalid channel.
+*)
+
+PROCEDURE OpenRead (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
+                    VAR res: OpenResults) ;
+BEGIN
+   flags := flags + ChanConsts.read + ChanConsts.old ;
+   IF NOT (ChanConsts.rawFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.textFlag)
+   END ;
+   cid := newCid(name, flags, res, TRUE, resetRead)
+END OpenRead ;
+
+
+(*
+   OpenAppend - attempts to obtain and open a channel connected
+                to a stored rewindable file of the given name.
+                The write and old flags are implied; without
+                the raw flag, text is implied.  If successful,
+                assigns to cid the identity of the opened channel,
+                assigns the value opened to res, and selects output
+                mode, with the write position corresponding to the
+                length of the file.  If a channel cannot be opened
+                as required, the value of res indicates the reason,
+                and cid identifies the invalid channel.
+  *)
+
+PROCEDURE OpenAppend (VAR cid: ChanId; name: ARRAY OF CHAR;
+                      flags: FlagSet; VAR res: OpenResults) ;
+BEGIN
+   flags := flags + ChanConsts.write + ChanConsts.old ;
+   IF NOT (ChanConsts.rawFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.textFlag)
+   END ;
+   cid := newCid(name, flags, res, FALSE, resetAppend) ;
+   IF IsSeqFile(cid)
+   THEN
+      FIO.SetPositionFromEnd(RTio.GetFile(cid), 0) ;
+      checkErrno(dev, RTio.GetDevicePtr(cid))
+   END
+END OpenAppend ;
+
+
+(*
+   resetAppend - ensures that +write and -read and seeks to
+                 the end of the file.
+*)
+
+PROCEDURE resetAppend (d: DeviceTablePtr) ;
+VAR
+   f: FIO.File ;
+BEGIN
+   WITH d^ DO
+      flags := flags + write - read ;
+      FIO.SetPositionFromEnd(RTio.GetFile(cid), 0) ;
+   END ;
+   checkErrno(dev, d)
+END resetAppend ;
+
+
+(*
+   resetRead - 
+*)
+
+PROCEDURE resetRead (d: DeviceTablePtr) ;
+BEGIN
+   Reread(d^.cid)
+END resetRead ;
+
+
+(*
+   resetWrite - 
+*)
+
+PROCEDURE resetWrite (d: DeviceTablePtr) ;
+BEGIN
+   Rewrite(d^.cid)
+END resetWrite ;
+
+
+(*
+   IsSeqFile - tests if the channel identified by cid is open to a
+               rewindable sequential file.
+*)
+
+PROCEDURE IsSeqFile (cid: ChanId) : BOOLEAN ;
+BEGIN
+   RETURN( (cid # NIL) AND (IOChan.InvalidChan() # cid) AND
+           (IsDevice(cid, did)) AND
+           ((ChanConsts.readFlag IN IOChan.CurrentFlags(cid)) OR
+            (ChanConsts.writeFlag IN IOChan.CurrentFlags(cid))) )
+END IsSeqFile ;
+
+
+(*
+   Reread - if the channel identified by cid is not open
+            to a rewindable sequential file, the exception
+            wrongDevice is raised; otherwise attempts to set
+            the read position to the start of the file, and
+            to select input mode.  If the operation cannot
+            be performed (perhaps because of insufficient
+            permissions) neither input mode nor output
+            mode is selected.
+*)
+
+PROCEDURE Reread (cid: ChanId) ;
+VAR
+   d: DeviceTablePtr ;
+BEGIN
+   IF IsSeqFile(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      WITH d^ DO
+         EXCL(flags, writeFlag) ;
+         IF readFlag IN flags
+         THEN
+            FIO.SetPositionFromBeginning(RTio.GetFile(cid), 0) ;
+            checkErrno(dev, d)
+         ELSE
+            EXCL(flags, readFlag)
+         END
+      END
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'SeqFile.' + __FUNCTION__ +
+                        ': channel is not a sequential file')
+   END
+END Reread ;
+
+
+(*
+   Rewrite - if the channel identified by cid is not open to a
+             rewindable sequential file, the exception wrongDevice
+             is raised; otherwise, attempts to truncate the
+             file to zero length, and to select output mode.
+             If the operation cannot be performed (perhaps
+             because of insufficient permissions) neither input
+             mode nor output mode is selected.
+*)
+
+PROCEDURE Rewrite (cid: ChanId) ;
+VAR
+   d: DeviceTablePtr ;
+BEGIN
+   IF IsSeqFile(cid)
+   THEN
+      d := DeviceTablePtrValue(cid, did) ;
+      WITH d^ DO
+         EXCL(flags, readFlag) ;
+         IF writeFlag IN flags
+         THEN
+            FIO.SetPositionFromBeginning(RTio.GetFile(cid), 0) ;
+            checkErrno(dev, d)
+         ELSE
+            EXCL(flags, writeFlag)
+         END
+      END
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'SeqFile.' + __FUNCTION__ +
+                        ': channel is not a sequential file')
+   END
+END Rewrite ;
+
+
+(*
+   handlefree - 
+*)
+
+PROCEDURE handlefree (d: DeviceTablePtr) ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      doFlush(d) ;
+      checkErrno(dev, d) ;
+      f := RTio.GetFile(RTio.ChanId(cid)) ;
+      IF FIO.IsNoError(f)
+      THEN
+         FIO.Close(f) ;
+      END ;
+      checkErrno(dev, d)
+   END
+END handlefree ;
+
+
+(*
+   Close - if the channel identified by cid is not open to a sequential
+           stream, the exception wrongDevice is raised; otherwise
+           closes the channel, and assigns the value identifying
+           the invalid channel to cid.
+*)
+
+PROCEDURE Close (VAR cid: ChanId) ;
+BEGIN
+   IF IsSeqFile(cid)
+   THEN
+      UnMakeChan(did, cid) ;
+      cid := IOChan.InvalidChan()
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'SeqFile.' + __FUNCTION__ +
+                        ': channel is not a sequential file')
+   END
+END Close ;
+
+
+(*
+   Init - 
+*)
+
+PROCEDURE Init ;
+VAR
+   gen: GenDevIF ;
+BEGIN
+   AllocateDeviceId(did) ;
+   gen := InitGenDevIF(did, doreadchar, dounreadchar,
+                       dogeterrno, dorbytes, dowbytes,
+                       dowriteln,
+                       iseof, iseoln, iserror) ;
+   dev := InitChanDev(streamfile, did, gen)
+END Init ;
+
+
+BEGIN
+   Init
+END SeqFile.
diff --git a/gcc/m2/gm2-libs-iso/ShortComplexMath.def b/gcc/m2/gm2-libs-iso/ShortComplexMath.def
new file mode 100644
index 00000000000..276d7613f92
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ShortComplexMath.def
@@ -0,0 +1,88 @@
+(* ShortComplexMath.def provides access to the ShortComplex intrincics.
+
+Copyright (C) 2010-2021 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/>.  *)
+
+DEFINITION MODULE ShortComplexMath;
+
+  (* Mathematical functions for the type SHORTCOMPLEX *)
+
+CONST
+  i =    CMPLX (0.0, 1.0);
+  one =  CMPLX (1.0, 0.0);
+  zero = CMPLX (0.0, 0.0);
+
+PROCEDURE abs (z: SHORTCOMPLEX): SHORTREAL;
+  (* Returns the length of z *)
+
+PROCEDURE arg (z: SHORTCOMPLEX): SHORTREAL;
+  (* Returns the angle that z subtends to the positive real axis *)
+
+PROCEDURE conj (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the complex conjugate of z *)
+
+PROCEDURE power (base: SHORTCOMPLEX; exponent: SHORTREAL): SHORTCOMPLEX;
+  (* Returns the value of the number base raised to the power exponent *)
+
+PROCEDURE sqrt (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the principal square root of z *)
+
+PROCEDURE exp (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the complex exponential of z *)
+
+PROCEDURE ln (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the principal value of the natural logarithm of z *)
+
+PROCEDURE sin (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the sine of z *)
+
+PROCEDURE cos (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the cosine of z *)
+
+PROCEDURE tan (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the tangent of z *)
+
+PROCEDURE arcsin (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the arcsine of z *)
+
+PROCEDURE arccos (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the arccosine of z *)
+
+PROCEDURE arctan (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the arctangent of z *)
+
+PROCEDURE polarToComplex (abs, arg: SHORTREAL): SHORTCOMPLEX;
+  (* Returns the complex number with the specified polar coordinates *)
+
+PROCEDURE scalarMult (scalar: SHORTREAL; z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the scalar product of scalar with z *)
+
+PROCEDURE IsCMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END ShortComplexMath.
+
diff --git a/gcc/m2/gm2-libs-iso/ShortComplexMath.mod b/gcc/m2/gm2-libs-iso/ShortComplexMath.mod
new file mode 100644
index 00000000000..ab2332baa42
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ShortComplexMath.mod
@@ -0,0 +1,164 @@
+(* ShortComplexMath.mod implements access to the ShortComplex intrincics.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ShortComplexMath ;
+
+IMPORT cbuiltin ;
+
+
+(* Returns the length of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cabsf)) abs (z: SHORTCOMPLEX): SHORTREAL;
+BEGIN
+   RETURN cbuiltin.cabsf (z)
+END abs ;
+
+
+(* Returns the angle that z subtends to the positive real axis *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cargf)) arg (z: SHORTCOMPLEX): SHORTREAL;
+BEGIN
+   RETURN cbuiltin.cargf (z)
+END arg ;
+
+
+(* Returns the complex conjugate of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_conjf)) conj (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.conjf (z)
+END conj ;
+
+
+(* Returns the value of the number base raised to the power exponent *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cpowerf)) power (base: SHORTCOMPLEX; exponent: SHORTREAL): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.cpowf (base, exponent)
+END power ;
+
+
+(* Returns the principal square root of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csqrtf)) sqrt (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.csqrtf (z)
+END sqrt ;
+
+
+(* Returns the complex exponential of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cexpf)) exp (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.cexpf (z)
+END exp ;
+
+
+(* Returns the principal value of the natural logarithm of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_clnf)) ln (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.clogf (z)
+END ln ;
+
+
+(* Returns the sine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csinf)) sin (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.csinf (z)
+END sin ;
+
+
+(* Returns the cosine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ccosf)) cos (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.ccosf (z)
+END cos ;
+
+
+(* Returns the tangent of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ctanf)) tan (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.ctanf (z)
+END tan ;
+
+
+(* Returns the arcsine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carcsinf)) arcsin (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.casinf (z)
+END arcsin ;
+
+
+(* Returns the arccosine of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carccosf)) arccos (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.cacosf (z)
+END arccos ;
+
+
+(* Returns the arctangent of z *)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_carctanf)) arctan (z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN cbuiltin.catanf (z)
+END arctan ;
+
+
+(* Returns the complex number with the specified polar coordinates *)
+
+PROCEDURE polarToComplex (abs, arg: SHORTREAL): SHORTCOMPLEX;
+BEGIN
+   RETURN CMPLX (abs*cbuiltin.cosf(arg), abs*cbuiltin.sinf(arg))
+END polarToComplex ;
+
+
+(* Returns the scalar product of scalar with z *)
+
+PROCEDURE scalarMult (scalar: SHORTREAL; z: SHORTCOMPLEX): SHORTCOMPLEX;
+BEGIN
+   RETURN CMPLX (RE(z)*scalar, IM(z)*scalar)
+END scalarMult ;
+
+
+(* Returns TRUE if the current coroutine is in the exceptional
+   execution state because of the raising of an exception in a
+   routine from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsCMathException (): BOOLEAN;
+BEGIN
+   (* --fixme-- we should really attempt to catch sigfpe in these procedures *)
+   RETURN( FALSE )
+END IsCMathException ;
+
+
+END ShortComplexMath.
diff --git a/gcc/m2/gm2-libs-iso/ShortIO.def b/gcc/m2/gm2-libs-iso/ShortIO.def
new file mode 100644
index 00000000000..f8ec0fdb5ed
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ShortIO.def
@@ -0,0 +1,82 @@
+(* ShortIO.def provides input/output of SHORTREAL over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+DEFINITION MODULE ShortIO;
+
+  (* Input and output of short real numbers in decimal text form
+     over specified channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit}, [".",
+       {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: SHORTREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed fixed or floating
+     point number.  The value of this number is assigned to real.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: SHORTREAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to cid in floating-point text form,
+     with sigFigs significant figures, in a field of the given
+     minimum width.
+  *)
+
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: SHORTREAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: SHORTREAL;
+                      place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to cid in fixed-point text form,
+     rounded to the given place relative to the decimal point,
+     in a field of the given minimum width.
+  *)
+
+PROCEDURE WriteReal (cid: IOChan.ChanId; real: SHORTREAL;
+                     width: CARDINAL);
+  (* Writes the value of real to cid, as WriteFixed if the
+     sign and magnitude can be shown in the given width, or
+     otherwise as WriteFloat.  The number of places or
+     significant digits depends on the given width.
+  *)
+
+END ShortIO.
diff --git a/gcc/m2/gm2-libs-iso/ShortIO.mod b/gcc/m2/gm2-libs-iso/ShortIO.mod
new file mode 100644
index 00000000000..900aa59e631
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ShortIO.mod
@@ -0,0 +1,105 @@
+(* ShortIO.mod implements input/output of SHORTREAL over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ShortIO;
+
+IMPORT RealIO ;
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, {decimal digit},
+       [".", {decimal digit}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, {decimal digit}
+  *)
+
+(* Skips leading spaces, and removes any remaining characters
+   from cid that form part of a signed fixed or floating
+   point number.  The value of this number is assigned to real.
+   The read result is set to the value allRight, outOfRange,
+   wrongFormat, endOfLine, or endOfInput.
+*)
+
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: SHORTREAL);
+VAR
+   r: REAL ;
+BEGIN
+   RealIO.ReadReal(cid, r) ;
+   real := r
+END ReadReal ;
+
+
+(* Writes the value of real to cid in floating-point text form,
+   with sigFigs significant figures, in a field of the given
+   minimum width.
+*)
+
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: SHORTREAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+BEGIN
+   RealIO.WriteFloat(cid, real, sigFigs, width)
+END WriteFloat ;
+
+
+(* As for WriteFloat, except that the number is scaled with
+   one to three digits in the whole number part, and with an
+   exponent that is a multiple of three.
+*)
+
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: SHORTREAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+BEGIN
+   RealIO.WriteEng(cid, real, sigFigs, width)
+END WriteEng ;
+
+
+(* Writes the value of real to cid in fixed-point text form,
+   rounded to the given place relative to the decimal point,
+   in a field of the given minimum width.
+*)
+
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: SHORTREAL;
+                      place: INTEGER; width: CARDINAL);
+BEGIN
+   RealIO.WriteFixed(cid, real, place, width)
+END WriteFixed ;
+
+
+(* Writes the value of real to cid, as WriteFixed if the sign
+   and magnitude can be shown in the given width, or otherwise
+   as WriteFloat.  The number of places or significant digits
+   depends on the given width.
+*)
+
+PROCEDURE WriteReal (cid: IOChan.ChanId;
+                     real: SHORTREAL; width: CARDINAL);
+BEGIN
+   RealIO.WriteReal(cid, real, width)
+END WriteReal ;
+
+
+END ShortIO.
diff --git a/gcc/m2/gm2-libs-iso/ShortWholeIO.def b/gcc/m2/gm2-libs-iso/ShortWholeIO.def
new file mode 100644
index 00000000000..02fe0b99711
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ShortWholeIO.def
@@ -0,0 +1,69 @@
+(* ShortWholeIO.def provides input/output of SHORTINT/SHORTCARD over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+DEFINITION MODULE ShortWholeIO;
+
+  (* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, {decimal digit}
+
+     The text form of an unsigned whole number is
+       decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: SHORTINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: SHORTINT;
+                    width: CARDINAL);
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: SHORTCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: SHORTCARD;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+
+END ShortWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/ShortWholeIO.mod b/gcc/m2/gm2-libs-iso/ShortWholeIO.mod
new file mode 100644
index 00000000000..13ae661c5b7
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/ShortWholeIO.mod
@@ -0,0 +1,175 @@
+(* ShortWholeIO.mod implements input/output of SHORTINT/SHORTCARD over channels.
+
+Copyright (C) 2013-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ShortWholeIO ;
+
+FROM ConvTypes IMPORT ScanClass, ScanState ;
+FROM TextIO IMPORT WriteChar, ReadChar ;
+FROM DynamicStrings IMPORT String, char, KillString, Length ;
+FROM StringConvert IMPORT IntegerToString, CardinalToString ;
+FROM WholeConv IMPORT ScanInt, ScanCard ;
+FROM StringChan IMPORT writeString ;
+FROM IOConsts IMPORT ReadResults ;
+
+
+(* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+*)
+
+IMPORT IOChan;
+
+(* The text form of a signed whole number is
+     ["+" | "-"], decimal digit, {decimal digit}
+
+   The text form of an unsigned whole number is
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: SHORTINT) ;
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+VAR
+   chClass  : ScanClass ;
+   nextState: ScanState ;
+   c        : SHORTCARD ;
+   ch       : CHAR ;
+   negative : BOOLEAN ;
+BEGIN
+   ReadChar(cid, ch) ;
+   negative := FALSE ;
+   c := 0 ;
+   nextState := ScanInt ;
+   REPEAT
+      nextState(ch, chClass, nextState) ;
+      IF chClass=valid
+      THEN
+         IF ch='+'
+         THEN
+            (* ignore *)
+         ELSIF ch='-'
+         THEN
+            negative := NOT negative
+         ELSE
+            c := c*10+VAL(SHORTCARD, ORD(ch)-ORD('0'))
+         END ;
+         ReadChar(cid, ch)
+      ELSIF chClass=padding
+      THEN
+         ReadChar(cid, ch)
+      END
+   UNTIL (chClass=invalid) OR (chClass=terminator) ;
+   IF chClass=terminator
+   THEN
+      IF negative
+      THEN
+         IF c=VAL(SHORTCARD, MAX(SHORTINT))+1
+         THEN
+            int := MIN(SHORTINT)
+         ELSIF c<=VAL(SHORTCARD, MAX(SHORTINT))
+         THEN
+            int := -VAL(SHORTINT, c)
+         ELSE
+            (* overflow *)
+            IOChan.SetReadResult(cid, outOfRange)
+         END
+      ELSE
+         int := c
+      END
+   END
+END ReadInt ;
+
+
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: SHORTINT;
+                    width: CARDINAL) ;
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+VAR
+   s: String ;
+BEGIN
+   s := IntegerToString(int, width, ' ', TRUE, 10, FALSE) ;
+   writeString(cid, s) ;
+   s := KillString(s)
+END WriteInt ;
+
+
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: SHORTCARD) ;
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+VAR
+   chClass  : ScanClass ;
+   nextState: ScanState ;
+   ch       : CHAR ;
+   c        : SHORTCARD ;
+BEGIN
+   ReadChar(cid, ch) ;
+   c := 0 ;
+   nextState := ScanCard ;
+   REPEAT
+      nextState(ch, chClass, nextState) ;
+      IF chClass=valid
+      THEN
+         IF ch='+'
+         THEN
+            (* ignore *)
+         ELSE
+            c := c*10+VAL(SHORTCARD, ORD(ch)-ORD('0'))
+         END ;
+         ReadChar(cid, ch)
+      ELSIF chClass=padding
+      THEN
+         ReadChar(cid, ch)
+      END
+   UNTIL (chClass=invalid) OR (chClass=terminator) ;
+   IF chClass=terminator
+   THEN
+      card := c
+   END
+END ReadCard ;
+
+
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: SHORTCARD;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+VAR
+   s: String ;
+BEGIN
+   s := CardinalToString(card, width, ' ', 10, FALSE) ;
+   writeString(cid, s) ;
+   s := KillString(s)
+END WriteCard ;
+
+
+END ShortWholeIO.
diff --git a/gcc/m2/gm2-libs-iso/SimpleCipher.def b/gcc/m2/gm2-libs-iso/SimpleCipher.def
new file mode 100644
index 00000000000..8a809c96109
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SimpleCipher.def
@@ -0,0 +1,60 @@
+(* SimpleCipher.def provides a pegalogical caesar cipher.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE SimpleCipher ;
+
+(*
+    Title      : SimpleCipher
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon Sep 29 11:02:56 2008
+    Revision   : $Version$ 
+    Description: provides a simple Caesar cipher layer which
+                 can be attached to any channel device.  This,
+                 pedagogical, module is designed to show how
+                 it is possible to add further layers underneath
+                 the channel devices.
+*)
+
+FROM IOChan IMPORT ChanId ;
+
+
+(*
+   InsertCipherLayer - inserts a caesar cipher below channel, cid.
+                       The encryption, key, is specified.
+*)
+
+PROCEDURE InsertCipherLayer (cid: ChanId; key: INTEGER) ;
+
+
+(*
+   RemoveCipherLayer - removes a Caesar cipher below channel, cid.
+*)
+
+PROCEDURE RemoveCipherLayer (cid: ChanId) ;
+
+
+END SimpleCipher.
diff --git a/gcc/m2/gm2-libs-iso/SimpleCipher.mod b/gcc/m2/gm2-libs-iso/SimpleCipher.mod
new file mode 100644
index 00000000000..9a374f345a3
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SimpleCipher.mod
@@ -0,0 +1,452 @@
+(* SimpleCipher.mod implements a pegalogical caesar cipher.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SimpleCipher ;
+
+
+FROM SYSTEM IMPORT ADDRESS, ADR, CARDINAL8, LOC ;
+FROM RTio IMPORT GetDeviceId ;
+FROM RTdata IMPORT ModuleId, MakeModuleId, InitData, GetData, KillData ;
+FROM IOLink IMPORT DeviceId, DeviceTable, DeviceTablePtr, DeviceTablePtrValue, AllocateDeviceId, RAISEdevException ;
+FROM IOChan IMPORT ChanExceptions ;
+FROM IOConsts IMPORT ReadResults ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM ASCII IMPORT nul, lf ;
+FROM Strings IMPORT Insert, Append ;
+FROM CharClass IMPORT IsLower, IsUpper, IsNumeric ;
+
+
+TYPE
+   PtrToLoc   = POINTER TO LOC ;
+   PtrToChar  = POINTER TO CHAR ;
+   CipherInfo = POINTER TO RECORD
+                              key  : INTEGER ;
+                              lower: DeviceTable ;
+                           END ;
+
+
+VAR
+   mid: ModuleId ;
+
+
+(*
+   RotateChar - 
+*)
+
+PROCEDURE RotateChar (ch, lower, upper: CHAR; key: INTEGER) : CHAR ;
+VAR
+   r: INTEGER ;
+BEGIN
+   r := VAL(INTEGER, ORD(upper)-ORD(lower))+1 ;
+   IF key<0
+   THEN
+      RETURN( RotateChar(ch, lower, upper, r-key) )
+   ELSE
+      IF key>r
+      THEN
+         key := key MOD r
+      END ;
+      (* key is now positive and within a sensible range *)
+      IF ORD(ch)+VAL(CARDINAL, key)>ORD(upper)
+      THEN
+         RETURN( CHR((ORD(ch)+VAL(CARDINAL, key))-VAL(CARDINAL, r)) )
+      ELSE
+         RETURN( CHR(ORD(ch)+VAL(CARDINAL, key)) )
+      END
+   END
+END RotateChar ;
+
+
+(*
+   encryptChar - encrypts, ch, using Caesar cipher.  Only
+                 characters [A-Z][a-z][0-9] are encrypted.
+                 Also these character ranges are only rotated
+                 around their own range.
+*)
+
+PROCEDURE encryptChar (ch: CHAR; key: INTEGER) : CHAR ;
+BEGIN
+   IF IsLower(ch)
+   THEN
+      RETURN( RotateChar(ch, 'a', 'z', key) )
+   ELSIF IsUpper(ch)
+   THEN
+      RETURN( RotateChar(ch, 'A', 'Z', key) )
+   ELSIF IsNumeric(ch)
+   THEN
+      RETURN( RotateChar(ch, '0', '9', key) )
+   ELSE
+      RETURN( ch )
+   END
+END encryptChar ;
+
+
+(*
+   decryptChar - decrypts, ch, using Caesar cipher.  Only
+                 characters [A-Z][a-z][0-9] are decrypted.
+                 Also these character ranges are only rotated
+                 around their own range.
+*)
+
+PROCEDURE decryptChar (ch: CHAR; key: INTEGER) : CHAR ;
+BEGIN
+   RETURN( encryptChar(ch, -key) )
+END decryptChar ;
+
+
+(*
+   RotateLoc - 
+*)
+
+PROCEDURE RotateLoc (cid: ChanId;
+                     did: DeviceId;
+                     l: LOC; key: INTEGER) : LOC ;
+VAR
+   i, u: INTEGER ;
+   c: CARDINAL8 ;
+BEGIN
+   IF SIZE(l)#SIZE(c)
+   THEN
+      RAISEdevException(cid, did, notAvailable, 'SimpleCipher: unable to cipher LOCs of this size')
+   ELSE
+      IF key<0
+      THEN
+         RETURN( RotateLoc(cid, did, l, -key+VAL(INTEGER, MAX(CARDINAL8))) )
+      ELSE
+         IF key>VAL(INTEGER, MAX(CARDINAL8))
+         THEN
+            key := key MOD (VAL(INTEGER, MAX(CARDINAL8))+1)
+         END ;
+         c := VAL(CARDINAL8, l) ;
+         u := VAL(INTEGER, MAX(CARDINAL8))+1 ;
+         IF u-VAL(INTEGER, c)>key
+         THEN
+            INC(c, key)
+         ELSE
+            c := key-(u-VAL(INTEGER, c))
+         END ;
+         RETURN( VAL(LOC, c) )
+      END
+   END
+END RotateLoc ;
+
+
+(*
+   encryptLoc - encrypts, l, by, key.
+*)
+
+PROCEDURE encryptLoc (cid: ChanId; did: DeviceId; l: LOC; key: INTEGER) : LOC ;
+BEGIN
+   RETURN( RotateLoc(cid, did, l, key) )
+END encryptLoc ;
+
+
+(*
+   decryptLoc - decrypts, l, by, key.
+*)
+
+PROCEDURE decryptLoc (cid: ChanId; did: DeviceId; l: LOC; key: INTEGER) : LOC ;
+BEGIN
+   RETURN( RotateLoc(cid, did, l, -key) )
+END decryptLoc ;
+
+
+PROCEDURE dolook (d: DeviceTablePtr;
+                  VAR ch: CHAR; VAR r: ReadResults) ;
+VAR
+   c: CipherInfo ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH c^ DO
+      lower.doLook(d, ch, r) ;
+      IF (r=allRight) OR (r=endOfLine)
+      THEN
+         ch := decryptChar(ch, key)
+      END
+   END
+END dolook ;
+
+
+PROCEDURE doskip (d: DeviceTablePtr) ;
+VAR
+   c: CipherInfo ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH c^ DO
+      lower.doSkip(d)
+   END
+END doskip ;
+
+
+PROCEDURE doskiplook (d: DeviceTablePtr;
+                      VAR ch: CHAR; VAR r: ReadResults) ;
+VAR
+   c: CipherInfo ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH c^ DO
+      lower.doSkipLook(d, ch, r) ;
+      IF (r=allRight) OR (r=endOfLine)
+      THEN
+         ch := decryptChar(ch, key)
+      END
+   END
+END doskiplook ;
+
+
+PROCEDURE dowriteln (d: DeviceTablePtr) ;
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := lf ;
+   dotextwrite(d, ADR(ch), 1)
+END dowriteln ;
+
+
+PROCEDURE dotextread (d: DeviceTablePtr;
+                      to: ADDRESS;
+                      maxChars: CARDINAL;
+                      VAR charsRead: CARDINAL) ;
+VAR
+   c : CipherInfo ;
+   i : CARDINAL ;
+   ch: CHAR ;
+   p : PtrToChar ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH c^ DO
+      charsRead := 0 ;
+      p := to ;
+      WHILE charsRead<maxChars DO
+         c^.lower.doTextRead(d, ADR(ch), SIZE(ch), i) ;
+         IF i>0
+         THEN
+            p^ := decryptChar(ch, key) ;
+            INC(p, SIZE(ch)) ;
+            INC(charsRead, i)
+         ELSE
+            RETURN
+         END
+      END
+   END
+END dotextread ;
+
+
+PROCEDURE dotextwrite (d: DeviceTablePtr;
+                       from: ADDRESS;
+                       charsToWrite: CARDINAL);
+VAR
+   c : CipherInfo ;
+   i : CARDINAL ;
+   ch: CHAR ;
+   p : PtrToChar ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH c^ DO
+      p := from ;
+      i := 0 ;
+      WHILE i<charsToWrite DO
+         ch := encryptChar(p^, key) ;
+         c^.lower.doTextWrite(d, ADR(ch), SIZE(ch)) ;
+         INC(p, SIZE(ch)) ;
+         INC(i)
+      END
+   END
+END dotextwrite ;
+
+
+PROCEDURE dorawread (d: DeviceTablePtr;
+                     to: ADDRESS;
+                     maxLocs: CARDINAL;
+                     VAR locsRead: CARDINAL) ;
+VAR
+   c: CipherInfo ;
+   i: CARDINAL ;
+   p: PtrToLoc ;
+   l: LOC ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH c^ DO
+      locsRead := 0 ;
+      p := to ;
+      WHILE locsRead<maxLocs DO
+         lower.doRawRead(d, ADR(l), SIZE(l), i) ;
+         IF i>0
+         THEN
+            p^ := decryptLoc(d^.cid, d^.did, l, key) ;
+            INC(p) ;
+            INC(locsRead, i)
+         ELSE
+            RETURN
+         END
+      END
+   END
+END dorawread ;
+
+
+PROCEDURE dorawwrite (d: DeviceTablePtr;
+                      from: ADDRESS;
+                      locsToWrite: CARDINAL) ;
+VAR
+   c: CipherInfo ;
+   i: CARDINAL ;
+   l: LOC ;
+   p: PtrToLoc ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH c^ DO
+      p := from ;
+      i := 0 ;
+      WHILE i<locsToWrite DO
+         l := encryptLoc(d^.cid, d^.did, p^, key) ;
+         lower.doRawWrite(d, ADR(l), SIZE(l)) ;
+         INC(p) ;
+         INC(i)
+      END
+   END
+END dorawwrite ;
+
+
+PROCEDURE dogetname (d: DeviceTablePtr;
+                     VAR a: ARRAY OF CHAR) ;
+VAR
+   c: CipherInfo ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH c^ DO
+      lower.doGetName(d, a) ;
+      Insert('SimpleCipher (', 0, a) ;
+      Append(')', a)
+   END
+END dogetname ;
+
+
+(*
+   freeData - disposes of, c.
+*)
+
+PROCEDURE freeData (c: CipherInfo) ;
+BEGIN
+   DISPOSE(c)
+END freeData ;
+
+
+(*
+   dofree - replace original methods and then delete data pertaining
+            to, mid.  The idea is that our new methods will call the
+            old methods and then decrypt data when reading and visa
+            versa for writing.  We write CHARs and LOCs at a time so
+            ensure no plaintext data is ever passed outside this
+            module.
+*)
+
+PROCEDURE dofree (d: DeviceTablePtr) ;
+VAR
+   c: CipherInfo ;
+BEGIN
+   c := GetData(d, mid) ;
+   WITH d^ DO
+      doLook := c^.lower.doLook ;
+      doLook := c^.lower.doLook ;
+      doSkip := c^.lower.doSkip ;
+      doSkipLook := c^.lower.doSkipLook ;
+      doLnWrite := c^.lower.doLnWrite ;
+      doTextRead := c^.lower.doTextRead ;
+      doTextRead := c^.lower.doTextRead ;
+      doRawRead := c^.lower.doRawRead ;
+      doRawWrite := c^.lower.doRawWrite ;
+      doGetName := c^.lower.doGetName ;
+      doReset := c^.lower.doReset ;
+      doFlush := c^.lower.doFlush ;
+      doFree := c^.lower.doFree
+   END
+END dofree ;
+
+
+(*
+   InsertCipherLayer - inserts a Caesar cipher below channel, cid.
+                       The encryption, key, is specified.
+*)
+
+PROCEDURE InsertCipherLayer (cid: ChanId; key: INTEGER) ;
+VAR
+   did: DeviceId ;
+   d  : DeviceTablePtr ;
+   c  : CipherInfo ;
+BEGIN
+   did := GetDeviceId(cid) ;
+   d := DeviceTablePtrValue(cid, did) ;
+   IF GetData(d, mid)=NIL
+   THEN
+      NEW(c) ;
+      c^.key := key ;
+      c^.lower := d^ ;
+      InitData(d, mid, c, freeData) ;
+      WITH d^ DO
+         doLook := dolook ;
+         doSkip := doskip ;
+         doSkipLook := doskiplook ;
+         doLnWrite := dowriteln ;
+         doTextRead := dotextread ;
+         doTextWrite := dotextwrite ;
+         doRawRead := dorawread ;
+         doRawWrite := dorawwrite ;
+         doGetName := dogetname ;
+         (* doReset := doreset ; no need for either of these *)
+         (* doFlush := doflush ; *)
+         doFree := dofree
+      END
+   ELSE
+      RAISEdevException(cid, did, notAvailable,
+                        'SimpleCipher: unable to insert multiple cipher layers from the same module under a channel')
+   END
+END InsertCipherLayer ;
+
+
+(*
+   RemoveCipherLayer - removes a Caesar cipher below channel, cid.
+*)
+
+PROCEDURE RemoveCipherLayer (cid: ChanId) ;
+VAR
+   did: DeviceId ;
+   d  : DeviceTablePtr ;
+BEGIN
+   did := GetDeviceId(cid) ;
+   d := DeviceTablePtrValue(cid, did) ;
+   IF GetData(d, mid)=NIL
+   THEN
+      RAISEdevException(cid, did, notAvailable,
+                        'SimpleCipher: no cipher layer to remove from this channel')
+   ELSE
+      KillData(d, mid)
+   END
+END RemoveCipherLayer ;
+
+
+BEGIN
+   MakeModuleId(mid)
+END SimpleCipher.
diff --git a/gcc/m2/gm2-libs-iso/StdChans.def b/gcc/m2/gm2-libs-iso/StdChans.def
new file mode 100644
index 00000000000..3fa7c4e1e87
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/StdChans.def
@@ -0,0 +1,67 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE StdChans;
+
+  (* Access to standard and default channels *)
+
+IMPORT IOChan;
+
+TYPE
+  ChanId = IOChan.ChanId;
+    (* Values of this type are used to identify channels *)
+
+  (* The following functions return the standard channel values.
+     These channels cannot be closed.
+  *)
+
+PROCEDURE StdInChan (): ChanId;
+  (* Returns the identity of the implementation-defined standard source for
+program
+     input.
+  *)
+
+PROCEDURE StdOutChan (): ChanId;
+  (* Returns the identity of the implementation-defined standard source for program
+     output.
+  *)
+
+PROCEDURE StdErrChan (): ChanId;
+  (* Returns the identity of the implementation-defined standard destination for program
+     error messages.
+  *)
+
+PROCEDURE NullChan (): ChanId;
+  (* Returns the identity of a channel open to the null device. *)
+
+  (* The following functions return the default channel values *)
+
+PROCEDURE InChan (): ChanId;
+  (* Returns the identity of the current default input channel. *)
+
+PROCEDURE OutChan (): ChanId;
+  (* Returns the identity of the current default output channel. *)
+
+PROCEDURE ErrChan (): ChanId;
+  (* Returns the identity of the current default error message channel. *)
+
+  (* The following procedures allow for redirection of the default channels *)
+
+PROCEDURE SetInChan (cid: ChanId);
+  (* Sets the current default input channel to that identified by cid. *)
+
+PROCEDURE SetOutChan (cid: ChanId);
+  (* Sets the current default output channel to that identified by cid. *)
+
+PROCEDURE SetErrChan (cid: ChanId);
+  (* Sets the current default error channel to that identified by cid. *)
+
+END StdChans.
diff --git a/gcc/m2/gm2-libs-iso/StdChans.mod b/gcc/m2/gm2-libs-iso/StdChans.mod
new file mode 100644
index 00000000000..e1994fc0a60
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/StdChans.mod
@@ -0,0 +1,312 @@
+(* StdChans.mod implement the ISO StdChans specification.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+IMPLEMENTATION MODULE StdChans ;
+
+IMPORT FIO, IOLink, ChanConsts, SYSTEM, RTio ;
+
+FROM RTio IMPORT SetFile, GetFile, GetDevicePtr ;
+FROM IOConsts IMPORT ReadResults ;
+FROM ChanConsts IMPORT read, write, text, raw, FlagSet ;
+FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
+
+FROM RTfio IMPORT doreadchar, dounreadchar,
+                  dogeterrno, dorbytes, dowbytes,
+                  dowriteln,
+                  iseof, iseoln, iserror ;
+
+FROM RTgen IMPORT ChanDev, DeviceType,
+                  InitChanDev, doLook, doSkip, doSkipLook, doWriteLn,
+                  doReadText, doWriteText, doReadLocs, doWriteLocs,
+                  checkErrno ;
+
+
+VAR
+   in,
+   out,
+   err,
+   stdin,
+   stdout,
+   stderr,
+   stdnull: ChanId ;
+   gen    : GenDevIF ;
+   dev    : ChanDev ;
+   did    : IOLink.DeviceId ;
+
+
+PROCEDURE look (d: IOLink.DeviceTablePtr;
+                VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doLook(dev, d, ch, r)
+END look ;
+
+
+PROCEDURE skip (d: IOLink.DeviceTablePtr) ;
+BEGIN
+   doSkip(dev, d)
+END skip ;
+
+
+PROCEDURE skiplook (d: IOLink.DeviceTablePtr;
+                    VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doSkipLook(dev, d, ch, r)
+END skiplook ;
+
+
+PROCEDURE lnwrite (d: IOLink.DeviceTablePtr) ;
+BEGIN
+   doWriteLn(dev, d)
+END lnwrite ;
+
+
+PROCEDURE textread (d: IOLink.DeviceTablePtr;
+                    to: SYSTEM.ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+BEGIN
+   doReadText(dev, d, to, maxChars, charsRead)
+END textread ;
+
+
+PROCEDURE textwrite (d: IOLink.DeviceTablePtr;
+                     from: SYSTEM.ADDRESS;
+                     charsToWrite: CARDINAL);
+BEGIN
+   doWriteText(dev, d, from, charsToWrite)
+END textwrite ;
+
+
+PROCEDURE rawread (d: IOLink.DeviceTablePtr;
+                   to: SYSTEM.ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+BEGIN
+   doReadLocs(dev, d, to, maxLocs, locsRead)
+END rawread ;
+
+
+PROCEDURE rawwrite (d: IOLink.DeviceTablePtr;
+                    from: SYSTEM.ADDRESS;
+                    locsToWrite: CARDINAL) ;
+BEGIN
+   doWriteLocs(dev, d, from, locsToWrite)
+END rawwrite ;
+
+
+PROCEDURE getname (d: IOLink.DeviceTablePtr;
+                   VAR a: ARRAY OF CHAR) ;
+BEGIN
+   FIO.GetFileName(GetFile(d^.cid), a)
+END getname ;
+
+
+PROCEDURE flush (d: IOLink.DeviceTablePtr) ;
+BEGIN
+   FIO.FlushBuffer(GetFile(d^.cid))
+END flush ;
+
+
+PROCEDURE StdInChan () : ChanId ;
+  (* Returns the identity of the implementation-defined standard source for
+     program input.
+  *)
+BEGIN
+   RETURN( stdin )
+END StdInChan ;
+
+
+PROCEDURE StdOutChan () : ChanId ;
+  (* Returns the identity of the implementation-defined standard source for program
+     output.
+  *)
+BEGIN
+   RETURN( stdout )
+END StdOutChan ;
+
+
+PROCEDURE StdErrChan () : ChanId ;
+  (* Returns the identity of the implementation-defined standard destination for program
+     error messages.
+  *)
+BEGIN
+   RETURN( stderr )
+END StdErrChan ;
+
+
+PROCEDURE NullChan () : ChanId ;
+  (* Returns the identity of a channel open to the null device. *)
+BEGIN
+   RETURN( stdnull )
+END NullChan ;
+
+
+  (* The following functions return the default channel values *)
+
+PROCEDURE InChan () : ChanId ;
+  (* Returns the identity of the current default input channel. *)
+BEGIN
+   RETURN( in )
+END InChan ;
+
+
+PROCEDURE OutChan () : ChanId ;
+  (* Returns the identity of the current default output channel. *)
+BEGIN
+   RETURN( out )
+END OutChan ;
+
+
+PROCEDURE ErrChan () : ChanId ;
+  (* Returns the identity of the current default error message channel. *)
+BEGIN
+   RETURN( err )
+END ErrChan ;
+
+  (* The following procedures allow for redirection of the default channels *)
+
+PROCEDURE SetInChan (cid: ChanId) ;
+  (* Sets the current default input channel to that identified by cid. *)
+BEGIN
+   in := cid
+END SetInChan ;
+
+
+PROCEDURE SetOutChan (cid: ChanId) ;
+  (* Sets the current default output channel to that identified by cid. *)
+BEGIN
+   out := cid
+END SetOutChan ;
+
+
+PROCEDURE SetErrChan (cid: ChanId) ;
+  (* Sets the current default error channel to that identified by cid. *)
+BEGIN
+   err := cid
+END SetErrChan ;
+
+
+(*
+   handlefree - 
+*)
+
+PROCEDURE handlefree (d: IOLink.DeviceTablePtr) ;
+VAR
+   f: FIO.File ;
+BEGIN
+   WITH d^ DO
+      doFlush(d) ;
+      checkErrno(dev, d) ;
+      f := RTio.GetFile(RTio.ChanId(cid)) ;
+      IF FIO.IsNoError(f)
+      THEN
+         FIO.FlushBuffer(f) ;
+      END ;
+      checkErrno(dev, d)
+   END
+END handlefree ;
+
+
+(*
+   SafeClose - only closes a channel if it was a StdChan.
+*)
+
+PROCEDURE SafeClose (VAR cid: ChanId) ;
+BEGIN
+   IF (cid#NIL) AND (cid#IOChan.InvalidChan()) AND IOLink.IsDevice(cid, did)
+   THEN
+      IOLink.UnMakeChan(did, cid) ;
+      cid := IOChan.InvalidChan()
+   END
+END SafeClose ;
+
+
+(*
+   MapFile - 
+*)
+
+PROCEDURE MapFile (f: FIO.File; fl: ChanConsts.FlagSet) : IOChan.ChanId ;
+VAR
+   c: IOChan.ChanId ;
+   d: IOLink.DeviceTablePtr ;
+BEGIN
+   IOLink.MakeChan(did, c) ;
+   d := GetDevicePtr(c) ;
+   WITH d^ DO
+      result := notKnown ;
+      SetFile(c, f) ;
+      flags := fl ;
+      doLook := look ;
+      doSkip := skip ;
+      doSkipLook := skiplook ;
+      doLnWrite := lnwrite ;
+      doTextRead := textread ;
+      doTextWrite := textwrite ;
+      doRawRead := rawread ;
+      doRawWrite := rawwrite ;
+      doGetName := getname ;
+      (* doReset := reset ; *)
+      doFlush := flush ;
+      doFree := handlefree
+   END ;
+   RETURN( c )
+END MapFile ;
+
+
+(*
+   Init - initializes the device and opens up the standard channels.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   IOLink.AllocateDeviceId(did) ;
+   IOLink.MakeChan(did, stdnull) ;
+
+   gen := InitGenDevIF(did, doreadchar, dounreadchar,
+                       dogeterrno, dorbytes, dowbytes,
+                       dowriteln,
+                       iseof, iseoln, iserror) ;
+   dev := InitChanDev(stdchans, did, gen) ;
+
+   stdin := MapFile(FIO.StdIn, read+text+raw) ;
+   stdout := MapFile(FIO.StdOut, write+text+raw) ;
+   stderr := MapFile(FIO.StdErr, write+text+raw) ;
+   SetInChan(stdin) ;
+   SetOutChan(stdout) ;
+   SetErrChan(stderr) ;
+END Init ;
+
+
+BEGIN
+   Init
+FINALLY
+   SafeClose(in) ;
+   SafeClose(out) ;
+   SafeClose(err) ;
+   SafeClose(stdin) ;
+   SafeClose(stdout) ;
+   SafeClose(stderr)
+END StdChans.
diff --git a/gcc/m2/gm2-libs-iso/Storage.def b/gcc/m2/gm2-libs-iso/Storage.def
new file mode 100644
index 00000000000..24bf8537896
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Storage.def
@@ -0,0 +1,57 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE Storage;
+
+  (* Facilities for dynamically allocating and deallocating storage *)
+
+IMPORT SYSTEM;
+
+PROCEDURE ALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL);
+  (* Allocates storage for a variable of size amount and assigns
+     the address of this variable to addr. If there is insufficient
+     unallocated storage to do this, the value NIL is assigned to addr.
+  *)
+
+PROCEDURE DEALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL);
+  (* Deallocates amount locations allocated by ALLOCATE for
+     the storage of the variable addressed by addr and assigns
+     the value NIL to addr.
+  *)
+
+PROCEDURE REALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL);
+  (* Attempts to reallocate, amount of storage.  Effectively it
+     calls ALLOCATE, copies the amount of data pointed to by
+     addr into the new space and DEALLOCATES the addr.
+     This procedure is a GNU extension.
+  *)
+
+TYPE
+  StorageExceptions = (
+    nilDeallocation,             (* first argument to DEALLOCATE is NIL *)
+    pointerToUnallocatedStorage, (* storage to deallocate not allocated by ALLOCATE *)
+    wrongStorageToUnallocate     (* amount to deallocate is not amount allocated *)
+  );
+
+PROCEDURE IsStorageException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception from
+     StorageExceptions; otherwise returns FALSE.
+  *)
+
+PROCEDURE StorageException (): StorageExceptions;
+  (* If the current coroutine is in the exceptional execution
+     state because of the raising of an exception from
+     StorageExceptions, returns the corresponding
+     enumeration value, and otherwise raises an exception.
+  *)
+
+END Storage.
diff --git a/gcc/m2/gm2-libs-iso/Storage.mod b/gcc/m2/gm2-libs-iso/Storage.mod
new file mode 100644
index 00000000000..abf49bcbea7
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Storage.mod
@@ -0,0 +1,176 @@
+(* Storage.mod implement the ISO Storage specification.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Storage ;
+
+FROM libc IMPORT malloc, free, memcpy ;
+FROM M2RTS IMPORT Halt ;
+FROM SYSTEM IMPORT TSIZE ;
+FROM M2EXCEPTION IMPORT M2Exceptions ;
+FROM RTentity IMPORT Group, InitGroup, GetKey, PutKey, DelKey, IsIn ;
+
+FROM EXCEPTIONS IMPORT ExceptionNumber, RAISE,
+                       AllocateSource, ExceptionSource, IsCurrentSource,
+                       IsExceptionalExecution ;
+
+
+
+PROCEDURE ALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL) ;
+BEGIN
+   Init ;
+   addr := malloc (amount) ;
+   IF addr#NIL
+   THEN
+      PutKey (storageTree, addr, amount)
+   END
+END ALLOCATE ;
+
+
+PROCEDURE DEALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL) ;
+BEGIN
+   assert (initialized) ;
+   IF VerifyDeallocate (addr, amount)
+   THEN
+      free (addr) ;
+      addr := NIL
+   END
+END DEALLOCATE ;
+
+
+PROCEDURE REALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL);
+  (* Attempts to reallocate, amount of storage.  Effectively it
+     calls ALLOCATE, copies the amount of data pointed to by
+     addr into the new space and DEALLOCATES the addr.
+     This procedure is a GNU extension.
+  *)
+VAR
+   newa: SYSTEM.ADDRESS ;
+   n   : CARDINAL ;
+BEGIN
+   assert (initialized) ;
+   IF NOT IsIn (storageTree, addr)
+   THEN
+      RAISE (storageException, ORD(pointerToUnallocatedStorage),
+             'trying to reallocate memory which has never been allocated') ;
+   END ;
+   n := GetKey (storageTree, addr) ;
+   ALLOCATE(newa, amount) ;
+   IF n<amount
+   THEN
+      newa := memcpy(newa, addr, n)
+   ELSE
+      newa := memcpy(newa, addr, amount)
+   END ;
+   DEALLOCATE(addr, n) ;
+   addr := newa
+END REALLOCATE ;
+
+
+PROCEDURE IsStorageException () : BOOLEAN;
+BEGIN
+   Init ;
+   RETURN( IsCurrentSource (storageException) )
+END IsStorageException ;
+
+
+PROCEDURE StorageException () : StorageExceptions ;
+BEGIN
+   Init ;
+   IF NOT IsExceptionalExecution ()
+   THEN
+      RAISE (storageException, ORD (functionException), 'no storage exception raised')
+   END ;
+   RETURN currentException
+END StorageException ;
+
+
+(*
+   VerifyDeallocate -
+*)
+
+PROCEDURE VerifyDeallocate (addr: SYSTEM.ADDRESS; amount: CARDINAL) : BOOLEAN ;
+VAR
+   a: CARDINAL ;
+BEGIN
+
+   IF addr=NIL
+   THEN
+      RAISE (storageException, ORD(nilDeallocation), 'deallocating pointer whose value is NIL') ;
+      RETURN FALSE
+   ELSE
+      IF NOT IsIn(storageTree, addr)
+      THEN
+         RAISE (storageException, ORD(pointerToUnallocatedStorage), 'trying to deallocate memory which has never been allocated') ;
+         RETURN FALSE
+      END ;
+      a := GetKey (storageTree, addr) ;
+      IF a#amount
+      THEN
+         RAISE (storageException, ORD(wrongStorageToUnallocate), 'wrong amount of storage being deallocated') ;
+         RETURN FALSE
+      END
+   END ;
+   DelKey (storageTree, addr) ;
+   RETURN TRUE
+END VerifyDeallocate ;
+
+
+(*
+   assert - simple assertion procedure.
+*)
+
+PROCEDURE assert (condition: BOOLEAN) ;
+BEGIN
+   IF NOT condition
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            'internal runtime error, module Storage has not been initialized yet')
+   END
+END assert ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   IF NOT initialized
+   THEN
+      initialized := TRUE ;
+      storageTree := InitGroup () ;
+      AllocateSource (storageException)
+   END
+END Init ;
+
+
+VAR
+   storageException: ExceptionSource ;
+   currentException: StorageExceptions ;
+   storageTree     : Group ;
+   initialized     : BOOLEAN ;  (* Set to FALSE when the bss is created.  *)
+
+END Storage.
diff --git a/gcc/m2/gm2-libs-iso/StreamFile.def b/gcc/m2/gm2-libs-iso/StreamFile.def
new file mode 100644
index 00000000000..d53e21a415f
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/StreamFile.def
@@ -0,0 +1,56 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE StreamFile;
+
+  (* Independent sequential data streams *)
+
+IMPORT IOChan, ChanConsts;
+
+TYPE
+  ChanId = IOChan.ChanId;
+  FlagSet = ChanConsts.FlagSet;
+  OpenResults = ChanConsts.OpenResults;
+
+  (* Accepted singleton values of FlagSet *)
+
+CONST
+  read = FlagSet{ChanConsts.readFlag};   (* input operations are requested/available *)
+  write = FlagSet{ChanConsts.writeFlag}; (* output operations are requested/available *)
+  old = FlagSet{ChanConsts.oldFlag};     (* a file may/must/did exist before the channel is
+                                            opened *)
+  text = FlagSet{ChanConsts.textFlag};   (* text operations are requested/available *)
+  raw = FlagSet{ChanConsts.rawFlag};     (* raw operations are requested/available *)
+
+
+PROCEDURE Open (VAR cid: ChanId; name: ARRAY OF CHAR;
+                flags: FlagSet; VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a
+     sequential stream of the given name.
+     The read flag implies old; without the raw flag, text is
+     implied.  If successful, assigns to cid the identity of
+     the opened channel, and assigns the value opened to res.
+     If a channel cannot be opened as required, the value of
+     res indicates the reason, and cid identifies the invalid
+     channel.
+  *)
+
+PROCEDURE IsStreamFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to a sequential stream. *)
+
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to a sequential stream, the exception
+     wrongDevice is raised; otherwise closes the channel, and assigns the value identifying
+     the invalid channel to cid.
+  *)
+
+END StreamFile.
+
diff --git a/gcc/m2/gm2-libs-iso/StreamFile.mod b/gcc/m2/gm2-libs-iso/StreamFile.mod
new file mode 100644
index 00000000000..63cbc39ccac
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/StreamFile.mod
@@ -0,0 +1,290 @@
+(* StreamFile.mod implement the ISO StreamFile specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE StreamFile ;
+
+FROM RTgen IMPORT ChanDev, DeviceType,
+                  InitChanDev, doLook, doSkip, doSkipLook, doWriteLn,
+                  doReadText, doWriteText, doReadLocs, doWriteLocs,
+                  checkErrno ;
+
+FROM RTfio IMPORT doreadchar, dounreadchar, dogeterrno, dorbytes,
+                  dowbytes, dowriteln, iseof, iseoln, iserror ;
+
+FROM IOLink IMPORT DeviceId, DeviceTablePtr, IsDevice, MakeChan, UnMakeChan,
+                   DeviceTablePtrValue, RAISEdevException, AllocateDeviceId ;
+
+FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
+FROM FIO IMPORT File ;
+FROM errno IMPORT geterrno ;
+FROM IOConsts IMPORT ReadResults ;
+
+IMPORT FIO, SYSTEM, RTio, errno, ErrnoCategory ;
+
+
+VAR
+   dev: ChanDev ;
+   did: DeviceId ;
+
+
+PROCEDURE look (d: DeviceTablePtr;
+                VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doLook(dev, d, ch, r)
+END look ;
+
+
+PROCEDURE skip (d: DeviceTablePtr) ;
+BEGIN
+   doSkip(dev, d)
+END skip ;
+
+
+PROCEDURE skiplook (d: DeviceTablePtr;
+                    VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doSkipLook(dev, d, ch, r)
+END skiplook ;
+
+
+PROCEDURE lnwrite (d: DeviceTablePtr) ;
+BEGIN
+   doWriteLn(dev, d)
+END lnwrite ;
+
+
+PROCEDURE textread (d: DeviceTablePtr;
+                    to: SYSTEM.ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+BEGIN
+   doReadText(dev, d, to, maxChars, charsRead)
+END textread ;
+
+
+PROCEDURE textwrite (d: DeviceTablePtr;
+                     from: SYSTEM.ADDRESS;
+                     charsToWrite: CARDINAL);
+BEGIN
+   doWriteText(dev, d, from, charsToWrite)
+END textwrite ;
+
+
+PROCEDURE rawread (d: DeviceTablePtr;
+                   to: SYSTEM.ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+BEGIN
+   doReadLocs(dev, d, to, maxLocs, locsRead)
+END rawread ;
+
+
+PROCEDURE rawwrite (d: DeviceTablePtr;
+                    from: SYSTEM.ADDRESS;
+                    locsToWrite: CARDINAL) ;
+BEGIN
+   doWriteLocs(dev, d, from, locsToWrite)
+END rawwrite ;
+
+
+PROCEDURE getname (d: DeviceTablePtr;
+                   VAR a: ARRAY OF CHAR) ;
+BEGIN
+   FIO.GetFileName(RTio.GetFile(d^.cid), a)
+END getname ;
+
+
+PROCEDURE flush (d: DeviceTablePtr) ;
+BEGIN
+   FIO.FlushBuffer(RTio.GetFile(d^.cid))
+END flush ;
+
+
+(*
+   checkOpenErrno - assigns, e, and, res, depending upon file result of opening,
+                    file.
+*)
+
+PROCEDURE checkOpenErrno (file: FIO.File; VAR e: INTEGER; VAR res: OpenResults) ;
+BEGIN
+   IF FIO.IsNoError(file)
+   THEN
+      e := 0 ;
+   ELSE
+      e := errno.geterrno()
+   END ;
+   res := ErrnoCategory.GetOpenResults(e)
+END checkOpenErrno ;
+
+
+(*
+   newCid - returns a ChanId which represents the opened file, name.
+            res is set appropriately on return.
+*)
+
+PROCEDURE newCid (fname: ARRAY OF CHAR;
+                  f: FlagSet;
+                  VAR res: OpenResults) : ChanId ;
+VAR
+   c   : RTio.ChanId ;
+   file: FIO.File ;
+   e   : INTEGER ;
+   p   : DeviceTablePtr ;
+BEGIN
+   IF ChanConsts.readFlag IN f
+   THEN
+      file := FIO.OpenToRead(fname)
+   ELSE
+      file := FIO.OpenToWrite(fname)
+   END ;
+   checkOpenErrno(file, e, res) ;
+
+   IF FIO.IsNoError(file)
+   THEN
+      MakeChan(did, c) ;
+      RTio.SetFile(c, file) ;
+      p := DeviceTablePtrValue(c, did) ;
+      WITH p^ DO
+         flags := f ;
+         errNum := e ;
+         doLook := look ;
+         doSkip := skip ;
+         doSkipLook := skiplook ;
+         doLnWrite := lnwrite ;
+         doTextRead := textread ;
+         doTextWrite := textwrite ;
+         doRawRead := rawread ;
+         doRawWrite := rawwrite ;
+         doGetName := getname ;
+         (* doReset := reset ; *)
+         doFlush := flush ;
+         doFree := handlefree
+      END ;
+      RETURN( c )
+   ELSE
+      RETURN( IOChan.InvalidChan() )
+   END
+END newCid ;
+
+
+(*
+   Open - attempts to obtain and open a channel connected to a
+          sequential stream of the given name.
+          The read flag implies old; without the raw flag,
+          text is implied.  If successful, assigns to cid
+          the identity of the opened channel, and assigns the
+          value opened to res.  If a channel cannot be opened
+          as required, the value of res indicates the reason,
+          and cid identifies the invalid channel.
+*)
+
+PROCEDURE Open (VAR cid: ChanId; name: ARRAY OF CHAR;
+                flags: FlagSet; VAR res: OpenResults) ;
+BEGIN
+   IF NOT (ChanConsts.rawFlag IN flags)
+   THEN
+      INCL(flags, ChanConsts.textFlag)
+   END ;
+   cid := newCid(name, flags, res)
+END Open ;
+
+
+(*
+   IsStreamFile - tests if the channel identified by cid is
+                  open to a sequential stream.
+*)
+
+PROCEDURE IsStreamFile (cid: ChanId) : BOOLEAN ;
+BEGIN
+   RETURN( (cid # NIL) AND (IOChan.InvalidChan() # cid) AND
+           (IsDevice(cid, did)) AND
+           ((ChanConsts.readFlag IN IOChan.CurrentFlags(cid)) OR
+            (ChanConsts.writeFlag IN IOChan.CurrentFlags(cid))) )
+END IsStreamFile ;
+
+
+(*
+   handlefree - 
+*)
+
+PROCEDURE handlefree (d: DeviceTablePtr) ;
+VAR
+   f: File ;
+BEGIN
+   WITH d^ DO
+      doFlush(d) ;
+      checkErrno(dev, d) ;
+      f := RTio.GetFile(RTio.ChanId(cid)) ;
+      IF FIO.IsNoError(f)
+      THEN
+         FIO.Close(f) ;
+      END ;
+      checkErrno(dev, d)
+   END
+END handlefree ;
+
+
+(*
+   Close - if the channel identified by cid is not open to a sequential
+           stream, the exception wrongDevice is raised; otherwise
+           closes the channel, and assigns the value identifying
+           the invalid channel to cid.
+*)
+
+PROCEDURE Close (VAR cid: ChanId) ;
+BEGIN
+   IF IsStreamFile(cid)
+   THEN
+      UnMakeChan(did, cid) ;
+      cid := IOChan.InvalidChan()
+   ELSE
+      RAISEdevException(cid, did, IOChan.wrongDevice,
+                        'StreamFile.' + __FUNCTION__ +
+                        ': channel is not a sequential file')
+   END
+END Close ;
+
+
+(*
+   Init - 
+*)
+
+PROCEDURE Init ;
+VAR
+   gen: GenDevIF ;
+BEGIN
+   AllocateDeviceId(did) ;
+   gen := InitGenDevIF(did, doreadchar, dounreadchar,
+                       dogeterrno, dorbytes, dowbytes,
+                       dowriteln,
+                       iseof, iseoln, iserror) ;
+   dev := InitChanDev(streamfile, did, gen)
+END Init ;
+
+
+BEGIN
+   Init
+END StreamFile.
diff --git a/gcc/m2/gm2-libs-iso/StringChan.def b/gcc/m2/gm2-libs-iso/StringChan.def
new file mode 100644
index 00000000000..8314bb30ed2
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/StringChan.def
@@ -0,0 +1,65 @@
+(* StringChan.def provides String input/output over channels.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE StringChan ;
+
+(*
+    Title      : StringChan
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Feb 20 23:29:51 2009
+    Revision   : $Version$ 
+    Description: provides a set of Channel and String
+                 input and output procedures.
+*)
+
+FROM DynamicStrings IMPORT String ;
+IMPORT IOChan;
+
+
+(*
+   writeString - writes a string, s, to ChanId, cid.
+                 The string, s, is not destroyed.
+*)
+
+PROCEDURE writeString (cid: IOChan.ChanId; s: String) ;
+
+
+(*
+   writeFieldWidth - writes a string, s, to ChanId, cid.
+                     The string, s, is not destroyed and it
+                     is prefixed by spaces so that at least,
+                     width, characters are written.  If the
+                     string, s, is longer than width then
+                     no spaces are prefixed to the output
+                     and the entire string is written.
+*)
+
+PROCEDURE writeFieldWidth (cid: IOChan.ChanId;
+                           s: String; width: CARDINAL) ;
+
+
+END StringChan.
diff --git a/gcc/m2/gm2-libs-iso/StringChan.mod b/gcc/m2/gm2-libs-iso/StringChan.mod
new file mode 100644
index 00000000000..7504eb35887
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/StringChan.mod
@@ -0,0 +1,76 @@
+(* StringChan.mod implements String input/output over channels.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE StringChan ;
+
+
+FROM DynamicStrings IMPORT Length, char ;
+FROM TextIO IMPORT WriteChar ;
+
+
+(*
+   writeString - writes a string, s, to ChanId, cid.
+                 The string, s, is not destroyed.
+*)
+
+PROCEDURE writeString (cid: IOChan.ChanId; s: String) ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   h := Length(s) ;
+   i := 0 ;
+   WHILE i<h DO
+      WriteChar(cid, char(s, i)) ;
+      INC(i)
+   END
+END writeString ;
+
+
+(*
+   writeFieldWidth - writes a string, s, to ChanId, cid.
+                     The string, s, is not destroyed and it
+                     is prefixed by spaces so that at least,
+                     width, characters are written.  If the
+                     string, s, is longer than width then
+                     no spaces are prefixed to the output
+                     and the entire string is written.
+*)
+
+PROCEDURE writeFieldWidth (cid: IOChan.ChanId;
+                           s: String; width: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := Length(s) ;
+   WHILE i<width DO
+      WriteChar(cid, ' ') ;
+      INC(i)
+   END ;
+   writeString(cid, s)
+END writeFieldWidth ;
+
+
+END StringChan.
diff --git a/gcc/m2/gm2-libs-iso/Strings.def b/gcc/m2/gm2-libs-iso/Strings.def
new file mode 100644
index 00000000000..580ba015c53
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Strings.def
@@ -0,0 +1,157 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE Strings;
+
+  (* Facilities for manipulating strings *)
+
+TYPE
+  String1 = ARRAY [0..0] OF CHAR;
+    (* String1 is provided for constructing a value of a single-character string type from a
+       single character value in order to pass CHAR values to ARRAY OF CHAR parameters.
+    *)
+
+PROCEDURE Length (stringVal: ARRAY OF CHAR): CARDINAL;
+  (* Returns the length of stringVal (the same value as would be returned by the
+     pervasive function LENGTH).
+  *)
+
+
+(* The following seven procedures construct a string value, and attempt to assign it to a
+   variable parameter.  They all have the property that if the length of the constructed string
+   value exceeds the capacity of the variable parameter, a truncated value is assigned, while
+   if the length of the constructed string value is less than the capacity of the variable
+   parameter, a string terminator is appended before assignment is performed.
+*)
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Copies source to destination *)
+
+PROCEDURE Extract (source: ARRAY OF CHAR; startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  (* Copies at most numberToExtract characters from source to destination, starting at position
+     startIndex in source.
+  *)
+
+PROCEDURE Delete (VAR stringVar: ARRAY OF CHAR; startIndex, numberToDelete:
+CARDINAL);
+  (* Deletes at most numberToDelete characters from stringVar, starting at position
+     startIndex.
+  *)
+
+PROCEDURE Insert (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                  VAR destination: ARRAY OF CHAR);
+  (* Inserts source into destination at position startIndex *)
+
+PROCEDURE Replace (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  (* Copies source into destination, starting at position startIndex. Copying stops when
+     all of source has been copied, or when the last character of the string value in
+     destination has been replaced.
+  *)
+
+PROCEDURE Append (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Appends source to destination. *)
+
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Concatenates source2 onto source1 and copies the result into destination. *)
+
+(* The following predicates provide for pre-testing of the operation-completion
+   conditions for the procedures above.
+*)
+
+PROCEDURE CanAssignAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if a number of characters, indicated by sourceLength, will fit into
+     destination; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanExtractAll (sourceLength, startIndex, numberToExtract: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there are numberToExtract characters starting at startIndex and
+     within the sourceLength of some string, and if the capacity of destination is
+     sufficient to hold numberToExtract characters; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanDeleteAll (stringLength, startIndex, numberToDelete: CARDINAL): BOOLEAN;
+  (* Returns TRUE if there are numberToDelete characters starting at startIndex and
+     within the stringLength of some string; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanInsertAll (sourceLength, startIndex: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is room for the insertion of sourceLength characters from
+     some string into destination starting at startIndex; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanReplaceAll (sourceLength, startIndex: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is room for the replacement of sourceLength characters in
+     destination starting at startIndex; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanAppendAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination to append a string of
+     length sourceLength to the string in destination; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanConcatAll (source1Length, source2Length: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination for a two strings of
+     lengths source1Length and source2Length; otherwise returns FALSE.
+  *)
+
+(* The following type and procedures provide for the comparison of string values, and for the
+   location of substrings within strings.
+*)
+
+TYPE
+  CompareResults = (less, equal, greater);
+
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): CompareResults;
+  (* Returns less, equal, or greater, according as stringVal1 is lexically less than,
+     equal to, or greater than stringVal2.
+  *)
+
+PROCEDURE Equal (stringVal1, stringVal2: ARRAY OF CHAR): BOOLEAN;
+  (* Returns Strings.Compare(stringVal1, stringVal2) = Strings.equal *)
+
+PROCEDURE FindNext (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks forward for next occurrence of pattern in stringToSearch, starting the search at
+     position startIndex. If startIndex < LENGTH(stringToSearch) and pattern is found,
+     patternFound is returned as TRUE, and posOfPattern contains the start position in
+     stringToSearch of pattern. Otherwise patternFound is returned as FALSE, and posOfPattern
+     is unchanged.
+  *)
+
+PROCEDURE FindPrev (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks backward for the previous occurrence of pattern in stringToSearch and returns the
+     position of the first character of the pattern if found. The search for the pattern
+     begins at startIndex. If pattern is found, patternFound is returned as TRUE, and
+     posOfPattern contains the start position in stringToSearch of pattern in the range
+     [0..startIndex]. Otherwise patternFound is returned as FALSE, and posOfPattern is unchanged.
+  *)
+
+PROCEDURE FindDiff (stringVal1, stringVal2: ARRAY OF CHAR;
+                    VAR differenceFound: BOOLEAN; VAR posOfDifference: CARDINAL);
+  (* Compares the string values in stringVal1 and stringVal2 for differences. If they
+     are equal, differenceFound is returned as FALSE, and TRUE otherwise. If
+     differenceFound is TRUE, posOfDifference is set to the position of the first
+     difference; otherwise posOfDifference is unchanged.
+  *)
+
+PROCEDURE Capitalize (VAR stringVar: ARRAY OF CHAR);
+  (* Applies the function CAP to each character of the string value in stringVar. *)
+
+
+END Strings.
+
diff --git a/gcc/m2/gm2-libs-iso/Strings.mod b/gcc/m2/gm2-libs-iso/Strings.mod
new file mode 100644
index 00000000000..c6e304dd19c
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/Strings.mod
@@ -0,0 +1,524 @@
+(* Strings.mod implement the ISO Strings specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Strings ;
+
+IMPORT ASCII ;
+FROM libc IMPORT printf ;
+
+CONST
+   Debugging = FALSE ;
+
+
+(*
+   Length - Returns the length of stringVal (the same value as would be returned by the
+            pervasive function LENGTH).
+*)
+
+PROCEDURE Length (stringVal: ARRAY OF CHAR) : CARDINAL;
+BEGIN
+   RETURN( LENGTH(stringVal) )
+END Length ;
+
+
+(* The following seven procedures construct a string value, and
+   attempt to assign it to a variable parameter.  They all have
+   the property that if the length of the constructed string
+   value exceeds the capacity of the variable parameter, a
+   truncated value is assigned, while if the length of the
+   constructed string value is less than the capacity of the
+   variable parameter, a string terminator is appended before
+   assignment is performed.
+*)
+
+(*
+   Assign - Copies source to destination.
+*)
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR) ;
+VAR
+   i,
+   sh, dh: CARDINAL ;
+BEGIN
+   sh := Length(source) ;
+   dh := HIGH(destination) ;
+   i := 0 ;
+   WHILE (i<sh) AND (i<=dh) DO
+      destination[i] := source[i] ;
+      INC(i)
+   END ;
+   IF i<=dh
+   THEN
+      destination[i] := ASCII.nul
+   END
+END Assign ;
+
+
+(* Copies at most numberToExtract characters from source to destination,
+   starting at position startIndex in source.
+*)
+
+PROCEDURE Extract (source: ARRAY OF CHAR;
+                   startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR) ;
+VAR
+   sh, dh,
+   i     : CARDINAL ;
+BEGIN
+   sh := Length(source) ;
+   dh := HIGH(destination) ;
+   i := 0 ;
+   WHILE (i<numberToExtract) AND (startIndex<sh) AND (i<=dh) DO
+      destination[i] := source[startIndex] ;
+      INC(i) ;
+      INC(startIndex)
+   END ;
+   IF i<=dh
+   THEN
+      destination[i] := ASCII.nul
+   END
+END Extract ;
+
+
+(* Deletes at most numberToDelete characters from stringVar, starting at position
+   startIndex.
+*)
+
+PROCEDURE Delete (VAR stringVar: ARRAY OF CHAR;
+                  startIndex, numberToDelete: CARDINAL) ;
+VAR
+   h: CARDINAL ;
+BEGIN
+   IF numberToDelete>0
+   THEN
+      (* numberToDelete can be consider as the number of characters to skip over *)
+      h := Length(stringVar) ;
+      WHILE (startIndex+numberToDelete<h) DO
+         stringVar[startIndex] := stringVar[startIndex+numberToDelete] ;
+         INC(startIndex)
+      END ;
+      IF startIndex<HIGH(stringVar)
+      THEN
+         stringVar[startIndex] := ASCII.nul
+      END
+   END
+END Delete ;
+
+
+(* Inserts source into destination at position startIndex *)
+
+PROCEDURE Insert (source: ARRAY OF CHAR;
+                  startIndex: CARDINAL;
+                  VAR destination: ARRAY OF CHAR) ;
+VAR
+   newEnd, endCopy,
+   i, j, sh, dh, dl: CARDINAL ;
+BEGIN
+   sh := Length(source) ;
+   dh := HIGH(destination) ;
+   dl := Length(destination) ;
+   (* make space for source *)
+   IF Debugging
+   THEN
+      printf("sh = %d   dh = %d   dl = %d\n",
+             sh, dh, dl);
+   END ;
+   newEnd := dl+sh ;
+   IF newEnd>dh
+   THEN
+      (* insert will truncate destination *)
+      newEnd := dh
+   END ;
+   IF newEnd>sh
+   THEN
+      endCopy := newEnd-sh
+   ELSE
+      endCopy := 0
+   END ;
+   IF Debugging
+   THEN
+      printf("\ndestination contains\n%s\nnewEnd = %d   endCopy = %d\n", destination, newEnd, endCopy) ;
+      printf("newEnd = %d\n", newEnd) ;
+      printf("endCopy = %d\n", endCopy) ;
+   END ;
+   INC(newEnd) ;
+   INC(endCopy) ;
+   WHILE endCopy>startIndex DO
+      DEC(newEnd) ;
+      DEC(endCopy) ;
+      IF Debugging
+      THEN
+         printf("copying dest %d to %d (%c) (startIndex=%d)\n",
+                endCopy, newEnd, destination[newEnd], startIndex)
+      END ;
+      destination[newEnd] := destination[endCopy]
+   END ;
+   IF Debugging
+   THEN
+      printf("destination now contains %s\n", destination)
+   END ;
+   (* copy source into destination *)
+   j := startIndex ;
+   i := 0 ;
+   WHILE (i<sh) AND (j<=dh) DO
+      destination[j] := source[i] ;
+      INC(i) ;
+      INC(j)
+   END
+END Insert ;
+
+
+(* Copies source into destination, starting at position startIndex. Copying stops when
+   all of source has been copied, or when the last character of the string value in
+   destination has been replaced.  *)
+
+PROCEDURE Replace (source: ARRAY OF CHAR;
+                   startIndex: CARDINAL;
+                   VAR destination: ARRAY OF CHAR) ;
+VAR
+   i, sh, dh: CARDINAL ;
+BEGIN
+   i := 0 ;
+   sh := Length(source) ;
+   dh := Length(destination) ;
+   WHILE (i<sh) AND (startIndex<dh) DO
+      destination[startIndex] := source[i] ;
+      INC(i) ;
+      INC(startIndex)
+   END ;
+   IF startIndex<HIGH(destination)
+   THEN
+      destination[startIndex] := ASCII.nul
+   END
+END Replace ;
+
+
+PROCEDURE Append (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR) ;
+  (* Appends source to destination. *)
+VAR
+   i, j, sh, dh: CARDINAL ;
+BEGIN
+   j := Length(destination) ;
+   dh := HIGH(destination) ;
+   sh := Length(source) ;
+   i := 0 ;
+   WHILE (i<sh) AND (j<=dh) DO
+      destination[j] := source[i] ;
+      INC(i) ;
+      INC(j)
+   END ;
+   IF j<=dh
+   THEN
+      destination[j] := ASCII.nul
+   END
+END Append ;
+
+
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Concatenates source2 onto source1 and copies the result into destination. *)
+BEGIN
+   Assign(source1, destination) ;
+   Append(source2, destination)
+END Concat ;
+
+
+(* The following predicates provide for pre-testing of the operation-completion
+   conditions for the procedures above.
+*)
+
+PROCEDURE CanAssignAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR) : BOOLEAN;
+  (* Returns TRUE if a number of characters, indicated by sourceLength, will fit into
+     destination; otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN( sourceLength<=HIGH(destination) )
+END CanAssignAll ;
+
+
+PROCEDURE CanExtractAll (sourceLength,
+                         startIndex,
+                         numberToExtract: CARDINAL;
+                         VAR destination: ARRAY OF CHAR) : BOOLEAN ;
+  (* Returns TRUE if there are numberToExtract characters starting at startIndex and
+     within the sourceLength of some string, and if the capacity of destination is
+     sufficient to hold numberToExtract characters; otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN( (numberToExtract+startIndex<=sourceLength) AND
+           (HIGH(destination)>=numberToExtract) )
+END CanExtractAll ;
+
+PROCEDURE CanDeleteAll (stringLength, startIndex, numberToDelete: CARDINAL) : BOOLEAN ;
+  (* Returns TRUE if there are numberToDelete characters starting at startIndex and
+     within the stringLength of some string; otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN( startIndex+numberToDelete<=stringLength )
+END CanDeleteAll ;
+
+PROCEDURE CanInsertAll (sourceLength, startIndex: CARDINAL;
+                        VAR destination: ARRAY OF CHAR) : BOOLEAN ;
+  (* Returns TRUE if there is room for the insertion of sourceLength characters
+     from some string into destination starting at startIndex; otherwise returns
+     FALSE.
+  *)
+BEGIN
+   RETURN( (HIGH(destination)-Length(destination)<sourceLength) AND
+           (HIGH(destination)-startIndex<sourceLength) )
+END CanInsertAll ;
+
+PROCEDURE CanReplaceAll (sourceLength, startIndex: CARDINAL;
+                         VAR destination: ARRAY OF CHAR) : BOOLEAN;
+  (* Returns TRUE if there is room for the replacement of sourceLength
+     characters in destination starting at startIndex; otherwise returns
+     FALSE.
+  *)
+BEGIN
+   RETURN( sourceLength<=Length(destination)-startIndex )
+END CanReplaceAll ;
+
+PROCEDURE CanAppendAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR) : BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination to append a string of
+     length sourceLength to the string in destination; otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN( HIGH(destination)-Length(destination)>=sourceLength )
+END CanAppendAll ;
+
+PROCEDURE CanConcatAll (source1Length, source2Length: CARDINAL;
+                        VAR destination: ARRAY OF CHAR) : BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination for a two strings of
+     lengths source1Length and source2Length; otherwise returns FALSE.
+  *)
+BEGIN
+   RETURN( HIGH(destination)-Length(destination)>=source1Length+source2Length )
+END CanConcatAll ;
+
+
+(* The following type and procedures provide for the comparison of string values, and for the
+   location of substrings within strings.
+*)
+
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR) : CompareResults ;
+  (* Returns less, equal, or greater, according as stringVal1 is lexically less than,
+     equal to, or greater than stringVal2.
+  *)
+VAR
+   i, l1, l2: CARDINAL ;
+BEGIN
+   l1 := Length(stringVal1) ;
+   l2 := Length(stringVal2) ;
+   i := 0 ;
+   WHILE (i<l1) AND (i<l2) DO
+      IF stringVal1[i]<stringVal2[i]
+      THEN
+         RETURN less
+      ELSIF stringVal1[i]>stringVal2[i]
+      THEN
+         RETURN greater
+      ELSE
+         INC(i)
+      END
+   END ;
+   IF l1<l2
+   THEN
+      RETURN less
+   ELSIF l1>l2
+   THEN
+      RETURN greater
+   ELSE
+      RETURN equal
+   END
+END Compare ;
+
+PROCEDURE Equal (stringVal1, stringVal2: ARRAY OF CHAR) : BOOLEAN ;
+  (* Returns Strings.Compare(stringVal1, stringVal2) = Strings.equal *)
+VAR
+   h1, h2, i: CARDINAL ;
+   c1, c2   : CHAR ;
+BEGIN
+   i := 0 ;
+   h1 := HIGH(stringVal1) ;
+   h2 := HIGH(stringVal2) ;
+   IF h1=h2
+   THEN
+      REPEAT
+         c1 := stringVal1[i] ;
+         c2 := stringVal2[i] ;
+         IF c1#c2
+         THEN
+            RETURN FALSE
+         END ;
+         IF c1=ASCII.nul
+         THEN
+            RETURN TRUE
+         END ;
+         INC(i) ;
+      UNTIL i>h1 ;
+      RETURN TRUE
+   ELSE
+      c1 := stringVal1[0] ;
+      c2 := stringVal2[0] ;
+      WHILE c1=c2 DO
+         IF c1=ASCII.nul
+         THEN
+            RETURN TRUE
+         END ;
+         INC(i) ;
+         IF i<=h1
+         THEN
+            c1 := stringVal1[i] ;
+            IF i<=h2
+            THEN
+               c2 := stringVal2[i]
+            ELSE
+               RETURN c1=ASCII.nul
+            END
+         ELSIF i<=h2
+         THEN
+            c2 := stringVal2[i] ;
+            RETURN c2=ASCII.nul
+         END
+      END ;
+      RETURN FALSE
+   END
+END Equal ;
+
+PROCEDURE FindNext (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL) ;
+  (* Looks forward for next occurrence of pattern in stringToSearch, starting the search at
+     position startIndex. If startIndex < LENGTH(stringToSearch) and pattern is found,
+     patternFound is returned as TRUE, and posOfPattern contains the start position in
+     stringToSearch of pattern. Otherwise patternFound is returned as FALSE, and posOfPattern
+     is unchanged.
+  *)
+VAR
+   i, j, hp, hs: CARDINAL ;
+BEGIN
+   i := startIndex ;
+   hp := Length(pattern) ;
+   hs := Length(stringToSearch) ;
+   IF hp<=hs
+   THEN
+      WHILE (i<=hs-hp) DO
+         j := 0 ;
+         WHILE (j<hp) AND (pattern[j]=stringToSearch[i+j]) DO
+            INC(j) ;
+            IF j=hp
+            THEN
+               posOfPattern := i ;
+               patternFound := TRUE ;
+               RETURN
+            END
+         END ;
+         INC(i)
+      END
+   END ;
+   patternFound := FALSE
+END FindNext ;
+
+PROCEDURE FindPrev (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks backward for the previous occurrence of pattern in stringToSearch and returns the
+     position of the first character of the pattern if found. The search for the pattern
+     begins at startIndex. If pattern is found, patternFound is returned as TRUE, and
+     posOfPattern contains the start position in stringToSearch of pattern in the range
+     [0..startIndex]. Otherwise patternFound is returned as FALSE, and
+     posOfPattern is unchanged.
+  *)
+VAR
+   i, j, hp, hs: CARDINAL ;
+BEGIN
+   hp := Length(pattern) ;
+   hs := Length(stringToSearch) ;
+   IF hp<=hs
+   THEN
+      i := hs-hp+1 ;
+      WHILE i>0 DO
+         DEC(i) ;
+         j := 0 ;
+         WHILE (j<hp) AND (pattern[j]=stringToSearch[i+j]) DO
+            INC(j) ;
+            IF j=hp
+            THEN
+               posOfPattern := i ;
+               patternFound := TRUE ;
+               RETURN
+            END
+         END
+      END
+   END ;
+   patternFound := FALSE
+END FindPrev ;
+
+PROCEDURE FindDiff (stringVal1, stringVal2: ARRAY OF CHAR;
+                    VAR differenceFound: BOOLEAN; VAR posOfDifference: CARDINAL) ;
+  (* Compares the string values in stringVal1 and stringVal2 for differences. If they
+     are equal, differenceFound is returned as FALSE, and TRUE otherwise. If
+     differenceFound is TRUE, posOfDifference is set to the position of the first
+     difference; otherwise posOfDifference is unchanged.
+  *)
+VAR
+   i,
+   s1h, s2h: CARDINAL ;
+BEGIN
+   s1h := Length(stringVal1) ;
+   s2h := Length(stringVal2) ;
+   i := 0 ;
+   WHILE (i<s1h) AND (i<s2h) DO
+      IF stringVal1[i]=stringVal2[i]
+      THEN
+         INC(i)
+      ELSE
+         differenceFound := TRUE ;
+         posOfDifference := i ;
+         RETURN
+      END
+   END ;
+   IF s1h=s2h
+   THEN
+      differenceFound := FALSE ;
+   ELSE
+      differenceFound := TRUE ;
+      posOfDifference := i
+   END
+END FindDiff ;
+
+PROCEDURE Capitalize (VAR stringVar: ARRAY OF CHAR) ;
+  (* Applies the function CAP to each character of the string value in stringVar. *)
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   i := 0 ;
+   h := Length(stringVar) ;
+   WHILE i<h DO
+      stringVar[i] := CAP(stringVar[i]) ;
+      INC(i)
+   END
+END Capitalize ;
+
+
+END Strings.
diff --git a/gcc/m2/gm2-libs-iso/SysClock.def b/gcc/m2/gm2-libs-iso/SysClock.def
new file mode 100644
index 00000000000..3e22f36e006
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SysClock.def
@@ -0,0 +1,61 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE SysClock;
+
+(* Facilities for accessing a system clock that records the date
+   and time of day *)
+
+CONST
+  maxSecondParts = 1000000 ;
+
+TYPE
+  Month    = [1 .. 12];
+  Day      = [1 .. 31];
+  Hour     = [0 .. 23];
+  Min      = [0 .. 59];
+  Sec      = [0 .. 59];
+  Fraction = [0 .. maxSecondParts];
+  UTCDiff  = [-780 .. 720];
+  DateTime =
+    RECORD
+      year:      CARDINAL;
+      month:     Month;
+      day:       Day;
+      hour:      Hour;
+      minute:    Min;
+      second:    Sec;
+      fractions: Fraction;      (* parts of a second *)
+      zone:      UTCDiff;       (* Time zone differential
+                                   factor which is the number
+                                   of minutes to add to local
+                                   time to obtain UTC. *)
+      summerTimeFlag: BOOLEAN;  (* Interpretation of flag
+                                   depends on local usage. *)
+    END;
+
+PROCEDURE CanGetClock(): BOOLEAN;
+(* Tests if the clock can be read *)
+
+PROCEDURE CanSetClock(): BOOLEAN;
+(* Tests if the clock can be set *)
+
+PROCEDURE IsValidDateTime(userData: DateTime): BOOLEAN;
+(* Tests if the value of userData is a valid *)
+
+PROCEDURE GetClock(VAR userData: DateTime);
+(* Assigns local date and time of the day to userData *)
+
+PROCEDURE SetClock(userData: DateTime);
+(* Sets the system time clock to the given local date and
+   time *)
+
+END SysClock.
diff --git a/gcc/m2/gm2-libs-iso/SysClock.mod b/gcc/m2/gm2-libs-iso/SysClock.mod
new file mode 100644
index 00000000000..10fb9f2c54e
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/SysClock.mod
@@ -0,0 +1,277 @@
+(* SysClock.mod implement the ISO SysClock specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SysClock ;
+
+FROM wraptime IMPORT timeval, timezone, tm,
+                     InitTimezone, InitTimeval,
+                     InitTM, KillTM,
+                     gettimeofday, settimeofday, GetFractions,
+                     localtime_r, GetSummerTime, GetDST,
+                     KillTimezone, KillTimeval, GetYear,
+                     GetMonth, GetDay, GetHour, GetMinute,
+                     GetSecond, SetTimeval, SetTimezone ;
+
+IMPORT Args ;
+
+VAR
+   canget,
+   canset,
+   known : BOOLEAN ;
+
+
+(*
+   determineAccess - test to see whether we can get and set
+                     the time.
+*)
+
+PROCEDURE determineAccess ;
+VAR
+   tv: timeval ;
+   tz: timezone ;
+BEGIN
+   tz := InitTimezone () ;
+   tv := InitTimeval () ;
+   canget := gettimeofday (tv, tz) = 0 ;
+   canset := canget AND (settimeofday (tv, tz) = 0) ;
+   tz := KillTimezone (tz) ;
+   tv := KillTimeval (tv)
+END determineAccess ;
+
+
+PROCEDURE CanGetClock () : BOOLEAN ;
+(* Tests if the clock can be read *)
+BEGIN
+   IF NOT known
+   THEN
+      determineAccess
+   END ;
+   RETURN canget
+END CanGetClock ;
+
+
+PROCEDURE CanSetClock () : BOOLEAN ;
+(* Tests if the clock can be set *)
+BEGIN
+   IF NOT known
+   THEN
+      determineAccess
+   END ;
+   RETURN canset
+END CanSetClock ;
+
+
+PROCEDURE IsValidDateTime (userData: DateTime) : BOOLEAN ;
+(* Tests if the value of userData is a valid *)
+BEGIN
+   WITH userData DO
+      CASE month OF
+
+      1:  |
+      2:  IF ((year MOD 4=0) AND (year MOD 100#0)) OR (year MOD 400=0)
+          THEN
+             RETURN day<=29
+          ELSE
+             RETURN day<=28
+          END |
+      3:  |
+      4:  RETURN day<=30 |
+      5:  |
+      6:  RETURN day<=30 |
+      7:  |
+      8:  |
+      9:  RETURN day<=30 |
+      10: |
+      11: RETURN day<=30 |
+      12:
+
+      END
+   END ;
+   RETURN( TRUE )
+END IsValidDateTime ;
+
+
+(*
+   foo -
+*)
+
+PROCEDURE foo () : CARDINAL ;
+BEGIN
+   RETURN 1
+END foo ;
+
+
+PROCEDURE GetClock (VAR userData: DateTime) ;
+(* Assigns local date and time of the day to userData *)
+VAR
+   m : tm ;
+   tv: timeval ;
+   tz: timezone ;
+BEGIN
+   IF CanGetClock ()
+   THEN
+      tv := InitTimeval () ;
+      tz := InitTimezone () ;
+      IF gettimeofday (tv, tz)=0
+      THEN
+         m := InitTM () ;
+         (* m := localtime_r (tv, m) ; *)
+         WITH userData DO
+         (*
+            year := GetYear (m) ;
+         *)
+            month := Args.Narg () (* GetMonth (m) *) (* + 1 *) ;
+            (*
+            day := GetDay (m) ;
+            hour := GetHour (m) ;
+            minute := GetMinute (m) ;
+            second := GetSecond (m) ;
+            fractions := GetFractions (tv) ;
+            zone := GetDST (tz) ;
+            summerTimeFlag := GetSummerTime (tz)
+            *)
+         END ;
+         m := KillTM (m)
+      ELSE
+         HALT
+      END ;
+      tv := KillTimeval (tv) ;
+      tz := KillTimezone (tz)
+   END
+END GetClock ;
+
+
+(*
+   daysInMonth - returns how many days there are in a month.
+*)
+
+PROCEDURE daysInMonth (year, month: CARDINAL) : CARDINAL ;
+BEGIN
+   CASE month OF
+
+   1:  |
+   2:  IF ((year MOD 4=0) AND (year MOD 100#0)) OR (year MOD 400=0)
+       THEN
+          RETURN 29
+       ELSE
+          RETURN 28
+       END |
+   3:  |
+   4:  RETURN 30 |
+   5:  |
+   6:  RETURN 30 |
+   7:  |
+   8:  |
+   9:  RETURN 30 |
+   10: |
+   11: RETURN 30 |
+   12: |
+
+   END ;
+   RETURN 31
+END daysInMonth ;
+
+
+(*
+   dayInYear -
+*)
+
+PROCEDURE dayInYear (day, month, year: CARDINAL) : CARDINAL ;
+BEGIN
+   WHILE month > 1 DO
+      INC (day, daysInMonth (year, month)) ;
+      DEC (month)
+   END ;
+   RETURN day
+END dayInYear ;
+
+
+(*
+   dayInWeek -
+*)
+
+PROCEDURE dayInWeek (day, month, year: CARDINAL) : CARDINAL ;
+CONST
+   janFirst1970 = 5 ;   (* thursday *)
+VAR
+   yearOffset: CARDINAL ;  (* days since Jan 1st 1970 *)
+BEGIN
+   yearOffset := janFirst1970 ;
+   WHILE year > 1970 DO
+      DEC (year) ;
+      INC (yearOffset, dayInYear (31, 12, year))
+   END ;
+   INC (yearOffset, dayInYear (day, month, year)) ;
+   RETURN yearOffset MOD 7
+END dayInWeek ;
+
+
+PROCEDURE SetClock (userData: DateTime);
+(* Sets the system time clock to the given local date and
+   time *)
+VAR
+   tv: timeval ;
+   tz: timezone ;
+BEGIN
+   IF CanSetClock ()
+   THEN
+      tv := InitTimeval () ;
+      tz := InitTimezone () ;
+      IF gettimeofday (tv, tz) = 0
+      THEN
+         (* fill in as many of tv, tz fields from userData as we can *)
+         WITH userData DO
+            IF summerTimeFlag
+            THEN
+               SetTimeval (tv, second, minute, hour, day, month, year,
+                           dayInYear(day, month, year),
+                           dayInWeek(day, month, year),
+                           1) ;
+               SetTimezone (tz, 1, zone)
+            ELSE
+               SetTimeval (tv, second, minute, hour, day, month, year,
+                           dayInYear(day, month, year),
+                           dayInWeek(day, month, year),
+                           0) ;
+               SetTimezone (tz, 0, zone)
+            END ;
+            IF settimeofday (tv, tz)#0
+            THEN
+               (* error, which we ignore *)
+            END
+         END
+      END ;
+      tv := KillTimeval (tv) ;
+      tz := KillTimezone (tz)
+   END
+END SetClock ;
+
+
+BEGIN
+   known := FALSE ;
+   canset := FALSE ;
+   canget := FALSE
+END SysClock.
diff --git a/gcc/m2/gm2-libs-iso/TERMINATION.def b/gcc/m2/gm2-libs-iso/TERMINATION.def
new file mode 100644
index 00000000000..935d86db11d
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/TERMINATION.def
@@ -0,0 +1,22 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE TERMINATION;
+
+(* Provides facilities for enquiries concerning the occurrence of termination events. *)
+
+PROCEDURE IsTerminating (): BOOLEAN ;
+  (* Returns true if any coroutine has started  program termination and false otherwise. *)
+
+PROCEDURE HasHalted (): BOOLEAN ;
+  (* Returns true if a call to HALT has been made and false otherwise. *)
+
+END TERMINATION.
diff --git a/gcc/m2/gm2-libs-iso/TERMINATION.mod b/gcc/m2/gm2-libs-iso/TERMINATION.mod
new file mode 100644
index 00000000000..5674d73dcc8
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/TERMINATION.mod
@@ -0,0 +1,53 @@
+(* TERMINATION.mod implement the ISO TERMINATION specification.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE TERMINATION ;
+
+IMPORT M2RTS ;
+
+(* Provides facilities for enquiries concerning the occurrence of termination events. *)
+
+VAR
+   terminating: BOOLEAN ;
+
+
+(* Returns true if any coroutine has started  program termination and false otherwise. *)
+
+PROCEDURE IsTerminating (): BOOLEAN ;
+BEGIN
+   RETURN M2RTS.IsTerminating()
+END IsTerminating ;
+
+
+(* Returns true if a call to HALT has been made and false otherwise. *)
+
+PROCEDURE HasHalted (): BOOLEAN ;
+BEGIN
+   RETURN M2RTS.HasHalted()
+END HasHalted ;
+
+
+END TERMINATION.
diff --git a/gcc/m2/gm2-libs-iso/TermFile.def b/gcc/m2/gm2-libs-iso/TermFile.def
new file mode 100644
index 00000000000..3d331f43cfd
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/TermFile.def
@@ -0,0 +1,68 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE TermFile;
+
+  (* Access to the terminal device *)
+
+  (* Channels opened by this module are connected to a single
+     terminal device; typed characters are distributed between
+     channels according to the sequence of read requests.
+  *)
+
+IMPORT IOChan, ChanConsts;
+
+TYPE
+  ChanId = IOChan.ChanId;
+  FlagSet = ChanConsts.FlagSet;
+  OpenResults = ChanConsts.OpenResults;
+
+  (* Accepted singleton values of FlagSet *)
+
+CONST
+  read = FlagSet{ChanConsts.readFlag};
+  (* input operations are requested/available *)
+  write = FlagSet{ChanConsts.writeFlag};
+  (* output operations are requested/available *)
+  text = FlagSet{ChanConsts.textFlag};
+  (* text operations are requested/available *)
+  raw = FlagSet{ChanConsts.rawFlag};
+  (* raw operations are requested/available *)
+  echo = FlagSet{ChanConsts.echoFlag};
+  (* echoing by interactive device on reading of
+     characters from input stream requested/applies
+  *)
+
+PROCEDURE Open (VAR cid: ChanId; flagset: FlagSet; VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to
+     the terminal.  Without the raw flag, text is implied.
+     Without the echo flag, line mode is requested,
+     otherwise single character mode is requested.
+     If successful, assigns to cid the identity of
+     the opened channel, and assigns the value opened to res.
+     If a channel cannot be opened as required, the value of
+     res indicates the reason, and cid identifies the
+     invalid channel.
+  *)
+
+PROCEDURE IsTermFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to
+     the terminal. *)
+
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to the terminal,
+     the exception wrongDevice is raised; otherwise closes the
+     channel and assigns the value identifying the invalid channel
+     to cid.
+  *)
+
+END TermFile.
+
diff --git a/gcc/m2/gm2-libs-iso/TermFile.mod b/gcc/m2/gm2-libs-iso/TermFile.mod
new file mode 100644
index 00000000000..5bf555955a5
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/TermFile.mod
@@ -0,0 +1,639 @@
+(* TermFile.mod implement the ISO TermFile specification.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE TermFile ;
+
+
+FROM ASCII IMPORT nul, lf, cr ;
+FROM ChanConsts IMPORT ChanFlags ;
+FROM RTio IMPORT GetDeviceId ;
+FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
+FROM RTdata IMPORT ModuleId, MakeModuleId, InitData, GetData, KillData ;
+FROM IOChan IMPORT ChanExceptions, InvalidChan, CurrentFlags ;
+FROM IOConsts IMPORT ReadResults ;
+FROM Strings IMPORT Assign ;
+
+FROM IOLink IMPORT DeviceId, DeviceTable, DeviceTablePtr, DeviceTablePtrValue, IsDevice,
+                   AllocateDeviceId, RAISEdevException, MakeChan, UnMakeChan ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Strings IMPORT Append ;
+
+
+FROM SYSTEM IMPORT ADDRESS, ADR, LOC ;
+FROM errno IMPORT geterrno ;
+FROM ErrnoCategory IMPORT GetOpenResults ;
+
+FROM RTgen IMPORT ChanDev, DeviceType, InitChanDev,
+                  doLook, doSkip, doSkipLook, doWriteLn,
+                  doReadText, doWriteText, doReadLocs, doWriteLocs,
+                  checkErrno ;
+
+FROM DynamicStrings IMPORT String, InitStringCharStar, CopyOut,
+                           KillString ;
+
+FROM termios IMPORT TERMIOS, InitTermios, KillTermios, tcgetattr,
+                    tcsetattr, cfmakeraw, tcsnow ;
+
+
+IMPORT libc ;
+
+
+CONST
+   O_RDONLY = 0 ;
+   O_WRONLY = 1 ;
+
+TYPE
+   PtrToLoc   = POINTER TO LOC ;
+   TermInfo   = POINTER TO RECORD
+                              fd      : INTEGER ;
+                              pushed  : CHAR ;
+                              pushBack: BOOLEAN ;
+                              old, new: TERMIOS ;
+                           END ;
+
+VAR
+   mid: ModuleId ;
+   did: DeviceId ;
+   dev: ChanDev ;
+
+
+(*
+   InitTermInfo - creates a new TermInfo and initializes fields,
+                  fd, and, pushed.
+*)
+
+PROCEDURE InitTermInfo (fd: INTEGER) : TermInfo ;
+VAR
+   t: TermInfo ;
+BEGIN
+   NEW(t) ;
+   t^.fd := fd ;
+   t^.pushBack := FALSE ;
+   t^.new := InitTermios() ;
+   t^.old := InitTermios() ;
+   RETURN( t )
+END InitTermInfo ;
+
+
+(*
+   KillTermInfo - deallocates memory associated with, t.
+*)
+
+PROCEDURE KillTermInfo (t: TermInfo) : TermInfo ;
+BEGIN
+   WITH t^ DO
+      new := KillTermios(new) ;
+      old := KillTermios(old)
+   END ;
+   DISPOSE(t) ;
+   RETURN( NIL )
+END KillTermInfo ;
+
+
+(*
+   getFd - return the file descriptor associated with, t.
+*)
+
+PROCEDURE getFd (t: TermInfo) : INTEGER ;
+BEGIN
+   RETURN( t^.fd )
+END getFd ;
+
+
+(*
+   getPushBackChar - returns TRUE if a previously pushed back
+                     character is available.  If TRUE then,
+                     ch, will be assigned to the pushed back
+                     character.
+*)
+
+PROCEDURE getPushBackChar (t: TermInfo; VAR ch: CHAR) : BOOLEAN ;
+BEGIN
+   WITH t^ DO
+      IF pushBack
+      THEN
+         ch := pushed ;
+         pushBack := FALSE ;
+         RETURN( TRUE )
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END getPushBackChar ;
+
+
+(*
+   setPushBackChar - attempts to push back, ch.  Only one character
+                     may be pushed back consecutively.
+*)
+
+PROCEDURE setPushBackChar (t: TermInfo; ch: CHAR) : BOOLEAN ;
+BEGIN
+   WITH t^ DO
+      IF pushBack
+      THEN
+         RETURN( FALSE )
+      ELSE
+         pushed := ch ;
+         pushBack := TRUE ;
+         RETURN( TRUE )
+      END
+   END
+END setPushBackChar ;
+
+
+PROCEDURE look (d: DeviceTablePtr;
+                VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doLook(dev, d, ch, r)
+END look ;
+
+
+PROCEDURE skip (d: DeviceTablePtr) ;
+BEGIN
+   doSkip(dev, d)
+END skip ;
+
+
+PROCEDURE skiplook (d: DeviceTablePtr;
+                    VAR ch: CHAR; VAR r: ReadResults) ;
+BEGIN
+   doSkipLook(dev, d, ch, r)
+END skiplook ;
+
+
+PROCEDURE lnwrite (d: DeviceTablePtr) ;
+BEGIN
+   doWriteLn(dev, d)
+END lnwrite ;
+
+
+PROCEDURE textread (d: DeviceTablePtr;
+                    to: ADDRESS;
+                    maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL) ;
+BEGIN
+   doReadText(dev, d, to, maxChars, charsRead)
+END textread ;
+
+
+PROCEDURE textwrite (d: DeviceTablePtr;
+                     from: ADDRESS;
+                     charsToWrite: CARDINAL);
+BEGIN
+   doWriteText(dev, d, from, charsToWrite)
+END textwrite ;
+
+
+PROCEDURE rawread (d: DeviceTablePtr;
+                   to: ADDRESS;
+                   maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL) ;
+BEGIN
+   doReadLocs(dev, d, to, maxLocs, locsRead)
+END rawread ;
+
+
+PROCEDURE rawwrite (d: DeviceTablePtr;
+                    from: ADDRESS;
+                    locsToWrite: CARDINAL) ;
+BEGIN
+   doWriteLocs(dev, d, from, locsToWrite)
+END rawwrite ;
+
+
+(*
+   doreadchar - returns a CHAR from the file associated with, g.
+*)
+
+PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+VAR
+   i : INTEGER ;
+   fd: INTEGER ;
+   t : TermInfo ;
+   ch: CHAR ;
+BEGIN
+   t := GetData(d, mid) ;
+   WITH d^ DO
+      fd := getFd(t) ;
+      IF NOT getPushBackChar(t, ch)
+      THEN
+         REPEAT
+            i := libc.read(fd, ADR(ch), SIZE(ch))
+         UNTIL i#0 ;
+         IF i<0
+         THEN
+            errNum := geterrno()
+         END
+      END ;
+      RETURN( ch )
+   END
+END doreadchar ;
+
+
+(*
+   dounreadchar - pushes a CHAR back onto the file associated with, g.
+*)
+
+PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+VAR
+   fd: INTEGER ;
+   t : TermInfo ;
+BEGIN
+   t := GetData(d, mid) ;
+   WITH d^ DO
+      fd := getFd(t) ;
+      IF NOT setPushBackChar(t, ch)
+      THEN
+         RAISEdevException(cid, did, notAvailable,
+                           'TermFile.dounreadchar: cannot push back more than one character consecutively')
+      END ;
+      RETURN( ch )
+   END
+END dounreadchar ;
+
+
+(*
+   dogeterrno - returns the errno relating to the generic device.
+*)
+
+PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+BEGIN
+   RETURN geterrno()
+END dogeterrno ;
+
+
+(*
+   dorbytes - reads upto, max, bytes setting, actual, and
+              returning FALSE if an error (not due to eof)
+              occurred.
+*)
+
+PROCEDURE dorbytes (g: GenDevIF; d: DeviceTablePtr;
+                    to: ADDRESS;
+                    max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   fd: INTEGER ;
+   t : TermInfo ;
+   p : PtrToLoc ;
+   i : INTEGER ;
+BEGIN
+   t := GetData(d, mid) ;
+   WITH d^ DO
+      IF max>0
+      THEN
+         p := to ;
+         IF getPushBackChar(t, p^)
+         THEN
+            actual := 1 ;
+            RETURN( TRUE )
+         END ;
+         fd := getFd(t) ;
+         i := libc.read(fd, p, max) ;
+         IF i>=0
+         THEN
+            actual := i ;
+            RETURN( TRUE )
+         ELSE
+            errNum := geterrno() ;
+            actual := 0 ;
+            RETURN( FALSE )
+         END
+      END
+   END
+END dorbytes ;
+
+
+(*
+   dowbytes - 
+*)
+
+PROCEDURE dowbytes (g: GenDevIF; d: DeviceTablePtr;
+                    from: ADDRESS;
+                    nBytes: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+VAR
+   fd: INTEGER ;
+   t : TermInfo ;
+   i : INTEGER ;
+BEGIN
+   t := GetData(d, mid) ;
+   WITH d^ DO
+      fd := getFd(t) ;
+      i := libc.write(fd, from, nBytes) ;
+      IF i>=0
+      THEN
+         actual := i ;
+         RETURN( TRUE )
+      ELSE
+         errNum := geterrno() ;
+         actual := 0 ;
+         RETURN( FALSE )
+      END
+   END
+END dowbytes ;
+
+
+(*
+   dowriteln - attempt to write an end of line marker to the
+               file and returns TRUE if successful.
+*)
+
+PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   a: ARRAY [0..1] OF CHAR ;
+   i: CARDINAL ;
+BEGIN
+   a[0] := cr ;
+   a[1] := lf ;
+   RETURN( dowbytes(g, d, ADR(a), SIZE(a), i) AND (i=SIZE(a)) )
+END dowriteln ;
+
+
+(*
+   iseof - returns TRUE if end of file is seen.
+*)
+
+PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := doreadchar(g, d) ;
+   WITH d^ DO
+      IF errNum=0
+      THEN
+         ch := dounreadchar(g, d, ch) ;
+         RETURN( FALSE )
+      ELSE
+         RETURN( TRUE )
+      END
+   END
+END iseof ;
+
+
+(*
+   iseoln - returns TRUE if end of line is seen.
+*)
+
+PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := doreadchar(g, d) ;
+   WITH d^ DO
+      IF errNum=0
+      THEN
+         ch := dounreadchar(g, d, ch) ;
+         RETURN( ch=lf )
+      ELSE
+         RETURN( FALSE )
+      END
+   END
+END iseoln ;
+
+
+(*
+   iserror - returns TRUE if an error was seen on the device.
+*)
+
+PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+BEGIN
+   RETURN( d^.errNum#0 )
+END iserror ;
+
+
+(*
+   getname - assigns, a, to the device name of the terminal.
+*)
+
+PROCEDURE getname (d: DeviceTablePtr;
+                   VAR a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar(libc.ttyname(0)) ;
+   CopyOut(a, s) ;
+   s := KillString(s)
+END getname ;
+
+
+(*
+   freeData - disposes of, t.
+*)
+
+PROCEDURE freeData (t: TermInfo) ;
+BEGIN
+   t := KillTermInfo(t)
+END freeData ;
+
+
+(*
+   handlefree - 
+*)
+
+PROCEDURE handlefree (d: DeviceTablePtr) ;
+VAR
+   t : TermInfo ;
+   fd: INTEGER ;
+   i : INTEGER ;
+BEGIN
+   t := GetData(d, mid) ;
+   fd := getFd(t) ;
+   i := libc.close(fd) ;
+   checkErrno(dev, d) ;
+   KillData(d, mid)
+END handlefree ;
+
+
+(*
+   termOpen - attempts to open up the terminal device.  It fills
+              in any implied flags and returns a result depending
+              whether the open was successful.
+*)
+
+PROCEDURE termOpen (t: TermInfo; VAR flagset: FlagSet; VAR e: INTEGER) : OpenResults ;
+VAR
+   i: INTEGER ;
+BEGIN
+   WITH t^ DO
+      IF NOT (rawFlag IN flagset)
+      THEN
+         INCL(flagset, textFlag)
+      END ;
+      IF NOT (echoFlag IN flagset)
+      THEN
+         INCL(flagset, interactiveFlag)
+      END ;
+      IF NOT (writeFlag IN flagset)
+      THEN
+         INCL(flagset, readFlag)
+      END ;
+      IF writeFlag IN flagset
+      THEN
+         fd := libc.open(ADR("/dev/tty"), O_WRONLY, 0600B)
+      ELSE
+         fd := libc.open(ADR("/dev/tty"), O_RDONLY)
+      END ;
+      IF tcgetattr(fd, new)=0
+      THEN
+      END ;
+      IF tcgetattr(fd, old)=0
+      THEN
+         IF rawFlag IN flagset
+         THEN
+            cfmakeraw(new)
+         END ;
+         IF tcsetattr(fd, tcsnow(), new)=0
+         THEN
+         END
+      END ;
+      e := geterrno() ;
+      RETURN( GetOpenResults(e) )
+   END
+END termOpen ;
+
+
+(*
+   RestoreTerminalSettings - 
+*)
+
+PROCEDURE RestoreTerminalSettings (cid: ChanId) ;
+VAR
+   d: DeviceTablePtr ;
+   t: TermInfo ;
+   e: INTEGER ;
+BEGIN
+   d := DeviceTablePtrValue(cid, did) ;
+   t := GetData(d, mid) ;
+   WITH t^ DO
+      IF tcsetattr(fd, tcsnow(), old)=0
+      THEN
+      END
+   END
+END RestoreTerminalSettings ;
+
+
+(*
+   Open - attempts to obtain and open a channel connected to
+          the terminal.  Without the raw flag, text is implied.
+          Without the echo flag, line mode is requested,
+          otherwise single character mode is requested.
+          If successful, assigns to cid the identity of
+          the opened channel, and assigns the value opened to res.
+          If a channel cannot be opened as required, the value of
+          res indicates the reason, and cid identifies the
+          invalid channel.
+*)
+
+PROCEDURE Open (VAR cid: ChanId;
+                flagset: FlagSet; VAR res: OpenResults) ;
+VAR
+   d: DeviceTablePtr ;
+   t: TermInfo ;
+   e: INTEGER ;
+BEGIN
+   MakeChan(did, cid) ;              (* create new channel *)
+   d := DeviceTablePtrValue(cid, did) ;
+   t := InitTermInfo(-1) ;
+   res := termOpen(t, flagset, e) ;
+   InitData(d, mid, t, freeData) ;   (* attach memory to device and module *)
+   WITH d^ DO
+      flags := flagset ;
+      errNum := e ;
+      doLook := look ;
+      doSkip := skip ;
+      doSkipLook := skiplook ;
+      doLnWrite := lnwrite ;
+      doTextRead := textread ;
+      doTextWrite := textwrite ;
+      doRawRead := rawread ;
+      doRawWrite := rawwrite ;
+      doGetName := getname ;
+      doFree := handlefree
+   END
+END Open ;
+
+
+(*
+   IsTermFile - tests if the channel identified by cid is open to
+                the terminal.
+*)
+
+PROCEDURE IsTermFile (cid: ChanId) : BOOLEAN ;
+BEGIN
+   RETURN( (cid # NIL) AND (InvalidChan() # cid) AND
+           (IsDevice(cid, did)) AND
+           ((readFlag IN CurrentFlags(cid)) OR
+            (writeFlag IN CurrentFlags(cid))) )
+END IsTermFile ;
+
+
+(*
+   Close - if the channel identified by cid is not open to the
+           terminal, the exception wrongDevice is raised; otherwise
+           closes the channel, and assigns the value identifying
+           the invalid channel to cid.
+*)
+
+PROCEDURE Close (VAR cid: ChanId) ;
+BEGIN
+   IF IsTermFile(cid)
+   THEN
+      RestoreTerminalSettings(cid) ;
+      UnMakeChan(did, cid) ;
+      cid := InvalidChan()
+   ELSE
+      RAISEdevException(cid, did, wrongDevice,
+                        'TermFile.' + __FUNCTION__ +
+                        ': channel is opened to the terminal')
+   END
+END Close ;
+
+
+(*
+   Init - 
+*)
+
+PROCEDURE Init ;
+VAR
+   gen: GenDevIF ;
+BEGIN
+   MakeModuleId(mid) ;
+   AllocateDeviceId(did) ;
+   gen := InitGenDevIF(did,
+                       doreadchar, dounreadchar,
+                       dogeterrno, dorbytes, dowbytes,
+                       dowriteln,
+                       iseof, iseoln, iserror) ;
+   dev := InitChanDev(term, did, gen)
+END Init ;
+
+
+BEGIN
+   Init
+END TermFile.
diff --git a/gcc/m2/gm2-libs-iso/TextIO.def b/gcc/m2/gm2-libs-iso/TextIO.def
new file mode 100644
index 00000000000..cac461b748a
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/TextIO.def
@@ -0,0 +1,74 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE TextIO;
+
+  (* Input and output of character and string types over
+     specified channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The following procedures do not read past line marks *)
+
+PROCEDURE ReadChar (cid: IOChan.ChanId; VAR ch: CHAR);
+  (* If possible, removes a character from the input stream
+     cid and assigns the corresponding value to ch.  The
+     read result is set to the value allRight, endOfLine, or
+     endOfInput.
+  *)
+
+PROCEDURE ReadRestLine (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Removes any remaining characters from the input stream
+     cid before the next line mark,  copying to s as many as
+     can be accommodated as a string value.  The read result is
+     set to the value allRight, outOfRange, endOfLine, or
+     endOfInput.
+  *)
+
+PROCEDURE ReadString (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Removes only those characters from the input stream cid
+     before the next line mark that can be accommodated in s
+     as a string value, and copies them to s.  The read result
+     is set to the value allRight, endOfLine, or endOfInput.
+  *)
+
+PROCEDURE ReadToken (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Skips leading spaces, and then removes characters from
+     the input stream cid before the next space or line mark,
+     copying to s as many as can be accommodated as a string
+     value.  The read result is set to the value allRight,
+     outOfRange, endOfLine, or endOfInput.
+  *)
+
+  (* The following procedure reads past the next line mark *)
+
+PROCEDURE SkipLine (cid: IOChan.ChanId);
+  (* Removes successive items from the input stream cid up
+     to and including the next line mark, or until the end
+     of input is reached.  The read result is set to the
+     value allRight, or endOfInput.
+  *)
+
+  (* Output procedures *)
+
+PROCEDURE WriteChar (cid: IOChan.ChanId; ch: CHAR);
+  (* Writes the value of ch to the output stream cid. *)
+
+PROCEDURE WriteLn (cid: IOChan.ChanId);
+  (* Writes a line mark to the output stream cid. *)
+
+PROCEDURE WriteString (cid: IOChan.ChanId; s: ARRAY OF CHAR);
+  (* Writes the string value in s to the output stream cid. *)
+
+END TextIO.
+
diff --git a/gcc/m2/gm2-libs-iso/TextIO.mod b/gcc/m2/gm2-libs-iso/TextIO.mod
new file mode 100644
index 00000000000..34c0d44abf4
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/TextIO.mod
@@ -0,0 +1,243 @@
+(* TextIO.mod implement the ISO TextIO specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE TextIO ;
+
+
+IMPORT IOChan, IOConsts, CharClass, ASCII ;
+FROM SYSTEM IMPORT ADR ;
+FROM FIO IMPORT FlushOutErr ;
+
+  (* The following procedures do not read past line marks *)
+
+PROCEDURE CanRead (cid: IOChan.ChanId) : BOOLEAN ;
+BEGIN
+   RETURN( (IOChan.ReadResult(cid)=IOConsts.notKnown) OR
+           (IOChan.ReadResult(cid)=IOConsts.allRight) )
+END CanRead ;
+
+PROCEDURE WasGoodChar (cid: IOChan.ChanId) : BOOLEAN ;
+BEGIN
+   RETURN( (IOChan.ReadResult(cid)#IOConsts.endOfLine) AND
+           (IOChan.ReadResult(cid)#IOConsts.endOfInput) )
+END WasGoodChar ;
+
+
+(*
+   SetResult - assigns the result in cid.
+               If s is empty then leave as endOfInput
+                  or endOfLine
+               If s is not empty then assign allRight
+               If range and i exceeds, h, then assign outOfRange
+*)
+
+PROCEDURE SetResult (cid: IOChan.ChanId; i: CARDINAL;
+                     VAR s: ARRAY OF CHAR; range: BOOLEAN) ;
+BEGIN
+   IF i<=HIGH(s)
+   THEN
+      s[i] := ASCII.nul ;
+      IF i>0
+      THEN
+         IOChan.SetReadResult(cid, IOConsts.allRight)
+      END
+   ELSIF range
+   THEN
+      IOChan.SetReadResult(cid, IOConsts.outOfRange)
+   END
+END SetResult ;
+
+
+PROCEDURE ReadChar (cid: IOChan.ChanId; VAR ch: CHAR);
+  (* If possible, removes a character from the input stream
+     cid and assigns the corresponding value to ch.  The
+     read result is set to the value allRight, endOfLine, or
+     endOfInput.
+  *)
+VAR
+   res: IOConsts.ReadResults ;
+BEGIN
+   FlushOutErr ;
+   IF CanRead(cid)
+   THEN
+      IOChan.Look(cid, ch, res) ;
+      IF res=IOConsts.allRight
+      THEN
+         IOChan.Skip(cid)
+      END
+   END
+END ReadChar ;
+
+PROCEDURE ReadRestLine (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Removes any remaining characters from the input stream
+     cid before the next line mark,  copying to s as many as
+     can be accommodated as a string value.  The read result is
+     set to the value allRight, outOfRange, endOfLine, or
+     endOfInput.
+  *)
+VAR
+   i, h    : CARDINAL ;
+   finished: BOOLEAN ;
+BEGIN
+   h := HIGH(s) ;
+   i := 0 ;
+   finished := FALSE ;
+   WHILE (i<=h) AND CanRead(cid) AND (NOT finished) DO
+      ReadChar(cid, s[i]) ;
+      IF WasGoodChar(cid)
+      THEN
+         INC(i)
+      ELSE
+         finished := TRUE
+      END
+   END ;
+   WHILE CanRead(cid) DO
+      IOChan.Skip(cid)
+   END ;
+   SetResult(cid, i, s, TRUE)
+END ReadRestLine ;
+
+PROCEDURE ReadString (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Removes only those characters from the input stream cid
+     before the next line mark that can be accommodated in s
+     as a string value, and copies them to s.  The read result
+     is set to the value allRight, endOfLine, or endOfInput.
+  *)
+VAR
+   i, h    : CARDINAL ;
+   finished: BOOLEAN ;
+BEGIN
+   h := HIGH(s) ;
+   i := 0 ;
+   finished := FALSE ;
+   WHILE (i<=h) AND CanRead(cid) AND (NOT finished) DO
+      ReadChar(cid, s[i]) ;
+      IF WasGoodChar(cid)
+      THEN
+         INC(i)
+      ELSE
+         finished := TRUE
+      END
+   END ;
+   SetResult(cid, i, s, FALSE)
+END ReadString ;
+
+
+(*
+   SkipSpaces - skips any spaces.
+*)
+
+PROCEDURE SkipSpaces (cid: IOChan.ChanId) ;
+VAR
+   ch : CHAR ;
+   res: IOConsts.ReadResults ;
+BEGIN
+   WHILE CanRead(cid) DO
+      IOChan.Look(cid, ch, res) ;
+      IF res=IOConsts.allRight
+      THEN
+         IF CharClass.IsWhiteSpace(ch)
+         THEN
+            IOChan.Skip(cid)
+         ELSE
+            RETURN
+         END
+      ELSE
+         RETURN
+      END
+   END
+END SkipSpaces ;
+
+
+PROCEDURE ReadToken (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Skips leading spaces, and then removes characters from
+     the input stream cid before the next space or line mark,
+     copying to s as many as can be accommodated as a string
+     value.  The read result is set to the value allRight,
+     outOfRange, endOfLine, or endOfInput.
+  *)
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   SkipSpaces(cid) ;
+   h := HIGH(s) ;
+   i := 0 ;
+   WHILE (i<=h) AND CanRead(cid) DO
+      ReadChar(cid, s[i]) ;
+      IF (s[i]=ASCII.nul) OR CharClass.IsWhiteSpace(s[i])
+      THEN
+         SetResult(cid, i, s, TRUE) ;
+         RETURN
+      END ;
+      INC(i)
+   END ;
+   SetResult(cid, i, s, TRUE)
+END ReadToken ;
+
+  (* The following procedure reads past the next line mark *)
+
+PROCEDURE SkipLine (cid: IOChan.ChanId);
+  (* Removes successive items from the input stream cid up
+     to and including the next line mark, or until the end
+     of input is reached.  The read result is set to the
+     value allRight, or endOfInput.
+  *)
+VAR
+   ch : CHAR ;
+   res: IOConsts.ReadResults ;
+BEGIN
+   IOChan.Look(cid, ch, res) ;
+   WHILE res=IOConsts.allRight DO
+      IOChan.SkipLook(cid, ch, res)
+   END ;
+   IF res=IOConsts.endOfLine
+   THEN
+      IOChan.Skip(cid)
+   END
+END SkipLine ;
+
+  (* Output procedures *)
+
+PROCEDURE WriteChar (cid: IOChan.ChanId; ch: CHAR);
+  (* Writes the value of ch to the output stream cid. *)
+BEGIN
+   IOChan.TextWrite(cid, ADR(ch), SIZE(ch))
+END WriteChar ;
+
+PROCEDURE WriteLn (cid: IOChan.ChanId);
+  (* Writes a line mark to the output stream cid. *)
+BEGIN
+   IOChan.WriteLn(cid)
+END WriteLn ;
+
+PROCEDURE WriteString (cid: IOChan.ChanId; s: ARRAY OF CHAR);
+  (* Writes the string value in s to the output stream cid. *)
+BEGIN
+   IOChan.TextWrite(cid, ADR(s), LENGTH(s))
+END WriteString ;
+
+
+END TextIO.
diff --git a/gcc/m2/gm2-libs-iso/WholeConv.def b/gcc/m2/gm2-libs-iso/WholeConv.def
new file mode 100644
index 00000000000..6192f12a895
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/WholeConv.def
@@ -0,0 +1,73 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE WholeConv;
+
+  (* Low-level whole-number/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+  ConvResults = ConvTypes.ConvResults;
+        (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+
+PROCEDURE ScanInt (inputCh: CHAR;
+                   VAR chClass: ConvTypes.ScanClass;
+                   VAR nextState: ConvTypes.ScanState) ;
+  (* Represents the start state of a finite state scanner for signed
+     whole numbers - assigns class of inputCh to chClass and a
+     procedure representing the next state to nextState.
+  *)
+
+PROCEDURE FormatInt (str: ARRAY OF CHAR): ConvResults;
+  (* Returns the format of the string value for conversion to INTEGER. *)
+
+PROCEDURE ValueInt (str: ARRAY OF CHAR): INTEGER;
+  (* Returns the value corresponding to the signed whole number string
+     value str if str is well-formed; otherwise raises the WholeConv
+     exception.
+   *)
+
+PROCEDURE LengthInt (int: INTEGER): CARDINAL;
+  (* Returns the number of characters in the string representation of
+     int.
+   *)
+
+PROCEDURE ScanCard (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState);
+  (* Represents the start state of a finite state scanner for unsigned
+     whole numbers - assigns class of inputCh to chClass and a procedure
+     representing the next state to nextState.
+   *)
+
+PROCEDURE FormatCard (str: ARRAY OF CHAR): ConvResults;
+  (* Returns the format of the string value for conversion to CARDINAL.
+   *)
+
+PROCEDURE ValueCard (str: ARRAY OF CHAR): CARDINAL;
+  (* Returns the value corresponding to the unsigned whole number string
+     value str if str is well-formed; otherwise raises the WholeConv
+     exception.
+   *)
+
+PROCEDURE LengthCard (card: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the string representation of
+     card.
+   *)
+
+PROCEDURE IsWholeConvException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution
+     state because of the raising of an exception in a routine from this
+     module; otherwise returns FALSE.
+  *)
+
+END WholeConv.
diff --git a/gcc/m2/gm2-libs-iso/WholeConv.mod b/gcc/m2/gm2-libs-iso/WholeConv.mod
new file mode 100644
index 00000000000..616d8d02303
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/WholeConv.mod
@@ -0,0 +1,374 @@
+(* WholeConv.mod implement the ISO WholeConv specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE WholeConv ;
+
+FROM CharClass IMPORT IsNumeric, IsWhiteSpace ;
+IMPORT EXCEPTIONS ;
+
+FROM ConvTypes IMPORT ScanClass ;
+
+
+TYPE
+   WholeConvException = (noException, invalidSigned, invalidUnsigned) ;
+
+VAR
+   wholeConv:  EXCEPTIONS.ExceptionSource ;
+
+
+(*
+   ScanInt - represents the start state of a finite state scanner
+             for signed whole numbers - assigns class of inputCh
+             to chClass and a procedure representing the next state
+             to nextState.
+*)
+
+PROCEDURE ScanInt (inputCh: CHAR;
+                   VAR chClass: ConvTypes.ScanClass;
+                   VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanRemainingDigits ;
+      chClass := valid
+   ELSIF (inputCh='+') OR (inputCh='-')
+   THEN
+      nextState := scanFirstDigit ;
+      chClass := valid
+   ELSIF IsWhiteSpace(inputCh)
+   THEN
+      nextState := scanSpace ;
+      chClass := padding
+   ELSE
+      nextState := ScanInt ;
+      chClass := invalid
+   END
+END ScanInt ;
+
+
+PROCEDURE scanFirstDigit (ch: CHAR;
+                          VAR chClass: ConvTypes.ScanClass;
+                          VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(ch)
+   THEN
+      chClass := valid ;
+      nextState := scanRemainingDigits
+   ELSE
+      chClass := invalid
+   END
+END scanFirstDigit ;
+
+
+PROCEDURE scanRemainingDigits (ch: CHAR;
+                               VAR chClass: ConvTypes.ScanClass;
+                               VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(ch)
+   THEN
+      chClass := valid
+   ELSE
+      chClass := terminator
+   END
+END scanRemainingDigits ;
+
+
+PROCEDURE scanSpace (ch: CHAR;
+                     VAR chClass: ConvTypes.ScanClass;
+                     VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsWhiteSpace(ch)
+   THEN
+      chClass := padding
+   ELSIF (ch='+') OR (ch='-')
+   THEN
+      chClass := valid ;
+      nextState := scanFirstDigit
+   ELSE
+      chClass := invalid
+   END
+END scanSpace ;
+
+
+(*
+   FormatInt - returns the format of the string value for
+               conversion to INTEGER.
+*)
+
+PROCEDURE FormatInt (str: ARRAY OF CHAR) : ConvResults ;
+VAR
+   proc   : ConvTypes.ScanState ;
+   chClass: ConvTypes.ScanClass ;
+   i, h   : CARDINAL ;
+BEGIN
+   i := 1 ;
+   h := LENGTH(str) ;
+   ScanInt(str[0], chClass, proc) ;
+   WHILE (i<h) AND (chClass=padding) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+   IF chClass=terminator
+   THEN
+      RETURN( strEmpty )
+   END ;
+   WHILE (i<h) AND (chClass=valid) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+   CASE chClass OF
+
+   padding   :  RETURN( strWrongFormat ) |
+   terminator,
+   valid     :  RETURN( strAllRight ) |
+   invalid   :  RETURN( strWrongFormat )
+
+   END
+END FormatInt ;
+
+
+(*
+   ValueInt - returns the value corresponding to the signed whole
+              number string value str if str is well-formed;
+              otherwise raises the WholeConv exception.
+*)
+
+PROCEDURE ValueInt (str: ARRAY OF CHAR) : INTEGER;
+VAR
+   proc   : ConvTypes.ScanState ;
+   chClass: ConvTypes.ScanClass ;
+   i, h   : CARDINAL ;
+   v      : INTEGER ;
+   value  : CARDINAL ;
+   neg    : BOOLEAN ;
+BEGIN
+   IF FormatInt(str)=strAllRight
+   THEN
+      value := 0 ;
+      neg := FALSE ;
+      i := 0 ;
+      h := LENGTH(str) ;
+      proc := ScanInt ;
+      chClass := valid ;
+      WHILE (i<h) AND ((chClass=valid) OR (chClass=padding)) DO
+         IF str[i]='-'
+         THEN
+            neg := NOT neg
+         ELSIF str[i]='+'
+         THEN
+            (* ignore *)
+         ELSIF IsNumeric(str[i])
+         THEN
+            value := value*10+(ORD(str[i])-ORD('0'))
+         END ;
+         proc(str[i], chClass, proc) ;
+         INC(i)
+      END ;
+      IF neg
+      THEN
+         v := -value
+      ELSE
+         v := value
+      END ;
+      RETURN( v )
+   ELSE
+      EXCEPTIONS.RAISE(wholeConv, ORD(invalidSigned),
+                       'WholeConv.' + __FUNCTION__ + ': signed number is invalid')
+   END
+END ValueInt ;
+
+
+(*
+   LengthInt - returns the number of characters in the string
+               representation of int.
+*)
+
+PROCEDURE LengthInt (int: INTEGER) : CARDINAL ;
+VAR
+   c, l: CARDINAL ;
+BEGIN
+   IF int<0
+   THEN
+      l := 2 ;
+      IF int=MIN(INTEGER)
+      THEN
+         c := VAL(CARDINAL, MAX(INTEGER))+1
+      ELSE
+         c := -int
+      END
+   ELSE
+      l := 1 ;
+      c := int
+   END ;
+   WHILE c>9 DO
+      c := c DIV 10 ;
+      INC(l)
+   END ;
+   RETURN( l )
+END LengthInt ;
+
+
+(*
+   ScanCard - represents the start state of a finite state scanner for
+              unsigned whole numbers - assigns class of inputCh to
+              chClass and a procedure representing the next state to
+              nextState.
+*)
+
+PROCEDURE ScanCard (inputCh: CHAR;
+                    VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+   IF IsNumeric(inputCh)
+   THEN
+      nextState := scanRemainingDigits ;
+      chClass := valid
+   ELSIF inputCh='+'
+   THEN
+      nextState := scanFirstDigit ;
+      chClass := valid
+   ELSIF IsWhiteSpace(inputCh)
+   THEN
+      nextState := scanSpace ;
+      chClass := padding
+   ELSE
+      nextState := ScanCard ;
+      chClass := invalid
+   END
+END ScanCard ;
+
+
+(*
+   FormatCard - returns the format of the string value for
+                conversion to CARDINAL.
+*)
+
+PROCEDURE FormatCard (str: ARRAY OF CHAR) : ConvResults ;
+VAR
+   proc   : ConvTypes.ScanState ;
+   chClass: ConvTypes.ScanClass ;
+   i, h   : CARDINAL ;
+BEGIN
+   i := 1 ;
+   h := LENGTH(str) ;
+   ScanCard(str[0], chClass, proc) ;
+   WHILE (i<h) AND (chClass=padding) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+   IF chClass=terminator
+   THEN
+      RETURN( strEmpty )
+   END ;
+   WHILE (i<h) AND (chClass=valid) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+   CASE chClass OF
+
+   padding   :  RETURN( strWrongFormat ) |
+   terminator,
+   valid     :  RETURN( strAllRight ) |
+   invalid   :  RETURN( strWrongFormat )
+
+   END
+END FormatCard ;
+
+
+(*
+   ValueCard - returns the value corresponding to the unsigned
+               whole number string value str if str is well-formed;
+               otherwise raises the WholeConv exception.
+*)
+
+PROCEDURE ValueCard (str: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   proc   : ConvTypes.ScanState ;
+   chClass: ConvTypes.ScanClass ;
+   i, h   : CARDINAL ;
+   value  : CARDINAL ;
+BEGIN
+   IF FormatCard(str)=strAllRight
+   THEN
+      value := 0 ;
+      i := 0 ;
+      h := LENGTH(str) ;
+      ScanCard(str[0], chClass, proc) ;
+      proc := ScanCard ;
+      chClass := valid ;
+      WHILE (i<h) AND ((chClass=valid) OR (chClass=padding)) DO
+         IF str[i]='+'
+         THEN
+            (* ignore *)
+         ELSIF IsNumeric(str[i])
+         THEN
+            value := value*10+(ORD(str[i])-ORD('0'))
+         END ;
+         proc(str[i], chClass, proc) ;
+         INC(i)
+      END ;
+      RETURN( value )
+   ELSE
+      EXCEPTIONS.RAISE(wholeConv, ORD(invalidUnsigned),
+                       'WholeConv:' + __FUNCTION__ + ': unsigned number is invalid')
+   END
+END ValueCard ;
+
+
+(*
+   LengthCard - returns the number of characters in the string
+                representation of, card.
+*)
+
+PROCEDURE LengthCard (card: CARDINAL) : CARDINAL ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := 1 ;
+   WHILE card>9 DO
+      card := card DIV 10 ;
+      INC(l)
+   END ;
+   RETURN( l )
+END LengthCard ;
+
+
+(*
+   IsWholeConvException - returns TRUE if the current coroutine is
+                          in the exceptional execution state because
+                          of the raising of an exception in a routine
+                          from this module; otherwise returns FALSE.
+*)
+
+PROCEDURE IsWholeConvException () : BOOLEAN ;
+BEGIN
+   RETURN( EXCEPTIONS.IsCurrentSource(wholeConv) )
+END IsWholeConvException ;
+
+
+BEGIN
+   EXCEPTIONS.AllocateSource(wholeConv)
+END WholeConv.
diff --git a/gcc/m2/gm2-libs-iso/WholeIO.def b/gcc/m2/gm2-libs-iso/WholeIO.def
new file mode 100644
index 00000000000..62d03b541a1
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/WholeIO.def
@@ -0,0 +1,54 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE WholeIO;
+
+  (* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, {decimal digit}
+
+     The text form of an unsigned whole number is
+       decimal digit, {decimal digit}
+  *)
+
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: INTEGER);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: INTEGER;
+                    width: CARDINAL);
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: CARDINAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: CARDINAL;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+
+END WholeIO.
diff --git a/gcc/m2/gm2-libs-iso/WholeIO.mod b/gcc/m2/gm2-libs-iso/WholeIO.mod
new file mode 100644
index 00000000000..5ee8a969ac1
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/WholeIO.mod
@@ -0,0 +1,175 @@
+(* WholeIO.mod implement the ISO WholeIO specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE WholeIO ;
+
+FROM ConvTypes IMPORT ScanClass, ScanState ;
+FROM TextIO IMPORT WriteChar, ReadChar ;
+FROM DynamicStrings IMPORT String, char, KillString, Length ;
+FROM StringConvert IMPORT IntegerToString, CardinalToString ;
+FROM WholeConv IMPORT ScanInt, ScanCard ;
+FROM StringChan IMPORT writeString ;
+FROM IOConsts IMPORT ReadResults ;
+
+
+(* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+*)
+
+IMPORT IOChan;
+
+(* The text form of a signed whole number is
+     ["+" | "-"], decimal digit, {decimal digit}
+
+   The text form of an unsigned whole number is
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: INTEGER) ;
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+VAR
+   chClass  : ScanClass ;
+   nextState: ScanState ;
+   c        : CARDINAL ;
+   ch       : CHAR ;
+   negative : BOOLEAN ;
+BEGIN
+   ReadChar(cid, ch) ;
+   negative := FALSE ;
+   c := 0 ;
+   nextState := ScanInt ;
+   REPEAT
+      nextState(ch, chClass, nextState) ;
+      IF chClass=valid
+      THEN
+         IF ch='+'
+         THEN
+            (* ignore *)
+         ELSIF ch='-'
+         THEN
+            negative := NOT negative
+         ELSE
+            c := c*10+(ORD(ch)-ORD('0'))
+         END ;
+         ReadChar(cid, ch)
+      ELSIF chClass=padding
+      THEN
+         ReadChar(cid, ch)
+      END
+   UNTIL (chClass=invalid) OR (chClass=terminator) ;
+   IF chClass=terminator
+   THEN
+      IF negative
+      THEN
+         IF c=VAL(CARDINAL, MAX(INTEGER))+1
+         THEN
+            int := MIN(INTEGER)
+         ELSIF c<=VAL(CARDINAL, MAX(INTEGER))
+         THEN
+            int := -VAL(INTEGER, c)
+         ELSE
+            (* overflow *)
+            IOChan.SetReadResult(cid, outOfRange)
+         END
+      ELSE
+         int := c
+      END
+   END
+END ReadInt ;
+
+
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: INTEGER;
+                    width: CARDINAL) ;
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+VAR
+   s: String ;
+BEGIN
+   s := IntegerToString(int, width, ' ', TRUE, 10, FALSE) ;
+   writeString(cid, s) ;
+   s := KillString(s)
+END WriteInt ;
+
+
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: CARDINAL) ;
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+VAR
+   chClass  : ScanClass ;
+   nextState: ScanState ;
+   ch       : CHAR ;
+   c        : CARDINAL ;
+BEGIN
+   ReadChar(cid, ch) ;
+   c := 0 ;
+   nextState := ScanCard ;
+   REPEAT
+      nextState(ch, chClass, nextState) ;
+      IF chClass=valid
+      THEN
+         IF ch='+'
+         THEN
+            (* ignore *)
+         ELSE
+            c := c*10+(ORD(ch)-ORD('0'))
+         END ;
+         ReadChar(cid, ch)
+      ELSIF chClass=padding
+      THEN
+         ReadChar(cid, ch)
+      END
+   UNTIL (chClass=invalid) OR (chClass=terminator) ;
+   IF chClass=terminator
+   THEN
+      card := c
+   END
+END ReadCard ;
+
+
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: CARDINAL;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+VAR
+   s: String ;
+BEGIN
+   s := CardinalToString(card, width, ' ', 10, FALSE) ;
+   writeString(cid, s) ;
+   s := KillString(s)
+END WriteCard ;
+
+
+END WholeIO.
diff --git a/gcc/m2/gm2-libs-iso/WholeStr.def b/gcc/m2/gm2-libs-iso/WholeStr.def
new file mode 100644
index 00000000000..a0a5ce66093
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/WholeStr.def
@@ -0,0 +1,56 @@
+(* Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) 1996-2021.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
+
+DEFINITION MODULE WholeStr;
+
+  (* Whole-number/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+  ConvResults = ConvTypes.ConvResults;
+  (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+
+(* the string form of a signed whole number is
+     ["+" | "-"], decimal digit, {decimal digit}
+*)
+
+PROCEDURE StrToInt (str: ARRAY OF CHAR; VAR int: INTEGER;
+                    VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent
+     characters in str are in the format of a signed whole
+     number, assigns a corresponding value to int. Assigns
+     a value indicating the format of str to res.
+  *)
+
+PROCEDURE IntToStr (int: INTEGER; VAR str: ARRAY OF CHAR);
+  (* Converts the value of int to string form and copies the
+     possibly truncated result to str. *)
+
+(* the string form of an unsigned whole number is
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE StrToCard (str: ARRAY OF CHAR;
+                     VAR card: CARDINAL;
+                     VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent
+     characters in str are in the format of an unsigned
+     whole number, assigns a corresponding value to card.
+     Assigns a value indicating the format of str to res.
+  *)
+
+PROCEDURE CardToStr (card: CARDINAL; VAR str: ARRAY OF CHAR);
+  (* Converts the value of card to string form and copies the
+     possibly truncated result to str. *)
+
+END WholeStr.
diff --git a/gcc/m2/gm2-libs-iso/WholeStr.mod b/gcc/m2/gm2-libs-iso/WholeStr.mod
new file mode 100644
index 00000000000..6f38ec505c3
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/WholeStr.mod
@@ -0,0 +1,99 @@
+(* WholeStr.mod implement the ISO WholeStr specification.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE WholeStr ;
+
+FROM DynamicStrings IMPORT String, KillString, CopyOut ;
+FROM StringConvert IMPORT CardinalToString, IntegerToString ;
+FROM WholeConv IMPORT FormatCard, ValueCard, FormatInt, ValueInt ;
+
+
+(* the string form of a signed whole number is
+     ["+" | "-"], decimal digit, {decimal digit}
+*)
+
+PROCEDURE StrToInt (str: ARRAY OF CHAR; VAR int: INTEGER;
+                    VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent
+     characters in str are in the format of a signed whole
+     number, assigns a corresponding value to int. Assigns
+     a value indicating the format of str to res.
+  *)
+BEGIN
+   res := FormatInt(str) ;
+   IF res=strAllRight
+   THEN
+      int := ValueInt(str)
+   END
+END StrToInt ;
+
+
+PROCEDURE IntToStr (int: INTEGER; VAR str: ARRAY OF CHAR);
+  (* Converts the value of int to string form and copies
+     the possibly truncated result to str. *)
+VAR
+   s: String ;
+BEGIN
+   s := IntegerToString(int, 0, ' ', TRUE, 10, FALSE) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END IntToStr ;
+
+
+(* the string form of an unsigned whole number is
+     decimal digit, {decimal digit}
+*)
+
+PROCEDURE StrToCard (str: ARRAY OF CHAR;
+                     VAR card: CARDINAL;
+                     VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent
+     characters in str are in the format of an unsigned
+     whole number, assigns a corresponding value to card.
+     Assigns a value indicating the format of str to res.
+  *)
+BEGIN
+   res := FormatCard(str) ;
+   IF res=strAllRight
+   THEN
+      card := ValueCard(str)
+   END
+END StrToCard ;
+
+
+PROCEDURE CardToStr (card: CARDINAL; VAR str: ARRAY OF CHAR);
+  (* Converts the value of card to string form and copies the
+     possibly truncated result to str. *)
+VAR
+   s: String ;
+BEGIN
+   s := CardinalToString(card, 0, ' ', 10, FALSE) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END CardToStr ;
+
+
+END WholeStr.
diff --git a/gcc/m2/gm2-libs-iso/wrapsock.c b/gcc/m2/gm2-libs-iso/wrapsock.c
new file mode 100644
index 00000000000..c614e0837ed
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/wrapsock.c
@@ -0,0 +1,260 @@
+/* wrapsock.c implements access to low level client socket primitives.
+
+Copyright (C) 2008-2021 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 <p2c/p2c.h>
+
+#if defined(HAVE_SYS_TYPES_H)
+#   include <sys/types.h>
+#endif
+
+#if defined(HAVE_SYS_SOCKET_H)
+#   include <sys/socket.h>
+#endif
+
+#include <netinet/in.h>
+#include <netdb.h>
+
+#if defined(HAVE_UNISTD_H)
+#  include <unistd.h>
+#endif
+
+#if defined(HAVE_SIGNAL_H)
+#  include <signal.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#  include <sys/errno.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#  include <errno.h>
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#  include <malloc.h>
+#endif
+
+#if defined(HAVE_SIGNAL_H)
+#  include <signal.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+#  include <string.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#  include <stdlib.h>
+#endif
+
+#if !defined(TRUE)
+#  define TRUE  (1==1)
+#endif
+#if !defined(FALSE)
+#  define FALSE (1==0)
+#endif
+
+#include "ChanConsts.h"
+
+#define MAXHOSTNAME 1024
+#define MAXPBBUF    1024
+
+
+typedef struct {
+  char                hostname[MAXHOSTNAME];
+  struct hostent     *hp;
+  struct sockaddr_in  sa;
+  int                 sockFd;
+  int                 portNo;
+  int                 hasChar;
+  char                pbChar[MAXPBBUF];
+} clientInfo;
+
+static openResults clientConnect (clientInfo *c);
+
+
+/*
+ *  clientOpen - returns an ISO Modula-2 OpenResult.
+ *               It attempts to connect to:  hostname:portNo.
+ *               If successful then the data structure, c,
+ *               will have its fields initialized.
+ */
+
+openResults wrapsock_clientOpen (clientInfo *c, char *hostname,
+				 unsigned int length, int portNo)
+{
+  /* remove SIGPIPE which is raised on the server if the client is killed */
+  signal(SIGPIPE, SIG_IGN);
+
+  c->hp = gethostbyname(hostname);
+  if (c->hp == NULL)
+    return noSuchFile;
+
+  memset((void *)&c->sa, 0, sizeof(c->sa));
+  c->sa.sin_family = AF_INET;
+  memcpy((void *)&c->sa.sin_addr, (void *)c->hp->h_addr, c->hp->h_length);
+  c->portNo        = portNo;
+  c->sa.sin_port   = htons(portNo);
+  c->hasChar       = 0;
+  /*
+   *  Open a TCP socket (an Internet stream socket)
+   */
+
+  c->sockFd = socket(c->hp->h_addrtype, SOCK_STREAM, 0);
+  return clientConnect(c);
+}
+
+/*
+ *  clientOpenIP - returns an ISO Modula-2 OpenResult.
+ *                 It attempts to connect to:  ipaddress:portNo.
+ *                 If successful then the data structure, c,
+ *                 will have its fields initialized.
+ */
+
+openResults wrapsock_clientOpenIP (clientInfo *c, unsigned int ip, int portNo)
+{
+  /* remove SIGPIPE which is raised on the server if the client is killed */
+  signal(SIGPIPE, SIG_IGN);
+
+  memset((void *)&c->sa, 0, sizeof(c->sa));
+  c->sa.sin_family = AF_INET;
+  memcpy((void *)&c->sa.sin_addr, (void *)&ip, sizeof(ip));
+  c->portNo        = portNo;
+  c->sa.sin_port   = htons(portNo);
+
+  /*
+   * Open a TCP socket (an Internet stream socket)
+   */
+
+  c->sockFd = socket(PF_INET, SOCK_STREAM, 0);
+  return clientConnect(c);
+}
+
+/*
+ *  clientConnect - returns an ISO Modula-2 OpenResult
+ *                  once a connect has been performed.
+ *                  If successful the clientInfo will
+ *                  include the file descriptor ready
+ *                  for read/write operations.
+ */
+
+static openResults clientConnect (clientInfo *c)
+{
+  if (connect(c->sockFd, (struct sockaddr *)&c->sa, sizeof(c->sa)) < 0)
+    return noSuchFile;
+
+  return opened;
+}
+
+/*
+ *  getClientPortNo - returns the portNo from structure, c.
+ */
+
+int wrapsock_getClientPortNo (clientInfo *c)
+{
+  return c->portNo;
+}
+
+/*
+ *  getClientHostname - fills in the hostname of the server
+ *                      the to which the client is connecting.
+ */
+
+void wrapsock_getClientHostname (clientInfo *c,
+				 char *hostname, unsigned int high)
+{
+  strncpy(hostname, c->hostname, high+1);
+}
+
+/*
+ *  getClientSocketFd - returns the sockFd from structure, c.
+ */
+
+int wrapsock_getClientSocketFd (clientInfo *c)
+{
+  return c->sockFd;
+}
+
+/*
+ *  getClientIP - returns the sockFd from structure, s.
+ */
+
+unsigned int wrapsock_getClientIP (clientInfo *c)
+{
+#if 0
+  printf("client ip = %s\n", inet_ntoa (c->sa.sin_addr.s_addr));
+#endif
+  return c->sa.sin_addr.s_addr;
+}
+
+/*
+ *  getPushBackChar - returns TRUE if a pushed back character
+ *                    is available.
+ */
+
+unsigned int wrapsock_getPushBackChar (clientInfo *c, char *ch)
+{
+  if (c->hasChar > 0) {
+    c->hasChar--;
+    *ch = c->pbChar[c->hasChar];
+    return TRUE;
+  }
+  return FALSE;
+}
+
+/*
+ *  setPushBackChar - returns TRUE if it is able to push back a
+ *                    character.
+ */
+
+unsigned int wrapsock_setPushBackChar (clientInfo *c, char ch)
+{
+  if (c->hasChar == MAXPBBUF)
+    return FALSE;
+  c->pbChar[c->hasChar] = ch;
+  c->hasChar++;
+  return TRUE;
+}
+
+/*
+ *  getSizeOfClientInfo - returns the sizeof (opaque data type).
+ */
+
+unsigned int wrapsock_getSizeOfClientInfo (void)
+{
+  return sizeof (clientInfo);
+}
+
+/*
+ *  GNU Modula-2 link fodder.
+ */
+
+void _M2_wrapsock_init (void)
+{
+}
+
+void _M2_wrapsock_finish (void)
+{
+}
diff --git a/gcc/m2/gm2-libs-iso/wrapsock.def b/gcc/m2/gm2-libs-iso/wrapsock.def
new file mode 100644
index 00000000000..0ab5013885e
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/wrapsock.def
@@ -0,0 +1,125 @@
+(* wrapsock.def provides access to low level client socket primitives.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE wrapsock ;
+
+(*
+    Title      : wrapsock
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Wed Oct  1 08:40:21 2008
+    Revision   : $Version$ 
+    Description: provides a set of wrappers to some client side
+                 tcp socket primatives.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM ChanConsts IMPORT OpenResults ;
+
+
+TYPE
+   clientInfo = ADDRESS ;
+
+
+(*
+   clientOpen - returns an ISO Modula-2 OpenResult.
+                It attempts to connect to:  hostname:portNo.
+                If successful then the data structure, c,
+                will have its fields initialized.
+*)
+
+PROCEDURE clientOpen (c: clientInfo;
+                      hostname: ADDRESS;
+                      length: CARDINAL;
+                      portNo: CARDINAL) : OpenResults ;
+
+
+(*
+   clientOpenIP - returns an ISO Modula-2 OpenResult.
+                  It attempts to connect to:  ipaddress:portNo.
+                  If successful then the data structure, c,
+                  will have its fields initialized.
+*)
+
+PROCEDURE clientOpenIP (c: clientInfo;
+                        ip: CARDINAL;
+                        portNo: CARDINAL) : OpenResults ;
+
+
+(*
+   getClientPortNo - returns the portNo from structure, c.
+*)
+
+PROCEDURE getClientPortNo (c: clientInfo) : CARDINAL ;
+
+
+(*
+   getClientHostname - fills in the hostname of the server
+                       the to which the client is connecting.
+*)
+
+PROCEDURE getClientHostname (c: clientInfo;
+                             hostname: ADDRESS; high: CARDINAL) ;
+
+
+(*
+   getClientSocketFd - returns the sockFd from structure, c.
+*)
+
+PROCEDURE getClientSocketFd (c: clientInfo) : INTEGER ;
+
+
+(*
+   getClientIP - returns the sockFd from structure, s.
+*)
+
+PROCEDURE getClientIP (c: clientInfo) : CARDINAL ;
+
+
+(*
+   getPushBackChar - returns TRUE if a pushed back character
+                     is available.
+*)
+
+PROCEDURE getPushBackChar (c: clientInfo; VAR ch: CHAR) : BOOLEAN ;
+
+
+(*
+   setPushBackChar - returns TRUE if it is able to push back a
+                     character.
+*)
+
+PROCEDURE setPushBackChar (c: clientInfo; ch: CHAR) : BOOLEAN ;
+
+
+(*
+   getSizeOfClientInfo - returns the sizeof (opaque data type).
+*)
+
+PROCEDURE getSizeOfClientInfo () : CARDINAL ;
+
+
+END wrapsock.
diff --git a/gcc/m2/gm2-libs-iso/wraptime.c b/gcc/m2/gm2-libs-iso/wraptime.c
new file mode 100644
index 00000000000..d4319c8f6a0
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/wraptime.c
@@ -0,0 +1,292 @@
+/* wraptime.c provides access to time functions.
+
+Copyright (C) 2009-2021 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 "gm2-libs-host.h"
+
+#if defined(HAVE_SYS_TYPES_H)
+#   include <sys/types.h>
+#endif
+
+#if defined(HAVE_SYS_TIME_H)
+#   include <sys/time.h>
+#endif
+
+#if defined(HAVE_TIME_H)
+#   include <time.h>
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#  include <malloc.h>
+#endif
+
+#if !defined(TRUE)
+#  define TRUE  (1==1)
+#endif
+#if !defined(FALSE)
+#  define FALSE (1==0)
+#endif
+
+/* InitTimeval returns a newly created opaque type.  */
+
+struct timeval *
+wraptime_InitTimeval (void)
+{
+#if defined(HAVE_TIMEVAL)
+  return (struct timeval *) malloc (sizeof (struct timeval));
+#else
+  return NULL;
+#endif
+}
+
+/* KillTimeval deallocates the memory associated with an
+   opaque type.  */
+
+struct timeval *
+wraptime_KillTimeval (void *tv)
+{
+  free (tv);
+  return NULL;
+}
+
+/* InitTimezone returns a newly created opaque type.  */
+
+struct timezone *
+wraptime_InitTimezone (void)
+{
+  return (struct timezone *) malloc (sizeof (struct timezone));
+}
+
+/* KillTimezone deallocates the memory associated with an
+   opaque type.  */
+
+struct timezone *
+wraptime_KillTimezone (struct timezone *tv)
+{
+  free (tv);
+  return NULL;
+}
+
+/* InitTM returns a newly created opaque type.  */
+
+struct tm *
+wraptime_InitTM (void)
+{
+  return (struct tm *) malloc (sizeof (struct tm));
+}
+
+/* KillTM deallocates the memory associated with an opaque type.  */
+
+struct tm *
+wraptime_KillTM (struct tm *tv)
+{
+  free (tv);
+  return NULL;
+}
+
+/* gettimeofday calls gettimeofday(2) with the same parameters, tv,
+   and, tz.  It returns 0 on success.  */
+
+int
+wraptime_gettimeofday (void *tv, struct timezone *tz)
+{
+  return gettimeofday (tv, tz);
+}
+
+/* settimeofday calls settimeofday(2) with the same parameters, tv,
+   and, tz.  It returns 0 on success.  */
+
+int
+wraptime_settimeofday (void *tv, struct timezone *tz)
+{
+  return settimeofday (tv, tz);
+}
+
+/* wraptime_GetFractions returns the tv_usec field inside the timeval
+   structure.  */
+
+#if defined(HAVE_TIMEVAL)
+unsigned int
+wraptime_GetFractions (struct timeval *tv)
+{
+  return (unsigned int) tv->tv_usec;
+}
+#else
+unsigned int
+wraptime_GetFractions (void *tv)
+{
+  return 0;
+}
+#endif
+
+/* localtime_r returns the tm parameter, m, after it has been assigned
+   with appropriate contents determined by, tv.  Notice that this
+   procedure function expects, timeval, as its first parameter and not
+   a time_t (as expected by the posix equivalent).  */
+
+#if defined(HAVE_TIMEVAL)
+struct tm *
+wraptime_localtime_r (struct timeval *tv, struct tm *m)
+{
+  return localtime_r (&tv->tv_sec, m);
+}
+#else
+struct tm *
+wraptime_localtime_r (void *tv, struct tm *m)
+{
+  return m;
+}
+#endif
+
+/* wraptime_GetYear returns the year from the structure, m.  */
+
+unsigned int
+wraptime_GetYear (struct tm *m)
+{
+  return m->tm_year;
+}
+
+/* wraptime_GetMonth returns the month from the structure, m.  */
+
+unsigned int
+wraptime_GetMonth (struct tm *m)
+{
+  return m->tm_mon;
+}
+
+/* wraptime_GetDay returns the day of the month from the structure, m.  */
+
+unsigned int
+wraptime_GetDay (struct tm *m)
+{
+  return m->tm_mday;
+}
+
+/* wraptime_GetHour returns the hour of the day from the structure, m.  */
+
+unsigned int
+wraptime_GetHour (struct tm *m)
+{
+  return m->tm_hour;
+}
+
+/* wraptime_GetMinute returns the minute within the hour from the structure, m.  */
+
+unsigned int
+wraptime_GetMinute (struct tm *m)
+{
+  return m->tm_min;
+}
+
+/* wraptime_GetSecond returns the seconds in the minute from the
+   structure, m.  The return value will always be in the range 0..59.
+   A leap minute of value 60 will be truncated to 59.  */
+
+unsigned int
+wraptime_GetSecond (struct tm *m)
+{
+  if (m->tm_sec == 60)
+    return 59;
+  else
+    return m->tm_sec;
+}
+
+/* wraptime_GetSummerTime returns true if summer time is in effect.  */
+
+unsigned int
+wraptime_GetSummerTime (struct timezone *tz)
+{
+  return tz->tz_dsttime != 0;
+}
+
+/* wraptime_GetDST returns the number of minutes west of GMT.  */
+
+int
+wraptime_GetDST (struct timezone *tz)
+{
+  return tz->tz_minuteswest;
+}
+
+/* SetTimezone set the timezone field inside timeval, tv.  */
+
+void
+wraptime_SetTimezone (struct timezone *tz,
+		      int zone, int minuteswest)
+{
+  tz->tz_dsttime = zone;
+  tz->tz_minuteswest = minuteswest;
+}
+
+/* SetTimeval sets the fields in tm, t, with:
+   second, minute, hour, day, month, year, fractions.  */
+
+#if defined(HAVE_TIMEVAL)
+void
+wraptime_SetTimeval (struct tm *t,
+		     unsigned int second,
+		     unsigned int minute,
+		     unsigned int hour,
+		     unsigned int day,
+		     unsigned int month,
+		     unsigned int year,
+		     unsigned int yday,
+		     unsigned int wday,
+		     unsigned int isdst)
+{
+  t->tm_sec = second;
+  t->tm_min = minute;
+  t->tm_hour = hour;
+  t->tm_mday = day;
+  t->tm_mon = month;
+  t->tm_year = year;
+  t->tm_yday = yday;
+  t->tm_wday = wday;
+  t->tm_isdst = isdst;
+}
+#else
+wraptime_SetTimeval (void *t,
+		     unsigned int second,
+		     unsigned int minute,
+		     unsigned int hour,
+		     unsigned int day,
+		     unsigned int month,
+		     unsigned int year,
+		     unsigned int yday,
+		     unsigned int wday,
+		     unsigned int isdst)
+{
+  return t;
+}
+#endif
+
+/* init/finish functions for the module.  */
+
+void
+_M2_wraptime_init ()
+{}
+
+void
+_M2_wraptime_finish ()
+{}
diff --git a/gcc/m2/gm2-libs-iso/wraptime.def b/gcc/m2/gm2-libs-iso/wraptime.def
new file mode 100644
index 00000000000..9a31b3ed0a0
--- /dev/null
+++ b/gcc/m2/gm2-libs-iso/wraptime.def
@@ -0,0 +1,207 @@
+(* wraptime.def provides access to time primitives.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE wraptime ;
+
+(*
+    Title      : wraptime
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Sun Mar  1 21:41:29 2009
+    Revision   : $Version$ 
+    Description: provides an interface to various time related
+                 entities on the underlying host operating system.
+                 It provides access to the glibc/libc functions:
+                 gettimeofday, settimeofday and localtime_r.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   timeval  = ADDRESS ;
+   timezone = ADDRESS ;
+   tm       = ADDRESS ;
+
+
+(*
+   InitTimeval - returns a newly created opaque type.
+*)
+
+PROCEDURE InitTimeval () : timeval ;
+
+
+(*
+   KillTimeval - deallocates the memory associated with an
+                 opaque type.
+*)
+
+PROCEDURE KillTimeval (tv: timeval) : timeval ;
+
+
+(*
+   InitTimezone - returns a newly created opaque type.
+*)
+
+PROCEDURE InitTimezone () : timezone ;
+
+
+(*
+   KillTimezone - deallocates the memory associated with an
+                  opaque type.
+*)
+
+PROCEDURE KillTimezone (tv: timezone) : timezone ;
+
+
+(*
+   InitTM - returns a newly created opaque type.
+*)
+
+PROCEDURE InitTM () : tm ;
+
+
+(*
+   KillTM - deallocates the memory associated with an
+            opaque type.
+*)
+
+PROCEDURE KillTM (tv: tm) : tm ;
+
+
+(*
+   gettimeofday - calls gettimeofday(2) with the same parameters, tv,
+                  and, tz.  It returns 0 on success.
+*)
+
+PROCEDURE gettimeofday (tv: timeval; tz: timezone) : INTEGER ;
+
+
+(*
+   settimeofday - calls settimeofday(2) with the same parameters, tv,
+                  and, tz.  It returns 0 on success.
+*)
+
+PROCEDURE settimeofday (tv: timeval; tz: timezone) : INTEGER ;
+
+
+(*
+   GetFractions - returns the tv_usec field inside the timeval structure
+                  as a CARDINAL.
+*)
+
+PROCEDURE GetFractions (tv: timeval) : CARDINAL ;
+
+
+(*
+   localtime_r - returns the tm parameter, m, after it has been assigned with
+                 appropriate contents determined by, tv.  Notice that
+                 this procedure function expects, timeval, as its first
+                 parameter and not a time_t (as expected by the posix
+                 equivalent).  This avoids having to expose a time_t
+                 system dependant definition.
+*)
+
+PROCEDURE localtime_r (tv: timeval; m: tm) : tm ;
+
+
+(*
+   GetYear - returns the year from the structure, m.
+*)
+
+PROCEDURE GetYear (m: tm) : CARDINAL ;
+
+
+(*
+   GetMonth - returns the month from the structure, m.
+*)
+
+PROCEDURE GetMonth (m: tm) : CARDINAL ;
+
+
+(*
+   GetDay - returns the day of the month from the structure, m.
+*)
+
+PROCEDURE GetDay (m: tm) : CARDINAL ;
+
+
+(*
+   GetHour - returns the hour of the day from the structure, m.
+*)
+
+PROCEDURE GetHour (m: tm) : CARDINAL ;
+
+
+(*
+   GetMinute - returns the minute within the hour from the structure, m.
+*)
+
+PROCEDURE GetMinute (m: tm) : CARDINAL ;
+
+
+(*
+   GetSecond - returns the seconds in the minute from the structure, m.
+               The return value will always be in the range 0..59.
+               A leap minute of value 60 will be truncated to 59.
+*)
+
+PROCEDURE GetSecond (m: tm) : CARDINAL ;
+
+
+(*
+   GetSummerTime - returns a boolean indicating whether summer time is
+                   set.
+*)
+
+PROCEDURE GetSummerTime (tz: timezone) : BOOLEAN ;
+
+
+(*
+   GetDST - returns the number of minutes west of GMT.
+*)
+
+PROCEDURE GetDST (tz: timezone) : INTEGER ;
+
+
+(*
+   SetTimeval - sets the fields in timeval, tv, with:
+                second, minute, hour, day, month, year, fractions.
+*)
+
+PROCEDURE SetTimeval (tv: timeval;
+                      second, minute, hour, day,
+                      month, year, yday, wday, isdst: CARDINAL) ;
+
+
+(*
+   SetTimezone - set the timezone field inside timeval, tv.
+*)
+
+PROCEDURE SetTimezone (tv: timeval;
+                       zone: CARDINAL; minuteswest: INTEGER) ;
+
+
+END wraptime.
diff --git a/gcc/m2/gm2-libs-min/M2RTS.def b/gcc/m2/gm2-libs-min/M2RTS.def
new file mode 100644
index 00000000000..e3e13b7b554
--- /dev/null
+++ b/gcc/m2/gm2-libs-min/M2RTS.def
@@ -0,0 +1,52 @@
+(* M2RTS.def implement the smallest number of routines for linking.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE M2RTS ;
+
+(* Implement the smallest number of routines to enable GNU Modula-2
+   to link an executable (possibly targetting tiny embedded systems).  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+(*
+   all these procedures do nothing except satisfy the linker.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE ExecuteTerminationProcedures ;
+PROCEDURE ExecuteInitialProcedures ;
+PROCEDURE HALT ;
+PROCEDURE NoException (filename: ADDRESS;
+                       line, column: CARDINAL; scope, message: ADDRESS) ;
+
+
+END M2RTS.
diff --git a/gcc/m2/gm2-libs-min/M2RTS.mod b/gcc/m2/gm2-libs-min/M2RTS.mod
new file mode 100644
index 00000000000..643156d3101
--- /dev/null
+++ b/gcc/m2/gm2-libs-min/M2RTS.mod
@@ -0,0 +1,79 @@
+(* M2RTS.mod implement the smallest number of routines for linking.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE M2RTS ;
+
+IMPORT libc, SYSTEM ;
+(* we reference these to ensure they are dragged in to the link *)
+
+
+(* all these procedures do nothing except satisfy the linker.  *)
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+END ExecuteTerminationProcedures ;
+
+
+PROCEDURE ExecuteInitialProcedures ;
+BEGIN
+END ExecuteInitialProcedures ;
+
+
+PROCEDURE HALT ;
+BEGIN
+END HALT ;
+
+
+PROCEDURE NoException (filename: ADDRESS;
+                       line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+END NoException ;
+
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+END RequestDependant ;
+
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+BEGIN
+END ConstructModules ;
+
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+BEGIN
+END DeconstructModules ;
+
+
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+BEGIN
+END RegisterModule ;
+
+END M2RTS.
diff --git a/gcc/m2/gm2-libs-min/SYSTEM.def b/gcc/m2/gm2-libs-min/SYSTEM.def
new file mode 100644
index 00000000000..2c517a9a79b
--- /dev/null
+++ b/gcc/m2/gm2-libs-min/SYSTEM.def
@@ -0,0 +1,45 @@
+(* SYSTEM.def a minimal SYSTEM module.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE SYSTEM ;
+
+EXPORT QUALIFIED BITSPERBYTE, BYTESPERWORD,
+                 ADDRESS, WORD, BYTE, CSIZE_T, CSSIZE_T, (* @SYSTEM_DATATYPES@ *)
+                 ADR, TSIZE ;
+                 (* SIZE is also exported if -fpim2 is used *)
+
+CONST
+  BITSPERBYTE   = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
+  BYTESPERWORD  = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
+
+
+(* all the following types are declared internally to gm2
+TYPE
+   @SYSTEM_TYPES@
+*)
+
+
+END SYSTEM.
diff --git a/gcc/m2/gm2-libs-min/SYSTEM.mod b/gcc/m2/gm2-libs-min/SYSTEM.mod
new file mode 100644
index 00000000000..9fe474f03f4
--- /dev/null
+++ b/gcc/m2/gm2-libs-min/SYSTEM.mod
@@ -0,0 +1,29 @@
+(* SYSTEM.mod a minimal SYSTEM module.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SYSTEM ;
+
+END SYSTEM.
diff --git a/gcc/m2/gm2-libs-min/libc.c b/gcc/m2/gm2-libs-min/libc.c
new file mode 100644
index 00000000000..b39bfffb65c
--- /dev/null
+++ b/gcc/m2/gm2-libs-min/libc.c
@@ -0,0 +1,40 @@
+/* libc.c provides minimal dummy routines for linking.
+
+Copyright (C) 2010-2021 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/>.  */
+
+void abort (int);
+void exit (int);
+
+void abort (int i)
+{
+  while (1)
+    ;
+}
+
+void exit (int i)
+{
+  while (1)
+    ;
+}
diff --git a/gcc/m2/gm2-libs-min/libc.def b/gcc/m2/gm2-libs-min/libc.def
new file mode 100644
index 00000000000..96d9cc976ea
--- /dev/null
+++ b/gcc/m2/gm2-libs-min/libc.def
@@ -0,0 +1,35 @@
+(* libc.def provides a minimal interface to libc.c.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" libc ;
+
+EXPORT UNQUALIFIED abort, exit, printf ;
+
+PROCEDURE abort (i: INTEGER) ;
+PROCEDURE exit (i: INTEGER) ;
+PROCEDURE printf (s: ARRAY OF CHAR; ...) : [INTEGER] ;
+
+END libc.
diff --git a/gcc/m2/gm2-libs-pim/BitBlockOps.def b/gcc/m2/gm2-libs-pim/BitBlockOps.def
new file mode 100644
index 00000000000..cce2d48e788
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/BitBlockOps.def
@@ -0,0 +1,132 @@
+(* BitBlockOps.def provides a Logitech compatible module.
+
+Copyright (C) 2007-2021 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/>.  *)
+
+DEFINITION MODULE BitBlockOps ;
+
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   BlockAnd - performs a bitwise AND on blocks
+              [dest..dest+size-1] := [dest..dest+size-1] AND
+                                     [src..src+size-1]
+*)
+
+PROCEDURE BlockAnd (dest, src: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   BlockOr - performs a bitwise OR on blocks
+             [dest..dest+size-1] := [dest..dest+size-1] OR
+                                    [src..src+size-1]
+*)
+
+PROCEDURE BlockOr (dest, src: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   BlockXor - performs a bitwise XOR on blocks
+              [dest..dest+size-1] := [dest..dest+size-1] XOR
+                                     [src..src+size-1]
+*)
+
+PROCEDURE BlockXor (dest, src: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   BlockNot - performs a bitsize NOT on the block as defined
+              by:  [dest..dest+size-1]
+*)
+
+PROCEDURE BlockNot (dest: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   BlockShr - performs a block shift right of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is shifted, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness SHIFT use
+              the SYSTEM.SHIFT procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+PROCEDURE BlockShr (dest: ADDRESS; size, count: CARDINAL) ;
+
+
+(*
+   BlockShl - performs a block shift left of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is shifted, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness SHIFT use
+              the SYSTEM.SHIFT procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+PROCEDURE BlockShl (dest: ADDRESS; size, count: CARDINAL) ;
+
+
+(*
+   BlockRor - performs a block rotate right of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is rotated, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness ROTATE use
+              the SYSTEM.ROTATE procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+PROCEDURE BlockRor (dest: ADDRESS; size, count: CARDINAL) ;
+
+
+(*
+   BlockRol - performs a block rotate left of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is rotated, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness ROTATE use
+              the SYSTEM.ROTATE procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+PROCEDURE BlockRol (dest: ADDRESS; size, count: CARDINAL) ;
+
+
+END BitBlockOps.
diff --git a/gcc/m2/gm2-libs-pim/BitBlockOps.mod b/gcc/m2/gm2-libs-pim/BitBlockOps.mod
new file mode 100644
index 00000000000..9544d34574c
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/BitBlockOps.mod
@@ -0,0 +1,303 @@
+(* BitBlockOps.mod provides a Logitech compatible module.
+
+Copyright (C) 2007-2021 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/>.  *)
+
+IMPLEMENTATION MODULE BitBlockOps ;
+
+
+FROM SYSTEM IMPORT BITSPERBYTE, SHIFT, BYTE, BITSET8, TSIZE ;
+FROM Builtins IMPORT memmove, memset ;
+
+TYPE
+   ptrToByte = POINTER TO BITSET8 ;
+   ptrToBitset = POINTER TO BITSET ;
+
+
+(*
+   BlockAnd - performs a bitwise AND on blocks
+              [dest..dest+size-1] := [dest..dest+size-1] AND
+                                     [src..src+size-1]
+*)
+
+PROCEDURE BlockAnd (dest, src: ADDRESS; size: CARDINAL) ;
+VAR
+   bitsetDest, bitsetSrc: ptrToBitset ;
+   byteDest, byteSrc    : ptrToByte ;
+BEGIN
+   bitsetDest := dest ;
+   bitsetSrc  := src ;
+   WHILE size > TSIZE (BITSET) DO
+      bitsetDest^ := bitsetDest^ * bitsetSrc^ ;
+      INC (bitsetDest, TSIZE (BITSET)) ;
+      INC (bitsetSrc, TSIZE (BITSET)) ;
+      DEC (size, TSIZE (BITSET))
+   END ;
+   byteDest := VAL (ptrToByte, bitsetDest) ;
+   byteSrc  := VAL (ptrToByte, bitsetSrc) ;
+   WHILE size > 0 DO
+      byteDest^ := byteDest^ * byteSrc^ ;
+      INC(byteDest) ;
+      INC(byteSrc) ;
+      DEC(size)
+   END
+END BlockAnd ;
+
+
+(*
+   BlockOr - performs a bitwise OR on blocks
+             [dest..dest+size-1] := [dest..dest+size-1] OR
+                                    [src..src+size-1]
+*)
+
+PROCEDURE BlockOr (dest, src: ADDRESS; size: CARDINAL) ;
+VAR
+   bitsetDest, bitsetSrc: ptrToBitset ;
+   byteDest, byteSrc    : ptrToByte ;
+BEGIN
+   bitsetDest := dest ;
+   bitsetSrc  := src ;
+   WHILE size > TSIZE (BITSET) DO
+      bitsetDest^ := bitsetDest^ + bitsetSrc^ ;
+      INC (bitsetDest, TSIZE (BITSET)) ;
+      INC (bitsetSrc, TSIZE (BITSET)) ;
+      DEC (size, TSIZE (BITSET))
+   END ;
+   byteDest := VAL (ptrToByte, bitsetDest) ;
+   byteSrc  := VAL (ptrToByte, bitsetSrc) ;
+   WHILE size > 0 DO
+      byteDest^ := byteDest^ + byteSrc^ ;
+      INC (byteDest) ;
+      INC (byteSrc) ;
+      DEC (size)
+   END
+END BlockOr ;
+
+
+(*
+   BlockXor - performs a bitwise XOR on blocks
+              [dest..dest+size-1] := [dest..dest+size-1] XOR
+                                     [src..src+size-1]
+*)
+
+PROCEDURE BlockXor (dest, src: ADDRESS; size: CARDINAL) ;
+VAR
+   bitsetDest, bitsetSrc: ptrToBitset ;
+   byteDest, byteSrc    : ptrToByte ;
+BEGIN
+   bitsetDest := dest ;
+   bitsetSrc  := src ;
+   WHILE size>TSIZE(BITSET) DO
+      bitsetDest^ := bitsetDest^ - bitsetSrc^ ;
+      INC(bitsetDest, TSIZE(BITSET)) ;
+      INC(bitsetSrc, TSIZE(BITSET)) ;
+      DEC(size, TSIZE(BITSET))
+   END ;
+   byteDest := VAL(ptrToByte, bitsetDest) ;
+   byteSrc  := VAL(ptrToByte, bitsetSrc) ;
+   WHILE size>0 DO
+      byteDest^ := byteDest^ - byteSrc^ ;
+      INC(byteDest) ;
+      INC(byteSrc) ;
+      DEC(size)
+   END
+END BlockXor ;
+
+
+(*
+   BlockNot - performs a bitsize NOT on the block as defined
+              by:  [dest..dest+size-1]
+*)
+
+PROCEDURE BlockNot (dest: ADDRESS; size: CARDINAL) ;
+VAR
+   bitsetDest: ptrToBitset ;
+   byteDest  : ptrToByte ;
+BEGIN
+   bitsetDest := dest ;
+   WHILE size>TSIZE(BITSET) DO
+      bitsetDest^ := -bitsetDest^ ;
+      INC(bitsetDest, TSIZE(BITSET)) ;
+      DEC(size, TSIZE(BITSET))
+   END ;
+   byteDest := VAL(ptrToByte, bitsetDest) ;
+   WHILE size>0 DO
+      byteDest^ := - byteDest^ ;
+      INC (byteDest) ;
+      DEC (size)
+   END
+END BlockNot ;
+
+
+(*
+   BlockShr - performs a block shift right of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is shifted, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness SHIFT use
+              the SYSTEM.SHIFT procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+PROCEDURE BlockShr (dest: ADDRESS; size, count: CARDINAL) ;
+VAR
+   p         : ptrToByte ;
+   carry,
+   hi, lo    : BITSET8 ;
+   byteOffset,
+   bitOffset : CARDINAL ;
+BEGIN
+   byteOffset := count DIV BITSPERBYTE ;
+   IF byteOffset >= size
+   THEN
+      (* shifted all data out, nothing left *)
+      p := dest ;
+      dest := memset (p, 0, size)
+   ELSE
+      bitOffset := count MOD BITSPERBYTE ;
+      IF byteOffset > 0
+      THEN
+         (* move whole bytes using memmove *)
+         p := dest ;
+         dest := memmove (dest, dest+VAL(ADDRESS, byteOffset), size-byteOffset) ;
+         (* zero leading bytes *)
+         dest := memset (p, 0, byteOffset)
+      END ;
+      IF bitOffset > 0
+      THEN
+         (* some real shifting is necessary *)
+         p := dest + VAL (ADDRESS, byteOffset) ;
+         hi := BITSET8 {} ;
+         WHILE size>byteOffset DO
+            lo := SHIFT (p^, -bitOffset) ;
+            carry := SHIFT (p^, BITSPERBYTE - bitOffset) ;
+            p^ := lo + hi ;
+            INC (p) ;
+            hi := carry ;
+            DEC (size)
+         END
+      END
+   END
+END BlockShr ;
+
+
+(*
+   BlockShl - performs a block shift left of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is shifted, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness SHIFT use
+              the SYSTEM.SHIFT procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+PROCEDURE BlockShl (dest: ADDRESS; size, count: CARDINAL) ;
+VAR
+   p         : ptrToByte ;
+   carry,
+   hi, lo    : BITSET8 ;
+   byteOffset,
+   bitOffset : CARDINAL ;
+BEGIN
+   byteOffset := count DIV BITSPERBYTE ;
+   IF byteOffset>=size
+   THEN
+      (* shifted all data out, nothing left *)
+      p := dest ;
+      dest := memset(p, 0, size)
+   ELSE
+      bitOffset := count MOD BITSPERBYTE ;
+      IF byteOffset>0
+      THEN
+         (* move whole bytes using memmove *)
+         p := dest ;
+         dest := memmove (dest, dest + VAL (ADDRESS, byteOffset), size - byteOffset) ;
+         (* zero leading bytes *)
+         dest := memset (p, 0, byteOffset)
+      END ;
+      IF bitOffset>0
+      THEN
+         (* some real shifting is necessary *)
+         p := dest + VAL (ADDRESS, byteOffset) ;
+         hi := BITSET8 {} ;
+         WHILE size > byteOffset DO
+            lo := SHIFT (p^, -bitOffset) ;
+            carry := SHIFT (p^, (BITSPERBYTE - bitOffset)) ;
+            p^ := lo + hi ;
+            INC (p) ;
+            hi := carry ;
+            DEC (size)
+         END
+      END
+   END
+END BlockShl ;
+
+
+(*
+   BlockRor - performs a block rotate right of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is shifted, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness ROTATE use
+              the SYSTEM.ROTATE procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+PROCEDURE BlockRor (dest: ADDRESS; size, count: CARDINAL) ;
+BEGIN
+   (* not yet implemented *)
+   HALT
+END BlockRor ;
+
+
+(*
+   BlockRol - performs a block rotate left of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is shifted, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness ROTATE use
+              the SYSTEM.ROTATE procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+PROCEDURE BlockRol (dest: ADDRESS; size, count: CARDINAL) ;
+BEGIN
+   (* not yet implemented *)
+   HALT
+END BlockRol ;
+
+
+END BitBlockOps.
diff --git a/gcc/m2/gm2-libs-pim/BitByteOps.def b/gcc/m2/gm2-libs-pim/BitByteOps.def
new file mode 100644
index 00000000000..9a554e956b9
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/BitByteOps.def
@@ -0,0 +1,143 @@
+(* BitByteOps.def provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2007-2021 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/>.  *)
+
+DEFINITION MODULE BitByteOps ;
+
+FROM SYSTEM IMPORT BYTE ;
+
+
+(*
+   GetBits - returns the bits firstBit..lastBit from source.
+             Bit 0 of byte maps onto the firstBit of source.
+*)
+
+PROCEDURE GetBits (source: BYTE; firstBit, lastBit: CARDINAL) : BYTE ;
+
+
+(*
+   SetBits - sets bits in, byte, starting at, firstBit, and ending at,
+             lastBit, with, pattern.  The bit zero of, pattern, will
+             be placed into, byte, at position, firstBit.
+*)
+
+PROCEDURE SetBits (VAR byte: BYTE; firstBit, lastBit: CARDINAL;
+                   pattern: BYTE) ;
+
+
+(*
+   ByteAnd - returns a bitwise (left AND right)
+*)
+
+PROCEDURE ByteAnd (left, right: BYTE) : BYTE ;
+
+
+(*
+   ByteOr - returns a bitwise (left OR right)
+*)
+
+PROCEDURE ByteOr (left, right: BYTE) : BYTE ;
+
+
+(*
+   ByteXor - returns a bitwise (left XOR right)
+*)
+
+PROCEDURE ByteXor (left, right: BYTE) : BYTE ;
+
+
+(*
+   ByteNot - returns a byte with all bits inverted.
+*)
+
+PROCEDURE ByteNot (byte: BYTE) : BYTE ;
+
+
+(*
+   ByteShr - returns a, byte, which has been shifted, count
+             bits to the right.
+*)
+
+PROCEDURE ByteShr (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   ByteShl - returns a, byte, which has been shifted, count
+             bits to the left.
+*)
+
+PROCEDURE ByteShl (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   ByteSar - shift byte arthemetic right.  Preserves the top
+             end bit and as the value is shifted right.
+*)
+
+PROCEDURE ByteSar (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   ByteRor - returns a, byte, which has been rotated, count
+             bits to the right.
+*)
+
+PROCEDURE ByteRor (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   ByteRol - returns a, byte, which has been rotated, count
+             bits to the left.
+*)
+
+PROCEDURE ByteRol (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   HighNibble - returns the top nibble only from, byte.
+                The top nibble of, byte, is extracted and
+                returned in the bottom nibble of the return
+                value.
+*)
+
+PROCEDURE HighNibble (byte: BYTE) : BYTE ;
+
+
+(*
+   LowNibble - returns the low nibble only from, byte.
+               The top nibble is replaced by zeros.
+*)
+
+PROCEDURE LowNibble (byte: BYTE) : BYTE ;
+
+
+(*
+   Swap - swaps the low and high nibbles in the, byte.
+*)
+
+PROCEDURE Swap (byte: BYTE) : BYTE ;
+
+
+END BitByteOps.
diff --git a/gcc/m2/gm2-libs-pim/BitByteOps.mod b/gcc/m2/gm2-libs-pim/BitByteOps.mod
new file mode 100644
index 00000000000..b461e125072
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/BitByteOps.mod
@@ -0,0 +1,227 @@
+(* BitByteOps.mod provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2007-2021 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/>.  *)
+
+IMPLEMENTATION MODULE BitByteOps ;
+
+FROM SYSTEM IMPORT BYTE, ADR, SHIFT, ROTATE, TSIZE, BITSET8, CARDINAL8 ;
+
+
+(*
+   GetBits - returns the bits firstBit..lastBit from source.
+             Bit 0 of byte maps onto the firstBit of source.
+*)
+
+PROCEDURE GetBits (source: BYTE; firstBit, lastBit: CARDINAL) : BYTE ;
+VAR
+   si  : CARDINAL8 ;
+   sb  : BITSET8 ;
+   mask: BITSET8 ;
+   i   : CARDINAL ;
+BEGIN
+   sb := VAL (BITSET8, source) ;
+   mask := BITSET8 {} ;
+   FOR i := firstBit TO lastBit DO
+      INCL (mask, i)
+   END ;
+   sb := VAL (BITSET8, source) * mask ;
+   i := 1 ;
+   WHILE firstBit > 0 DO
+      DEC (firstBit) ;
+      i := i*2
+   END ;
+   si := VAL (CARDINAL8, sb) ;
+   RETURN VAL (BYTE, si DIV VAL (CARDINAL8, i))
+END GetBits ;
+
+
+(*
+   SetBits - sets bits in, byte, starting at, firstBit, and ending at,
+             lastBit, with, pattern.  The bit zero of, pattern, will
+             be placed into, byte, at position, firstBit.
+*)
+
+PROCEDURE SetBits (VAR byte: BYTE; firstBit, lastBit: CARDINAL;
+                   pattern: BYTE) ;
+VAR
+   pb, pp: BITSET8 ;
+   i, j  : CARDINAL ;
+BEGIN
+   pb := VAL (BITSET8, byte) ;
+   pp := VAL (BITSET8, pattern) ;
+   j := 0 ;
+   FOR i := firstBit TO lastBit DO
+      IF j IN pp
+      THEN
+         INCL (pb, i)
+      ELSE
+         EXCL (pb, i)
+      END ;
+      INC (j)
+   END ;
+   byte := VAL (BYTE, pb)
+END SetBits ;
+
+
+(*
+   ByteAnd - returns a bitwise (left AND right)
+*)
+
+PROCEDURE ByteAnd (left, right: BYTE) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, VAL (BITSET8, left) * VAL (BITSET8, right))
+END ByteAnd ;
+
+
+(*
+   ByteOr - returns a bitwise (left OR right)
+*)
+
+PROCEDURE ByteOr (left, right: BYTE) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, VAL (BITSET8, left) + VAL (BITSET8, right))
+END ByteOr ;
+
+
+(*
+   ByteXor - returns a bitwise (left XOR right)
+*)
+
+PROCEDURE ByteXor (left, right: BYTE) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, VAL (BITSET8, left) DIV VAL (BITSET8, right))
+END ByteXor ;
+
+
+(*
+   ByteNot - returns a byte with all bits inverted.
+*)
+
+PROCEDURE ByteNot (byte: BYTE) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, -VAL (BITSET8, byte))
+END ByteNot ;
+
+
+(*
+   ByteShr - returns a, byte, which has been shifted, count
+             bits to the right.
+*)
+
+PROCEDURE ByteShr (byte: BYTE; count: CARDINAL) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, SHIFT (VAL (BITSET8, byte), count))
+END ByteShr ;
+
+
+(*
+   ByteShl - returns a, byte, which has been shifted, count
+             bits to the left.
+*)
+
+PROCEDURE ByteShl (byte: BYTE; count: CARDINAL) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, SHIFT (VAL (BITSET8, byte), -VAL (INTEGER, count)))
+END ByteShl ;
+
+
+(*
+   ByteSar - shift byte arthemetic right.  Preserves the top
+             end bit as the value is shifted right.
+*)
+
+PROCEDURE ByteSar (byte: BYTE; count: CARDINAL) : BYTE ;
+VAR
+   b: BYTE ;
+BEGIN
+   IF MAX(BITSET8) IN VAL(BITSET8, byte)
+   THEN
+      b := VAL (BYTE, SHIFT (VAL (BITSET8, byte), count) + BITSET8 {MAX (BITSET8)}) ;
+      RETURN b
+   ELSE
+      RETURN VAL (BYTE, SHIFT (VAL (BITSET8, byte), count))
+   END
+END ByteSar ;
+
+
+(*
+   ByteRor - returns a, byte, which has been rotated, count
+             bits to the right.
+*)
+
+PROCEDURE ByteRor (byte: BYTE; count: CARDINAL) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, ROTATE (VAL (BITSET8, byte), count))
+END ByteRor ;
+
+
+(*
+   ByteRol - returns a, byte, which has been rotated, count
+             bits to the left.
+*)
+
+PROCEDURE ByteRol (byte: BYTE; count: CARDINAL) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, ROTATE (VAL (BITSET8, byte), -VAL (INTEGER, count)))
+END ByteRol ;
+
+
+(*
+   HighHibble - returns the top nibble only from, byte,
+                in the lowest nibble position.
+*)
+
+PROCEDURE HighNibble (byte: BYTE) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, VAL (CARDINAL8, byte) DIV 16)
+END HighNibble ;
+
+
+(*
+   LowNibble - returns the low nibble only from, byte.
+               The top nibble is replaced by zeros.
+*)
+
+PROCEDURE LowNibble (byte: BYTE) : BYTE ;
+BEGIN
+   RETURN VAL (BYTE, VAL (BITSET8, byte) * BITSET8 {0..3})
+END LowNibble ;
+
+
+(*
+   Swap - swaps the low and high nibbles in the, byte.
+*)
+
+PROCEDURE Swap (byte: BYTE) : BYTE ;
+BEGIN
+   RETURN VAL(BYTE,
+              VAL(BITSET8, VAL (CARDINAL8,
+                                VAL (BITSET8, byte) *
+                                BITSET8 {4..7}) DIV 16) +
+              VAL(BITSET8, byte) * BITSET8 {0..3})
+END Swap ;
+
+
+END BitByteOps.
diff --git a/gcc/m2/gm2-libs-pim/BitWordOps.def b/gcc/m2/gm2-libs-pim/BitWordOps.def
new file mode 100644
index 00000000000..d083736d6ed
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/BitWordOps.def
@@ -0,0 +1,143 @@
+(* BitWordOps.def provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2007-2021 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/>.  *)
+
+DEFINITION MODULE BitWordOps ;
+
+FROM SYSTEM IMPORT WORD ;
+
+
+(*
+   GetBits - returns the bits firstBit..lastBit from source.
+             Bit 0 of word maps onto the firstBit of source.
+*)
+
+PROCEDURE GetBits (source: WORD; firstBit, lastBit: CARDINAL) : WORD ;
+
+
+(*
+   SetBits - sets bits in, word, starting at, firstBit, and ending at,
+             lastBit, with, pattern.  The bit zero of, pattern, will
+             be placed into, word, at position, firstBit.
+*)
+
+PROCEDURE SetBits (VAR word: WORD; firstBit, lastBit: CARDINAL;
+                   pattern: WORD) ;
+
+
+(*
+   WordAnd - returns a bitwise (left AND right)
+*)
+
+PROCEDURE WordAnd (left, right: WORD) : WORD ;
+
+
+(*
+   WordOr - returns a bitwise (left OR right)
+*)
+
+PROCEDURE WordOr (left, right: WORD) : WORD ;
+
+
+(*
+   WordXor - returns a bitwise (left XOR right)
+*)
+
+PROCEDURE WordXor (left, right: WORD) : WORD ;
+
+
+(*
+   WordNot - returns a word with all bits inverted.
+*)
+
+PROCEDURE WordNot (word: WORD) : WORD ;
+
+
+(*
+   WordShr - returns a, word, which has been shifted, count
+             bits to the right.
+*)
+
+PROCEDURE WordShr (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   WordShl - returns a, word, which has been shifted, count
+             bits to the left.
+*)
+
+PROCEDURE WordShl (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   WordSar - shift word arthemetic right.  Preserves the top
+             end bit and as the value is shifted right.
+*)
+
+PROCEDURE WordSar (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   WordRor - returns a, word, which has been rotated, count
+             bits to the right.
+*)
+
+PROCEDURE WordRor (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   WordRol - returns a, word, which has been rotated, count
+             bits to the left.
+*)
+
+PROCEDURE WordRol (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   HighByte - returns the top byte only from, word.
+              The byte is returned in the bottom byte
+              in the return value.
+*)
+
+PROCEDURE HighByte (word: WORD) : WORD ;
+
+
+(*
+   LowByte - returns the low byte only from, word.
+             The byte is returned in the bottom byte
+             in the return value.
+*)
+
+PROCEDURE LowByte (word: WORD) : WORD ;
+
+
+(*
+   Swap - byte flips the contents of word.
+*)
+
+PROCEDURE Swap (word: WORD) : WORD ;
+
+
+END BitWordOps.
diff --git a/gcc/m2/gm2-libs-pim/BitWordOps.mod b/gcc/m2/gm2-libs-pim/BitWordOps.mod
new file mode 100644
index 00000000000..9c3ea429c10
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/BitWordOps.mod
@@ -0,0 +1,252 @@
+(* BitWordOps.mod provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2007-2021 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/>.  *)
+
+IMPLEMENTATION MODULE BitWordOps ;
+
+FROM SYSTEM IMPORT BYTE, ADR, SHIFT, ROTATE, TSIZE ;
+
+
+(*
+   GetBits - returns the bits firstBit..lastBit from source.
+             Bit 0 of word maps onto the firstBit of source.
+*)
+
+PROCEDURE GetBits (source: WORD; firstBit, lastBit: CARDINAL) : WORD ;
+VAR
+   si  : CARDINAL ;
+   sb  : BITSET ;
+   mask: BITSET ;
+   i   : CARDINAL ;
+BEGIN
+   sb := VAL (BITSET, source) ;
+   mask := {} ;
+   FOR i := firstBit TO lastBit DO
+      INCL (mask, i)
+   END ;
+   sb := VAL (BITSET, source) * mask ;
+   i := 1 ;
+   WHILE firstBit > 0 DO
+      DEC (firstBit) ;
+      i := i*2
+   END ;
+   si := VAL (CARDINAL, sb) ;
+   RETURN VAL (WORD, si DIV i)
+END GetBits ;
+
+
+(*
+   SetBits - sets bits in, word, starting at, firstBit, and ending at,
+             lastBit, with, pattern.  The bit zero of, pattern, will
+             be placed into, word, at position, firstBit.
+*)
+
+PROCEDURE SetBits (VAR word: WORD; firstBit, lastBit: CARDINAL;
+                   pattern: WORD) ;
+VAR
+   pw, pp: BITSET ;
+   i, j  : CARDINAL ;
+BEGIN
+   pw := VAL (BITSET, word) ;
+   pp := VAL (BITSET, pattern) ;
+   j := 0 ;
+   FOR i := firstBit TO lastBit DO
+      IF j IN pp
+      THEN
+         INCL (pw, i)
+      ELSE
+         EXCL (pw, i)
+      END ;
+      INC (j)
+   END ;
+   word := VAL (WORD, pw)
+END SetBits ;
+
+
+(*
+   WordAnd - returns a bitwise (left AND right)
+*)
+
+PROCEDURE WordAnd (left, right: WORD) : WORD ;
+BEGIN
+   RETURN VAL (WORD, VAL (BITSET, left) * VAL (BITSET, right))
+END WordAnd ;
+
+
+(*
+   WordOr - returns a bitwise (left OR right)
+*)
+
+PROCEDURE WordOr (left, right: WORD) : WORD ;
+BEGIN
+   RETURN VAL (WORD, VAL (BITSET, left) + VAL (BITSET, right))
+END WordOr ;
+
+
+(*
+   WordXor - returns a bitwise (left XOR right)
+*)
+
+PROCEDURE WordXor (left, right: WORD) : WORD ;
+BEGIN
+   RETURN VAL (WORD, VAL (BITSET, left) DIV VAL (BITSET, right))
+END WordXor ;
+
+
+(*
+   WordNot - returns a word with all bits inverted.
+*)
+
+PROCEDURE WordNot (word: WORD) : WORD ;
+BEGIN
+   RETURN VAL (WORD, -VAL (BITSET, word))
+END WordNot ;
+
+
+(*
+   WordShr - returns a, word, which has been shifted, count
+             bits to the right.
+*)
+
+PROCEDURE WordShr (word: WORD; count: CARDINAL) : WORD ;
+BEGIN
+   RETURN SHIFT (VAL (BITSET, word), count)
+END WordShr ;
+
+
+(*
+   WordShl - returns a, word, which has been shifted, count
+             bits to the left.
+*)
+
+PROCEDURE WordShl (word: WORD; count: CARDINAL) : WORD ;
+BEGIN
+   RETURN SHIFT (VAL (BITSET, word), -VAL (INTEGER, count))
+END WordShl ;
+
+
+(*
+   WordSar - shift word arthemetic right.  Preserves the top
+             end bit and as the value is shifted right.
+*)
+
+PROCEDURE WordSar (word: WORD; count: CARDINAL) : WORD ;
+VAR
+   w: WORD ;
+BEGIN
+   IF MAX (BITSET) IN VAL (BITSET, word)
+   THEN
+      w := VAL (WORD, SHIFT (VAL (BITSET, word), count)) ;
+      SetBits(w, MAX (BITSET) - count, MAX (BITSET), -BITSET{}) ;
+      RETURN w
+   ELSE
+      RETURN SHIFT(VAL(BITSET, word), count)
+   END
+END WordSar ;
+
+
+(*
+   WordRor - returns a, word, which has been rotated, count
+             bits to the right.
+*)
+
+PROCEDURE WordRor (word: WORD; count: CARDINAL) : WORD ;
+BEGIN
+   RETURN ROTATE (VAL (BITSET, word), count)
+END WordRor ;
+
+
+(*
+   WordRol - returns a, word, which has been rotated, count
+             bits to the left.
+*)
+
+PROCEDURE WordRol (word: WORD; count: CARDINAL) : WORD ;
+BEGIN
+   RETURN ROTATE (VAL (BITSET, word), -VAL (INTEGER, count))
+END WordRol ;
+
+
+(*
+   HighByte - returns the top byte only from, word.
+              The byte is returned in the bottom byte
+              in the return value.
+*)
+
+PROCEDURE HighByte (word: WORD) : WORD ;
+VAR
+   p, q  : POINTER TO ARRAY [0..TSIZE(WORD)-1] OF BYTE ;
+   result: WORD ;
+BEGIN
+   p := ADR (word) ;
+   q := ADR (result) ;
+   result := 0 ;
+   q^[0] := p^[TSIZE(WORD)-1] ;
+   RETURN result
+END HighByte ;
+
+
+(*
+   LowByte - returns the low byte only from, word.
+             The byte is returned in the bottom byte
+             in the return value.
+*)
+
+PROCEDURE LowByte (word: WORD) : WORD ;
+VAR
+   p, q  : POINTER TO ARRAY [0..TSIZE(WORD)-1] OF BYTE ;
+   result: WORD ;
+BEGIN
+   p := ADR (word) ;
+   q := ADR (result) ;
+   result := 0 ;
+   q^[0] := p^[0] ;
+   RETURN result
+END LowByte ;
+
+
+(*
+   Swap - byte flips the contents of word.
+*)
+
+PROCEDURE Swap (word: WORD) : WORD ;
+VAR
+   p   : POINTER TO ARRAY [0..TSIZE(WORD)-1] OF BYTE ;
+   i, j: CARDINAL ;
+   b   : BYTE ;
+BEGIN
+   p := ADR (word) ;
+   j := TSIZE (WORD)-1 ;
+   FOR i := 0 TO (TSIZE (WORD) DIV 2)-1 DO
+      b := p^[i] ;
+      p^[i] := p^[j] ;
+      p^[j] := b ;
+      DEC (j)
+   END ;
+   RETURN word
+END Swap ;
+
+
+END BitWordOps.
diff --git a/gcc/m2/gm2-libs-pim/BlockOps.def b/gcc/m2/gm2-libs-pim/BlockOps.def
new file mode 100644
index 00000000000..b78e1017818
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/BlockOps.def
@@ -0,0 +1,90 @@
+(* BlockOps.def provides a Logitech compatible module for block moves.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE BlockOps ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   MoveBlockForward - moves, n, bytes from, src, to, dest.
+                      Starts copying from src and keep copying
+                      until, n, bytes have been copied.
+*)
+
+PROCEDURE BlockMoveForward (dest, src: ADDRESS; n: CARDINAL) ;
+
+
+(*
+   MoveBlockBackward - moves, n, bytes from, src, to, dest.
+                       Starts copying from src+n and keeps copying
+                       until, n, bytes have been copied.
+                       The last datum to be copied will be the byte
+                       at address, src.
+*)
+
+PROCEDURE BlockMoveBackward (dest, src: ADDRESS; n: CARDINAL) ;
+
+
+(*
+   BlockClear - fills, block..block+n-1, with zero's.
+*)
+
+PROCEDURE BlockClear (block: ADDRESS; n: CARDINAL) ;
+
+
+(*
+   BlockSet - fills, n, bytes starting at, block, with a pattern
+              defined at address pattern..pattern+patternSize-1.
+*)
+
+PROCEDURE BlockSet (block: ADDRESS; n: CARDINAL;
+                    pattern: ADDRESS; patternSize: CARDINAL) ;
+
+
+(*
+   BlockEqual - returns TRUE if the blocks defined, a..a+n-1, and,
+                b..b+n-1 contain the same bytes.
+*)
+
+PROCEDURE BlockEqual (a, b: ADDRESS; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   BlockPosition - searches for a pattern as defined by
+                   pattern..patternSize-1 in the block,
+                   block..block+blockSize-1.  It returns
+                   the offset from block indicating the
+                   first occurence of, pattern.
+                   MAX(CARDINAL) is returned if no match
+                   is detected.
+*)
+
+PROCEDURE BlockPosition (block: ADDRESS; blockSize: CARDINAL;
+                         pattern: ADDRESS; patternSize: CARDINAL) : CARDINAL ;
+
+
+END BlockOps.
diff --git a/gcc/m2/gm2-libs-pim/BlockOps.mod b/gcc/m2/gm2-libs-pim/BlockOps.mod
new file mode 100644
index 00000000000..ac0a0b3f4e9
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/BlockOps.mod
@@ -0,0 +1,193 @@
+(* BlockOps.mod provides a Logitech compatible module for block moves.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+IMPLEMENTATION MODULE BlockOps ;
+
+FROM Builtins IMPORT memcpy, memmove, memset ;
+FROM SYSTEM IMPORT TSIZE, BYTE, WORD ;
+
+TYPE
+   ptrToByte = POINTER TO BYTE ;
+   ptrToWord = POINTER TO WORD ;
+
+
+(*
+   MoveBlockForward - moves, n, bytes from, src, to, dest.
+                      Starts copying from src and keep copying
+                      until, n, bytes have been copied.
+*)
+
+PROCEDURE BlockMoveForward (dest, src: ADDRESS; n: CARDINAL) ;
+BEGIN
+   IF ((src<=dest) AND (src+n>=dest)) OR
+      ((src>=dest) AND (src+n<=dest))
+   THEN
+      dest := memmove(dest, src, n)
+   ELSE
+      (* no overlap, use memcpy *)
+      dest := memcpy(dest, src, n)
+   END
+END BlockMoveForward ;
+
+
+(*
+   MoveBlockBackward - moves, n, bytes from, src, to, dest.
+                       Starts copying from src+n and keeps copying
+                       until, n, bytes have been copied.
+                       The last datum to be copied will be the byte
+                       at address, src.
+*)
+
+PROCEDURE BlockMoveBackward (dest, src: ADDRESS; n: CARDINAL) ;
+VAR
+   pbd, pbs: ptrToByte ;
+BEGIN
+   IF ((src<=dest) AND (src+n>=dest)) OR
+      ((src>=dest) AND (src+n<=dest))
+   THEN
+      dest := memmove(dest, src, n)
+   ELSE
+      (* copy byte by byte backwards *)
+      pbs := src+VAL(ADDRESS, n-TSIZE(BYTE)) ;
+      pbd := dest+VAL(ADDRESS, n-TSIZE(BYTE)) ;
+      WHILE n>0 DO
+         pbd^ := pbs^ ;
+         DEC(n) ;
+         DEC(pbd) ;
+         DEC(pbs)
+      END
+   END
+END BlockMoveBackward ;
+
+
+(*
+   BlockClear - fills, block..block+n-1, with zero's.
+*)
+
+PROCEDURE BlockClear (block: ADDRESS; n: CARDINAL) ;
+BEGIN
+   block := memset(block, 0, n)
+END BlockClear ;
+
+
+(*
+   BlockSet - fills, n, bytes starting at, block, with a pattern
+              defined at address pattern..pattern+patternSize-1.
+*)
+
+PROCEDURE BlockSet (block: ADDRESS; n: CARDINAL;
+                    pattern: ADDRESS; patternSize: CARDINAL) ;
+VAR
+   b: ADDRESS ;
+BEGIN
+   b := block ;
+   WHILE n>0 DO
+      block := memcpy(b, pattern, patternSize) ;
+      INC(b, patternSize) ;
+      DEC(n, patternSize)
+   END ;
+   IF n>0
+   THEN
+      block := memcpy(b, pattern, n)
+   END
+END BlockSet ;
+
+
+(*
+   BlockEqual - returns TRUE if the blocks defined, a..a+n-1, and,
+                b..b+n-1 contain the same bytes.
+*)
+
+PROCEDURE BlockEqual (a, b: ADDRESS; n: CARDINAL) : BOOLEAN ;
+VAR
+   pwa, pwb: ptrToWord ;
+   pba, pbb: ptrToByte ;
+BEGIN
+   pwa := a ;
+   pwb := b ;
+   WHILE n>=TSIZE(WORD) DO
+      IF pwa^#pwb^
+      THEN
+         RETURN FALSE
+      END ;
+      INC(pwa, TSIZE(WORD)) ;
+      INC(pwb, TSIZE(WORD)) ;
+      DEC(n, TSIZE(WORD))
+   END ;
+   (* and check any remaining bytes *)
+   pba := VAL(ptrToByte, pwa) ;
+   pbb := VAL(ptrToByte, pwb) ;
+   WHILE n>0 DO
+      IF pba^#pbb^
+      THEN
+         RETURN FALSE
+      END ;
+      INC(pba) ;
+      INC(pbb) ;
+      DEC(n)
+   END ;
+   RETURN TRUE
+END BlockEqual ;
+
+
+(*
+   BlockPosition - searches for a pattern as defined by
+                   pattern..patternSize-1 in the block,
+                   block..block+blockSize-1.  It returns
+                   the offset from block indicating the
+                   first occurence of, pattern.
+                   MAX(CARDINAL) is returned if no match
+                   is detected.
+*)
+
+PROCEDURE BlockPosition (block: ADDRESS; blockSize: CARDINAL;
+                         pattern: ADDRESS; patternSize: CARDINAL) : CARDINAL ;
+VAR
+   n, o    : CARDINAL ;
+   pba, pbb: ptrToByte ;
+BEGIN
+   o := 0 ;
+   pba := block ;
+   pbb := pattern ;
+   WHILE blockSize>0 DO
+      pbb := pattern ;
+      n := patternSize ;
+      WHILE n>0 DO
+         IF pbb^#pba^
+         THEN
+            RETURN o
+         END ;
+         INC(pba) ;
+         INC(pbb) ;
+         INC(o) ;
+         DEC(n)
+      END
+   END ;
+   RETURN MAX(CARDINAL)
+END BlockPosition ;
+
+
+END BlockOps.
diff --git a/gcc/m2/gm2-libs-pim/Break.c b/gcc/m2/gm2-libs-pim/Break.c
new file mode 100644
index 00000000000..6a0c77c79c8
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Break.c
@@ -0,0 +1,128 @@
+/* Break.c - access to the signal handler for catching control C.
+
+Copyright (C) 2004-2021 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 <stdio.h>
+#include <stdarg.h>
+#include "gm2-libs-host.h"
+
+#if defined(HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#include <malloc.h>
+#endif
+
+typedef void (*PROC) (void);
+
+#if defined(HAVE_SIGNAL_H)
+#include <signal.h>
+
+struct plist
+{
+  PROC proc;
+  struct plist *next;
+};
+
+static struct plist *head = NULL;
+
+/* localHandler - dismisses the parameter, p, and invokes the GNU
+   Modula-2 handler.  */
+
+static void
+localHandler (int p)
+{
+  if (head != NULL)
+    head->proc ();
+}
+
+/* EnableBreak - enable the current break handler.  */
+
+void
+Break_EnableBreak (void)
+{
+  signal (SIGINT, localHandler);
+}
+
+/* DisableBreak - disable the current break handler (and all
+   installed handlers).  */
+
+void
+Break_DisableBreak (void)
+{
+  signal (SIGINT, SIG_IGN);
+}
+
+/* InstallBreak - installs a procedure, p, to be invoked when a
+   ctrl-c is caught.  Any number of these procedures may be stacked.
+   Only the top procedure is run when ctrl-c is caught.  */
+
+void
+Break_InstallBreak (PROC p)
+{
+  struct plist *q = (struct plist *)malloc (sizeof (struct plist));
+
+  if (q == NULL)
+    {
+      perror ("out of memory error in module Break");
+      exit (1);
+    }
+  q->next = head;
+  head = q;
+  head->proc = p;
+}
+
+/* UnInstallBreak - pops the break handler stack.  */
+
+void
+Break_UnInstallBreak (void)
+{
+  struct plist *q = head;
+
+  if (head != NULL)
+    {
+      head = head->next;
+      free (q);
+    }
+}
+#else
+void
+Break_EnableBreak (void)
+{
+}
+void
+Break_DisableBreak (void)
+{
+}
+void
+Break_InstallBreak (PROC *p)
+{
+}
+void
+Break_UnInstallBreak (void)
+{
+}
+#endif
diff --git a/gcc/m2/gm2-libs-pim/Break.def b/gcc/m2/gm2-libs-pim/Break.def
new file mode 100644
index 00000000000..05ce0956495
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Break.def
@@ -0,0 +1,65 @@
+(* Break.def provides a Logitech compatible Break handler module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE Break ;
+
+
+EXPORT QUALIFIED EnableBreak, DisableBreak, InstallBreak, UnInstallBreak ;
+
+
+(*
+   EnableBreak - enable the current break handler.
+*)
+
+PROCEDURE EnableBreak ;
+
+
+(*
+   DisableBreak - disable the current break handler (and all
+                  installed handlers).
+*)
+
+PROCEDURE DisableBreak ;
+
+
+(*
+   InstallBreak - installs a procedure, p, to be invoked when
+                  a ctrl-c is caught. Any number of these
+                  procedures may be stacked. Only the top
+                  procedure is run when ctrl-c is caught.
+*)
+
+PROCEDURE InstallBreak (p: PROC) ;
+
+
+(*
+   UnInstallBreak - pops the break handler stack.
+*)
+
+PROCEDURE UnInstallBreak ;
+
+
+END Break.
diff --git a/gcc/m2/gm2-libs-pim/CardinalIO.def b/gcc/m2/gm2-libs-pim/CardinalIO.def
new file mode 100644
index 00000000000..166a7a969c0
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/CardinalIO.def
@@ -0,0 +1,146 @@
+(* CardinalIO.def provides a PIM and Logitech compatible module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE CardinalIO ;
+
+EXPORT QUALIFIED Done,
+                 ReadCardinal, WriteCardinal, ReadHex, WriteHex,
+                 ReadLongCardinal, WriteLongCardinal, ReadLongHex,
+                 WriteLongHex,
+                 ReadShortCardinal, WriteShortCardinal, ReadShortHex,
+                 WriteShortHex ;
+
+
+VAR
+   Done: BOOLEAN ;
+
+
+(*
+   ReadCardinal - read an unsigned decimal number from the terminal.
+                  The read continues until a space, newline, esc or
+                  end of file is reached.
+*)
+
+PROCEDURE ReadCardinal (VAR c: CARDINAL) ;
+
+
+(*
+   WriteCardinal - writes the value, c, to the terminal and ensures
+                   that at least, n, characters are written. The number
+                   will be padded out by preceeding spaces if necessary.
+*)
+
+PROCEDURE WriteCardinal (c: CARDINAL; n: CARDINAL) ;
+
+
+(*
+   ReadHex - reads in an unsigned hexadecimal number from the terminal.
+             The read continues until a space, newline, esc or
+             end of file is reached.
+*)
+
+PROCEDURE ReadHex (VAR c: CARDINAL) ;
+
+
+(*
+   WriteHex - writes out a CARDINAL, c, in hexadecimal format padding
+              with, n, characters (leading with '0')
+*)
+
+PROCEDURE WriteHex (c: CARDINAL; n: CARDINAL) ;
+
+
+(*
+   ReadLongCardinal - read an unsigned decimal number from the terminal.
+                      The read continues until a space, newline, esc or
+                      end of file is reached.
+*)
+
+PROCEDURE ReadLongCardinal (VAR c: LONGCARD) ;
+
+
+(*
+   WriteLongCardinal - writes the value, c, to the terminal and ensures
+                       that at least, n, characters are written. The number
+                       will be padded out by preceeding spaces if necessary.
+*)
+
+PROCEDURE WriteLongCardinal (c: LONGCARD; n: CARDINAL) ;
+
+
+(*
+   ReadLongHex - reads in an unsigned hexadecimal number from the terminal.
+                 The read continues until a space, newline, esc or
+                 end of file is reached.
+*)
+
+PROCEDURE ReadLongHex (VAR c: LONGCARD) ;
+
+
+(*
+   WriteLongHex - writes out a LONGCARD, c, in hexadecimal format padding
+                  with, n, characters (leading with '0')
+*)
+
+PROCEDURE WriteLongHex (c: LONGCARD; n: CARDINAL) ;
+
+
+(*
+   WriteShortCardinal - writes the value, c, to the terminal and ensures
+                       that at least, n, characters are written. The number
+                       will be padded out by preceeding spaces if necessary.
+*)
+
+PROCEDURE WriteShortCardinal (c: SHORTCARD; n: CARDINAL) ;
+
+
+(*
+   ReadShortCardinal - read an unsigned decimal number from the terminal.
+                       The read continues until a space, newline, esc or
+                       end of file is reached.
+*)
+
+PROCEDURE ReadShortCardinal (VAR c: SHORTCARD) ;
+
+
+(*
+   ReadShortHex - reads in an unsigned hexadecimal number from the terminal.
+                 The read continues until a space, newline, esc or
+                 end of file is reached.
+*)
+
+PROCEDURE ReadShortHex (VAR c: SHORTCARD) ;
+
+
+(*
+   WriteShortHex - writes out a SHORTCARD, c, in hexadecimal format padding
+                  with, n, characters (leading with '0')
+*)
+
+PROCEDURE WriteShortHex (c: SHORTCARD; n: CARDINAL) ;
+
+
+END CardinalIO.
diff --git a/gcc/m2/gm2-libs-pim/CardinalIO.mod b/gcc/m2/gm2-libs-pim/CardinalIO.mod
new file mode 100644
index 00000000000..a02febfdba4
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/CardinalIO.mod
@@ -0,0 +1,257 @@
+(* CardinalIO.mod provides a PIM and Logitech compatible module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE CardinalIO ;
+
+
+FROM DynamicStrings IMPORT String, InitString, KillString, RemoveWhitePrefix ;
+FROM SYSTEM IMPORT ADR, BYTE ;
+IMPORT InOut ;
+
+FROM StringConvert IMPORT StringToCardinal, CardinalToString,
+                          StringToLongCardinal, LongCardinalToString,
+                          StringToShortCardinal, ShortCardinalToString ;
+
+
+(*
+   ReadCardinal - read an unsigned decimal number from the terminal.
+                  The read continues until a space, newline, esc or
+                  end of file is reached.
+*)
+
+PROCEDURE ReadCardinal (VAR c: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      c := StringToCardinal(s, 10, Done)
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadCardinal ;
+
+
+(*
+   WriteCardinal - writes the value, c, to the terminal and ensures
+                   that at least, n, characters are written. The number
+                   will be padded out by preceeding spaces if necessary.
+*)
+
+PROCEDURE WriteCardinal (c: CARDINAL; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := KillString(InOut.WriteS(CardinalToString(c, n, ' ', 10, FALSE))) ;
+   Done := TRUE
+END WriteCardinal ;
+
+
+(*
+   ReadHex - reads in an unsigned hexadecimal number from the terminal.
+             The read continues until a space, newline, esc or
+             end of file is reached.
+*)
+
+PROCEDURE ReadHex (VAR c: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      c := StringToCardinal(s, 16, Done)
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadHex ;
+
+
+(*
+   WriteHex - writes out a CARDINAL, c, in hexadecimal format padding
+              with, n, characters (leading with '0')
+*)
+
+PROCEDURE WriteHex (c: CARDINAL; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := KillString(InOut.WriteS(CardinalToString(c, n, '0', 16, TRUE))) ;
+   Done := TRUE
+END WriteHex ;
+
+
+(*
+   ReadLongCardinal - read an unsigned decimal number from the terminal.
+                      The read continues until a space, newline, esc or
+                      end of file is reached.
+*)
+
+PROCEDURE ReadLongCardinal (VAR c: LONGCARD) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      c := StringToLongCardinal(s, 10, Done)
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadLongCardinal ;
+
+
+(*
+   WriteLongCardinal - writes the value, c, to the terminal and ensures
+                       that at least, n, characters are written. The number
+                       will be padded out by preceeding spaces if necessary.
+*)
+
+PROCEDURE WriteLongCardinal (c: LONGCARD; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := KillString(InOut.WriteS(LongCardinalToString(c, n, ' ', 10, FALSE))) ;
+   Done := TRUE
+END WriteLongCardinal ;
+
+
+(*
+   ReadLongHex - reads in an unsigned hexadecimal number from the terminal.
+                 The read continues until a space, newline, esc or
+                 end of file is reached.
+*)
+
+PROCEDURE ReadLongHex (VAR c: LONGCARD) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      c := StringToLongCardinal(s, 16, Done)
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadLongHex ;
+
+
+(*
+   WriteLongHex - writes out a LONGCARD, c, in hexadecimal format padding
+                  with, n, characters (leading with '0')
+*)
+
+PROCEDURE WriteLongHex (c: LONGCARD; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := KillString(InOut.WriteS(LongCardinalToString(c, n, '0', 16, TRUE))) ;
+   Done := TRUE
+END WriteLongHex ;
+
+
+(*
+   ReadShortCardinal - read an unsigned decimal number from the terminal.
+                       The read continues until a space, newline, esc or
+                       end of file is reached.
+*)
+
+PROCEDURE ReadShortCardinal (VAR c: SHORTCARD) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      c := StringToShortCardinal(s, 10, Done)
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadShortCardinal ;
+
+
+(*
+   WriteShortCardinal - writes the value, c, to the terminal and ensures
+                        that at least, n, characters are written. The number
+                        will be padded out by preceeding spaces if necessary.
+*)
+
+PROCEDURE WriteShortCardinal (c: SHORTCARD; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := KillString(InOut.WriteS(ShortCardinalToString(c, n, ' ', 10, FALSE))) ;
+   Done := TRUE
+END WriteShortCardinal ;
+
+
+(*
+   ReadShortHex - reads in an unsigned hexadecimal number from the terminal.
+                  The read continues until a space, newline, esc or
+                  end of file is reached.
+*)
+
+PROCEDURE ReadShortHex (VAR c: SHORTCARD) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      c := StringToShortCardinal(s, 16, Done)
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadShortHex ;
+
+
+(*
+   WriteShortHex - writes out a SHORTCARD, c, in hexadecimal format padding
+                   with, n, characters (leading with '0')
+*)
+
+PROCEDURE WriteShortHex (c: SHORTCARD; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := KillString(InOut.WriteS(ShortCardinalToString(c, n, '0', 16, TRUE))) ;
+   Done := TRUE
+END WriteShortHex ;
+
+
+END CardinalIO.
+(*
+ * Local variables:
+ *  compile-command: "gm2 -I.:../gm2-libs -g -c -Wsources CardinalIO.mod"
+ * End:
+ *)
diff --git a/gcc/m2/gm2-libs-pim/Conversions.def b/gcc/m2/gm2-libs-pim/Conversions.def
new file mode 100644
index 00000000000..c43f07cd244
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Conversions.def
@@ -0,0 +1,55 @@
+(* Conversions.def provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE Conversions ;
+
+EXPORT QUALIFIED ConvertOctal, ConvertHex, ConvertCardinal,
+                 ConvertInteger, ConvertLongInt, ConvertShortInt ;
+
+(*
+   ConvertOctal - converts a CARDINAL, num, into an octal/hex/decimal
+                  string and right justifies the string. It adds
+                  spaces rather than '0' to pad out the string
+                  to len characters.
+
+                  If the length of str is < num then the number is
+                  truncated on the right.
+*)
+
+PROCEDURE ConvertOctal    (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+PROCEDURE ConvertHex      (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+PROCEDURE ConvertCardinal (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+
+(*
+   The INTEGER counterparts will add a '-' if, num, is <0
+*)
+
+PROCEDURE ConvertInteger  (num: INTEGER; len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+PROCEDURE ConvertLongInt  (num: LONGINT; len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+PROCEDURE ConvertShortInt (num: SHORTINT; len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+
+
+END Conversions.
diff --git a/gcc/m2/gm2-libs-pim/Conversions.mod b/gcc/m2/gm2-libs-pim/Conversions.mod
new file mode 100644
index 00000000000..9696e7a004a
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Conversions.mod
@@ -0,0 +1,126 @@
+(* Conversions.mod provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Conversions ;
+
+
+FROM DynamicStrings IMPORT String, InitString, KillString, CopyOut ;
+FROM StringConvert IMPORT IntegerToString, StringToInteger,
+                          StringToLongInteger, LongIntegerToString,
+                          StringToCardinal, CardinalToString ;
+
+
+(*
+   ConvertOctal - converts a CARDINAL, num, into an octal string
+                  and right justifies the string. It adds
+                  spaces rather than '0' to pad out the string
+                  to len characters.
+
+                  If the length of str is < num then the number is
+                  truncated on the right.
+*)
+
+PROCEDURE ConvertOctal (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := CardinalToString(num, len, ' ', 8, FALSE) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END ConvertOctal ;
+
+
+PROCEDURE ConvertHex (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := CardinalToString(num, len, ' ', 16, TRUE) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END ConvertHex ;
+
+
+PROCEDURE ConvertCardinal (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := CardinalToString(num, len, ' ', 10, FALSE) ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END ConvertCardinal ;
+
+
+(*
+   The INTEGER counterparts will add a '-' if, num, is <0
+*)
+
+PROCEDURE ConvertInteger (num: INTEGER; len: CARDINAL;
+                          VAR str: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF num<0
+   THEN
+      s := IntegerToString(num, len, ' ', TRUE, 10, FALSE)
+   ELSE
+      s := IntegerToString(num, len, ' ', FALSE, 10, FALSE)
+   END ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END ConvertInteger ;
+
+
+PROCEDURE ConvertLongInt (num: LONGINT; len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF num<0
+   THEN
+      s := LongIntegerToString(num, len, ' ', TRUE, 10, FALSE)
+   ELSE
+      s := LongIntegerToString(num, len, ' ', FALSE, 10, FALSE)
+   END ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END ConvertLongInt ;
+
+
+PROCEDURE ConvertShortInt (num: SHORTINT; len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF num<0
+   THEN
+      s := IntegerToString(VAL(INTEGER, num), len, ' ', TRUE, 10, FALSE)
+   ELSE
+      s := IntegerToString(VAL(INTEGER, num), len, ' ', FALSE, 10, FALSE)
+   END ;
+   CopyOut(str, s) ;
+   s := KillString(s)
+END ConvertShortInt ;
+
+
+END Conversions.
diff --git a/gcc/m2/gm2-libs-pim/DebugPMD.def b/gcc/m2/gm2-libs-pim/DebugPMD.def
new file mode 100644
index 00000000000..6d1747a6b4b
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/DebugPMD.def
@@ -0,0 +1,29 @@
+(* DebugPMD.def provides a compatible Logitech debug module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE DebugPMD ;
+
+END DebugPMD.
diff --git a/gcc/m2/gm2-libs-pim/DebugPMD.mod b/gcc/m2/gm2-libs-pim/DebugPMD.mod
new file mode 100644
index 00000000000..b493204beeb
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/DebugPMD.mod
@@ -0,0 +1,29 @@
+(* DebugPMD.mod provides a compatible Logitech debug module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE DebugPMD ;
+
+END DebugPMD.
diff --git a/gcc/m2/gm2-libs-pim/DebugTrace.def b/gcc/m2/gm2-libs-pim/DebugTrace.def
new file mode 100644
index 00000000000..17b646d9569
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/DebugTrace.def
@@ -0,0 +1,29 @@
+(* DebugTrace.def provides a Logitech compatible module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE DebugTrace ;
+
+END DebugTrace.
diff --git a/gcc/m2/gm2-libs-pim/DebugTrace.mod b/gcc/m2/gm2-libs-pim/DebugTrace.mod
new file mode 100644
index 00000000000..030859017af
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/DebugTrace.mod
@@ -0,0 +1,29 @@
+(* DebugTrace.mod provides a Logitech compatible module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE DebugTrace ;
+
+END DebugTrace.
diff --git a/gcc/m2/gm2-libs-pim/Delay.def b/gcc/m2/gm2-libs-pim/Delay.def
new file mode 100644
index 00000000000..4a4f9af2a23
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Delay.def
@@ -0,0 +1,39 @@
+(* Delay.def provides a Logitech compatible module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE Delay ;
+
+EXPORT QUALIFIED Delay ;
+
+
+(*
+   milliSec - delays the program by approximately, milliSec, milliseconds.
+*)
+
+PROCEDURE Delay (milliSec: INTEGER) ;
+
+
+END Delay.
diff --git a/gcc/m2/gm2-libs-pim/Delay.mod b/gcc/m2/gm2-libs-pim/Delay.mod
new file mode 100644
index 00000000000..1c5585e66e4
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Delay.mod
@@ -0,0 +1,43 @@
+(* Delay.mod provides a Logitech compatible module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Delay ;
+
+FROM Selective IMPORT Timeval, InitTime, KillTime, Select ;
+
+
+PROCEDURE Delay (milliSec: INTEGER) ;
+VAR
+   t: Timeval ;
+   r: INTEGER ;
+BEGIN
+   t := InitTime(0, milliSec*1000) ;
+   r := Select(0, NIL, NIL, NIL, t) ;
+   t := KillTime(t)
+END Delay ;
+
+
+END Delay.
diff --git a/gcc/m2/gm2-libs-pim/Display.def b/gcc/m2/gm2-libs-pim/Display.def
new file mode 100644
index 00000000000..5c66b28d372
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Display.def
@@ -0,0 +1,41 @@
+(* Display.def provides a Logitech 3.0 compatible Display module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE Display ;
+
+EXPORT QUALIFIED Write ;
+
+
+(*
+   Write - display a character to the stdout.
+           ASCII.EOL moves to the beginning of the next line.
+           ASCII.del erases the character to the left of the cursor.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+
+
+END Display.
diff --git a/gcc/m2/gm2-libs-pim/Display.mod b/gcc/m2/gm2-libs-pim/Display.mod
new file mode 100644
index 00000000000..0c9664337d5
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Display.mod
@@ -0,0 +1,54 @@
+(* Display.mod provides a Logitech 3.0 compatible Display module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Display ;
+
+FROM FIO IMPORT StdOut, WriteChar ;
+FROM ASCII IMPORT EOL, nl, bs, del ;
+
+
+(*
+   Write - display a character to the stdout.
+           ASCII.EOL moves to the beginning of the next line.
+           ASCII.del erases the character to the left of the cursor.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+BEGIN
+   CASE ch OF
+
+   EOL:   WriteChar(StdOut, nl) |
+   del:   WriteChar(StdOut, bs) ;
+          WriteChar(StdOut, ' ') ;
+          WriteChar(StdOut, bs)
+
+   ELSE
+      WriteChar(StdOut, ch)
+   END
+END Write ;
+
+
+END Display.
diff --git a/gcc/m2/gm2-libs-pim/ErrorCode.def b/gcc/m2/gm2-libs-pim/ErrorCode.def
new file mode 100644
index 00000000000..53b26f0207f
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/ErrorCode.def
@@ -0,0 +1,56 @@
+(* ErrorCode.def provides a Logitech compatible module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE ErrorCode ;
+
+EXPORT QUALIFIED SetErrorCode, GetErrorCode, ExitToOS ;
+
+
+(*
+   SetErrorCode - sets the exit value which will be used if
+                  the application terminates normally.
+*)
+
+PROCEDURE SetErrorCode (value: INTEGER) ;
+
+
+(*
+   GetErrorCode - returns the current value to be used upon
+                  application termination.
+*)
+
+PROCEDURE GetErrorCode (VAR value: INTEGER) ;
+
+
+(*
+   ExitToOS - terminate the application and exit returning
+              the last value set by SetErrorCode to the OS.
+*)
+
+PROCEDURE ExitToOS ;
+
+
+END ErrorCode.
diff --git a/gcc/m2/gm2-libs-pim/ErrorCode.mod b/gcc/m2/gm2-libs-pim/ErrorCode.mod
new file mode 100644
index 00000000000..f69e259d6c1
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/ErrorCode.mod
@@ -0,0 +1,71 @@
+(* ErrorCode.mod provides a Logitech compatible module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ErrorCode ;
+
+FROM M2RTS IMPORT ExitOnHalt ;
+
+VAR
+   exitCode: INTEGER ;
+
+
+(*
+   SetErrorCode - sets the exit value which will be used if
+                  the application terminates normally.
+*)
+
+PROCEDURE SetErrorCode (value: INTEGER) ;
+BEGIN
+   exitCode := value ;
+   ExitOnHalt(value)
+END SetErrorCode ;
+
+
+(*
+   GetErrorCode - returns the current value to be used upon
+                  application termination.
+*)
+
+PROCEDURE GetErrorCode (VAR value: INTEGER) ;
+BEGIN
+   value := exitCode
+END GetErrorCode ;
+
+
+(*
+   ExitToOS - terminate the application and exit returning
+              the last value set by SetErrorCode to the OS.
+*)
+
+PROCEDURE ExitToOS ;
+BEGIN
+   HALT
+END ExitToOS ;
+
+
+BEGIN
+   exitCode := 0
+END ErrorCode.
diff --git a/gcc/m2/gm2-libs-pim/FileSystem.def b/gcc/m2/gm2-libs-pim/FileSystem.def
new file mode 100644
index 00000000000..072d9dec3b0
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/FileSystem.def
@@ -0,0 +1,275 @@
+(* FileSystem.def provides a PIM [234] FileSystem module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE FileSystem ;
+
+(*  Use this module sparingly, FIO or the ISO file modules have a
+    much cleaner interface.  *)
+
+FROM SYSTEM IMPORT WORD, BYTE, ADDRESS ;
+IMPORT FIO ;
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED File, Response, Flag, FlagSet,
+
+                 Create, Close, Lookup, Rename, Delete,
+                 SetRead, SetWrite, SetModify, SetOpen,
+                 Doio, SetPos, GetPos, Length, Reset,
+
+                 ReadWord, ReadChar, ReadByte, ReadNBytes,
+                 WriteWord, WriteChar, WriteByte, WriteNBytes ;
+
+TYPE
+   File = RECORD
+             res     : Response ;
+             flags   : FlagSet ;
+             eof     : BOOLEAN ;
+             lastWord: WORD ;
+             lastByte: BYTE ;
+             fio     : FIO.File ;
+             highpos,
+             lowpos  : CARDINAL ;
+             name    : String ;
+          END ;
+
+   Flag = (
+           read,        (* read access mode *)
+           write,       (* write access mode *)
+           modify,
+           truncate,    (* truncate file when closed *)
+           again,       (* reread the last character *)
+           temporary,   (* file is temporary *)
+           opened       (* file has been opened *)
+          );
+
+   FlagSet = SET OF Flag;
+
+   Response = (done, notdone, notsupported, callerror,
+               unknownfile, paramerror, toomanyfiles,
+               userdeverror) ;
+
+   Command = (create, close, lookup, rename, delete,
+              setread, setwrite, setmodify, setopen,
+              doio, setpos, getpos, length) ;
+
+
+(*
+   Create - creates a temporary file. To make the file perminant
+            the file must be renamed.
+*)
+
+PROCEDURE Create (VAR f: File) ;
+
+
+(*
+   Close - closes an open file.
+*)
+
+PROCEDURE Close (f: File) ;
+
+
+(*
+   Lookup - looks for a file, filename. If the file is found
+            then, f, is opened. If it is not found and, newFile,
+            is TRUE then a new file is created and attached to, f.
+            If, newFile, is FALSE and no file was found then f.res
+            is set to notdone.
+*)
+
+PROCEDURE Lookup (VAR f: File; filename: ARRAY OF CHAR; newFile: BOOLEAN) ;
+
+
+(*
+   Rename - rename a file and change a temporary file to a permanent
+            file. f.res is set appropriately.
+*)
+
+PROCEDURE Rename (VAR f: File; newname: ARRAY OF CHAR) ;
+
+
+(*
+   Delete - deletes a file, name, and sets the f.res field.
+            f.res is set appropriately.
+*)
+
+PROCEDURE Delete (name: ARRAY OF CHAR; VAR f: File) ;
+
+
+(*
+   ReadWord - reads a WORD, w, from file, f.
+              f.res is set appropriately.
+*)
+
+PROCEDURE ReadWord (VAR f: File; VAR w: WORD) ;
+
+
+(*
+   WriteWord - writes one word to a file, f.
+               f.res is set appropriately.
+*)
+
+PROCEDURE WriteWord (VAR f: File; w: WORD) ;
+
+
+(*
+   ReadChar - reads one character from a file, f.
+*)
+
+PROCEDURE ReadChar (VAR f: File; VAR ch: CHAR) ;
+
+
+(*
+   WriteChar - writes a character, ch, to a file, f.
+               f.res is set appropriately.
+*)
+
+PROCEDURE WriteChar (VAR f: File; ch: CHAR) ;
+
+
+(*
+   ReadByte - reads a BYTE, b, from file, f.
+              f.res is set appropriately.
+*)
+
+PROCEDURE ReadByte (VAR f: File; VAR b: BYTE) ;
+
+
+(*
+   WriteByte - writes one BYTE, b, to a file, f.
+               f.res is set appropriately.
+*)
+
+PROCEDURE WriteByte (VAR f: File; b: BYTE) ;
+
+
+(*
+   ReadNBytes - reads a sequence of bytes from a file, f.
+*)
+
+PROCEDURE ReadNBytes (VAR f: File; a: ADDRESS; amount: CARDINAL;
+                      VAR actuallyRead: CARDINAL) ;
+
+
+(*
+   WriteNBytes - writes a sequence of bytes to file, f.
+*)
+
+PROCEDURE WriteNBytes (VAR f: File; a: ADDRESS; amount: CARDINAL;
+                       VAR actuallyWritten: CARDINAL) ;
+
+
+(*
+   Again - returns the last character read to the internal buffer
+           so that it can be read again.
+*)
+
+PROCEDURE Again (VAR f: File) ;
+
+
+(*
+   SetRead - puts the file, f, into the read state.
+             The file position is unchanged.
+*)
+
+PROCEDURE SetRead (VAR f: File) ;
+
+
+(*
+   SetWrite - puts the file, f, into the write state.
+              The file position is unchanged.
+*)
+
+PROCEDURE SetWrite (VAR f: File) ;
+
+
+(*
+   SetModify - puts the file, f, into the modify state.
+               The file position is unchanged but the file can be
+               read and written.
+*)
+
+PROCEDURE SetModify (VAR f: File) ;
+
+
+(*
+   SetOpen - places a file, f, into the open state. The file may
+             have been in the read/write/modify state before and
+             in which case the previous buffer contents are flushed
+             and the file state is reset to open. The position is
+             unaltered.
+*)
+
+PROCEDURE SetOpen (VAR f: File) ;
+
+
+(*
+   Reset - places a file, f, into the open state and reset the
+           position to the start of the file.
+*)
+
+PROCEDURE Reset (VAR f: File) ;
+
+
+(*
+   SetPos - lseek to a position within a file.
+*)
+
+PROCEDURE SetPos (VAR f: File; high, low: CARDINAL) ;
+
+
+(*
+   GetPos - return the position within a file.
+*)
+
+PROCEDURE GetPos (VAR f: File; VAR high, low: CARDINAL) ;
+
+
+(*
+   Length - returns the length of file, in, high, and, low.
+*)
+
+PROCEDURE Length (VAR f: File; VAR high, low: CARDINAL) ;
+
+
+(*
+   Doio - effectively flushes a file in write mode, rereads the
+          current buffer from disk if in read mode and writes
+          and rereads the buffer if in modify mode.
+*)
+
+PROCEDURE Doio (VAR f: File) ;
+
+
+(*
+   FileNameChar - checks to see whether the character, ch, is
+                  legal in a filename. nul is returned if the
+                  character was illegal.
+*)
+
+PROCEDURE FileNameChar (ch: CHAR) ;
+
+
+END FileSystem.
diff --git a/gcc/m2/gm2-libs-pim/FileSystem.mod b/gcc/m2/gm2-libs-pim/FileSystem.mod
new file mode 100644
index 00000000000..0bfce019297
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/FileSystem.mod
@@ -0,0 +1,658 @@
+(* FileSystem.mod provides a PIM [234] FileSystem module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE FileSystem ;
+
+FROM M2RTS IMPORT InstallTerminationProcedure ;
+FROM Storage IMPORT ALLOCATE ;
+FROM SYSTEM IMPORT WORD, BYTE, ADDRESS, ADR ;
+IMPORT FIO, SFIO, libc, wrapc ;
+FROM DynamicStrings IMPORT String, InitString, ConCat, ConCatChar, KillString, string ;
+FROM FormatStrings IMPORT Sprintf2 ;
+
+CONST
+   TMPDIR   = '/tmp' ;
+   DIRSEP   = '/' ;
+   SEEK_SET = 0 ;   (* seek relative to from beginning of the file *)
+
+TYPE
+   FileList = POINTER TO RECORD
+                            next     : FileList ;
+                            n        : String ;
+                            stillTemp: BOOLEAN ;
+                         END ;
+
+VAR
+   HeadOfTemp: FileList ;
+   tempNo    : CARDINAL ;
+
+
+(*
+   Create - creates a temporary file. To make the file perminant
+            the file must be renamed.
+*)
+
+PROCEDURE Create (VAR f: File) ;
+BEGIN
+   WITH f DO
+      flags := FlagSet{write, temporary} ;
+      eof := FALSE ;
+      lastWord := WORD(0) ;
+      lastByte := CHAR(0) ;
+      name := MakeTemporary() ;
+      fio := SFIO.OpenToWrite(name) ;
+      IF FIO.IsNoError(fio)
+      THEN
+         res := done
+      ELSE
+         res := notdone
+      END ;
+      highpos := 0 ;
+      lowpos := 0
+   END
+END Create ;
+
+
+(*
+   Close - closes an open file.
+*)
+
+PROCEDURE Close (f: File) ;
+BEGIN
+   WITH f DO
+      eof := TRUE ;
+      FIO.Close(fio) ;
+      IF FIO.IsNoError(fio)
+      THEN
+         res := done
+      ELSE
+         res := notdone
+      END ;
+      IF temporary IN flags
+      THEN
+         deleteFile(name, f)
+      END ;
+      name := KillString(name)
+   END
+END Close ;
+
+
+(*
+   Lookup - looks for a file, filename. If the file is found
+            then, f, is opened. If it is not found and, newFile,
+            is TRUE then a new file is created and attached to, f.
+            If, newFile, is FALSE and no file was found then f.res
+            is set to notdone.
+*)
+
+PROCEDURE Lookup (VAR f: File; filename: ARRAY OF CHAR; newFile: BOOLEAN) ;
+BEGIN
+   WITH f DO
+      flags := FlagSet{} ;
+      IF FIO.Exists(filename)
+      THEN
+         fio := FIO.OpenToRead(filename) ;
+         INCL(flags, read) ;
+         res := done
+      ELSIF newFile
+      THEN
+         fio := FIO.OpenToWrite(filename) ;
+         INCL(flags, write) ;
+         res := done
+      ELSE
+         res := notdone
+      END ;
+      name := InitString(filename) ;
+      eof := FALSE ;
+      highpos := 0 ;
+      lowpos := 0
+   END
+END Lookup ;
+
+
+(*
+   Rename - rename a file and change a temporary file to a permanent
+            file. f.res is set appropriately.
+*)
+
+PROCEDURE Rename (VAR f: File; newname: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+   r: INTEGER ;
+BEGIN
+   s := InitString(newname) ;
+   WITH f DO
+      r := libc.rename(string(name), string(s)) ;
+      IF r=0
+      THEN
+         res := done
+      ELSE
+         res := notdone
+      END ;
+      EXCL(flags, temporary) ;
+      name := KillString(name) ;
+      name := s
+   END
+END Rename ;
+
+
+(*
+   deleteFile - deletes file, name. It also kills the string, name.
+*)
+
+PROCEDURE deleteFile (VAR name: String; VAR f: File) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   r := libc.unlink(string(name)) ;
+   IF r=0
+   THEN
+      f.res := done
+   ELSE
+      f.res := notdone
+   END ;
+   name := KillString(name) ;
+   name := NIL
+END deleteFile ;
+
+
+(*
+   Delete - deletes a file, name, and sets the f.res field.
+            f.res is set appropriately.
+*)
+
+PROCEDURE Delete (name: ARRAY OF CHAR; VAR f: File) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString(name) ;
+   deleteFile(s, f) ;
+   s := KillString(s)
+END Delete ;
+
+
+(*
+   ReadWord - reads a WORD, w, from file, f.
+              f.res is set appropriately.
+*)
+
+PROCEDURE ReadWord (VAR f: File; VAR w: WORD) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   WITH f DO
+      IF again IN flags
+      THEN
+         w := lastWord ;
+         EXCL(flags, again)
+      ELSE
+         ReadNBytes(f, ADR(w), SIZE(w), n) ;
+         IF n=SIZE(w)
+         THEN
+            res := done
+         ELSE
+            res := notdone ;
+            eof := TRUE
+         END
+      END
+   END
+END ReadWord ;
+
+
+(*
+   WriteWord - writes one word to a file, f.
+               f.res is set appropriately.
+*)
+
+PROCEDURE WriteWord (VAR f: File; w: WORD) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   WriteNBytes(f, ADR(w), SIZE(w), n) ;
+   WITH f DO
+      IF n=SIZE(w)
+      THEN
+         res := done
+      ELSE
+         res := notdone
+      END
+   END
+END WriteWord ;
+
+
+(*
+   ReadChar - reads one character from a file, f.
+*)
+
+PROCEDURE ReadChar (VAR f: File; VAR ch: CHAR) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   WITH f DO
+      IF again IN flags
+      THEN
+         ch := CHAR(lastByte) ;
+         EXCL(flags, again)
+      ELSE
+         ReadNBytes(f, ADR(ch), SIZE(ch), n) ;
+         IF n=SIZE(ch)
+         THEN
+            res := done ;
+            lastByte := BYTE(ch)
+         ELSE
+            res := notdone ;
+            eof := TRUE
+         END
+      END
+   END
+END ReadChar ;
+
+
+(*
+   WriteChar - writes a character, ch, to a file, f.
+               f.res is set appropriately.
+*)
+
+PROCEDURE WriteChar (VAR f: File; ch: CHAR) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   WriteNBytes(f, ADR(ch), SIZE(ch), n) ;
+   WITH f DO
+      IF n=SIZE(ch)
+      THEN
+         res := done
+      ELSE
+         res := notdone
+      END
+   END
+END WriteChar ;
+
+
+(*
+   ReadByte - reads a BYTE, b, from file, f.
+              f.res is set appropriately.
+*)
+
+PROCEDURE ReadByte (VAR f: File; VAR b: BYTE) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   WITH f DO
+      IF again IN flags
+      THEN
+         b := lastByte ;
+         EXCL(flags, again)
+      ELSE
+         ReadNBytes(f, ADR(b), SIZE(b), n) ;
+         IF n=SIZE(b)
+         THEN
+            res := done ;
+            lastByte := b
+         ELSE
+            res := notdone ;
+            eof := TRUE
+         END
+      END
+   END
+END ReadByte ;
+
+
+(*
+   WriteByte - writes one BYTE, b, to a file, f.
+               f.res is set appropriately.
+*)
+
+PROCEDURE WriteByte (VAR f: File; b: BYTE) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   WriteNBytes(f, ADR(b), SIZE(b), n) ;
+   WITH f DO
+      IF n=SIZE(b)
+      THEN
+         res := done
+      ELSE
+         res := notdone
+      END
+   END
+END WriteByte ;
+
+
+(*
+   ReadNBytes - reads a sequence of bytes from a file, f.
+*)
+
+PROCEDURE ReadNBytes (VAR f: File; a: ADDRESS; amount: CARDINAL;
+                      VAR actuallyRead: CARDINAL) ;
+BEGIN
+   WITH f DO
+      IF amount>0
+      THEN
+         actuallyRead := FIO.ReadNBytes(fio, amount, a) ;
+         IF FIO.IsNoError(fio)
+         THEN
+            res := done ;
+            IF MAX(CARDINAL)-lowpos<actuallyRead
+            THEN
+               INC(highpos)
+            END ;
+            INC(lowpos, actuallyRead)
+         ELSE
+            res := notdone ;
+            eof := TRUE
+         END
+      END
+   END
+END ReadNBytes ;
+
+
+(*
+   WriteNBytes - writes a sequence of bytes to file, f.
+*)
+
+PROCEDURE WriteNBytes (VAR f: File; a: ADDRESS; amount: CARDINAL;
+                       VAR actuallyWritten: CARDINAL) ;
+BEGIN
+   actuallyWritten := 0 ;
+   WITH f DO
+      IF amount>0
+      THEN
+         actuallyWritten := FIO.WriteNBytes(fio, amount, a) ;
+         IF FIO.IsNoError(fio)
+         THEN
+            res := done ;
+            IF MAX(CARDINAL)-lowpos<actuallyWritten
+            THEN
+               INC(highpos)
+            END ;
+            INC(lowpos, actuallyWritten)
+         ELSE
+            res := notdone
+         END
+      END
+   END
+END WriteNBytes ;
+
+
+(*
+   Again - returns the last character read to the internal buffer
+           so that it can be read again.
+*)
+
+PROCEDURE Again (VAR f: File) ;
+BEGIN
+   INCL(f.flags, again)
+END Again ;
+
+
+(*
+   doModeChange -
+*)
+
+PROCEDURE doModeChange (VAR f: File; mode: Flag) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   WITH f DO
+      IF NOT (mode IN flags)
+      THEN
+         INCL(flags, mode) ;
+         IF mode=read
+         THEN
+            EXCL(flags, write)
+         ELSIF mode=write
+         THEN
+            EXCL(flags, read)
+         END ;
+         IF opened IN flags
+         THEN
+            FIO.Close(fio)
+         END ;
+         IF read IN flags
+         THEN
+            fio := SFIO.OpenToRead(name)
+         ELSIF write IN flags
+         THEN
+            fio := SFIO.OpenToWrite(name)
+         END ;
+         INCL (flags, opened) ;
+         r := libc.lseek (fio,
+                          VAL (LONGINT, lowpos) + VAL (LONGINT, highpos) * VAL (LONGINT, MAX (CARDINAL)),
+                          SEEK_SET)
+      END
+   END
+END doModeChange ;
+
+
+(*
+   SetRead - puts the file, f, into the read state.
+             The file position is unchanged.
+*)
+
+PROCEDURE SetRead (VAR f: File) ;
+BEGIN
+   doModeChange(f, read)
+END SetRead ;
+
+
+(*
+   SetWrite - puts the file, f, into the write state.
+              The file position is unchanged.
+*)
+
+PROCEDURE SetWrite (VAR f: File) ;
+BEGIN
+   doModeChange(f, write)
+END SetWrite ;
+
+
+(*
+   SetModify - puts the file, f, into the modify state.
+               The file position is unchanged but the file can be
+               read and written.
+*)
+
+PROCEDURE SetModify (VAR f: File) ;
+BEGIN
+   doModeChange(f, modify)
+END SetModify ;
+
+
+(*
+   SetOpen - places a file, f, into the open state. The file may
+             have been in the read/write/modify state before and
+             in which case the previous buffer contents are flushed
+             and the file state is reset to open. The position is
+             unaltered.
+*)
+
+PROCEDURE SetOpen (VAR f: File) ;
+BEGIN
+   doModeChange(f, opened)
+END SetOpen ;
+
+
+(*
+   Reset - places a file, f, into the open state and reset the
+           position to the start of the file.
+*)
+
+PROCEDURE Reset (VAR f: File) ;
+BEGIN
+   SetOpen(f) ;
+   SetPos(f, 0, 0)
+END Reset ;
+
+
+(*
+   SetPos - lseek to a position within a file.
+*)
+
+PROCEDURE SetPos (VAR f: File; high, low: CARDINAL) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   WITH f DO
+      r := libc.lseek(fio, VAL(LONGCARD, low) +
+                      (VAL(LONGCARD, MAX(CARDINAL)) * VAL(LONGCARD, high)),
+                      SEEK_SET) ;
+      highpos := high ;
+      lowpos := low ;
+   END
+END SetPos ;
+
+
+(*
+   GetPos - return the position within a file.
+*)
+
+PROCEDURE GetPos (VAR f: File; VAR high, low: CARDINAL) ;
+BEGIN
+   WITH f DO
+      high := highpos ;
+      low := lowpos
+   END
+END GetPos ;
+
+
+(*
+   Length - returns the length of file, in, high, and, low.
+*)
+
+PROCEDURE Length (VAR f: File; VAR high, low: CARDINAL) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   WITH f DO
+      i := wrapc.filesize(FIO.GetUnixFileDescriptor(fio), high, low)
+   END
+END Length ;
+
+
+(*
+   Doio - effectively flushes a file in write mode, rereads the
+          current buffer from disk if in read mode and writes
+          and rereads the buffer if in modify mode.
+*)
+
+PROCEDURE Doio (VAR f: File) ;
+BEGIN
+   WITH f DO
+      IF opened IN flags
+      THEN
+         FIO.Close(fio) ;
+         EXCL(flags, opened)
+      END ;
+      IF read IN flags
+      THEN
+         fio := SFIO.OpenToRead(name) ;
+         INCL(flags, opened) ;
+         SetPos(f, lowpos, highpos)
+      ELSIF write IN flags
+      THEN
+         fio := SFIO.OpenToWrite(name) ;
+         INCL(flags, opened) ;
+         SetPos(f, lowpos, highpos)
+      END
+   END
+END Doio ;
+
+
+(*
+   FileNameChar - checks to see whether the character, ch, is
+                  legal in a filename. nul is returned if the
+                  character was illegal.
+*)
+
+PROCEDURE FileNameChar (ch: CHAR) : CHAR ;
+BEGIN
+   RETURN ch
+END FileNameChar ;
+
+
+(*
+   MakeTemporary - creates a temporary file and returns its name.
+*)
+
+PROCEDURE MakeTemporary () : String ;
+VAR
+   p: FileList ;
+   i: INTEGER ;
+BEGIN
+   NEW(p) ;
+   INC(tempNo) ;
+   i := libc.getpid() ;
+   WITH p^ DO
+      next := HeadOfTemp ;
+      n    := Sprintf2(InitString('fs-%d-%d'), i, tempNo) ;
+      n    := ConCat(ConCatChar(InitString(TMPDIR), DIRSEP), n) ;
+      RETURN n
+   END
+END MakeTemporary ;
+
+
+(*
+   CleanUp - deletes all temporary files.
+*)
+
+PROCEDURE CleanUp ;
+VAR
+   p: FileList ;
+   r: INTEGER ;
+BEGIN
+   p := HeadOfTemp ;
+   WHILE p#NIL DO
+      WITH p^ DO
+         IF stillTemp
+         THEN
+            stillTemp := FALSE ;
+            r := libc.unlink(string(n))
+         END
+      END ;
+      p := p^.next
+   END
+END CleanUp ;
+
+
+(*
+   Init - installs the termination procedure to tidy up any temporary files.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   tempNo := 0 ;
+   HeadOfTemp := NIL ;
+   IF NOT InstallTerminationProcedure(CleanUp)
+   THEN
+      HALT
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END FileSystem.
diff --git a/gcc/m2/gm2-libs-pim/FloatingUtilities.def b/gcc/m2/gm2-libs-pim/FloatingUtilities.def
new file mode 100644
index 00000000000..2a6bec333ec
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/FloatingUtilities.def
@@ -0,0 +1,105 @@
+(* FloatingUtilities.def provides a Logitech compatible library.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE FloatingUtilities ;
+
+EXPORT QUALIFIED Frac, Round, Float, Trunc,
+                 Fracl, Roundl, Floatl, Truncl ;
+
+
+(*
+   Frac - returns the fractional component of, r.
+*)
+
+PROCEDURE Frac (r: REAL) : REAL ;
+
+
+(*
+   Int - returns the integer part of r. It rounds the value towards zero.
+*)
+
+PROCEDURE Int (r: REAL) : INTEGER ;
+
+
+(*
+   Round - returns the number rounded to the nearest integer.
+*)
+
+PROCEDURE Round (r: REAL) : INTEGER ;
+
+
+(*
+   Float - returns a REAL value corresponding to, i.
+*)
+
+PROCEDURE Float (i: INTEGER) : REAL ;
+
+
+(*
+   Trunc - round to the nearest integer not larger in absolute
+           value.
+*)
+
+PROCEDURE Trunc (r: REAL) : INTEGER ;
+
+
+(*
+   Fracl - returns the fractional component of, r.
+*)
+
+PROCEDURE Fracl (r: LONGREAL) : LONGREAL ;
+
+
+(*
+   Intl - returns the integer part of r. It rounds the value towards zero.
+*)
+
+PROCEDURE Intl (r: LONGREAL) : LONGINT ;
+
+
+(*
+   Roundl - returns the number rounded to the nearest integer.
+*)
+
+PROCEDURE Roundl (r: LONGREAL) : LONGINT ;
+
+
+(*
+   Floatl - returns a REAL value corresponding to, i.
+*)
+
+PROCEDURE Floatl (i: INTEGER) : LONGREAL ;
+
+
+(*
+   Truncl - round to the nearest integer not larger in absolute
+            value.
+*)
+
+PROCEDURE Truncl (r: LONGREAL) : LONGINT ;
+
+
+END FloatingUtilities.
diff --git a/gcc/m2/gm2-libs-pim/FloatingUtilities.mod b/gcc/m2/gm2-libs-pim/FloatingUtilities.mod
new file mode 100644
index 00000000000..3da987b0da4
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/FloatingUtilities.mod
@@ -0,0 +1,153 @@
+(* FloatingUtilities.mod provides a Logitech compatible library.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+IMPLEMENTATION MODULE FloatingUtilities ;
+
+
+(*
+   Frac - returns the fractional component of, r.
+*)
+
+PROCEDURE Frac (r: REAL) : REAL ;
+BEGIN
+   RETURN r-VAL(REAL, Int(r))
+END Frac ;
+
+
+(*
+   Int - returns the integer part of r. It rounds the value towards zero.
+*)
+
+PROCEDURE Int (r: REAL) : INTEGER ;
+BEGIN
+   IF r>=0.0
+   THEN
+      RETURN VAL(INTEGER, r)
+   ELSE
+      RETURN -VAL(INTEGER, -r)
+   END
+END Int ;
+
+
+(*
+   Round - returns the number rounded to the nearest integer.
+           It rounds away from zero.
+*)
+
+PROCEDURE Round (r: REAL) : INTEGER ;
+BEGIN
+   IF r>=0.0
+   THEN
+      RETURN Int(r+0.5)
+   ELSE
+      RETURN Int(r-0.5)
+   END
+END Round ;
+
+
+(*
+   Float - returns a REAL value corresponding to, i.
+*)
+
+PROCEDURE Float (i: INTEGER) : REAL ;
+BEGIN
+   RETURN VAL(REAL, i)
+END Float ;
+
+
+(*
+   Trunc - round to the nearest integer not larger in absolute
+           value.
+*)
+
+PROCEDURE Trunc (r: REAL) : INTEGER ;
+BEGIN
+   RETURN TRUNC(r)
+END Trunc ;
+
+
+(*
+   Fracl - returns the fractional component of, r.
+*)
+
+PROCEDURE Fracl (r: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN r-VAL(LONGREAL, Intl(r))
+END Fracl ;
+
+
+(*
+   Intl - returns the integer part of r. It rounds the value towards zero.
+*)
+
+PROCEDURE Intl (r: LONGREAL) : LONGINT ;
+BEGIN
+   IF r>=0.0
+   THEN
+      RETURN VAL(LONGINT, r)
+   ELSE
+      RETURN -VAL(LONGINT, -r)
+   END
+END Intl ;
+
+
+(*
+   Roundl - returns the number rounded to the nearest integer.
+*)
+
+PROCEDURE Roundl (r: LONGREAL) : LONGINT ;
+BEGIN
+   IF r>=0.0
+   THEN
+      RETURN Intl(r+0.5)
+   ELSE
+      RETURN Intl(r-0.5)
+   END
+END Roundl ;
+
+
+(*
+   Floatl - returns a REAL value corresponding to, i.
+*)
+
+PROCEDURE Floatl (i: INTEGER) : LONGREAL ;
+BEGIN
+   RETURN VAL(LONGREAL, i)
+END Floatl ;
+
+
+(*
+   Truncl - round to the nearest integer not larger in absolute
+            value.
+*)
+
+PROCEDURE Truncl (r: LONGREAL) : LONGINT ;
+BEGIN
+   RETURN VAL(LONGINT, r)
+END Truncl ;
+
+
+END FloatingUtilities.
diff --git a/gcc/m2/gm2-libs-pim/InOut.def b/gcc/m2/gm2-libs-pim/InOut.def
new file mode 100644
index 00000000000..efbc43ca88a
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/InOut.def
@@ -0,0 +1,190 @@
+(* InOut.def provides a compatible PIM [234] InOut module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE InOut ;
+
+IMPORT ASCII ;
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED EOL, Done, termCH, OpenInput, OpenOutput,
+                 CloseInput, CloseOutput,
+                 Read, ReadString, ReadInt, ReadCard,
+                 Write, WriteLn, WriteString, WriteInt, WriteCard,
+                 WriteOct, WriteHex,
+                 ReadS, WriteS ;
+
+CONST
+   EOL = ASCII.EOL ;
+
+VAR
+   Done  : BOOLEAN ;
+   termCH: CHAR ;
+
+
+(*
+   OpenInput - reads a string from stdin as the filename for reading.
+               If the filename ends with `.' then it appends the defext
+               extension. The global variable Done is set if all
+               was successful.
+*)
+
+PROCEDURE OpenInput (defext: ARRAY OF CHAR) ;
+
+
+(*
+   CloseInput - closes an opened input file and returns input back to
+                StdIn.
+*)
+
+PROCEDURE CloseInput ;
+
+
+(*
+   OpenOutput - reads a string from stdin as the filename for writing.
+                If the filename ends with `.' then it appends the defext
+                extension. The global variable Done is set if all
+                was successful.
+*)
+
+PROCEDURE OpenOutput (defext: ARRAY OF CHAR) ;
+
+
+(*
+   CloseOutput - closes an opened output file and returns output back to
+                 StdOut.
+*)
+
+PROCEDURE CloseOutput ;
+
+
+(*
+   Read - reads a single character from the current input file.
+          Done is set to FALSE if end of file is reached or an
+          error occurs.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   ReadString - reads a sequence of characters. Leading white space
+                is ignored and the string is terminated with a character
+                <= ' '
+*)
+
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+
+
+(*
+   WriteString - writes a string to the output file.
+*)
+
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+
+
+(*
+   Write - writes out a single character, ch, to the current output file.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+
+
+(*
+   WriteLn - writes a newline to the output file.
+*)
+
+PROCEDURE WriteLn ;
+
+
+(*
+   ReadInt - reads a string and converts it into an INTEGER, x.
+             Done is set if an INTEGER is read.
+*)
+
+PROCEDURE ReadInt (VAR x: INTEGER) ;
+
+
+(*
+   ReadInt - reads a string and converts it into an INTEGER, x.
+             Done is set if an INTEGER is read.
+*)
+
+PROCEDURE ReadCard (VAR x: CARDINAL) ;
+
+
+(*
+   WriteCard - writes the CARDINAL, x, to the output file. It ensures
+               that the number occupies, n, characters. Leading spaces
+               are added if required.
+*)
+
+PROCEDURE WriteCard (x, n: CARDINAL) ;
+
+
+(*
+   WriteInt - writes the INTEGER, x, to the output file. It ensures
+              that the number occupies, n, characters. Leading spaces
+              are added if required.
+*)
+
+PROCEDURE WriteInt (x: INTEGER; n: CARDINAL) ;
+
+
+(*
+   WriteOct - writes the CARDINAL, x, to the output file in octal.
+              It ensures that the number occupies, n, characters.
+              Leading spaces are added if required.
+*)
+
+PROCEDURE WriteOct (x, n: CARDINAL) ;
+
+
+(*
+   WriteHex - writes the CARDINAL, x, to the output file in hexadecimal.
+              It ensures that the number occupies, n, characters.
+              Leading spaces are added if required.
+*)
+
+PROCEDURE WriteHex (x, n: CARDINAL) ;
+
+
+(*
+   ReadS - returns a string which has is a sequence of characters.
+           Leading white space is ignored and string is terminated
+           with a character <= ' '.
+*)
+
+PROCEDURE ReadS () : String ;
+
+
+(*
+   WriteS - writes a String to the output device.
+            It returns the string, s.
+*)
+
+PROCEDURE WriteS (s: String) : String ;
+
+
+END InOut.
diff --git a/gcc/m2/gm2-libs-pim/InOut.mod b/gcc/m2/gm2-libs-pim/InOut.mod
new file mode 100644
index 00000000000..423fd5edd5f
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/InOut.mod
@@ -0,0 +1,434 @@
+(* InOut.mod provides a compatible PIM [234] InOut module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE InOut ;
+
+IMPORT FIO, SFIO, Terminal ;
+FROM FIO IMPORT File, StdIn, StdOut ;
+
+FROM DynamicStrings IMPORT String, InitString, Mark, KillString, ConCat,
+                           RemoveWhitePrefix, char, ConCatChar, Length ;
+
+FROM StringConvert IMPORT CardinalToString, stoc, stoi, ctos, itos ;
+FROM ASCII IMPORT nul ;
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT read, write ;
+FROM Termbase IMPORT AssignRead, AssignWrite ;
+IMPORT Keyboard ;
+
+
+CONST
+   stdin = 0 ;
+   stdout = 1 ;
+
+TYPE
+   CharSet = SET OF CHAR ;
+
+VAR
+   in, out: File ;
+   inUsed,
+   outUsed: BOOLEAN ;
+
+
+(*
+   OpenInput - reads a string from stdin as the filename for reading.
+               If the filename ends with `.' then it appends the defext
+               extension. The global variable Done is set if all
+               was successful.
+*)
+
+PROCEDURE OpenInput (defext: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := ReadS() ;
+   IF char(s, -1)='.'
+   THEN
+      s := ConCat(s, Mark(InitString(defext)))
+   END ;
+   IF SFIO.Exists(s)
+   THEN
+      in := SFIO.OpenToRead(s) ;
+      Done := FIO.IsNoError(in) ;
+      inUsed := TRUE
+   ELSE
+      Done := FALSE ;
+      inUsed := FALSE
+   END ;
+   s := KillString(s)
+END OpenInput ;
+
+
+(*
+   CloseInput - closes an opened input file and returns input back to
+                StdIn.
+*)
+
+PROCEDURE CloseInput ;
+BEGIN
+   IF inUsed
+   THEN
+      FIO.Close(in) ;
+      in := StdIn ;
+      inUsed := FALSE
+   END
+END CloseInput ;
+
+
+(*
+   OpenOutput - reads a string from stdin as the filename for writing.
+                If the filename ends with `.' then it appends the defext
+                extension. The global variable Done is set if all
+                was successful.
+*)
+
+PROCEDURE OpenOutput (defext: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := ReadS() ;
+   IF char(s, -1)='.'
+   THEN
+      s := ConCat(s, Mark(InitString(defext)))
+   END ;
+   IF SFIO.Exists(s)
+   THEN
+      out := SFIO.OpenToWrite(s) ;
+      Done := FIO.IsNoError(out) ;
+      outUsed := TRUE
+   ELSE
+      Done := FALSE ;
+      outUsed := FALSE
+   END ;
+   s := KillString(s)
+END OpenOutput ;
+
+
+(*
+   CloseOutput - closes an opened output file and returns output back to
+                 StdOut.
+*)
+
+PROCEDURE CloseOutput ;
+BEGIN
+   IF outUsed
+   THEN
+      FIO.Close(out) ;
+      out := StdOut ;
+      outUsed := FALSE
+   END
+END CloseOutput ;
+
+
+(*
+   LocalRead -
+*)
+
+PROCEDURE LocalRead (VAR ch: CHAR) ;
+BEGIN
+   ch := FIO.ReadChar(in) ;
+   Done := FIO.IsNoError(in) AND (NOT FIO.EOF(in))
+END LocalRead ;
+
+
+(*
+   LocalStatus - returns TRUE if more characters may be read.
+*)
+
+PROCEDURE LocalStatus () : BOOLEAN ;
+BEGIN
+   IF inUsed
+   THEN
+      RETURN Done
+   ELSE
+      RETURN Keyboard.KeyPressed ()
+   END
+END LocalStatus ;
+
+
+(*
+   ReadS - returns a string which has is a sequence of characters.
+           Leading white space is ignored and string is terminated
+           with a character <= ' '.
+*)
+
+PROCEDURE ReadS () : String ;
+VAR
+   s : String ;
+   ch: CHAR ;
+BEGIN
+   s := InitString('') ;
+   REPEAT
+      Read(ch)
+   UNTIL ch>' ' ;
+   WHILE ch>' ' DO
+      s := ConCatChar(s, ch) ;
+      Read(ch)
+   END ;
+   (* successful *)
+   RETURN( s )
+END ReadS ;
+
+
+(*
+   Read - reads a single character from the current input file.
+          Done is set to FALSE if end of file is reached or an
+          error occurs.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+BEGIN
+   Terminal.Read(ch)
+END Read ;
+
+
+(*
+   ReadString - reads a sequence of characters. Leading white space
+                is ignored and the string is terminated with a character
+                <= ' '
+*)
+
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+VAR
+   h, i: CARDINAL ;
+BEGIN
+   (* skip leading spaces *)
+   REPEAT
+      Read(termCH)
+   UNTIL termCH>' ' ;
+   s[0] := termCH ;
+   i := 1 ;
+   h := HIGH(s) ;
+   IF i<=h
+   THEN
+      REPEAT
+         Read(termCH) ;
+         IF termCH<=' '
+         THEN
+            s[i] := nul ;
+            (* successful *)
+            RETURN
+         END ;
+         s[i] := termCH ;
+         INC(i)
+      UNTIL i>h ;
+   END ;
+   Done := FALSE   (* out of space *)
+END ReadString ;
+
+
+(*
+   WriteString - writes a string to the output file.
+*)
+
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+BEGIN
+   FIO.WriteString(out, s) ;
+   Done := FIO.IsNoError(out)
+END WriteString ;
+
+
+(*
+   LocalWrite -
+*)
+
+PROCEDURE LocalWrite (ch: CHAR) ;
+BEGIN
+   FIO.WriteChar(out, ch) ;
+   Done := FIO.IsNoError(out)
+(*
+   IF outUsed
+   THEN
+      FIO.WriteChar(out, ch) ;
+      Done := FIO.IsNoError(out)
+   ELSE
+      Done := (write(stdout, ADR(ch), 1) = 1)
+   END
+*)
+END LocalWrite ;
+
+
+(*
+   Write - writes out a single character, ch, to the current output file.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+BEGIN
+   Terminal.Write(ch)
+END Write ;
+
+
+(*
+   WriteS - writes a String to the output device.
+            It returns the string, s.
+*)
+
+PROCEDURE WriteS (s: String) : String ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   i := 0 ;
+   h := Length(s) ;
+   WHILE i<h DO
+      Write(char(s, i)) ;
+      INC(i)
+   END ;
+   RETURN( s )
+END WriteS ;
+
+
+(*
+   WriteLn - writes a newline to the output file.
+*)
+
+PROCEDURE WriteLn ;
+BEGIN
+   IF outUsed
+   THEN
+      FIO.WriteLine(out) ;
+      Done := FIO.IsNoError(out)
+   ELSE
+      Terminal.WriteLn
+   END
+END WriteLn ;
+
+
+(*
+   ReadInt - reads a string and converts it into an INTEGER, x.
+             Done is set if an INTEGER is read.
+*)
+
+PROCEDURE ReadInt (VAR x: INTEGER) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(ReadS()) ;
+   IF char(s, 0) IN CharSet{'-', '+', '0'..'9'}
+   THEN
+      x := stoi(s) ;
+      Done := TRUE
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadInt ;
+
+
+(*
+   ReadInt - reads a string and converts it into an INTEGER, x.
+             Done is set if an INTEGER is read.
+*)
+
+PROCEDURE ReadCard (VAR x: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(ReadS()) ;
+   IF char(s, 0) IN CharSet{'+', '0'..'9'}
+   THEN
+      x := stoc(s) ;
+      Done := TRUE
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadCard ;
+
+
+(*
+   WriteCard - writes the CARDINAL, x, to the output file. It ensures
+               that the number occupies, n, characters. Leading spaces
+               are added if required.
+*)
+
+PROCEDURE WriteCard (x, n: CARDINAL) ;
+BEGIN
+   IF KillString(SFIO.WriteS(out, ctos(x, n, ' ')))=NIL
+   THEN
+   END
+END WriteCard ;
+
+
+(*
+   WriteInt - writes the INTEGER, x, to the output file. It ensures
+              that the number occupies, n, characters. Leading spaces
+              are added if required.
+*)
+
+PROCEDURE WriteInt (x: INTEGER; n: CARDINAL) ;
+BEGIN
+   IF KillString(SFIO.WriteS(out, itos(x, n, ' ', FALSE)))=NIL
+   THEN
+   END
+END WriteInt ;
+
+
+(*
+   WriteOct - writes the CARDINAL, x, to the output file in octal.
+              It ensures that the number occupies, n, characters.
+              Leading spaces are added if required.
+*)
+
+PROCEDURE WriteOct (x, n: CARDINAL) ;
+BEGIN
+   IF KillString(SFIO.WriteS(out, CardinalToString(x, n, ' ', 8, FALSE)))=NIL
+   THEN
+   END
+END WriteOct ;
+
+
+(*
+   WriteHex - writes the CARDINAL, x, to the output file in hexadecimal.
+              It ensures that the number occupies, n, characters.
+              Leading spaces are added if required.
+*)
+
+PROCEDURE WriteHex (x, n: CARDINAL) ;
+BEGIN
+   IF KillString(SFIO.WriteS(out, CardinalToString(x, n, ' ', 16, TRUE)))=NIL
+   THEN
+   END
+END WriteHex ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   in := FIO.StdIn ;
+   out := FIO.StdOut ;
+   inUsed := FALSE ;
+   outUsed := FALSE ;
+   AssignRead(LocalRead, LocalStatus, Done) ;
+   AssignWrite(LocalWrite, Done)
+END Init ;
+
+
+BEGIN
+   Init
+END InOut.
diff --git a/gcc/m2/gm2-libs-pim/Keyboard.def b/gcc/m2/gm2-libs-pim/Keyboard.def
new file mode 100644
index 00000000000..68b3fa5e58f
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Keyboard.def
@@ -0,0 +1,48 @@
+(* Keyboard.def provides compatibility with Logitech 3.0 Keyboard module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE Keyboard ;
+
+EXPORT QUALIFIED Read, KeyPressed ;
+
+
+(*
+   Read - reads a character from StdIn. If necessary it will wait
+          for a key to become present on StdIn.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   KeyPressed - returns TRUE if a character can be read from StdIn
+                without blocking the caller.
+*)
+
+PROCEDURE KeyPressed () : BOOLEAN ;
+
+
+END Keyboard.
diff --git a/gcc/m2/gm2-libs-pim/Keyboard.mod b/gcc/m2/gm2-libs-pim/Keyboard.mod
new file mode 100644
index 00000000000..5b4f02ca922
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Keyboard.mod
@@ -0,0 +1,74 @@
+(* Keyboard.mod provides compatibility with Logitech 3.0 Keyboard module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Keyboard ;
+
+FROM Selective IMPORT SetOfFd, InitSet, KillSet, MaxFdsPlusOne, ReadCharRaw,
+                      Timeval, InitTime, KillTime, FdIsSet, FdZero, FdSet,
+                      Select ;
+
+
+CONST
+   stdin = 0 ;
+
+
+(*
+   Read - reads a character from StdIn. If necessary it will wait
+          for a key to become present on StdIn.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+BEGIN
+   ch := ReadCharRaw(stdin)
+END Read ;
+
+
+(*
+   KeyPressed - returns TRUE if a character can be read from StdIn
+                without blocking the caller.
+*)
+
+PROCEDURE KeyPressed () : BOOLEAN ;
+VAR
+   s      : SetOfFd ;
+   t      : Timeval ;
+   r      : INTEGER ;
+   Pressed: BOOLEAN ;
+BEGIN
+   t := InitTime(0, 0) ;
+   s := InitSet() ;
+   FdZero(s) ;
+   FdSet(stdin, s) ;
+   r := Select(MaxFdsPlusOne(stdin, stdin),
+               s, NIL, NIL, t) ;
+   Pressed := FdIsSet(stdin, s) ;
+   s := KillSet(s) ;
+   t := KillTime(t) ;
+   RETURN( Pressed )
+END KeyPressed ;
+
+
+END Keyboard.
diff --git a/gcc/m2/gm2-libs-pim/LongIO.def b/gcc/m2/gm2-libs-pim/LongIO.def
new file mode 100644
index 00000000000..6569fc8e61a
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/LongIO.def
@@ -0,0 +1,38 @@
+(* LongIO.def provides a Logitech-3.0 compatible library for GNU Modula-2.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE LongIO ;
+
+EXPORT QUALIFIED Done, ReadLongInt, WriteLongInt ;
+
+VAR
+   Done: BOOLEAN ;
+
+PROCEDURE ReadLongInt (VAR i: LONGINT) ;
+PROCEDURE WriteLongInt (i: LONGINT; n: CARDINAL) ;
+
+
+END LongIO.
diff --git a/gcc/m2/gm2-libs-pim/LongIO.mod b/gcc/m2/gm2-libs-pim/LongIO.mod
new file mode 100644
index 00000000000..8c346c6f7e3
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/LongIO.mod
@@ -0,0 +1,65 @@
+(* LongIO.mod provides a Logitech-3.0 compatible library for GNU Modula-2.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LongIO ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, RemoveWhitePrefix ;
+FROM StringConvert IMPORT StringToLongInteger, LongIntegerToString ;
+
+IMPORT InOut ;
+
+
+
+PROCEDURE ReadLongInt (VAR i: LONGINT) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      i := StringToLongInteger(s, 10, Done)
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadLongInt ;
+
+
+PROCEDURE WriteLongInt (i: LONGINT; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   IF i<0
+   THEN
+      s := KillString(InOut.WriteS(LongIntegerToString(i, n, ' ', TRUE, 10, FALSE)))
+   ELSE
+      s := KillString(InOut.WriteS(LongIntegerToString(i, n, ' ', FALSE, 10, FALSE)))
+   END ;
+   Done := TRUE
+END WriteLongInt ;
+
+
+END LongIO.
diff --git a/gcc/m2/gm2-libs-pim/NumberConversion.def b/gcc/m2/gm2-libs-pim/NumberConversion.def
new file mode 100644
index 00000000000..dceeb5207d9
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/NumberConversion.def
@@ -0,0 +1,31 @@
+(* NumberConversion.def provides a Logitech compatible conversion library.
+
+Copyright (C) 2007-2021 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/>.  *)
+
+DEFINITION MODULE NumberConversion ;
+
+(* --fixme-- finish this.  *)
+
+END NumberConversion.
diff --git a/gcc/m2/gm2-libs-pim/NumberConversion.mod b/gcc/m2/gm2-libs-pim/NumberConversion.mod
new file mode 100644
index 00000000000..b541a0b21c8
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/NumberConversion.mod
@@ -0,0 +1,31 @@
+(* NumberConversion.mod provides a Logitech compatible conversion library.
+
+Copyright (C) 2007-2021 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/>.  *)
+
+IMPLEMENTATION MODULE NumberConversion ;
+
+(* --fixme-- finish this.  *)
+
+END NumberConversion.
diff --git a/gcc/m2/gm2-libs-pim/README.texi b/gcc/m2/gm2-libs-pim/README.texi
new file mode 100644
index 00000000000..8bf4d7b3843
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/README.texi
@@ -0,0 +1,44 @@
+@c README.texi describes the additional PIM libraries.
+@c Copyright @copyright{} 2000-2020 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+These modules are provided to enable legacy Modula-2 applications to
+build with GNU Modula-2. It is advised that these module should not
+be used for new projects, maybe the ISO libraries or the native
+compiler PIM libraries (FIO) should be used instead.
+
+Here is an outline of the module layering:
+
+@example
+
+InOut  RealInOut  LongIO CardinalIO
+    \     |       |      /
+           Terminal
+-----------------------------------
+              |
+           Termbase
+           /      \
+    Keyboard      Display
+
+@end example
+
+Above the line are user level PIM [234] and Logitech 3.0 compatible
+modules.  Below the line Logitech 3.0 advised that these modules
+should be considered part of the runtime system. The libraries do
+not provide all the features found in the Logitech libraries as
+a number of these features were MS-DOS related. Essentially the
+basic input/output, file system, string manipulation and conversion
+routines are provided. Access to DOSCALL, graphics, time and date
+are not as these were constrained by the limitations of MS-DOS.
+
+The following libraries are contained within the base GNU Modula-2
+libraries and are also Logitech-3.0 compatible: @xref{gm2-libs/ASCII},
+@xref{gm2-libs/Storage} and @xref{gm2-libs/MathLib0}.  These libraries
+are always available for any dialect of the language (although their
+implementation and behaviour might differ, for example Storage ISO and
+PIM).
+
+The following libraries are Logitech-3.0 compatible but fall outside
+the base GNU Modula-2 libraries.
diff --git a/gcc/m2/gm2-libs-pim/Random.def b/gcc/m2/gm2-libs-pim/Random.def
new file mode 100644
index 00000000000..c3bacad2ee6
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Random.def
@@ -0,0 +1,83 @@
+(* Random.def provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE Random ;
+
+FROM SYSTEM IMPORT BYTE ;
+EXPORT QUALIFIED Randomize, RandomInit, RandomBytes, RandomCard, RandomInt, RandomReal, RandomLongReal ;
+
+
+(*
+   Randomize - initialize the random number generator with a seed
+               based on the microseconds.
+*)
+
+PROCEDURE Randomize ;
+
+
+(*
+   RandomInit - initialize the random number generator with value, seed.
+*)
+
+PROCEDURE RandomInit (seed: CARDINAL) ;
+
+
+(*
+   RandomBytes - fills in an array with random values.
+*)
+
+PROCEDURE RandomBytes (VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   RandomInt - return an INTEGER in the range 0..bound-1
+*)
+
+PROCEDURE RandomInt (bound: INTEGER) : INTEGER ;
+
+
+(*
+   RandomCard - return a CARDINAL in the range 0..bound-1
+*)
+
+PROCEDURE RandomCard (bound: CARDINAL) : CARDINAL ;
+
+
+(*
+   RandomReal - return a REAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomReal () : REAL ;
+
+
+(*
+   RandomLongReal - return a LONGREAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomLongReal () : LONGREAL ;
+
+
+END Random.
diff --git a/gcc/m2/gm2-libs-pim/Random.mod b/gcc/m2/gm2-libs-pim/Random.mod
new file mode 100644
index 00000000000..73d7a1c37ce
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Random.mod
@@ -0,0 +1,133 @@
+(* Random.mod provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Random ;
+
+FROM libc IMPORT rand, srand ;
+FROM Selective IMPORT Timeval, InitTime, KillTime, GetTime, GetTimeOfDay ;
+
+
+(*
+   Randomize - initialize the random number generator with a seed
+               based on the microseconds.
+*)
+
+PROCEDURE Randomize ;
+VAR
+   t        : Timeval ;
+   sec, usec: CARDINAL ;
+BEGIN
+   t := InitTime (0, 0) ;
+   IF GetTimeOfDay (t) = 0
+   THEN
+   END ;
+   GetTime (t, sec, usec) ;
+   RandomInit (usec) ;
+   t := KillTime (t)
+END Randomize ;
+
+
+(*
+   RandomInit - initialize the random number generator with value, seed.
+*)
+
+PROCEDURE RandomInit (seed: CARDINAL) ;
+BEGIN
+   srand (seed)
+END RandomInit ;
+
+
+(*
+   RandomBytes - fills in an array with random values.
+*)
+
+PROCEDURE RandomBytes (VAR a: ARRAY OF BYTE) ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   h := HIGH (a) ;
+   i := 0 ;
+   WHILE i <= h DO
+      a[i] := VAL (BYTE, rand ()) ;
+      INC (i)
+   END
+END RandomBytes ;
+
+
+(*
+   RandomInt - return an INTEGER in the range 0..bound-1
+*)
+
+PROCEDURE RandomInt (bound: INTEGER) : INTEGER ;
+BEGIN
+   IF bound=0
+   THEN
+      RETURN rand ()
+   ELSE
+      RETURN rand () MOD bound
+   END
+END RandomInt ;
+
+
+(*
+   RandomCard - return a CARDINAL in the range 0..bound-1
+*)
+
+PROCEDURE RandomCard (bound: CARDINAL) : CARDINAL ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   RandomBytes (c) ;
+   RETURN c MOD bound
+END RandomCard ;
+
+
+(*
+   RandomReal - return a REAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomReal () : REAL ;
+BEGIN
+   RETURN RandomLongReal ()
+END RandomReal ;
+
+
+(*
+   RandomLongReal - return a LONGREAL number in the range 0.0..1.0
+*)
+
+PROCEDURE RandomLongReal () : LONGREAL ;
+VAR
+   l: LONGCARD ;
+BEGIN
+   RandomBytes (l) ;
+   RETURN VAL (LONGREAL, l) / VAL (LONGREAL, MAX (LONGCARD))
+END RandomLongReal ;
+
+
+BEGIN
+   Randomize
+END Random.
diff --git a/gcc/m2/gm2-libs-pim/RealConversions.def b/gcc/m2/gm2-libs-pim/RealConversions.def
new file mode 100644
index 00000000000..7ab19730bb5
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/RealConversions.def
@@ -0,0 +1,135 @@
+(* RealConversions.def provides a Logitech-3.0 compatible module.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE RealConversions ;
+
+EXPORT QUALIFIED SetNoOfExponentDigits,
+                 RealToString, StringToReal,
+                 LongRealToString, StringToLongReal ;
+
+
+(*
+   SetNoOfExponentDigits - sets the number of exponent digits to be
+                           used during future calls of LongRealToString
+                           and RealToString providing that the width
+                           is sufficient.
+                           If this value is set to 0 (the default) then
+                           the number digits used is the minimum necessary.
+*)
+
+PROCEDURE SetNoOfExponentDigits (places: CARDINAL) ;
+
+
+(*
+   RealToString - converts a real, r, into a right justified string, str.
+                  The number of digits to the right of the decimal point
+                  is given in, digits.  The value, width, represents the
+                  maximum number of characters to be used in the string,
+                  str.
+
+                  If digits is negative then exponent notation is used
+                  whereas if digits is positive then fixed point notation
+                  is used.
+
+                  If, r, is less than 0.0 then a '-' preceeds the value,
+                  str.  However, if, r, is >= 0.0 a '+' is not added.
+
+                  If the conversion of, r, to a string requires more
+                  than, width, characters then the string, str, is set
+                  to a nul string and, ok is assigned FALSE.
+
+                  For fixed point notation the minimum width required is
+                  ABS(width)+8
+
+                  For exponent notation the minimum width required is
+                  ABS(digits)+2+log10(magnitude).
+
+                  if r is a NaN then the string 'nan' is returned formatted and
+                  ok will be FALSE.
+*)
+
+PROCEDURE RealToString (r: REAL; digits, width: INTEGER;
+                        VAR str: ARRAY OF CHAR; VAR ok: BOOLEAN) ;
+
+
+(*
+   LongRealToString - converts a real, r, into a right justified string, str.
+                      The number of digits to the right of the decimal point
+                      is given in, digits. The value, width, represents the
+                      maximum number of characters to be used in the string,
+                      str.
+
+                      If digits is negative then exponent notation is used
+                      whereas if digits is positive then fixed point notation
+                      is used.
+
+                      If, r, is less than 0.0 then a '-' preceeds the value,
+                      str. However, if, r, is >= 0.0 a '+' is not added.
+
+                      If the conversion of, r, to a string requires more
+                      than, width, characters then the string, str, is set
+                      to a nul string and, ok is assigned FALSE.
+
+                      For fixed point notation the minimum width required is
+                      ABS(width)+8
+
+                      For exponent notation the minimum width required is
+                      ABS(digits)+2+log10(magnitude).
+
+                      Examples:
+                      RealToString(100.0, 10, 10, a, ok)       ->  '100.000000'
+                      RealToString(100.0, -5, 12, a, ok)       ->  '  1.00000E+2'
+
+                      RealToString(123.456789, 10, 10, a, ok)  ->  '123.456789'
+                      RealToString(123.456789, -5, 13, a, ok)  ->  '    1.23456E+2'
+
+                      RealToString(123.456789, -2, 15, a, ok)  ->  '          1.23E+2'
+
+                      if r is a NaN then the string 'nan' is returned formatted and
+                      ok will be FALSE.
+*)
+
+PROCEDURE LongRealToString (r: LONGREAL; digits, width: INTEGER;
+                            VAR str: ARRAY OF CHAR; VAR ok: BOOLEAN) ;
+
+
+(*
+   StringToReal - converts, str, into a REAL, r. The parameter, ok, is
+                  set to TRUE if the conversion was successful.
+*)
+
+PROCEDURE StringToReal (str: ARRAY OF CHAR; VAR r: REAL; VAR ok: BOOLEAN) ;
+
+
+(*
+   StringToLongReal - converts, str, into a LONGREAL, r. The parameter, ok, is
+                      set to TRUE if the conversion was successful.
+*)
+
+PROCEDURE StringToLongReal (str: ARRAY OF CHAR; VAR r: LONGREAL; VAR ok: BOOLEAN) ;
+
+
+END RealConversions.
diff --git a/gcc/m2/gm2-libs-pim/RealConversions.mod b/gcc/m2/gm2-libs-pim/RealConversions.mod
new file mode 100644
index 00000000000..42693fe9994
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/RealConversions.mod
@@ -0,0 +1,467 @@
+(* RealConversions.mod provides a Logitech-3.0 compatible module.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RealConversions ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, CopyOut, Length,
+                           ConCat, ConCatChar, Mark, RemoveWhitePrefix,
+                           InitStringChar, Mult, Slice, Index, char, string,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+FROM StringConvert IMPORT LongrealToString, StringToLongreal,
+                          StringToLongreal, StringToInteger, itos ;
+
+FROM ASCII IMPORT nul ;
+FROM Builtins IMPORT logl, log10l ;
+FROM libm IMPORT powl ;
+FROM libc IMPORT printf ;
+
+
+CONST
+   Debugging = FALSE ;
+   DefaultExponentDigits = 0 ;
+
+VAR
+   ExponentDigits: CARDINAL ;
+
+(*
+#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__)
+*)
+
+(*
+   logl10 -
+*)
+
+PROCEDURE logl10 (r: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN logl(r)/logl(10.0)
+END logl10 ;
+
+
+(*
+   logi10 -
+*)
+
+PROCEDURE logi10 (i: INTEGER) : INTEGER ;
+VAR
+   j: INTEGER ;
+BEGIN
+   j := 0 ;
+   IF i<0
+   THEN
+      WHILE i<-9 DO
+         DEC(j) ;
+         i := i DIV 10
+      END
+   ELSE
+      WHILE i>9 DO
+         INC(j) ;
+         i := i DIV 10
+      END
+   END ;
+   RETURN j
+END logi10 ;
+
+
+(*
+   powl10 -
+*)
+
+PROCEDURE powl10 (i: INTEGER) : LONGREAL ;
+VAR
+   r: LONGREAL ;
+BEGIN
+   r := 1.0 ;
+   IF i<0
+   THEN
+      WHILE i<0 DO
+         r := r/10.0 ;
+         INC(i)
+      END
+   ELSE
+      WHILE i>0 DO
+         r := r*10.0 ;
+         DEC(i)
+      END
+   END ;
+   RETURN r
+END powl10 ;
+
+
+(*
+   doPowerOfTen - safely returns the exponent of a LONGREAL as an INTEGER.
+*)
+
+PROCEDURE doPowerOfTen (r: LONGREAL) : INTEGER ;
+VAR
+   i   : INTEGER ;
+   c, d: LONGREAL ;
+BEGIN
+   IF r=0.0
+   THEN
+      RETURN( 0 )
+   ELSE
+      IF r<0.0
+      THEN
+         c := -r
+      ELSE
+         c := r
+      END ;
+      IF c>=1.0
+      THEN
+         RETURN( VAL(INTEGER, log10l(c)) )
+      ELSE
+         i := 0 ;
+         LOOP
+            d := c*powl(10.0, VAL(LONGREAL, i)) ;
+            IF d>=1.0
+            THEN
+               RETURN( -i )
+            ELSE
+               INC(i)
+            END
+         END
+      END
+   END
+END doPowerOfTen ;
+
+
+(*
+   SetNoOfExponentDigits - sets the number of exponent digits to be
+                           used during future calls of LongRealToString
+                           and RealToString providing that the width
+                           is sufficient.
+                           If this value is set to 0 (the default) then
+                           the number digits used is the minimum necessary.
+*)
+
+PROCEDURE SetNoOfExponentDigits (places: CARDINAL) ;
+BEGIN
+   ExponentDigits := places
+END SetNoOfExponentDigits ;
+
+
+(*
+   Pad - prefixes spaces in front of, s, so that width characters are used.
+*)
+
+PROCEDURE Pad (s: String; width: CARDINAL) : String ;
+BEGIN
+   IF Length(s)<width
+   THEN
+      RETURN( ConCat(Mult(InitStringChar(' '), width-Length(s)), Mark(s)) )
+   ELSE
+      RETURN( s )
+   END
+END Pad ;
+
+
+(*
+   MakeNanString -
+*)
+
+PROCEDURE MakeNanString (VAR str: ARRAY OF CHAR; width: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := Pad(InitString('nan'), width) ;
+   IF Length(s)<=width
+   THEN
+      CopyOut(str, s)
+   ELSE
+      str[0] := nul
+   END ;
+   s := KillString(s)
+END MakeNanString ;
+
+
+(*
+   RealToString - converts a real, r, into a right justified string, str.
+                  The number of digits to the right of the decimal point
+                  is given in, digits.  The value, width, represents the
+                  maximum number of characters to be used in the string,
+                  str.
+
+                  If digits is negative then exponental notation is used
+                  whereas if digits is positive then fixed point notation
+                  is used.
+
+                  If, r, is less than 0.0 then a '-' preceeds the value,
+                  str.  However, if, r, is >= 0.0 a '+' is not added.
+
+                  If the conversion of, r, to a string requires more
+                  than, width, characters then the string, str, is set
+                  to a nul string and, ok is assigned FALSE.
+
+                  For fixed point notation the minimum width required is
+                  ABS(width)+8
+
+                  For exponent notation the minimum width required is
+                  ABS(digits)+2+log10(magnitude).
+
+                  if r is a NaN then the string 'nan' is returned formatted
+                  and ok will be FALSE.
+*)
+
+PROCEDURE RealToString (r: REAL; digits, width: INTEGER;
+                        VAR str: ARRAY OF CHAR; VAR ok: BOOLEAN) ;
+VAR
+   l: LONGREAL ;
+BEGIN
+   (* --fixme-- *)
+   (* IF IsNan(r)
+      THEN
+         ok := FALSE ;
+         MakeNanString(str, width) ;
+      ELSE
+         ...
+      END
+   *)
+   l := VAL(LONGREAL, r) ;
+   LongRealToString(l, digits, width, str, ok)
+END RealToString ;
+
+
+(*
+   doLongRealToString -
+*)
+
+PROCEDURE doLongRealToString (r: LONGREAL; digits, width, powerOfTen: INTEGER; VAR ok: BOOLEAN) : String ;
+VAR
+   sign, s , e  : String ;
+   point, len: INTEGER ;
+BEGIN
+   IF digits>0
+   THEN
+      ok := TRUE ;
+      RETURN( Slice(Mark(LongrealToString(r, width, digits)), 0, width) )
+   ELSE
+      digits := ABS(digits) ;
+      IF r>=0.0
+      THEN
+         sign := InitString('')
+      ELSE
+         sign := InitString('-') ;
+         r := -r
+      END ;
+      s := InitString('') ;
+      r := r*powl10(-powerOfTen) ;
+      IF width>=VAL(INTEGER, Length(s))+2
+      THEN
+         s := ConCat(s, Mark(RemoveWhitePrefix(Mark(LongrealToString(r, width+1, width))))) ;
+         IF Debugging
+         THEN
+            printf('value returned was %s\n', string(s))
+         END ;
+         point := Index(s, '.', 0) ;
+         IF point>=0
+         THEN
+            (* remove the '.' *)
+            s := ConCat(Slice(Mark(s), 0, point), Mark(Slice(Mark(s), point+1, 0))) ;
+            s := Slice(Mark(s), 0, width) ;
+            IF Debugging
+            THEN
+               printf('value returned was %s\n', string(s))
+            END ;
+            point := powerOfTen ;
+            (* now strip off trailing '0's *)
+            WHILE (Length(s)>2) AND (char(s, -1)='0') DO
+               s := Slice(Mark(s), 0, -1)
+            END ;
+            len := Length(s) ;
+            IF Debugging
+            THEN
+               printf('point = %d, powerOfTen = %d, len = %d,  len-point = %d\n',
+                      point, powerOfTen, len, len-point) ;
+               printf('value returned was %s\n', string(s))
+            END ;
+            WHILE len<2 DO
+               s := ConCat(s, Mark(InitString('0'))) ;
+               len := Length(s)
+            END ;
+            point := 1 ;
+            IF digits>width-point-2
+            THEN
+               (* need to round the result *)
+               digits := width-point-2
+            END ;
+            s := ConCat(Slice(s, 0, point),
+                        Mark(ConCat(InitStringChar('.'),
+                                    Mark(Slice(Mark(s), point, point+digits))))) ;
+            IF Debugging
+            THEN
+               printf("value returned was '%s'\n", string(s))
+            END ;
+            (* and add trailing '0's if needed *)
+            IF VAL(INTEGER, Length(s))-point<digits+1
+            THEN
+               s := ConCat(s, Mark(Mult(Mark(InitString('0')), digits+1-(VAL(INTEGER, Length(s))-point)))) ;
+               IF Debugging
+               THEN
+                  printf("value returned was '%s'\n", string(s))
+               END
+            END ;
+            IF powerOfTen-point+1>=0
+            THEN
+               e := ConCat(InitString('E+'),
+                           Mark(itos(powerOfTen-point+1, ExponentDigits, '0', FALSE)))
+            ELSE
+               e := ConCat(InitString('E-'),
+                           Mark(itos(ABS(powerOfTen-point+1), ExponentDigits, '0', FALSE)))
+            END ;
+            IF Debugging
+            THEN
+               printf("value returned was '%s' and '%s'\n", string(s), string(e))
+            END
+         END ;
+         s := ConCat(sign, Mark(ConCat(s, Mark(e)))) ;
+         ok := TRUE
+      ELSE
+         s := InitString('') ;
+         ok := FALSE
+      END
+   END ;
+   RETURN( s )
+END doLongRealToString ;
+
+
+(*
+   LongRealToString - converts a real, r, into a right justified string, str.
+                      The number of digits to the right of the decimal point
+                      is given in, digits.  The value, width, represents the
+                      maximum number of characters to be used in the string,
+                      str.
+
+                      If digits is negative then exponent notation is used
+                      whereas if digits is positive then fixed point notation
+                      is used.
+
+                      If, r, is less than 0.0 then a '-' preceeds the value,
+                      str.  However, if, r, is >= 0.0 a '+' is not added.
+
+                      If the conversion of, r, to a string requires more
+                      than, width, characters then the string, str, is set
+                      to a nul string and, ok is assigned FALSE.
+
+                      For fixed point notation the minimum width required is
+                      ABS(width)+8
+
+                      For exponent notation the minimum width required is
+                      ABS(digits)+2+log10(magnitude).
+
+                      Examples:
+                      RealToString(100.0, 10, 10, a, ok)       ->  '100.000000'
+                      RealToString(100.0, -5, 12, a, ok)       ->  '  1.00000E+2'
+
+                      RealToString(123.456789, 10, 10, a, ok)  ->  '123.456789'
+                      RealToString(123.456789, -5, 13, a, ok)  ->  '    1.23456E+2'
+
+                      RealToString(123.456789, -2, 15, a, ok)  ->  '          1.23E+2'
+
+                      if r is a NaN then the string 'nan' is returned formatted and
+                      ok will be FALSE.
+*)
+
+PROCEDURE LongRealToString (r: LONGREAL; digits, width: INTEGER;
+                            VAR str: ARRAY OF CHAR; VAR ok: BOOLEAN) ;
+VAR
+   s         : String ;
+   powerOfTen: INTEGER ;
+BEGIN
+   (* --fixme-- *)
+   (* IF IsNan(r)
+      THEN
+         ok := FALSE ;
+         MakeNanString(str, width) ;
+         RETURN
+      END
+   *)
+   powerOfTen := doPowerOfTen(r) ;
+   IF (powerOfTen=MAX(INTEGER)) OR (powerOfTen=MIN(INTEGER))
+   THEN
+      ok := FALSE ;
+      MakeNanString(str, width) ;
+      RETURN
+   END ;
+   s := doLongRealToString(r, digits, width, powerOfTen, ok) ;
+   ok := TRUE ;
+   IF VAL(INTEGER, Length(s))<=width
+   THEN
+      s := ConCat(Mult(Mark(InitStringChar(' ')), width-VAL(INTEGER, Length(s))), Mark(s)) ;
+      IF Debugging
+      THEN
+         printf('value returned was %s\n', string(s))
+      END ;
+      CopyOut(str, s)
+   ELSE
+      str[0] := nul ;
+      ok := FALSE
+   END ;
+   s := KillString(s)
+END LongRealToString ;
+
+
+(*
+   StringToLongReal - converts, str, into a LONGREAL, r. The parameter, ok, is
+                      set to TRUE if the conversion was successful.
+*)
+
+PROCEDURE StringToLongReal (str: ARRAY OF CHAR; VAR r: LONGREAL; VAR ok: BOOLEAN) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString(str) ;
+   r := StringToLongreal(s, ok) ;
+   s := KillString(s)
+END StringToLongReal ;
+
+
+(*
+   StringToReal - converts, str, into a REAL, r. The parameter, ok, is
+                  set to TRUE if the conversion was successful.
+*)
+
+PROCEDURE StringToReal (str: ARRAY OF CHAR; VAR r: REAL; VAR ok: BOOLEAN) ;
+VAR
+   l: LONGREAL ;
+BEGIN
+   StringToLongReal(str, l, ok) ;
+   IF ok
+   THEN
+      r := VAL(REAL, l)
+   END
+END StringToReal ;
+
+
+BEGIN
+   ExponentDigits := DefaultExponentDigits
+END RealConversions.
diff --git a/gcc/m2/gm2-libs-pim/RealInOut.def b/gcc/m2/gm2-libs-pim/RealInOut.def
new file mode 100644
index 00000000000..cdaaa3ac86e
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/RealInOut.def
@@ -0,0 +1,124 @@
+(* RealInOut.def provides a compatible RealInOut PIM 234 module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE RealInOut ;
+
+EXPORT QUALIFIED SetNoOfDecimalPlaces,
+                 ReadReal, WriteReal, WriteRealOct,
+                 ReadLongReal, WriteLongReal, WriteLongRealOct,
+                 ReadShortReal, WriteShortReal, WriteShortRealOct,
+                 Done ;
+
+CONST
+   DefaultDecimalPlaces = 6 ;
+
+VAR
+   Done: BOOLEAN ;
+
+
+(*
+   SetNoOfDecimalPlaces - number of decimal places WriteReal and
+                          WriteLongReal should emit.  This procedure
+                          can be used to override the default
+                          DefaultDecimalPlaces constant.
+*)
+
+PROCEDURE SetNoOfDecimalPlaces (places: CARDINAL) ;
+
+
+(*
+   ReadReal - reads a real number, legal syntaxes include:
+              100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+PROCEDURE ReadReal (VAR x: REAL) ;
+
+
+(*
+   WriteReal - writes a real to the terminal. The real number
+               is right justified and, n, is the minimum field
+               width.
+*)
+
+PROCEDURE WriteReal (x: REAL; n: CARDINAL) ;
+
+
+(*
+   WriteRealOct - writes the real to terminal in octal words.
+*)
+
+PROCEDURE WriteRealOct (x: REAL) ;
+
+
+(*
+   ReadLongReal - reads a LONGREAL number, legal syntaxes include:
+                  100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+PROCEDURE ReadLongReal (VAR x: LONGREAL) ;
+
+
+(*
+   WriteLongReal - writes a LONGREAL to the terminal. The real number
+                   is right justified and, n, is the minimum field
+                   width.
+*)
+
+PROCEDURE WriteLongReal (x: LONGREAL; n: CARDINAL) ;
+
+
+(*
+   WriteLongRealOct - writes the LONGREAL to terminal in octal words.
+*)
+
+PROCEDURE WriteLongRealOct (x: LONGREAL) ;
+
+
+(*
+   ReadShortReal - reads a SHORTREAL number, legal syntaxes include:
+                   100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+PROCEDURE ReadShortReal (VAR x: SHORTREAL) ;
+
+
+(*
+   WriteShortReal - writes a SHORTREAL to the terminal. The real number
+                    is right justified and, n, is the minimum field
+                    width.
+*)
+
+PROCEDURE WriteShortReal (x: SHORTREAL; n: CARDINAL) ;
+
+
+(*
+   WriteShortRealOct - writes the SHORTREAL to terminal in octal words.
+*)
+
+PROCEDURE WriteShortRealOct (x: SHORTREAL) ;
+
+
+END RealInOut.
diff --git a/gcc/m2/gm2-libs-pim/RealInOut.mod b/gcc/m2/gm2-libs-pim/RealInOut.mod
new file mode 100644
index 00000000000..68697d0d213
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/RealInOut.mod
@@ -0,0 +1,248 @@
+(* RealInOut.mod provides a compatible RealInOut PIM 234 module.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RealInOut ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, RemoveWhitePrefix,
+                           Length, Mult, InitStringChar, Mark, ConCat,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+FROM StringConvert IMPORT StringToLongreal, LongrealToString ;
+FROM SYSTEM IMPORT ADR, BYTE ;
+IMPORT InOut ;
+
+VAR
+   DecimalPlacesLength: CARDINAL ;
+
+(*
+ #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__)
+*)
+
+(*
+   SetNoOfDecimalPlaces - number of decimal places WriteReal and
+                          WriteLongReal should emit.  This procedure
+                          can be used to override the default
+                          DefaultDecimalPlaces constant.
+*)
+
+PROCEDURE SetNoOfDecimalPlaces (places: CARDINAL) ;
+BEGIN
+   DecimalPlacesLength := places
+END SetNoOfDecimalPlaces ;
+
+
+(*
+   Pad - return a padded string with prefixed white space to ensure
+         that at least, n, characters are used.
+*)
+
+PROCEDURE Pad (s: String; n: CARDINAL) : String ;
+BEGIN
+   IF Length(s)<n
+   THEN
+      s := ConCat(Mult(Mark(InitStringChar(' ')), n-Length(s)), Mark(s))
+   END ;
+   RETURN( s )
+END Pad ;
+
+
+(*
+   ReadReal - reads a real number, legal syntaxes include:
+              100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+PROCEDURE ReadReal (VAR x: REAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      x := VAL(REAL, StringToLongreal(s, Done))
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadReal ;
+
+
+(*
+   WriteReal - writes a real to the terminal. The real number
+               is right justified and, n, is the minimum field
+               width.
+*)
+
+PROCEDURE WriteReal (x: REAL; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := LongrealToString(VAL(LONGREAL, x), 0, DecimalPlacesLength) ;
+   s := Pad(s, n) ;
+   s := KillString(InOut.WriteS(s)) ;
+   Done := TRUE
+END WriteReal ;
+
+
+(*
+   WriteRealOct - writes the real to terminal in octal words.
+*)
+
+PROCEDURE WriteRealOct (x: REAL) ;
+VAR
+   p: POINTER TO BYTE ;
+   i: CARDINAL ;
+BEGIN
+   p := ADR(x) ;
+   i := 0 ;
+   WHILE i<SIZE(x) DO
+      InOut.WriteOct(VAL(CARDINAL, p^), 3) ;
+      INC(p) ;
+      INC(i)
+   END
+END WriteRealOct ;
+
+
+(*
+   ReadLongReal - reads a LONGLONGREAL number, legal syntaxes include:
+                  100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+PROCEDURE ReadLongReal (VAR x: LONGREAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      x := StringToLongreal(s, Done)
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadLongReal ;
+
+
+(*
+   WriteLongReal - writes a real to the terminal. The real number
+                   is right justified and, n, is the minimum field
+                   width.
+*)
+
+PROCEDURE WriteLongReal (x: LONGREAL; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := LongrealToString(VAL(LONGREAL, x), 0, DecimalPlacesLength) ;
+   s := Pad(s, n) ;
+   s := KillString(InOut.WriteS(s)) ;
+   Done := TRUE
+END WriteLongReal ;
+
+
+(*
+   WriteLongRealOct - writes the real to terminal in octal words.
+*)
+
+PROCEDURE WriteLongRealOct (x: LONGREAL) ;
+VAR
+   p: POINTER TO BYTE ;
+   i: CARDINAL ;
+BEGIN
+   p := ADR(x) ;
+   i := 0 ;
+   WHILE i<SIZE(x) DO
+      InOut.WriteOct(VAL(CARDINAL, p^), 3) ;
+      INC(p) ;
+      INC(i)
+   END
+END WriteLongRealOct ;
+
+
+(*
+   ReadShortReal - reads a SHORTREAL number, legal syntaxes include:
+                   100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+PROCEDURE ReadShortReal (VAR x: SHORTREAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := RemoveWhitePrefix(InOut.ReadS()) ;
+   IF InOut.Done
+   THEN
+      x := VAL(SHORTREAL, StringToLongreal(s, Done))
+   ELSE
+      Done := FALSE
+   END ;
+   s := KillString(s)
+END ReadShortReal ;
+
+
+(*
+   WriteShortReal - writes a real to the terminal. The real number
+                    is right justified and, n, is the minimum field
+                    width.
+*)
+
+PROCEDURE WriteShortReal (x: SHORTREAL; n: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := LongrealToString(VAL(LONGREAL, x), 0, DecimalPlacesLength) ;
+   s := Pad(s, n) ;
+   s := KillString(InOut.WriteS(s)) ;
+   Done := TRUE
+END WriteShortReal ;
+
+
+(*
+   WriteShortRealOct - writes the real to terminal in octal words.
+*)
+
+PROCEDURE WriteShortRealOct (x: SHORTREAL) ;
+VAR
+   p: POINTER TO BYTE ;
+   i: CARDINAL ;
+BEGIN
+   p := ADR(x) ;
+   i := 0 ;
+   WHILE i<SIZE(x) DO
+      InOut.WriteOct(VAL(CARDINAL, p^), 3) ;
+      INC(p) ;
+      INC(i)
+   END
+END WriteShortRealOct ;
+
+
+BEGIN
+   DecimalPlacesLength := DefaultDecimalPlaces
+END RealInOut.
diff --git a/gcc/m2/gm2-libs-pim/Strings.def b/gcc/m2/gm2-libs-pim/Strings.def
new file mode 100644
index 00000000000..cd1c4bd82db
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Strings.def
@@ -0,0 +1,92 @@
+(* Strings.def provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE Strings ;
+
+EXPORT QUALIFIED Assign, Insert, Delete, Pos, Copy, ConCat, Length,
+                 CompareStr ;
+
+(*
+   Assign - dest := source.
+*)
+
+PROCEDURE Assign (VAR dest: ARRAY OF CHAR; source: ARRAY OF CHAR) ;
+
+
+(*
+   Insert - insert the string, substr, into str at position, index.
+            substr, is added to the end of, str, if, index >= length(str)
+*)
+
+PROCEDURE Insert (substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR;
+                  index: CARDINAL) ;
+
+
+(*
+   Delete - delete len characters from, str, starting at, index.
+*)
+
+PROCEDURE Delete (VAR str: ARRAY OF CHAR; index: CARDINAL; length: CARDINAL) ;
+
+
+(*
+   Pos - return the first position of, substr, in, str.
+*)
+
+PROCEDURE Pos (substr, str: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   Copy - copy at most, length, characters in, substr, to, str,
+          starting at position, index.
+*)
+
+PROCEDURE Copy (str: ARRAY OF CHAR;
+                index, length: CARDINAL; VAR result: ARRAY OF CHAR) ;
+
+(*
+   ConCat - concatenates two strings, s1, and, s2
+            and places the result into, dest.
+*)
+
+PROCEDURE ConCat (s1, s2: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR) ;
+
+
+(*
+   Length - return the length of string, s.
+*)
+
+PROCEDURE Length (s: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   CompareStr - compare two strings, left, and, right.
+*)
+
+PROCEDURE CompareStr (left, right: ARRAY OF CHAR) : INTEGER ;
+
+
+END Strings.
diff --git a/gcc/m2/gm2-libs-pim/Strings.mod b/gcc/m2/gm2-libs-pim/Strings.mod
new file mode 100644
index 00000000000..ddf5deaf24a
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Strings.mod
@@ -0,0 +1,179 @@
+(* Strings.mod provides a Logitech-3.0 compatible library.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Strings ;
+
+FROM ASCII IMPORT nul ;
+IMPORT StrLib ;
+IMPORT DynamicStrings ;
+
+
+(*
+   Assign - source := dest.
+*)
+
+PROCEDURE Assign (VAR dest: ARRAY OF CHAR; source: ARRAY OF CHAR) ;
+BEGIN
+   StrLib.StrCopy(source, dest)
+END Assign ;
+
+
+(*
+   Insert - insert the string, substr, into str at position, index.
+            substr, is added to the end of, str, if, index >= length(str)
+*)
+
+PROCEDURE Insert (substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR;
+                  index: CARDINAL) ;
+VAR
+   s1, s2: DynamicStrings.String ;
+BEGIN
+   IF index>Length(str)
+   THEN
+      ConCat(str, substr, str)
+   ELSE
+      s1 := DynamicStrings.InitString(str) ;
+      s2 := DynamicStrings.ConCat(DynamicStrings.Slice(s1, 0, index),
+                                  DynamicStrings.Mark(DynamicStrings.InitString(str))) ;
+      s2 := DynamicStrings.ConCat(s2, DynamicStrings.Slice(s1, index, 0)) ;
+      DynamicStrings.CopyOut(str, s2) ;
+      s1 := DynamicStrings.KillString(s1) ;
+      s2 := DynamicStrings.KillString(s2)
+   END
+END Insert ;
+
+
+(*
+   Delete - delete len characters from, str, starting at, index.
+*)
+
+PROCEDURE Delete (VAR str: ARRAY OF CHAR; index: CARDINAL; length: CARDINAL) ;
+VAR
+   s: DynamicStrings.String ;
+BEGIN
+   s := DynamicStrings.InitString(str) ;
+   s := DynamicStrings.ConCat(DynamicStrings.Mark(DynamicStrings.Slice(s, 0, index)),
+                              DynamicStrings.Mark(DynamicStrings.Slice(s, index+length, 0))) ;
+   DynamicStrings.CopyOut(str, s) ;
+   s := DynamicStrings.KillString(s)
+END Delete ;
+
+
+(*
+   Pos - return the first position of, substr, in, str.
+*)
+
+PROCEDURE Pos (substr, str: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   i, k, l   : INTEGER ;
+   s1, s2, s3: DynamicStrings.String ;
+BEGIN
+   s1 := DynamicStrings.InitString(str) ;
+   s2 := DynamicStrings.InitString(substr) ;
+   k := DynamicStrings.Length(s1) ;
+   l := DynamicStrings.Length(s2) ;
+   i := 0 ;
+   REPEAT
+      i := DynamicStrings.Index(s1, DynamicStrings.char(s2, 0), i) ;
+      IF i>=0
+      THEN
+         s3 := DynamicStrings.Slice(s1, i, l) ;
+         IF DynamicStrings.Equal(s3, s2)
+         THEN
+            s1 := DynamicStrings.KillString(s1) ;
+            s2 := DynamicStrings.KillString(s2) ;
+            s3 := DynamicStrings.KillString(s3) ;
+            RETURN( i )
+         END ;
+         s3 := DynamicStrings.KillString(s3)
+      END ;
+      INC(i)
+   UNTIL i>=k ;
+   s1 := DynamicStrings.KillString(s1) ;
+   s2 := DynamicStrings.KillString(s2) ;
+   s3 := DynamicStrings.KillString(s3) ;
+   RETURN( HIGH(str)+1 )
+END Pos ;
+
+
+(*
+   Copy - copy at most, length, characters in, substr, to, str,
+          starting at position, index.
+*)
+
+PROCEDURE Copy (str: ARRAY OF CHAR;
+                index, length: CARDINAL; VAR result: ARRAY OF CHAR) ;
+VAR
+   s1, s2: DynamicStrings.String ;
+BEGIN
+   s1 := DynamicStrings.InitString(str) ;
+   s2 := DynamicStrings.Slice(s1, index, index+length) ;
+   DynamicStrings.CopyOut(result, s2) ;
+   s1 := DynamicStrings.KillString(s1) ;
+   s2 := DynamicStrings.KillString(s2)
+END Copy ;
+
+
+(*
+   ConCat - concatenates two strings, s1, and, s2
+            and places the result into, dest.
+*)
+
+PROCEDURE ConCat (s1, s2: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR) ;
+BEGIN
+   StrLib.StrConCat(s1, s2, dest)
+END ConCat ;
+
+
+(*
+   Length - return the length of string, s.
+*)
+
+PROCEDURE Length (s: ARRAY OF CHAR) : CARDINAL ;
+BEGIN
+   RETURN( StrLib.StrLen(s) )
+END Length ;
+
+
+(*
+   CompareStr - compare two strings, left, and, right.
+*)
+
+PROCEDURE CompareStr (left, right: ARRAY OF CHAR) : INTEGER ;
+BEGIN
+   IF StrLib.StrLess(left, right)
+   THEN
+      RETURN( -1 )
+   ELSIF StrLib.StrEqual(left, right)
+   THEN
+      RETURN( 0 )
+   ELSE
+      RETURN( 1 )
+   END
+END CompareStr ;
+
+
+END Strings.
diff --git a/gcc/m2/gm2-libs-pim/Termbase.def b/gcc/m2/gm2-libs-pim/Termbase.def
new file mode 100644
index 00000000000..4a9da7df887
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Termbase.def
@@ -0,0 +1,107 @@
+(* Termbase.def provides GNU Modula-2 with a PIM 234 compatible Termbase.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE Termbase ;
+
+(*
+   Initially the read routines from Keyboard and the
+   write routine from Display is assigned to the Read,
+   KeyPressed and Write procedures.
+*)
+
+EXPORT QUALIFIED ReadProcedure, StatusProcedure, WriteProcedure,
+                 AssignRead, AssignWrite, UnAssignRead, UnAssignWrite,
+                 Read, KeyPressed, Write ;
+
+TYPE
+   ReadProcedure = PROCEDURE (VAR CHAR) ;
+   WriteProcedure = PROCEDURE (CHAR) ;
+   StatusProcedure = PROCEDURE () : BOOLEAN ;
+
+
+(*
+   AssignRead - assigns a read procedure and status procedure for terminal
+                input. Done is set to TRUE if successful. Subsequent
+                Read and KeyPressed calls are mapped onto the user supplied
+                procedures. The previous read and status procedures are
+                uncovered and reused after UnAssignRead is called.
+*)
+
+PROCEDURE AssignRead (rp: ReadProcedure; sp: StatusProcedure;
+                      VAR Done: BOOLEAN) ;
+
+
+(*
+   UnAssignRead - undo the last call to AssignRead and set Done to TRUE
+                  on success.
+*)
+
+PROCEDURE UnAssignRead (VAR Done: BOOLEAN) ;
+
+
+(*
+   Read - reads a single character using the currently active read
+          procedure.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   KeyPressed - returns TRUE if a character is available to be read.
+*)
+
+PROCEDURE KeyPressed () : BOOLEAN ;
+
+
+(*
+   AssignWrite - assigns a write procedure for terminal output.
+                 Done is set to TRUE if successful. Subsequent
+                 Write calls are mapped onto the user supplied
+                 procedure. The previous write procedure is
+                 uncovered and reused after UnAssignWrite is called.
+*)
+
+PROCEDURE AssignWrite (wp: WriteProcedure; VAR Done: BOOLEAN) ;
+
+
+(*
+   UnAssignWrite - undo the last call to AssignWrite and set Done to TRUE
+                   on success.
+*)
+
+PROCEDURE UnAssignWrite (VAR Done: BOOLEAN) ;
+
+
+(*
+   Write - writes a single character using the currently active write
+           procedure.
+*)
+
+PROCEDURE Write (VAR ch: CHAR) ;
+
+
+END Termbase.
diff --git a/gcc/m2/gm2-libs-pim/Termbase.mod b/gcc/m2/gm2-libs-pim/Termbase.mod
new file mode 100644
index 00000000000..4f41217eb52
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Termbase.mod
@@ -0,0 +1,220 @@
+(* Termbase.mod provides GNU Modula-2 with a PIM 234 compatible Termbase.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Termbase ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2RTS IMPORT Halt ;
+IMPORT Display, Keyboard ;
+
+TYPE
+   ReadMethods = POINTER TO RECORD
+                               r   : ReadProcedure ;
+                               s   : StatusProcedure ;
+                               next: ReadMethods ;
+                            END ;
+
+   WriteMethod = POINTER TO RECORD
+                               w   : WriteProcedure ;
+                               next: WriteMethod ;
+                            END ;
+
+VAR
+   rStack: ReadMethods ;
+   wStack: WriteMethod ;
+
+
+(*
+   AssignRead - assigns a read procedure and status procedure for terminal
+                input. Done is set to TRUE if successful. Subsequent
+                Read and KeyPressed calls are mapped onto the user supplied
+                procedures. The previous read and status procedures are
+                uncovered and reused after UnAssignRead is called.
+*)
+
+PROCEDURE AssignRead (rp: ReadProcedure; sp: StatusProcedure;
+                      VAR Done: BOOLEAN) ;
+VAR
+   t: ReadMethods ;
+BEGIN
+   t := rStack ;
+   NEW(rStack) ;
+   IF rStack=NIL
+   THEN
+      Done := FALSE
+   ELSE
+      WITH rStack^ DO
+         r := rp ;
+         s := sp ;
+         next := t
+      END ;
+      Done := TRUE
+   END
+END AssignRead ;
+
+
+(*
+   UnAssignRead - undo the last call to AssignRead and set Done to TRUE
+                  on success.
+*)
+
+PROCEDURE UnAssignRead (VAR Done: BOOLEAN) ;
+VAR
+   t: ReadMethods ;
+BEGIN
+   IF rStack=NIL
+   THEN
+      Done := FALSE
+   ELSE
+      Done := TRUE
+   END ;
+   t := rStack ;
+   rStack := rStack^.next ;
+   DISPOSE(t)
+END UnAssignRead ;
+
+
+(*
+   Read - reads a single character using the currently active read
+          procedure.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+BEGIN
+   IF rStack=NIL
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__, 'no active read procedure')
+   ELSE
+      rStack^.r(ch)
+   END
+END Read ;
+
+
+(*
+   KeyPressed - returns TRUE if a character is available to be read.
+*)
+
+PROCEDURE KeyPressed () : BOOLEAN ;
+BEGIN
+   IF rStack=NIL
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__, 'no active status procedure')
+   ELSE
+      RETURN( rStack^.s() )
+   END
+END KeyPressed ;
+
+
+(*
+   AssignWrite - assigns a write procedure for terminal output.
+                 Done is set to TRUE if successful. Subsequent
+                 Write calls are mapped onto the user supplied
+                 procedure. The previous write procedure is
+                 uncovered and reused after UnAssignWrite is called.
+*)
+
+PROCEDURE AssignWrite (wp: WriteProcedure; VAR Done: BOOLEAN) ;
+VAR
+   t: WriteMethod ;
+BEGIN
+   t := wStack ;
+   NEW(wStack) ;
+   IF wStack=NIL
+   THEN
+      Done := FALSE
+   ELSE
+      WITH wStack^ DO
+         w := wp ;
+         next := t
+      END ;
+      Done := TRUE
+   END
+END AssignWrite ;
+
+
+(*
+   UnAssignWrite - undo the last call to AssignWrite and set Done to TRUE
+                   on success.
+*)
+
+PROCEDURE UnAssignWrite (VAR Done: BOOLEAN) ;
+VAR
+   t: WriteMethod ;
+BEGIN
+   IF wStack=NIL
+   THEN
+      Done := FALSE
+   ELSE
+      Done := TRUE
+   END ;
+   t := wStack ;
+   wStack := wStack^.next ;
+   DISPOSE(t)
+END UnAssignWrite ;
+
+
+(*
+   Write - writes a single character using the currently active write
+           procedure.
+*)
+
+PROCEDURE Write (VAR ch: CHAR) ;
+BEGIN
+   IF wStack=NIL
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__, 'no active write procedure')
+   ELSE
+      wStack^.w(ch)
+   END
+END Write ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+VAR
+   Done: BOOLEAN ;
+BEGIN
+   rStack := NIL ;
+   wStack := NIL ;
+   AssignRead(Keyboard.Read, Keyboard.KeyPressed, Done) ;
+   IF NOT Done
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__, 'failed to assign read routines from module Keyboard')
+   END ;
+   AssignWrite(Display.Write, Done) ;
+   IF NOT Done
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__, 'failed to assign write routine from module Display')
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END Termbase.
diff --git a/gcc/m2/gm2-libs-pim/Terminal.def b/gcc/m2/gm2-libs-pim/Terminal.def
new file mode 100644
index 00000000000..ecb0e8d98ac
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Terminal.def
@@ -0,0 +1,91 @@
+(* Terminal.def provides a Logitech 3.0 compatible and PIM [234] compatible.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+DEFINITION MODULE Terminal ;
+
+(*
+   It provides simple terminal input output
+   routines which all utilize the TermBase module.
+*)
+
+EXPORT QUALIFIED Read, KeyPressed, ReadAgain, ReadString, Write,
+                 WriteString, WriteLn ;
+
+
+(*
+   Read - reads a single character.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   KeyPressed - returns TRUE if a character can be read without blocking
+                the caller.
+*)
+
+PROCEDURE KeyPressed () : BOOLEAN ;
+
+
+(*
+   ReadString - reads a sequence of characters.
+                Tabs are expanded into 8 spaces and <cr> or <lf> terminates
+                the string.
+*)
+
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+
+
+(*
+   ReadAgain - makes the last character readable again.
+*)
+
+PROCEDURE ReadAgain ;
+
+
+(*
+   Write - writes a single character to the Termbase module.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+
+
+(*
+   WriteString - writes out a string which is terminated by a <nul>
+                 character or the end of string HIGH(s).
+*)
+
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+
+
+(*
+   WriteLn - writes a lf character.
+*)
+
+PROCEDURE WriteLn ;
+
+
+END Terminal.
diff --git a/gcc/m2/gm2-libs-pim/Terminal.mod b/gcc/m2/gm2-libs-pim/Terminal.mod
new file mode 100644
index 00000000000..de0f60cd1b4
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/Terminal.mod
@@ -0,0 +1,142 @@
+(* Terminal.mod provides a Logitech 3.0 compatible and PIM [234] compatible.
+
+Copyright (C) 2004-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Terminal ;
+
+IMPORT Termbase ;
+FROM ASCII IMPORT nul, cr, tab, lf ;
+
+
+(*
+   Read - reads a single character, ch, from the underlying Termbase
+          module.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+BEGIN
+   Termbase.Read(ch)
+END Read ;
+
+
+(*
+   ReadAgain - makes the last character readable again.
+*)
+
+PROCEDURE ReadAgain ;
+BEGIN
+END ReadAgain ;
+
+
+(*
+   KeyPressed - returns TRUE if a character can be read without blocking
+                the caller.
+*)
+
+PROCEDURE KeyPressed () : BOOLEAN ;
+BEGIN
+   RETURN( Termbase.KeyPressed() )
+END KeyPressed ;
+
+
+(*
+   Write - writes a single character to the Termbase module.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+BEGIN
+   Termbase.Write(ch)
+END Write ;
+
+
+(*
+   ReadString - reads a sequence of characters.
+                Tabs are expanded into 8 spaces and <cr> or <lf> terminates
+                the string.
+*)
+
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+VAR
+   t, h, i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   h := HIGH(s) ;
+   IF i<=h
+   THEN
+      REPEAT
+         Read(s[i]) ;
+         IF (s[i]=cr) OR (s[i]=lf)
+         THEN
+            s[i] := nul ;
+            (* successful *)
+            RETURN
+         ELSIF s[i]=tab
+         THEN
+            t := 0 ;
+            REPEAT
+               s[i] := ' ' ;
+               INC(i) ;
+               IF i>h
+               THEN
+                  RETURN
+               END ;
+               INC(t)
+            UNTIL t=8
+         END ;
+         INC(i)
+      UNTIL i>h
+   END
+END ReadString ;
+
+
+(*
+   WriteString - writes out a string which is terminated by a <nul>
+                 character or the end of string HIGH(s).
+*)
+
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   h := HIGH(s) ;
+   i := 0 ;
+   WHILE (i<=h) AND (s[i]#nul) DO
+      Write(s[i]) ;
+      INC(i)
+   END
+END WriteString ;
+
+
+(*
+   WriteLn - writes a lf character.
+*)
+
+PROCEDURE WriteLn ;
+BEGIN
+   Write(lf)
+END WriteLn ;
+
+
+END Terminal.
diff --git a/gcc/m2/gm2-libs-pim/TimeDate.def b/gcc/m2/gm2-libs-pim/TimeDate.def
new file mode 100644
index 00000000000..e72da90fcab
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/TimeDate.def
@@ -0,0 +1,98 @@
+(* TimeDate.def provides a Logitech-3.0 compatible library module.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE TimeDate ;
+
+(*
+   Legacy compatibility - you are advised to use cleaner
+   designed modules based on 'man 3 strtime'
+   and friends for new projects as the day value here is ugly.
+   [it was mapped onto MSDOS pre 2000].
+*)
+
+EXPORT QUALIFIED Time, GetTime, SetTime, CompareTime, TimeToZero,
+                 TimeToString ;
+
+TYPE
+(*
+   day holds:  bits 0..4 = day of month (1..31)
+                    5..8 = month of year (1..12)
+                    9..  = year - 1900
+   minute holds:    hours * 60 + minutes
+   millisec holds:  seconds * 1000 + millisec
+                    which is reset to 0 every minute
+*)
+
+   Time = RECORD
+             day, minute, millisec: CARDINAL ;
+          END ;
+
+
+(*
+   GetTime - returns the current date and time.
+*)
+
+PROCEDURE GetTime (VAR curTime: Time) ;
+
+
+(*
+   SetTime - does nothing, but provides compatibility with
+             the Logitech-3.0 library.
+*)
+
+PROCEDURE SetTime (curTime: Time) ;
+
+
+(*
+   CompareTime - compare two dates and time which returns:
+
+                 -1  if t1 < t2
+                  0  if t1 = t2
+                  1  if t1 > t2
+*)
+
+PROCEDURE CompareTime (t1, t2: Time) : INTEGER ;
+
+
+(*
+   TimeToZero - initializes, t, to zero.
+*)
+
+PROCEDURE TimeToZero (VAR t: Time) ;
+
+
+(*
+   TimeToString - convert time, t, to a string.
+                  The string, s, should be at least 19 characters
+                  long and the returned string will be
+
+                  yyyy-mm-dd hh:mm:ss
+*)
+
+PROCEDURE TimeToString (t: Time; VAR s: ARRAY OF CHAR) ;
+
+
+END TimeDate.
diff --git a/gcc/m2/gm2-libs-pim/TimeDate.mod b/gcc/m2/gm2-libs-pim/TimeDate.mod
new file mode 100644
index 00000000000..30e5d6cbd06
--- /dev/null
+++ b/gcc/m2/gm2-libs-pim/TimeDate.mod
@@ -0,0 +1,140 @@
+(* TimeDate.mod provides a Logitech-3.0 compatible library module.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+IMPLEMENTATION MODULE TimeDate ;
+
+
+FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE ;
+FROM libc IMPORT tm, time, time_t, memcpy, localtime ;
+FROM DynamicStrings IMPORT String, Mark, ConCat, InitString, KillString, CopyOut ;
+FROM FormatStrings IMPORT Sprintf3 ;
+
+IMPORT Selective ;
+
+
+(*
+   TimeToString - convert time, t, to a string.
+                  The string, s, should be at least 19 characters
+                  long and the returned string will be
+
+                  yyyy-mm-dd hh:mm:ss
+*)
+
+PROCEDURE TimeToString (t: Time; VAR s: ARRAY OF CHAR) ;
+VAR
+   q              : String ;
+   y, m, d, h, sec: CARDINAL ;
+BEGIN
+   WITH t DO
+      y := day DIV 512 + 1900 ;
+      m := (day DIV 32) MOD 16 ;
+      d := day MOD 32 ;
+      q := Sprintf3(Mark(InitString('%04d-%02d-%02d')), y, m, d) ;
+      h := minute DIV 60 ;
+      m := minute MOD 60 ;
+      sec := millisec DIV 1000 ;
+      q := ConCat(q, Mark(Sprintf3(Mark(InitString(' %02d:%02d:%02d')), h, m, sec))) ;
+      CopyOut(s, q) ;
+      q := KillString(q) ;
+   END
+END TimeToString ;
+
+
+PROCEDURE TimeToZero (VAR t: Time) ;
+BEGIN
+   WITH t DO
+      day := 0 ;
+      minute := 0 ;
+      millisec := 0
+   END
+END TimeToZero ;
+
+
+PROCEDURE CompareTime (t1, t2: Time) : INTEGER ;
+BEGIN
+   IF t1.day<t2.day
+   THEN
+      RETURN -1
+   ELSIF t1.day>t2.day
+   THEN
+      RETURN 1
+   ELSE
+      IF t1.minute<t2.minute
+      THEN
+         RETURN -1
+      ELSIF t1.minute>t2.minute
+      THEN
+         RETURN 1
+      ELSE
+         IF t1.millisec<t2.millisec
+         THEN
+            RETURN -1
+         ELSIF t1.millisec>t2.millisec
+         THEN
+            RETURN 1
+         ELSE
+            RETURN 0
+         END
+      END
+   END
+END CompareTime ;
+
+
+PROCEDURE SetTime (curTime: Time) ;
+BEGIN
+   (* does nothing *)
+END SetTime ;
+
+
+PROCEDURE GetTime (VAR curTime: Time) ;
+VAR
+   l   : time_t ;
+   r   : INTEGER ;
+   t   : tm ;
+   a   : ADDRESS ;
+   tv  : Selective.Timeval ;
+   s, u: CARDINAL ;
+BEGIN
+   tv := Selective.InitTime(0, 0) ;
+   r := Selective.GetTimeOfDay(tv) ;
+   l := time(NIL) ;
+   IF l#-1
+   THEN
+      a := localtime(l) ;
+      a := memcpy(ADR(t), a, TSIZE(t)) ;
+      WITH curTime DO
+         day := t.tm_mday+(t.tm_mon+1)*32+t.tm_year*512 ;
+         minute := t.tm_min+t.tm_hour*60 ;
+         Selective.GetTime(tv, s, u) ;
+         (* s MOD 61, to allow for leap seconds *)
+         millisec := (u DIV 1000) MOD (60 * 1000) + ((s MOD 61) * 1000)
+      END
+   END ;
+   tv := Selective.KillTime(tv)
+END GetTime ;
+
+
+END TimeDate.
diff --git a/gcc/m2/gm2-libs/ASCII.def b/gcc/m2/gm2-libs/ASCII.def
new file mode 100644
index 00000000000..076238adbc6
--- /dev/null
+++ b/gcc/m2/gm2-libs/ASCII.def
@@ -0,0 +1,54 @@
+(* ASCII.def Defines all ascii constants.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE ASCII ;
+
+EXPORT QUALIFIED
+     nul, soh, stx, etx, eot, enq, ack, bel,
+     bs , ht , nl , vt , np , cr , so , si ,
+     dle, dc1, dc2, dc3, dc4, nak, syn, etb,
+     can, em , sub, esc, fs , gs , rs , us ,
+     sp ,  (* All the above are in order *)
+     lf, ff, eof, del, tab, EOL ;
+
+(*
+   Note that lf, eof and EOL are added.
+*)
+
+CONST
+     nul=000C; soh=001C; stx=002C; etx=003C;
+     eot=004C; enq=005C; ack=006C; bel=007C;
+     bs =010C; ht =011C; nl =012C; vt =013C;
+     np =014C; cr =015C; so =016C; si =017C;
+     dle=020C; dc1=021C; dc2=022C; dc3=023C;
+     dc4=024C; nak=025C; syn=026C; etb=027C;
+     can=030C; em =031C; sub=032C; esc=033C;
+     fs =034C; gs =035C; rs =036C; us =037C;
+     sp =040C; (* All the above are in order *)
+     lf =nl  ; ff =np  ; eof=eot ; tab=ht  ;
+     del=177C; EOL=nl  ;
+
+END ASCII.
diff --git a/gcc/m2/gm2-libs/ASCII.mod b/gcc/m2/gm2-libs/ASCII.mod
new file mode 100644
index 00000000000..c8177571c71
--- /dev/null
+++ b/gcc/m2/gm2-libs/ASCII.mod
@@ -0,0 +1,29 @@
+(* ASCII.mod dummy companion module for the definition.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE ASCII ;
+
+END ASCII.
diff --git a/gcc/m2/gm2-libs/Args.def b/gcc/m2/gm2-libs/Args.def
new file mode 100644
index 00000000000..b252d428122
--- /dev/null
+++ b/gcc/m2/gm2-libs/Args.def
@@ -0,0 +1,48 @@
+(* Args.def provide access to command line arguments.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Args ;
+
+EXPORT QUALIFIED GetArg, Narg ;
+
+
+(*
+   GetArg - returns the nth argument from the command line.
+            The success of the operation is returned.
+*)
+
+PROCEDURE GetArg (VAR a: ARRAY OF CHAR; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line.
+*)
+
+PROCEDURE Narg () : CARDINAL ;
+
+
+END Args.
diff --git a/gcc/m2/gm2-libs/Args.mod b/gcc/m2/gm2-libs/Args.mod
new file mode 100644
index 00000000000..2b8dc03335e
--- /dev/null
+++ b/gcc/m2/gm2-libs/Args.mod
@@ -0,0 +1,89 @@
+(* Args.mod provide access to command line arguments.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Args ;
+
+
+FROM UnixArgs IMPORT GetArgC, GetArgV ;
+FROM ASCII IMPORT nul ;
+
+
+CONST
+   MaxArgs   =  255 ;
+   MaxString = 4096 ;
+
+
+(*
+   Source allows us to examine the ArgV contents.
+*)
+
+VAR
+   Source: POINTER TO ARRAY [0..MaxArgs] OF
+           POINTER TO ARRAY [0..MaxString] OF CHAR ;
+
+
+(*
+   GetArg - returns the nth argument from the command line.
+            The success of the operation is returned.
+*)
+
+PROCEDURE GetArg (VAR a: ARRAY OF CHAR; n: CARDINAL) : BOOLEAN ;
+VAR
+   i   : INTEGER ;
+   High,
+   j   : CARDINAL ;
+BEGIN
+   i := VAL (INTEGER, n) ;
+   j := 0 ;
+   High := HIGH(a) ;
+   IF i < GetArgC ()
+   THEN
+      Source := GetArgV () ;
+      WHILE (Source^[i]^[j]#nul) AND (j<High) DO
+         a[j] := Source^[i]^[j] ;
+         INC(j)
+      END
+   END ;
+   IF j<=High
+   THEN
+      a[j] := nul
+   END ;
+   RETURN i < GetArgC ()
+END GetArg ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line.
+*)
+
+PROCEDURE Narg () : CARDINAL ;
+BEGIN
+   RETURN GetArgC ()
+END Narg ;
+
+
+END Args.
diff --git a/gcc/m2/gm2-libs/Assertion.def b/gcc/m2/gm2-libs/Assertion.def
new file mode 100644
index 00000000000..9658717f896
--- /dev/null
+++ b/gcc/m2/gm2-libs/Assertion.def
@@ -0,0 +1,40 @@
+(* Assertion.def provides an assert procedure.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Assertion ;
+
+EXPORT QUALIFIED Assert ;
+
+
+(*
+   Assert - tests the boolean Condition, if it fails then HALT
+            is called.
+*)
+
+PROCEDURE Assert (Condition: BOOLEAN) ;
+
+
+END Assertion.
diff --git a/gcc/m2/gm2-libs/Assertion.mod b/gcc/m2/gm2-libs/Assertion.mod
new file mode 100644
index 00000000000..1d4c7c39a09
--- /dev/null
+++ b/gcc/m2/gm2-libs/Assertion.mod
@@ -0,0 +1,46 @@
+(* Assertion.mod provides an assert procedure.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Assertion ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+(*
+   Assert - tests the boolean Condition, if it fails then HALT is called.
+*)
+
+PROCEDURE Assert (Condition: BOOLEAN) ;
+BEGIN
+   IF NOT Condition
+   THEN
+      WriteString('assert failed - halting system') ; WriteLn ;
+      HALT
+   END
+END Assert ;
+
+
+END Assertion.
diff --git a/gcc/m2/gm2-libs/Break.def b/gcc/m2/gm2-libs/Break.def
new file mode 100644
index 00000000000..6414b3977ed
--- /dev/null
+++ b/gcc/m2/gm2-libs/Break.def
@@ -0,0 +1,29 @@
+(* Break.def provides a dummy compatibility library for legacy systems.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Break ;
+
+END Break.
diff --git a/gcc/m2/gm2-libs/Break.mod b/gcc/m2/gm2-libs/Break.mod
new file mode 100644
index 00000000000..d5a8b1e03cd
--- /dev/null
+++ b/gcc/m2/gm2-libs/Break.mod
@@ -0,0 +1,29 @@
+(* Break.mod provides a dummy compatibility library for legacy systems.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Break ;
+
+END Break.
diff --git a/gcc/m2/gm2-libs/Builtins.def b/gcc/m2/gm2-libs/Builtins.def
new file mode 100644
index 00000000000..1c321691317
--- /dev/null
+++ b/gcc/m2/gm2-libs/Builtins.def
@@ -0,0 +1,239 @@
+(* Builtins.def provides access to all built-in functions.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Builtins ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+(* floating point intrinsic procedure functions *)
+
+PROCEDURE __BUILTIN__ isfinitef (x: SHORTREAL) : BOOLEAN ;
+PROCEDURE __BUILTIN__ isfinite (x: REAL) : BOOLEAN ;
+PROCEDURE __BUILTIN__ isfinitel (x: LONGREAL) : BOOLEAN ;
+
+PROCEDURE __BUILTIN__ sinf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ sin (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ sinl (x: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ cosf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ cos (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ cosl (x: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ sqrtf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ sqrt (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ sqrtl (x: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ atan2f (x, y: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ atan2 (x, y: REAL) : REAL ;
+PROCEDURE __BUILTIN__ atan2l (x, y: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ fabsf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ fabs (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ fabsl (x: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ logf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ log (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ logl (x: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ expf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ exp (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ expl (x: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ log10f (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ log10 (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ log10l (x: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ exp10f (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ exp10 (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ exp10l (x: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ ilogbf (x: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ ilogb (x: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ ilogbl (x: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ huge_val () : REAL ;
+PROCEDURE __BUILTIN__ huge_valf () : SHORTREAL ;
+PROCEDURE __BUILTIN__ huge_vall () : LONGREAL ;
+
+PROCEDURE __BUILTIN__ significand (r: REAL) : REAL ;
+PROCEDURE __BUILTIN__ significandf (s: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ significandl (l: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ modf (x: REAL; VAR y: REAL) : REAL ;
+PROCEDURE __BUILTIN__ modff (x: SHORTREAL;
+                             VAR y: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ modfl (x: LONGREAL; VAR y: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ signbit (r: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ signbitf (s: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ signbitl (l: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ nextafter (x, y: REAL) : REAL ;
+PROCEDURE __BUILTIN__ nextafterf (x, y: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ nextafterl (x, y: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ nexttoward (x, y: REAL) : LONGREAL ;
+PROCEDURE __BUILTIN__ nexttowardf (x, y: SHORTREAL) : LONGREAL ;
+PROCEDURE __BUILTIN__ nexttowardl (x, y: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ scalb (x, n: REAL) : REAL ;
+PROCEDURE __BUILTIN__ scalbf (x, n: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ scalbl (x, n: LONGREAL) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ scalbln (x: REAL; n: LONGINT) : REAL ;
+PROCEDURE __BUILTIN__ scalblnf (x: SHORTREAL; n: LONGINT) : SHORTREAL ;
+PROCEDURE __BUILTIN__ scalblnl (x: LONGREAL; n: LONGINT) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ scalbn (x: REAL; n: INTEGER) : REAL ;
+PROCEDURE __BUILTIN__ scalbnf (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+PROCEDURE __BUILTIN__ scalbnl (x: LONGREAL; n: INTEGER) : LONGREAL ;
+
+(* complex arithmetic intrincic procedure functions *)
+
+PROCEDURE __BUILTIN__ cabsf (z: SHORTCOMPLEX) : SHORTREAL ;
+PROCEDURE __BUILTIN__ cabs (z: COMPLEX) : REAL ;
+PROCEDURE __BUILTIN__ cabsl (z: LONGCOMPLEX) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ cargf (z: SHORTCOMPLEX) : SHORTREAL ;
+PROCEDURE __BUILTIN__ carg (z: COMPLEX) : REAL ;
+PROCEDURE __BUILTIN__ cargl (z: LONGCOMPLEX) : LONGREAL ;
+
+PROCEDURE __BUILTIN__ conjf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ conj (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ conjl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ cpowerf (base: SHORTCOMPLEX;
+                               exp: SHORTREAL) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ cpower (base: COMPLEX; exp: REAL) : COMPLEX ;
+PROCEDURE __BUILTIN__ cpowerl (base: LONGCOMPLEX;
+                               exp: LONGREAL) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ csqrtf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ csqrt (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ csqrtl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ cexpf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ cexp (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ cexpl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ clnf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ cln (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ clnl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ csinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ csin (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ csinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ ccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ ccos (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ ccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ ctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ ctan (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ ctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ carcsinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ carcsin (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ carcsinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ carccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ carccos (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ carccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE __BUILTIN__ carctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE __BUILTIN__ carctan (z: COMPLEX) : COMPLEX ;
+PROCEDURE __BUILTIN__ carctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+(* memory and string intrincic procedure functions *)
+
+PROCEDURE __BUILTIN__ alloca (i: CARDINAL) : ADDRESS ;
+PROCEDURE __BUILTIN__ memcpy (dest, src: ADDRESS;
+                              nbytes: CARDINAL) : ADDRESS ;
+PROCEDURE __BUILTIN__ index (s: ADDRESS; c: INTEGER) : ADDRESS ;
+PROCEDURE __BUILTIN__ rindex (s: ADDRESS; c: INTEGER) : ADDRESS ;
+PROCEDURE __BUILTIN__ memcmp (s1, s2: ADDRESS;
+                              nbytes: CARDINAL) : INTEGER ;
+PROCEDURE __BUILTIN__ memset (s: ADDRESS; c: INTEGER;
+                              nbytes: CARDINAL) : ADDRESS ;
+PROCEDURE __BUILTIN__ memmove (s1, s2: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+PROCEDURE __BUILTIN__ strcat (dest, src: ADDRESS) : ADDRESS ;
+PROCEDURE __BUILTIN__ strncat (dest, src: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+PROCEDURE __BUILTIN__ strcpy (dest, src: ADDRESS) : ADDRESS ;
+PROCEDURE __BUILTIN__ strncpy (dest, src: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+PROCEDURE __BUILTIN__ strcmp (s1, s2: ADDRESS) : INTEGER ;
+PROCEDURE __BUILTIN__ strncmp (s1, s2: ADDRESS;
+                               nbytes: CARDINAL) : INTEGER ;
+PROCEDURE __BUILTIN__ strlen (s: ADDRESS) : INTEGER ;
+PROCEDURE __BUILTIN__ strstr (haystack, needle: ADDRESS) : ADDRESS ;
+PROCEDURE __BUILTIN__ strpbrk (s, accept: ADDRESS) : ADDRESS ;
+PROCEDURE __BUILTIN__ strspn (s, accept: ADDRESS) : CARDINAL ;
+PROCEDURE __BUILTIN__ strcspn (s, accept: ADDRESS) : CARDINAL ;
+PROCEDURE __BUILTIN__ strchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+PROCEDURE __BUILTIN__ strrchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+
+(*
+   longjmp - this GCC builtin restricts the val to always 1.
+*)
+(* do not use these two builtins, as gcc, only really
+   anticipates that the Ada front end should use them
+   and it only uses them in its runtime exception handling.
+   We leave them here in the hope that someday they will
+   behave more like their libc counterparts.  *)
+
+PROCEDURE __BUILTIN__ longjmp (env: ADDRESS; val: INTEGER) ;
+PROCEDURE __BUILTIN__ setjmp (env: ADDRESS) : INTEGER ;
+
+
+(*
+   frame_address - returns the address of the frame.
+                   The current frame is obtained if level is 0,
+                   the next level up if level is 1 etc.
+*)
+
+PROCEDURE __BUILTIN__ frame_address (level: CARDINAL) : ADDRESS ;
+
+
+(*
+   return_address - returns the return address of function.
+                    The current function return address is
+                    obtained if level is 0,
+                    the next level up if level is 1 etc.
+*)
+
+PROCEDURE __BUILTIN__ return_address (level: CARDINAL) : ADDRESS ;
+
+
+(*
+   alloca_trace - this is a no-op which is used for internal debugging.
+*)
+
+PROCEDURE alloca_trace (returned: ADDRESS; nBytes: CARDINAL) : ADDRESS ;
+
+
+END Builtins.
diff --git a/gcc/m2/gm2-libs/Builtins.mod b/gcc/m2/gm2-libs/Builtins.mod
new file mode 100644
index 00000000000..c679259dc3c
--- /dev/null
+++ b/gcc/m2/gm2-libs/Builtins.mod
@@ -0,0 +1,686 @@
+(* Builtins.mod provides access to all built-in functions.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Builtins ;
+
+IMPORT cbuiltin, wrapc ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_alloca)) alloca (i: CARDINAL) : ADDRESS ;
+BEGIN
+   (* This routine will never be called as it allocates memory on
+      top of the current stack frame, which is automatically
+      deallocated upon its return. *)
+   HALT ;
+   RETURN NIL
+END alloca ;
+
+PROCEDURE alloca_trace (returned: ADDRESS; nBytes: CARDINAL) : ADDRESS ;
+BEGIN
+   (* this routine is only called if -fdebug-builtins is supplied
+      on the command line.  The purpose of this routine is to allow
+      a developer to single step into this routine and inspect the
+      value of, nBytes, and, returned.
+    *)
+   RETURN returned
+END alloca_trace ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_memcpy)) memcpy (dest, src: ADDRESS; nbytes: CARDINAL) : ADDRESS ;
+BEGIN
+   (* hopefully the compiler will choose to use the __builtin_memcpy function within GCC.
+      This call is here just in case it cannot. Ie if the user sets a procedure variable to
+      memcpy, then clearly the compiler cannot inline such a call and thus it will
+      be forced into calling this function.
+   *)
+   RETURN cbuiltin.memcpy (dest, src, nbytes)
+END memcpy ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_isfinite)) isfinitef (x: SHORTREAL) : BOOLEAN ;
+BEGIN
+   RETURN wrapc.isfinitef (x)=1
+END isfinitef ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_isfinite)) isfinite (x: REAL) : BOOLEAN ;
+BEGIN
+   RETURN wrapc.isfinite (x)=1
+END isfinite ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_isfinite)) isfinitel (x: LONGREAL) : BOOLEAN ;
+BEGIN
+   RETURN wrapc.isfinitel (x)=1
+END isfinitel ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sin)) sin (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.sin (x)
+END sin ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sinf)) sinf (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.sinf (x)
+END sinf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sinl)) sinl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.sinl (x)
+END sinl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cos)) cos (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.cos (x)
+END cos ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cosf)) cosf (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.cosf (x)
+END cosf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cosl)) cosl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.cosl (x)
+END cosl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_atan2)) atan2 (x, y: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.atan2 (x, y)
+END atan2 ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_atan2f)) atan2f (x, y: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.atan2f (x, y)
+END atan2f ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_atan2l)) atan2l (x, y: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.atan2l (x, y)
+END atan2l ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sqrt)) sqrt (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.sqrt (x)
+END sqrt ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sqrtf)) sqrtf (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.sqrtf (x)
+END sqrtf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sqrtl)) sqrtl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.sqrtl (x)
+END sqrtl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_fabs)) fabs (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.fabs (x)
+END fabs ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_fabsf)) fabsf (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.fabsf (x)
+END fabsf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_fabsl)) fabsl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.fabsl (x)
+END fabsl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_log)) log (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.log (x)
+END log ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_logf)) logf (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.logf (x)
+END logf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_logl)) logl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.logl (x)
+END logl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_exp)) exp (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.exp (x)
+END exp ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_expf)) expf (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.expf (x)
+END expf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_expl)) expl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.expl (x)
+END expl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_log10)) log10 (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.log10 (x)
+END log10 ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_log10f)) log10f (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.log10f (x)
+END log10f ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_log10l)) log10l (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.log10l (x)
+END log10l ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_exp10)) exp10 (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.exp10 (x)
+END exp10 ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_exp10f)) exp10f (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.exp10f (x)
+END exp10f ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_exp10l)) exp10l (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.exp10l (x)
+END exp10l ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_ilogb)) ilogb (x: REAL) : INTEGER ;
+BEGIN
+   RETURN cbuiltin.ilogb (x)
+END ilogb ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_ilogbf)) ilogbf (x: SHORTREAL) : INTEGER ;
+BEGIN
+   RETURN cbuiltin.ilogbf (x)
+END ilogbf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_ilogbl)) ilogbl (x: LONGREAL) : INTEGER ;
+BEGIN
+   RETURN cbuiltin.ilogbl (x)
+END ilogbl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_significand)) significand (r: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.significand (r)
+END significand ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_significandf)) significandf (s: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.significandf (s)
+END significandf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_significandl)) significandl (l: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.significandl (l)
+END significandl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_modf)) modf (x: REAL; VAR y: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.modf (x, y)
+END modf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_modff)) modff (x: SHORTREAL; VAR y: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.modff (x, y)
+END modff ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_modfl)) modfl (x: LONGREAL; VAR y: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.modfl (x, y)
+END modfl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_signbit)) signbit (r: REAL) : INTEGER ;
+BEGIN
+   RETURN wrapc.signbit (r)
+END signbit ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_signbitf)) signbitf (s: SHORTREAL) : INTEGER ;
+BEGIN
+   RETURN wrapc.signbitf (s)
+END signbitf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_signbitl)) signbitl (l: LONGREAL) : INTEGER ;
+BEGIN
+   RETURN wrapc.signbitl (l)
+END signbitl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_nextafter)) nextafter (x, y: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.nextafter (x, y)
+END nextafter ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_nextafterf)) nextafterf (x, y: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.nextafterf (x, y)
+END nextafterf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_nextafterl)) nextafterl (x, y: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.nextafterl (x, y)
+END nextafterl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_nexttoward)) nexttoward (x, y: REAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.nexttoward (x, y)
+END nexttoward ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_nexttowardf)) nexttowardf (x, y: SHORTREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.nexttowardf (x, y)
+END nexttowardf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_nexttowardl)) nexttowardl (x, y: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.nexttowardl (x, y)
+END nexttowardl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalb)) scalb (x, n: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.scalb (x, n)
+END scalb ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalbf)) scalbf (x, n: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.scalbf (x, n)
+END scalbf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalbl)) scalbl (x, n: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.scalbl (x, n)
+END scalbl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalbln)) scalbln (x: REAL; n: LONGINT) : REAL ;
+BEGIN
+   RETURN cbuiltin.scalbln (x, n)
+END scalbln ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalblnf)) scalblnf (x: SHORTREAL; n: LONGINT) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.scalblnf (x, n)
+END scalblnf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalblnl)) scalblnl (x: LONGREAL; n: LONGINT) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.scalblnl (x, n)
+END scalblnl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalbn)) scalbn (x: REAL; n: INTEGER) : REAL ;
+BEGIN
+   RETURN cbuiltin.scalbn (x, n)
+END scalbn ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalbnf)) scalbnf (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.scalbnf (x, n)
+END scalbnf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_scalbnl)) scalbnl (x: LONGREAL; n: INTEGER) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.scalbnl (x, n)
+END scalbnl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cabsf)) cabsf (z: SHORTCOMPLEX) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.cabsf(z)
+END cabsf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cabs)) cabs (z: COMPLEX) : REAL ;
+BEGIN
+   RETURN cbuiltin.cabs(z)
+END cabs ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cabsl)) cabsl (z: LONGCOMPLEX) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.cabsl(z)
+END cabsl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cargf)) cargf (z: SHORTCOMPLEX) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.cargf(z)
+END cargf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_carg)) carg (z: COMPLEX) : REAL ;
+BEGIN
+   RETURN cbuiltin.carg(z)
+END carg ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cargl)) cargl (z: LONGCOMPLEX) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.cargl(z)
+END cargl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_conjf)) conjf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.conjf(z)
+END conjf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_conj)) conj (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.conj(z)
+END conj ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_conjl)) conjl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.conjl(z)
+END conjl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cpowf)) cpowerf (base: SHORTCOMPLEX; exp: SHORTREAL) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.cpowf(base, exp)
+END cpowerf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cpow)) cpower (base: COMPLEX; exp: REAL) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.cpow(base, exp)
+END cpower ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cpowl)) cpowerl (base: LONGCOMPLEX; exp: LONGREAL) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.cpowl(base, exp)
+END cpowerl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csqrtf)) csqrtf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.csqrtf(z)
+END csqrtf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csqrt)) csqrt (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.csqrt(z)
+END csqrt ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csqrtl)) csqrtl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.csqrtl(z)
+END csqrtl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cexpf)) cexpf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.cexpf(z)
+END cexpf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cexp)) cexp (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.cexp(z)
+END cexp ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cexpl)) cexpl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.cexpl(z)
+END cexpl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_clogf)) clnf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.clogf(z)
+END clnf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_clog)) cln (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.clog(z)
+END cln ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_clogl)) clnl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.clogl(z)
+END clnl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csinf)) csinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.csinf(z)
+END csinf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csin)) csin (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.csin(z)
+END csin ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_csinl)) csinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.csinl(z)
+END csinl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ccosf)) ccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.ccosf(z)
+END ccosf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ccos)) ccos (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.ccos(z)
+END ccos ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ccosl)) ccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.ccosl(z)
+END ccosl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ctanf)) ctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.ctanf(z)
+END ctanf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ctan)) ctan (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.ctan(z)
+END ctan ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_ctanl)) ctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.ctanl(z)
+END ctanl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_casinf)) carcsinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.casinf(z)
+END carcsinf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_casin)) carcsin (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.casin(z)
+END carcsin ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_casinl)) carcsinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.casinl(z)
+END carcsinl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cacosf)) carccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.cacosf(z)
+END carccosf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cacos)) carccos (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.cacos(z)
+END carccos ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_cacosl)) carccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.cacosl(z)
+END carccosl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_catanf)) carctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.catanf(z)
+END carctanf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_catan)) carctan (z: COMPLEX) : COMPLEX ;
+BEGIN
+   RETURN cbuiltin.catan(z)
+END carctan ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_catanl)) carctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+BEGIN
+   RETURN cbuiltin.catanl(z)
+END carctanl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_index)) index (s: ADDRESS; c: INTEGER) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.index (s, c)
+END index ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_rindex)) rindex (s: ADDRESS; c: INTEGER) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.rindex (s, c)
+END rindex ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_memcmp)) memcmp (s1, s2: ADDRESS; nbytes: CARDINAL) : INTEGER ;
+BEGIN
+   RETURN cbuiltin.memcmp (s1, s2, nbytes)
+END memcmp ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_memset)) memset (s: ADDRESS; c: INTEGER; nbytes: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.memset (s, c, nbytes)
+END memset ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_memmove)) memmove (s1, s2: ADDRESS; nbytes: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.memmove (s1, s2, nbytes)
+END memmove ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strcat)) strcat (dest, src: ADDRESS) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.strcat (dest, src)
+END strcat ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strncat)) strncat (dest, src: ADDRESS; nbytes: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.strncat (dest, src, nbytes)
+END strncat ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strcpy)) strcpy (dest, src: ADDRESS) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.strcpy (dest, src)
+END strcpy ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strncpy)) strncpy (dest, src: ADDRESS; nbytes: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.strncpy (dest, src, nbytes)
+END strncpy ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strcmp)) strcmp (s1, s2: ADDRESS) : INTEGER ;
+BEGIN
+   RETURN cbuiltin.strcmp (s1, s2)
+END strcmp ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strncmp)) strncmp (s1, s2: ADDRESS; nbytes: CARDINAL) : INTEGER ;
+BEGIN
+   RETURN cbuiltin.strncmp (s1, s2, nbytes)
+END strncmp ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strlen)) strlen (s: ADDRESS) : INTEGER ;
+BEGIN
+   RETURN cbuiltin.strlen (s)
+END strlen ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strstr)) strstr (haystack, needle: ADDRESS) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.strstr (haystack, needle)
+END strstr ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strpbrk)) strpbrk (s, accept: ADDRESS) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.strpbrk (s, accept)
+END strpbrk ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strspn)) strspn (s, accept: ADDRESS) : CARDINAL ;
+BEGIN
+   RETURN cbuiltin.strspn (s, accept)
+END strspn ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strcspn)) strcspn (s, accept: ADDRESS) : CARDINAL ;
+BEGIN
+   RETURN cbuiltin.strcspn (s, accept)
+END strcspn ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strchr)) strchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.strchr (s, c)
+END strchr ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_strrchr)) strrchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+BEGIN
+   RETURN cbuiltin.strrchr (s, c)
+END strrchr ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_huge_val)) huge_val () : REAL ;
+BEGIN
+   RETURN -1.0
+END huge_val ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_huge_vall)) huge_vall () : LONGREAL ;
+BEGIN
+   RETURN -1.0
+END huge_vall ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_huge_valf)) huge_valf () : SHORTREAL ;
+BEGIN
+   RETURN -1.0
+END huge_valf ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_longjmp)) longjmp (env: ADDRESS; val: INTEGER) ;
+BEGIN
+   (* empty, replaced internally by gcc *)
+END longjmp ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_setjmp)) setjmp (env: ADDRESS) : INTEGER ;
+BEGIN
+   (* empty, replaced internally by gcc *)
+   RETURN 0   (* keeps gm2 happy *)
+END setjmp ;
+
+
+(*
+   frame_address - returns the address of the frame.
+                   The current frame is obtained if level is 0,
+                   the next level up is level is 1 etc.
+*)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__
+         ((__builtin_frame_address))
+         frame_address (level: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN NIL
+END frame_address ;
+
+
+(*
+   return_address - returns the return address of function.
+                    The current function return address is
+                    obtained if level is 0,
+                    the next level up is level is 1 etc.
+*)
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__
+         ((__builtin_return_address))
+         return_address (level: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN NIL
+END return_address ;
+
+
+END Builtins.
diff --git a/gcc/m2/gm2-libs/COROUTINES.def b/gcc/m2/gm2-libs/COROUTINES.def
new file mode 100644
index 00000000000..d7b7dc857df
--- /dev/null
+++ b/gcc/m2/gm2-libs/COROUTINES.def
@@ -0,0 +1,36 @@
+(* COROUTINES.def defines an ISO compatible module priority range.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" COROUTINES ;
+
+CONST
+   UnassignedPriority = 0 ;
+
+TYPE
+   INTERRUPTSOURCE = CARDINAL ;
+   PROTECTION = [UnassignedPriority..7] ;
+
+END COROUTINES.
diff --git a/gcc/m2/gm2-libs/COROUTINES.mod b/gcc/m2/gm2-libs/COROUTINES.mod
new file mode 100644
index 00000000000..155f3651520
--- /dev/null
+++ b/gcc/m2/gm2-libs/COROUTINES.mod
@@ -0,0 +1,29 @@
+(* COROUTINES.mod dummy module for COROUTINES.def.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE COROUTINES ;
+
+END COROUTINES.
diff --git a/gcc/m2/gm2-libs/CmdArgs.def b/gcc/m2/gm2-libs/CmdArgs.def
new file mode 100644
index 00000000000..b467a0d1ae6
--- /dev/null
+++ b/gcc/m2/gm2-libs/CmdArgs.def
@@ -0,0 +1,49 @@
+(* CmdArgs.def provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE CmdArgs ;
+
+EXPORT QUALIFIED GetArg, Narg ;
+
+
+(*
+   GetArg - returns the nth argument from the command line, CmdLine
+            the success of the operation is returned.
+*)
+
+PROCEDURE GetArg (CmdLine: ARRAY OF CHAR;
+                  n: CARDINAL; VAR Argi: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line, CmdLine.
+*)
+
+PROCEDURE Narg (CmdLine: ARRAY OF CHAR) : CARDINAL ;
+
+
+END CmdArgs.
diff --git a/gcc/m2/gm2-libs/CmdArgs.mod b/gcc/m2/gm2-libs/CmdArgs.mod
new file mode 100644
index 00000000000..c676f0f3164
--- /dev/null
+++ b/gcc/m2/gm2-libs/CmdArgs.mod
@@ -0,0 +1,224 @@
+(* CmdArgs.mod provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE CmdArgs ;
+
+FROM ASCII IMPORT cr, nul ;
+FROM StrLib IMPORT StrLen ;
+
+CONST
+   esc    = '\' ;
+   space  = ' ' ;
+   squote = "'" ;
+   dquote = '"' ;
+   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.
+*)
+
+PROCEDURE GetArg (CmdLine: ARRAY OF CHAR ;
+                  n: CARDINAL; VAR Argi: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   Index,
+   i     : CARDINAL ;
+   Another: BOOLEAN ;
+BEGIN
+   Index := 0 ;
+   (* Continually retrieve an argument until we get the n th argument. *)
+   i := 0 ;
+   REPEAT
+      Another := GetNextArg(CmdLine, Index, Argi) ;
+      INC(i) ;
+   UNTIL (i>n) OR (NOT Another) ;
+   RETURN( i>n )
+END GetArg ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE GetNextArg (CmdLine: ARRAY OF CHAR; VAR CmdIndex: CARDINAL;
+                      VAR Arg: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   ArgIndex: CARDINAL ;  (* Index into Arg *)
+   HighA,
+   HighC: CARDINAL ;
+BEGIN
+   HighA := HIGH(Arg) ;
+   HighC := StrLen(CmdLine) ;
+   ArgIndex := 0 ;
+   (* Skip spaces *)
+   WHILE (CmdIndex<HighC) AND Space(CmdLine[CmdIndex]) DO
+      INC(CmdIndex)
+   END ;
+   IF CmdIndex<HighC
+   THEN
+      IF SingleQuote(CmdLine[CmdIndex])
+      THEN
+         (* Skip over the single quote *)
+         INC(CmdIndex) ;
+         CopyUntil(CmdLine, CmdIndex, HighC, Arg, ArgIndex, HighA, squote) ;
+         INC(CmdIndex)
+      ELSIF DoubleQuote(CmdLine[CmdIndex])
+      THEN
+         (* Skip over the double quote *)
+         INC(CmdIndex) ;
+         CopyUntil(CmdLine, CmdIndex, HighC, Arg, ArgIndex, HighA, dquote) ;
+         INC(CmdIndex)
+      ELSE
+         CopyUntilSpace(CmdLine, CmdIndex, HighC, Arg, ArgIndex, HighA)
+      END
+   END ;
+   (* Skip spaces *)
+   WHILE (CmdIndex<HighC) AND Space(CmdLine[CmdIndex]) DO
+      INC(CmdIndex)
+   END ;
+   IF ArgIndex<HighA
+   THEN
+      Arg[ArgIndex] := nul
+   END ;
+   RETURN( (CmdIndex<HighC) )
+END GetNextArg ;
+
+
+(*
+   CopyUntilSpace - copies characters until a Space character is found.
+*)
+
+PROCEDURE CopyUntilSpace (From: ARRAY OF CHAR;
+                          VAR FromIndex: CARDINAL; FromHigh: CARDINAL;
+                          VAR To: ARRAY OF CHAR;
+                          VAR ToIndex: CARDINAL; ToHigh: CARDINAL) ;
+BEGIN
+   WHILE (FromIndex<FromHigh) AND (ToIndex<ToHigh) AND
+         (NOT Space(From[FromIndex])) DO
+      CopyChar(From, FromIndex, FromHigh, To, ToIndex, ToHigh)
+   END
+END CopyUntilSpace ;
+
+
+(*
+   CopyUntil - copies characters until the UntilChar is found.
+*)
+
+PROCEDURE CopyUntil (From: ARRAY OF CHAR;
+                     VAR FromIndex: CARDINAL; FromHigh: CARDINAL;
+                     VAR To: ARRAY OF CHAR;
+                     VAR ToIndex: CARDINAL; ToHigh: CARDINAL;
+                     UntilChar: CHAR) ;
+BEGIN
+   WHILE (FromIndex<FromHigh) AND (ToIndex<ToHigh) AND
+         (From[FromIndex]#UntilChar) DO
+      CopyChar(From, FromIndex, FromHigh, To, ToIndex, ToHigh)
+   END
+END CopyUntil ;
+
+
+(*
+   CopyChar - copies a character from string From to string To and
+              takes into consideration escape characters. ie \x
+              Where x is any character.
+*)
+
+PROCEDURE CopyChar (From: ARRAY OF CHAR;
+                    VAR FromIndex: CARDINAL; FromHigh: CARDINAL;
+                    VAR To: ARRAY OF CHAR;
+                    VAR ToIndex: CARDINAL; ToHigh: CARDINAL) ;
+BEGIN
+   IF (FromIndex<FromHigh) AND (ToIndex<ToHigh)
+   THEN
+      IF Escape(From[FromIndex])
+      THEN
+         (* Skip over Escape Character *)
+         INC(FromIndex)
+      END ;
+      IF FromIndex<FromHigh
+      THEN
+         (* Copy Normal Character *)
+         To[ToIndex] := From[FromIndex] ;
+         INC(ToIndex) ;
+         INC(FromIndex)
+      END
+   END
+END CopyChar ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line, CmdLine.
+*)
+
+PROCEDURE Narg (CmdLine: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   a    : ARRAY [0..1000] OF CHAR ;
+   ArgNo: CARDINAL ;
+BEGIN
+   ArgNo := 0 ;
+   WHILE GetArg(CmdLine, ArgNo, a) DO
+      INC( ArgNo )
+   END ;
+(*
+   IF ArgNo>0
+   THEN
+      DEC(ArgNo)
+   END ;
+*)
+   RETURN( ArgNo )
+END Narg ;
+
+
+PROCEDURE Escape (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( ch=esc )
+END Escape ;
+
+
+PROCEDURE Space (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( (ch=space) OR (ch=tab) )
+END Space ;
+
+
+PROCEDURE DoubleQuote (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( ch=dquote )
+END DoubleQuote ;
+
+
+PROCEDURE SingleQuote (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( ch=squote )
+END SingleQuote ;
+
+
+END CmdArgs.
diff --git a/gcc/m2/gm2-libs/Debug.def b/gcc/m2/gm2-libs/Debug.def
new file mode 100644
index 00000000000..6372045efed
--- /dev/null
+++ b/gcc/m2/gm2-libs/Debug.def
@@ -0,0 +1,61 @@
+(* Debug.def provides some simple debugging routines.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Debug ;
+
+(*
+    Title      : Debug
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Sat Aug 13 19:41:57 1994
+    Last edit  : Sat Aug 13 19:41:57 1994
+    Description: provides some simple debugging routines.
+*)
+
+EXPORT QUALIFIED Halt, DebugString ;
+
+
+(*
+   Halt - writes a message in the format:
+          Module:Line:Message
+
+          It then terminates by calling HALT.
+*)
+
+PROCEDURE Halt (Message: ARRAY OF CHAR;
+                LineNo: CARDINAL;
+                Module: ARRAY OF CHAR) ;
+
+
+(*
+   DebugString - writes a string to the debugging device (Scn.Write).
+                 It interprets \n as carriage return, linefeed.
+*)
+
+PROCEDURE DebugString (a: ARRAY OF CHAR) ;
+
+
+END Debug.
diff --git a/gcc/m2/gm2-libs/Debug.mod b/gcc/m2/gm2-libs/Debug.mod
new file mode 100644
index 00000000000..44546f090c6
--- /dev/null
+++ b/gcc/m2/gm2-libs/Debug.mod
@@ -0,0 +1,107 @@
+(* Debug.mod provides some simple debugging routines.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Debug ;
+
+FROM ASCII IMPORT cr, nul, lf ;
+FROM NumberIO IMPORT CardToStr ;
+FROM StdIO IMPORT Write ;
+FROM libc IMPORT exit ;
+
+
+(*
+   Halt - writes a message in the format:
+          Module:Line:Message
+
+          It then terminates by calling HALT.
+*)
+
+PROCEDURE Halt (Message: ARRAY OF CHAR;
+                LineNo: CARDINAL;
+                Module: ARRAY OF CHAR) ;
+CONST
+   MaxNoOfDigits = 12 ;  (* should be large enough for most source files.. *)
+VAR
+   No               : ARRAY [0..MaxNoOfDigits] OF CHAR ;
+BEGIN
+   DebugString(Module) ;
+   CardToStr(LineNo, 0, No) ;
+   DebugString(':') ;
+   DebugString(No) ;
+   DebugString(':') ;
+   DebugString(Message) ;
+   DebugString('\n') ;
+   HALT
+END Halt ;
+
+
+(*
+   DebugString - writes a string to the debugging device (Scn.Write).
+                 It interprets \n as carriage return, linefeed.
+*)
+
+PROCEDURE DebugString (a: ARRAY OF CHAR) ;
+VAR
+   n, high: CARDINAL ;
+BEGIN
+   high := HIGH( a ) ;
+   n := 0 ;
+   WHILE (n <= high) AND (a[n] # nul) DO
+      IF a[n]='\'
+      THEN
+         IF n+1<=high
+         THEN
+            IF a[n+1]='n'
+            THEN
+               WriteLn ;
+               INC(n)
+            ELSIF a[n+1]='\'
+            THEN
+               Write('\') ;
+               INC(n)
+            END
+         END
+      ELSE
+         Write( a[n] )
+      END ;
+      INC( n )
+   END
+END DebugString ;
+
+
+(*
+   WriteLn - writes a carriage return and a newline
+             character.
+*)
+
+PROCEDURE WriteLn ;
+BEGIN
+   Write(cr) ;
+   Write(lf)
+END WriteLn ;
+
+
+END Debug.
diff --git a/gcc/m2/gm2-libs/DynamicStrings.def b/gcc/m2/gm2-libs/DynamicStrings.def
new file mode 100644
index 00000000000..c234e574069
--- /dev/null
+++ b/gcc/m2/gm2-libs/DynamicStrings.def
@@ -0,0 +1,378 @@
+(* DynamicStrings.def provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE DynamicStrings ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED String,
+                 InitString, KillString, Fin, InitStringCharStar,
+                 InitStringChar, Index, RIndex,
+                 Mark, Length, ConCat, ConCatChar, Assign, Dup, Add,
+                 Equal, EqualCharStar, EqualArray, ToUpper, ToLower,
+                 CopyOut, Mult, Slice,
+                 RemoveWhitePrefix, RemoveWhitePostfix, RemoveComment,
+                 char, string,
+                 InitStringDB, InitStringCharStarDB, InitStringCharDB,
+                 MultDB, DupDB, SliceDB,
+                 PushAllocation, PopAllocation, PopAllocationExemption ;
+
+TYPE
+   String ;
+
+
+(*
+   InitString - creates and returns a String type object.
+                Initial contents are, a.
+*)
+
+PROCEDURE InitString (a: ARRAY OF CHAR) : String ;
+
+
+(*
+   KillString - frees String, s, and its contents.
+                NIL is returned.
+*)
+
+PROCEDURE KillString (s: String) : String ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Fin (s: String) ;
+
+
+(*
+   InitStringCharStar - initializes and returns a String to contain
+                        the C string.
+*)
+
+PROCEDURE InitStringCharStar (a: ADDRESS) : String ;
+
+
+(*
+   InitStringChar - initializes and returns a String to contain the
+                    single character, ch.
+*)
+
+PROCEDURE InitStringChar (ch: CHAR) : String ;
+
+
+(*
+   Mark - marks String, s, ready for garbage collection.
+*)
+
+PROCEDURE Mark (s: String) : String ;
+
+
+(*
+   Length - returns the length of the String, s.
+*)
+
+PROCEDURE Length (s: String) : CARDINAL ;
+
+
+(*
+   ConCat - returns String, a, after the contents of, b,
+            have been appended.
+*)
+
+PROCEDURE ConCat (a, b: String) : String ;
+
+
+(*
+   ConCatChar - returns String, a, after character, ch,
+                has been appended.
+*)
+
+PROCEDURE ConCatChar (a: String; ch: CHAR) : String ;
+
+
+(*
+   Assign - assigns the contents of, b, into, a.
+            String, a, is returned.
+*)
+
+PROCEDURE Assign (a, b: String) : String ;
+
+
+(*
+   Dup - duplicate a String, s, returning the copy of s.
+*)
+
+PROCEDURE Dup (s: String) : String ;
+
+
+(*
+   Add - returns a new String which contains the contents of a and b.
+*)
+
+PROCEDURE Add (a, b: String) : String ;
+
+
+(*
+   Equal - returns TRUE if String, a, and, b, are equal.
+*)
+
+PROCEDURE Equal (a, b: String) : BOOLEAN ;
+
+
+(*
+   EqualCharStar - returns TRUE if contents of String, s, is
+                   the same as the string, a.
+*)
+
+PROCEDURE EqualCharStar (s: String; a: ADDRESS) : BOOLEAN ;
+
+
+(*
+   EqualArray - returns TRUE if contents of String, s, is the
+                same as the string, a.
+*)
+
+PROCEDURE EqualArray (s: String; a: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   Mult - returns a new string which is n concatenations of String, s.
+          If n<=0 then an empty string is returned.
+*)
+
+PROCEDURE Mult (s: String; n: CARDINAL) : String ;
+
+
+(*
+   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
+*)
+
+PROCEDURE Slice (s: String; low, high: INTEGER) : String ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Index (s: String; ch: CHAR; o: CARDINAL) : INTEGER ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE RIndex (s: String; ch: CHAR; o: CARDINAL) : INTEGER ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE RemoveComment (s: String; comment: CHAR) : String ;
+
+
+(*
+   RemoveWhitePrefix - removes any leading white space from String, s.
+                       A new string is returned.
+*)
+
+PROCEDURE RemoveWhitePrefix (s: String) : String ;
+
+
+(*
+   RemoveWhitePostfix - removes any leading white space from String, s.
+                        A new string is returned.
+*)
+
+PROCEDURE RemoveWhitePostfix (s: String) : String ;
+
+
+(*
+   ToUpper - returns string, s, after it has had its lower case
+             characters replaced by upper case characters.
+             The string, s, is not duplicated.
+*)
+
+PROCEDURE ToUpper (s: String) : String ;
+
+
+(*
+   ToLower - returns string, s, after it has had its upper case
+             characters replaced by lower case characters.
+             The string, s, is not duplicated.
+*)
+
+PROCEDURE ToLower (s: String) : String ;
+
+
+(*
+   CopyOut - copies string, s, to a.
+*)
+
+PROCEDURE CopyOut (VAR a: ARRAY OF CHAR; s: String) ;
+
+
+(*
+   char - returns the character, ch, at position, i, in String, s.
+          As Slice the index can be negative so:
+
+          char(s, 0) will return the first character
+          char(s, 1) will return the second character
+          char(s, -1) will return the last character
+          char(s, -2) will return the penultimate character
+
+          a nul character is returned if the index is out of range.
+*)
+
+PROCEDURE char (s: String; i: INTEGER) : CHAR ;
+
+
+(*
+   string - returns the C style char * of String, s.
+*)
+
+PROCEDURE string (s: String) : ADDRESS ;
+
+
+(*
+   to easily debug an application using this library one could use
+   use the following macro processing defines:
+
+   #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__)
+
+   and then invoke gm2 with the -fcpp flag.
+*)
+
+
+(*
+   InitStringDB - the debug version of InitString.
+*)
+
+PROCEDURE InitStringDB (a: ARRAY OF CHAR;
+                        file: ARRAY OF CHAR; line: CARDINAL) : String ;
+
+
+(*
+   InitStringCharStarDB - the debug version of InitStringCharStar.
+*)
+
+PROCEDURE InitStringCharStarDB (a: ADDRESS;
+                                file: ARRAY OF CHAR;
+                                line: CARDINAL) : String ;
+
+
+(*
+   InitStringCharDB - the debug version of InitStringChar.
+*)
+
+PROCEDURE InitStringCharDB (ch: CHAR;
+                            file: ARRAY OF CHAR;
+                            line: CARDINAL) : String ;
+
+
+(*
+   MultDB - the debug version of MultDB.
+*)
+
+PROCEDURE MultDB (s: String; n: CARDINAL;
+                  file: ARRAY OF CHAR; line: CARDINAL) : String ;
+
+
+(*
+   DupDB - the debug version of Dup.
+*)
+
+PROCEDURE DupDB (s: String;
+                 file: ARRAY OF CHAR; line: CARDINAL) : String ;
+
+
+(*
+   SliceDB - debug version of Slice.
+*)
+
+PROCEDURE SliceDB (s: String; low, high: INTEGER;
+                   file: ARRAY OF CHAR; line: CARDINAL) : String ;
+
+(*
+   PushAllocation - pushes the current allocation/deallocation lists.
+*)
+
+PROCEDURE PushAllocation ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE PopAllocation (halt: BOOLEAN) ;
+
+
+(*
+   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.
+
+                            The string, e, is returned unmodified,
+*)
+
+PROCEDURE PopAllocationExemption (halt: BOOLEAN; e: String) : String ;
+
+
+END DynamicStrings.
diff --git a/gcc/m2/gm2-libs/DynamicStrings.mod b/gcc/m2/gm2-libs/DynamicStrings.mod
new file mode 100644
index 00000000000..751fc3045c9
--- /dev/null
+++ b/gcc/m2/gm2-libs/DynamicStrings.mod
@@ -0,0 +1,1878 @@
+(* DynamicStrings.mod provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE DynamicStrings ;
+
+FROM libc IMPORT strlen, strncpy, write, exit ;
+FROM StrLib IMPORT StrLen ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Assertion IMPORT Assert ;
+FROM SYSTEM IMPORT ADR ;
+FROM ASCII IMPORT nul, tab, lf ;
+FROM M2RTS IMPORT Halt ;
+
+CONST
+   MaxBuf   = 127 ;
+   PoisonOn = FALSE ;    (* to enable debugging of this module, turn on PoisonOn and DebugOn.  *)
+   DebugOn  = FALSE ;
+   CheckOn  = FALSE ;    (* to enable debugging of users of this module turn on                *)
+   TraceOn  = FALSE ;    (* CheckOn and TraceOn.  Enabling both of these is very expensive.    *)
+
+TYPE
+   Contents = RECORD
+                 buf : ARRAY [0..MaxBuf-1] OF CHAR ;
+                 len : CARDINAL ;
+                 next: String ;
+              END ;
+
+   Descriptor = POINTER TO descriptor ;
+
+   String = POINTER TO stringRecord ;
+
+   DebugInfo = RECORD
+                  next: String ;   (* a mechanism for tracking used/lost strings *)
+                  file: ADDRESS ;
+                  line: CARDINAL ;
+                  proc: ADDRESS ;
+               END ;
+
+   stringRecord = RECORD
+                     contents: Contents ;
+                     head    : Descriptor ;
+                     debug   : DebugInfo ;
+                  END ;
+
+   desState = (inuse, marked, onlist, poisoned) ;
+
+   descriptor = RECORD
+                   charStarUsed : BOOLEAN ;     (* can we garbage collect this? *)
+                   charStar     : ADDRESS ;
+                   charStarSize : CARDINAL ;
+                   charStarValid: BOOLEAN ;
+                   state        : desState ;
+                   garbage      : String ;      (* temporary strings to be destroyed
+                                                   once this string is killed *)
+                END ;
+
+   frame    = POINTER TO frameRec ;
+   frameRec =            RECORD
+                            alloc, dealloc: String ;
+                            next          : frame ;
+                         END ;
+
+VAR
+   Initialized: BOOLEAN ;
+   frameHead  : frame ;
+   captured   : String ;  (* debugging aid.  *)
+
+
+(* writeStringDesc write out debugging information about string, s.  *)
+
+PROCEDURE writeStringDesc (s: String) ;
+BEGIN
+   writeCstring (s^.debug.file) ; writeString (':') ;
+   writeCard (s^.debug.line) ; writeString (':') ;
+   writeCstring (s^.debug.proc) ; writeString (' ') ;
+   writeAddress (s) ;
+   writeString (' ') ;
+   CASE s^.head^.state OF
+
+   inuse   :  writeString ("still in use (") ; writeCard (s^.contents.len) ; writeString (") characters") |
+   marked  :  writeString ("marked") |
+   onlist  :  writeString ("on a (lost) garbage list") |
+   poisoned:  writeString ("poisoned")
+
+   ELSE
+      writeString ("unknown state")
+   END
+END writeStringDesc ;
+
+
+(*
+   writeNspace -
+*)
+
+PROCEDURE writeNspace (n: CARDINAL) ;
+BEGIN
+   WHILE n > 0 DO
+      writeString (' ') ;
+      DEC (n)
+   END
+END writeNspace ;
+
+
+(*
+   DumpStringInfo -
+*)
+
+PROCEDURE DumpStringInfo (s: String; i: CARDINAL) ;
+VAR
+   t: String ;
+BEGIN
+   IF s # NIL
+   THEN
+      writeNspace (i) ; writeStringDesc (s) ; writeLn ;
+      IF s^.head^.garbage # NIL
+      THEN
+         writeNspace (i) ; writeString ('garbage list:') ; writeLn ;
+         REPEAT
+            s := s^.head^.garbage ;
+            DumpStringInfo (s, i+1) ; writeLn
+         UNTIL s = NIL
+      END
+   END
+END DumpStringInfo ;
+
+
+PROCEDURE stop ;
+END stop ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE PopAllocationExemption (halt: BOOLEAN; e: String) : String ;
+VAR
+   s: String ;
+   f: frame ;
+   b: BOOLEAN ;
+BEGIN
+   Init ;
+   IF CheckOn
+   THEN
+      IF frameHead = NIL
+      THEN
+         stop ;
+         Halt (__FILE__, __LINE__, __FUNCTION__,
+               "mismatched number of PopAllocation's compared to PushAllocation's")
+         (* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") *)
+      ELSE
+         IF frameHead^.alloc # NIL
+         THEN
+            b := FALSE ;
+            s := frameHead^.alloc ;
+            WHILE s # NIL DO
+               IF NOT ((e = s) OR IsOnGarbage (e, s) OR IsOnGarbage (s, e))
+               THEN
+                  IF NOT b
+                  THEN
+                     writeString ("the following strings have been lost") ; writeLn ;
+                     b := TRUE
+                  END ;
+                  DumpStringInfo (s, 0)
+               END ;
+               s := s^.debug.next
+            END ;
+            IF b AND halt
+            THEN
+               exit (1)
+            END
+         END ;
+         frameHead := frameHead^.next
+      END
+   END ;
+   RETURN e
+END PopAllocationExemption ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE PopAllocation (halt: BOOLEAN) ;
+BEGIN
+   IF CheckOn
+   THEN
+      IF PopAllocationExemption (halt, NIL) = NIL
+      THEN
+      END
+   END
+END PopAllocation ;
+
+
+(*
+   PushAllocation - pushes the current allocation/deallocation lists.
+*)
+
+PROCEDURE PushAllocation ;
+VAR
+   f: frame ;
+BEGIN
+   IF CheckOn
+   THEN
+      Init ;
+      NEW (f) ;
+      WITH f^ DO
+         next := frameHead ;
+         alloc := NIL ;
+         dealloc := NIL
+      END ;
+      frameHead := f
+   END
+END PushAllocation ;
+
+
+(*
+   doDSdbEnter -
+*)
+
+PROCEDURE doDSdbEnter ;
+BEGIN
+   IF CheckOn
+   THEN
+      PushAllocation
+   END
+END doDSdbEnter ;
+
+
+(*
+   doDSdbExit -
+*)
+
+PROCEDURE doDSdbExit (s: String) ;
+BEGIN
+   IF CheckOn
+   THEN
+      s := PopAllocationExemption (TRUE, s)
+   END
+END doDSdbExit ;
+
+
+(*
+   DSdbEnter -
+*)
+
+PROCEDURE DSdbEnter ;
+BEGIN
+END DSdbEnter ;
+
+
+(*
+   DSdbExit -
+*)
+
+PROCEDURE DSdbExit (s: String) ;
+BEGIN
+END DSdbExit ;
+
+
+(*
+ *   #undef GM2_DEBUG_DYNAMICSTINGS
+ *   #if defined(GM2_DEBUG_DYNAMICSTINGS)
+ *   #  define DSdbEnter doDSdbEnter
+ *   #  define DSdbExit  doDSdbExit
+ *   #  define CheckOn   TRUE
+ *   #  define TraceOn   TRUE
+ *   #endif
+ *)
+
+
+PROCEDURE Capture (s: String) : CARDINAL ;
+BEGIN
+   captured := s ;
+   RETURN 1
+END Capture ;
+
+
+(*
+   Min -
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a < b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Min ;
+
+
+(*
+   Max -
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a > b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Max ;
+
+
+(*
+   writeString - writes a string to stdout.
+*)
+
+PROCEDURE writeString (a: ARRAY OF CHAR) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := write (1, ADR (a), StrLen (a))
+END writeString ;
+
+
+(*
+   writeCstring - writes a C string to stdout.
+*)
+
+PROCEDURE writeCstring (a: ADDRESS) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   IF a = NIL
+   THEN
+      writeString ('(null)')
+   ELSE
+      i := write (1, a, strlen (a))
+   END
+END writeCstring ;
+
+
+(*
+   writeCard -
+*)
+
+PROCEDURE writeCard (c: CARDINAL) ;
+VAR
+   ch: CHAR ;
+   i : INTEGER ;
+BEGIN
+   IF c > 9
+   THEN
+      writeCard (c DIV 10) ;
+      writeCard (c MOD 10)
+   ELSE
+      ch := CHR (ORD ('0') + c) ;
+      i := write (1, ADR (ch), 1)
+   END
+END writeCard ;
+
+
+(*
+   writeLongcard -
+*)
+
+PROCEDURE writeLongcard (l: LONGCARD) ;
+VAR
+   ch: CHAR ;
+   i : INTEGER ;
+BEGIN
+   IF l > 16
+   THEN
+      writeLongcard (l DIV 16) ;
+      writeLongcard (l MOD 16)
+   ELSIF l < 10
+   THEN
+      ch := CHR (ORD ('0') + VAL (CARDINAL, l)) ;
+      i := write(1, ADR(ch), 1)
+   ELSIF l<16
+   THEN
+      ch := CHR (ORD ('a') + VAL(CARDINAL, l) - 10) ;
+      i := write (1, ADR (ch), 1)
+   END
+END writeLongcard ;
+
+
+(*
+   writeAddress -
+*)
+
+PROCEDURE writeAddress (a: ADDRESS) ;
+BEGIN
+   writeLongcard (VAL (LONGCARD, a))
+END writeAddress ;
+
+
+(*
+   writeLn - writes a newline.
+*)
+
+PROCEDURE writeLn ;
+VAR
+   ch: CHAR ;
+   i : INTEGER ;
+BEGIN
+   ch := lf ;
+   i := write (1, ADR (ch), 1)
+END writeLn ;
+
+
+(*
+   AssignDebug - assigns, file, and, line, information to string, s.
+*)
+
+PROCEDURE AssignDebug (s: String; file: ARRAY OF CHAR; line: CARDINAL; proc: ARRAY OF CHAR) : String ;
+VAR
+   f, p: ADDRESS ;
+BEGIN
+   f := ADR (file) ;
+   p := ADR (proc) ;
+   WITH s^ DO
+      ALLOCATE (debug.file, StrLen (file) + 1) ;
+      IF strncpy(debug.file, f, StrLen(file)+1)=NIL
+      THEN
+      END ;
+      debug.line := line ;
+      ALLOCATE (debug.proc, StrLen (proc) + 1) ;
+      IF strncpy (debug.proc, p, StrLen (proc) + 1) = NIL
+      THEN
+      END
+   END ;
+   RETURN( s )
+END AssignDebug ;
+
+
+(*
+   CopyOut - copies string, s, to a.
+*)
+
+PROCEDURE CopyOut (VAR a: ARRAY OF CHAR; s: String) ;
+VAR
+   i, l: CARDINAL ;
+BEGIN
+   l := Min (HIGH (a) + 1, Length (s)) ;
+   i := 0 ;
+   WHILE i < l DO
+      a[i] := char (s, i) ;
+      INC (i)
+   END ;
+   IF i <= HIGH (a)
+   THEN
+      a[i] := nul
+   END
+END CopyOut ;
+
+
+(*
+   IsOn - returns TRUE if, s, is on one of the debug lists.
+*)
+
+PROCEDURE IsOn (list, s: String) : BOOLEAN ;
+BEGIN
+   WHILE (list # s) AND (list # NIL) DO
+      list := list^.debug.next
+   END ;
+   RETURN list = s
+END IsOn ;
+
+
+(*
+   AddTo - adds string, s, to, list.
+*)
+
+PROCEDURE AddTo (VAR list: String; s: String) ;
+BEGIN
+   IF list = NIL
+   THEN
+      list := s ;
+      s^.debug.next := NIL
+   ELSE
+      s^.debug.next := list ;
+      list := s
+   END
+END AddTo ;
+
+
+(*
+   SubFrom - removes string, s, from, list.
+*)
+
+PROCEDURE SubFrom (VAR list: String; s: String) ;
+VAR
+   p: String ;
+BEGIN
+   IF list = s
+   THEN
+      list := s^.debug.next ;
+   ELSE
+      p := list ;
+      WHILE (p^.debug.next # NIL) AND (p^.debug.next # s) DO
+         p := p^.debug.next
+      END ;
+      IF p^.debug.next = s
+      THEN
+         p^.debug.next := s^.debug.next
+      ELSE
+         (* not found, quit *)
+         RETURN
+      END
+   END ;
+   s^.debug.next := NIL
+END SubFrom ;
+
+
+(*
+   AddAllocated - adds string, s, to the head of the allocated list.
+*)
+
+PROCEDURE AddAllocated (s: String) ;
+BEGIN
+   Init ;
+   AddTo (frameHead^.alloc, s)
+END AddAllocated ;
+
+
+(*
+   AddDeallocated - adds string, s, to the head of the deallocated list.
+*)
+
+PROCEDURE AddDeallocated (s: String) ;
+BEGIN
+   Init ;
+   AddTo (frameHead^.dealloc, s)
+END AddDeallocated ;
+
+
+(*
+   IsOnAllocated - returns TRUE if the string, s, has ever been allocated.
+*)
+
+PROCEDURE IsOnAllocated (s: String) : BOOLEAN ;
+VAR
+   f: frame ;
+BEGIN
+   Init ;
+   f := frameHead ;
+   REPEAT
+      IF IsOn (f^.alloc, s)
+      THEN
+         RETURN TRUE
+      ELSE
+         f := f^.next
+      END
+   UNTIL f = NIL ;
+   RETURN FALSE
+END IsOnAllocated ;
+
+
+(*
+   IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated.
+*)
+
+PROCEDURE IsOnDeallocated (s: String) : BOOLEAN ;
+VAR
+   f: frame ;
+BEGIN
+   Init ;
+   f := frameHead ;
+   REPEAT
+      IF IsOn (f^.dealloc, s)
+      THEN
+         RETURN TRUE
+      ELSE
+         f := f^.next
+      END
+   UNTIL f = NIL ;
+   RETURN FALSE
+END IsOnDeallocated ;
+
+
+(*
+   SubAllocated - removes string, s, from the list of allocated strings.
+*)
+
+PROCEDURE SubAllocated (s: String) ;
+VAR
+   f: frame ;
+BEGIN
+   Init ;
+   f := frameHead ;
+   REPEAT
+      IF IsOn (f^.alloc, s)
+      THEN
+         SubFrom (f^.alloc, s) ;
+         RETURN
+      ELSE
+         f := f^.next
+      END
+   UNTIL f = NIL
+END SubAllocated ;
+
+
+(*
+   SubDeallocated - removes string, s, from the list of deallocated strings.
+*)
+
+PROCEDURE SubDeallocated (s: String) ;
+VAR
+   f: frame ;
+BEGIN
+   Init ;
+   f := frameHead ;
+   REPEAT
+      IF IsOn (f^.dealloc, s)
+      THEN
+         SubFrom (f^.dealloc, s) ;
+         RETURN
+      ELSE
+         f := f^.next
+      END
+   UNTIL f = NIL
+END SubDeallocated ;
+
+
+(*
+   SubDebugInfo - removes string, s, from the list of allocated strings.
+*)
+
+PROCEDURE SubDebugInfo (s: String) ;
+BEGIN
+   IF IsOnDeallocated (s)
+   THEN
+      Assert (NOT DebugOn) ;
+      (* string has already been deallocated *)
+      RETURN
+   END ;
+   IF IsOnAllocated (s)
+   THEN
+      SubAllocated (s) ;
+      AddDeallocated (s)
+   ELSE
+      Assert (NOT DebugOn)
+      (* string has not been allocated *)
+   END
+END SubDebugInfo ;
+
+
+(*
+   AddDebugInfo - adds string, s, to the list of allocated strings.
+*)
+
+PROCEDURE AddDebugInfo (s: String) ;
+BEGIN
+   WITH s^ DO
+      debug.next := NIL ;
+      debug.file := NIL ;
+      debug.line := 0 ;
+      debug.proc := NIL ;
+   END ;
+   IF CheckOn
+   THEN
+      AddAllocated (s)
+   END
+END AddDebugInfo ;
+
+
+(*
+   ConcatContents - add the contents of string, a, where, h, is the
+                    total length of, a. The offset is in, o.
+*)
+
+PROCEDURE ConcatContents (VAR c: Contents; a: ARRAY OF CHAR; h, o: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := c.len ;
+   WHILE (o < h) AND (i < MaxBuf) DO
+      c.buf[i] := a[o] ;
+      INC (o) ;
+      INC (i)
+   END ;
+   IF o < h
+   THEN
+      c.len := MaxBuf ;
+      NEW (c.next) ;
+      WITH c.next^ DO
+         head := NIL ;
+         contents.len := 0 ;
+         contents.next := NIL ;
+         ConcatContents (contents, a, h, o)
+      END ;
+      AddDebugInfo (c.next) ;
+      c.next := AssignDebug (c.next, __FILE__, __LINE__, __FUNCTION__)
+   ELSE
+      c.len := i
+   END
+END ConcatContents ;
+
+
+(*
+   InitString - creates and returns a String type object.
+                Initial contents are, a.
+*)
+
+PROCEDURE InitString (a: ARRAY OF CHAR) : String ;
+VAR
+   s: String ;
+BEGIN
+   NEW(s) ;
+   WITH s^ DO
+      WITH contents DO
+         len := 0 ;
+         next := NIL
+      END ;
+      ConcatContents (contents, a, StrLen (a), 0) ;
+      NEW (head) ;
+      WITH head^ DO
+         charStarUsed  := FALSE ;
+         charStar      := NIL ;
+         charStarSize  := 0;
+         charStarValid := FALSE ;
+         garbage       := NIL ;
+         state         := inuse ;
+      END
+   END ;
+   AddDebugInfo (s) ;
+   IF TraceOn
+   THEN
+      s := AssignDebug (s, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN s
+END InitString ;
+
+
+(*
+   DeallocateCharStar - deallocates any charStar.
+*)
+
+PROCEDURE DeallocateCharStar (s: String) ;
+BEGIN
+   IF (s # NIL) AND (s^.head # NIL)
+   THEN
+      WITH s^.head^ DO
+         IF charStarUsed AND (charStar # NIL)
+         THEN
+            DEALLOCATE (charStar, charStarSize)
+         END ;
+         charStarUsed  := FALSE ;
+         charStar      := NIL ;
+         charStarSize  := 0 ;
+         charStarValid := FALSE
+      END
+   END
+END DeallocateCharStar ;
+
+
+(*
+   CheckPoisoned - checks for a poisoned string, s.
+*)
+
+PROCEDURE CheckPoisoned (s: String) : String ;
+BEGIN
+   IF PoisonOn AND (s # NIL) AND (s^.head # NIL) AND (s^.head^.state = poisoned)
+   THEN
+      HALT
+   END ;
+   RETURN s
+END CheckPoisoned ;
+
+
+(*
+   KillString - frees String, s, and its contents.
+                NIL is returned.
+*)
+
+PROCEDURE KillString (s: String) : String ;
+VAR
+   t: String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   IF s # NIL
+   THEN
+      IF CheckOn
+      THEN
+         IF IsOnAllocated (s)
+         THEN
+            SubAllocated (s)
+         ELSIF IsOnDeallocated (s)
+         THEN
+            SubDeallocated (s)
+         END
+      END ;
+      WITH s^ DO
+         IF head # NIL
+         THEN
+            WITH head^ DO
+               state := poisoned ;
+               garbage := KillString (garbage) ;
+               IF NOT PoisonOn
+               THEN
+                  DeallocateCharStar (s)
+               END
+            END ;
+            IF NOT PoisonOn
+            THEN
+               DISPOSE (head) ;
+               head := NIL
+            END
+         END ;
+         t := KillString (s^.contents.next) ;
+         IF NOT PoisonOn
+         THEN
+            DISPOSE (s)
+         END
+      END
+   END ;
+   RETURN NIL
+END KillString ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Fin (s: String) ;
+BEGIN
+   IF KillString (s) # NIL
+   THEN
+      HALT
+   END
+END Fin ;
+
+
+(*
+   MarkInvalid - marks the char * version of String, s, as invalid.
+*)
+
+PROCEDURE MarkInvalid (s: String) ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   IF s^.head # NIL
+   THEN
+      s^.head^.charStarValid := FALSE
+   END
+END MarkInvalid ;
+
+
+(*
+   ConcatContentsAddress - concatenate the string, a, where, h, is the
+                           total length of, a.
+*)
+
+PROCEDURE ConcatContentsAddress (VAR c: Contents; a: ADDRESS; h: CARDINAL) ;
+VAR
+   p   : POINTER TO CHAR ;
+   i, j: CARDINAL ;
+BEGIN
+   j := 0 ;
+   i := c.len ;
+   p := a ;
+   WHILE (j < h) AND (i < MaxBuf) DO
+      c.buf[i] := p^ ;
+      INC (i) ;
+      INC (j) ;
+      INC (p)
+   END ;
+   IF j < h
+   THEN
+      c.len := MaxBuf ;
+      NEW (c.next) ;
+      WITH c.next^ DO
+         head          := NIL ;
+         contents.len  := 0 ;
+         contents.next := NIL ;
+         ConcatContentsAddress (contents, p, h - j)
+      END ;
+      AddDebugInfo (c.next) ;
+      IF TraceOn
+      THEN
+         c.next := AssignDebug (c.next, __FILE__, __LINE__, __FUNCTION__)
+      END
+   ELSE
+      c.len := i ;
+      c.next := NIL
+   END
+END ConcatContentsAddress ;
+
+
+(*
+   InitStringCharStar - initializes and returns a String to contain the C string.
+*)
+
+PROCEDURE InitStringCharStar (a: ADDRESS) : String ;
+VAR
+   s: String ;
+BEGIN
+   NEW (s) ;
+   WITH s^ DO
+      WITH contents DO
+         len := 0 ;
+         next := NIL
+      END ;
+      IF a#NIL
+      THEN
+         ConcatContentsAddress (contents, a, strlen (a))
+      END ;
+      NEW (head) ;
+      WITH head^ DO
+         charStarUsed  := FALSE ;
+         charStar      := NIL ;
+         charStarSize  := 0 ;
+         charStarValid := FALSE ;
+         garbage       := NIL ;
+         state         := inuse
+      END
+   END ;
+   AddDebugInfo (s) ;
+   IF TraceOn
+   THEN
+      s := AssignDebug (s, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN s
+END InitStringCharStar ;
+
+
+(*
+   InitStringChar - initializes and returns a String to contain the single character, ch.
+*)
+
+PROCEDURE InitStringChar (ch: CHAR) : String ;
+VAR
+   a: ARRAY [0..1] OF CHAR ;
+   s: String ;
+BEGIN
+   a[0] := ch ;
+   a[1] := nul ;
+   s := InitString (a) ;
+   IF TraceOn
+   THEN
+      s := AssignDebug (s, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN s
+END InitStringChar ;
+
+
+(*
+   Mark - marks String, s, ready for garbage collection.
+*)
+
+PROCEDURE Mark (s: String) : String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   IF (s # NIL) AND (s^.head^.state = inuse)
+   THEN
+      s^.head^.state := marked
+   END ;
+   RETURN s
+END Mark ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE AddToGarbage (a, b: String) : String ;
+VAR
+   c: String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      a := CheckPoisoned (a) ;
+      b := CheckPoisoned (b)
+   END ;
+(*
+   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) AND (a # NIL) AND (b # NIL) AND (b^.head^.state = marked) AND (a^.head^.state = inuse)
+   THEN
+      c := a ;
+      WHILE c^.head^.garbage # NIL DO
+         c := c^.head^.garbage
+      END ;
+      c^.head^.garbage := b ;
+      b^.head^.state := onlist ;
+      IF CheckOn
+      THEN
+         SubDebugInfo (b)
+      END
+   END ;
+   RETURN a
+END AddToGarbage ;
+
+
+(*
+   IsOnGarbage - returns TRUE if, s, is on string, e, garbage list.
+*)
+
+PROCEDURE IsOnGarbage (e, s: String) : BOOLEAN ;
+BEGIN
+   IF (e # NIL) AND (s # NIL)
+   THEN
+      WHILE e^.head^.garbage # NIL DO
+         IF e^.head^.garbage = s
+         THEN
+            RETURN TRUE
+         ELSE
+            e := e^.head^.garbage
+         END
+      END
+   END ;
+   RETURN FALSE
+END IsOnGarbage ;
+
+
+(*
+   Length - returns the length of the String, s.
+*)
+
+PROCEDURE Length (s: String) : CARDINAL ;
+BEGIN
+   IF s = NIL
+   THEN
+      RETURN 0
+   ELSE
+      RETURN s^.contents.len + Length (s^.contents.next)
+   END
+END Length ;
+
+
+(*
+   ConCat - returns String, a, after the contents of, b, have been appended.
+*)
+
+PROCEDURE ConCat (a, b: String) : String ;
+VAR
+   t: String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      a := CheckPoisoned (a) ;
+      b := CheckPoisoned (b)
+   END ;
+   IF a = b
+   THEN
+      RETURN ConCat (a, Mark (Dup (b)))
+   ELSIF a # NIL
+   THEN
+      a := AddToGarbage (a, b) ;
+      MarkInvalid (a) ;
+      t := a ;
+      WHILE b # NIL DO
+         WHILE (t^.contents.len = MaxBuf) AND (t^.contents.next # NIL) DO
+            t := t^.contents.next
+         END ;
+         ConcatContents (t^.contents, b^.contents.buf, b^.contents.len, 0) ;
+         b := b^.contents.next
+      END
+   END ;
+   IF (a = NIL) AND (b # NIL)
+   THEN
+      HALT
+   END ;
+   RETURN a
+END ConCat ;
+
+
+(*
+   ConCatChar - returns String, a, after character, ch, has been appended.
+*)
+
+PROCEDURE ConCatChar (a: String; ch: CHAR) : String ;
+VAR
+   b: ARRAY [0..1] OF CHAR ;
+   t: String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      a := CheckPoisoned (a)
+   END ;
+   b[0] := ch ;
+   b[1] := nul ;
+   t := a ;
+   MarkInvalid (a) ;
+   WHILE (t^.contents.len = MaxBuf) AND (t^.contents.next # NIL) DO
+      t := t^.contents.next
+   END ;
+   ConcatContents (t^.contents, b, 1, 0) ;
+   RETURN a
+END ConCatChar ;
+
+
+(*
+   Assign - assigns the contents of, b, into, a.
+            String, a, is returned.
+*)
+
+PROCEDURE Assign (a, b: String) : String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      a := CheckPoisoned (a) ;
+      b := CheckPoisoned (b)
+   END ;
+   IF (a # NIL) AND (b # NIL)
+   THEN
+      WITH a^ DO
+         contents.next := KillString (contents.next) ;
+         contents.len  := 0
+      END
+   END ;
+   RETURN ConCat (a, b)
+END Assign ;
+
+
+(*
+   Dup - duplicate a String, s, returning the copy of s.
+*)
+
+PROCEDURE Dup (s: String) : String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   s := Assign (InitString (''), s) ;
+   IF TraceOn
+   THEN
+      s := AssignDebug (s, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN s
+END Dup ;
+
+
+(*
+   Add - returns a new String which contains the contents of a and b.
+*)
+
+PROCEDURE Add (a, b: String) : String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      a := CheckPoisoned (a) ;
+      b := CheckPoisoned (b)
+   END ;
+   a := ConCat (ConCat (InitString (''), a), b) ;
+   IF TraceOn
+   THEN
+      a := AssignDebug (a, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN a
+END Add ;
+
+
+(*
+   Equal - returns TRUE if String, a, and, b, are equal.
+*)
+
+PROCEDURE Equal (a, b: String) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF PoisonOn
+   THEN
+      a := CheckPoisoned (a) ;
+      b := CheckPoisoned (b)
+   END ;
+   IF Length (a) = Length (b)
+   THEN
+      WHILE (a # NIL) AND (b # NIL) DO
+         i := 0 ;
+         Assert (a^.contents.len = b^.contents.len) ;
+         WHILE i<a^.contents.len DO
+            IF a^.contents.buf[i] # a^.contents.buf[i]
+            THEN
+               HALT
+            END ;
+            IF b^.contents.buf[i] # b^.contents.buf[i]
+            THEN
+               HALT
+            END ;
+            IF a^.contents.buf[i] # b^.contents.buf[i]
+            THEN
+               RETURN FALSE
+            END ;
+            INC (i)
+         END ;
+         a := a^.contents.next ;
+         b := b^.contents.next
+      END ;
+      RETURN TRUE
+   ELSE
+      RETURN FALSE
+   END
+END Equal ;
+
+
+(*
+   EqualCharStar - returns TRUE if contents of String, s, is the same as the
+                   string, a.
+*)
+
+PROCEDURE EqualCharStar (s: String; a: ADDRESS) : BOOLEAN ;
+VAR
+   t: String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   t := InitStringCharStar (a) ;
+   IF TraceOn
+   THEN
+      t := AssignDebug (t, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   t := AddToGarbage (t, s) ;
+   IF Equal (t, s)
+   THEN
+      t := KillString (t) ;
+      RETURN TRUE
+   ELSE
+      t := KillString (t) ;
+      RETURN FALSE
+   END
+END EqualCharStar ;
+
+
+(*
+   EqualArray - returns TRUE if contents of String, s, is the same as the
+                string, a.
+*)
+
+PROCEDURE EqualArray (s: String; a: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   t: String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   t := InitString (a) ;
+   IF TraceOn
+   THEN
+      t := AssignDebug (t, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   t := AddToGarbage (t, s) ;
+   IF Equal (t, s)
+   THEN
+      t := KillString (t) ;
+      RETURN TRUE
+   ELSE
+      t := KillString (t) ;
+      RETURN FALSE
+   END
+END EqualArray ;
+
+
+(*
+   Mult - returns a new string which is n concatenations of String, s.
+*)
+
+PROCEDURE Mult (s: String; n: CARDINAL) : String ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   IF n<=0
+   THEN
+      s := AddToGarbage (InitString (''), s)
+   ELSE
+      s := ConCat (Mult (s, n-1), s)
+   END ;
+   IF TraceOn
+   THEN
+      s := AssignDebug (s, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN s
+END Mult ;
+
+
+(*
+   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
+*)
+
+PROCEDURE Slice (s: String; low, high: INTEGER) : String ;
+VAR
+   d, t         : String ;
+   start, end, o: INTEGER ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   IF low < 0
+   THEN
+      low := VAL (INTEGER, Length (s)) + low
+   END ;
+   IF high <= 0
+   THEN
+      high := VAL (INTEGER, Length (s)) + high
+   ELSE
+      (* make sure high is <= Length (s) *)
+      high := Min (Length (s), high)
+   END ;
+   d := InitString ('') ;
+   d := AddToGarbage (d, s) ;
+   o := 0 ;
+   t := d ;
+   WHILE s # NIL DO
+      IF low < o + VAL (INTEGER, s^.contents.len)
+      THEN
+         IF o > high
+         THEN
+            s := NIL
+         ELSE
+            (* found sliceable unit *)
+            IF low < o
+            THEN
+               start := 0
+            ELSE
+               start := low - o
+            END ;
+            end := Max (Min (MaxBuf, high - o), 0) ;
+            WHILE t^.contents.len = MaxBuf DO
+               IF t^.contents.next = NIL
+               THEN
+                  NEW (t^.contents.next) ;
+                  WITH t^.contents.next^ DO
+                     head         := NIL ;
+                     contents.len := 0
+                  END ;
+                  AddDebugInfo (t^.contents.next) ;
+                  IF TraceOn
+                  THEN
+                     t^.contents.next := AssignDebug (t^.contents.next, __FILE__, __LINE__, __FUNCTION__)
+                  END
+               END ;
+               t := t^.contents.next
+            END ;
+            ConcatContentsAddress (t^.contents,
+                                   ADR (s^.contents.buf[start]), end - start) ;
+            INC (o, s^.contents.len) ;
+            s := s^.contents.next
+         END
+      ELSE
+         INC (o, s^.contents.len) ;
+         s := s^.contents.next
+      END ;
+   END ;
+   IF TraceOn
+   THEN
+      d := AssignDebug (d, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN d
+END Slice ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Index (s: String; ch: CHAR; o: CARDINAL) : INTEGER ;
+VAR
+   i, k: CARDINAL ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   k := 0 ;
+   WHILE s # NIL DO
+      WITH s^ DO
+         IF k + contents.len < o
+         THEN
+            INC (k, contents.len)
+         ELSE
+            i := o - k ;
+            WHILE i < contents.len DO
+               IF contents.buf[i] = ch
+               THEN
+                  RETURN k + i
+               END ;
+               INC (i)
+            END ;
+            INC (k, i) ;
+            o := k
+         END
+      END ;
+      s := s^.contents.next
+   END ;
+   RETURN -1
+END Index ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE RIndex (s: String; ch: CHAR; o: CARDINAL) : INTEGER ;
+VAR
+   i, k: CARDINAL ;
+   j   : INTEGER ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   j := -1 ;
+   k :=  0 ;
+   WHILE s # NIL DO
+      WITH s^ DO
+         IF k + contents.len < o
+         THEN
+            INC (k, contents.len)
+         ELSE
+            IF o < k
+            THEN
+               i := 0
+            ELSE
+               i := o - k
+            END ;
+            WHILE i < contents.len DO
+               IF contents.buf[i] = ch
+               THEN
+                  j := k
+               END ;
+               INC (k) ;
+               INC (i)
+            END
+         END
+      END ;
+      s := s^.contents.next
+   END ;
+   RETURN j
+END RIndex ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE RemoveComment (s: String; comment: CHAR) : String ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := Index (s, comment, 0) ;
+   IF i = 0
+   THEN
+      s := InitString ('')
+   ELSIF i > 0
+   THEN
+      s := RemoveWhitePostfix (Slice (Mark (s), 0, i))
+   END ;
+   IF TraceOn
+   THEN
+      s := AssignDebug (s, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN s
+END RemoveComment ;
+
+
+(*
+   char - returns the character, ch, at position, i, in String, s.
+*)
+
+PROCEDURE char (s: String; i: INTEGER) : CHAR ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   IF i<0
+   THEN
+      c := VAL (CARDINAL, VAL (INTEGER, Length (s)) + i)
+   ELSE
+      c := i
+   END ;
+   WHILE (s # NIL) AND (c >= s^.contents.len) DO
+      DEC (c, s^.contents.len) ;
+      s := s^.contents.next
+   END ;
+   IF (s = NIL) OR (c >= s^.contents.len)
+   THEN
+      RETURN nul
+   ELSE
+      RETURN s^.contents.buf[c]
+   END
+END char ;
+
+
+(*
+   string - returns the C style char * of String, s.
+*)
+
+PROCEDURE string (s: String) : ADDRESS ;
+VAR
+   a   : String ;
+   l, i: CARDINAL ;
+   p   : POINTER TO CHAR ;
+BEGIN
+   IF PoisonOn
+   THEN
+      s := CheckPoisoned (s)
+   END ;
+   IF s = NIL
+   THEN
+      RETURN NIL
+   ELSE
+      IF NOT s^.head^.charStarValid
+      THEN
+         l := Length (s) ;
+         WITH s^.head^ DO
+            IF NOT (charStarUsed AND (charStarSize > l))
+            THEN
+               DeallocateCharStar (s) ;
+               ALLOCATE (charStar, l+1) ;
+               charStarSize := l+1 ;
+               charStarUsed := TRUE
+            END ;
+            p := charStar ;
+         END ;
+         a := s ;
+         WHILE a#NIL DO
+            i := 0 ;
+            WHILE i < a^.contents.len DO
+               p^ := a^.contents.buf[i] ;
+               INC (i) ;
+               INC (p)
+            END ;
+            a := a^.contents.next
+         END ;
+         p^ := nul ;
+         s^.head^.charStarValid := TRUE
+      END ;
+      RETURN s^.head^.charStar
+   END
+END string ;
+
+
+(*
+   IsWhite - returns TRUE if, ch, is a space or a tab.
+*)
+
+PROCEDURE IsWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch = ' ') OR (ch = tab)
+END IsWhite ;
+
+
+(*
+   RemoveWhitePrefix - removes any leading white space from String, s.
+                       A new string is returned.
+*)
+
+PROCEDURE RemoveWhitePrefix (s: String) : String ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE IsWhite (char (s, i)) DO
+      INC (i)
+   END ;
+   s := Slice (s, INTEGER (i), 0) ;
+   IF TraceOn
+   THEN
+      s := AssignDebug (s, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN s
+END RemoveWhitePrefix ;
+
+
+(*
+   RemoveWhitePostfix - removes any leading white space from String, s.
+                        A new string is returned.
+*)
+
+PROCEDURE RemoveWhitePostfix (s: String) : String ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := VAL(INTEGER, Length (s)) - 1 ;
+   WHILE (i >= 0) AND IsWhite (char (s, i)) DO
+      DEC (i)
+   END ;
+   s := Slice (s, 0, i+1) ;
+   IF TraceOn
+   THEN
+      s := AssignDebug (s, __FILE__, __LINE__, __FUNCTION__)
+   END ;
+   RETURN s
+END RemoveWhitePostfix ;
+
+
+(*
+   ToUpper - returns string, s, after it has had its lower case characters
+             replaced by upper case characters.
+             The string, s, is not duplicated.
+*)
+
+PROCEDURE ToUpper (s: String) : String ;
+VAR
+   ch: CHAR ;
+   i : CARDINAL ;
+   t : String ;
+BEGIN
+   IF s # NIL
+   THEN
+      MarkInvalid (s) ;
+      t := s ;
+      WHILE t # NIL DO
+         WITH t^ DO
+            i := 0 ;
+            WHILE i < contents.len DO
+               ch := contents.buf[i] ;
+               IF (ch >= 'a') AND (ch <= 'z')
+               THEN
+                  contents.buf[i] := CHR (ORD (ch) - ORD ('a') + ORD ('A'))
+               END ;
+               INC (i)
+            END
+         END ;
+         t := t^.contents.next
+      END
+   END ;
+   RETURN s
+END ToUpper ;
+
+
+(*
+   ToLower - returns string, s, after it has had its upper case characters
+             replaced by lower case characters.
+             The string, s, is not duplicated.
+*)
+
+PROCEDURE ToLower (s: String) : String ;
+VAR
+   ch: CHAR ;
+   i : CARDINAL ;
+   t : String ;
+BEGIN
+   IF s # NIL
+   THEN
+      MarkInvalid (s) ;
+      t := s ;
+      WHILE t # NIL DO
+         WITH t^ DO
+            i := 0 ;
+            WHILE i < contents.len DO
+               ch := contents.buf[i] ;
+               IF (ch >= 'A') AND (ch <= 'Z')
+               THEN
+                  contents.buf[i] := CHR (ORD (ch) - ORD ('A') + ORD ('a'))
+               END ;
+               INC (i)
+            END
+         END ;
+         t := t^.contents.next
+      END
+   END ;
+   RETURN s
+END ToLower ;
+
+
+(*
+   InitStringDB - the debug version of InitString.
+*)
+
+PROCEDURE InitStringDB (a: ARRAY OF CHAR; file: ARRAY OF CHAR; line: CARDINAL) : String ;
+BEGIN
+   RETURN AssignDebug (InitString (a), file, line, 'InitString')
+END InitStringDB ;
+
+
+(*
+   InitStringCharStarDB - the debug version of InitStringCharStar.
+*)
+
+PROCEDURE InitStringCharStarDB (a: ADDRESS; file: ARRAY OF CHAR; line: CARDINAL) : String ;
+BEGIN
+   RETURN AssignDebug (InitStringCharStar (a), file, line, 'InitStringCharStar')
+END InitStringCharStarDB ;
+
+
+(*
+   InitStringCharDB - the debug version of InitStringChar.
+*)
+
+PROCEDURE InitStringCharDB (ch: CHAR; file: ARRAY OF CHAR; line: CARDINAL) : String ;
+BEGIN
+   RETURN AssignDebug (InitStringChar (ch), file, line, 'InitStringChar')
+END InitStringCharDB ;
+
+
+(*
+   MultDB - the debug version of MultDB.
+*)
+
+PROCEDURE MultDB (s: String; n: CARDINAL; file: ARRAY OF CHAR; line: CARDINAL) : String ;
+BEGIN
+   RETURN AssignDebug (Mult (s, n), file, line, 'Mult')
+END MultDB ;
+
+
+(*
+   DupDB - the debug version of Dup.
+*)
+
+PROCEDURE DupDB (s: String; file: ARRAY OF CHAR; line: CARDINAL) : String ;
+BEGIN
+   RETURN AssignDebug (Dup (s), file, line, 'Dup')
+END DupDB ;
+
+
+(*
+   SliceDB - debug version of Slice.
+*)
+
+PROCEDURE SliceDB (s: String; low, high: INTEGER;
+                   file: ARRAY OF CHAR; line: CARDINAL) : String ;
+BEGIN
+   DSdbEnter ;
+   s := AssignDebug (Slice (s, low, high), file, line, 'Slice') ;
+   DSdbExit (s) ;
+   RETURN s
+END SliceDB ;
+
+
+(*
+   DumpState -
+*)
+
+PROCEDURE DumpState (s: String) ;
+BEGIN
+   CASE s^.head^.state OF
+
+   inuse   :  writeString ("still in use (") ; writeCard (s^.contents.len) ; writeString (") characters") |
+   marked  :  writeString ("marked") |
+   onlist  :  writeString ("on a garbage list") |
+   poisoned:  writeString ("poisoned")
+
+   ELSE
+      writeString ("unknown state")
+   END
+END DumpState ;
+
+
+(*
+   DumpStringSynopsis -
+*)
+
+PROCEDURE DumpStringSynopsis (s: String) ;
+BEGIN
+   writeCstring (s^.debug.file) ; writeString (':') ;
+   writeCard (s^.debug.line) ; writeString (':') ;
+   writeCstring (s^.debug.proc) ;
+   writeString (' string ') ;
+   writeAddress (s) ;
+   writeString (' ') ;
+   DumpState (s) ;
+   IF IsOnAllocated (s)
+   THEN
+      writeString (' globally allocated')
+   ELSIF IsOnDeallocated (s)
+   THEN
+      writeString (' globally deallocated')
+   ELSE
+      writeString (' globally unknown')
+   END ;
+   writeLn
+END DumpStringSynopsis ;
+
+
+(*
+   DumpString - displays the contents of string, s.
+*)
+
+PROCEDURE DumpString (s: String) ;
+VAR
+   t: String ;
+BEGIN
+   IF s # NIL
+   THEN
+      DumpStringSynopsis (s) ;
+      IF (s^.head # NIL) AND (s^.head^.garbage # NIL)
+      THEN
+         writeString ('display chained strings on the garbage list') ; writeLn ;
+         t := s^.head^.garbage ;
+         WHILE t # NIL DO
+            DumpStringSynopsis (t) ;
+            t := t^.head^.garbage
+         END
+      END
+   END
+END DumpString ;
+
+
+(*
+   Init - initialize the module.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   IF NOT Initialized
+   THEN
+      Initialized := TRUE ;
+      frameHead := NIL ;
+      PushAllocation ;
+   END
+END Init ;
+
+
+BEGIN
+   Initialized := FALSE ;
+   Init
+END DynamicStrings.
diff --git a/gcc/m2/gm2-libs/Environment.def b/gcc/m2/gm2-libs/Environment.def
new file mode 100644
index 00000000000..9c5d1348a22
--- /dev/null
+++ b/gcc/m2/gm2-libs/Environment.def
@@ -0,0 +1,53 @@
+(* Environment.def provides access to the environment settings of a process.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Environment ;
+
+EXPORT QUALIFIED GetEnvironment, PutEnvironment ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE GetEnvironment (Env: ARRAY OF CHAR;
+                          VAR dest: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   PutEnvironment - change or add an environment variable definition
+                    EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*)
+
+PROCEDURE PutEnvironment (EnvDef: ARRAY OF CHAR) : BOOLEAN ;
+
+
+END Environment.
diff --git a/gcc/m2/gm2-libs/Environment.mod b/gcc/m2/gm2-libs/Environment.mod
new file mode 100644
index 00000000000..331c752f534
--- /dev/null
+++ b/gcc/m2/gm2-libs/Environment.mod
@@ -0,0 +1,78 @@
+(* Environment.mod provides access to the environment settings of a process.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Environment ;
+
+
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT getenv, putenv ;
+FROM ASCII IMPORT nul ;
+FROM StrLib IMPORT StrCopy ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE GetEnvironment (Env: ARRAY OF CHAR;
+                          VAR dest: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   High,
+   i   : CARDINAL ;
+   Addr: POINTER TO CHAR ;
+BEGIN
+   i := 0 ;
+   High := HIGH (dest) ;
+   Addr := getenv (ADR (Env)) ;
+   WHILE (i<High) AND (Addr#NIL) AND (Addr^#nul) DO
+      dest[i] := Addr^ ;
+      INC (Addr) ;
+      INC (i)
+   END ;
+   IF i<High
+   THEN
+      dest[i] := nul
+   END ;
+   RETURN Addr#NIL
+END GetEnvironment ;
+
+
+(*
+   PutEnvironment - change or add an environment variable definition EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*)
+
+PROCEDURE PutEnvironment (EnvDef: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   RETURN putenv (ADR (EnvDef)) = 0
+END PutEnvironment ;
+
+
+END Environment.
diff --git a/gcc/m2/gm2-libs/FIO.def b/gcc/m2/gm2-libs/FIO.def
new file mode 100644
index 00000000000..6e2b39c5a20
--- /dev/null
+++ b/gcc/m2/gm2-libs/FIO.def
@@ -0,0 +1,344 @@
+(* FIO.def provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FIO ;
+
+(* Provides a simple buffered file input/output library.  *)
+
+
+FROM SYSTEM IMPORT ADDRESS, BYTE ;
+
+EXPORT QUALIFIED (* types *)
+                 File,
+                 (* procedures *)
+                 OpenToRead, OpenToWrite, OpenForRandom, Close,
+                 EOF, EOLN, WasEOLN, IsNoError, Exists, IsActive,
+                 exists, openToRead, openToWrite, openForRandom,
+                 SetPositionFromBeginning,
+                 SetPositionFromEnd,
+                 FindPosition,
+                 ReadChar, ReadString,
+                 WriteChar, WriteString, WriteLine,
+                 WriteCardinal, ReadCardinal,
+                 UnReadChar,
+                 WriteNBytes, ReadNBytes,
+                 FlushBuffer,
+                 GetUnixFileDescriptor,
+                 GetFileName, getFileName, getFileNameLength,
+                 FlushOutErr,
+                 (* variables *)
+                 StdIn, StdOut, StdErr ;
+
+TYPE
+   File = CARDINAL ;
+
+(* the following variables are initialized to their UNIX equivalents *)
+VAR
+   StdIn, StdOut, StdErr: File ;
+
+
+
+(*
+   IsNoError - returns a TRUE if no error has occured on file, f.
+*)
+
+PROCEDURE IsNoError (f: File) : BOOLEAN ;
+
+
+(*
+   IsActive - returns TRUE if the file, f, is still active.
+*)
+
+PROCEDURE IsActive (f: File) : BOOLEAN ;
+
+
+(*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*)
+
+PROCEDURE Exists (fname: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OpenToRead (fname: ARRAY OF CHAR) : File ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OpenToWrite (fname: ARRAY OF CHAR) : File ;
+
+
+(*
+   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.
+                   newfile, determines whether a file should be
+                   created if towrite is TRUE or whether the
+                   previous file should be left alone,
+                   allowing this descriptor to seek
+                   and modify an existing file.
+*)
+
+PROCEDURE OpenForRandom (fname: ARRAY OF CHAR;
+                         towrite, newfile: BOOLEAN) : File ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Close (f: File) ;
+
+
+(* the following functions are functionally equivalent to the above
+   except they allow C style names.
+*)
+
+PROCEDURE exists        (fname: ADDRESS; flength: CARDINAL) : BOOLEAN ;
+PROCEDURE openToRead    (fname: ADDRESS; flength: CARDINAL) : File ;
+PROCEDURE openToWrite   (fname: ADDRESS; flength: CARDINAL) : File ;
+PROCEDURE openForRandom (fname: ADDRESS; flength: CARDINAL;
+                         towrite, newfile: BOOLEAN) : File ;
+
+
+(*
+   FlushBuffer - flush contents of the FIO file, f, to libc.
+*)
+
+PROCEDURE FlushBuffer (f: File) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL;
+                      dest: ADDRESS) : CARDINAL ;
+
+
+(*
+   ReadAny - reads HIGH(a) bytes into, a. All input
+             is fully buffered, unlike ReadNBytes and thus is more
+             suited to small reads.
+*)
+
+PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL;
+                       src: ADDRESS) : CARDINAL ;
+
+
+(*
+   WriteAny - writes HIGH(a) bytes onto, file, f. All output
+              is fully buffered, unlike WriteNBytes and thus is more
+              suited to small writes.
+*)
+
+PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   WriteChar - writes a single character to file, f.
+*)
+
+PROCEDURE WriteChar (f: File; ch: CHAR) ;
+
+
+(*
+   EOF - tests to see whether a file, f, has reached end of file.
+*)
+
+PROCEDURE EOF (f: File) : BOOLEAN ;
+
+
+(*
+   EOLN - tests to see whether a file, f, is about to read a newline.
+          It does NOT consume the newline.  It reads the next character
+          and then immediately unreads the character.
+*)
+
+PROCEDURE EOLN (f: File) : BOOLEAN ;
+
+
+(*
+   WasEOLN - tests to see whether a file, f, has just read a newline
+             character.
+*)
+
+PROCEDURE WasEOLN (f: File) : BOOLEAN ;
+
+
+(*
+   ReadChar - returns a character read from file, f.
+              Sensible to check with IsNoError or EOF after calling
+              this function.
+*)
+
+PROCEDURE ReadChar (f: File) : CHAR ;
+
+
+(*
+   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,
+                end of file or end of line seen.
+*)
+
+PROCEDURE UnReadChar (f: File ; ch: CHAR) ;
+
+
+(*
+   WriteLine - writes out a linefeed to file, f.
+*)
+
+PROCEDURE WriteLine (f: File) ;
+
+
+(*
+   WriteString - writes a string to file, f.
+*)
+
+PROCEDURE WriteString (f: File; a: ARRAY OF CHAR) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ReadString (f: File; VAR a: ARRAY OF CHAR) ;
+
+
+(*
+   WriteCardinal - writes a CARDINAL to file, f.
+                   It writes the binary image of the CARDINAL.
+                   to file, f.
+*)
+
+PROCEDURE WriteCardinal (f: File; c: CARDINAL) ;
+
+
+(*
+   ReadCardinal - reads a CARDINAL from file, f.
+                  It reads a bit image of a CARDINAL
+                  from file, f.
+*)
+
+PROCEDURE ReadCardinal (f: File) : CARDINAL ;
+
+
+(*
+   GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+                           Useful when combining FIO.mod with select
+                           (in Selective.def - but note the comments in
+                            Selective about using read/write primatives)
+*)
+
+PROCEDURE GetUnixFileDescriptor (f: File) : INTEGER ;
+
+
+(*
+   SetPositionFromBeginning - sets the position from the beginning
+                              of the file.
+*)
+
+PROCEDURE SetPositionFromBeginning (f: File; pos: LONGINT) ;
+
+
+(*
+   SetPositionFromEnd - sets the position from the end of the file.
+*)
+
+PROCEDURE SetPositionFromEnd (f: File; pos: LONGINT) ;
+
+
+(*
+   FindPosition - returns the current absolute position in file, f.
+*)
+
+PROCEDURE FindPosition (f: File) : LONGINT ;
+
+
+(*
+   GetFileName - assigns, a, with the filename associated with, f.
+*)
+
+PROCEDURE GetFileName (f: File; VAR a: ARRAY OF CHAR) ;
+
+
+(*
+   getFileName - returns the address of the filename associated with, f.
+*)
+
+PROCEDURE getFileName (f: File) : ADDRESS ;
+
+
+(*
+   getFileNameLength - returns the number of characters associated with
+                       filename, f.
+*)
+
+PROCEDURE getFileNameLength (f: File) : CARDINAL ;
+
+
+(*
+   FlushOutErr - flushes, StdOut, and, StdErr.
+*)
+
+PROCEDURE FlushOutErr ;
+
+
+END FIO.
diff --git a/gcc/m2/gm2-libs/FIO.mod b/gcc/m2/gm2-libs/FIO.mod
new file mode 100644
index 00000000000..3630664735e
--- /dev/null
+++ b/gcc/m2/gm2-libs/FIO.mod
@@ -0,0 +1,1712 @@
+(* FIO.mod provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2022 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/>.  *)
+
+IMPLEMENTATION MODULE FIO ;
+
+(*
+    Title      : FIO
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Thu Sep  2 22:07:21 1999
+    Last edit  : Thu Sep  2 22:07:21 1999
+    Description: a complete reimplememtation of FIO.mod
+                 provides a simple buffered file input/output library.
+*)
+
+FROM SYSTEM IMPORT ADR, TSIZE, SIZE, WORD ;
+FROM ASCII IMPORT nl, nul, tab ;
+FROM StrLib IMPORT StrLen, StrConCat, StrCopy ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM NumberIO IMPORT CardToStr ;
+FROM libc IMPORT exit, open, creat, read, write, close, lseek, strncpy, memcpy ;
+FROM Indexing IMPORT Index, InitIndex, InBounds, HighIndice, PutIndice, GetIndice ;
+FROM M2RTS IMPORT InstallTerminationProcedure ;
+
+CONST
+   SEEK_SET            =       0 ;   (* relative from beginning of the file *)
+   SEEK_END            =       2 ;   (* relative to the end of the file     *)
+   UNIXREADONLY        =       0 ;
+   UNIXWRITEONLY       =       1 ;
+   CreatePermissions   =     666B;
+   MaxBufferLength     = 1024*16 ;
+   MaxErrorString      = 1024* 8 ;
+
+TYPE
+   FileUsage         = (unused, openedforread, openedforwrite, openedforrandom) ;
+   FileStatus        = (successful, outofmemory, toomanyfilesopen, failed, connectionfailure, endofline, endoffile) ;
+
+   NameInfo          = RECORD
+                          address: ADDRESS ;
+                          size   : CARDINAL ;
+                       END ;
+
+   Buffer            = POINTER TO buf ;
+   buf               =            RECORD
+                                     valid   : BOOLEAN ;   (* are the field valid?             *)
+                                     bufstart: LONGINT ;   (* the position of buffer in file   *)
+                                     position: CARDINAL ;  (* where are we through this buffer *)
+                                     address : ADDRESS ;   (* dynamic buffer address           *)
+                                     filled  : CARDINAL ;  (* length of the buffer filled      *)
+                                     size    : CARDINAL ;  (* maximum space in this buffer     *)
+                                     left    : CARDINAL ;  (* number of bytes left to read     *)
+                                     contents: POINTER TO ARRAY [0..MaxBufferLength] OF CHAR ;
+                                  END ;
+
+   FileDescriptor   = POINTER TO fds ;
+   fds               =            RECORD
+                                     unixfd: INTEGER ;
+                                     name  : NameInfo ;
+                                     state : FileStatus ;
+                                     usage : FileUsage ;
+                                     output: BOOLEAN ;     (* is this file going to write data *)
+                                     buffer: Buffer ;
+                                     abspos: LONGINT ;     (* absolute position into file.     *)
+                                  END ;                    (* reflects low level reads which   *)
+                                                           (* means this value will normally   *)
+                                                           (* be further through the file than *)
+                                                           (* bufstart above.                  *)
+   PtrToChar         = POINTER TO CHAR ;
+
+
+VAR
+   FileInfo: Index ;
+   Error   : File ;   (* not stderr, this is an unused file handle
+                         which only serves to hold status values
+                         when we cannot create a new file handle *)
+
+
+(*
+   GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*)
+
+PROCEDURE GetUnixFileDescriptor (f: File) : INTEGER ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         RETURN( fd^.unixfd )
+      END
+   END ;
+   FormatError1('file %d has not been opened or is out of range\n', f) ;
+   RETURN( -1 )
+END GetUnixFileDescriptor ;
+
+
+(*
+   WriteString - writes a string to file, f.
+*)
+
+PROCEDURE WriteString (f: File; a: ARRAY OF CHAR) ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := StrLen(a) ;
+   IF WriteNBytes(f, l, ADR(a))#l
+   THEN
+   END
+END WriteString ;
+
+
+(*
+   Max - returns the maximum of two values.
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a>b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Max ;
+
+
+(*
+   Min - returns the minimum of two values.
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+(*
+   GetNextFreeDescriptor - returns the index to the FileInfo array indicating
+                           the next free slot.
+*)
+
+PROCEDURE GetNextFreeDescriptor () : File ;
+VAR
+   f, h: File ;
+   fd  : FileDescriptor ;
+BEGIN
+   f := Error+1 ;
+   h := HighIndice(FileInfo) ;
+   LOOP
+      IF f<=h
+      THEN
+         fd := GetIndice(FileInfo, f) ;
+         IF fd=NIL
+         THEN
+            RETURN( f )
+         END
+      END ;
+      INC(f) ;
+      IF f>h
+      THEN
+         PutIndice(FileInfo, f, NIL) ;  (* create new slot *)
+         RETURN( f )
+      END
+   END
+END GetNextFreeDescriptor ;
+
+
+(*
+   IsNoError - returns a TRUE if no error has occured on file, f.
+*)
+
+PROCEDURE IsNoError (f: File) : BOOLEAN ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f=Error
+   THEN
+      RETURN( FALSE )
+   ELSE
+      fd := GetIndice(FileInfo, f) ;
+      RETURN( (fd#NIL) AND ((fd^.state=successful) OR (fd^.state=endoffile) OR (fd^.state=endofline)) )
+   END
+END IsNoError ;
+
+
+(*
+   IsActive - returns TRUE if the file, f, is still active.
+*)
+
+PROCEDURE IsActive (f: File) : BOOLEAN ;
+BEGIN
+   IF f=Error
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( GetIndice(FileInfo, f)#NIL )
+   END
+END IsActive ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE openToRead (fname: ADDRESS; flength: CARDINAL) : File ;
+VAR
+   f: File ;
+BEGIN
+   f := GetNextFreeDescriptor() ;
+   IF f=Error
+   THEN
+      SetState(f, toomanyfilesopen)
+   ELSE
+      f := InitializeFile(f, fname, flength, successful, openedforread, FALSE, MaxBufferLength) ;
+      ConnectToUnix(f, FALSE, FALSE)
+   END ;
+   RETURN( f )
+END openToRead ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE openToWrite (fname: ADDRESS; flength: CARDINAL) : File ;
+VAR
+   f: File ;
+BEGIN
+   f := GetNextFreeDescriptor() ;
+   IF f=Error
+   THEN
+      SetState(f, toomanyfilesopen)
+   ELSE
+      f := InitializeFile(f, fname, flength, successful, openedforwrite, TRUE, MaxBufferLength) ;
+      ConnectToUnix(f, TRUE, TRUE)
+   END ;
+   RETURN( f )
+END openToWrite ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE openForRandom (fname: ADDRESS; flength: CARDINAL;
+                         towrite, newfile: BOOLEAN) : File ;
+VAR
+   f: File ;
+BEGIN
+   f := GetNextFreeDescriptor() ;
+   IF f=Error
+   THEN
+      SetState(f, toomanyfilesopen)
+   ELSE
+      f := InitializeFile(f, fname, flength, successful, openedforrandom, towrite, MaxBufferLength) ;
+      ConnectToUnix(f, towrite, newfile)
+   END ;
+   RETURN( f )
+END openForRandom ;
+
+
+(*
+   exists - returns TRUE if a file named, fname exists for reading.
+*)
+
+PROCEDURE exists (fname: ADDRESS; flength: CARDINAL) : BOOLEAN ;
+VAR
+   f: File ;
+BEGIN
+   f := openToRead(fname, flength) ;
+   IF IsNoError(f)
+   THEN
+      Close(f) ;
+      RETURN( TRUE )
+   ELSE
+      Close(f) ;
+      RETURN( FALSE )
+   END
+END exists ;
+
+
+(*
+   SetState - sets the field, state, of file, f, to, s.
+*)
+
+PROCEDURE SetState (f: File; s: FileStatus) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   fd := GetIndice(FileInfo, f) ;
+   fd^.state := s
+END SetState ;
+
+
+(*
+   InitializeFile - initialize a file descriptor
+*)
+
+PROCEDURE InitializeFile (f: File; fname: ADDRESS;
+                          flength: CARDINAL; fstate: FileStatus;
+                          use: FileUsage;
+                          towrite: BOOLEAN; buflength: CARDINAL) : File ;
+VAR
+   p : PtrToChar ;
+   fd: FileDescriptor ;
+BEGIN
+   NEW(fd) ;
+   IF fd=NIL
+   THEN
+      SetState(Error, outofmemory) ;
+      RETURN( Error )
+   ELSE
+      PutIndice(FileInfo, f, fd) ;
+      WITH fd^ DO
+         name.size := flength+1 ;  (* need to guarantee the nul for C *)
+         usage     := use ;
+         output    := towrite ;
+         ALLOCATE(name.address, name.size) ;
+         IF name.address=NIL
+         THEN
+            state := outofmemory ;
+            RETURN( f )
+         END ;
+         name.address := strncpy(name.address, fname, flength) ;
+         (* and assign nul to the last byte *)
+         p := name.address ;
+         INC(p, flength) ;
+         p^ := nul ;
+         abspos := 0 ;
+         (* now for the buffer *)
+         NEW(buffer) ;
+         IF buffer=NIL
+         THEN
+            SetState(Error, outofmemory) ;
+            RETURN( Error )
+         ELSE
+            WITH buffer^ DO
+               valid    := FALSE ;
+               bufstart := 0 ;
+               size     := buflength ;
+               position := 0 ;
+               filled   := 0 ;
+               IF size=0
+               THEN
+                  address := NIL
+               ELSE
+                  ALLOCATE(address, size) ;
+                  IF address=NIL
+                  THEN
+                     state := outofmemory ;
+                     RETURN( f )
+                  END
+               END ;
+               IF towrite
+               THEN
+                  left := size
+               ELSE
+                  left := 0
+               END ;
+               contents := address ;  (* provides easy access for reading characters *)
+            END ;
+            state := fstate
+         END
+      END
+   END ;
+   RETURN( f )
+END InitializeFile ;
+
+
+(*
+   ConnectToUnix - connects a FIO file to a UNIX file descriptor.
+*)
+
+PROCEDURE ConnectToUnix (f: File; towrite, newfile: BOOLEAN) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            IF towrite
+            THEN
+               IF newfile
+               THEN
+                  unixfd := creat(name.address, CreatePermissions)
+               ELSE
+                  unixfd := open(name.address, UNIXWRITEONLY, 0)
+               END
+            ELSE
+               unixfd := open(name.address, UNIXREADONLY, 0)
+            END ;
+            IF unixfd<0
+            THEN
+               state := connectionfailure
+            END
+         END
+      END
+   END
+END ConnectToUnix ;
+
+
+(*
+   The following functions are wrappers for the above.
+*)
+
+PROCEDURE Exists (fname: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( exists(ADR(fname), StrLen(fname)) )
+END Exists ;
+
+
+PROCEDURE OpenToRead (fname: ARRAY OF CHAR) : File ;
+BEGIN
+   RETURN( openToRead(ADR(fname), StrLen(fname)) )
+END OpenToRead ;
+
+
+PROCEDURE OpenToWrite (fname: ARRAY OF CHAR) : File ;
+BEGIN
+   RETURN( openToWrite(ADR(fname), StrLen(fname)) )
+END OpenToWrite ;
+
+
+PROCEDURE OpenForRandom (fname: ARRAY OF CHAR;
+                         towrite: BOOLEAN; newfile: BOOLEAN) : File ;
+BEGIN
+   RETURN( openForRandom(ADR(fname), StrLen(fname), towrite, newfile) )
+END OpenForRandom ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Close (f: File) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      (*
+         we allow users to close files which have an error status
+      *)
+      IF fd#NIL
+      THEN
+         FlushBuffer(f) ;
+         WITH fd^ DO
+            IF unixfd>=0
+            THEN
+               IF close(unixfd)#0
+               THEN
+                  FormatError1('failed to close file (%s)\n', name.address) ;
+                  state := failed   (* --fixme-- too late to notify user (unless we return a BOOLEAN) *)
+               END
+            END ;
+            IF name.address#NIL
+            THEN
+               DEALLOCATE(name.address, name.size)
+            END ;
+            IF buffer#NIL
+            THEN
+               WITH buffer^ DO
+                  IF address#NIL
+                  THEN
+                     DEALLOCATE(address, size)
+                  END
+               END ;
+               DISPOSE(buffer) ;
+               buffer := NIL
+            END
+         END ;
+         DISPOSE(fd) ;
+         PutIndice(FileInfo, f, NIL)
+      END
+   END
+END Close ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ReadFromBuffer (f: File; a: ADDRESS; nBytes: CARDINAL) : INTEGER ;
+VAR
+   t     : ADDRESS ;
+   result: INTEGER ;
+   total,
+   n     : CARDINAL ;
+   p     : POINTER TO BYTE ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      total := 0 ;   (* how many bytes have we read *)
+      fd := GetIndice(FileInfo, f) ;
+      WITH fd^ DO
+         (* extract from the buffer first *)
+         IF (buffer#NIL) AND (buffer^.valid)
+         THEN
+            WITH buffer^ DO
+               IF left>0
+               THEN
+                  IF nBytes=1
+                  THEN
+                     (* too expensive to call memcpy for 1 character *)
+                     p := a ;
+                     p^ := contents^[position] ;
+                     DEC(left) ;         (* remove consumed bytes               *)
+                     INC(position) ;     (* move onwards n bytes                *)
+                     nBytes := 0 ;       (* reduce the amount for future direct *)
+                                         (* read                                *)
+                     RETURN( 1 )
+                  ELSE
+                     n := Min(left, nBytes) ;
+                     t := address ;
+                     INC(t, position) ;
+                     p := memcpy(a, t, n) ;
+                     DEC(left, n) ;      (* remove consumed bytes               *)
+                     INC(position, n) ;  (* move onwards n bytes                *)
+                                         (* move onwards ready for direct reads *)
+                     INC(a, n) ;
+                     DEC(nBytes, n) ;    (* reduce the amount for future direct *)
+                                         (* read                                *)
+                     INC(total, n) ;
+                     RETURN( total )     (* much cleaner to return now,         *)
+                  END                    (* difficult to record an error if     *)
+               END                       (* the read below returns -1           *)
+            END
+         END ;
+         IF nBytes>0
+         THEN
+            (* still more to read *)
+            result := read(unixfd, a, INTEGER(nBytes)) ;
+            IF result>0
+            THEN
+               INC(total, result) ;
+               INC(abspos, result) ;
+               (* now disable the buffer as we read directly into, a. *)
+               IF buffer#NIL
+               THEN
+                  buffer^.valid := FALSE
+               END ;
+            ELSE
+               IF result=0
+               THEN
+                  (* eof reached *)
+                  state := endoffile
+               ELSE
+                  state := failed
+               END ;
+               (* indicate buffer is empty *)
+               IF buffer#NIL
+               THEN
+                  WITH buffer^ DO
+                     valid    := FALSE ;
+                     left     := 0 ;
+                     position := 0 ;
+                     IF address#NIL
+                     THEN
+                        contents^[position] := nul
+                     END
+                  END
+               END ;
+               RETURN( -1 )
+            END
+         END
+      END ;
+      RETURN( total )
+   ELSE
+      RETURN( -1 )
+   END
+END ReadFromBuffer ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL; dest: ADDRESS) : CARDINAL ;
+VAR
+   n: INTEGER ;
+   p: POINTER TO CHAR ;
+BEGIN
+   IF f # Error
+   THEN
+      CheckAccess (f, openedforread, FALSE) ;
+      n := ReadFromBuffer (f, dest, nBytes) ;
+      IF n <= 0
+      THEN
+         RETURN 0
+      ELSE
+         p := dest ;
+         INC (p, n-1) ;
+         SetEndOfLine (f, p^) ;
+         RETURN n
+      END
+   ELSE
+      RETURN 0
+   END
+END ReadNBytes ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
+VAR
+   t     : ADDRESS ;
+   result: INTEGER ;
+   total,
+   n     : INTEGER ;
+   p     : POINTER TO BYTE ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      total := 0 ;   (* how many bytes have we read *)
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            (* extract from the buffer first *)
+            IF buffer#NIL
+            THEN
+               WITH buffer^ DO
+                  WHILE nBytes>0 DO
+                     IF (left>0) AND valid
+                     THEN
+                        IF nBytes=1
+                        THEN
+                           (* too expensive to call memcpy for 1 character *)
+                           p := a ;
+                           p^ := contents^[position] ;
+                           DEC(left) ;         (* remove consumed byte                *)
+                           INC(position) ;     (* move onwards n byte                 *)
+                           INC(total) ;
+                           RETURN( total )
+                        ELSE
+                           n := Min(left, nBytes) ;
+                           t := address ;
+                           INC(t, position) ;
+                           p := memcpy(a, t, n) ;
+                           DEC(left, n) ;      (* remove consumed bytes               *)
+                           INC(position, n) ;  (* move onwards n bytes                *)
+                                               (* move onwards ready for direct reads *)
+                           INC(a, n) ;
+                           DEC(nBytes, n) ;    (* reduce the amount for future direct *)
+                                               (* read                                *)
+                           INC(total, n)
+                        END
+                     ELSE
+                        (* refill buffer *)
+                        n := read(unixfd, address, size) ;
+                        IF n>=0
+                        THEN
+                           valid    := TRUE ;
+                           position := 0 ;
+                           left     := n ;
+                           filled   := n ;
+                           bufstart := abspos ;
+                           INC(abspos, n) ;
+                           IF n=0
+                           THEN
+                              (* eof reached *)
+                              state := endoffile ;
+                              RETURN( -1 )
+                           END
+                        ELSE
+                           valid    := FALSE ;
+                           position := 0 ;
+                           left     := 0 ;
+                           filled   := 0 ;
+                           state    := failed ;
+                           RETURN( total )
+                        END
+                     END
+                  END
+               END ;
+               RETURN( total )
+            ELSE
+               RETURN( -1 )
+            END
+         END
+      END
+   ELSE
+      RETURN( -1 )
+   END
+END BufferedRead ;
+
+
+(*
+   HandleEscape - translates \n and \t into their respective ascii codes.
+*)
+
+PROCEDURE HandleEscape (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR;
+                        VAR i, j: CARDINAL; HighSrc, HighDest: CARDINAL) ;
+BEGIN
+   IF (i+1<HighSrc) AND (src[i]='\') AND (j<HighDest)
+   THEN
+      IF src[i+1]='n'
+      THEN
+         (* requires a newline *)
+         dest[j] := nl ;
+         INC(j) ;
+         INC(i, 2)
+      ELSIF src[i+1]='t'
+      THEN
+         (* requires a tab (yuck) tempted to fake this but I better not.. *)
+         dest[j] := tab ;
+         INC(j) ;
+         INC(i, 2)
+      ELSE
+         (* copy escaped character *)
+         INC(i) ;
+         dest[j] := src[i] ;
+         INC(j) ;
+         INC(i)
+      END
+   END
+END HandleEscape ;
+
+
+(*
+   Cast - casts a := b
+*)
+
+PROCEDURE Cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF HIGH(a)=HIGH(b)
+   THEN
+      FOR i := 0 TO HIGH(a) DO
+         a[i] := b[i]
+      END
+   ELSE
+      FormatError('cast failed')
+   END
+END Cast ;
+
+
+(*
+   StringFormat1 - converts string, src, into, dest, together with encapsulated
+                   entity, w. It only formats the first %s or %d with n.
+*)
+
+PROCEDURE StringFormat1 (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR;
+                         w: ARRAY OF BYTE) ;
+VAR
+   HighSrc,
+   HighDest,
+   c, i, j : CARDINAL ;
+   str     : ARRAY [0..MaxErrorString] OF CHAR ;
+   p       : POINTER TO CHAR ;
+BEGIN
+   HighSrc := StrLen(src) ;
+   HighDest := HIGH(dest) ;
+   p := NIL ;
+   c := 0 ;
+   i := 0 ;
+   j := 0 ;
+   WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) AND (src[i]#'%') DO
+      IF src[i]='\'
+      THEN
+         HandleEscape(dest, src, i, j, HighSrc, HighDest)
+      ELSE
+         dest[j] := src[i] ;
+         INC(i) ;
+         INC(j)
+      END
+   END ;
+
+   IF (i+1<HighSrc) AND (src[i]='%') AND (j<HighDest)
+   THEN
+      IF src[i+1]='s'
+      THEN
+         Cast(p, w) ;
+         WHILE (j<HighDest) AND (p^#nul) DO
+            dest[j] := p^ ;
+            INC(j) ;
+            INC(p)
+         END ;
+         IF j<HighDest
+         THEN
+            dest[j] := nul
+         END ;
+         j := StrLen(dest) ;
+         INC(i, 2)
+      ELSIF src[i+1]='d'
+      THEN
+         dest[j] := nul ;
+         Cast(c, w) ;
+         CardToStr(c, 0, str) ;
+         StrConCat(dest, str, dest) ;
+         j := StrLen(dest) ;
+         INC(i, 2)
+      ELSE
+         dest[j] := src[i] ;
+         INC(i) ;
+         INC(j)
+      END
+   END ;
+   (* and finish off copying src into dest *)
+   WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) DO
+      IF src[i]='\'
+      THEN
+         HandleEscape(dest, src, i, j, HighSrc, HighDest)
+      ELSE
+         dest[j] := src[i] ;
+         INC(i) ;
+         INC(j)
+      END
+   END ;
+   IF j<HighDest
+   THEN
+      dest[j] := nul
+   END ;
+END StringFormat1 ;
+
+
+(*
+   FormatError - provides a orthoganal counterpart to the procedure below.
+*)
+
+PROCEDURE FormatError (a: ARRAY OF CHAR) ;
+BEGIN
+   WriteString (StdErr, a)
+END FormatError ;
+
+
+(*
+   FormatError1 - generic error procedure taking standard format string
+                  and single parameter.
+*)
+
+PROCEDURE FormatError1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   s: ARRAY [0..MaxErrorString] OF CHAR ;
+BEGIN
+   StringFormat1 (s, a, w) ;
+   FormatError (s)
+END FormatError1 ;
+
+
+(*
+   FormatError2 - generic error procedure taking standard format string
+                  and two parameters.
+*)
+
+PROCEDURE FormatError2 (a: ARRAY OF CHAR;
+                        w1, w2: ARRAY OF BYTE) ;
+VAR
+   s: ARRAY [0..MaxErrorString] OF CHAR ;
+BEGIN
+   StringFormat1 (s, a, w1) ;
+   FormatError1 (s, w2)
+END FormatError2 ;
+
+
+(*
+   CheckAccess - checks to see whether a file f has been
+                 opened for read/write.
+*)
+
+PROCEDURE CheckAccess (f: File; use: FileUsage; towrite: BOOLEAN) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice (FileInfo, f) ;
+      IF fd=NIL
+      THEN
+         IF f#StdErr
+         THEN
+            FormatError ('this file has probably been closed and not reopened successfully or alternatively never opened\n')
+         END ;
+         HALT
+      ELSE
+         WITH fd^ DO
+            IF (use=openedforwrite) AND (usage=openedforread)
+            THEN
+               FormatError1 ('this file (%s) has been opened for reading but is now being written\n',
+                             name.address) ;
+               HALT
+            ELSIF (use=openedforread) AND (usage=openedforwrite)
+            THEN
+               FormatError1('this file (%s) has been opened for writing but is now being read\n',
+                            name.address) ;
+               HALT
+            ELSIF state=connectionfailure
+            THEN
+               FormatError1('this file (%s) was not successfully opened\n',
+                            name.address) ;
+               HALT
+            ELSIF towrite#output
+            THEN
+               IF output
+               THEN
+                  FormatError1('this file (%s) was opened for writing but is now being read\n',
+                               name.address) ;
+                  HALT
+               ELSE
+                  FormatError1('this file (%s) was opened for reading but is now being written\n',
+                               name.address) ;
+                  HALT
+               END
+            END
+         END
+      END
+   ELSE
+      FormatError('this file has not been opened successfully\n') ;
+      HALT
+   END
+END CheckAccess ;
+
+
+(*
+   ReadChar - returns a character read from file f.
+              Sensible to check with IsNoError or EOF after calling
+              this function.
+*)
+
+PROCEDURE ReadChar (f: File) : CHAR ;
+VAR
+   ch: CHAR ;
+BEGIN
+   CheckAccess (f, openedforread, FALSE) ;
+   IF BufferedRead (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch))
+   THEN
+      SetEndOfLine (f, ch) ;
+      RETURN ch
+   ELSE
+      RETURN nul
+   END
+END ReadChar ;
+
+
+(*
+   SetEndOfLine -
+*)
+
+PROCEDURE SetEndOfLine (f: File; ch: CHAR) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      WITH fd^ DO
+         IF ch=nl
+         THEN
+            state := endofline
+         ELSE
+            state := successful
+         END
+      END
+   END
+END SetEndOfLine ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE UnReadChar (f: File; ch: CHAR) ;
+VAR
+   fd  : FileDescriptor ;
+   n   : CARDINAL ;
+   a, b: ADDRESS ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      WITH fd^ DO
+         IF (state=successful) OR (state=endoffile) OR (state=endofline)
+         THEN
+            IF (buffer#NIL) AND (buffer^.valid)
+            THEN
+               WITH buffer^ DO
+                  (* we assume that a ReadChar has occurred, we will check just in case. *)
+                  IF state=endoffile
+                  THEN
+                     position := MaxBufferLength ;
+                     left := 0 ;
+                     filled := 0 ;
+                     state := successful
+                  END ;
+                  IF position>0
+                  THEN
+                     DEC(position) ;
+                     INC(left) ;
+                     contents^[position] := ch ;
+                  ELSE
+                     (* position=0 *)
+                     (* if possible make room and store ch *)
+                     IF filled=size
+                     THEN
+                        FormatError1('performing too many UnReadChar calls on file (%d)\n', f)
+                     ELSE
+                        n := filled-position ;
+                        b := ADR(contents^[position]) ;
+                        a := ADR(contents^[position+1]) ;
+                        a := memcpy(a, b, n) ;
+                        INC(filled) ;
+                        contents^[position] := ch ;
+                     END
+                  END
+               END
+            END
+         ELSE
+            FormatError1('UnReadChar can only be called if the previous read was successful or end of file, error on file (%d)\n', f)
+         END
+      END
+   END
+END UnReadChar ;
+
+
+(*
+   ReadAny - reads HIGH(a) bytes into, a. All input
+             is fully buffered, unlike ReadNBytes and thus is more
+             suited to small reads.
+*)
+
+PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF BufferedRead (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
+   THEN
+      SetEndOfLine(f, a[HIGH(a)])
+   END
+END ReadAny ;
+
+
+(*
+   EOF - tests to see whether a file, f, has reached end of file.
+*)
+
+PROCEDURE EOF (f: File) : BOOLEAN ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         RETURN( fd^.state=endoffile )
+      END
+   END ;
+   RETURN( TRUE )
+END EOF ;
+
+
+(*
+   EOLN - tests to see whether a file, f, is upon a newline.
+          It does NOT consume the newline.
+*)
+
+PROCEDURE EOLN (f: File) : BOOLEAN ;
+VAR
+   ch: CHAR ;
+   fd: FileDescriptor ;
+BEGIN
+   CheckAccess(f, 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
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         IF (fd^.state=successful) OR (fd^.state=endofline)
+         THEN
+            ch := ReadChar(f) ;
+            IF (fd^.state=successful) OR (fd^.state=endofline)
+            THEN
+               UnReadChar(f, ch)
+            END ;
+            RETURN( ch=nl )
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END EOLN ;
+
+
+(*
+   WasEOLN - tests to see whether a file, f, has just seen a newline.
+*)
+
+PROCEDURE WasEOLN (f: File) : BOOLEAN ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF f=Error
+   THEN
+      RETURN FALSE
+   ELSE
+      fd := GetIndice(FileInfo, f) ;
+      RETURN( (fd#NIL) AND (fd^.state=endofline) )
+   END
+END WasEOLN ;
+
+
+(*
+   WriteLine - writes out a linefeed to file, f.
+*)
+
+PROCEDURE WriteLine (f: File) ;
+BEGIN
+   WriteChar(f, nl)
+END WriteLine ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL; src: ADDRESS) : CARDINAL ;
+VAR
+   total: INTEGER ;
+   fd   : FileDescriptor ;
+BEGIN
+   CheckAccess(f, openedforwrite, TRUE) ;
+   FlushBuffer(f) ;
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            total := write(unixfd, src, INTEGER(nBytes)) ;
+            IF total<0
+            THEN
+               state := failed ;
+               RETURN( 0 )
+            ELSE
+               INC(abspos, CARDINAL(total)) ;
+               IF buffer#NIL
+               THEN
+                  buffer^.bufstart := abspos
+               END ;
+               RETURN( CARDINAL(total) )
+            END
+         END
+      END
+   END ;
+   RETURN( 0 )
+END WriteNBytes ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE BufferedWrite (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
+VAR
+   t     : ADDRESS ;
+   result: INTEGER ;
+   total,
+   n     : INTEGER ;
+   p     : POINTER TO BYTE ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         total := 0 ;   (* how many bytes have we read *)
+         WITH fd^ DO
+            IF buffer#NIL
+            THEN
+               WITH buffer^ DO
+                  WHILE nBytes>0 DO
+                     (* place into the buffer first *)
+                     IF left>0
+                     THEN
+                        IF nBytes=1
+                        THEN
+                           (* too expensive to call memcpy for 1 character *)
+                           p := a ;
+                           contents^[position] := p^ ;
+                           DEC(left) ;         (* reduce space                        *)
+                           INC(position) ;     (* move onwards n byte                 *)
+                           INC(total) ;
+                           RETURN( total )
+                        ELSE
+                           n := Min(left, nBytes) ;
+                           t := address ;
+                           INC(t, position) ;
+                           p := memcpy(a, t, CARDINAL(n)) ;
+                           DEC(left, n) ;      (* remove consumed bytes               *)
+                           INC(position, n) ;  (* move onwards n bytes                *)
+                                               (* move ready for further writes       *)
+                           INC(a, n) ;
+                           DEC(nBytes, n) ;    (* reduce the amount for future writes *)
+                           INC(total, n)
+                        END
+                     ELSE
+                        FlushBuffer(f) ;
+                        IF (state#successful) AND (state#endofline)
+                        THEN
+                           nBytes := 0
+                        END
+                     END
+                  END
+               END ;
+               RETURN( total )
+            END
+         END
+      END
+   END ;
+   RETURN( -1 )
+END BufferedWrite ;
+
+
+(*
+   FlushBuffer - flush contents of file, f.
+*)
+
+PROCEDURE FlushBuffer (f: File) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            IF output AND (buffer#NIL)
+            THEN
+               WITH buffer^ DO
+                  IF (position=0) OR (write(unixfd, address, position)=VAL(INTEGER, position))
+                  THEN
+                     INC(abspos, position) ;
+                     bufstart := abspos ;
+                     position := 0 ;
+                     filled   := 0 ;
+                     left     := size
+                  ELSE
+                     state := failed
+                  END
+               END
+            END
+         END
+      END
+   END
+END FlushBuffer ;
+
+
+(*
+   WriteAny - writes HIGH(a) bytes onto, file, f. All output
+              is fully buffered, unlike WriteNBytes and thus is more
+              suited to small writes.
+*)
+
+PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
+BEGIN
+   CheckAccess (f, openedforwrite, TRUE) ;
+   IF BufferedWrite (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
+   THEN
+   END
+END WriteAny ;
+
+
+(*
+   WriteChar - writes a single character to file, f.
+*)
+
+PROCEDURE WriteChar (f: File; ch: CHAR) ;
+BEGIN
+   CheckAccess (f, openedforwrite, TRUE) ;
+   IF BufferedWrite (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch))
+   THEN
+   END
+END WriteChar ;
+
+
+(*
+   WriteCardinal - writes a CARDINAL to file, f.
+                   It writes the binary image of the cardinal
+                   to file, f.
+*)
+
+PROCEDURE WriteCardinal (f: File; c: CARDINAL) ;
+BEGIN
+   WriteAny(f, c)
+END WriteCardinal ;
+
+
+(*
+   ReadCardinal - reads a CARDINAL from file, f.
+                  It reads a binary image of a CARDINAL
+                  from a file, f.
+*)
+
+PROCEDURE ReadCardinal (f: File) : CARDINAL ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   ReadAny(f, c) ;
+   RETURN( c )
+END ReadCardinal ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ReadString (f: File; VAR a: ARRAY OF CHAR) ;
+VAR
+   high,
+   i   : CARDINAL ;
+   ch  : CHAR ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   high := HIGH(a) ;
+   i := 0 ;
+   REPEAT
+      ch := ReadChar(f) ;
+      IF i<=high
+      THEN
+         IF (ch=nl) OR (NOT IsNoError(f)) OR EOF(f)
+         THEN
+            a[i] := nul ;
+            INC(i)
+         ELSE
+            a[i] := ch ;
+            INC(i)
+         END
+      END
+   UNTIL (ch=nl) OR (i>high) OR (NOT IsNoError(f)) OR EOF(f)
+END ReadString ;
+
+
+(*
+   SetPositionFromBeginning - sets the position from the beginning of the file.
+*)
+
+PROCEDURE SetPositionFromBeginning (f: File; pos: LONGINT) ;
+VAR
+   offset: LONGINT ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            (* 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 (abspos#pos) OR TRUE
+            THEN
+               FlushBuffer(f) ;
+               IF buffer#NIL
+               THEN
+                  WITH buffer^ DO
+                     IF output
+                     THEN
+                        left := size
+                     ELSE
+                        left := 0
+                     END ;
+                     position := 0 ;
+                     filled   := 0
+                  END
+               END ;
+               offset := lseek(unixfd, pos, SEEK_SET) ;
+               IF (offset>=0) AND (pos=offset)
+               THEN
+                  abspos := pos
+               ELSE
+                  state  := failed ;
+                  abspos := 0
+               END ;
+               IF buffer#NIL
+               THEN
+                  buffer^.valid := FALSE ;
+                  buffer^.bufstart := abspos
+               END
+            END
+         END
+      END
+   END
+END SetPositionFromBeginning ;
+
+
+(*
+   SetPositionFromEnd - sets the position from the end of the file.
+*)
+
+PROCEDURE SetPositionFromEnd (f: File; pos: LONGINT) ;
+VAR
+   offset: LONGINT ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            FlushBuffer(f) ;
+            IF buffer#NIL
+            THEN
+               WITH buffer^ DO
+                  IF output
+                  THEN
+                     left := size
+                  ELSE
+                     left := 0
+                  END ;
+                  position := 0 ;
+                  filled   := 0
+               END
+            END ;
+            offset := lseek(unixfd, pos, SEEK_END) ;
+            IF offset>=0
+            THEN
+               abspos := offset ;
+            ELSE
+               state  := failed ;
+               abspos := 0 ;
+               offset := 0
+            END ;
+            IF buffer#NIL
+            THEN
+               buffer^.valid := FALSE ;
+               buffer^.bufstart := offset
+            END
+         END
+      END
+   END
+END SetPositionFromEnd ;
+
+
+(*
+   FindPosition - returns the current absolute position in file, f.
+*)
+
+PROCEDURE FindPosition (f: File) : LONGINT ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            IF (buffer=NIL) OR (NOT buffer^.valid)
+            THEN
+               RETURN( abspos )
+            ELSE
+               WITH buffer^ DO
+                  RETURN( bufstart+VAL(LONGINT, position) )
+               END
+            END
+         END
+      END
+   END ;
+   RETURN( 0 )
+END FindPosition ;
+
+
+(*
+   GetFileName - assigns, a, with the filename associated with, f.
+*)
+
+PROCEDURE GetFileName (f: File; VAR a: ARRAY OF CHAR) ;
+VAR
+   i : CARDINAL ;
+   p : POINTER TO CHAR ;
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd=NIL
+      THEN
+         FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ;
+         HALT
+      ELSE
+         WITH fd^.name DO
+            IF address=NIL
+            THEN
+               StrCopy('', a)
+            ELSE
+               p := address ;
+               i := 0 ;
+               WHILE (p^#nul) AND (i<=HIGH(a)) DO
+                  a[i] := p^ ;
+                  INC(p) ;
+                  INC(i)
+               END
+            END
+         END
+      END
+   END
+END GetFileName ;
+
+
+(*
+   getFileName - returns the address of the filename associated with, f.
+*)
+
+PROCEDURE getFileName (f: File) : ADDRESS ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd=NIL
+      THEN
+         FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ;
+         HALT
+      ELSE
+         RETURN fd^.name.address
+      END
+   END
+END getFileName ;
+
+
+(*
+   getFileNameLength - returns the number of characters associated with filename, f.
+*)
+
+PROCEDURE getFileNameLength (f: File) : CARDINAL ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd=NIL
+      THEN
+         FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ;
+         HALT
+      ELSE
+         RETURN fd^.name.size
+      END
+   END
+END getFileNameLength ;
+
+
+(*
+   PreInitialize - preinitialize the file descriptor.
+*)
+
+PROCEDURE PreInitialize (f: File; fname: ARRAY OF CHAR;
+                         state: FileStatus; use: FileUsage;
+                         towrite: BOOLEAN; osfd: INTEGER; bufsize: CARDINAL) ;
+VAR
+   fd, fe: FileDescriptor ;
+BEGIN
+   IF InitializeFile(f, ADR(fname), StrLen(fname), state, use, towrite, bufsize)=f
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF f=Error
+      THEN
+         fe := GetIndice(FileInfo, StdErr) ;
+         IF fe=NIL
+         THEN
+            HALT
+         ELSE
+            fd^.unixfd := fe^.unixfd    (* the error channel *)
+         END
+      ELSE
+         fd^.unixfd := osfd
+      END
+   ELSE
+      HALT
+   END
+END PreInitialize ;
+
+
+(*
+   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).
+*)
+
+PROCEDURE FlushOutErr ;
+BEGIN
+   IF IsNoError(StdOut)
+   THEN
+      FlushBuffer(StdOut)
+   END ;
+   IF IsNoError(StdErr)
+   THEN
+      FlushBuffer(StdErr)
+   END
+END FlushOutErr ;
+
+
+(*
+   Init - initialize the modules, global variables.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   FileInfo := InitIndex(0) ;
+   Error := 0 ;
+   PreInitialize(Error       , 'error'   , toomanyfilesopen, unused        , FALSE, -1, 0) ;
+   StdIn := 1 ;
+   PreInitialize(StdIn       , '<stdin>' , successful      , openedforread , FALSE, 0, MaxBufferLength) ;
+   StdOut := 2 ;
+   PreInitialize(StdOut      , '<stdout>', successful      , openedforwrite,  TRUE, 1, MaxBufferLength) ;
+   StdErr := 3 ;
+   PreInitialize(StdErr      , '<stderr>', successful      , openedforwrite,  TRUE, 2, MaxBufferLength) ;
+   IF NOT InstallTerminationProcedure(FlushOutErr)
+   THEN
+      HALT
+   END
+END Init ;
+
+
+BEGIN
+   Init
+FINALLY
+   FlushOutErr
+END FIO.
diff --git a/gcc/m2/gm2-libs/FormatStrings.def b/gcc/m2/gm2-libs/FormatStrings.def
new file mode 100644
index 00000000000..f5cc9723b88
--- /dev/null
+++ b/gcc/m2/gm2-libs/FormatStrings.def
@@ -0,0 +1,83 @@
+(* FormatStrings.def provides a pseudo printf capability.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE FormatStrings ;
+
+FROM SYSTEM IMPORT BYTE ;
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4,
+                 HandleEscape ;
+
+
+(*
+   Sprintf0 - returns a String containing, fmt, after it has had its
+              escape sequences translated.
+*)
+
+PROCEDURE Sprintf0 (fmt: String) : String ;
+
+
+(*
+   Sprintf1 - returns a String containing, fmt, together with
+              encapsulated entity, w. It only formats the
+              first %s or %d with n.
+*)
+
+PROCEDURE Sprintf1 (fmt: String; w: ARRAY OF BYTE) : String ;
+
+
+(*
+   Sprintf2 - returns a string, fmt, which has been formatted.
+*)
+
+PROCEDURE Sprintf2 (fmt: String; w1, w2: ARRAY OF BYTE) : String ;
+
+
+(*
+   Sprintf3 - returns a string, fmt, which has been formatted.
+*)
+
+PROCEDURE Sprintf3 (fmt: String; w1, w2, w3: ARRAY OF BYTE) : String ;
+
+
+(*
+   Sprintf4 - returns a string, fmt, which has been formatted.
+*)
+
+PROCEDURE Sprintf4 (fmt: String;
+                    w1, w2, w3, w4: ARRAY OF BYTE) : String ;
+
+
+(*
+   HandleEscape - translates \a, \b, \e, \f, \n, \r, \x[hex] \[octal]
+                  into their respective ascii codes.  It also converts
+                  \[any] into a single [any] character.
+*)
+
+PROCEDURE HandleEscape (s: String) : String ;
+
+
+END FormatStrings.
diff --git a/gcc/m2/gm2-libs/FormatStrings.mod b/gcc/m2/gm2-libs/FormatStrings.mod
new file mode 100644
index 00000000000..973c41aab46
--- /dev/null
+++ b/gcc/m2/gm2-libs/FormatStrings.mod
@@ -0,0 +1,580 @@
+(* FormatStrings.mod provides a pseudo printf capability.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+IMPLEMENTATION MODULE FormatStrings ;
+
+FROM DynamicStrings IMPORT String, InitString, InitStringChar, Mark,
+                           ConCat, Slice, Index, char, string,
+                           Assign, Length, Mult, Dup, ConCatChar,
+                           PushAllocation, PopAllocationExemption,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB,
+                           KillString, ConCatChar ;
+
+FROM StringConvert IMPORT IntegerToString, CardinalToString, hstoc ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+IMPORT ASCII ;
+
+
+(*
+#undef GM2_DEBUG_FORMATSTRINGS
+#if defined(GM2_DEBUG_FORMATSTRINGS)
+#  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
+*)
+
+
+(*
+   doDSdbEnter -
+*)
+
+PROCEDURE doDSdbEnter ;
+BEGIN
+   PushAllocation
+END doDSdbEnter ;
+
+
+(*
+   doDSdbExit -
+*)
+
+PROCEDURE doDSdbExit (s: String) ;
+BEGIN
+   s := PopAllocationExemption (TRUE, s)
+END doDSdbExit ;
+
+
+(*
+   DSdbEnter -
+*)
+
+PROCEDURE DSdbEnter ;
+BEGIN
+END DSdbEnter ;
+
+
+(*
+   DSdbExit -
+*)
+
+PROCEDURE DSdbExit (s: String) ;
+BEGIN
+END DSdbExit ;
+
+
+(*
+#if defined(GM2_DEBUG_FORMATSTRINGS)
+#  define DBsbEnter doDBsbEnter
+#  define DBsbExit  doDBsbExit
+#endif
+*)
+
+
+(*
+   IsDigit - returns TRUE if ch lies in the range: 0..9
+*)
+
+PROCEDURE IsDigit (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( (ch>='0') AND (ch<='9') )
+END IsDigit ;
+
+
+(*
+   Cast - casts a := b
+*)
+
+PROCEDURE Cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF HIGH(a)=HIGH(b)
+   THEN
+      FOR i := 0 TO HIGH(a) DO
+         a[i] := b[i]
+      END
+   ELSE
+      HALT
+   END
+END Cast ;
+
+
+(*
+   isHex -
+*)
+
+PROCEDURE isHex (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN ( ((ch >= '0') AND (ch <= '9')) OR
+            ((ch >= 'A') AND (ch <= 'F')) OR
+            ((ch >= 'a') AND (ch <= 'f')) )
+END isHex ;
+
+
+(*
+   toHex -
+*)
+
+PROCEDURE toHex (ch: CHAR) : CARDINAL ;
+BEGIN
+   IF ((ch >= '0') AND (ch <= '9'))
+   THEN
+      RETURN ORD (ch) - ORD ('0')
+   ELSIF (ch >= 'A') AND (ch <= 'F')
+   THEN
+      RETURN ORD (ch) - ORD ('A') + 10
+   ELSE
+      RETURN ORD (ch) - ORD ('a') + 10
+   END
+END toHex ;
+
+
+(*
+   toOct -
+*)
+
+PROCEDURE toOct (ch: CHAR) : CARDINAL ;
+BEGIN
+   RETURN ORD (ch) - ORD ('0')
+END toOct ;
+
+
+(*
+   isOct -
+*)
+
+PROCEDURE isOct (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch >= '0') AND (ch <= '8')
+END isOct ;
+
+
+(*
+   HandleEscape - translates \a, \b, \e, \f, \n, \r, \x[hex] \[octal] into
+                  their respective ascii codes.  It also converts \[any] into
+                  a single [any] character.
+*)
+
+PROCEDURE HandleEscape (s: String) : String ;
+VAR
+   d   : String ;
+   i, j: INTEGER ;
+   ch  : CHAR ;
+   b   : BYTE ;
+BEGIN
+   DSdbEnter ;
+   d := InitString ('') ;
+   i := Index (s, '\', 0) ;
+   j := 0 ;
+   WHILE i>=0 DO
+      IF i>0
+      THEN
+         (* initially i might be zero which means the end of the string, which is not what we want.  *)
+         d := ConCat (d, Slice (s, j, i))
+      END ;
+      ch := char (s, i+1) ;
+      IF ch='a'
+      THEN
+         (* requires a bell.  *)
+         d := ConCat (d, Mark (InitStringChar (ASCII.bel)))
+      ELSIF ch='b'
+      THEN
+         (* requires a backspace.  *)
+         d := ConCat (d, Mark (InitStringChar (ASCII.bs)))
+      ELSIF ch='e'
+      THEN
+         (* requires a escape.  *)
+         d := ConCat (d, Mark (InitStringChar (ASCII.esc)))
+      ELSIF ch='f'
+      THEN
+         (* requires a formfeed.  *)
+         d := ConCat (d, Mark (InitStringChar (ASCII.ff)))
+      ELSIF ch='n'
+      THEN
+         (* requires a newline.  *)
+         d := ConCat (d, Mark (InitStringChar (ASCII.nl)))
+      ELSIF ch='r'
+      THEN
+         (* requires a carriage return.  *)
+         d := ConCat (d, Mark (InitStringChar (ASCII.cr)))
+      ELSIF ch='t'
+      THEN
+         (* requires a tab.  *)
+         d := ConCat (d, Mark (InitStringChar (ASCII.tab)))
+      ELSIF ch='x'
+      THEN
+         INC (i) ;
+         IF isHex (char (s, i+1))
+         THEN
+            b := VAL (BYTE, toHex (char (s, i+1))) ;
+            INC (i) ;
+            IF isHex (char (s, i+1))
+            THEN
+               b := VAL (BYTE, VAL (CARDINAL, b) * 010H + toHex (char (s, i+1))) ;
+               d := ConCat (d, Mark (InitStringChar (VAL (CHAR, b))))
+            END
+         END
+      ELSIF isOct (ch)
+      THEN
+         b := VAL (BYTE, toOct (ch)) ;
+         INC (i) ;
+         IF isOct (char (s, i+1))
+         THEN
+            b := VAL (BYTE, VAL (CARDINAL, b) * 8 + toOct (char (s, i+1))) ;
+            INC (i) ;
+            IF isOct (char (s, i+1))
+            THEN
+               b := VAL (BYTE, VAL (CARDINAL, b) * 8 + toOct (char (s, i+1)))
+            END
+         END ;
+         d := ConCat (d, Mark (InitStringChar (VAL (CHAR, b))))
+      ELSE
+         (* copy escaped character.  *)
+         d := ConCat (d, Mark (InitStringChar (ch)))
+      END ;
+      INC (i, 2) ;
+      j := i ;
+      i := Index (s, '\', CARDINAL (i))
+   END ;
+   (*   s := Assign(s, Mark(ConCat(d, Mark(Slice(s, j, 0))))) ;   (* dont Mark(s) in the Slice as we Assign contents *) *)
+   s := ConCat (d, Mark (Slice (Mark (s), j, 0))) ;
+   DSdbExit (s) ;
+   RETURN s
+END HandleEscape ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE FormatString (fmt: String; VAR startpos: INTEGER; in: String; w: ARRAY OF BYTE) : String ;
+VAR
+   s: String ;
+BEGIN
+   DSdbEnter ;
+   IF startpos >= 0
+   THEN
+      s := PerformFormatString (fmt, startpos, in, w)
+   ELSE
+      s := Dup (in)
+   END ;
+   DSdbExit (s) ;
+   RETURN s
+END FormatString ;
+
+
+PROCEDURE PerformFormatString (fmt: String; VAR startpos: INTEGER; in: String; w: ARRAY OF BYTE) : String ;
+VAR
+   left     : BOOLEAN ;
+   u        : CARDINAL ;
+   c,
+   width,
+   nextperc,
+   afterperc,
+   endpos   : INTEGER ;
+   leader,
+   ch, ch2  : CHAR ;
+   p        : String ;
+BEGIN
+   WHILE startpos >= 0 DO
+      nextperc := Index (fmt, '%', startpos) ;
+      afterperc := nextperc ;
+      IF nextperc >= 0
+      THEN
+         INC (afterperc) ;
+         IF char (fmt, afterperc)='-'
+         THEN
+            left := TRUE ;
+            INC (afterperc)
+         ELSE
+            left := FALSE
+         END ;
+         ch := char (fmt, afterperc) ;
+         IF ch = '0'
+         THEN
+            leader := '0'
+         ELSE
+            leader := ' '
+         END ;
+         width := 0 ;
+         WHILE IsDigit (ch) DO
+            width := (width*10)+VAL (INTEGER, ORD (ch) - ORD ('0')) ;
+            INC (afterperc) ;
+            ch := char (fmt, afterperc)
+         END ;
+         IF (ch='c') OR (ch='s')
+         THEN
+            INC (afterperc) ;
+            IF (ch='c')
+            THEN
+               ch2 := w[0] ;
+               p := ConCatChar (InitString (''), ch2)
+            ELSE
+               Cast (p, w) ;
+               p := Dup (p)
+            END ;
+            IF (width>0) AND (VAL (INTEGER, Length (p)) < width)
+            THEN
+               IF left
+               THEN
+                  (* place trailing spaces after, p.  *)
+                  p := ConCat(p,
+                              Mark(Mult(Mark(InitString(' ')), width-VAL(INTEGER, Length(p)))))
+               ELSE
+                  (* padd string, p, with leading spaces.  *)
+                  p := ConCat(Mult(Mark(InitString(' ')), width-VAL(INTEGER, Length(p))),
+                              Mark(p))
+               END
+            END ;
+            (* include string, p, into, in.  *)
+            IF nextperc > 0
+            THEN
+               in := ConCat (in, Slice (fmt, startpos, nextperc))
+            END ;
+            in := ConCat (in, p) ;
+            startpos := afterperc ;
+            DSdbExit (NIL) ;
+            RETURN in
+         ELSIF ch='d'
+         THEN
+            INC (afterperc) ;
+            Cast (c, w) ;
+            in := Copy (fmt, in, startpos, nextperc) ;
+            in := ConCat (in, IntegerToString (c, width, leader, FALSE, 10, FALSE)) ;
+            startpos := afterperc ;
+            DSdbExit (NIL) ;
+            RETURN in
+         ELSIF ch='x'
+         THEN
+            INC (afterperc) ;
+            Cast (u, w) ;
+            in := ConCat (in, Slice (fmt, startpos, nextperc)) ;
+            in := ConCat (in, CardinalToString (u, width, leader, 16, TRUE)) ;
+            startpos := afterperc ;
+            DSdbExit (NIL) ;
+            RETURN in
+         ELSIF ch='u'
+         THEN
+            INC (afterperc) ;
+            Cast (u, w) ;
+            in := ConCat (in, Slice (fmt, startpos, nextperc)) ;
+            in := ConCat (in, CardinalToString (u, width, leader, 10, FALSE)) ;
+            startpos := afterperc ;
+            DSdbExit (NIL) ;
+            RETURN in
+         ELSE
+            INC (afterperc) ;
+            (* copy format string.  *)
+            IF nextperc > 0
+            THEN
+               in := ConCat (in, Slice (fmt, startpos, nextperc))
+            END ;
+            (* and the character after the %.  *)
+            in := ConCat (in, Mark (InitStringChar (ch)))
+         END ;
+         startpos := afterperc
+      ELSE
+         (* nothing to do.  *)
+         DSdbExit (NIL) ;
+         RETURN in
+      END
+   END ;
+   DSdbExit (NIL) ;
+   RETURN in
+END PerformFormatString ;
+
+
+(*
+   Copy - copies, fmt[start:end] -> in and returns in.  Providing that start >= 0.
+*)
+
+PROCEDURE Copy (fmt, in: String; start, end: INTEGER) : String ;
+BEGIN
+   IF start >= 0
+   THEN
+      IF end > 0
+      THEN
+         in := ConCat (in, Mark (Slice (fmt, start, end)))
+      ELSIF end < 0
+      THEN
+         in := ConCat (in, Mark (Slice (fmt, start, 0)))
+      END
+   END ;
+   RETURN in
+END Copy ;
+
+
+(*
+   HandlePercent - pre-condition:  s, is a string.
+                   Post-condition:  a new string is returned which is a copy of,
+                   s, except %% is transformed into %.
+*)
+
+PROCEDURE HandlePercent (fmt, s: String; startpos: INTEGER) : String ;
+VAR
+   prevpos: INTEGER ;
+   result : String ;
+BEGIN
+   IF (startpos = VAL (INTEGER, Length (fmt))) OR (startpos < 0)
+   THEN
+      RETURN s
+   ELSE
+      prevpos := startpos ;
+      WHILE (startpos >= 0) AND (prevpos < INTEGER (Length (fmt))) DO
+         startpos := Index (fmt, '%', startpos) ;
+         IF startpos >= prevpos
+         THEN
+            IF startpos > 0
+            THEN
+               s := ConCat (s, Mark (Slice (fmt, prevpos, startpos)))
+            END ;
+            INC (startpos) ;
+            IF char (fmt, startpos) = '%'
+            THEN
+               s := ConCatChar (s, '%') ;
+               INC (startpos)
+            END ;
+            prevpos := startpos
+         END
+      END ;
+      IF (prevpos < INTEGER (Length (fmt)))
+      THEN
+         s := ConCat (s, Mark (Slice (fmt, prevpos, 0)))
+      END ;
+      RETURN s
+   END
+END HandlePercent ;
+
+
+(*
+   Sprintf0 - returns a String containing, s, after it has had its
+              escape sequences translated.
+*)
+
+PROCEDURE Sprintf0 (fmt: String) : String ;
+VAR
+   s: String ;
+BEGIN
+   DSdbEnter ;
+   fmt := HandleEscape (fmt) ;
+   s := HandlePercent (fmt, InitString (''), 0) ;
+   DSdbExit (s) ;
+   RETURN s
+END Sprintf0 ;
+
+
+(*
+   Sprintf1 - returns a String containing, s, together with encapsulated
+              entity, w. It only formats the first %s or %d with n.
+*)
+
+PROCEDURE Sprintf1 (fmt: String; w: ARRAY OF BYTE) : String ;
+VAR
+   i: INTEGER ;
+   s: String ;
+BEGIN
+   DSdbEnter ;
+   fmt := HandleEscape (fmt) ;
+   i := 0 ;
+   s := FormatString (fmt, i, InitString (''), w) ;
+   s := HandlePercent (fmt, s, i) ;
+   DSdbExit (s) ;
+   RETURN s
+END Sprintf1 ;
+
+
+(*
+   Sprintf2 - returns a string, s, which has been formatted.
+*)
+
+PROCEDURE Sprintf2 (fmt: String; w1, w2: ARRAY OF BYTE) : String ;
+VAR
+   i: INTEGER ;
+   s: String ;
+BEGIN
+   DSdbEnter ;
+   fmt := HandleEscape (fmt) ;
+   i := 0 ;
+   s := FormatString (fmt, i, InitString (''), w1) ;
+   s := FormatString (fmt, i, s, w2) ;
+   s := HandlePercent (fmt, s, i) ;
+   DSdbExit (s) ;
+   RETURN s
+END Sprintf2 ;
+
+
+(*
+   Sprintf3 - returns a string, s, which has been formatted.
+*)
+
+PROCEDURE Sprintf3 (fmt: String; w1, w2, w3: ARRAY OF BYTE) : String ;
+VAR
+   i: INTEGER ;
+   s: String ;
+BEGIN
+   DSdbEnter ;
+   fmt := HandleEscape (fmt) ;
+   i := 0 ;
+   s := FormatString (fmt, i, InitString (''), w1) ;
+   s := FormatString (fmt, i, s, w2) ;
+   s := FormatString (fmt, i, s, w3) ;
+   s := HandlePercent (fmt, s, i) ;
+   DSdbExit (s) ;
+   RETURN s
+END Sprintf3 ;
+
+
+(*
+   Sprintf4 - returns a string, s, which has been formatted.
+*)
+
+PROCEDURE Sprintf4 (fmt: String; w1, w2, w3, w4: ARRAY OF BYTE) : String ;
+VAR
+   i: INTEGER ;
+   s: String ;
+BEGIN
+   DSdbEnter ;
+   fmt := HandleEscape (fmt) ;
+   i := 0 ;
+   s := FormatString (fmt, i, InitString (''), w1) ;
+   s := FormatString (fmt, i, s, w2) ;
+   s := FormatString (fmt, i, s, w3) ;
+   s := FormatString (fmt, i, s, w4) ;
+   s := HandlePercent (fmt, s, i) ;
+   DSdbExit (s) ;
+   RETURN s
+END Sprintf4 ;
+
+
+END FormatStrings.
diff --git a/gcc/m2/gm2-libs/FpuIO.def b/gcc/m2/gm2-libs/FpuIO.def
new file mode 100644
index 00000000000..6f3e96d9984
--- /dev/null
+++ b/gcc/m2/gm2-libs/FpuIO.def
@@ -0,0 +1,56 @@
+(* FpuIO.def Implements a fixed format input/output for REAL/LONGREAL.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FpuIO ;
+
+EXPORT QUALIFIED ReadReal, WriteReal, StrToReal, RealToStr,
+                 ReadLongReal, WriteLongReal, StrToLongReal,
+                 LongRealToStr,
+                 ReadLongInt, WriteLongInt, StrToLongInt,
+                 LongIntToStr ;
+
+
+PROCEDURE ReadReal (VAR x: REAL) ;
+PROCEDURE WriteReal (x: REAL; TotalWidth, FractionWidth: CARDINAL) ;
+PROCEDURE StrToReal (a: ARRAY OF CHAR ; VAR x: REAL) ;
+PROCEDURE RealToStr (x: REAL; TotalWidth, FractionWidth: CARDINAL;
+                     VAR a: ARRAY OF CHAR) ;
+
+PROCEDURE ReadLongReal (VAR x: LONGREAL) ;
+PROCEDURE WriteLongReal (x: LONGREAL;
+                         TotalWidth, FractionWidth: CARDINAL) ;
+PROCEDURE StrToLongReal (a: ARRAY OF CHAR ; VAR x: LONGREAL) ;
+PROCEDURE LongRealToStr (x: LONGREAL;
+                         TotalWidth, FractionWidth: CARDINAL;
+                         VAR a: ARRAY OF CHAR) ;
+
+PROCEDURE ReadLongInt (VAR x: LONGINT) ;
+PROCEDURE WriteLongInt (x: LONGINT; n: CARDINAL) ;
+PROCEDURE StrToLongInt (a: ARRAY OF CHAR ; VAR x: LONGINT) ;
+PROCEDURE LongIntToStr (x: LONGINT; n: CARDINAL; VAR a: ARRAY OF CHAR) ;
+
+
+END FpuIO.
diff --git a/gcc/m2/gm2-libs/FpuIO.mod b/gcc/m2/gm2-libs/FpuIO.mod
new file mode 100644
index 00000000000..1988b0babb7
--- /dev/null
+++ b/gcc/m2/gm2-libs/FpuIO.mod
@@ -0,0 +1,190 @@
+(* FpuIO.mod implements a fixed format input/output for REAL/LONGREAL.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE FpuIO ;
+
+FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
+FROM StrLib IMPORT StrLen, StrRemoveWhitePrefix ;
+FROM ASCII IMPORT nul ;
+FROM DynamicStrings IMPORT String, InitString, KillString, CopyOut,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+FROM StringConvert IMPORT StringToLongreal, LongrealToString,
+                          LongIntegerToString, StringToLongInteger ;
+
+(*
+#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
+*)
+
+
+CONST
+   MaxLineLength = 100 ;
+
+
+PROCEDURE ReadReal (VAR x: REAL) ;
+VAR
+   a: ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   ReadString(a) ;
+   StrToReal(a, x)
+END ReadReal ;
+
+
+(*
+   WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+               FractionWidth into, string, a.
+*)
+
+PROCEDURE WriteReal (x: REAL; TotalWidth, FractionWidth: CARDINAL) ;
+VAR
+   a: ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   RealToStr(x, TotalWidth, FractionWidth, a) ;
+   WriteString(a)
+END WriteReal ;
+
+
+PROCEDURE StrToReal (a: ARRAY OF CHAR ; VAR x: REAL) ;
+VAR
+   lr: LONGREAL ;
+BEGIN
+   StrToLongReal(a, lr) ;  (* let StrToLongReal do the work and we convert the result back to REAL *)
+   x := VAL(REAL, lr)
+END StrToReal ;
+
+
+PROCEDURE ReadLongReal (VAR x: LONGREAL) ;
+VAR
+   a: ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   ReadString(a) ;
+   StrToLongReal(a, x)
+END ReadLongReal ;
+
+
+(*
+   WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+                   FractionWidth into a string.
+*)
+
+PROCEDURE WriteLongReal (x: LONGREAL; TotalWidth, FractionWidth: CARDINAL) ;
+VAR
+   a: ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   LongRealToStr(x, TotalWidth, FractionWidth, a) ;
+   WriteString(a)
+END WriteLongReal ;
+
+
+PROCEDURE StrToLongReal (a: ARRAY OF CHAR ; VAR x: LONGREAL) ;
+VAR
+   found: BOOLEAN ;
+   s    : String ;
+BEGIN
+   s := InitString(a) ;
+   x := StringToLongreal(s, found) ;
+   s := KillString(s)
+END StrToLongReal ;
+
+
+(*
+   RealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+               FractionWidth into a string.
+*)
+
+PROCEDURE RealToStr (x: REAL; TotalWidth, FractionWidth: CARDINAL; VAR a: ARRAY OF CHAR) ;
+VAR
+   lr: LONGREAL ;
+BEGIN
+   lr := VAL(LONGREAL, x) ;
+   LongRealToStr(lr, TotalWidth, FractionWidth, a)
+END RealToStr ;
+
+
+(*
+   LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+                   FractionWidth into a string.
+*)
+
+PROCEDURE LongRealToStr (x: LONGREAL; TotalWidth, FractionWidth: CARDINAL; VAR a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := LongrealToString(x, TotalWidth, FractionWidth) ;
+   CopyOut(a, s) ;
+   s := KillString(s)
+END LongRealToStr ;
+
+
+PROCEDURE ReadLongInt (VAR x: LONGINT) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   ReadString( a ) ;
+   StrToLongInt(a, x)
+END ReadLongInt ;
+
+
+PROCEDURE WriteLongInt (x: LONGINT; n: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   LongIntToStr(x, n, a) ;
+   WriteString(a)
+END WriteLongInt ;
+
+
+PROCEDURE LongIntToStr (x: LONGINT; n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := LongIntegerToString(x, n, ' ', FALSE, 10, TRUE) ;
+   CopyOut(a, s) ;
+   s := KillString(s)
+END LongIntToStr ;
+
+
+PROCEDURE StrToLongInt (a: ARRAY OF CHAR ; VAR x: LONGINT) ;
+VAR
+   s    : String ;
+   found: BOOLEAN ;
+BEGIN
+   s := InitString(a) ;
+   x := StringToLongInteger(s, 10, found) ;
+   s := KillString(s)
+END StrToLongInt ;
+
+
+END FpuIO.
diff --git a/gcc/m2/gm2-libs/GetOpt.def b/gcc/m2/gm2-libs/GetOpt.def
new file mode 100644
index 00000000000..468754bd975
--- /dev/null
+++ b/gcc/m2/gm2-libs/GetOpt.def
@@ -0,0 +1,124 @@
+(* GetOpt.def allows users to manage long options to getopt.
+
+Copyright (C) 2017-2021 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/>.  *)
+
+DEFINITION MODULE GetOpt ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String ;
+
+CONST
+   no_argument = 0 ;
+   required_argument = 1 ;
+   optional_argument = 2 ;
+
+TYPE
+   LongOptions ;
+   PtrToInteger = POINTER TO INTEGER ;
+
+(*
+   GetOpt - call C getopt and fill in the parameters:
+            optarg, optind, opterr and optop.
+*)
+
+PROCEDURE GetOpt (argc: INTEGER; argv: ADDRESS; optstring: String;
+                  VAR optarg: String;
+                  VAR optind, opterr, optopt: INTEGER) : CHAR ;
+
+
+(*
+   InitLongOptions - creates and returns a LongOptions empty array.
+*)
+
+PROCEDURE InitLongOptions () : LongOptions ;
+
+
+(*
+   AddLongOption - appends long option {name, has_arg, flag, val} to the
+                   array of options and new long options array is
+                   returned.
+                   The old array, lo, should no longer be used.
+
+   (from man 3 getopt)
+       The meanings of the different fields are:
+
+       name   is the name of the long option.
+
+       has_arg
+              is: no_argument (or 0) if the option does not take an
+              argument; required_argument (or  1) if the option
+              requires an argument; or optional_argument (or 2) if
+              the option takes an optional argument.
+
+       flag   specifies how results are returned for a long option.
+              If flag is NULL, then getopt_long() returns val.
+              (For example, the calling program may set val to the
+              equivalent short option character).  Otherwise,
+              getopt_long() returns 0, and flag points to a
+              variable which is set to val if the option is found,
+              but left unchanged if the option is not found.
+
+       val    is the value to return, or to load into the variable
+              pointed to by flag.
+
+       The last element of the array has to be filled with zeros.
+*)
+
+PROCEDURE AddLongOption (lo: LongOptions;
+                         name: String; has_arg: INTEGER;
+                         flag: PtrToInteger;
+                         val: INTEGER) : LongOptions ;
+
+
+(*
+   KillLongOptions - returns NIL and also frees up memory
+                     associated with, lo.
+*)
+
+PROCEDURE KillLongOptions (lo: LongOptions) : LongOptions ;
+
+
+(*
+   GetOptLong - works like GetOpt but will accept long options (using
+                two dashes).  If the program only accepts long options
+                then optstring should be an empty string, not NIL.
+*)
+
+PROCEDURE GetOptLong (argc: INTEGER; argv: ADDRESS; optstring: String;
+                      longopts: LongOptions;
+                      VAR longindex: INTEGER) : INTEGER ;
+
+
+(*
+   GetOptLongOnly - works like GetOptLong except that a single dash
+                    can be used for a long option.
+*)
+
+PROCEDURE GetOptLongOnly (argc: INTEGER; argv: ADDRESS;
+                          optstring: String; longopts: LongOptions;
+                          VAR longindex: INTEGER) : INTEGER ;
+
+
+END GetOpt.
diff --git a/gcc/m2/gm2-libs/GetOpt.mod b/gcc/m2/gm2-libs/GetOpt.mod
new file mode 100644
index 00000000000..dc4ba1be57e
--- /dev/null
+++ b/gcc/m2/gm2-libs/GetOpt.mod
@@ -0,0 +1,213 @@
+(* GetOpt.mod allows users to manage long options to getopt.
+
+Copyright (C) 2017-2021 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/>.  *)
+
+IMPLEMENTATION MODULE GetOpt ;  (*!m2pim+gm2*)
+
+FROM DynamicStrings IMPORT string, InitStringCharStar ;
+FROM Storage IMPORT ALLOCATE, REALLOCATE, DEALLOCATE ;
+FROM MemUtils IMPORT MemCopy ;
+
+IMPORT cgetopt ;
+
+
+TYPE
+   Crecord = RECORD    (* see man 3 getopt.  *)
+                name   : ADDRESS ;
+                has_arg: INTEGER ;
+                flag   : PtrToInteger ;
+                val    : INTEGER ;
+             END ;
+
+   ptrToCrecord = POINTER TO Crecord ;
+
+   LongOptions = POINTER TO RECORD
+                               cptr: ptrToCrecord ;
+                               len : CARDINAL ;
+                               size: CARDINAL ;
+                            END ;
+
+
+(*
+   GetOpt - call C getopt and fill in the parameters:
+            optarg, optind, opterr and optop.
+*)
+
+PROCEDURE GetOpt (argc: INTEGER; argv: ADDRESS; optstring: String;
+                  VAR optarg: String;
+                  VAR optind, opterr, optopt: INTEGER) : CHAR ;
+VAR
+   r: CHAR ;
+BEGIN
+   r := cgetopt.getopt (argc, argv, string (optstring)) ;
+   optarg := InitStringCharStar (cgetopt.optarg) ;
+   opterr := cgetopt.opterr ;
+   optopt := cgetopt.optopt ;
+   RETURN r
+END GetOpt ;
+
+
+(*
+   InitLongOptions - creates and returns a LongOptions empty array.
+*)
+
+PROCEDURE InitLongOptions () : LongOptions ;
+VAR
+   lo: LongOptions ;
+BEGIN
+   NEW (lo) ;
+   WITH lo^ DO
+      cptr := NIL ;
+      len := 0 ;
+      size := 0
+   END ;
+   RETURN lo
+END InitLongOptions ;
+
+
+(*
+   AddLongOption - appends long option {name, has_arg, flag, val} to the
+                   array of options and new long options array is returned.
+                   The old array, lo, should no longer be used.
+
+   (from man 3 getopt)
+       The meanings of the different fields are:
+
+       name   is the name of the long option.
+
+       has_arg
+              is: no_argument (or 0) if the option does not take an  argument;  required_argument
+              (or  1)  if  the  option  requires  an argument; or optional_argument (or 2) if the
+              option takes an optional argument.
+
+       flag   specifies how results are returned for a  long  option.   If  flag  is  NULL,  then
+              getopt_long()  returns  val.   (For example, the calling program may set val to the
+              equivalent short option character.)  Otherwise, getopt_long() returns 0,  and  flag
+              points to a variable which is set to val if the option is found, but left unchanged
+              if the option is not found.
+
+       val    is the value to return, or to load into the variable pointed to by flag.
+
+       The last element of the array has to be filled with zeros.
+*)
+
+PROCEDURE AddLongOption (lo: LongOptions;
+                         name: String; has_arg: INTEGER;
+                         flag: PtrToInteger; val: INTEGER) : LongOptions ;
+VAR
+   old,
+   entry: ptrToCrecord ;
+BEGIN
+   IF lo^.cptr = NIL
+   THEN
+      NEW (lo^.cptr) ;
+      lo^.len := 1 ;
+      lo^.size := SIZE (Crecord) ;
+      entry := lo^.cptr
+   ELSE
+      old := lo^.cptr ;
+      INC (lo^.len) ;
+      lo^.size := lo^.len * SIZE (Crecord) ;
+      REALLOCATE (lo^.cptr, lo^.size) ;
+      IF lo^.cptr = NIL
+      THEN
+         entry := NIL
+      ELSIF old = lo^.cptr
+      THEN
+         entry := lo^.cptr ;
+         INC (entry, SIZE (Crecord) * lo^.len-1)
+      ELSE
+         MemCopy (old, lo^.len-1, lo^.cptr) ;
+         entry := lo^.cptr ;
+         INC (entry, SIZE (Crecord) * lo^.len-1)
+      END
+   END ;
+   fillIn (entry, name, has_arg, flag, val) ;
+   RETURN lo
+END AddLongOption ;
+
+
+(*
+   fillIn - fills in
+*)
+
+PROCEDURE fillIn (entry: ptrToCrecord;
+                  name: String; has_arg: INTEGER; flag: PtrToInteger; val: INTEGER) ;
+BEGIN
+   IF entry # NIL
+   THEN
+      entry^.name := name ;
+      entry^.has_arg := has_arg ;
+      entry^.flag := flag ;
+      entry^.val := val
+   END
+END fillIn ;
+
+
+(*
+   KillLongOptions - returns NIL and also frees up memory associated with, lo.
+*)
+
+PROCEDURE KillLongOptions (lo: LongOptions) : LongOptions ;
+BEGIN
+   DEALLOCATE (lo^.cptr, lo^.size) ;
+   DISPOSE (lo) ;
+   RETURN NIL
+END KillLongOptions ;
+
+
+(*
+   GetOptLong - works like GetOpt but will accept long options (using two dashes).
+                If the program only accepts long options then optstring should be
+                an empty string, not NIL.
+*)
+
+PROCEDURE GetOptLong (argc: INTEGER; argv: ADDRESS; optstring: String;
+                      longopts: LongOptions; VAR longindex: INTEGER) : INTEGER ;
+VAR
+   r: INTEGER ;
+BEGIN
+   r := cgetopt.getopt_long (argc, argv, string (optstring), longopts^.cptr, longindex) ;
+   RETURN r
+END GetOptLong ;
+
+
+(*
+   GetOptLongOnly - works like GetOptLong except that a single dash can be used
+                    for a long option.
+*)
+
+PROCEDURE GetOptLongOnly (argc: INTEGER; argv: ADDRESS; optstring: String;
+                          longopts: LongOptions; VAR longindex: INTEGER) : INTEGER ;
+VAR
+   r: INTEGER ;
+BEGIN
+   r := cgetopt.getopt_long_only (argc, argv, string (optstring),
+                                 longopts^.cptr, longindex) ;
+   RETURN r
+END GetOptLongOnly ;
+
+
+END GetOpt.
diff --git a/gcc/m2/gm2-libs/IO.def b/gcc/m2/gm2-libs/IO.def
new file mode 100644
index 00000000000..d386bd508ba
--- /dev/null
+++ b/gcc/m2/gm2-libs/IO.def
@@ -0,0 +1,85 @@
+(* IO.def provides Read, Write, Errors procedures mapping onto 0, 1 and 2.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE IO ;
+
+(*
+   Author     : Gaius Mulley
+   Title      : IO
+   Date       : 3/4/86  [$Date: 2010/10/03 19:01:10 $]
+   SYSTEM     : GNU Modula-2
+   Description: provides Read, Write, Errors procedures that map onto UNIX
+                file descriptors 0, 1 and 2. This is achieved by using
+                FIO if we are in buffered mode and using libc.write
+                if not.
+   Version    : $Revision: 1.6 $
+*)
+
+EXPORT QUALIFIED Read, Write, Error,
+                 UnBufferedMode, BufferedMode,
+                 EchoOn, EchoOff ;
+
+
+PROCEDURE Read (VAR ch: CHAR) ;
+PROCEDURE Write (ch: CHAR) ;
+PROCEDURE Error (ch: CHAR) ;
+
+
+(*
+   UnBufferedMode - places file descriptor, fd, into an unbuffered mode.
+*)
+
+PROCEDURE UnBufferedMode (fd: INTEGER; input: BOOLEAN) ;
+
+
+(*
+   BufferedMode - places file descriptor, fd, into a buffered mode.
+*)
+
+PROCEDURE BufferedMode (fd: INTEGER; input: BOOLEAN) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE EchoOn (fd: INTEGER; input: BOOLEAN) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE EchoOff (fd: INTEGER; input: BOOLEAN) ;
+
+
+END IO.
diff --git a/gcc/m2/gm2-libs/IO.mod b/gcc/m2/gm2-libs/IO.mod
new file mode 100644
index 00000000000..027e4c10499
--- /dev/null
+++ b/gcc/m2/gm2-libs/IO.mod
@@ -0,0 +1,365 @@
+(* IO.mod provides Read, Write, Errors procedures mapping onto 0, 1 and 2.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE IO ;
+
+
+FROM StrLib IMPORT StrCopy ;
+FROM SYSTEM IMPORT ADR, SIZE ;
+FROM libc IMPORT read, write, system, isatty ;
+
+FROM FIO IMPORT File, StdIn, StdOut, StdErr, WriteChar, ReadChar,
+                GetUnixFileDescriptor, FlushBuffer ;
+
+FROM errno IMPORT geterrno, EINTR, EAGAIN ;
+FROM ASCII IMPORT cr, eof, nl;
+FROM termios IMPORT TERMIOS, Flag, InitTermios, KillTermios,
+                    SetFlag, tcgetattr, tcsetattr, cfmakeraw,
+                    tcsdrain, tcsnow, tcsflush ;
+
+
+CONST
+   MaxDefaultFd = 2 ;
+
+TYPE
+   BasicFds = RECORD
+                 IsEof,
+                 IsRaw: BOOLEAN ;
+              END ;
+
+VAR
+   fdState: ARRAY [0..MaxDefaultFd] OF BasicFds ;
+
+
+(*
+   IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*)
+
+PROCEDURE IsDefaultFd (fd: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN( (fd<=MaxDefaultFd) AND (fd>=0) )
+END IsDefaultFd ;
+
+
+PROCEDURE Read (VAR ch: CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   WITH fdState[0] DO
+      FlushBuffer(StdOut) ;
+      FlushBuffer(StdErr) ;
+      IF IsRaw
+      THEN
+         IF IsEof
+         THEN
+            ch := eof
+         ELSE
+            LOOP
+               r := read(GetUnixFileDescriptor(StdIn), ADR(ch), 1) ;
+               IF r=1
+               THEN
+                  RETURN
+               ELSIF r=-1
+               THEN
+                  r := geterrno() ;
+                  IF r#EAGAIN
+                  THEN
+                     IsEof := TRUE ;
+                     ch := eof ;
+                     RETURN
+                  END
+               END
+            END
+         END
+      ELSE
+         ch := ReadChar(StdIn)
+      END
+   END
+END Read ;
+
+
+(*
+   doWrite - performs the write of a single character, ch,
+             onto fd or f.
+*)
+
+PROCEDURE doWrite (fd: INTEGER; f: File; ch: CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   WITH fdState[fd] DO
+      IF IsRaw
+      THEN
+         IF NOT IsEof
+         THEN
+            LOOP
+               r := write(GetUnixFileDescriptor(f), ADR(ch), 1) ;
+               IF r=1
+               THEN
+                  RETURN
+               ELSIF r=-1
+               THEN
+                  r := geterrno() ;
+                  IF (r#EAGAIN) AND (r#EINTR)
+                  THEN
+                     IsEof := TRUE ;
+                     RETURN
+                  END
+               END
+            END
+         END
+      ELSE
+         WriteChar(f, ch)
+      END
+   END
+END doWrite ;
+
+
+PROCEDURE Write (ch: CHAR) ;
+BEGIN
+   doWrite(1, StdOut, ch)
+END Write ;
+
+
+PROCEDURE Error (ch: CHAR) ;
+BEGIN
+   doWrite(2, StdErr, ch)
+END Error ;
+
+
+(*
+   setFlag - sets or unsets the appropriate flag in, t.
+*)
+
+PROCEDURE setFlag (t: TERMIOS; f: Flag; b: BOOLEAN) ;
+BEGIN
+   IF SetFlag(t, f, b)
+   THEN
+   END
+END setFlag ;
+
+
+(*
+   doraw - sets all the flags associated with making this
+           file descriptor into raw input/output.
+*)
+
+PROCEDURE doraw (term: TERMIOS) ;
+BEGIN
+   (*
+    * 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, ignbrk, FALSE) ;
+   setFlag(term, ibrkint, FALSE) ;
+   setFlag(term, iparmrk, FALSE) ;
+   setFlag(term, istrip, FALSE) ;
+   setFlag(term, inlcr, FALSE) ;
+   setFlag(term, igncr, FALSE) ;
+   setFlag(term, icrnl, FALSE) ;
+   setFlag(term, ixon, FALSE) ;
+
+   setFlag(term, opost, FALSE) ;
+
+   setFlag(term, lecho, FALSE) ;
+   setFlag(term, lechonl, FALSE) ;
+   setFlag(term, licanon, FALSE) ;
+   setFlag(term, lisig, FALSE) ;
+   setFlag(term, liexten, FALSE) ;
+
+   setFlag(term, parenb, FALSE) ;
+   setFlag(term, cs8, TRUE)
+END doraw ;
+
+
+(*
+   dononraw - sets all the flags associated with making this
+              file descriptor into non raw input/output.
+*)
+
+PROCEDURE dononraw (term: TERMIOS) ;
+BEGIN
+   (*
+    * 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, ignbrk, TRUE) ;
+   setFlag(term, ibrkint, TRUE) ;
+   setFlag(term, iparmrk, TRUE) ;
+   setFlag(term, istrip, TRUE) ;
+   setFlag(term, inlcr, TRUE) ;
+   setFlag(term, igncr, TRUE) ;
+   setFlag(term, icrnl, TRUE) ;
+   setFlag(term, ixon, TRUE) ;
+
+   setFlag(term, opost, TRUE) ;
+
+   setFlag(term, lecho, TRUE) ;
+   setFlag(term, lechonl, TRUE) ;
+   setFlag(term, licanon, TRUE) ;
+   setFlag(term, lisig, TRUE) ;
+   setFlag(term, liexten, TRUE)
+END dononraw ;
+
+
+PROCEDURE BufferedMode (fd: INTEGER; input: BOOLEAN) ;
+VAR
+   term: TERMIOS ;
+   r   : INTEGER ;
+BEGIN
+   IF IsDefaultFd(fd)
+   THEN
+      fdState[fd].IsRaw := FALSE
+   END ;
+   term := InitTermios() ;
+   IF tcgetattr(fd, term)=0
+   THEN
+      dononraw(term) ;
+      IF input
+      THEN
+         r := tcsetattr(fd, tcsflush(), term)
+      ELSE
+         r := tcsetattr(fd, tcsdrain(), term)
+      END
+   END ;
+   term := KillTermios(term)
+END BufferedMode ;
+
+
+PROCEDURE UnBufferedMode (fd: INTEGER; input: BOOLEAN) ;
+VAR
+   term  : TERMIOS ;
+   result: INTEGER ;
+BEGIN
+   IF IsDefaultFd(fd)
+   THEN
+      fdState[fd].IsRaw := TRUE
+   END ;
+   term := InitTermios() ;
+   IF tcgetattr(fd, term)=0
+   THEN
+      doraw(term) ;
+      IF input
+      THEN
+         result := tcsetattr(fd, tcsflush(), term)
+      ELSE
+         result := tcsetattr(fd, tcsdrain(), term)
+      END
+   END ;
+   term := KillTermios(term)
+END UnBufferedMode ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE EchoOn (fd: INTEGER; input: BOOLEAN) ;
+VAR
+   term  : TERMIOS ;
+   result: INTEGER ;
+BEGIN
+   term := InitTermios() ;
+   IF tcgetattr(fd, term)=0
+   THEN
+      setFlag(term, lecho, TRUE) ;
+      IF input
+      THEN
+         result := tcsetattr(fd, tcsflush(), term)
+      ELSE
+         result := tcsetattr(fd, tcsdrain(), term)
+      END
+   END ;
+   term := KillTermios(term)
+END EchoOn ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE EchoOff (fd: INTEGER; input: BOOLEAN) ;
+VAR
+   term  : TERMIOS ;
+   result: INTEGER ;
+BEGIN
+   term := InitTermios() ;
+   IF tcgetattr(fd, term)=0
+   THEN
+      setFlag(term, lecho, FALSE) ;
+      IF input
+      THEN
+         result := tcsetattr(fd, tcsflush(), term)
+      ELSE
+         result := tcsetattr(fd, tcsdrain(), term)
+      END
+   END ;
+   term := KillTermios(term)
+END EchoOff ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   WITH fdState[0] DO
+      IsEof := FALSE ;
+      IsRaw := FALSE
+   END ;
+   WITH fdState[1] DO
+      IsEof := FALSE ;
+      IsRaw := FALSE
+   END ;
+   WITH fdState[2] DO
+      IsEof := FALSE ;
+      IsRaw := FALSE
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END IO.
diff --git a/gcc/m2/gm2-libs/Indexing.def b/gcc/m2/gm2-libs/Indexing.def
new file mode 100644
index 00000000000..d4a0b4e8956
--- /dev/null
+++ b/gcc/m2/gm2-libs/Indexing.def
@@ -0,0 +1,133 @@
+(* Indexing.def provides a dynamic indexing mechanism for CARDINAL.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+DEFINITION MODULE Indexing ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED Index, InitIndex, KillIndex, GetIndice, PutIndice,
+                 HighIndice, LowIndice, InBounds, IsIndiceInIndex,
+                 RemoveIndiceFromIndex, IncludeIndiceIntoIndex,
+                 ForeachIndiceInIndexDo, DeleteIndice, DebugIndex ;
+
+TYPE
+   Index ;
+   IndexProcedure = PROCEDURE (ADDRESS) ;
+
+
+(*
+   InitIndex - creates and returns an Index.
+*)
+
+PROCEDURE InitIndex (low: CARDINAL) : Index ;
+
+
+(*
+   KillIndex - returns Index to free storage.
+*)
+
+PROCEDURE KillIndex (i: Index) : Index ;
+
+
+(*
+   DebugIndex - turns on debugging within an index.
+*)
+
+PROCEDURE DebugIndex (i: Index) : Index ;
+
+
+(*
+   InBounds - returns TRUE if indice, n, is within the bounds
+              of the dynamic array.
+*)
+
+PROCEDURE InBounds (i: Index; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   HighIndice - returns the last legally accessible indice of this array.
+*)
+
+PROCEDURE HighIndice (i: Index) : CARDINAL ;
+
+
+(*
+   LowIndice - returns the first legally accessible indice of this array.
+*)
+
+PROCEDURE LowIndice (i: Index) : CARDINAL ;
+
+
+(*
+   PutIndice - places, a, into the dynamic array at position i[n]
+*)
+
+PROCEDURE PutIndice (i: Index; n: CARDINAL; a: ADDRESS) ;
+
+
+(*
+   GetIndice - retrieves, element i[n] from the dynamic array.
+*)
+
+PROCEDURE GetIndice (i: Index; n: CARDINAL) : ADDRESS ;
+
+
+(*
+   IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*)
+
+PROCEDURE IsIndiceInIndex (i: Index; a: ADDRESS) : BOOLEAN ;
+
+
+(*
+   RemoveIndiceFromIndex - removes, a, from Index, i.
+*)
+
+PROCEDURE RemoveIndiceFromIndex (i: Index; a: ADDRESS) ;
+
+
+(*
+   DeleteIndice - delete i[j] from the array.
+*)
+
+PROCEDURE DeleteIndice (i: Index; j: CARDINAL) ;
+
+
+(*
+   IncludeIndiceIntoIndex - if the indice is not in the index, then
+                            add it at the end.
+*)
+
+PROCEDURE IncludeIndiceIntoIndex (i: Index; a: ADDRESS) ;
+
+
+(*
+   ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*)
+
+PROCEDURE ForeachIndiceInIndexDo (i: Index; p: IndexProcedure) ;
+
+
+END Indexing.
diff --git a/gcc/m2/gm2-libs/Indexing.mod b/gcc/m2/gm2-libs/Indexing.mod
new file mode 100644
index 00000000000..5dcec236d1d
--- /dev/null
+++ b/gcc/m2/gm2-libs/Indexing.mod
@@ -0,0 +1,345 @@
+(* Indexing.mod provides a dynamic indexing mechanism for CARDINAL.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Indexing ;
+
+FROM libc IMPORT memset, memmove ;
+FROM Storage IMPORT ALLOCATE, REALLOCATE, DEALLOCATE ;
+FROM SYSTEM IMPORT TSIZE, ADDRESS, WORD, BYTE ;
+
+CONST
+   MinSize = 128 ;
+
+TYPE
+   PtrToAddress = POINTER TO ADDRESS ;
+   PtrToByte    = POINTER TO BYTE ;
+
+   Index = POINTER TO RECORD
+                         ArrayStart: ADDRESS ;
+                         ArraySize : CARDINAL ;
+                         Used,
+                         Low,
+                         High      : CARDINAL ;
+                         Debug     : BOOLEAN ;
+                         Map       : BITSET ;
+                      END ;
+
+(*
+   InitIndex - creates and returns an Index.
+*)
+
+PROCEDURE InitIndex (low: CARDINAL) : Index ;
+VAR
+   i: Index ;
+BEGIN
+   NEW(i) ;
+   WITH i^ DO
+      Low := low ;
+      High := 0 ;
+      ArraySize := MinSize ;
+      ALLOCATE(ArrayStart, MinSize) ;
+      ArrayStart := memset(ArrayStart, 0, ArraySize) ;
+      Debug := FALSE ;
+      Used := 0 ;
+      Map := BITSET{}
+   END ;
+   RETURN( i )
+END InitIndex ;
+
+
+(*
+   KillIndex - returns Index to free storage.
+*)
+
+PROCEDURE KillIndex (i: Index) : Index ;
+BEGIN
+   WITH i^ DO
+      DEALLOCATE(ArrayStart, ArraySize)
+   END ;
+   DISPOSE(i) ;
+   RETURN( NIL )
+END KillIndex ;
+
+
+(*
+   DebugIndex - turns on debugging within an index.
+*)
+
+PROCEDURE DebugIndex (i: Index) : Index ;
+BEGIN
+   i^.Debug := TRUE ;
+   RETURN( i )
+END DebugIndex ;
+
+
+(*
+   InBounds - returns TRUE if indice, n, is within the bounds
+              of the dynamic array.
+*)
+
+PROCEDURE InBounds (i: Index; n: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF i=NIL
+   THEN
+      HALT
+   ELSE
+      WITH i^ DO
+         RETURN( (n>=Low) AND (n<=High) )
+      END
+   END
+END InBounds ;
+
+
+(*
+   HighIndice - returns the last legally accessible indice of this array.
+*)
+
+PROCEDURE HighIndice (i: Index) : CARDINAL ;
+BEGIN
+   IF i=NIL
+   THEN
+      HALT
+   ELSE
+      RETURN( i^.High )
+   END
+END HighIndice ;
+
+
+(*
+   LowIndice - returns the first legally accessible indice of this array.
+*)
+
+PROCEDURE LowIndice (i: Index) : CARDINAL ;
+BEGIN
+   IF i=NIL
+   THEN
+      HALT
+   ELSE
+      RETURN( i^.Low )
+   END
+END LowIndice ;
+
+
+(*
+   PutIndice - places, a, into the dynamic array at position i[n]
+*)
+
+PROCEDURE PutIndice (i: Index; n: CARDINAL; a: ADDRESS) ;
+VAR
+   oldSize: CARDINAL ;
+   b      : ADDRESS ;
+   p      : POINTER TO POINTER TO WORD ;
+BEGIN
+   WITH i^ DO
+      IF NOT InBounds(i, n)
+      THEN
+         IF n<Low
+         THEN
+            HALT
+         ELSE
+            oldSize := ArraySize ;
+            WHILE (n-Low)*TSIZE(ADDRESS)>=ArraySize DO
+               ArraySize := ArraySize * 2
+            END ;
+            IF oldSize#ArraySize
+            THEN
+(*
+               IF Debug
+               THEN
+                  printf2('increasing memory hunk from %d to %d\n',
+                          oldSize, ArraySize)
+               END ;
+*)
+               REALLOCATE(ArrayStart, ArraySize) ;
+               (* and initialize the remainder of the array to NIL *)
+               b := ArrayStart ;
+               INC(b, oldSize) ;
+               b := memset(b, 0, ArraySize-oldSize)
+            END ;
+            High := n
+         END
+      END ;
+      b := ArrayStart ;
+      INC(b, (n-Low)*TSIZE(ADDRESS)) ;
+      p := b;
+      p^ := a ;
+      INC(Used) ;
+      IF Debug
+      THEN
+         IF n<32
+         THEN
+            INCL(Map, n)
+         END
+      END
+   END
+END PutIndice ;
+
+
+(*
+   GetIndice - retrieves, element i[n] from the dynamic array.
+*)
+
+PROCEDURE GetIndice (i: Index; n: CARDINAL) : ADDRESS ;
+VAR
+   b: PtrToByte ;
+   p: PtrToAddress ;
+BEGIN
+   WITH i^ DO
+      IF NOT InBounds(i, n)
+      THEN
+         HALT
+      END ;
+      b := ArrayStart ;
+      INC(b, (n-Low)*TSIZE(ADDRESS)) ;
+      p := VAL(PtrToAddress, b) ;
+      IF Debug
+      THEN
+         IF (n<32) AND (NOT (n IN Map)) AND (p^#NIL)
+         THEN
+            HALT
+         END
+      END ;
+      RETURN( p^ )
+   END
+END GetIndice ;
+
+
+(*
+   IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*)
+
+PROCEDURE IsIndiceInIndex (i: Index; a: ADDRESS) : BOOLEAN ;
+VAR
+   j: CARDINAL ;
+   b: PtrToByte ;
+   p: PtrToAddress ;
+BEGIN
+   WITH i^ DO
+      j := Low ;
+      b := ArrayStart ;
+      WHILE j<=High DO
+         p := VAL(PtrToAddress, b) ;
+         IF p^=a
+         THEN
+            RETURN( TRUE )
+         END ;
+         (* we must not INC(p, ..) as p2c gets confused *)
+         INC(b, TSIZE(ADDRESS)) ;
+         INC(j)
+      END
+   END ;
+   RETURN( FALSE )
+END IsIndiceInIndex ;
+
+
+(*
+   RemoveIndiceFromIndex - removes, a, from Index, i.
+*)
+
+PROCEDURE RemoveIndiceFromIndex (i: Index; a: ADDRESS) ;
+VAR
+   j, k: CARDINAL ;
+   p   : PtrToAddress ;
+   b   : PtrToByte ;
+BEGIN
+   WITH i^ DO
+      j := Low ;
+      b := ArrayStart ;
+      WHILE j<=High DO
+         p := VAL(PtrToAddress, b) ;
+         INC(b, TSIZE(ADDRESS)) ;
+         IF p^=a
+         THEN
+            DeleteIndice(i, j)
+         END ;
+         INC(j)
+      END
+   END
+END RemoveIndiceFromIndex ;
+
+
+(*
+   DeleteIndice - delete i[j] from the array.
+*)
+
+PROCEDURE DeleteIndice (i: Index; j: CARDINAL) ;
+VAR
+   p: PtrToAddress ;
+   b: PtrToByte ;
+BEGIN
+   WITH i^ DO
+      IF InBounds(i, j)
+      THEN
+         b := ArrayStart ;
+         INC(b, TSIZE(ADDRESS)*(j-Low)) ;
+         p := VAL(PtrToAddress, b) ;
+         INC(b, TSIZE(ADDRESS)) ;
+         p := memmove(p, b, (High-j)*TSIZE(ADDRESS)) ;
+         DEC(High) ;
+         DEC(Used)
+      ELSE
+         HALT
+      END
+   END
+END DeleteIndice ;
+
+
+(*
+   IncludeIndiceIntoIndex - if the indice is not in the index, then
+                            add it at the end.
+*)
+
+PROCEDURE IncludeIndiceIntoIndex (i: Index; a: ADDRESS) ;
+BEGIN
+   IF NOT IsIndiceInIndex(i, a)
+   THEN
+      IF i^.Used=0
+      THEN
+         PutIndice(i, LowIndice(i), a)
+      ELSE
+         PutIndice(i, HighIndice(i)+1, a)
+      END
+   END
+END IncludeIndiceIntoIndex ;
+
+
+(*
+   ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*)
+
+PROCEDURE ForeachIndiceInIndexDo (i: Index; p: IndexProcedure) ;
+VAR
+   j: CARDINAL ;
+BEGIN
+   j := LowIndice(i) ;
+   WHILE j<=HighIndice(i) DO
+      p(GetIndice(i, j)) ;
+      INC(j)
+   END
+END ForeachIndiceInIndexDo ;
+
+
+END Indexing.
diff --git a/gcc/m2/gm2-libs/LMathLib0.def b/gcc/m2/gm2-libs/LMathLib0.def
new file mode 100644
index 00000000000..2e2e60a1da6
--- /dev/null
+++ b/gcc/m2/gm2-libs/LMathLib0.def
@@ -0,0 +1,44 @@
+(* LMathLib0.def provide access to the LONGREAL instrinics.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE LMathLib0 ;
+
+CONST
+   pi   = 3.1415926535897932384626433832795028841972;
+   exp1 = 2.7182818284590452353602874713526624977572;
+
+
+PROCEDURE __BUILTIN__ sqrt (x: LONGREAL) : LONGREAL ;
+PROCEDURE exp (x: LONGREAL) : LONGREAL ;
+PROCEDURE ln (x: LONGREAL) : LONGREAL ;
+PROCEDURE __BUILTIN__ sin (x: LONGREAL) : LONGREAL ;
+PROCEDURE __BUILTIN__ cos (x: LONGREAL) : LONGREAL ;
+PROCEDURE tan (x: LONGREAL) : LONGREAL ;
+PROCEDURE arctan (x: LONGREAL) : LONGREAL ;
+PROCEDURE entier (x: LONGREAL) : INTEGER ;
+
+
+END LMathLib0.
diff --git a/gcc/m2/gm2-libs/LMathLib0.mod b/gcc/m2/gm2-libs/LMathLib0.mod
new file mode 100644
index 00000000000..46f720303d0
--- /dev/null
+++ b/gcc/m2/gm2-libs/LMathLib0.mod
@@ -0,0 +1,81 @@
+(* LMathLib0.mod provide access to the LONGREAL instrinics.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LMathLib0 ;
+
+IMPORT cbuiltin, libm ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sqrtl)) sqrt (x: LONGREAL): LONGREAL;
+BEGIN
+   RETURN cbuiltin.sqrtl (x)
+END sqrt ;
+
+PROCEDURE exp (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN libm.expl (x)
+END exp ;
+
+
+(*
+                log (b)
+   log (b)  =      c
+      a         ------
+                log (a)
+                   c
+*)
+
+PROCEDURE ln (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN libm.logl (x) / libm.logl (exp1)
+END ln ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sinl)) sin (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.sinl (x)
+END sin ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cosl)) cos (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.cosl (x)
+END cos ;
+
+PROCEDURE tan (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN libm.tanl (x)
+END tan ;
+
+PROCEDURE arctan (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN libm.atanl (x)
+END arctan ;
+
+PROCEDURE entier (x: LONGREAL) : INTEGER ;
+BEGIN
+   RETURN TRUNC (libm.floorl (x))
+END entier ;
+
+
+END LMathLib0.
diff --git a/gcc/m2/gm2-libs/LegacyReal.def b/gcc/m2/gm2-libs/LegacyReal.def
new file mode 100644
index 00000000000..d0d78a40c63
--- /dev/null
+++ b/gcc/m2/gm2-libs/LegacyReal.def
@@ -0,0 +1,33 @@
+(* LegacyReal.def provides a legacy definition for REAL.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE LegacyReal ;
+
+TYPE
+   REAL = SHORTREAL ;
+
+
+END LegacyReal.
diff --git a/gcc/m2/gm2-libs/LegacyReal.mod b/gcc/m2/gm2-libs/LegacyReal.mod
new file mode 100644
index 00000000000..f660a530120
--- /dev/null
+++ b/gcc/m2/gm2-libs/LegacyReal.mod
@@ -0,0 +1,29 @@
+(* LegacyReal.mod provides a legacy definition for REAL.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE LegacyReal ;
+
+END LegacyReal.
diff --git a/gcc/m2/gm2-libs/M2Dependent.def b/gcc/m2/gm2-libs/M2Dependent.def
new file mode 100644
index 00000000000..a7c18159b12
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2Dependent.def
@@ -0,0 +1,62 @@
+(* M2Dependent.def defines the run time module dependencies interface.
+
+Copyright (C) 2022 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/>.  *)
+
+DEFINITION MODULE M2Dependent ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+   ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+
+END M2Dependent.
diff --git a/gcc/m2/gm2-libs/M2Dependent.mod b/gcc/m2/gm2-libs/M2Dependent.mod
new file mode 100644
index 00000000000..bdfebcf51ef
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2Dependent.mod
@@ -0,0 +1,830 @@
+(* M2Dependent.mod implements the run time module dependencies.
+
+Copyright (C) 2022 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/>.  *)
+
+IMPLEMENTATION MODULE M2Dependent ;
+
+
+FROM libc IMPORT abort, exit, write, getenv, printf ;
+(* FROM Builtins IMPORT strncmp, strcmp ;  not available during bootstrap.  *)
+FROM M2LINK IMPORT ForcedModuleInitOrder, StaticInitialization, PtrToChar ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR ;
+FROM Storage IMPORT ALLOCATE ;
+FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
+
+IMPORT M2RTS ;
+
+
+TYPE
+   DependencyState = (unregistered, unordered, started, ordered, user) ;
+
+   DependencyList = RECORD
+                       proc  : PROC ;
+                       (* Has this module order been forced by the user?  *)
+                       forced,
+                       (* Is the module a definition module for C?  *)
+                       forc  : BOOLEAN ;
+                       appl  : BOOLEAN ;  (* The application module?  *)
+                       state : DependencyState ;
+                    END ;
+
+   ModuleChain = POINTER TO RECORD
+                               name      : ADDRESS ;
+                               init,
+                               fini      : ArgCVEnvP ;
+                               dependency: DependencyList ;
+                               prev,
+                               next      : ModuleChain ;
+                            END ;
+
+VAR
+   Modules        : ARRAY DependencyState OF ModuleChain ;
+   Initialized,
+   ModuleTrace,
+   DependencyTrace,
+   PreTrace,
+   PostTrace,
+   ForceTrace     : BOOLEAN ;
+
+
+(*
+   CreateModule - creates a new module entry and returns the
+                  ModuleChain.
+*)
+
+PROCEDURE CreateModule (name: ADDRESS;
+                        init, fini:  ArgCVEnvP;
+                        dependencies: PROC) : ModuleChain ;
+VAR
+   mptr: ModuleChain ;
+BEGIN
+   NEW (mptr) ;
+   mptr^.name := name ;
+   mptr^.init := init ;
+   mptr^.fini := fini ;
+   mptr^.dependency.proc := dependencies ;
+   mptr^.dependency.state := unregistered ;
+   mptr^.prev := NIL ;
+   mptr^.next := NIL ;
+   RETURN mptr
+END CreateModule ;
+
+
+(*
+   AppendModule - append chain to end of the list.
+*)
+
+PROCEDURE AppendModule (VAR head: ModuleChain; chain: ModuleChain) ;
+BEGIN
+   IF head = NIL
+   THEN
+      head := chain ;
+      chain^.prev := chain ;
+      chain^.next := chain
+   ELSE
+      chain^.next := head ;   (* Add Item to the end of list.  *)
+      chain^.prev  := head^.prev ;
+      head^.prev^.next := chain ;
+      head^.prev := chain
+   END
+END AppendModule ;
+
+
+(*
+   RemoveModule - remove chain from double linked list head.
+*)
+
+PROCEDURE RemoveModule (VAR head: ModuleChain; chain: ModuleChain) ;
+BEGIN
+   IF (chain^.next=head) AND (chain=head)
+   THEN
+      head := NIL
+   ELSE
+      IF head=chain
+      THEN
+         head := head^.next
+      END ;
+      chain^.prev^.next := chain^.next ;
+      chain^.next^.prev := chain^.prev
+   END
+END RemoveModule ;
+
+
+(*
+   onChain - returns TRUE if mptr is on the Modules[state] list.
+*)
+
+PROCEDURE onChain (state: DependencyState; mptr: ModuleChain) : BOOLEAN ;
+VAR
+   ptr: ModuleChain ;
+BEGIN
+   IF Modules[state] # NIL
+   THEN
+      ptr := Modules[state] ;
+      REPEAT
+         IF ptr = mptr
+         THEN
+            RETURN TRUE
+         END ;
+         ptr := ptr^.next
+      UNTIL ptr=Modules[state]
+   END ;
+   RETURN FALSE
+END onChain ;
+
+
+(*
+   LookupModuleN - lookup module from the state list.  The string is limited
+                   to nchar.
+*)
+
+PROCEDURE LookupModuleN (state: DependencyState;
+                         name: ADDRESS; nchar: CARDINAL) : ModuleChain ;
+VAR
+   ptr: ModuleChain ;
+BEGIN
+   IF Modules[state] # NIL
+   THEN
+      ptr := Modules[state] ;
+      REPEAT
+         IF strncmp (ptr^.name, name, nchar) = 0
+         THEN
+            RETURN ptr
+         END ;
+         ptr := ptr^.next
+      UNTIL ptr = Modules[state]
+   END ;
+   RETURN NIL
+END LookupModuleN ;
+
+
+(*
+   LookupModule - lookup and return the ModuleChain pointer containing
+                  module name from a particular list.
+*)
+
+PROCEDURE LookupModule (state: DependencyState; name: ADDRESS) : ModuleChain ;
+BEGIN
+   RETURN LookupModuleN (state, name, strlen (name))
+END LookupModule ;
+
+
+(*
+   toCString - replace any character sequence \n into a newline.
+*)
+
+PROCEDURE toCString (VAR str: ARRAY OF CHAR) ;
+VAR
+   high, i, j: CARDINAL ;
+BEGIN
+   i := 0 ;
+   high := HIGH (str) ;
+   WHILE i < high DO
+      IF (str[i] = "\") AND (i < high)
+      THEN
+         IF str[i+1] = "n"
+         THEN
+            str[i] := nl ;
+            j := i+1 ;
+            WHILE j < high DO
+               str[j] := str[j+1] ;
+               INC (j)
+            END
+         END
+      END ;
+      INC (i)
+   END
+END toCString ;
+
+
+(*
+   strcmp - return 0 if both strings are equal.
+            We cannot use Builtins.def during bootstrap.
+*)
+
+PROCEDURE strcmp (a, b: PtrToChar) : INTEGER ;
+BEGIN
+   IF (a # NIL) AND (b # NIL)
+   THEN
+      IF a = b
+      THEN
+         RETURN 0
+      ELSE
+         WHILE a^ = b^ DO
+            IF a^ = nul
+            THEN
+               RETURN 0
+            END ;
+            INC (a) ;
+            INC (b)
+         END
+      END
+   END ;
+   RETURN 1
+END strcmp ;
+
+
+(*
+   strncmp - return 0 if both strings are equal.
+             We cannot use Builtins.def during bootstrap.
+*)
+
+PROCEDURE strncmp (a, b: PtrToChar; n: CARDINAL) : INTEGER ;
+BEGIN
+   IF (a # NIL) AND (b # NIL) AND (n > 0)
+   THEN
+      IF a = b
+      THEN
+         RETURN 0
+      ELSE
+         WHILE (a^ = b^) AND (n > 0) DO
+            IF (a^ = nul) OR (n = 1)
+            THEN
+               RETURN 0
+            END ;
+            INC (a) ;
+            INC (b) ;
+            DEC (n)
+         END
+      END
+   END ;
+   RETURN 1
+END strncmp ;
+
+
+(*
+   strlen - returns the length of string.
+*)
+
+PROCEDURE strlen (string: PtrToChar) : INTEGER ;
+VAR
+   count: INTEGER ;
+BEGIN
+   IF string = NIL
+   THEN
+      RETURN 0
+   ELSE
+      count := 0 ;
+      WHILE string^ # nul DO
+         INC (string) ;
+         INC (count)
+      END ;
+      RETURN count
+   END
+END strlen ;
+
+
+(*
+   traceprintf - wrap printf with a boolean flag.
+*)
+
+PROCEDURE traceprintf (flag: BOOLEAN; str: ARRAY OF CHAR) ;
+BEGIN
+   IF flag
+   THEN
+      toCString (str) ;
+      printf (str)
+   END
+END traceprintf ;
+
+
+(*
+   traceprintf2 - wrap printf with a boolean flag.
+*)
+
+PROCEDURE traceprintf2 (flag: BOOLEAN; str: ARRAY OF CHAR; arg: ADDRESS) ;
+BEGIN
+   IF flag
+   THEN
+      toCString (str) ;
+      printf (str, arg)
+   END
+END traceprintf2 ;
+
+
+(*
+   moveTo - moves mptr to the new list determined by newstate.
+            It updates the mptr state appropriately.
+*)
+
+PROCEDURE moveTo (newstate: DependencyState; mptr: ModuleChain) ;
+BEGIN
+   IF onChain (mptr^.dependency.state, mptr)
+   THEN
+      RemoveModule (Modules[mptr^.dependency.state], mptr)
+   END ;
+   mptr^.dependency.state := newstate ;
+   AppendModule (Modules[mptr^.dependency.state], mptr)
+END moveTo ;
+
+
+(*
+   ResolveDependant -
+*)
+
+PROCEDURE ResolveDependant (mptr: ModuleChain; currentmodule: ADDRESS) ;
+BEGIN
+   IF mptr = NIL
+   THEN
+      traceprintf (DependencyTrace, "   module has not been registered via a global constructor\n");
+   ELSE
+      IF onChain (started, mptr)
+      THEN
+         traceprintf (DependencyTrace, "   processing...\n");
+      ELSE
+         moveTo (started, mptr) ;
+         traceprintf2 (DependencyTrace, "   starting: %s\n",
+                       currentmodule);
+         mptr^.dependency.proc ;  (* Invoke and process the dependency graph.  *)
+         traceprintf2 (DependencyTrace, "   finished: %s\n",
+                       currentmodule);
+         moveTo (ordered, mptr)
+      END
+   END
+END ResolveDependant ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.  It only takes effect
+                      if we are not using StaticInitialization.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+   CheckInitialized ;
+   IF NOT StaticInitialization
+   THEN
+      PerformRequestDependant (modulename, dependantmodule)
+   END
+END RequestDependant ;
+
+
+(*
+   PerformRequestDependant - the current modulename has a dependancy upon
+                             dependantmodule.  If dependantmodule is NIL then
+                             modulename has no further dependants and it can be
+                             resolved.
+*)
+
+PROCEDURE PerformRequestDependant (modulename, dependantmodule: ADDRESS) ;
+VAR
+   mptr: ModuleChain ;
+BEGIN
+   traceprintf2 (DependencyTrace, "  module %s", modulename) ;
+   IF dependantmodule = NIL
+   THEN
+      traceprintf2 (DependencyTrace, " has finished its import graph\n", modulename) ;
+      mptr := LookupModule (unordered, modulename) ;
+      IF mptr # NIL
+      THEN
+         traceprintf2 (DependencyTrace, "  module %s is now ordered\n", modulename) ;
+         moveTo (ordered, mptr)
+      END
+   ELSE
+      traceprintf2 (DependencyTrace, " imports from %s\n", dependantmodule) ;
+      mptr := LookupModule (ordered, dependantmodule) ;
+      IF mptr = NIL
+      THEN
+         traceprintf2 (DependencyTrace, "  module %s is not ordered\n", dependantmodule) ;
+         mptr := LookupModule (unordered, dependantmodule) ;
+         IF mptr = NIL
+         THEN
+            traceprintf2 (DependencyTrace, "  module %s is not unordered\n", dependantmodule) ;
+            mptr := LookupModule (started, dependantmodule) ;
+            IF mptr = NIL
+            THEN
+               traceprintf2 (DependencyTrace, "  module %s has not started\n", dependantmodule) ;
+               traceprintf2 (DependencyTrace, "  module %s attempting to import from",
+                             modulename) ;
+               traceprintf2 (DependencyTrace, " %s which has not registered itself via a constructor\n",
+                             dependantmodule)
+            ELSE
+               traceprintf2 (DependencyTrace, "  module %s has registered itself and has started\n", dependantmodule)
+            END
+         ELSE
+            traceprintf2 (DependencyTrace, "  module %s resolving\n", dependantmodule) ;
+            ResolveDependant (mptr, dependantmodule)
+         END
+      ELSE
+         traceprintf2 (DependencyTrace, "  module %s ", modulename) ;
+         traceprintf2 (DependencyTrace, " dependant %s is ordered\n", dependantmodule)
+      END
+   END
+END PerformRequestDependant ;
+
+
+(*
+   ResolveDependencies - resolve dependencies for currentmodule.
+*)
+
+PROCEDURE ResolveDependencies (currentmodule: ADDRESS) ;
+VAR
+   mptr: ModuleChain ;
+BEGIN
+   mptr := LookupModule (unordered, currentmodule) ;
+   WHILE mptr # NIL DO
+      traceprintf2 (DependencyTrace, "   attempting to resolve the dependants for %s\n",
+                    currentmodule);
+      ResolveDependant (mptr, currentmodule) ;
+      mptr := Modules[unordered]
+   END
+END ResolveDependencies ;
+
+
+(*
+   DisplayModuleInfo - displays all module in the state.
+*)
+
+PROCEDURE DisplayModuleInfo (state: DependencyState; name: ARRAY OF CHAR) ;
+VAR
+   mptr : ModuleChain ;
+   count: CARDINAL ;
+BEGIN
+   IF Modules[state] # NIL
+   THEN
+      printf ("%s modules\n", ADR (name)) ;
+      mptr := Modules[state] ;
+      count := 0 ;
+      REPEAT
+         printf ("  %d  %s", count, mptr^.name) ;
+         INC (count) ;
+         IF mptr^.dependency.appl
+         THEN
+            printf (" application")
+         END ;
+         IF mptr^.dependency.forc
+         THEN
+            printf (" for C")
+         END ;
+         IF mptr^.dependency.forced
+         THEN
+            printf (" forced ordering")
+         END ;
+         printf ("\n") ;
+         mptr := mptr^.next ;
+      UNTIL mptr = Modules[state]
+   END
+END DisplayModuleInfo ;
+
+
+(*
+   DumpModuleData -
+*)
+
+PROCEDURE DumpModuleData (flag: BOOLEAN) ;
+VAR
+   mptr: ModuleChain ;
+BEGIN
+   IF flag
+   THEN
+      DisplayModuleInfo (unregistered, "unregistered") ;
+      DisplayModuleInfo (unordered, "unordered") ;
+      DisplayModuleInfo (started, "started") ;
+      DisplayModuleInfo (ordered, "ordered") ;
+   END
+END DumpModuleData ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE combine (src, dest: DependencyState) ;
+VAR
+   last: ModuleChain ;
+BEGIN
+   WHILE Modules[src] # NIL DO
+      last := Modules[src]^.prev ;
+      moveTo (ordered, last) ;
+      Modules[dest] := last  (* New item is at the head.  *)
+   END
+END combine ;
+
+
+(*
+   ForceDependencies - if the user has specified a forced order then we override
+                       the dynamic ordering with the preference.
+*)
+
+PROCEDURE ForceDependencies ;
+VAR
+   mptr,
+   userChain: ModuleChain ;
+   count    : CARDINAL ;
+   pc, start: PtrToChar ;
+BEGIN
+   IF ForcedModuleInitOrder # NIL
+   THEN
+      userChain := NIL ;
+      pc := ForcedModuleInitOrder ;
+      start := pc ;
+      count := 0 ;
+      WHILE pc^ # nul DO
+         IF pc^ = ','
+         THEN
+            mptr := LookupModuleN (ordered, start, count) ;
+            IF mptr # NIL
+            THEN
+               mptr^.dependency.forced := TRUE ;
+               moveTo (user, mptr)
+            END ;
+            INC (pc) ;
+            start := pc ;
+            count := 0
+         ELSE
+            INC (pc) ;
+            INC (count)
+         END
+      END ;
+      IF start # pc
+      THEN
+         mptr := LookupModuleN (ordered, start, count) ;
+         IF mptr # NIL
+         THEN
+            mptr^.dependency.forced := TRUE ;
+            moveTo (user, mptr)
+         END
+      END ;
+      combine (user, ordered)
+   END
+END ForceDependencies ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE CheckApplication ;
+VAR
+   mptr,
+   appl: ModuleChain ;
+BEGIN
+   mptr := Modules[ordered] ;
+   IF mptr # NIL
+   THEN
+      appl := NIL ;
+      REPEAT
+         IF mptr^.dependency.appl
+         THEN
+            appl := mptr
+         ELSE
+            mptr := mptr^.next
+         END
+      UNTIL (appl # NIL) OR (mptr=Modules[ordered]) ;
+      IF appl # NIL
+      THEN
+         Modules[ordered] := appl^.next
+      END
+   END
+END CheckApplication ;
+
+
+(*
+   ConstructModules - resolve dependencies and then call each
+                      module constructor in turn.
+*)
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+VAR
+   mptr: ModuleChain ;
+   nulp: ArgCVEnvP ;
+BEGIN
+   CheckInitialized ;
+   traceprintf2 (ModuleTrace, "application module: %s\n", applicationmodule);
+   mptr := LookupModule (unordered, applicationmodule) ;
+   IF mptr # NIL
+   THEN
+      mptr^.dependency.appl := TRUE
+   END ;
+   traceprintf (PreTrace, "Pre resolving dependents\n");
+   DumpModuleData (PreTrace) ;
+   ResolveDependencies (applicationmodule) ;
+   traceprintf (PreTrace, "Post resolving dependents\n");
+   DumpModuleData (PostTrace) ;
+   ForceDependencies ;
+   traceprintf (ForceTrace, "After user forcing ordering\n");
+   DumpModuleData (ForceTrace) ;
+   CheckApplication ;
+   traceprintf (ForceTrace, "After runtime forces application to the end\n");
+   DumpModuleData (ForceTrace) ;
+   IF Modules[ordered] = NIL
+   THEN
+      traceprintf2 (ModuleTrace, "  module: %s has not registered itself using a global constructor\n", applicationmodule);
+      traceprintf2 (ModuleTrace, "  hint try compile and linking using: gm2 %s.mod\n", applicationmodule);
+      traceprintf2 (ModuleTrace, "  or try using: gm2 -fscaffold-static %s.mod\n",
+      applicationmodule);
+   ELSE
+      mptr := Modules[ordered] ;
+      REPEAT
+         IF mptr^.dependency.forc
+         THEN
+            traceprintf2 (ModuleTrace, "initializing module: %s for C\n", mptr^.name);
+         ELSE
+            traceprintf2 (ModuleTrace, "initializing module: %s\n", mptr^.name);
+         END ;
+         IF mptr^.dependency.appl
+         THEN
+            traceprintf2 (ModuleTrace, "application module: %s\n", mptr^.name);
+            traceprintf (ModuleTrace, "  calling M2RTS_ExecuteInitialProcedures\n");
+            M2RTS.ExecuteInitialProcedures ;
+            traceprintf (ModuleTrace, "  calling application module\n");
+         END ;
+         mptr^.init (argc, argv, envp) ;
+         mptr := mptr^.next
+      UNTIL mptr = Modules[ordered]
+   END
+END ConstructModules ;
+
+
+(*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*)
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+VAR
+   mptr: ModuleChain ;
+BEGIN
+   traceprintf2 (ModuleTrace, "application module finishing: %s\n", applicationmodule);
+   IF Modules[ordered] = NIL
+   THEN
+      traceprintf (ModuleTrace, "  no ordered modules found during finishing\n")
+   ELSE
+      traceprintf (ModuleTrace, "ExecuteTerminationProcedures\n") ;
+      M2RTS.ExecuteTerminationProcedures ;
+      traceprintf (ModuleTrace, "terminating modules in sequence\n") ;
+      mptr := Modules[ordered]^.prev ;
+      REPEAT
+         IF mptr^.dependency.forc
+         THEN
+            traceprintf2 (ModuleTrace, "finalizing module: %s for C\n", mptr^.name);
+         ELSE
+            traceprintf2 (ModuleTrace, "finalizing module: %s\n", mptr^.name);
+         END ;
+         mptr^.fini (argc, argv, envp) ;
+         mptr := mptr^.prev
+      UNTIL mptr = Modules[ordered]^.prev
+   END
+END DeconstructModules ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+BEGIN
+   CheckInitialized ;
+   IF NOT StaticInitialization
+   THEN
+      traceprintf2 (ModuleTrace, "module: %s registering\n",
+                    name);
+      moveTo (unordered,
+              CreateModule (name, init, fini, dependencies))
+   END
+END RegisterModule ;
+
+
+(*
+   equal - return TRUE if C string cstr is equal to str.
+*)
+
+PROCEDURE equal (cstr: ADDRESS; str: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   RETURN strncmp (cstr, ADR (str), StrLen (str)) = 0
+END equal ;
+
+
+(*
+   SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+                     DumpPostInit to FALSE.  It checks the environment
+                     GCC_M2LINK_RTFLAG which can contain
+                     "all,module,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.
+                     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.
+*)
+
+PROCEDURE SetupDebugFlags ;
+VAR
+   pc: POINTER TO CHAR ;
+BEGIN
+   ModuleTrace := FALSE ;
+   DependencyTrace := FALSE ;
+   PostTrace := FALSE ;
+   PreTrace := FALSE ;
+   ForceTrace := FALSE ;
+   pc := getenv (ADR ("GCC_M2LINK_RTFLAG")) ;
+   WHILE (pc # NIL) AND (pc^ # nul) DO
+      IF equal (pc, "all")
+      THEN
+         ModuleTrace := TRUE ;
+         DependencyTrace := TRUE ;
+         PreTrace := TRUE ;
+         PostTrace := TRUE ;
+         ForceTrace := TRUE ;
+         INC (pc, 3)
+      ELSIF equal (pc, "module")
+      THEN
+         ModuleTrace := TRUE ;
+         INC (pc, 6)
+      ELSIF equal (pc, "dep")
+      THEN
+         DependencyTrace := TRUE ;
+         INC (pc, 3)
+      ELSIF equal (pc, "pre")
+      THEN
+         PreTrace := TRUE ;
+         INC (pc, 3)
+      ELSIF equal (pc, "post")
+      THEN
+         PostTrace := TRUE ;
+         INC (pc, 4)
+      ELSIF equal (pc, "force")
+      THEN
+         ForceTrace := TRUE ;
+         INC (pc, 5)
+      ELSE
+         INC (pc)
+      END
+   END
+END SetupDebugFlags ;
+
+
+(*
+   Init - initialize the debug flags and set all lists to NIL.
+*)
+
+PROCEDURE Init ;
+VAR
+   state: DependencyState ;
+BEGIN
+   SetupDebugFlags ;
+   FOR state := MIN (DependencyState) TO MAX (DependencyState) DO
+      Modules[state] := NIL
+   END
+END Init ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE CheckInitialized ;
+BEGIN
+   IF NOT Initialized
+   THEN
+      Initialized := TRUE ;
+      Init
+   END
+END CheckInitialized ;
+
+
+BEGIN
+   CheckInitialized
+END M2Dependent.
diff --git a/gcc/m2/gm2-libs/M2EXCEPTION.def b/gcc/m2/gm2-libs/M2EXCEPTION.def
new file mode 100644
index 00000000000..d3a930a661a
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2EXCEPTION.def
@@ -0,0 +1,54 @@
+(* M2EXCEPTION.def enumerates all exceptions.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE M2EXCEPTION;
+
+
+(* This enumerated list of exceptions must match the exceptions in gm2-libs-iso to
+   allow mixed module dialect projects.  *)
+
+TYPE
+  M2Exceptions =
+    (indexException,     rangeException,         caseSelectException,  invalidLocation,
+     functionException,  wholeValueException,    wholeDivException,    realValueException,
+     realDivException,   complexValueException,  complexDivException,  protException,
+     sysException,       coException,            exException
+    );
+
+
+(* 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).  *)
+
+PROCEDURE M2Exception () : M2Exceptions;
+
+(* 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.  *)
+
+PROCEDURE IsM2Exception () : BOOLEAN;
+
+
+END M2EXCEPTION.
diff --git a/gcc/m2/gm2-libs/M2EXCEPTION.mod b/gcc/m2/gm2-libs/M2EXCEPTION.mod
new file mode 100644
index 00000000000..486a96ce5b8
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2EXCEPTION.mod
@@ -0,0 +1,69 @@
+(* M2EXCEPTION.mod implement M2Exception and IsM2Exception.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE M2EXCEPTION ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM RTExceptions IMPORT EHBlock, GetExceptionBlock, GetNumber, Raise,
+                         SetExceptionBlock, InitExceptionBlock ;
+
+
+(* 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).  *)
+
+PROCEDURE M2Exception () : M2Exceptions;
+VAR
+   e: EHBlock ;
+   n: CARDINAL ;
+BEGIN
+   e := GetExceptionBlock () ;
+   n := GetNumber (e) ;
+   IF n = MAX (CARDINAL)
+   THEN
+      Raise (ORD (exException), ADR (__FILE__), __LINE__, __COLUMN__, ADR (__FUNCTION__),
+             ADR ('current coroutine is not in the exceptional execution state'))
+   ELSE
+      RETURN VAL (M2Exceptions, n)
+   END
+END M2Exception ;
+
+
+(* 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.  *)
+
+PROCEDURE IsM2Exception () : BOOLEAN;
+VAR
+   e: EHBlock ;
+BEGIN
+   e := GetExceptionBlock () ;
+   RETURN GetNumber (e) # MAX (CARDINAL)
+END IsM2Exception ;
+
+
+BEGIN
+   SetExceptionBlock (InitExceptionBlock ())
+END M2EXCEPTION.
diff --git a/gcc/m2/gm2-libs/M2LINK.def b/gcc/m2/gm2-libs/M2LINK.def
new file mode 100644
index 00000000000..409142a2af5
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2LINK.def
@@ -0,0 +1,41 @@
+(* M2LINK.def defines the linking mode used in Modula-2.
+
+Copyright (C) 2022 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/>.  *)
+
+DEFINITION MODULE FOR "C" M2LINK ;
+
+
+TYPE
+   PtrToChar = POINTER TO CHAR ;
+
+(* These variables are set by the compiler in the program module
+   according to linking command line options.  *)
+
+VAR
+   ForcedModuleInitOrder: PtrToChar ;
+   StaticInitialization : BOOLEAN ;
+
+
+END M2LINK.
diff --git a/gcc/m2/gm2-libs/M2RTS.def b/gcc/m2/gm2-libs/M2RTS.def
new file mode 100644
index 00000000000..1ae183b3e48
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2RTS.def
@@ -0,0 +1,187 @@
+(* M2RTS.def Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE M2RTS ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+   ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+
+(*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE is the
+                                 procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   ExecuteInitialProcedures - executes the initial procedures installed
+                              by InstallInitialProcedure.
+*)
+
+PROCEDURE ExecuteInitialProcedures ;
+
+
+(*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the main
+                             program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   ExecuteTerminationProcedures - calls each installed termination procedure
+                                  in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+
+
+(*
+   Terminate - provides compatibility for pim.  It call exit with
+               the exitcode provided in a prior call to ExitOnHalt
+               (or zero if ExitOnHalt was never called).  It does
+               not call ExecuteTerminationProcedures.
+*)
+
+PROCEDURE Terminate <* noreturn *> ;
+
+
+(*
+   HALT - terminate the current program.  The procedure Terminate
+          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.
+*)
+
+PROCEDURE HALT ([exitcode: INTEGER = -1]) <* noreturn *> ;
+
+
+(*
+   Halt - provides a more user friendly version of HALT, which takes
+          four parameters to aid debugging.
+*)
+
+PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+                function: ARRAY OF CHAR; description: ARRAY OF CHAR)
+		<* noreturn *> ;
+
+
+(*
+   ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*)
+
+PROCEDURE ExitOnHalt (e: INTEGER) ;
+
+
+(*
+   ErrorMessage - emits an error message to stderr and then calls exit (1).
+*)
+
+PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
+                        file: ARRAY OF CHAR;
+                        line: CARDINAL;
+                        function: ARRAY OF CHAR) <* 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.
+*)
+
+PROCEDURE Length (a: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   The following are the runtime exception handler routines.
+*)
+
+PROCEDURE AssignmentException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE IncException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE DecException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE InclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ExclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ShiftException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE RotateException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE StaticArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE DynamicArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ForLoopBeginException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ForLoopToException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ForLoopEndException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE PointerNilException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE NoReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE CaseException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeNonPosDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeNonPosModException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeZeroDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeZeroRemException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE WholeValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE RealValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE ParameterException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+PROCEDURE NoException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+
+
+END M2RTS.
diff --git a/gcc/m2/gm2-libs/M2RTS.mod b/gcc/m2/gm2-libs/M2RTS.mod
new file mode 100644
index 00000000000..6ce97f97ab1
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2RTS.mod
@@ -0,0 +1,547 @@
+(* M2RTS.mod Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE M2RTS ;
+
+
+FROM libc IMPORT abort, exit, write, getenv, printf ;
+(* FROM Builtins IMPORT strncmp, strcmp ;  not available during bootstrap.  *)
+FROM NumberIO IMPORT CardToStr ;
+FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM ASCII IMPORT nl, nul ;
+FROM Storage IMPORT ALLOCATE ;
+
+IMPORT RTExceptions ;
+IMPORT M2EXCEPTION ;
+IMPORT M2Dependent ;
+
+TYPE
+   PtrToChar = POINTER TO CHAR ;
+
+   ProcedureList = RECORD
+                      head, tail: ProcedureChain
+                   END ;
+
+   ProcedureChain = POINTER TO RECORD
+                                  p   : PROC ;
+                                  prev,
+                                  next: ProcedureChain ;
+                                END ;
+
+
+VAR
+   InitialProc,
+   TerminateProc: ProcedureList ;
+   ExitValue    : INTEGER ;
+   isHalting,
+   CallExit     : BOOLEAN ;
+   Initialized  : BOOLEAN ;
+
+
+(*
+   ConstructModules - resolve dependencies and then call each
+                      module constructor in turn.
+*)
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+BEGIN
+   M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+END ConstructModules ;
+
+
+(*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*)
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+BEGIN
+   M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+END DeconstructModules ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+BEGIN
+   M2Dependent.RegisterModule (name, init, fini, dependencies)
+END RegisterModule ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+   M2Dependent.RequestDependant (modulename, dependantmodule)
+END RequestDependant ;
+
+
+(*
+   ExecuteReverse - execute the procedure associated with procptr
+                    and then proceed to try and execute all previous
+                    procedures in the chain.
+*)
+
+PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
+BEGIN
+   WHILE procptr # NIL DO
+      procptr^.p ;  (* Invoke the procedure.  *)
+      procptr := procptr^.prev
+   END
+END ExecuteReverse ;
+
+
+(*
+   ExecuteTerminationProcedures - calls each installed termination procedure
+                                  in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+   ExecuteReverse (TerminateProc.tail)
+END ExecuteTerminationProcedures ;
+
+
+(*
+   ExecuteInitialProcedures - executes the initial procedures installed by
+                              InstallInitialProcedure.
+*)
+
+PROCEDURE ExecuteInitialProcedures ;
+BEGIN
+   ExecuteReverse (InitialProc.tail)
+END ExecuteInitialProcedures ;
+
+
+(*
+   AppendProc - append proc to the end of the procedure list
+                defined by proclist.
+*)
+
+PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
+VAR
+   pdes: ProcedureChain ;
+BEGIN
+   NEW (pdes) ;
+   WITH pdes^ DO
+      p := proc ;
+      prev := proclist.tail ;
+      next := NIL
+   END ;
+   IF proclist.head = NIL
+   THEN
+      proclist.head := pdes
+   END ;
+   proclist.tail := pdes ;
+   RETURN TRUE
+END AppendProc ;
+
+
+(*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE if the
+                                 procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+   RETURN AppendProc (TerminateProc, p)
+END InstallTerminationProcedure ;
+
+
+(*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the
+                             main program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+   RETURN AppendProc (InitialProc, p)
+END InstallInitialProcedure ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE HALT ([exitcode: INTEGER = -1]) <* noreturn *> ;
+BEGIN
+   IF exitcode#-1
+   THEN
+      CallExit := TRUE ;
+      ExitValue := exitcode
+   END ;
+   IF isHalting
+   THEN
+      (* double HALT found *)
+      exit(-1)
+   ELSE
+      isHalting := TRUE ;
+      ExecuteTerminationProcedures ;
+   END ;
+   IF CallExit
+   THEN
+      exit(ExitValue)
+   ELSE
+      abort
+   END
+END HALT ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Terminate <* noreturn *> ;
+BEGIN
+   exit (ExitValue)
+END Terminate ;
+
+
+(*
+   ErrorString - writes a string to stderr.
+*)
+
+PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
+VAR
+   n: INTEGER ;
+BEGIN
+   n := write (2, ADR (a), StrLen (a))
+END ErrorString ;
+
+
+(*
+   ErrorMessage - emits an error message to stderr and then calls exit (1).
+*)
+
+PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
+                        file: ARRAY OF CHAR;
+                        line: CARDINAL;
+                        function: ARRAY OF CHAR) <* noreturn *> ;
+VAR
+   LineNo: ARRAY [0..10] OF CHAR ;
+BEGIN
+   ErrorString (file) ; ErrorString(':') ;
+   CardToStr (line, 0, LineNo) ;
+   ErrorString (LineNo) ; ErrorString(':') ;
+   IF NOT StrEqual (function, '')
+   THEN
+      ErrorString ('in ') ;
+      ErrorString (function) ;
+      ErrorString (' has caused ') ;
+   END ;
+   ErrorString (message) ;
+   LineNo[0] := nl ; LineNo[1] := nul ;
+   ErrorString (LineNo) ;
+   exit (1)
+END ErrorMessage ;
+
+
+(*
+   Halt - provides a more user friendly version of HALT, which takes
+          four parameters to aid debugging.
+*)
+
+PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+                function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
+BEGIN
+   ErrorMessage (description, file, line, function) ;
+   HALT
+END Halt ;
+
+
+(*
+   The following are the runtime exception handler routines.
+*)
+
+PROCEDURE AssignmentException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END AssignmentException ;
+
+
+PROCEDURE ReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ReturnException ;
+
+
+PROCEDURE IncException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END IncException ;
+
+
+PROCEDURE DecException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END DecException ;
+
+
+PROCEDURE InclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END InclException ;
+
+
+PROCEDURE ExclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                      filename, line, column, scope, message)
+END ExclException ;
+
+
+PROCEDURE ShiftException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ShiftException ;
+
+
+PROCEDURE RotateException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END RotateException ;
+
+
+PROCEDURE StaticArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.indexException),
+                       filename, line, column, scope, message)
+END StaticArraySubscriptException ;
+
+
+PROCEDURE DynamicArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.indexException),
+                       filename, line, column, scope, message)
+END DynamicArraySubscriptException ;
+
+
+PROCEDURE ForLoopBeginException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ForLoopBeginException ;
+
+
+PROCEDURE ForLoopToException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ForLoopToException ;
+
+
+PROCEDURE ForLoopEndException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ForLoopEndException ;
+
+
+PROCEDURE PointerNilException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.invalidLocation),
+                       filename, line, column, scope, message)
+END PointerNilException ;
+
+
+PROCEDURE NoReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.functionException),
+                       filename, line, column, scope, message)
+END NoReturnException ;
+
+
+PROCEDURE CaseException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.caseSelectException),
+                       filename, line, column, scope, message)
+END CaseException ;
+
+
+PROCEDURE WholeNonPosDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeDivException),
+                       filename, line, column, scope, message)
+END WholeNonPosDivException ;
+
+
+PROCEDURE WholeNonPosModException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeDivException),
+                       filename, line, column, scope, message)
+END WholeNonPosModException ;
+
+
+PROCEDURE WholeZeroDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise(ORD (M2EXCEPTION.wholeDivException),
+                      filename, line, column, scope, message)
+END WholeZeroDivException ;
+
+
+PROCEDURE WholeZeroRemException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeDivException),
+                       filename, line, column, scope, message)
+END WholeZeroRemException ;
+
+
+PROCEDURE WholeValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.wholeValueException),
+                       filename, line, column, scope, message)
+END WholeValueException ;
+
+
+PROCEDURE RealValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.realValueException),
+                       filename, line, column, scope, message)
+END RealValueException ;
+
+
+PROCEDURE ParameterException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.rangeException),
+                       filename, line, column, scope, message)
+END ParameterException ;
+
+
+PROCEDURE NoException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+BEGIN
+   RTExceptions.Raise (ORD (M2EXCEPTION.exException),
+                       filename, line, column, scope, message)
+END NoException ;
+
+
+(*
+   ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*)
+
+PROCEDURE ExitOnHalt (e: INTEGER) ;
+BEGIN
+   ExitValue := e ;
+   CallExit := TRUE
+END ExitOnHalt ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Length (a: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   l, h: CARDINAL ;
+BEGIN
+   l := 0 ;
+   h := HIGH(a) ;
+   WHILE (l<=h) AND (a[l]#nul) DO
+      INC(l)
+   END ;
+   RETURN( l )
+END Length ;
+
+
+(*
+   InitProcList - initialize the head and tail pointers to NIL.
+*)
+
+PROCEDURE InitProcList (VAR p: ProcedureList) ;
+BEGIN
+   p.head := NIL ;
+   p.tail := NIL
+END InitProcList ;
+
+
+(*
+   Init - initialize the initial, terminate procedure lists and booleans.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   InitProcList (InitialProc) ;
+   InitProcList (TerminateProc) ;
+   ExitValue := 0 ;
+   isHalting := FALSE ;
+   CallExit := FALSE   (* default by calling abort *)
+END Init ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE CheckInitialized ;
+BEGIN
+   IF NOT Initialized
+   THEN
+      Initialized := TRUE ;
+      Init
+   END
+END CheckInitialized ;
+
+
+BEGIN
+   CheckInitialized
+END M2RTS.
diff --git a/gcc/m2/gm2-libs/MathLib0.def b/gcc/m2/gm2-libs/MathLib0.def
new file mode 100644
index 00000000000..0520ddeea3a
--- /dev/null
+++ b/gcc/m2/gm2-libs/MathLib0.def
@@ -0,0 +1,44 @@
+(* MathLib0.def provides access to math functions.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+DEFINITION MODULE MathLib0 ;
+
+CONST
+   pi   = 3.1415926535897932384626433832795028841972;
+   exp1 = 2.7182818284590452353602874713526624977572;
+
+
+PROCEDURE __BUILTIN__ sqrt (x: REAL) : REAL ;
+PROCEDURE exp (x: REAL) : REAL ;
+PROCEDURE ln (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ sin (x: REAL) : REAL ;
+PROCEDURE __BUILTIN__ cos (x: REAL) : REAL ;
+PROCEDURE tan (x: REAL) : REAL ;
+PROCEDURE arctan (x: REAL) : REAL ;
+PROCEDURE entier (x: REAL) : INTEGER ;
+
+
+END MathLib0.
diff --git a/gcc/m2/gm2-libs/MathLib0.mod b/gcc/m2/gm2-libs/MathLib0.mod
new file mode 100644
index 00000000000..1dd8c2ae984
--- /dev/null
+++ b/gcc/m2/gm2-libs/MathLib0.mod
@@ -0,0 +1,161 @@
+(* MathLib0.mod provides access to math functions.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+IMPLEMENTATION MODULE MathLib0 ;
+
+IMPORT cbuiltin, libm ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sqrt)) sqrt (x: REAL): REAL;
+BEGIN
+   RETURN cbuiltin.sqrt (x)
+END sqrt ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sqrtl)) sqrtl (x: LONGREAL): LONGREAL;
+BEGIN
+   RETURN cbuiltin.sqrtl (x)
+END sqrtl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sqrts)) sqrts (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.sqrtf (x)
+END sqrts ;
+
+PROCEDURE exp (x: REAL) : REAL ;
+BEGIN
+   RETURN libm.exp (x)
+END exp ;
+
+PROCEDURE exps (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN libm.expf (x)
+END exps ;
+
+PROCEDURE expl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN libm.expl (x)
+END expl ;
+
+
+(*
+                log (b)
+   log (b)  =      c
+      a         ------
+                log (a)
+                   c
+*)
+
+PROCEDURE ln (x: REAL) : REAL ;
+BEGIN
+   RETURN libm.log (x) / libm.log (exp1)
+END ln ;
+
+PROCEDURE lns (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN libm.logf (x) / libm.logf (exp1)
+END lns ;
+
+PROCEDURE lnl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN libm.logl (x) / libm.logl (exp1)
+END lnl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sin)) sin (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.sin (x)
+END sin ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sinl)) sinl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.sinl (x)
+END sinl ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sinf)) sins (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.sinf (x)
+END sins ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cos)) cos (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.cos (x)
+END cos ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cosf)) coss (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.cosf (x)
+END coss ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cosl)) cosl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN cbuiltin.cosl (x)
+END cosl ;
+
+PROCEDURE tan (x: REAL) : REAL ;
+BEGIN
+   RETURN libm.tan (x)
+END tan ;
+
+PROCEDURE tanl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN libm.tanl (x)
+END tanl ;
+
+PROCEDURE tans (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN libm.tanf (x)
+END tans ;
+
+PROCEDURE arctan (x: REAL) : REAL ;
+BEGIN
+   RETURN libm.atan (x)
+END arctan ;
+
+PROCEDURE arctans (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN libm.atanf (x)
+END arctans ;
+
+PROCEDURE arctanl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN libm.atanl (x)
+END arctanl ;
+
+PROCEDURE entier (x: REAL) : INTEGER ;
+BEGIN
+   RETURN TRUNC (libm.floor (x))
+END entier ;
+
+PROCEDURE entiers (x: SHORTREAL) : INTEGER ;
+BEGIN
+   RETURN TRUNC (libm.floorf (x))
+END entiers ;
+
+PROCEDURE entierl (x: LONGREAL) : INTEGER ;
+BEGIN
+   RETURN TRUNC (libm.floorl (x))
+END entierl ;
+
+
+END MathLib0.
diff --git a/gcc/m2/gm2-libs/MemUtils.def b/gcc/m2/gm2-libs/MemUtils.def
new file mode 100644
index 00000000000..234225e777b
--- /dev/null
+++ b/gcc/m2/gm2-libs/MemUtils.def
@@ -0,0 +1,47 @@
+(* MemUtils.def provides some basic memory utilities.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE MemUtils ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED MemCopy, MemZero ;
+
+
+(*
+   MemCopy - copys a region of memory to the required destination.
+*)
+
+PROCEDURE MemCopy (from: ADDRESS; length: CARDINAL; to: ADDRESS) ;
+
+
+(*
+   MemZero - sets a region of memory: a..a+length to zero.
+*)
+
+PROCEDURE MemZero (a: ADDRESS; length: CARDINAL) ;
+
+
+END MemUtils.
diff --git a/gcc/m2/gm2-libs/MemUtils.mod b/gcc/m2/gm2-libs/MemUtils.mod
new file mode 100644
index 00000000000..d299444da67
--- /dev/null
+++ b/gcc/m2/gm2-libs/MemUtils.mod
@@ -0,0 +1,85 @@
+(* MemUtils.mod provides some basic memory utilities.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE MemUtils ;
+
+
+FROM SYSTEM IMPORT WORD, BYTE, TSIZE ;
+
+
+(*
+   MemCopy - copys a region of memory to the required destination.
+*)
+
+PROCEDURE MemCopy (from: ADDRESS; length: CARDINAL; to: ADDRESS) ;
+VAR
+   pwb, pwa: POINTER TO WORD ;
+   pbb, pba: POINTER TO BYTE ;
+BEGIN
+   WHILE length>=TSIZE(WORD) DO
+      pwa := from ;
+      pwb := to ;
+      pwb^ := pwa^ ;
+      INC(from  , TSIZE(WORD)) ;
+      INC(to    , TSIZE(WORD)) ;
+      DEC(length, TSIZE(WORD))
+   END ;
+   WHILE length>0 DO
+      pba := from ;
+      pbb := to ;
+      pbb^ := pba^ ;
+      INC(from  , TSIZE(BYTE)) ;
+      INC(to    , TSIZE(BYTE)) ;
+      DEC(length, TSIZE(BYTE))
+   END
+END MemCopy ;
+
+
+(*
+   MemZero - sets a region of memory: a..a+length to zero.
+*)
+
+PROCEDURE MemZero (a: ADDRESS; length: CARDINAL) ;
+VAR
+   pwa: POINTER TO WORD ;
+   pba: POINTER TO BYTE ;
+BEGIN
+   pwa := a ;
+   WHILE length>=TSIZE(WORD) DO
+      pwa^ := WORD(0) ;
+      INC(pwa, TSIZE(WORD)) ;
+      DEC(length, TSIZE(WORD))
+   END ;
+   pba := ADDRESS(pwa) ;
+   WHILE length>=TSIZE(BYTE) DO
+      pba^ := BYTE(0) ;
+      INC(pba, TSIZE(BYTE)) ;
+      DEC(length, TSIZE(BYTE))
+   END
+END MemZero ;
+
+
+END MemUtils.
diff --git a/gcc/m2/gm2-libs/NumberIO.def b/gcc/m2/gm2-libs/NumberIO.def
new file mode 100644
index 00000000000..f57ad0b2ee9
--- /dev/null
+++ b/gcc/m2/gm2-libs/NumberIO.def
@@ -0,0 +1,83 @@
+(* NumberIO.def provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE NumberIO ;
+
+EXPORT QUALIFIED ReadCard, WriteCard, ReadHex, WriteHex, ReadInt, WriteInt,
+                 CardToStr, StrToCard, StrToHex, HexToStr, StrToInt, IntToStr,
+                 ReadOct, WriteOct, OctToStr, StrToOct,
+                 ReadBin, WriteBin, BinToStr, StrToBin,
+                 StrToBinInt, StrToHexInt, StrToOctInt ;
+
+
+PROCEDURE ReadCard (VAR x: CARDINAL) ;
+
+PROCEDURE WriteCard (x, n: CARDINAL) ;
+
+PROCEDURE ReadHex (VAR x: CARDINAL) ;
+
+PROCEDURE WriteHex (x, n: CARDINAL) ;
+
+PROCEDURE ReadInt (VAR x: INTEGER) ;
+
+PROCEDURE WriteInt (x: INTEGER ; n: CARDINAL) ;
+
+PROCEDURE CardToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+PROCEDURE StrToCard (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+
+PROCEDURE HexToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+PROCEDURE StrToHex (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+
+PROCEDURE IntToStr (x: INTEGER ; n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+PROCEDURE StrToInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+
+PROCEDURE ReadOct (VAR x: CARDINAL) ;
+
+PROCEDURE WriteOct (x, n: CARDINAL) ;
+
+PROCEDURE OctToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+PROCEDURE StrToOct (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+
+PROCEDURE ReadBin (VAR x: CARDINAL) ;
+
+PROCEDURE WriteBin (x, n: CARDINAL) ;
+
+PROCEDURE BinToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+PROCEDURE StrToBin (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+
+PROCEDURE StrToBinInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+
+PROCEDURE StrToHexInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+
+PROCEDURE StrToOctInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+
+
+END NumberIO.
diff --git a/gcc/m2/gm2-libs/NumberIO.mod b/gcc/m2/gm2-libs/NumberIO.mod
new file mode 100644
index 00000000000..bda4582f9de
--- /dev/null
+++ b/gcc/m2/gm2-libs/NumberIO.mod
@@ -0,0 +1,600 @@
+(* NumberIO.mod provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE NumberIO ;
+
+
+FROM ASCII IMPORT nul ;
+FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
+FROM StrLib IMPORT StrLen, StrRemoveWhitePrefix ;
+
+
+CONST
+   MaxLineLength = 79 ;
+   MaxDigits     = 20 ;
+   MaxHexDigits  = 20 ;
+   MaxOctDigits  = 40 ;
+   MaxBits       = 64 ;
+
+
+PROCEDURE CardToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+VAR
+   i, j,
+   Higha : CARDINAL ;
+   buf   : ARRAY [1..MaxDigits] OF CARDINAL ;
+BEGIN
+   i := 0 ;
+   REPEAT
+      INC(i) ;
+      IF i>MaxDigits
+      THEN
+         WriteString('NumberIO - increase MaxDigits') ; WriteLn ;
+         HALT
+      END ;
+      buf[i] := x MOD 10 ;
+      x := x DIV 10 ;
+   UNTIL x=0 ;
+   j := 0 ;
+   Higha := HIGH(a) ;
+   WHILE (n>i) AND (j<=Higha) DO
+      a[j] := ' ' ;
+      INC(j) ;
+      DEC(n)
+   END ;
+   WHILE (i>0) AND (j<=Higha) DO
+      a[j] := CHR( buf[i] + ORD('0') ) ;
+      INC(j) ;
+      DEC(i)
+   END ;
+   IF j<=Higha
+   THEN
+      a[j] := nul
+   END
+END CardToStr ;
+
+
+PROCEDURE StrToCard (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+VAR
+   i     : CARDINAL ;
+   ok    : BOOLEAN ;
+   higha : CARDINAL ;
+BEGIN
+   StrRemoveWhitePrefix(a, a) ;
+   higha := StrLen(a) ;
+   i := 0 ;
+   ok := TRUE ;
+   WHILE ok DO
+      IF i<higha
+      THEN
+         IF (a[i]<'0') OR (a[i]>'9')
+         THEN
+            INC(i)
+         ELSE
+            ok := FALSE
+         END
+      ELSE
+         ok := FALSE
+      END
+   END ;
+   x := 0 ;
+   IF i<higha
+   THEN
+      ok := TRUE ;
+      REPEAT
+         x := 10*x + (ORD(a[i])-ORD('0')) ;
+         IF i<higha
+         THEN
+            INC(i) ;
+            IF (a[i]<'0') OR (a[i]>'9')
+            THEN
+               ok := FALSE
+            END
+         ELSE
+            ok := FALSE
+         END
+      UNTIL NOT ok ;
+   END
+END StrToCard ;
+
+
+PROCEDURE IntToStr (x: INTEGER; n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+VAR
+   i, j, c,
+   Higha   : CARDINAL ;
+   buf     : ARRAY [1..MaxDigits] OF CARDINAL ;
+   Negative: BOOLEAN ;
+BEGIN
+   IF x<0
+   THEN
+      Negative := TRUE ;
+      c := VAL(CARDINAL, ABS(x+1))+1 ;
+      IF n>0
+      THEN
+         DEC(n)
+      END
+   ELSE
+      c := x ;
+      Negative := FALSE
+   END ;
+   i := 0 ;
+   REPEAT
+      INC(i) ;
+      IF i>MaxDigits
+      THEN
+         WriteString('NumberIO - increase MaxDigits') ; WriteLn ;
+         HALT
+      END ;
+      buf[i] := c MOD 10 ;
+      c := c DIV 10 ;
+   UNTIL c=0 ;
+   j := 0 ;
+   Higha := HIGH(a) ;
+   WHILE (n>i) AND (j<=Higha) DO
+      a[j] := ' ' ;
+      INC(j) ;
+      DEC(n)
+   END ;
+   IF Negative
+   THEN
+      a[j] := '-' ;
+      INC(j)
+   END ;
+   WHILE (i#0) AND (j<=Higha) DO
+      a[j] := CHR( buf[i] + ORD('0') ) ;
+      INC(j) ;
+      DEC(i)
+   END ;
+   IF j<=Higha
+   THEN
+      a[j] := nul
+   END
+END IntToStr ;
+
+
+PROCEDURE StrToInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+VAR
+   i        : CARDINAL ;
+   ok,
+   Negative : BOOLEAN ;
+   higha    : CARDINAL ;
+BEGIN
+   StrRemoveWhitePrefix(a, a) ;
+   higha := StrLen(a) ;
+   i := 0 ;
+   Negative := FALSE ;
+   ok := TRUE ;
+   WHILE ok DO
+      IF i<higha
+      THEN
+         IF a[i]='-'
+         THEN
+            INC(i) ;
+            Negative := NOT Negative
+         ELSIF (a[i]<'0') OR (a[i]>'9')
+         THEN
+            INC(i)
+         ELSE
+            ok := FALSE
+         END
+      ELSE
+         ok := FALSE
+      END
+   END ;
+   x := 0 ;
+   IF i<higha
+   THEN
+      ok := TRUE ;
+      REPEAT
+         IF Negative
+         THEN
+            x := 10*x - INTEGER(ORD(a[i])-ORD('0'))
+         ELSE
+            x := 10*x + INTEGER(ORD(a[i])-ORD('0'))
+         END ;
+         IF i<higha
+         THEN
+            INC(i) ;
+            IF (a[i]<'0') OR (a[i]>'9')
+            THEN
+               ok := FALSE
+            END
+         ELSE
+            ok := FALSE
+         END
+      UNTIL NOT ok ;
+   END
+END StrToInt ;
+
+
+PROCEDURE HexToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+VAR
+   i, j,
+   Higha : CARDINAL ;
+   buf   : ARRAY [1..MaxHexDigits] OF CARDINAL ;
+BEGIN
+   i := 0 ;
+   REPEAT
+      INC(i) ;
+      IF i>MaxHexDigits
+      THEN
+         WriteString('NumberIO - increase MaxDigits') ; WriteLn ;
+         HALT
+      END ;
+      buf[i] := x MOD 010H ;
+      x := x DIV 010H ;
+   UNTIL x=0 ;
+   j := 0 ;
+   Higha := HIGH(a) ;
+   WHILE (n>i) AND (j<=Higha) DO
+      a[j] := '0' ;
+      INC(j) ;
+      DEC(n)
+   END ;
+   WHILE (i#0) AND (j<=Higha) DO
+      IF buf[i]<10
+      THEN
+         a[j] := CHR( buf[i] + ORD('0') )
+      ELSE
+         a[j] := CHR( buf[i] + ORD('A')-10 )
+      END ;
+      INC(j) ;
+      DEC(i)
+   END ;
+   IF j<=Higha
+   THEN
+      a[j] := nul
+   END
+END HexToStr ;
+
+
+PROCEDURE StrToHex (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   StrToHexInt(a, i) ;
+   x := VAL(CARDINAL, i)
+END StrToHex ;
+
+
+PROCEDURE StrToHexInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+VAR
+   i     : CARDINAL ;
+   ok    : BOOLEAN ;
+   higha : CARDINAL ;
+BEGIN
+   StrRemoveWhitePrefix(a, a) ;
+   higha := StrLen(a) ;
+   i := 0 ;
+   ok := TRUE ;
+   WHILE ok DO
+      IF i<higha
+      THEN
+         IF ((a[i]>='0') AND (a[i]<='9')) OR ((a[i]>='A') AND (a[i]<='F'))
+         THEN
+            ok := FALSE
+         ELSE
+            INC(i)
+         END
+      ELSE
+         ok := FALSE
+      END
+   END ;
+   x := 0 ;
+   IF i<higha
+   THEN
+      ok := TRUE ;
+      REPEAT
+         IF (a[i]>='0') AND (a[i]<='9')
+         THEN
+            x := 010H*x + VAL(INTEGER, (ORD(a[i])-ORD('0')))
+         ELSIF (a[i]>='A') AND (a[i]<='F')
+         THEN
+            x := 010H*x + VAL(INTEGER, (ORD(a[i])-ORD('A')+10))
+         END ;
+         IF i<higha
+         THEN
+            INC(i) ;
+            IF ((a[i]<'0') OR (a[i]>'9')) AND ((a[i]<'A') OR (a[i]>'F'))
+            THEN
+               ok := FALSE
+            END
+         ELSE
+            ok := FALSE
+         END
+      UNTIL NOT ok ;
+   END
+END StrToHexInt ;
+
+
+PROCEDURE OctToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+VAR
+   i, j,
+   Higha : CARDINAL ;
+   buf   : ARRAY [1..MaxOctDigits] OF CARDINAL ;
+BEGIN
+   i := 0 ;
+   REPEAT
+      INC(i) ;
+      IF i>MaxOctDigits
+      THEN
+         WriteString('NumberIO - increase MaxDigits') ; WriteLn ;
+         HALT
+      END ;
+      buf[i] := x MOD 8 ;
+      x := x DIV 8 ;
+   UNTIL x=0 ;
+   j := 0 ;
+   Higha := HIGH(a) ;
+   WHILE (n>i) AND (j<=Higha) DO
+      a[j] := ' ' ;
+      INC(j) ;
+      DEC(n)
+   END ;
+   WHILE (i>0) AND (j<=Higha) DO
+      a[j] := CHR( buf[i] + ORD('0') ) ;
+      INC(j) ;
+      DEC(i)
+   END ;
+   IF j<=Higha
+   THEN
+      a[j] := nul
+   END
+END OctToStr ;
+
+
+PROCEDURE StrToOct (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   StrToOctInt(a, i) ;
+   x := VAL(CARDINAL, i)
+END StrToOct ;
+
+
+PROCEDURE StrToOctInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+VAR
+   i     : CARDINAL ;
+   ok    : BOOLEAN ;
+   higha : CARDINAL ;
+BEGIN
+   StrRemoveWhitePrefix(a, a) ;
+   higha := StrLen(a) ;
+   i := 0 ;
+   ok := TRUE ;
+   WHILE ok DO
+      IF i<higha
+      THEN
+         IF (a[i]<'0') OR (a[i]>'7')
+         THEN
+            INC(i)
+         ELSE
+            ok := FALSE
+         END
+      ELSE
+         ok := FALSE
+      END
+   END ;
+   x := 0 ;
+   IF i<higha
+   THEN
+      ok := TRUE ;
+      REPEAT
+         x := 8*x + VAL(INTEGER, (ORD(a[i])-ORD('0'))) ;
+         IF i<higha
+         THEN
+            INC(i) ;
+            IF (a[i]<'0') OR (a[i]>'7')
+            THEN
+               ok := FALSE
+            END
+         ELSE
+            ok := FALSE
+         END
+      UNTIL NOT ok ;
+   END
+END StrToOctInt ;
+
+
+PROCEDURE BinToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+VAR
+   i, j,
+   Higha : CARDINAL ;
+   buf   : ARRAY [1..MaxBits] OF CARDINAL ;
+BEGIN
+   i := 0 ;
+   REPEAT
+      INC(i) ;
+      IF i>MaxBits
+      THEN
+         WriteString('NumberIO - increase MaxBits') ; WriteLn ;
+         HALT
+      END ;
+      buf[i] := x MOD 2 ;
+      x := x DIV 2 ;
+   UNTIL x=0 ;
+   j := 0 ;
+   Higha := HIGH(a) ;
+   WHILE (n>i) AND (j<=Higha) DO
+      a[j] := ' ' ;
+      INC(j) ;
+      DEC(n)
+   END ;
+   WHILE (i>0) AND (j<=Higha) DO
+      a[j] := CHR( buf[i] + ORD('0') ) ;
+      INC(j) ;
+      DEC(i)
+   END ;
+   IF j<=Higha
+   THEN
+      a[j] := nul
+   END
+END BinToStr ;
+
+
+PROCEDURE StrToBin (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   StrToBinInt(a, i) ;
+   x := VAL(CARDINAL, i)
+END StrToBin ;
+
+
+PROCEDURE StrToBinInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+VAR
+   i     : CARDINAL ;
+   ok    : BOOLEAN ;
+   higha : CARDINAL ;
+BEGIN
+   StrRemoveWhitePrefix(a, a) ;
+   higha := StrLen(a) ;
+   i := 0 ;
+   ok := TRUE ;
+   WHILE ok DO
+      IF i<higha
+      THEN
+         IF (a[i]<'0') OR (a[i]>'1')
+         THEN
+            INC(i)
+         ELSE
+            ok := FALSE
+         END
+      ELSE
+         ok := FALSE
+      END
+   END ;
+   x := 0 ;
+   IF i<higha
+   THEN
+      ok := TRUE ;
+      REPEAT
+         x := 2*x + VAL(INTEGER, (ORD(a[i])-ORD('0'))) ;
+         IF i<higha
+         THEN
+            INC(i) ;
+            IF (a[i]<'0') OR (a[i]>'1')
+            THEN
+               ok := FALSE
+            END
+         ELSE
+            ok := FALSE
+         END
+      UNTIL NOT ok ;
+   END
+END StrToBinInt ;
+
+
+PROCEDURE ReadOct (VAR x: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   ReadString( a ) ;
+   StrToOct( a, x )
+END ReadOct ;
+
+
+PROCEDURE WriteOct (x, n: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   OctToStr( x, n, a ) ;
+   WriteString( a )
+END WriteOct ;
+
+
+PROCEDURE ReadBin (VAR x: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   ReadString(a) ;
+   StrToBin(a, x)
+END ReadBin ;
+
+
+PROCEDURE WriteBin (x, n: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   BinToStr( x, n, a ) ;
+   WriteString( a )
+END WriteBin ;
+
+
+PROCEDURE ReadCard (VAR x: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   ReadString( a ) ;
+   StrToCard( a, x )
+END ReadCard ;
+
+
+PROCEDURE WriteCard (x, n: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   CardToStr( x, n, a ) ;
+   WriteString( a )
+END WriteCard ;
+
+
+PROCEDURE ReadInt (VAR x: INTEGER) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   ReadString( a ) ;
+   StrToInt( a, x )
+END ReadInt ;
+
+
+PROCEDURE WriteInt (x: INTEGER; n: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   IntToStr( x, n, a ) ;
+   WriteString( a )
+END WriteInt ;
+
+
+PROCEDURE ReadHex (VAR x: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   ReadString( a ) ;
+   StrToHex( a, x )
+END ReadHex ;
+
+
+PROCEDURE WriteHex (x, n: CARDINAL) ;
+VAR
+   a : ARRAY [0..MaxLineLength] OF CHAR ;
+BEGIN
+   HexToStr( x, n, a ) ;
+   WriteString( a )
+END WriteHex ;
+
+
+END NumberIO.
diff --git a/gcc/m2/gm2-libs/OptLib.def b/gcc/m2/gm2-libs/OptLib.def
new file mode 100644
index 00000000000..563f786d1cc
--- /dev/null
+++ b/gcc/m2/gm2-libs/OptLib.def
@@ -0,0 +1,106 @@
+(* OptLib.def allows users to manipulate Argv/Argc.
+
+Copyright (C) 2019-2021 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/>.  *)
+
+DEFINITION MODULE OptLib ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String ;
+
+TYPE
+   Option ;
+
+
+(*
+   InitOption - constructor for Option.
+*)
+
+PROCEDURE InitOption (argc: INTEGER; argv: ADDRESS) : Option ;
+
+
+(*
+   KillOption - deconstructor for Option.
+*)
+
+PROCEDURE KillOption (o: Option) : Option ;
+
+
+(*
+   Dup - duplicate the option array inside, o.
+         Notice that this does not duplicate all the contents
+         (strings) of argv.
+         Shallow copy of the top level indices.
+*)
+
+PROCEDURE Dup (o: Option) : Option ;
+
+
+(*
+   Slice - return a new option which has elements [low:high] from the
+           options, o.
+*)
+
+PROCEDURE Slice (o: Option; low, high: INTEGER) : Option ;
+
+
+(*
+   IndexStrCmp - returns the index in the argv array which matches
+                 string, s.  -1 is returned if the string is not found.
+*)
+
+PROCEDURE IndexStrCmp (o: Option; s: String) : INTEGER ;
+
+
+(*
+   IndexStrNCmp - returns the index in the argv array where the first
+                  characters are matched by string, s.
+                  -1 is returned if the string is not found.
+*)
+
+PROCEDURE IndexStrNCmp (o: Option; s: String) : INTEGER ;
+
+
+(*
+   ConCat - returns the concatenation of a and b.
+*)
+
+PROCEDURE ConCat (a, b: Option) : Option ;
+
+
+(*
+   GetArgv - return the argv component of option.
+*)
+
+PROCEDURE GetArgv (o: Option) : ADDRESS ;
+
+
+(*
+   GetArgc - return the argc component of option.
+*)
+
+PROCEDURE GetArgc (o: Option) : INTEGER ;
+
+
+END OptLib.
diff --git a/gcc/m2/gm2-libs/OptLib.mod b/gcc/m2/gm2-libs/OptLib.mod
new file mode 100644
index 00000000000..b4370299b65
--- /dev/null
+++ b/gcc/m2/gm2-libs/OptLib.mod
@@ -0,0 +1,279 @@
+(* OptLib.mod allows users to manipulate Argv/Argc.
+
+Copyright (C) 2019-2021 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/>.  *)
+
+IMPLEMENTATION MODULE OptLib ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM libc IMPORT memcpy ;
+FROM DynamicStrings IMPORT String ;
+
+IMPORT DynamicStrings ;
+
+
+TYPE
+   Option = POINTER TO RECORD
+                          argc: INTEGER ;
+                          argv: ADDRESS ;
+                          next: Option ;
+                       END ;
+
+VAR
+   freeList: Option ;
+
+
+(*
+   InitOption - constructor for Option.
+*)
+
+PROCEDURE InitOption (argc: INTEGER; argv: ADDRESS) : Option ;
+VAR
+   o: Option ;
+BEGIN
+   o := newOption () ;
+   o^.argc := argc ;
+   o^.argv := argv ;
+   o^.next := NIL ;
+   RETURN o
+END InitOption ;
+
+
+(*
+   newOption - returns an option
+*)
+
+PROCEDURE newOption () : Option ;
+VAR
+   o: Option ;
+BEGIN
+   IF freeList = NIL
+   THEN
+      NEW (o)
+   ELSE
+      o := freeList ;
+      freeList := freeList^.next
+   END ;
+   RETURN o
+END newOption ;
+
+
+(*
+   KillOption - deconstructor for Option.
+*)
+
+PROCEDURE KillOption (o: Option) : Option ;
+BEGIN
+   o^.next := freeList ;
+   freeList := o ;
+   RETURN NIL
+END KillOption ;
+
+
+(*
+   Min - returns the lowest value of a and b.
+*)
+
+PROCEDURE Min (a, b: INTEGER) : INTEGER ;
+BEGIN
+   IF a < b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Min ;
+
+
+(*
+   dupArgv - return an array which is a duplicate as defined
+             by argc and argv.
+*)
+
+PROCEDURE dupArgv (argc: INTEGER; argv: ADDRESS) : ADDRESS ;
+VAR
+   nargv: ADDRESS ;
+BEGIN
+   ALLOCATE (nargv, VAL (CARDINAL, argc) * SIZE (ADDRESS)) ;
+   nargv := memcpy (nargv, argv, VAL (CARDINAL, argc) * SIZE (ADDRESS)) ;
+   RETURN nargv
+END dupArgv ;
+
+
+(*
+   Dup - duplicate the option array inside, o.
+         Notice that this does not duplicate all the contents
+         (strings) of argv.
+         Shallow copy of the top level indices.
+*)
+
+PROCEDURE Dup (o: Option) : Option ;
+VAR
+   n: Option ;
+BEGIN
+   n := newOption () ;
+   n^.argc := o^.argc ;
+   n^.argv := dupArgv (o^.argc, o^.argv) ;
+   n^.next := NIL ;
+   RETURN n
+END Dup ;
+
+
+(*
+   Slice - return a new option which has elements [low:high] from the
+           options, o.
+*)
+
+PROCEDURE Slice (o: Option; low, high: INTEGER) : Option ;
+VAR
+   n: Option ;
+   p: POINTER TO CHAR ;
+   a: ADDRESS ;
+BEGIN
+   n := newOption () ;
+   IF low < 0
+   THEN
+      low := o^.argc + low
+   END ;
+   IF high <= 0
+   THEN
+      high := o^.argc + high
+   ELSE
+      high := Min (o^.argc, high)
+   END ;
+   n^.argc := high-low+1 ;
+   p := o^.argv ;
+   INC (p, VAL (INTEGER, SIZE (ADDRESS)) * low) ;
+   ALLOCATE (a, VAL (INTEGER, SIZE (ADDRESS)) * n^.argc) ;
+   n^.argv := memcpy (a, p, VAL (INTEGER, SIZE (ADDRESS)) * n^.argc) ;
+   n^.next := NIL ;
+   RETURN n
+END Slice ;
+
+
+(*
+   IndexStrCmp - returns the index in the argv array which matches
+                 string, s.  -1 is returned if the string is not found.
+*)
+
+PROCEDURE IndexStrCmp (o: Option; s: String) : INTEGER ;
+VAR
+   i        : INTEGER ;
+   p        : POINTER TO POINTER TO CHAR ;
+   optString: String ;
+BEGIN
+   i := 0 ;
+   p := o^.argv ;
+   WHILE i < o^.argc DO
+      optString := DynamicStrings.InitStringCharStar (p^) ;
+      IF DynamicStrings.Equal (s, optString)
+      THEN
+         optString := DynamicStrings.KillString (optString) ;
+         RETURN i
+      END ;
+      optString := DynamicStrings.KillString (optString) ;
+      INC (p, SIZE (ADDRESS)) ;
+      INC (i)
+   END ;
+   RETURN -1
+END IndexStrCmp ;
+
+
+(*
+   IndexStrNCmp - returns the index in the argv array where the first
+                  characters are matched by string, s.
+                  -1 is returned if the string is not found.
+*)
+
+PROCEDURE IndexStrNCmp (o: Option; s: String) : INTEGER ;
+VAR
+   len      : CARDINAL ;
+   i        : INTEGER ;
+   p        : POINTER TO POINTER TO CHAR ;
+   optString: String ;
+BEGIN
+   i := 0 ;
+   p := o^.argv ;
+   len := DynamicStrings.Length (s) ;
+   WHILE i < o^.argc DO
+      optString := DynamicStrings.InitStringCharStar (p^) ;
+      IF DynamicStrings.Length (optString) >= len
+      THEN
+         optString := DynamicStrings.Slice (DynamicStrings.Mark (optString), 0, len) ;
+         IF DynamicStrings.Equal (s, optString)
+         THEN
+            optString := DynamicStrings.KillString (optString) ;
+            RETURN i
+         END
+      END ;
+      optString := DynamicStrings.KillString (optString) ;
+      INC (p, SIZE (ADDRESS)) ;
+      INC (i)
+   END ;
+   RETURN -1
+END IndexStrNCmp ;
+
+
+(*
+   ConCat - returns the concatenation of a and b.
+*)
+
+PROCEDURE ConCat (a, b: Option) : Option ;
+VAR
+   result: Option ;
+BEGIN
+   result := newOption () ;
+   result^.argc := a^.argc + b^.argc ;
+   ALLOCATE (result^.argv, result^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
+   result^.argv := memcpy (result^.argv, a^.argv, a^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
+   result^.argv := memcpy (result^.argv + VAL (ADDRESS, a^.argc * VAL (INTEGER, SIZE (ADDRESS))),
+                           b^.argv, b^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
+   result^.next := NIL ;
+   RETURN result
+END ConCat ;
+
+
+(*
+   GetArgv - return the argv component of option.
+*)
+
+PROCEDURE GetArgv (o: Option) : ADDRESS ;
+BEGIN
+   RETURN o^.argv
+END GetArgv ;
+
+
+(*
+   GetArgc - return the argc component of option.
+*)
+
+PROCEDURE GetArgc (o: Option) : INTEGER ;
+BEGIN
+   RETURN o^.argc
+END GetArgc ;
+
+
+BEGIN
+   freeList := NIL
+END OptLib.
diff --git a/gcc/m2/gm2-libs/PushBackInput.def b/gcc/m2/gm2-libs/PushBackInput.def
new file mode 100644
index 00000000000..22319dd80cc
--- /dev/null
+++ b/gcc/m2/gm2-libs/PushBackInput.def
@@ -0,0 +1,135 @@
+(* PushBackInput.def provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE PushBackInput ;
+
+FROM FIO IMPORT File ;
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED Open, PutCh, GetCh, Error, WarnError, WarnString,
+                 Close, SetDebug, GetExitStatus, PutStr,
+                 PutString, GetColumnPosition, GetCurrentLine ;
+
+
+(*
+   Open - opens a file for reading.
+*)
+
+PROCEDURE Open (a: ARRAY OF CHAR) : File ;
+
+
+(*
+   GetCh - gets a character from either the push back stack or
+           from file, f.
+*)
+
+PROCEDURE GetCh (f: File) : CHAR ;
+
+
+(*
+   PutCh - pushes a character onto the push back stack, it also
+           returns the character which has been pushed.
+*)
+
+PROCEDURE PutCh (ch: CHAR) : CHAR ;
+
+
+(*
+   PutString - pushes a string onto the push back stack.
+*)
+
+PROCEDURE PutString (a: ARRAY OF CHAR) ;
+
+
+(*
+   PutStr - pushes a dynamic string onto the push back stack.
+            The string, s, is not deallocated.
+*)
+
+PROCEDURE PutStr (s: String) ;
+
+
+(*
+   Error - emits an error message with the appropriate file, line combination.
+*)
+
+PROCEDURE Error (a: ARRAY OF CHAR) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE WarnError (a: ARRAY OF CHAR) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE WarnString (s: String) ;
+
+
+(*
+   Close - closes the opened file.
+*)
+
+PROCEDURE Close (f: File) ;
+
+
+(*
+   GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*)
+
+PROCEDURE GetExitStatus () : CARDINAL ;
+
+
+(*
+   SetDebug - sets the debug flag on or off.
+*)
+
+PROCEDURE SetDebug (d: BOOLEAN) ;
+
+
+(*
+   GetColumnPosition - returns the column position of the current character.
+*)
+
+PROCEDURE GetColumnPosition () : CARDINAL ;
+
+
+(*
+   GetCurrentLine - returns the current line number.
+*)
+
+PROCEDURE GetCurrentLine () : CARDINAL ;
+
+
+END PushBackInput.
diff --git a/gcc/m2/gm2-libs/PushBackInput.mod b/gcc/m2/gm2-libs/PushBackInput.mod
new file mode 100644
index 00000000000..a197b70bfa2
--- /dev/null
+++ b/gcc/m2/gm2-libs/PushBackInput.mod
@@ -0,0 +1,307 @@
+(* PushBackInput.mod provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE PushBackInput ;
+
+
+FROM FIO IMPORT ReadChar, IsNoError, EOF, OpenToRead, WriteChar, StdErr ;
+FROM DynamicStrings IMPORT string, Length, char ;
+FROM ASCII IMPORT nul, cr, lf ;
+FROM Debug IMPORT Halt ;
+FROM StrLib IMPORT StrCopy, StrLen ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StdIO IMPORT Write, PushOutput, PopOutput ;
+FROM libc IMPORT exit ;
+
+IMPORT FIO ;
+
+
+CONST
+   MaxPushBackStack =  8192 ;
+   MaxFileName      =  4096 ;
+
+VAR
+   FileName  : ARRAY [0..MaxFileName] OF CHAR ;
+   CharStack : ARRAY [0..MaxPushBackStack] OF CHAR ;
+   ExitStatus: CARDINAL ;
+   Column,
+   StackPtr,
+   LineNo    : CARDINAL ;
+   Debugging : BOOLEAN ;
+
+
+(*
+   GetCh - gets a character from either the push back stack or
+           from file, f.
+*)
+
+PROCEDURE GetCh (f: File) : CHAR ;
+VAR
+   ch: CHAR ;
+BEGIN
+   IF StackPtr>0
+   THEN
+      DEC(StackPtr) ;
+      IF Debugging
+      THEN
+         Write(CharStack[StackPtr])
+      END ;
+      RETURN( CharStack[StackPtr] )
+   ELSE
+      IF EOF(f) OR (NOT IsNoError(f))
+      THEN
+         ch := nul
+      ELSE
+         REPEAT
+            ch := ReadChar(f)
+         UNTIL (ch#cr) OR EOF(f) OR (NOT IsNoError(f)) ;
+         IF ch=lf
+         THEN
+            Column := 0 ;
+            INC(LineNo)
+         ELSE
+            INC(Column)
+         END
+      END ;
+      IF Debugging
+      THEN
+         Write(ch)
+      END ;
+      RETURN( ch )
+   END
+END GetCh ;
+
+
+(*
+   PutStr - pushes a dynamic string onto the push back stack.
+            The string, s, is not deallocated.
+*)
+
+PROCEDURE PutStr (s: String) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := Length (s) ;
+   WHILE i > 0 DO
+      DEC (i) ;
+      IF PutCh (char (s, i)) # char (s, i)
+      THEN
+         Halt('assert failed', __LINE__, __FILE__)
+      END
+   END
+END PutStr ;
+
+
+(*
+   PutString - pushes a string onto the push back stack.
+*)
+
+PROCEDURE PutString (a: ARRAY OF CHAR) ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := StrLen (a) ;
+   WHILE l > 0 DO
+      DEC (l) ;
+      IF PutCh (a[l]) # a[l]
+      THEN
+         Halt ('assert failed', __LINE__, __FILE__)
+      END
+   END
+END PutString ;
+
+
+(*
+   PutCh - pushes a character onto the push back stack, it also
+           returns the character which has been pushed.
+*)
+
+PROCEDURE PutCh (ch: CHAR) : CHAR ;
+BEGIN
+   IF StackPtr<MaxPushBackStack
+   THEN
+      CharStack[StackPtr] := ch ;
+      INC(StackPtr)
+   ELSE
+      Halt('max push back stack exceeded, increase MaxPushBackStack', __LINE__, __FILE__)
+   END ;
+   RETURN( ch )
+END PutCh ;
+
+
+(*
+   Open - opens a file for reading.
+*)
+
+PROCEDURE Open (a: ARRAY OF CHAR) : File ;
+BEGIN
+   Init ;
+   StrCopy(a, FileName) ;
+   RETURN( OpenToRead(a) )
+END Open ;
+
+
+(*
+   Close - closes the opened file.
+*)
+
+PROCEDURE Close (f: File) ;
+BEGIN
+   FIO.Close(f)
+END Close ;
+
+
+(*
+   ErrChar - writes a char, ch, to stderr.
+*)
+
+PROCEDURE ErrChar (ch: CHAR) ;
+BEGIN
+   WriteChar(StdErr, ch)
+END ErrChar ;
+
+
+(*
+   Error - emits an error message with the appropriate file, line combination.
+*)
+
+PROCEDURE Error (a: ARRAY OF CHAR) ;
+BEGIN
+   PushOutput(ErrChar) ;
+   WriteString(FileName) ; Write(':') ; WriteCard(LineNo, 0) ; Write(':') ; WriteString(a) ; WriteLn ;
+   PopOutput ;
+   FIO.Close(StdErr) ;
+   exit(1)
+END Error ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE WarnError (a: ARRAY OF CHAR) ;
+BEGIN
+   PushOutput(ErrChar) ;
+   WriteString(FileName) ; Write(':') ; WriteCard(LineNo, 0) ; Write(':') ; WriteString(a) ; WriteLn ;
+   PopOutput ;
+   ExitStatus := 1
+END WarnError ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE WarnString (s: String) ;
+VAR
+   p : POINTER TO CHAR ;
+BEGIN
+   p := string(s) ;
+   WriteString(FileName) ; Write(':') ; WriteCard(LineNo, 0) ; Write(':') ;
+   REPEAT
+      IF p#NIL
+      THEN
+         IF p^=lf
+         THEN
+            WriteLn ;
+            WriteString(FileName) ; Write(':') ; WriteCard(LineNo, 0) ; Write(':')
+         ELSE
+            Write(p^)
+         END ;
+         INC(p)
+      END ;
+   UNTIL (p=NIL) OR (p^=nul) ;
+   ExitStatus := 1
+END WarnString ;
+
+
+(*
+   GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*)
+
+PROCEDURE GetExitStatus () : CARDINAL ;
+BEGIN
+   RETURN( ExitStatus )
+END GetExitStatus ;
+
+
+(*
+   SetDebug - sets the debug flag on or off.
+*)
+
+PROCEDURE SetDebug (d: BOOLEAN) ;
+BEGIN
+   Debugging := d
+END SetDebug ;
+
+
+(*
+   GetColumnPosition - returns the column position of the current character.
+*)
+
+PROCEDURE GetColumnPosition () : CARDINAL ;
+BEGIN
+   IF StackPtr>Column
+   THEN
+      RETURN( 0 )
+   ELSE
+      RETURN( Column-StackPtr )
+   END
+END GetColumnPosition ;
+
+
+(*
+   GetCurrentLine - returns the current line number.
+*)
+
+PROCEDURE GetCurrentLine () : CARDINAL ;
+BEGIN
+   RETURN( LineNo )
+END GetCurrentLine ;
+
+
+(*
+   Init - initialize global variables.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   ExitStatus := 0 ;
+   StackPtr   := 0 ;
+   LineNo     := 1 ;
+   Column     := 0
+END Init ;
+
+
+BEGIN
+   SetDebug(FALSE) ;
+   Init
+END PushBackInput.
diff --git a/gcc/m2/gm2-libs/README.texi b/gcc/m2/gm2-libs/README.texi
new file mode 100644
index 00000000000..0de04ff8436
--- /dev/null
+++ b/gcc/m2/gm2-libs/README.texi
@@ -0,0 +1,18 @@
+@c README.texi describes the pim libraries.
+@c Copyright @copyright{} 2000-2022 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+These are the base libraries for the GNU Modula-2 compiler.  These
+modules originally came from the M2F compiler and have been cleaned up
+and extended.  They provide a basic interface to the underlying
+operating system via libc.  They also include a number of libraries to
+allow access to compiler built-ins. Perhaps the largest difference to
+PIM and ISO libraries is the @code{DynamicString} module which
+declares the type @code{String}.  The heavy use of this opaque data
+type results in a number of equivalent modules that can either handle
+@code{ARRAY OF CHAR} or @code{String}.
+
+These modules have been extensively tested and are used throughout
+building the GNU Modula-2 compiler.
diff --git a/gcc/m2/gm2-libs/RTExceptions.def b/gcc/m2/gm2-libs/RTExceptions.def
new file mode 100644
index 00000000000..3c24835d87e
--- /dev/null
+++ b/gcc/m2/gm2-libs/RTExceptions.def
@@ -0,0 +1,195 @@
+(* RTExceptions.def runtime exception handler routines.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE RTExceptions ;
+
+(* Runtime exception handler routines.  This should
+   be considered as a system module for GNU Modula-2
+   and allow the compiler to interface with exception
+   handling.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED EHBlock,
+                 Raise, SetExceptionBlock, GetExceptionBlock,
+                 GetTextBuffer, GetTextBufferSize, GetNumber,
+                 InitExceptionBlock, KillExceptionBlock,
+                 PushHandler, PopHandler,
+                 BaseExceptionsThrow, DefaultErrorCatch,
+                 IsInExceptionState, SetExceptionState,
+                 SwitchExceptionState, GetBaseExceptionBlock,
+                 SetExceptionSource, GetExceptionSource ;
+
+TYPE
+   EHBlock ;
+   ProcedureHandler = PROCEDURE ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Raise (number: CARDINAL;
+                 file: ADDRESS; line: CARDINAL;
+                 column: CARDINAL; function: ADDRESS;
+                 message: ADDRESS) ;
+
+
+(*
+   SetExceptionBlock - sets, source, as the active EHB.
+*)
+
+PROCEDURE SetExceptionBlock (source: EHBlock) ;
+
+
+(*
+   GetExceptionBlock - returns the active EHB.
+*)
+
+PROCEDURE GetExceptionBlock () : EHBlock ;
+
+
+(*
+   GetTextBuffer - returns the address of the EHB buffer.
+*)
+
+PROCEDURE GetTextBuffer (e: EHBlock) : ADDRESS ;
+
+
+(*
+   GetTextBufferSize - return the size of the EHB text buffer.
+*)
+
+PROCEDURE GetTextBufferSize (e: EHBlock) : CARDINAL ;
+
+
+(*
+   GetNumber - return the exception number associated with,
+               source.
+*)
+
+PROCEDURE GetNumber (source: EHBlock) : CARDINAL ;
+
+
+(*
+   InitExceptionBlock - creates and returns a new exception block.
+*)
+
+PROCEDURE InitExceptionBlock () : EHBlock ;
+
+
+(*
+   KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*)
+
+PROCEDURE KillExceptionBlock (e: EHBlock) : EHBlock ;
+
+
+(*
+   PushHandler - install a handler in EHB, e.
+*)
+
+PROCEDURE PushHandler (e: EHBlock; number: CARDINAL; p: ProcedureHandler) ;
+
+
+(*
+   PopHandler - removes the handler associated with, number, from
+                EHB, e.
+*)
+
+PROCEDURE PopHandler (e: EHBlock; number: CARDINAL) ;
+
+
+(*
+   DefaultErrorCatch - displays the current error message in
+                       the current exception block and then
+                       calls HALT.
+*)
+
+PROCEDURE DefaultErrorCatch ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE BaseExceptionsThrow ;
+
+
+(*
+   IsInExceptionState - returns TRUE if the program is currently
+                        in the exception state.
+*)
+
+PROCEDURE IsInExceptionState () : BOOLEAN ;
+
+
+(*
+   SetExceptionState - returns the current exception state and
+                       then sets the current exception state to,
+                       to.
+*)
+
+PROCEDURE SetExceptionState (to: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SwitchExceptionState - assigns, from, with the current exception
+                          state and then assigns the current exception
+                          to, to.
+*)
+
+PROCEDURE SwitchExceptionState (VAR from: BOOLEAN; to: BOOLEAN) ;
+
+
+(*
+   GetBaseExceptionBlock - returns the initial language exception block
+                           created.
+*)
+
+PROCEDURE GetBaseExceptionBlock () : EHBlock ;
+
+
+(*
+   SetExceptionSource - sets the current exception source to, source.
+*)
+
+PROCEDURE SetExceptionSource (source: ADDRESS) ;
+
+
+(*
+   GetExceptionSource - returns the current exception source.
+*)
+
+PROCEDURE GetExceptionSource () : ADDRESS ;
+
+
+END RTExceptions.
diff --git a/gcc/m2/gm2-libs/RTExceptions.mod b/gcc/m2/gm2-libs/RTExceptions.mod
new file mode 100644
index 00000000000..9ca0e87884e
--- /dev/null
+++ b/gcc/m2/gm2-libs/RTExceptions.mod
@@ -0,0 +1,835 @@
+(* RTExceptions.mod runtime exception handler routines.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RTExceptions ;
+
+FROM ASCII IMPORT nul, nl ;
+FROM StrLib IMPORT StrLen ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM SYSTEM IMPORT ADR, THROW ;
+FROM libc IMPORT write, strlen ;
+FROM M2RTS IMPORT HALT, Halt ;
+FROM SysExceptions IMPORT InitExceptionHandlers ;
+
+IMPORT M2EXCEPTION ;
+
+
+CONST
+   MaxBuffer = 4096 ;
+
+TYPE
+   Handler = POINTER TO RECORD
+                           p    : ProcedureHandler ;
+                           n    : CARDINAL ;
+                           right,
+                           left,
+                           stack: Handler ;
+                        END ;
+
+   EHBlock = POINTER TO RECORD
+                           buffer  : ARRAY [0..MaxBuffer] OF CHAR ;
+                           number  : CARDINAL ;
+                           handlers: Handler ;
+                           right   : EHBlock ;
+                        END ;
+
+   PtrToChar = POINTER TO CHAR ;
+
+
+VAR
+   inException  : BOOLEAN ;
+   freeHandler  : Handler ;
+   freeEHB,
+   currentEHB   : EHBlock ;
+   currentSource: ADDRESS ;
+
+
+(*
+   SetExceptionSource - sets the current exception source to, source.
+*)
+
+PROCEDURE SetExceptionSource (source: ADDRESS) ;
+BEGIN
+   currentSource := source
+END SetExceptionSource ;
+
+
+(*
+   GetExceptionSource - returns the current exception source.
+*)
+
+PROCEDURE GetExceptionSource () : ADDRESS ;
+BEGIN
+   RETURN currentSource
+END GetExceptionSource ;
+
+
+(*
+   ErrorString - writes a string to stderr.
+*)
+
+PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
+VAR
+   n: INTEGER ;
+BEGIN
+   n := write(2, ADR(a), StrLen(a))
+END ErrorString ;
+
+
+(*
+   findHandler -
+*)
+
+PROCEDURE findHandler (e: EHBlock; number: CARDINAL) : Handler ;
+VAR
+   h: Handler ;
+BEGIN
+   h := e^.handlers^.right ;
+   WHILE (h#e^.handlers) AND (number#h^.n) DO
+      h := h^.right
+   END ;
+   IF h=e^.handlers
+   THEN
+      RETURN( NIL )
+   ELSE
+      RETURN( h )
+   END
+END findHandler ;
+
+
+(*
+   InvokeHandler - invokes the associated handler for the current
+                   exception in the active EHB.
+*)
+
+PROCEDURE InvokeHandler ;
+VAR
+   h: Handler ;
+BEGIN
+   h := findHandler(currentEHB, currentEHB^.number) ;
+   IF h=NIL
+   THEN
+      THROW(GetNumber(GetExceptionBlock()))
+   ELSE
+      h^.p
+   END
+END InvokeHandler ;
+
+
+(*
+   DefaultErrorCatch - displays the current error message in
+                       the current exception block and then
+                       calls HALT.
+*)
+
+PROCEDURE DefaultErrorCatch ;
+VAR
+   e: EHBlock ;
+   n: INTEGER ;
+BEGIN
+   e := GetExceptionBlock() ;
+   n := write(2, GetTextBuffer(e), strlen(GetTextBuffer(e))) ;
+   HALT
+END DefaultErrorCatch ;
+
+
+(*
+   DoThrow - throw the exception number in the exception block.
+*)
+
+PROCEDURE DoThrow ;
+BEGIN
+   THROW(GetNumber(GetExceptionBlock()))
+END DoThrow ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE BaseExceptionsThrow ;
+VAR
+   i: M2EXCEPTION.M2Exceptions ;
+BEGIN
+   FOR i := MIN(M2EXCEPTION.M2Exceptions) TO MAX(M2EXCEPTION.M2Exceptions) DO
+      PushHandler(GetExceptionBlock(), VAL(CARDINAL, i), DoThrow)
+   END
+END BaseExceptionsThrow ;
+
+
+(*
+   addChar - adds, ch, to the current exception handler text buffer
+             at index, i.  The index in then incremented.
+*)
+
+PROCEDURE addChar (ch: CHAR; VAR i: CARDINAL) ;
+BEGIN
+   IF (i<=MaxBuffer) AND (currentEHB#NIL)
+   THEN
+      currentEHB^.buffer[i] := ch ;
+      INC(i)
+   END
+END addChar ;
+
+
+(*
+   stripPath - returns the filename from the path.
+*)
+
+PROCEDURE stripPath (s: ADDRESS) : ADDRESS ;
+VAR
+   f, p: PtrToChar ;
+BEGIN
+   p := s ;
+   f := s ;
+   WHILE p^#nul DO
+      IF p^='/'
+      THEN
+         INC(p) ;
+         f := p
+      ELSE
+         INC(p)
+      END
+   END ;
+   RETURN( f )
+END stripPath ;
+
+
+(*
+   addFile - adds the filename determined by, s, however it strips
+             any preceeding path.
+*)
+
+PROCEDURE addFile (s: ADDRESS; VAR i: CARDINAL) ;
+VAR
+   p: PtrToChar ;
+BEGIN
+   p := stripPath(s) ;
+   WHILE (p#NIL) AND (p^#nul) DO
+      addChar(p^, i) ;
+      INC(p)
+   END
+END addFile ;
+
+
+(*
+   addStr - adds a C string from address, s, into the current
+            handler text buffer.
+*)
+
+PROCEDURE addStr (s: ADDRESS; VAR i: CARDINAL) ;
+VAR
+   p: PtrToChar ;
+BEGIN
+   p := s ;
+   WHILE (p#NIL) AND (p^#nul) DO
+      addChar(p^, i) ;
+      INC(p)
+   END
+END addStr ;
+
+
+(*
+   addNum - adds a number, n, to the current handler
+            text buffer.
+*)
+
+PROCEDURE addNum (n: CARDINAL; VAR i: CARDINAL) ;
+BEGIN
+   IF n<10
+   THEN
+      addChar(CHR(n MOD 10 + ORD('0')), i)
+   ELSE
+      addNum(n DIV 10, i) ;
+      addNum(n MOD 10, i)
+   END
+END addNum ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Raise (number: CARDINAL;
+                 file: ADDRESS; line: CARDINAL;
+                 column: CARDINAL; function: ADDRESS;
+                 message: ADDRESS) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   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 (nl, i) ;
+   addFile (file, i) ;
+   addChar (':', i) ;
+   addNum (line, i) ;
+   addChar (':', i) ;
+   addNum (column, i) ;
+   addChar (':', i) ;
+   addStr (message, i) ;
+   addChar (nl, i) ;
+   addChar (nul, i) ;
+   InvokeHandler
+END Raise ;
+
+
+(*
+   SetExceptionBlock - sets, source, as the active EHB.
+*)
+
+PROCEDURE SetExceptionBlock (source: EHBlock) ;
+BEGIN
+   currentEHB := source
+END SetExceptionBlock ;
+
+
+(*
+   GetExceptionBlock - returns the active EHB.
+*)
+
+PROCEDURE GetExceptionBlock () : EHBlock ;
+BEGIN
+   RETURN( currentEHB )
+END GetExceptionBlock ;
+
+
+(*
+   GetTextBuffer - returns the address of the EHB buffer.
+*)
+
+PROCEDURE GetTextBuffer (e: EHBlock) : ADDRESS ;
+BEGIN
+   RETURN( ADR(e^.buffer) )
+END GetTextBuffer ;
+
+
+(*
+   GetTextBufferSize - return the size of the EHB text buffer.
+*)
+
+PROCEDURE GetTextBufferSize (e: EHBlock) : CARDINAL ;
+BEGIN
+   RETURN SIZE(e^.buffer)
+END GetTextBufferSize ;
+
+
+(*
+   GetNumber - return the exception number associated with,
+               source.
+*)
+
+PROCEDURE GetNumber (source: EHBlock) : CARDINAL ;
+BEGIN
+   RETURN( source^.number )
+END GetNumber ;
+
+
+(*
+   New - returns a new EHBlock.
+*)
+
+PROCEDURE New () : EHBlock ;
+VAR
+   e: EHBlock ;
+BEGIN
+   IF freeEHB=NIL
+   THEN
+      NEW(e)
+   ELSE
+      e := freeEHB ;
+      freeEHB := freeEHB^.right
+   END ;
+   RETURN( e )
+END New ;
+
+
+(*
+   InitExceptionBlock - creates and returns a new exception block.
+*)
+
+PROCEDURE InitExceptionBlock () : EHBlock ;
+VAR
+   e: EHBlock ;
+BEGIN
+   e := New() ;
+   WITH e^ DO
+      number := MAX(CARDINAL) ;
+      handlers := NewHandler() ;   (* add the dummy onto the head *)
+      handlers^.right := handlers ;
+      handlers^.left := handlers ;
+      right := e
+   END ;
+   RETURN( e )
+END InitExceptionBlock ;
+
+
+(*
+   KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*)
+
+PROCEDURE KillExceptionBlock (e: EHBlock) : EHBlock ;
+BEGIN
+   e^.handlers := KillHandlers(e^.handlers) ;
+   e^.right := freeEHB ;
+   freeEHB := e ;
+   RETURN( NIL )
+END KillExceptionBlock ;
+
+
+(*
+   NewHandler - returns a new handler.
+*)
+
+PROCEDURE NewHandler () : Handler ;
+VAR
+   h: Handler ;
+BEGIN
+   IF freeHandler=NIL
+   THEN
+      NEW(h)
+   ELSE
+      h := freeHandler ;
+      freeHandler := freeHandler^.right
+   END ;
+   RETURN( h )
+END NewHandler ;
+
+
+(*
+   KillHandler - returns, NIL, and places, h, onto the free list.
+*)
+
+PROCEDURE KillHandler (h: Handler) : Handler ;
+BEGIN
+   h^.right := freeHandler ;
+   freeHandler := h ;
+   RETURN( NIL )
+END KillHandler ;
+
+
+(*
+   KillHandlers - kills all handlers in the list.
+*)
+
+PROCEDURE KillHandlers (h: Handler) : Handler ;
+BEGIN
+   h^.left^.right := freeHandler ;
+   freeHandler := h ;
+   RETURN( NIL )
+END KillHandlers ;
+
+
+(*
+   InitHandler -
+*)
+
+PROCEDURE InitHandler (h: Handler; l, r, s: Handler; number: CARDINAL; proc: ProcedureHandler) : Handler ;
+BEGIN
+   WITH h^ DO
+      p := proc ;
+      n := number ;
+      right := r ;
+      left := l ;
+      stack := s
+   END ;
+   RETURN( h )
+END InitHandler ;
+
+
+(*
+   SubHandler -
+*)
+
+PROCEDURE SubHandler (h: Handler) ;
+BEGIN
+   h^.right^.left := h^.left ;
+   h^.left^.right := h^.right ;
+END SubHandler ;
+
+
+(*
+   AddHandler - add, e, to the end of the list of handlers.
+*)
+
+PROCEDURE AddHandler (e: EHBlock; h: Handler) ;
+BEGIN
+   h^.right := e^.handlers ;
+   h^.left := e^.handlers^.left ;
+   e^.handlers^.left^.right := h ;
+   e^.handlers^.left := h
+END AddHandler ;
+
+
+(*
+   PushHandler - install a handler in EHB, e.
+*)
+
+PROCEDURE PushHandler (e: EHBlock; number: CARDINAL; p: ProcedureHandler) ;
+VAR
+   h, i: Handler ;
+BEGIN
+   h := findHandler(e, number) ;
+   IF h=NIL
+   THEN
+      i := InitHandler(NewHandler(), NIL, NIL, NIL, number, p) ;
+   ELSE
+      (* remove, h, *)
+      SubHandler(h) ;
+      (* stack it onto a new handler *)
+      i := InitHandler(NewHandler(), NIL, NIL, h, number, p) ;
+   END ;
+   (* add new handler *)
+   AddHandler(e, i)
+END PushHandler ;
+
+
+(*
+   PopHandler - removes the handler associated with, number, from
+                EHB, e.
+*)
+
+PROCEDURE PopHandler (e: EHBlock; number: CARDINAL) ;
+VAR
+   h, i: Handler ;
+BEGIN
+   h := findHandler(e, number) ;
+   IF h#NIL
+   THEN
+      (* remove, h, *)
+      SubHandler(h) ;
+      IF h^.stack#NIL
+      THEN
+         AddHandler(e, h^.stack)
+      END ;
+      h := KillHandler(h)
+   END
+END PopHandler ;
+
+
+(*
+   IsInExceptionState - returns TRUE if the program is currently
+                        in the exception state.
+*)
+
+PROCEDURE IsInExceptionState () : BOOLEAN ;
+BEGIN
+   RETURN( inException )
+END IsInExceptionState ;
+
+
+(*
+   SetExceptionState - returns the current exception state and
+                       then sets the current exception state to,
+                       to.
+*)
+
+PROCEDURE SetExceptionState (to: BOOLEAN) : BOOLEAN ;
+VAR
+   old: BOOLEAN ;
+BEGIN
+   old := inException ;
+   inException := to ;
+   RETURN( old )
+END SetExceptionState ;
+
+
+(*
+   SwitchExceptionState - assigns, from, with the current exception
+                          state and then assigns the current exception
+                          to, to.
+*)
+
+PROCEDURE SwitchExceptionState (VAR from: BOOLEAN; to: BOOLEAN) ;
+BEGIN
+   from := inException ;
+   inException := to
+END SwitchExceptionState ;
+
+
+(*
+   GetBaseExceptionBlock - returns the initial language exception block
+                           created.
+*)
+
+PROCEDURE GetBaseExceptionBlock () : EHBlock ;
+BEGIN
+   IF currentEHB=NIL
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__, 'currentEHB has not been initialized yet')
+   ELSE
+      RETURN( currentEHB )
+   END
+END GetBaseExceptionBlock ;
+
+
+(*
+   indexf - raise an index out of bounds exception.
+*)
+
+PROCEDURE indexf (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.indexException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("array index out of bounds"))
+END indexf ;
+
+
+(*
+   range - raise an assignment out of range exception.
+*)
+
+PROCEDURE range (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.rangeException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("assignment out of range"))
+END range ;
+
+
+(*
+   casef - raise a case selector out of range exception.
+*)
+
+PROCEDURE casef (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.caseSelectException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("case selector out of range"))
+END casef ;
+
+
+(*
+   invalidloc - raise an invalid location exception.
+*)
+
+PROCEDURE invalidloc (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.invalidLocation),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("invalid address referenced"))
+END invalidloc ;
+
+
+(*
+   function - raise a ... function ... exception.  --fixme-- what does this exception catch?
+*)
+
+PROCEDURE function (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.functionException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("... function ... "))  (* --fixme-- what has happened ? *)
+END function ;
+
+
+(*
+   wholevalue - raise an illegal whole value exception.
+*)
+
+PROCEDURE wholevalue (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.wholeValueException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("illegal whole value exception"))
+END wholevalue ;
+
+
+(*
+   wholediv - raise a division by zero exception.
+*)
+
+PROCEDURE wholediv (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.wholeDivException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("illegal whole value exception"))
+END wholediv ;
+
+
+(*
+   realvalue - raise an illegal real value exception.
+*)
+
+PROCEDURE realvalue (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.realValueException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("illegal real value exception"))
+END realvalue ;
+
+
+(*
+   realdiv - raise a division by zero in a real number exception.
+*)
+
+PROCEDURE realdiv (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.realDivException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("real number division by zero exception"))
+END realdiv ;
+
+
+(*
+   complexvalue - raise an illegal complex value exception.
+*)
+
+PROCEDURE complexvalue (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.complexValueException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("illegal complex value exception"))
+END complexvalue ;
+
+
+(*
+   complexdiv - raise a division by zero in a complex number exception.
+*)
+
+PROCEDURE complexdiv (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.complexDivException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("complex number division by zero exception"))
+END complexdiv ;
+
+
+(*
+   protection - raise a protection exception.
+*)
+
+PROCEDURE protection (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.protException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("protection exception"))
+END protection ;
+
+
+(*
+   systemf - raise a system exception.
+*)
+
+PROCEDURE systemf (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.sysException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("system exception"))
+END systemf ;
+
+
+(*
+   coroutine - raise a coroutine exception.
+*)
+
+PROCEDURE coroutine (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.coException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("coroutine exception"))
+END coroutine ;
+
+
+(*
+   exception - raise a exception exception.
+*)
+
+PROCEDURE exception (a: ADDRESS) ;
+BEGIN
+   Raise(ORD(M2EXCEPTION.exException),
+         ADR(__FILE__), __LINE__, __COLUMN__, ADR(__FUNCTION__),
+         ADR("exception exception"))
+END exception ;
+
+
+(*
+   Init - initialises this module.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   inException := FALSE ;
+   freeHandler := NIL ;
+   freeEHB := NIL ;
+   currentEHB := InitExceptionBlock() ;
+   currentSource := NIL ;
+   BaseExceptionsThrow ;
+   InitExceptionHandlers(indexf, range, casef, invalidloc,
+                         function, wholevalue, wholediv,
+                         realvalue, realdiv, complexvalue,
+                         complexdiv, protection, systemf,
+                         coroutine, exception)
+END Init ;
+
+
+(*
+   TidyUp - deallocate memory used by this module.
+*)
+
+PROCEDURE TidyUp ;
+VAR
+   f: Handler ;
+   e: EHBlock ;
+BEGIN
+   IF currentEHB#NIL
+   THEN
+      currentEHB := KillExceptionBlock(currentEHB)
+   END ;
+   WHILE freeHandler#NIL DO
+      f := freeHandler ;
+      freeHandler := freeHandler^.right ;
+      DISPOSE(f)
+   END ;
+   WHILE freeEHB#NIL DO
+      e := freeEHB ;
+      freeEHB := freeEHB^.right ;
+      DISPOSE(e)
+   END
+END TidyUp ;
+
+
+BEGIN
+   Init
+FINALLY
+   TidyUp
+END RTExceptions.
diff --git a/gcc/m2/gm2-libs/RTint.def b/gcc/m2/gm2-libs/RTint.def
new file mode 100644
index 00000000000..54057477476
--- /dev/null
+++ b/gcc/m2/gm2-libs/RTint.def
@@ -0,0 +1,127 @@
+(* RTint.def provides users of the COROUTINES library with the.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE RTint ;
+
+(* Provides users of the COROUTINES library with the
+   ability to create interrupt sources based on
+   file descriptors and timeouts.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   DispatchVector = PROCEDURE (CARDINAL, CARDINAL, ADDRESS) ;
+
+
+(*
+   InitInputVector - returns an interrupt vector which is associated
+                     with the file descriptor, fd.
+*)
+
+PROCEDURE InitInputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitOutputVector - returns an interrupt vector which is associated
+                      with the file descriptor, fd.
+*)
+
+PROCEDURE InitOutputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitTimeVector - returns an interrupt vector associated with
+                    the relative time.
+*)
+
+PROCEDURE InitTimeVector (micro, secs: CARDINAL; pri: CARDINAL) : CARDINAL ;
+
+
+(*
+   ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt
+                     at the new relative time.
+*)
+
+PROCEDURE ReArmTimeVector (vec: CARDINAL; micro, secs: CARDINAL) ;
+
+
+(*
+   GetTimeVector - assigns, micro, and, secs, with the remaining
+                   time before this interrupt will expire.
+                   This value is only updated when a Listen
+                   occurs.
+*)
+
+PROCEDURE GetTimeVector (vec: CARDINAL; VAR micro, secs: CARDINAL) ;
+
+
+(*
+   AttachVector - adds the pointer, p, to be associated with the interrupt
+                  vector. It returns the previous value attached to this
+                  vector.
+*)
+
+PROCEDURE AttachVector (vec: CARDINAL; p: ADDRESS) : ADDRESS ;
+
+
+(*
+   IncludeVector - includes, vec, into the dispatcher list of
+                   possible interrupt causes.
+*)
+
+PROCEDURE IncludeVector (vec: CARDINAL) ;
+
+
+(*
+   ExcludeVector - excludes, vec, from the dispatcher list of
+                   possible interrupt causes.
+*)
+
+PROCEDURE ExcludeVector (vec: CARDINAL) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Listen (untilInterrupt: BOOLEAN;
+                  call: DispatchVector;
+                  pri: CARDINAL) ;
+
+
+(*
+   Init - allows the user to force the initialize order.
+*)
+
+PROCEDURE Init ;
+
+
+END RTint.
diff --git a/gcc/m2/gm2-libs/RTint.mod b/gcc/m2/gm2-libs/RTint.mod
new file mode 100644
index 00000000000..a1682bd906e
--- /dev/null
+++ b/gcc/m2/gm2-libs/RTint.mod
@@ -0,0 +1,847 @@
+(* RTint.mod provides users of the COROUTINES library with the.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE RTint ;
+
+
+FROM M2RTS IMPORT Halt ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM RTco IMPORT select, initSemaphore, wait, signal ;
+FROM COROUTINES IMPORT PROTECTION ;
+FROM libc IMPORT printf, perror ;
+FROM Assertion IMPORT Assert ;
+
+FROM Selective IMPORT InitSet, FdSet, Timeval, InitTime, KillTime, KillSet,
+                      SetOfFd, FdIsSet, GetTime, FdZero, GetTimeOfDay, SetTime,
+                      FdClr;
+
+CONST
+   Microseconds = 1000000 ;
+   DebugTime    = 0 ;
+   Debugging    = FALSE ;
+
+TYPE
+   VectorType = (input, output, time) ;
+   Vector     = POINTER TO RECORD
+                              type    : VectorType ;
+                              priority: CARDINAL ;
+                              arg     : ADDRESS ;
+                              pending,
+                              exists  : Vector ;
+                              no      : CARDINAL ;
+                              File    : INTEGER ;
+                              rel,
+                              abs     : Timeval ;
+                              queued  : BOOLEAN ;
+                           END ;
+
+VAR
+   VecNo      : CARDINAL ;
+   Exists     : Vector ;
+   Pending    : ARRAY [MIN(PROTECTION)..MAX(PROTECTION)] OF Vector ;
+   lock       : INTEGER ;
+   initialized: BOOLEAN ;
+
+
+(*
+   Max - returns the maximum: i or j.
+*)
+
+PROCEDURE Max (i, j: INTEGER) : INTEGER ;
+BEGIN
+   IF i>j
+   THEN
+      RETURN i
+   ELSE
+      RETURN j
+   END
+END Max ;
+
+
+(*
+   Max - returns the minimum: i or j.
+*)
+
+PROCEDURE Min (i, j: INTEGER) : INTEGER ;
+BEGIN
+   IF i<j
+   THEN
+      RETURN i
+   ELSE
+      RETURN j
+   END
+END Min ;
+
+
+(*
+   FindVector - searches the exists list for a vector of type, t,
+                which is associated with file descriptor, fd.
+*)
+
+PROCEDURE FindVector (fd: INTEGER; t: VectorType) : Vector ;
+VAR
+   v: Vector ;
+BEGIN
+   v := Exists ;
+   WHILE v#NIL DO
+      IF (v^.type=t) AND (v^.File=fd)
+      THEN
+         RETURN v
+      END ;
+      v := v^.exists
+   END ;
+   RETURN NIL
+END FindVector ;
+
+
+(*
+   InitInputVector - returns an interrupt vector which is associated
+                     with the file descriptor, fd.
+*)
+
+PROCEDURE InitInputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
+VAR
+   v: Vector ;
+BEGIN
+   IF Debugging
+   THEN
+      printf("InitInputVector fd = %d priority = %d\n", fd, pri)
+   END ;
+   wait (lock) ;
+   v := FindVector(fd, input) ;
+   IF v=NIL
+   THEN
+      NEW(v) ;
+      INC(VecNo) ;
+      WITH v^ DO
+         type     := input ;
+         priority := pri ;
+         arg      := NIL ;
+         pending  := NIL ;
+         exists   := Exists ;
+         no       := VecNo ;
+         File     := fd
+      END ;
+      Exists := v ;
+      signal (lock) ;
+      RETURN VecNo
+   ELSE
+      signal (lock) ;
+      RETURN v^.no
+   END
+END InitInputVector ;
+
+
+(*
+   InitOutputVector - returns an interrupt vector which is associated
+                      with the file descriptor, fd.
+*)
+
+PROCEDURE InitOutputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
+VAR
+   v: Vector ;
+BEGIN
+   wait (lock) ;
+   v := FindVector (fd, output) ;
+   IF v=NIL
+   THEN
+      NEW (v) ;
+      IF v = NIL
+      THEN
+         HALT
+      ELSE
+         INC (VecNo) ;
+         WITH v^ DO
+            type     := output ;
+            priority := pri ;
+            arg      := NIL ;
+            pending  := NIL ;
+            exists   := Exists ;
+            no       := VecNo ;
+            File     := fd
+         END ;
+         Exists := v ;
+         signal (lock) ;
+         RETURN VecNo
+      END
+   ELSE
+      signal (lock) ;
+      RETURN v^.no
+   END
+END InitOutputVector ;
+
+
+(*
+   InitTimeVector - returns an interrupt vector associated with
+                    the relative time.
+*)
+
+PROCEDURE InitTimeVector (micro, secs: CARDINAL; pri: CARDINAL) : CARDINAL ;
+VAR
+   v: Vector ;
+BEGIN
+   wait (lock) ;
+   NEW (v) ;
+   IF v = NIL
+   THEN
+      HALT
+   ELSE
+      INC (VecNo) ;
+      Assert (micro<Microseconds) ;
+      WITH v^ DO
+         type     := time ;
+         priority := pri ;
+         arg      := NIL ;
+         pending  := NIL ;
+         exists   := Exists ;
+         no       := VecNo ;
+         rel      := InitTime(secs+DebugTime, micro) ;
+         abs      := InitTime(0, 0) ;
+         queued   := FALSE
+      END ;
+      Exists := v
+   END ;
+   signal (lock) ;
+   RETURN VecNo
+END InitTimeVector ;
+
+
+(*
+   FindVectorNo - searches the Exists list for vector, vec.
+*)
+
+PROCEDURE FindVectorNo (vec: CARDINAL) : Vector ;
+VAR
+   v: Vector ;
+BEGIN
+   v := Exists ;
+   WHILE (v#NIL) AND (v^.no#vec) DO
+      v := v^.exists
+   END ;
+   RETURN v
+END FindVectorNo ;
+
+
+(*
+   FindPendingVector - searches the pending list for vector, vec.
+*)
+
+PROCEDURE FindPendingVector (vec: CARDINAL) : Vector ;
+VAR
+   i: CARDINAL ;
+   v: Vector ;
+BEGIN
+   FOR i := MIN(PROTECTION) TO MAX(PROTECTION) DO
+      v := Pending[i] ;
+      WHILE (v#NIL) AND (v^.no#vec) DO
+         v := v^.pending
+      END ;
+      IF (v#NIL) AND (v^.no=vec)
+      THEN
+         RETURN v
+      END
+   END ;
+   RETURN NIL
+END FindPendingVector ;
+
+
+(*
+   ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt
+                     at the new relative time.
+*)
+
+PROCEDURE ReArmTimeVector (vec: CARDINAL;
+                           micro, secs: CARDINAL) ;
+VAR
+   v: Vector ;
+BEGIN
+   Assert(micro<Microseconds) ;
+   wait (lock) ;
+   v := FindVectorNo(vec) ;
+   IF v=NIL
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__,
+           'cannot find vector supplied')
+   ELSE
+      WITH v^ DO
+         SetTime (rel, secs + DebugTime, micro)
+      END
+   END ;
+   signal (lock)
+END ReArmTimeVector ;
+
+
+(*
+   GetTimeVector - assigns, micro, and, secs, with the remaining
+                   time before this interrupt will expire.
+                   This value is only updated when a Listen
+                   occurs.
+*)
+
+PROCEDURE GetTimeVector (vec: CARDINAL; VAR micro, secs: CARDINAL) ;
+VAR
+   v: Vector ;
+BEGIN
+   wait (lock) ;
+   v := FindVectorNo (vec) ;
+   IF v=NIL
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__,
+           'cannot find vector supplied')
+   ELSE
+      WITH v^ DO
+         GetTime (rel, secs, micro) ;
+         Assert (micro < Microseconds)
+      END
+   END ;
+   signal (lock)
+END GetTimeVector ;
+
+
+(*
+   AttachVector - adds the pointer, p, to be associated with the interrupt
+                  vector. It returns the previous value attached to this
+                  vector.
+*)
+
+PROCEDURE AttachVector (vec: CARDINAL; p: ADDRESS) : ADDRESS ;
+VAR
+   v: Vector ;
+   l: ADDRESS ;
+BEGIN
+   wait (lock) ;
+   v := FindVectorNo (vec) ;
+   IF v=NIL
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__, 'cannot find vector supplied')
+   ELSE
+      l := v^.arg ;
+      v^.arg := p ;
+      IF Debugging
+      THEN
+         printf ("AttachVector %d with 0x%x\n", vec, p);
+         DumpPendingQueue ;
+      END ;
+      signal (lock) ;
+      RETURN l
+   END
+END AttachVector ;
+
+
+(*
+   IncludeVector - includes, vec, into the dispatcher list of
+                   possible interrupt causes.
+*)
+
+PROCEDURE IncludeVector (vec: CARDINAL) ;
+VAR
+   v   : Vector ;
+   m, s: CARDINAL ;
+   r   : INTEGER ;
+BEGIN
+   wait (lock) ;
+   v := FindPendingVector (vec) ;
+   IF v=NIL
+   THEN
+      v := FindVectorNo (vec) ;
+      IF v = NIL
+      THEN
+         Halt (__FILE__, __LINE__, __FUNCTION__,
+               'cannot find vector supplied') ;
+      ELSE
+         (* printf('including vector %d  (fd = %d)\n', vec, v^.File) ; *)
+         v^.pending := Pending[v^.priority] ;
+         Pending[v^.priority] := v ;
+         IF (v^.type = time) AND (NOT v^.queued)
+         THEN
+            v^.queued := TRUE ;
+            r := GetTimeOfDay (v^.abs) ;
+            Assert (r=0) ;
+            GetTime (v^.abs, s, m) ;
+            Assert (m<Microseconds) ;
+            AddTime (v^.abs, v^.rel) ;
+            GetTime (v^.abs, s, m) ;
+            Assert (m<Microseconds)
+         END
+      END
+   ELSE
+      IF Debugging
+      THEN
+         printf ('odd vector (%d) type (%d) arg (0x%x) is already attached to the pending queue\n',
+                 vec, v^.type, v^.arg)
+      END ;
+      stop
+   END ;
+   signal (lock)
+END IncludeVector ;
+
+
+(*
+   ExcludeVector - excludes, vec, from the dispatcher list of
+                   possible interrupt causes.
+*)
+
+PROCEDURE ExcludeVector (vec: CARDINAL) ;
+VAR
+   v, u: Vector ;
+BEGIN
+   wait (lock) ;
+   v := FindPendingVector(vec) ;
+   IF v=NIL
+   THEN
+      Halt (__FILE__, __LINE__, __FUNCTION__,
+            'cannot find pending vector supplied')
+   ELSE
+      (* printf('excluding vector %d\n', vec) ; *)
+      IF Pending[v^.priority]=v
+      THEN
+         Pending[v^.priority] := Pending[v^.priority]^.pending
+      ELSE
+         u := Pending[v^.priority] ;
+         WHILE u^.pending#v DO
+            u := u^.pending
+         END ;
+         u^.pending := v^.pending
+      END ;
+      IF v^.type=time
+      THEN
+         v^.queued := FALSE
+      END
+   END ;
+   signal (lock)
+END ExcludeVector ;
+
+
+(*
+   AddFd - adds the file descriptor, fd, to set, s, updating, max.
+*)
+
+PROCEDURE AddFd (VAR s: SetOfFd; VAR max: INTEGER; fd: INTEGER) ;
+BEGIN
+   max := Max (fd, max) ;
+   IF s = NIL
+   THEN
+      s := InitSet () ;
+      FdZero (s)
+   END ;
+   FdSet (fd, s)
+   (* printf('%d, ', fd) *)
+END AddFd ;
+
+
+(*
+   DumpPendingQueue - displays the pending queue.
+*)
+
+PROCEDURE DumpPendingQueue ;
+VAR
+   p   : PROTECTION ;
+   v   : Vector ;
+   s, m: CARDINAL ;
+BEGIN
+   printf ("Pending queue\n");
+   FOR p := MIN (PROTECTION) TO MAX (PROTECTION) DO
+      printf ("[%d]  ", p);
+      v := Pending[p] ;
+      WHILE v#NIL DO
+         IF (v^.type=input) OR (v^.type=output)
+         THEN
+            printf ("(fd=%d) (vec=%d)", v^.File, v^.no)
+         ELSIF v^.type=time
+         THEN
+            GetTime(v^.rel, s, m) ;
+            Assert (m<Microseconds) ;
+            printf ("time (%u.%06u secs) (arg = 0x%x)\n", s, m, v^.arg)
+         END ;
+         v := v^.pending
+      END ;
+      printf (" \n")
+   END
+END DumpPendingQueue ;
+
+
+PROCEDURE stop ;
+BEGIN
+END stop ;
+
+
+(*
+   AddTime - t1 := t1 + t2
+*)
+
+PROCEDURE AddTime (t1, t2: Timeval) ;
+VAR
+   a, b, s, m: CARDINAL ;
+BEGIN
+   GetTime (t1, s, m) ;
+   Assert (m < Microseconds) ;
+   GetTime (t2, a, b) ;
+   Assert (b < Microseconds) ;
+   INC (a, s) ;
+   INC (b, m) ;
+   IF b >= Microseconds
+   THEN
+      DEC (b, Microseconds) ;
+      INC (a)
+   END ;
+   SetTime (t1, a, b)
+END AddTime ;
+
+
+(*
+   IsGreaterEqual - returns TRUE if, a>=b
+*)
+
+PROCEDURE IsGreaterEqual (a, b: Timeval) : BOOLEAN ;
+VAR
+   as, am, bs, bm: CARDINAL ;
+BEGIN
+   GetTime (a, as, am) ;
+   Assert (am < Microseconds) ;
+   GetTime (b, bs, bm) ;
+   Assert (bm < Microseconds) ;
+   RETURN (as > bs) OR ((as = bs) AND (am >= bm))
+END IsGreaterEqual ;
+
+
+(*
+   SubTime - assigns, s and m, to a - b.
+*)
+
+PROCEDURE SubTime (VAR s, m: CARDINAL; a, b: Timeval) ;
+VAR
+   as, am,
+   bs, bm: CARDINAL ;
+BEGIN
+   GetTime (a, as, am) ;
+   Assert (am < Microseconds) ;
+   GetTime (b, bs, bm) ;
+   Assert (bm < Microseconds) ;
+   IF IsGreaterEqual (a, b)
+   THEN
+      s := as - bs ;
+      IF am >= bm
+      THEN
+         m := am - bm ;
+         Assert (m < Microseconds) ;
+      ELSE
+         Assert (s > 0) ;
+         DEC (s) ;
+         m := (Microseconds + am) - bm ;
+         Assert (m < Microseconds)
+      END
+   ELSE
+      s := 0 ;
+      m := 0
+   END
+END SubTime ;
+
+
+(*
+   activatePending - activates the first interrupt pending and clears it.
+*)
+
+PROCEDURE activatePending (untilInterrupt: BOOLEAN; call: DispatchVector; pri: CARDINAL;
+                           maxFd: INTEGER; VAR i, o: SetOfFd; VAR t: Timeval; b4, after: Timeval) : BOOLEAN ;
+VAR
+   r   : INTEGER ;
+   p   : CARDINAL ;
+   v   : Vector ;
+   b4s,
+   b4m,
+   afs,
+   afm,
+   s, m: CARDINAL ;
+BEGIN
+   wait (lock) ;
+   p := MAX (PROTECTION) ;
+   WHILE p > pri DO
+      v := Pending[p] ;
+      WHILE v # NIL DO
+         WITH v^ DO
+            CASE type OF
+
+            input :  IF (File < maxFd) AND (i # NIL) AND FdIsSet (File, i)
+                     THEN
+                        IF Debugging
+                        THEN
+                           printf ('read (fd=%d) is ready (vec=%d)\n', File, no) ;
+                           DumpPendingQueue
+                        END ;
+                        FdClr (File, i) ;  (* so we dont activate this again from our select.  *)
+                        signal (lock) ;
+                        call (no, priority, arg) ;
+                        RETURN TRUE
+                     END |
+            output:  IF (File < maxFd) AND (o#NIL) AND FdIsSet (File, o)
+                     THEN
+                        IF Debugging
+                        THEN
+                           printf ('write (fd=%d) is ready (vec=%d)\n', File, no) ;
+                           DumpPendingQueue
+                        END ;
+                        FdClr (File, o) ;  (* so we dont activate this again from our select.  *)
+                        signal (lock) ;
+                        call (no, priority, arg) ;
+                        RETURN TRUE
+                     END |
+            time  :  IF untilInterrupt AND (t # NIL)
+                     THEN
+                        r := GetTimeOfDay (after) ;
+                        Assert (r=0) ;
+                        IF Debugging
+                        THEN
+                           GetTime (t, s, m) ;
+                           Assert (m < Microseconds) ;
+                           GetTime (after, afs, afm) ;
+                           Assert (afm < Microseconds) ;
+                           GetTime (b4, b4s, b4m) ;
+                           Assert (b4m < Microseconds) ;
+                           printf ("waited %u.%06u + %u.%06u now is %u.%06u\n",
+                                   s, m, b4s, b4m, afs, afm) ;
+                        END ;
+                        IF IsGreaterEqual (after, abs)
+                        THEN
+                           IF Debugging
+                           THEN
+                              DumpPendingQueue ;
+                              printf ("time has expired calling dispatcher\n")
+                           END ;
+                           t := KillTime (t) ;  (* so we dont activate this again from our select.  *)
+                           signal (lock) ;
+                           IF Debugging
+                           THEN
+                              printf ("call (%d, %d, 0x%x)\n", no, priority, arg)
+                           END ;
+                           call (no, priority, arg) ;
+                           RETURN TRUE
+                        ELSIF Debugging
+                        THEN
+                           printf ("must wait longer as time has not expired\n")
+                        END
+                     END
+            END
+         END ;
+         v := v^.pending
+      END ;
+      DEC (p)
+   END ;
+   signal (lock) ;
+   RETURN FALSE
+END activatePending ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Listen (untilInterrupt: BOOLEAN;
+                  call: DispatchVector;
+                  pri: CARDINAL) ;
+VAR
+   found: BOOLEAN ;
+   r    : INTEGER ;
+   after,
+   b4,
+   t    : Timeval ;
+   v    : Vector ;
+   i, o : SetOfFd ;
+   b4s,
+   b4m,
+   afs,
+   afm,
+   s, m : CARDINAL ;
+   maxFd: INTEGER ;
+   p    : CARDINAL ;
+BEGIN
+   wait (lock) ;
+   IF pri < MAX (PROTECTION)
+   THEN
+      IF Debugging
+      THEN
+         DumpPendingQueue
+      END ;
+      maxFd := -1 ;
+      t := NIL ;
+      i := NIL ;
+      o := NIL ;
+      t := InitTime (MAX (INTEGER), 0) ;
+      p := MAX (PROTECTION) ;
+      found := FALSE ;
+      WHILE p>pri DO
+         v := Pending[p] ;
+         WHILE v#NIL DO
+            WITH v^ DO
+               CASE type OF
+
+               input :  AddFd (i, maxFd, File) |
+               output:  AddFd (o, maxFd, File) |
+               time  :  IF IsGreaterEqual (t, abs)
+                        THEN
+                           GetTime (abs, s, m) ;
+                           Assert (m<Microseconds) ;
+                           IF Debugging
+                           THEN
+                              printf ("shortest delay is %u.%06u\n", s, m)
+                           END ;
+                           SetTime (t, s, m) ;
+                           found := TRUE
+                        END
+
+               END
+            END ;
+            v := v^.pending
+         END ;
+         DEC (p)
+      END ;
+      IF NOT untilInterrupt
+      THEN
+         SetTime (t, 0, 0)
+      END ;
+      IF untilInterrupt AND (i=NIL) AND (o=NIL) AND (NOT found)
+      THEN
+         Halt (__FILE__, __LINE__, __FUNCTION__,
+               'deadlock found, no more processes to run and no interrupts active')
+      END ;
+      (* printf('timeval = 0x%x\n', t) ; *)
+      (* printf('}\n') ; *)
+      IF (NOT found) AND (maxFd=-1) AND (i=NIL) AND (o=NIL)
+      THEN
+         (* no file descriptors to be selected upon.  *)
+         t := KillTime (t) ;
+         signal (lock) ;
+         RETURN
+      ELSE
+         GetTime (t, s, m) ;
+         Assert (m<Microseconds) ;
+         b4 := InitTime (0, 0) ;
+         after := InitTime (0, 0) ;
+         r := GetTimeOfDay (b4) ;
+         Assert (r=0) ;
+         SubTime (s, m, t, b4) ;
+         SetTime (t, s, m) ;
+         IF Debugging
+         THEN
+            printf ("select waiting for %u.%06u seconds\n", s, m)
+         END ;
+         signal (lock) ;
+         REPEAT
+            IF Debugging
+            THEN
+               printf ("select (.., .., .., %u.%06u)\n", s, m)
+            END ;
+            r := select (maxFd+1, i, o, NIL, t) ;
+            IF r=-1
+            THEN
+               perror ("select") ;
+               r := select (maxFd+1, i, o, NIL, NIL) ;
+               IF r=-1
+               THEN
+                  perror ("select timeout argument is faulty")
+               END ;
+               r := select (maxFd+1, i, NIL, NIL, t) ;
+               IF r=-1
+               THEN
+                  perror ("select output fd argument is faulty")
+               END ;
+               r := select (maxFd+1, NIL, o, NIL, t) ;
+               IF r=-1
+               THEN
+                  perror ("select input fd argument is faulty")
+               ELSE
+                  perror ("select maxFD+1 argument is faulty")
+               END
+            END
+         UNTIL r#-1
+      END ;
+      WHILE activatePending (untilInterrupt, call, pri,
+                             maxFd+1, i, o, t, b4, after) DO
+      END ;
+      IF t#NIL
+      THEN
+         t := KillTime (t)
+      END ;
+      IF after#NIL
+      THEN
+         t := KillTime (after)
+      END ;
+      IF b4#NIL
+      THEN
+         t := KillTime (b4)
+      END ;
+      IF i#NIL
+      THEN
+         i := KillSet (i)
+      END ;
+      IF o#NIL
+      THEN
+         o := KillSet (o)
+      END
+   END ;
+   signal (lock)
+END Listen ;
+
+
+(*
+   init -
+*)
+
+PROCEDURE init ;
+VAR
+   p: PROTECTION ;
+BEGIN
+   lock := initSemaphore (1) ;
+   wait (lock) ;
+   Exists := NIL ;
+   FOR p := MIN(PROTECTION) TO MAX(PROTECTION) DO
+      Pending[p] := NIL
+   END ;
+   initialized := TRUE ;
+   signal (lock)
+END init ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   IF NOT initialized
+   THEN
+      init
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END RTint.
diff --git a/gcc/m2/gm2-libs/SArgs.def b/gcc/m2/gm2-libs/SArgs.def
new file mode 100644
index 00000000000..cf8164ff905
--- /dev/null
+++ b/gcc/m2/gm2-libs/SArgs.def
@@ -0,0 +1,51 @@
+(* SArgs.def provides a String interface to the command line arguments.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE SArgs ;
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED GetArg, Narg ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE GetArg (VAR s: String ; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line.
+*)
+
+PROCEDURE Narg() : CARDINAL ;
+
+
+END SArgs.
diff --git a/gcc/m2/gm2-libs/SArgs.mod b/gcc/m2/gm2-libs/SArgs.mod
new file mode 100644
index 00000000000..3e167bf6736
--- /dev/null
+++ b/gcc/m2/gm2-libs/SArgs.mod
@@ -0,0 +1,91 @@
+(* SArgs.mod provides a String interface to the command line arguments.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SArgs ;
+
+FROM SYSTEM IMPORT TSIZE, ADDRESS ;
+FROM UnixArgs IMPORT GetArgC, GetArgV ;
+
+FROM DynamicStrings IMPORT InitStringCharStar,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+TYPE
+   PtrToChar      = POINTER TO CHAR ;
+   PtrToPtrToChar = POINTER TO PtrToChar ;
+
+(*
+#undef GM2_DEBUG_SARGS
+if defined(GM2_DEBUG_SARGS)
+#  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
+*)
+
+
+(*
+   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.
+*)
+
+PROCEDURE GetArg (VAR s: String; n: CARDINAL) : BOOLEAN ;
+VAR
+   i  : INTEGER ;
+   ppc: PtrToPtrToChar ;
+BEGIN
+   i := VAL (INTEGER, n) ;
+   IF i < GetArgC ()
+   THEN
+      (* ppc := ADDRESS (VAL (PtrToPtrToChar, ArgV) + (i * CARDINAL (TSIZE(PtrToChar)))) ; *)
+      ppc := ADDRESS (PtrToChar (GetArgV ()) + (n * TSIZE (PtrToChar))) ;
+      s   := InitStringCharStar (ppc^) ;
+
+      RETURN TRUE
+   ELSE
+      s := NIL ;
+      RETURN FALSE
+   END ;
+END GetArg ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line.
+*)
+
+PROCEDURE Narg () : CARDINAL ;
+BEGIN
+   RETURN GetArgC ()
+END Narg ;
+
+
+END SArgs.
diff --git a/gcc/m2/gm2-libs/SCmdArgs.def b/gcc/m2/gm2-libs/SCmdArgs.def
new file mode 100644
index 00000000000..bf24980dc62
--- /dev/null
+++ b/gcc/m2/gm2-libs/SCmdArgs.def
@@ -0,0 +1,51 @@
+(* SCmdArgs.def provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE SCmdArgs ;
+
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED GetArg, Narg ;
+
+
+(*
+   GetArg - returns the nth argument from the command line, CmdLine
+            the success of the operation is returned.
+*)
+
+PROCEDURE GetArg (CmdLine: String;
+                  n: CARDINAL; VAR Argi: String) : BOOLEAN ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line, CmdLine.
+*)
+
+PROCEDURE Narg (CmdLine: String) : CARDINAL ;
+
+
+END SCmdArgs.
diff --git a/gcc/m2/gm2-libs/SCmdArgs.mod b/gcc/m2/gm2-libs/SCmdArgs.mod
new file mode 100644
index 00000000000..a1c9f3c57ae
--- /dev/null
+++ b/gcc/m2/gm2-libs/SCmdArgs.mod
@@ -0,0 +1,211 @@
+(* SCmdArgs.mod provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SCmdArgs ;
+
+FROM ASCII IMPORT cr, nul ;
+FROM DynamicStrings IMPORT Length, Slice, char ;
+
+CONST
+   esc    = '\' ;
+   space  = ' ' ;
+   squote = "'" ;
+   dquote = '"' ;
+   tab    = ' ' ;
+
+
+(*
+   isWhite -
+*)
+
+PROCEDURE isWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch=space) OR (ch=tab)
+END isWhite ;
+
+
+(*
+   skipWhite -
+*)
+
+PROCEDURE skipWhite (s: String; i, e: INTEGER) : INTEGER ;
+VAR
+   ch: CHAR ;
+BEGIN
+   WHILE i<e DO
+      ch := char(s, i) ;
+      IF isWhite(ch)
+      THEN
+         INC(i)
+      ELSE
+         RETURN( i )
+      END
+   END ;
+   RETURN( i )
+END skipWhite ;
+
+
+(*
+   skipOverWhite -
+*)
+
+PROCEDURE skipOverWhite (s: String; start, end: INTEGER) : INTEGER ;
+BEGIN
+   INC(start) ;
+   WHILE (start<end) AND (NOT isWhite(char(s, start))) DO
+      INC(start)
+   END ;
+   RETURN( start )
+END skipOverWhite ;
+
+
+(*
+   skipOver -
+*)
+
+PROCEDURE skipOver (s: String; start, end: INTEGER; ch: CHAR) : INTEGER ;
+BEGIN
+   INC(start) ;
+   WHILE (start<end) AND (char(s, start)#ch) DO
+      INC(start)
+   END ;
+   RETURN( start )
+END skipOver ;
+
+
+(*
+   skipNextArg -
+*)
+
+PROCEDURE skipNextArg (s: String; start, end: INTEGER) : INTEGER ;
+VAR
+   ch: CHAR ;
+BEGIN
+   IF start<end
+   THEN
+      ch := char(s, start) ;
+      IF ch=dquote
+      THEN
+         end := skipOver(s, start, end, dquote)
+      ELSIF ch=squote
+      THEN
+         end := skipOver(s, start, end, squote)
+      ELSE
+         end := skipOverWhite(s, start, end)
+      END
+   END ;
+   RETURN( end )
+END skipNextArg ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE GetArg (CmdLine: String;
+                  n: CARDINAL; VAR Argi: String) : BOOLEAN ;
+VAR
+   i         : CARDINAL ;
+   sn,
+   start, end: INTEGER ;
+   ch        : CHAR ;
+BEGIN
+   i := 0 ;
+   start := 0 ;
+   end := Length(CmdLine) ;
+   WHILE i<n DO
+      start := skipWhite(CmdLine, start, end) ;
+      sn := skipNextArg(CmdLine, start, end) ;
+      IF sn<end
+      THEN
+         start := sn ;
+         INC(i)
+      ELSE
+         RETURN( FALSE )
+      END
+   END ;
+   start := skipWhite(CmdLine, start, end) ;
+   sn := skipNextArg(CmdLine, start, end) ;
+   Argi := Slice(CmdLine, start, sn) ;
+   RETURN( TRUE )
+END GetArg ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line, CmdLine.
+*)
+
+PROCEDURE Narg (CmdLine: String) : CARDINAL ;
+VAR
+   n         : CARDINAL ;
+   s,
+   start, end: INTEGER ;
+BEGIN
+   n := 0 ;
+   start := 0 ;
+   end := Length(CmdLine) ;
+   LOOP
+      start := skipWhite(CmdLine, start, end) ;
+      s := skipNextArg(CmdLine, start, end) ;
+      IF s<end
+      THEN
+         start := s ;
+         INC(n)
+      ELSE
+         RETURN( n )
+      END
+   END
+END Narg ;
+
+
+PROCEDURE Escape (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( ch=esc )
+END Escape ;
+
+
+PROCEDURE Space (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( (ch=space) OR (ch=tab) )
+END Space ;
+
+
+PROCEDURE DoubleQuote (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( ch=dquote )
+END DoubleQuote ;
+
+
+PROCEDURE SingleQuote (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( ch=squote )
+END SingleQuote ;
+
+
+END SCmdArgs.
diff --git a/gcc/m2/gm2-libs/SEnvironment.def b/gcc/m2/gm2-libs/SEnvironment.def
new file mode 100644
index 00000000000..7a15e3594aa
--- /dev/null
+++ b/gcc/m2/gm2-libs/SEnvironment.def
@@ -0,0 +1,54 @@
+(* SEnvironment.def provides access to the environment of a process.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE SEnvironment ;
+
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED GetEnvironment ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE GetEnvironment (Env: String;
+                          VAR dest: String) : BOOLEAN ;
+
+
+(*
+   PutEnvironment - change or add an environment variable definition EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*)
+
+PROCEDURE PutEnvironment (EnvDef: String) : BOOLEAN ;
+
+
+END SEnvironment.
diff --git a/gcc/m2/gm2-libs/SEnvironment.mod b/gcc/m2/gm2-libs/SEnvironment.mod
new file mode 100644
index 00000000000..853f3a2abe4
--- /dev/null
+++ b/gcc/m2/gm2-libs/SEnvironment.mod
@@ -0,0 +1,90 @@
+(* SEnvironment.mod provides access to the environment of a process.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SEnvironment ;
+
+FROM DynamicStrings IMPORT string, InitStringCharStar,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+FROM libc IMPORT getenv, putenv ;
+
+(*
+#undef GM2_DEBUG_SENVIRONMENT
+if defined(GM2_DEBUG_SENVIRONMENT)
+#  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
+*)
+
+
+(*
+   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.
+*)
+
+PROCEDURE GetEnvironment (Env: String;
+                          VAR dest: String) : BOOLEAN ;
+VAR
+   Addr: POINTER TO CHAR ;
+BEGIN
+   IF Env=NIL
+   THEN
+      dest := NIL ;
+      RETURN FALSE
+   ELSE
+      Addr := getenv (string (Env)) ;
+      IF Addr=NIL
+      THEN
+         dest := NIL ;
+         RETURN FALSE
+      ELSE
+         dest := InitStringCharStar (Addr) ;
+         RETURN TRUE
+      END
+   END
+END GetEnvironment ;
+
+
+(*
+   PutEnvironment - change or add an environment variable definition EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*)
+
+PROCEDURE PutEnvironment (EnvDef: String) : BOOLEAN ;
+BEGIN
+   RETURN putenv (string (EnvDef)) = 0
+END PutEnvironment ;
+
+
+END SEnvironment.
diff --git a/gcc/m2/gm2-libs/SFIO.def b/gcc/m2/gm2-libs/SFIO.def
new file mode 100644
index 00000000000..95b270c73f6
--- /dev/null
+++ b/gcc/m2/gm2-libs/SFIO.def
@@ -0,0 +1,94 @@
+(* SFIO.def provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE SFIO ;
+
+FROM DynamicStrings IMPORT String ;
+FROM FIO IMPORT File ;
+
+EXPORT QUALIFIED OpenToRead, OpenToWrite, OpenForRandom, Exists, WriteS, ReadS ;
+
+
+(*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*)
+
+PROCEDURE Exists (fname: String) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OpenToRead (fname: String) : File ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OpenToWrite (fname: String) : File ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OpenForRandom (fname: String; towrite, newfile: BOOLEAN) : File ;
+
+
+(*
+   WriteS - writes a string, s, to, file. It returns the String, s.
+*)
+
+PROCEDURE WriteS (file: File; s: String) : String ;
+
+
+(*
+   ReadS - reads a string, s, from, file. It returns the String, s.
+           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.
+*)
+
+PROCEDURE ReadS (file: File) : String ;
+
+
+END SFIO.
diff --git a/gcc/m2/gm2-libs/SFIO.mod b/gcc/m2/gm2-libs/SFIO.mod
new file mode 100644
index 00000000000..c568f7e8db6
--- /dev/null
+++ b/gcc/m2/gm2-libs/SFIO.mod
@@ -0,0 +1,148 @@
+(* SFIO.mod provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SFIO ;
+
+FROM ASCII IMPORT nul ;
+
+FROM DynamicStrings IMPORT string, Length, InitString, ConCatChar,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+FROM FIO IMPORT exists, openToRead, openToWrite, openForRandom, WriteNBytes, ReadChar,
+                EOLN, EOF, IsNoError ;
+
+(*
+#undef GM2_DEBUG_SFIO
+#if defined(GM2_DEBUG_SFIO)
+#  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
+*)
+
+
+(*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*)
+
+PROCEDURE Exists (fname: String) : BOOLEAN ;
+BEGIN
+   RETURN exists (string (fname), Length (fname))
+END Exists ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OpenToRead (fname: String) : File ;
+BEGIN
+   RETURN openToRead (string (fname), Length (fname))
+END OpenToRead ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OpenToWrite (fname: String) : File ;
+BEGIN
+   RETURN openToWrite (string (fname), Length (fname))
+END OpenToWrite ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE OpenForRandom (fname: String; towrite, newfile: BOOLEAN) : File ;
+BEGIN
+   RETURN openForRandom (string (fname), Length (fname), towrite, newfile)
+END OpenForRandom ;
+
+
+(*
+   WriteS - writes a string, s, to, file. It returns the String, s.
+*)
+
+PROCEDURE WriteS (file: File; s: String) : String ;
+VAR
+   nBytes: CARDINAL ;
+BEGIN
+   IF s#NIL
+   THEN
+      nBytes := WriteNBytes(file, Length(s), string(s))
+   END ;
+   RETURN( s )
+END WriteS ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ReadS (file: File) : String ;
+VAR
+   s: String ;
+   c: CARDINAL ;
+BEGIN
+   s := InitString ('') ;
+   WHILE (NOT EOLN (file)) AND (NOT EOF (file)) AND IsNoError (file) DO
+      s := ConCatChar (s, ReadChar (file))
+   END ;
+   IF EOLN (file)
+   THEN
+      (* consume nl *)
+      IF ReadChar (file) = nul
+      THEN
+      END
+   END ;
+   RETURN s
+END ReadS ;
+
+
+END SFIO.
diff --git a/gcc/m2/gm2-libs/SMathLib0.def b/gcc/m2/gm2-libs/SMathLib0.def
new file mode 100644
index 00000000000..24a407f52c1
--- /dev/null
+++ b/gcc/m2/gm2-libs/SMathLib0.def
@@ -0,0 +1,44 @@
+(* SMathLib0.def provide access to the SHORTREAL instrinics.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE SMathLib0 ;
+
+CONST
+   pi   = 3.1415926535897932384626433832795028841972;
+   exp1 = 2.7182818284590452353602874713526624977572;
+
+
+PROCEDURE __BUILTIN__ sqrt (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE exp (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE ln (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ sin (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ cos (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE tan (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE arctan (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE entier (x: SHORTREAL) : INTEGER ;
+
+
+END SMathLib0.
diff --git a/gcc/m2/gm2-libs/SMathLib0.mod b/gcc/m2/gm2-libs/SMathLib0.mod
new file mode 100644
index 00000000000..2cdfa7fb887
--- /dev/null
+++ b/gcc/m2/gm2-libs/SMathLib0.mod
@@ -0,0 +1,81 @@
+(* SMathLib0.mod provide access to the SHORTREAL instrinics.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SMathLib0 ;
+
+IMPORT cbuiltin, libm ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sqrtf)) sqrt (x: SHORTREAL): SHORTREAL;
+BEGIN
+   RETURN cbuiltin.sqrtf (x)
+END sqrt ;
+
+PROCEDURE exp (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN libm.expf (x)
+END exp ;
+
+
+(*
+                log (b)
+   log (b)  =      c
+      a         ------
+                log (a)
+                   c
+*)
+
+PROCEDURE ln (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN libm.logf (x) / libm.logf (exp1)
+END ln ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sinf)) sin (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.sinf (x)
+END sin ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_cosf)) cos (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN cbuiltin.cosf (x)
+END cos ;
+
+PROCEDURE tan (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN libm.tanf (x)
+END tan ;
+
+PROCEDURE arctan (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN libm.atanf (x)
+END arctan ;
+
+PROCEDURE entier (x: SHORTREAL) : INTEGER ;
+BEGIN
+   RETURN TRUNC (libm.floorf (x))
+END entier ;
+
+
+END SMathLib0.
diff --git a/gcc/m2/gm2-libs/SYSTEM.def b/gcc/m2/gm2-libs/SYSTEM.def
new file mode 100644
index 00000000000..2667e3bcdf5
--- /dev/null
+++ b/gcc/m2/gm2-libs/SYSTEM.def
@@ -0,0 +1,197 @@
+(* SYSTEM.def provides access to the SYSTEM dependent module.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE SYSTEM ;
+
+EXPORT QUALIFIED BITSPERBYTE, BYTESPERWORD,
+                 ADDRESS, WORD, BYTE, CSIZE_T, CSSIZE_T, (* @SYSTEM_DATATYPES@  *)
+                 ADR, TSIZE, ROTATE, SHIFT, THROW, TBITSIZE ;
+                 (* SIZE is also exported if -fpim2 is used.  *)
+
+CONST
+  BITSPERBYTE   = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
+  BYTESPERWORD  = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
+
+(* Note that the full list of system and sized datatypes include:
+   LOC, WORD, BYTE, ADDRESS,
+
+   (and the non language standard target types)
+
+   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+   WORD16, WORD32, WORD64, BITSET8, BITSET16,
+   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
+   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.
+
+   Also note that the non-standard data types will
+   move into another module in the future.  *)
+
+
+(* The following types are supported on this target:
+TYPE
+   @SYSTEM_TYPES@
+*)
+
+
+(*
+   all the functions below are declared internally to gm2
+   ======================================================
+
+PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
+  (* Returns the address of variable v. *)
+
+PROCEDURE SIZE (v: <type>) : ZType;
+  (* Returns the number of BYTES used to store a v of
+     any specified <type>.  Only available if -fpim2 is used.
+  *)
+
+PROCEDURE TSIZE (<type>) : CARDINAL;
+  (* Returns the number of BYTES used to store a value of the
+     specified <type>.
+  *)
+
+PROCEDURE ROTATE (val: <a set type>;
+                  num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by rotating up/right
+     or down/right by the absolute value of num.  The direction is
+     down/right if the sign of num is negative, otherwise the direction
+     is up/left.
+  *)
+
+PROCEDURE SHIFT (val: <a set type>;
+                 num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by shifting up/left
+     or down/right by the absolute value of num, introducing
+     zeros as necessary.  The direction is down/right if the sign of
+     num is negative, otherwise the direction is up/left.
+  *)
+
+PROCEDURE THROW (i: INTEGER) ;
+  (*
+     THROW is a GNU extension and was not part of the PIM or ISO
+     standards.  It throws an exception which will be caught by the
+     EXCEPT block (assuming it exists).  This is a compiler builtin
+     function which interfaces to the GCC exception handling runtime
+     system.
+     GCC uses the term throw, hence the naming distinction between
+     the GCC builtin and the Modula-2 runtime library procedure Raise.
+     The later library procedure Raise will call SYSTEM.THROW after
+     performing various housekeeping activities.
+  *)
+
+PROCEDURE TBITSIZE (<type>) : CARDINAL ;
+  (* Returns the minimum number of bits necessary to represent
+     <type>.  This procedure function is only useful for determining
+     the number of bits used for any type field within a packed RECORD.
+     It is not particularly useful elsewhere since <type> might be
+     optimized for speed, for example a BOOLEAN could occupy a WORD.
+  *)
+*)
+
+(* The following procedures are invoked by GNU Modula-2 to
+   shift non word sized set types. They are not strictly part
+   of the core PIM Modula-2, however they are used
+   to implement the SHIFT procedure defined above,
+   which are in turn used by the Logitech compatible libraries.
+
+   Users will access these procedures by using the procedure
+   SHIFT above and GNU Modula-2 will map SHIFT onto one of
+   the following procedures.
+*)
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*)
+
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      ShiftCount: CARDINAL) ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger
+               sets.
+*)
+
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*)
+
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+
+
+END SYSTEM.
diff --git a/gcc/m2/gm2-libs/SYSTEM.mod b/gcc/m2/gm2-libs/SYSTEM.mod
new file mode 100644
index 00000000000..536f112f22e
--- /dev/null
+++ b/gcc/m2/gm2-libs/SYSTEM.mod
@@ -0,0 +1,273 @@
+(* SYSTEM.mod provides access to the SYSTEM dependent module.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SYSTEM ;
+
+FROM libc IMPORT memcpy, memcpy, memset ;
+
+CONST
+   BitsPerBitset = MAX(BITSET)+1 ;
+
+
+(*
+   Max - returns the maximum of a and b.
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a>b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Max ;
+
+
+(*
+   Min - returns the minimum of a and b.
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   IF ShiftCount>0
+   THEN
+      ShiftCount := ShiftCount MOD VAL(INTEGER, SetSizeInBits) ;
+      ShiftLeft(s, d, SetSizeInBits, ShiftCount)
+   ELSIF ShiftCount<0
+   THEN
+      ShiftCount := (-ShiftCount) MOD VAL(INTEGER, SetSizeInBits) ;
+      ShiftRight(s, d, SetSizeInBits, ShiftCount)
+   ELSE
+      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
+   END
+END ShiftVal ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at compile
+               time.
+*)
+
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   i, j, h: CARDINAL ;
+   a      : ADDRESS ;
+BEGIN
+   h := HIGH(s)+1 ;
+   IF ShiftCount MOD BitsPerBitset=0
+   THEN
+      i := ShiftCount DIV BitsPerBitset ;
+      a := ADR(d[i]) ;
+      a := memcpy(a, ADR(s), (h-i)*SIZE(BITSET)) ;
+      a := memset(ADR(d), 0, i*SIZE(BITSET))
+   ELSE
+      i := h ;
+      WHILE i>0 DO
+         DEC(i) ;
+         lo := SHIFT(s[i], ShiftCount MOD BitsPerBitset) ;
+         hi := SHIFT(s[i], -(BitsPerBitset - (ShiftCount MOD BitsPerBitset))) ;
+         d[i] := BITSET{} ;
+         j := i + ShiftCount DIV BitsPerBitset ;
+         IF j<h
+         THEN
+            d[j] := d[j] + lo ;
+            INC(j) ;
+            IF j<h
+            THEN
+               d[j] := d[j] + hi
+            END
+         END
+      END
+   END
+END ShiftLeft ;
+
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at compile
+                time.
+*)
+
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      ShiftCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   j, i, h: INTEGER ;
+   a      : ADDRESS ;
+BEGIN
+   h := HIGH (s) + 1 ;
+   IF ShiftCount MOD BitsPerBitset = 0
+   THEN
+      i := ShiftCount DIV BitsPerBitset ;
+      a := ADR (s[i]) ;
+      j := h-i ;
+      a := memcpy (ADR (d), a, j * VAL (INTEGER, SIZE (BITSET))) ;
+      a := ADR (d[j]) ;
+      a := memset (a, 0, i * VAL (INTEGER, SIZE (BITSET)))
+   ELSE
+      i := 0 ;
+      WHILE i<h DO
+         lo := SHIFT(s[i], BitsPerBitset - (ShiftCount MOD BitsPerBitset)) ;
+         hi := SHIFT(s[i], -(ShiftCount MOD BitsPerBitset)) ;
+         d[i] := BITSET{} ;
+         j := i - VAL (INTEGER, ShiftCount DIV BitsPerBitset) ;
+         IF j>=0
+         THEN
+            d[j] := d[j] + hi ;
+            DEC(j) ;
+            IF j>=0
+            THEN
+               d[j] := d[j] + lo
+            END
+         END ;
+         INC(i)
+      END
+   END
+END ShiftRight ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger sets.
+*)
+
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   IF RotateCount>0
+   THEN
+      RotateCount := RotateCount MOD VAL(INTEGER, SetSizeInBits)
+   ELSIF RotateCount<0
+   THEN
+      RotateCount := -VAL(INTEGER, VAL(CARDINAL, -RotateCount) MOD SetSizeInBits)
+   END ;
+   IF RotateCount>0
+   THEN
+      RotateLeft(s, d, SetSizeInBits, RotateCount)
+   ELSIF RotateCount<0
+   THEN
+      RotateRight(s, d, SetSizeInBits, -RotateCount)
+   ELSE
+      (* no rotate required, but we must copy source to dest.  *)
+      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
+   END
+END RotateVal ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at compile
+                time.
+*)
+
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+VAR
+   lo, hi : BITSET ;
+   b, i, j, h: CARDINAL ;
+BEGIN
+   h := HIGH(s) ;
+   (* firstly we set d := {} *)
+   i := 0 ;
+   WHILE i<=h DO
+      d[i] := BITSET{} ;
+      INC(i)
+   END ;
+   i := h+1 ;
+   RotateCount := RotateCount MOD SetSizeInBits ;
+   b := SetSizeInBits MOD BitsPerBitset ;
+   IF b=0
+   THEN
+      b := BitsPerBitset
+   END ;
+   WHILE i>0 DO
+      DEC(i) ;
+      lo := SHIFT(s[i], RotateCount MOD BitsPerBitset) ;
+      hi := SHIFT(s[i], -(b - (RotateCount MOD BitsPerBitset))) ;
+      j := ((i*BitsPerBitset + RotateCount) MOD
+            SetSizeInBits) DIV BitsPerBitset ;
+      d[j] := d[j] + lo ;
+      j := (((i+1)*BitsPerBitset + RotateCount) MOD
+            SetSizeInBits) DIV BitsPerBitset ;
+      d[j] := d[j] + hi ;
+      b := BitsPerBitset
+   END
+END RotateLeft ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at compile
+                 time.
+*)
+
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+BEGIN
+   RotateLeft(s, d, SetSizeInBits, SetSizeInBits-RotateCount)
+END RotateRight ;
+
+
+END SYSTEM.
diff --git a/gcc/m2/gm2-libs/Scan.def b/gcc/m2/gm2-libs/Scan.def
new file mode 100644
index 00000000000..d13a27864d6
--- /dev/null
+++ b/gcc/m2/gm2-libs/Scan.def
@@ -0,0 +1,85 @@
+(* Scan.def Provides a primitive symbol fetching from input.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Scan ;
+
+(* Provides a primitive symbol fetching from input.
+   Symbols are delimited by spaces and tabs.
+   Limitation only allows one source file at
+   a time to deliver symbols.  *)
+
+
+EXPORT QUALIFIED GetNextSymbol, WriteError,
+                 OpenSource, CloseSource,
+                 TerminateOnError, DefineComments ;
+
+
+(* OpenSource - opens a source file for reading.                  *)
+
+PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(* CloseSource - closes the current source file from reading.     *)
+
+PROCEDURE CloseSource ;
+
+
+(* GetNextSymbol gets the next source symbol and returns it in a. *)
+
+PROCEDURE GetNextSymbol (VAR a: ARRAY OF CHAR) ;
+
+
+(* WriteError writes a message, a, under the source line, which   *)
+(* attempts to pinpoint the Symbol at fault.                      *)
+
+PROCEDURE WriteError (a: ARRAY OF CHAR) ;
+
+
+(*
+   TerminateOnError - exits with status 1 if we call WriteError.
+*)
+
+PROCEDURE TerminateOnError ;
+
+
+(*
+   DefineComments - defines the start of comments within the source
+                    file.
+
+                    The characters in Start define the comment start
+                    and characters in End define the end.
+                    The BOOLEAN eoln determine whether the comment
+                    is terminated by end of line. If eoln is TRUE
+                    then End is ignored.
+
+                    If this procedure is never called then no comments
+                    are allowed.
+*)
+
+PROCEDURE DefineComments (Start, End: ARRAY OF CHAR; eoln: BOOLEAN) ;
+
+
+END Scan.
diff --git a/gcc/m2/gm2-libs/Scan.mod b/gcc/m2/gm2-libs/Scan.mod
new file mode 100644
index 00000000000..672b589bb5b
--- /dev/null
+++ b/gcc/m2/gm2-libs/Scan.mod
@@ -0,0 +1,420 @@
+(* Scan.mod Provides a primitive symbol fetching from input.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Scan ;
+
+
+IMPORT StdIO ;
+
+FROM ASCII IMPORT nul, lf, cr, bs, del, bel ;
+FROM StdIO IMPORT Write ;
+FROM StrLib IMPORT StrEqual, StrLen, StrCopy ;
+FROM NumberIO IMPORT WriteCard, CardToStr ;
+FROM FIO IMPORT OpenToRead, IsNoError, Close, File, ReadChar ;
+FROM StrIO IMPORT WriteLn, WriteString ;
+FROM libc IMPORT exit ;
+
+
+CONST
+   MaxLength = 255 ;  (* Max Length of Source Line *)
+
+VAR
+   FileName,
+   CurrentString       : ARRAY [0..MaxLength] OF CHAR ;
+   CurrentLineNo       : CARDINAL ;
+   CurrentCursorPos    : CARDINAL ;
+   EOF                 : BOOLEAN ;
+   LengthOfCurSym      : CARDINAL ;
+   f                   : File ;
+   Opened              : BOOLEAN ;
+   HaltOnError         : BOOLEAN ;
+   AllowComments       : BOOLEAN ;
+   CommentLeader,
+   CommentTrailer      : ARRAY [0..MaxLength] OF CHAR ;
+   TerminateOnEndOfLine: BOOLEAN ;
+   InString            : BOOLEAN ;
+
+
+PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   StrCopy(a, FileName) ;
+   f := OpenToRead(a) ;
+   IF IsNoError(f)
+   THEN
+      StrCopy( '', CurrentString ) ;
+      LengthOfCurSym := 0 ;
+      CurrentCursorPos := 0 ;
+      EOF := FALSE ;
+      CurrentLineNo := 1 ;
+      Opened := TRUE
+   ELSE
+      Opened := FALSE
+   END ;
+   RETURN( Opened )
+END OpenSource ;
+
+
+PROCEDURE CloseSource ;
+BEGIN
+   IF Opened
+   THEN
+      Close( f ) ;
+      Opened := FALSE
+   END
+END CloseSource ;
+
+
+(*
+   IsStartOfComment - returns TRUE if we are looking at the start of a comment.
+*)
+
+PROCEDURE IsStartOfComment () : BOOLEAN ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   IF AllowComments
+   THEN
+      i := 0 ;
+      h := StrLen(CommentLeader) ;
+      WHILE (i<h) AND (CommentLeader[i]=CurrentString[CurrentCursorPos+i]) DO
+         INC(i)
+      END ;
+      RETURN( i=h )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsStartOfComment ;
+
+
+(*
+   IsEndOfComment - returns TRUE if we can see the end of comment string.
+                    If TRUE is returned then we also have consumed the string.
+*)
+
+PROCEDURE IsEndOfComment () : BOOLEAN ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   IF AllowComments
+   THEN
+      IF TerminateOnEndOfLine AND (SymbolChar()=nul)
+      THEN
+         NextChar ;
+         RETURN( TRUE )
+      ELSE
+         i := 0 ;
+         h := StrLen(CommentTrailer) ;
+         WHILE (i<h) AND (CommentTrailer[i]=CurrentString[CurrentCursorPos+i]) DO
+            INC(i)
+         END ;
+         IF (i=h) AND (h#0)
+         THEN
+            (* seen tailer therefore eat it *)
+            INC(CurrentCursorPos, i) ;
+            RETURN( TRUE )
+         ELSE
+            RETURN( FALSE )
+         END
+      END
+   ELSE
+      RETURN( FALSE )
+   END
+END IsEndOfComment ;
+
+
+(*
+   IsQuote - returns TRUE if the current character is a quote.
+*)
+
+PROCEDURE IsQuote () : BOOLEAN ;
+BEGIN
+   RETURN( SymbolChar()='"' )
+END IsQuote ;
+
+
+(*
+   GetNextSymbol - returns the next symbol from the source file.
+                   It ignores comments and treats strings differently
+                   from normal symbols. Strings will return " string ".
+*)
+
+PROCEDURE GetNextSymbol (VAR a: ARRAY OF CHAR) ;
+VAR
+   index,
+   High    : CARDINAL ;
+BEGIN
+   index := 0 ;
+   High  := HIGH( a ) ;
+   ChuckUpToSymbol ;
+
+   IF InString
+   THEN
+      IF (NOT EOF) AND (NOT IsStartOfComment()) AND (index<High) AND IsQuote()
+      THEN
+         (* found final quote *)
+         a[index] := SymbolChar() ;
+         NextChar ;
+         INC(index) ;
+         InString := FALSE ;
+      ELSE
+         (* copy literal into, a *)
+         WHILE (index<High) AND (NOT EOF) AND (SymbolChar()#nul) AND (NOT IsQuote()) DO
+            a[index] := SymbolChar() ;
+            NextChar ;
+            INC(index)
+         END ;
+         IF NOT IsQuote()
+         THEN
+            WriteError('unterminated string, strings must terminate before the end of a line')
+         END ;
+      END
+   ELSE
+      IF (NOT EOF) AND (NOT IsStartOfComment())
+      THEN
+         IF (index<High) AND IsQuote()
+         THEN
+            (* found string start *)
+            a[index] := SymbolChar() ;
+            NextChar ; (* skip quote *)
+            INC(index) ;
+            InString := TRUE ;
+         ELSE
+            (* normal symbol, not a comment and not a string *)
+            WHILE (index<High) AND (NOT NonSymbolChar()) AND (NOT IsStartOfComment()) DO
+               a[index] := SymbolChar() ;
+               NextChar ;
+               INC(index)
+            END
+         END
+      END
+   END ;
+   IF index<High
+   THEN
+      a[index] := nul
+   END ;
+   LengthOfCurSym := index
+END GetNextSymbol ;
+
+
+(*
+   ChuckUpToSymbol - throws away white space and comments.
+*)
+
+PROCEDURE ChuckUpToSymbol ;
+BEGIN
+   REPEAT
+      IF (NOT EOF) AND IsStartOfComment()
+      THEN
+         NextChar ;
+         WHILE (NOT EOF) AND (NOT IsEndOfComment()) DO
+            NextChar
+         END
+      END ;
+      WHILE (NOT EOF) AND NonSymbolChar() DO
+         NextChar
+      END
+   UNTIL EOF OR (NOT IsStartOfComment())
+END ChuckUpToSymbol ;
+
+
+(*
+   SymbolChar - returns a character from the CurrentString, if the end
+                of CurrentString is found then SymbolChar returns nul.
+*)
+
+PROCEDURE SymbolChar () : CHAR ;
+BEGIN
+   IF EOF
+   THEN
+      RETURN( nul )
+   ELSE
+      IF CurrentCursorPos<StrLen(CurrentString)
+      THEN
+         RETURN( CurrentString[CurrentCursorPos] )
+      ELSE
+         RETURN( nul )
+      END
+   END
+END SymbolChar ;
+
+
+(* NextChar advances the CurrentCursorPos along a line of the source, *)
+(* resetting the CurrentCursorPos every time a newline is read.       *)
+
+PROCEDURE NextChar ;
+BEGIN
+   IF NOT EOF
+   THEN
+      IF CurrentCursorPos<StrLen(CurrentString)
+      THEN
+         INC(CurrentCursorPos)
+      ELSE
+         ReadString(CurrentString) ;
+         (* WriteString( CurrentString ) ; WriteLn ; *)
+         INC(CurrentLineNo) ;
+         CurrentCursorPos := 0 ;
+         LengthOfCurSym := 0
+      END
+   END
+END NextChar ;
+
+
+PROCEDURE NonSymbolChar () : BOOLEAN ;
+BEGIN
+   RETURN( CurrentString[CurrentCursorPos]<=' ' )
+END NonSymbolChar ;
+
+
+PROCEDURE WriteError (a: ARRAY OF CHAR) ;
+VAR
+   i, j  : CARDINAL ;
+   LineNo: ARRAY [0..20] OF CHAR ;
+BEGIN
+   WriteString(FileName) ;
+   Write(':') ;
+   CardToStr(CurrentLineNo, 0, LineNo) ;
+   WriteString(LineNo) ;
+   Write(':') ;
+   WriteString( CurrentString ) ; WriteLn ;
+   WriteString(FileName) ;
+   Write(':') ;
+   WriteString(LineNo) ;
+   Write(':') ;
+   i := 0 ;
+   j := CurrentCursorPos-LengthOfCurSym ;
+   WHILE i<j DO
+      Write(' ') ;
+      INC( i )
+   END ;
+   FOR i := 1 TO LengthOfCurSym DO
+      Write('^')
+   END ;
+   WriteLn ;
+   WriteString(FileName) ;
+   Write(':') ;
+   WriteString(LineNo) ;
+   Write(':') ;
+   WriteString( a ) ; WriteLn ;
+   IF HaltOnError
+   THEN
+      exit(1)
+   END
+END WriteError ;
+
+
+PROCEDURE ReadString (VAR a: ARRAY OF CHAR) ;
+VAR
+   n    ,
+   high : CARDINAL ;
+   ch   : CHAR ;
+BEGIN
+   high := HIGH( a ) ;
+   n := 0 ;
+   REPEAT
+      Read( ch ) ;
+      IF (ch=del) OR (ch=bs)
+      THEN
+         IF n=0
+         THEN
+            Write( bel )
+         ELSE
+            Write( bs ) ;
+            Write(' ') ;
+            Write( bs ) ;
+            DEC( n )
+         END
+      ELSIF n <= high
+      THEN
+         IF (ch = cr) OR (cr = lf)
+         THEN
+            a[n] := nul
+         ELSE
+(*            Write( ch ) ;
+ *)           a[n] := ch
+         END ;
+         INC( n )
+      ELSE
+         ch := cr  (* exit gracefully *)
+      END
+   UNTIL ch = cr
+END ReadString ;
+
+
+PROCEDURE Read (VAR ch: CHAR) ;
+BEGIN
+   IF Opened
+   THEN
+      ch := ReadChar(f) ;
+      EOF := NOT IsNoError(f)
+   ELSE
+      StdIO.Read( ch )
+   END ;
+   IF ch=lf THEN ch := cr END
+END Read ;
+
+
+(*
+   TerminateOnError - exits with status 1 if we call WriteError.
+*)
+
+PROCEDURE TerminateOnError ;
+BEGIN
+   HaltOnError := TRUE
+END TerminateOnError ;
+
+
+(*
+   DefineComments - defines the start of comments within the source
+                    file.
+
+                    The characters in Start define the comment start
+                    and characters in End define the end.
+                    The BOOLEAN eoln determine whether the comment
+                    is terminated by end of line. If eoln is TRUE
+                    then End is ignored.
+*)
+
+PROCEDURE DefineComments (Start, End: ARRAY OF CHAR; eoln: BOOLEAN) ;
+BEGIN
+   TerminateOnEndOfLine := eoln ;
+   StrCopy(Start, CommentLeader) ;
+   StrCopy(End, CommentTrailer) ;
+   AllowComments := StrLen(CommentLeader)>0
+END DefineComments ;
+
+
+BEGIN
+   InString             := FALSE ;
+   AllowComments        := FALSE ;
+   TerminateOnEndOfLine := FALSE ;
+   StrCopy(''           , CurrentString) ;
+   LengthOfCurSym       := 0 ;
+   CurrentCursorPos     := 0 ;
+   EOF                  := FALSE ;
+   CurrentLineNo        := 1 ;
+   Opened               := FALSE ;
+   HaltOnError          := FALSE
+END Scan.
diff --git a/gcc/m2/gm2-libs/Selective.def b/gcc/m2/gm2-libs/Selective.def
new file mode 100644
index 00000000000..84bae59ced9
--- /dev/null
+++ b/gcc/m2/gm2-libs/Selective.def
@@ -0,0 +1,72 @@
+(* Selective.def provides Modula-2 with access to the select(2) primitive.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Selective ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED SetOfFd, Timeval,
+                 InitSet, KillSet, InitTime, KillTime,
+                 GetTime, SetTime,
+                 FdZero, FdSet, FdClr, FdIsSet, Select,
+                 MaxFdsPlusOne, WriteCharRaw, ReadCharRaw,
+                 GetTimeOfDay ;
+
+TYPE
+   SetOfFd = ADDRESS ;    (* Hidden type in Selective.c *)
+   Timeval = ADDRESS ;    (* Hidden type in Selective.c *)
+
+
+PROCEDURE Select (nooffds: CARDINAL;
+                  readfds, writefds, exceptfds: SetOfFd;
+                  timeout: Timeval) : INTEGER ;
+
+PROCEDURE InitTime (sec, usec: CARDINAL) : Timeval ;
+PROCEDURE KillTime (t: Timeval) : Timeval ;
+PROCEDURE GetTime (t: Timeval; VAR sec, usec: CARDINAL) ;
+PROCEDURE SetTime (t: Timeval; sec, usec: CARDINAL) ;
+PROCEDURE InitSet () : SetOfFd ;
+PROCEDURE KillSet (s: SetOfFd) : SetOfFd ;
+PROCEDURE FdZero (s: SetOfFd) ;
+PROCEDURE FdSet (fd: INTEGER; s: SetOfFd) ;
+PROCEDURE FdClr (fd: INTEGER; s: SetOfFd) ;
+PROCEDURE FdIsSet (fd: INTEGER; s: SetOfFd) : BOOLEAN ;
+PROCEDURE MaxFdsPlusOne (a, b: INTEGER) : INTEGER ;
+
+(* you must use the raw routines with select - not the FIO buffered routines *)
+PROCEDURE WriteCharRaw (fd: INTEGER; ch: CHAR) ;
+PROCEDURE ReadCharRaw (fd: INTEGER) : CHAR ;
+
+(*
+   GetTimeOfDay - fills in a record, Timeval, filled in with the
+                  current system time in seconds and microseconds.
+                  It returns zero (see man 3p gettimeofday)
+*)
+
+PROCEDURE GetTimeOfDay (tv: Timeval) : INTEGER ;
+
+
+END Selective.
diff --git a/gcc/m2/gm2-libs/StdIO.def b/gcc/m2/gm2-libs/StdIO.def
new file mode 100644
index 00000000000..237532597e5
--- /dev/null
+++ b/gcc/m2/gm2-libs/StdIO.def
@@ -0,0 +1,102 @@
+(* StdIO.def provides general Read and Write procedures.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE StdIO ;
+
+EXPORT QUALIFIED ProcRead, ProcWrite,
+                 Read, Write,
+                 PushOutput, PopOutput, GetCurrentOutput,
+                 PushInput, PopInput, GetCurrentInput ;
+
+
+TYPE
+   ProcWrite = PROCEDURE (CHAR) ;
+   ProcRead  = PROCEDURE (VAR CHAR) ;
+
+
+(*
+   Read - is the generic procedure that all higher application layers
+          should use to receive a character.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   Write - is the generic procedure that all higher application layers
+           should use to emit a character.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+
+
+(*
+   PushOutput - pushes the current Write procedure onto a stack,
+                any future references to Write will actually invoke
+                procedure, p.
+*)
+
+PROCEDURE PushOutput (p: ProcWrite) ;
+
+
+(*
+   PopOutput - restores Write to use the previous output procedure.
+*)
+
+PROCEDURE PopOutput ;
+
+
+(*
+   GetCurrentOutput - returns the current output procedure.
+*)
+
+PROCEDURE GetCurrentOutput () : ProcWrite ;
+
+
+(*
+   PushInput - pushes the current Read procedure onto a stack,
+               any future references to Read will actually invoke
+               procedure, p.
+*)
+
+PROCEDURE PushInput (p: ProcRead) ;
+
+
+(*
+   PopInput - restores Write to use the previous output procedure.
+*)
+
+PROCEDURE PopInput ;
+
+
+(*
+   GetCurrentInput - returns the current input procedure.
+*)
+
+PROCEDURE GetCurrentInput () : ProcRead ;
+
+
+END StdIO.
diff --git a/gcc/m2/gm2-libs/StdIO.mod b/gcc/m2/gm2-libs/StdIO.mod
new file mode 100644
index 00000000000..c4c13a1bdd8
--- /dev/null
+++ b/gcc/m2/gm2-libs/StdIO.mod
@@ -0,0 +1,165 @@
+(* StdIO.mod provides general Read and Write procedures.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE StdIO ;
+
+IMPORT IO ;
+
+
+CONST
+   MaxStack = 40 ;
+
+VAR
+   StackW   : ARRAY [0..MaxStack] OF ProcWrite ;
+   StackWPtr: CARDINAL ;
+   StackR   : ARRAY [0..MaxStack] OF ProcRead ;
+   StackRPtr: CARDINAL ;
+
+
+(*
+   Read - is the generic procedure that all higher application layers
+          should use to receive a character.
+*)
+
+PROCEDURE Read (VAR ch: CHAR) ;
+BEGIN
+   StackR[StackRPtr](ch)
+END Read ;
+
+
+(*
+   Write - is the generic procedure that all higher application layers
+           should use to emit a character.
+*)
+
+PROCEDURE Write (ch: CHAR) ;
+BEGIN
+   StackW[StackWPtr](ch)
+END Write ;
+
+
+(*
+   PushOutput - pushes the current Write procedure onto a stack,
+                any future references to Write will actually invoke
+                procedure, p.
+*)
+
+PROCEDURE PushOutput (p: ProcWrite) ;
+BEGIN
+   IF StackWPtr=MaxStack
+   THEN
+      HALT
+   ELSE
+      INC(StackWPtr) ;
+      StackW[StackWPtr] := p
+   END
+END PushOutput ;
+
+
+(*
+   PopOutput - restores Write to use the previous output procedure.
+*)
+
+PROCEDURE PopOutput ;
+BEGIN
+   IF StackWPtr=1
+   THEN
+      HALT
+   ELSE
+      DEC(StackWPtr)
+   END
+END PopOutput ;
+
+
+(*
+   GetCurrentOutput - returns the current output procedure.
+*)
+
+PROCEDURE GetCurrentOutput () : ProcWrite ;
+BEGIN
+   IF StackWPtr>0
+   THEN
+      RETURN( StackW[StackWPtr] )
+   ELSE
+      HALT
+   END
+END GetCurrentOutput ;
+
+
+(*
+   PushInput - pushes the current Read procedure onto a stack,
+               any future references to Read will actually invoke
+               procedure, p.
+*)
+
+PROCEDURE PushInput (p: ProcRead) ;
+BEGIN
+   IF StackRPtr=MaxStack
+   THEN
+      HALT
+   ELSE
+      INC(StackRPtr) ;
+      StackR[StackRPtr] := p
+   END
+END PushInput ;
+
+
+(*
+   PopInput - restores Write to use the previous output procedure.
+*)
+
+PROCEDURE PopInput ;
+BEGIN
+   IF StackRPtr=1
+   THEN
+      HALT
+   ELSE
+      DEC(StackRPtr)
+   END
+END PopInput ;
+
+
+(*
+   GetCurrentInput - returns the current input procedure.
+*)
+
+PROCEDURE GetCurrentInput () : ProcRead ;
+BEGIN
+   IF StackRPtr>0
+   THEN
+      RETURN( StackR[StackRPtr] )
+   ELSE
+      HALT
+   END
+END GetCurrentInput ;
+
+
+BEGIN
+   StackWPtr := 0 ;
+   StackRPtr := 0 ;
+   PushOutput(IO.Write) ;
+   PushInput(IO.Read)
+END StdIO.
diff --git a/gcc/m2/gm2-libs/Storage.def b/gcc/m2/gm2-libs/Storage.def
new file mode 100644
index 00000000000..85beaa8f7fa
--- /dev/null
+++ b/gcc/m2/gm2-libs/Storage.def
@@ -0,0 +1,69 @@
+(* Storage.def provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE Storage ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED ALLOCATE, DEALLOCATE, REALLOCATE, Available ;
+
+
+
+(*
+   ALLOCATE - attempt to allocate memory from the heap.
+              NIL is returned in, a, if ALLOCATE fails.
+*)
+
+PROCEDURE ALLOCATE (VAR a: ADDRESS ; Size: CARDINAL) ;
+
+
+(*
+   DEALLOCATE - return, Size, bytes to the heap.
+                The variable, a, is set to NIL.
+*)
+
+PROCEDURE DEALLOCATE (VAR a: ADDRESS ; Size: CARDINAL) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE REALLOCATE (VAR a: ADDRESS; Size: CARDINAL) ;
+
+
+(*
+   Available - returns TRUE if, Size, bytes can be allocated.
+*)
+
+PROCEDURE Available (Size: CARDINAL) : BOOLEAN ;
+
+
+END Storage.
diff --git a/gcc/m2/gm2-libs/Storage.mod b/gcc/m2/gm2-libs/Storage.mod
new file mode 100644
index 00000000000..78556d2d76d
--- /dev/null
+++ b/gcc/m2/gm2-libs/Storage.mod
@@ -0,0 +1,57 @@
+(* Storage.mod provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE Storage ;
+
+
+IMPORT SysStorage ;
+
+
+PROCEDURE ALLOCATE (VAR a: ADDRESS ; Size: CARDINAL) ;
+BEGIN
+   SysStorage.ALLOCATE (a, Size)
+END ALLOCATE ;
+
+
+PROCEDURE DEALLOCATE (VAR a: ADDRESS; Size: CARDINAL);
+BEGIN
+   SysStorage.DEALLOCATE (a, Size)
+END DEALLOCATE ;
+
+
+PROCEDURE REALLOCATE (VAR a: ADDRESS; Size: CARDINAL);
+BEGIN
+   SysStorage.REALLOCATE (a, Size)
+END REALLOCATE ;
+
+
+PROCEDURE Available (Size: CARDINAL) : BOOLEAN;
+BEGIN
+   RETURN SysStorage.Available (Size)
+END Available ;
+
+
+END Storage.
diff --git a/gcc/m2/gm2-libs/StrCase.def b/gcc/m2/gm2-libs/StrCase.def
new file mode 100644
index 00000000000..3f6601e56cc
--- /dev/null
+++ b/gcc/m2/gm2-libs/StrCase.def
@@ -0,0 +1,67 @@
+(* StrCase.def provides procedure to convert between text case.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE StrCase ;
+
+
+EXPORT QUALIFIED StrToUpperCase, StrToLowerCase, Cap, Lower ;
+
+
+(*
+   StrToUpperCase - converts string, a, to uppercase returning the
+                    result in, b.
+*)
+
+PROCEDURE StrToUpperCase (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+
+
+(*
+   StrToLowerCase - converts string, a, to lowercase returning the
+                    result in, b.
+*)
+
+PROCEDURE StrToLowerCase (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Cap (ch: CHAR) : CHAR ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Lower (ch: CHAR) : CHAR ;
+
+
+END StrCase.
diff --git a/gcc/m2/gm2-libs/StrCase.mod b/gcc/m2/gm2-libs/StrCase.mod
new file mode 100644
index 00000000000..f5eca177ab3
--- /dev/null
+++ b/gcc/m2/gm2-libs/StrCase.mod
@@ -0,0 +1,116 @@
+(* StrCase.mod provides procedure to convert between text case.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE StrCase ;
+
+
+FROM ASCII IMPORT nul ;
+FROM StrLib IMPORT StrLen ;
+
+
+(*
+   StrToUpperCase - converts string, a, to uppercase returning the
+                    result in, b.
+*)
+
+PROCEDURE StrToUpperCase (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+VAR
+   higha,
+   highb,
+   i    : CARDINAL ;
+BEGIN
+   higha := StrLen(a) ;
+   highb := HIGH(b) ;
+   i := 0 ;
+   WHILE (i<higha) AND (a[i]#nul) AND (i<highb) DO
+      b[i] := Cap(a[i]) ;
+      INC(i)
+   END ;
+   IF i<highb
+   THEN
+      b[i] := nul
+   END
+END StrToUpperCase ;
+
+
+(*
+   StrToLowerCase - converts string, a, to lowercase returning the
+                    result in, b.
+*)
+
+PROCEDURE StrToLowerCase (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+VAR
+   higha,
+   highb,
+   i    : CARDINAL ;
+BEGIN
+   higha := StrLen(a) ;
+   highb := HIGH(b) ;
+   i := 0 ;
+   WHILE (i<higha) AND (a[i]#nul) AND (i<highb) DO
+      b[i] := Lower(a[i]) ;
+      INC(i)
+   END ;
+   IF i<highb
+   THEN
+      b[i] := nul
+   END
+END StrToLowerCase ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Cap (ch: CHAR) : CHAR ;
+BEGIN
+   IF (ch>='a') AND (ch<='z')
+   THEN
+      ch := CHR( ORD(ch)-ORD('a')+ORD('A') )
+   END ;
+   RETURN( ch )
+END Cap ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Lower (ch: CHAR) : CHAR ;
+BEGIN
+   IF (ch>='A') AND (ch<='Z')
+   THEN
+      ch := CHR( ORD(ch)-ORD('A')+ORD('a') )
+   END ;
+   RETURN( ch )
+END Lower ;
+
+
+END StrCase.
diff --git a/gcc/m2/gm2-libs/StrIO.def b/gcc/m2/gm2-libs/StrIO.def
new file mode 100644
index 00000000000..d8cb5210cb4
--- /dev/null
+++ b/gcc/m2/gm2-libs/StrIO.def
@@ -0,0 +1,57 @@
+(* StrIO.def Provides simple string input output routines.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE StrIO ;
+
+EXPORT QUALIFIED ReadString, WriteString,
+                 WriteLn ;
+
+
+(*
+   WriteLn - writes a carriage return and a newline
+             character.
+*)
+
+PROCEDURE WriteLn ;
+
+
+(*
+   ReadString - reads a sequence of characters into a string.
+                Line editing accepts Del, Ctrl H, Ctrl W and
+                Ctrl U.
+*)
+
+PROCEDURE ReadString (VAR a: ARRAY OF CHAR) ;
+
+
+(*
+   WriteString - writes a string to the default output.
+*)
+
+PROCEDURE WriteString (a: ARRAY OF CHAR) ;
+
+
+END StrIO.
diff --git a/gcc/m2/gm2-libs/StrIO.mod b/gcc/m2/gm2-libs/StrIO.mod
new file mode 100644
index 00000000000..072b608841d
--- /dev/null
+++ b/gcc/m2/gm2-libs/StrIO.mod
@@ -0,0 +1,194 @@
+(* StrIO.mod provides simple string input output routines.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE StrIO ;
+
+
+FROM ASCII IMPORT cr, nul, lf, bel, del, bs, nak, etb, ff, eof ;
+FROM StdIO IMPORT Read, Write ;
+FROM libc IMPORT isatty ;
+
+
+VAR
+   IsATTY: BOOLEAN ;   (* Is default input from the keyboard? *)
+
+
+(*
+   WriteLn - writes a carriage return and a newline
+             character.
+*)
+
+PROCEDURE WriteLn ;
+BEGIN
+   Echo(cr) ;
+   Write(lf)
+END WriteLn ;
+
+
+(*
+   ReadString - reads a sequence of characters into a string.
+                Line editing accepts Del, Ctrl H, Ctrl W and
+                Ctrl U.
+*)
+
+PROCEDURE ReadString (VAR a: ARRAY OF CHAR) ;
+VAR
+   n    ,
+   high : CARDINAL ;
+   ch   : CHAR ;
+BEGIN
+   high := HIGH(a) ;
+   n := 0 ;
+   REPEAT
+      Read(ch) ;
+      IF (ch=del) OR (ch=bs)
+      THEN
+         IF n=0
+         THEN
+            Write(bel)
+         ELSE
+            Erase ;
+            DEC(n)
+         END
+      ELSIF ch=nak    (* Ctrl U *)
+      THEN
+         WHILE n>0 DO
+            Erase ;
+            DEC(n)
+         END
+      ELSIF ch=etb    (* Ctrl W *)
+      THEN
+         IF n=0
+         THEN
+            Echo(bel)
+         ELSIF AlphaNum(a[n-1])
+         THEN
+            REPEAT
+               Erase ;
+               DEC(n)
+            UNTIL (n=0) OR (NOT AlphaNum(a[n-1]))
+         ELSE
+            Erase ;
+            DEC(n)
+         END
+      ELSIF n<=high
+      THEN
+         IF (ch=cr) OR (ch=lf)
+         THEN
+            a[n] := nul ;
+            INC(n)
+         ELSIF ch=ff
+         THEN
+            a[0] := ch ;
+            IF high>0
+            THEN
+               a[1] := nul
+            END ;
+            ch := cr
+         ELSIF ch>=' '
+         THEN
+            Echo(ch) ;
+            a[n] := ch ;
+            INC(n)
+         ELSIF ch=eof
+         THEN
+            a[n] := ch ;
+            INC(n) ;
+            ch := cr;
+            IF n<=high
+            THEN
+               a[n] := nul
+            END
+         END
+      ELSIF ch#cr
+      THEN
+         Echo(bel)
+      END
+   UNTIL (ch=cr) OR (ch=lf)
+END ReadString ;
+
+
+(*
+   WriteString - writes a string to the default output.
+*)
+
+PROCEDURE WriteString (a: ARRAY OF CHAR) ;
+VAR
+   n    ,
+   high : CARDINAL ;
+BEGIN
+   high := HIGH(a) ;
+   n := 0 ;
+   WHILE (n <= high) AND (a[n] # nul) DO
+      Write(a[n]) ;
+      INC(n)
+   END
+END WriteString ;
+
+
+(*
+   Erase - writes a backspace, space and backspace to remove the
+           last character displayed.
+*)
+
+PROCEDURE Erase ;
+BEGIN
+   Echo(bs) ;
+   Echo(' ') ;
+   Echo(bs)
+END Erase ;
+
+
+(*
+   Echo - echos the character, ch, onto the output channel if IsATTY
+          is true.
+*)
+
+PROCEDURE Echo (ch: CHAR) ;
+BEGIN
+   IF IsATTY
+   THEN
+      Write(ch)
+   END
+END Echo ;
+
+
+(*
+   AlphaNum- returns true if character, ch, is an alphanumeric character.
+*)
+
+PROCEDURE AlphaNum (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN ((ch>='a') AND (ch<='z')) OR
+          ((ch>='A') AND (ch<='Z')) OR
+          ((ch>='0') AND (ch<='9'))
+END AlphaNum ;
+
+
+BEGIN
+(*   IsATTY := isatty() *)
+   IsATTY := FALSE
+END StrIO.
diff --git a/gcc/m2/gm2-libs/StrLib.def b/gcc/m2/gm2-libs/StrLib.def
new file mode 100644
index 00000000000..676d3c4e480
--- /dev/null
+++ b/gcc/m2/gm2-libs/StrLib.def
@@ -0,0 +1,86 @@
+(* StrLib.def provides string manipulation procedures.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE StrLib ;
+
+EXPORT QUALIFIED StrConCat, StrLen, StrCopy, StrEqual, StrLess,
+      	       	 IsSubString, StrRemoveWhitePrefix ;
+
+
+(*
+   StrConCat - combines a and b into c.
+*)
+
+PROCEDURE StrConCat (a, b: ARRAY OF CHAR; VAR c: ARRAY OF CHAR) ;
+
+
+(*
+   StrLess - returns TRUE if string, a, alphabetically occurs before
+             string, b.
+*)
+
+PROCEDURE StrLess (a, b: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   StrEqual - performs a = b on two strings.
+*)
+
+PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   StrLen - returns the length of string, a.
+*)
+
+PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StrCopy (src: ARRAY OF CHAR ; VAR dest: ARRAY OF CHAR) ;
+
+
+(*
+   IsSubString - returns true if b is a subcomponent of a.
+*)
+
+PROCEDURE IsSubString (a, b: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+                          space infront of a.
+*)
+
+PROCEDURE StrRemoveWhitePrefix (a: ARRAY OF CHAR; VAR b: ARRAY OF CHAR) ;
+
+
+END StrLib.
diff --git a/gcc/m2/gm2-libs/StrLib.mod b/gcc/m2/gm2-libs/StrLib.mod
new file mode 100644
index 00000000000..0c1ae4c7da6
--- /dev/null
+++ b/gcc/m2/gm2-libs/StrLib.mod
@@ -0,0 +1,220 @@
+(* StrLib.mod provides string manipulation procedures.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE StrLib ;
+
+FROM ASCII IMPORT nul, tab ;
+
+
+(*
+   StrConCat - combines a and b into c.
+*)
+
+PROCEDURE StrConCat (a: ARRAY OF CHAR; b: ARRAY OF CHAR; VAR c: ARRAY OF CHAR) ;
+VAR
+   Highb,
+   Highc,
+   i, j : CARDINAL ;
+BEGIN
+   Highb := StrLen(b) ;
+   Highc := HIGH(c) ;
+   StrCopy(a, c) ;
+   i := StrLen(c) ;
+   j := 0 ;
+   WHILE (j<Highb) AND (i<=Highc) DO
+      c[i] := b[j] ;
+      INC(i) ;
+      INC(j)
+   END ;
+   IF i<=Highc
+   THEN
+      c[i] := nul
+   END
+END StrConCat ;
+
+
+(*
+   StrLess - returns TRUE if string, a, alphabetically occurs before
+             string, b.
+*)
+
+PROCEDURE StrLess (a, b: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   Higha,
+   Highb,
+   i    : CARDINAL ;
+BEGIN
+   Higha := StrLen(a) ;
+   Highb := StrLen(b) ;
+   i := 0 ;
+   WHILE (i<Higha) AND (i<Highb) DO
+      IF a[i]<b[i]
+      THEN
+         RETURN( TRUE )
+      ELSIF a[i]>b[i]
+      THEN
+         RETURN( FALSE )
+      END ;
+      (* must be equal, move on to next character *)
+      INC(i)
+   END ;
+   RETURN( Higha<Highb )    (* substrings are equal so we go on length *)
+END StrLess ;
+
+
+PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   i,
+   higha,
+   highb: CARDINAL ;
+BEGIN
+   higha := HIGH(a) ;
+   highb := HIGH(b) ;
+   i := 0 ;
+   WHILE (i<=higha) AND (i<=highb) AND (a[i]#nul) AND (b[i]#nul) DO
+      IF a[i]#b[i]
+      THEN
+         RETURN( FALSE )
+      END ;
+      INC(i)
+   END ;
+   RETURN NOT (((i<=higha) AND (a[i]#nul)) OR
+               ((i<=highb) AND (b[i]#nul)))
+END StrEqual ;
+
+
+PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   High,
+   Len : CARDINAL ;
+BEGIN
+   Len := 0 ;
+   High := HIGH(a) ;
+   WHILE (Len<=High) AND (a[Len]#nul) DO
+      INC(Len)
+   END ;
+   RETURN( Len )
+END StrLen ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StrCopy (src: ARRAY OF CHAR ; VAR dest: ARRAY OF CHAR) ;
+VAR
+   HighSrc,
+   HighDest,
+   n       : CARDINAL ;
+BEGIN
+   n := 0 ;
+   HighSrc := StrLen (src) ;
+   HighDest := HIGH (dest) ;
+   WHILE (n < HighSrc) AND (n <= HighDest) DO
+      dest[n] := src[n] ;
+      INC (n)
+   END ;
+   IF n <= HighDest
+   THEN
+      dest[n] := nul
+   END
+END StrCopy ;
+
+
+(*
+   IsSubString - returns true if b is a subcomponent of a.
+*)
+
+PROCEDURE IsSubString (a, b: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   i, j,
+   LengthA,
+   LengthB: CARDINAL ;
+BEGIN
+   LengthA := StrLen(a) ;
+   LengthB := StrLen(b) ;
+   i := 0 ;
+   IF LengthA>LengthB
+   THEN
+      WHILE i<=LengthA-LengthB DO
+      	 j := 0 ;
+      	 WHILE (j<LengthB) AND (a[i+j]=b[j]) DO
+      	    INC(j)
+      	 END ;
+      	 IF j=LengthB
+      	 THEN
+      	    RETURN( TRUE )
+      	 ELSE
+      	    INC(i)
+      	 END
+      END
+   END ;
+   RETURN( FALSE )
+END IsSubString ;
+
+
+(*
+   IsWhite - returns TRUE if, ch, is a space or a tab.
+*)
+
+PROCEDURE IsWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( (ch=' ') OR (ch=tab) )
+END IsWhite ;
+
+
+(*
+   StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+                          space infront of a.
+*)
+
+PROCEDURE StrRemoveWhitePrefix (a: ARRAY OF CHAR; VAR b: ARRAY OF CHAR) ;
+VAR
+   i, j,
+   higha, highb: CARDINAL ;
+BEGIN
+   i := 0 ;
+   j := 0 ;
+   higha := StrLen(a) ;
+   highb := HIGH(b) ;
+   WHILE (i<higha) AND IsWhite(a[i]) DO
+      INC(i)
+   END ;
+   WHILE (i<higha) AND (j<=highb) DO
+      b[j] := a[i] ;
+      INC(i) ;
+      INC(j)
+   END ;
+   IF j<=highb
+   THEN
+      b[j] := nul
+   END
+END StrRemoveWhitePrefix ;
+
+
+END StrLib.
diff --git a/gcc/m2/gm2-libs/StringConvert.def b/gcc/m2/gm2-libs/StringConvert.def
new file mode 100644
index 00000000000..b2c25b5a2f6
--- /dev/null
+++ b/gcc/m2/gm2-libs/StringConvert.def
@@ -0,0 +1,337 @@
+(* StringConvert.def provides functions to convert numbers to and from strings.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE StringConvert ;
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED IntegerToString, StringToInteger,
+                 StringToLongInteger, LongIntegerToString,
+                 StringToCardinal, CardinalToString,
+                 StringToLongCardinal, LongCardinalToString,
+                 StringToShortCardinal, ShortCardinalToString,
+                 StringToLongreal, LongrealToString,
+                 ToSigFig,
+                 stoi, itos, ctos, stoc, hstoi, ostoi, bstoi,
+                 hstoc, ostoc, bstoc,
+                 stor, stolr ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE IntegerToString (i: INTEGER; width: CARDINAL; padding: CHAR; sign: BOOLEAN;
+                           base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+(*
+   CardinalToString - converts CARDINAL, 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.
+*)
+
+PROCEDURE CardinalToString (c: CARDINAL; width: CARDINAL; padding: CHAR;
+                            base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToInteger (s: String; base: CARDINAL; VAR found: BOOLEAN) : INTEGER ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToCardinal (s: String; base: CARDINAL; VAR found: BOOLEAN) : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE LongIntegerToString (i: LONGINT; width: CARDINAL; padding: CHAR;
+                               sign: BOOLEAN; base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToLongInteger (s: String; base: CARDINAL; VAR found: BOOLEAN) : LONGINT ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE LongCardinalToString (c: LONGCARD; width: CARDINAL; padding: CHAR;
+                                base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToLongCardinal (s: String; base: CARDINAL; VAR found: BOOLEAN) : LONGCARD ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ShortCardinalToString (c: SHORTCARD; width: CARDINAL; padding: CHAR;
+                                 base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToShortCardinal (s: String; base: CARDINAL;
+                                 VAR found: BOOLEAN) : SHORTCARD ;
+
+
+(*
+   stoi - decimal string to INTEGER
+*)
+
+PROCEDURE stoi (s: String) : INTEGER ;
+
+
+(*
+   itos - integer to decimal string.
+*)
+
+PROCEDURE itos (i: INTEGER; width: CARDINAL; padding: CHAR; sign: BOOLEAN) : String ;
+
+
+(*
+   ctos - cardinal to decimal string.
+*)
+
+PROCEDURE ctos (c: CARDINAL; width: CARDINAL; padding: CHAR) : String ;
+
+
+(*
+   stoc - decimal string to CARDINAL
+*)
+
+PROCEDURE stoc (s: String) : CARDINAL ;
+
+
+(*
+   hstoi - hexidecimal string to INTEGER
+*)
+
+PROCEDURE hstoi (s: String) : INTEGER ;
+
+
+(*
+   ostoi - octal string to INTEGER
+*)
+
+PROCEDURE ostoi (s: String) : INTEGER ;
+
+
+(*
+   bstoi - binary string to INTEGER
+*)
+
+PROCEDURE bstoi (s: String) : INTEGER ;
+
+
+(*
+   hstoc - hexidecimal string to CARDINAL
+*)
+
+PROCEDURE hstoc (s: String) : CARDINAL ;
+
+
+(*
+   ostoc - octal string to CARDINAL
+*)
+
+PROCEDURE ostoc (s: String) : CARDINAL ;
+
+
+(*
+   bstoc - binary string to CARDINAL
+*)
+
+PROCEDURE bstoc (s: String) : CARDINAL ;
+
+
+(*
+   StringToLongreal - returns a LONGREAL and sets found to TRUE
+                      if a legal number is seen.
+*)
+
+PROCEDURE StringToLongreal (s: String; VAR found: BOOLEAN) : LONGREAL ;
+
+
+(*
+   LongrealToString - converts a LONGREAL number, Real, which has,
+                      TotalWidth, and FractionWidth into a string.
+
+                      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'
+
+                      If TotalWidth is 0 then the function
+                      will return the value of x which is converted
+                      into as a fixed point number with exhaustive
+                      precision.
+*)
+
+PROCEDURE LongrealToString (x: LONGREAL;
+                            TotalWidth, FractionWidth: CARDINAL) : String ;
+
+
+(*
+   stor - returns a REAL given a string.
+*)
+
+PROCEDURE stor (s: String) : REAL ;
+
+
+(*
+   stolr - returns a LONGREAL given a string.
+*)
+
+PROCEDURE stolr (s: String) : LONGREAL ;
+
+
+(*
+   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
+*)
+
+PROCEDURE ToSigFig (s: String; n: CARDINAL) : String ;
+
+
+(*
+   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
+*)
+
+PROCEDURE ToDecimalPlaces (s: String; n: CARDINAL) : String ;
+
+
+END StringConvert.
diff --git a/gcc/m2/gm2-libs/StringConvert.mod b/gcc/m2/gm2-libs/StringConvert.mod
new file mode 100644
index 00000000000..f5af4507b00
--- /dev/null
+++ b/gcc/m2/gm2-libs/StringConvert.mod
@@ -0,0 +1,1406 @@
+(* StringConvert.mod provides functions to convert numbers to and from strings.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE StringConvert ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM libc IMPORT free, printf ;
+FROM libm IMPORT powl ;
+FROM M2RTS IMPORT ErrorMessage ;
+
+IMPORT DynamicStrings ;
+
+FROM DynamicStrings IMPORT String, InitString,
+                           InitStringChar, InitStringCharStar,
+                           Mark, ConCat, Dup, string,
+                           Slice, Index, char, Assign, Length, Mult,
+                           RemoveWhitePrefix, ConCatChar, KillString,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+FROM ldtoa IMPORT Mode, strtold, ldtoa ;
+IMPORT dtoa ;   (* this fixes linking - as the C ldtoa uses dtoa *)
+
+
+(*
+#undef GM2_DEBUG_STRINGCONVERT
+#if defined(GM2_DEBUG_STRINGCONVERT)
+#  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
+*)
+
+(*
+   Assert - implement a simple assert.
+*)
+
+PROCEDURE Assert (b: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL; func: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT b
+   THEN
+      ErrorMessage('assert failed', file, line, func)
+   END
+END Assert ;
+
+
+(*
+   Max -
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a>b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Max ;
+
+
+(*
+   Min -
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+(*
+   LongMin - returns the smallest LONGCARD
+*)
+
+PROCEDURE LongMin (a, b: LONGCARD) : LONGCARD ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END LongMin ;
+
+
+(*
+   IsDigit - returns TRUE if, ch, lies between '0'..'9'.
+*)
+
+PROCEDURE IsDigit (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch>='0') AND (ch<='9')
+END IsDigit ;
+
+
+(*
+   IsDecimalDigitValid - returns the TRUE if, ch, is a base legal decimal digit.
+                         If legal then the value is appended numerically onto, c.
+*)
+
+PROCEDURE IsDecimalDigitValid (ch: CHAR; base: CARDINAL; VAR c: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsDigit(ch) AND (ORD(ch)-ORD('0')<base)
+   THEN
+      c := c*base + (ORD(ch)-ORD('0')) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsDecimalDigitValid ;
+
+
+(*
+   IsHexidecimalDigitValid - returns the TRUE if, ch, is a base legal hexidecimal digit.
+                             If legal then the value is appended numerically onto, c.
+*)
+
+PROCEDURE IsHexidecimalDigitValid (ch: CHAR; base: CARDINAL; VAR c: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF (ch>='a') AND (ch<='f') AND (ORD(ch)-ORD('a')+10<base)
+   THEN
+      c := c*base + (ORD(ch)-ORD('a')+10) ;
+      RETURN( TRUE )
+   ELSIF (ch>='A') AND (ch<='F') AND (ORD(ch)-ORD('F')+10<base)
+   THEN
+      c := c*base + (ORD(ch)-ORD('A')+10) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsHexidecimalDigitValid ;
+
+
+(*
+   IsDecimalDigitValidLong - returns the TRUE if, ch, is a base legal decimal digit.
+                             If legal then the value is appended numerically onto, c.
+*)
+
+PROCEDURE IsDecimalDigitValidLong (ch: CHAR; base: CARDINAL;
+                                   VAR c: LONGCARD) : BOOLEAN ;
+BEGIN
+   IF IsDigit(ch) AND (ORD(ch)-ORD('0')<base)
+   THEN
+      c := c * VAL(LONGCARD, base + (ORD(ch)-ORD('0'))) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsDecimalDigitValidLong ;
+
+
+(*
+   IsHexidecimalDigitValidLong - returns the TRUE if, ch, is a base legal hexidecimal digit.
+                                 If legal then the value is appended numerically onto, c.
+*)
+
+PROCEDURE IsHexidecimalDigitValidLong (ch: CHAR; base:  CARDINAL; VAR c: LONGCARD) : BOOLEAN ;
+BEGIN
+   IF (ch>='a') AND (ch<='f') AND (ORD(ch)-ORD('a')+10<base)
+   THEN
+      c := c * VAL(LONGCARD, base + (ORD(ch)-ORD('a')+10)) ;
+      RETURN( TRUE )
+   ELSIF (ch>='A') AND (ch<='F') AND (ORD(ch)-ORD('F')+10<base)
+   THEN
+      c := c * VAL(LONGCARD, base + (ORD(ch)-ORD('A')+10)) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsHexidecimalDigitValidLong ;
+
+
+(*
+   IsDecimalDigitValidShort - returns the TRUE if, ch, is a base legal decimal digit.
+                              If legal then the value is appended numerically onto, c.
+*)
+
+PROCEDURE IsDecimalDigitValidShort (ch: CHAR; base: CARDINAL; VAR c: SHORTCARD) : BOOLEAN ;
+BEGIN
+   IF IsDigit(ch) AND (ORD(ch)-ORD('0')<base)
+   THEN
+      c := c * VAL(SHORTCARD, base + (ORD(ch)-ORD('0'))) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsDecimalDigitValidShort ;
+
+
+(*
+   IsHexidecimalDigitValidShort - returns the TRUE if, ch, is a base legal hexidecimal digit.
+                                  If legal then the value is appended numerically onto, c.
+*)
+
+PROCEDURE IsHexidecimalDigitValidShort (ch: CHAR; base: CARDINAL; VAR c: SHORTCARD) : BOOLEAN ;
+BEGIN
+   IF (ch>='a') AND (ch<='f') AND (ORD(ch)-ORD('a')+10<base)
+   THEN
+      c := c * VAL(SHORTCARD, base + (ORD(ch)-ORD('a')+10)) ;
+      RETURN( TRUE )
+   ELSIF (ch>='A') AND (ch<='F') AND (ORD(ch)-ORD('F')+10<base)
+   THEN
+      c := c * VAL(SHORTCARD, base + (ORD(ch)-ORD('A')+10)) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsHexidecimalDigitValidShort ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE IntegerToString (i: INTEGER; width: CARDINAL; padding: CHAR; sign: BOOLEAN;
+                           base: CARDINAL; lower: BOOLEAN) : String ;
+VAR
+   s: String ;
+   c: CARDINAL ;
+BEGIN
+   IF i<0
+   THEN
+      IF i=MIN(INTEGER)
+      THEN
+         (* remember that -15 MOD 4 = 1 in Modula-2 *)
+         c := VAL(CARDINAL, ABS(i+1))+1 ;
+         IF width>0
+         THEN
+            RETURN( ConCat(IntegerToString(-VAL(INTEGER, c DIV base),
+                                           width-1, padding, sign, base, lower),
+                           Mark(IntegerToString(c MOD base, 0, ' ', FALSE, base, lower))) )
+         ELSE
+            RETURN( ConCat(IntegerToString(-VAL(INTEGER, c DIV base),
+                                           0, padding, sign, base, lower),
+                           Mark(IntegerToString(c MOD base, 0, ' ', FALSE, base, lower))) )
+         END
+      ELSE
+         s := InitString('-')
+      END ;
+      i := -i
+   ELSE
+      IF sign
+      THEN
+         s := InitString('+')
+      ELSE
+         s := InitString('')
+      END
+   END ;
+   IF i>VAL(INTEGER, base)-1
+   THEN
+      s := ConCat(ConCat(s, Mark(IntegerToString(VAL(CARDINAL, i) DIV base, 0, ' ', FALSE, base, lower))),
+                  Mark(IntegerToString(VAL(CARDINAL, i) MOD base, 0, ' ', FALSE, base, lower)))
+   ELSE
+      IF i<=9
+      THEN
+         s := ConCat(s, Mark(InitStringChar(CHR(VAL(CARDINAL, i)+ORD('0')))))
+      ELSE
+         IF lower
+         THEN
+            s := ConCat(s, Mark(InitStringChar(CHR(VAL(CARDINAL, i)+ORD('a')-10))))
+         ELSE
+            s := ConCat(s, Mark(InitStringChar(CHR(VAL(CARDINAL, i)+ORD('A')-10))))
+         END
+      END
+   END ;
+   IF width>DynamicStrings.Length(s)
+   THEN
+      RETURN( ConCat(Mult(Mark(InitStringChar(padding)), width-DynamicStrings.Length(s)), Mark(s)) )
+   END ;
+   RETURN( s )
+END IntegerToString ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE CardinalToString (c: CARDINAL; width: CARDINAL; padding: CHAR;
+                            base: CARDINAL; lower: BOOLEAN) : String ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString('') ;
+   IF c>base-1
+   THEN
+      s := ConCat(ConCat(s, Mark(CardinalToString(c DIV base, 0, ' ', base, lower))),
+                  Mark(CardinalToString(c MOD base, 0, ' ', base, lower)))
+   ELSE
+      IF c<=9
+      THEN
+         s := ConCat(s, Mark(InitStringChar(CHR(c+ORD('0')))))
+      ELSE
+         IF lower
+         THEN
+            s := ConCat(s, Mark(InitStringChar(CHR(c+ORD('a')-10))))
+         ELSE
+            s := ConCat(s, Mark(InitStringChar(CHR(c+ORD('A')-10))))
+         END
+      END
+   END ;
+   IF width>DynamicStrings.Length(s)
+   THEN
+      RETURN( ConCat(Mult(Mark(InitStringChar(padding)), width-DynamicStrings.Length(s)), s) )
+   END ;
+   RETURN( s )
+END CardinalToString ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE LongIntegerToString (i: LONGINT; width: CARDINAL; padding: CHAR;
+                               sign: BOOLEAN; base: CARDINAL; lower: BOOLEAN) : String ;
+
+VAR
+   s: String ;
+   c: LONGCARD ;
+BEGIN
+   IF i<0
+   THEN
+      IF i=MIN(LONGINT)
+      THEN
+         (* 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 := VAL(LONGCARD, ABS(i+1))+1 ;
+         IF width>0
+         THEN
+            RETURN( ConCat(LongIntegerToString(-VAL(LONGINT, c DIV VAL(LONGCARD, base)),
+                                               width-1, padding, sign, base, lower),
+                           Mark(LongIntegerToString(c MOD VAL(LONGCARD, base), 0, ' ', FALSE, base, lower))) )
+         ELSE
+            RETURN( ConCat(LongIntegerToString(-VAL(LONGINT, c DIV VAL(LONGCARD, base)),
+                                               0, padding, sign, base, lower),
+                           Mark(LongIntegerToString(c MOD VAL(LONGCARD, base), 0, ' ', FALSE, base, lower))) )
+         END
+      ELSE
+         s := InitString('-')
+      END ;
+      i := -i
+   ELSE
+      IF sign
+      THEN
+         s := InitString('+')
+      ELSE
+         s := InitString('')
+      END
+   END ;
+   IF i>VAL(LONGINT, base-1)
+   THEN
+      s := ConCat(ConCat(s, Mark(LongIntegerToString(i DIV VAL(LONGINT, base), 0, ' ', FALSE, base, lower))),
+                  Mark(LongIntegerToString(i MOD VAL(LONGINT, base), 0, ' ', FALSE, base, lower)))
+   ELSE
+      IF i<=9
+      THEN
+         s := ConCat(s, Mark(InitStringChar(CHR(VAL(CARDINAL, i)+ORD('0')))))
+      ELSE
+         IF lower
+         THEN
+            s := ConCat(s, Mark(InitStringChar(CHR(VAL(CARDINAL, i)+ORD('a')-10))))
+         ELSE
+            s := ConCat(s, Mark(InitStringChar(CHR(VAL(CARDINAL, i)+ORD('A')-10))))
+         END
+      END
+   END ;
+   IF width>DynamicStrings.Length(s)
+   THEN
+      RETURN( ConCat(Mult(Mark(InitStringChar(padding)), width-DynamicStrings.Length(s)), s) )
+   END ;
+   RETURN( s )
+END LongIntegerToString ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToLongInteger (s: String; base: CARDINAL; VAR found: BOOLEAN) : LONGINT ;
+VAR
+   n, l    : CARDINAL ;
+   c       : LONGCARD ;
+   negative: BOOLEAN ;
+BEGIN
+   s := RemoveWhitePrefix(s) ;    (* returns a new string, s *)
+   l := DynamicStrings.Length(s) ;
+   c := 0 ;
+   n := 0 ;
+   negative := FALSE ;
+   IF n<l
+   THEN
+      (* parse leading + and - *)
+      WHILE (char(s, n)='-') OR (char(s, n)='+') DO
+         IF char(s, n)='-'
+         THEN
+            negative := NOT negative
+         END ;
+         INC(n)
+      END ;
+      WHILE (n<l) AND (IsDecimalDigitValidLong(char(s, n), base, c) OR
+                       IsHexidecimalDigitValidLong(char(s, n), base, c)) DO
+         found := TRUE ;
+         INC(n)
+      END
+   END ;
+   s := KillString(s) ;
+   IF negative
+   THEN
+      RETURN( -VAL(LONGINT, LongMin(VAL(LONGCARD, MAX(LONGINT))+1, c)) )
+   ELSE
+      RETURN( VAL(LONGINT, LongMin(MAX(LONGINT), c)) )
+   END
+END StringToLongInteger ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToInteger (s: String; base: CARDINAL;
+                           VAR found: BOOLEAN) : INTEGER ;
+VAR
+   n, l    : CARDINAL ;
+   c       : CARDINAL ;
+   negative: BOOLEAN ;
+BEGIN
+   s := RemoveWhitePrefix(s) ;    (* returns a new string, s *)
+   l := DynamicStrings.Length(s) ;
+   c := 0 ;
+   n := 0 ;
+   negative := FALSE ;
+   IF n<l
+   THEN
+      (* parse leading + and - *)
+      WHILE (char(s, n)='-') OR (char(s, n)='+') DO
+         IF char(s, n)='-'
+         THEN
+            negative := NOT negative
+         END ;
+         INC(n)
+      END ;
+      WHILE (n<l) AND (IsDecimalDigitValid(char(s, n), base, c) OR
+                       IsHexidecimalDigitValid(char(s, n), base, c)) DO
+         found := TRUE ;
+         INC(n)
+      END
+   END ;
+   s := KillString(s) ;
+   IF negative
+   THEN
+      RETURN( -VAL(INTEGER, Min(VAL(CARDINAL, MAX(INTEGER))+1, c)) )
+   ELSE
+      RETURN( VAL(INTEGER, Min(MAX(INTEGER), c)) )
+   END
+END StringToInteger ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToCardinal (s: String; base: CARDINAL;
+                            VAR found: BOOLEAN) : CARDINAL ;
+VAR
+   n, l: CARDINAL ;
+   c   : CARDINAL ;
+BEGIN
+   s := RemoveWhitePrefix(s) ;    (* returns a new string, s *)
+   l := DynamicStrings.Length(s) ;
+   c := 0 ;
+   n := 0 ;
+   IF n<l
+   THEN
+      (* parse leading + *)
+      WHILE (char(s, n)='+') DO
+         INC(n)
+      END ;
+      WHILE (n<l) AND (IsDecimalDigitValid(char(s, n), base, c) OR
+                       IsHexidecimalDigitValid(char(s, n), base, c)) DO
+         found := TRUE ;
+         INC(n)
+      END
+   END ;
+   s := KillString(s) ;
+   RETURN( c )
+END StringToCardinal ;
+
+
+(*
+   stoi - decimal string to INTEGER
+*)
+
+PROCEDURE stoi (s: String) : INTEGER ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToInteger(s, 10, found) )
+END stoi ;
+
+
+(*
+   itos - integer to decimal string.
+*)
+
+PROCEDURE itos (i: INTEGER; width: CARDINAL; padding: CHAR; sign: BOOLEAN) : String ;
+BEGIN
+   RETURN( IntegerToString(i, width, padding, sign, 10, FALSE) )
+END itos ;
+
+
+(*
+   ctos - cardinal to decimal string.
+*)
+
+PROCEDURE ctos (c: CARDINAL; width: CARDINAL; padding: CHAR) : String ;
+BEGIN
+   RETURN( CardinalToString(c, width, padding, 10, FALSE) )
+END ctos ;
+
+
+(*
+   stoc - decimal string to CARDINAL
+*)
+
+PROCEDURE stoc (s: String) : CARDINAL ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToCardinal(s, 10, found) )
+END stoc ;
+
+
+(*
+   hstoi - hexidecimal string to INTEGER
+*)
+
+PROCEDURE hstoi (s: String) : INTEGER ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToInteger(s, 16, found) )
+END hstoi ;
+
+
+(*
+   ostoi - octal string to INTEGER
+*)
+
+PROCEDURE ostoi (s: String) : INTEGER ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToInteger(s, 8, found) )
+END ostoi ;
+
+
+(*
+   bstoi - binary string to INTEGER
+*)
+
+PROCEDURE bstoi (s: String) : INTEGER ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToInteger(s, 2, found) )
+END bstoi ;
+
+
+(*
+   hstoc - hexidecimal string to CARDINAL
+*)
+
+PROCEDURE hstoc (s: String) : CARDINAL ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToCardinal(s, 16, found) )
+END hstoc ;
+
+
+(*
+   ostoc - octal string to CARDINAL
+*)
+
+PROCEDURE ostoc (s: String) : CARDINAL ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToCardinal(s, 8, found) )
+END ostoc ;
+
+
+(*
+   bstoc - binary string to CARDINAL
+*)
+
+PROCEDURE bstoc (s: String) : CARDINAL ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToCardinal(s, 2, found) )
+END bstoc ;
+
+
+(* **********************************************************************
+   R e a l    a n d    L o n g R e a l    c o n v e r s i o n
+   ********************************************************************** *)
+
+
+(*
+   ToThePower10 - returns a LONGREAL containing the value of v * 10^power.
+*)
+
+PROCEDURE ToThePower10 (v: LONGREAL; power: INTEGER) : LONGREAL;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := 0 ;
+   IF power>0
+   THEN
+      WHILE i<power DO
+         v := v * 10.0 ;
+         INC(i)
+      END
+   ELSE
+      WHILE i>power DO
+         v := v / 10.0 ;
+         DEC(i)
+      END
+   END ;
+   RETURN( v )
+END ToThePower10 ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE DetermineSafeTruncation () : CARDINAL ;
+VAR
+   MaxPowerOfTen: REAL ;
+   LogPower     : CARDINAL ;
+BEGIN
+   MaxPowerOfTen := 1.0 ;
+   LogPower      := 0 ;
+   WHILE MaxPowerOfTen*10.0<FLOAT(MAX(INTEGER) DIV 10) DO
+      MaxPowerOfTen := MaxPowerOfTen * 10.0 ;
+      INC(LogPower)
+   END ;
+   RETURN( LogPower )
+END DetermineSafeTruncation ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE LongrealToString (x: LONGREAL;
+                            TotalWidth, FractionWidth: CARDINAL) : String ;
+VAR
+   maxprecision: BOOLEAN ;
+   s           : String ;
+   r           : ADDRESS ;
+   point       : INTEGER ;
+   sign        : BOOLEAN ;
+   l           : INTEGER ;
+BEGIN
+   IF TotalWidth=0
+   THEN
+      maxprecision := TRUE ;
+      r := ldtoa(x, decimaldigits, 100, point, sign)
+   ELSE
+      r := ldtoa(x, decimaldigits, 100, point, sign)
+   END ;
+   s := InitStringCharStar(r) ;
+   free(r) ;
+   l := DynamicStrings.Length(s) ;
+   IF point>l
+   THEN
+      s := ConCat(s, Mark(Mult(Mark(InitStringChar('0')), point-l))) ;
+      s := ConCat(s, Mark(InitString('.0'))) ;
+      IF (NOT maxprecision) AND (FractionWidth>0)
+      THEN
+         DEC(FractionWidth) ;
+         IF VAL(INTEGER, FractionWidth)>point-l
+         THEN
+            s := ConCat(s, Mark(Mult(Mark(InitString('0')), FractionWidth)))
+         END
+      END
+   ELSIF point<0
+   THEN
+      s := ConCat(Mult(Mark(InitStringChar('0')), -point), Mark(s)) ;
+      l := DynamicStrings.Length(s) ;
+      s := ConCat(InitString('0.'), Mark(s)) ;
+      IF (NOT maxprecision) AND (l<VAL(INTEGER, FractionWidth))
+      THEN
+         s := ConCat(s, Mark(Mult(Mark(InitString('0')), VAL(INTEGER, FractionWidth)-l)))
+      END
+   ELSE
+      IF point=0
+      THEN
+         s := ConCat(InitString('0.'), Mark(Slice(Mark(s), point, 0)))
+      ELSE
+         s := ConCat(ConCatChar(Slice(Mark(s), 0, point), '.'),
+                     Mark(Slice(Mark(s), point, 0)))
+      END ;
+      IF (NOT maxprecision) AND (l-point<VAL(INTEGER, FractionWidth))
+      THEN
+         s := ConCat(s, Mark(Mult(Mark(InitString('0')), VAL(INTEGER, FractionWidth)-(l-point))))
+      END
+   END ;
+   IF DynamicStrings.Length(s)>TotalWidth
+   THEN
+      IF TotalWidth>0
+      THEN
+         IF sign
+         THEN
+            s := Slice(Mark(ToDecimalPlaces(s, FractionWidth)), 0, TotalWidth-1) ;
+            s := ConCat(InitStringChar('-'), Mark(s)) ;
+            sign := FALSE
+         ELSE
+            (* minus 1 because all results will include a '.' *)
+            s := Slice(Mark(ToDecimalPlaces(s, FractionWidth)), 0, TotalWidth) ;
+         END
+      ELSE
+         IF sign
+         THEN
+            s := ToDecimalPlaces(s, FractionWidth) ;
+            s := ConCat(InitStringChar('-'), Mark(s)) ;
+            sign := FALSE
+         ELSE
+            (* minus 1 because all results will include a '.' *)
+            s := ToDecimalPlaces(s, FractionWidth)
+         END
+      END
+   END ;
+   IF DynamicStrings.Length(s)<TotalWidth
+   THEN
+      s := ConCat(Mult(Mark(InitStringChar(' ')), TotalWidth-DynamicStrings.Length(s)), Mark(s))
+   END ;
+   RETURN( s )
+END LongrealToString ;
+
+
+(*
+   StringToLongreal - returns a LONGREAL and sets found to TRUE if a legal number is seen.
+*)
+
+PROCEDURE StringToLongreal (s: String; VAR found: BOOLEAN) : LONGREAL ;
+VAR
+   error: BOOLEAN ;
+   value: LONGREAL ;
+BEGIN
+   s := RemoveWhitePrefix(s) ;   (* new string is created *)
+   value := strtold(string(s), error) ;
+   s := KillString(s) ;
+   found := NOT error ;
+   RETURN value
+END StringToLongreal ;
+
+
+(*
+   rtos -
+*)
+
+PROCEDURE rtos (r: REAL; TotalWidth, FractionWidth: CARDINAL) : String ;
+BEGIN
+   HALT ;
+   RETURN ( NIL )
+END rtos ;
+
+
+(*
+   stor - returns a REAL given a string.
+*)
+
+PROCEDURE stor (s: String) : REAL ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( VAL(REAL, StringToLongreal(s, found)) )
+END stor ;
+
+
+(*
+   lrtos -
+*)
+
+PROCEDURE lrtos (r: LONGREAL; TotalWidth, FractionWidth: CARDINAL) : String ;
+BEGIN
+   HALT ;
+   RETURN ( NIL )
+END lrtos ;
+
+
+(*
+   stolr - returns a LONGREAL given a string.
+*)
+
+PROCEDURE stolr (s: String) : LONGREAL ;
+VAR
+   found: BOOLEAN ;
+BEGIN
+   RETURN( StringToLongreal(s, found) )
+END stolr ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE LongCardinalToString (c: LONGCARD; width: CARDINAL; padding: CHAR;
+                                base: CARDINAL; lower: BOOLEAN) : String ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString('') ;
+   IF c>VAL(LONGCARD, base-1)
+   THEN
+      s := ConCat(ConCat(s, LongCardinalToString(c DIV VAL(LONGCARD, base), 0, ' ', base, lower)),
+                  LongCardinalToString(c MOD VAL(LONGCARD, base), 0, ' ', base, lower))
+   ELSE
+      IF c<=9
+      THEN
+         s := ConCat(s, InitStringChar(CHR(VAL(CARDINAL, c)+ORD('0'))))
+      ELSE
+         IF lower
+         THEN
+            s := ConCat(s, InitStringChar(CHR(VAL(CARDINAL, c)+ORD('a')-10)))
+         ELSE
+            s := ConCat(s, InitStringChar(CHR(VAL(CARDINAL, c)+ORD('A')-10)))
+         END
+      END
+   END ;
+   IF width>DynamicStrings.Length(s)
+   THEN
+      RETURN( ConCat(Mult(Mark(InitStringChar(padding)), width-DynamicStrings.Length(s)), s) )
+   END ;
+   RETURN( s )
+END LongCardinalToString ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToLongCardinal (s: String; base: CARDINAL; VAR found: BOOLEAN) : LONGCARD ;
+VAR
+   n, l: CARDINAL ;
+   c   : LONGCARD ;
+BEGIN
+   s := RemoveWhitePrefix(s) ;    (* returns a new string, s *)
+   l := DynamicStrings.Length(s) ;
+   c := 0 ;
+   n := 0 ;
+   IF n<l
+   THEN
+      (* parse leading + *)
+      WHILE (char(s, n)='+') DO
+         INC(n)
+      END ;
+      WHILE (n<l) AND (IsDecimalDigitValidLong(char(s, n), base, c) OR
+                       IsHexidecimalDigitValidLong(char(s, n), base, c)) DO
+         found := TRUE ;
+         INC(n)
+      END
+   END ;
+   s := KillString(s) ;
+   RETURN( c )
+END StringToLongCardinal ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ShortCardinalToString (c: SHORTCARD; width: CARDINAL; padding: CHAR;
+                                base: CARDINAL; lower: BOOLEAN) : String ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString('') ;
+   IF VAL(CARDINAL, c)>base-1
+   THEN
+      s := ConCat(ConCat(s, ShortCardinalToString(c DIV VAL(SHORTCARD, base), 0, ' ', base, lower)),
+                  ShortCardinalToString(c MOD VAL(SHORTCARD, base), 0, ' ', base, lower))
+   ELSE
+      IF c<=9
+      THEN
+         s := ConCat(s, InitStringChar(CHR(VAL(CARDINAL, c)+ORD('0'))))
+      ELSE
+         IF lower
+         THEN
+            s := ConCat(s, InitStringChar(CHR(VAL(CARDINAL, c)+ORD('a')-10)))
+         ELSE
+            s := ConCat(s, InitStringChar(CHR(VAL(CARDINAL, c)+ORD('A')-10)))
+         END
+      END
+   END ;
+   IF width>DynamicStrings.Length(s)
+   THEN
+      RETURN( ConCat(Mult(Mark(InitStringChar(padding)), width-DynamicStrings.Length(s)), s) )
+   END ;
+   RETURN( s )
+END ShortCardinalToString ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE StringToShortCardinal (s: String; base: CARDINAL;
+                                 VAR found: BOOLEAN) : SHORTCARD ;
+VAR
+   n, l: CARDINAL ;
+   c   : SHORTCARD ;
+BEGIN
+   s := RemoveWhitePrefix(s) ;    (* returns a new string, s *)
+   l := DynamicStrings.Length(s) ;
+   c := 0 ;
+   n := 0 ;
+   IF n<l
+   THEN
+      (* parse leading + *)
+      WHILE (char(s, n)='+') DO
+         INC(n)
+      END ;
+      WHILE (n<l) AND (IsDecimalDigitValidShort(char(s, n), base, c) OR
+                       IsHexidecimalDigitValidShort(char(s, n), base, c)) DO
+         found := TRUE ;
+         INC(n)
+      END
+   END ;
+   s := KillString(s) ;
+   RETURN( c )
+END StringToShortCardinal ;
+
+
+(*
+   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
+*)
+
+PROCEDURE ToDecimalPlaces (s: String; n: CARDINAL) : String ;
+VAR
+   point: INTEGER ;
+BEGIN
+   Assert(IsDigit(char(s, 0)) OR (char(s, 0)='.'), __FILE__, __LINE__, __FUNCTION__) ;
+   point := Index(s, '.', 0) ;
+   IF point<0
+   THEN
+      IF n>0
+      THEN
+         RETURN( ConCat(ConCat(s, Mark(InitStringChar('.'))), Mult(Mark(InitStringChar('0')), n)) )
+      ELSE
+         RETURN( s )
+      END
+   END ;
+   s := doDecimalPlaces(s, n) ;
+   (* if the last character is '.' remove it *)
+   IF (DynamicStrings.Length(s)>0) AND (char(s, -1)='.')
+   THEN
+      RETURN( Slice(Mark(s), 0, -1) )
+   ELSE
+      RETURN( s )
+   END
+END ToDecimalPlaces ;
+
+
+(*
+   doDecimalPlaces - returns a string which is accurate to
+                     n decimal places.  It returns a new String
+                     and, s, will be destroyed.
+*)
+
+PROCEDURE doDecimalPlaces (s: String; n: CARDINAL) : String ;
+VAR
+   i, l,
+   point    : INTEGER ;
+   t,
+   whole,
+   fraction,
+   tenths,
+   hundreths: String ;
+BEGIN
+   l := DynamicStrings.Length(s) ;
+   i := 0 ;
+   (* remove '.' *)
+   point := Index(s, '.', 0) ;
+   IF point=0
+   THEN
+      s := Slice(Mark(s), 1, 0)
+   ELSIF point<l
+   THEN
+      s := ConCat(Slice(Mark(s), 0, point),
+                  Mark(Slice(Mark(s), point+1, 0)))
+   ELSE
+      s := Slice(Mark(s), 0, point)
+   END ;
+   l := DynamicStrings.Length(s) ;
+   i := 0 ;
+   IF l>0
+   THEN
+      (* skip over leading zeros *)
+      WHILE (i<l) AND (char(s, i)='0') DO
+         INC(i)
+      END ;
+      (* was the string full of zeros? *)
+      IF (i=l) AND (char(s, i-1)='0')
+      THEN
+         s := KillString(s) ;
+         s := ConCat(InitString('0.'), Mark(Mult(Mark(InitStringChar('0')), n))) ;
+         RETURN( s )
+      END
+   END ;
+   (* add a leading zero in case we need to overflow the carry *)
+   (* insert leading zero *)
+   s := ConCat(InitStringChar('0'), Mark(s)) ;
+   INC(point) ;  (* and move point position to correct place *)
+   l := DynamicStrings.Length(s) ;   (* update new length *)
+   i := point ;
+   WHILE (n>1) AND (i<l) DO
+      DEC(n) ;
+      INC(i)
+   END ;
+   IF i+3<=l
+   THEN
+      t := Dup(s) ;
+      hundreths := Slice(Mark(s), i+1, i+3) ;
+      s := t ;
+      IF stoc(hundreths)>=50
+      THEN
+         s := carryOne(Mark(s), i)
+      END ;
+      hundreths := KillString(hundreths)
+   ELSIF i+2<=l
+   THEN
+      t := Dup(s) ;
+      tenths := Slice(Mark(s), i+1, i+2) ;
+      s := t ;
+      IF stoc(tenths)>=5
+      THEN
+         s := carryOne(Mark(s), i)
+      END ;
+      tenths := KillString(tenths)
+   END ;
+   (* check whether we need to remove the leading zero *)
+   IF char(s, 0)='0'
+   THEN
+      s := Slice(Mark(s), 1, 0) ;
+      DEC(l) ;
+      DEC(point)
+   END ;
+   IF i<l
+   THEN
+      s := Slice(Mark(s), 0, i) ;
+      l := DynamicStrings.Length(s) ;
+      IF l<point
+      THEN
+         s := ConCat(s, Mult(Mark(InitStringChar('0')), point-l))
+      END
+   END ;
+   (* re-insert the point *)
+   IF point>=0
+   THEN
+      IF point=0
+      THEN
+         s := ConCat(InitStringChar('.'), Mark(s))
+      ELSE
+         s := ConCat(ConCatChar(Slice(Mark(s), 0, point), '.'),
+                     Mark(Slice(Mark(s), point, 0)))
+      END
+   END ;
+   RETURN( s )
+END doDecimalPlaces ;
+
+
+(*
+   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
+*)
+
+PROCEDURE ToSigFig (s: String; n: CARDINAL) : String ;
+VAR
+   point: INTEGER ;
+   poTen: CARDINAL ;
+BEGIN
+   Assert(IsDigit(char(s, 0)) OR (char(s, 0)='.'), __FILE__, __LINE__, __FUNCTION__) ;
+   point := Index(s, '.', 0) ;
+   IF point<0
+   THEN
+      poTen := DynamicStrings.Length(s)
+   ELSE
+      poTen := point
+   END ;
+   s := doSigFig(s, n) ;
+   (* if the last character is '.' remove it *)
+   IF (DynamicStrings.Length(s)>0) AND (char(s, -1)='.')
+   THEN
+      RETURN( Slice(Mark(s), 0, -1) )
+   ELSE
+      IF poTen>DynamicStrings.Length(s)
+      THEN
+         s := ConCat(s, Mark(Mult(Mark(InitStringChar('0')), poTen-DynamicStrings.Length(s))))
+      END ;
+      RETURN( s )
+   END
+END ToSigFig ;
+
+
+(*
+   doSigFig - returns a string which is accurate to
+              n decimal places.  It returns a new String
+              and, s, will be destroyed.
+*)
+
+PROCEDURE doSigFig (s: String; n: CARDINAL) : String ;
+VAR
+   i, l, z,
+   point    : INTEGER ;
+   t,
+   tenths,
+   hundreths: String ;
+BEGIN
+   l := DynamicStrings.Length(s) ;
+   i := 0 ;
+   (* remove '.' *)
+   point := Index(s, '.', 0) ;
+   IF point>=0
+   THEN
+      IF point=0
+      THEN
+         s := Slice(Mark(s), 1, 0)
+      ELSIF point<l
+      THEN
+         s := ConCat(Slice(Mark(s), 0, point),
+                     Mark(Slice(Mark(s), point+1, 0)))
+      ELSE
+         s := Slice(Mark(s), 0, point)
+      END
+   ELSE
+      s := Dup(Mark(s))
+   END ;
+   l := DynamicStrings.Length(s) ;
+   i := 0 ;
+   IF l>0
+   THEN
+      (* skip over leading zeros *)
+      WHILE (i<l) AND (char(s, i)='0') DO
+         INC(i)
+      END ;
+      (* was the string full of zeros? *)
+      IF (i=l) AND (char(s, i-1)='0')
+      THEN
+         (* truncate string *)
+         s := Slice(Mark(s), 0, n) ;
+         i := n
+      END
+   END ;
+   (* add a leading zero in case we need to overflow the carry *)
+   z := i ;  (* remember where we inserted zero *)
+   IF z=0
+   THEN
+      s := ConCat(InitStringChar('0'), Mark(s))
+   ELSE
+      s := ConCat(ConCatChar(Slice(Mark(s), 0, i), '0'),
+                  Mark(Slice(Mark(s), i, 0)))
+   END ;
+   INC(n) ;  (* and increase the number of sig figs needed *)
+   l := DynamicStrings.Length(s) ;
+   WHILE (n>1) AND (i<l) DO
+      DEC(n) ;
+      INC(i)
+   END ;
+   IF i+3<=l
+   THEN
+      t := Dup(s) ;
+      hundreths := Slice(Mark(s), i+1, i+3) ;
+      s := t ;
+      IF stoc(hundreths)>=50
+      THEN
+         s := carryOne(Mark(s), i)
+      END ;
+      hundreths := KillString(hundreths)
+   ELSIF i+2<=l
+   THEN
+      t := Dup(s) ;
+      tenths := Slice(Mark(s), i+1, i+2) ;
+      s := t ;
+      IF stoc(tenths)>=5
+      THEN
+         s := carryOne(Mark(s), i)
+      END ;
+      tenths := KillString(tenths)
+   END ;
+   (* check whether we need to remove the leading zero *)
+   IF char(s, z)='0'
+   THEN
+      IF z=0
+      THEN
+         s := Slice(Mark(s), z+1, 0)
+      ELSE
+         s := ConCat(Slice(Mark(s), 0, z),
+                     Mark(Slice(Mark(s), z+1, 0)))
+      END ;
+      l := DynamicStrings.Length(s)
+   ELSE
+      INC(point)
+   END ;
+   IF i<l
+   THEN
+      s := Slice(Mark(s), 0, i) ;
+      l := DynamicStrings.Length(s) ;
+      IF l<point
+      THEN
+         s := ConCat(s, Mult(Mark(InitStringChar('0')), point-l))
+      END
+   END ;
+   (* re-insert the point *)
+   IF point>=0
+   THEN
+      IF point=0
+      THEN
+         s := ConCat(InitStringChar('.'), Mark(s))
+      ELSE
+         s := ConCat(ConCatChar(Slice(Mark(s), 0, point), '.'),
+                     Mark(Slice(Mark(s), point, 0)))
+      END
+   END ;
+   RETURN( s )
+END doSigFig ;
+
+
+(*
+   carryOne - add a carry at position, i.
+*)
+
+PROCEDURE carryOne (s: String; i: CARDINAL) : String ;
+BEGIN
+   IF i>=0
+   THEN
+      IF IsDigit(char(s, i))
+      THEN
+         IF char(s, i)='9'
+         THEN
+            IF i=0
+            THEN
+               s := ConCat(InitStringChar('1'), Mark(s)) ;
+               RETURN s
+            ELSE
+               s := ConCat(ConCatChar(Slice(Mark(s), 0, i), '0'),
+                           Mark(Slice(Mark(s), i+1, 0))) ;
+               RETURN carryOne(s, i-1)
+            END
+         ELSE
+            IF i=0
+            THEN
+               s := ConCat(InitStringChar(CHR(ORD(char(s, i))+1)),
+                           Mark(Slice(Mark(s), i+1, 0)))
+            ELSE
+               s := ConCat(ConCatChar(Slice(Mark(s), 0, i),
+                                      CHR(ORD(char(s, i))+1)),
+                           Mark(Slice(Mark(s), i+1, 0)))
+            END
+         END
+      END
+   END ;
+   RETURN s
+END carryOne ;
+
+
+END StringConvert.
diff --git a/gcc/m2/gm2-libs/SysExceptions.def b/gcc/m2/gm2-libs/SysExceptions.def
new file mode 100644
index 00000000000..a12bdc4e19e
--- /dev/null
+++ b/gcc/m2/gm2-libs/SysExceptions.def
@@ -0,0 +1,47 @@
+(* SysExceptions.def provides a mechanism for the underlying libraries to.
+
+Copyright (C) 2009-2021 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/>.  *)
+
+DEFINITION MODULE SysExceptions ;
+
+(* Provides a mechanism for the underlying libraries to
+   configure the exception routines.  This mechanism
+   is used by both the ISO and PIM libraries.
+   It is written to be ISO compliant and this also
+   allows for mixed dialect projects.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   PROCEXCEPTION = PROCEDURE (ADDRESS) ;
+
+PROCEDURE InitExceptionHandlers (indexf, range, casef, invalidloc,
+                                 function, wholevalue, wholediv,
+                                 realvalue, realdiv, complexvalue,
+                                 complexdiv, protection, systemf,
+                                 coroutine, exception: PROCEXCEPTION) ;
+
+
+END SysExceptions.
diff --git a/gcc/m2/gm2-libs/SysStorage.def b/gcc/m2/gm2-libs/SysStorage.def
new file mode 100644
index 00000000000..91f461eb65a
--- /dev/null
+++ b/gcc/m2/gm2-libs/SysStorage.def
@@ -0,0 +1,81 @@
+(* SysStorage.def provides dynamic allocation for the system components.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE SysStorage ;
+
+(*  Provides dynamic allocation for the system components.
+    This allows the application to use the traditional Storage module
+    which can be handled differently.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED ALLOCATE, DEALLOCATE, REALLOCATE, Available, Init ;
+
+
+(*
+   ALLOCATE - attempt to allocate memory from the heap.
+              NIL is returned in, a, if ALLOCATE fails.
+*)
+
+PROCEDURE ALLOCATE (VAR a: ADDRESS ; size: CARDINAL) ;
+
+
+(*
+   DEALLOCATE - return, size, bytes to the heap.
+                The variable, a, is set to NIL.
+*)
+
+PROCEDURE DEALLOCATE (VAR a: ADDRESS ; size: CARDINAL) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE REALLOCATE (VAR a: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   Available - returns TRUE if, size, bytes can be allocated.
+*)
+
+PROCEDURE Available (size: CARDINAL) : BOOLEAN;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Init ;
+
+
+END SysStorage.
diff --git a/gcc/m2/gm2-libs/SysStorage.mod b/gcc/m2/gm2-libs/SysStorage.mod
new file mode 100644
index 00000000000..60da9248112
--- /dev/null
+++ b/gcc/m2/gm2-libs/SysStorage.mod
@@ -0,0 +1,181 @@
+(* SysStorage.mod provides dynamic allocation for the system components.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE SysStorage ;
+
+FROM libc IMPORT malloc, free, realloc, memset, getenv, printf ;
+FROM Debug IMPORT Halt ;
+FROM SYSTEM IMPORT ADR ;
+
+
+CONST
+   enableDeallocation =  TRUE ;
+   enableZero         = FALSE ;
+   enableTrace        = FALSE ;
+
+VAR
+   callno: CARDINAL ;
+   zero,
+   trace : BOOLEAN ;
+
+
+PROCEDURE ALLOCATE (VAR a: ADDRESS ; size: CARDINAL) ;
+BEGIN
+   a := malloc (size) ;
+   IF a = NIL
+   THEN
+      Halt ('out of memory error', __LINE__, __FILE__)
+   END ;
+   IF enableTrace AND trace
+   THEN
+      printf ("<DEBUG-CALL> %d SysStorage.ALLOCATE (0x%x, %d bytes)\n", callno, a, size) ;
+      printf ("<MEM-ALLOC> %ld %d\n", a, size);
+      INC (callno)
+   END
+END ALLOCATE ;
+
+
+PROCEDURE DEALLOCATE (VAR a: ADDRESS; size: CARDINAL);
+BEGIN
+   IF enableTrace AND trace
+   THEN
+      printf ("<DEBUG-CALL> %d SysStorage.DEALLOCATE (0x%x, %d bytes)\n", callno, a, size) ;
+      INC (callno)
+   END ;
+   IF enableZero AND zero
+   THEN
+      IF enableTrace AND trace
+      THEN
+         printf ("  memset (0x%x, 0, %d bytes)\n", a, size)
+      END ;
+      IF memset (a, 0, size) # a
+      THEN
+         Halt ('memset should have returned the first parameter', __LINE__, __FILE__)
+      END
+   END ;
+   IF enableDeallocation
+   THEN
+      IF enableTrace AND trace
+      THEN
+         printf ("  free (0x%x)   %d bytes\n", a, size) ;
+         printf ("<MEM-FREE> %ld %d\n", a, size);
+      END ;
+      free (a)
+   END ;
+   a := NIL
+END DEALLOCATE ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE REALLOCATE (VAR a: ADDRESS; size: CARDINAL) ;
+BEGIN
+   IF a = NIL
+   THEN
+      ALLOCATE (a, size)
+   ELSE
+      IF enableTrace AND trace
+      THEN
+         printf ("<DEBUG-CALL> %d SysStorage.REALLOCATE (0x%x, %d bytes)\n", callno, a, size) ;
+         INC (callno)
+      END ;
+      IF enableTrace AND trace
+      THEN
+         printf ("  realloc (0x%x, %d bytes)  ->  ", a, size) ;
+         printf ("<MEM-FREE> %ld %d\n", a, size)
+      END ;
+      a := realloc (a, size) ;
+      IF a = NIL
+      THEN
+         Halt ('out of memory error', __LINE__, __FILE__)
+      END ;
+      IF enableTrace AND trace
+      THEN
+         printf ("<MEM-ALLOC> %ld %d\n", a, size) ;
+         printf ("  0x%x  %d bytes\n", a, size)
+      END
+   END
+END REALLOCATE ;
+
+
+PROCEDURE Available (size: CARDINAL) : BOOLEAN;
+VAR
+   a: ADDRESS ;
+BEGIN
+   IF enableTrace AND trace
+   THEN
+      printf ("<DEBUG-CALL> %d SysStorage.Available (%d bytes)\n", callno, size) ;
+      INC (callno)
+   END ;
+   a := malloc (size) ;
+   IF a = NIL
+   THEN
+      IF enableTrace AND trace
+      THEN
+         printf ("   no\n", size)
+      END ;
+      RETURN FALSE
+   ELSE
+      IF enableTrace AND trace
+      THEN
+         printf ("   yes\n", size)
+      END ;
+      free (a) ;
+      RETURN TRUE
+   END
+END Available ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Init ;
+END Init ;
+
+
+BEGIN
+   callno := 0 ;
+   IF enableTrace
+   THEN
+      trace := getenv (ADR ("M2DEBUG_SYSSTORAGE_trace")) # NIL
+   ELSE
+      trace := FALSE
+   END ;
+   IF enableZero
+   THEN
+      zero := getenv (ADR ("M2DEBUG_SYSSTORAGE_zero")) # NIL
+   ELSE
+      zero := FALSE
+   END
+END SysStorage.
diff --git a/gcc/m2/gm2-libs/TimeString.def b/gcc/m2/gm2-libs/TimeString.def
new file mode 100644
index 00000000000..c6204185f15
--- /dev/null
+++ b/gcc/m2/gm2-libs/TimeString.def
@@ -0,0 +1,40 @@
+(* TimeString.def provides time related string manipulation procedures.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE TimeString ;
+
+EXPORT QUALIFIED GetTimeString ;
+
+
+(*
+   GetTimeString - places the time in ascii format into array, a.
+
+*)
+
+PROCEDURE GetTimeString (VAR a: ARRAY OF CHAR) ;
+
+
+END TimeString.
diff --git a/gcc/m2/gm2-libs/TimeString.mod b/gcc/m2/gm2-libs/TimeString.mod
new file mode 100644
index 00000000000..5ad642ff81c
--- /dev/null
+++ b/gcc/m2/gm2-libs/TimeString.mod
@@ -0,0 +1,62 @@
+(* TimeString.mod provides time related string manipulation procedures.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE TimeString ;
+
+
+FROM wrapc IMPORT strtime ;
+FROM ASCII IMPORT nul ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   GetTimeString - places the time in ascii format into array, a.
+
+*)
+
+PROCEDURE GetTimeString (VAR a: ARRAY OF CHAR) ;
+VAR
+   Addr: POINTER TO CHAR ;
+   i   : CARDINAL ;
+BEGIN
+   Addr := strtime() ;
+   i := 0 ;
+   IF Addr#NIL
+   THEN
+      WHILE (i<HIGH(a)) AND (Addr^#nul) DO
+         a[i] := Addr^ ;
+         INC(i) ;
+         INC(Addr)
+      END
+   END ;
+   IF i<HIGH(a)
+   THEN
+      a[i] := nul
+   END
+END GetTimeString ;
+
+
+END TimeString.
diff --git a/gcc/m2/gm2-libs/UnixArgs.def b/gcc/m2/gm2-libs/UnixArgs.def
new file mode 100644
index 00000000000..23a21b8ce00
--- /dev/null
+++ b/gcc/m2/gm2-libs/UnixArgs.def
@@ -0,0 +1,38 @@
+(* UnixArgs.def Implements access to the arguments argc, argv, envp.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE UnixArgs ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED GetArgC, GetArgV, GetEnvV ;
+
+PROCEDURE GetArgC () : INTEGER ;
+PROCEDURE GetArgV () : ADDRESS ;
+PROCEDURE GetEnvV () : ADDRESS ;
+
+
+END UnixArgs.
diff --git a/gcc/m2/gm2-libs/cbuiltin.def b/gcc/m2/gm2-libs/cbuiltin.def
new file mode 100644
index 00000000000..24d6647ceca
--- /dev/null
+++ b/gcc/m2/gm2-libs/cbuiltin.def
@@ -0,0 +1,208 @@
+(* cbuiltin.def provides non-builtin equivalent routines.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" cbuiltin ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT UNQUALIFIED alloca, memcpy,
+		   isfinite, isfinitef, isfinitel,
+		   isinf_sign, isinf_signf, isinf_signl,
+                   sinf, sinl, sin,
+                   cosf, cosl, cos,
+                   atan2f, atan2l, atan2,
+                   sqrtf, sqrtl, sqrt,
+                   fabsf, fabsl, fabs,
+                   logf, logl, log,
+                   expf, expl, exp,
+                   log10f, log10l, log10,
+                   exp10f, exp10l, exp10,
+                   ilogbf, ilogbl, ilogb,
+                   significand, significandf, significandl,
+                   modf, modff, modfl,
+                   nextafter, nextafterf, nextafterl,
+                   nexttoward, nexttowardf, nexttowardl,
+                   scalb, scalbf, scalbl,
+                   scalbn, scalbnf, scalbnl,
+                   scalbln, scalblnf, scalblnl,
+
+                   cabsf, cabsl, cabs,
+                   cargf, carg, cargl,
+                   conjf, conj, conjl,
+                   cpowf, cpow, cpowl,
+                   csqrtf, csqrt, csqrtl,
+                   cexpf, cexp, cexpl,
+                   clogf, clog, clogl,
+                   csinf, csin, csinl,
+                   ccosf, ccos, ccosl,
+                   ctanf, ctan, ctanl,
+                   casinf, casin, casinl,
+                   cacosf, cacos, cacosl,
+                   catanf, catan, catanl,
+
+                   index, rindex,
+                   memcmp, memset, memmove,
+                   strcat, strncat, strcpy, strncpy, strcmp, strncmp,
+                   strlen, strstr, strpbrk, strspn, strcspn, strchr, strrchr ;
+
+PROCEDURE alloca (i: CARDINAL) : ADDRESS ;
+PROCEDURE memcpy (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+PROCEDURE isfinite (x: REAL) : BOOLEAN ;
+PROCEDURE isfinitel (x: LONGREAL) : BOOLEAN ;
+PROCEDURE isfinitef (x: SHORTREAL) : BOOLEAN ;
+PROCEDURE isinf_sign (x: REAL) : BOOLEAN ;
+PROCEDURE isinf_signl (x: LONGREAL) : BOOLEAN ;
+PROCEDURE isinf_signf (x: SHORTREAL) : BOOLEAN ;
+PROCEDURE sinf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE sin (x: REAL) : REAL ;
+PROCEDURE sinl (x: LONGREAL) : LONGREAL ;
+PROCEDURE cosf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE cos (x: REAL) : REAL ;
+PROCEDURE cosl (x: LONGREAL) : LONGREAL ;
+PROCEDURE atan2f (x, y: SHORTREAL) : SHORTREAL ;
+PROCEDURE atan2 (x, y: REAL) : REAL ;
+PROCEDURE atan2l (x, y: LONGREAL) : LONGREAL ;
+PROCEDURE sqrtf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE sqrt (x: REAL) : REAL ;
+PROCEDURE sqrtl (x: LONGREAL) : LONGREAL ;
+PROCEDURE fabsf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE fabs (x: REAL) : REAL ;
+PROCEDURE fabsl (x: LONGREAL) : LONGREAL ;
+PROCEDURE logf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE log (x: REAL) : REAL ;
+PROCEDURE logl (x: LONGREAL) : LONGREAL ;
+PROCEDURE expf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE exp (x: REAL) : REAL ;
+PROCEDURE expl (x: LONGREAL) : LONGREAL ;
+PROCEDURE log10f (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE log10 (x: REAL) : REAL ;
+PROCEDURE log10l (x: LONGREAL) : LONGREAL ;
+PROCEDURE exp10f (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE exp10 (x: REAL) : REAL ;
+PROCEDURE exp10l (x: LONGREAL) : LONGREAL ;
+PROCEDURE ilogbf (x: SHORTREAL) : INTEGER ;
+PROCEDURE ilogb (x: REAL) : INTEGER ;
+PROCEDURE ilogbl (x: LONGREAL) : INTEGER ;
+
+PROCEDURE significand (r: REAL) : REAL ;
+PROCEDURE significandf (s: SHORTREAL) : SHORTREAL ;
+PROCEDURE significandl (l: LONGREAL) : LONGREAL ;
+
+PROCEDURE modf (x: REAL; VAR y: REAL) : REAL ;
+PROCEDURE modff (x: SHORTREAL; VAR y: SHORTREAL) : SHORTREAL ;
+PROCEDURE modfl (x: LONGREAL; VAR y: LONGREAL) : LONGREAL ;
+
+PROCEDURE nextafter (x, y: REAL) : REAL ;
+PROCEDURE nextafterf (x, y: SHORTREAL) : SHORTREAL ;
+PROCEDURE nextafterl (x, y: LONGREAL) : LONGREAL ;
+
+PROCEDURE nexttoward (x, y: REAL) : REAL ;
+PROCEDURE nexttowardf (x, y: SHORTREAL) : SHORTREAL ;
+PROCEDURE nexttowardl (x, y: LONGREAL) : LONGREAL ;
+
+PROCEDURE scalb (x, n: REAL) : REAL ;
+PROCEDURE scalbf (x, n: SHORTREAL) : SHORTREAL ;
+PROCEDURE scalbl (x, n: LONGREAL) : LONGREAL ;
+
+PROCEDURE scalbn (x: REAL; n: INTEGER) : REAL ;
+PROCEDURE scalbnf (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+PROCEDURE scalbnl (x: LONGREAL; n: INTEGER) : LONGREAL ;
+
+PROCEDURE scalbln (x: REAL; n: LONGINT) : REAL ;
+PROCEDURE scalblnf (x: SHORTREAL; n: LONGINT) : SHORTREAL ;
+PROCEDURE scalblnl (x: LONGREAL; n: LONGINT) : LONGREAL ;
+
+PROCEDURE cabsf (z: SHORTCOMPLEX) : SHORTREAL ;
+PROCEDURE cabs (z: COMPLEX) : REAL ;
+PROCEDURE cabsl (z: LONGCOMPLEX) : LONGREAL ;
+
+PROCEDURE cargf (z: SHORTCOMPLEX) : SHORTREAL ;
+PROCEDURE carg (z: COMPLEX) : REAL ;
+PROCEDURE cargl (z: LONGCOMPLEX) : LONGREAL ;
+
+PROCEDURE conjf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE conj (z: COMPLEX) : COMPLEX ;
+PROCEDURE conjl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE cpowf (base: SHORTCOMPLEX; exp: SHORTREAL) : SHORTCOMPLEX ;
+PROCEDURE cpow (base: COMPLEX; exp: REAL) : COMPLEX ;
+PROCEDURE cpowl (base: LONGCOMPLEX; exp: LONGREAL) : LONGCOMPLEX ;
+
+PROCEDURE csqrtf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE csqrt (z: COMPLEX) : COMPLEX ;
+PROCEDURE csqrtl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE cexpf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE cexp (z: COMPLEX) : COMPLEX ;
+PROCEDURE cexpl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE clogf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE clog (z: COMPLEX) : COMPLEX ;
+PROCEDURE clogl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE csinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE csin (z: COMPLEX) : COMPLEX ;
+PROCEDURE csinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE ccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE ccos (z: COMPLEX) : COMPLEX ;
+PROCEDURE ccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE ctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE ctan (z: COMPLEX) : COMPLEX ;
+PROCEDURE ctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE casinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE casin (z: COMPLEX) : COMPLEX ;
+PROCEDURE casinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE cacosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE cacos (z: COMPLEX) : COMPLEX ;
+PROCEDURE cacosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE catanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+PROCEDURE catan (z: COMPLEX) : COMPLEX ;
+PROCEDURE catanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+PROCEDURE index (s: ADDRESS; c: INTEGER) : ADDRESS ;
+PROCEDURE rindex (s: ADDRESS; c: INTEGER) : ADDRESS ;
+PROCEDURE memcmp (s1, s2: ADDRESS; n: CARDINAL) : INTEGER ;
+PROCEDURE memmove (s1, s2: ADDRESS; n: CARDINAL) : ADDRESS ;
+PROCEDURE memset (s: ADDRESS; c: INTEGER; n: CARDINAL) : ADDRESS ;
+PROCEDURE strcat (dest, src: ADDRESS) : ADDRESS ;
+PROCEDURE strncat (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+PROCEDURE strcpy (dest, src: ADDRESS) : ADDRESS ;
+PROCEDURE strncpy (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+PROCEDURE strcmp (s1, s2: ADDRESS) : INTEGER ;
+PROCEDURE strncmp (s1, s2: ADDRESS; n: CARDINAL) : INTEGER ;
+PROCEDURE strlen (s: ADDRESS) : INTEGER ;
+PROCEDURE strstr (haystack, needle: ADDRESS) : ADDRESS ;
+PROCEDURE strpbrk (s, accept: ADDRESS) : ADDRESS ;
+PROCEDURE strspn (s, accept: ADDRESS) : CARDINAL ;
+PROCEDURE strcspn (s, accept: ADDRESS) : CARDINAL ;
+PROCEDURE strchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+PROCEDURE strrchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+
+END cbuiltin.
diff --git a/gcc/m2/gm2-libs/cgetopt.def b/gcc/m2/gm2-libs/cgetopt.def
new file mode 100644
index 00000000000..90ea88863d0
--- /dev/null
+++ b/gcc/m2/gm2-libs/cgetopt.def
@@ -0,0 +1,107 @@
+(* getopt.def provides access to the getopt C library.
+
+Copyright (C) 2017-2021 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/>.  *)
+
+DEFINITION MODULE cgetopt ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+   Options = ADDRESS ;
+
+VAR
+   optarg                : ADDRESS ;
+   optind, opterr, optopt: INTEGER ;
+
+
+(*
+   getopt - the getopt() function parses the command-line arguments.
+            Its arguments argc and argv are the argument count and array as
+            passed to the main() function on program invocation.  An element of
+            argv that starts with '-' (and is not exactly "-" or "--") is an
+            option element.  The characters of this element (aside from the
+            initial '-') are option characters.  If getopt() is called
+            repeatedly, it returns successively each of the option characters
+            from each of the option elements.
+*)
+
+PROCEDURE getopt (argc: INTEGER; argv: ADDRESS; optstring: ADDRESS) : CHAR ;
+
+
+(*
+   getopt_long - works like getopt() except that it also accepts long options,
+                 started with two dashes.  (If the program accepts only long
+                 options, then optstring should be specified as an empty string (""),
+                 not NULL.)  Long option names may be abbreviated if the abbreviation
+                 is unique or is an exact match for some defined option.  A
+                 long option may take a parameter, of the form --arg=param or
+                 --arg param.
+*)
+
+PROCEDURE getopt_long (argc: INTEGER; argv: ADDRESS; optstring: ADDRESS;
+                       longopts: ADDRESS; VAR longindex: INTEGER) : INTEGER ;
+
+
+(*
+   getopt_long_only - a wrapper for the C getopt_long_only.
+*)
+
+PROCEDURE getopt_long_only (argc: INTEGER; argv: ADDRESS; optstring: ADDRESS;
+                            longopts: ADDRESS; VAR longindex: INTEGER) : INTEGER ;
+
+
+(*
+   InitOptions - constructor for empty Options.
+*)
+
+PROCEDURE InitOptions () : Options ;
+
+
+(*
+   KillOptions - deconstructor for empty Options.
+*)
+
+PROCEDURE KillOptions (o: Options) : Options ;
+
+
+(*
+   SetOption - set option[index] with {name, has_arg, flag, val}.
+*)
+
+PROCEDURE SetOption (o: Options; index: CARDINAL;
+                     name: ADDRESS; has_arg: BOOLEAN;
+                     VAR flag: INTEGER; val: INTEGER) ;
+
+
+(*
+   GetLongOptionArray - return a pointer to the C array containing all
+                        long options.
+*)
+
+PROCEDURE GetLongOptionArray (o: Options) : ADDRESS ;
+
+
+END cgetopt.
diff --git a/gcc/m2/gm2-libs/config-host b/gcc/m2/gm2-libs/config-host
new file mode 100755
index 00000000000..72619e305d3
--- /dev/null
+++ b/gcc/m2/gm2-libs/config-host
@@ -0,0 +1,5629 @@
+#! /bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.64 for ASCII.def 1.8.2.
+#
+# Report bugs to <gm2@nongnu.org>.
+#
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software
+# Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+if test "x$CONFIG_SHELL" = x; then
+  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '\${1+\"\$@\"}'='\"\$@\"'
+  setopt NO_GLOB_SUBST
+else
+  case \`(set -o) 2>/dev/null\` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+"
+  as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
+
+exitcode=0
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
+
+else
+  exitcode=1; echo positional parameters were not saved.
+fi
+test x\$exitcode = x0 || exit 1"
+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
+test \$(( 1 + 1 )) = 2 || exit 1"
+  if (eval "$as_required") 2>/dev/null; then :
+  as_have_required=yes
+else
+  as_have_required=no
+fi
+  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
+
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  as_found=:
+  case $as_dir in #(
+	 /*)
+	   for as_base in sh bash ksh sh5; do
+	     # Try only shells that exist, to save several forks.
+	     as_shell=$as_dir/$as_base
+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  CONFIG_SHELL=$as_shell as_have_required=yes
+		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  break 2
+fi
+fi
+	   done;;
+       esac
+  as_found=false
+done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+  CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
+IFS=$as_save_IFS
+
+
+      if test "x$CONFIG_SHELL" != x; then :
+  # We cannot yet assume a decent shell, so we have to provide a
+	# neutralization value for shells without unset; and this also
+	# works around shells that cannot unset nonexistent variables.
+	BASH_ENV=/dev/null
+	ENV=/dev/null
+	(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+	export CONFIG_SHELL
+	exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}
+fi
+
+    if test x$as_have_required = xno; then :
+  $as_echo "$0: This script requires a shell more modern than all"
+  $as_echo "$0: the shells that I found on your system."
+  if test x${ZSH_VERSION+set} = xset ; then
+    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
+  else
+    $as_echo "$0: Please tell bug-autoconf@gnu.org and gm2@nongnu.org
+$0: about your system, including any error possibly output
+$0: before this message. Then install a modern shell, or
+$0: manually run the script under such a shell if you do
+$0: have one."
+  fi
+  exit 1
+fi
+fi
+fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
+
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+# as_fn_error ERROR [LINENO LOG_FD]
+# ---------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with status $?, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$?; test $as_status -eq 0 && as_status=1
+  if test "$3"; then
+    as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3
+  fi
+  $as_echo "$as_me: error: $1" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+
+  as_lineno_1=$LINENO as_lineno_1a=$LINENO
+  as_lineno_2=$LINENO as_lineno_2a=$LINENO
+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
+  sed -n '
+    p
+    /[$]LINENO/=
+  ' <$as_myself |
+    sed '
+      s/[$]LINENO.*/&-/
+      t lineno
+      b
+      :lineno
+      N
+      :loop
+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
+      t loop
+      s/-\n.*//
+    ' >$as_me.lineno &&
+  chmod +x "$as_me.lineno" ||
+    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+
+  # Don't try to exec as it changes $[0], causing all sort of problems
+  # (the dirname of $[0] is not the place where we might find the
+  # original and so on.  Autoconf is especially sensitive to this).
+  . "./$as_me.lineno"
+  # Exit status is that of the last command.
+  exit
+}
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -p'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -p'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -p'
+  fi
+else
+  as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+if test -x / >/dev/null 2>&1; then
+  as_test_x='test -x'
+else
+  if ls -dL / >/dev/null 2>&1; then
+    as_ls_L_option=L
+  else
+    as_ls_L_option=
+  fi
+  as_test_x='
+    eval sh -c '\''
+      if test -d "$1"; then
+	test -d "$1/.";
+      else
+	case $1 in #(
+	-*)set "./$1";;
+	esac;
+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
+	???[sx]*):;;*)false;;esac;fi
+    '\'' sh
+  '
+fi
+as_executable_p=$as_test_x
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+exec 7<&0 </dev/null 6>&1
+
+# Name of the host.
+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_clean_files=
+ac_config_libobj_dir=.
+LIBOBJS=
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+
+# Identity of this package.
+PACKAGE_NAME='ASCII.def'
+PACKAGE_TARNAME='ascii-def'
+PACKAGE_VERSION='1.8.2'
+PACKAGE_STRING='ASCII.def 1.8.2'
+PACKAGE_BUGREPORT='gm2@nongnu.org'
+PACKAGE_URL=''
+
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#ifdef HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#ifdef HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+#  include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
+#  include <memory.h>
+# endif
+# include <string.h>
+#endif
+#ifdef HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#ifdef HAVE_INTTYPES_H
+# include <inttypes.h>
+#endif
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
+ac_subst_vars='LTLIBOBJS
+LIBOBJS
+ALLOCA
+EGREP
+GREP
+CPP
+OBJEXT
+EXEEXT
+ac_ct_CC
+CPPFLAGS
+LDFLAGS
+CFLAGS
+CC
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL'
+ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+'
+      ac_precious_vars='build_alias
+host_alias
+target_alias
+CC
+CFLAGS
+LDFLAGS
+LIBS
+CPPFLAGS
+CPP'
+
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
+
+ac_prev=
+ac_dashdash=
+for ac_option
+do
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval $ac_prev=\$ac_option
+    ac_prev=
+    continue
+  fi
+
+  case $ac_option in
+  *=*)	ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+  *)	ac_optarg=yes ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case $ac_dashdash$ac_option in
+  --)
+    ac_dashdash=yes ;;
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir=$ac_optarg ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build_alias ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build_alias=$ac_optarg ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file=$ac_optarg ;;
+
+  --config-cache | -C)
+    cache_file=config.cache ;;
+
+  -datadir | --datadir | --datadi | --datad)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=*)
+    datadir=$ac_optarg ;;
+
+  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+  | --dataroo | --dataro | --datar)
+    ac_prev=datarootdir ;;
+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+    datarootdir=$ac_optarg ;;
+
+  -disable-* | --disable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=no ;;
+
+  -docdir | --docdir | --docdi | --doc | --do)
+    ac_prev=docdir ;;
+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+    docdir=$ac_optarg ;;
+
+  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+    ac_prev=dvidir ;;
+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+    dvidir=$ac_optarg ;;
+
+  -enable-* | --enable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=\$ac_optarg ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix=$ac_optarg ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he | -h)
+    ac_init_help=long ;;
+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+    ac_init_help=recursive ;;
+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+    ac_init_help=short ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host_alias ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host_alias=$ac_optarg ;;
+
+  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+    ac_prev=htmldir ;;
+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+  | --ht=*)
+    htmldir=$ac_optarg ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir=$ac_optarg ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir=$ac_optarg ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir=$ac_optarg ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir=$ac_optarg ;;
+
+  -localedir | --localedir | --localedi | --localed | --locale)
+    ac_prev=localedir ;;
+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+    localedir=$ac_optarg ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst | --locals)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
+    localstatedir=$ac_optarg ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir=$ac_optarg ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c | -n)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir=$ac_optarg ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix=$ac_optarg ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix=$ac_optarg ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix=$ac_optarg ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name=$ac_optarg ;;
+
+  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+    ac_prev=pdfdir ;;
+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+    pdfdir=$ac_optarg ;;
+
+  -psdir | --psdir | --psdi | --psd | --ps)
+    ac_prev=psdir ;;
+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+    psdir=$ac_optarg ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir=$ac_optarg ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir=$ac_optarg ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site=$ac_optarg ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir=$ac_optarg ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir=$ac_optarg ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target_alias ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target_alias=$ac_optarg ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers | -V)
+    ac_init_version=: ;;
+
+  -with-* | --with-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=\$ac_optarg ;;
+
+  -without-* | --without-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=no ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes=$ac_optarg ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries=$ac_optarg ;;
+
+  -*) as_fn_error "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information."
+    ;;
+
+  *=*)
+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+    # Reject names that are not valid shell variable names.
+    case $ac_envvar in #(
+      '' | [0-9]* | *[!_$as_cr_alnum]* )
+      as_fn_error "invalid variable name: \`$ac_envvar'" ;;
+    esac
+    eval $ac_envvar=\$ac_optarg
+    export $ac_envvar ;;
+
+  *)
+    # FIXME: should be removed in autoconf 3.0.
+    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+    : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+  as_fn_error "missing argument to $ac_option"
+fi
+
+if test -n "$ac_unrecognized_opts"; then
+  case $enable_option_checking in
+    no) ;;
+    fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;;
+    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
+  esac
+fi
+
+# Check all directory arguments for consistency.
+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
+		datadir sysconfdir sharedstatedir localstatedir includedir \
+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+		libdir localedir mandir
+do
+  eval ac_val=\$$ac_var
+  # Remove trailing slashes.
+  case $ac_val in
+    */ )
+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+      eval $ac_var=\$ac_val;;
+  esac
+  # Be sure to have absolute directory names.
+  case $ac_val in
+    [\\/$]* | ?:[\\/]* )  continue;;
+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
+  esac
+  as_fn_error "expected an absolute directory name for --$ac_var: $ac_val"
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+  if test "x$build_alias" = x; then
+    cross_compiling=maybe
+    $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+    If a cross compiler is detected then cross compile mode will be used." >&2
+  elif test "x$build_alias" != "x$host_alias"; then
+    cross_compiling=yes
+  fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+  as_fn_error "working directory cannot be determined"
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+  as_fn_error "pwd does not report name of working directory"
+
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then the parent directory.
+  ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_myself" : 'X\(//\)[^/]' \| \
+	 X"$as_myself" : 'X\(//\)$' \| \
+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  srcdir=$ac_confdir
+  if test ! -r "$srcdir/$ac_unique_file"; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r "$srcdir/$ac_unique_file"; then
+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+  as_fn_error "cannot find sources ($ac_unique_file) in $srcdir"
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg"
+	pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+  srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+  eval ac_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_env_${ac_var}_value=\$${ac_var}
+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+  # Omit some internal or obsolete options to make the list less imposing.
+  # This message is too long to be a string in the A/UX 3.1 sh.
+  cat <<_ACEOF
+\`configure' configures ASCII.def 1.8.2 to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE.  See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+  -h, --help              display this help and exit
+      --help=short        display options specific to this package
+      --help=recursive    display the short help of all the included packages
+  -V, --version           display version information and exit
+  -q, --quiet, --silent   do not print \`checking...' messages
+      --cache-file=FILE   cache test results in FILE [disabled]
+  -C, --config-cache      alias for \`--cache-file=config.cache'
+  -n, --no-create         do not create output files
+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']
+
+Installation directories:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+  --bindir=DIR            user executables [EPREFIX/bin]
+  --sbindir=DIR           system admin executables [EPREFIX/sbin]
+  --libexecdir=DIR        program executables [EPREFIX/libexec]
+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
+  --libdir=DIR            object code libraries [EPREFIX/lib]
+  --includedir=DIR        C header files [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
+  --infodir=DIR           info documentation [DATAROOTDIR/info]
+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]
+  --mandir=DIR            man documentation [DATAROOTDIR/man]
+  --docdir=DIR            documentation root [DATAROOTDIR/doc/ascii-def]
+  --htmldir=DIR           html documentation [DOCDIR]
+  --dvidir=DIR            dvi documentation [DOCDIR]
+  --pdfdir=DIR            pdf documentation [DOCDIR]
+  --psdir=DIR             ps documentation [DOCDIR]
+_ACEOF
+
+  cat <<\_ACEOF
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+  case $ac_init_help in
+     short | recursive ) echo "Configuration of ASCII.def 1.8.2:";;
+   esac
+  cat <<\_ACEOF
+
+Some influential environment variables:
+  CC          C compiler command
+  CFLAGS      C compiler flags
+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+              nonstandard directory <lib dir>
+  LIBS        libraries to pass to the linker, e.g. -l<library>
+  CPPFLAGS    C/C++/Objective C preprocessor flags, e.g. -I<include dir> if
+              you have headers in a nonstandard directory <include dir>
+  CPP         C preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to <gm2@nongnu.org>.
+_ACEOF
+ac_status=$?
+fi
+
+if test "$ac_init_help" = "recursive"; then
+  # If there are subdirs, report their specific --help.
+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+    test -d "$ac_dir" ||
+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+      continue
+    ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+    cd "$ac_dir" || { ac_status=$?; continue; }
+    # Check for guested configure.
+    if test -f "$ac_srcdir/configure.gnu"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+    elif test -f "$ac_srcdir/configure"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure" --help=recursive
+    else
+      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+    fi || ac_status=$?
+    cd "$ac_pwd" || { ac_status=$?; break; }
+  done
+fi
+
+test -n "$ac_init_help" && exit $ac_status
+if $ac_init_version; then
+  cat <<\_ACEOF
+ASCII.def configure 1.8.2
+generated by GNU Autoconf 2.64
+
+Copyright (C) 2009 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+  exit
+fi
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+
+# ac_fn_c_try_compile LINENO
+# --------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext
+  if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  return $ac_retval
+
+} # ac_fn_c_try_compile
+
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+    ac_retval=1
+fi
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  return $ac_retval
+
+} # ac_fn_c_try_cpp
+
+# ac_fn_c_try_run LINENO
+# ----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
+# that executables *can* be run.
+ac_fn_c_try_run ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: program exited with status $ac_status" >&5
+       $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+       ac_retval=$ac_status
+fi
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  return $ac_retval
+
+} # ac_fn_c_try_run
+
+# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists, giving a warning if it cannot be compiled using
+# the include files in INCLUDES and setting the cache variable VAR
+# accordingly.
+ac_fn_c_check_header_mongrel ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+  $as_echo_n "(cached) " >&6
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+else
+  # Is the header compilable?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
+$as_echo_n "checking $2 usability... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_header_compiler=yes
+else
+  ac_header_compiler=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
+$as_echo "$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
+$as_echo_n "checking $2 presence... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <$2>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  ac_header_preproc=yes
+else
+  ac_header_preproc=no
+fi
+rm -f conftest.err conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
+$as_echo "$ac_header_preproc" >&6; }
+
+# So?  What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
+  yes:no: )
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
+$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+    ;;
+  no:yes:* )
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
+$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5
+$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
+$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5
+$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+( cat <<\_ASBOX
+## ----------------------------- ##
+## Report this to gm2@nongnu.org ##
+## ----------------------------- ##
+_ASBOX
+     ) | sed "s/^/$as_me: WARNING:     /" >&2
+    ;;
+esac
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+  $as_echo_n "(cached) " >&6
+else
+  eval "$3=\$ac_header_compiler"
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+fi
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+
+} # ac_fn_c_check_header_mongrel
+
+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_c_check_header_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+
+} # ac_fn_c_check_header_compile
+
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext conftest$ac_exeext
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext && {
+	 test "$cross_compiling" = yes ||
+	 $as_test_x conftest$ac_exeext
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+  # interfere with the next link command; also delete a directory that is
+  # left behind by Apple's compiler.  We do this before executing the actions.
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  return $ac_retval
+
+} # ac_fn_c_try_link
+
+# ac_fn_c_check_func LINENO FUNC VAR
+# ----------------------------------
+# Tests whether FUNC exists, setting the cache variable VAR accordingly
+ac_fn_c_check_func ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+/* Define $2 to an innocuous variant, in case <limits.h> declares $2.
+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
+#define $2 innocuous_$2
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $2 (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $2
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $2 ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined __stub_$2 || defined __stub___$2
+choke me
+#endif
+
+int
+main ()
+{
+return $2 ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+
+} # ac_fn_c_check_func
+
+# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES
+# --------------------------------------------
+# Tries to find the compile-time value of EXPR in a program that includes
+# INCLUDES, setting VAR accordingly. Returns whether the value could be
+# computed
+ac_fn_c_compute_int ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if test "$cross_compiling" = yes; then
+    # Depending upon the size, compute the lo and hi bounds.
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) >= 0)];
+test_array [0] = 0
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_lo=0 ac_mid=0
+  while :; do
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) <= $ac_mid)];
+test_array [0] = 0
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_hi=$ac_mid; break
+else
+  as_fn_arith $ac_mid + 1 && ac_lo=$as_val
+			if test $ac_lo -le $ac_mid; then
+			  ac_lo= ac_hi=
+			  break
+			fi
+			as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+  done
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) < 0)];
+test_array [0] = 0
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_hi=-1 ac_mid=-1
+  while :; do
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) >= $ac_mid)];
+test_array [0] = 0
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_lo=$ac_mid; break
+else
+  as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val
+			if test $ac_mid -le $ac_hi; then
+			  ac_lo= ac_hi=
+			  break
+			fi
+			as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+  done
+else
+  ac_lo= ac_hi=
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+# Binary search between lo and hi bounds.
+while test "x$ac_lo" != "x$ac_hi"; do
+  as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) <= $ac_mid)];
+test_array [0] = 0
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_hi=$ac_mid
+else
+  as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+case $ac_lo in #((
+?*) eval "$3=\$ac_lo"; ac_retval=0 ;;
+'') ac_retval=1 ;;
+esac
+  else
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+static long int longval () { return $2; }
+static unsigned long int ulongval () { return $2; }
+#include <stdio.h>
+#include <stdlib.h>
+int
+main ()
+{
+
+  FILE *f = fopen ("conftest.val", "w");
+  if (! f)
+    return 1;
+  if (($2) < 0)
+    {
+      long int i = longval ();
+      if (i != ($2))
+	return 1;
+      fprintf (f, "%ld", i);
+    }
+  else
+    {
+      unsigned long int i = ulongval ();
+      if (i != ($2))
+	return 1;
+      fprintf (f, "%lu", i);
+    }
+  /* Do not output a trailing newline, as this causes \r\n confusion
+     on some platforms.  */
+  return ferror (f) || fclose (f) != 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+  echo >>conftest.val; read $3 <conftest.val; ac_retval=0
+else
+  ac_retval=1
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+rm -f conftest.val
+
+  fi
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  return $ac_retval
+
+} # ac_fn_c_compute_int
+cat >config.log <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by ASCII.def $as_me 1.8.2, which was
+generated by GNU Autoconf 2.64.  Invocation command line was
+
+  $ $0 $@
+
+_ACEOF
+exec 5>>config.log
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`
+
+/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    $as_echo "PATH: $as_dir"
+  done
+IFS=$as_save_IFS
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+  for ac_arg
+  do
+    case $ac_arg in
+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+    | -silent | --silent | --silen | --sile | --sil)
+      continue ;;
+    *\'*)
+      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    case $ac_pass in
+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
+    2)
+      as_fn_append ac_configure_args1 " '$ac_arg'"
+      if test $ac_must_keep_next = true; then
+	ac_must_keep_next=false # Got value, back to normal.
+      else
+	case $ac_arg in
+	  *=* | --config-cache | -C | -disable-* | --disable-* \
+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+	  | -with-* | --with-* | -without-* | --without-* | --x)
+	    case "$ac_configure_args0 " in
+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+	    esac
+	    ;;
+	  -* ) ac_must_keep_next=true ;;
+	esac
+      fi
+      as_fn_append ac_configure_args " '$ac_arg'"
+      ;;
+    esac
+  done
+done
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log.  We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
+trap 'exit_status=$?
+  # Save into config.log some information that might help in debugging.
+  {
+    echo
+
+    cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+    echo
+    # The following way of writing the cache mishandles newlines in values,
+(
+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+  (set) 2>&1 |
+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      sed -n \
+	"s/'\''/'\''\\\\'\'''\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+      ;; #(
+    *)
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+)
+    echo
+
+    cat <<\_ASBOX
+## ----------------- ##
+## Output variables. ##
+## ----------------- ##
+_ASBOX
+    echo
+    for ac_var in $ac_subst_vars
+    do
+      eval ac_val=\$$ac_var
+      case $ac_val in
+      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+      esac
+      $as_echo "$ac_var='\''$ac_val'\''"
+    done | sort
+    echo
+
+    if test -n "$ac_subst_files"; then
+      cat <<\_ASBOX
+## ------------------- ##
+## File substitutions. ##
+## ------------------- ##
+_ASBOX
+      echo
+      for ac_var in $ac_subst_files
+      do
+	eval ac_val=\$$ac_var
+	case $ac_val in
+	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+	esac
+	$as_echo "$ac_var='\''$ac_val'\''"
+      done | sort
+      echo
+    fi
+
+    if test -s confdefs.h; then
+      cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+      echo
+      cat confdefs.h
+      echo
+    fi
+    test "$ac_signal" != 0 &&
+      $as_echo "$as_me: caught signal $ac_signal"
+    $as_echo "$as_me: exit $exit_status"
+  } >&5
+  rm -f core *.core core.conftest.* &&
+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
+    exit $exit_status
+' 0
+for ac_signal in 1 2 13 15; do
+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -f -r conftest* confdefs.h
+
+$as_echo "/* confdefs.h */" > confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
+if test -n "$CONFIG_SITE"; then
+  ac_site_file1=$CONFIG_SITE
+elif test "x$prefix" != xNONE; then
+  ac_site_file1=$prefix/share/config.site
+  ac_site_file2=$prefix/etc/config.site
+else
+  ac_site_file1=$ac_default_prefix/share/config.site
+  ac_site_file2=$ac_default_prefix/etc/config.site
+fi
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
+do
+  test "x$ac_site_file" = xNONE && continue
+  if test -r "$ac_site_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
+    sed 's/^/| /' "$ac_site_file" >&5
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  # Some versions of bash will fail to source /dev/null (special
+  # files actually), so we avoid doing that.
+  if test -f "$cache_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
+    case $cache_file in
+      [\\/]* | ?:[\\/]* ) . "$cache_file";;
+      *)                      . "./$cache_file";;
+    esac
+  fi
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
+  >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in $ac_precious_vars; do
+  eval ac_old_set=\$ac_cv_env_${ac_var}_set
+  eval ac_new_set=\$ac_env_${ac_var}_set
+  eval ac_old_val=\$ac_cv_env_${ac_var}_value
+  eval ac_new_val=\$ac_env_${ac_var}_value
+  case $ac_old_set,$ac_new_set in
+    set,)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,set)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,);;
+    *)
+      if test "x$ac_old_val" != "x$ac_new_val"; then
+	# differences in whitespace do not lead to failure.
+	ac_old_val_w=`echo x $ac_old_val`
+	ac_new_val_w=`echo x $ac_new_val`
+	if test "$ac_old_val_w" != "$ac_new_val_w"; then
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+	  ac_cache_corrupted=:
+	else
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+	  eval $ac_var=\$ac_old_val
+	fi
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
+$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}
+      fi;;
+  esac
+  # Pass precious variables to config.status.
+  if test "$ac_new_set" = set; then
+    case $ac_new_val in
+    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+    *) ac_arg=$ac_var=$ac_new_val ;;
+    esac
+    case " $ac_configure_args " in
+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;
+    esac
+  fi
+done
+if $ac_cache_corrupted; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+  as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
+fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+ac_config_headers="$ac_config_headers gm2-libs-host.h:gm2-libs-host.h.in"
+
+
+# Checks for programs.
+
+# Checks for libraries.
+
+# Checks for header files.
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_CC="${ac_tool_prefix}gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+  ac_ct_CC=$CC
+  # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_ac_ct_CC="gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+else
+  CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+          if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_CC="${ac_tool_prefix}cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  fi
+fi
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+       ac_prog_rejected=yes
+       continue
+     fi
+    ac_cv_prog_CC="cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# != 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+  fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$CC"; then
+  if test -n "$ac_tool_prefix"; then
+  for ac_prog in cl.exe
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$CC" && break
+  done
+fi
+if test -z "$CC"; then
+  ac_ct_CC=$CC
+  for ac_prog in cl.exe
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_ac_ct_CC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CC" && break
+done
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+fi
+
+fi
+
+
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "no acceptable C compiler found in \$PATH
+See \`config.log' for more details." "$LINENO" 5; }
+
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    rm -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdio.h>
+int
+main ()
+{
+FILE *f = fopen ("conftest.out", "w");
+ return ferror (f) || fclose (f) != 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out conftest.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
+$as_echo_n "checking for C compiler default output file name... " >&6; }
+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+
+# The possible output files:
+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
+
+ac_rmfiles=
+for ac_file in $ac_files
+do
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+  esac
+done
+rm -f $ac_rmfiles
+
+if { { ac_try="$ac_link_default"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link_default") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile.  We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
+do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
+	;;
+    [ab].out )
+	# We found the default executable, but exeext='' is most
+	# certainly right.
+	break;;
+    *.* )
+	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+	then :; else
+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	fi
+	# We set ac_cv_exeext here because the later test for it is not
+	# safe: cross compilers may not add the suffix if given an `-o'
+	# argument, so we may need to know it at that point already.
+	# Even if this section looks crufty: it has the advantage of
+	# actually working.
+	break;;
+    * )
+	break;;
+  esac
+done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
+else
+  ac_file=''
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
+$as_echo "$ac_file" >&6; }
+if test -z "$ac_file"; then :
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ as_fn_set_status 77
+as_fn_error "C compiler cannot create executables
+See \`config.log' for more details." "$LINENO" 5; }; }
+fi
+ac_exeext=$ac_cv_exeext
+
+# Check that the compiler produces executables we can run.  If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
+$as_echo_n "checking whether the C compiler works... " >&6; }
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+  if { ac_try='./$ac_file'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then
+    cross_compiling=no
+  else
+    if test "$cross_compiling" = maybe; then
+	cross_compiling=yes
+    else
+	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." "$LINENO" 5; }
+    fi
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+
+rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out conftest.out
+ac_clean_files=$ac_clean_files_save
+# Check that the compiler produces executables we can run.  If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
+$as_echo_n "checking whether we are cross compiling... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
+$as_echo "$cross_compiling" >&6; }
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
+$as_echo_n "checking for suffix of executables... " >&6; }
+if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	  break;;
+    * ) break;;
+  esac
+done
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+rm -f conftest$ac_cv_exeext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
+$as_echo "$ac_cv_exeext" >&6; }
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
+$as_echo_n "checking for suffix of object files... " >&6; }
+if test "${ac_cv_objext+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  for ac_file in conftest.o conftest.obj conftest.*; do
+  test -f "$ac_file" || continue;
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+       break;;
+  esac
+done
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
+$as_echo "$ac_cv_objext" >&6; }
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if test "${ac_cv_c_compiler_gnu+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if test "${ac_cv_prog_cc_g+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_save_c_werror_flag=$ac_c_werror_flag
+   ac_c_werror_flag=yes
+   ac_cv_prog_cc_g=no
+   CFLAGS="-g"
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+else
+  CFLAGS=""
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  ac_c_werror_flag=$ac_save_c_werror_flag
+	 CFLAGS="-g"
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if test "${ac_cv_prog_cc_c89+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
+   function prototypes and stuff, but not '\xHH' hex character constants.
+   These don't provoke an error unfortunately, instead are silently treated
+   as 'x'.  The following induces an error, until -std is added to get
+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
+   array size at least.  It's necessary to write '\x00'==0 to get something
+   that's true only with -std.  */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+   inside strings and character constants.  */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+  ;
+  return 0;
+}
+_ACEOF
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_c89=$ac_arg
+fi
+rm -f core conftest.err conftest.$ac_objext
+  test "x$ac_cv_prog_cc_c89" != "xno" && break
+done
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
+fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+  x)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+  xno)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
+  *)
+    CC="$CC $ac_cv_prog_cc_c89"
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
+esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+  if test "${ac_cv_prog_CPP+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+      # Double quotes because CPP needs to be expanded
+    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+    do
+      ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+  break
+fi
+
+    done
+    ac_cv_prog_CPP=$CPP
+
+fi
+  CPP=$ac_cv_prog_CPP
+else
+  ac_cv_prog_CPP=$CPP
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if test "${ac_cv_path_GREP+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$GREP"; then
+  ac_path_GREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in grep ggrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+      { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+  # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'GREP' >> "conftest.nl"
+    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_GREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_GREP="$ac_path_GREP"
+      ac_path_GREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_GREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_GREP"; then
+    as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_GREP=$GREP
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if test "${ac_cv_path_EGREP+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+   then ac_cv_path_EGREP="$GREP -E"
+   else
+     if test -z "$EGREP"; then
+  ac_path_EGREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in egrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+      { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+  # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'EGREP' >> "conftest.nl"
+    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_EGREP="$ac_path_EGREP"
+      ac_path_EGREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_EGREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_EGREP"; then
+    as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_EGREP=$EGREP
+fi
+
+   fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if test "${ac_cv_header_stdc+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_stdc=yes
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "memchr" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "free" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+  if test "$cross_compiling" = yes; then :
+  :
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ctype.h>
+#include <stdlib.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+		   (('a' <= (c) && (c) <= 'i') \
+		     || ('j' <= (c) && (c) <= 'r') \
+		     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+  int i;
+  for (i = 0; i < 256; i++)
+    if (XOR (islower (i), ISLOWER (i))
+	|| toupper (i) != TOUPPER (i))
+      return 2;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5
+$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; }
+if test "${ac_cv_header_time+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+
+int
+main ()
+{
+if ((struct tm *) 0)
+return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_time=yes
+else
+  ac_cv_header_time=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_time" >&5
+$as_echo "$ac_cv_header_time" >&6; }
+if test $ac_cv_header_time = yes; then
+
+$as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sys/wait.h that is POSIX.1 compatible" >&5
+$as_echo_n "checking for sys/wait.h that is POSIX.1 compatible... " >&6; }
+if test "${ac_cv_header_sys_wait_h+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <sys/types.h>
+#include <sys/wait.h>
+#ifndef WEXITSTATUS
+# define WEXITSTATUS(stat_val) ((unsigned int) (stat_val) >> 8)
+#endif
+#ifndef WIFEXITED
+# define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
+#endif
+
+int
+main ()
+{
+  int s;
+  wait (&s);
+  s = WIFEXITED (s) ? WEXITSTATUS (s) : 1;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_sys_wait_h=yes
+else
+  ac_cv_header_sys_wait_h=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_sys_wait_h" >&5
+$as_echo "$ac_cv_header_sys_wait_h" >&6; }
+if test $ac_cv_header_sys_wait_h = yes; then
+
+$as_echo "#define HAVE_SYS_WAIT_H 1" >>confdefs.h
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+		  inttypes.h stdint.h unistd.h
+do :
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+eval as_val=\$$as_ac_Header
+   if test "x$as_val" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+ac_fn_c_check_header_mongrel "$LINENO" "math.h" "ac_cv_header_math_h" "$ac_includes_default"
+if test "x$ac_cv_header_math_h" = x""yes; then :
+
+$as_echo "#define HAVE_MATH_H 1" >>confdefs.h
+
+fi
+
+
+
+for ac_header in limits.h stddef.h string.h strings.h stdlib.h \
+                 time.h \
+		 fcntl.h unistd.h sys/file.h sys/time.h sys/mman.h \
+		 sys/resource.h sys/param.h sys/times.h sys/stat.h \
+                 sys/wait.h sys/ioctl.h errno.h sys/errno.h \
+		 pwd.h direct.h dirent.h signal.h malloc.h langinfo.h \
+                 pthread.h stdarg.h stdio.h sys/types.h termios.h \
+                 netinet/in.h netdb.h
+do :
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+eval as_val=\$$as_ac_Header
+   if test "x$as_val" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+# Checks for typedefs, structures, and compiler characteristics.
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat file-mode macros are broken" >&5
+$as_echo_n "checking whether stat file-mode macros are broken... " >&6; }
+if test "${ac_cv_header_stat_broken+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#if defined S_ISBLK && defined S_IFDIR
+extern char c1[S_ISBLK (S_IFDIR) ? -1 : 1];
+#endif
+
+#if defined S_ISBLK && defined S_IFCHR
+extern char c2[S_ISBLK (S_IFCHR) ? -1 : 1];
+#endif
+
+#if defined S_ISLNK && defined S_IFREG
+extern char c3[S_ISLNK (S_IFREG) ? -1 : 1];
+#endif
+
+#if defined S_ISSOCK && defined S_IFREG
+extern char c4[S_ISSOCK (S_IFREG) ? -1 : 1];
+#endif
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_stat_broken=no
+else
+  ac_cv_header_stat_broken=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stat_broken" >&5
+$as_echo "$ac_cv_header_stat_broken" >&6; }
+if test $ac_cv_header_stat_broken = yes; then
+
+$as_echo "#define STAT_MACROS_BROKEN 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct tm is in sys/time.h or time.h" >&5
+$as_echo_n "checking whether struct tm is in sys/time.h or time.h... " >&6; }
+if test "${ac_cv_struct_tm+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <sys/types.h>
+#include <time.h>
+
+int
+main ()
+{
+struct tm tm;
+				     int *p = &tm.tm_sec;
+				     return !p;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_struct_tm=time.h
+else
+  ac_cv_struct_tm=sys/time.h
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_tm" >&5
+$as_echo "$ac_cv_struct_tm" >&6; }
+if test $ac_cv_struct_tm = sys/time.h; then
+
+$as_echo "#define TM_IN_SYS_TIME 1" >>confdefs.h
+
+fi
+
+# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works
+# for constant arguments.  Useless!
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5
+$as_echo_n "checking for working alloca.h... " >&6; }
+if test "${ac_cv_working_alloca_h+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <alloca.h>
+int
+main ()
+{
+char *p = (char *) alloca (2 * sizeof (int));
+			  if (p) return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_working_alloca_h=yes
+else
+  ac_cv_working_alloca_h=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_working_alloca_h" >&5
+$as_echo "$ac_cv_working_alloca_h" >&6; }
+if test $ac_cv_working_alloca_h = yes; then
+
+$as_echo "#define HAVE_ALLOCA_H 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5
+$as_echo_n "checking for alloca... " >&6; }
+if test "${ac_cv_func_alloca_works+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __GNUC__
+# define alloca __builtin_alloca
+#else
+# ifdef _MSC_VER
+#  include <malloc.h>
+#  define alloca _alloca
+# else
+#  ifdef HAVE_ALLOCA_H
+#   include <alloca.h>
+#  else
+#   ifdef _AIX
+ #pragma alloca
+#   else
+#    ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+#    endif
+#   endif
+#  endif
+# endif
+#endif
+
+int
+main ()
+{
+char *p = (char *) alloca (1);
+				    if (p) return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_func_alloca_works=yes
+else
+  ac_cv_func_alloca_works=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_alloca_works" >&5
+$as_echo "$ac_cv_func_alloca_works" >&6; }
+
+if test $ac_cv_func_alloca_works = yes; then
+
+$as_echo "#define HAVE_ALLOCA 1" >>confdefs.h
+
+else
+  # The SVR3 libPW and SVR4 libucb both contain incompatible functions
+# that cause trouble.  Some versions do not even contain alloca or
+# contain a buggy version.  If you still want to use their alloca,
+# use ar to extract alloca.o from them instead of compiling alloca.c.
+
+ALLOCA=\${LIBOBJDIR}alloca.$ac_objext
+
+$as_echo "#define C_ALLOCA 1" >>confdefs.h
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5
+$as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; }
+if test "${ac_cv_os_cray+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#if defined CRAY && ! defined CRAY2
+webecray
+#else
+wenotbecray
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "webecray" >/dev/null 2>&1; then :
+  ac_cv_os_cray=yes
+else
+  ac_cv_os_cray=no
+fi
+rm -f conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_os_cray" >&5
+$as_echo "$ac_cv_os_cray" >&6; }
+if test $ac_cv_os_cray = yes; then
+  for ac_func in _getb67 GETB67 getb67; do
+    as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+eval as_val=\$$as_ac_var
+   if test "x$as_val" = x""yes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define CRAY_STACKSEG_END $ac_func
+_ACEOF
+
+    break
+fi
+
+  done
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5
+$as_echo_n "checking stack direction for C alloca... " >&6; }
+if test "${ac_cv_c_stack_direction+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test "$cross_compiling" = yes; then :
+  ac_cv_c_stack_direction=0
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$ac_includes_default
+int
+find_stack_direction ()
+{
+  static char *addr = 0;
+  auto char dummy;
+  if (addr == 0)
+    {
+      addr = &dummy;
+      return find_stack_direction ();
+    }
+  else
+    return (&dummy > addr) ? 1 : -1;
+}
+
+int
+main ()
+{
+  return find_stack_direction () < 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+  ac_cv_c_stack_direction=1
+else
+  ac_cv_c_stack_direction=-1
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_stack_direction" >&5
+$as_echo "$ac_cv_c_stack_direction" >&6; }
+cat >>confdefs.h <<_ACEOF
+#define STACK_DIRECTION $ac_cv_c_stack_direction
+_ACEOF
+
+
+fi
+
+for ac_header in sys/select.h sys/socket.h
+do :
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+eval as_val=\$$as_ac_Header
+   if test "x$as_val" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking types of arguments for select" >&5
+$as_echo_n "checking types of arguments for select... " >&6; }
+if test "${ac_cv_func_select_args+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  for ac_arg234 in 'fd_set *' 'int *' 'void *'; do
+ for ac_arg1 in 'int' 'size_t' 'unsigned long int' 'unsigned int'; do
+  for ac_arg5 in 'struct timeval *' 'const struct timeval *'; do
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$ac_includes_default
+#ifdef HAVE_SYS_SELECT_H
+# include <sys/select.h>
+#endif
+#ifdef HAVE_SYS_SOCKET_H
+# include <sys/socket.h>
+#endif
+
+int
+main ()
+{
+extern int select ($ac_arg1,
+					    $ac_arg234, $ac_arg234, $ac_arg234,
+					    $ac_arg5);
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_func_select_args="$ac_arg1,$ac_arg234,$ac_arg5"; break 3
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+  done
+ done
+done
+# Provide a safe default value.
+: ${ac_cv_func_select_args='int,int *,struct timeval *'}
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_select_args" >&5
+$as_echo "$ac_cv_func_select_args" >&6; }
+ac_save_IFS=$IFS; IFS=','
+set dummy `echo "$ac_cv_func_select_args" | sed 's/\*/\*/g'`
+IFS=$ac_save_IFS
+shift
+
+cat >>confdefs.h <<_ACEOF
+#define SELECT_TYPE_ARG1 $1
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define SELECT_TYPE_ARG234 ($2)
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define SELECT_TYPE_ARG5 ($3)
+_ACEOF
+
+rm -f conftest*
+
+
+# Checks for library functions.
+
+for ac_func in ctime
+do :
+  ac_fn_c_check_func "$LINENO" "ctime" "ac_cv_func_ctime"
+if test "x$ac_cv_func_ctime" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_CTIME 1
+_ACEOF
+
+fi
+done
+
+for ac_func in rand
+do :
+  ac_fn_c_check_func "$LINENO" "rand" "ac_cv_func_rand"
+if test "x$ac_cv_func_rand" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_RAND 1
+_ACEOF
+
+fi
+done
+
+for ac_func in fstat
+do :
+  ac_fn_c_check_func "$LINENO" "fstat" "ac_cv_func_fstat"
+if test "x$ac_cv_func_fstat" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_FSTAT 1
+_ACEOF
+
+fi
+done
+
+for ac_func in select
+do :
+  ac_fn_c_check_func "$LINENO" "select" "ac_cv_func_select"
+if test "x$ac_cv_func_select" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_SELECT 1
+_ACEOF
+
+fi
+done
+
+for ac_func in strsignal
+do :
+  ac_fn_c_check_func "$LINENO" "strsignal" "ac_cv_func_strsignal"
+if test "x$ac_cv_func_strsignal" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_STRSIGNAL 1
+_ACEOF
+
+fi
+done
+
+for ac_func in strtod
+do :
+  ac_fn_c_check_func "$LINENO" "strtod" "ac_cv_func_strtod"
+if test "x$ac_cv_func_strtod" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_STRTOD 1
+_ACEOF
+
+fi
+done
+
+for ac_func in strtold
+do :
+  ac_fn_c_check_func "$LINENO" "strtold" "ac_cv_func_strtold"
+if test "x$ac_cv_func_strtold" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_STRTOLD 1
+_ACEOF
+
+fi
+done
+
+for ac_func in cfmakeraw
+do :
+  ac_fn_c_check_func "$LINENO" "cfmakeraw" "ac_cv_func_cfmakeraw"
+if test "x$ac_cv_func_cfmakeraw" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_CFMAKERAW 1
+_ACEOF
+
+fi
+done
+
+
+#
+# library functions (used by gm2-libs and ulm-lib-gm2)
+# the results of this configuration are process by
+# tools-src/createUlmSys in order to produce the runtime system
+# interface.
+#
+for ac_func in access
+do :
+  ac_fn_c_check_func "$LINENO" "access" "ac_cv_func_access"
+if test "x$ac_cv_func_access" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_ACCESS 1
+_ACEOF
+
+fi
+done
+
+for ac_func in brk
+do :
+  ac_fn_c_check_func "$LINENO" "brk" "ac_cv_func_brk"
+if test "x$ac_cv_func_brk" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_BRK 1
+_ACEOF
+
+fi
+done
+
+for ac_func in close
+do :
+  ac_fn_c_check_func "$LINENO" "close" "ac_cv_func_close"
+if test "x$ac_cv_func_close" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_CLOSE 1
+_ACEOF
+
+fi
+done
+
+for ac_func in creat
+do :
+  ac_fn_c_check_func "$LINENO" "creat" "ac_cv_func_creat"
+if test "x$ac_cv_func_creat" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_CREAT 1
+_ACEOF
+
+fi
+done
+
+for ac_func in dup
+do :
+  ac_fn_c_check_func "$LINENO" "dup" "ac_cv_func_dup"
+if test "x$ac_cv_func_dup" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_DUP 1
+_ACEOF
+
+fi
+done
+
+for ac_func in execve
+do :
+  ac_fn_c_check_func "$LINENO" "execve" "ac_cv_func_execve"
+if test "x$ac_cv_func_execve" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_EXECVE 1
+_ACEOF
+
+fi
+done
+
+for ac_func in exit
+do :
+  ac_fn_c_check_func "$LINENO" "exit" "ac_cv_func_exit"
+if test "x$ac_cv_func_exit" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_EXIT 1
+_ACEOF
+
+fi
+done
+
+for ac_func in fcntl
+do :
+  ac_fn_c_check_func "$LINENO" "fcntl" "ac_cv_func_fcntl"
+if test "x$ac_cv_func_fcntl" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_FCNTL 1
+_ACEOF
+
+fi
+done
+
+for ac_func in fstat
+do :
+  ac_fn_c_check_func "$LINENO" "fstat" "ac_cv_func_fstat"
+if test "x$ac_cv_func_fstat" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_FSTAT 1
+_ACEOF
+
+fi
+done
+
+for ac_func in getdents
+do :
+  ac_fn_c_check_func "$LINENO" "getdents" "ac_cv_func_getdents"
+if test "x$ac_cv_func_getdents" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_GETDENTS 1
+_ACEOF
+
+fi
+done
+
+for ac_func in getgid
+do :
+  ac_fn_c_check_func "$LINENO" "getgid" "ac_cv_func_getgid"
+if test "x$ac_cv_func_getgid" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_GETGID 1
+_ACEOF
+
+fi
+done
+
+for ac_func in getpid
+do :
+  ac_fn_c_check_func "$LINENO" "getpid" "ac_cv_func_getpid"
+if test "x$ac_cv_func_getpid" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_GETPID 1
+_ACEOF
+
+fi
+done
+
+for ac_func in gettimeofday
+do :
+  ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday"
+if test "x$ac_cv_func_gettimeofday" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_GETTIMEOFDAY 1
+_ACEOF
+
+fi
+done
+
+for ac_func in getuid
+do :
+  ac_fn_c_check_func "$LINENO" "getuid" "ac_cv_func_getuid"
+if test "x$ac_cv_func_getuid" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_GETUID 1
+_ACEOF
+
+fi
+done
+
+for ac_func in ioctl
+do :
+  ac_fn_c_check_func "$LINENO" "ioctl" "ac_cv_func_ioctl"
+if test "x$ac_cv_func_ioctl" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_IOCTL 1
+_ACEOF
+
+fi
+done
+
+for ac_func in kill
+do :
+  ac_fn_c_check_func "$LINENO" "kill" "ac_cv_func_kill"
+if test "x$ac_cv_func_kill" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_KILL 1
+_ACEOF
+
+fi
+done
+
+for ac_func in link
+do :
+  ac_fn_c_check_func "$LINENO" "link" "ac_cv_func_link"
+if test "x$ac_cv_func_link" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_LINK 1
+_ACEOF
+
+fi
+done
+
+for ac_func in lseek
+do :
+  ac_fn_c_check_func "$LINENO" "lseek" "ac_cv_func_lseek"
+if test "x$ac_cv_func_lseek" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_LSEEK 1
+_ACEOF
+
+fi
+done
+
+for ac_func in open
+do :
+  ac_fn_c_check_func "$LINENO" "open" "ac_cv_func_open"
+if test "x$ac_cv_func_open" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_OPEN 1
+_ACEOF
+
+fi
+done
+
+for ac_func in pause
+do :
+  ac_fn_c_check_func "$LINENO" "pause" "ac_cv_func_pause"
+if test "x$ac_cv_func_pause" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_PAUSE 1
+_ACEOF
+
+fi
+done
+
+for ac_func in pipe
+do :
+  ac_fn_c_check_func "$LINENO" "pipe" "ac_cv_func_pipe"
+if test "x$ac_cv_func_pipe" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_PIPE 1
+_ACEOF
+
+fi
+done
+
+for ac_func in read
+do :
+  ac_fn_c_check_func "$LINENO" "read" "ac_cv_func_read"
+if test "x$ac_cv_func_read" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_READ 1
+_ACEOF
+
+fi
+done
+
+for ac_func in setitimer
+do :
+  ac_fn_c_check_func "$LINENO" "setitimer" "ac_cv_func_setitimer"
+if test "x$ac_cv_func_setitimer" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_SETITIMER 1
+_ACEOF
+
+fi
+done
+
+for ac_func in setgid
+do :
+  ac_fn_c_check_func "$LINENO" "setgid" "ac_cv_func_setgid"
+if test "x$ac_cv_func_setgid" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_SETGID 1
+_ACEOF
+
+fi
+done
+
+for ac_func in setuid
+do :
+  ac_fn_c_check_func "$LINENO" "setuid" "ac_cv_func_setuid"
+if test "x$ac_cv_func_setuid" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_SETUID 1
+_ACEOF
+
+fi
+done
+
+for ac_func in stat
+do :
+  ac_fn_c_check_func "$LINENO" "stat" "ac_cv_func_stat"
+if test "x$ac_cv_func_stat" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_STAT 1
+_ACEOF
+
+fi
+done
+
+for ac_func in times
+do :
+  ac_fn_c_check_func "$LINENO" "times" "ac_cv_func_times"
+if test "x$ac_cv_func_times" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_TIMES 1
+_ACEOF
+
+fi
+done
+
+for ac_func in unlink
+do :
+  ac_fn_c_check_func "$LINENO" "unlink" "ac_cv_func_unlink"
+if test "x$ac_cv_func_unlink" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_UNLINK 1
+_ACEOF
+
+fi
+done
+
+for ac_func in wait
+do :
+  ac_fn_c_check_func "$LINENO" "wait" "ac_cv_func_wait"
+if test "x$ac_cv_func_wait" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_WAIT 1
+_ACEOF
+
+fi
+done
+
+for ac_func in write
+do :
+  ac_fn_c_check_func "$LINENO" "write" "ac_cv_func_write"
+if test "x$ac_cv_func_write" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_WRITE 1
+_ACEOF
+
+fi
+done
+
+
+
+
+# The cast to long int works around a bug in the HP C Compiler
+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
+# This bug is HP SR number 8606223364.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long" >&5
+$as_echo_n "checking size of long... " >&6; }
+if test "${ac_cv_sizeof_long+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long"        "$ac_includes_default"; then :
+
+else
+  if test "$ac_cv_type_long" = yes; then
+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ as_fn_set_status 77
+as_fn_error "cannot compute sizeof (long)
+See \`config.log' for more details." "$LINENO" 5; }; }
+   else
+     ac_cv_sizeof_long=0
+   fi
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long" >&5
+$as_echo "$ac_cv_sizeof_long" >&6; }
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_LONG $ac_cv_sizeof_long
+_ACEOF
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5
+$as_echo_n "checking for struct timeval... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif
+int
+main ()
+{
+static struct timeval x; x.tv_sec = x.tv_usec;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+   HAVE_TIMEVAL=yes
+
+$as_echo "#define HAVE_TIMEVAL 1" >>confdefs.h
+
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+   HAVE_TIMEVAL=no
+
+$as_echo "#define HAVE_TIMEVAL 1" >>confdefs.h
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+
+# AC_CHECK_TYPES(time_t)
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for exp10 in -lm" >&5
+$as_echo_n "checking for exp10 in -lm... " >&6; }
+if test "${ac_cv_lib_m_exp10+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char exp10 ();
+int
+main ()
+{
+return exp10 ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_exp10=yes
+else
+  ac_cv_lib_m_exp10=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_exp10" >&5
+$as_echo "$ac_cv_lib_m_exp10" >&6; }
+if test "x$ac_cv_lib_m_exp10" = x""yes; then :
+
+$as_echo "#define HAVE_EXP10 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for exp10f in -lm" >&5
+$as_echo_n "checking for exp10f in -lm... " >&6; }
+if test "${ac_cv_lib_m_exp10f+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char exp10f ();
+int
+main ()
+{
+return exp10f ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_exp10f=yes
+else
+  ac_cv_lib_m_exp10f=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_exp10f" >&5
+$as_echo "$ac_cv_lib_m_exp10f" >&6; }
+if test "x$ac_cv_lib_m_exp10f" = x""yes; then :
+
+$as_echo "#define HAVE_EXP10F 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for exp10l in -lm" >&5
+$as_echo_n "checking for exp10l in -lm... " >&6; }
+if test "${ac_cv_lib_m_exp10l+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char exp10l ();
+int
+main ()
+{
+return exp10l ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_exp10l=yes
+else
+  ac_cv_lib_m_exp10l=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_exp10l" >&5
+$as_echo "$ac_cv_lib_m_exp10l" >&6; }
+if test "x$ac_cv_lib_m_exp10l" = x""yes; then :
+
+$as_echo "#define HAVE_EXP10L 1" >>confdefs.h
+
+fi
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for signbit in -lm" >&5
+$as_echo_n "checking for signbit in -lm... " >&6; }
+if test "${ac_cv_lib_m_signbit+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char signbit ();
+int
+main ()
+{
+return signbit ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_signbit=yes
+else
+  ac_cv_lib_m_signbit=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_signbit" >&5
+$as_echo "$ac_cv_lib_m_signbit" >&6; }
+if test "x$ac_cv_lib_m_signbit" = x""yes; then :
+
+$as_echo "#define HAVE_SIGNBIT 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for signbitf in -lm" >&5
+$as_echo_n "checking for signbitf in -lm... " >&6; }
+if test "${ac_cv_lib_m_signbitf+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char signbitf ();
+int
+main ()
+{
+return signbitf ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_signbitf=yes
+else
+  ac_cv_lib_m_signbitf=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_signbitf" >&5
+$as_echo "$ac_cv_lib_m_signbitf" >&6; }
+if test "x$ac_cv_lib_m_signbitf" = x""yes; then :
+
+$as_echo "#define HAVE_SIGNBITF 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for signbitl in -lm" >&5
+$as_echo_n "checking for signbitl in -lm... " >&6; }
+if test "${ac_cv_lib_m_signbitl+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char signbitl ();
+int
+main ()
+{
+return signbitl ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_signbitl=yes
+else
+  ac_cv_lib_m_signbitl=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_signbitl" >&5
+$as_echo "$ac_cv_lib_m_signbitl" >&6; }
+if test "x$ac_cv_lib_m_signbitl" = x""yes; then :
+
+$as_echo "#define HAVE_SIGNBITL 1" >>confdefs.h
+
+fi
+
+
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems.  If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, we kill variables containing newlines.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(
+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+
+  (set) 2>&1 |
+    case $as_nl`(ac_space=' '; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      # `set' does not quote correctly, so add quotes: double-quote
+      # substitution turns \\\\ into \\, and sed turns \\ into \.
+      sed -n \
+	"s/'/'\\\\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+      ;; #(
+    *)
+      # `set' quotes correctly as required by POSIX, so do not add quotes.
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+) |
+  sed '
+     /^ac_cv_env_/b end
+     t clear
+     :clear
+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+     t end
+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+     :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+  if test -w "$cache_file"; then
+    test "x$cache_file" != "x/dev/null" &&
+      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
+    cat confcache >$cache_file
+  else
+    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
+  fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+DEFS=-DHAVE_CONFIG_H
+
+ac_libobjs=
+ac_ltlibobjs=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+  # 1. Remove the extension, and $U if already installed.
+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
+  #    will be set to the directory where LIBOBJS objects are built.
+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: ${CONFIG_STATUS=./config.status}
+ac_write_fail=0
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error ERROR [LINENO LOG_FD]
+# ---------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with status $?, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$?; test $as_status -eq 0 && as_status=1
+  if test "$3"; then
+    as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3
+  fi
+  $as_echo "$as_me: error: $1" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -p'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -p'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -p'
+  fi
+else
+  as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+if test -x / >/dev/null 2>&1; then
+  as_test_x='test -x'
+else
+  if ls -dL / >/dev/null 2>&1; then
+    as_ls_L_option=L
+  else
+    as_ls_L_option=
+  fi
+  as_test_x='
+    eval sh -c '\''
+      if test -d "$1"; then
+	test -d "$1/.";
+      else
+	case $1 in #(
+	-*)set "./$1";;
+	esac;
+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
+	???[sx]*):;;*)false;;esac;fi
+    '\'' sh
+  '
+fi
+as_executable_p=$as_test_x
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+exec 6>&1
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling.
+ac_log="
+This file was extended by ASCII.def $as_me 1.8.2, which was
+generated by GNU Autoconf 2.64.  Invocation command line was
+
+  CONFIG_FILES    = $CONFIG_FILES
+  CONFIG_HEADERS  = $CONFIG_HEADERS
+  CONFIG_LINKS    = $CONFIG_LINKS
+  CONFIG_COMMANDS = $CONFIG_COMMANDS
+  $ $0 $@
+
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
+_ACEOF
+
+
+case $ac_config_headers in *"
+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;
+esac
+
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+# Files that config.status was made for.
+config_headers="$ac_config_headers"
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+ac_cs_usage="\
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration.  Unless the files
+and actions are specified as TAGs, all are instantiated by default.
+
+Usage: $0 [OPTION]... [TAG]...
+
+  -h, --help       print this help, then exit
+  -V, --version    print version number and configuration settings, then exit
+  -q, --quiet, --silent
+                   do not print progress messages
+  -d, --debug      don't remove temporary files
+      --recheck    update $as_me by reconfiguring in the same conditions
+      --header=FILE[:TEMPLATE]
+                   instantiate the configuration header FILE
+
+Configuration headers:
+$config_headers
+
+Report bugs to <gm2@nongnu.org>."
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_version="\\
+ASCII.def config.status 1.8.2
+configured by $0, generated by GNU Autoconf 2.64,
+  with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
+
+Copyright (C) 2009 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+test -n "\$AWK" || AWK=awk
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
+ac_need_defaults=:
+while test $# != 0
+do
+  case $1 in
+  --*=*)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
+    ac_shift=:
+    ;;
+  *)
+    ac_option=$1
+    ac_optarg=$2
+    ac_shift=shift
+    ;;
+  esac
+
+  case $ac_option in
+  # Handling of the options.
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    ac_cs_recheck=: ;;
+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+    $as_echo "$ac_cs_version"; exit ;;
+  --debug | --debu | --deb | --de | --d | -d )
+    debug=: ;;
+  --header | --heade | --head | --hea )
+    $ac_shift
+    case $ac_optarg in
+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"
+    ac_need_defaults=false;;
+  --he | --h)
+    # Conflict between --help and --header
+    as_fn_error "ambiguous option: \`$1'
+Try \`$0 --help' for more information.";;
+  --help | --hel | -h )
+    $as_echo "$ac_cs_usage"; exit ;;
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil | --si | --s)
+    ac_cs_silent=: ;;
+
+  # This is an error.
+  -*) as_fn_error "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
+
+  *) as_fn_append ac_config_targets " $1"
+     ac_need_defaults=false ;;
+
+  esac
+  shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+  exec 6>/dev/null
+  ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+if \$ac_cs_recheck; then
+  set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+  shift
+  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+  CONFIG_SHELL='$SHELL'
+  export CONFIG_SHELL
+  exec "\$@"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+exec 5>>config.log
+{
+  echo
+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+  $as_echo "$ac_log"
+} >&5
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+
+# Handling of arguments.
+for ac_config_target in $ac_config_targets
+do
+  case $ac_config_target in
+    "gm2-libs-host.h") CONFIG_HEADERS="$CONFIG_HEADERS gm2-libs-host.h:gm2-libs-host.h.in" ;;
+
+  *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
+  esac
+done
+
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used.  Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
+fi
+
+# Have a temporary directory for convenience.  Make it in the build tree
+# simply because there is no reason against having it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
+$debug ||
+{
+  tmp=
+  trap 'exit_status=$?
+  { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status
+' 0
+  trap 'as_fn_exit 1' 1 2 13 15
+}
+# Create a (secure) tmp directory for tmp files.
+
+{
+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+  test -n "$tmp" && test -d "$tmp"
+}  ||
+{
+  tmp=./conf$$-$RANDOM
+  (umask 077 && mkdir "$tmp")
+} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5
+
+# Set up the scripts for CONFIG_HEADERS section.
+# No need to generate them if there are no CONFIG_HEADERS.
+# This happens for instance with `./config.status Makefile'.
+if test -n "$CONFIG_HEADERS"; then
+cat >"$tmp/defines.awk" <<\_ACAWK ||
+BEGIN {
+_ACEOF
+
+# Transform confdefs.h into an awk script `defines.awk', embedded as
+# here-document in config.status, that substitutes the proper values into
+# config.h.in to produce config.h.
+
+# Create a delimiter string that does not exist in confdefs.h, to ease
+# handling of long lines.
+ac_delim='%!_!# '
+for ac_last_try in false false :; do
+  ac_t=`sed -n "/$ac_delim/p" confdefs.h`
+  if test -z "$ac_t"; then
+    break
+  elif $ac_last_try; then
+    as_fn_error "could not make $CONFIG_HEADERS" "$LINENO" 5
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+
+# For the awk script, D is an array of macro values keyed by name,
+# likewise P contains macro parameters if any.  Preserve backslash
+# newline sequences.
+
+ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*
+sed -n '
+s/.\{148\}/&'"$ac_delim"'/g
+t rset
+:rset
+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /
+t def
+d
+:def
+s/\\$//
+t bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3"/p
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p
+d
+:bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3\\\\\\n"\\/p
+t cont
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p
+t cont
+d
+:cont
+n
+s/.\{148\}/&'"$ac_delim"'/g
+t clear
+:clear
+s/\\$//
+t bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/"/p
+d
+:bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p
+b cont
+' <confdefs.h | sed '
+s/'"$ac_delim"'/"\\\
+"/g' >>$CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+  for (key in D) D_is_set[key] = 1
+  FS = ""
+}
+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {
+  line = \$ 0
+  split(line, arg, " ")
+  if (arg[1] == "#") {
+    defundef = arg[2]
+    mac1 = arg[3]
+  } else {
+    defundef = substr(arg[1], 2)
+    mac1 = arg[2]
+  }
+  split(mac1, mac2, "(") #)
+  macro = mac2[1]
+  prefix = substr(line, 1, index(line, defundef) - 1)
+  if (D_is_set[macro]) {
+    # Preserve the white space surrounding the "#".
+    print prefix "define", macro P[macro] D[macro]
+    next
+  } else {
+    # Replace #undef with comments.  This is necessary, for example,
+    # in the case of _POSIX_SOURCE, which is predefined and required
+    # on some systems where configure will not decide to define it.
+    if (defundef == "undef") {
+      print "/*", prefix defundef, macro, "*/"
+      next
+    }
+  }
+}
+{ print }
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+  as_fn_error "could not setup config headers machinery" "$LINENO" 5
+fi # test -n "$CONFIG_HEADERS"
+
+
+eval set X "    :H $CONFIG_HEADERS    "
+shift
+for ac_tag
+do
+  case $ac_tag in
+  :[FHLC]) ac_mode=$ac_tag; continue;;
+  esac
+  case $ac_mode$ac_tag in
+  :[FHL]*:*);;
+  :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;;
+  :[FH]-) ac_tag=-:-;;
+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+  esac
+  ac_save_IFS=$IFS
+  IFS=:
+  set x $ac_tag
+  IFS=$ac_save_IFS
+  shift
+  ac_file=$1
+  shift
+
+  case $ac_mode in
+  :L) ac_source=$1;;
+  :[FH])
+    ac_file_inputs=
+    for ac_f
+    do
+      case $ac_f in
+      -) ac_f="$tmp/stdin";;
+      *) # Look for the file first in the build tree, then in the source tree
+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
+	 # because $ac_f cannot contain `:'.
+	 test -f "$ac_f" ||
+	   case $ac_f in
+	   [\\/$]*) false;;
+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+	   esac ||
+	   as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;;
+      esac
+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+      as_fn_append ac_file_inputs " '$ac_f'"
+    done
+
+    # Let's still pretend it is `configure' which instantiates (i.e., don't
+    # use $as_me), people would be surprised to read:
+    #    /* config.h.  Generated by config.status.  */
+    configure_input='Generated from '`
+	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+	`' by configure.'
+    if test x"$ac_file" != x-; then
+      configure_input="$ac_file.  $configure_input"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
+    fi
+    # Neutralize special characters interpreted by sed in replacement strings.
+    case $configure_input in #(
+    *\&* | *\|* | *\\* )
+       ac_sed_conf_input=`$as_echo "$configure_input" |
+       sed 's/[\\\\&|]/\\\\&/g'`;; #(
+    *) ac_sed_conf_input=$configure_input;;
+    esac
+
+    case $ac_tag in
+    *:-:* | *:-) cat >"$tmp/stdin" \
+      || as_fn_error "could not create $ac_file" "$LINENO" 5 ;;
+    esac
+    ;;
+  esac
+
+  ac_dir=`$as_dirname -- "$ac_file" ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$ac_file" : 'X\(//\)[^/]' \| \
+	 X"$ac_file" : 'X\(//\)$' \| \
+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$ac_file" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  as_dir="$ac_dir"; as_fn_mkdir_p
+  ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+
+  case $ac_mode in
+
+  :H)
+  #
+  # CONFIG_HEADER
+  #
+  if test x"$ac_file" != x-; then
+    {
+      $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs"
+    } >"$tmp/config.h" \
+      || as_fn_error "could not create $ac_file" "$LINENO" 5
+    if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5
+$as_echo "$as_me: $ac_file is unchanged" >&6;}
+    else
+      rm -f "$ac_file"
+      mv "$tmp/config.h" "$ac_file" \
+	|| as_fn_error "could not create $ac_file" "$LINENO" 5
+    fi
+  else
+    $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \
+      || as_fn_error "could not create -" "$LINENO" 5
+  fi
+ ;;
+
+
+  esac
+
+done # for ac_tag
+
+
+as_fn_exit 0
+_ACEOF
+ac_clean_files=$ac_clean_files_save
+
+test $ac_write_fail = 0 ||
+  as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded.  So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status.  When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+  ac_cs_success=:
+  ac_config_status_args=
+  test "$silent" = yes &&
+    ac_config_status_args="$ac_config_status_args --quiet"
+  exec 5>/dev/null
+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+  exec 5>>config.log
+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+  # would make configure fail if this is the last instruction.
+  $ac_cs_success || as_fn_exit $?
+fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
+fi
+
diff --git a/gcc/m2/gm2-libs/config-host.in b/gcc/m2/gm2-libs/config-host.in
new file mode 100644
index 00000000000..d17480de135
--- /dev/null
+++ b/gcc/m2/gm2-libs/config-host.in
@@ -0,0 +1,148 @@
+# 
+# config-host.in a configure sub script for GNU M2.
+# 
+# Copyright (C) 2005-2021 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/>.
+#
+AC_INIT(ASCII.def, 1.9.5, gm2@nongnu.org)
+AC_CONFIG_HEADER(gm2-libs-host.h:gm2-libs-host.h.in)
+
+# Checks for programs.
+
+# Checks for libraries.
+
+# Checks for header files.
+AC_HEADER_STDC
+AC_HEADER_TIME
+AC_HEADER_SYS_WAIT
+AC_CHECK_HEADER([math.h],
+	       [AC_DEFINE([HAVE_MATH_H], [1], [have math.h])])
+
+AC_CHECK_HEADERS([limits.h stddef.h string.h strings.h stdlib.h \
+		  time.h \
+		  fcntl.h unistd.h sys/file.h sys/time.h sys/mman.h \
+		  sys/resource.h sys/param.h sys/times.h sys/stat.h \
+                  sys/wait.h sys/ioctl.h errno.h sys/errno.h \
+		  pwd.h direct.h dirent.h signal.h malloc.h langinfo.h \
+                  pthread.h stdarg.h stdio.h sys/types.h termios.h \
+                  netinet/in.h netdb.h])
+
+# Checks for typedefs, structures, and compiler characteristics.
+
+AC_HEADER_STAT
+AC_STRUCT_TM
+AC_FUNC_ALLOCA
+AC_FUNC_SELECT_ARGTYPES
+
+# Checks for library functions.
+
+AC_CHECK_FUNCS(ctime)
+AC_CHECK_FUNCS(rand)
+AC_CHECK_FUNCS(fstat)
+AC_CHECK_FUNCS(select)
+AC_CHECK_FUNCS(strsignal)
+AC_CHECK_FUNCS(strtod)
+AC_CHECK_FUNCS(strtold)
+AC_CHECK_FUNCS(cfmakeraw)
+
+#
+# library functions (used by gm2-libs and ulm-lib-gm2)
+# the results of this configuration are process by
+# tools-src/createUlmSys in order to produce the runtime system
+# interface.
+#
+AC_CHECK_FUNCS(access)
+AC_CHECK_FUNCS(brk)
+AC_CHECK_FUNCS(close)
+AC_CHECK_FUNCS(creat)
+AC_CHECK_FUNCS(dup)
+AC_CHECK_FUNCS(execve)
+AC_CHECK_FUNCS(exit)
+AC_CHECK_FUNCS(fcntl)
+AC_CHECK_FUNCS(fstat)
+AC_CHECK_FUNCS(getdents)
+AC_CHECK_FUNCS(getgid)
+AC_CHECK_FUNCS(getpid)
+AC_CHECK_FUNCS(gettimeofday)
+AC_CHECK_FUNCS(getuid)
+AC_CHECK_FUNCS(ioctl)
+AC_CHECK_FUNCS(kill)
+AC_CHECK_FUNCS(link)
+AC_CHECK_FUNCS(lseek)
+AC_CHECK_FUNCS(open)
+AC_CHECK_FUNCS(pause)
+AC_CHECK_FUNCS(pipe)
+AC_CHECK_FUNCS(read)
+AC_CHECK_FUNCS(setitimer)
+AC_CHECK_FUNCS(setgid)
+AC_CHECK_FUNCS(setuid)
+AC_CHECK_FUNCS(stat)
+AC_CHECK_FUNCS(times)
+AC_CHECK_FUNCS(unlink)
+AC_CHECK_FUNCS(wait)
+AC_CHECK_FUNCS(write)
+
+
+dnl
+dnl  now check for specific types
+dnl
+
+AC_CHECK_SIZEOF([long])
+
+dnl this routine has been adopted from the GNU emacs20 distrubution
+AC_MSG_CHECKING(for struct timeval)
+AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME
+#include <sys/time.h>
+#include <time.h>
+#else
+#ifdef HAVE_SYS_TIME_H
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif
+#endif], [static struct timeval x; x.tv_sec = x.tv_usec;],
+  [AC_MSG_RESULT(yes)
+   HAVE_TIMEVAL=yes
+   AC_DEFINE([HAVE_TIMEVAL], [1], [struct timeval exists])],
+  [AC_MSG_RESULT(no)
+   HAVE_TIMEVAL=no]
+   AC_DEFINE([HAVE_TIMEVAL], [1], [struct timeval exists]))
+
+
+# AC_CHECK_TYPES(time_t)
+
+
+dnl
+dnl  now check for presence of libraries and functions within libraries.
+dnl
+
+AC_CHECK_LIB(m, exp10, [AC_DEFINE([HAVE_EXP10],[1],[Define to 1 if your system has 'exp10'.])])
+AC_CHECK_LIB(m, exp10f, [AC_DEFINE([HAVE_EXP10F],[1],[Define to 1 if your system has 'exp10f'.])])
+AC_CHECK_LIB(m, exp10l, [AC_DEFINE([HAVE_EXP10L],[1],[Define to 1 if your system has 'exp10l'.])])
+
+AC_CHECK_LIB(m, signbit, [AC_DEFINE([HAVE_SIGNBIT],[1],[Define to 1 if your system has 'signbit'.])])
+AC_CHECK_LIB(m, signbitf, [AC_DEFINE([HAVE_SIGNBITF],[1],[Define to 1 if your system has 'signbitf'.])])
+AC_CHECK_LIB(m, signbitl, [AC_DEFINE([HAVE_SIGNBITL],[1],[Define to 1 if your system has 'signbitl'.])])
+
+AC_OUTPUT
diff --git a/gcc/m2/gm2-libs/cxxabi.def b/gcc/m2/gm2-libs/cxxabi.def
new file mode 100644
index 00000000000..8bbd5500e9c
--- /dev/null
+++ b/gcc/m2/gm2-libs/cxxabi.def
@@ -0,0 +1,41 @@
+(* cxxabi.def provides prototypes to the C++ABI.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" cxxabi ;
+
+(* This should only be used by the compiler and it matches the
+    g++ implementation.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT UNQUALIFIED __cxa_begin_catch, __cxa_end_catch, __cxa_rethrow ;
+
+
+PROCEDURE __cxa_begin_catch (a: ADDRESS) : ADDRESS ;
+PROCEDURE __cxa_end_catch ;
+PROCEDURE __cxa_rethrow ;
+
+
+END cxxabi.
diff --git a/gcc/m2/gm2-libs/dtoa.def b/gcc/m2/gm2-libs/dtoa.def
new file mode 100644
index 00000000000..401440f39f2
--- /dev/null
+++ b/gcc/m2/gm2-libs/dtoa.def
@@ -0,0 +1,59 @@
+(* dtoa.def provides routines to convert between a C double.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE dtoa ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   Mode = (maxsignificant, decimaldigits) ;
+
+
+(*
+   strtod - returns a REAL given a string, s.  It will set
+            error to TRUE if the number is too large.
+*)
+
+PROCEDURE strtod (s: ADDRESS; VAR error: BOOLEAN) : REAL ;
+
+
+(*
+   dtoa - converts a REAL, d, into a string.  The address of the
+          string is returned.
+          mode       indicates the type of conversion required.
+          ndigits    determines the number of digits according to mode.
+          decpt      the position of the decimal point.
+          sign       does the string have a sign?
+*)
+
+PROCEDURE dtoa (d        : REAL;
+                mode     : Mode;
+                ndigits  : INTEGER;
+	        VAR decpt: INTEGER;
+	        VAR sign : BOOLEAN) : ADDRESS ;
+
+
+END dtoa.
diff --git a/gcc/m2/gm2-libs/errno.def b/gcc/m2/gm2-libs/errno.def
new file mode 100644
index 00000000000..4e3c09cb531
--- /dev/null
+++ b/gcc/m2/gm2-libs/errno.def
@@ -0,0 +1,37 @@
+(* errno.def provides a Modula-2 interface to the C errno.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE errno ;
+
+CONST
+    EINTR  =  4 ;   (* system call interrupted *)
+    ERANGE = 34 ;   (* result is too large     *)
+    EAGAIN = 11 ;   (* retry the system call   *)
+
+PROCEDURE geterrno () : INTEGER ;
+
+
+END errno.
diff --git a/gcc/m2/gm2-libs/gdbif.def b/gcc/m2/gm2-libs/gdbif.def
new file mode 100644
index 00000000000..a08a2d6bb82
--- /dev/null
+++ b/gcc/m2/gm2-libs/gdbif.def
@@ -0,0 +1,60 @@
+(* gdbif.def enable interactive connectivity with gdb.
+
+Copyright (C) 2011-2021 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/>.  *)
+
+DEFINITION MODULE gdbif ;
+
+(*  Provides interactive connectivity with gdb useful for debugging
+    Modula-2 shared libraries.  *)
+
+EXPORT UNQUALIFIED sleepSpin, finishSpin, connectSpin ;
+
+
+(*
+   finishSpin - sets boolean mustWait to FALSE.
+*)
+
+PROCEDURE finishSpin ;
+
+
+(*
+   sleepSpin - waits for the boolean variable mustWait to become FALSE.
+               It sleeps for a second between each test of the variable.
+*)
+
+PROCEDURE sleepSpin ;
+
+
+(*
+   connectSpin - breakpoint placeholder.  Its only purpose is to allow users
+                 to set a breakpoint.  This procedure is called once
+                 sleepSpin is released from its spin (via a call from
+                 finishSpin).
+*)
+
+PROCEDURE connectSpin ;
+
+
+END gdbif.
diff --git a/gcc/m2/gm2-libs/gdbif.mod b/gcc/m2/gm2-libs/gdbif.mod
new file mode 100644
index 00000000000..36a6161902c
--- /dev/null
+++ b/gcc/m2/gm2-libs/gdbif.mod
@@ -0,0 +1,109 @@
+(* gdbif.mod enable interactive connectivity with gdb.
+
+Copyright (C) 2011-2021 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/>.  *)
+
+IMPLEMENTATION MODULE gdbif ;
+
+
+FROM libc IMPORT printf, getpid, sleep ;
+FROM FIO IMPORT File, WriteString, WriteLine, OpenToWrite, Close, IsNoError ;
+FROM StringConvert IMPORT itos ;
+FROM DynamicStrings IMPORT String, KillString ;
+IMPORT SFIO ;
+
+VAR
+   invoked,
+   mustWait: BOOLEAN ;
+
+
+(*
+   connectSpin - breakpoint placeholder.
+*)
+
+PROCEDURE connectSpin ;
+BEGIN
+   (* do nothing, its purpose is to allow gdb to set breakpoints here.  *)
+END connectSpin ;
+
+
+(*
+   sleepSpin - waits for the boolean variable mustWait to become FALSE.
+               It sleeps for a second between each test of the variable.
+*)
+
+PROCEDURE sleepSpin ;
+BEGIN
+   IF mustWait
+   THEN
+      printf ("process %d is waiting for you to:\n", getpid ());
+      printf ("(gdb) attach %d\n", getpid ());
+      printf ("(gdb) break connectSpin\n");
+      printf ("(gdb) print finishSpin()\n");
+      REPEAT
+         sleep (1);
+         printf (".")
+      UNTIL NOT mustWait ;
+      printf ("ok continuing\n");
+      connectSpin
+   END
+END sleepSpin ;
+
+
+(*
+   finishSpin - sets boolean mustWait to FALSE.
+*)
+
+PROCEDURE finishSpin ;
+BEGIN
+   mustWait := FALSE
+END finishSpin ;
+
+
+(*
+   gdbinit -
+*)
+
+PROCEDURE gdbinit ;
+VAR
+   file: File ;
+   s   : String ;
+BEGIN
+   file := OpenToWrite (".gdbinit") ;
+   IF IsNoError (file)
+   THEN
+      WriteString (file, "attach ") ;
+      s := SFIO.WriteS (file, itos (getpid (), 6, " ", FALSE)) ;
+      WriteString (file, "break connectSpin") ; WriteLine (file) ;
+      WriteString (file, "print finishSpin()") ; WriteLine (file) ;
+      s := KillString (s) ;
+      Close (file) ;
+      sleepSpin
+   END
+END gdbinit ;
+
+
+BEGIN
+   mustWait := TRUE
+END gdbif.
diff --git a/gcc/m2/gm2-libs/gm2-libs-host.h.in b/gcc/m2/gm2-libs/gm2-libs-host.h.in
new file mode 100644
index 00000000000..6858e4e777f
--- /dev/null
+++ b/gcc/m2/gm2-libs/gm2-libs-host.h.in
@@ -0,0 +1,324 @@
+/* gm2-libs-host.h.in  Generated by autoheader.
+
+Copyright (C) 2005-2021 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/>.  */
+
+/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP
+   systems. This function is required for `alloca.c' support on those systems.
+   */
+#undef CRAY_STACKSEG_END
+
+/* Define to 1 if using `alloca.c'. */
+#undef C_ALLOCA
+
+/* Define to 1 if you have the `access' function. */
+#undef HAVE_ACCESS
+
+/* Define to 1 if you have `alloca', as a function or macro. */
+#undef HAVE_ALLOCA
+
+/* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix).
+   */
+#undef HAVE_ALLOCA_H
+
+/* Define to 1 if you have the `brk' function. */
+#undef HAVE_BRK
+
+/* Define to 1 if you have the `cfmakeraw' function. */
+#undef HAVE_CFMAKERAW
+
+/* Define to 1 if you have the `close' function. */
+#undef HAVE_CLOSE
+
+/* Define to 1 if you have the `creat' function. */
+#undef HAVE_CREAT
+
+/* Define to 1 if you have the `ctime' function. */
+#undef HAVE_CTIME
+
+/* Define to 1 if you have the <direct.h> header file. */
+#undef HAVE_DIRECT_H
+
+/* Define to 1 if you have the <dirent.h> header file. */
+#undef HAVE_DIRENT_H
+
+/* Define to 1 if you have the `dup' function. */
+#undef HAVE_DUP
+
+/* Define to 1 if you have the <errno.h> header file. */
+#undef HAVE_ERRNO_H
+
+/* Define to 1 if you have the `execve' function. */
+#undef HAVE_EXECVE
+
+/* Define to 1 if you have the `exit' function. */
+#undef HAVE_EXIT
+
+/* Define to 1 if your system has 'exp10'. */
+#undef HAVE_EXP10
+
+/* Define to 1 if your system has 'exp10f'. */
+#undef HAVE_EXP10F
+
+/* Define to 1 if your system has 'exp10l'. */
+#undef HAVE_EXP10L
+
+/* Define to 1 if you have the `fcntl' function. */
+#undef HAVE_FCNTL
+
+/* Define to 1 if you have the <fcntl.h> header file. */
+#undef HAVE_FCNTL_H
+
+/* Define to 1 if you have the `fstat' function. */
+#undef HAVE_FSTAT
+
+/* Define to 1 if you have the `getdents' function. */
+#undef HAVE_GETDENTS
+
+/* Define to 1 if you have the `getgid' function. */
+#undef HAVE_GETGID
+
+/* Define to 1 if you have the `getpid' function. */
+#undef HAVE_GETPID
+
+/* Define to 1 if you have the `gettimeofday' function. */
+#undef HAVE_GETTIMEOFDAY
+
+/* Define to 1 if you have the `getuid' function. */
+#undef HAVE_GETUID
+
+/* Define to 1 if you have the <inttypes.h> header file. */
+#undef HAVE_INTTYPES_H
+
+/* Define to 1 if you have the `ioctl' function. */
+#undef HAVE_IOCTL
+
+/* Define to 1 if you have the `kill' function. */
+#undef HAVE_KILL
+
+/* Define to 1 if you have the <langinfo.h> header file. */
+#undef HAVE_LANGINFO_H
+
+/* Define to 1 if you have the `pth' library (-lpth). */
+#undef HAVE_LIBPTH
+
+/* Define to 1 if you have the <limits.h> header file. */
+#undef HAVE_LIMITS_H
+
+/* Define to 1 if you have the `link' function. */
+#undef HAVE_LINK
+
+/* Define to 1 if you have the `lseek' function. */
+#undef HAVE_LSEEK
+
+/* Define to 1 if you have the <malloc.h> header file. */
+#undef HAVE_MALLOC_H
+
+/* have math.h */
+#undef HAVE_MATH_H
+
+/* Define to 1 if you have the <memory.h> header file. */
+#undef HAVE_MEMORY_H
+
+/* Define to 1 if you have the <netdb.h> header file. */
+#undef HAVE_NETDB_H
+
+/* Define to 1 if you have the <netinet/in.h> header file. */
+#undef HAVE_NETINET_IN_H
+
+/* Define to 1 if you have the `open' function. */
+#undef HAVE_OPEN
+
+/* Define to 1 if you have the `pause' function. */
+#undef HAVE_PAUSE
+
+/* Define to 1 if you have the `pipe' function. */
+#undef HAVE_PIPE
+
+/* Define to 1 if you have the <pthread.h> header file. */
+#undef HAVE_PTHREAD_H
+
+/* Define to 1 if you have the <pwd.h> header file. */
+#undef HAVE_PWD_H
+
+/* Define to 1 if you have the `rand' function. */
+#undef HAVE_RAND
+
+/* Define to 1 if you have the `read' function. */
+#undef HAVE_READ
+
+/* Define to 1 if you have the `select' function. */
+#undef HAVE_SELECT
+
+/* Define to 1 if you have the `setgid' function. */
+#undef HAVE_SETGID
+
+/* Define to 1 if you have the `setitimer' function. */
+#undef HAVE_SETITIMER
+
+/* Define to 1 if you have the `setuid' function. */
+#undef HAVE_SETUID
+
+/* Define to 1 if you have the <signal.h> header file. */
+#undef HAVE_SIGNAL_H
+
+/* Define to 1 if your system has 'signbit'. */
+#undef HAVE_SIGNBIT
+
+/* Define to 1 if your system has 'signbitf'. */
+#undef HAVE_SIGNBITF
+
+/* Define to 1 if your system has 'signbitl'. */
+#undef HAVE_SIGNBITL
+
+/* Define to 1 if you have the `stat' function. */
+#undef HAVE_STAT
+
+/* Define to 1 if you have the <stdarg.h> header file. */
+#undef HAVE_STDARG_H
+
+/* Define to 1 if you have the <stddef.h> header file. */
+#undef HAVE_STDDEF_H
+
+/* Define to 1 if you have the <stdint.h> header file. */
+#undef HAVE_STDINT_H
+
+/* Define to 1 if you have the <stdio.h> header file. */
+#undef HAVE_STDIO_H
+
+/* Define to 1 if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define to 1 if you have the <strings.h> header file. */
+#undef HAVE_STRINGS_H
+
+/* Define to 1 if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define to 1 if you have the `strsignal' function. */
+#undef HAVE_STRSIGNAL
+
+/* Define to 1 if you have the `strtod' function. */
+#undef HAVE_STRTOD
+
+/* Define to 1 if you have the `strtold' function. */
+#undef HAVE_STRTOLD
+
+/* Define to 1 if you have the <sys/errno.h> header file. */
+#undef HAVE_SYS_ERRNO_H
+
+/* Define to 1 if you have the <sys/file.h> header file. */
+#undef HAVE_SYS_FILE_H
+
+/* Define to 1 if you have the <sys/ioctl.h> header file. */
+#undef HAVE_SYS_IOCTL_H
+
+/* Define to 1 if you have the <sys/mman.h> header file. */
+#undef HAVE_SYS_MMAN_H
+
+/* Define to 1 if you have the <sys/param.h> header file. */
+#undef HAVE_SYS_PARAM_H
+
+/* Define to 1 if you have the <sys/resource.h> header file. */
+#undef HAVE_SYS_RESOURCE_H
+
+/* Define to 1 if you have the <sys/select.h> header file. */
+#undef HAVE_SYS_SELECT_H
+
+/* Define to 1 if you have the <sys/socket.h> header file. */
+#undef HAVE_SYS_SOCKET_H
+
+/* Define to 1 if you have the <sys/stat.h> header file. */
+#undef HAVE_SYS_STAT_H
+
+/* Define to 1 if you have the <sys/times.h> header file. */
+#undef HAVE_SYS_TIMES_H
+
+/* Define to 1 if you have the <sys/time.h> header file. */
+#undef HAVE_SYS_TIME_H
+
+/* Define to 1 if you have the <sys/types.h> header file. */
+#undef HAVE_SYS_TYPES_H
+
+/* Define to 1 if you have the <sys/wait.h> header file. */
+#undef HAVE_SYS_WAIT_H
+
+/* Define to 1 if you have the <termios.h> header file. */
+#undef HAVE_TERMIOS_H
+
+/* Define to 1 if you have the `times' function. */
+#undef HAVE_TIMES
+
+/* struct timeval exists */
+#undef HAVE_TIMEVAL
+
+/* Define to 1 if you have the <time.h> header file. */
+#undef HAVE_TIME_H
+
+/* Define to 1 if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
+
+/* Define to 1 if you have the `unlink' function. */
+#undef HAVE_UNLINK
+
+/* Define to 1 if you have the `wait' function. */
+#undef HAVE_WAIT
+
+/* Define to 1 if you have the `write' function. */
+#undef HAVE_WRITE
+
+/* Define to the type of arg 1 for `select'. */
+#undef SELECT_TYPE_ARG1
+
+/* Define to the type of args 2, 3 and 4 for `select'. */
+#undef SELECT_TYPE_ARG234
+
+/* Define to the type of arg 5 for `select'. */
+#undef SELECT_TYPE_ARG5
+
+/* The size of `long', as computed by sizeof. */
+#undef SIZEOF_LONG
+
+/* If using the C implementation of alloca, define if you know the
+   direction of stack growth for your system; otherwise it will be
+   automatically deduced at runtime.
+	STACK_DIRECTION > 0 => grows toward higher addresses
+	STACK_DIRECTION < 0 => grows toward lower addresses
+	STACK_DIRECTION = 0 => direction of growth unknown */
+#undef STACK_DIRECTION
+
+/* Define to 1 if the `S_IS*' macros in <sys/stat.h> do not work properly. */
+#undef STAT_MACROS_BROKEN
+
+/* Define to 1 if you have the ANSI C header files. */
+#undef STDC_HEADERS
+
+/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
+#undef TIME_WITH_SYS_TIME
+
+/* Define to 1 if your <sys/time.h> declares `struct tm'. */
+#undef TM_IN_SYS_TIME
+
+/* Define to `unsigned int' if <sys/types.h> does not define. */
+#undef size_t
diff --git a/gcc/m2/gm2-libs/ldtoa.def b/gcc/m2/gm2-libs/ldtoa.def
new file mode 100644
index 00000000000..fa4e4a694a8
--- /dev/null
+++ b/gcc/m2/gm2-libs/ldtoa.def
@@ -0,0 +1,59 @@
+(* ldtoa.def provides routines to convert between a C long double.
+
+Copyright (C) 2008-2021 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/>.  *)
+
+DEFINITION MODULE ldtoa ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   Mode = (maxsignificant, decimaldigits) ;
+
+
+(*
+   strtold - returns a LONGREAL given a C string, s.  It will set
+             error to TRUE if the number is too large or badly formed.
+*)
+
+PROCEDURE strtold (s: ADDRESS; VAR error: BOOLEAN) : LONGREAL ;
+
+
+(*
+   ldtoa - converts a LONGREAL, d, into a string.  The address of the
+           string is returned.
+           mode       indicates the type of conversion required.
+           ndigits    determines the number of digits according to mode.
+           decpt      the position of the decimal point.
+           sign       does the string have a sign?
+*)
+
+PROCEDURE ldtoa (d        : LONGREAL;
+                 mode     : Mode;
+                 ndigits  : INTEGER;
+                 VAR decpt: INTEGER;
+                 VAR sign : BOOLEAN) : ADDRESS ;
+
+
+END ldtoa.
diff --git a/gcc/m2/gm2-libs/libc.def b/gcc/m2/gm2-libs/libc.def
new file mode 100644
index 00000000000..0ac6a459d9c
--- /dev/null
+++ b/gcc/m2/gm2-libs/libc.def
@@ -0,0 +1,476 @@
+(* libc.def provides an interface to the C library functions.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" libc ;
+
+FROM SYSTEM IMPORT ADDRESS, CSIZE_T, CSSIZE_T ;
+
+EXPORT UNQUALIFIED time_t, timeb, tm, ptrToTM,
+                   write, read,
+                   system, abort,
+                   malloc, free,
+                   exit, isatty,
+                   getenv, putenv, getpid,
+                   dup, close, open, lseek,
+                   readv, writev,
+                   perror, creat,
+                   getcwd, chown, strlen, strcpy, strncpy,
+                   unlink, setenv,
+                   memcpy, memset, memmove, printf, realloc,
+                   rand, srand,
+                   time, localtime, ftime,
+                   shutdown, rename, setjmp, longjmp, atexit,
+                   ttyname, sleep, execv ;
+
+
+TYPE
+   time_t = LONGINT ;
+
+   ptrToTM = POINTER TO tm ;
+   tm = RECORD
+           tm_sec: INTEGER ;     (* Seconds.     [0-60] (1 leap second) *)
+           tm_min: INTEGER ;     (* Minutes.     [0-59]   *)
+           tm_hour: INTEGER ;    (* Hours.       [0-23]   *)
+           tm_mday: INTEGER ;    (* Day.         [1-31]   *)
+           tm_mon: INTEGER ;     (* Month.       [0-11]   *)
+           tm_year: INTEGER ;    (* Year - 1900.          *)
+           tm_wday: INTEGER ;    (* Day of week. [0-6]    *)
+           tm_yday: INTEGER ;    (* Days in year.[0-365]  *)
+           tm_isdst: INTEGER ;   (* DST.         [-1/0/1] *)
+           tm_gmtoff: LONGINT ;  (* Seconds east of UTC.  *)
+           tm_zone: ADDRESS ;    (* char * zone name      *)
+        END ;
+
+   timeb = RECORD
+              time    : time_t ;
+              millitm : SHORTCARD ;
+              timezone: SHORTCARD ;
+              dstflag : SHORTCARD ;
+           END ;
+
+   exitP = PROCEDURE () : INTEGER ;
+
+
+(*
+     ssize_t write (int d, void *buf, size_t nbytes)
+*)
+
+PROCEDURE write (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : [ CSSIZE_T ] ;
+
+
+(*
+     ssize_t read (int d, void *buf, size_t nbytes)
+*)
+
+PROCEDURE read (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : [ CSSIZE_T ] ;
+
+
+(*
+     int system(string)
+     char *string;
+*)
+
+PROCEDURE system (a: ADDRESS) : [ INTEGER ] ;
+
+
+(*
+     abort - generate a fault
+
+     abort() first closes all open files if possible, then sends
+     an IOT signal to the process.  This signal usually results
+     in termination with a core dump, which may be used for
+     debugging.
+
+     It is possible for abort() to return control if is caught or
+     ignored, in which case the value returned is that of the
+     kill(2V) system call.
+*)
+
+PROCEDURE abort <* noreturn *> ;
+
+
+(*
+     malloc - memory allocator.
+
+     void *malloc(size_t size);
+
+     malloc() returns a pointer to a block of at least size
+     bytes, which is appropriately aligned.  If size is zero,
+     malloc() returns a non-NULL pointer, but this pointer should
+     not be dereferenced.
+*)
+
+PROCEDURE malloc (size: CSIZE_T) : ADDRESS ;
+
+
+(*
+     free - memory deallocator.
+
+     free (void *ptr);
+
+     free() releases a previously allocated block.  Its argument
+     is a pointer to a block previously allocated by malloc,
+     calloc, realloc, malloc, or memalign.
+*)
+
+PROCEDURE free (ptr: ADDRESS) ;
+
+
+(*
+     void *realloc (void *ptr, size_t size);
+
+     realloc changes the size of the memory block pointed to
+     by ptr to size bytes. The contents will be  unchanged  to
+     the minimum of the old and new sizes; newly allocated memory
+     will be uninitialized. If ptr is NIL, the call is
+     equivalent  to malloc(size); if size is equal to zero, the
+     call is equivalent to free(ptr). Unless ptr is NIL, it
+     must have been returned by an earlier call to malloc(),
+     realloc.
+*)
+
+PROCEDURE realloc (ptr: ADDRESS; size: CSIZE_T) : ADDRESS ;
+
+
+(*
+   isatty - does this descriptor refer to a terminal.
+*)
+
+PROCEDURE isatty (fd: INTEGER) : INTEGER ;
+
+
+(*
+   exit - returns control to the invoking process. Result, r, is
+          returned.
+*)
+
+PROCEDURE exit (r: INTEGER) <* noreturn *> ;
+
+
+(*
+   getenv - returns the C string for the equivalent C environment
+            variable.
+*)
+
+PROCEDURE getenv (s: ADDRESS) : ADDRESS ;
+
+
+(*
+   putenv - change or add an environment variable.
+*)
+
+PROCEDURE putenv (s: ADDRESS) : INTEGER ;
+
+
+(*
+   getpid - returns the UNIX process identification number.
+*)
+
+PROCEDURE getpid () : INTEGER ;
+
+
+(*
+   dup - duplicates the file descriptor, d.
+*)
+
+PROCEDURE dup (d: INTEGER) : INTEGER ;
+
+
+(*
+   close - closes the file descriptor, d.
+*)
+
+PROCEDURE close (d: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   open - open the file, filename with flag and mode.
+*)
+
+PROCEDURE open (filename: ADDRESS; oflag: INTEGER; ...) : INTEGER ;
+
+
+(*
+   creat - creates a new file
+*)
+
+PROCEDURE creat (filename: ADDRESS; mode: CARDINAL) : INTEGER;
+
+
+(*
+   lseek - calls unix lseek:
+
+           off_t lseek(int fildes, off_t offset, int whence);
+*)
+
+PROCEDURE lseek (fd: INTEGER; offset: LONGINT; whence: INTEGER) : LONGINT ;
+
+
+(*
+   perror - writes errno and string. (ARRAY OF CHAR is translated onto ADDRESS).
+*)
+
+PROCEDURE perror (string: ARRAY OF CHAR);
+
+
+(*
+   readv - reads an io vector of bytes.
+*)
+
+PROCEDURE readv (fd: INTEGER; v: ADDRESS; n: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   writev - writes an io vector of bytes.
+*)
+
+PROCEDURE writev (fd: INTEGER; v: ADDRESS; n: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   getcwd - copies the absolute pathname of the
+            current working directory to the array pointed to by buf,
+            which is of length size.
+
+            If the current absolute path name would require a buffer
+            longer than size elements, NULL is returned, and errno is
+            set to ERANGE; an application should check for this error,
+            and allocate a larger buffer if necessary.
+*)
+
+PROCEDURE getcwd (buf: ADDRESS; size: CSIZE_T) : ADDRESS ;
+
+
+(*
+   chown - The  owner  of  the  file  specified  by  path or by fd is
+           changed.  Only the super-user may change the  owner  of  a
+           file.   The  owner  of  a file may change the group of the
+           file to any group of which that owner is  a  member.   The
+           super-user may change the group arbitrarily.
+
+           If  the owner or group is specified as -1, then that ID is
+           not changed.
+
+           On success, zero is returned.  On error, -1  is  returned,
+           and errno is set appropriately.
+*)
+
+PROCEDURE chown (filename: ADDRESS; uid, gid: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   strlen - returns the length of string, a.
+*)
+
+PROCEDURE strlen (a: ADDRESS) : CSIZE_T ;
+
+
+(*
+   strcpy - copies string, src, into, dest.
+            It returns dest.
+*)
+
+PROCEDURE strcpy (dest, src: ADDRESS) : [ ADDRESS ] ;
+
+
+(*
+   strncpy - copies string, src, into, dest, copying at most, n, bytes.
+             It returns dest.
+*)
+
+PROCEDURE strncpy (dest, src: ADDRESS; n: CARDINAL) : [ ADDRESS ] ;
+
+
+(*
+   unlink - removes file and returns 0 if successful.
+*)
+
+PROCEDURE unlink (file: ADDRESS) : [ INTEGER ] ;
+
+
+(*
+   memcpy - copy memory area
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memcpy(void *dest, const void *src, size_t n);
+   It returns dest.
+*)
+
+PROCEDURE memcpy (dest, src: ADDRESS; size: CSIZE_T) : [ ADDRESS ] ;
+
+
+(*
+   memset - fill memory with a constant byte
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memset(void *s, int c, size_t n);
+   It returns s.
+*)
+
+PROCEDURE memset (s: ADDRESS; c: INTEGER; size: CSIZE_T) : [ ADDRESS ] ;
+
+
+(*
+   memmove - copy memory areas which may overlap
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memmove(void *dest, const void *src, size_t n);
+   It returns dest.
+*)
+
+PROCEDURE memmove (dest, src: ADDRESS; size: CSIZE_T) : [ ADDRESS ] ;
+
+
+(*
+   int printf(const char *format, ...);
+*)
+
+PROCEDURE printf (format: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+
+
+(*
+   setenv - sets environment variable, name, to value.
+            It will overwrite an existing value if, overwrite,
+            is true.  It returns 0 on success and -1 for an error.
+*)
+
+PROCEDURE setenv (name: ADDRESS; value: ADDRESS; overwrite: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   srand - initialize the random number seed.
+*)
+
+PROCEDURE srand (seed: INTEGER) ;
+
+
+(*
+   rand - return a random integer.
+*)
+
+PROCEDURE rand () : INTEGER ;
+
+
+(*
+   time - returns a pointer to the time_t value. If, a,
+          is not NIL then the libc value is copied into
+          memory at address, a.
+*)
+
+PROCEDURE time (a: ADDRESS) : time_t ;
+
+
+(*
+   localtime - returns a pointer to the libc copy of the tm
+               structure.
+*)
+
+PROCEDURE localtime (VAR t: time_t) : ADDRESS ;
+
+
+(*
+   ftime - return date and time.
+*)
+
+PROCEDURE ftime (VAR t: timeb) : [ INTEGER ] ;
+
+
+(*
+   shutdown - shutdown a socket, s.
+              if how = 0, then no more reads are allowed.
+              if how = 1, then no more writes are allowed.
+              if how = 2, then mo more reads or writes are allowed.
+*)
+
+PROCEDURE shutdown (s: INTEGER; how: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   rename - change the name or location of a file
+*)
+
+PROCEDURE rename (oldpath, newpath: ADDRESS) : [ INTEGER ] ;
+
+
+(*
+   setjmp - returns 0 if returning directly, and non-zero
+            when returning from longjmp using the saved
+            context.
+*)
+
+PROCEDURE setjmp (env: ADDRESS) : INTEGER ;
+
+
+(*
+   longjmp - restores the environment saved by the last call
+             of setjmp with the corresponding env argument.
+             After longjmp is completed, program execution
+             continues as if the corresponding call of setjmp
+             had just returned the value val.  The value of
+             val must not be zero.
+*)
+
+PROCEDURE longjmp (env: ADDRESS; val: INTEGER) ;
+
+
+(*
+   atexit - execute, proc, when the function exit is called.
+*)
+
+PROCEDURE atexit (proc: exitP) : [ INTEGER ] ;
+
+
+(*
+   ttyname - returns a pointer to a string determining the ttyname.
+*)
+
+PROCEDURE ttyname (filedes: INTEGER) : ADDRESS ;
+
+
+(*
+   sleep - calling thread sleeps for seconds.
+*)
+
+PROCEDURE sleep (seconds: CARDINAL) : [ CARDINAL ] ;
+
+
+(*
+   execv - execute a file.
+*)
+
+PROCEDURE execv (pathname: ADDRESS; argv: ADDRESS) : [ INTEGER ] ;
+
+
+END libc.
diff --git a/gcc/m2/gm2-libs/libm.def b/gcc/m2/gm2-libs/libm.def
new file mode 100644
index 00000000000..f9b18cfd6e1
--- /dev/null
+++ b/gcc/m2/gm2-libs/libm.def
@@ -0,0 +1,92 @@
+(* libm.def provides access to libm.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" libm ;
+
+(* Users are strongly advised to use MathLib0 or RealMath as calls
+   to functions within these modules will generate inline code.
+   This module is used by MathLib0 and RealMath when inline code cannot
+   be generated.  *)
+
+EXPORT UNQUALIFIED sin, sinl, sinf,
+                   cos, cosl, cosf,
+                   tan, tanl, tanf,
+                   sqrt, sqrtl, sqrtf,
+                   asin, asinl, asinf,
+                   acos, acosl, acosf,
+                   atan, atanl, atanf,
+                   atan2, atan2l, atan2f,
+                   exp, expl, expf,
+                   log, logl, logf,
+                   exp10, exp10l, exp10f,
+                   pow, powl, powf,
+                   floor, floorl, floorf,
+                   ceil, ceill, ceilf ;
+
+PROCEDURE sin (x: REAL) : REAL ;
+PROCEDURE sinl (x: LONGREAL) : LONGREAL ;
+PROCEDURE sinf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE cos (x: REAL) : REAL ;
+PROCEDURE cosl (x: LONGREAL) : LONGREAL ;
+PROCEDURE cosf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE tan (x: REAL) : REAL ;
+PROCEDURE tanl (x: LONGREAL) : LONGREAL ;
+PROCEDURE tanf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE sqrt (x: REAL) : REAL ;
+PROCEDURE sqrtl (x: LONGREAL) : LONGREAL ;
+PROCEDURE sqrtf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE asin (x: REAL) : REAL ;
+PROCEDURE asinl (x: LONGREAL) : LONGREAL ;
+PROCEDURE asinf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE acos (x: REAL) : REAL ;
+PROCEDURE acosl (x: LONGREAL) : LONGREAL ;
+PROCEDURE acosf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE atan (x: REAL) : REAL ;
+PROCEDURE atanl (x: LONGREAL) : LONGREAL ;
+PROCEDURE atanf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE atan2 (x, y: REAL) : REAL ;
+PROCEDURE atan2l (x, y: LONGREAL) : LONGREAL ;
+PROCEDURE atan2f (x, y: SHORTREAL) : SHORTREAL ;
+PROCEDURE exp (x: REAL) : REAL ;
+PROCEDURE expl (x: LONGREAL) : LONGREAL ;
+PROCEDURE expf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE log (x: REAL) : REAL ;
+PROCEDURE logl (x: LONGREAL) : LONGREAL ;
+PROCEDURE logf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE exp10 (x: REAL) : REAL ;
+PROCEDURE exp10l (x: LONGREAL) : LONGREAL ;
+PROCEDURE exp10f (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE pow (x, y: REAL) : REAL ;
+PROCEDURE powl (x, y: LONGREAL) : LONGREAL ;
+PROCEDURE powf (x, y: SHORTREAL) : SHORTREAL ;
+PROCEDURE floor (x: REAL) : REAL ;
+PROCEDURE floorl (x: LONGREAL) : LONGREAL ;
+PROCEDURE floorf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE ceil (x: REAL) : REAL ;
+PROCEDURE ceill (x: LONGREAL) : LONGREAL ;
+PROCEDURE ceilf (x: SHORTREAL) : SHORTREAL ;
+
+END libm.
diff --git a/gcc/m2/gm2-libs/sckt.def b/gcc/m2/gm2-libs/sckt.def
new file mode 100644
index 00000000000..a50199c128b
--- /dev/null
+++ b/gcc/m2/gm2-libs/sckt.def
@@ -0,0 +1,160 @@
+(* sckt.def provides a minimal interface to tcp sockets.
+
+Copyright (C) 2003-2021 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/>.  *)
+
+DEFINITION MODULE sckt ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT UNQUALIFIED tcpServerState,
+                   tcpServerEstablish, tcpServerEstablishPort,
+                   tcpServerAccept, getLocalIP,
+                   tcpServerPortNo, tcpServerIP, tcpServerSocketFd,
+                   tcpServerClientIP, tcpServerClientPortNo,
+                   tcpClientState,
+                   tcpClientSocket, tcpClientSocketIP, tcpClientConnect,
+                   tcpClientPortNo, tcpClientIP, tcpClientSocketFd ;
+
+TYPE
+   tcpServerState = ADDRESS ;
+   tcpClientState = ADDRESS ;
+
+
+(*
+   tcpServerEstablish - returns a tcpState containing the relevant
+                        information about a socket declared to receive
+                        tcp connections.
+*)
+
+PROCEDURE tcpServerEstablish () : tcpServerState ;
+
+
+(*
+   tcpServerEstablishPort - returns a tcpState containing the relevant
+                            information about a socket declared to receive
+                            tcp connections.  This method attempts to use
+                            the port specified by the parameter.
+*)
+
+PROCEDURE tcpServerEstablishPort (port: CARDINAL) : tcpServerState ;
+
+
+(*
+   tcpServerAccept - returns a file descriptor once a client has connected and
+                     been accepted.
+*)
+
+PROCEDURE tcpServerAccept (s: tcpServerState) : INTEGER ;
+
+
+(*
+   tcpServerPortNo - returns the portNo from structure, s.
+*)
+
+PROCEDURE tcpServerPortNo (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpSocketFd - returns the sockFd from structure, s.
+*)
+
+PROCEDURE tcpServerSocketFd (s: tcpServerState) : INTEGER ;
+
+
+(*
+   getLocalIP - returns the IP address of this machine.
+*)
+
+PROCEDURE getLocalIP (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpServerIP - returns the IP address from structure, s.
+*)
+
+PROCEDURE tcpServerIP (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpServerClientIP - returns the IP address of the client who
+                       has connected to server, s.
+*)
+
+PROCEDURE tcpServerClientIP (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpServerClientPortNo - returns the port number of the client who
+                           has connected to server, s.
+*)
+
+PROCEDURE tcpServerClientPortNo (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpClientSocket - returns a file descriptor (socket) which has
+                     connected to, serverName:portNo.
+*)
+
+PROCEDURE tcpClientSocket (serverName: ADDRESS; portNo: CARDINAL) : tcpClientState ;
+
+
+(*
+   tcpClientSocketIP - returns a file descriptor (socket) which has
+                       connected to, ip:portNo.
+*)
+
+PROCEDURE tcpClientSocketIP (ip: CARDINAL; portNo: CARDINAL) : tcpClientState ;
+
+
+(*
+   tcpClientConnect - returns the file descriptor associated with, s,
+                      once a connect has been performed.
+*)
+
+PROCEDURE tcpClientConnect (s: tcpClientState) : INTEGER ;
+
+
+(*
+   tcpClientPortNo - returns the portNo from structure, s.
+*)
+
+PROCEDURE tcpClientPortNo (s: tcpClientState) : INTEGER ;
+
+
+(*
+   tcpClientSocketFd - returns the sockFd from structure, s.
+*)
+
+PROCEDURE tcpClientSocketFd (s: tcpClientState) : INTEGER ;
+
+
+(*
+   tcpClientIP - returns the IP address from structure, s.
+*)
+
+PROCEDURE tcpClientIP (s: tcpClientState) : CARDINAL ;
+
+
+END sckt.
diff --git a/gcc/m2/gm2-libs/termios.def b/gcc/m2/gm2-libs/termios.def
new file mode 100644
index 00000000000..7b22ccfef77
--- /dev/null
+++ b/gcc/m2/gm2-libs/termios.def
@@ -0,0 +1,233 @@
+(* termios.def provides a procedural interface to termios.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+DEFINITION MODULE termios ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   TERMIOS = ADDRESS ;
+
+   ControlChar = (vintr, vquit, verase, vkill, veof, vtime, vmin,
+                  vswtc, vstart, vstop, vsusp, veol, vreprint, vdiscard,
+                  vwerase, vlnext, veol2) ;
+
+   Flag = (
+           (* input flag bits *)
+           ignbrk, ibrkint, ignpar, iparmrk, inpck, istrip, inlcr,
+           igncr, icrnl, iuclc, ixon, ixany, ixoff, imaxbel,
+           (* output flag bits *)
+           opost, olcuc, onlcr, ocrnl, onocr, onlret, ofill, ofdel,
+           onl0, onl1, ocr0, ocr1, ocr2, ocr3,
+           otab0, otab1, otab2, otab3, obs0, obs1, off0, off1, ovt0, ovt1,
+           (* baud rate *)
+           b0, b50, b75, b110, b135, b150, b200, b300, b600, b1200,
+           b1800, b2400, b4800, b9600, b19200, b38400,
+           b57600, b115200, b240400, b460800, b500000, b576000,
+           b921600, b1000000, b1152000, b1500000, b2000000, b2500000,
+           b3000000, b3500000, b4000000, maxbaud, crtscts,
+           (* character size *)
+           cs5, cs6, cs7, cs8, cstopb, cread, parenb, parodd, hupcl, clocal,
+           (* local flags *)
+           lisig, licanon, lxcase, lecho, lechoe, lechok, lechonl, lnoflsh,
+           ltopstop, lechoctl, lechoprt, lechoke, lflusho, lpendin, liexten) ;
+
+
+(*
+   InitTermios - new data structure.
+*)
+
+PROCEDURE InitTermios () : TERMIOS ;
+
+
+(*
+   KillTermios - delete data structure.
+*)
+
+PROCEDURE KillTermios (t: TERMIOS) : TERMIOS ;
+
+
+(*
+   cfgetospeed - return output baud rate.
+*)
+
+PROCEDURE cfgetospeed (t: TERMIOS) : INTEGER ;
+
+
+(*
+   cfgetispeed - return input baud rate.
+*)
+
+PROCEDURE cfgetispeed (t: TERMIOS) : INTEGER ;
+
+
+(*
+   cfsetospeed - set output baud rate.
+*)
+
+PROCEDURE cfsetospeed (t: TERMIOS; b: CARDINAL) : INTEGER ;
+
+
+(*
+   cfsetispeed - set input baud rate.
+*)
+
+PROCEDURE cfsetispeed (t: TERMIOS; b: CARDINAL) : INTEGER ;
+
+
+(*
+   cfsetspeed - set input and output baud rate.
+*)
+
+PROCEDURE cfsetspeed (t: TERMIOS; b: CARDINAL) : INTEGER ;
+
+
+(*
+   tcgetattr - get state of, fd, into, t.
+*)
+
+PROCEDURE tcgetattr (fd: INTEGER; t: TERMIOS) : INTEGER ;
+
+
+(*
+   The following three functions return the different option values.
+*)
+
+PROCEDURE tcsnow () : INTEGER ;   (* alter fd now *)
+PROCEDURE tcsdrain () : INTEGER ; (* alter when all output has been sent *)
+PROCEDURE tcsflush () : INTEGER ; (* like drain, except discard any pending input *)
+
+
+(*
+   tcsetattr - set state of, fd, to, t, using option.
+*)
+
+PROCEDURE tcsetattr (fd: INTEGER; option: INTEGER; t: TERMIOS) : INTEGER ;
+
+
+(*
+   cfmakeraw - sets, t, to raw mode.
+*)
+
+PROCEDURE cfmakeraw (t: TERMIOS) ;
+
+
+(*
+   tcsendbreak - send zero bits for duration.
+*)
+
+PROCEDURE tcsendbreak (fd: INTEGER; duration: INTEGER) : INTEGER ;
+
+
+(*
+   tcdrain - waits for pending output to be written on, fd.
+*)
+
+PROCEDURE tcdrain (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflushi - flush input.
+*)
+
+PROCEDURE tcflushi (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflusho - flush output.
+*)
+
+PROCEDURE tcflusho (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflushio - flush input and output.
+*)
+
+PROCEDURE tcflushio (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflowoni - restart input on, fd.
+*)
+
+PROCEDURE tcflowoni (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflowoffi - stop input on, fd.
+*)
+
+PROCEDURE tcflowoffi (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflowono - restart output on, fd.
+*)
+
+PROCEDURE tcflowono (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflowoffo - stop output on, fd.
+*)
+
+PROCEDURE tcflowoffo (fd: INTEGER) : INTEGER ;
+
+
+(*
+   GetFlag - sets a flag value from, t, in, b, and returns TRUE
+             if, t, supports, f.
+*)
+
+PROCEDURE GetFlag (t: TERMIOS; f: Flag; VAR b: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetFlag - sets a flag value in, t, to, b, and returns TRUE if
+             this flag value is supported.
+*)
+
+PROCEDURE SetFlag (t: TERMIOS; f: Flag; b: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   GetChar - sets a CHAR, ch, value from, t, and returns TRUE if
+             this value is supported.
+*)
+
+PROCEDURE GetChar (t: TERMIOS; c: ControlChar; VAR ch: CHAR) : BOOLEAN ;
+
+
+(*
+   SetChar - sets a CHAR value in, t, and returns TRUE if, c,
+             is supported.
+*)
+
+PROCEDURE SetChar (t: TERMIOS; c: ControlChar; ch: CHAR) : BOOLEAN ;
+
+
+END termios.
diff --git a/gcc/m2/gm2-libs/wrapc.def b/gcc/m2/gm2-libs/wrapc.def
new file mode 100644
index 00000000000..8e6fd2c8859
--- /dev/null
+++ b/gcc/m2/gm2-libs/wrapc.def
@@ -0,0 +1,124 @@
+(* wrapc.def provides access to more of the C library.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE wrapc ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED strtime, filesize, fileinode,
+                 getrand, getusername, filemtime,
+                 getnameuidgid, signbit, signbitf, signbitl,
+		 isfinite, isfinitel, isfinitef ;
+
+
+(*
+   strtime - returns the C string for the equivalent C asctime
+             function.
+*)
+
+PROCEDURE strtime () : ADDRESS ;
+
+
+(*
+   filesize - assigns the size of a file, f, into low, high and
+              returns zero if successful.
+*)
+
+PROCEDURE filesize (f: INTEGER; VAR low, high: CARDINAL) : INTEGER ;
+
+
+(*
+   fileinode - return the inode associated with file, f.
+*)
+
+PROCEDURE fileinode (f: INTEGER; VAR low, high: CARDINAL) : INTEGER ;
+
+
+(*
+   filemtime - returns the mtime of a file, f.
+*)
+
+PROCEDURE filemtime (f: INTEGER) : INTEGER ;
+
+
+(*
+   getrand - returns a random number between 0..n-1
+*)
+
+PROCEDURE getrand (n: INTEGER) : INTEGER ;
+
+
+(*
+   getusername - returns a C string describing the current user.
+*)
+
+PROCEDURE getusername () : ADDRESS ;
+
+
+(*
+   getnameuidgid - fills in the, uid, and, gid, which represents
+                   user, name.
+*)
+
+PROCEDURE getnameuidgid (name: ADDRESS; VAR uid, gid: INTEGER) ;
+
+
+(*
+   in C these procedure functions are really macros, so we provide
+   real C functions and let gm2 call these if the builtins
+   are unavailable.
+*)
+
+PROCEDURE signbit (r: REAL) : INTEGER ;
+PROCEDURE signbitf (s: SHORTREAL) : INTEGER ;
+PROCEDURE signbitl (l: LONGREAL) : INTEGER ;
+
+
+(*
+   isfinite - provide non builtin alternative to the gcc builtin isfinite.
+              Returns 1 if x is finite and 0 if it is not.
+*)
+
+PROCEDURE isfinite (x: REAL) : INTEGER ;
+
+
+(*
+   isfinitef - provide non builtin alternative to the gcc builtin isfinite.
+               Returns 1 if x is finite and 0 if it is not.
+*)
+
+PROCEDURE isfinitef (x: SHORTREAL) : INTEGER ;
+
+
+(*
+   isfinitel - provide non builtin alternative to the gcc builtin isfinite.
+               Returns 1 if x is finite and 0 if it is not.
+*)
+
+PROCEDURE isfinitel (x: LONGREAL) : INTEGER ;
+
+
+END wrapc.
diff --git a/gcc/m2/gm2config.h.in b/gcc/m2/gm2config.h.in
new file mode 100644
index 00000000000..ced7f4586dc
--- /dev/null
+++ b/gcc/m2/gm2config.h.in
@@ -0,0 +1,56 @@
+/* gm2config.h.in template file for values required by gm2spec.c.
+
+Copyright (C) 2006-2022 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/>.  */
+
+#ifndef PACKAGE_BUGREPORT
+/* Define to the address where bug reports for this package should be sent. */
+#undef PACKAGE_BUGREPORT
+#endif
+
+#ifndef PACKAGE_NAME
+/* Define to the full name of this package. */
+#undef PACKAGE_NAME
+#endif
+
+#ifndef PACKAGE_STRING
+/* Define to the full name and version of this package. */
+#undef PACKAGE_STRING
+#endif
+
+/* Define to 1 if you have the `stpcmp' function. */
+#undef HAVE_STPCMP
+
+/* Define to 1 if you have the dirent.h header. */
+#undef HAVE_DIRENT_H
+
+/* Define to 1 if you have the sys/ndir.h header. */
+#undef HAVE_SYS_NDIR_H
+
+/* Define to 1 if you have the sys/dir.h header. */
+#undef HAVE_SYS_DIR_H
+
+/* Define to 1 if you have the ndir.h header. */
+#undef HAVE_NDIR_H
+
+/* Define to 1 if you have the sys/types.h header. */
+#undef HAVE_SYS_TYPES_H
+
+/* Define to 1 if you have the opendir function.  */
+#undef HAVE_OPENDIR
diff --git a/gcc/m2/gm2spec.cc b/gcc/m2/gm2spec.cc
new file mode 100644
index 00000000000..680dd3602ef
--- /dev/null
+++ b/gcc/m2/gm2spec.cc
@@ -0,0 +1,946 @@
+/* gm2spec.cc specific flags and argument handling within GNU Modula-2.
+
+Copyright (C) 2007-2022 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 "coretypes.h"
+#include "tm.h"
+#include "xregex.h"
+#include "obstack.h"
+#include "intl.h"
+#include "prefix.h"
+#include "opt-suggestions.h"
+#include "gcc.h"
+#include "opts.h"
+#include "vec.h"
+
+#include "m2/gm2config.h"
+
+#ifdef HAVE_DIRENT_H
+#include <dirent.h>
+#else
+#ifdef HAVE_SYS_NDIR_H
+#include <sys/ndir.h>
+#endif
+#ifdef HAVE_SYS_DIR_H
+#include <sys/dir.h>
+#endif
+#ifdef HAVE_NDIR_H
+#include <ndir.h>
+#endif
+#endif
+
+/* This bit is set if we saw a `-xfoo' language specification.  */
+#define LANGSPEC	(1<<1)
+/* This bit is set if they did `-lm' or `-lmath'.  */
+#define MATHLIB		(1<<2)
+/* This bit is set if they did `-lc'.  */
+#define WITHLIBC	(1<<3)
+/* Skip this option.  */
+#define SKIPOPT		(1<<4)
+
+#ifndef MATH_LIBRARY
+#define MATH_LIBRARY "m"
+#endif
+#ifndef MATH_LIBRARY_PROFILE
+#define MATH_LIBRARY_PROFILE MATH_LIBRARY
+#endif
+
+#ifndef LIBSTDCXX
+#define LIBSTDCXX "stdc++"
+#endif
+#ifndef LIBSTDCXX_PROFILE
+#define LIBSTDCXX_PROFILE LIBSTDCXX
+#endif
+#ifndef LIBSTDCXX_STATIC
+#define LIBSTDCXX_STATIC NULL
+#endif
+
+#ifndef LIBCXX
+#define LIBCXX "c++"
+#endif
+#ifndef LIBCXX_PROFILE
+#define LIBCXX_PROFILE LIBCXX
+#endif
+#ifndef LIBCXX_STATIC
+#define LIBCXX_STATIC NULL
+#endif
+
+#ifndef LIBCXXABI
+#define LIBCXXABI "c++abi"
+#endif
+#ifndef LIBCXXABI_PROFILE
+#define LIBCXXABI_PROFILE LIBCXXABI
+#endif
+#ifndef LIBCXXABI_STATIC
+#define LIBCXXABI_STATIC NULL
+#endif
+
+/* The values used here must match those of the stdlib_kind enumeration
+   in c.opt.  */
+enum stdcxxlib_kind
+{
+  USE_LIBSTDCXX = 1,
+  USE_LIBCXX = 2
+};
+
+#define DEFAULT_DIALECT "pim"
+#undef DEBUG_ARG
+
+typedef enum { iso, pim, min, logitech, pimcoroutine, maxlib } libs;
+
+/* These are the library names which are installed as part of gm2 and reflect
+   -flibs=name.  The -flibs= option provides the user with a short cut to add
+   libraries without having to know the include and link path.  */
+
+static const char *library_name[maxlib]
+    = { "m2iso", "m2pim", "m2min", "m2log", "m2cor" };
+
+/* They match the installed archive name for example libm2iso.a,
+   libm2pim.a, libm2min.a, libm2log.a and libm2cor.a.  They also match a
+   subdirectory name where the definition modules are kept.  The driver
+   checks the argument to -flibs= for an entry in library_name or
+   alternatively the existance of the subdirectory (to allow for third
+   party libraries to coexist).  */
+
+static const char *library_abbrev[maxlib]
+    = { "iso", "pim", "min", "log", "cor" };
+
+/* Users may specifiy -flibs=pim,iso etc which are mapped onto
+   -flibs=m2pim,m2iso respectively.  This provides a match between
+   the dialect of Modula-2 and the library set.  */
+
+static const char *add_include (const char *libpath, const char *library);
+
+static bool seen_scaffold_static = false;
+static bool seen_scaffold_dynamic = false;
+static bool scaffold_static = false;
+static bool scaffold_dynamic = true;  // Default uses -fscaffold-dynamic.
+static bool seen_gen_module_list = false;
+static bool seen_uselist = false;
+static bool uselist = false;
+static bool gen_module_list = true;  // Default uses -fgen-module-list=-.
+static const char *gen_module_filename = "-";
+static const char *multilib_dir = NULL;
+/* The original argument list and related info is copied here.  */
+static unsigned int gm2_xargc;
+static const struct cl_decoded_option *gm2_x_decoded_options;
+static void append_arg (const struct cl_decoded_option *);
+
+/* The new argument list will be built here.  */
+static unsigned int gm2_newargc;
+static struct cl_decoded_option *gm2_new_decoded_options;
+
+
+/* Return whether strings S1 and S2 are both NULL or both the same
+   string.  */
+
+static bool
+strings_same (const char *s1, const char *s2)
+{
+  return s1 == s2 || (s1 != NULL && s2 != NULL && strcmp (s1, s2) == 0);
+}
+
+bool
+options_same (const struct cl_decoded_option *opt1,
+	      const struct cl_decoded_option *opt2)
+{
+  return (opt1->opt_index == opt2->opt_index
+	  && strings_same (opt1->arg, opt2->arg)
+	  && strings_same (opt1->orig_option_with_args_text,
+			   opt2->orig_option_with_args_text)
+	  && strings_same (opt1->canonical_option[0],
+			   opt2->canonical_option[0])
+	  && strings_same (opt1->canonical_option[1],
+			   opt2->canonical_option[1])
+	  && strings_same (opt1->canonical_option[2],
+			   opt2->canonical_option[2])
+	  && strings_same (opt1->canonical_option[3],
+			   opt2->canonical_option[3])
+	  && (opt1->canonical_option_num_elements
+	      == opt2->canonical_option_num_elements)
+	  && opt1->value == opt2->value
+	  && opt1->errors == opt2->errors);
+}
+
+/* Append another argument to the list being built.  */
+
+static void
+append_arg (const struct cl_decoded_option *arg)
+{
+  static unsigned int newargsize;
+
+  if (gm2_new_decoded_options == gm2_x_decoded_options
+      && gm2_newargc < gm2_xargc
+      && options_same (arg, &gm2_x_decoded_options[gm2_newargc]))
+    {
+      ++gm2_newargc;
+      return;			/* Nothing new here.  */
+    }
+
+  if (gm2_new_decoded_options == gm2_x_decoded_options)
+    {				/* Make new arglist.  */
+      unsigned int i;
+
+      newargsize = (gm2_xargc << 2) + 20;	/* This should handle all.  */
+      gm2_new_decoded_options = XNEWVEC (struct cl_decoded_option, newargsize);
+
+      /* Copy what has been done so far.  */
+      for (i = 0; i < gm2_newargc; ++i)
+	gm2_new_decoded_options[i] = gm2_x_decoded_options[i];
+    }
+
+  if (gm2_newargc == newargsize)
+    fatal_error (input_location, "overflowed output argument list for %qs",
+		 arg->orig_option_with_args_text);
+
+  gm2_new_decoded_options[gm2_newargc++] = *arg;
+}
+
+/* Append an option described by OPT_INDEX, ARG and VALUE to the list
+   being built.  */
+
+static void
+append_option (size_t opt_index, const char *arg, int value)
+{
+  struct cl_decoded_option decoded;
+
+  generate_option (opt_index, arg, value, CL_DRIVER, &decoded);
+  append_arg (&decoded);
+}
+
+/* build_archive_path returns a string containing the path to the
+   archive defined by libpath and dialectLib.  */
+
+static const char *
+build_archive_path (const char *libpath, const char *library)
+{
+  if (library != NULL)
+    {
+      const char *libdir = (const char *)library;
+
+      if (libdir != NULL)
+        {
+	  int machine_length = 0;
+          char dir_sep[2];
+
+          dir_sep[0] = DIR_SEPARATOR;
+          dir_sep[1] = (char)0;
+
+	  if (multilib_dir != NULL)
+	    {
+	      machine_length = strlen (multilib_dir);
+	      machine_length += strlen (dir_sep);
+	    }
+
+	  int l = strlen (libpath) + 1 + strlen ("m2") + 1
+	    + strlen (libdir) + 1 + machine_length + 1;
+          char *s = (char *)xmalloc (l);
+
+          strcpy (s, libpath);
+          strcat (s, dir_sep);
+	  if (machine_length > 0)
+	    {
+	      strcat (s, multilib_dir);
+	      strcat (s, dir_sep);
+	    }
+          strcat (s, "m2");
+          strcat (s, dir_sep);
+          strcat (s, libdir);
+          return s;
+        }
+    }
+  return NULL;
+}
+
+/* safe_strdup safely duplicates a string.  */
+
+static char *
+safe_strdup (const char *s)
+{
+  if (s != NULL)
+    return xstrdup (s);
+  return NULL;
+}
+
+/* add_default_combination adds the correct link path and then the
+   library name.  */
+
+static bool
+add_default_combination (const char *libpath, const char *library)
+{
+  if (library != NULL)
+    {
+      append_option (OPT_L, build_archive_path (libpath, library), 1);
+      append_option (OPT_l, safe_strdup (library), 1);
+      return true;
+    }
+  return false;
+}
+
+/* add_default_archives adds the default archives to the end of the
+   current command line.  */
+
+static int
+add_default_archives (const char *libpath, const char *libraries)
+{
+  const char *l = libraries;
+  const char *e;
+  char *libname;
+  unsigned int libcount = 0;
+
+  do
+    {
+      e = index (l, ',');
+      if (e == NULL)
+        {
+          libname = xstrdup (l);
+          l = NULL;
+	  if (add_default_combination (libpath, libname))
+	    libcount++;
+	  free (libname);
+        }
+      else
+        {
+          libname = xstrndup (l, e - l);
+          l = e + 1;
+	  if (add_default_combination (libpath, libname))
+	    libcount++;
+	  free (libname);
+        }
+    }
+  while ((l != NULL) && (l[0] != (char)0));
+  return libcount;
+}
+
+/* build_include_path builds the component of the include path
+   referenced by the library.  */
+
+static const char *
+build_include_path (const char *libpath, const char *library)
+{
+  char dir_sep[2];
+  char *gm2libs;
+  unsigned int machine_length = 0;
+
+  dir_sep[0] = DIR_SEPARATOR;
+  dir_sep[1] = (char)0;
+
+  if (multilib_dir != NULL)
+    {
+      machine_length = strlen (multilib_dir);
+      machine_length += strlen (dir_sep);
+    }
+
+  gm2libs = (char *)alloca (strlen (libpath) + strlen (dir_sep) + strlen ("m2")
+                            + strlen (dir_sep) + strlen (library) + 1
+			    + machine_length + 1);
+  strcpy (gm2libs, libpath);
+  strcat (gm2libs, dir_sep);
+  if (machine_length > 0)
+    {
+      strcat (gm2libs, multilib_dir);
+      strcat (gm2libs, dir_sep);
+    }
+  strcat (gm2libs, "m2");
+  strcat (gm2libs, dir_sep);
+  strcat (gm2libs, library);
+
+  return xstrdup (gm2libs);
+}
+
+/* add_include add the correct include path given the libpath and
+   library.  The new path is returned.  */
+
+static const char *
+add_include (const char *libpath, const char *library)
+{
+  if (library == NULL)
+    return NULL;
+  else
+    return build_include_path (libpath, library);
+}
+
+/* add_default_includes add the appropriate default include paths
+   depending upon the style of libraries chosen.  */
+
+static void
+add_default_includes (const char *libpath, const char *libraries)
+{
+  const char *l = libraries;
+  const char *e;
+  const char *c;
+  const char *path;
+
+  do
+    {
+      e = index (l, ',');
+      if (e == NULL)
+        {
+          c = xstrdup (l);
+          l = NULL;
+        }
+      else
+        {
+          c = xstrndup (l, e - l);
+          l = e + 1;
+        }
+      path = add_include (libpath, c);
+      append_option (OPT_I, path, 1);
+    }
+  while ((l != NULL) && (l[0] != (char)0));
+}
+
+/* library_installed returns true if directory library is found under
+   libpath.  */
+
+static bool
+library_installed (const char *libpath, const char *library)
+{
+#if defined(HAVE_OPENDIR) && defined(HAVE_DIRENT_H)
+  const char *complete = build_archive_path (libpath, library);
+  DIR *directory = opendir (complete);
+
+  if (directory == NULL || (errno == ENOENT))
+    return false;
+  /* Directory exists and therefore the library also exists.  */
+  closedir (directory);
+  return true;
+#else
+  return false;
+#endif
+}
+
+/* check_valid check to see that the library is valid.
+   It check the library against the default library set in gm2 and
+   also against any additional libraries installed in the prefix tree.  */
+
+static bool
+check_valid_library (const char *libpath, const char *library)
+{
+  /* Firstly check against the default libraries (which might not be
+     installed yet).  */
+  for (int i = 0; i < maxlib; i++)
+    if (strcmp (library, library_name[i]) == 0)
+      return true;
+  /* Secondly check whether it is installed (a third party library).  */
+  return library_installed (libpath, library);
+}
+
+/* check_valid_list check to see that the libraries specified are valid.
+   It checks against the default library set in gm2 and also against
+   any additional libraries installed in the libpath tree.  */
+
+static bool
+check_valid_list (const char *libpath, const char *libraries)
+{
+  const char *start = libraries;
+  const char *end;
+  const char *copy;
+
+  do
+    {
+      end = index (start, ',');
+      if (end == NULL)
+        {
+          copy = xstrdup (start);
+          start = NULL;
+        }
+      else
+        {
+          copy = xstrndup (start, end - start);
+          start = end + 1;
+        }
+      if (! check_valid_library (libpath, copy))
+	{
+	  error ("library specified %sq is either not installed or does not exist",
+		 copy);
+	  return false;
+	}
+    }
+  while ((start != NULL) && (start[0] != (char)0));
+  return true;
+}
+
+/* add_word returns a new string which has the contents of lib
+   appended to list.  If list is NULL then lib is duplicated and
+   returned otherwise the list is appended by "," and the contents of
+   lib.  */
+
+static const char *
+add_word (const char *list, const char *lib)
+{
+  char *copy;
+  if (list == NULL)
+    return xstrdup (lib);
+  copy = (char *) xmalloc (strlen (list) + strlen (lib) + 1 + 1);
+  strcpy (copy, list);
+  strcat (copy, ",");
+  strcat (copy, lib);
+  return copy;
+}
+
+/* convert_abbreviation checks abbreviation against known library
+   abbreviations.  If an abbreviation is found it converts the element
+   to the full library name, otherwise the user supplied name is added
+   to the full_libraries list.  A new string is returned.  */
+
+static const char *
+convert_abbreviation (const char *full_libraries, const char *abbreviation)
+{
+  for (int i = 0; i < maxlib; i++)
+    if (strcmp (abbreviation, library_abbrev[i]) == 0)
+      return add_word (full_libraries, library_name[i]);
+  /* No abbreviation found therefore assume user specified full library name.  */
+  return add_word (full_libraries, abbreviation);
+}
+
+/* convert_abbreviations checks each element in the library list to
+   see if an a known library abbreviation was used.  If found it
+   converts the element to the full library name, otherwise the
+   element is copied into the list.  A new string is returned.  */
+
+static const char *
+convert_abbreviations (const char *libraries)
+{
+  const char *start = libraries;
+  const char *end;
+  const char *full_libraries = NULL;
+
+  do
+    {
+      end = index (start, ',');
+      if (end == NULL)
+        {
+          full_libraries = convert_abbreviation (full_libraries, start);
+          start = NULL;
+        }
+      else
+        {
+          full_libraries = convert_abbreviation (full_libraries, xstrndup (start, end - start));
+          start = end + 1;
+        }
+    }
+  while ((start != NULL) && (start[0] != (char)0));
+  return full_libraries;
+}
+
+
+void
+lang_specific_driver (struct cl_decoded_option **in_decoded_options,
+		      unsigned int *in_decoded_options_count,
+		      int *in_added_libraries)
+{
+  unsigned int argc = *in_decoded_options_count;
+  struct cl_decoded_option *decoded_options = *in_decoded_options;
+  unsigned int i;
+
+  /* True if we saw a `-xfoo' language specification on the command
+     line.  This function will add a -xmodula-2 if the user has not
+     already placed one onto the command line.  */
+  bool seen_x_flag = false;
+  const char *language = NULL;
+
+  /* If nonzero, the user gave us the `-p' or `-pg' flag.  */
+  int saw_profile_flag = 0;
+
+  /* What action to take for the c++ runtime library:
+    -1  means we should not link it in.
+     0  means we should link it if it is needed.
+     1  means it is needed and should be linked in.
+     2  means it is needed but should be linked statically.  */
+  int library = 0;
+
+  /* Which c++ runtime library to link.  */
+  stdcxxlib_kind which_library = USE_LIBSTDCXX;
+
+  const char *libraries = NULL;
+  const char *dialect = DEFAULT_DIALECT;
+  const char *libpath = LIBSUBDIR;
+
+  /* An array used to flag each argument that needs a bit set for
+     LANGSPEC, MATHLIB, or WITHLIBC.  */
+  int *args;
+
+  /* Have we seen -fmod=?  */
+  bool seen_module_extension = false;
+
+  /* Should the driver perform a link?  */
+  bool linking = true;
+
+  /* "-lm" or "-lmath" if it appears on the command line.  */
+  const struct cl_decoded_option *saw_math = NULL;
+
+  /* "-lc" if it appears on the command line.  */
+  const struct cl_decoded_option *saw_libc = NULL;
+
+  /* By default, we throw on the math library if we have one.  */
+  int need_math = (MATH_LIBRARY[0] != '\0');
+
+  /* 1 if we should add -lpthread to the command-line.  */
+  int need_pthread = 1;
+
+  /* True if we saw -static.  */
+  int static_link = 0;
+
+  /* True if we should add -shared-libgcc to the command-line.  */
+  int shared_libgcc = 1;
+
+  /* Have we seen the -v flag?  */
+  bool verbose = false;
+
+  /* The number of libraries added in.  */
+  int added_libraries;
+
+#ifdef ENABLE_PLUGIN
+  /* True if we should add -fplugin=m2rte to the command-line.  */
+  bool need_plugin = true;
+#else
+  bool need_plugin = false;
+#endif
+
+  /* True if we should set up include paths and library paths.  */
+  bool allow_libraries = true;
+
+#if defined(DEBUG_ARG)
+  printf ("argc = %d\n", argc);
+  fprintf (stderr, "Incoming:");
+  for (i = 0; i < argc; i++)
+    fprintf (stderr, " %s", decoded_options[i].orig_option_with_args_text);
+  fprintf (stderr, "\n");
+#endif
+
+  gm2_xargc = argc;
+  gm2_x_decoded_options = decoded_options;
+  gm2_newargc = 0;
+  gm2_new_decoded_options = decoded_options;
+  added_libraries = *in_added_libraries;
+  args = XCNEWVEC (int, argc);
+
+  /* First pass through arglist.
+
+     If -nostdlib or a "turn-off-linking" option is anywhere in the
+     command line, don't do any library-option processing (except
+     relating to -x).  */
+
+  for (i = 1; i < argc; i++)
+    {
+      const char *arg = decoded_options[i].arg;
+      args[i] = 0;
+#if defined(DEBUG_ARG)
+      printf ("1st pass: %s\n",
+	      decoded_options[i].orig_option_with_args_text);
+#endif
+      switch (decoded_options[i].opt_index)
+	{
+	case OPT_fiso:
+	  dialect = "iso";
+	  break;
+	case OPT_fpim2:
+	  dialect = "pim2";
+	  break;
+	case OPT_fpim3:
+	  dialect = "pim3";
+	  break;
+	case OPT_fpim4:
+	  dialect = "pim4";
+	  break;
+	case OPT_fpim:
+	  dialect = "pim";
+	  break;
+	case OPT_flibs_:
+	  libraries = xstrdup (arg);
+	  allow_libraries = decoded_options[i].value;
+	  break;
+	case OPT_fmod_:
+	  seen_module_extension = true;
+	  break;
+        case OPT_fpthread:
+          need_pthread = decoded_options[i].value;
+          break;
+        case OPT_fm2_plugin:
+          need_plugin = decoded_options[i].value;
+#ifndef ENABLE_PLUGIN
+	  if (need_plugin)
+	    error ("plugin support is disabled; configure with "
+		   "%<--enable-plugin%>");
+#endif
+          break;
+	case OPT_fscaffold_dynamic:
+	  seen_scaffold_dynamic = true;
+	  scaffold_dynamic = decoded_options[i].value;
+	  break;
+	case OPT_fscaffold_static:
+	  seen_scaffold_static = true;
+	  scaffold_static = decoded_options[i].value;
+	  break;
+	case OPT_fgen_module_list_:
+	  seen_gen_module_list = true;
+	  gen_module_list = decoded_options[i].value;
+	  if (gen_module_list)
+	    gen_module_filename = decoded_options[i].arg;
+	  break;
+	case OPT_fuse_list_:
+	  seen_uselist = true;
+	  uselist = decoded_options[i].value;
+	  break;
+
+	case OPT_nostdlib:
+	case OPT_nostdlib__:
+	case OPT_nodefaultlibs:
+	  library = -1;
+	  break;
+
+	case OPT_l:
+	  if (strcmp (arg, MATH_LIBRARY) == 0)
+	    {
+	      args[i] |= MATHLIB;
+	      need_math = 0;
+	    }
+	  else if (strcmp (arg, "c") == 0)
+	    args[i] |= WITHLIBC;
+	  else
+	    /* Unrecognized libraries (e.g. -lfoo) may require libstdc++.  */
+	    library = (library == 0) ? 1 : library;
+	  break;
+
+	case OPT_pg:
+	case OPT_p:
+	  saw_profile_flag++;
+	  break;
+
+	case OPT_x:
+          seen_x_flag = true;
+          language = arg;
+	  break;
+
+	case OPT_v:
+	  verbose = true;
+	  break;
+
+	case OPT_Xlinker:
+	case OPT_Wl_:
+	  /* Arguments that go directly to the linker might be .o files,
+	     or something, and so might cause libstdc++ to be needed.  */
+	  if (library == 0)
+	    library = 1;
+	  break;
+
+	case OPT_c:
+	case OPT_r:
+	case OPT_S:
+	case OPT_E:
+	case OPT_M:
+	case OPT_MM:
+	case OPT_fsyntax_only:
+	  /* Don't specify libraries if we won't link, since that would
+	     cause a warning.  */
+	  linking = false;
+	  library = -1;
+	  break;
+
+	case OPT_static:
+	  static_link = 1;
+	  break;
+
+	case OPT_static_libgcc:
+	  shared_libgcc = 0;
+	  break;
+
+	case OPT_static_libstdc__:
+	  library = library >= 0 ? 2 : library;
+	  args[i] |= SKIPOPT;
+	  break;
+
+	case OPT_stdlib_:
+	  which_library = (stdcxxlib_kind) decoded_options[i].value;
+	  break;
+
+	default:
+	  if ((decoded_options[i].orig_option_with_args_text != NULL)
+	      && (strncmp (decoded_options[i].orig_option_with_args_text,
+			   "-m", 2) == 0))
+	    multilib_dir = xstrdup (decoded_options[i].orig_option_with_args_text
+				    + 2);
+	}
+    }
+  if (language != NULL && (strcmp (language, "modula-2") != 0))
+    return;
+
+  if (scaffold_static && scaffold_dynamic)
+    {
+      if (! seen_scaffold_dynamic)
+	scaffold_dynamic = false;
+      if (scaffold_dynamic && scaffold_static)
+	error ("%qs and %qs cannot both be enabled",
+	       "-fscaffold-dynamic", "-fscaffold-static");
+    }
+  if (uselist && gen_module_list)
+    {
+      if (! seen_gen_module_list)
+	gen_module_list = false;
+      if (uselist && gen_module_list)
+	error ("%qs and %qs cannot both be enabled",
+	       "-fgen-module-list=", "-fuse-list=");
+    }
+
+
+  /* There's no point adding -shared-libgcc if we don't have a shared
+     libgcc.  */
+#ifndef ENABLE_SHARED_LIBGCC
+  shared_libgcc = 0;
+#endif
+
+  /* Second pass through arglist, transforming arguments as appropriate.  */
+
+  append_arg (&decoded_options[0]); /* Start with command name, of course.  */
+  for (i = 1; i < argc; ++i)
+    {
+#if defined(DEBUG_ARG)
+      printf ("2nd pass: %s\n",
+	      decoded_options[i].orig_option_with_args_text);
+#endif
+      if ((args[i] & SKIPOPT) == 0)
+	{
+	  append_arg (&decoded_options[i]);
+	  /* Make sure -lstdc++ is before the math library, since libstdc++
+	     itself uses those math routines.  */
+	  if (!saw_math && (args[i] & MATHLIB) && library > 0)
+	    saw_math = &decoded_options[i];
+
+	  if (!saw_libc && (args[i] & WITHLIBC) && library > 0)
+	    saw_libc = &decoded_options[i];
+	}
+#if defined(DEBUG_ARG)
+      else
+	printf ("skipping: %s\n",
+		decoded_options[i].orig_option_with_args_text);
+#endif
+    }
+
+  /* We now add in extra arguments to facilitate a successful
+     compile or link.  For example include paths for dialect of Modula-2,
+     library paths and default scaffold linking options.  */
+
+  /* If we have not seen either uselist or gen_module_list and we need
+     to link then we turn on -fgen_module_list=- as the default.  */
+  if ((! (seen_uselist || seen_gen_module_list)) && linking)
+    append_option (OPT_fgen_module_list_, "-", 1);
+
+  if (allow_libraries)
+    {
+      /* If the libraries have not been specified by the user but the
+	 dialect has been specified then select the appropriate libraries.  */
+      if (libraries == NULL)
+	{
+	  if (strcmp (dialect, "iso") == 0)
+	    libraries = xstrdup ("m2iso,m2pim");
+	  else
+	    /* Default to pim libraries if none specified.  */
+	    libraries = xstrdup ("m2pim,m2log,m2iso");
+	}
+      libraries = convert_abbreviations (libraries);
+      if (! check_valid_list (libpath, libraries))
+	return;
+      add_default_includes (libpath, libraries);
+    }
+  if ((! seen_x_flag) && seen_module_extension)
+    append_option (OPT_x, "modula-2", 1);
+
+  if (need_plugin)
+    append_option (OPT_fplugin_, "m2rte", 1);
+
+  if (linking)
+    {
+      if (allow_libraries)
+	add_default_archives (libpath, libraries);
+      /* Add `-lstdc++' if we haven't already done so.  */
+#ifdef HAVE_LD_STATIC_DYNAMIC
+      if (library > 1 && !static_link)
+	append_option (OPT_Wl_, LD_STATIC_OPTION, 1);
+#endif
+      if (which_library == USE_LIBCXX)
+	{
+	  append_option (OPT_l, saw_profile_flag ? LIBCXX_PROFILE : LIBCXX, 1);
+	  added_libraries++;
+	  if (LIBCXXABI != NULL)
+	    {
+	      append_option (OPT_l, saw_profile_flag ? LIBCXXABI_PROFILE
+			     : LIBCXXABI, 1);
+	      added_libraries++;
+	    }
+	}
+      else
+	{
+	  append_option (OPT_l, saw_profile_flag ? LIBSTDCXX_PROFILE
+			 : LIBSTDCXX, 1);
+	  added_libraries++;
+	}
+      /* Add target-dependent static library, if necessary.  */
+      if ((static_link || library > 1) && LIBSTDCXX_STATIC != NULL)
+	{
+	  append_option (OPT_l, LIBSTDCXX_STATIC, 1);
+	  added_libraries++;
+	}
+#ifdef HAVE_LD_STATIC_DYNAMIC
+      if (library > 1 && !static_link)
+	append_option (OPT_Wl_, LD_DYNAMIC_OPTION, 1);
+#endif
+    }
+  if (need_math)
+    {
+      append_option (OPT_l, saw_profile_flag ? MATH_LIBRARY_PROFILE :
+		     MATH_LIBRARY, 1);
+      added_libraries++;
+    }
+  if (need_pthread)
+    {
+      append_option (OPT_l, "pthread", 1);
+      added_libraries++;
+    }
+  if (shared_libgcc && !static_link)
+    append_option (OPT_shared_libgcc, NULL, 1);
+
+  if (verbose && gm2_new_decoded_options != gm2_x_decoded_options)
+    {
+      fprintf (stderr, _("Driving:"));
+      for (i = 0; i < gm2_newargc; i++)
+	fprintf (stderr, " %s",
+		 gm2_new_decoded_options[i].orig_option_with_args_text);
+      fprintf (stderr, "\n");
+      fprintf (stderr, "new argc = %d, added_libraries = %d\n",
+	       gm2_newargc, added_libraries);
+    }
+
+  *in_decoded_options_count = gm2_newargc;
+  *in_decoded_options = gm2_new_decoded_options;
+  *in_added_libraries = added_libraries;
+}
+
+/* Called before linking.  Returns 0 on success and -1 on failure.  */
+int
+lang_specific_pre_link (void)  /* Not used for M2.  */
+{
+  return 0;
+}
+
+/* Number of extra output files that lang_specific_pre_link may generate.  */
+int lang_specific_extra_outfiles = 0;
diff --git a/gcc/m2/gm2version.h b/gcc/m2/gm2version.h
new file mode 100644
index 00000000000..61b5559be37
--- /dev/null
+++ b/gcc/m2/gm2version.h
@@ -0,0 +1,22 @@
+/* gm2version provides access to the gm2 front end version number.
+
+Copyright (C) 2008-2022 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/>.  */
+
+extern void gm2_version (int need_to_exit);
diff --git a/gcc/m2/images/LICENSE.IMG b/gcc/m2/images/LICENSE.IMG
new file mode 100755
index 00000000000..7a2433d8e6a
--- /dev/null
+++ b/gcc/m2/images/LICENSE.IMG
@@ -0,0 +1,20 @@
+The files gnupng and gnu.eps are part of GNU Modula-2.
+
+Copyright (C) 2005-2020 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 GNU Modula-2; see the file COPYING.  If not, write to the
+Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
diff --git a/gcc/m2/images/gnu.eps b/gcc/m2/images/gnu.eps
new file mode 100755
index 00000000000..d9f6dcd3248
--- /dev/null
+++ b/gcc/m2/images/gnu.eps
@@ -0,0 +1,547 @@
+%!PS-Adobe-2.0 EPSF-2.0
+%%Creator: pnmtops
+%%Title: noname.ps
+%%Pages: 1
+%%BoundingBox: 244 337 368 455
+%%EndComments
+/readstring {
+  currentfile exch readhexstring pop
+} bind def
+/picstr 129 string def
+%%EndProlog
+%%Page: 1 1
+gsave
+244.08 337.44 translate
+123.84 117.12 scale
+129 122 8
+[ 129 0 0 -122 0 122 ]
+{ picstr readstring }
+image
+fffffffffffffffffffffffffffffffffffbfefffffffbfffff7fff7fffd
+fdfffcfffff9fff8fffffffffefbfffffdfffefffbfcffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffefdfefffff9
+fffffffffafffffefffbfffafffff9fdfffefefffafffffffff5fffff6ff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffffff3ff
+f8fffafffff7fffff9fffffffcf3fffffafcfff9fffefffbfff6fffffdff
+fffcffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fefefffffffffffffffffafafffffff7fffffffffcfffafffff8fffff9ff
+f8fbf5fffffdfffffbffffffffffffffffffffffffffffffffffffffffff
+fffffffffcfbfdfff7ffeefffffffcfbfffffbffffffe9f6fdfffffdfff6
+fcfdfffefffdfef5fffffcffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffefefffffffffefef7fffffffef5fcfffffff8ffff
+f1fffef9fffdf9fffdfffffff7fff9f2ffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffdfff5f7fff8fffffffed09e6c877859
+4d5a5344453e72bce1fffffff4fffefffffffbf8faffffffffffffffffff
+fffffffffffffffffffffffffffffffffffefffffefefffefcfffdfdffff
+fdfdfffffefffafbfbfefeffd5ab8f999d95bfdcf9fefefffdffffffffff
+fffffffffffffffffffffffffffffffffffffffffffff9fff7fffffafff7
+c641468cddffffe6dcf9fff8fcfefff5bb93666bfffffffbf8fffbffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffdfffffe
+fcfefffffafffffbfcfffffbfefcf9fffffee85e00588a9dc3babb6f2c2e
+acfaf7fffcfdffffffffffffffffffffffffffffffffffffffffffffffff
+fffff6fefffbff987ba5c2e6fffde1beabb58677888f9cd6c39ad0f5cb92
+80d5fffbfffcfdfff9f9fbffffffffffffffffffffffffffffffffffffff
+fffffffffffbfffffefdfffffffefffbfffffcfffffff3fffaba5f558ae1
+f1c6f4aef5fafffdc06346c9f5ffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffefff9fccd64b9fdf7ff999b91445544134c7566
+ad9a275b004657fff8e37792fdf0fffff8ffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffdfffffdfffffdf5fffffcfffffafffd
+fbf7b44b73f4d09c6a4b64647d996b6c9ed1dac82e8df2fdffffffffffff
+fffffffffffffffffffffffffffffffffffffffdeea678a5dfd3866984a5
+584566682f4c5f48729b702c2e1616025574e1f9d26b6bddfff4ffeaddff
+fffffffffffffffffffffffffffffffffffffffffffffffffffefcfffff6
+e8bdf6fffbfafff1b665483e8a4928302d42535f6d988d406a4171c0b7ff
+b5469afffffffffffffffffffffffffffffffffffffffdfff8fffbfe6136
+cdfaefda491f5a54635745139c42445d60727d651c5488580e5b5d2d36a8
+e9ff46416d72bd53ffffffffffffffffffffffffffffffffffffffffffff
+fffffdfffffffafffaa5ff83436e5b4456ab2e0c24552d4f435056b38e8a
+688fa84590974492acddc04e8afafefdfff9fefffffffffffffffffffffb
+ffffffffffff8e71edfddfe9588f323aa273481356a5bcbc43a17487679c
+8dda915f926a4a007378cbe5d3ffffbb76ffffffffffffffffffffffffff
+fffffffffffffffffffffffdfffafffbfffdc5beffcccabdbb9f60080021
+489761a7dbb97fb1916175557640115a5d944b5fc348aefffdfbfff8fbff
+fffffffffffffffffffefffbf8ffaf98ffffee3ca6bb503d314973b439c4
+ecc6e9d2aa9da2419fc8dacda7d2a39d67c175cbb4e7ff9465fcffffffff
+fffffffffffffffffffffffffffffffffffffffffffff9fffffdfff083cf
+f0b3b23c42685c8597c9bbafc7cca6b0bbd5a491a60100487857238dcbdb
+e236f3fff8f8fffffffffffffffffffffffff7fffffdbf9ffffce5b2b6bf
+9a9d5d010b64b78276fff4c8744c1c1d031b339298ffc0fd89b9d6d0d2c6
+506bd6ffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffafffffcffffedb869c3e29f4fa48bbcd8accfbbcbbe9daeb1acb36572
+00341b4ca46a0b0306a76898f2fffffdfcfffffffffffffffffffffdfff8
+e38aecfbffd7aeb483c9d967630064bfd6e1a4434e85acc5fdf7fff1dec0
+988ab0619e9d6b7f96f8fffdffffffffffffffffffffffffffffffffffff
+fffffffffffffffffcfffbfcfffcfefffbfffba27579418a745e5c5f6242
+638cbd8c96aa9ab02d522947a35e0051635f62c51ff4fff1fffeffffffff
+fffffffffff3fffaff56d9fff4b6cb2b4b86c478f9cc146bb2c64a58e1f5
+fffdfff8fffcfcfef7fcfffffff0fffffffff7fdf6fff7ffffffffffffff
+fffffffffffffffffffffffffffffffffffcfffffcfffffcfcfdfffbffff
+fef4fffffff6fffbfff58c3e1a9a7f9a53cbc18e922e043614004865ed79
+5dfffefffffffffffffffffffffffff9ec70f3fffaec9c76ad8aa7bee9cc
+e1e3c6777decf7fffff8fdfffefdfafffefffefffbfffffdfbf2fffff7ff
+f7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffe
+fefffffdfffffafbf7fffffff9fffafffffffff9fbfa999db778a2bb6155
+3f0710212e4749a3ff3deefff7fffffffffffffffffffffcff7aeefbf9d2
+bbacaa2ea9e1ce82e8ffce23d1fbfffefff8fffafffdfffff7fffff9fffe
+fdfffcfffffffcfffdfbffffffffffffffffffffffffffffffffffffffff
+fffffffffffffbfffefbfffffffafffffffdfefffefff0fffaffffffffff
+fdffe15d8b9a23a6bd45219b6b402f77b8ffbf88fbfffcfffdfffff9fff4
+fdfffac08afeffeccd73bbb6baa9cdd4ba9aaa43f1fdfff6fcffffffffff
+fffffffffff6fffffffefffdfdfffafffffff5fffefffbfbfffffffffbff
+fafffff8fffffffefffdfffff6fffffcfff9fffffefefff7fffffcfdfbff
+fffffffffffffffffeffffffb972448fd3adbf56321c4a538962d3fc24ff
+f5fffffff8fffdfcfffffeff2ffffadff0a0b0a649c1a5d5cfe9b250ffff
+fff4fffffcfffffffffffffffffefffcf8fffcfefffffffffcf7fffffcfe
+fafffff4fffbfbfffffffefffff6fff6fffffffefffbfffefafafffbfff8
+fffffffff7fffffffafffffffffffffffffffff4fbff875395bde5cb6509
+75966758c2daff3ebdfffffffffafdfff9fffffa74aaf3ff9886b4ce7cce
+3d75b5e9ec4efff8fffef7fffffcfffffffffffffffffdfffffdfffcfff4
+fefffffded86481b4b2f42599cf2fffffdfffafffffbfffcfffffcfffffc
+fdfffffffff6fffffafff7fefffbfffff9fffffffffffffffffffff3ffff
+f8fa2a6febc154a5950f44564243a3f26e7cfafbfffcfffafffffafce21f
+f5ffe3e3e9899dc5a4b26ea5e88aeefdfffffdfffff7fbffffffffffffff
+fffff3fcfffcfdfdfffae85f8599ddeffff7ffdcba71544695fff9fffff7
+fffffffcfdffecc2bcd9b1ecf0f5fffafffffcfffffffbfdfffeffffffff
+fffffffffffafffafff7ffae64fc5691b00003010f4658a7d5cd46fffeff
+fbfffdfffff9ffa66afbf7f0d1bae0b8a3b39bd75e6dbdfffffeeefff6fe
+fffffffffffffffffffffdfffff9fdfffff58c2ae1f3fffffff4ffffffff
+e4fcf66044f3f9fff7fffafdffde6600053f6c5b3b0478d7fff8fffbf6fa
+fffffbfffffafffffffffffffffffffcfefffffaff8ccd2b7d68e25299a1
+748d9ee4f821fbfefffffdfffff7ffff68fffdf0f5edecc8d7b1c078a58f
+75fff6fffffffffffffcfffffffffffffffffffffffbfff5eb8279bdfeff
+bfffdc95e7da6473b61e8678dadf7187fcfdfffee172337654a368b486a2
+f0ff64236febfdfffdfcfffff8fffefffffffffffffffffbfffefffaffff
+b37c73a6cdb633373a332384a9ff38fffcfffffbfffff9ffee5dfff7ffe0
+ccb591aae2bfb7619cc0f7ffffffecfffffffbfffffffffffffffffff7ff
+f7fac362dafaf9ffb8c6ba9a478c030d005a3457306394fff643f288657b
+7a004b94595890470e25aabb96ae3e70fcfff5f7fffefdffffffffffffff
+fffffffffff2f9fffff24ac9e2b86597370e040049bad638fffffffcffff
+fffffdbe74feffb59a96969364ab6f59ce6af6fffbfdfffffffdfffcffff
+ffffffffffffffffffffde4beaffffff903658876a411f9e00032b1a1122
+1f65baeaf900470a280d021f11164145101300435849249d9a47d5fffbff
+fffffefffffffffffffffffcfff5fffffbfbff63ebb0ad703f505c60bfbb
+71f65afffcfffefffefbfffc99befff0e5e6f28d519a99c25aff54feffff
+fffffffffffffffffffafffcfffffffbfdffff6bfcfcfbd5be7370014c23
+000085010200240c14105843789fdb43432209050300235443050009000f
+1c3d13cf9c20bcfafffffbfffff9fffcf9fffffcfffbf9ffffffffff8bed
+625be392bf8865552944fc74fffcfffbfffefdf8ff50e7ffebf7d9b6be7f
+65231a939d94fcfffcfffffffffffffffffffffbfff7fffffffff23fdbff
+c07895786f3119000052213610000004000a2c0c453664700f5f41060300
+070000390000000003001111b9a8f33e8bfffcfdfffffffffffffbf7fffb
+fefffffffdfcfcadc36585acd4658dccaca166aa6fd1fffffcfffdfffeff
+54fff9fff9fff5e6c5896175144bb8fff9fafffffffffffffffffffcfffe
+fff9fff5fe6cb9ffb9a39b21414a1d2311045c46021000040003081c0729
+283400183b472d30623105001506090005070001025b4fd6a66684fffefa
+fefef5f8fffffbfffbfffffdfeffffffb092d6dbd3675c939bb7abb6d99d
+d6f4fffffffefffefc63fcf9d4c1bab7a5a27a9a717042c8fef4ffffffff
+fffffffffffdfefffafffcf9ff6e89ffe78e789902000008043000001501
+000007000307000004130024000730e01f4c09152000001a070000000800
+160a2071ff61b0f9fffffffefefffffffefffffbfafffffdffc2ddc0ac41
+230000003cba90d4acb7fffffbfffffefcff60fffaffe5ede66b2f224841
+eb4de2fafffafffffffffffffffffbfffffff9faff9aa3ffd94c0a140f00
+030500010600000b00000704000000070003120000033fa37aeb0c583ca0
+0c1c0002000000070007000346a3fd8ac4fbfafdfffffdf7fffafffdfdff
+fffdf9fb94d0baa6ac983346591a4849efa1e9fffffdfbffffffdc7dfbed
+b7d5e6d1ab4d5e65b8de41dcfbfffefffffffffffffffffff8fffffaffbb
+7df8d48c630d00000f00000715010600000009000002010034000700000d
+003297cd885c1b85e0386e000202020100000004060010a3f18dfffffef4
+fffef7fffefffbfffffcfdffff6cfdf2e7d86561c0c5b8d8b6c09cfffcff
+fffbfffffeb08fddad9c715b768d677b3470fc45e8fff4ffffffffffffff
+fffffffbfcfffddf60f9ad93545200470b011400050a0003001500160000
+0605012b00744e00006000aea84d963a44474ce6490d0000050004030100
+000634c5de77f3fffffcfffffffcfffbfffff5fffff350ffa481644f4f59
+575da3d2a290f6fffffcfffefaffdf8dfed9f5dead996881d183a6fd51db
+fdfffdfffffffffffffffff7fffdfeff55e19cad416316003f5900000211
+400005030000150001040005000f230005079514bbaa627544b6f270ff6e
+0602011c030f000025031d1b92ffc98ef6fff6fffffffefff9fffff9fff6
+be76eaaa471f30007aab76a1d8e18bfcfefffefffdfffbfe79eeefe3ddb3
+726f775674a9ff87befefffafcfffffffafffefffff6ffff89daac761d00
+0005001d501b040000094e00074000120000000600000e438f792a8d63cf
+6f9f64a91f34b9757111140713481a0304071b00260595af8c97fdfdf9ff
+fffefffafffffcfcff86cd620c060d0846471a589dadfc9bfeffffffffff
+ffffff86f5dbcf912059a79c761eaef1e085fff3fffafffcfefbfffdfef9
+fff2c2b8b1891f09000300061a604c0006140032000000000f0c12000003
+33d0effbff2f9eabcdc3b063dac0244a51200d03001d492600000a001f06
+1e4c40ec87d5fffffff0fffdfffbfffffff87bf76f511736b25d8da398a0
+bdfe9afff8fffffffff9ffff7df7deb4bed2a2df87569e71edff6effffff
+fffff8fefffdfffffff6e892cef1446700021506000d34000304558b71c9
+ffe1b86d4e414ba2c4fffefffef965928dc9d9b0ffb1c1df47588999ccb1
+7c001f00000000145d00014b3ef94fe3fffafffffffafff7fffc57cefd83
+144d3b8d432d6077ffd1ff95fcfffffefffffafffe61ffe9f3d58bbd8b8a
+d0929e7fff9fd0fbf9f5fffffff8fff6fdfc97c2974b4416121321000016
+566e72cadefffffefffffbf4f6fffdebfff8fffdfefffcff5b894b9899b3
+68411e42bbe8fdf7f9d9abaecfe2b97d5f21050624383dac8fe5fbfbf6f8
+fffefdff95bdb630303f5788646b9a2c9b95d16dc5fcf7fffdfffeffffff
+4cfffef0dbcba072a370715dbca3e892fffffffafbfffffbf8ef78a0bb89
+53305c15402a52d4f7fff8fffff6fffffdf5feffffffdff6fffcffffffff
+f2ffffec6951596f11013245fff9fefffffdff64d1fffffdffffcb68569c
+878e2e9d60adf4fffffcfff980afab4415061c2b5072558a80b58af046e3
+fffffffefffbfffefc4be6ffcfc7d86cb03521097caf74fec0dbfeffffff
+fffbffbb59b9488c36001e57001e78ccf6fffffcfff8fffbfff9ffffffff
+b0e1fffffafdfafffbfffaf7fffbf68075d70064b0d9fbf6fff3f9fff98d
+fff8fffffcfffd991f3b956e27679e1264aeb69054c1d7188e08082da30b
+acaa64aeeeaeac8ffffffefffefffafffaf96fb1d1ecffae423c50587a44
+17669cf8499ff6fffff5f95fcb5d5235600d400027affff5fffffff4feff
+fffafafdffffea72660dc1fcf0fffffffefdc29cfdbafff3fffd7038858f
+9bfffff4fffff6f79490fffffdfbfffdfcd35994a31e6761ace89f63a438
+34615b6a5a5d2f48cc318b55e4acd8aae6fff3fffffdfffcffffffa298f1
+dbc261557b6abb5200007b41aabb2c91aabba2a7ddd44f0500072a0d66e0
+fffffffcfff7fffefffaffffda31458b330f25dafffff8fffdffffb8b3b6
+bdf7fffffae5ec9d1f94fffdffdc9a8becfd66b8fdfefff6fffffcbc4488
+4741354242bd1a56050e3146950d49491d766861a9b5e1a15ffbfffffdff
+fffbfffffdf5ea43d0efbd5e8b90c420000f8c3e4a6f582096bdb7fcd766
+47500302000055fffffdfffffffffefefffffff7eb414ef83e040041ffff
+fffefffdf9fffdffa594fffcfffcf6fe860e96fffeff640455cbfff855ff
+fffbfffff7fffbac008b60436358990148080d255d2c6931592801d1bebc
+b8e488b6fffffafdfffbfdfffcfffff753def5e9e4f49590060e66465f03
+a4512c76fff8b38b0f0d0700070041f4fffbfffffbf9fffffcf7f7f4ff46
+46d6a71c0000c8fffcfffffffafffffbfdffffdbccf7fbd7258bc1ffffff
+dd00409dffedffc8a5fffff8fff9ffffff72998c4f124d780d95234b0014
+671c4599232348c7d1b7c071fffefffffffffffffffbfffffa7fdaedf0ed
+c8f272424c3da8417f4855002d8c919c43180006482337e5fffefffbfbff
+fffdf9fefffff3e638a1bff100029dfffff4fffefafffefef9fff1ffffef
+f5fffff6fffffffcf89f006ffffffdfdfe76f9fffefffffdfdffe63d4d9b
+5d48ac11bb5353053d525a9a7f84505fddb7f96cb9eff7fff9f6fffcfdfc
+fefffcffd44ce5e5f4e2b88a381f4a646e6358000d008e412f3a140f0018
+68fffbfbfefffffdfffffefffffdf5b52b8c7ff2ff579cfdfdffffecc8ce
+cec073fff6fffbf2d1e7fdf8fffcfef9ffff2f65b2bfcde1ffff8bfaffff
+fbfffdfaffffa0868b19436532a74d750f3f4eb4628987d4c1bed5b48dfe
+fffffffffffffefbfbfffff6ffffb8b2d1c3d4ad8294a5d3409a64424a35
+139c3f005c1c49462afafafffffff3fffffdfdfffffbffff7669e5d2ffe4
+dcf9fcffffab89fffff6f854cffffbfffee4cef9fffffffdfff6f4021d6c
+fffab9fff0affffff8fff6fffffafffc449659765e54606465717e77e1a2
+749bf0c7e0b26bdff8fefff4f9fffffffffffefefbfcfcff4bd3e7dfdddf
+ced739af5357754f0d21272c074946200f44eafffff3fffdf8fbfffffaf9
+fffff872ffdcfaf9f4fffeffe3c2fffefbf9ffffc028e8fefff8fe55e7ff
+f9fbfdfaffcd0451fefcfffffe96e3fbfffdfff8fffff5ffff7363a9bc30
+5ca3656d8cb574ffcd94d5b9a9db66d5fffff6fffffcfffffafcfffbfeff
+fffffefd67e1edcad8984f7a9770a9a1031c307a2800635d8e13e0fefeff
+fffafffffdfffdfaffffe5baffffadfffffdffffffffd9fffffffffcfdfe
+96fffff9fbffb6bdfffffefff8ffb911cdfffffffafd70fffbf9ffffffff
+f9fffffff21da9d94a71ac915f97c097b2d3a0cae37868c0fffff8fff6ff
+fffafffdfdfffffbfffbffffffb0b1bfdf72be898f74e0ba6f24aa204485
+2c86884950fffffffefbfffffcfff8fdfffce1e1f7fcffd4fffefbfefdff
+ef74fcf6b4769a558bbaddf7fffdfdfbf7eafffffffcfece48fdbd94785f
+aebff4fffffafffffcfefbfff6ff6446ae756163e38b989eced4addbb9ce
+32bcfffffffdfcfffffcfffffffffffffffffffffafff898af86bf8cb9b6
+e5b9ba9664e4401090428ab820feffffffffffffffffffffffffffffffff
+ffffabfcfefffffeffa348405407000001314051fffcfefefed1fffffffc
+fefffa4a70959319000320badbfffff4fffff8fff7ffffcc0f7769b572e0
+c09bbddacd92ff7b46e6fffbffffffffffffffffffffffffffffffffffff
+fdfaff6fab9fd2d1e5a7e28a49d4ae6b88ce98d3569bfcffffffffffffff
+fffffffffffffffffffffeacfffffbfbfffc9700161e5d19030786ffd8b3
+fffffcffeedefffafcfffaffa287fa590212303200d2fbfefffff9fff8fc
+fbfff975a677cfa4b9d190b8e4f8e0816afafaffffffffffffffffffffff
+fffffffffffffffffafffffaf5a2f9ffb387dda7ce6cf5bda999f7dacc00
+f0fffffffffffffffffffffffffffffffffffffbb9fefffef9ffff602e9f
+f5c1000e5706d1fbfdfef7ffffffd9fff9fefff9ffff3e6d01013645f041
+d5fbfffcfffff8fefffffaffcf1db3d0edffddf4bab9b99ad7f7fffff7ff
+fffffffffffffffffffffffffffffffffffffffffafaf970efbed675dec3
+65d1d0b2f4f9d9b607fff7fffffffffffffffffffffffffffffffffff2d1
+fafefffefdff9cebebff9d0001001ef1bafefffafffefafefafffffdfffb
+faff4107090065fff8fffffcfdf9fefefffffffff8f4d90c0946524465a6
+fffffff9fff9fffffbfffffffffffffffffffffffffffffffffffef6ffff
+fffedc5efedafeedafa1b6be97ebdbdda35ffeffffffffffffffffffffff
+ffffffffffffffcfe4fbfcffffffffe83ea9fffd730033f5f4b9fff1fffc
+fff7fff6fffff9ffffffffdc107f96f1b5618afffbfffffefcfffff4ffff
+feff7058fffcfffff9fffefdfff8fffbffffffffffffffffffffffffffff
+fffffffffffffdf9fff4fbffe78dccf6b1a0b59694b8f7cdf6b096f6ffff
+fffffffffffffffffffffffffffffffe95edfffffcfafffff8f7799ba6f4
+fdfdfff2bcffeefefffffffffbfffffefeffeffeffd082d9a190a2f0ffff
+fdf7fffff8f8fffcf6fffba4b2defff9fffff6fffffcfffffbfdffffffff
+fffffffffffffffffffffffffffff8fff5fffff9fff4fc5c6589e4ccfae1
+dacbf1eb86e1fff9fffffffffffffffffffffffffffffffff35ef7fffffb
+fcfffffff7f4e5ff8a8c9386fcfffac0f7fffffff5fffefffffcffffffff
+fc5c6fad459dfaf5fdfdfffffff5fff5fefff0fff5b6a4fffcfafffffffa
+fbfff1fffffefffffffffffffffffffffffffffffffffffff7fffdfefffe
+fffff7e9585ef2ffb5fffffdf5b6ffffffffffffffffffffffffffffffff
+ffffffe741fffffefffffefbfffff7fff9fffcfffffdf9c1eefffdfffcff
+fffffdfffffdfffcfefffb8cffdea7bafffffffbfefffdfffdfffafff9ff
+fc78e7fffff7fefffbfff4fffdfbffffffffffffffffffffffffffffffff
+fffffffffffffffffffff9fefbffd9a58652afcadfb58ff9fcffffffffff
+fffffffffffff9fffefffff8a2a5ddfbfcfffefffffffffffffffffffeff
+ffeedef3fffcfffff7fffefffffffff8fffffdfa9edfff62a7b9fffffbff
+fffcfffffdfffffefffbfdbbfffffffbffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffff4fbe29a8a7c
+5397fffff9fffffffffffffffffffffffafafdeeff81c6ecfffdfffffaff
+fffffffffffffffef8fdfffffffffdfffffdfffbfcfffffffffff6ffffdb
+86ffc1a172e9fdfffffffefffffefcfefefcffffb7fffffaffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffffffefb
+f4fefaf9fffbfdfeff9af1f4fefffffffffffffffffff9f6fffcffffffbe
+a1b5d8fffdfffffefffffffffffffffffffdfdfffff9fbfff8fffffdfdff
+fefcfffefff7fffbff98b2ff6bff77f3fff5fffefbfbfffffffafbffff98
+ecfff1f2ffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffff9fffdff99fefff7ffffffffffffffff
+fffcfff5fffff6fb64ffb1e3fffffcfdfcfffffffffffffffffffffffcff
+fffffffff9fefffefff8fffffcfefffff8fcf553f48ff8f59ee3fff6ffff
+fffffffefdfff4fff770ff8e65ffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffcfcfafefefefffffdfffc6effff
+fdfafffffffffffffffffefbfff2ffffc4c9f8b0dbfafcffffffffffffff
+fffffffffdfffffffffff9f5fff8fffff6fffffffcfffffffffff5ff9dde
+b9a3fff98876d4f4f5fff3fffdfffbfcffff9c574f54ffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffff3ff83f0fefffcfffffffffffffffffffcf8ffe8e08bfffff4d6
+fffffff8fdfffffffffffffffffffffffffaf9fffffafff8f7fffdf8fbfc
+fffdfefffdfff6e976be6dfff7fbf069384e56f7f9fcb7e9fffdfcef5900
+87ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffcfefffffffffefff1ff6ea2fffafefcfffffffffffffffffeff
+f8f0efa2fdfffaffc1f6fffff7fffffffffffffffffffffdfffffbfffff6
+daa471aafffefffffffffbfffef5fffeff5fbd69f9fffdfef5ffec8d2d14
+71ecb280c0c5db2b57f2ffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffcfffffbfff4679bf9fffdffffff
+fffffffffffffffff9ffb573cefefeffffdff3f6ffffffffffffffffffff
+fffffcffffffffc9768b97ab8c3e59effefcfffcfffefff7fffaf44361ff
+fbfffffffdfefdf1a77876988da4b296cefffbffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffff8fffffffdfffeff
+bbb9fffefff7fffdfffdfffefbfffcfffdf2d24ecefbfffbfdfffad3fff8
+fffffef8fffffffff7fffafffffbffa289fffffffcfff7d396d2fffdfbff
+fffffbffffffb867fcffffdab8b6f3fffefdffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffbfafffafffffeb4e0fdf7f5fffdfffffff9fffafffff6e5b170f6ff
+f9fffdfbffffedfffffffffffcfefafeffffffffffffff8dafffc4d8fffd
+f8fffafffaa6cefff6fefffff7f7ffffde51aa4a6becd63dfffffffcffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffff6fffffeffeffffebed4fffffff8fffdfff7faff
+fef7e1a29769f0fefffbfff7fafffefffefffbfffefdfffcfafefbfefffb
+f7ff48f23130c1bbd3fff1f6ffffd72f0babfffafffffff7fffff5bcffff
+ffff85b1fff3fffcffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffff2fffdffffffff73ecf4
+fffffaf9fffffffcffdcc3cb4d89b4fef8fffefefffefffafff7fffbfffd
+fffffffffffffefdffffff899a00c1fbffdbfafffffffdf9df54355ebeff
+f3fffefdf6fdfef3fffff7ec58fdfffdfdffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffffffeff
+fefdf3ffff827afffff9fafffffee2fff9e2538d6beed28dfefffffafffb
+fffefcfffbfffffffffff9fafffffffdfff3ffffa59700fffff9f6effeff
+f3fff6fffbaa461da3fffdfefffffafffffffff9f842f1fffdfeffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffaffffffff40c3fafffafffffce2436714271f8cf7f3
+ffb894fffbf7fff9fffffcfefffffffffcfefffffffffafdfbfcfffff295
+c859feff8d01657fd0fffffffefffcffcfaeecfff9fffffff3fffcfdffff
+73def7feffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffcfffdfd8cc5ffffffffecbfae
+52f8b562dbf7fff8fffbd298fffefefffffefcfefdfffffffdfcfffef5ff
+fffafffffffcfff9a9e9e0ffff40003adc97befffdfbfeffffffdbd1daff
+fffafffdfffafcfbf3aec9fff1ffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffffdffa6
+aafffafff7ba8e3f87b08944fffcfffbfffefcfeb0ddfffff1fffffcfffd
+fffafffeffffe0bacdeefbfffdfbffffffffb1fffffbd4450a22a199b7f0
+fffefdfff5ffecfffff8fffffffdffffffffb1bbfcfffbffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffff5fffbb5fdffea7b3c9187acffffb497fbfffdfef8fffcfecf
+96fffcf9fff7ffffffffffffffffffcfb7fffff9fdfffffffafff6fffff7
+fbffffffffd7a282bafdfdfffcfcfffffffffffffffbfffffefffeb8b8ff
+f8ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffff2fcabfba84b526d447afdfbffb0c1
+fffffffffafffcff93d4fffffffbfffffffffffffffffffafff8fdfffdff
+fefffdfffbffecf4fffffcfafbfcffc29759fffffcfafffdfff9fffffffc
+fff6fffff9ff46f6f8fffdffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffcfbffff8c7aacff
+efb9ebf6fffff599f1fffefffffefffed3976af7fffcffffffffffffffff
+fffffffefffffdbcb7bcfffffffecdeefbfdf7fffffffeffb4e875d4fbff
+f7fffffdfffffffefafffffdfbbd4db2fcfff7ffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffcfffffff9fffffdfffbfffff6ff91fffcfbfdffffffff97b674fffa
+fafffffffffffffffffffffffffff6ffffee98f8fff5ffcaf5fffffffefa
+fffffab7ffe0aaf9fffcfefffefafcfdfefff5e2de671094fff2fffffbff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffcfff4fffffcfff9fffffffcfbffff9afff9fffe
+fbffffffc8a670fcf9fffffcfffffffffffffffffbf4fffffefaffefabff
+ffcefefafffffff8fffff9ffeff8fcc9fffbfffff7fffffffbffffc54891
+0191f8fffffafffeffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffdfff8fef7fffffff9ffff
+fbfefffbb7fffcfffffcfffffeffc070c3fdfefffbffffffffffffffffff
+fffafcfffffcff88fbfdabfffefff5fdfefffffbfcfffcf8f9fffffdfdfe
+fffefeffcab8524d1ca6fffffffff9ffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffffff9fe
+fffffffffcf9fffbfffcfefff4a9fefffffffffefffefafbff99e0f6ffff
+fffffffffffffffff8fffffffbfef7ffd1b7cfe8fefffdfffffff8f7ffff
+fffffffff7fff9f9fffcffbba368554341d3fbfff7fdfffefbffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffdfcfbfefafffbfffefffafdffa6fffff9fffffdff
+fffffaf392aafffefdfffffffffffffffffff3fefffcfffffcfc77abfffb
+fff8fdfffdfffffcfcfffffffafffdfffefffa95558b75704fb7fbfffcff
+fffbfffefeffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffdfefffcffff
+ff9afffffffff9fffdfffffbfad0bafdfbfffbfffefffcfdffffffffffff
+fffffffffff647a8fcfffafffff5fffffefdfbfffffefff9fffffbe48776
+b5cad445d0fffefffff6fffffffdffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffefffdfffeffa0fcfbfffffbfefdfffffffdc19ddbfff7fff0ff
+fff7fffef9fffffffffffffffffdffb75cf8fffbfcf6fffffffffffff8f7
+fefffff7fffff3f2fbf5fff5ee63b8fdfffffffffff6ffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffdfefefffcffb1fcfffffefefffffcfbfb
+ffabe183a1f5fffdf8f7fffcfefffffffffffffffffffdfffa87dbfffaff
+fffff8fbfffdfefffff7fafffcf8fffffcf8fffdfffffe5893fff5f5ffff
+fffaffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffdfdfffffbffcebf
+fff9fdfffffffbfffafce7d1e6f097affbfefffdf4fffdffffffffffffff
+fffefffdff58f4fefbfefbfffbfbfff5faf7fffffffdfffffffffffbf8ff
+fffcfb6c6afffff1fff4ffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffefffffbffec67fbf9fffdfdfffffff9ffffffff9ce3d9bcf6fff6ff
+fffefffffffffffffffffdfbfffdbb26cdfefff7fefffeffffffffffeffb
+fefff3fffcfffafffaffffff43cffdeffffefff9ffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffefffffffffcffff71fefffffbfffdfffffefafcff
+ff70eef5bdacfefafffefdfffffffffffffffffffff6fffe723ee1fcfff8
+fffef4fff4fefcfffefff6fefffffff9e3d1e8ae96a3fff6f7fffcfcffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffdfffefffffeffffadecfffc
+fcfffbfffcfffffffff0ffceceace3a4f5fff9feffffffffffffffffffff
+fff2feffae86dff5fbf5fffff9f8f5e3f3ba8742310000212600000039c1
+fff8fffff9fff6ffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffffdfffc
+fefffffdfeb6bcfffafffff9fffffcfcfffdffffffffffa5c1c8eefffdff
+fffffffffffffffff9fefffaf5ffdf51122d4e838269edaa3629a9bbd2be
+a88d62220002a7fffbfff5fffcfdfffffdffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffe72fffffdfffff9ffffffffffffffff
+fe8489e2cefdfffffffffffffff9fbfffffffdfdfdfdffffee9d4389ab97
+775678dcfffbfefffffcfffff7d07afeffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffff24fbfffff9fd
+ffffffffffffffffffcbb7ceb8fffff6fffcfcfdfffffffefbfbfcffffff
+fffdfbfff8fff8c1a8e6fffbfef8fffff9fcfffaffffff74fff1ffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffff7afb3f5fffbffffffffffffffffffffd594c7fef8fffffafffffffe
+fdfffffbfffffcf9fafefffffff3fffffffffff8fffffffff8fcfff8fdfc
+fff999e3ffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffb8dfffff4fffaffffffffffffffffb3eec9
+fffff3fbfffffdfffffafbfffffcfffffffffffffcfdfff8f9f9fefcfffb
+fbfdfffffffffafffeffffbed5ffefffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffff81f1f8fbffffffff
+fffffffffffffe8dc2cefafdfffffbf9fdfffffdfdfffcfffffefdffffff
+fbfff8fffffdfbfffbfffffdfaf6fffff9fffaff98e1fffeffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+f7ea86fffff8fffffffffffffffffffff5bdc2bc86c8fcfffffdfcfffffb
+fffffff9f1f2f9fdfcf5fffffff2e9f0d3effffafefffffffcfffef8fc4f
+e7f7ffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffefffdaef5f9fff6fffffffffffffffff4ffffddb5ff
+af77f3fffff5fffffbfffbfdfdfefffae6d0fffffdfbe8f6ecd88f3f0308
+0800235045343422c3ffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffdfff8bcbdfafffeffffffffff
+fffffffcfff7ffd2b5ef85bef6fff9fffff9fffffffefffff5d4b4faffec
+efc1a223041d00000c000569b7ffedcee2fffffdfeffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffdffffff
+51fbfffffffffffffffbfffffffcfffff6f8b6ff8ffcfefffcfffdffffff
+ffffffebe0fff173304560010048170e000005b9fbffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffff2fdfbf8a0fffffcf4fffff5fffff8fffffafff8fffbdc6e
+faf0fffdfddefffefdfdfdfffdffecd538be69301d14562681794370fffe
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffefffffff398b5fdfffffdfcfffff2ff
+fcfffcffffffffbbfff1eff7ece7cafff9fffff4fffffff3e6d6d894947d
+7552eff6bd5bf6f5fffbffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffff4fffbffff91
+eaf9fefffff6f8fffffafffff8fdfba8ebf2e0fffabdb7fefffffefaf2ff
+fafafffffffff8ddf9b2f5ffffa744d8fefdffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffcfffff5ff8ce5f2fffffffffefbfff7ffffffb6ffffd9f5e2ff
+92c6ffcaffd2ebfcfbfffffbfffafffec6ffb2fcfdffffa069fefffbffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffdfff8fffffffaffbac0fffff2fffefffdfff8
+fffff1efdffae9f0ff40f6d5ffd1daf7fffafffffbfcf9fdffefe0c2ffff
+f2eeff43f0f9ffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffbfffff9fcffeefffd62
+78fbfff5fffffffffbfffffadda8f3e9fffb50c8b2ff94fefffffffef7ff
+fcfffafffae5ffb7faffcef8aad3ffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffe
+fffefffafffffcffd374b7ffebfffffefdfff9ffffffffb6ffcaffdd36bb
+fc78fff6fffefafffffdfffdfffbfff8adfefed6ffadb2fffcffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffefbdcabd4e7f1eff9fcffffffff
+ffffffe1e2d9ffb996fdb9f1fcfffbf4fffcfefffffbfffffcaaeaffd1fb
+49c9f9ffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffcfff0e877
+f3fffffafdffffffffffffffddc7abffffbdbdf36dfcfafffffffffffaff
+f9fff7e896cecce3c724ffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffefceaffd8ffffd6fcfefffffffefefffafffff2cdfaf2b9f087
+bff9fffbf4fcfafffcfffdfb8dc2f6afe942cdfefff4ffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffdfff6f5ffe9fffefffffffffffefeff
+fbfffff9e6e5ebcfe78778eafbfffffff8fff7fa9579b8b19cb8e4fffbf7
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffbfffcf3fff6fff1
+fffffffffffffefef7fdfff9f5d4d2ffedcdc3c99fddfff4fcffecc44b84
+a39ab7fff7fff8fffff6ffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffefffdffdbffedfffffffffffffffffefffefff9b8ffb8fdfcbdbcf7d5
+c9fdfffdd59d40b6af70faffe4cceaccf0faffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffcfcfff7f8fffffffefefffffffff9f6ddc8
+feadf7fffffb99c4a8b6ffffb9be6fd5a18cf5f6e2c5fff8fdd1eefdffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffff9fffffbfffcfffffffe
+feffffffffffded2dbbbfdfffcffce9e86dad6f8dfbdb0c2b964aefae3b6
+fff7fffffcdfffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffbbf1cdfbfefff9f8c27ba3aff4ebbe
+aabef66914fefeb8c0bcebfffffdc9ffd1fefffefff8fbffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffecab0fffffffb
+fff0acaddbc3f9d9cec0c7ad2964ffe6405e359bcbacffb493e5fff8fffb
+f9fffdffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffeecb5fff7fbffffe5e8dca8c0f9d5cfcadb7f1dbaff7dbe57423187
+70954d815efdfffffffffbfbffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffefff3e1e9fbfff9ecfff9b919e8d8bec8b687
+0edeff5424430013090047b4bfaaf8fafffdfcffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffbfffff5f6fffeffe2fc
+ffff7e5499d3b1cea900d2ff6dfd8c537fb39075fffffffffaffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffe
+fffefffffdfffffebffff6f9ffbff78a49f216b1ffe8aa5725100900acff
+fef3fcfff9fffff8ffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffdfff6fff8fffafffbc9ecf9fdffe1ffa6bcb779cd
+f2d0aa663570b8fafff8fff9fcfff8faffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffafffffafffafffdfffffaff
+f5ffddecfff9d1a99ecdfefee0a4b8b7a0a3c1b7fffffffcfffdfbffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffff3cdd4fff6c2b1b1d8f3fffffcfffdf0ffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+fffffffffffffffffffffffffffffffffffffffffffef6eff6f9fdfff7f5
+fefffffffffffdffffffffffffffffffffffffffffffffffffffffffffff
+ffffffffffffffffffffffffffffffffffff
+grestore
+showpage
+%%Trailer
diff --git a/gcc/m2/images/gnupng b/gcc/m2/images/gnupng
new file mode 100755
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/gcc/m2/images/gnupng
diff --git a/gcc/m2/init/README b/gcc/m2/init/README
new file mode 100644
index 00000000000..6ff090bd13f
--- /dev/null
+++ b/gcc/m2/init/README
@@ -0,0 +1,3 @@
+This directory contains the module list for each tool.  The modules
+are ordered in to reflect the sequence of initialization and (in
+reverse their deconstruction).
\ No newline at end of file
diff --git a/gcc/m2/init/mcinit b/gcc/m2/init/mcinit
new file mode 100644
index 00000000000..24730397144
--- /dev/null
+++ b/gcc/m2/init/mcinit
@@ -0,0 +1,137 @@
+# mcinit list of Modula-2 modules used by mc.
+#
+# Copyright (C) 2000-2020 Free Software Foundation, Inc.
+#
+# This file is part of GCC.
+#
+# GCC 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.
+#
+# GCC 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+#
+Storage
+SYSTEM
+# M2Dependent
+M2RTS
+RTExceptions
+# SYSTEM    9 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/SYSTEM.mod
+# StrLib    8 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/StrLib.mod
+# ASCII    8 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/ASCII.mod
+# M2EXCEPTION    8 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/M2EXCEPTION.mod
+# Debug    8 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/Debug.mod
+# FIO    8 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/FIO.mod
+# SysExceptions    8 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/SysExceptions.def
+# errno    8 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/errno.def
+# termios    8 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/termios.def
+# UnixArgs    7 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/UnixArgs.def
+# SysStorage    7 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/SysStorage.mod
+# IO    7 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/IO.mod
+# RTExceptions    7 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/RTExceptions.mod
+# Assertion    7 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/Assertion.mod
+# mcflex    6 ../../gcc-5.2.0/gcc/gm2/mc/mcflex.def
+# Storage    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/Storage.mod
+# M2RTS    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/M2RTS.mod
+# DynamicStrings    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/DynamicStrings.mod
+# SArgs    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/SArgs.mod
+# StdIO    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/StdIO.mod
+# wlists    6 ../../gcc-5.2.0/gcc/gm2/mc/wlists.mod
+# libc    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/libc.def FOR 'C'
+# NumberIO    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/NumberIO.mod
+# libm    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/libm.def FOR 'C'
+# ldtoa    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/ldtoa.def
+# dtoa    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/dtoa.def
+# symbolKey    6 ../../gcc-5.2.0/gcc/gm2/mc/symbolKey.mod
+# FormatStrings    6 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/FormatStrings.mod
+# StrIO    5 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/StrIO.mod
+# StringConvert    5 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/StringConvert.mod
+# mcLexBuf    5 ../../gcc-5.2.0/gcc/gm2/mc/mcLexBuf.mod
+# mcOptions    5 ../../gcc-5.2.0/gcc/gm2/mc/mcOptions.mod
+# varargs    5 ../../gcc-5.2.0/gcc/gm2/mc/varargs.mod
+# decl    5 ../../gcc-5.2.0/gcc/gm2/mc/decl.mod
+# mcError    5 ../../gcc-5.2.0/gcc/gm2/mc/mcError.mod
+# SFIO    5 /opt/gm2/lib/gcc/x86_64-linux-gnu/4.7.4/m2/pim/SFIO.mod
+# nameKey    5 ../../gcc-5.2.0/gcc/gm2/mc/nameKey.mod
+# Indexing    5 ../../gcc-5.2.0/gcc/gm2/mc/Indexing.mod
+# mcMetaError    4 ../../gcc-5.2.0/gcc/gm2/mc/mcMetaError.mod
+# mcFileName    4 ../../gcc-5.2.0/gcc/gm2/mc/mcFileName.mod
+# alists    4 ../../gcc-5.2.0/gcc/gm2/mc/alists.mod
+# mcReserved    4 ../../gcc-5.2.0/gcc/gm2/mc/mcReserved.mod
+# mcPrintf    4 ../../gcc-5.2.0/gcc/gm2/mc/mcPrintf.mod
+# mcStack    4 ../../gcc-5.2.0/gcc/gm2/mc/mcStack.mod
+# mcDebug    4 ../../gcc-5.2.0/gcc/gm2/mc/mcDebug.mod
+# mcPreprocess    3 ../../gcc-5.2.0/gcc/gm2/mc/mcPreprocess.mod
+# mcQuiet    3 ../../gcc-5.2.0/gcc/gm2/mc/mcQuiet.mod
+# mcp1    3 gm2/gm2-auto/mcp1.mod
+# mcp2    3 gm2/gm2-auto/mcp2.mod
+# mcp3    3 gm2/gm2-auto/mcp3.mod
+# mcp4    3 gm2/gm2-auto/mcp4.mod
+# mcSearch    3 ../../gcc-5.2.0/gcc/gm2/mc/mcSearch.mod
+# mcComp    2 ../../gcc-5.2.0/gcc/gm2/mc/mcComp.mod
+# top    1 ../../gcc-5.2.0/gcc/gm2/mc/top.mod
+#
+# Initialization order
+#
+# RTco
+RTint
+StrLib
+ASCII
+M2EXCEPTION
+Debug
+FIO
+SysExceptions
+errno
+termios
+UnixArgs
+SysStorage
+IO
+Assertion
+mcflex
+DynamicStrings
+SArgs
+StdIO
+NumberIO
+StrIO
+StringConvert
+wlists
+alists
+Indexing
+ldtoa
+dtoa
+nameKey
+symbolKey
+FormatStrings
+mcLexBuf
+mcOptions
+varargs
+mcPretty
+decl
+mcError
+SFIO
+mcMetaError
+mcFileName
+mcReserved
+mcPrintf
+mcStack
+mcDebug
+mcPreprocess
+mcQuiet
+mcp1
+mcp2
+mcp3
+mcp4
+mcp5
+mcSearch
+mcComp
+keyc
+mcStream
+mcComment
+top
diff --git a/gcc/m2/init/ppginit b/gcc/m2/init/ppginit
new file mode 100644
index 00000000000..de70988ffe8
--- /dev/null
+++ b/gcc/m2/init/ppginit
@@ -0,0 +1,53 @@
+# ppginit list of Modula-2 modules used by ppg.
+#
+# Copyright (C) 2000-2020 Free Software Foundation, Inc.
+#
+# This file is part of GCC.
+#
+# GCC 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.
+#
+# GCC 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+#
+#
+# Initialization order
+#
+RTExceptions
+M2EXCEPTION
+M2RTS
+SysExceptions
+StrLib
+errno
+termios
+IO
+StdIO
+Debug
+SysStorage
+Storage
+StrIO
+DynamicStrings
+Assertion
+Indexing
+NameKey
+NumberIO
+PushBackInput
+SymbolKey
+UnixArgs
+FIO
+SFIO
+StrCase
+bnflex
+Lists
+Args
+Output
+ppg
+mod_init
diff --git a/gcc/m2/lang-specs.h b/gcc/m2/lang-specs.h
new file mode 100644
index 00000000000..706064fc8db
--- /dev/null
+++ b/gcc/m2/lang-specs.h
@@ -0,0 +1,38 @@
+/* Definitions for specs for GNU Modula-2.
+   Copyright (C) 2001-2022 Free Software Foundation, Inc.
+   Contributed by Gaius Mulley.
+
+This file is part of GCC.
+
+GCC 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.
+
+GCC 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 GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* This is the contribution to the `default_compilers' array in gcc.c for
+   GNU Modula-2.  */
+
+/* Pass the preprocessor options on the command line together with
+   the exec prefix.  */
+
+#define M2CPP "%{fcpp:-fcpp-begin " \
+              "      -E -lang-asm -traditional-cpp " \
+              "      %(cpp_unique_options) -fcpp-end}"
+
+  {".mod", "@modula-2", 0, 0, 0},
+  {"@modula-2",
+      "cc1gm2 " M2CPP
+      "      %(cc1_options) %{B*} %{c*} %{f*} %{+e*} %{I*} "
+      "      %{MD} %{MMD} %{M} %{MM} %{MA} %{MT*} %{MF*} %V"
+      "      %{save-temps*}"
+      "      %i %{!fsyntax-only:%(invoke_as)}",
+      0, 0, 0},
diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt
new file mode 100644
index 00000000000..83a5ce7eb30
--- /dev/null
+++ b/gcc/m2/lang.opt
@@ -0,0 +1,352 @@
+; Options for the Modula-2 front end.
+;
+; Copyright (C) 2016-2022 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/>.  *)
+
+; See the GCC internals manual for a description of this file's format.
+
+; Please try to keep this file in ASCII collating order.
+
+Language
+Modula-2
+
+B
+Modula-2
+; Documented in c.opt
+
+D
+Modula-2
+; Documented in c.opt
+
+E
+Modula-2
+; Documented in c.opt (passed to the preprocessor if -fcpp is used)
+
+I
+Modula-2 Joined Separate
+; Documented in c.opt
+
+L
+Modula-2 Joined Separate
+; Not documented
+
+M
+Modula-2
+; Documented in c.opt
+
+O
+Modula-2
+; Documented in c.opt
+
+Wall
+Modula-2
+; Documented in c.opt
+
+Wpedantic
+Modula-2
+; Documented in common.opt
+
+Wpedantic-param-names
+Modula-2
+compiler checks to force definition module procedure parameter names with their implementation module counterpart
+
+Wpedantic-cast
+Modula-2
+compiler warns if a cast is being used on types of differing sizes
+
+Wverbose-unbounded
+Modula-2
+inform user which parameters will be passed by reference
+
+Wstyle
+Modula-2
+extra compile time semantic checking, typically tries to catch poor programming style
+
+Wunused-variable
+Modula-2
+; Documented in c.opt
+
+Wunused-parameter
+Modula-2
+; Documented in c.opt
+
+c
+Modula-2
+; Documented in c.opt
+
+fauto-init
+Modula-2
+automatically initializes all pointers to NIL
+
+fbounds
+Modula-2
+turns on runtime subrange, array index and indirection via NIL pointer checking
+
+fcase
+Modula-2
+turns on runtime checking to check whether a CASE statement requires an ELSE clause when on was not specified
+
+fobjc-std=objc1
+Modula-2
+; Documented in c.opt
+
+fcpp
+Modula-2
+use cpp to preprocess the module
+
+fcpp-end
+Modula-2
+passed to the preprocessor if -fcpp is used (internal switch)
+
+fcpp-begin
+Modula-2
+passed to the preprocessor if -fcpp is used (internal switch)
+
+fdebug-builtins
+Modula-2
+call a real function, rather than the builtin equivalent
+
+fd
+Modula-2
+turn on internal debugging of the compiler (internal switch)
+
+fdebug-trace-quad
+Modula-2
+turn on quadruple tracing (internal switch)
+
+fdebug-trace-api
+Modula-2
+turn on the Modula-2 api tracing (internal switch)
+
+fdebug-function-line-numbers
+Modula-2
+turn on the Modula-2 function line number generation (internal switch)
+
+fdef=
+Modula-2 Joined
+recognise the specified suffix as a definition module filename
+
+fdump-system-exports
+Modula-2
+display all inbuilt system items
+
+fexceptions
+Modula-2
+; Documented in common.opt
+
+fextended-opaque
+Modula-2
+allows opaque types to be implemented as any type (a GNU Modula-2 extension)
+
+ffloatvalue
+Modula-2
+turns on runtime checking to check whether a floating point number is about to exceed range
+
+fgen-module-list=
+Modula-2 Joined
+create a topologically sorted module list from all dependent modules used in the application
+
+findex
+Modula-2
+turns on all range checking for numerical values
+
+fiso
+Modula-2
+use ISO dialect of Modula-2
+
+flibs=
+Modula-2 Joined
+specify the library order, currently legal entries include: log, min, pim, iso or their directory name equivalent m2log, m2min, m2pim, m2iso.
+
+flocation=
+Modula-2 Joined
+set all location values to a specific value (internal switch)
+
+fm2-g
+Modula-2
+generate extra nops to improve debugging, producing an instruction for every code related keyword
+
+fm2-lower-case
+Modula-2
+generate error messages which render keywords in lower case
+
+fm2-plugin
+Modula-2
+insert plugin to identify runtime errors at compiletime (default on)
+
+fm2-statistics
+Modula-2
+display statistics about the amount of source lines compiled and symbols used
+
+fm2-strict-type
+Modula-2
+experimental flag to turn on the new strict type checker
+
+fm2-whole-program
+Modula-2
+compile all implementation modules and program module at once
+
+fmod=
+Modula-2 Joined
+recognise the specified suffix as implementation and module filenames
+
+fnil
+Modula-2
+turns on runtime checking to detect accessing data through a NIL value pointer
+
+fpim
+Modula-2
+use PIM [234] dialect of Modula-2
+
+fpim2
+Modula-2
+use PIM 2 dialect of Modula-2
+
+fpim3
+Modula-2
+use PIM 3 dialect of Modula-2
+
+fpim4
+Modula-2
+use PIM 4 dialect of Modula-2
+
+fpositive-mod-floor-div
+Modula-2
+force positive result from MOD and DIV result floor
+
+fpthread
+Modula-2
+link against the pthread library (default on)
+
+fq
+Modula-2
+internal compiler debugging information, dump the list of quadruples
+
+frange
+Modula-2
+turns on all range checking for numerical values
+
+freturn
+Modula-2
+turns on runtime checking for functions which finish without executing a RETURN statement
+
+fruntime-modules=
+Modula-2 Joined
+specify the list of runtime modules and their initialization order
+
+fscaffold-dynamic
+Modula-2
+the modules initialization order is dynamically determined by M2RTS and application dependancies
+
+fscaffold-c
+Modula-2
+generate a C source scaffold for the current module being compiled
+
+fscaffold-c++
+Modula-2
+generate a C++ source scaffold for the current module being compiled
+
+fscaffold-main
+Modula-2
+generate the main function
+
+fscaffold-static
+Modula-2
+generate static scaffold initialization and finalization for every module inside main
+
+fshared
+Modula-2
+generate a shared library from the module
+
+fsoft-check-all
+Modula-2
+turns on all software runtime checking (an abbreviation for -fnil -frange -findex -fwholediv -fcase -freturn -fwholevalue -ffloatvalue)
+
+fsources
+Modula-2
+display the location of module source files as they are compiled
+
+fswig
+Modula-2
+create a swig interface file for the module
+
+funbounded-by-reference
+Modula-2
+optimize non var unbounded parameters by passing it by reference, providing it is not written to within the callee procedure.
+
+fuse-list=
+Modula-2 Joined
+orders the initialization/finalializations for scaffold-static or force linking of modules if scaffold-dynamic
+
+fversion
+Modula-2
+; Documented in common.opt
+
+fwholediv
+Modula-2
+turns on all division and modulus by zero checking for ordinal values
+
+fwholevalue
+Modula-2
+turns on runtime checking to check whether a whole number is about to exceed range
+
+iprefix
+Modula-2
+; Documented in c.opt
+
+isystem
+Modula-2
+; Documented in c.opt
+
+idirafter
+Modula-2
+; Documented in c.opt
+
+imultilib
+Modula-2
+; Documented in c.opt
+
+lang-asm
+Modula-2
+; Documented in c.opt
+
+-save-temps
+Modula-2 Alias(save-temps)
+
+save-temps
+Modula-2
+save temporary preprocessed files
+
+save-temps=
+Modula-2 Joined
+save temporary preprocessed files
+
+traditional-cpp
+Modula-2
+; Documented in c.opt
+
+v
+Modula-2
+; Documented in c.opt
+
+x
+Modula-2 Joined
+specify the language from the compiler driver
+
+; This comment is to ensure we retain the blank line above.
diff --git a/gcc/m2/m2-tree.def b/gcc/m2/m2-tree.def
new file mode 100644
index 00000000000..f7681a13b8e
--- /dev/null
+++ b/gcc/m2/m2-tree.def
@@ -0,0 +1,24 @@
+/* gm2-tree.def a component of a C header file used to define a SET type.
+
+Copyright (C) 2006-2022 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 COPYING.  If not, write to the
+Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
+
+/* A SET_TYPE type.  */
+DEFTREECODE (SET_TYPE, "set_type", tcc_type, 0)
diff --git a/gcc/m2/m2-tree.h b/gcc/m2/m2-tree.h
new file mode 100644
index 00000000000..ce8e261838c
--- /dev/null
+++ b/gcc/m2/m2-tree.h
@@ -0,0 +1,48 @@
+/* m2-tree.h create language specific tree nodes for Modula-2.
+
+Copyright (C) 2001-2022 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/>.  */
+
+#ifndef GCC_GM2_TREE_H
+#define GCC_GM2_TREE_H
+
+#include "ggc.h"
+#include "function.h"
+#include "hashtab.h"
+#include "vec.h"
+
+/* These macros provide convenient access to the various statement nodes.  */
+
+#define TRY_STMTS(NODE)		TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 0)
+#define TRY_HANDLERS(NODE)	TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 1)
+
+/* Nonzero if this try block is a function try block.  */
+#define FN_TRY_BLOCK_P(NODE)	TREE_LANG_FLAG_3 (TRY_BLOCK_CHECK (NODE))
+#define HANDLER_PARMS(NODE)	TREE_OPERAND (HANDLER_CHECK (NODE), 0)
+#define HANDLER_BODY(NODE)	TREE_OPERAND (HANDLER_CHECK (NODE), 1)
+#define HANDLER_TYPE(NODE)	TREE_TYPE (HANDLER_CHECK (NODE))
+
+/* STMT_EXPR accessor.  */
+#define STMT_EXPR_STMT(NODE)	TREE_OPERAND (STMT_EXPR_CHECK (NODE), 0)
+
+/* EXPR_STMT accessor.  This gives the expression associated with an
+   expression statement.  */
+#define EXPR_STMT_EXPR(NODE)	TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0)
+
+#endif
diff --git a/gcc/m2/m2.flex b/gcc/m2/m2.flex
new file mode 100644
index 00000000000..14e90f03fee
--- /dev/null
+++ b/gcc/m2/m2.flex
@@ -0,0 +1,760 @@
+%{
+/* m2.flex implements lexical analysis for Modula-2.
+
+Copyright (C) 2004-2022 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 "gm2-gcc/gcc-consolidation.h"
+
+#include "GM2Reserved.h"
+#include "GM2LexBuf.h"
+#include "input.h"
+#include "m2options.h"
+
+
+#if defined(GM2USEGGC)
+#  include "ggc.h"
+#endif
+
+#include "timevar.h"
+
+#define START_FILE(F,L)   m2linemap_StartFile(F,L)
+#define END_FILE()        m2linemap_EndFile()
+#define START_LINE(N,S)   m2linemap_StartLine(N,S)
+#define GET_LOCATION(COLUMN_START,COLUMN_END) \
+        m2linemap_GetLocationRange(COLUMN_START,COLUMN_END)
+#define TIMEVAR_PUSH_LEX  timevar_push (TV_LEX)
+#define TIMEVAR_POP_LEX   timevar_pop (TV_LEX)
+
+#ifdef __cplusplus
+#define EXTERN extern "C"
+#endif
+
+  /* m2.flex provides a lexical analyser for GNU Modula-2.  */
+
+  struct lineInfo {
+    char            *linebuf;          /* line contents */
+    int              linelen;          /* length */
+    int              tokenpos;         /* start position of token within line */
+    int              toklen;           /* a copy of yylen (length of token) */
+    int              nextpos;          /* position after token */
+    int              lineno;           /* line number of this line */
+    int              column;           /* first column number of token on this line */
+    int              inuse;            /* do we need to keep this line info? */
+    location_t       location;         /* the corresponding gcc location_t */
+    struct lineInfo *next;
+  };
+
+  struct functionInfo {
+    char                *name;         /* function name */
+    int                  module;       /* is it really a module? */
+    struct functionInfo *next;         /* list of nested functions */
+  };
+
+  static int                  lineno      =1;   /* a running count of the file line number */
+  static char                *filename    =NULL;
+  static int                  commentLevel=0;
+  static struct lineInfo     *currentLine=NULL;
+  static struct functionInfo *currentFunction=NULL;
+  static int                  seenFunctionStart=FALSE;
+  static int                  seenEnd=FALSE;
+  static int                  seenModuleStart=FALSE;
+  static int                  isDefinitionModule=FALSE;
+  static int                  totalLines=0;
+
+static  void pushLine                 (void);
+static  void popLine                  (void);
+static  void finishedLine             (void);
+static  void resetpos                 (void);
+static  void consumeLine              (void);
+static  void updatepos                (void);
+static  void skippos                  (void);
+static  void poperrorskip             (const char *);
+static  void endOfComment             (void);
+static  void handleDate               (void);
+static  void handleLine               (void);
+static  void handleFile               (void);
+static  void handleFunction           (void);
+static  void handleColumn             (void);
+static  void pushFunction             (char *function, int module);
+static  void popFunction              (void);
+static  void checkFunction            (void);
+EXTERN  void m2flex_M2Error           (const char *);
+EXTERN  location_t m2flex_GetLocation (void);
+EXTERN  int  m2flex_GetColumnNo       (void);
+EXTERN  int  m2flex_OpenSource        (char *s);
+EXTERN  int  m2flex_GetLineNo         (void);
+EXTERN  void m2flex_CloseSource       (void);
+EXTERN  char *m2flex_GetToken         (void);
+EXTERN  void _M2_m2flex_init          (void);
+EXTERN  int  m2flex_GetTotalLines     (void);
+extern  void  yylex                   (void);
+
+#if !defined(TRUE)
+#    define TRUE  (1==1)
+#endif
+#if !defined(FALSE)
+#    define FALSE (1==0)
+#endif
+
+#define YY_DECL void yylex (void)
+%}
+
+%option nounput
+%x COMMENT COMMENT1 LINE0 LINE1 LINE2
+
+%%
+
+"(*"                       { updatepos();
+                             commentLevel=1; pushLine(); skippos();
+			     BEGIN COMMENT; }
+<COMMENT>"*)"              { endOfComment(); }
+<COMMENT>"(*"              { commentLevel++; pushLine(); updatepos(); skippos(); }
+<COMMENT>"<*"              { if (commentLevel == 1) {
+                               updatepos();
+                               pushLine();
+                               skippos();
+                               BEGIN COMMENT1;
+                             } else
+                               updatepos(); skippos();
+                           }
+<COMMENT>\n.*              { consumeLine(); }
+<COMMENT>.                 { updatepos(); skippos(); }
+<COMMENT1>.                { updatepos(); skippos(); }
+<COMMENT1>"*>"             { updatepos(); skippos(); finishedLine(); BEGIN COMMENT; }
+<COMMENT1>\n.*             { consumeLine(); }
+<COMMENT1>"*)"             { poperrorskip("unterminated source code directive, missing *>");
+                             endOfComment(); }
+<COMMENT1><<EOF>>          { poperrorskip("unterminated source code directive, missing *>"); BEGIN COMMENT; }
+<COMMENT><<EOF>>           { poperrorskip("unterminated comment found at the end of the file, missing *)"); BEGIN INITIAL; }
+
+^\#.*                      { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
+\n\#.*                     { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
+<LINE0>\#[ \t]*            { updatepos(); }
+<LINE0>[0-9]+[ \t]*\"      { updatepos(); lineno=atoi(yytext)-1; BEGIN LINE1; }
+<LINE0>\n                  { m2flex_M2Error("missing initial quote after #line directive"); resetpos(); BEGIN INITIAL; }
+<LINE0>[^\n]
+<LINE1>[^\"\n]+            { m2flex_M2Error("missing final quote after #line directive"); resetpos(); BEGIN INITIAL; }
+<LINE1>.*\"                { updatepos();
+                             filename = (char *)xrealloc(filename, yyleng+1);
+			     strcpy(filename, yytext);
+                             filename[yyleng-1] = (char)0;  /* remove trailing quote */
+                             START_FILE (filename, lineno);
+                             BEGIN LINE2;
+                           }
+<LINE2>[ \t]*              { updatepos(); }
+<LINE2>\n                  { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>2[ \t]*\n           { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>1[ \t]*\n           { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>1[ \t]*.*\n         { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>2[ \t]*.*\n         { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>3[ \t]*.*\n         { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+
+\n[^\#].*                  { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+\n                         { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+
+\"[^\"\n]*\"               { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; }
+\"[^\"\n]*$                { updatepos();
+                             m2flex_M2Error("missing terminating quote, \"");
+                             resetpos(); return;
+                           }
+
+'[^'\n]*'                  { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; }
+'[^'\n]*$                  { updatepos();
+                             m2flex_M2Error("missing terminating quote, '");
+                             resetpos(); return;
+                           }
+
+<<EOF>>                    { updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return; }
+\+                         { updatepos(); M2LexBuf_AddTok(M2Reserved_plustok); return; }
+-                          { updatepos(); M2LexBuf_AddTok(M2Reserved_minustok); return; }
+"*"                        { updatepos(); M2LexBuf_AddTok(M2Reserved_timestok); return; }
+\/                         { updatepos(); M2LexBuf_AddTok(M2Reserved_dividetok); return; }
+:=                         { updatepos(); M2LexBuf_AddTok(M2Reserved_becomestok); return; }
+\&                         { updatepos(); M2LexBuf_AddTok(M2Reserved_ambersandtok); return; }
+\.                         { updatepos(); M2LexBuf_AddTok(M2Reserved_periodtok); return; }
+\,                         { updatepos(); M2LexBuf_AddTok(M2Reserved_commatok); return; }
+\;                         { updatepos(); M2LexBuf_AddTok(M2Reserved_semicolontok); return; }
+\(                         { updatepos(); M2LexBuf_AddTok(M2Reserved_lparatok); return; }
+\)                         { updatepos(); M2LexBuf_AddTok(M2Reserved_rparatok); return; }
+\[                         { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; }
+\]                         { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; }
+\(\!                       { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; }
+\!\)                       { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; }
+\^                         { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; }
+\@                         { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; }
+\{                         { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; }
+\}                         { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; }
+\(\:                       { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; }
+\:\)                       { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; }
+\'                         { updatepos(); M2LexBuf_AddTok(M2Reserved_singlequotetok); return; }
+\=                         { updatepos(); M2LexBuf_AddTok(M2Reserved_equaltok); return; }
+\#                         { updatepos(); M2LexBuf_AddTok(M2Reserved_hashtok); return; }
+\<                         { updatepos(); M2LexBuf_AddTok(M2Reserved_lesstok); return; }
+\>                         { updatepos(); M2LexBuf_AddTok(M2Reserved_greatertok); return; }
+\<\>                       { updatepos(); M2LexBuf_AddTok(M2Reserved_lessgreatertok); return; }
+\<\=                       { updatepos(); M2LexBuf_AddTok(M2Reserved_lessequaltok); return; }
+\>\=                       { updatepos(); M2LexBuf_AddTok(M2Reserved_greaterequaltok); return; }
+"<*"                       { updatepos(); M2LexBuf_AddTok(M2Reserved_ldirectivetok); return; }
+"*>"                       { updatepos(); M2LexBuf_AddTok(M2Reserved_rdirectivetok); return; }
+\.\.                       { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodtok); return; }
+\.\.\.                     { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodperiodtok); return; }
+\:                         { updatepos(); M2LexBuf_AddTok(M2Reserved_colontok); return; }
+\"                         { updatepos(); M2LexBuf_AddTok(M2Reserved_doublequotestok); return; }
+\|                         { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; }
+\!                         { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; }
+\~                         { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; }
+AND                        { updatepos(); M2LexBuf_AddTok(M2Reserved_andtok); return; }
+ARRAY                      { updatepos(); M2LexBuf_AddTok(M2Reserved_arraytok); return; }
+BEGIN                      { updatepos(); M2LexBuf_AddTok(M2Reserved_begintok); return; }
+BY                         { updatepos(); M2LexBuf_AddTok(M2Reserved_bytok); return; }
+CASE                       { updatepos(); M2LexBuf_AddTok(M2Reserved_casetok); return; }
+CONST                      { updatepos(); M2LexBuf_AddTok(M2Reserved_consttok); return; }
+DEFINITION                 { updatepos(); isDefinitionModule = TRUE;
+                             M2LexBuf_AddTok(M2Reserved_definitiontok); return; }
+DIV                        { updatepos(); M2LexBuf_AddTok(M2Reserved_divtok); return; }
+DO                         { updatepos(); M2LexBuf_AddTok(M2Reserved_dotok); return; }
+ELSE                       { updatepos(); M2LexBuf_AddTok(M2Reserved_elsetok); return; }
+ELSIF                      { updatepos(); M2LexBuf_AddTok(M2Reserved_elsiftok); return; }
+END                        { updatepos(); seenEnd=TRUE;
+                             M2LexBuf_AddTok(M2Reserved_endtok); return; }
+EXCEPT                     { updatepos(); M2LexBuf_AddTok(M2Reserved_excepttok); return; }
+EXIT                       { updatepos(); M2LexBuf_AddTok(M2Reserved_exittok); return; }
+EXPORT                     { updatepos(); M2LexBuf_AddTok(M2Reserved_exporttok); return; }
+FINALLY                    { updatepos(); M2LexBuf_AddTok(M2Reserved_finallytok); return; }
+FOR                        { updatepos(); M2LexBuf_AddTok(M2Reserved_fortok); return; }
+FROM                       { updatepos(); M2LexBuf_AddTok(M2Reserved_fromtok); return; }
+IF                         { updatepos(); M2LexBuf_AddTok(M2Reserved_iftok); return; }
+IMPLEMENTATION             { updatepos(); M2LexBuf_AddTok(M2Reserved_implementationtok); return; }
+IMPORT                     { updatepos(); M2LexBuf_AddTok(M2Reserved_importtok); return; }
+IN                         { updatepos(); M2LexBuf_AddTok(M2Reserved_intok); return; }
+LOOP                       { updatepos(); M2LexBuf_AddTok(M2Reserved_looptok); return; }
+MOD                        { updatepos(); M2LexBuf_AddTok(M2Reserved_modtok); return; }
+MODULE                     { updatepos(); seenModuleStart=TRUE;
+                             M2LexBuf_AddTok(M2Reserved_moduletok); return; }
+NOT                        { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; }
+OF                         { updatepos(); M2LexBuf_AddTok(M2Reserved_oftok); return; }
+OR                         { updatepos(); M2LexBuf_AddTok(M2Reserved_ortok); return; }
+PACKEDSET                  { updatepos(); M2LexBuf_AddTok(M2Reserved_packedsettok); return; }
+POINTER                    { updatepos(); M2LexBuf_AddTok(M2Reserved_pointertok); return; }
+PROCEDURE                  { updatepos(); seenFunctionStart=TRUE;
+                             M2LexBuf_AddTok(M2Reserved_proceduretok); return; }
+QUALIFIED                  { updatepos(); M2LexBuf_AddTok(M2Reserved_qualifiedtok); return; }
+UNQUALIFIED                { updatepos(); M2LexBuf_AddTok(M2Reserved_unqualifiedtok); return; }
+RECORD                     { updatepos(); M2LexBuf_AddTok(M2Reserved_recordtok); return; }
+REM                        { updatepos(); M2LexBuf_AddTok(M2Reserved_remtok); return; }
+REPEAT                     { updatepos(); M2LexBuf_AddTok(M2Reserved_repeattok); return; }
+RETRY                      { updatepos(); M2LexBuf_AddTok(M2Reserved_retrytok); return; }
+RETURN                     { updatepos(); M2LexBuf_AddTok(M2Reserved_returntok); return; }
+SET                        { updatepos(); M2LexBuf_AddTok(M2Reserved_settok); return; }
+THEN                       { updatepos(); M2LexBuf_AddTok(M2Reserved_thentok); return; }
+TO                         { updatepos(); M2LexBuf_AddTok(M2Reserved_totok); return; }
+TYPE                       { updatepos(); M2LexBuf_AddTok(M2Reserved_typetok); return; }
+UNTIL                      { updatepos(); M2LexBuf_AddTok(M2Reserved_untiltok); return; }
+VAR                        { updatepos(); M2LexBuf_AddTok(M2Reserved_vartok); return; }
+WHILE                      { updatepos(); M2LexBuf_AddTok(M2Reserved_whiletok); return; }
+WITH                       { updatepos(); M2LexBuf_AddTok(M2Reserved_withtok); return; }
+ASM                        { updatepos(); M2LexBuf_AddTok(M2Reserved_asmtok); return; }
+VOLATILE                   { updatepos(); M2LexBuf_AddTok(M2Reserved_volatiletok); return; }
+\_\_DATE\_\_               { updatepos(); handleDate(); return; }
+\_\_LINE\_\_               { updatepos(); handleLine(); return; }
+\_\_FILE\_\_               { updatepos(); handleFile(); return; }
+\_\_FUNCTION\_\_           { updatepos(); handleFunction(); return; }
+\_\_COLUMN\_\_             { updatepos(); handleColumn(); return; }
+\_\_ATTRIBUTE\_\_          { updatepos(); M2LexBuf_AddTok(M2Reserved_attributetok); return; }
+\_\_BUILTIN\_\_            { updatepos(); M2LexBuf_AddTok(M2Reserved_builtintok); return; }
+\_\_INLINE\_\_             { updatepos(); M2LexBuf_AddTok(M2Reserved_inlinetok); return; }
+
+
+(([0-9]*\.[0-9]+)(E[+-]?[0-9]+)?) { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
+[0-9]*\.E[+-]?[0-9]+       { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
+[a-zA-Z_][a-zA-Z0-9_]*     { checkFunction(); updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_identtok, yytext); return; }
+[0-9]+                     { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9]+B                    { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9]+C                    { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9A-F]+H                 { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[\t\r ]+                   { currentLine->tokenpos += yyleng;  /* Ignore space.  */; }
+.                          { updatepos(); m2flex_M2Error("unrecognised symbol"); skippos(); }
+
+%%
+
+/* have removed the -? from the beginning of the real/integer constant literal rules */
+
+/*
+ *  hand built routines
+ */
+
+/*
+ *  handleFile - handles the __FILE__ construct by wraping it in double quotes and putting
+ *               it into the token buffer as a string.
+ */
+
+static void handleFile (void)
+{
+  char *s = (char *)alloca(strlen(filename)+2+1);
+
+  strcpy(s, "\"");
+  strcat(s, filename);
+  strcat(s, "\"");
+  M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+}
+
+/*
+ *  handleLine - handles the __LINE__ construct by passing an integer to
+ *               the token buffer.
+ */
+
+static void handleLine (void)
+{
+  M2LexBuf_AddTokInteger(M2Reserved_integertok, lineno);
+}
+
+/*
+ *  handleColumn - handles the __COLUMN__ construct by passing an integer to
+ *                 the token buffer.
+ */
+
+static void handleColumn (void)
+{
+  M2LexBuf_AddTokInteger(M2Reserved_integertok, m2flex_GetColumnNo());
+}
+
+/*
+ *  handleDate - handles the __DATE__ construct by passing the date
+ *               as a string to the token buffer.
+ */
+
+static void handleDate (void)
+{
+  time_t  clock = time ((time_t *)0);
+  char   *sdate = ctime (&clock);
+  char   *s     = (char *) alloca (strlen (sdate) + 2 + 1);
+  char   *p     = index (sdate, '\n');
+
+  if (p != NULL) {
+    *p = (char) 0;
+  }
+  strcpy(s, "\"");
+  strcat(s, sdate);
+  strcat(s, "\"");
+  M2LexBuf_AddTokCharStar (M2Reserved_stringtok, s);
+}
+
+/*
+ *  handleFunction - handles the __FUNCTION__ construct by wrapping
+ *                   it in double quotes and putting it into the token
+ *                   buffer as a string.
+ */
+
+static void handleFunction (void)
+{
+  if (currentFunction == NULL)
+    M2LexBuf_AddTokCharStar(M2Reserved_stringtok, const_cast<char *>("\"\""));
+  else if (currentFunction->module) {
+    char *s = (char *) alloca(strlen(yytext) +
+			      strlen("\"module  initialization\"") + 1);
+    strcpy(s, "\"module ");
+    strcat(s, currentFunction->name);
+    strcat(s, " initialization\"");
+    M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+  } else {
+    char *function = currentFunction->name;
+    char *s = (char *)alloca(strlen(function)+2+1);
+    strcpy(s, "\"");
+    strcat(s, function);
+    strcat(s, "\"");
+    M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+  }
+}
+
+/*
+ *  pushFunction - pushes the function name onto the stack.
+ */
+
+static void pushFunction (char *function, int module)
+{
+  if (currentFunction == NULL) {
+    currentFunction = (struct functionInfo *)xmalloc (sizeof (struct functionInfo));
+    currentFunction->name = xstrdup(function);
+    currentFunction->next = NULL;
+    currentFunction->module = module;
+  } else {
+    struct functionInfo *f = (struct functionInfo *)xmalloc (sizeof (struct functionInfo));
+    f->name = xstrdup(function);
+    f->next = currentFunction;
+    f->module = module;
+    currentFunction = f;
+  }
+}
+
+/*
+ *  popFunction - pops the current function.
+ */
+
+static void popFunction (void)
+{
+  if (currentFunction != NULL && currentFunction->next != NULL) {
+    struct functionInfo *f = currentFunction;
+
+    currentFunction = currentFunction->next;
+    if (f->name != NULL)
+      free(f->name);
+    free(f);
+  }
+}
+
+/*
+ *  endOfComment - handles the end of comment
+ */
+
+static void endOfComment (void)
+{
+  commentLevel--;
+  updatepos();
+  skippos();
+  if (commentLevel==0) {
+    BEGIN INITIAL;
+    finishedLine();
+  } else
+    popLine();
+}
+
+/*
+ *  m2flex_M2Error - displays the error message, s, after the code line and pointer
+ *                   to the erroneous token.
+ */
+
+EXTERN void m2flex_M2Error (const char *s)
+{
+  if (currentLine->linebuf != NULL) {
+    int i=1;
+
+    printf("%s:%d:%s\n", filename, currentLine->lineno, currentLine->linebuf);
+    printf("%s:%d:%*s", filename, currentLine->lineno, 1+currentLine->tokenpos, "^");
+    while (i<currentLine->toklen) {
+      putchar('^');
+      i++;
+    }
+    putchar('\n');
+  }
+  printf("%s:%d:%s\n", filename, currentLine->lineno, s);
+}
+
+static void poperrorskip (const char *s)
+{
+  int nextpos =currentLine->nextpos;
+  int tokenpos=currentLine->tokenpos;
+
+  popLine();
+  m2flex_M2Error(s);
+  if (currentLine != NULL) {
+    currentLine->nextpos  = nextpos;
+    currentLine->tokenpos = tokenpos;
+  }
+}
+
+/*
+ *  consumeLine - reads a line into a buffer, it then pushes back the whole
+ *                line except the initial \n.
+ */
+
+static void consumeLine (void)
+{
+  if (currentLine->linelen<yyleng) {
+    currentLine->linebuf = (char *)xrealloc (currentLine->linebuf, yyleng);
+    currentLine->linelen = yyleng;
+  }
+  strcpy(currentLine->linebuf, yytext+1);  /* copy all except the initial \n */
+  lineno++;
+  totalLines++;
+  currentLine->lineno = lineno;
+  currentLine->tokenpos=0;
+  currentLine->nextpos=0;
+  currentLine->column=0;
+  START_LINE (lineno, yyleng);
+  yyless(1);                  /* push back all but the \n */
+}
+
+static void assert_location (location_t location ATTRIBUTE_UNUSED)
+{
+#if 0
+  if ((location != BUILTINS_LOCATION) && (location != UNKNOWN_LOCATION) && (! M2Options_GetCpp ())) {
+     expanded_location xl = expand_location (location);
+     if (xl.line != currentLine->lineno) {
+       m2flex_M2Error ("mismatched gcc location and front end token number");
+     }
+  }
+#endif
+}
+
+/*
+ *  updatepos - updates the current token position.
+ *              Should be used when a rule matches a token.
+ */
+
+static void updatepos (void)
+{
+  seenFunctionStart    = FALSE;
+  seenEnd              = FALSE;
+  seenModuleStart      = FALSE;
+  currentLine->nextpos = currentLine->tokenpos+yyleng;
+  currentLine->toklen  = yyleng;
+  /* if (currentLine->column == 0) */
+  currentLine->column = currentLine->tokenpos+1;
+  currentLine->location =
+    M2Options_OverrideLocation (GET_LOCATION (currentLine->column,
+                                              currentLine->column+currentLine->toklen-1));
+  assert_location (GET_LOCATION (currentLine->column,
+                                 currentLine->column+currentLine->toklen-1));
+}
+
+/*
+ *  checkFunction - checks to see whether we have seen the start
+ *                  or end of a function.
+ */
+
+static void checkFunction (void)
+{
+  if (! isDefinitionModule) {
+    if (seenModuleStart)
+      pushFunction(yytext, 1);
+    if (seenFunctionStart)
+      pushFunction(yytext, 0);
+    if (seenEnd && currentFunction != NULL &&
+	(strcmp(currentFunction->name, yytext) == 0))
+      popFunction();
+  }
+  seenFunctionStart = FALSE;
+  seenEnd           = FALSE;
+  seenModuleStart   = FALSE;
+}
+
+/*
+ *  skippos - skips over this token. This function should be called
+ *            if we are not returning and thus not calling getToken.
+ */
+
+static void skippos (void)
+{
+  currentLine->tokenpos = currentLine->nextpos;
+}
+
+/*
+ *  initLine - initializes a currentLine
+ */
+
+static void initLine (void)
+{
+  currentLine = (struct lineInfo *)xmalloc (sizeof(struct lineInfo));
+
+  if (currentLine == NULL)
+    perror("xmalloc");
+  currentLine->linebuf    = NULL;
+  currentLine->linelen    = 0;
+  currentLine->tokenpos   = 0;
+  currentLine->toklen     = 0;
+  currentLine->nextpos    = 0;
+  currentLine->lineno = lineno;
+  currentLine->column     = 0;
+  currentLine->inuse      = TRUE;
+  currentLine->next       = NULL;
+}
+
+/*
+ *  pushLine - pushes a new line structure.
+ */
+
+static void pushLine (void)
+{
+  if (currentLine == NULL)
+    initLine();
+  else if (currentLine->inuse) {
+      struct lineInfo *l = (struct lineInfo *)xmalloc (sizeof(struct lineInfo));
+
+      if (currentLine->linebuf == NULL) {
+	l->linebuf  = NULL;
+	l->linelen  = 0;
+      } else {
+	l->linebuf    = (char *)xstrdup (currentLine->linebuf);
+	l->linelen    = strlen (l->linebuf)+1;
+      }
+      l->tokenpos   = currentLine->tokenpos;
+      l->toklen     = currentLine->toklen;
+      l->nextpos    = currentLine->nextpos;
+      l->lineno = currentLine->lineno;
+      l->column     = currentLine->column;
+      l->next       = currentLine;
+      currentLine   = l;
+  }
+  currentLine->inuse = TRUE;
+}
+
+/*
+ *  popLine - pops a line structure.
+ */
+
+static void popLine (void)
+{
+  if (currentLine != NULL) {
+    struct lineInfo *l = currentLine;
+
+    if (currentLine->linebuf != NULL)
+      free(currentLine->linebuf);
+    currentLine = l->next;
+    free(l);
+  }
+}
+
+/*
+ *  resetpos - resets the position of the next token to the start of the line.
+ */
+
+static void resetpos (void)
+{
+  if (currentLine != NULL)
+    currentLine->nextpos = 0;
+}
+
+/*
+ *  finishedLine - indicates that the current line does not need to be preserved when a pushLine
+ *                 occurs.
+ */
+
+static void finishedLine (void)
+{
+  currentLine->inuse = FALSE;
+}
+
+/*
+ *  m2flex_GetToken - returns a new token.
+ */
+
+EXTERN char *m2flex_GetToken (void)
+{
+  TIMEVAR_PUSH_LEX;
+  if (currentLine == NULL)
+    initLine();
+  currentLine->tokenpos = currentLine->nextpos;
+  yylex();
+  TIMEVAR_POP_LEX;
+  return yytext;
+}
+
+/*
+ *  CloseSource - provided for semantic sugar
+ */
+
+EXTERN void m2flex_CloseSource (void)
+{
+  END_FILE ();
+}
+
+/*
+ *  OpenSource - returns TRUE if file s can be opened and
+ *               all tokens are taken from this file.
+ */
+
+EXTERN int m2flex_OpenSource (char *s)
+{
+  FILE *f = fopen(s, "r");
+
+  if (f == NULL)
+    return( FALSE );
+  else {
+    isDefinitionModule = FALSE;
+    while (currentFunction != NULL)
+      {
+	struct functionInfo *f = currentFunction;
+        currentFunction = f->next;
+        if (f->name != NULL)
+  	  free(f->name);
+      	free(f);
+      }
+    yy_delete_buffer (YY_CURRENT_BUFFER);
+    yy_switch_to_buffer (yy_create_buffer(f, YY_BUF_SIZE));
+    filename = xstrdup (s);
+    lineno = 1;
+    if (currentLine == NULL)
+      pushLine ();
+    else
+      currentLine->lineno = lineno;
+    START_FILE (filename, lineno);
+    BEGIN INITIAL; resetpos ();
+    return TRUE;
+  }
+}
+
+/*
+ *  m2flex_GetLineNo - returns the current line number.
+ */
+
+EXTERN int m2flex_GetLineNo (void)
+{
+  if (currentLine != NULL)
+    return currentLine->lineno;
+  else
+    return 0;
+}
+
+/*
+ *  m2flex_GetColumnNo - returns the column where the current
+ *                       token starts.
+ */
+
+EXTERN int m2flex_GetColumnNo (void)
+{
+  if (currentLine != NULL)
+    return currentLine->column;
+  else
+    return 0;
+}
+
+/*
+ *  m2flex_GetLocation - returns the gcc location_t of the current token.
+ */
+
+EXTERN location_t m2flex_GetLocation (void)
+{
+  if (currentLine != NULL)
+    return currentLine->location;
+  else
+    return 0;
+}
+
+/*
+ *  GetTotalLines - returns the total number of lines parsed.
+ */
+
+EXTERN int m2flex_GetTotalLines (void)
+{
+  return totalLines;
+}
+
+/*
+ *  yywrap is called when end of file is seen. We push an eof token
+ *         and tell the lexical analysis to stop.
+ */
+
+int yywrap (void)
+{
+  updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return 1;
+}
+
+EXTERN void _M2_m2flex_init (void) {}
+EXTERN void _M2_m2flex_finish (void) {}
diff --git a/gcc/m2/m2pp.cc b/gcc/m2/m2pp.cc
new file mode 100644
index 00000000000..8d6dad6de22
--- /dev/null
+++ b/gcc/m2/m2pp.cc
@@ -0,0 +1,2647 @@
+/* m2pp.c pretty print trees, output in Modula-2 where possible.
+
+Copyright (C) 2007-2022 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(GM2)
+#include "gm2-gcc/gcc-consolidation.h"
+
+#include "m2-tree.h"
+#include "gm2-lang.h"
+
+#include "gm2-gcc/m2tree.h"
+#include "gm2-gcc/m2expr.h"
+#include "gm2-gcc/m2type.h"
+#include "gm2-gcc/m2decl.h"
+#else
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "cp/cp-tree.h"
+#include "stringpool.h"
+#include "gm2-gcc/gcc-consolidation.h"
+#include "../cp/cp-tree.h"
+#endif
+
+#define M2PP_C
+#include "m2/m2pp.h"
+
+namespace modula2 {
+
+#undef DEBUGGING
+
+typedef struct pretty_t
+{
+  int needs_space;
+  int needs_indent;
+  int curpos;
+  int indent;
+  int issued_begin;
+  int in_vars;
+  int in_types;
+  tree block;
+  int bits;
+} pretty;
+
+typedef struct m2stack_t
+{
+  tree value;
+  struct m2stack_t *next;
+} stack;
+
+/* Prototypes.  */
+
+static pretty *initPretty (int bits);
+static pretty *dupPretty (pretty *s);
+static int getindent (pretty *s);
+static void setindent (pretty *s, int n);
+static int getcurpos (pretty *s);
+static void m2pp_identifier (pretty *s, tree t);
+static void m2pp_needspace (pretty *s);
+static void m2pp_function (pretty *s, tree t);
+static void m2pp_function_header (pretty *s, tree t);
+static void m2pp_function_vars (pretty *s, tree t);
+static void m2pp_statement_sequence (pretty *s, tree t);
+static void m2pp_print (pretty *s, const char *p);
+static void m2pp_print_char (pretty *s, char ch);
+static void m2pp_parameter (pretty *s, tree t);
+static void m2pp_type (pretty *s, tree t);
+static void m2pp_ident_pointer (pretty *s, tree t);
+static void m2pp_set_type (pretty *s, tree t);
+static void m2pp_enum (pretty *s, tree t);
+static void m2pp_array (pretty *s, tree t);
+static void m2pp_subrange (pretty *s, tree t);
+static void m2pp_gimpified (pretty *s, tree t);
+static void m2pp_pointer_type (pretty *s, tree t);
+static void m2pp_record_type (pretty *s, tree t);
+static void m2pp_union_type (pretty *s, tree t);
+static void m2pp_simple_type (pretty *s, tree t);
+static void m2pp_expression (pretty *s, tree t);
+static void m2pp_relop (pretty *s, tree t, const char *p);
+static void m2pp_simple_expression (pretty *s, tree t);
+static void m2pp_statement_sequence (pretty *s, tree t);
+static void m2pp_unknown (pretty *s, const char *s1, const char *s2);
+static void m2pp_statement (pretty *s, tree t);
+static void m2pp_assignment (pretty *s, tree t);
+static void m2pp_designator (pretty *s, tree t);
+static void m2pp_conditional (pretty *s, tree t);
+static void m2pp_label_expr (pretty *s, tree t);
+static void m2pp_label_decl (pretty *s, tree t);
+static void m2pp_goto (pretty *s, tree t);
+static void m2pp_list (pretty *s, tree t);
+static void m2pp_offset (pretty *s, tree t);
+static void m2pp_indirect_ref (pretty *s, tree t);
+static void m2pp_integer_cst (pretty *s, tree t);
+static void m2pp_real_cst (pretty *s, tree t);
+static void m2pp_string_cst (pretty *s, tree t);
+static void m2pp_integer (pretty *s, tree t);
+static void m2pp_addr_expr (pretty *s, tree t);
+static void m2pp_nop (pretty *s, tree t);
+static void m2pp_convert (pretty *s, tree t);
+static void m2pp_var_decl (pretty *s, tree t);
+static void m2pp_binary (pretty *s, tree t, const char *p);
+static void m2pp_unary (pretty *s, tree t, const char *p);
+static void m2pp_call_expr (pretty *s, tree t);
+static void m2pp_procedure_call (pretty *s, tree t);
+static void m2pp_ssa (pretty *s, tree t);
+static void m2pp_block (pretty *s, tree t);
+static void m2pp_block_list (pretty *s, tree t);
+static void m2pp_var_list (pretty *s, tree t);
+static void m2pp_bind_expr (pretty *s, tree t);
+static void m2pp_return_expr (pretty *s, tree t);
+static void m2pp_result_decl (pretty *s, tree t);
+static void m2pp_try_block (pretty *s, tree t);
+static void m2pp_cleanup_point_expr (pretty *s, tree t);
+static void m2pp_handler (pretty *s, tree t);
+static void m2pp_component_ref (pretty *s, tree t);
+static void m2pp_array_ref (pretty *s, tree t);
+static void m2pp_begin (pretty *s);
+static void m2pp_var (pretty *s);
+static void m2pp_types (pretty *s);
+static void m2pp_decl_expr (pretty *s, tree t);
+static void m2pp_var_type_decl (pretty *s, tree t);
+static void m2pp_non_lvalue_expr (pretty *s, tree t);
+static void m2pp_procedure_type (pretty *s, tree t);
+static void m2pp_param_type (pretty *s, tree t);
+static void m2pp_type_lowlevel (pretty *s, tree t);
+static void m2pp_try_catch_expr (pretty *s, tree t);
+static void m2pp_throw (pretty *s, tree t);
+static void m2pp_catch_expr (pretty *s, tree t);
+static void m2pp_try_finally_expr (pretty *s, tree t);
+static void m2pp_complex (pretty *s, tree t);
+static void killPretty (pretty *s);
+static void m2pp_compound_expression (pretty *s, tree t);
+static void m2pp_target_expression (pretty *s, tree t);
+static void m2pp_constructor (pretty *s, tree t);
+static void m2pp_translation (pretty *s, tree t);
+static void m2pp_module_block (pretty *s, tree t);
+static void push (tree t);
+static void pop (void);
+static int begin_printed (tree t);
+static void m2pp_decl_list (pretty *s, tree t);
+static void m2pp_loc (pretty *s, tree t);
+
+void pet (tree t);
+void m2pp_integer (pretty *s, tree t);
+
+extern void stop (void);
+
+static stack *stackPtr = NULL;
+
+/* do_pf helper function for pf.  */
+
+void
+do_pf (tree t, int bits)
+{
+  pretty *state = initPretty (bits);
+
+  if (TREE_CODE (t) == TRANSLATION_UNIT_DECL)
+    m2pp_translation (state, t);
+  else if (TREE_CODE (t) == BLOCK)
+    m2pp_module_block (state, t);
+  else if (TREE_CODE (t) == FUNCTION_DECL)
+    m2pp_function (state, t);
+  else
+    m2pp_statement_sequence (state, t);
+  killPretty (state);
+}
+
+/* pf print function.  Expected to be printed interactively from
+   the debugger: print pf(func), or to be called from code.  */
+
+void
+pf (tree t)
+{
+  do_pf (t, FALSE);
+}
+
+/* pe print expression.  Expected to be printed interactively from
+   the debugger: print pe(expr), or to be called from code.  */
+
+void
+pe (tree t)
+{
+  pretty *state = initPretty (FALSE);
+
+  m2pp_expression (state, t);
+  m2pp_needspace (state);
+  m2pp_print (state, ";\n");
+  killPretty (state);
+}
+
+/* pet print expression and its type.  Expected to be printed
+   interactively from the debugger: print pet(expr), or to be called
+   from code.  */
+
+void
+pet (tree t)
+{
+  pretty *state = initPretty (FALSE);
+
+  m2pp_expression (state, t);
+  m2pp_needspace (state);
+  m2pp_print (state, ":");
+  m2pp_type (state, TREE_TYPE (t));
+  m2pp_print (state, ";\n");
+  killPretty (state);
+}
+
+/* pt print type.  Expected to be printed interactively from the
+   debugger: print pt(expr), or to be called from code.  */
+
+void
+pt (tree t)
+{
+  pretty *state = initPretty (FALSE);
+  m2pp_type (state, t);
+  m2pp_needspace (state);
+  m2pp_print (state, ";\n");
+  killPretty (state);
+}
+
+/* ptl print type low level.  Expected to be printed interactively
+   from the debugger: print ptl(type), or to be called from code.  */
+
+void
+ptl (tree t)
+{
+  pretty *state = initPretty (FALSE);
+  m2pp_type_lowlevel (state, t);
+  m2pp_needspace (state);
+  m2pp_print (state, ";\n");
+  killPretty (state);
+}
+
+/* ptcl print TREE_CHAINed list.  */
+
+void
+ptcl (tree t)
+{
+  pretty *state = initPretty (FALSE);
+
+  m2pp_decl_list (state, t);
+  m2pp_print (state, "\n");
+  killPretty (state);
+}
+
+/* loc if tree has a location then display it within a comment.  */
+
+static void
+m2pp_loc (pretty *s, tree t)
+{
+  if (CAN_HAVE_LOCATION_P (t))
+    {
+      if (EXPR_HAS_LOCATION (t))
+        {
+          if (EXPR_LOCATION (t) == UNKNOWN_LOCATION)
+            m2pp_print (s, "(* missing location1 *)\n");
+          else
+            {
+              expanded_location l = expand_location (EXPR_LOCATION (t));
+
+              m2pp_print (s, "(* ");
+              m2pp_print (s, l.file);
+              m2pp_print (s, ":");
+              printf ("%d", l.line);
+              m2pp_print (s, " *)");
+              m2pp_print (s, "\n");
+            }
+        }
+      else
+        {
+          m2pp_print (s, "(* missing location2 *)\n");
+        }
+    }
+}
+
+/* m2pp_decl_list prints a TREE_CHAINed list for a decl node.  */
+
+static void
+m2pp_decl_list (pretty *s, tree t)
+{
+  tree u = t;
+
+  m2pp_print (s, "(");
+  m2pp_needspace (s);
+  while (t != NULL_TREE)
+    {
+      m2pp_identifier (s, t);
+      t = TREE_CHAIN (t);
+      if (t == u || t == NULL_TREE)
+        break;
+      m2pp_print (s, ",");
+      m2pp_needspace (s);
+    }
+  m2pp_needspace (s);
+  m2pp_print (s, ")");
+}
+
+static void
+m2pp_decl_bool (pretty *s, tree t)
+{
+  if (TREE_STATIC (t))
+    m2pp_print (s, "static, ");
+  if (DECL_EXTERNAL (t))
+    m2pp_print (s, "external, ");
+  if (DECL_SEEN_IN_BIND_EXPR_P (t))
+    m2pp_print (s, "in bind expr, ");
+}
+
+void
+pv (tree t)
+{
+  if (t)
+    {
+      enum tree_code code = TREE_CODE (t);
+
+      if (code == PARM_DECL)
+        {
+          pretty *state = initPretty (FALSE);
+          m2pp_identifier (state, t);
+          m2pp_needspace (state);
+          m2pp_print (state, "<parm_decl context = ");
+          m2pp_identifier (state, DECL_CONTEXT (t));
+          if (DECL_ABSTRACT_ORIGIN (t) == t)
+            m2pp_print (state, ">\n");
+          else
+            {
+              m2pp_print (state, ", abstract origin = ");
+              m2pp_identifier (state, DECL_ABSTRACT_ORIGIN (t));
+              m2pp_print (state, ">\n");
+	      modula2::pv (DECL_ABSTRACT_ORIGIN (t));
+            }
+          killPretty (state);
+        }
+      if (code == VAR_DECL)
+        {
+          pretty *state = initPretty (FALSE);
+          m2pp_identifier (state, t);
+          m2pp_needspace (state);
+          m2pp_print (state, "(* <var_decl context = ");
+          m2pp_identifier (state, DECL_CONTEXT (t));
+          m2pp_decl_bool (state, t);
+          if (DECL_ABSTRACT_ORIGIN (t) == t)
+            m2pp_print (state, "> *)\n");
+          else
+            {
+              m2pp_print (state, ", abstract origin = ");
+              m2pp_identifier (state, DECL_ABSTRACT_ORIGIN (t));
+              m2pp_print (state, "> *)\n");
+	      modula2::pv (DECL_ABSTRACT_ORIGIN (t));
+            }
+          killPretty (state);
+        }
+    }
+}
+
+#if defined(GM2_MAINTAINER)
+
+/* remember an internal debugging hook. */
+static tree rememberF = NULL;
+
+static void
+remember (tree t)
+{
+  rememberF = t;
+  printf ("type:  watch *((tree *) %p) != %p\n", (void *)&DECL_SAVED_TREE (t),
+          (void *)DECL_SAVED_TREE (t));
+}
+#endif
+
+/* push pushes tree t onto stack.  */
+
+static void
+push (tree t)
+{
+  stack *s = (stack *)xmalloc (sizeof (stack));
+
+  s->value = t;
+  s->next = stackPtr;
+  stackPtr = s;
+}
+
+/* pop pops a tree, from the stack.  */
+
+static void
+pop (void)
+{
+  stack *s = stackPtr;
+
+  stackPtr = stackPtr->next;
+  free (s);
+}
+
+/* being_printed returns TRUE if t is held on the stack.  */
+
+static int
+begin_printed (tree t)
+{
+  stack *s = stackPtr;
+
+  while (s != NULL)
+    {
+      if (s->value == t)
+        return TRUE;
+      else
+        s = s->next;
+    }
+  return FALSE;
+}
+
+/* dupPretty duplicate and return a copy of state s.  */
+
+static pretty *
+dupPretty (pretty *s)
+{
+  pretty *p = initPretty (s->bits);
+  *p = *s;
+  return p;
+}
+
+/* initPretty initialise the state of the pretty printer.  */
+
+static pretty *
+initPretty (int bits)
+{
+  pretty *state = (pretty *)xmalloc (sizeof (pretty));
+  state->needs_space = FALSE;
+  state->needs_indent = FALSE;
+  state->curpos = 0;
+  state->indent = 0;
+  state->issued_begin = FALSE;
+  state->in_vars = FALSE;
+  state->in_types = FALSE;
+  state->block = NULL_TREE;
+  state->bits = bits;
+  return state;
+}
+
+/* killPretty cleans up the state.  */
+
+static void
+killPretty (pretty *s)
+{
+  free (s);
+  fflush (stdout);
+}
+
+/* getindent returns the current indent value.  */
+
+static int
+getindent (pretty *s)
+{
+  return s->indent;
+}
+
+/* setindent sets the current indent to, n.  */
+
+static void
+setindent (pretty *s, int n)
+{
+  s->indent = n;
+}
+
+/* getcurpos returns the current cursor position.  */
+
+static int
+getcurpos (pretty *s)
+{
+  if (s->needs_space)
+    return s->curpos + 1;
+  else
+    return s->curpos;
+}
+
+/* m2pp_type_lowlevel prints out the low level details of a
+   fundamental type.  */
+
+static void
+m2pp_type_lowlevel (pretty *s, tree t)
+{
+  if (TREE_CODE (t) == INTEGER_TYPE)
+    {
+      m2pp_print (s, "min");
+      m2pp_needspace (s);
+      m2pp_integer_cst (s, TYPE_MIN_VALUE (t));
+      m2pp_print (s, ", max");
+      m2pp_needspace (s);
+      m2pp_integer_cst (s, TYPE_MAX_VALUE (t));
+      m2pp_print (s, ", type size unit");
+      m2pp_needspace (s);
+      m2pp_integer_cst (s, TYPE_SIZE_UNIT (t));
+      m2pp_print (s, ", type size");
+      m2pp_needspace (s);
+      m2pp_integer_cst (s, TYPE_SIZE (t));
+
+      printf (", precision %d, mode %d, align %d, user align %d",
+              TYPE_PRECISION (t), TYPE_MODE (t), TYPE_ALIGN (t),
+              TYPE_USER_ALIGN (t));
+
+      m2pp_needspace (s);
+      if (TYPE_UNSIGNED (t))
+        m2pp_print (s, "unsigned\n");
+      else
+        m2pp_print (s, "signed\n");
+    }
+}
+
+/* m2pp_var emit a VAR if necessary.  */
+
+static void
+m2pp_var (pretty *s)
+{
+  if (!s->in_vars)
+    {
+      s->in_vars = TRUE;
+      m2pp_print (s, "VAR\n");
+      setindent (s, getindent (s) + 3);
+    }
+}
+
+/* m2pp_types emit a TYPE if necessary.  */
+
+static void
+m2pp_types (pretty *s)
+{
+  if (!s->in_types)
+    {
+      s->in_types = TRUE;
+      m2pp_print (s, "TYPE\n");
+      setindent (s, getindent (s) + 3);
+    }
+}
+
+/* hextree displays the critical fields for function, block and
+   bind_expr trees in raw hex.  */
+
+static void
+hextree (tree t)
+{
+  if (t == NULL_TREE)
+    return;
+
+  if (TREE_CODE (t) == BLOCK)
+    {
+      printf ("(* BLOCK %p *)\n", (void *)t);
+      printf ("BLOCK_VARS (t) =  %p\n", (void *)BLOCK_VARS (t));
+      printf ("BLOCK_SUPERCONTEXT (t)  =  %p\n",
+              (void *)BLOCK_SUPERCONTEXT (t));
+    }
+  if (TREE_CODE (t) == BIND_EXPR)
+    {
+      printf ("(* BIND_EXPR %p *)\n", (void *)t);
+      printf ("BIND_EXPR_VARS (t) =  %p\n", (void *)BIND_EXPR_VARS (t));
+      printf ("BIND_EXPR_BLOCK (t) =  %p\n", (void *)BIND_EXPR_BLOCK (t));
+      printf ("BIND_EXPR_BODY (t) =  %p\n", (void *)BIND_EXPR_BODY (t));
+    }
+  if (TREE_CODE (t) == FUNCTION_DECL)
+    {
+      printf ("(* FUNCTION_DECL %p *)\n", (void *)t);
+      printf ("DECL_INITIAL (t) =  %p\n", (void *)DECL_INITIAL (t));
+      printf ("DECL_SAVED_TREE (t) = %p\n", (void *)DECL_SAVED_TREE (t));
+      hextree (DECL_INITIAL (t));
+      hextree (DECL_SAVED_TREE (t));
+    }
+  if (TREE_CODE (t) == VAR_DECL)
+    {
+      pretty *state = initPretty (FALSE);
+
+      printf ("(* VAR_DECL %p <", (void *)t);
+      if (DECL_SEEN_IN_BIND_EXPR_P (t))
+        printf ("b");
+      if (DECL_EXTERNAL (t))
+        printf ("e");
+      if (TREE_STATIC (t))
+        printf ("s");
+      printf ("> context = %p*)\n", (void *)decl_function_context (t));
+      m2pp_type (state, TREE_TYPE (t));
+      m2pp_needspace (state);
+      m2pp_print (state, ";\n");
+      killPretty (state);
+    }
+  if (TREE_CODE (t) == PARM_DECL)
+    {
+      pretty *state = initPretty (FALSE);
+
+      printf ("(* PARM_DECL %p <", (void *)t);
+      printf ("> context = %p*)\n", (void *)decl_function_context (t));
+      m2pp_type (state, TREE_TYPE (t));
+      m2pp_needspace (state);
+      m2pp_print (state, ";\n");
+      killPretty (state);
+    }
+}
+
+/* translation produce a pseudo implementation module from the tree t.  */
+
+static void
+m2pp_translation (pretty *s, tree t)
+{
+  tree block = DECL_INITIAL (t);
+
+  m2pp_print (s, "IMPLEMENTATION MODULE ");
+  m2pp_identifier (s, t);
+  m2pp_print (s, "\n\n");
+
+  if (block != NULL)
+    {
+      m2pp_module_block (s, block);
+      m2pp_print (s, "\n");
+    }
+
+  m2pp_print (s, "\n");
+  m2pp_print (s, "END ");
+  m2pp_identifier (s, t);
+  m2pp_print (s, ".\n");
+}
+
+static void
+m2pp_module_block (pretty *s, tree t)
+{
+  t = BLOCK_VARS (t);
+
+  if (t != NULL_TREE)
+    for (; t != NULL_TREE; t = TREE_CHAIN (t))
+      {
+        switch (TREE_CODE (t))
+          {
+          case FUNCTION_DECL:
+            if (!DECL_EXTERNAL (t))
+              {
+                pretty *p = dupPretty (s);
+                printf ("\n");
+                p->in_vars = FALSE;
+                p->in_types = FALSE;
+                m2pp_function (p, t);
+                killPretty (p);
+                printf ("\n");
+                s->in_vars = FALSE;
+                s->in_types = FALSE;
+              }
+            break;
+
+          case TYPE_DECL:
+            {
+              int o = getindent (s);
+              int p;
+
+              m2pp_print (s, "\n");
+              m2pp_types (s);
+              setindent (s, o + 3);
+              m2pp_identifier (s, t);
+              m2pp_print (s, " = ");
+              p = getcurpos (s);
+              setindent (s, p);
+              m2pp_type (s, TREE_TYPE (t));
+              setindent (s, o);
+              m2pp_needspace (s);
+              m2pp_print (s, ";\n");
+              s->in_vars = FALSE;
+            }
+            break;
+
+          case VAR_DECL:
+            m2pp_var (s);
+            m2pp_identifier (s, t);
+            m2pp_needspace (s);
+            m2pp_print (s, ":");
+            m2pp_needspace (s);
+            m2pp_type (s, TREE_TYPE (t));
+            m2pp_needspace (s);
+            m2pp_print (s, ";\n");
+            s->in_types = FALSE;
+            break;
+
+          case DECL_EXPR:
+            printf ("is this node legal here? \n");
+            m2pp_decl_expr (s, t);
+            break;
+
+          default:
+            m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
+          }
+      }
+}
+
+/* m2pp_begin emit a BEGIN if necessary.  */
+
+static void
+m2pp_begin (pretty *s)
+{
+  if (!s->issued_begin)
+    {
+      if (s->in_vars || s->in_types)
+        {
+          setindent (s, getindent (s) - 3);
+          m2pp_print (s, "BEGIN\n");
+          setindent (s, getindent (s) + 3);
+        }
+      else
+        {
+          m2pp_print (s, "BEGIN\n");
+          setindent (s, getindent (s) + 3);
+        }
+      s->issued_begin = TRUE;
+      s->in_vars = FALSE;
+      s->in_types = FALSE;
+    }
+}
+
+/* m2pp_function walk over the function.  */
+
+static void
+m2pp_function (pretty *s, tree t)
+{
+  m2pp_function_header (s, t);
+  m2pp_function_vars (s, t);
+  m2pp_statement_sequence (s, DECL_SAVED_TREE (t));
+  if (TREE_CODE (t) == FUNCTION_DECL)
+    {
+      m2pp_begin (s);
+      setindent (s, getindent (s) - 3);
+      m2pp_print (s, "END");
+      m2pp_needspace (s);
+      m2pp_identifier (s, t);
+      m2pp_needspace (s);
+      m2pp_print (s, ";\n");
+    }
+}
+
+/* m2pp_bind_expr displays the bind expr tree node.  */
+
+static void
+m2pp_bind_expr (pretty *s, tree t)
+{
+  if (TREE_CODE (t) == BIND_EXPR)
+    {
+      if (BIND_EXPR_VARS (t))
+        {
+          m2pp_print (s, "(* variables in bind_expr *)\n");
+          m2pp_var (s);
+          m2pp_var_list (s, BIND_EXPR_VARS (t));
+        }
+      if (BIND_EXPR_BLOCK (t))
+        {
+          m2pp_print (s, "(* bind_expr_block *)\n");
+          m2pp_statement_sequence (s, BIND_EXPR_BLOCK (t));
+          m2pp_needspace (s);
+          m2pp_print (s, "; \n");
+        }
+      m2pp_statement_sequence (s, BIND_EXPR_BODY (t));
+    }
+}
+
+/* m2pp_block_list iterates over the list of blocks.  */
+
+static void
+m2pp_block_list (pretty *s, tree t)
+{
+  for (; t; t = BLOCK_CHAIN (t))
+    m2pp_block (s, t);
+}
+
+/* m2pp_block prints the VARiables and the TYPEs inside a block.  */
+
+static void
+m2pp_block (pretty *s, tree t)
+{
+  if ((BLOCK_VARS (t) != NULL_TREE) && (s->block != BLOCK_VARS (t)))
+    {
+      s->block = BLOCK_VARS (t);
+      m2pp_print (s, "(* block variables *)\n");
+      m2pp_var (s);
+      m2pp_var_list (s, BLOCK_VARS (t));
+    }
+}
+
+/* m2pp_var_type_decl displays the variable and type declaration.  */
+
+static void
+m2pp_var_type_decl (pretty *s, tree t)
+{
+  m2pp_identifier (s, t);
+  m2pp_needspace (s);
+  m2pp_print (s, ":");
+  m2pp_needspace (s);
+  m2pp_type (s, TREE_TYPE (t));
+  m2pp_needspace (s);
+  m2pp_print (s, ";\n");
+}
+
+/* m2pp_var_list print a variable list.  */
+
+static void
+m2pp_var_list (pretty *s, tree t)
+{
+  if (t != NULL_TREE)
+    for (; t; t = TREE_CHAIN (t))
+      {
+        if (TREE_CODE (t) == FUNCTION_DECL)
+          {
+            pretty *p = dupPretty (s);
+            printf ("\n");
+            p->in_vars = FALSE;
+            p->in_types = FALSE;
+            m2pp_function (p, t);
+            killPretty (p);
+            printf ("\n");
+          }
+        else if (TREE_CODE (t) == TYPE_DECL)
+          m2pp_identifier (s, t);
+        else if (TREE_CODE (t) == DECL_EXPR)
+          {
+            printf ("is this node legal here? \n");
+            // is it legal to have a DECL_EXPR here ?
+            m2pp_var_type_decl (s, DECL_EXPR_DECL (t));
+          }
+        else
+          m2pp_var_type_decl (s, t);
+      }
+}
+
+#if 0
+/* m2pp_type_list print a variable list.  */
+
+static void
+m2pp_type_list (pretty *s, tree t)
+{
+  if (t != NULL_TREE)
+    for (; t; t = TREE_CHAIN (t))
+      {
+	m2pp_identifier (s, t);
+	m2pp_needspace (s);
+	m2pp_print (s, "=");
+	m2pp_needspace (s);
+	m2pp_type (s, TREE_TYPE (t));
+	m2pp_needspace (s);
+	m2pp_print (s, ";\n");
+      }
+}
+#endif
+
+/* m2pp_needspace sets appropriate flag to TRUE.  */
+
+static void
+m2pp_needspace (pretty *s)
+{
+  s->needs_space = TRUE;
+}
+
+/* m2pp_identifer prints an identifier.  */
+
+static void
+m2pp_identifier (pretty *s, tree t)
+{
+  if (t)
+    {
+      if (TREE_CODE (t) == COMPONENT_REF)
+        m2pp_component_ref (s, t);
+      else if (DECL_NAME (t) && IDENTIFIER_POINTER (DECL_NAME (t)))
+        m2pp_ident_pointer (s, DECL_NAME (t));
+      else
+        {
+          char name[100];
+
+          if (TREE_CODE (t) == CONST_DECL)
+            snprintf (name, 100, "C_%u", DECL_UID (t));
+          else
+            snprintf (name, 100, "D_%u", DECL_UID (t));
+          m2pp_print (s, name);
+        }
+    }
+}
+
+/* m2pp_ident_pointer displays an ident pointer.  */
+
+static void
+m2pp_ident_pointer (pretty *s, tree t)
+{
+  if (t)
+    m2pp_print (s, IDENTIFIER_POINTER (t));
+}
+
+/* m2pp_parameter prints out a param decl tree.  */
+
+static void
+m2pp_parameter (pretty *s, tree t)
+{
+  if (TREE_CODE (t) == PARM_DECL)
+    {
+      if (TREE_TYPE (t) && (TREE_CODE (TREE_TYPE (t)) == REFERENCE_TYPE))
+        {
+          m2pp_print (s, "VAR");
+          m2pp_needspace (s);
+          m2pp_identifier (s, t);
+          m2pp_print (s, ":");
+          m2pp_needspace (s);
+          m2pp_simple_type (s, TREE_TYPE (TREE_TYPE (t)));
+        }
+      else
+        {
+          m2pp_identifier (s, t);
+          m2pp_print (s, ":");
+          m2pp_needspace (s);
+          m2pp_simple_type (s, TREE_TYPE (t));
+        }
+    }
+}
+
+/* m2pp_param_type prints out the type of parameter.  */
+
+static void
+m2pp_param_type (pretty *s, tree t)
+{
+  if (t && (TREE_CODE (t) == REFERENCE_TYPE))
+    {
+      m2pp_print (s, "VAR");
+      m2pp_needspace (s);
+      m2pp_simple_type (s, TREE_TYPE (t));
+    }
+  else
+    m2pp_simple_type (s, t);
+}
+
+/* m2pp_procedure_type displays a procedure type.  */
+
+static void
+m2pp_procedure_type (pretty *s, tree t)
+{
+  push (t);
+  if (TREE_CODE (t) == FUNCTION_TYPE)
+    {
+      tree i = TYPE_ARG_TYPES (t);
+      tree returnType = TREE_TYPE (TREE_TYPE (t));
+
+      m2pp_needspace (s);
+      m2pp_print (s, "PROCEDURE");
+      m2pp_needspace (s);
+      if (i != NULL_TREE)
+        {
+          int o = getindent (s);
+          int p;
+          int first = TRUE;
+
+          m2pp_print (s, "(");
+          p = getcurpos (s);
+          setindent (s, p);
+          while (i != NULL_TREE)
+            {
+              if (TREE_CHAIN (i) == NULL_TREE)
+                {
+                  if (TREE_VALUE (i) == void_type_node)
+                    /* Ignore void_type_node at the end.  */
+                    ;
+                  else
+                    {
+                      m2pp_param_type (s, TREE_VALUE (i));
+                      m2pp_print (s, ", ...");
+                    }
+                  break;
+                }
+              else
+                {
+                  if (!first)
+                    {
+                      m2pp_print (s, ",");
+                      m2pp_needspace (s);
+                    }
+                  m2pp_param_type (s, TREE_VALUE (i));
+                }
+              i = TREE_CHAIN (i);
+              first = FALSE;
+            }
+          m2pp_print (s, ")");
+          setindent (s, o);
+        }
+      else if (returnType != NULL_TREE)
+        {
+          m2pp_needspace (s);
+          m2pp_print (s, "()");
+        }
+      if (returnType != NULL_TREE)
+        {
+          m2pp_needspace (s);
+          m2pp_print (s, ": ");
+          m2pp_simple_type (s, returnType);
+        }
+    }
+  pop ();
+}
+
+/* m2pp_comment_header displays a simple header with some critical
+   tree info.  */
+
+static void
+m2pp_comment_header (pretty *s, tree t)
+{
+  int o = getindent (s);
+
+  m2pp_print (s, "(*\n");
+  setindent (s, o + 3);
+  m2pp_identifier (s, t);
+  m2pp_needspace (s);
+  m2pp_print (s, "-");
+  m2pp_needspace (s);
+  if (TREE_PUBLIC (t))
+    {
+      m2pp_needspace (s);
+      m2pp_print (s, "public,");
+    }
+  if (TREE_STATIC (t))
+    {
+      m2pp_needspace (s);
+      m2pp_print (s, "static,");
+    }
+  if (DECL_EXTERNAL (t))
+    {
+      m2pp_needspace (s);
+      m2pp_print (s, "extern");
+    }
+  m2pp_print (s, "\n");
+  setindent (s, o);
+  m2pp_print (s, "*)\n\n");
+}
+
+/* m2pp_function_header displays the function header.  */
+
+static void
+m2pp_function_header (pretty *s, tree t)
+{
+  push (t);
+  if (TREE_CODE (t) == FUNCTION_DECL)
+    {
+      tree i = DECL_ARGUMENTS (t);
+      tree returnType = TREE_TYPE (TREE_TYPE (t));
+
+      m2pp_comment_header (s, t);
+      m2pp_print (s, "PROCEDURE ");
+      m2pp_identifier (s, t);
+      m2pp_needspace (s);
+      if (i != NULL_TREE)
+        {
+          int o = getindent (s);
+          int p;
+
+          m2pp_print (s, "(");
+          p = getcurpos (s);
+          setindent (s, p);
+          while (i != NULL_TREE)
+            {
+              m2pp_parameter (s, i);
+              i = TREE_CHAIN (i);
+              if (i != NULL_TREE)
+                m2pp_print (s, ";\n");
+            }
+          m2pp_print (s, ")");
+          m2pp_needspace (s);
+          setindent (s, o);
+        }
+      else if (returnType != void_type_node)
+        {
+          m2pp_print (s, "()");
+          m2pp_needspace (s);
+        }
+      if (returnType != void_type_node)
+        {
+          m2pp_print (s, ": ");
+          m2pp_simple_type (s, returnType);
+          m2pp_needspace (s);
+        }
+      m2pp_print (s, "; ");
+      m2pp_loc (s, t);
+      m2pp_print (s, "\n");
+    }
+  pop ();
+}
+
+/* m2pp_add_var adds a variable into a list as defined by, data.  */
+
+static tree
+m2pp_add_var (tree *tp, int *walk_subtrees, void *data)
+{
+  tree t = *tp;
+  pretty *s = (pretty *)data;
+  enum tree_code code = TREE_CODE (t);
+
+  if (code == VAR_DECL)
+    {
+      m2pp_var (s);
+      m2pp_identifier (s, t);
+      m2pp_needspace (s);
+      m2pp_print (s, ":");
+      m2pp_needspace (s);
+      m2pp_type (s, TREE_TYPE (t));
+      m2pp_needspace (s);
+      m2pp_print (s, ";\n");
+    }
+  if (code == SSA_NAME)
+    {
+      m2pp_var (s);
+      m2pp_ssa (s, t);
+      m2pp_identifier (s, SSA_NAME_VAR (t));
+      m2pp_needspace (s);
+      m2pp_print (s, ":");
+      m2pp_needspace (s);
+      m2pp_type (s, TREE_TYPE (t));
+      m2pp_needspace (s);
+      m2pp_print (s, ";\n");
+    }
+
+  *walk_subtrees = 1;
+  return NULL_TREE;
+}
+
+/* m2pp_function_vars displays variables as defined by the function
+   tree.  */
+
+static void
+m2pp_function_vars (pretty *s, tree t)
+{
+  walk_tree_without_duplicates (&t, m2pp_add_var, s);
+
+  if (TREE_CODE (t) == FUNCTION_DECL && DECL_INITIAL (t))
+    {
+      m2pp_print (s, "(* variables in function_decl (decl_initial) *)\n");
+      m2pp_var (s);
+      m2pp_statement_sequence (s, DECL_INITIAL (t));
+    }
+}
+
+/* m2pp_print print out a string p interpreting '\n' and
+   adjusting the fields within state s.  */
+
+static void
+m2pp_print (pretty *s, const char *p)
+{
+  if (p)
+    {
+      int l = strlen (p);
+      int i = 0;
+
+      if (s->needs_space)
+        {
+          printf (" ");
+          s->needs_space = FALSE;
+          s->curpos++;
+        }
+
+      while (i < l)
+        {
+          if (p[i] == '\n')
+            {
+              s->needs_indent = TRUE;
+              s->curpos = 0;
+              printf ("\n");
+            }
+          else
+            {
+              if (s->needs_indent)
+                {
+                  if (s->indent > 0)
+                    printf ("%*c", s->indent, ' ');
+                  s->needs_indent = FALSE;
+                  s->curpos += s->indent;
+                }
+              s->curpos++;
+              putchar (p[i]);
+            }
+          i++;
+        }
+    }
+}
+
+/* m2pp_print_char prints out a character ch obeying needs_space
+   and needs_indent.  */
+
+static void
+m2pp_print_char (pretty *s, char ch)
+{
+  if (s->needs_space)
+    {
+      printf (" ");
+      s->needs_space = FALSE;
+      s->curpos++;
+    }
+  if (s->needs_indent)
+    {
+      if (s->indent > 0)
+        printf ("%*c", s->indent, ' ');
+      s->needs_indent = FALSE;
+      s->curpos += s->indent;
+    }
+  if (ch == '\n')
+    {
+      s->curpos++;
+      putchar ('\\');
+      putchar ('n');
+    }
+  else
+    putchar (ch);
+  s->curpos++;
+}
+
+/* m2pp_integer display the appropriate integer type.  */
+
+#if defined(GM2)
+void
+m2pp_integer (pretty *s, tree t)
+{
+  if (t == m2type_GetM2ZType ())
+    m2pp_print (s, "M2ZTYPE");
+  else if (t == m2type_GetM2LongIntType ())
+    m2pp_print (s, "LONGINT");
+  else if (t == m2type_GetM2IntegerType ())
+    m2pp_print (s, "INTEGER");
+  else if (t == m2type_GetM2ShortIntType ())
+    m2pp_print (s, "SHORTINT");
+  else if (t == m2type_GetLongIntType ())
+    m2pp_print (s, "long int");
+  else if (t == m2type_GetIntegerType ())
+    m2pp_print (s, "int");
+  else if (t == m2type_GetShortIntType ())
+    m2pp_print (s, "short");
+  else if (t == m2type_GetM2LongCardType ())
+    m2pp_print (s, "LONGCARD");
+  else if (t == m2type_GetM2CardinalType ())
+    m2pp_print (s, "CARDINAL");
+  else if (t == m2type_GetM2ShortCardType ())
+    m2pp_print (s, "SHORTCARD");
+  else if (t == m2type_GetCardinalType ())
+    m2pp_print (s, "CARDINAL");
+  else if (t == m2type_GetPointerType ())
+    m2pp_print (s, "ADDRESS");
+  else if (t == m2type_GetByteType ())
+    m2pp_print (s, "BYTE");
+  else if (t == m2type_GetCharType ())
+    m2pp_print (s, "CHAR");
+  else if (t == m2type_GetBitsetType ())
+    m2pp_print (s, "BITSET");
+  else if (t == m2type_GetBitnumType ())
+    m2pp_print (s, "BITNUM");
+  else
+    {
+      if (TYPE_UNSIGNED (t))
+        m2pp_print (s, "CARDINAL");
+      else
+        m2pp_print (s, "INTEGER");
+      m2pp_integer_cst (s, TYPE_SIZE (t));
+    }
+}
+#else
+void
+m2pp_integer (pretty *s, tree t ATTRIBUTE_UNUSED)
+{
+  m2pp_print (s, "INTEGER");
+}
+#endif
+
+/* m2pp_complex display the actual complex type.  */
+
+#if defined(GM2)
+static void
+m2pp_complex (pretty *s, tree t)
+{
+  if (t == m2type_GetM2ComplexType ())
+    m2pp_print (s, "COMPLEX");
+  else if (t == m2type_GetM2LongComplexType ())
+    m2pp_print (s, "LONGCOMPLEX");
+  else if (t == m2type_GetM2ShortComplexType ())
+    m2pp_print (s, "SHORTCOMPLEX");
+  else if (t == m2type_GetM2CType ())
+    m2pp_print (s, "C'omplex' type");
+  else if (t == m2type_GetM2Complex32 ())
+    m2pp_print (s, "COMPLEX32");
+  else if (t == m2type_GetM2Complex64 ())
+    m2pp_print (s, "COMPLEX64");
+  else if (t == m2type_GetM2Complex96 ())
+    m2pp_print (s, "COMPLEX96");
+  else if (t == m2type_GetM2Complex128 ())
+    m2pp_print (s, "COMPLEX128");
+  else
+    m2pp_print (s, "unknown COMPLEX type");
+}
+
+#else
+
+static void
+m2pp_complex (pretty *s, tree t ATTRIBUTE_UNUSED)
+{
+  m2pp_print (s, "a COMPLEX type");
+}
+#endif
+
+/* m2pp_type prints a full type.  */
+
+void
+m2pp_type (pretty *s, tree t)
+{
+  if (begin_printed (t))
+    {
+      m2pp_print (s, "<...>");
+      return;
+    }
+  if ((TREE_CODE (t) != FIELD_DECL) && (TREE_CODE (t) != TYPE_DECL))
+    m2pp_gimpified (s, t);
+  switch (TREE_CODE (t))
+    {
+    case INTEGER_TYPE:
+      m2pp_integer (s, t);
+      break;
+    case REAL_TYPE:
+      m2pp_print (s, "REAL");
+      break;
+    case ENUMERAL_TYPE:
+      m2pp_enum (s, t);
+      break;
+    case UNION_TYPE:
+      m2pp_union_type (s, t);
+      break;
+    case RECORD_TYPE:
+      m2pp_record_type (s, t);
+      break;
+    case ARRAY_TYPE:
+      m2pp_array (s, t);
+      break;
+#if 0
+    case FUNCTION_TYPE:
+      m2pp_function_type (s, t);
+      break;
+#endif
+    case TYPE_DECL:
+      m2pp_identifier (s, t);
+      break;
+    case POINTER_TYPE:
+      m2pp_pointer_type (s, t);
+      break;
+#if defined(GM2)
+    case SET_TYPE:
+      m2pp_set_type (s, t);
+      break;
+#endif
+    case VOID_TYPE:
+      m2pp_print (s, "ADDRESS");
+      break;
+    case COMPLEX_TYPE:
+      m2pp_complex (s, t);
+      break;
+    default:
+      m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
+    }
+}
+
+/* m2pp_set_type prints out the set type.  */
+
+static void
+m2pp_set_type (pretty *s, tree t)
+{
+  push (t);
+  m2pp_print (s, "SET OF");
+  m2pp_needspace (s);
+  m2pp_type (s, TREE_TYPE (t));
+  pop ();
+}
+
+/* m2pp_enum print out the enumeration type.  */
+
+static void
+m2pp_enum (pretty *s, tree t)
+{
+  tree chain_p = TYPE_VALUES (t);
+
+  push (t);
+  m2pp_print (s, "(");
+  while (chain_p)
+    {
+      m2pp_ident_pointer (s, TREE_PURPOSE (chain_p));
+      chain_p = TREE_CHAIN (chain_p);
+      if (chain_p)
+        m2pp_print (s, ", ");
+    }
+  m2pp_print (s, ")");
+  pop ();
+}
+
+/* m2pp_array prints out the array type.  */
+
+static void
+m2pp_array (pretty *s, tree t)
+{
+  push (t);
+  m2pp_print (s, "ARRAY");
+  m2pp_needspace (s);
+  m2pp_subrange (s, TYPE_DOMAIN (t));
+  m2pp_needspace (s);
+  m2pp_print (s, "OF");
+  m2pp_needspace (s);
+  m2pp_type (s, TREE_TYPE (t));
+  pop ();
+}
+
+/* m2pp_subrange prints out the subrange, but probably the lower
+   bound will always be zero.  */
+
+static void
+m2pp_subrange (pretty *s, tree t)
+{
+  tree min = TYPE_MIN_VALUE (t);
+  tree max = TYPE_MAX_VALUE (t);
+
+  m2pp_print (s, "[");
+  m2pp_expression (s, min);
+  m2pp_print (s, "..");
+  m2pp_expression (s, max);
+  m2pp_print (s, "]");
+}
+
+/* m2pp_gimplified print out a gimplified comment.  */
+
+static void
+m2pp_gimpified (pretty *s, tree t)
+{
+  if (!TYPE_SIZES_GIMPLIFIED (t))
+    {
+      m2pp_print (s, "(* <!g> *)");
+      m2pp_needspace (s);
+    }
+}
+
+/* m2pp_printer_type display the pointer type.  */
+
+static void
+m2pp_pointer_type (pretty *s, tree t)
+{
+  push (t);
+  if (TREE_CODE (t) == POINTER_TYPE)
+    {
+      if (TREE_CODE (TREE_TYPE (t)) == FUNCTION_TYPE)
+        m2pp_procedure_type (s, TREE_TYPE (t));
+      else if (t == ptr_type_node)
+        m2pp_print (s, "ADDRESS");
+      else
+        {
+          m2pp_print (s, "POINTER TO");
+          m2pp_needspace (s);
+          m2pp_type (s, TREE_TYPE (t));
+        }
+    }
+  pop ();
+}
+
+/* m2pp_record_alignment prints out whether this record is aligned
+   (packed).  */
+
+static void
+m2pp_record_alignment (pretty *s, tree t)
+{
+  if (TYPE_PACKED (t))
+    m2pp_print (s, "<* bytealignment (0) *>\n");
+}
+
+static unsigned int
+m2pp_getaligned (tree t)
+{
+  if (DECL_P (t))
+    {
+      if (DECL_USER_ALIGN (t))
+        return DECL_ALIGN (t);
+    }
+  else if (TYPE_P (t))
+    {
+      if (TYPE_USER_ALIGN (t))
+        return TYPE_ALIGN (t);
+    }
+  return 0;
+}
+
+static void
+m2pp_recordfield_alignment (pretty *s, tree t)
+{
+  unsigned int aligned = m2pp_getaligned (t);
+
+  if (aligned != 0)
+    {
+      int o = getindent (s);
+      int p = getcurpos (s);
+      m2pp_needspace (s);
+      m2pp_print (s, "<* bytealignment (");
+      setindent (s, p + 18);
+
+      printf ("%d", aligned / BITS_PER_UNIT);
+
+      m2pp_print (s, ")");
+      m2pp_needspace (s);
+      setindent (s, p);
+      m2pp_print (s, "*>");
+      setindent (s, o);
+    }
+}
+
+static void
+m2pp_recordfield_bitfield (pretty *s, tree t)
+{
+  if ((TREE_CODE (t) == FIELD_DECL) && DECL_PACKED (t))
+    {
+      m2pp_print (s, " (* packed");
+      if (DECL_NONADDRESSABLE_P (t))
+        m2pp_print (s, ", non-addressible");
+      if (DECL_BIT_FIELD (t))
+        m2pp_print (s, ", bit-field");
+      m2pp_print (s, ", offset: ");
+      m2pp_expression (s, DECL_FIELD_OFFSET (t));
+      m2pp_print (s, ", bit offset:");
+      m2pp_expression (s, DECL_FIELD_BIT_OFFSET (t));
+      m2pp_print (s, " *) ");
+    }
+}
+
+/* m2pp_record_type displays the record type.  */
+
+static void
+m2pp_record_type (pretty *s, tree t)
+{
+  push (t);
+  if (TREE_CODE (t) == RECORD_TYPE)
+    {
+      tree i;
+      int o = getindent (s);
+      int p = getcurpos (s);
+
+      m2pp_print (s, "RECORD\n");
+      setindent (s, p + 3);
+      m2pp_record_alignment (s, t);
+      for (i = TYPE_FIELDS (t); i != NULL_TREE; i = TREE_CHAIN (i))
+        {
+          m2pp_identifier (s, i);
+          m2pp_print (s, " : ");
+          m2pp_type (s, TREE_TYPE (i));
+          m2pp_recordfield_bitfield (s, i);
+          m2pp_recordfield_alignment (s, i);
+          m2pp_print (s, ";\n");
+        }
+      setindent (s, p);
+      m2pp_print (s, "END");
+      setindent (s, o);
+    }
+  pop ();
+}
+
+/* m2pp_record_type displays the record type.  */
+
+static void
+m2pp_union_type (pretty *s, tree t)
+{
+  push (t);
+  if (TREE_CODE (t) == UNION_TYPE)
+    {
+      tree i;
+      int o = getindent (s);
+      int p = getcurpos (s);
+
+      m2pp_print (s, "CASE .. OF\n");
+      setindent (s, p + 3);
+      m2pp_record_alignment (s, t);
+      for (i = TYPE_FIELDS (t); i != NULL_TREE; i = TREE_CHAIN (i))
+        {
+          m2pp_identifier (s, i);
+          m2pp_print (s, " : ");
+          m2pp_type (s, TREE_TYPE (i));
+          m2pp_recordfield_bitfield (s, i);
+          m2pp_print (s, ";\n");
+        }
+      setindent (s, p);
+      m2pp_print (s, "END");
+      setindent (s, o);
+    }
+  pop ();
+}
+
+/* m2pp_simple_type.  */
+
+static void
+m2pp_simple_type (pretty *s, tree t)
+{
+  if (begin_printed (t))
+    {
+      m2pp_print (s, "<...>");
+      return;
+    }
+
+  m2pp_gimpified (s, t);
+  switch (TREE_CODE (t))
+    {
+    case INTEGER_TYPE:
+      m2pp_integer (s, t);
+      break;
+    case REAL_TYPE:
+      m2pp_print (s, "REAL");
+      break;
+    case BOOLEAN_TYPE:
+      m2pp_print (s, "BOOLEAN");
+      break;
+    case VOID_TYPE:
+      m2pp_print (s, "ADDRESS");
+      break;
+    case TYPE_DECL:
+      m2pp_identifier (s, t);
+      break;
+    case POINTER_TYPE:
+      m2pp_pointer_type (s, t);
+      break;
+    case RECORD_TYPE:
+      m2pp_record_type (s, t);
+      break;
+    case UNION_TYPE:
+      m2pp_union_type (s, t);
+      break;
+    case ENUMERAL_TYPE:
+      m2pp_enum (s, t);
+      break;
+    case COMPLEX_TYPE:
+      m2pp_complex (s, t);
+      break;
+    default:
+      m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
+    }
+}
+
+/* m2pp_expression display an expression.  */
+
+static void
+m2pp_expression (pretty *s, tree t)
+{
+  enum tree_code code = TREE_CODE (t);
+
+  switch (code)
+    {
+    case EQ_EXPR:
+      m2pp_relop (s, t, "=");
+      break;
+    case NE_EXPR:
+      m2pp_relop (s, t, "#");
+      break;
+    case LE_EXPR:
+      m2pp_relop (s, t, "<=");
+      break;
+    case GE_EXPR:
+      m2pp_relop (s, t, ">=");
+      break;
+    case LT_EXPR:
+      m2pp_relop (s, t, "<");
+      break;
+    case GT_EXPR:
+      m2pp_relop (s, t, ">");
+      break;
+    default:
+      m2pp_simple_expression (s, t);
+    }
+}
+
+/* m2pp_relop displays the lhs relop rhs.  */
+
+static void
+m2pp_relop (pretty *s, tree t, const char *p)
+{
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_needspace (s);
+  m2pp_print (s, p);
+  m2pp_needspace (s);
+  m2pp_expression (s, TREE_OPERAND (t, 1));
+}
+
+/* m2pp_compound_expression handle compound expression tree.  */
+
+static void
+m2pp_compound_expression (pretty *s, tree t)
+{
+  m2pp_print (s, "compound expression {");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, " (* result ignored *), ");
+  m2pp_expression (s, TREE_OPERAND (t, 1));
+  m2pp_print (s, "}");
+  m2pp_needspace (s);
+}
+
+/* m2pp_target_expression handle target expression tree.  */
+
+static void
+m2pp_target_expression (pretty *s, tree t)
+{
+  m2pp_print (s, "{");
+  m2pp_needspace (s);
+  if (TREE_OPERAND (t, 0) != NULL_TREE)
+    {
+      m2pp_print (s, "(* target *) ");
+      m2pp_expression (s, TREE_OPERAND (t, 0));
+      m2pp_print (s, ",");
+      m2pp_needspace (s);
+    }
+  if (TREE_OPERAND (t, 1) != NULL_TREE)
+    {
+      m2pp_print (s, "(* initializer *) ");
+      m2pp_expression (s, TREE_OPERAND (t, 1));
+      m2pp_print (s, ",");
+      m2pp_needspace (s);
+    }
+  if (TREE_OPERAND (t, 2) != NULL_TREE)
+    {
+      m2pp_print (s, "(* cleanup *) ");
+      m2pp_expression (s, TREE_OPERAND (t, 2));
+      m2pp_print (s, ",");
+      m2pp_needspace (s);
+    }
+  if (TREE_OPERAND (t, 3) != NULL_TREE)
+    {
+      m2pp_print (s, "(* saved initializer *) ");
+      m2pp_expression (s, TREE_OPERAND (t, 3));
+      m2pp_print (s, ",");
+      m2pp_needspace (s);
+    }
+  m2pp_print (s, "}");
+  m2pp_needspace (s);
+}
+
+/* m2pp_constructor print out a constructor.  */
+
+static void
+m2pp_constructor (pretty *s, tree t)
+{
+  tree purpose, value;
+  unsigned HOST_WIDE_INT ix;
+
+  m2pp_print (s, "{ ");
+  FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (t), ix, purpose, value)
+  {
+    m2pp_print (s, "(index: ");
+    m2pp_simple_expression (s, purpose);
+    m2pp_print (s, ") ");
+    m2pp_simple_expression (s, value);
+    m2pp_print (s, ", ");
+  }
+  m2pp_print (s, "}");
+  m2pp_print (s, "(* type: ");
+  setindent (s, getindent (s) + 8);
+  m2pp_type (s, TREE_TYPE (t));
+  setindent (s, getindent (s) - 8);
+  m2pp_print (s, " *)\n");
+}
+
+/* m2pp_complex_expr handle GCC complex_expr tree.  */
+
+static void
+m2pp_complex_expr (pretty *s, tree t)
+{
+  if (TREE_CODE (t) == COMPLEX_CST)
+    {
+      m2pp_print (s, "CMPLX(");
+      m2pp_needspace (s);
+      m2pp_expression (s, TREE_REALPART (t));
+      m2pp_print (s, ",");
+      m2pp_needspace (s);
+      m2pp_expression (s, TREE_IMAGPART (t));
+      m2pp_print (s, ")");
+    }
+  else
+    {
+      m2pp_print (s, "CMPLX(");
+      m2pp_needspace (s);
+      m2pp_expression (s, TREE_OPERAND (t, 0));
+      m2pp_print (s, ",");
+      m2pp_needspace (s);
+      m2pp_expression (s, TREE_OPERAND (t, 1));
+      m2pp_print (s, ")");
+    }
+}
+
+/* m2pp_imagpart_expr handle imagpart_expr tree.  */
+
+static void
+m2pp_imagpart_expr (pretty *s, tree t)
+{
+  m2pp_print (s, "IM(");
+  m2pp_needspace (s);
+  if (TREE_CODE (t) == IMAGPART_EXPR)
+    m2pp_expression (s, TREE_OPERAND (t, 0));
+  else if (TREE_CODE (t) == COMPLEX_CST)
+    m2pp_expression (s, TREE_IMAGPART (t));
+  m2pp_needspace (s);
+  m2pp_print (s, ")");
+}
+
+/* m2pp_realpart_expr handle imagpart_expr tree.  */
+
+static void
+m2pp_realpart_expr (pretty *s, tree t)
+{
+  m2pp_print (s, "RE(");
+  m2pp_needspace (s);
+  if (TREE_CODE (t) == REALPART_EXPR)
+    m2pp_expression (s, TREE_OPERAND (t, 0));
+  else if (TREE_CODE (t) == COMPLEX_CST)
+    m2pp_expression (s, TREE_REALPART (t));
+  m2pp_needspace (s);
+  m2pp_print (s, ")");
+}
+
+/* m2pp_bit_ior_expr generate a C style bit or.  */
+
+static void
+m2pp_bit_ior_expr (pretty *s, tree t)
+{
+  m2pp_binary (s, t, "|");
+}
+
+/* m2pp_truth_expr.  */
+
+static void
+m2pp_truth_expr (pretty *s, tree t, const char *op)
+{
+  m2pp_print (s, "(");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, ")");
+  m2pp_needspace (s);
+  m2pp_print (s, op);
+  m2pp_needspace (s);
+  m2pp_print (s, "(");
+  m2pp_expression (s, TREE_OPERAND (t, 1));
+  m2pp_print (s, ")");
+}
+
+/* m2pp_simple_expression handle GCC expression tree.  */
+
+static void
+m2pp_simple_expression (pretty *s, tree t)
+{
+  enum tree_code code = TREE_CODE (t);
+
+  switch (code)
+    {
+    case ERROR_MARK:
+      m2pp_print (s, "(* !!! ERROR NODE !!! *)");
+      break;
+    case CONSTRUCTOR:
+      m2pp_constructor (s, t);
+      break;
+    case IDENTIFIER_NODE:
+      m2pp_ident_pointer (s, t);
+      break;
+    case PARM_DECL:
+      m2pp_identifier (s, t);
+      break;
+    case FIELD_DECL:
+      m2pp_identifier (s, t);
+      break;
+    case TREE_LIST:
+      m2pp_list (s, t);
+      break;
+    case BLOCK:
+      m2pp_print (s, "(* BLOCK NODE *)");
+      break;
+    case OFFSET_TYPE:
+      m2pp_offset (s, t);
+      break;
+    case INTEGER_CST:
+      m2pp_integer_cst (s, t);
+      break;
+    case REAL_CST:
+      m2pp_real_cst (s, t);
+      break;
+    case STRING_CST:
+      m2pp_string_cst (s, t);
+      break;
+    case INDIRECT_REF:
+      m2pp_indirect_ref (s, t);
+      break;
+    case ADDR_EXPR:
+      m2pp_addr_expr (s, t);
+      break;
+    case NOP_EXPR:
+      m2pp_nop (s, t);
+      break;
+    case CONVERT_EXPR:
+      m2pp_convert (s, t);
+      break;
+    case VAR_DECL:
+      m2pp_var_decl (s, t);
+      break;
+    case RESULT_DECL:
+      m2pp_result_decl (s, t);
+      break;
+    case PLUS_EXPR:
+      m2pp_binary (s, t, "+");
+      break;
+    case MINUS_EXPR:
+      m2pp_binary (s, t, "-");
+      break;
+    case MULT_EXPR:
+      m2pp_binary (s, t, "*");
+      break;
+    case FLOOR_DIV_EXPR:
+    case CEIL_DIV_EXPR:
+    case TRUNC_DIV_EXPR:
+    case ROUND_DIV_EXPR:
+      m2pp_binary (s, t, "DIV");
+      break;
+    case FLOOR_MOD_EXPR:
+    case CEIL_MOD_EXPR:
+    case TRUNC_MOD_EXPR:
+    case ROUND_MOD_EXPR:
+      m2pp_binary (s, t, "MOD");
+      break;
+    case NEGATE_EXPR:
+      m2pp_unary (s, t, "-");
+      break;
+    case CALL_EXPR:
+      m2pp_call_expr (s, t);
+      break;
+    case SSA_NAME:
+      m2pp_ssa (s, t);
+      break;
+    case COMPONENT_REF:
+      m2pp_component_ref (s, t);
+      break;
+    case RETURN_EXPR:
+      m2pp_return_expr (s, t);
+      break;
+    case ARRAY_REF:
+      m2pp_array_ref (s, t);
+      break;
+    case NON_LVALUE_EXPR:
+      m2pp_non_lvalue_expr (s, t);
+      break;
+    case EXPR_STMT:
+      m2pp_expression (s, EXPR_STMT_EXPR (t));
+      break;
+#if 0
+    case EXC_PTR_EXPR:
+      m2pp_print (s, "GCC_EXCEPTION_OBJECT");
+      break;
+#endif
+    case INIT_EXPR:
+    case MODIFY_EXPR:
+      m2pp_assignment (s, t);
+      break;
+    case COMPOUND_EXPR:
+      m2pp_compound_expression (s, t);
+      break;
+    case TARGET_EXPR:
+      m2pp_target_expression (s, t);
+      break;
+    case THROW_EXPR:
+      m2pp_throw (s, t);
+      break;
+    case FUNCTION_DECL:
+      m2pp_identifier (s, t);
+      break;
+    case COMPLEX_EXPR:
+      m2pp_complex_expr (s, t);
+      break;
+    case REALPART_EXPR:
+      m2pp_realpart_expr (s, t);
+      break;
+    case IMAGPART_EXPR:
+      m2pp_imagpart_expr (s, t);
+      break;
+    case CONST_DECL:
+      m2pp_identifier (s, t);
+      break;
+    case POINTER_PLUS_EXPR:
+      m2pp_binary (s, t, "+");
+      break;
+    case CLEANUP_POINT_EXPR:
+      m2pp_cleanup_point_expr (s, t);
+      break;
+    case BIT_IOR_EXPR:
+      m2pp_bit_ior_expr (s, t);
+      break;
+    case TRUTH_ANDIF_EXPR:
+      m2pp_truth_expr (s, t, "AND");
+      break;
+    case TRUTH_ORIF_EXPR:
+      m2pp_truth_expr (s, t, "OR");
+      break;
+    default:
+      m2pp_unknown (s, __FUNCTION__, get_tree_code_name (code));
+    }
+}
+
+/* non_lvalue_expr indicates that operand 0 is not an lvalue.  */
+
+static void
+m2pp_non_lvalue_expr (pretty *s, tree t)
+{
+  m2pp_needspace (s);
+  m2pp_print (s, "assert_non_lvalue(");
+  m2pp_needspace (s);
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_needspace (s);
+  m2pp_print (s, ")");
+}
+
+/* m2pp_array_ref prints out the array reference.  */
+
+static void
+m2pp_array_ref (pretty *s, tree t)
+{
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, "[");
+  m2pp_expression (s, TREE_OPERAND (t, 1));
+  m2pp_print (s, "]");
+}
+
+/* m2pp_ssa prints out the ssa variable name.  */
+
+static void
+m2pp_ssa (pretty *s, tree t)
+{
+  m2pp_identifier (s, SSA_NAME_VAR (t));
+}
+
+/* m2pp_binary print the binary operator, p, and lhs, rhs.  */
+
+static void
+m2pp_binary (pretty *s, tree t, const char *p)
+{
+  tree left = TREE_OPERAND (t, 0);
+  tree right = TREE_OPERAND (t, 1);
+
+  m2pp_expression (s, left);
+  m2pp_needspace (s);
+  m2pp_print (s, p);
+  m2pp_needspace (s);
+  m2pp_expression (s, right);
+}
+
+/* m2pp_unary print the unary operator, p, and expression.  */
+
+static void
+m2pp_unary (pretty *s, tree t, const char *p)
+{
+  tree expr = TREE_OPERAND (t, 0);
+
+  m2pp_needspace (s);
+  m2pp_print (s, p);
+  m2pp_expression (s, expr);
+}
+
+/* m2pp_integer_cst displays the integer constant.  */
+
+static void
+m2pp_integer_cst (pretty *s, tree t)
+{
+  char val[100];
+
+  snprintf (val, 100, "%lud", TREE_INT_CST_LOW (t));
+  m2pp_print (s, val);
+}
+
+/* m2pp_real_cst displays the real constant.  */
+
+static void
+m2pp_real_cst (pretty *s, tree t ATTRIBUTE_UNUSED)
+{
+  m2pp_print (s, "<unknown real>");
+}
+
+/* m2pp_string_cst displays the real constant.  */
+
+static void
+m2pp_string_cst (pretty *s, tree t)
+{
+  const char *p = TREE_STRING_POINTER (t);
+  int i = 0;
+
+  m2pp_print (s, "\"");
+  while (p[i] != '\0')
+    {
+      m2pp_print_char (s, p[i]);
+      i++;
+    }
+  m2pp_print (s, "\"");
+}
+
+/* m2pp_statement_sequence iterates over a statement list
+   displaying each statement in turn.  */
+
+static void
+m2pp_statement_sequence (pretty *s, tree t)
+{
+  if (t != NULL_TREE)
+    {
+      if (TREE_CODE (t) == STATEMENT_LIST)
+        {
+          tree_stmt_iterator i;
+          m2pp_print (s, "(* statement list *)\n");
+
+          for (i = tsi_start (t); !tsi_end_p (i); tsi_next (&i))
+            m2pp_statement (s, *tsi_stmt_ptr (i));
+        }
+      else
+        m2pp_statement (s, t);
+    }
+}
+
+/* m2pp_unknown displays an error message.  */
+
+static void
+m2pp_unknown (pretty *s, const char *s1, const char *s2)
+{
+  m2pp_begin (s);
+  m2pp_print (s, s1);
+  m2pp_needspace (s);
+  m2pp_print (s, s2);
+  m2pp_needspace (s);
+}
+
+/* m2pp_throw displays a throw statement.  */
+
+static void
+m2pp_throw (pretty *s, tree t)
+{
+  tree expr = TREE_OPERAND (t, 0);
+
+  m2pp_begin (s);
+  if (expr == NULL_TREE)
+    m2pp_print (s, "THROW ;\n");
+  else
+    {
+      m2pp_print (s, "THROW (");
+      m2pp_expression (s, TREE_OPERAND (t, 0));
+      m2pp_print (s, ")\n");
+    }
+}
+
+/* m2pp_catch_expr attempts to reconstruct a catch expr.  */
+
+static void
+m2pp_catch_expr (pretty *s, tree t)
+{
+  tree types = CATCH_TYPES (t);
+  tree body = CATCH_BODY (t);
+
+  m2pp_print (s, "(* CATCH expression ");
+  if (types != NULL_TREE)
+    {
+      m2pp_print (s, "(");
+      m2pp_expression (s, types);
+      m2pp_print (s, ")");
+    }
+  m2pp_print (s, "*)\n");
+  m2pp_print (s, "(* catch body *)\n");
+  m2pp_statement_sequence (s, body);
+  m2pp_print (s, "(* end catch body *)\n");
+}
+
+/* m2pp_try_finally_expr attemts to reconstruct a try finally expr.  */
+
+static void
+m2pp_try_finally_expr (pretty *s, tree t)
+{
+  m2pp_begin (s);
+  m2pp_print (s, "(* try_finally_expr *)\n");
+  setindent (s, getindent (s) + 3);
+  m2pp_statement_sequence (s, TREE_OPERAND (t, 0));
+  setindent (s, getindent (s) - 3);
+  m2pp_print (s,
+              "(* finally (cleanup which is executed after the above) *)\n");
+  setindent (s, getindent (s) + 3);
+  m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
+  setindent (s, getindent (s) - 3);
+  m2pp_print (s, "(* end try_finally_expr *)\n");
+}
+
+#if !defined(GM2)
+/* m2pp_if_stmt pretty print a C++ if_stmt.  */
+
+static void
+m2pp_if_stmt (pretty *s, tree t)
+{
+  m2pp_print (s, "(* only C++ uses if_stmt nodes *)\n");
+  m2pp_print (s, "IF ");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, "\n");
+  m2pp_print (s, "THEN\n");
+  setindent (s, getindent (s) + 3);
+  m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
+  setindent (s, getindent (s) - 3);
+  m2pp_print (s, "ELSE\n");
+  setindent (s, getindent (s) + 3);
+  m2pp_statement_sequence (s, TREE_OPERAND (t, 2));
+  setindent (s, getindent (s) - 3);
+  m2pp_print (s, "END\n");
+}
+#endif
+
+/* m2pp_statement attempts to reconstruct a statement.  */
+
+static void
+m2pp_statement (pretty *s, tree t)
+{
+  enum tree_code code = TREE_CODE (t);
+
+  m2pp_loc (s, t);
+  switch (code)
+    {
+    case COND_EXPR:
+      m2pp_conditional (s, t);
+      break;
+    case LABEL_EXPR:
+      m2pp_label_expr (s, t);
+      break;
+    case LABEL_DECL:
+      m2pp_label_decl (s, t);
+      break;
+    case GOTO_EXPR:
+      m2pp_goto (s, t);
+      break;
+    case INIT_EXPR:
+    case MODIFY_EXPR:
+      m2pp_assignment (s, t);
+      break;
+    case CALL_EXPR:
+      m2pp_procedure_call (s, t);
+      break;
+    case BLOCK:
+      m2pp_block_list (s, t);
+      break;
+    case BIND_EXPR:
+      m2pp_bind_expr (s, t);
+      break;
+    case RETURN_EXPR:
+      m2pp_return_expr (s, t);
+      break;
+    case DECL_EXPR:
+      m2pp_decl_expr (s, t);
+      break;
+    case TRY_BLOCK:
+      m2pp_try_block (s, t);
+      break;
+    case HANDLER:
+      m2pp_handler (s, t);
+      break;
+    case CLEANUP_POINT_EXPR:
+      m2pp_cleanup_point_expr (s, t);
+      break;
+    case THROW_EXPR:
+      m2pp_throw (s, t);
+      break;
+    case TRY_CATCH_EXPR:
+      m2pp_try_catch_expr (s, t);
+      break;
+    case TRY_FINALLY_EXPR:
+      m2pp_try_finally_expr (s, t);
+      break;
+    case CATCH_EXPR:
+      m2pp_catch_expr (s, t);
+      break;
+#if defined(CPP)
+    case IF_STMT:
+      m2pp_if_stmt (s, t);
+      break;
+#endif
+    case ERROR_MARK:
+      m2pp_print (s, "<ERROR CODE>\n");
+      break;
+    default:
+      m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
+    }
+}
+
+/* m2pp_try_catch_expr is used after gimplification.  */
+
+static void
+m2pp_try_catch_expr (pretty *s, tree t)
+{
+  m2pp_print (s, "(* try_catch_expr begins *)\n");
+  m2pp_statement_sequence (s, TREE_OPERAND (t, 0));
+  setindent (s, 0);
+  m2pp_print (s, "EXCEPT\n");
+  setindent (s, 3);
+  m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
+  m2pp_print (s, "(* try_catch_expr ends *)\n");
+}
+
+/* m2pp_cleanup_point_expr emits a comment indicating a GCC
+   cleanup_point_expr is present.  */
+
+static void
+m2pp_cleanup_point_expr (pretty *s, tree t)
+{
+  m2pp_begin (s);
+  m2pp_print (s, "(* cleanup point begins *)\n");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, "(* cleanup point ends *)\n");
+}
+
+/* m2pp_decl_expr displays a local declaration.  */
+
+static void
+m2pp_decl_expr (pretty *s, tree t)
+{
+  m2pp_var (s);
+  m2pp_print (s, "(* variable in decl_expr *)\n");
+  m2pp_var_type_decl (s, DECL_EXPR_DECL (t));
+}
+
+/* m2pp_procedure_call print a call to a procedure.  */
+
+static void
+m2pp_procedure_call (pretty *s, tree t)
+{
+  m2pp_begin (s);
+  m2pp_call_expr (s, t);
+  m2pp_needspace (s);
+  m2pp_print (s, ";\n");
+}
+
+/* args displays each argument in an iter list by calling expression.  */
+
+static void
+m2pp_args (pretty *s, tree e)
+{
+  call_expr_arg_iterator iter;
+  tree arg;
+
+  m2pp_print (s, "(");
+  m2pp_needspace (s);
+  FOR_EACH_CALL_EXPR_ARG (arg, iter, e)
+  {
+    m2pp_expression (s, arg);
+    if (more_call_expr_args_p (&iter))
+      {
+        m2pp_print (s, ",");
+        m2pp_needspace (s);
+      }
+  }
+  m2pp_print (s, ")");
+}
+
+/* m2pp_call_expr print a call to a procedure or function.  */
+
+static void
+m2pp_call_expr (pretty *s, tree t)
+{
+  tree call = CALL_EXPR_FN (t);
+  tree args = TREE_OPERAND (t, 1);
+  tree type = TREE_TYPE (t);
+  int has_return_type = TRUE;
+  tree proc;
+
+  if (type && (TREE_CODE (type) == VOID_TYPE))
+    has_return_type = FALSE;
+
+  if (TREE_CODE (call) == ADDR_EXPR || TREE_CODE (call) == NON_LVALUE_EXPR)
+    proc = TREE_OPERAND (call, 0);
+  else
+    proc = call;
+
+  m2pp_expression (s, proc);
+  if (args || has_return_type)
+    m2pp_args (s, t);
+}
+
+/* m2pp_return_expr displays the return statement.  */
+
+static void
+m2pp_return_expr (pretty *s, tree t)
+{
+  tree e = TREE_OPERAND (t, 0);
+
+  m2pp_begin (s);
+  if (e == NULL_TREE)
+    {
+      m2pp_print (s, "RETURN");
+    }
+  else if (TREE_CODE (e) == MODIFY_EXPR || (TREE_CODE (e) == INIT_EXPR))
+    {
+      m2pp_assignment (s, e);
+      m2pp_print (s, "RETURN");
+      m2pp_needspace (s);
+      m2pp_expression (s, TREE_OPERAND (e, 0));
+    }
+  else
+    {
+      m2pp_print (s, "RETURN");
+      m2pp_needspace (s);
+      m2pp_expression (s, e);
+    }
+  m2pp_needspace (s);
+  m2pp_print (s, ";\n");
+}
+
+/* m2pp_try_block displays the try block.  */
+
+static void
+m2pp_try_block (pretty *s, tree t)
+{
+  tree stmts = TRY_STMTS (t);
+  tree handlers = TRY_HANDLERS (t);
+
+  m2pp_begin (s);
+  m2pp_print (s, "(* TRY *)\n");
+  m2pp_statement_sequence (s, stmts);
+  setindent (s, 0);
+  m2pp_print (s, "EXCEPT\n");
+  setindent (s, 3);
+  m2pp_statement_sequence (s, handlers);
+  m2pp_print (s, "(* END TRY *)\n");
+}
+
+/* m2pp_try_block displays the handler block.  */
+
+static void
+m2pp_handler (pretty *s, tree t)
+{
+  tree parms = HANDLER_PARMS (t);
+  tree body = HANDLER_BODY (t);
+  tree type = HANDLER_TYPE (t);
+
+  m2pp_print (s, "(* handler *)\n");
+  if (parms != NULL_TREE)
+    {
+      m2pp_print (s, "(* handler parameter has a type (should be NULL_TREE) "
+                     "in Modula-2 *)\n");
+      m2pp_print (s, "CATCH (");
+      m2pp_expression (s, parms);
+      m2pp_print (s, ")\n");
+    }
+  if (type != NULL_TREE)
+    m2pp_print (s, "(* handler type (should be NULL_TREE) in Modula-2 *)\n");
+  m2pp_statement_sequence (s, body);
+}
+
+/* m2pp_assignment prints out the assignment statement.  */
+
+static void
+m2pp_assignment (pretty *s, tree t)
+{
+  int o;
+
+  m2pp_begin (s);
+  m2pp_designator (s, TREE_OPERAND (t, 0));
+  m2pp_needspace (s);
+  m2pp_print (s, ":=");
+  m2pp_needspace (s);
+  o = getindent (s);
+  setindent (s, getcurpos (s) + 1);
+  m2pp_expression (s, TREE_OPERAND (t, 1));
+  m2pp_needspace (s);
+  m2pp_print (s, ";\n");
+  setindent (s, o);
+}
+
+/* m2pp_designator displays the lhs of an assignment.  */
+
+static void
+m2pp_designator (pretty *s, tree t)
+{
+  m2pp_expression (s, t);
+}
+
+/* m2pp_indirect_ref displays the indirect operator.  */
+
+static void
+m2pp_indirect_ref (pretty *s, tree t)
+{
+  m2pp_print (s, "(");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, ")^");
+}
+
+/* m2pp_conditional builds an IF THEN ELSE END.  With more work
+   this should be moved into statement sequence which could look for
+   repeat and while loops.  */
+
+static void
+m2pp_conditional (pretty *s, tree t)
+{
+  int o;
+
+  m2pp_begin (s);
+  m2pp_print (s, "IF");
+  m2pp_needspace (s);
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, "\nTHEN\n");
+  o = getindent (s);
+  setindent (s, o + 3);
+  m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
+  setindent (s, o);
+  if (TREE_OPERAND (t, 2) != NULL_TREE)
+    {
+      m2pp_print (s, "ELSE\n");
+      setindent (s, o + 3);
+      m2pp_statement_sequence (s, TREE_OPERAND (t, 2));
+      setindent (s, o);
+    }
+  m2pp_print (s, "END ;\n");
+}
+
+/* m2pp_label_decl displays a label.  Again should be moved into
+   statement sequence to determine proper loop constructs.  */
+
+static void
+m2pp_label_decl (pretty *s, tree t)
+{
+  m2pp_begin (s);
+  m2pp_print (s, "(* label  ");
+  m2pp_identifier (s, t);
+  m2pp_print (s, ": *)\n");
+}
+
+/* m2pp_label_expr skips the LABEL_EXPR to find the LABEL_DECL.  */
+
+static void
+m2pp_label_expr (pretty *s, tree t)
+{
+  m2pp_begin (s);
+  m2pp_statement (s, TREE_OPERAND (t, 0));
+}
+
+/* m2pp_goto displays a goto statement.  Again should be moved into
+   statement sequence to determine proper loop constructs.  */
+
+static void
+m2pp_goto (pretty *s, tree t)
+{
+  m2pp_begin (s);
+  m2pp_print (s, "(* goto ");
+  m2pp_identifier (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, " *)\n");
+}
+
+/* m2pp_list prints a TREE_CHAINed list.  */
+
+static void
+m2pp_list (pretty *s, tree t)
+{
+  tree u = t;
+
+  m2pp_print (s, "(");
+  m2pp_needspace (s);
+  while (t != NULL_TREE)
+    {
+      m2pp_expression (s, TREE_VALUE (t));
+      t = TREE_CHAIN (t);
+      if (t == u || t == NULL_TREE)
+        break;
+      m2pp_print (s, ",");
+      m2pp_needspace (s);
+    }
+  m2pp_needspace (s);
+  m2pp_print (s, ")");
+}
+
+/* m2pp_offset displays the offset operator.  */
+
+static void
+m2pp_offset (pretty *s, tree t)
+{
+  tree type = TREE_TYPE (t);
+  tree base = TYPE_OFFSET_BASETYPE (t);
+
+  m2pp_print (s, "OFFSET (");
+  m2pp_type (s, base);
+  m2pp_print (s, ".");
+  m2pp_type (s, type);
+  m2pp_print (s, ")");
+}
+
+/* m2pp_addr_expr create an ADR expression.  */
+
+static void
+m2pp_addr_expr (pretty *s, tree t)
+{
+  m2pp_needspace (s);
+  m2pp_print (s, "ADR (");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, ")");
+}
+
+/* m2pp_nop generate a CAST expression.  */
+
+static void
+m2pp_nop (pretty *s, tree t)
+{
+  m2pp_needspace (s);
+  m2pp_print (s, "CAST (");
+  m2pp_simple_type (s, TREE_TYPE (t));
+  m2pp_print (s, ", ");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, ")");
+}
+
+/* m2pp_convert generate a CONVERT expression.  */
+
+static void
+m2pp_convert (pretty *s, tree t)
+{
+  m2pp_needspace (s);
+  m2pp_print (s, "CONVERT (");
+  m2pp_simple_type (s, TREE_TYPE (t));
+  m2pp_print (s, ", ");
+  m2pp_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, ")");
+}
+
+/* m2pp_var_decl generate a variable.  */
+
+static void
+m2pp_var_decl (pretty *s, tree t)
+{
+  m2pp_identifier (s, t);
+}
+
+/* m2pp_result_decl generate a result declaration (variable).  */
+
+static void
+m2pp_result_decl (pretty *s, tree t)
+{
+  m2pp_identifier (s, t);
+}
+
+/* m2pp_component_ref generate a record field access.  */
+
+static void
+m2pp_component_ref (pretty *s, tree t)
+{
+  m2pp_simple_expression (s, TREE_OPERAND (t, 0));
+  m2pp_print (s, ".");
+  m2pp_simple_expression (s, TREE_OPERAND (t, 1));
+}
+
+}
diff --git a/gcc/m2/m2pp.h b/gcc/m2/m2pp.h
new file mode 100644
index 00000000000..67419c69ef5
--- /dev/null
+++ b/gcc/m2/m2pp.h
@@ -0,0 +1,43 @@
+/* m2pp.h pretty print trees, output in Modula-2 where possible.
+
+Copyright (C) 2007-2022 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(M2PP_H)
+#   define M2PP_H
+
+#   if defined(M2PP_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+namespace modula2 {
+/* These functions allow a maintainer to dump the trees in Modula-2.  */
+
+EXTERN void pf (tree t);
+EXTERN void pe (tree t);
+EXTERN void pt (tree t);
+EXTERN void ptl (tree t);
+EXTERN void pv (tree t);
+EXTERN void ptcl (tree t);
+}
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot-ch/GBuiltins.c b/gcc/m2/mc-boot-ch/GBuiltins.c
new file mode 100644
index 00000000000..826fa1003e9
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GBuiltins.c
@@ -0,0 +1,43 @@
+/* GBuiltins.c dummy module to aid linking mc projects.
+
+Copyright (C) 2016-2022 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)
+{
+}
diff --git a/gcc/m2/mc-boot-ch/GM2LINK.c b/gcc/m2/mc-boot-ch/GM2LINK.c
new file mode 100644
index 00000000000..302f219ed5f
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GM2LINK.c
@@ -0,0 +1,27 @@
+/* GM2LINK.c a handwritten module for mc.
+
+Copyright (C) 2022 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;
diff --git a/gcc/m2/mc-boot-ch/GRTco.c b/gcc/m2/mc-boot-ch/GRTco.c
new file mode 100644
index 00000000000..f960885d359
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GRTco.c
@@ -0,0 +1,126 @@
+/* RTco.c provides dummy access to thread primitives.
+
+Copyright (C) 2019-2022 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)
+{
+}
+
+
+EXTERN
+void
+_M2_RTco_init (void)
+{
+}
+
+EXTERN
+void
+_M2_RTco_finish (void)
+{
+}
diff --git a/gcc/m2/mc-boot-ch/GSYSTEM.c b/gcc/m2/mc-boot-ch/GSYSTEM.c
new file mode 100644
index 00000000000..a2855ac605c
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GSYSTEM.c
@@ -0,0 +1,38 @@
+/* GSYSTEM.c a handwritten dummy module for mc.
+
+Copyright (C) 2018-2022 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)
+{
+}
diff --git a/gcc/m2/mc-boot-ch/GSelective.c b/gcc/m2/mc-boot-ch/GSelective.c
new file mode 100644
index 00000000000..17be47c129d
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GSelective.c
@@ -0,0 +1,275 @@
+/* GSelective.c provides access to select for Modula-2.
+
+Copyright (C) 2016-2022 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 ()
+{
+}
diff --git a/gcc/m2/mc-boot-ch/GSysExceptions.c b/gcc/m2/mc-boot-ch/GSysExceptions.c
new file mode 100644
index 00000000000..f6cddf92fe1
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GSysExceptions.c
@@ -0,0 +1,237 @@
+/* GSysExceptions.c low level module interfacing exceptions to the OS.
+
+Copyright (C) 2016-2022 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_finish (void)
+{
+}
diff --git a/gcc/m2/mc-boot-ch/GUnixArgs.cc b/gcc/m2/mc-boot-ch/GUnixArgs.cc
new file mode 100644
index 00000000000..1180f351b24
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GUnixArgs.cc
@@ -0,0 +1,91 @@
+/* UnixArgs.cc record argc, argv as global variables.
+
+Copyright (C) 2009-2022 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 "m2rts.h"
+
+
+extern "C" int UnixArgs_GetArgC (void);
+extern "C" char **UnixArgs_GetArgV (void);
+extern "C" char **UnixArgs_GetEnvV (void);
+
+static int UnixArgs_ArgC;
+static char **UnixArgs_ArgV;
+static char **UnixArgs_EnvV;
+
+
+/* GetArgC returns argc.  */
+
+extern "C" int
+UnixArgs_GetArgC (void)
+{
+  return UnixArgs_ArgC;
+}
+
+
+/* GetArgV returns argv.  */
+
+extern "C" char **
+UnixArgs_GetArgV (void)
+{
+  return UnixArgs_ArgV;
+}
+
+
+/* GetEnvV returns envv.  */
+
+extern "C" char **
+UnixArgs_GetEnvV (void)
+{
+  return UnixArgs_EnvV;
+}
+
+
+extern "C" void
+_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+{
+  UnixArgs_ArgC = argc;
+  UnixArgs_ArgV = argv;
+  UnixArgs_EnvV = envp;
+}
+
+extern "C" void
+_M2_UnixArgs_finish (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_UnixArgs_dep (void)
+{
+}
+
+struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
+
+_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
+{
+  M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_finish,
+			_M2_UnixArgs_dep);
+}
diff --git a/gcc/m2/mc-boot-ch/Gabort.c b/gcc/m2/mc-boot-ch/Gabort.c
new file mode 100644
index 00000000000..5ebd94de3ac
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gabort.c
@@ -0,0 +1,30 @@
+/* Gabort.c a GCC style abort function.
+
+Copyright (C) 2022 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);
+}
diff --git a/gcc/m2/mc-boot-ch/Gcbuiltin.c b/gcc/m2/mc-boot-ch/Gcbuiltin.c
new file mode 100644
index 00000000000..76592136c15
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gcbuiltin.c
@@ -0,0 +1,173 @@
+/* Gcbuiltin.c provides access to some math intrinsic functions.
+
+Copyright (C) 2016-2022 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);
+}
diff --git a/gcc/m2/mc-boot-ch/Gdtoa.c b/gcc/m2/mc-boot-ch/Gdtoa.c
new file mode 100644
index 00000000000..07ef6be7013
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gdtoa.c
@@ -0,0 +1,184 @@
+/* Gdtoa.c provides access to double string conversion.
+
+Copyright (C) 2016-2022 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
diff --git a/gcc/m2/mc-boot-ch/Gerrno.c b/gcc/m2/mc-boot-ch/Gerrno.c
new file mode 100644
index 00000000000..36e577704c5
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gerrno.c
@@ -0,0 +1,54 @@
+/* Gerrno.c provides access to errno for Modula-2.
+
+Copyright (C) 2016-2022 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_finish (int argc, char *p)
+{
+}
+
+#   ifdef __cplusplus
+}
+#   endif
diff --git a/gcc/m2/mc-boot-ch/Gldtoa.c b/gcc/m2/mc-boot-ch/Gldtoa.c
new file mode 100644
index 00000000000..84e6954af3f
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gldtoa.c
@@ -0,0 +1,107 @@
+/* Gldtoa.c provides access to long double string conversion.
+
+Copyright (C) 2016-2022 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
diff --git a/gcc/m2/mc-boot-ch/Glibc.c b/gcc/m2/mc-boot-ch/Glibc.c
new file mode 100644
index 00000000000..501da7803a1
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Glibc.c
@@ -0,0 +1,242 @@
+/* Glibc.c provides access to some libc functions.
+
+Copyright (C) 2016-2022 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
+void *
+libc_malloc (unsigned int size)
+{
+  return malloc (size);
+}
+
+EXTERN
+void
+libc_free (void *p)
+{
+  free (p);
+}
+
+EXTERN
+char *
+libc_strcpy (char *dest, char *src)
+{
+  return strcpy (dest, src);
+}
+
+EXTERN
+char *
+libc_strncpy (char *dest, char *src, int n)
+{
+  return strncpy (dest, src, n);
+}
+
+EXTERN
+int
+libc_unlink (char *p)
+{
+  return unlink (p);
+}
+
+EXTERN
+int
+libc_system (char *command)
+{
+  return system (command);
+}
+
+EXTERN
+void *
+libc_memcpy (void *dest, void *src, int n)
+{
+  return memcpy (dest, src, n);
+}
+
+EXTERN
+char *
+libc_getenv (char *name)
+{
+  return getenv (name);
+}
+
+EXTERN
+int
+libc_putenv (char *name)
+{
+  return putenv (name);
+}
+
+EXTERN
+int
+libc_creat (char *p, mode_t mode)
+{
+  return creat (p, mode);
+}
+
+EXTERN
+int
+libc_open (char *p, int flags, mode_t mode)
+{
+  return open (p, flags, mode);
+}
+
+EXTERN
+off_t
+libc_lseek (int fd, off_t offset, int whence)
+{
+  return lseek (fd, offset, whence);
+}
+
+EXTERN
+void *
+libc_realloc (void *ptr, size_t size)
+{
+  return realloc (ptr, size);
+}
+
+EXTERN
+void *
+libc_memset (void *s, int c, size_t n)
+{
+  return memset (s, c, n);
+}
+
+EXTERN
+void *
+libc_memmove (void *dest, void *src, size_t n)
+{
+  return memmove (dest, src, n);
+}
+
+EXTERN
+int
+libc_getpid (void)
+{
+  return getpid ();
+}
+
+EXTERN
+unsigned int
+libc_sleep (unsigned int s)
+{
+  return sleep (s);
+}
+
+EXTERN
+int
+libc_atexit (void (*function) (void))
+{
+  return atexit (function);
+}
diff --git a/gcc/m2/mc-boot-ch/Glibm.c b/gcc/m2/mc-boot-ch/Glibm.c
new file mode 100644
index 00000000000..16c669386d0
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Glibm.c
@@ -0,0 +1,224 @@
+/* Glibm.c provides access to some libm functions.
+
+Copyright (C) 2016-2022 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);
+}
diff --git a/gcc/m2/mc-boot-ch/Gmcrts.c b/gcc/m2/mc-boot-ch/Gmcrts.c
new file mode 100644
index 00000000000..c965e596bfc
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gmcrts.c
@@ -0,0 +1,54 @@
+/* Gmcrts.c implements case and return exceptions.
+
+Copyright (C) 2016-2022 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
diff --git a/gcc/m2/mc-boot-ch/Gmcrts.h b/gcc/m2/mc-boot-ch/Gmcrts.h
new file mode 100644
index 00000000000..0e04751d930
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gmcrts.h
@@ -0,0 +1,37 @@
+/* Gmcrts.h provides prototypes to case and return exceptions.
+
+Copyright (C) 2016-2022 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(MCRTS_H)
+#define MCRTS_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void CaseException (const char *s, unsigned int high, unsigned int lineno);
+void ReturnException (const char *s, unsigned int high, unsigned int lineno);
+/* void throw (int n);  */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff --git a/gcc/m2/mc-boot-ch/Gnetwork.h b/gcc/m2/mc-boot-ch/Gnetwork.h
new file mode 100644
index 00000000000..6ea86d01e4b
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gnetwork.h
@@ -0,0 +1,56 @@
+/* Gnetwork.h provides prototypes to htonl and htons.
+
+Copyright (C) 2016-2022 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(_network_H)
+#define _network_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#if !defined(PROC_D)
+#define PROC_D
+typedef void (*PROC_t) (void);
+typedef struct
+{
+  PROC_t proc;
+} PROC;
+#endif
+
+#if defined(_network_C)
+#define EXTERN
+#else
+#define EXTERN extern
+#endif
+
+/* htons returns a network ordered SHORTCARD.  */
+
+EXTERN short unsigned int network_htons (short unsigned int s);
+
+/* htonl returns a network ordered CARDINAL.  */
+
+EXTERN unsigned int network_htonl (unsigned int s);
+
+#ifdef __cplusplus
+}
+#endif
+
+#undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot-ch/Gtermios.cc b/gcc/m2/mc-boot-ch/Gtermios.cc
new file mode 100644
index 00000000000..79c22005804
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gtermios.cc
@@ -0,0 +1,1947 @@
+/* Gtermios.c handwritten module for mc.
+
+Copyright (C) 2010-2022 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 HAVE_TERMIOS_H
+# include <termios.h>
+#endif
+
+#ifdef TERMIOS_NEEDS_XOPEN_SOURCE
+#define _XOPEN_SOURCE
+#endif
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+#define EXPORT(X) termios##_##X
+
+typedef enum {
+  vintr,
+  vquit,
+  verase,
+  vkill,
+  veof,
+  vtime,
+  vmin,
+  vswtc,
+  vstart,
+  vstop,
+  vsusp,
+  veol,
+  vreprint,
+  vdiscard,
+  vwerase,
+  vlnext,
+  veol2
+} ControlChar;
+
+typedef enum {
+  /* input flag bits.  */
+  ignbrk,
+  ibrkint,
+  ignpar,
+  iparmrk,
+  inpck,
+  istrip,
+  inlcr,
+  igncr,
+  icrnl,
+  iuclc,
+  ixon,
+  ixany,
+  ixoff,
+  imaxbel,
+  /* output flag bits.  */
+  opost,
+  olcuc,
+  onlcr,
+  ocrnl,
+  onocr,
+  onlret,
+  ofill,
+  ofdel,
+  onl0,
+  onl1,
+  ocr0,
+  ocr1,
+  ocr2,
+  ocr3,
+  otab0,
+  otab1,
+  otab2,
+  otab3,
+  obs0,
+  obs1,
+  off0,
+  off1,
+  ovt0,
+  ovt1,
+  /* baud rate.  */
+  b0,
+  b50,
+  b75,
+  b110,
+  b135,
+  b150,
+  b200,
+  b300,
+  b600,
+  b1200,
+  b1800,
+  b2400,
+  b4800,
+  b9600,
+  b19200,
+  b38400,
+  b57600,
+  b115200,
+  b240400,
+  b460800,
+  b500000,
+  b576000,
+  b921600,
+  b1000000,
+  b1152000,
+  b1500000,
+  b2000000,
+  b2500000,
+  b3000000,
+  b3500000,
+  b4000000,
+  maxbaud,
+  crtscts,
+  /* character size.  */
+  cs5,
+  cs6,
+  cs7,
+  cs8,
+  cstopb,
+  cread,
+  parenb,
+  parodd,
+  hupcl,
+  clocal,
+  /* local flags.  */
+  lisig,
+  licanon,
+  lxcase,
+  lecho,
+  lechoe,
+  lechok,
+  lechonl,
+  lnoflsh,
+  ltopstop,
+  lechoctl,
+  lechoprt,
+  lechoke,
+  lflusho,
+  lpendin,
+  liexten
+} Flag;
+
+int
+doSetUnset (tcflag_t *bitset, unsigned int mask, int value)
+{
+  if (value)
+    (*bitset) |= mask;
+  else
+    (*bitset) &= (~mask);
+  return 1;
+}
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* InitTermios - new data structure.  */
+
+void *
+EXPORT (InitTermios) (void)
+{
+  struct termios *p = (struct termios *)malloc (sizeof (struct termios));
+
+  memset (p, 0, sizeof (struct termios));
+  return p;
+}
+
+/* KillTermios - delete data structure.  */
+
+void *
+EXPORT (KillTermios) (struct termios *p)
+{
+  free (p);
+  return NULL;
+}
+
+/* tcsnow - return the value of TCSANOW.  */
+
+int
+EXPORT (tcsnow) (void)
+{
+  return TCSANOW;
+}
+
+/* tcsdrain - return the value of TCSADRAIN.  */
+
+int
+EXPORT (tcsdrain) (void)
+{
+  return TCSADRAIN;
+}
+
+/* tcsflush - return the value of TCSAFLUSH.  */
+
+int
+EXPORT (tcsflush) (void)
+{
+  return TCSAFLUSH;
+}
+
+/* cfgetospeed - return output baud rate.  */
+
+int
+EXPORT (cfgetospeed) (struct termios *t)
+{
+  return cfgetospeed (t);
+}
+
+/* cfgetispeed - return input baud rate.  */
+
+int
+EXPORT (cfgetispeed) (struct termios *t)
+{
+  return cfgetispeed (t);
+}
+
+/* cfsetospeed - set output baud rate.  */
+
+int
+EXPORT (cfsetospeed) (struct termios *t, unsigned int b)
+{
+  return cfsetospeed (t, b);
+}
+
+/* cfsetispeed - set input baud rate.  */
+
+int
+EXPORT (cfsetispeed) (struct termios *t, unsigned int b)
+{
+  return cfsetispeed (t, b);
+}
+
+/* cfsetspeed - set input and output baud rate.  */
+
+int
+EXPORT (cfsetspeed) (struct termios *t, unsigned int b)
+{
+  int val = cfsetispeed (t, b);
+  if (val == 0)
+    return cfsetospeed (t, b);
+  cfsetospeed (t, b);
+  return val;
+}
+
+/* tcgetattr - get state of, fd, into, t.  */
+
+int
+EXPORT (tcgetattr) (int fd, struct termios *t)
+{
+  return tcgetattr (fd, t);
+}
+
+/* tcsetattr - set state of, fd, to, t, using option.  */
+
+int
+EXPORT (tcsetattr) (int fd, int option, struct termios *t)
+{
+  return tcsetattr (fd, option, t);
+}
+
+/* cfmakeraw - sets the terminal to raw mode.  */
+
+void
+EXPORT (cfmakeraw) (struct termios *t)
+{
+#if defined(HAVE_CFMAKERAW)
+  return cfmakeraw (t);
+#endif
+}
+
+/* tcsendbreak - send zero bits for duration.  */
+
+int
+EXPORT (tcsendbreak) (int fd, int duration)
+{
+  return tcsendbreak (fd, duration);
+}
+
+/* tcdrain - waits for pending output to be written on, fd.  */
+
+int
+EXPORT (tcdrain) (int fd)
+{
+  return tcdrain (fd);
+}
+
+/* tcflushi - flush input.  */
+
+int
+EXPORT (tcflushi) (int fd)
+{
+#if defined(TCIFLUSH)
+  return tcflush (fd, TCIFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflusho - flush output.  */
+
+int
+EXPORT (tcflusho) (int fd)
+{
+#if defined(TCOFLUSH)
+  return tcflush (fd, TCOFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflushio - flush input and output.  */
+
+int
+EXPORT (tcflushio) (int fd)
+{
+#if defined(TCIOFLUSH)
+  return tcflush (fd, TCIOFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoni - restart input on, fd.  */
+
+int
+EXPORT (tcflowoni) (int fd)
+{
+#if defined(TCION)
+  return tcflow (fd, TCION);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoffi - stop input on, fd.  */
+
+int
+EXPORT (tcflowoffi) (int fd)
+{
+#if defined(TCIOFF)
+  return tcflow (fd, TCIOFF);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowono - restart output on, fd.  */
+
+int
+EXPORT (tcflowono) (int fd)
+{
+#if defined(TCOON)
+  return tcflow (fd, TCOON);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoffo - stop output on, fd.  */
+
+int
+EXPORT (tcflowoffo) (int fd)
+{
+#if defined(TCOOFF)
+  return tcflow (fd, TCOOFF);
+#else
+  return 1;
+#endif
+}
+
+/* GetFlag - sets a flag value from, t, in, b, and returns TRUE if,
+   t, supports, f.  */
+
+int
+EXPORT (GetFlag) (struct termios *t, Flag f, int *b)
+{
+  switch (f)
+    {
+
+    case ignbrk:
+#if defined(IGNBRK)
+      *b = ((t->c_iflag & IGNBRK) == IGNBRK);
+      return 1;
+#else
+      return 0;
+#endif
+    case ibrkint:
+#if defined(BRKINT)
+      *b = ((t->c_iflag & BRKINT) == BRKINT);
+      return 1;
+#else
+      return 0;
+#endif
+    case ignpar:
+#if defined(IGNPAR)
+      *b = ((t->c_iflag & IGNPAR) == IGNPAR);
+      return 1;
+#else
+      return 0;
+#endif
+    case iparmrk:
+#if defined(PARMRK)
+      *b = ((t->c_iflag & PARMRK) == PARMRK);
+      return 1;
+#else
+      return 0;
+#endif
+    case inpck:
+#if defined(INPCK)
+      *b = ((t->c_iflag & INPCK) == INPCK);
+      return 1;
+#else
+      return 0;
+#endif
+    case istrip:
+#if defined(ISTRIP)
+      *b = ((t->c_iflag & ISTRIP) == ISTRIP);
+      return 1;
+#else
+      return 0;
+#endif
+    case inlcr:
+#if defined(INLCR)
+      *b = ((t->c_iflag & INLCR) == INLCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case igncr:
+#if defined(IGNCR)
+      *b = ((t->c_iflag & IGNCR) == IGNCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case icrnl:
+#if defined(ICRNL)
+      *b = ((t->c_iflag & ICRNL) == ICRNL);
+      return 1;
+#else
+      return 0;
+#endif
+    case iuclc:
+#if defined(IUCLC)
+      *b = ((t->c_iflag & IUCLC) == IUCLC);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixon:
+#if defined(IXON)
+      *b = ((t->c_iflag & IXON) == IXON);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixany:
+#if defined(IXANY)
+      *b = ((t->c_iflag & IXANY) == IXANY);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixoff:
+#if defined(IXOFF)
+      *b = ((t->c_iflag & IXOFF) == IXOFF);
+      return 1;
+#else
+      return 0;
+#endif
+    case imaxbel:
+#if defined(IMAXBEL)
+      *b = ((t->c_iflag & IMAXBEL) == IMAXBEL);
+      return 1;
+#else
+      return 0;
+#endif
+    case opost:
+#if defined(OPOST)
+      *b = ((t->c_oflag & OPOST) == OPOST);
+      return 1;
+#else
+      return 0;
+#endif
+    case olcuc:
+#if defined(OLCUC)
+      *b = ((t->c_oflag & OLCUC) == OLCUC);
+      return 1;
+#else
+      return 0;
+#endif
+    case onlcr:
+#if defined(ONLCR)
+      *b = ((t->c_oflag & ONLCR) == ONLCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocrnl:
+#if defined(OCRNL)
+      *b = ((t->c_oflag & OCRNL) == OCRNL);
+      return 1;
+#else
+      return 0;
+#endif
+    case onocr:
+#if defined(ONOCR)
+      *b = ((t->c_oflag & ONOCR) == ONOCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case onlret:
+#if defined(ONLRET)
+      *b = ((t->c_oflag & ONLRET) == ONLRET);
+      return 1;
+#else
+      return 0;
+#endif
+    case ofill:
+#if defined(OFILL)
+      *b = ((t->c_oflag & OFILL) == OFILL);
+      return 1;
+#else
+      return 0;
+#endif
+    case ofdel:
+#if defined(OFDEL)
+      *b = ((t->c_oflag & OFDEL) == OFDEL);
+      return 1;
+#else
+      return 0;
+#endif
+    case onl0:
+#if defined(NL0)
+      *b = ((t->c_oflag & NL0) == NL0);
+      return 1;
+#else
+      return 0;
+#endif
+    case onl1:
+#if defined(NL1)
+      *b = ((t->c_oflag & NL1) == NL1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr0:
+#if defined(CR0)
+      *b = ((t->c_oflag & CR0) == CR0);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr1:
+#if defined(CR1)
+      *b = ((t->c_oflag & CR1) == CR1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr2:
+#if defined(CR2)
+      *b = ((t->c_oflag & CR2) == CR2);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr3:
+#if defined(CR3)
+      *b = ((t->c_oflag & CR3) == CR3);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab0:
+#if defined(TAB0)
+      *b = ((t->c_oflag & TAB0) == TAB0);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab1:
+#if defined(TAB1)
+      *b = ((t->c_oflag & TAB1) == TAB1);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab2:
+#if defined(TAB2)
+      *b = ((t->c_oflag & TAB2) == TAB2);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab3:
+#if defined(TAB3)
+      *b = ((t->c_oflag & TAB3) == TAB3);
+      return 1;
+#else
+      return 0;
+#endif
+    case obs0:
+#if defined(BS0)
+      *b = ((t->c_oflag & BS0) == BS0);
+      return 1;
+#else
+      return 0;
+#endif
+    case obs1:
+#if defined(BS1)
+      *b = ((t->c_oflag & BS1) == BS1);
+      return 1;
+#else
+      return 0;
+#endif
+    case off0:
+#if defined(FF0)
+      *b = ((t->c_oflag & FF0) == FF0);
+      return 1;
+#else
+      return 0;
+#endif
+    case off1:
+#if defined(FF1)
+      *b = ((t->c_oflag & FF1) == FF1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ovt0:
+#if defined(VT0)
+      *b = ((t->c_oflag & VT0) == VT0);
+      return 1;
+#else
+      return 0;
+#endif
+    case ovt1:
+#if defined(VT1)
+      *b = ((t->c_oflag & VT1) == VT1);
+      return 1;
+#else
+      return 0;
+#endif
+    case b0:
+#if defined(B0)
+      *b = ((t->c_cflag & B0) == B0);
+      return 1;
+#else
+      return 0;
+#endif
+    case b50:
+#if defined(B50)
+      *b = ((t->c_cflag & B50) == B50);
+      return 1;
+#else
+      return 0;
+#endif
+    case b75:
+#if defined(B75)
+      *b = ((t->c_cflag & B75) == B75);
+      return 1;
+#else
+      return 0;
+#endif
+    case b110:
+#if defined(B110)
+      *b = ((t->c_cflag & B110) == B110);
+      return 1;
+#else
+      return 0;
+#endif
+    case b135:
+#if defined(B134)
+      *b = ((t->c_cflag & B134) == B134);
+      return 1;
+#else
+      return 0;
+#endif
+    case b150:
+#if defined(B150)
+      *b = ((t->c_cflag & B150) == B150);
+      return 1;
+#else
+      return 0;
+#endif
+    case b200:
+#if defined(B200)
+      *b = ((t->c_cflag & B200) == B200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b300:
+#if defined(B300)
+      *b = ((t->c_cflag & B300) == B300);
+      return 1;
+#else
+      return 0;
+#endif
+    case b600:
+#if defined(B600)
+      *b = ((t->c_cflag & B600) == B600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1200:
+#if defined(B1200)
+      *b = ((t->c_cflag & B1200) == B1200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1800:
+#if defined(B1800)
+      *b = ((t->c_cflag & B1800) == B1800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2400:
+#if defined(B2400)
+      *b = ((t->c_cflag & B2400) == B2400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b4800:
+#if defined(B4800)
+      *b = ((t->c_cflag & B4800) == B4800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b9600:
+#if defined(B9600)
+      *b = ((t->c_cflag & B9600) == B9600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b19200:
+#if defined(B19200)
+      *b = ((t->c_cflag & B19200) == B19200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b38400:
+#if defined(B38400)
+      *b = ((t->c_cflag & B38400) == B38400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b57600:
+#if defined(B57600)
+      *b = ((t->c_cflag & B57600) == B57600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b115200:
+#if defined(B115200)
+      *b = ((t->c_cflag & B115200) == B115200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b240400:
+#if defined(B230400)
+      *b = ((t->c_cflag & B230400) == B230400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b460800:
+#if defined(B460800)
+      *b = ((t->c_cflag & B460800) == B460800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b500000:
+#if defined(B500000)
+      *b = ((t->c_cflag & B500000) == B500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b576000:
+#if defined(B576000)
+      *b = ((t->c_cflag & B576000) == B576000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b921600:
+#if defined(B921600)
+      *b = ((t->c_cflag & B921600) == B921600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1000000:
+#if defined(B1000000)
+      *b = ((t->c_cflag & B1000000) == B1000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1152000:
+#if defined(B1152000)
+      *b = ((t->c_cflag & B1152000) == B1152000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1500000:
+#if defined(B1500000)
+      *b = ((t->c_cflag & B1500000) == B1500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2000000:
+#if defined(B2000000)
+      *b = ((t->c_cflag & B2000000) == B2000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2500000:
+#if defined(B2500000)
+      *b = ((t->c_cflag & B2500000) == B2500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b3000000:
+#if defined(B3000000)
+      *b = ((t->c_cflag & B3000000) == B3000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b3500000:
+#if defined(B3500000)
+      *b = ((t->c_cflag & B3500000) == B3500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b4000000:
+#if defined(B4000000)
+      *b = ((t->c_cflag & B4000000) == B4000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case maxbaud:
+#if defined(__MAX_BAUD)
+      *b = ((t->c_cflag & __MAX_BAUD) == __MAX_BAUD);
+      return 1;
+#else
+      return 0;
+#endif
+    case crtscts:
+#if defined(CRTSCTS)
+      *b = ((t->c_cflag & CRTSCTS) == CRTSCTS);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs5:
+#if defined(CS5)
+      *b = ((t->c_cflag & CS5) == CS5);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs6:
+#if defined(CS6)
+      *b = ((t->c_cflag & CS6) == CS6);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs7:
+#if defined(CS7)
+      *b = ((t->c_cflag & CS7) == CS7);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs8:
+#if defined(CS8)
+      *b = ((t->c_cflag & CS8) == CS8);
+      return 1;
+#else
+      return 0;
+#endif
+    case cstopb:
+#if defined(CSTOPB)
+      *b = ((t->c_cflag & CSTOPB) == CSTOPB);
+      return 1;
+#else
+      return 0;
+#endif
+    case cread:
+#if defined(CREAD)
+      *b = ((t->c_cflag & CREAD) == CREAD);
+      return 1;
+#else
+      return 0;
+#endif
+    case parenb:
+#if defined(PARENB)
+      *b = ((t->c_cflag & PARENB) == PARENB);
+      return 1;
+#else
+      return 0;
+#endif
+    case parodd:
+#if defined(PARODD)
+      *b = ((t->c_cflag & PARODD) == PARODD);
+      return 1;
+#else
+      return 0;
+#endif
+    case hupcl:
+#if defined(HUPCL)
+      *b = ((t->c_cflag & HUPCL) == HUPCL);
+      return 1;
+#else
+      return 0;
+#endif
+    case clocal:
+#if defined(CLOCAL)
+      *b = ((t->c_cflag & CLOCAL) == CLOCAL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lisig:
+#if defined(ISIG)
+      *b = ((t->c_lflag & ISIG) == ISIG);
+      return 1;
+#else
+      return 0;
+#endif
+    case licanon:
+#if defined(ICANON)
+      *b = ((t->c_lflag & ICANON) == ICANON);
+      return 1;
+#else
+      return 0;
+#endif
+    case lxcase:
+#if defined(XCASE)
+      *b = ((t->c_lflag & XCASE) == XCASE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lecho:
+#if defined(ECHO)
+      *b = ((t->c_lflag & ECHO) == ECHO);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoe:
+#if defined(ECHOE)
+      *b = ((t->c_lflag & ECHOE) == ECHOE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechok:
+#if defined(ECHOK)
+      *b = ((t->c_lflag & ECHOK) == ECHOK);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechonl:
+#if defined(ECHONL)
+      *b = ((t->c_lflag & ECHONL) == ECHONL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lnoflsh:
+#if defined(NOFLSH)
+      *b = ((t->c_lflag & NOFLSH) == NOFLSH);
+      return 1;
+#else
+      return 0;
+#endif
+    case ltopstop:
+#if defined(TOSTOP)
+      *b = ((t->c_lflag & TOSTOP) == TOSTOP);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoctl:
+#if defined(ECHOCTL)
+      *b = ((t->c_lflag & ECHOCTL) == ECHOCTL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoprt:
+#if defined(ECHOPRT)
+      *b = ((t->c_lflag & ECHOPRT) == ECHOPRT);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoke:
+#if defined(ECHOKE)
+      *b = ((t->c_lflag & ECHOKE) == ECHOKE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lflusho:
+#if defined(FLUSHO)
+      *b = ((t->c_lflag & FLUSHO) == FLUSHO);
+      return 1;
+#else
+      return 0;
+#endif
+    case lpendin:
+#if defined(PENDIN)
+      *b = ((t->c_lflag & PENDIN) == PENDIN);
+      return 1;
+#else
+      return 0;
+#endif
+    case liexten:
+#if defined(IEXTEN)
+      *b = ((t->c_lflag & IEXTEN) == IEXTEN);
+      return 1;
+#else
+      return 0;
+#endif
+    }
+  return 0;
+}
+
+/* SetFlag - sets a flag value in, t, to, b, and returns TRUE if this
+   flag value is supported.  */
+
+int
+EXPORT (SetFlag) (struct termios *t, Flag f, int b)
+{
+  switch (f)
+    {
+    case ignbrk:
+#if defined(IGNBRK)
+      return doSetUnset (&t->c_iflag, IGNBRK, b);
+#else
+      return 0;
+#endif
+    case ibrkint:
+#if defined(BRKINT)
+      return doSetUnset (&t->c_iflag, BRKINT, b);
+#else
+      return 0;
+#endif
+    case ignpar:
+#if defined(IGNPAR)
+      return doSetUnset (&t->c_iflag, IGNPAR, b);
+#else
+      return 0;
+#endif
+    case iparmrk:
+#if defined(PARMRK)
+      return doSetUnset (&t->c_iflag, PARMRK, b);
+#else
+      return 0;
+#endif
+    case inpck:
+#if defined(INPCK)
+      return doSetUnset (&t->c_iflag, INPCK, b);
+#else
+      return 0;
+#endif
+    case istrip:
+#if defined(ISTRIP)
+      return doSetUnset (&t->c_iflag, ISTRIP, b);
+#else
+      return 0;
+#endif
+    case inlcr:
+#if defined(INLCR)
+      return doSetUnset (&t->c_iflag, INLCR, b);
+#else
+      return 0;
+#endif
+    case igncr:
+#if defined(IGNCR)
+      return doSetUnset (&t->c_iflag, IGNCR, b);
+#else
+      return 0;
+#endif
+    case icrnl:
+#if defined(ICRNL)
+      return doSetUnset (&t->c_iflag, ICRNL, b);
+#else
+      return 0;
+#endif
+    case iuclc:
+#if defined(IUCLC)
+      return doSetUnset (&t->c_iflag, IUCLC, b);
+#else
+      return 0;
+#endif
+    case ixon:
+#if defined(IXON)
+      return doSetUnset (&t->c_iflag, IXON, b);
+#else
+      return 0;
+#endif
+    case ixany:
+#if defined(IXANY)
+      return doSetUnset (&t->c_iflag, IXANY, b);
+#else
+      return 0;
+#endif
+    case ixoff:
+#if defined(IXOFF)
+      return doSetUnset (&t->c_iflag, IXOFF, b);
+#else
+      return 0;
+#endif
+    case imaxbel:
+#if defined(IMAXBEL)
+      return doSetUnset (&t->c_iflag, IMAXBEL, b);
+#else
+      return 0;
+#endif
+    case opost:
+#if defined(OPOST)
+      return doSetUnset (&t->c_oflag, OPOST, b);
+#else
+      return 0;
+#endif
+    case olcuc:
+#if defined(OLCUC)
+      return doSetUnset (&t->c_oflag, OLCUC, b);
+#else
+      return 0;
+#endif
+    case onlcr:
+#if defined(ONLCR)
+      return doSetUnset (&t->c_oflag, ONLCR, b);
+#else
+      return 0;
+#endif
+    case ocrnl:
+#if defined(OCRNL)
+      return doSetUnset (&t->c_oflag, OCRNL, b);
+#else
+      return 0;
+#endif
+    case onocr:
+#if defined(ONOCR)
+      return doSetUnset (&t->c_oflag, ONOCR, b);
+#else
+      return 0;
+#endif
+    case onlret:
+#if defined(ONLRET)
+      return doSetUnset (&t->c_oflag, ONLRET, b);
+#else
+      return 0;
+#endif
+    case ofill:
+#if defined(OFILL)
+      return doSetUnset (&t->c_oflag, OFILL, b);
+#else
+      return 0;
+#endif
+    case ofdel:
+#if defined(OFDEL)
+      return doSetUnset (&t->c_oflag, OFDEL, b);
+#else
+      return 0;
+#endif
+    case onl0:
+#if defined(NL0)
+      return doSetUnset (&t->c_oflag, NL0, b);
+#else
+      return 0;
+#endif
+    case onl1:
+#if defined(NL1)
+      return doSetUnset (&t->c_oflag, NL1, b);
+#else
+      return 0;
+#endif
+    case ocr0:
+#if defined(CR0)
+      return doSetUnset (&t->c_oflag, CR0, b);
+#else
+      return 0;
+#endif
+    case ocr1:
+#if defined(CR1)
+      return doSetUnset (&t->c_oflag, CR1, b);
+#else
+      return 0;
+#endif
+    case ocr2:
+#if defined(CR2)
+      return doSetUnset (&t->c_oflag, CR2, b);
+#else
+      return 0;
+#endif
+    case ocr3:
+#if defined(CR3)
+      return doSetUnset (&t->c_oflag, CR3, b);
+#else
+      return 0;
+#endif
+    case otab0:
+#if defined(TAB0)
+      return doSetUnset (&t->c_oflag, TAB0, b);
+#else
+      return 0;
+#endif
+    case otab1:
+#if defined(TAB1)
+      return doSetUnset (&t->c_oflag, TAB1, b);
+#else
+      return 0;
+#endif
+    case otab2:
+#if defined(TAB2)
+      return doSetUnset (&t->c_oflag, TAB2, b);
+#else
+      return 0;
+#endif
+    case otab3:
+#if defined(TAB3)
+      return doSetUnset (&t->c_oflag, TAB3, b);
+#else
+      return 0;
+#endif
+    case obs0:
+#if defined(BS0)
+      return doSetUnset (&t->c_oflag, BS0, b);
+#else
+      return 0;
+#endif
+    case obs1:
+#if defined(BS1)
+      return doSetUnset (&t->c_oflag, BS1, b);
+#else
+      return 0;
+#endif
+    case off0:
+#if defined(FF0)
+      return doSetUnset (&t->c_oflag, FF0, b);
+#else
+      return 0;
+#endif
+    case off1:
+#if defined(FF1)
+      return doSetUnset (&t->c_oflag, FF1, b);
+#else
+      return 0;
+#endif
+    case ovt0:
+#if defined(VT0)
+      return doSetUnset (&t->c_oflag, VT0, b);
+#else
+      return 0;
+#endif
+    case ovt1:
+#if defined(VT1)
+      return doSetUnset (&t->c_oflag, VT1, b);
+#else
+      return 0;
+#endif
+    case b0:
+#if defined(B0)
+      return doSetUnset (&t->c_cflag, B0, b);
+#else
+      return 0;
+#endif
+    case b50:
+#if defined(B50)
+      return doSetUnset (&t->c_cflag, B50, b);
+#else
+      return 0;
+#endif
+    case b75:
+#if defined(B75)
+      return doSetUnset (&t->c_cflag, B75, b);
+#else
+      return 0;
+#endif
+    case b110:
+#if defined(B110)
+      return doSetUnset (&t->c_cflag, B110, b);
+#else
+      return 0;
+#endif
+    case b135:
+#if defined(B134)
+      return doSetUnset (&t->c_cflag, B134, b);
+#else
+      return 0;
+#endif
+    case b150:
+#if defined(B150)
+      return doSetUnset (&t->c_cflag, B150, b);
+#else
+      return 0;
+#endif
+    case b200:
+#if defined(B200)
+      return doSetUnset (&t->c_cflag, B200, b);
+#else
+      return 0;
+#endif
+    case b300:
+#if defined(B300)
+      return doSetUnset (&t->c_cflag, B300, b);
+#else
+      return 0;
+#endif
+    case b600:
+#if defined(B600)
+      return doSetUnset (&t->c_cflag, B600, b);
+#else
+      return 0;
+#endif
+    case b1200:
+#if defined(B1200)
+      return doSetUnset (&t->c_cflag, B1200, b);
+#else
+      return 0;
+#endif
+    case b1800:
+#if defined(B1800)
+      return doSetUnset (&t->c_cflag, B1800, b);
+#else
+      return 0;
+#endif
+    case b2400:
+#if defined(B2400)
+      return doSetUnset (&t->c_cflag, B2400, b);
+#else
+      return 0;
+#endif
+    case b4800:
+#if defined(B4800)
+      return doSetUnset (&t->c_cflag, B4800, b);
+#else
+      return 0;
+#endif
+    case b9600:
+#if defined(B9600)
+      return doSetUnset (&t->c_cflag, B9600, b);
+#else
+      return 0;
+#endif
+    case b19200:
+#if defined(B19200)
+      return doSetUnset (&t->c_cflag, B19200, b);
+#else
+      return 0;
+#endif
+    case b38400:
+#if defined(B38400)
+      return doSetUnset (&t->c_cflag, B38400, b);
+#else
+      return 0;
+#endif
+    case b57600:
+#if defined(B57600)
+      return doSetUnset (&t->c_cflag, B57600, b);
+#else
+      return 0;
+#endif
+    case b115200:
+#if defined(B115200)
+      return doSetUnset (&t->c_cflag, B115200, b);
+#else
+      return 0;
+#endif
+    case b240400:
+#if defined(B230400)
+      return doSetUnset (&t->c_cflag, B230400, b);
+#else
+      return 0;
+#endif
+    case b460800:
+#if defined(B460800)
+      return doSetUnset (&t->c_cflag, B460800, b);
+#else
+      return 0;
+#endif
+    case b500000:
+#if defined(B500000)
+      return doSetUnset (&t->c_cflag, B500000, b);
+#else
+      return 0;
+#endif
+    case b576000:
+#if defined(B576000)
+      return doSetUnset (&t->c_cflag, B576000, b);
+#else
+      return 0;
+#endif
+    case b921600:
+#if defined(B921600)
+      return doSetUnset (&t->c_cflag, B921600, b);
+#else
+      return 0;
+#endif
+    case b1000000:
+#if defined(B1000000)
+      return doSetUnset (&t->c_cflag, B1000000, b);
+#else
+      return 0;
+#endif
+    case b1152000:
+#if defined(B1152000)
+      return doSetUnset (&t->c_cflag, B1152000, b);
+#else
+      return 0;
+#endif
+    case b1500000:
+#if defined(B1500000)
+      return doSetUnset (&t->c_cflag, B1500000, b);
+#else
+      return 0;
+#endif
+    case b2000000:
+#if defined(B2000000)
+      return doSetUnset (&t->c_cflag, B2000000, b);
+#else
+      return 0;
+#endif
+    case b2500000:
+#if defined(B2500000)
+      return doSetUnset (&t->c_cflag, B2500000, b);
+#else
+      return 0;
+#endif
+    case b3000000:
+#if defined(B3000000)
+      return doSetUnset (&t->c_cflag, B3000000, b);
+#else
+      return 0;
+#endif
+    case b3500000:
+#if defined(B3500000)
+      return doSetUnset (&t->c_cflag, B3500000, b);
+#else
+      return 0;
+#endif
+    case b4000000:
+#if defined(B4000000)
+      return doSetUnset (&t->c_cflag, B4000000, b);
+#else
+      return 0;
+#endif
+    case maxbaud:
+#if defined(__MAX_BAUD)
+      return doSetUnset (&t->c_cflag, __MAX_BAUD, b);
+#else
+      return 0;
+#endif
+    case crtscts:
+#if defined(CRTSCTS)
+      return doSetUnset (&t->c_cflag, CRTSCTS, b);
+#else
+      return 0;
+#endif
+    case cs5:
+#if defined(CS5)
+      return doSetUnset (&t->c_cflag, CS5, b);
+#else
+      return 0;
+#endif
+    case cs6:
+#if defined(CS6)
+      return doSetUnset (&t->c_cflag, CS6, b);
+#else
+      return 0;
+#endif
+    case cs7:
+#if defined(CS7)
+      return doSetUnset (&t->c_cflag, CS7, b);
+#else
+      return 0;
+#endif
+    case cs8:
+#if defined(CS8)
+      return doSetUnset (&t->c_cflag, CS8, b);
+#else
+      return 0;
+#endif
+    case cstopb:
+#if defined(CSTOPB)
+      return doSetUnset (&t->c_cflag, CSTOPB, b);
+#else
+      return 0;
+#endif
+    case cread:
+#if defined(CREAD)
+      return doSetUnset (&t->c_cflag, CREAD, b);
+#else
+      return 0;
+#endif
+    case parenb:
+#if defined(PARENB)
+      return doSetUnset (&t->c_cflag, PARENB, b);
+#else
+      return 0;
+#endif
+    case parodd:
+#if defined(PARODD)
+      return doSetUnset (&t->c_cflag, PARODD, b);
+#else
+      return 0;
+#endif
+    case hupcl:
+#if defined(HUPCL)
+      return doSetUnset (&t->c_cflag, HUPCL, b);
+#else
+      return 0;
+#endif
+    case clocal:
+#if defined(CLOCAL)
+      return doSetUnset (&t->c_cflag, CLOCAL, b);
+#else
+      return 0;
+#endif
+    case lisig:
+#if defined(ISIG)
+      return doSetUnset (&t->c_lflag, ISIG, b);
+#else
+      return 0;
+#endif
+    case licanon:
+#if defined(ICANON)
+      return doSetUnset (&t->c_lflag, ICANON, b);
+#else
+      return 0;
+#endif
+    case lxcase:
+#if defined(XCASE)
+      return doSetUnset (&t->c_lflag, XCASE, b);
+#else
+      return 0;
+#endif
+    case lecho:
+#if defined(ECHO)
+      return doSetUnset (&t->c_lflag, ECHO, b);
+#else
+      return 0;
+#endif
+    case lechoe:
+#if defined(ECHOE)
+      return doSetUnset (&t->c_lflag, ECHOE, b);
+#else
+      return 0;
+#endif
+    case lechok:
+#if defined(ECHOK)
+      return doSetUnset (&t->c_lflag, ECHOK, b);
+#else
+      return 0;
+#endif
+    case lechonl:
+#if defined(ECHONL)
+      return doSetUnset (&t->c_lflag, ECHONL, b);
+#else
+      return 0;
+#endif
+    case lnoflsh:
+#if defined(NOFLSH)
+      return doSetUnset (&t->c_lflag, NOFLSH, b);
+#else
+      return 0;
+#endif
+    case ltopstop:
+#if defined(TOSTOP)
+      return doSetUnset (&t->c_lflag, TOSTOP, b);
+#else
+      return 0;
+#endif
+    case lechoctl:
+#if defined(ECHOCTL)
+      return doSetUnset (&t->c_lflag, ECHOCTL, b);
+#else
+      return 0;
+#endif
+    case lechoprt:
+#if defined(ECHOPRT)
+      return doSetUnset (&t->c_lflag, ECHOPRT, b);
+#else
+      return 0;
+#endif
+    case lechoke:
+#if defined(ECHOKE)
+      return doSetUnset (&t->c_lflag, ECHOKE, b);
+#else
+      return 0;
+#endif
+    case lflusho:
+#if defined(FLUSHO)
+      return doSetUnset (&t->c_lflag, FLUSHO, b);
+#else
+      return 0;
+#endif
+    case lpendin:
+#if defined(PENDIN)
+      return doSetUnset (&t->c_lflag, PENDIN, b);
+#else
+      return 0;
+#endif
+    case liexten:
+#if defined(IEXTEN)
+      return doSetUnset (&t->c_lflag, IEXTEN, b);
+#else
+      return 0;
+#endif
+    }
+  return 0;
+}
+
+/* GetChar - sets a CHAR, ch, value from, t, and returns TRUE if this
+   value is supported.  */
+
+int
+EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch)
+{
+  switch (c)
+    {
+
+    case vintr:
+#if defined(VINTR)
+      *ch = t->c_cc[VINTR];
+      return 1;
+#else
+      return 0;
+#endif
+    case vquit:
+#if defined(VQUIT)
+      *ch = t->c_cc[VQUIT];
+      return 1;
+#else
+      return 0;
+#endif
+    case verase:
+#if defined(VERASE)
+      *ch = t->c_cc[VERASE];
+      return 1;
+#else
+      return 0;
+#endif
+    case vkill:
+#if defined(VKILL)
+      *ch = t->c_cc[VKILL];
+      return 1;
+#else
+      return 0;
+#endif
+    case veof:
+#if defined(VEOF)
+      *ch = t->c_cc[VEOF];
+      return 1;
+#else
+      return 0;
+#endif
+    case vtime:
+#if defined(VTIME)
+      *ch = t->c_cc[VTIME];
+      return 1;
+#else
+      return 0;
+#endif
+    case vmin:
+#if defined(VMIN)
+      *ch = t->c_cc[VMIN];
+      return 1;
+#else
+      return 0;
+#endif
+    case vswtc:
+#if defined(VSWTC)
+      *ch = t->c_cc[VSWTC];
+      return 1;
+#else
+      return 0;
+#endif
+    case vstart:
+#if defined(VSTART)
+      *ch = t->c_cc[VSTART];
+      return 1;
+#else
+      return 0;
+#endif
+    case vstop:
+#if defined(VSTOP)
+      *ch = t->c_cc[VSTOP];
+      return 1;
+#else
+      return 0;
+#endif
+    case vsusp:
+#if defined(VSUSP)
+      *ch = t->c_cc[VSUSP];
+      return 1;
+#else
+      return 0;
+#endif
+    case veol:
+#if defined(VEOL)
+      *ch = t->c_cc[VEOL];
+      return 1;
+#else
+      return 0;
+#endif
+    case vreprint:
+#if defined(VREPRINT)
+      *ch = t->c_cc[VREPRINT];
+      return 1;
+#else
+      return 0;
+#endif
+    case vdiscard:
+#if defined(VDISCARD)
+      *ch = t->c_cc[VDISCARD];
+      return 1;
+#else
+      return 0;
+#endif
+    case vwerase:
+#if defined(VWERASE)
+      *ch = t->c_cc[VWERASE];
+      return 1;
+#else
+      return 0;
+#endif
+    case vlnext:
+#if defined(VLNEXT)
+      *ch = t->c_cc[VLNEXT];
+      return 1;
+#else
+      return 0;
+#endif
+    case veol2:
+#if defined(VEOL2)
+      *ch = t->c_cc[VEOL2];
+      return 1;
+#else
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+
+/* SetChar - sets a CHAR value in, t, and returns TRUE if, c, is
+   supported.  */
+
+int
+EXPORT (SetChar) (struct termios *t, ControlChar c, char ch)
+{
+  switch (c)
+    {
+
+    case vintr:
+#if defined(VINTR)
+      t->c_cc[VINTR] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vquit:
+#if defined(VQUIT)
+      t->c_cc[VQUIT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case verase:
+#if defined(VERASE)
+      t->c_cc[VERASE] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vkill:
+#if defined(VKILL)
+      t->c_cc[VKILL] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veof:
+#if defined(VEOF)
+      t->c_cc[VEOF] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vtime:
+#if defined(VTIME)
+      t->c_cc[VTIME] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vmin:
+#if defined(VMIN)
+      t->c_cc[VMIN] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vswtc:
+#if defined(VSWTC)
+      t->c_cc[VSWTC] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vstart:
+#if defined(VSTART)
+      t->c_cc[VSTART] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vstop:
+#if defined(VSTOP)
+      t->c_cc[VSTOP] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vsusp:
+#if defined(VSUSP)
+      t->c_cc[VSUSP] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veol:
+#if defined(VEOL)
+      t->c_cc[VEOL] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vreprint:
+#if defined(VREPRINT)
+      t->c_cc[VREPRINT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vdiscard:
+#if defined(VDISCARD)
+      t->c_cc[VDISCARD] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vwerase:
+#if defined(VWERASE)
+      t->c_cc[VWERASE] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vlnext:
+#if defined(VLNEXT)
+      t->c_cc[VLNEXT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veol2:
+#if defined(VEOL2)
+      t->c_cc[VEOL2] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+
+void
+_M2_termios_init (void)
+{
+}
+
+void
+_M2_termios_finish (void)
+{
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/mc-boot-ch/Gwrapc.c b/gcc/m2/mc-boot-ch/Gwrapc.c
new file mode 100644
index 00000000000..d98a5e41102
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gwrapc.c
@@ -0,0 +1,183 @@
+/* Gwrapc.c wrap libc functions for mc.
+
+Copyright (C) 2005-2022 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
diff --git a/gcc/m2/mc-boot-ch/README b/gcc/m2/mc-boot-ch/README
new file mode 100644
index 00000000000..0281636c44d
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/README
@@ -0,0 +1,2 @@
+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
diff --git a/gcc/m2/mc-boot-ch/m2rts.h b/gcc/m2/mc-boot-ch/m2rts.h
new file mode 100644
index 00000000000..57e6e90d94d
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/m2rts.h
@@ -0,0 +1,41 @@
+/* m2rts.h provides a C interface to M2RTS.mod.
+
+Copyright (C) 2019-2022 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/>.  */
+
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
+extern "C" void M2RTS_RegisterModule (const char *modulename,
+				      proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void _M2_M2RTS_init (void);
+
+extern "C" void M2RTS_ConstructModules (const char *,
+					int argc, char *argv[], char *envp[]);
+extern "C" void M2RTS_Terminate (void);
+extern "C" void M2RTS_DeconstructModules (void);
+
+extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn));
diff --git a/gcc/m2/mc-boot-ch/network.c b/gcc/m2/mc-boot-ch/network.c
new file mode 100644
index 00000000000..74ebe51f3d4
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/network.c
@@ -0,0 +1,40 @@
+/* network.c provide access to htons and htonl.
+
+Copyright (C) 2010-2022 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);
+}
diff --git a/gcc/m2/mc-boot/GASCII.c b/gcc/m2/mc-boot/GASCII.c
new file mode 100644
index 00000000000..2e95d5cc3c7
--- /dev/null
+++ b/gcc/m2/mc-boot/GASCII.c
@@ -0,0 +1,86 @@
+/* do not edit automatically generated by mc from ASCII.  */
+/* ASCII.mod dummy companion module for the definition.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GASCII.h b/gcc/m2/mc-boot/GASCII.h
new file mode 100644
index 00000000000..f3c943cd0f9
--- /dev/null
+++ b/gcc/m2/mc-boot/GASCII.h
@@ -0,0 +1,94 @@
+/* do not edit automatically generated by mc from ASCII.  */
+/* ASCII.def Defines all ascii constants.
+
+Copyright (C) 2001-2021 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 (_ASCII_H)
+#   define _ASCII_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_ASCII_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   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
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GArgs.c b/gcc/m2/mc-boot/GArgs.c
new file mode 100644
index 00000000000..a25fa9bfde4
--- /dev/null
+++ b/gcc/m2/mc-boot/GArgs.c
@@ -0,0 +1,120 @@
+/* do not edit automatically generated by mc from Args.  */
+/* Args.mod provide access to command line arguments.
+
+Copyright (C) 2001-2021 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 (((*(*Source).array[i]).array[j] != ASCII_nul) && (j < High))
+        {
+          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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GArgs.h b/gcc/m2/mc-boot/GArgs.h
new file mode 100644
index 00000000000..166a49eb91e
--- /dev/null
+++ b/gcc/m2/mc-boot/GArgs.h
@@ -0,0 +1,69 @@
+/* do not edit automatically generated by mc from Args.  */
+/* Args.def provide access to command line arguments.
+
+Copyright (C) 2001-2021 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 (_Args_H)
+#   define _Args_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Args_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   GetArg - returns the nth argument from the command line.
+            The success of the operation is returned.
+*/
+
+EXTERN unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n);
+
+/*
+   Narg - returns the number of arguments available from
+          command line.
+*/
+
+EXTERN unsigned int Args_Narg (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GAssertion.c b/gcc/m2/mc-boot/GAssertion.c
new file mode 100644
index 00000000000..9faab7b4946
--- /dev/null
+++ b/gcc/m2/mc-boot/GAssertion.c
@@ -0,0 +1,71 @@
+/* do not edit automatically generated by mc from Assertion.  */
+/* Assertion.mod provides an assert procedure.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GAssertion.h b/gcc/m2/mc-boot/GAssertion.h
new file mode 100644
index 00000000000..c84cd7cb400
--- /dev/null
+++ b/gcc/m2/mc-boot/GAssertion.h
@@ -0,0 +1,62 @@
+/* do not edit automatically generated by mc from Assertion.  */
+/* Assertion.def provides an assert procedure.
+
+Copyright (C) 2001-2021 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 (_Assertion_H)
+#   define _Assertion_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Assertion_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Assert - tests the boolean Condition, if it fails then HALT
+            is called.
+*/
+
+EXTERN void Assertion_Assert (unsigned int Condition);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GBreak.c b/gcc/m2/mc-boot/GBreak.c
new file mode 100644
index 00000000000..655018d0b0a
--- /dev/null
+++ b/gcc/m2/mc-boot/GBreak.c
@@ -0,0 +1,47 @@
+/* do not edit automatically generated by mc from Break.  */
+/* Break.mod provides a dummy compatibility library for legacy systems.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GBreak.h b/gcc/m2/mc-boot/GBreak.h
new file mode 100644
index 00000000000..47a210d1005
--- /dev/null
+++ b/gcc/m2/mc-boot/GBreak.h
@@ -0,0 +1,55 @@
+/* do not edit automatically generated by mc from Break.  */
+/* Break.def provides a dummy compatibility library for legacy systems.
+
+Copyright (C) 2001-2021 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 (_Break_H)
+#   define _Break_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Break_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GCOROUTINES.h b/gcc/m2/mc-boot/GCOROUTINES.h
new file mode 100644
index 00000000000..e2953d61dc2
--- /dev/null
+++ b/gcc/m2/mc-boot/GCOROUTINES.h
@@ -0,0 +1,60 @@
+/* do not edit automatically generated by mc from COROUTINES.  */
+/* COROUTINES.def defines an ISO compatible module priority range.
+
+Copyright (C) 2001-2021 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 (_COROUTINES_H)
+#   define _COROUTINES_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_COROUTINES_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define COROUTINES_UnassignedPriority 0
+typedef unsigned int COROUTINES_INTERRUPTSOURCE;
+
+typedef unsigned int COROUTINES_PROTECTION;
+
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GCmdArgs.c b/gcc/m2/mc-boot/GCmdArgs.c
new file mode 100644
index 00000000000..d3881e48227
--- /dev/null
+++ b/gcc/m2/mc-boot/GCmdArgs.c
@@ -0,0 +1,322 @@
+/* do not edit automatically generated by mc from CmdArgs.  */
+/* CmdArgs.mod provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GCmdArgs.h b/gcc/m2/mc-boot/GCmdArgs.h
new file mode 100644
index 00000000000..50c365230df
--- /dev/null
+++ b/gcc/m2/mc-boot/GCmdArgs.h
@@ -0,0 +1,69 @@
+/* do not edit automatically generated by mc from CmdArgs.  */
+/* CmdArgs.def provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2021 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 (_CmdArgs_H)
+#   define _CmdArgs_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_CmdArgs_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   GetArg - returns the nth argument from the command line, CmdLine
+            the success of the operation is returned.
+*/
+
+EXTERN 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 unsigned int CmdArgs_Narg (const char *CmdLine_, unsigned int _CmdLine_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GDebug.c b/gcc/m2/mc-boot/GDebug.c
new file mode 100644
index 00000000000..2f2bf82f7fe
--- /dev/null
+++ b/gcc/m2/mc-boot/GDebug.c
@@ -0,0 +1,168 @@
+/* do not edit automatically generated by mc from Debug.  */
+/* Debug.mod provides some simple debugging routines.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GDebug.h b/gcc/m2/mc-boot/GDebug.h
new file mode 100644
index 00000000000..cfeef7567f7
--- /dev/null
+++ b/gcc/m2/mc-boot/GDebug.h
@@ -0,0 +1,72 @@
+/* do not edit automatically generated by mc from Debug.  */
+/* Debug.def provides some simple debugging routines.
+
+Copyright (C) 2001-2021 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 (_Debug_H)
+#   define _Debug_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Debug_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Halt - writes a message in the format:
+          Module:Line:Message
+
+          It then terminates by calling HALT.
+*/
+
+EXTERN 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 void Debug_DebugString (const char *a_, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GDynamicStrings.c b/gcc/m2/mc-boot/GDynamicStrings.c
new file mode 100644
index 00000000000..23ed7fbfbff
--- /dev/null
+++ b/gcc/m2/mc-boot/GDynamicStrings.c
@@ -0,0 +1,2686 @@
+/* do not edit automatically generated by mc from DynamicStrings.  */
+/* DynamicStrings.mod provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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] != a->contents.buf.array[i])
+                {
+                  M2RTS_HALT (-1);
+                  __builtin_unreachable ();
+                }
+              if (b->contents.buf.array[i] != b->contents.buf.array[i])
+                {
+                  M2RTS_HALT (-1);
+                  __builtin_unreachable ();
+                }
+              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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1258, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1288, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1320, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1388, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1405, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1517, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1629, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1651, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GDynamicStrings.h b/gcc/m2/mc-boot/GDynamicStrings.h
new file mode 100644
index 00000000000..c0f3d5d995d
--- /dev/null
+++ b/gcc/m2/mc-boot/GDynamicStrings.h
@@ -0,0 +1,334 @@
+/* do not edit automatically generated by mc from DynamicStrings.  */
+/* DynamicStrings.def provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2021 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 (_DynamicStrings_H)
+#   define _DynamicStrings_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_DynamicStrings_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (DynamicStrings_String_D)
+#  define DynamicStrings_String_D
+   typedef void *DynamicStrings_String;
+#endif
+
+
+/*
+   InitString - creates and returns a String type object.
+                Initial contents are, a.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high);
+
+/*
+   KillString - frees String, s, and its contents.
+                NIL is returned.
+*/
+
+EXTERN 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 void DynamicStrings_Fin (DynamicStrings_String s);
+
+/*
+   InitStringCharStar - initializes and returns a String to contain
+                        the C string.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_InitStringCharStar (void * a);
+
+/*
+   InitStringChar - initializes and returns a String to contain the
+                    single character, ch.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_InitStringChar (char ch);
+
+/*
+   Mark - marks String, s, ready for garbage collection.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s);
+
+/*
+   Length - returns the length of the String, s.
+*/
+
+EXTERN unsigned int DynamicStrings_Length (DynamicStrings_String s);
+
+/*
+   ConCat - returns String, a, after the contents of, b,
+            have been appended.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+   ConCatChar - returns String, a, after character, ch,
+                has been appended.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch);
+
+/*
+   Assign - assigns the contents of, b, into, a.
+            String, a, is returned.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+   Dup - duplicate a String, s, returning the copy of s.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s);
+
+/*
+   Add - returns a new String which contains the contents of a and b.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+   Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+EXTERN 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 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 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.
+          If n<=0 then an empty string is returned.
+*/
+
+EXTERN 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 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 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 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 DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment);
+
+/*
+   RemoveWhitePrefix - removes any leading white space from String, s.
+                       A new string is returned.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s);
+
+/*
+   RemoveWhitePostfix - removes any leading white space from String, s.
+                        A new string is returned.
+*/
+
+EXTERN 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 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 DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s);
+
+/*
+   CopyOut - copies string, s, to a.
+*/
+
+EXTERN void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s);
+
+/*
+   char - returns the character, ch, at position, i, in String, s.
+          As Slice the index can be negative so:
+
+          char(s, 0) will return the first character
+          char(s, 1) will return the second character
+          char(s, -1) will return the last character
+          char(s, -2) will return the penultimate character
+
+          a nul character is returned if the index is out of range.
+*/
+
+EXTERN char DynamicStrings_char (DynamicStrings_String s, int i);
+
+/*
+   string - returns the C style char * of String, s.
+*/
+
+EXTERN void * DynamicStrings_string (DynamicStrings_String s);
+
+/*
+   InitStringDB - the debug version of InitString.
+*/
+
+EXTERN 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 DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+   InitStringCharDB - the debug version of InitStringChar.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+   MultDB - the debug version of MultDB.
+*/
+
+EXTERN 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 DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+   SliceDB - debug version of Slice.
+*/
+
+EXTERN 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 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 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.
+
+                            The string, e, is returned unmodified,
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GEnvironment.c b/gcc/m2/mc-boot/GEnvironment.c
new file mode 100644
index 00000000000..5487a4d4934
--- /dev/null
+++ b/gcc/m2/mc-boot/GEnvironment.c
@@ -0,0 +1,129 @@
+/* do not edit automatically generated by mc from Environment.  */
+/* Environment.mod provides access to the environment settings of a process.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GEnvironment.h b/gcc/m2/mc-boot/GEnvironment.h
new file mode 100644
index 00000000000..0a3c4653557
--- /dev/null
+++ b/gcc/m2/mc-boot/GEnvironment.h
@@ -0,0 +1,73 @@
+/* do not edit automatically generated by mc from Environment.  */
+/* Environment.def provides access to the environment settings of a process.
+
+Copyright (C) 2001-2021 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 (_Environment_H)
+#   define _Environment_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Environment_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   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 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 unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GFIO.c b/gcc/m2/mc-boot/GFIO.c
new file mode 100644
index 00000000000..aa075c765d7
--- /dev/null
+++ b/gcc/m2/mc-boot/GFIO.c
@@ -0,0 +1,2328 @@
+/* do not edit automatically generated by mc from FIO.  */
+/* FIO.mod provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2022 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-git-devel-modula2/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;  /* reduce the amount for future direct  */
+                  /* 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)
+    {
+      /* avoid dangling else.  */
+      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;
+            }
+          else
+            {
+              return -1;
+            }
+        }
+    }
+  else
+    {
+      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)) == _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)) == _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)) == 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)) == 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;
+        }
+    }
+  ReturnException ("../../gcc-git-devel-modula2/gcc/m2/gm2-libs/FIO.def", 25, 1);
+  __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;
+        }
+    }
+  ReturnException ("../../gcc-git-devel-modula2/gcc/m2/gm2-libs/FIO.def", 25, 1);
+  __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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+  FIO_FlushOutErr ();
+}
diff --git a/gcc/m2/mc-boot/GFIO.h b/gcc/m2/mc-boot/GFIO.h
new file mode 100644
index 00000000000..5f24a4c6762
--- /dev/null
+++ b/gcc/m2/mc-boot/GFIO.h
@@ -0,0 +1,300 @@
+/* do not edit automatically generated by mc from FIO.  */
+/* FIO.def provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2021 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 (_FIO_H)
+#   define _FIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_FIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef unsigned int FIO_File;
+
+EXTERN FIO_File FIO_StdIn;
+EXTERN FIO_File FIO_StdOut;
+EXTERN FIO_File FIO_StdErr;
+
+/*
+   IsNoError - returns a TRUE if no error has occured on file, f.
+*/
+
+EXTERN unsigned int FIO_IsNoError (FIO_File f);
+
+/*
+   IsActive - returns TRUE if the file, f, is still active.
+*/
+
+EXTERN unsigned int FIO_IsActive (FIO_File f);
+
+/*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+EXTERN unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high);
+
+/*
+   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 FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high);
+
+/*
+   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 FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high);
+
+/*
+   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.
+                   newfile, determines whether a file should be
+                   created if towrite is TRUE or whether the
+                   previous file should be left alone,
+                   allowing this descriptor to seek
+                   and modify an existing file.
+*/
+
+EXTERN 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 void FIO_Close (FIO_File f);
+EXTERN unsigned int FIO_exists (void * fname, unsigned int flength);
+EXTERN FIO_File FIO_openToRead (void * fname, unsigned int flength);
+EXTERN FIO_File FIO_openToWrite (void * fname, unsigned int flength);
+EXTERN FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile);
+
+/*
+   FlushBuffer - flush contents of the FIO file, f, to libc.
+*/
+
+EXTERN 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 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 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 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 void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+
+/*
+   WriteChar - writes a single character to file, f.
+*/
+
+EXTERN void FIO_WriteChar (FIO_File f, char ch);
+
+/*
+   EOF - tests to see whether a file, f, has reached end of file.
+*/
+
+EXTERN unsigned int FIO_EOF (FIO_File f);
+
+/*
+   EOLN - tests to see whether a file, f, is about to read a newline.
+          It does NOT consume the newline.  It reads the next character
+          and then immediately unreads the character.
+*/
+
+EXTERN unsigned int FIO_EOLN (FIO_File f);
+
+/*
+   WasEOLN - tests to see whether a file, f, has just read a newline
+             character.
+*/
+
+EXTERN 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 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,
+                end of file or end of line seen.
+*/
+
+EXTERN void FIO_UnReadChar (FIO_File f, char ch);
+
+/*
+   WriteLine - writes out a linefeed to file, f.
+*/
+
+EXTERN void FIO_WriteLine (FIO_File f);
+
+/*
+   WriteString - writes a string to file, f.
+*/
+
+EXTERN 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 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 void FIO_WriteCardinal (FIO_File f, unsigned int c);
+
+/*
+   ReadCardinal - reads a CARDINAL from file, f.
+                  It reads a bit image of a CARDINAL
+                  from file, f.
+*/
+
+EXTERN unsigned int FIO_ReadCardinal (FIO_File f);
+
+/*
+   GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+                           Useful when combining FIO.mod with select
+                           (in Selective.def - but note the comments in
+                            Selective about using read/write primatives)
+*/
+
+EXTERN int FIO_GetUnixFileDescriptor (FIO_File f);
+
+/*
+   SetPositionFromBeginning - sets the position from the beginning
+                              of the file.
+*/
+
+EXTERN void FIO_SetPositionFromBeginning (FIO_File f, long int pos);
+
+/*
+   SetPositionFromEnd - sets the position from the end of the file.
+*/
+
+EXTERN void FIO_SetPositionFromEnd (FIO_File f, long int pos);
+
+/*
+   FindPosition - returns the current absolute position in file, f.
+*/
+
+EXTERN long int FIO_FindPosition (FIO_File f);
+
+/*
+   GetFileName - assigns, a, with the filename associated with, f.
+*/
+
+EXTERN void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high);
+
+/*
+   getFileName - returns the address of the filename associated with, f.
+*/
+
+EXTERN void * FIO_getFileName (FIO_File f);
+
+/*
+   getFileNameLength - returns the number of characters associated with
+                       filename, f.
+*/
+
+EXTERN unsigned int FIO_getFileNameLength (FIO_File f);
+
+/*
+   FlushOutErr - flushes, StdOut, and, StdErr.
+*/
+
+EXTERN void FIO_FlushOutErr (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GFormatStrings.c b/gcc/m2/mc-boot/GFormatStrings.c
new file mode 100644
index 00000000000..65d5d67598b
--- /dev/null
+++ b/gcc/m2/mc-boot/GFormatStrings.c
@@ -0,0 +1,845 @@
+/* do not edit automatically generated by mc from FormatStrings.  */
+/* FormatStrings.mod provides a pseudo printf capability.
+
+Copyright (C) 2005-2021 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 == (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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GFormatStrings.h b/gcc/m2/mc-boot/GFormatStrings.h
new file mode 100644
index 00000000000..668a2fdb955
--- /dev/null
+++ b/gcc/m2/mc-boot/GFormatStrings.h
@@ -0,0 +1,99 @@
+/* do not edit automatically generated by mc from FormatStrings.  */
+/* FormatStrings.def provides a pseudo printf capability.
+
+Copyright (C) 2005-2021 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 (_FormatStrings_H)
+#   define _FormatStrings_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GDynamicStrings.h"
+
+#   if defined (_FormatStrings_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Sprintf0 - returns a String containing, fmt, after it has had its
+              escape sequences translated.
+*/
+
+EXTERN DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt);
+
+/*
+   Sprintf1 - returns a String containing, fmt, together with
+              encapsulated entity, w. It only formats the
+              first %s or %d with n.
+*/
+
+EXTERN DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high);
+
+/*
+   Sprintf2 - returns a string, fmt, which has been formatted.
+*/
+
+EXTERN 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, fmt, which has been formatted.
+*/
+
+EXTERN 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, fmt, which has been formatted.
+*/
+
+EXTERN 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 DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GFpuIO.c b/gcc/m2/mc-boot/GFpuIO.c
new file mode 100644
index 00000000000..354cddbf700
--- /dev/null
+++ b/gcc/m2/mc-boot/GFpuIO.c
@@ -0,0 +1,336 @@
+/* do not edit automatically generated by mc from FpuIO.  */
+/* FpuIO.mod implements a fixed format input/output for REAL/LONGREAL.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GFpuIO.h b/gcc/m2/mc-boot/GFpuIO.h
new file mode 100644
index 00000000000..fd070ee05d8
--- /dev/null
+++ b/gcc/m2/mc-boot/GFpuIO.h
@@ -0,0 +1,67 @@
+/* do not edit automatically generated by mc from FpuIO.  */
+/* FpuIO.def Implements a fixed format input/output for REAL/LONGREAL.
+
+Copyright (C) 2001-2021 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 (_FpuIO_H)
+#   define _FpuIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_FpuIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN void FpuIO_ReadReal (double *x);
+EXTERN void FpuIO_WriteReal (double x, unsigned int TotalWidth, unsigned int FractionWidth);
+EXTERN void FpuIO_StrToReal (const char *a_, unsigned int _a_high, double *x);
+EXTERN void FpuIO_RealToStr (double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high);
+EXTERN void FpuIO_ReadLongReal (long double *x);
+EXTERN void FpuIO_WriteLongReal (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+EXTERN void FpuIO_StrToLongReal (const char *a_, unsigned int _a_high, long double *x);
+EXTERN void FpuIO_LongRealToStr (long double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high);
+EXTERN void FpuIO_ReadLongInt (long int *x);
+EXTERN void FpuIO_WriteLongInt (long int x, unsigned int n);
+EXTERN void FpuIO_StrToLongInt (const char *a_, unsigned int _a_high, long int *x);
+EXTERN void FpuIO_LongIntToStr (long int x, unsigned int n, char *a, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GIO.c b/gcc/m2/mc-boot/GIO.c
new file mode 100644
index 00000000000..10f1c85682d
--- /dev/null
+++ b/gcc/m2/mc-boot/GIO.c
@@ -0,0 +1,479 @@
+/* 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-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GIO.h b/gcc/m2/mc-boot/GIO.h
new file mode 100644
index 00000000000..dc40066bd51
--- /dev/null
+++ b/gcc/m2/mc-boot/GIO.h
@@ -0,0 +1,88 @@
+/* do not edit automatically generated by mc from IO.  */
+/* IO.def provides Read, Write, Errors procedures mapping onto 0, 1 and 2.
+
+Copyright (C) 2001-2021 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 (_IO_H)
+#   define _IO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_IO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN void IO_Read (char *ch);
+EXTERN void IO_Write (char ch);
+EXTERN void IO_Error (char ch);
+
+/*
+   UnBufferedMode - places file descriptor, fd, into an unbuffered mode.
+*/
+
+EXTERN void IO_UnBufferedMode (int fd, unsigned int input);
+
+/*
+   BufferedMode - places file descriptor, fd, into a buffered mode.
+*/
+
+EXTERN 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 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 void IO_EchoOff (int fd, unsigned int input);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GIndexing.c b/gcc/m2/mc-boot/GIndexing.c
new file mode 100644
index 00000000000..16740f98dca
--- /dev/null
+++ b/gcc/m2/mc-boot/GIndexing.c
@@ -0,0 +1,491 @@
+/* do not edit automatically generated by mc from Indexing.  */
+/* Indexing provides a dynamic array of pointers.
+   Copyright (C) 2015-2022 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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GIndexing.h b/gcc/m2/mc-boot/GIndexing.h
new file mode 100644
index 00000000000..56145407d9e
--- /dev/null
+++ b/gcc/m2/mc-boot/GIndexing.h
@@ -0,0 +1,141 @@
+/* do not edit automatically generated by mc from Indexing.  */
+/* Indexing.def provides a dynamic indexing mechanism.
+
+Copyright (C) 2015-2022 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 (_Indexing_H)
+#   define _Indexing_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_Indexing_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (Indexing_Index_D)
+#  define Indexing_Index_D
+   typedef void *Indexing_Index;
+#endif
+
+typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure;
+
+typedef void (*Indexing_IndexProcedure_t) (void *);
+struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
+
+
+/*
+   InitIndex - creates and returns an Index.
+*/
+
+EXTERN Indexing_Index Indexing_InitIndex (unsigned int low);
+
+/*
+   KillIndex - returns Index to free storage.
+*/
+
+EXTERN Indexing_Index Indexing_KillIndex (Indexing_Index i);
+
+/*
+   DebugIndex - turns on debugging within an index.
+*/
+
+EXTERN Indexing_Index Indexing_DebugIndex (Indexing_Index i);
+
+/*
+   InBounds - returns TRUE if indice, n, is within the bounds
+              of the dynamic array.
+*/
+
+EXTERN unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n);
+
+/*
+   HighIndice - returns the last legally accessible indice of this array.
+*/
+
+EXTERN unsigned int Indexing_HighIndice (Indexing_Index i);
+
+/*
+   LowIndice - returns the first legally accessible indice of this array.
+*/
+
+EXTERN unsigned int Indexing_LowIndice (Indexing_Index i);
+
+/*
+   PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+EXTERN void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a);
+
+/*
+   GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+EXTERN void * Indexing_GetIndice (Indexing_Index i, unsigned int n);
+
+/*
+   IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+EXTERN unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a);
+
+/*
+   RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+EXTERN void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a);
+
+/*
+   DeleteIndice - delete i[j] from the array.
+*/
+
+EXTERN 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 void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a);
+
+/*
+   ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+EXTERN void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GM2Dependent.c b/gcc/m2/mc-boot/GM2Dependent.c
new file mode 100644
index 00000000000..af0cea89ce1
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2Dependent.c
@@ -0,0 +1,1116 @@
+/* do not edit automatically generated by mc from M2Dependent.  */
+/* M2Dependent.mod implements the run time module dependencies.
+
+Copyright (C) 2022 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;
+                           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 ModuleTrace;
+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, int argc, void * argv, void * envp);
+
+/*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, 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 * name, 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 * dependantmodule);
+
+/*
+   CreateModule - creates a new module entry and returns the
+                  ModuleChain.
+*/
+
+static M2Dependent_ModuleChain CreateModule (void * name, 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);
+
+/*
+   LookupModuleN - lookup module from the state list.  The string is limited
+                   to nchar.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar);
+
+/*
+   LookupModule - lookup and return the ModuleChain pointer containing
+                  module name from a particular list.
+*/
+
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name);
+
+/*
+   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);
+
+/*
+   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);
+
+/*
+   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 * dependantmodule);
+
+/*
+   ResolveDependencies - resolve dependencies for currentmodule.
+*/
+
+static void ResolveDependencies (void * currentmodule);
+
+/*
+   DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_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);
+
+/*
+   ForceDependencies - if the user has specified a forced order then we override
+                       the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void);
+
+/*
+   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,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.
+                     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, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+  M2Dependent_ModuleChain mptr;
+
+  Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
+  mptr->name = name;
+  mptr->init = init;
+  mptr->fini = fini;
+  mptr->dependency.proc = dependencies;
+  mptr->dependency.state = M2Dependent_unregistered;
+  mptr->prev = NULL;
+  mptr->next = NULL;
+  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 ();
+}
+
+
+/*
+   LookupModuleN - lookup module from the state list.  The string is limited
+                   to nchar.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar)
+{
+  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), nchar)) == 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)
+{
+  return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))));
+  /* 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 ((str[i] == '\\') && (i < high))
+        {
+          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 (((a != NULL) && (b != NULL)) && (n > 0))
+    {
+      /* avoid gcc warning by using compound statement even if not strictly necessary.  */
+      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 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, arg);
+    }
+}
+
+
+/*
+   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)
+{
+  if (mptr == NULL)
+    {
+      traceprintf (DependencyTrace, (const char *) "   module has not been registered via a global constructor\\n", 60);
+    }
+  else
+    {
+      if (onChain (M2Dependent_started, mptr))
+        {
+          traceprintf (DependencyTrace, (const char *) "   processing...\\n", 18);
+        }
+      else
+        {
+          moveTo (M2Dependent_started, mptr);
+          traceprintf2 (DependencyTrace, (const char *) "   starting: %s\\n", 17, currentmodule);
+          (*mptr->dependency.proc.proc) ();  /* Invoke and process the dependency graph.  */
+          traceprintf2 (DependencyTrace, (const char *) "   finished: %s\\n", 17, currentmodule);  /* 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 * dependantmodule)
+{
+  M2Dependent_ModuleChain mptr;
+
+  traceprintf2 (DependencyTrace, (const char *) "  module %s", 11, modulename);
+  if (dependantmodule == NULL)
+    {
+      /* avoid dangling else.  */
+      traceprintf2 (DependencyTrace, (const char *) " has finished its import graph\\n", 32, modulename);
+      mptr = LookupModule (M2Dependent_unordered, modulename);
+      if (mptr != NULL)
+        {
+          traceprintf2 (DependencyTrace, (const char *) "  module %s is now ordered\\n", 28, modulename);
+          moveTo (M2Dependent_ordered, mptr);
+        }
+    }
+  else
+    {
+      traceprintf2 (DependencyTrace, (const char *) " imports from %s\\n", 18, dependantmodule);
+      mptr = LookupModule (M2Dependent_ordered, dependantmodule);
+      if (mptr == NULL)
+        {
+          traceprintf2 (DependencyTrace, (const char *) "  module %s is not ordered\\n", 28, dependantmodule);
+          mptr = LookupModule (M2Dependent_unordered, dependantmodule);
+          if (mptr == NULL)
+            {
+              traceprintf2 (DependencyTrace, (const char *) "  module %s is not unordered\\n", 30, dependantmodule);
+              mptr = LookupModule (M2Dependent_started, dependantmodule);
+              if (mptr == NULL)
+                {
+                  traceprintf2 (DependencyTrace, (const char *) "  module %s has not started\\n", 29, dependantmodule);
+                  traceprintf2 (DependencyTrace, (const char *) "  module %s attempting to import from", 37, modulename);
+                  traceprintf2 (DependencyTrace, (const char *) " %s which has not registered itself via a constructor\\n", 55, dependantmodule);
+                }
+              else
+                {
+                  traceprintf2 (DependencyTrace, (const char *) "  module %s has registered itself and has started\\n", 51, dependantmodule);
+                }
+            }
+          else
+            {
+              traceprintf2 (DependencyTrace, (const char *) "  module %s resolving\\n", 23, dependantmodule);
+              ResolveDependant (mptr, dependantmodule);
+            }
+        }
+      else
+        {
+          traceprintf2 (DependencyTrace, (const char *) "  module %s ", 12, modulename);
+          traceprintf2 (DependencyTrace, (const char *) " dependant %s is ordered\\n", 26, dependantmodule);
+        }
+    }
+}
+
+
+/*
+   ResolveDependencies - resolve dependencies for currentmodule.
+*/
+
+static void ResolveDependencies (void * currentmodule)
+{
+  M2Dependent_ModuleChain mptr;
+
+  mptr = LookupModule (M2Dependent_unordered, currentmodule);
+  while (mptr != NULL)
+    {
+      traceprintf2 (DependencyTrace, (const char *) "   attempting to resolve the dependants for %s\\n", 48, currentmodule);
+      ResolveDependant (mptr, currentmodule);
+      mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
+    }
+}
+
+
+/*
+   DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high)
+{
+  M2Dependent_ModuleChain mptr;
+  char name[_name_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (name, name_, _name_high+1);
+
+  if (Modules.array[state-M2Dependent_unregistered] != NULL)
+    {
+      libc_printf ((const char *) "%s modules\\n", 12, &name);
+      mptr = Modules.array[state-M2Dependent_unregistered];
+      do {
+        libc_printf ((const char *) "  %s", 4, mptr->name);
+        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.  */
+    }
+}
+
+
+/*
+   ForceDependencies - if the user has specified a forced order then we override
+                       the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void)
+{
+  M2Dependent_ModuleChain mptr;
+  M2Dependent_ModuleChain userChain;
+  unsigned int count;
+  M2LINK_PtrToChar pc;
+  M2LINK_PtrToChar start;
+
+  if (M2LINK_ForcedModuleInitOrder != NULL)
+    {
+      userChain = NULL;
+      pc = M2LINK_ForcedModuleInitOrder;
+      start = pc;
+      count = 0;
+      while ((*pc) != ASCII_nul)
+        {
+          if ((*pc) == ',')
+            {
+              mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
+              if (mptr != NULL)
+                {
+                  mptr->dependency.forced = TRUE;
+                  moveTo (M2Dependent_user, mptr);
+                }
+              pc += 1;
+              start = pc;
+              count = 0;
+            }
+          else
+            {
+              pc += 1;
+              count += 1;
+            }
+        }
+      if (start != pc)
+        {
+          mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
+          if (mptr != NULL)
+            {
+              mptr->dependency.forced = TRUE;
+              moveTo (M2Dependent_user, mptr);
+            }
+        }
+      combine (M2Dependent_user, M2Dependent_ordered);
+    }
+}
+
+
+/*
+   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,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.
+                     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;
+  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;
+          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 *) "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, int argc, void * argv, void * envp)
+{
+  M2Dependent_ModuleChain mptr;
+  M2Dependent_ArgCVEnvP nulp;
+
+  CheckInitialized ();
+  traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
+  mptr = LookupModule (M2Dependent_unordered, applicationmodule);
+  if (mptr != NULL)
+    {
+      mptr->dependency.appl = TRUE;
+    }
+  traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
+  DumpModuleData (PreTrace);
+  ResolveDependencies (applicationmodule);
+  traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
+  DumpModuleData (PostTrace);
+  ForceDependencies ();
+  traceprintf (ForceTrace, (const char *) "After user forcing ordering\\n", 29);
+  DumpModuleData (ForceTrace);
+  if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
+    {
+      traceprintf2 (ModuleTrace, (const char *) "  module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+      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)
+          {
+            traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+          }
+        else
+          {
+            traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+          }
+        if (mptr->dependency.appl)
+          {
+            traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, mptr->name);
+            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, int argc, void * argv, void * envp)
+{
+  M2Dependent_ModuleChain mptr;
+
+  traceprintf2 (ModuleTrace, (const char *) "application module finishing: %s\\n", 34, applicationmodule);
+  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)
+          {
+            traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s for C\\n", 29, mptr->name);
+          }
+        else
+          {
+            traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s\\n", 23, mptr->name);
+          }
+        (*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 * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+  CheckInitialized ();
+  if (! M2LINK_StaticInitialization)
+    {
+      traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
+      moveTo (M2Dependent_unordered, CreateModule (name, init, fini, 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 * dependantmodule)
+{
+  CheckInitialized ();
+  if (! M2LINK_StaticInitialization)
+    {
+      PerformRequestDependant (modulename, dependantmodule);
+    }
+}
+
+extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+  CheckInitialized ();
+}
+
+extern "C" void _M2_M2Dependent_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GM2Dependent.h b/gcc/m2/mc-boot/GM2Dependent.h
new file mode 100644
index 00000000000..7cdbee63d26
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2Dependent.h
@@ -0,0 +1,78 @@
+/* do not edit automatically generated by mc from M2Dependent.  */
+/* M2Dependent.def defines the run time module dependencies interface.
+
+Copyright (C) 2022 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 (_M2Dependent_H)
+#   define _M2Dependent_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_M2Dependent_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
+
+typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
+struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
+
+EXTERN void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, 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 void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*/
+
+EXTERN void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GM2EXCEPTION.c b/gcc/m2/mc-boot/GM2EXCEPTION.c
new file mode 100644
index 00000000000..f216888d279
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2EXCEPTION.c
@@ -0,0 +1,89 @@
+/* do not edit automatically generated by mc from M2EXCEPTION.  */
+/* M2EXCEPTION.mod implement M2Exception and IsM2Exception.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GM2EXCEPTION.h b/gcc/m2/mc-boot/GM2EXCEPTION.h
new file mode 100644
index 00000000000..7289c2b3761
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2EXCEPTION.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from M2EXCEPTION.  */
+/* M2EXCEPTION.def enumerates all exceptions.
+
+Copyright (C) 2001-2021 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 (_M2EXCEPTION_H)
+#   define _M2EXCEPTION_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_M2EXCEPTION_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+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 M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void);
+EXTERN unsigned int M2EXCEPTION_IsM2Exception (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GM2LINK.h b/gcc/m2/mc-boot/GM2LINK.h
new file mode 100644
index 00000000000..9807ab19d7e
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2LINK.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from M2LINK.  */
+/* M2LINK.def defines the linking mode used in Modula-2.
+
+Copyright (C) 2022 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 (_M2LINK_H)
+#   define _M2LINK_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_M2LINK_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef char *M2LINK_PtrToChar;
+
+EXTERN M2LINK_PtrToChar M2LINK_ForcedModuleInitOrder;
+EXTERN unsigned int M2LINK_StaticInitialization;
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GM2RTS.c b/gcc/m2/mc-boot/GM2RTS.c
new file mode 100644
index 00000000000..e7302f60565
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2RTS.c
@@ -0,0 +1,744 @@
+/* do not edit automatically generated by mc from M2RTS.  */
+/* M2RTS.mod Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2021 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;
+
+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, int argc, void * argv, void * envp);
+
+/*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, 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, 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 * dependantmodule);
+
+/*
+   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.
+*/
+
+extern "C" void M2RTS_Halt (const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __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 *file_, unsigned int _file_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);
+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);
+
+/*
+   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 (2, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+   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, int argc, void * argv, void * envp)
+{
+  M2Dependent_ConstructModules (applicationmodule, argc, argv, envp);
+}
+
+
+/*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+{
+  M2Dependent_DeconstructModules (applicationmodule, 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, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+  M2Dependent_RegisterModule (name, (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 * dependantmodule)
+{
+  M2Dependent_RequestDependant (modulename, dependantmodule);
+}
+
+
+/*
+   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.
+*/
+
+extern "C" void M2RTS_Halt (const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high)
+{
+  char file[_file_high+1];
+  char function[_function_high+1];
+  char description[_description_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (file, file_, _file_high+1);
+  memcpy (function, function_, _function_high+1);
+  memcpy (description, description_, _description_high+1);
+
+  M2RTS_ErrorMessage ((const char *) description, _description_high, (const char *) file, _file_high, line, (const char *) function, _function_high);
+  M2RTS_HALT (-1);
+  __builtin_unreachable ();
+}
+
+
+/*
+   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 *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high)
+{
+  typedef struct ErrorMessage__T2_a ErrorMessage__T2;
+
+  struct ErrorMessage__T2_a { char array[10+1]; };
+  ErrorMessage__T2 LineNo;
+  char message[_message_high+1];
+  char file[_file_high+1];
+  char function[_function_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (message, message_, _message_high+1);
+  memcpy (file, file_, _file_high+1);
+  memcpy (function, function_, _function_high+1);
+
+  ErrorString ((const char *) file, _file_high);
+  ErrorString ((const char *) ":", 1);
+  NumberIO_CardToStr (line, 0, (char *) &LineNo.array[0], 10);
+  ErrorString ((const char *) &LineNo.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);
+  LineNo.array[0] = ASCII_nl;
+  LineNo.array[1] = ASCII_nul;
+  ErrorString ((const char *) &LineNo.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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GM2RTS.h b/gcc/m2/mc-boot/GM2RTS.h
new file mode 100644
index 00000000000..fd0ffa4ccec
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2RTS.h
@@ -0,0 +1,182 @@
+/* do not edit automatically generated by mc from M2RTS.  */
+/* M2RTS.def Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2021 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 (_M2RTS_H)
+#   define _M2RTS_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_M2RTS_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+EXTERN void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2RTS_DeconstructModules (void * applicationmodule, 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 void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*/
+
+EXTERN void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+
+/*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE is the
+                                 procedure is installed.
+*/
+
+EXTERN unsigned int M2RTS_InstallTerminationProcedure (PROC p);
+
+/*
+   ExecuteInitialProcedures - executes the initial procedures installed
+                              by InstallInitialProcedure.
+*/
+
+EXTERN void M2RTS_ExecuteInitialProcedures (void);
+
+/*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the main
+                             program module.
+*/
+
+EXTERN unsigned int M2RTS_InstallInitialProcedure (PROC p);
+
+/*
+   ExecuteTerminationProcedures - calls each installed termination procedure
+                                  in reverse order.
+*/
+
+EXTERN void M2RTS_ExecuteTerminationProcedures (void);
+
+/*
+   Terminate - provides compatibility for pim.  It call exit with
+               the exitcode provided in a prior call to ExitOnHalt
+               (or zero if ExitOnHalt was never called).  It does
+               not call ExecuteTerminationProcedures.
+*/
+
+EXTERN void M2RTS_Terminate (void) __attribute__ ((noreturn));
+
+/*
+   HALT - terminate the current program.  The procedure Terminate
+          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 void M2RTS_HALT (int exitcode) __attribute__ ((noreturn));
+
+/*
+   Halt - provides a more user friendly version of HALT, which takes
+          four parameters to aid debugging.
+*/
+
+EXTERN void M2RTS_Halt (const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+
+/*
+   ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*/
+
+EXTERN void M2RTS_ExitOnHalt (int e);
+
+/*
+   ErrorMessage - emits an error message to stderr and then calls exit (1).
+*/
+
+EXTERN void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *file_, unsigned int _file_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 unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
+EXTERN void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GMemUtils.c b/gcc/m2/mc-boot/GMemUtils.c
new file mode 100644
index 00000000000..f81fca9699b
--- /dev/null
+++ b/gcc/m2/mc-boot/GMemUtils.c
@@ -0,0 +1,126 @@
+/* do not edit automatically generated by mc from MemUtils.  */
+/* MemUtils.mod provides some basic memory utilities.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GMemUtils.h b/gcc/m2/mc-boot/GMemUtils.h
new file mode 100644
index 00000000000..3258234d6a5
--- /dev/null
+++ b/gcc/m2/mc-boot/GMemUtils.h
@@ -0,0 +1,68 @@
+/* do not edit automatically generated by mc from MemUtils.  */
+/* MemUtils.def provides some basic memory utilities.
+
+Copyright (C) 2001-2021 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 (_MemUtils_H)
+#   define _MemUtils_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_MemUtils_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   MemCopy - copys a region of memory to the required destination.
+*/
+
+EXTERN void MemUtils_MemCopy (void * from, unsigned int length, void * to);
+
+/*
+   MemZero - sets a region of memory: a..a+length to zero.
+*/
+
+EXTERN void MemUtils_MemZero (void * a, unsigned int length);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GNumberIO.c b/gcc/m2/mc-boot/GNumberIO.c
new file mode 100644
index 00000000000..6b90074a158
--- /dev/null
+++ b/gcc/m2/mc-boot/GNumberIO.c
@@ -0,0 +1,776 @@
+/* do not edit automatically generated by mc from NumberIO.  */
+/* NumberIO.mod provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GNumberIO.h b/gcc/m2/mc-boot/GNumberIO.h
new file mode 100644
index 00000000000..efebe4ee793
--- /dev/null
+++ b/gcc/m2/mc-boot/GNumberIO.h
@@ -0,0 +1,78 @@
+/* do not edit automatically generated by mc from NumberIO.  */
+/* NumberIO.def provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2021 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 (_NumberIO_H)
+#   define _NumberIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_NumberIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN void NumberIO_ReadCard (unsigned int *x);
+EXTERN void NumberIO_WriteCard (unsigned int x, unsigned int n);
+EXTERN void NumberIO_ReadHex (unsigned int *x);
+EXTERN void NumberIO_WriteHex (unsigned int x, unsigned int n);
+EXTERN void NumberIO_ReadInt (int *x);
+EXTERN void NumberIO_WriteInt (int x, unsigned int n);
+EXTERN void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x);
+EXTERN void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x);
+EXTERN void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x);
+EXTERN void NumberIO_ReadOct (unsigned int *x);
+EXTERN void NumberIO_WriteOct (unsigned int x, unsigned int n);
+EXTERN void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x);
+EXTERN void NumberIO_ReadBin (unsigned int *x);
+EXTERN void NumberIO_WriteBin (unsigned int x, unsigned int n);
+EXTERN void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x);
+EXTERN void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x);
+EXTERN void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x);
+EXTERN void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GPushBackInput.c b/gcc/m2/mc-boot/GPushBackInput.c
new file mode 100644
index 00000000000..b0ede086be4
--- /dev/null
+++ b/gcc/m2/mc-boot/GPushBackInput.c
@@ -0,0 +1,488 @@
+/* do not edit automatically generated by mc from PushBackInput.  */
+/* PushBackInput.mod provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 61);
+    }
+  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-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 61);
+        }
+    }
+}
+
+
+/*
+   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-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 61);
+        }
+    }
+}
+
+
+/*
+   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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GPushBackInput.h b/gcc/m2/mc-boot/GPushBackInput.h
new file mode 100644
index 00000000000..68ab44bf2dd
--- /dev/null
+++ b/gcc/m2/mc-boot/GPushBackInput.h
@@ -0,0 +1,142 @@
+/* do not edit automatically generated by mc from PushBackInput.  */
+/* PushBackInput.def provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2021 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 (_PushBackInput_H)
+#   define _PushBackInput_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GFIO.h"
+#   include "GDynamicStrings.h"
+
+#   if defined (_PushBackInput_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Open - opens a file for reading.
+*/
+
+EXTERN 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 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 char PushBackInput_PutCh (char ch);
+
+/*
+   PutString - pushes a string onto the push back stack.
+*/
+
+EXTERN 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 void PushBackInput_PutStr (DynamicStrings_String s);
+
+/*
+   Error - emits an error message with the appropriate file, line combination.
+*/
+
+EXTERN 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 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 void PushBackInput_WarnString (DynamicStrings_String s);
+
+/*
+   Close - closes the opened file.
+*/
+
+EXTERN void PushBackInput_Close (FIO_File f);
+
+/*
+   GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*/
+
+EXTERN unsigned int PushBackInput_GetExitStatus (void);
+
+/*
+   SetDebug - sets the debug flag on or off.
+*/
+
+EXTERN void PushBackInput_SetDebug (unsigned int d);
+
+/*
+   GetColumnPosition - returns the column position of the current character.
+*/
+
+EXTERN unsigned int PushBackInput_GetColumnPosition (void);
+
+/*
+   GetCurrentLine - returns the current line number.
+*/
+
+EXTERN unsigned int PushBackInput_GetCurrentLine (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GRTExceptions.c b/gcc/m2/mc-boot/GRTExceptions.c
new file mode 100644
index 00000000000..046e681b065
--- /dev/null
+++ b/gcc/m2/mc-boot/GRTExceptions.c
@@ -0,0 +1,1221 @@
+/* do not edit automatically generated by mc from RTExceptions.  */
+/* RTExceptions.mod runtime exception handler routines.
+
+Copyright (C) 2008-2021 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);
+
+/*
+   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);
+
+/*
+   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) ();
+    }
+}
+
+
+/*
+   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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 612, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 624, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 636, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 648, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 660, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 672, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 684, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 696, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 708, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 720, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 732, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 744, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 756, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 768, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 780, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 60, 598, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+    }
+  else
+    {
+      return currentEHB;
+    }
+  ReturnException ("../../gcc-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+  TidyUp ();
+}
diff --git a/gcc/m2/mc-boot/GRTExceptions.h b/gcc/m2/mc-boot/GRTExceptions.h
new file mode 100644
index 00000000000..6a00a981b90
--- /dev/null
+++ b/gcc/m2/mc-boot/GRTExceptions.h
@@ -0,0 +1,190 @@
+/* do not edit automatically generated by mc from RTExceptions.  */
+/* RTExceptions.def runtime exception handler routines.
+
+Copyright (C) 2008-2021 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 (_RTExceptions_H)
+#   define _RTExceptions_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_RTExceptions_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (RTExceptions_EHBlock_D)
+#  define RTExceptions_EHBlock_D
+   typedef void *RTExceptions_EHBlock;
+#endif
+
+typedef struct RTExceptions_ProcedureHandler_p RTExceptions_ProcedureHandler;
+
+typedef void (*RTExceptions_ProcedureHandler_t) (void);
+struct RTExceptions_ProcedureHandler_p { RTExceptions_ProcedureHandler_t proc; };
+
+
+/*
+   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 void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message);
+
+/*
+   SetExceptionBlock - sets, source, as the active EHB.
+*/
+
+EXTERN void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source);
+
+/*
+   GetExceptionBlock - returns the active EHB.
+*/
+
+EXTERN RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void);
+
+/*
+   GetTextBuffer - returns the address of the EHB buffer.
+*/
+
+EXTERN void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e);
+
+/*
+   GetTextBufferSize - return the size of the EHB text buffer.
+*/
+
+EXTERN unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e);
+
+/*
+   GetNumber - return the exception number associated with,
+               source.
+*/
+
+EXTERN unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source);
+
+/*
+   InitExceptionBlock - creates and returns a new exception block.
+*/
+
+EXTERN RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void);
+
+/*
+   KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*/
+
+EXTERN RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e);
+
+/*
+   PushHandler - install a handler in EHB, e.
+*/
+
+EXTERN void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p);
+
+/*
+   PopHandler - removes the handler associated with, number, from
+                EHB, e.
+*/
+
+EXTERN 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 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 void RTExceptions_BaseExceptionsThrow (void);
+
+/*
+   IsInExceptionState - returns TRUE if the program is currently
+                        in the exception state.
+*/
+
+EXTERN unsigned int RTExceptions_IsInExceptionState (void);
+
+/*
+   SetExceptionState - returns the current exception state and
+                       then sets the current exception state to,
+                       to.
+*/
+
+EXTERN unsigned int RTExceptions_SetExceptionState (unsigned int to);
+
+/*
+   SwitchExceptionState - assigns, from, with the current exception
+                          state and then assigns the current exception
+                          to, to.
+*/
+
+EXTERN void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to);
+
+/*
+   GetBaseExceptionBlock - returns the initial language exception block
+                           created.
+*/
+
+EXTERN RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void);
+
+/*
+   SetExceptionSource - sets the current exception source to, source.
+*/
+
+EXTERN void RTExceptions_SetExceptionSource (void * source);
+
+/*
+   GetExceptionSource - returns the current exception source.
+*/
+
+EXTERN void * RTExceptions_GetExceptionSource (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GRTco.h b/gcc/m2/mc-boot/GRTco.h
new file mode 100644
index 00000000000..858d48a4431
--- /dev/null
+++ b/gcc/m2/mc-boot/GRTco.h
@@ -0,0 +1,114 @@
+/* do not edit automatically generated by mc from RTco.  */
+/* RTco.def provides minimal access to thread primitives.
+
+Copyright (C) 2019-2021 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 (_RTco_H)
+#   define _RTco_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_RTco_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN int RTco_init (void);
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN int RTco_initThread (PROC p, unsigned int stackSize, unsigned int interruptLevel);
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN int RTco_initSemaphore (unsigned int value);
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN void RTco_wait (int semaphore);
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN void RTco_signal (int semaphore);
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN void RTco_transfer (int *p1, int p2);
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN void RTco_waitThread (int tid);
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN void RTco_signalThread (int tid);
+
+/*
+ init initializes the module and allows the application to lazily invoke threads.  */
+
+EXTERN int RTco_currentThread (void);
+
+/*
+ currentInterruptLevel returns the interrupt level of the current thread.  */
+
+EXTERN unsigned int RTco_currentInterruptLevel (void);
+EXTERN unsigned int RTco_turnInterrupts (unsigned int newLevel);
+
+/*
+   select access to the select system call which will be thread safe.
+   This is typically called from the idle process to wait for an interrupt.
+*/
+
+EXTERN int RTco_select (int p1, void * p2, void * p3, void * p4, void * p5);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GRTint.c b/gcc/m2/mc-boot/GRTint.c
new file mode 100644
index 00000000000..fd73d328894
--- /dev/null
+++ b/gcc/m2/mc-boot/GRTint.c
@@ -0,0 +1,1122 @@
+/* do not edit automatically generated by mc from RTint.  */
+/* RTint.mod provides users of the COROUTINES library with the.
+
+Copyright (C) 2009-2021 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, p, 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 * p);
+
+/*
+   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, t,
+                which is associated with file descriptor, fd.
+*/
+
+static RTint_Vector FindVector (int fd, RTint_VectorType t);
+
+/*
+   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, s, updating, max.
+*/
+
+static void AddFd (Selective_SetOfFd *s, int *max, int fd);
+
+/*
+   DumpPendingQueue - displays the pending queue.
+*/
+
+static void DumpPendingQueue (void);
+
+/*
+   DumpPendingQueue - displays the pending queue.
+*/
+
+static void stop (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 *i, Selective_SetOfFd *o, Selective_Timeval *t, 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, t,
+                which is associated with file descriptor, fd.
+*/
+
+static RTint_Vector FindVector (int fd, RTint_VectorType t)
+{
+  RTint_Vector v;
+
+  v = Exists;
+  while (v != NULL)
+    {
+      if ((v->type == t) && (v->File == fd))
+        {
+          return v;
+        }
+      v = v->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 v;
+
+  v = Exists;
+  while ((v != NULL) && (v->no != vec))
+    {
+      v = v->exists;
+    }
+  return v;
+  /* 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 i;
+  RTint_Vector v;
+
+  for (i=COROUTINES_UnassignedPriority; i<=7; i++)
+    {
+      v = Pending.array[i-(COROUTINES_UnassignedPriority)];
+      while ((v != NULL) && (v->no != vec))
+        {
+          v = v->pending;
+        }
+      if ((v != NULL) && (v->no == vec))
+        {
+          return v;
+        }
+    }
+  return NULL;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   AddFd - adds the file descriptor, fd, to set, s, updating, max.
+*/
+
+static void AddFd (Selective_SetOfFd *s, int *max, int fd)
+{
+  (*max) = Max (fd, (*max));
+  if ((*s) == NULL)
+    {
+      (*s) = Selective_InitSet ();
+      Selective_FdZero ((*s));
+    }
+  /* printf('%d, ', fd)  */
+  Selective_FdSet (fd, (*s));
+}
+
+
+/*
+   DumpPendingQueue - displays the pending queue.
+*/
+
+static void DumpPendingQueue (void)
+{
+  COROUTINES_PROTECTION p;
+  RTint_Vector v;
+  unsigned int s;
+  unsigned int m;
+
+  libc_printf ((const char *) "Pending queue\\n", 15);
+  for (p=COROUTINES_UnassignedPriority; p<=7; p++)
+    {
+      libc_printf ((const char *) "[%d]  ", 6, p);
+      v = Pending.array[p-(COROUTINES_UnassignedPriority)];
+      while (v != NULL)
+        {
+          if ((v->type == RTint_input) || (v->type == RTint_output))
+            {
+              libc_printf ((const char *) "(fd=%d) (vec=%d)", 16, v->File, v->no);
+            }
+          else if (v->type == RTint_time)
+            {
+              /* avoid dangling else.  */
+              Selective_GetTime (v->rel, &s, &m);
+              Assertion_Assert (m < Microseconds);
+              libc_printf ((const char *) "time (%u.%06u secs) (arg = 0x%x)\\n", 34, s, m, v->arg);
+            }
+          v = v->pending;
+        }
+      libc_printf ((const char *) " \\n", 3);
+    }
+}
+
+
+/*
+   DumpPendingQueue - displays the pending queue.
+*/
+
+static void stop (void)
+{
+}
+
+
+/*
+   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 *i, Selective_SetOfFd *o, Selective_Timeval *t, Selective_Timeval b4, Selective_Timeval after)
+{
+  int r;
+  unsigned int p;
+  RTint_Vector v;
+  unsigned int b4s;
+  unsigned int b4m;
+  unsigned int afs;
+  unsigned int afm;
+  unsigned int s;
+  unsigned int m;
+
+  RTco_wait (lock);
+  p = static_cast<unsigned int> (7);
+  while (p > pri)
+    {
+      v = Pending.array[p-(COROUTINES_UnassignedPriority)];
+      while (v != NULL)
+        {
+          switch (v->type)
+            {
+              case RTint_input:
+                if (((v->File < maxFd) && ((*i) != NULL)) && (Selective_FdIsSet (v->File, (*i))))
+                  {
+                    if (Debugging)
+                      {
+                        libc_printf ((const char *) "read (fd=%d) is ready (vec=%d)\\n", 32, v->File, v->no);
+                        DumpPendingQueue ();
+                      }
+                    Selective_FdClr (v->File, (*i));  /* so we dont activate this again from our select.  */
+                    RTco_signal (lock);  /* so we dont activate this again from our select.  */
+                    (*call.proc) (v->no, v->priority, v->arg);
+                    return TRUE;
+                  }
+                break;
+
+              case RTint_output:
+                if (((v->File < maxFd) && ((*o) != NULL)) && (Selective_FdIsSet (v->File, (*o))))
+                  {
+                    if (Debugging)
+                      {
+                        libc_printf ((const char *) "write (fd=%d) is ready (vec=%d)\\n", 33, v->File, v->no);
+                        DumpPendingQueue ();
+                      }
+                    Selective_FdClr (v->File, (*o));  /* so we dont activate this again from our select.  */
+                    RTco_signal (lock);  /* so we dont activate this again from our select.  */
+                    (*call.proc) (v->no, v->priority, v->arg);
+                    return TRUE;
+                  }
+                break;
+
+              case RTint_time:
+                if (untilInterrupt && ((*t) != NULL))
+                  {
+                    r = Selective_GetTimeOfDay (after);
+                    Assertion_Assert (r == 0);
+                    if (Debugging)
+                      {
+                        Selective_GetTime ((*t), &s, &m);
+                        Assertion_Assert (m < 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, s, m, b4s, b4m, afs, afm);
+                      }
+                    if (IsGreaterEqual (after, v->abs_))
+                      {
+                        if (Debugging)
+                          {
+                            DumpPendingQueue ();
+                            libc_printf ((const char *) "time has expired calling dispatcher\\n", 37);
+                          }
+                        (*t) = Selective_KillTime ((*t));  /* 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, v->no, v->priority, v->arg);
+                          }
+                        (*call.proc) (v->no, v->priority, v->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-git-devel-modula2/gcc/m2/gm2-libs/RTint.def", 25, 1);
+                __builtin_unreachable ();
+            }
+          v = v->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 v;
+
+  if (Debugging)
+    {
+      libc_printf ((const char *) "InitInputVector fd = %d priority = %d\\n", 39, fd, pri);
+    }
+  RTco_wait (lock);
+  v = FindVector (fd, RTint_input);
+  if (v == NULL)
+    {
+      Storage_ALLOCATE ((void **) &v, sizeof (RTint__T1));
+      VecNo += 1;
+      v->type = RTint_input;
+      v->priority = pri;
+      v->arg = NULL;
+      v->pending = NULL;
+      v->exists = Exists;
+      v->no = VecNo;
+      v->File = fd;
+      Exists = v;
+      RTco_signal (lock);
+      return VecNo;
+    }
+  else
+    {
+      RTco_signal (lock);
+      return v->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 v;
+
+  RTco_wait (lock);
+  v = FindVector (fd, RTint_output);
+  if (v == NULL)
+    {
+      Storage_ALLOCATE ((void **) &v, sizeof (RTint__T1));
+      if (v == NULL)
+        {
+          M2RTS_HALT (-1);
+          __builtin_unreachable ();
+        }
+      else
+        {
+          VecNo += 1;
+          v->type = RTint_output;
+          v->priority = pri;
+          v->arg = NULL;
+          v->pending = NULL;
+          v->exists = Exists;
+          v->no = VecNo;
+          v->File = fd;
+          Exists = v;
+          RTco_signal (lock);
+          return VecNo;
+        }
+    }
+  else
+    {
+      RTco_signal (lock);
+      return v->no;
+    }
+  ReturnException ("../../gcc-git-devel-modula2/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 v;
+
+  RTco_wait (lock);
+  Storage_ALLOCATE ((void **) &v, sizeof (RTint__T1));
+  if (v == NULL)
+    {
+      M2RTS_HALT (-1);
+      __builtin_unreachable ();
+    }
+  else
+    {
+      VecNo += 1;
+      Assertion_Assert (micro < Microseconds);
+      v->type = RTint_time;
+      v->priority = pri;
+      v->arg = NULL;
+      v->pending = NULL;
+      v->exists = Exists;
+      v->no = VecNo;
+      v->rel = Selective_InitTime (secs+DebugTime, micro);
+      v->abs_ = Selective_InitTime (0, 0);
+      v->queued = FALSE;
+      Exists = v;
+    }
+  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 v;
+
+  Assertion_Assert (micro < Microseconds);
+  RTco_wait (lock);
+  v = FindVectorNo (vec);
+  if (v == NULL)
+    {
+      M2RTS_Halt ((const char *) "../../gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 53, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
+    }
+  else
+    {
+      Selective_SetTime (v->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 v;
+
+  RTco_wait (lock);
+  v = FindVectorNo (vec);
+  if (v == NULL)
+    {
+      M2RTS_Halt ((const char *) "../../gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 53, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
+    }
+  else
+    {
+      Selective_GetTime (v->rel, secs, micro);
+      Assertion_Assert ((*micro) < Microseconds);
+    }
+  RTco_signal (lock);
+}
+
+
+/*
+   AttachVector - adds the pointer, p, 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 * p)
+{
+  RTint_Vector v;
+  void * l;
+
+  RTco_wait (lock);
+  v = FindVectorNo (vec);
+  if (v == NULL)
+    {
+      M2RTS_Halt ((const char *) "../../gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 53, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
+    }
+  else
+    {
+      l = v->arg;
+      v->arg = p;
+      if (Debugging)
+        {
+          libc_printf ((const char *) "AttachVector %d with 0x%x\\n", 27, vec, p);
+          DumpPendingQueue ();
+        }
+      RTco_signal (lock);
+      return l;
+    }
+  ReturnException ("../../gcc-git-devel-modula2/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 v;
+  unsigned int m;
+  unsigned int s;
+  int r;
+
+  RTco_wait (lock);
+  v = FindPendingVector (vec);
+  if (v == NULL)
+    {
+      /* avoid dangling else.  */
+      v = FindVectorNo (vec);
+      if (v == NULL)
+        {
+          M2RTS_Halt ((const char *) "../../gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 53, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
+        }
+      else
+        {
+          /* printf('including vector %d  (fd = %d)
+          ', vec, v^.File) ;  */
+          v->pending = Pending.array[v->priority-(COROUTINES_UnassignedPriority)];
+          Pending.array[v->priority-(COROUTINES_UnassignedPriority)] = v;
+          if ((v->type == RTint_time) && ! v->queued)
+            {
+              v->queued = TRUE;
+              r = Selective_GetTimeOfDay (v->abs_);
+              Assertion_Assert (r == 0);
+              Selective_GetTime (v->abs_, &s, &m);
+              Assertion_Assert (m < Microseconds);
+              AddTime (v->abs_, v->rel);
+              Selective_GetTime (v->abs_, &s, &m);
+              Assertion_Assert (m < Microseconds);
+            }
+        }
+    }
+  else
+    {
+      if (Debugging)
+        {
+          libc_printf ((const char *) "odd vector (%d) type (%d) arg (0x%x) is already attached to the pending queue\\n", 79, vec, v->type, v->arg);
+        }
+      stop ();
+    }
+  RTco_signal (lock);
+}
+
+
+/*
+   ExcludeVector - excludes, vec, from the dispatcher list of
+                   possible interrupt causes.
+*/
+
+extern "C" void RTint_ExcludeVector (unsigned int vec)
+{
+  RTint_Vector v;
+  RTint_Vector u;
+
+  RTco_wait (lock);
+  v = FindPendingVector (vec);
+  if (v == NULL)
+    {
+      M2RTS_Halt ((const char *) "../../gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 53, 415, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
+    }
+  else
+    {
+      /* printf('excluding vector %d
+      ', vec) ;  */
+      if (Pending.array[v->priority-(COROUTINES_UnassignedPriority)] == v)
+        {
+          Pending.array[v->priority-(COROUTINES_UnassignedPriority)] = Pending.array[v->priority-(COROUTINES_UnassignedPriority)]->pending;
+        }
+      else
+        {
+          u = Pending.array[v->priority-(COROUTINES_UnassignedPriority)];
+          while (u->pending != v)
+            {
+              u = u->pending;
+            }
+          u->pending = v->pending;
+        }
+      if (v->type == RTint_time)
+        {
+          v->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 r;
+  Selective_Timeval after;
+  Selective_Timeval b4;
+  Selective_Timeval t;
+  RTint_Vector v;
+  Selective_SetOfFd i;
+  Selective_SetOfFd o;
+  unsigned int b4s;
+  unsigned int b4m;
+  unsigned int afs;
+  unsigned int afm;
+  unsigned int s;
+  unsigned int m;
+  int maxFd;
+  unsigned int p;
+
+  RTco_wait (lock);
+  if (pri < (7))
+    {
+      if (Debugging)
+        {
+          DumpPendingQueue ();
+        }
+      maxFd = -1;
+      t = NULL;
+      i = NULL;
+      o = NULL;
+      t = Selective_InitTime (static_cast<unsigned int> (INT_MAX), 0);
+      p = static_cast<unsigned int> (7);
+      found = FALSE;
+      while (p > pri)
+        {
+          v = Pending.array[p-(COROUTINES_UnassignedPriority)];
+          while (v != NULL)
+            {
+              switch (v->type)
+                {
+                  case RTint_input:
+                    AddFd (&i, &maxFd, v->File);
+                    break;
+
+                  case RTint_output:
+                    AddFd (&o, &maxFd, v->File);
+                    break;
+
+                  case RTint_time:
+                    if (IsGreaterEqual (t, v->abs_))
+                      {
+                        Selective_GetTime (v->abs_, &s, &m);
+                        Assertion_Assert (m < Microseconds);
+                        if (Debugging)
+                          {
+                            libc_printf ((const char *) "shortest delay is %u.%06u\\n", 27, s, m);
+                          }
+                        Selective_SetTime (t, s, m);
+                        found = TRUE;
+                      }
+                    break;
+
+
+                  default:
+                    CaseException ("../../gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.def", 25, 1);
+                    __builtin_unreachable ();
+                }
+              v = v->pending;
+            }
+          p -= 1;
+        }
+      if (! untilInterrupt)
+        {
+          Selective_SetTime (t, 0, 0);
+        }
+      if (((untilInterrupt && (i == NULL)) && (o == NULL)) && ! found)
+        {
+          M2RTS_Halt ((const char *) "../../gcc-git-devel-modula2/gcc/m2/gm2-libs/RTint.mod", 53, 731, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
+        }
+      /* printf('}
+      ') ;  */
+      if (((! found && (maxFd == -1)) && (i == NULL)) && (o == NULL))
+        {
+          /* no file descriptors to be selected upon.  */
+          t = Selective_KillTime (t);
+          RTco_signal (lock);
+          return ;
+        }
+      else
+        {
+          Selective_GetTime (t, &s, &m);
+          Assertion_Assert (m < Microseconds);
+          b4 = Selective_InitTime (0, 0);
+          after = Selective_InitTime (0, 0);
+          r = Selective_GetTimeOfDay (b4);
+          Assertion_Assert (r == 0);
+          SubTime (&s, &m, t, b4);
+          Selective_SetTime (t, s, m);
+          if (Debugging)
+            {
+              libc_printf ((const char *) "select waiting for %u.%06u seconds\\n", 36, s, m);
+            }
+          RTco_signal (lock);
+          do {
+            if (Debugging)
+              {
+                libc_printf ((const char *) "select (.., .., .., %u.%06u)\\n", 30, s, m);
+              }
+            r = RTco_select (maxFd+1, i, o, NULL, t);
+            if (r == -1)
+              {
+                libc_perror ((const char *) "select", 6);
+                r = RTco_select (maxFd+1, i, o, NULL, NULL);
+                if (r == -1)
+                  {
+                    libc_perror ((const char *) "select timeout argument is faulty", 33);
+                  }
+                r = RTco_select (maxFd+1, i, NULL, NULL, t);
+                if (r == -1)
+                  {
+                    libc_perror ((const char *) "select output fd argument is faulty", 35);
+                  }
+                r = RTco_select (maxFd+1, NULL, o, NULL, t);
+                if (r == -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 (! (r != -1));
+        }
+      while (activatePending (untilInterrupt, call, pri, maxFd+1, &i, &o, &t, b4, after))
+        {}  /* empty.  */
+      if (t != NULL)
+        {
+          t = Selective_KillTime (t);
+        }
+      if (after != NULL)
+        {
+          t = Selective_KillTime (after);
+        }
+      if (b4 != NULL)
+        {
+          t = Selective_KillTime (b4);
+        }
+      if (i != NULL)
+        {
+          i = Selective_KillSet (i);
+        }
+      if (o != NULL)
+        {
+          o = Selective_KillSet (o);
+        }
+    }
+  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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GRTint.h b/gcc/m2/mc-boot/GRTint.h
new file mode 100644
index 00000000000..7dcceaf2c5b
--- /dev/null
+++ b/gcc/m2/mc-boot/GRTint.h
@@ -0,0 +1,137 @@
+/* do not edit automatically generated by mc from RTint.  */
+/* RTint.def provides users of the COROUTINES library with the.
+
+Copyright (C) 2009-2021 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 (_RTint_H)
+#   define _RTint_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_RTint_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct RTint_DispatchVector_p RTint_DispatchVector;
+
+typedef void (*RTint_DispatchVector_t) (unsigned int, unsigned int, void *);
+struct RTint_DispatchVector_p { RTint_DispatchVector_t proc; };
+
+
+/*
+   InitInputVector - returns an interrupt vector which is associated
+                     with the file descriptor, fd.
+*/
+
+EXTERN unsigned int RTint_InitInputVector (int fd, unsigned int pri);
+
+/*
+   InitOutputVector - returns an interrupt vector which is associated
+                      with the file descriptor, fd.
+*/
+
+EXTERN unsigned int RTint_InitOutputVector (int fd, unsigned int pri);
+
+/*
+   InitTimeVector - returns an interrupt vector associated with
+                    the relative time.
+*/
+
+EXTERN 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 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 void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsigned int *secs);
+
+/*
+   AttachVector - adds the pointer, p, to be associated with the interrupt
+                  vector. It returns the previous value attached to this
+                  vector.
+*/
+
+EXTERN void * RTint_AttachVector (unsigned int vec, void * p);
+
+/*
+   IncludeVector - includes, vec, into the dispatcher list of
+                   possible interrupt causes.
+*/
+
+EXTERN void RTint_IncludeVector (unsigned int vec);
+
+/*
+   ExcludeVector - excludes, vec, from the dispatcher list of
+                   possible interrupt causes.
+*/
+
+EXTERN 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 void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri);
+
+/*
+   Init - allows the user to force the initialize order.
+*/
+
+EXTERN void RTint_Init (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GSArgs.c b/gcc/m2/mc-boot/GSArgs.c
new file mode 100644
index 00000000000..81fa51da63a
--- /dev/null
+++ b/gcc/m2/mc-boot/GSArgs.c
@@ -0,0 +1,125 @@
+/* do not edit automatically generated by mc from SArgs.  */
+/* SArgs.mod provides a String interface to the command line arguments.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GSArgs.h b/gcc/m2/mc-boot/GSArgs.h
new file mode 100644
index 00000000000..d0fcc3760d3
--- /dev/null
+++ b/gcc/m2/mc-boot/GSArgs.h
@@ -0,0 +1,72 @@
+/* do not edit automatically generated by mc from SArgs.  */
+/* SArgs.def provides a String interface to the command line arguments.
+
+Copyright (C) 2001-2021 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 (_SArgs_H)
+#   define _SArgs_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_SArgs_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   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 unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int n);
+
+/*
+   Narg - returns the number of arguments available from
+          command line.
+*/
+
+EXTERN unsigned int SArgs_Narg (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GSFIO.c b/gcc/m2/mc-boot/GSFIO.c
new file mode 100644
index 00000000000..cbe50fc386d
--- /dev/null
+++ b/gcc/m2/mc-boot/GSFIO.c
@@ -0,0 +1,216 @@
+/* do not edit automatically generated by mc from SFIO.  */
+/* SFIO.mod provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GSFIO.h b/gcc/m2/mc-boot/GSFIO.h
new file mode 100644
index 00000000000..36be78de9fb
--- /dev/null
+++ b/gcc/m2/mc-boot/GSFIO.h
@@ -0,0 +1,110 @@
+/* do not edit automatically generated by mc from SFIO.  */
+/* SFIO.def provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2021 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 (_SFIO_H)
+#   define _SFIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+#   include "GFIO.h"
+
+#   if defined (_SFIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+EXTERN 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 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 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 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 DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s);
+
+/*
+   ReadS - reads a string, s, from, file. It returns the String, s.
+           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 DynamicStrings_String SFIO_ReadS (FIO_File file);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GSYSTEM.h b/gcc/m2/mc-boot/GSYSTEM.h
new file mode 100644
index 00000000000..9f6b1f70461
--- /dev/null
+++ b/gcc/m2/mc-boot/GSYSTEM.h
@@ -0,0 +1,112 @@
+/* do not edit automatically generated by mc from SYSTEM.  */
+/* SYSTEM.def provides access to the SYSTEM dependent module.
+
+Copyright (C) 2001-2021 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 (_SYSTEM_H)
+#   define _SYSTEM_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_SYSTEM_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define SYSTEM_BITSPERBYTE 8
+#   define SYSTEM_BYTESPERWORD 4
+
+/*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*/
+
+EXTERN void SYSTEM_ShiftVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int ShiftCount);
+
+/*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*/
+
+EXTERN void SYSTEM_ShiftLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
+
+/*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*/
+
+EXTERN void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
+
+/*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger
+               sets.
+*/
+
+EXTERN void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount);
+
+/*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*/
+
+EXTERN void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
+
+/*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*/
+
+EXTERN void SYSTEM_RotateRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GSelective.h b/gcc/m2/mc-boot/GSelective.h
new file mode 100644
index 00000000000..3c29f2847a0
--- /dev/null
+++ b/gcc/m2/mc-boot/GSelective.h
@@ -0,0 +1,82 @@
+/* do not edit automatically generated by mc from Selective.  */
+/* Selective.def provides Modula-2 with access to the select(2) primitive.
+
+Copyright (C) 2001-2021 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 (_Selective_H)
+#   define _Selective_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_Selective_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef void *Selective_SetOfFd;
+
+typedef void *Selective_Timeval;
+
+EXTERN int Selective_Select (unsigned int nooffds, Selective_SetOfFd readfds, Selective_SetOfFd writefds, Selective_SetOfFd exceptfds, Selective_Timeval timeout);
+EXTERN Selective_Timeval Selective_InitTime (unsigned int sec, unsigned int usec);
+EXTERN Selective_Timeval Selective_KillTime (Selective_Timeval t);
+EXTERN void Selective_GetTime (Selective_Timeval t, unsigned int *sec, unsigned int *usec);
+EXTERN void Selective_SetTime (Selective_Timeval t, unsigned int sec, unsigned int usec);
+EXTERN Selective_SetOfFd Selective_InitSet (void);
+EXTERN Selective_SetOfFd Selective_KillSet (Selective_SetOfFd s);
+EXTERN void Selective_FdZero (Selective_SetOfFd s);
+EXTERN void Selective_FdSet (int fd, Selective_SetOfFd s);
+EXTERN void Selective_FdClr (int fd, Selective_SetOfFd s);
+EXTERN unsigned int Selective_FdIsSet (int fd, Selective_SetOfFd s);
+EXTERN int Selective_MaxFdsPlusOne (int a, int b);
+EXTERN void Selective_WriteCharRaw (int fd, char ch);
+EXTERN char Selective_ReadCharRaw (int fd);
+
+/*
+   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 (Selective_Timeval tv);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GStdIO.c b/gcc/m2/mc-boot/GStdIO.c
new file mode 100644
index 00000000000..3a575f7562f
--- /dev/null
+++ b/gcc/m2/mc-boot/GStdIO.c
@@ -0,0 +1,269 @@
+/* do not edit automatically generated by mc from StdIO.  */
+/* StdIO.mod provides general Read and Write procedures.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStdIO.h b/gcc/m2/mc-boot/GStdIO.h
new file mode 100644
index 00000000000..34a8870c85a
--- /dev/null
+++ b/gcc/m2/mc-boot/GStdIO.h
@@ -0,0 +1,119 @@
+/* do not edit automatically generated by mc from StdIO.  */
+/* StdIO.def provides general Read and Write procedures.
+
+Copyright (C) 2001-2021 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 (_StdIO_H)
+#   define _StdIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_StdIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct StdIO_ProcWrite_p StdIO_ProcWrite;
+
+typedef struct StdIO_ProcRead_p StdIO_ProcRead;
+
+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; };
+
+
+/*
+   Read - is the generic procedure that all higher application layers
+          should use to receive a character.
+*/
+
+EXTERN void StdIO_Read (char *ch);
+
+/*
+   Write - is the generic procedure that all higher application layers
+           should use to emit a character.
+*/
+
+EXTERN 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 void StdIO_PushOutput (StdIO_ProcWrite p);
+
+/*
+   PopOutput - restores Write to use the previous output procedure.
+*/
+
+EXTERN void StdIO_PopOutput (void);
+
+/*
+   GetCurrentOutput - returns the current output procedure.
+*/
+
+EXTERN 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 void StdIO_PushInput (StdIO_ProcRead p);
+
+/*
+   PopInput - restores Write to use the previous output procedure.
+*/
+
+EXTERN void StdIO_PopInput (void);
+
+/*
+   GetCurrentInput - returns the current input procedure.
+*/
+
+EXTERN StdIO_ProcRead StdIO_GetCurrentInput (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GStorage.c b/gcc/m2/mc-boot/GStorage.c
new file mode 100644
index 00000000000..aae84c8d75b
--- /dev/null
+++ b/gcc/m2/mc-boot/GStorage.c
@@ -0,0 +1,74 @@
+/* do not edit automatically generated by mc from Storage.  */
+/* Storage.mod provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStorage.h b/gcc/m2/mc-boot/GStorage.h
new file mode 100644
index 00000000000..517f255b236
--- /dev/null
+++ b/gcc/m2/mc-boot/GStorage.h
@@ -0,0 +1,86 @@
+/* do not edit automatically generated by mc from Storage.  */
+/* Storage.def provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2021 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 (_Storage_H)
+#   define _Storage_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_Storage_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   ALLOCATE - attempt to allocate memory from the heap.
+              NIL is returned in, a, if ALLOCATE fails.
+*/
+
+EXTERN void Storage_ALLOCATE (void * *a, unsigned int Size);
+
+/*
+   DEALLOCATE - return, Size, bytes to the heap.
+                The variable, a, is set to NIL.
+*/
+
+EXTERN void Storage_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 void Storage_REALLOCATE (void * *a, unsigned int Size);
+
+/*
+   Available - returns TRUE if, Size, bytes can be allocated.
+*/
+
+EXTERN unsigned int Storage_Available (unsigned int Size);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GStrCase.c b/gcc/m2/mc-boot/GStrCase.c
new file mode 100644
index 00000000000..1ac42d81107
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrCase.c
@@ -0,0 +1,175 @@
+/* do not edit automatically generated by mc from StrCase.  */
+/* StrCase.mod provides procedure to convert between text case.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStrCase.h b/gcc/m2/mc-boot/GStrCase.h
new file mode 100644
index 00000000000..6294d60c99a
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrCase.h
@@ -0,0 +1,85 @@
+/* do not edit automatically generated by mc from StrCase.  */
+/* StrCase.def provides procedure to convert between text case.
+
+Copyright (C) 2001-2021 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 (_StrCase_H)
+#   define _StrCase_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_StrCase_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   StrToUpperCase - converts string, a, to uppercase returning the
+                    result in, b.
+*/
+
+EXTERN 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 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 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 char StrCase_Lower (char ch);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GStrIO.c b/gcc/m2/mc-boot/GStrIO.c
new file mode 100644
index 00000000000..59f1ba50b3b
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrIO.c
@@ -0,0 +1,277 @@
+/* do not edit automatically generated by mc from StrIO.  */
+/* StrIO.mod provides simple string input output routines.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStrIO.h b/gcc/m2/mc-boot/GStrIO.h
new file mode 100644
index 00000000000..6ec85184705
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrIO.h
@@ -0,0 +1,76 @@
+/* do not edit automatically generated by mc from StrIO.  */
+/* StrIO.def Provides simple string input output routines.
+
+Copyright (C) 2001-2021 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 (_StrIO_H)
+#   define _StrIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_StrIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   WriteLn - writes a carriage return and a newline
+             character.
+*/
+
+EXTERN 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 void StrIO_ReadString (char *a, unsigned int _a_high);
+
+/*
+   WriteString - writes a string to the default output.
+*/
+
+EXTERN void StrIO_WriteString (const char *a_, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GStrLib.c b/gcc/m2/mc-boot/GStrLib.c
new file mode 100644
index 00000000000..eaf63fa275b
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrLib.c
@@ -0,0 +1,346 @@
+/* do not edit automatically generated by mc from StrLib.  */
+/* StrLib.mod provides string manipulation procedures.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStrLib.h b/gcc/m2/mc-boot/GStrLib.h
new file mode 100644
index 00000000000..fa916ecab5f
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrLib.h
@@ -0,0 +1,101 @@
+/* do not edit automatically generated by mc from StrLib.  */
+/* StrLib.def provides string manipulation procedures.
+
+Copyright (C) 2001-2021 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 (_StrLib_H)
+#   define _StrLib_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_StrLib_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   StrConCat - combines a and b into c.
+*/
+
+EXTERN 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 unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+
+/*
+   StrEqual - performs a = b on two strings.
+*/
+
+EXTERN unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+
+/*
+   StrLen - returns the length of string, a.
+*/
+
+EXTERN 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 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 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 void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GStringConvert.c b/gcc/m2/mc-boot/GStringConvert.c
new file mode 100644
index 00000000000..75ad8fd6614
--- /dev/null
+++ b/gcc/m2/mc-boot/GStringConvert.c
@@ -0,0 +1,2005 @@
+/* do not edit automatically generated by mc from StringConvert.  */
+/* StringConvert.mod provides functions to convert numbers to and from strings.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/gcc/m2/gm2-libs/StringConvert.mod", 61, 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-git-devel-modula2/gcc/m2/gm2-libs/StringConvert.mod", 61, 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStringConvert.h b/gcc/m2/mc-boot/GStringConvert.h
new file mode 100644
index 00000000000..40d6c0bdf16
--- /dev/null
+++ b/gcc/m2/mc-boot/GStringConvert.h
@@ -0,0 +1,317 @@
+/* do not edit automatically generated by mc from StringConvert.  */
+/* StringConvert.def provides functions to convert numbers to and from strings.
+
+Copyright (C) 2001-2021 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 (_StringConvert_H)
+#   define _StringConvert_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_StringConvert_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   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 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
+                      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 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 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 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 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 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 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 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 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 short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+   stoi - decimal string to INTEGER
+*/
+
+EXTERN int StringConvert_stoi (DynamicStrings_String s);
+
+/*
+   itos - integer to decimal string.
+*/
+
+EXTERN DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign);
+
+/*
+   ctos - cardinal to decimal string.
+*/
+
+EXTERN DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding);
+
+/*
+   stoc - decimal string to CARDINAL
+*/
+
+EXTERN unsigned int StringConvert_stoc (DynamicStrings_String s);
+
+/*
+   hstoi - hexidecimal string to INTEGER
+*/
+
+EXTERN int StringConvert_hstoi (DynamicStrings_String s);
+
+/*
+   ostoi - octal string to INTEGER
+*/
+
+EXTERN int StringConvert_ostoi (DynamicStrings_String s);
+
+/*
+   bstoi - binary string to INTEGER
+*/
+
+EXTERN int StringConvert_bstoi (DynamicStrings_String s);
+
+/*
+   hstoc - hexidecimal string to CARDINAL
+*/
+
+EXTERN unsigned int StringConvert_hstoc (DynamicStrings_String s);
+
+/*
+   ostoc - octal string to CARDINAL
+*/
+
+EXTERN unsigned int StringConvert_ostoc (DynamicStrings_String s);
+
+/*
+   bstoc - binary string to CARDINAL
+*/
+
+EXTERN unsigned int StringConvert_bstoc (DynamicStrings_String s);
+
+/*
+   StringToLongreal - returns a LONGREAL and sets found to TRUE
+                      if a legal number is seen.
+*/
+
+EXTERN long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found);
+
+/*
+   LongrealToString - converts a LONGREAL number, Real, which has,
+                      TotalWidth, and FractionWidth into a string.
+
+                      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'
+
+                      If TotalWidth is 0 then the function
+                      will return the value of x which is converted
+                      into as a fixed point number with exhaustive
+                      precision.
+*/
+
+EXTERN DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+   stor - returns a REAL given a string.
+*/
+
+EXTERN double StringConvert_stor (DynamicStrings_String s);
+
+/*
+   stolr - returns a LONGREAL given a string.
+*/
+
+EXTERN 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 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 DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GSysExceptions.h b/gcc/m2/mc-boot/GSysExceptions.h
new file mode 100644
index 00000000000..c5a9884ed14
--- /dev/null
+++ b/gcc/m2/mc-boot/GSysExceptions.h
@@ -0,0 +1,62 @@
+/* do not edit automatically generated by mc from SysExceptions.  */
+/* SysExceptions.def provides a mechanism for the underlying libraries to.
+
+Copyright (C) 2009-2021 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 (_SysExceptions_H)
+#   define _SysExceptions_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_SysExceptions_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct SysExceptions_PROCEXCEPTION_p SysExceptions_PROCEXCEPTION;
+
+typedef void (*SysExceptions_PROCEXCEPTION_t) (void *);
+struct SysExceptions_PROCEXCEPTION_p { SysExceptions_PROCEXCEPTION_t proc; };
+
+EXTERN void SysExceptions_InitExceptionHandlers (SysExceptions_PROCEXCEPTION indexf, SysExceptions_PROCEXCEPTION range, SysExceptions_PROCEXCEPTION casef, SysExceptions_PROCEXCEPTION invalidloc, SysExceptions_PROCEXCEPTION function, SysExceptions_PROCEXCEPTION wholevalue, SysExceptions_PROCEXCEPTION wholediv, SysExceptions_PROCEXCEPTION realvalue, SysExceptions_PROCEXCEPTION realdiv, SysExceptions_PROCEXCEPTION complexvalue, SysExceptions_PROCEXCEPTION complexdiv, SysExceptions_PROCEXCEPTION protection, SysExceptions_PROCEXCEPTION systemf, SysExceptions_PROCEXCEPTION coroutine, SysExceptions_PROCEXCEPTION exception);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GSysStorage.c b/gcc/m2/mc-boot/GSysStorage.c
new file mode 100644
index 00000000000..aae6cd7db73
--- /dev/null
+++ b/gcc/m2/mc-boot/GSysStorage.c
@@ -0,0 +1,249 @@
+/* do not edit automatically generated by mc from SysStorage.  */
+/* SysStorage.mod provides dynamic allocation for the system components.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 58);
+    }
+  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-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 58);
+        }
+    }
+  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-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 58);
+        }
+      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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GSysStorage.h b/gcc/m2/mc-boot/GSysStorage.h
new file mode 100644
index 00000000000..ab5872768e0
--- /dev/null
+++ b/gcc/m2/mc-boot/GSysStorage.h
@@ -0,0 +1,95 @@
+/* do not edit automatically generated by mc from SysStorage.  */
+/* SysStorage.def provides dynamic allocation for the system components.
+
+Copyright (C) 2001-2021 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 (_SysStorage_H)
+#   define _SysStorage_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_SysStorage_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   ALLOCATE - attempt to allocate memory from the heap.
+              NIL is returned in, a, if ALLOCATE fails.
+*/
+
+EXTERN void SysStorage_ALLOCATE (void * *a, unsigned int size);
+
+/*
+   DEALLOCATE - return, size, bytes to the heap.
+                The variable, a, is set to NIL.
+*/
+
+EXTERN 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 void SysStorage_REALLOCATE (void * *a, unsigned int size);
+
+/*
+   Available - returns TRUE if, size, bytes can be allocated.
+*/
+
+EXTERN 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 void SysStorage_Init (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GTimeString.c b/gcc/m2/mc-boot/GTimeString.c
new file mode 100644
index 00000000000..440e82cc811
--- /dev/null
+++ b/gcc/m2/mc-boot/GTimeString.c
@@ -0,0 +1,91 @@
+/* do not edit automatically generated by mc from TimeString.  */
+/* TimeString.mod provides time related string manipulation procedures.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GTimeString.h b/gcc/m2/mc-boot/GTimeString.h
new file mode 100644
index 00000000000..6d71e55349b
--- /dev/null
+++ b/gcc/m2/mc-boot/GTimeString.h
@@ -0,0 +1,62 @@
+/* do not edit automatically generated by mc from TimeString.  */
+/* TimeString.def provides time related string manipulation procedures.
+
+Copyright (C) 2001-2021 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 (_TimeString_H)
+#   define _TimeString_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_TimeString_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   GetTimeString - places the time in ascii format into array, a.
+
+*/
+
+EXTERN void TimeString_GetTimeString (char *a, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GUnixArgs.h b/gcc/m2/mc-boot/GUnixArgs.h
new file mode 100644
index 00000000000..4960ba0a232
--- /dev/null
+++ b/gcc/m2/mc-boot/GUnixArgs.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from UnixArgs.  */
+/* UnixArgs.def Implements access to the arguments argc, argv, envp.
+
+Copyright (C) 2001-2021 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 (_UnixArgs_H)
+#   define _UnixArgs_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_UnixArgs_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN int UnixArgs_GetArgC (void);
+EXTERN void * UnixArgs_GetArgV (void);
+EXTERN void * UnixArgs_GetEnvV (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Galists.c b/gcc/m2/mc-boot/Galists.c
new file mode 100644
index 00000000000..9cd425a14a7
--- /dev/null
+++ b/gcc/m2/mc-boot/Galists.c
@@ -0,0 +1,440 @@
+/* do not edit automatically generated by mc from alists.  */
+/* alists.mod address lists module.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Galists.h b/gcc/m2/mc-boot/Galists.h
new file mode 100644
index 00000000000..a8040cd6680
--- /dev/null
+++ b/gcc/m2/mc-boot/Galists.h
@@ -0,0 +1,131 @@
+/* do not edit automatically generated by mc from alists.  */
+/* alists.def address lists module.
+
+Copyright (C) 2015-2022 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 (_alists_H)
+#   define _alists_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_alists_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (alists_alist_D)
+#  define alists_alist_D
+   typedef void *alists_alist;
+#endif
+
+typedef struct alists_performOperation_p alists_performOperation;
+
+typedef void (*alists_performOperation_t) (void *);
+struct alists_performOperation_p { alists_performOperation_t proc; };
+
+
+/*
+   initList - creates a new alist, l.
+*/
+
+EXTERN alists_alist alists_initList (void);
+
+/*
+   killList - deletes the complete alist, l.
+*/
+
+EXTERN void alists_killList (alists_alist *l);
+
+/*
+   putItemIntoList - places an ADDRESS, c, into alist, l.
+*/
+
+EXTERN void alists_putItemIntoList (alists_alist l, void * c);
+
+/*
+   getItemFromList - retrieves the nth ADDRESS from alist, l.
+*/
+
+EXTERN void * alists_getItemFromList (alists_alist l, unsigned int n);
+
+/*
+   getIndexOfList - returns the index for ADDRESS, c, in alist, l.
+                    If more than one CARDINAL, c, exists the index
+                    for the first is returned.
+*/
+
+EXTERN unsigned int alists_getIndexOfList (alists_alist l, void * c);
+
+/*
+   noOfItemsInList - returns the number of items in alist, l.
+*/
+
+EXTERN unsigned int alists_noOfItemsInList (alists_alist l);
+
+/*
+   includeItemIntoList - adds an ADDRESS, c, into a alist providing
+                         the value does not already exist.
+*/
+
+EXTERN void alists_includeItemIntoList (alists_alist l, void * c);
+
+/*
+   removeItemFromList - removes an ADDRESS, c, from a alist.
+                        It assumes that this value only appears once.
+*/
+
+EXTERN void alists_removeItemFromList (alists_alist l, void * c);
+
+/*
+   isItemInList - returns true if a ADDRESS, c, was found in alist, l.
+*/
+
+EXTERN unsigned int alists_isItemInList (alists_alist l, void * c);
+
+/*
+   foreachItemInListDo - calls procedure, P, foreach item in alist, l.
+*/
+
+EXTERN void alists_foreachItemInListDo (alists_alist l, alists_performOperation p);
+
+/*
+   duplicateList - returns a duplicate alist derived from, l.
+*/
+
+EXTERN alists_alist alists_duplicateList (alists_alist l);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gdecl.c b/gcc/m2/mc-boot/Gdecl.c
new file mode 100644
index 00000000000..bbc3325f3b8
--- /dev/null
+++ b/gcc/m2/mc-boot/Gdecl.c
@@ -0,0 +1,26922 @@
+/* do not edit automatically generated by mc from decl.  */
+/* decl.mod declaration nodes used to create the AST.
+
+Copyright (C) 2015-2022 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;
+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;
+
+#   define symbolKey_NulKey NULL
+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 wlists__T9_r wlists__T9;
+
+typedef struct mcPretty__T12_r mcPretty__T12;
+
+typedef struct DynamicStrings_Contents_r DynamicStrings_Contents;
+
+typedef struct DynamicStrings__T7_a DynamicStrings__T7;
+
+typedef struct wlists__T10_a wlists__T10;
+
+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 DynamicStrings__T7_a { char array[(MaxBuf-1)+1]; };
+struct wlists__T10_a { unsigned int array[maxNoOfElements-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 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;
+                       };
+
+struct DynamicStrings_Contents_r {
+                                   DynamicStrings__T7 buf;
+                                   unsigned int len;
+                                   DynamicStrings_String next;
+                                 };
+
+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, int argc, void * argv, void * envp);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+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 *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+extern "C" void M2RTS_ExitOnHalt (int e);
+extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *file_, unsigned int _file_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);
+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);
+
+/*
+   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" 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_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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  switch (f->kind)
+    {
+      case decl_varientfield:
+        f->varientfieldF.varient = v;
+        break;
+
+
+      default:
+        CaseException ("../../gcc-git-devel-modula2/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)) == nameKey_NulName)
+              {
+                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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  M2RTS_HALT (-1);
+  __builtin_unreachable ();
+  ReturnException ("../../gcc-git-devel-modula2/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-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  M2RTS_HALT (-1);
+  __builtin_unreachable ();
+  ReturnException ("../../gcc-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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)
+    {
+      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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  ReturnException ("../../gcc-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  M2RTS_HALT (-1);
+  __builtin_unreachable ();
+  ReturnException ("../../gcc-git-devel-modula2/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 *) "_finish", 7);
+  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 *) "_finish", 7);
+  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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  ReturnException ("../../gcc-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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 (&currentModule->defF.enumFixup);
+    }
+  else if (decl_isImp (currentModule))
+    {
+      /* avoid dangling else.  */
+      n = getNextFixup (&currentModule->impF.enumFixup);
+    }
+  else if (decl_isModule (currentModule))
+    {
+      /* avoid dangling else.  */
+      n = getNextFixup (&currentModule->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-git-devel-modula2/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-git-devel-modula2/gcc/m2/mc/decl.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  M2RTS_HALT (-1);
+  __builtin_unreachable ();
+  ReturnException ("../../gcc-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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 (&currentModule->defF.constFixup);
+    }
+  else if (decl_isImp (currentModule))
+    {
+      /* avoid dangling else.  */
+      return getNextFixup (&currentModule->impF.constFixup);
+    }
+  else if (decl_isModule (currentModule))
+    {
+      /* avoid dangling else.  */
+      return getNextFixup (&currentModule->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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gdecl.h b/gcc/m2/mc-boot/Gdecl.h
new file mode 100644
index 00000000000..cd01904ca36
--- /dev/null
+++ b/gcc/m2/mc-boot/Gdecl.h
@@ -0,0 +1,1281 @@
+/* do not edit automatically generated by mc from decl.  */
+/* decl.def declaration nodes used to create the AST.
+
+Copyright (C) 2015-2022 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 (_decl_H)
+#   define _decl_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GnameKey.h"
+#   include "GsymbolKey.h"
+#   include "GmcReserved.h"
+#   include "GmcComment.h"
+
+#   if defined (_decl_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (decl_node_D)
+#  define decl_node_D
+   typedef void *decl_node;
+#endif
+
+typedef struct decl_isNodeF_p decl_isNodeF;
+
+typedef unsigned int (*decl_isNodeF_t) (decl_node);
+struct decl_isNodeF_p { decl_isNodeF_t proc; };
+
+
+/*
+   getDeclaredMod - returns the token number associated with the nodes declaration
+                    in the implementation or program module.
+*/
+
+EXTERN unsigned int decl_getDeclaredMod (decl_node n);
+
+/*
+   getDeclaredDef - returns the token number associated with the nodes declaration
+                    in the definition module.
+*/
+
+EXTERN unsigned int decl_getDeclaredDef (decl_node n);
+
+/*
+   getFirstUsed - returns the token number associated with the first use of
+                  node, n.
+*/
+
+EXTERN unsigned int decl_getFirstUsed (decl_node n);
+
+/*
+   isDef - return TRUE if node, n, is a definition module.
+*/
+
+EXTERN unsigned int decl_isDef (decl_node n);
+
+/*
+   isImp - return TRUE if node, n, is an implementation module.
+*/
+
+EXTERN unsigned int decl_isImp (decl_node n);
+
+/*
+   isImpOrModule - returns TRUE if, n, is a program module or implementation module.
+*/
+
+EXTERN unsigned int decl_isImpOrModule (decl_node n);
+
+/*
+   isVisited - returns TRUE if the node was visited.
+*/
+
+EXTERN unsigned int decl_isVisited (decl_node n);
+
+/*
+   unsetVisited - unset the visited flag on a def/imp/module node.
+*/
+
+EXTERN void decl_unsetVisited (decl_node n);
+
+/*
+   setVisited - set the visited flag on a def/imp/module node.
+*/
+
+EXTERN void decl_setVisited (decl_node n);
+
+/*
+   setEnumsComplete - sets the field inside the def or imp or module, n.
+*/
+
+EXTERN void decl_setEnumsComplete (decl_node n);
+
+/*
+   getEnumsComplete - gets the field from the def or imp or module, n.
+*/
+
+EXTERN unsigned int decl_getEnumsComplete (decl_node n);
+
+/*
+   resetEnumPos - resets the index into the saved list of enums inside
+                  module, n.
+*/
+
+EXTERN void decl_resetEnumPos (decl_node n);
+
+/*
+   getNextEnum - returns the next enumeration node.
+*/
+
+EXTERN decl_node decl_getNextEnum (void);
+
+/*
+   isModule - return TRUE if node, n, is a program module.
+*/
+
+EXTERN 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 unsigned int decl_isMainModule (decl_node n);
+
+/*
+   setMainModule - sets node, n, as the main module to be compiled.
+*/
+
+EXTERN void decl_setMainModule (decl_node n);
+
+/*
+   setCurrentModule - sets node, n, as the current module being compiled.
+*/
+
+EXTERN void decl_setCurrentModule (decl_node n);
+
+/*
+   lookupDef - returns a definition module node named, n.
+*/
+
+EXTERN decl_node decl_lookupDef (nameKey_Name n);
+
+/*
+   lookupImp - returns an implementation module node named, n.
+*/
+
+EXTERN decl_node decl_lookupImp (nameKey_Name n);
+
+/*
+   lookupModule - returns a module node named, n.
+*/
+
+EXTERN decl_node decl_lookupModule (nameKey_Name n);
+
+/*
+   putDefForC - the definition module was defined FOR "C".
+*/
+
+EXTERN void decl_putDefForC (decl_node n);
+
+/*
+   lookupInScope - looks up a symbol named, n, from, scope.
+*/
+
+EXTERN decl_node decl_lookupInScope (decl_node scope, nameKey_Name n);
+
+/*
+   isConst - returns TRUE if node, n, is a const.
+*/
+
+EXTERN unsigned int decl_isConst (decl_node n);
+
+/*
+   isType - returns TRUE if node, n, is a type.
+*/
+
+EXTERN unsigned int decl_isType (decl_node n);
+
+/*
+   putType - places, exp, as the type alias to des.
+             TYPE des = exp ;
+*/
+
+EXTERN void decl_putType (decl_node des, decl_node exp);
+
+/*
+   getType - returns the type associated with node, n.
+*/
+
+EXTERN decl_node decl_getType (decl_node n);
+
+/*
+   skipType - skips over type aliases.
+*/
+
+EXTERN decl_node decl_skipType (decl_node n);
+
+/*
+   putTypeHidden - marks type, des, as being a hidden type.
+                   TYPE des ;
+*/
+
+EXTERN void decl_putTypeHidden (decl_node des);
+
+/*
+   isTypeHidden - returns TRUE if type, n, is hidden.
+*/
+
+EXTERN unsigned int decl_isTypeHidden (decl_node n);
+
+/*
+   hasHidden - returns TRUE if module, n, has a hidden type.
+*/
+
+EXTERN unsigned int decl_hasHidden (decl_node n);
+
+/*
+   isVar - returns TRUE if node, n, is a type.
+*/
+
+EXTERN unsigned int decl_isVar (decl_node n);
+
+/*
+   isTemporary - returns TRUE if node, n, is a variable and temporary.
+*/
+
+EXTERN unsigned int decl_isTemporary (decl_node n);
+
+/*
+   isExported - returns TRUE if symbol, n, is exported from
+                the definition module.
+*/
+
+EXTERN unsigned int decl_isExported (decl_node n);
+
+/*
+   getDeclScope - returns the node representing the
+                  current declaration scope.
+*/
+
+EXTERN decl_node decl_getDeclScope (void);
+
+/*
+   getScope - returns the scope associated with node, n.
+*/
+
+EXTERN decl_node decl_getScope (decl_node n);
+
+/*
+   isLiteral - returns TRUE if, n, is a literal.
+*/
+
+EXTERN unsigned int decl_isLiteral (decl_node n);
+
+/*
+   isConstSet - returns TRUE if, n, is a constant set.
+*/
+
+EXTERN unsigned int decl_isConstSet (decl_node n);
+
+/*
+   isEnumerationField - returns TRUE if, n, is an enumeration field.
+*/
+
+EXTERN unsigned int decl_isEnumerationField (decl_node n);
+
+/*
+   isEnumeration - returns TRUE if node, n, is an enumeration type.
+*/
+
+EXTERN unsigned int decl_isEnumeration (decl_node n);
+
+/*
+   isUnbounded - returns TRUE if, n, is an unbounded array.
+*/
+
+EXTERN unsigned int decl_isUnbounded (decl_node n);
+
+/*
+   isParameter - returns TRUE if, n, is a parameter.
+*/
+
+EXTERN unsigned int decl_isParameter (decl_node n);
+
+/*
+   isVarParam - returns TRUE if, n, is a var parameter.
+*/
+
+EXTERN unsigned int decl_isVarParam (decl_node n);
+
+/*
+   isParam - returns TRUE if, n, is a non var parameter.
+*/
+
+EXTERN unsigned int decl_isParam (decl_node n);
+
+/*
+   isNonVarParam - is an alias to isParam.
+*/
+
+EXTERN 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 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 unsigned int decl_isOptarg (decl_node n);
+
+/*
+   isRecord - returns TRUE if, n, is a record.
+*/
+
+EXTERN unsigned int decl_isRecord (decl_node n);
+
+/*
+   isRecordField - returns TRUE if, n, is a record field.
+*/
+
+EXTERN unsigned int decl_isRecordField (decl_node n);
+
+/*
+   isVarientField - returns TRUE if, n, is a varient field.
+*/
+
+EXTERN unsigned int decl_isVarientField (decl_node n);
+
+/*
+   isArray - returns TRUE if, n, is an array.
+*/
+
+EXTERN unsigned int decl_isArray (decl_node n);
+
+/*
+   isProcType - returns TRUE if, n, is a procedure type.
+*/
+
+EXTERN unsigned int decl_isProcType (decl_node n);
+
+/*
+   isPointer - returns TRUE if, n, is a pointer.
+*/
+
+EXTERN unsigned int decl_isPointer (decl_node n);
+
+/*
+   isProcedure - returns TRUE if, n, is a procedure.
+*/
+
+EXTERN unsigned int decl_isProcedure (decl_node n);
+
+/*
+   isVarient - returns TRUE if, n, is a varient record.
+*/
+
+EXTERN unsigned int decl_isVarient (decl_node n);
+
+/*
+   isSet - returns TRUE if, n, is a set type.
+*/
+
+EXTERN unsigned int decl_isSet (decl_node n);
+
+/*
+   isSubrange - returns TRUE if, n, is a subrange type.
+*/
+
+EXTERN unsigned int decl_isSubrange (decl_node n);
+
+/*
+   isZtype - returns TRUE if, n, is the Z type.
+*/
+
+EXTERN unsigned int decl_isZtype (decl_node n);
+
+/*
+   isRtype - returns TRUE if, n, is the R type.
+*/
+
+EXTERN unsigned int decl_isRtype (decl_node n);
+
+/*
+   makeConst - create, initialise and return a const node.
+*/
+
+EXTERN decl_node decl_makeConst (nameKey_Name n);
+
+/*
+   putConst - places value, v, into node, n.
+*/
+
+EXTERN void decl_putConst (decl_node n, decl_node v);
+
+/*
+   makeType - create, initialise and return a type node.
+*/
+
+EXTERN decl_node decl_makeType (nameKey_Name n);
+
+/*
+   makeTypeImp - lookup a type in the definition module
+                 and return it.  Otherwise create a new type.
+*/
+
+EXTERN decl_node decl_makeTypeImp (nameKey_Name n);
+
+/*
+   makeVar - create, initialise and return a var node.
+*/
+
+EXTERN decl_node decl_makeVar (nameKey_Name n);
+
+/*
+   putVar - places, type, as the type for var.
+*/
+
+EXTERN void decl_putVar (decl_node var, decl_node type, decl_node decl);
+
+/*
+   makeVarDecl - creates a variable declaration list from
+                 identlist, i, and, type, in the current scope.
+*/
+
+EXTERN decl_node decl_makeVarDecl (decl_node i, decl_node type);
+
+/*
+   makeEnum - creates an enumerated type and returns the node.
+*/
+
+EXTERN decl_node decl_makeEnum (void);
+
+/*
+   makeEnumField - returns an enumeration field, named, n.
+*/
+
+EXTERN decl_node decl_makeEnumField (decl_node e, nameKey_Name n);
+
+/*
+   makeSubrange - returns a subrange node, built from range: low..high.
+*/
+
+EXTERN decl_node decl_makeSubrange (decl_node low, decl_node high);
+
+/*
+   putSubrangeType - assigns, type, to the subrange type, sub.
+*/
+
+EXTERN void decl_putSubrangeType (decl_node sub, decl_node type);
+
+/*
+   makePointer - returns a pointer of, type, node.
+*/
+
+EXTERN decl_node decl_makePointer (decl_node type);
+
+/*
+   makeSet - returns a set of, type, node.
+*/
+
+EXTERN decl_node decl_makeSet (decl_node type);
+
+/*
+   makeArray - returns a node representing ARRAY subrange OF type.
+*/
+
+EXTERN decl_node decl_makeArray (decl_node subr, decl_node type);
+
+/*
+   putUnbounded - sets array, n, as unbounded.
+*/
+
+EXTERN void decl_putUnbounded (decl_node n);
+
+/*
+   makeRecord - creates and returns a record node.
+*/
+
+EXTERN decl_node decl_makeRecord (void);
+
+/*
+   makeVarient - creates a new symbol, a varient symbol for record or varient field
+                 symbol, r.
+*/
+
+EXTERN decl_node decl_makeVarient (decl_node r);
+
+/*
+   addFieldsToRecord - adds fields, i, of type, t, into a record, r.
+                       It returns, r.
+*/
+
+EXTERN 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, t, varient, r.
+*/
+
+EXTERN 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 decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p);
+
+/*
+   getSymName - returns the name of symbol, n.
+*/
+
+EXTERN 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 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 decl_node decl_lookupExported (decl_node n, nameKey_Name i);
+
+/*
+   lookupSym - returns the symbol named, n, from the scope stack.
+*/
+
+EXTERN 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 void decl_addImportedModule (decl_node m, decl_node i, unsigned int scoped);
+
+/*
+   setSource - sets the source filename for module, n, to s.
+*/
+
+EXTERN void decl_setSource (decl_node n, nameKey_Name s);
+
+/*
+   getSource - returns the source filename for module, n.
+*/
+
+EXTERN nameKey_Name decl_getSource (decl_node n);
+
+/*
+   getMainModule - returns the main module node.
+*/
+
+EXTERN decl_node decl_getMainModule (void);
+
+/*
+   getCurrentModule - returns the current module being compiled.
+*/
+
+EXTERN decl_node decl_getCurrentModule (void);
+
+/*
+   foreachDefModuleDo - foreach definition node, n, in the module universe,
+                        call p (n).
+*/
+
+EXTERN void decl_foreachDefModuleDo (symbolKey_performOperation p);
+
+/*
+   foreachModModuleDo - foreach implementation or module node, n, in the module universe,
+                        call p (n).
+*/
+
+EXTERN void decl_foreachModModuleDo (symbolKey_performOperation p);
+
+/*
+   enterScope - pushes symbol, n, to the scope stack.
+*/
+
+EXTERN void decl_enterScope (decl_node n);
+
+/*
+   leaveScope - removes the top level scope and all enumeration transparent scopes.
+*/
+
+EXTERN void decl_leaveScope (void);
+
+/*
+   makeProcedure - create, initialise and return a procedure node.
+*/
+
+EXTERN 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 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 void decl_putCommentModProcedure (decl_node n);
+
+/*
+   makeProcType - returns a proctype node.
+*/
+
+EXTERN decl_node decl_makeProcType (void);
+
+/*
+   putReturnType - sets the return type of procedure or proctype, proc, to, type.
+*/
+
+EXTERN void decl_putReturnType (decl_node proc, decl_node type);
+
+/*
+   putOptReturn - sets, proctype or procedure, proc, to have an optional return type.
+*/
+
+EXTERN void decl_putOptReturn (decl_node proc);
+
+/*
+   makeVarParameter - returns a var parameter node with namelist and type.
+                      Where the parameters are declared as l: type.
+*/
+
+EXTERN decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused);
+
+/*
+   makeNonVarParameter - returns a non var parameter node with namelist and type.
+                         Where the parameters are declared as l: type.
+*/
+
+EXTERN decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused);
+
+/*
+   paramEnter - reset the parameter count.
+*/
+
+EXTERN void decl_paramEnter (decl_node n);
+
+/*
+   paramLeave - set paramater checking to TRUE from now onwards.
+*/
+
+EXTERN void decl_paramLeave (decl_node n);
+
+/*
+   makeIdentList - returns a node which will be used to maintain an ident list.
+*/
+
+EXTERN decl_node decl_makeIdentList (void);
+
+/*
+   putIdent - places ident, i, into identlist, n.
+*/
+
+EXTERN 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 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 void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused);
+
+/*
+   makeVarargs - returns a varargs node.
+*/
+
+EXTERN decl_node decl_makeVarargs (void);
+
+/*
+   isVarargs - returns TRUE if, n, is a varargs node.
+*/
+
+EXTERN unsigned int decl_isVarargs (decl_node n);
+
+/*
+   addParameter - adds a parameter, param, to procedure or proctype, proc.
+*/
+
+EXTERN void decl_addParameter (decl_node proc, decl_node param);
+
+/*
+   makeBinaryTok - creates and returns a boolean type node with,
+                   l, and, r, nodes.
+*/
+
+EXTERN 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 decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e);
+
+/*
+   makeComponentRef - build a componentref node which accesses, field,
+                      within, record, rec.
+*/
+
+EXTERN decl_node decl_makeComponentRef (decl_node rec, decl_node field);
+
+/*
+   makePointerRef - build a pointerref node which accesses, field,
+                    within, pointer to record, ptr.
+*/
+
+EXTERN decl_node decl_makePointerRef (decl_node ptr, decl_node field);
+
+/*
+   isPointerRef - returns TRUE if, n, is a pointerref node.
+*/
+
+EXTERN unsigned int decl_isPointerRef (decl_node n);
+
+/*
+   makeDeRef - dereferences the pointer defined by, n.
+*/
+
+EXTERN 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 decl_node decl_makeArrayRef (decl_node array, decl_node index);
+
+/*
+   getLastOp - return the right most non leaf node.
+*/
+
+EXTERN decl_node decl_getLastOp (decl_node n);
+
+/*
+   getCardinal - returns the cardinal type node.
+*/
+
+EXTERN decl_node decl_getCardinal (void);
+
+/*
+   makeLiteralInt - creates and returns a literal node based on an integer type.
+*/
+
+EXTERN decl_node decl_makeLiteralInt (nameKey_Name n);
+
+/*
+   makeLiteralReal - creates and returns a literal node based on a real type.
+*/
+
+EXTERN decl_node decl_makeLiteralReal (nameKey_Name n);
+
+/*
+   makeString - creates and returns a node containing string, n.
+*/
+
+EXTERN decl_node decl_makeString (nameKey_Name n);
+
+/*
+   makeSetValue - creates and returns a setvalue node.
+*/
+
+EXTERN decl_node decl_makeSetValue (void);
+
+/*
+   isSetValue - returns TRUE if, n, is a setvalue node.
+*/
+
+EXTERN unsigned int decl_isSetValue (decl_node n);
+
+/*
+   putSetValue - assigns the type, t, to the set value, n.  The
+                 node, n, is returned.
+*/
+
+EXTERN 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 decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h);
+
+/*
+   getBuiltinConst - creates and returns a builtin const if available.
+*/
+
+EXTERN decl_node decl_getBuiltinConst (nameKey_Name n);
+
+/*
+   makeExpList - creates and returns an expList node.
+*/
+
+EXTERN decl_node decl_makeExpList (void);
+
+/*
+   isExpList - returns TRUE if, n, is an explist node.
+*/
+
+EXTERN unsigned int decl_isExpList (decl_node n);
+
+/*
+   putExpList - places, expression, e, within the explist, n.
+*/
+
+EXTERN void decl_putExpList (decl_node n, decl_node e);
+
+/*
+   makeConstExp - returns a constexp node.
+*/
+
+EXTERN decl_node decl_makeConstExp (void);
+
+/*
+   getNextConstExp - returns the next constexp node.
+*/
+
+EXTERN decl_node decl_getNextConstExp (void);
+
+/*
+   setConstExpComplete - sets the field inside the def or imp or module, n.
+*/
+
+EXTERN void decl_setConstExpComplete (decl_node n);
+
+/*
+   fixupConstExp - assign fixup expression, e, into the argument of, c.
+*/
+
+EXTERN decl_node decl_fixupConstExp (decl_node c, decl_node e);
+
+/*
+   resetConstExpPos - resets the index into the saved list of constexps inside
+                      module, n.
+*/
+
+EXTERN void decl_resetConstExpPos (decl_node n);
+
+/*
+   makeFuncCall - builds a function call to c with param list, n.
+*/
+
+EXTERN decl_node decl_makeFuncCall (decl_node c, decl_node n);
+
+/*
+   makeStatementSequence - create and return a statement sequence node.
+*/
+
+EXTERN decl_node decl_makeStatementSequence (void);
+
+/*
+   isStatementSequence - returns TRUE if node, n, is a statement sequence.
+*/
+
+EXTERN unsigned int decl_isStatementSequence (decl_node n);
+
+/*
+   addStatement - adds node, n, as a statement to statememt sequence, s.
+*/
+
+EXTERN void decl_addStatement (decl_node s, decl_node n);
+
+/*
+   addCommentBody - adds a body comment to a statement sequence node.
+*/
+
+EXTERN void decl_addCommentBody (decl_node n);
+
+/*
+   addCommentAfter - adds an after comment to a statement sequence node.
+*/
+
+EXTERN void decl_addCommentAfter (decl_node n);
+
+/*
+   addIfComments - adds the, body, and, after, comments to if node, n.
+*/
+
+EXTERN 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 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 void decl_addIfEndComments (decl_node n, decl_node body, decl_node after);
+
+/*
+   makeReturn - creates and returns a return node.
+*/
+
+EXTERN decl_node decl_makeReturn (void);
+
+/*
+   isReturn - returns TRUE if node, n, is a return.
+*/
+
+EXTERN unsigned int decl_isReturn (decl_node n);
+
+/*
+   putReturn - assigns node, e, as the expression on the return node.
+*/
+
+EXTERN void decl_putReturn (decl_node n, decl_node e);
+
+/*
+   makeWhile - creates and returns a while node.
+*/
+
+EXTERN decl_node decl_makeWhile (void);
+
+/*
+   putWhile - places an expression, e, and statement sequence, s, into the while
+              node, n.
+*/
+
+EXTERN void decl_putWhile (decl_node n, decl_node e, decl_node s);
+
+/*
+   isWhile - returns TRUE if node, n, is a while.
+*/
+
+EXTERN unsigned int decl_isWhile (decl_node n);
+
+/*
+   addWhileDoComment - adds body and after comments to while node, w.
+*/
+
+EXTERN 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 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 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 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 void decl_putFinally (decl_node b, decl_node s);
+
+/*
+   makeExit - creates and returns an exit node.
+*/
+
+EXTERN decl_node decl_makeExit (decl_node l, unsigned int n);
+
+/*
+   isExit - returns TRUE if node, n, is an exit.
+*/
+
+EXTERN unsigned int decl_isExit (decl_node n);
+
+/*
+   makeLoop - creates and returns a loop node.
+*/
+
+EXTERN decl_node decl_makeLoop (void);
+
+/*
+   isLoop - returns TRUE if, n, is a loop node.
+*/
+
+EXTERN unsigned int decl_isLoop (decl_node n);
+
+/*
+   putLoop - places statement sequence, s, into loop, l.
+*/
+
+EXTERN void decl_putLoop (decl_node l, decl_node s);
+
+/*
+   makeComment - creates and returns a comment node.
+*/
+
+EXTERN decl_node decl_makeComment (const char *a_, unsigned int _a_high);
+
+/*
+   makeCommentS - creates and returns a comment node.
+*/
+
+EXTERN 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 decl_node decl_makeIf (decl_node e, decl_node s);
+
+/*
+   isIf - returns TRUE if, n, is an if node.
+*/
+
+EXTERN 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 decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s);
+
+/*
+   isElsif - returns TRUE if node, n, is an elsif node.
+*/
+
+EXTERN 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 void decl_putElse (decl_node i, decl_node s);
+
+/*
+   makeFor - creates and returns a for node.
+*/
+
+EXTERN decl_node decl_makeFor (void);
+
+/*
+   isFor - returns TRUE if node, n, is a for node.
+*/
+
+EXTERN 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 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 decl_node decl_makeRepeat (void);
+
+/*
+   isRepeat - returns TRUE if node, n, is a repeat node.
+*/
+
+EXTERN unsigned int decl_isRepeat (decl_node n);
+
+/*
+   putRepeat - places statements, s, and expression, e, into
+               repeat statement, n.
+*/
+
+EXTERN void decl_putRepeat (decl_node n, decl_node s, decl_node e);
+
+/*
+   addRepeatComment - adds body and after comments to repeat node, r.
+*/
+
+EXTERN 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 void decl_addUntilComment (decl_node r, decl_node body, decl_node after);
+
+/*
+   makeCase - builds and returns a case statement node.
+*/
+
+EXTERN decl_node decl_makeCase (void);
+
+/*
+   isCase - returns TRUE if node, n, is a case statement.
+*/
+
+EXTERN unsigned int decl_isCase (decl_node n);
+
+/*
+   putCaseExpression - places expression, e, into case statement, n.
+                       n is returned.
+*/
+
+EXTERN decl_node decl_putCaseExpression (decl_node n, decl_node e);
+
+/*
+   putCaseElse - places else statement, e, into case statement, n.
+                 n is returned.
+*/
+
+EXTERN 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 decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s);
+
+/*
+   makeCaseLabelList - creates and returns a caselabellist node.
+*/
+
+EXTERN decl_node decl_makeCaseLabelList (decl_node l, decl_node s);
+
+/*
+   isCaseLabelList - returns TRUE if, n, is a caselabellist.
+*/
+
+EXTERN unsigned int decl_isCaseLabelList (decl_node n);
+
+/*
+   makeCaseList - creates and returns a case statement node.
+*/
+
+EXTERN decl_node decl_makeCaseList (void);
+
+/*
+   isCaseList - returns TRUE if, n, is a case list.
+*/
+
+EXTERN unsigned int decl_isCaseList (decl_node n);
+
+/*
+   putCaseRange - places the case range lo..hi into caselist, n.
+*/
+
+EXTERN decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi);
+
+/*
+   makeRange - creates and returns a case range.
+*/
+
+EXTERN decl_node decl_makeRange (decl_node lo, decl_node hi);
+
+/*
+   isRange - returns TRUE if node, n, is a range.
+*/
+
+EXTERN unsigned int decl_isRange (decl_node n);
+
+/*
+   setNoReturn - sets noreturn field inside procedure.
+*/
+
+EXTERN 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 decl_node decl_dupExpr (decl_node n);
+
+/*
+   setLangC - set the target language as ansi C.
+*/
+
+EXTERN void decl_setLangC (void);
+
+/*
+   setLangCP - set the target language as C++.
+*/
+
+EXTERN void decl_setLangCP (void);
+
+/*
+   setLangM2 - set the target language as Modula-2.
+*/
+
+EXTERN 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 void decl_out (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gdtoa.h b/gcc/m2/mc-boot/Gdtoa.h
new file mode 100644
index 00000000000..6f624ac7304
--- /dev/null
+++ b/gcc/m2/mc-boot/Gdtoa.h
@@ -0,0 +1,76 @@
+/* do not edit automatically generated by mc from dtoa.  */
+/* dtoa.def provides routines to convert between a C double.
+
+Copyright (C) 2008-2021 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 (_dtoa_H)
+#   define _dtoa_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_dtoa_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef enum {dtoa_maxsignificant, dtoa_decimaldigits} dtoa_Mode;
+
+
+/*
+   strtod - returns a REAL given a string, s.  It will set
+            error to TRUE if the number is too large.
+*/
+
+EXTERN double dtoa_strtod (void * s, unsigned int *error);
+
+/*
+   dtoa - converts a REAL, d, into a string.  The address of the
+          string is returned.
+          mode       indicates the type of conversion required.
+          ndigits    determines the number of digits according to mode.
+          decpt      the position of the decimal point.
+          sign       does the string have a sign?
+*/
+
+EXTERN void * dtoa_dtoa (double d, dtoa_Mode mode, int ndigits, int *decpt, unsigned int *sign);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gerrno.h b/gcc/m2/mc-boot/Gerrno.h
new file mode 100644
index 00000000000..b890d6aa5ca
--- /dev/null
+++ b/gcc/m2/mc-boot/Gerrno.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from errno.  */
+/* errno.def provides a Modula-2 interface to the C errno.
+
+Copyright (C) 2005-2021 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 (_errno_H)
+#   define _errno_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_errno_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define errno_EINTR 4
+#   define errno_ERANGE 34
+#   define errno_EAGAIN 11
+EXTERN int errno_geterrno (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gkeyc.c b/gcc/m2/mc-boot/Gkeyc.c
new file mode 100644
index 00000000000..a0a061aa17f
--- /dev/null
+++ b/gcc/m2/mc-boot/Gkeyc.c
@@ -0,0 +1,1621 @@
+/* do not edit automatically generated by mc from keyc.  */
+/* keyc maintains the C name scope and avoids C/C++ name conflicts.
+   Copyright (C) 2016-2022 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) || seenUIntMin) || seenIntMax) || seenUIntMax) || seenLongMax) || seenULongMax) || seenCharMax) || seenUCharMax) || 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-git-devel-modula2/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;
+  seenUIntMin = FALSE;
+  seenIntMax = FALSE;
+  seenUIntMax = FALSE;
+  seenLongMax = FALSE;
+  seenULongMax = FALSE;
+  seenCharMax = FALSE;
+  seenUCharMax = FALSE;
+  seenUIntMax = 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gkeyc.h b/gcc/m2/mc-boot/Gkeyc.h
new file mode 100644
index 00000000000..044f831d9dc
--- /dev/null
+++ b/gcc/m2/mc-boot/Gkeyc.h
@@ -0,0 +1,308 @@
+/* do not edit automatically generated by mc from keyc.  */
+/* keyc.def provides an interface to emitting symbols which.
+
+Copyright (C) 2016-2022 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 (_keyc_H)
+#   define _keyc_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GmcPretty.h"
+#   include "GDynamicStrings.h"
+#   include "Gdecl.h"
+#   include "GnameKey.h"
+
+#   if defined (_keyc_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   useUnistd - need to use unistd.h call using open/close/read/write require this header.
+*/
+
+EXTERN void keyc_useUnistd (void);
+
+/*
+   useThrow - use the throw function.
+*/
+
+EXTERN void keyc_useThrow (void);
+
+/*
+   useStorage - indicate we have used storage.
+*/
+
+EXTERN void keyc_useStorage (void);
+
+/*
+   useFree - indicate we have used free.
+*/
+
+EXTERN void keyc_useFree (void);
+
+/*
+   useMalloc - indicate we have used malloc.
+*/
+
+EXTERN void keyc_useMalloc (void);
+
+/*
+   useProc - indicate we have used proc.
+*/
+
+EXTERN void keyc_useProc (void);
+
+/*
+   useTrue - indicate we have used TRUE.
+*/
+
+EXTERN void keyc_useTrue (void);
+
+/*
+   useFalse - indicate we have used FALSE.
+*/
+
+EXTERN void keyc_useFalse (void);
+
+/*
+   useNull - indicate we have used NULL.
+*/
+
+EXTERN void keyc_useNull (void);
+
+/*
+   useMemcpy - indicate we have used memcpy.
+*/
+
+EXTERN void keyc_useMemcpy (void);
+
+/*
+   useIntMin - indicate we have used INT_MIN.
+*/
+
+EXTERN void keyc_useIntMin (void);
+
+/*
+   useUIntMin - indicate we have used UINT_MIN.
+*/
+
+EXTERN void keyc_useUIntMin (void);
+
+/*
+   useLongMin - indicate we have used LONG_MIN.
+*/
+
+EXTERN void keyc_useLongMin (void);
+
+/*
+   useULongMin - indicate we have used ULONG_MIN.
+*/
+
+EXTERN void keyc_useULongMin (void);
+
+/*
+   useCharMin - indicate we have used CHAR_MIN.
+*/
+
+EXTERN void keyc_useCharMin (void);
+
+/*
+   useUCharMin - indicate we have used UCHAR_MIN.
+*/
+
+EXTERN void keyc_useUCharMin (void);
+
+/*
+   useIntMax - indicate we have used INT_MAX.
+*/
+
+EXTERN void keyc_useIntMax (void);
+
+/*
+   useUIntMax - indicate we have used UINT_MAX.
+*/
+
+EXTERN void keyc_useUIntMax (void);
+
+/*
+   useLongMax - indicate we have used LONG_MAX.
+*/
+
+EXTERN void keyc_useLongMax (void);
+
+/*
+   useULongMax - indicate we have used ULONG_MAX.
+*/
+
+EXTERN void keyc_useULongMax (void);
+
+/*
+   useCharMax - indicate we have used CHAR_MAX.
+*/
+
+EXTERN void keyc_useCharMax (void);
+
+/*
+   useUCharMax - indicate we have used UChar_MAX.
+*/
+
+EXTERN void keyc_useUCharMax (void);
+
+/*
+   useSize_t - indicate we have used size_t.
+*/
+
+EXTERN void keyc_useSize_t (void);
+
+/*
+   useSSize_t - indicate we have used ssize_t.
+*/
+
+EXTERN void keyc_useSSize_t (void);
+
+/*
+   useLabs - indicate we have used labs.
+*/
+
+EXTERN void keyc_useLabs (void);
+
+/*
+   useAbs - indicate we have used abs.
+*/
+
+EXTERN void keyc_useAbs (void);
+
+/*
+   useFabs - indicate we have used fabs.
+*/
+
+EXTERN void keyc_useFabs (void);
+
+/*
+   useFabsl - indicate we have used fabsl.
+*/
+
+EXTERN void keyc_useFabsl (void);
+
+/*
+   useException - use the exceptions module, mcrts.
+*/
+
+EXTERN void keyc_useException (void);
+
+/*
+   useComplex - use the complex data type.
+*/
+
+EXTERN void keyc_useComplex (void);
+
+/*
+   useM2RTS - indicate we have used M2RTS in the converted code.
+*/
+
+EXTERN void keyc_useM2RTS (void);
+
+/*
+   useStrlen - indicate we have used strlen in the converted code.
+*/
+
+EXTERN void keyc_useStrlen (void);
+
+/*
+   useCtype - indicate we have used the toupper function.
+*/
+
+EXTERN void keyc_useCtype (void);
+
+/*
+   genDefs - generate definitions or includes for all
+             macros and prototypes used.
+*/
+
+EXTERN void keyc_genDefs (mcPretty_pretty p);
+
+/*
+   genConfigSystem - generate include files for config.h and system.h
+                     within the GCC framework.
+*/
+
+EXTERN void keyc_genConfigSystem (mcPretty_pretty p);
+
+/*
+   enterScope - enter a scope defined by, n.
+*/
+
+EXTERN void keyc_enterScope (decl_node n);
+
+/*
+   leaveScope - leave the scope defined by, n.
+*/
+
+EXTERN 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 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 nameKey_Name keyc_cnamen (nameKey_Name n, unsigned int scopes);
+
+/*
+   cp - include C++ keywords and standard declarations to avoid.
+*/
+
+EXTERN void keyc_cp (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gldtoa.h b/gcc/m2/mc-boot/Gldtoa.h
new file mode 100644
index 00000000000..c7b16260b17
--- /dev/null
+++ b/gcc/m2/mc-boot/Gldtoa.h
@@ -0,0 +1,76 @@
+/* do not edit automatically generated by mc from ldtoa.  */
+/* ldtoa.def provides routines to convert between a C long double.
+
+Copyright (C) 2008-2021 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 (_ldtoa_H)
+#   define _ldtoa_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_ldtoa_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef enum {ldtoa_maxsignificant, ldtoa_decimaldigits} ldtoa_Mode;
+
+
+/*
+   strtold - returns a LONGREAL given a C string, s.  It will set
+             error to TRUE if the number is too large or badly formed.
+*/
+
+EXTERN long double ldtoa_strtold (void * s, unsigned int *error);
+
+/*
+   ldtoa - converts a LONGREAL, d, into a string.  The address of the
+           string is returned.
+           mode       indicates the type of conversion required.
+           ndigits    determines the number of digits according to mode.
+           decpt      the position of the decimal point.
+           sign       does the string have a sign?
+*/
+
+EXTERN void * ldtoa_ldtoa (long double d, ldtoa_Mode mode, int ndigits, int *decpt, unsigned int *sign);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Glibc.h b/gcc/m2/mc-boot/Glibc.h
new file mode 100644
index 00000000000..ad4197066cc
--- /dev/null
+++ b/gcc/m2/mc-boot/Glibc.h
@@ -0,0 +1,412 @@
+/* do not edit automatically generated by mc from libc.  */
+/* libc.def provides an interface to the C library functions.
+
+Copyright (C) 2001-2021 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 (_libc_H)
+#   define _libc_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_libc_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef long int libc_time_t;
+
+typedef struct libc_tm_r libc_tm;
+
+typedef struct libc_timeb_r libc_timeb;
+
+typedef struct libc_exitP_p libc_exitP;
+
+typedef libc_tm *libc_ptrToTM;
+
+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; };
+
+EXTERN ssize_t libc_write (int d, void * buf, size_t nbytes);
+EXTERN ssize_t libc_read (int d, void * buf, size_t nbytes);
+EXTERN int libc_system (void * a);
+
+/*
+     abort - generate a fault
+
+     abort() first closes all open files if possible, then sends
+     an IOT signal to the process.  This signal usually results
+     in termination with a core dump, which may be used for
+     debugging.
+
+     It is possible for abort() to return control if is caught or
+     ignored, in which case the value returned is that of the
+     kill(2V) system call.
+*/
+
+EXTERN void libc_abort (void) __attribute__ ((noreturn));
+
+/*
+     malloc - memory allocator.
+
+     void *malloc(size_t size);
+
+     malloc() returns a pointer to a block of at least size
+     bytes, which is appropriately aligned.  If size is zero,
+     malloc() returns a non-NULL pointer, but this pointer should
+     not be dereferenced.
+*/
+
+EXTERN void * libc_malloc (size_t size);
+
+/*
+     free - memory deallocator.
+
+     free (void *ptr);
+
+     free() releases a previously allocated block.  Its argument
+     is a pointer to a block previously allocated by malloc,
+     calloc, realloc, malloc, or memalign.
+*/
+
+EXTERN void libc_free (void * ptr);
+EXTERN void * libc_realloc (void * ptr, size_t size);
+
+/*
+   isatty - does this descriptor refer to a terminal.
+*/
+
+EXTERN int libc_isatty (int fd);
+
+/*
+   exit - returns control to the invoking process. Result, r, is
+          returned.
+*/
+
+EXTERN void libc_exit (int r) __attribute__ ((noreturn));
+
+/*
+   getenv - returns the C string for the equivalent C environment
+            variable.
+*/
+
+EXTERN void * libc_getenv (void * s);
+
+/*
+   putenv - change or add an environment variable.
+*/
+
+EXTERN int libc_putenv (void * s);
+
+/*
+   getpid - returns the UNIX process identification number.
+*/
+
+EXTERN int libc_getpid (void);
+
+/*
+   dup - duplicates the file descriptor, d.
+*/
+
+EXTERN int libc_dup (int d);
+
+/*
+   close - closes the file descriptor, d.
+*/
+
+EXTERN int libc_close (int d);
+
+/*
+   open - open the file, filename with flag and mode.
+*/
+
+EXTERN int libc_open (void * filename, int oflag, ...);
+
+/*
+   creat - creates a new file
+*/
+
+EXTERN int libc_creat (void * filename, unsigned int mode);
+
+/*
+   lseek - calls unix lseek:
+
+           off_t lseek(int fildes, off_t offset, int whence);
+*/
+
+EXTERN long int libc_lseek (int fd, long int offset, int whence);
+
+/*
+   perror - writes errno and string. (ARRAY OF CHAR is translated onto ADDRESS).
+*/
+
+EXTERN void libc_perror (const char *string_, unsigned int _string_high);
+
+/*
+   readv - reads an io vector of bytes.
+*/
+
+EXTERN int libc_readv (int fd, void * v, int n);
+
+/*
+   writev - writes an io vector of bytes.
+*/
+
+EXTERN int libc_writev (int fd, void * v, int n);
+
+/*
+   getcwd - copies the absolute pathname of the
+            current working directory to the array pointed to by buf,
+            which is of length size.
+
+            If the current absolute path name would require a buffer
+            longer than size elements, NULL is returned, and errno is
+            set to ERANGE; an application should check for this error,
+            and allocate a larger buffer if necessary.
+*/
+
+EXTERN void * libc_getcwd (void * buf, size_t size);
+
+/*
+   chown - The  owner  of  the  file  specified  by  path or by fd is
+           changed.  Only the super-user may change the  owner  of  a
+           file.   The  owner  of  a file may change the group of the
+           file to any group of which that owner is  a  member.   The
+           super-user may change the group arbitrarily.
+
+           If  the owner or group is specified as -1, then that ID is
+           not changed.
+
+           On success, zero is returned.  On error, -1  is  returned,
+           and errno is set appropriately.
+*/
+
+EXTERN int libc_chown (void * filename, int uid, int gid);
+
+/*
+   strlen - returns the length of string, a.
+*/
+
+EXTERN size_t libc_strlen (void * a);
+
+/*
+   strcpy - copies string, src, into, dest.
+            It returns dest.
+*/
+
+EXTERN void * libc_strcpy (void * dest, void * src);
+
+/*
+   strncpy - copies string, src, into, dest, copying at most, n, bytes.
+             It returns dest.
+*/
+
+EXTERN void * libc_strncpy (void * dest, void * src, unsigned int n);
+
+/*
+   unlink - removes file and returns 0 if successful.
+*/
+
+EXTERN int libc_unlink (void * file);
+
+/*
+   memcpy - copy memory area
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memcpy(void *dest, const void *src, size_t n);
+   It returns dest.
+*/
+
+EXTERN void * libc_memcpy (void * dest, void * src, size_t size);
+
+/*
+   memset - fill memory with a constant byte
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memset(void *s, int c, size_t n);
+   It returns s.
+*/
+
+EXTERN void * libc_memset (void * s, int c, size_t size);
+
+/*
+   memmove - copy memory areas which may overlap
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memmove(void *dest, const void *src, size_t n);
+   It returns dest.
+*/
+
+EXTERN void * libc_memmove (void * dest, void * src, size_t size);
+EXTERN int libc_printf (const char *format_, unsigned int _format_high, ...);
+
+/*
+   setenv - sets environment variable, name, to value.
+            It will overwrite an existing value if, overwrite,
+            is true.  It returns 0 on success and -1 for an error.
+*/
+
+EXTERN int libc_setenv (void * name, void * value, int overwrite);
+
+/*
+   srand - initialize the random number seed.
+*/
+
+EXTERN void libc_srand (int seed);
+
+/*
+   rand - return a random integer.
+*/
+
+EXTERN int libc_rand (void);
+
+/*
+   time - returns a pointer to the time_t value. If, a,
+          is not NIL then the libc value is copied into
+          memory at address, a.
+*/
+
+EXTERN libc_time_t libc_time (void * a);
+
+/*
+   localtime - returns a pointer to the libc copy of the tm
+               structure.
+*/
+
+EXTERN void * libc_localtime (libc_time_t *t);
+
+/*
+   ftime - return date and time.
+*/
+
+EXTERN int libc_ftime (libc_timeb *t);
+
+/*
+   shutdown - shutdown a socket, s.
+              if how = 0, then no more reads are allowed.
+              if how = 1, then no more writes are allowed.
+              if how = 2, then mo more reads or writes are allowed.
+*/
+
+EXTERN int libc_shutdown (int s, int how);
+
+/*
+   rename - change the name or location of a file
+*/
+
+EXTERN int libc_rename (void * oldpath, void * newpath);
+
+/*
+   setjmp - returns 0 if returning directly, and non-zero
+            when returning from longjmp using the saved
+            context.
+*/
+
+EXTERN int libc_setjmp (void * env);
+
+/*
+   longjmp - restores the environment saved by the last call
+             of setjmp with the corresponding env argument.
+             After longjmp is completed, program execution
+             continues as if the corresponding call of setjmp
+             had just returned the value val.  The value of
+             val must not be zero.
+*/
+
+EXTERN void libc_longjmp (void * env, int val);
+
+/*
+   atexit - execute, proc, when the function exit is called.
+*/
+
+EXTERN int libc_atexit (libc_exitP_C proc);
+
+/*
+   ttyname - returns a pointer to a string determining the ttyname.
+*/
+
+EXTERN void * libc_ttyname (int filedes);
+
+/*
+   sleep - calling thread sleeps for seconds.
+*/
+
+EXTERN unsigned int libc_sleep (unsigned int seconds);
+
+/*
+   execv - execute a file.
+*/
+
+EXTERN int libc_execv (void * pathname, void * argv);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Glibm.h b/gcc/m2/mc-boot/Glibm.h
new file mode 100644
index 00000000000..9fe86a58e0e
--- /dev/null
+++ b/gcc/m2/mc-boot/Glibm.h
@@ -0,0 +1,97 @@
+/* do not edit automatically generated by mc from libm.  */
+/* libm.def provides access to libm.
+
+Copyright (C) 2003-2021 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 (_libm_H)
+#   define _libm_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_libm_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN double libm_sin (double x);
+EXTERN long double libm_sinl (long double x);
+EXTERN float libm_sinf (float x);
+EXTERN double libm_cos (double x);
+EXTERN long double libm_cosl (long double x);
+EXTERN float libm_cosf (float x);
+EXTERN double libm_tan (double x);
+EXTERN long double libm_tanl (long double x);
+EXTERN float libm_tanf (float x);
+EXTERN double libm_sqrt (double x);
+EXTERN long double libm_sqrtl (long double x);
+EXTERN float libm_sqrtf (float x);
+EXTERN double libm_asin (double x);
+EXTERN long double libm_asinl (long double x);
+EXTERN float libm_asinf (float x);
+EXTERN double libm_acos (double x);
+EXTERN long double libm_acosl (long double x);
+EXTERN float libm_acosf (float x);
+EXTERN double libm_atan (double x);
+EXTERN long double libm_atanl (long double x);
+EXTERN float libm_atanf (float x);
+EXTERN double libm_atan2 (double x, double y);
+EXTERN long double libm_atan2l (long double x, long double y);
+EXTERN float libm_atan2f (float x, float y);
+EXTERN double libm_exp (double x);
+EXTERN long double libm_expl (long double x);
+EXTERN float libm_expf (float x);
+EXTERN double libm_log (double x);
+EXTERN long double libm_logl (long double x);
+EXTERN float libm_logf (float x);
+EXTERN double libm_exp10 (double x);
+EXTERN long double libm_exp10l (long double x);
+EXTERN float libm_exp10f (float x);
+EXTERN double libm_pow (double x, double y);
+EXTERN long double libm_powl (long double x, long double y);
+EXTERN float libm_powf (float x, float y);
+EXTERN double libm_floor (double x);
+EXTERN long double libm_floorl (long double x);
+EXTERN float libm_floorf (float x);
+EXTERN double libm_ceil (double x);
+EXTERN long double libm_ceill (long double x);
+EXTERN float libm_ceilf (float x);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Glists.c b/gcc/m2/mc-boot/Glists.c
new file mode 100644
index 00000000000..c2abea56ebb
--- /dev/null
+++ b/gcc/m2/mc-boot/Glists.c
@@ -0,0 +1,439 @@
+/* do not edit automatically generated by mc from lists.  */
+/* Dynamic list library for pointers.
+   Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Glists.h b/gcc/m2/mc-boot/Glists.h
new file mode 100644
index 00000000000..50b3d5f5b7a
--- /dev/null
+++ b/gcc/m2/mc-boot/Glists.h
@@ -0,0 +1,127 @@
+/* do not edit automatically generated by mc from lists.  */
+/* lists.def Provides an unordered list manipulation package.
+
+Copyright (C) 2015-2022 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 (_lists_H)
+#   define _lists_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GsymbolKey.h"
+
+#   if defined (_lists_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (lists_list_D)
+#  define lists_list_D
+   typedef void *lists_list;
+#endif
+
+
+/*
+   initList - creates a new list, l.
+*/
+
+EXTERN lists_list lists_initList (void);
+
+/*
+   killList - deletes the complete list, l.
+*/
+
+EXTERN void lists_killList (lists_list *l);
+
+/*
+   putItemIntoList - places an ADDRESS, c, into list, l.
+*/
+
+EXTERN void lists_putItemIntoList (lists_list l, void * c);
+
+/*
+   getItemFromList - retrieves the nth ADDRESS from list, l.
+*/
+
+EXTERN void * lists_getItemFromList (lists_list l, unsigned int n);
+
+/*
+   getIndexOfList - returns the index for ADDRESS, c, in list, l.
+                    If more than one CARDINAL, c, exists the index
+                    for the first is returned.
+*/
+
+EXTERN unsigned int lists_getIndexOfList (lists_list l, void * c);
+
+/*
+   noOfItemsInList - returns the number of items in list, l.
+*/
+
+EXTERN unsigned int lists_noOfItemsInList (lists_list l);
+
+/*
+   includeItemIntoList - adds an ADDRESS, c, into a list providing
+                         the value does not already exist.
+*/
+
+EXTERN void lists_includeItemIntoList (lists_list l, void * c);
+
+/*
+   removeItemFromList - removes an ADDRESS, c, from a list.
+                        It assumes that this value only appears once.
+*/
+
+EXTERN void lists_removeItemFromList (lists_list l, void * c);
+
+/*
+   isItemInList - returns true if a ADDRESS, c, was found in list, l.
+*/
+
+EXTERN unsigned int lists_isItemInList (lists_list l, void * c);
+
+/*
+   foreachItemInListDo - calls procedure, P, foreach item in list, l.
+*/
+
+EXTERN void lists_foreachItemInListDo (lists_list l, symbolKey_performOperation p);
+
+/*
+   duplicateList - returns a duplicate list derived from, l.
+*/
+
+EXTERN lists_list lists_duplicateList (lists_list l);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcComment.c b/gcc/m2/mc-boot/GmcComment.c
new file mode 100644
index 00000000000..d9e65b155f1
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcComment.c
@@ -0,0 +1,468 @@
+/* do not edit automatically generated by mc from mcComment.  */
+/* mcComment.mod provides a module to remember the comments.
+
+Copyright (C) 2015-2022 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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcComment.h b/gcc/m2/mc-boot/GmcComment.h
new file mode 100644
index 00000000000..bbfcb7595b5
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcComment.h
@@ -0,0 +1,131 @@
+/* do not edit automatically generated by mc from mcComment.  */
+/* mcComment.def provides a module to remember the comments.
+
+Copyright (C) 2015-2022 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 (_mcComment_H)
+#   define _mcComment_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GDynamicStrings.h"
+#   include "GnameKey.h"
+
+#   if defined (_mcComment_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (mcComment_commentDesc_D)
+#  define mcComment_commentDesc_D
+   typedef void *mcComment_commentDesc;
+#endif
+
+
+/*
+   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.  The new comment descriptor is returned.
+		 If onlySpaces is TRUE then an inbody comment is created.
+		 If onlySpaces is FALSE then an after statement comment is created.
+*/
+
+EXTERN mcComment_commentDesc mcComment_initComment (unsigned int onlySpaces);
+
+/*
+   addText - cs is a C string (null terminated) which contains comment text.
+*/
+
+EXTERN void mcComment_addText (mcComment_commentDesc cd, void * cs);
+
+/*
+   getContent - returns the content of comment, cd.
+*/
+
+EXTERN DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd);
+
+/*
+   getCommentCharStar - returns the contents of the comment, cd.
+*/
+
+EXTERN 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 void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname);
+
+/*
+   getProcedureComment - returns the procedure comment if available.
+*/
+
+EXTERN DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd);
+
+/*
+   getAfterStatementComment - returns the after comment if available.
+*/
+
+EXTERN DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd);
+
+/*
+   getInbodyStatementComment - returns the statement comment if available.
+*/
+
+EXTERN DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd);
+
+/*
+   isProcedureComment - returns TRUE if, cd, is a procedure comment.
+*/
+
+EXTERN unsigned int mcComment_isProcedureComment (mcComment_commentDesc cd);
+
+/*
+   isBodyComment - returns TRUE if, cd, is a body comment.
+*/
+
+EXTERN unsigned int mcComment_isBodyComment (mcComment_commentDesc cd);
+
+/*
+   isAfterComment - returns TRUE if, cd, is an after comment.
+*/
+
+EXTERN unsigned int mcComment_isAfterComment (mcComment_commentDesc cd);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcComp.c b/gcc/m2/mc-boot/GmcComp.c
new file mode 100644
index 00000000000..246b75a615b
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcComp.c
@@ -0,0 +1,660 @@
+/* do not edit automatically generated by mc from mcComp.  */
+/* Copyright (C) 2015-2022 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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcComp.h b/gcc/m2/mc-boot/GmcComp.h
new file mode 100644
index 00000000000..a6104cdf326
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcComp.h
@@ -0,0 +1,63 @@
+/* do not edit automatically generated by mc from mcComp.  */
+/* mcComp.def provides a procedure which coordinates all passes of mc.
+
+Copyright (C) 2011-2022 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 (_mcComp_H)
+#   define _mcComp_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_mcComp_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   compile - translate file, s, using a 6 pass technique.
+*/
+
+EXTERN void mcComp_compile (DynamicStrings_String s);
+
+/*
+   getPassNo - return the pass no.
+*/
+
+EXTERN unsigned int mcComp_getPassNo (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcDebug.c b/gcc/m2/mc-boot/GmcDebug.c
new file mode 100644
index 00000000000..3c471965c40
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcDebug.c
@@ -0,0 +1,86 @@
+/* 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-git-devel-modula2/gcc/m2/mc/mcDebug.mod", 49, 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcDebug.h b/gcc/m2/mc-boot/GmcDebug.h
new file mode 100644
index 00000000000..bfa3315a7b0
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcDebug.h
@@ -0,0 +1,63 @@
+/* do not edit automatically generated by mc from mcDebug.  */
+/* mcDebug.def provides simple assert and writeDebug facility.
+
+Copyright (C) 2015-2022 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 (_mcDebug_H)
+#   define _mcDebug_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_mcDebug_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   assert - tests the boolean, q. If false then an error is reported
+            and the execution is terminated.
+*/
+
+EXTERN void mcDebug_assert (unsigned int q);
+
+/*
+   writeDebug - only writes a string if the debugging mode is on.
+*/
+
+EXTERN void mcDebug_writeDebug (const char *a_, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcError.c b/gcc/m2/mc-boot/GmcError.c
new file mode 100644
index 00000000000..39f4640b70a
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcError.c
@@ -0,0 +1,1197 @@
+/* do not edit automatically generated by mc from mcError.  */
+/* mcError.mod provides an interface between the string handling modules.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcError.h b/gcc/m2/mc-boot/GmcError.h
new file mode 100644
index 00000000000..33d887da857
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcError.h
@@ -0,0 +1,170 @@
+/* do not edit automatically generated by mc from mcError.  */
+/* mcError.def provides an interface between the string handling modules.
+
+Copyright (C) 2015-2022 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 (_mcError_H)
+#   define _mcError_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GDynamicStrings.h"
+
+#   if defined (_mcError_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (mcError_error_D)
+#  define mcError_error_D
+   typedef void *mcError_error;
+#endif
+
+
+/*
+   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 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 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 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 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 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 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 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.
+*/
+
+EXTERN mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e);
+EXTERN void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high);
+EXTERN void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+EXTERN 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 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 void mcError_errorString (mcError_error e, DynamicStrings_String str);
+EXTERN void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok);
+EXTERN void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2);
+EXTERN void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2);
+EXTERN void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok);
+EXTERN void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2);
+EXTERN void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2);
+
+/*
+   warnFormat0 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*/
+
+EXTERN 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 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.
+                 If an error is present the compilation is terminated.
+                 All warnings are ignored.
+*/
+
+EXTERN 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 void mcError_flushWarnings (void);
+
+/*
+   errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
+*/
+
+EXTERN void mcError_errorAbort0 (const char *a_, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcFileName.c b/gcc/m2/mc-boot/GmcFileName.c
new file mode 100644
index 00000000000..b41bcf6debe
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcFileName.c
@@ -0,0 +1,152 @@
+/* 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcFileName.h b/gcc/m2/mc-boot/GmcFileName.h
new file mode 100644
index 00000000000..6da1a2769f8
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcFileName.h
@@ -0,0 +1,84 @@
+/* do not edit automatically generated by mc from mcFileName.  */
+/* mcFileName.def Provides a procedure to calculate a system file name.
+
+Copyright (C) 2015-2022 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 (_mcFileName_H)
+#   define _mcFileName_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_mcFileName_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   calculateFileName - calculates and returns a new string filename
+                       given a module and an extension. This file name
+                       length will be operating system specific.
+                       String, Extension, is concatenated onto
+                       Module and thus it is safe to `Mark' the extension
+                       for garbage collection.
+*/
+
+EXTERN 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 DynamicStrings_String mcFileName_calculateStemName (DynamicStrings_String module);
+
+/*
+   extractExtension - given a, filename, return the filename without
+                      the extension, Ext.
+*/
+
+EXTERN 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 DynamicStrings_String mcFileName_extractModule (DynamicStrings_String filename);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcLexBuf.c b/gcc/m2/mc-boot/GmcLexBuf.c
new file mode 100644
index 00000000000..e2e3eae50ae
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcLexBuf.c
@@ -0,0 +1,1849 @@
+/* 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-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcLexBuf.h b/gcc/m2/mc-boot/GmcLexBuf.h
new file mode 100644
index 00000000000..b21cd4a4026
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcLexBuf.h
@@ -0,0 +1,233 @@
+/* do not edit automatically generated by mc from mcLexBuf.  */
+/* mcLexBuf.def provides a buffer for the all the tokens created by m2.lex.
+
+Copyright (C) 2015-2022 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 (_mcLexBuf_H)
+#   define _mcLexBuf_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GmcReserved.h"
+#   include "GDynamicStrings.h"
+#   include "GmcComment.h"
+
+#   if defined (_mcLexBuf_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN mcReserved_toktype mcLexBuf_currenttoken;
+EXTERN void * mcLexBuf_currentstring;
+EXTERN unsigned int mcLexBuf_currentcolumn;
+EXTERN int mcLexBuf_currentinteger;
+EXTERN mcComment_commentDesc mcLexBuf_lastcomment;
+EXTERN mcComment_commentDesc mcLexBuf_currentcomment;
+
+/*
+   getProcedureComment - returns the procedure comment if it exists,
+                         or NIL otherwise.
+*/
+
+EXTERN mcComment_commentDesc mcLexBuf_getProcedureComment (void);
+
+/*
+   getBodyComment - returns the body comment if it exists,
+                    or NIL otherwise.
+*/
+
+EXTERN mcComment_commentDesc mcLexBuf_getBodyComment (void);
+
+/*
+   getAfterComment - returns the after comment if it exists,
+                     or NIL otherwise.
+*/
+
+EXTERN mcComment_commentDesc mcLexBuf_getAfterComment (void);
+
+/*
+   openSource - Attempts to open the source file, s.
+                The success of the operation is returned.
+*/
+
+EXTERN unsigned int mcLexBuf_openSource (DynamicStrings_String s);
+
+/*
+   closeSource - closes the current open file.
+*/
+
+EXTERN void mcLexBuf_closeSource (void);
+
+/*
+   reInitialize - re-initialize the all the data structures.
+*/
+
+EXTERN void mcLexBuf_reInitialize (void);
+
+/*
+   resetForNewPass - reset the buffer pointers to the beginning ready for
+                     a new pass
+*/
+
+EXTERN void mcLexBuf_resetForNewPass (void);
+
+/*
+   getToken - gets the next token into currenttoken.
+*/
+
+EXTERN void mcLexBuf_getToken (void);
+
+/*
+   insertToken - inserts a symbol, token, infront of the current token
+                 ready for the next pass.
+*/
+
+EXTERN 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 void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token);
+
+/*
+   getPreviousTokenLineNo - returns the line number of the previous token.
+*/
+
+EXTERN unsigned int mcLexBuf_getPreviousTokenLineNo (void);
+
+/*
+   getLineNo - returns the current line number where the symbol occurs in
+               the source file.
+*/
+
+EXTERN unsigned int mcLexBuf_getLineNo (void);
+
+/*
+   getTokenNo - returns the current token number.
+*/
+
+EXTERN 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 unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth);
+
+/*
+   getColumnNo - returns the current column where the symbol occurs in
+                 the source file.
+*/
+
+EXTERN 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 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 DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth);
+
+/*
+   getFileName - returns a String defining the current file.
+*/
+
+EXTERN DynamicStrings_String mcLexBuf_getFileName (void);
+
+/*
+   addTok - adds a token to the buffer.
+*/
+
+EXTERN 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 void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s);
+
+/*
+   addTokInteger - adds a token and an integer to the buffer.
+*/
+
+EXTERN void mcLexBuf_addTokInteger (mcReserved_toktype t, int i);
+
+/*
+   addTokComment - adds a token to the buffer and a comment descriptor, com.
+*/
+
+EXTERN void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com);
+
+/*
+   setFile - sets the current filename to, filename.
+*/
+
+EXTERN void mcLexBuf_setFile (void * filename);
+
+/*
+   pushFile - indicates that, filename, has just been included.
+*/
+
+EXTERN void mcLexBuf_pushFile (void * filename);
+
+/*
+   popFile - indicates that we are returning to, filename, having finished
+             an include.
+*/
+
+EXTERN void mcLexBuf_popFile (void * filename);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcMetaError.c b/gcc/m2/mc-boot/GmcMetaError.c
new file mode 100644
index 00000000000..0c4aaf90a53
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcMetaError.c
@@ -0,0 +1,1880 @@
+/* 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-git-devel-modula2/gcc/m2/mc/mcMetaError.mod", 53, 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-git-devel-modula2/gcc/m2/mc/mcMetaError.mod", 53, 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-git-devel-modula2/gcc/m2/mc/mcMetaError.mod", 53, 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-git-devel-modula2/gcc/m2/mc/mcMetaError.mod", 53, 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, &quotes));
+            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, &quotes));
+            break;
+
+          case 'n':
+            o = x (o, doNumber (bol, sym, o, &quotes));
+            break;
+
+          case 'N':
+            o = x (o, doCount (bol, sym, o, &quotes));
+            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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcMetaError.h b/gcc/m2/mc-boot/GmcMetaError.h
new file mode 100644
index 00000000000..826b7ec20d2
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcMetaError.h
@@ -0,0 +1,76 @@
+/* do not edit automatically generated by mc from mcMetaError.  */
+/* mcMetaError.def provides a set of high level error routines.
+
+Copyright (C) 2015-2022 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 (_mcMetaError_H)
+#   define _mcMetaError_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GDynamicStrings.h"
+
+#   if defined (_mcMetaError_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
+EXTERN 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 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 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 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 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 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 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 void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
+EXTERN 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 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 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 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 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 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 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 void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high);
+EXTERN void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+EXTERN 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 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 void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high);
+EXTERN 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 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 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);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcOptions.c b/gcc/m2/mc-boot/GmcOptions.c
new file mode 100644
index 00000000000..42717cf9588
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcOptions.c
@@ -0,0 +1,1046 @@
+/* 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"
+
+#   define YEAR "2021"
+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 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);
+
+/*
+   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);
+
+
+/*
+   displayVersion - displays the version of the compiler.
+*/
+
+static void displayVersion (unsigned int mustExit)
+{
+  mcPrintf_printf0 ((const char *) "Copyright (C) ''2021'' Free Software Foundation, Inc.\\n", 55);
+  mcPrintf_printf0 ((const char *) "License GPLv2: GNU GPL version 2 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 *) "  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)
+{
+  comment (f, (const char *) "Copyright (C) ''2021'' Free Software Foundation, Inc.", 53);
+  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)
+{
+  comment (f, (const char *) "Copyright (C) ''2021'' Free Software Foundation, Inc.", 53);
+  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;
+    }
+}
+
+
+/*
+   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);
+}
+
+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;
+  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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcOptions.h b/gcc/m2/mc-boot/GmcOptions.h
new file mode 100644
index 00000000000..d1c653720cf
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcOptions.h
@@ -0,0 +1,140 @@
+/* do not edit automatically generated by mc from mcOptions.  */
+/* mcOptions.def handles the options for mc.
+
+Copyright (C) 2015-2022 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 (_mcOptions_H)
+#   define _mcOptions_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+#   include "GFIO.h"
+
+#   if defined (_mcOptions_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   handleOptions - iterates over all options setting appropriate
+                   values and returns the single source file
+                   if found at the end of the arguments.
+*/
+
+EXTERN DynamicStrings_String mcOptions_handleOptions (void);
+
+/*
+   getQuiet - return the value of quiet.
+*/
+
+EXTERN unsigned int mcOptions_getQuiet (void);
+
+/*
+   getVerbose - return the value of verbose.
+*/
+
+EXTERN unsigned int mcOptions_getVerbose (void);
+
+/*
+   getInternalDebugging - return the value of internalDebugging.
+*/
+
+EXTERN unsigned int mcOptions_getInternalDebugging (void);
+EXTERN DynamicStrings_String mcOptions_getCppCommandLine (void);
+
+/*
+   getOutputFile - sets the output filename to output.
+*/
+
+EXTERN DynamicStrings_String mcOptions_getOutputFile (void);
+
+/*
+   getExtendedOpaque - return the extendedOpaque value.
+*/
+
+EXTERN unsigned int mcOptions_getExtendedOpaque (void);
+
+/*
+   setDebugTopological - sets the flag debugTopological to value.
+*/
+
+EXTERN void mcOptions_setDebugTopological (unsigned int value);
+
+/*
+   getDebugTopological - returns the flag value of the command
+                         line option --debug-top.
+*/
+
+EXTERN unsigned int mcOptions_getDebugTopological (void);
+
+/*
+   getHPrefix - saves the H file prefix.
+*/
+
+EXTERN DynamicStrings_String mcOptions_getHPrefix (void);
+
+/*
+   getIgnoreFQ - returns the ignorefq flag.
+*/
+
+EXTERN unsigned int mcOptions_getIgnoreFQ (void);
+
+/*
+   getGccConfigSystem - return the value of the gccConfigSystem flag.
+*/
+
+EXTERN unsigned int mcOptions_getGccConfigSystem (void);
+
+/*
+   getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*/
+
+EXTERN unsigned int mcOptions_getScaffoldDynamic (void);
+
+/*
+   getScaffoldMain - return true if the --scaffold-main option was present.
+*/
+
+EXTERN unsigned int mcOptions_getScaffoldMain (void);
+
+/*
+   writeGPLheader - writes out the GPL or the GLPL as a comment.
+*/
+
+EXTERN void mcOptions_writeGPLheader (FIO_File f);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcPreprocess.c b/gcc/m2/mc-boot/GmcPreprocess.c
new file mode 100644
index 00000000000..df335c08e20
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcPreprocess.c
@@ -0,0 +1,181 @@
+/* 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcPreprocess.h b/gcc/m2/mc-boot/GmcPreprocess.h
new file mode 100644
index 00000000000..b800587b1f8
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcPreprocess.h
@@ -0,0 +1,63 @@
+/* do not edit automatically generated by mc from mcPreprocess.  */
+/* mcPreprocess.def provides a mechanism to invoke the C preprocessor.
+
+Copyright (C) 2015-2022 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 (_mcPreprocess_H)
+#   define _mcPreprocess_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_mcPreprocess_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   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 DynamicStrings_String mcPreprocess_preprocessModule (DynamicStrings_String filename);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcPretty.c b/gcc/m2/mc-boot/GmcPretty.c
new file mode 100644
index 00000000000..674db9443a5
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcPretty.c
@@ -0,0 +1,468 @@
+/* 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcPretty.h b/gcc/m2/mc-boot/GmcPretty.h
new file mode 100644
index 00000000000..2f2f6cd16ee
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcPretty.h
@@ -0,0 +1,158 @@
+/* do not edit automatically generated by mc from mcPretty.  */
+/* mcPretty.def provides an interface to the pretty printing of output code.
+
+Copyright (C) 2016-2022 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 (_mcPretty_H)
+#   define _mcPretty_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_mcPretty_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (mcPretty_pretty_D)
+#  define mcPretty_pretty_D
+   typedef void *mcPretty_pretty;
+#endif
+
+typedef struct mcPretty_writeProc_p mcPretty_writeProc;
+
+typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc;
+
+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; };
+
+
+/*
+   initPretty - initialise a pretty print data structure.
+*/
+
+EXTERN mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l);
+
+/*
+   dupPretty - duplicate a pretty print data structure.
+*/
+
+EXTERN mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p);
+
+/*
+   killPretty - destroy a pretty print data structure.
+                Post condition:  p is assigned to NIL.
+*/
+
+EXTERN void mcPretty_killPretty (mcPretty_pretty *p);
+
+/*
+   pushPretty - duplicate, p.  Push, p, and return the duplicate.
+*/
+
+EXTERN mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p);
+
+/*
+   popPretty - pops the pretty object from the stack.
+*/
+
+EXTERN mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p);
+
+/*
+   getindent - returns the current indent value.
+*/
+
+EXTERN unsigned int mcPretty_getindent (mcPretty_pretty p);
+
+/*
+   setindent - sets the current indent to, n.
+*/
+
+EXTERN void mcPretty_setindent (mcPretty_pretty p, unsigned int n);
+
+/*
+   getcurpos - returns the current cursor position.
+*/
+
+EXTERN unsigned int mcPretty_getcurpos (mcPretty_pretty s);
+
+/*
+   getseekpos - returns the seek position.
+*/
+
+EXTERN unsigned int mcPretty_getseekpos (mcPretty_pretty s);
+
+/*
+   getcurline - returns the current line number.
+*/
+
+EXTERN unsigned int mcPretty_getcurline (mcPretty_pretty s);
+
+/*
+   setNeedSpace - sets needSpace flag to TRUE.
+*/
+
+EXTERN void mcPretty_setNeedSpace (mcPretty_pretty s);
+
+/*
+   noSpace - unset needsSpace.
+*/
+
+EXTERN void mcPretty_noSpace (mcPretty_pretty s);
+
+/*
+   print - print a string using, p.
+*/
+
+EXTERN void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high);
+
+/*
+   prints - print a string using, p.
+*/
+
+EXTERN void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+   raw - print out string, s, without any translation of
+         escape sequences.
+*/
+
+EXTERN void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcPrintf.c b/gcc/m2/mc-boot/GmcPrintf.c
new file mode 100644
index 00000000000..0bfe898e155
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcPrintf.c
@@ -0,0 +1,655 @@
+/* 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcPrintf.h b/gcc/m2/mc-boot/GmcPrintf.h
new file mode 100644
index 00000000000..1d924243b03
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcPrintf.h
@@ -0,0 +1,122 @@
+/* do not edit automatically generated by mc from mcPrintf.  */
+/* mcPrintf.def provides a poor mans printf capability.
+
+Copyright (C) 2015-2022 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 (_mcPrintf_H)
+#   define _mcPrintf_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GFIO.h"
+
+#   if defined (_mcPrintf_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   printf0 - writes out an array to, StdOut, after the escape sequences have been
+             translated.
+*/
+
+EXTERN 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 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 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 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 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 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 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 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 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 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);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcQuiet.c b/gcc/m2/mc-boot/GmcQuiet.c
new file mode 100644
index 00000000000..88115761c8b
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcQuiet.c
@@ -0,0 +1,129 @@
+/* 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcQuiet.h b/gcc/m2/mc-boot/GmcQuiet.h
new file mode 100644
index 00000000000..a8dc4f044dd
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcQuiet.h
@@ -0,0 +1,56 @@
+/* do not edit automatically generated by mc from mcQuiet.  */
+/* mcQuiet.def provides a wrapper to mcPrintf, each call is only passed.
+
+Copyright (C) 2015-2022 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 (_mcQuiet_H)
+#   define _mcQuiet_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_mcQuiet_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN void mcQuiet_qprintf0 (const char *a_, unsigned int _a_high);
+EXTERN void mcQuiet_qprintf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+EXTERN 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 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 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);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcReserved.c b/gcc/m2/mc-boot/GmcReserved.c
new file mode 100644
index 00000000000..a1221f9d85e
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcReserved.c
@@ -0,0 +1,40 @@
+/* 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcReserved.h b/gcc/m2/mc-boot/GmcReserved.h
new file mode 100644
index 00000000000..2f91fb1bdc2
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcReserved.h
@@ -0,0 +1,52 @@
+/* do not edit automatically generated by mc from mcReserved.  */
+/* mcReserved.def defines the toktype.
+
+Copyright (C) 2015-2022 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 (_mcReserved_H)
+#   define _mcReserved_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_mcReserved_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+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;
+
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcSearch.c b/gcc/m2/mc-boot/GmcSearch.c
new file mode 100644
index 00000000000..08b9312c22f
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcSearch.c
@@ -0,0 +1,408 @@
+/* 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcSearch.h b/gcc/m2/mc-boot/GmcSearch.h
new file mode 100644
index 00000000000..dbb32026049
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcSearch.h
@@ -0,0 +1,119 @@
+/* do not edit automatically generated by mc from mcSearch.  */
+/* mcSearch.def mcSearch provides a mechanism to search selected directories.
+
+Copyright (C) 2015-2022 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 (_mcSearch_H)
+#   define _mcSearch_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_mcSearch_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   initSearchPath - initialise the compiler search, 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 void mcSearch_initSearchPath (DynamicStrings_String path);
+
+/*
+   prependSearchPath - prepends a new path to the initial search path.
+*/
+
+EXTERN 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.
+                    FindSourceFile sets FullPath to a new string if successful.
+*/
+
+EXTERN 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 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 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 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 void mcSearch_setModExtension (DynamicStrings_String ext);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcStack.c b/gcc/m2/mc-boot/GmcStack.c
new file mode 100644
index 00000000000..83fecdadb65
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcStack.c
@@ -0,0 +1,228 @@
+/* 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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcStack.h b/gcc/m2/mc-boot/GmcStack.h
new file mode 100644
index 00000000000..a19450fc26a
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcStack.h
@@ -0,0 +1,102 @@
+/* do not edit automatically generated by mc from mcStack.  */
+/* mcStack.def provides a stack data type and associated procedures.
+
+Copyright (C) 2015-2022 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 (_mcStack_H)
+#   define _mcStack_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_mcStack_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (mcStack_stack_D)
+#  define mcStack_stack_D
+   typedef void *mcStack_stack;
+#endif
+
+
+/*
+   init - create and return a stack.
+*/
+
+EXTERN mcStack_stack mcStack_init (void);
+
+/*
+   kill - deletes stack, s.
+*/
+
+EXTERN void mcStack_kill (mcStack_stack *s);
+
+/*
+   push - an address, a, onto the stack, s.
+          It returns, a.
+*/
+
+EXTERN void * mcStack_push (mcStack_stack s, void * a);
+
+/*
+   pop - and return the top element from stack, s.
+*/
+
+EXTERN void * mcStack_pop (mcStack_stack s);
+
+/*
+   replace - performs a pop; push (a); return a.
+*/
+
+EXTERN void * mcStack_replace (mcStack_stack s, void * a);
+
+/*
+   depth - returns the depth of the stack.
+*/
+
+EXTERN 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 void * mcStack_access (mcStack_stack s, unsigned int i);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GmcStream.c b/gcc/m2/mc-boot/GmcStream.c
new file mode 100644
index 00000000000..2ec838d5b2a
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcStream.c
@@ -0,0 +1,266 @@
+/* do not edit automatically generated by mc from mcStream.  */
+/* mcStream.mod provides an interface to create a file from fragments.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GmcStream.h b/gcc/m2/mc-boot/GmcStream.h
new file mode 100644
index 00000000000..45886c09466
--- /dev/null
+++ b/gcc/m2/mc-boot/GmcStream.h
@@ -0,0 +1,79 @@
+/* do not edit automatically generated by mc from mcStream.  */
+/* mcStream.def provides an interface to create a file from fragments.
+
+Copyright (C) 2015-2022 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 (_mcStream_H)
+#   define _mcStream_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GFIO.h"
+
+#   if defined (_mcStream_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   openFrag - create and open fragment, id, and return the file.
+              The file should not be closed by the user.
+*/
+
+EXTERN FIO_File mcStream_openFrag (unsigned int id);
+
+/*
+   setDest - informs the stream module and all fragments must be copied
+             info, f.
+*/
+
+EXTERN 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 FIO_File mcStream_combine (void);
+
+/*
+   removeFiles - remove any fragment.
+*/
+
+EXTERN void mcStream_removeFiles (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gmcflex.h b/gcc/m2/mc-boot/Gmcflex.h
new file mode 100644
index 00000000000..b5b70814af6
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcflex.h
@@ -0,0 +1,89 @@
+/* do not edit automatically generated by mc from mcflex.  */
+/* mcflex.def provides a Modula-2 definition module for the C lexical.
+
+Copyright (C) 2015-2022 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 (_mcflex_H)
+#   define _mcflex_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_mcflex_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   closeSource - provided for semantic sugar
+*/
+
+EXTERN void mcflex_closeSource (void);
+EXTERN unsigned int mcflex_openSource (void * s);
+
+/*
+   getToken - returns the ADDRESS of the next token.
+*/
+
+EXTERN void * mcflex_getToken (void);
+
+/*
+   getLineNo - returns the current line number.
+*/
+
+EXTERN unsigned int mcflex_getLineNo (void);
+
+/*
+   getColumnNo - returns the column where the current token starts.
+*/
+
+EXTERN unsigned int mcflex_getColumnNo (void);
+
+/*
+   mcError - displays the error message, s, after the code line and pointer
+             to the erroneous token.
+*/
+
+EXTERN void mcflex_mcError (void * s);
+
+/*
+   getTotalLines - returns the total number of lines parsed.
+*/
+
+EXTERN unsigned int mcflex_getTotalLines (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gmcp1.c b/gcc/m2/mc-boot/Gmcp1.c
new file mode 100644
index 00000000000..e4f154410e0
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp1.c
@@ -0,0 +1,7265 @@
+/* do not edit automatically generated by mc from mcp1.  */
+/* output from mc-1.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gmcp1.h b/gcc/m2/mc-boot/Gmcp1.h
new file mode 100644
index 00000000000..0bce477f35c
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp1.h
@@ -0,0 +1,57 @@
+/* do not edit automatically generated by mc from mcp1.  */
+/* mcp1.def provides an interface to the pass 1 parser.
+
+Copyright (C) 2015-2022 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 (_mcp1_H)
+#   define _mcp1_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_mcp1_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*/
+
+EXTERN unsigned int mcp1_CompilationUnit (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gmcp2.c b/gcc/m2/mc-boot/Gmcp2.c
new file mode 100644
index 00000000000..cd2bd399b76
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp2.c
@@ -0,0 +1,7637 @@
+/* do not edit automatically generated by mc from mcp2.  */
+/* output from mc-2.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gmcp2.h b/gcc/m2/mc-boot/Gmcp2.h
new file mode 100644
index 00000000000..9a267755657
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp2.h
@@ -0,0 +1,57 @@
+/* do not edit automatically generated by mc from mcp2.  */
+/* mcp2.def provides an interface to the pass 2 parser.
+
+Copyright (C) 2015-2022 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 (_mcp2_H)
+#   define _mcp2_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_mcp2_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*/
+
+EXTERN unsigned int mcp2_CompilationUnit (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gmcp3.c b/gcc/m2/mc-boot/Gmcp3.c
new file mode 100644
index 00000000000..54913266418
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp3.c
@@ -0,0 +1,7854 @@
+/* do not edit automatically generated by mc from mcp3.  */
+/* output from mc-3.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gmcp3.h b/gcc/m2/mc-boot/Gmcp3.h
new file mode 100644
index 00000000000..74d98d919c1
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp3.h
@@ -0,0 +1,57 @@
+/* do not edit automatically generated by mc from mcp3.  */
+/* mcp3.def provides an interface to the pass 3 parser.
+
+Copyright (C) 2015-2022 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 (_mcp3_H)
+#   define _mcp3_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_mcp3_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*/
+
+EXTERN unsigned int mcp3_CompilationUnit (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gmcp4.c b/gcc/m2/mc-boot/Gmcp4.c
new file mode 100644
index 00000000000..d4c7f336f37
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp4.c
@@ -0,0 +1,7717 @@
+/* do not edit automatically generated by mc from mcp4.  */
+/* output from mc-4.bnf, automatically generated do not edit.
+
+Copyright (C) 2016-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gmcp4.h b/gcc/m2/mc-boot/Gmcp4.h
new file mode 100644
index 00000000000..cd8313b8a72
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp4.h
@@ -0,0 +1,57 @@
+/* do not edit automatically generated by mc from mcp4.  */
+/* mcp4.def provides an interface to the pass 4 parser.
+
+Copyright (C) 2016-2022 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 (_mcp4_H)
+#   define _mcp4_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_mcp4_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*/
+
+EXTERN unsigned int mcp4_CompilationUnit (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gmcp5.c b/gcc/m2/mc-boot/Gmcp5.c
new file mode 100644
index 00000000000..f584efff5cb
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp5.c
@@ -0,0 +1,8576 @@
+/* do not edit automatically generated by mc from mcp5.  */
+/* output from mc-5.bnf, automatically generated do not edit.
+
+Copyright (C) 2016-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gmcp5.h b/gcc/m2/mc-boot/Gmcp5.h
new file mode 100644
index 00000000000..4a135553ae1
--- /dev/null
+++ b/gcc/m2/mc-boot/Gmcp5.h
@@ -0,0 +1,57 @@
+/* do not edit automatically generated by mc from mcp5.  */
+/* mcp5.def provides an interface to the pass 5 parser.
+
+Copyright (C) 2016-2022 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 (_mcp5_H)
+#   define _mcp5_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_mcp5_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*/
+
+EXTERN unsigned int mcp5_CompilationUnit (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GnameKey.c b/gcc/m2/mc-boot/GnameKey.c
new file mode 100644
index 00000000000..096c65f2cfd
--- /dev/null
+++ b/gcc/m2/mc-boot/GnameKey.c
@@ -0,0 +1,584 @@
+/* do not edit automatically generated by mc from nameKey.  */
+/* nameKey.mod provides a dynamic binary tree name to key.
+
+Copyright (C) 2015-2022 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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GnameKey.h b/gcc/m2/mc-boot/GnameKey.h
new file mode 100644
index 00000000000..b46328fc8f2
--- /dev/null
+++ b/gcc/m2/mc-boot/GnameKey.h
@@ -0,0 +1,111 @@
+/* do not edit automatically generated by mc from nameKey.  */
+/* nameKey.def provides a dynamic binary tree name to key.
+
+Copyright (C) 2015-2022 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 (_nameKey_H)
+#   define _nameKey_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_nameKey_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define nameKey_NulName 0
+typedef unsigned int nameKey_Name;
+
+
+/*
+   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 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 nameKey_Name nameKey_makekey (void * a);
+
+/*
+   getKey - returns the name, a, of the key, key.
+*/
+
+EXTERN void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high);
+
+/*
+   lengthKey - returns the length of a Key.
+*/
+
+EXTERN unsigned int nameKey_lengthKey (nameKey_Name key);
+
+/*
+   isKey - returns TRUE if string, a, is currently a key.
+*/
+
+EXTERN unsigned int nameKey_isKey (const char *a_, unsigned int _a_high);
+
+/*
+   writeKey - Display the symbol represented by Key.
+*/
+
+EXTERN void nameKey_writeKey (nameKey_Name key);
+
+/*
+   isSameExcludingCase - returns TRUE if key1 and key2 are
+                         the same. It is case insensitive.
+*/
+
+EXTERN unsigned int nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2);
+
+/*
+   keyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+EXTERN void * nameKey_keyToCharStar (nameKey_Name key);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gpth.h b/gcc/m2/mc-boot/Gpth.h
new file mode 100644
index 00000000000..7619d7d55e0
--- /dev/null
+++ b/gcc/m2/mc-boot/Gpth.h
@@ -0,0 +1,43 @@
+
+
+#if !defined (_pth_H)
+#   define _pth_H
+
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_pth_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct pth_proc_p pth_proc;
+
+typedef unsigned int pth_size_t;
+
+typedef void *pth_pth_uctx_t;
+
+typedef void (*pth_proc_t) (void *);
+struct pth_proc_p { pth_proc_t proc; };
+
+EXTERN int pth_pth_select (int p1, void * p2, void * p3, void * p4, void * p5);
+EXTERN int pth_pth_uctx_create (void * p);
+EXTERN int pth_pth_uctx_make (pth_pth_uctx_t p1, void * p2, pth_size_t p3, void * p4, pth_proc p5, void * p6, pth_pth_uctx_t p7);
+EXTERN int pth_pth_uctx_save (pth_pth_uctx_t p1);
+EXTERN int pth_pth_uctx_switch (pth_pth_uctx_t p1, pth_pth_uctx_t p2);
+EXTERN int pth_pth_init (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GsymbolKey.c b/gcc/m2/mc-boot/GsymbolKey.c
new file mode 100644
index 00000000000..dc5c45cdc70
--- /dev/null
+++ b/gcc/m2/mc-boot/GsymbolKey.c
@@ -0,0 +1,406 @@
+/* do not edit automatically generated by mc from symbolKey.  */
+/* symbolKey.mod provides binary tree operations for storing symbols.
+
+Copyright (C) 2015-2022 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-git-devel-modula2/gcc/m2/mc/symbolKey.mod", 51);
+    }
+  (*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-git-devel-modula2/gcc/m2/mc/symbolKey.mod", 51);
+    }
+}
+
+
+/*
+   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-git-devel-modula2/gcc/m2/mc/symbolKey.mod", 51);
+    }
+}
+
+
+/*
+   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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GsymbolKey.h b/gcc/m2/mc-boot/GsymbolKey.h
new file mode 100644
index 00000000000..eddf4ab115b
--- /dev/null
+++ b/gcc/m2/mc-boot/GsymbolKey.h
@@ -0,0 +1,127 @@
+/* do not edit automatically generated by mc from symbolKey.  */
+/* symbolKey.def provides binary tree operations for storing symbols.
+
+Copyright (C) 2015-2022 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 (_symbolKey_H)
+#   define _symbolKey_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   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
+#   include "GSYSTEM.h"
+#   include "GnameKey.h"
+
+#   if defined (_symbolKey_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define symbolKey_NulKey NULL
+#if !defined (symbolKey_symbolTree_D)
+#  define symbolKey_symbolTree_D
+   typedef void *symbolKey_symbolTree;
+#endif
+
+typedef struct symbolKey_isSymbol_p symbolKey_isSymbol;
+
+typedef struct symbolKey_performOperation_p symbolKey_performOperation;
+
+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; };
+
+
+/*
+   initTree - initializes a symbolTree pointed to by t.
+*/
+
+EXTERN symbolKey_symbolTree symbolKey_initTree (void);
+
+/*
+   killTree - destroys the symbolTree pointed to by t.
+*/
+
+EXTERN void symbolKey_killTree (symbolKey_symbolTree *t);
+
+/*
+   getSymKey - searches the symbolTree t for an entry name. If
+               found then the key is returned otherwise NulKey
+               is returned.
+*/
+
+EXTERN void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name);
+
+/*
+   putSymKey - puts an symbol entry, name, in the symbolTree t.
+               SymKey is the value stored with name.
+*/
+
+EXTERN void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key);
+
+/*
+   delSymKey - deletes a symbol entry name in the symbolTree, t.
+*/
+
+EXTERN void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name);
+
+/*
+   isEmptyTree - returns true if symbolTree, t, is empty.
+*/
+
+EXTERN 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.
+*/
+
+EXTERN 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.
+                   It traverse the tree in order.
+*/
+
+EXTERN void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gtermios.h b/gcc/m2/mc-boot/Gtermios.h
new file mode 100644
index 00000000000..e8b79774187
--- /dev/null
+++ b/gcc/m2/mc-boot/Gtermios.h
@@ -0,0 +1,207 @@
+/* do not edit automatically generated by mc from termios.  */
+/* termios.def provides a procedural interface to termios.
+
+Copyright (C) 2005-2021 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 (_termios_H)
+#   define _termios_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_termios_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef void *termios_TERMIOS;
+
+typedef enum {termios_vintr, termios_vquit, termios_verase, termios_vkill, termios_veof, termios_vtime, termios_vmin, termios_vswtc, termios_vstart, termios_vstop, termios_vsusp, termios_veol, termios_vreprint, termios_vdiscard, termios_vwerase, termios_vlnext, termios_veol2} termios_ControlChar;
+
+typedef enum {termios_ignbrk, termios_ibrkint, termios_ignpar, termios_iparmrk, termios_inpck, termios_istrip, termios_inlcr, termios_igncr, termios_icrnl, termios_iuclc, termios_ixon, termios_ixany, termios_ixoff, termios_imaxbel, termios_opost, termios_olcuc, termios_onlcr, termios_ocrnl, termios_onocr, termios_onlret, termios_ofill, termios_ofdel, termios_onl0, termios_onl1, termios_ocr0, termios_ocr1, termios_ocr2, termios_ocr3, termios_otab0, termios_otab1, termios_otab2, termios_otab3, termios_obs0, termios_obs1, termios_off0, termios_off1, termios_ovt0, termios_ovt1, termios_b0, termios_b50, termios_b75, termios_b110, termios_b135, termios_b150, termios_b200, termios_b300, termios_b600, termios_b1200, termios_b1800, termios_b2400, termios_b4800, termios_b9600, termios_b19200, termios_b38400, termios_b57600, termios_b115200, termios_b240400, termios_b460800, termios_b500000, termios_b576000, termios_b921600, termios_b1000000, termios_b1152000, termios_b1500000, termios_b2000000, termios_b2500000, termios_b3000000, termios_b3500000, termios_b4000000, termios_maxbaud, termios_crtscts, termios_cs5, termios_cs6, termios_cs7, termios_cs8, termios_cstopb, termios_cread, termios_parenb, termios_parodd, termios_hupcl, termios_clocal, termios_lisig, termios_licanon, termios_lxcase, termios_lecho, termios_lechoe, termios_lechok, termios_lechonl, termios_lnoflsh, termios_ltopstop, termios_lechoctl, termios_lechoprt, termios_lechoke, termios_lflusho, termios_lpendin, termios_liexten} termios_Flag;
+
+
+/*
+   InitTermios - new data structure.
+*/
+
+EXTERN termios_TERMIOS termios_InitTermios (void);
+
+/*
+   KillTermios - delete data structure.
+*/
+
+EXTERN termios_TERMIOS termios_KillTermios (termios_TERMIOS t);
+
+/*
+   cfgetospeed - return output baud rate.
+*/
+
+EXTERN int termios_cfgetospeed (termios_TERMIOS t);
+
+/*
+   cfgetispeed - return input baud rate.
+*/
+
+EXTERN int termios_cfgetispeed (termios_TERMIOS t);
+
+/*
+   cfsetospeed - set output baud rate.
+*/
+
+EXTERN int termios_cfsetospeed (termios_TERMIOS t, unsigned int b);
+
+/*
+   cfsetispeed - set input baud rate.
+*/
+
+EXTERN int termios_cfsetispeed (termios_TERMIOS t, unsigned int b);
+
+/*
+   cfsetspeed - set input and output baud rate.
+*/
+
+EXTERN int termios_cfsetspeed (termios_TERMIOS t, unsigned int b);
+
+/*
+   tcgetattr - get state of, fd, into, t.
+*/
+
+EXTERN int termios_tcgetattr (int fd, termios_TERMIOS t);
+EXTERN int termios_tcsnow (void);
+EXTERN int termios_tcsdrain (void);
+EXTERN int termios_tcsflush (void);
+
+/*
+   tcsetattr - set state of, fd, to, t, using option.
+*/
+
+EXTERN int termios_tcsetattr (int fd, int option, termios_TERMIOS t);
+
+/*
+   cfmakeraw - sets, t, to raw mode.
+*/
+
+EXTERN void termios_cfmakeraw (termios_TERMIOS t);
+
+/*
+   tcsendbreak - send zero bits for duration.
+*/
+
+EXTERN int termios_tcsendbreak (int fd, int duration);
+
+/*
+   tcdrain - waits for pending output to be written on, fd.
+*/
+
+EXTERN int termios_tcdrain (int fd);
+
+/*
+   tcflushi - flush input.
+*/
+
+EXTERN int termios_tcflushi (int fd);
+
+/*
+   tcflusho - flush output.
+*/
+
+EXTERN int termios_tcflusho (int fd);
+
+/*
+   tcflushio - flush input and output.
+*/
+
+EXTERN int termios_tcflushio (int fd);
+
+/*
+   tcflowoni - restart input on, fd.
+*/
+
+EXTERN int termios_tcflowoni (int fd);
+
+/*
+   tcflowoffi - stop input on, fd.
+*/
+
+EXTERN int termios_tcflowoffi (int fd);
+
+/*
+   tcflowono - restart output on, fd.
+*/
+
+EXTERN int termios_tcflowono (int fd);
+
+/*
+   tcflowoffo - stop output on, fd.
+*/
+
+EXTERN int termios_tcflowoffo (int fd);
+
+/*
+   GetFlag - sets a flag value from, t, in, b, and returns TRUE
+             if, t, supports, f.
+*/
+
+EXTERN unsigned int termios_GetFlag (termios_TERMIOS t, termios_Flag f, unsigned int *b);
+
+/*
+   SetFlag - sets a flag value in, t, to, b, and returns TRUE if
+             this flag value is supported.
+*/
+
+EXTERN unsigned int termios_SetFlag (termios_TERMIOS t, termios_Flag f, unsigned int b);
+
+/*
+   GetChar - sets a CHAR, ch, value from, t, and returns TRUE if
+             this value is supported.
+*/
+
+EXTERN unsigned int termios_GetChar (termios_TERMIOS t, termios_ControlChar c, char *ch);
+
+/*
+   SetChar - sets a CHAR value in, t, and returns TRUE if, c,
+             is supported.
+*/
+
+EXTERN unsigned int termios_SetChar (termios_TERMIOS t, termios_ControlChar c, char ch);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gtop.c b/gcc/m2/mc-boot/Gtop.c
new file mode 100644
index 00000000000..85511559e48
--- /dev/null
+++ b/gcc/m2/mc-boot/Gtop.c
@@ -0,0 +1,100 @@
+/* do not edit automatically generated by mc from top.  */
+/* top.mod main top level program module for mc.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gvarargs.c b/gcc/m2/mc-boot/Gvarargs.c
new file mode 100644
index 00000000000..0e4a10629db
--- /dev/null
+++ b/gcc/m2/mc-boot/Gvarargs.c
@@ -0,0 +1,431 @@
+/* do not edit automatically generated by mc from varargs.  */
+/* varargs.mod provides a basic vararg facility for GNU Modula-2.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gvarargs.h b/gcc/m2/mc-boot/Gvarargs.h
new file mode 100644
index 00000000000..07db00deead
--- /dev/null
+++ b/gcc/m2/mc-boot/Gvarargs.h
@@ -0,0 +1,119 @@
+/* do not edit automatically generated by mc from varargs.  */
+/* varargs.def provides a basic vararg facility for GNU Modula-2.
+
+Copyright (C) 2015-2022 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 (_varargs_H)
+#   define _varargs_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_varargs_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (varargs_vararg_D)
+#  define varargs_vararg_D
+   typedef void *varargs_vararg;
+#endif
+
+
+/*
+   nargs - returns the number of arguments wrapped in, v.
+*/
+
+EXTERN 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 void varargs_arg (varargs_vararg v, unsigned char *a, unsigned int _a_high);
+
+/*
+   next - assigns the next arg to be collected as, i.
+*/
+
+EXTERN void varargs_next (varargs_vararg v, unsigned int i);
+
+/*
+   copy - returns a copy of, v.
+*/
+
+EXTERN 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 void varargs_replace (varargs_vararg v, unsigned char *a, unsigned int _a_high);
+
+/*
+   end - destructor for vararg, v.
+*/
+
+EXTERN void varargs_end (varargs_vararg *v);
+
+/*
+   start1 - wraps up argument, a, into a vararg.
+*/
+
+EXTERN varargs_vararg varargs_start1 (const unsigned char *a_, unsigned int _a_high);
+
+/*
+   start2 - wraps up arguments, a, b, into a vararg.
+*/
+
+EXTERN 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 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 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);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gwlists.c b/gcc/m2/mc-boot/Gwlists.c
new file mode 100644
index 00000000000..ec4011c7cd4
--- /dev/null
+++ b/gcc/m2/mc-boot/Gwlists.c
@@ -0,0 +1,471 @@
+/* do not edit automatically generated by mc from wlists.  */
+/* wlists.mod word lists module.
+
+Copyright (C) 2015-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/Gwlists.h b/gcc/m2/mc-boot/Gwlists.h
new file mode 100644
index 00000000000..aba0aa92dd0
--- /dev/null
+++ b/gcc/m2/mc-boot/Gwlists.h
@@ -0,0 +1,139 @@
+/* do not edit automatically generated by mc from wlists.  */
+/* wlists.def word lists module.
+
+Copyright (C) 2015-2022 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 (_wlists_H)
+#   define _wlists_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_wlists_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (wlists_wlist_D)
+#  define wlists_wlist_D
+   typedef void *wlists_wlist;
+#endif
+
+typedef struct wlists_performOperation_p wlists_performOperation;
+
+typedef void (*wlists_performOperation_t) (unsigned int);
+struct wlists_performOperation_p { wlists_performOperation_t proc; };
+
+
+/*
+   initList - creates a new wlist, l.
+*/
+
+EXTERN wlists_wlist wlists_initList (void);
+
+/*
+   killList - deletes the complete wlist, l.
+*/
+
+EXTERN void wlists_killList (wlists_wlist *l);
+
+/*
+   putItemIntoList - places an WORD, c, into wlist, l.
+*/
+
+EXTERN void wlists_putItemIntoList (wlists_wlist l, unsigned int c);
+
+/*
+   getItemFromList - retrieves the nth WORD from wlist, l.
+*/
+
+EXTERN unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n);
+
+/*
+   getIndexOfList - returns the index for WORD, c, in wlist, l.
+                    If more than one CARDINAL, c, exists the index
+                    for the first is returned.
+*/
+
+EXTERN unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c);
+
+/*
+   noOfItemsInList - returns the number of items in wlist, l.
+*/
+
+EXTERN unsigned int wlists_noOfItemsInList (wlists_wlist l);
+
+/*
+   includeItemIntoList - adds an WORD, c, into a wlist providing
+                         the value does not already exist.
+*/
+
+EXTERN void wlists_includeItemIntoList (wlists_wlist l, unsigned int c);
+
+/*
+   removeItemFromList - removes an WORD, c, from a wlist.
+                        It assumes that this value only appears once.
+*/
+
+EXTERN 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 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 unsigned int wlists_isItemInList (wlists_wlist l, unsigned int c);
+
+/*
+   foreachItemInListDo - calls procedure, P, foreach item in wlist, l.
+*/
+
+EXTERN void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p);
+
+/*
+   duplicateList - returns a duplicate wlist derived from, l.
+*/
+
+EXTERN wlists_wlist wlists_duplicateList (wlists_wlist l);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/Gwrapc.h b/gcc/m2/mc-boot/Gwrapc.h
new file mode 100644
index 00000000000..8bd4a2d81f8
--- /dev/null
+++ b/gcc/m2/mc-boot/Gwrapc.h
@@ -0,0 +1,125 @@
+/* do not edit automatically generated by mc from wrapc.  */
+/* wrapc.def provides access to more of the C library.
+
+Copyright (C) 2001-2021 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 (_wrapc_H)
+#   define _wrapc_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_wrapc_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   strtime - returns the C string for the equivalent C asctime
+             function.
+*/
+
+EXTERN void * wrapc_strtime (void);
+
+/*
+   filesize - assigns the size of a file, f, into low, high and
+              returns zero if successful.
+*/
+
+EXTERN int wrapc_filesize (int f, unsigned int *low, unsigned int *high);
+
+/*
+   fileinode - return the inode associated with file, f.
+*/
+
+EXTERN int wrapc_fileinode (int f, unsigned int *low, unsigned int *high);
+
+/*
+   filemtime - returns the mtime of a file, f.
+*/
+
+EXTERN int wrapc_filemtime (int f);
+
+/*
+   getrand - returns a random number between 0..n-1
+*/
+
+EXTERN int wrapc_getrand (int n);
+
+/*
+   getusername - returns a C string describing the current user.
+*/
+
+EXTERN void * wrapc_getusername (void);
+
+/*
+   getnameuidgid - fills in the, uid, and, gid, which represents
+                   user, name.
+*/
+
+EXTERN void wrapc_getnameuidgid (void * name, int *uid, int *gid);
+EXTERN int wrapc_signbit (double r);
+EXTERN int wrapc_signbitf (float s);
+EXTERN int wrapc_signbitl (long double l);
+
+/*
+   isfinite - provide non builtin alternative to the gcc builtin isfinite.
+              Returns 1 if x is finite and 0 if it is not.
+*/
+
+EXTERN int wrapc_isfinite (double x);
+
+/*
+   isfinitef - provide non builtin alternative to the gcc builtin isfinite.
+               Returns 1 if x is finite and 0 if it is not.
+*/
+
+EXTERN int wrapc_isfinitef (float x);
+
+/*
+   isfinitel - provide non builtin alternative to the gcc builtin isfinite.
+               Returns 1 if x is finite and 0 if it is not.
+*/
+
+EXTERN int wrapc_isfinitel (long double x);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/README b/gcc/m2/mc-boot/README
new file mode 100644
index 00000000000..14c156d32e7
--- /dev/null
+++ b/gcc/m2/mc-boot/README
@@ -0,0 +1,3 @@
+This directory contains the automatically translated version of mc.
+This source code is C++ and the original in mc is Modula-2.
+It is rebuilt by the Modula-2 maintainer.
diff --git a/gcc/m2/mc/Indexing.def b/gcc/m2/mc/Indexing.def
new file mode 100644
index 00000000000..e50e869c0d5
--- /dev/null
+++ b/gcc/m2/mc/Indexing.def
@@ -0,0 +1,128 @@
+(* Indexing.def provides a dynamic indexing mechanism.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE Indexing ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED Index, InitIndex, KillIndex, GetIndice, PutIndice,
+                 HighIndice, LowIndice, InBounds, IsIndiceInIndex,
+                 RemoveIndiceFromIndex, IncludeIndiceIntoIndex,
+                 ForeachIndiceInIndexDo, DeleteIndice, DebugIndex ;
+
+TYPE
+   Index ;
+   IndexProcedure = PROCEDURE (ADDRESS) ;
+
+
+(*
+   InitIndex - creates and returns an Index.
+*)
+
+PROCEDURE InitIndex (low: CARDINAL) : Index ;
+
+
+(*
+   KillIndex - returns Index to free storage.
+*)
+
+PROCEDURE KillIndex (i: Index) : Index ;
+
+
+(*
+   DebugIndex - turns on debugging within an index.
+*)
+
+PROCEDURE DebugIndex (i: Index) : Index ;
+
+
+(*
+   InBounds - returns TRUE if indice, n, is within the bounds
+              of the dynamic array.
+*)
+
+PROCEDURE InBounds (i: Index; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   HighIndice - returns the last legally accessible indice of this array.
+*)
+
+PROCEDURE HighIndice (i: Index) : CARDINAL ;
+
+
+(*
+   LowIndice - returns the first legally accessible indice of this array.
+*)
+
+PROCEDURE LowIndice (i: Index) : CARDINAL ;
+
+
+(*
+   PutIndice - places, a, into the dynamic array at position i[n]
+*)
+
+PROCEDURE PutIndice (i: Index; n: CARDINAL; a: ADDRESS) ;
+
+
+(*
+   GetIndice - retrieves, element i[n] from the dynamic array.
+*)
+
+PROCEDURE GetIndice (i: Index; n: CARDINAL) : ADDRESS ;
+
+
+(*
+   IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*)
+
+PROCEDURE IsIndiceInIndex (i: Index; a: ADDRESS) : BOOLEAN ;
+
+
+(*
+   RemoveIndiceFromIndex - removes, a, from Index, i.
+*)
+
+PROCEDURE RemoveIndiceFromIndex (i: Index; a: ADDRESS) ;
+
+
+(*
+   DeleteIndice - delete i[j] from the array.
+*)
+
+PROCEDURE DeleteIndice (i: Index; j: CARDINAL) ;
+
+
+(*
+   IncludeIndiceIntoIndex - if the indice is not in the index, then
+                            add it at the end.
+*)
+
+PROCEDURE IncludeIndiceIntoIndex (i: Index; a: ADDRESS) ;
+
+
+(*
+   ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*)
+
+PROCEDURE ForeachIndiceInIndexDo (i: Index; p: IndexProcedure) ;
+
+
+END Indexing.
diff --git a/gcc/m2/mc/Indexing.mod b/gcc/m2/mc/Indexing.mod
new file mode 100644
index 00000000000..3124b119ac9
--- /dev/null
+++ b/gcc/m2/mc/Indexing.mod
@@ -0,0 +1,343 @@
+(* Indexing provides a dynamic array of pointers.
+   Copyright (C) 2015-2022 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. *)
+
+IMPLEMENTATION MODULE Indexing ;
+
+FROM libc IMPORT memset, memmove ;
+FROM Storage IMPORT ALLOCATE, REALLOCATE, DEALLOCATE ;
+FROM SYSTEM IMPORT TSIZE, ADDRESS, WORD, BYTE ;
+FROM mcDebug IMPORT assert ;
+
+CONST
+   MinSize = 128 ;
+
+TYPE
+   PtrToAddress = POINTER TO ADDRESS ;
+   PtrToByte    = POINTER TO BYTE ;
+
+   Index = POINTER TO RECORD
+                         ArrayStart: ADDRESS ;
+                         ArraySize : CARDINAL ;
+                         Used,
+                         Low,
+                         High      : CARDINAL ;
+                         Debug     : BOOLEAN ;
+                         Map       : BITSET ;
+                      END ;
+
+(*
+   InitIndex - creates and returns an Index.
+*)
+
+PROCEDURE InitIndex (low: CARDINAL) : Index ;
+VAR
+   i: Index ;
+BEGIN
+   NEW(i) ;
+   WITH i^ DO
+      Low := low ;
+      High := 0 ;
+      ArraySize := MinSize ;
+      ALLOCATE(ArrayStart, MinSize) ;
+      ArrayStart := memset(ArrayStart, 0, ArraySize) ;
+      Debug := FALSE ;
+      Used := 0 ;
+      Map := BITSET{}
+   END ;
+   RETURN( i )
+END InitIndex ;
+
+
+(*
+   KillIndex - returns Index to free storage.
+*)
+
+PROCEDURE KillIndex (i: Index) : Index ;
+BEGIN
+   WITH i^ DO
+      DEALLOCATE(ArrayStart, ArraySize)
+   END ;
+   DISPOSE(i) ;
+   RETURN( NIL )
+END KillIndex ;
+
+
+(*
+   DebugIndex - turns on debugging within an index.
+*)
+
+PROCEDURE DebugIndex (i: Index) : Index ;
+BEGIN
+   i^.Debug := TRUE ;
+   RETURN( i )
+END DebugIndex ;
+
+
+(*
+   InBounds - returns TRUE if indice, n, is within the bounds
+              of the dynamic array.
+*)
+
+PROCEDURE InBounds (i: Index; n: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF i=NIL
+   THEN
+      HALT
+   ELSE
+      WITH i^ DO
+         RETURN( (n>=Low) AND (n<=High) )
+      END
+   END
+END InBounds ;
+
+
+(*
+   HighIndice - returns the last legally accessible indice of this array.
+*)
+
+PROCEDURE HighIndice (i: Index) : CARDINAL ;
+BEGIN
+   IF i=NIL
+   THEN
+      HALT
+   ELSE
+      RETURN( i^.High )
+   END
+END HighIndice ;
+
+
+(*
+   LowIndice - returns the first legally accessible indice of this array.
+*)
+
+PROCEDURE LowIndice (i: Index) : CARDINAL ;
+BEGIN
+   IF i=NIL
+   THEN
+      HALT
+   ELSE
+      RETURN( i^.Low )
+   END
+END LowIndice ;
+
+
+(*
+   PutIndice - places, a, into the dynamic array at position i[n]
+*)
+
+PROCEDURE PutIndice (i: Index; n: CARDINAL; a: ADDRESS) ;
+VAR
+   oldSize: CARDINAL ;
+   b      : ADDRESS ;
+   p      : POINTER TO POINTER TO WORD ;
+BEGIN
+   WITH i^ DO
+      IF NOT InBounds(i, n)
+      THEN
+         IF n<Low
+         THEN
+            HALT
+         ELSE
+            oldSize := ArraySize ;
+            WHILE (n-Low)*TSIZE(ADDRESS)>=ArraySize DO
+               ArraySize := ArraySize * 2
+            END ;
+            IF oldSize#ArraySize
+            THEN
+(*
+               IF Debug
+               THEN
+                  printf2('increasing memory hunk from %d to %d\n',
+                          oldSize, ArraySize)
+               END ;
+*)
+               REALLOCATE(ArrayStart, ArraySize) ;
+               (* and initialize the remainder of the array to NIL *)
+               b := ArrayStart ;
+               INC(b, oldSize) ;
+               b := memset(b, 0, ArraySize-oldSize)
+            END ;
+            High := n
+         END
+      END ;
+      b := ArrayStart ;
+      INC(b, (n-Low)*TSIZE(ADDRESS)) ;
+      p := b;
+      p^ := a ;
+      INC(Used) ;
+      IF Debug
+      THEN
+         IF n<32
+         THEN
+            INCL(Map, n)
+         END
+      END
+   END
+END PutIndice ;
+
+
+(*
+   GetIndice - retrieves, element i[n] from the dynamic array.
+*)
+
+PROCEDURE GetIndice (i: Index; n: CARDINAL) : ADDRESS ;
+VAR
+   b: PtrToByte ;
+   p: PtrToAddress ;
+BEGIN
+   WITH i^ DO
+      IF NOT InBounds(i, n)
+      THEN
+         HALT
+      END ;
+      b := ArrayStart ;
+      INC(b, (n-Low)*TSIZE(ADDRESS)) ;
+      p := VAL(PtrToAddress, b) ;
+      IF Debug
+      THEN
+         IF (n<32) AND (NOT (n IN Map)) AND (p^#NIL)
+         THEN
+            HALT
+         END
+      END ;
+      RETURN( p^ )
+   END
+END GetIndice ;
+
+
+(*
+   IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*)
+
+PROCEDURE IsIndiceInIndex (i: Index; a: ADDRESS) : BOOLEAN ;
+VAR
+   j: CARDINAL ;
+   b: PtrToByte ;
+   p: PtrToAddress ;
+BEGIN
+   WITH i^ DO
+      j := Low ;
+      b := ArrayStart ;
+      WHILE j<=High DO
+         p := VAL(PtrToAddress, b) ;
+         IF p^=a
+         THEN
+            RETURN( TRUE )
+         END ;
+         (* we must not INC(p, ..) as p2c gets confused *)
+         INC(b, TSIZE(ADDRESS)) ;
+         INC(j)
+      END
+   END ;
+   RETURN( FALSE )
+END IsIndiceInIndex ;
+
+
+(*
+   RemoveIndiceFromIndex - removes, a, from Index, i.
+*)
+
+PROCEDURE RemoveIndiceFromIndex (i: Index; a: ADDRESS) ;
+VAR
+   j, k: CARDINAL ;
+   p   : PtrToAddress ;
+   b   : PtrToByte ;
+BEGIN
+   WITH i^ DO
+      j := Low ;
+      b := ArrayStart ;
+      WHILE j<=High DO
+         p := VAL(PtrToAddress, b) ;
+         INC(b, TSIZE(ADDRESS)) ;
+         IF p^=a
+         THEN
+            DeleteIndice(i, j)
+         END ;
+         INC(j)
+      END
+   END
+END RemoveIndiceFromIndex ;
+
+
+(*
+   DeleteIndice - delete i[j] from the array.
+*)
+
+PROCEDURE DeleteIndice (i: Index; j: CARDINAL) ;
+VAR
+   p: PtrToAddress ;
+   b: PtrToByte ;
+BEGIN
+   WITH i^ DO
+      IF InBounds(i, j)
+      THEN
+         b := ArrayStart ;
+         INC(b, TSIZE(ADDRESS)*(j-Low)) ;
+         p := VAL(PtrToAddress, b) ;
+         INC(b, TSIZE(ADDRESS)) ;
+         p := memmove(p, b, (High-j)*TSIZE(ADDRESS)) ;
+         DEC(High) ;
+         DEC(Used)
+      ELSE
+         HALT
+      END
+   END
+END DeleteIndice ;
+
+
+(*
+   IncludeIndiceIntoIndex - if the indice is not in the index, then
+                            add it at the end.
+*)
+
+PROCEDURE IncludeIndiceIntoIndex (i: Index; a: ADDRESS) ;
+BEGIN
+   IF NOT IsIndiceInIndex(i, a)
+   THEN
+      IF i^.Used=0
+      THEN
+         PutIndice(i, LowIndice(i), a)
+      ELSE
+         PutIndice(i, HighIndice(i)+1, a)
+      END
+   END
+END IncludeIndiceIntoIndex ;
+
+
+(*
+   ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*)
+
+PROCEDURE ForeachIndiceInIndexDo (i: Index; p: IndexProcedure) ;
+VAR
+   j: CARDINAL ;
+   q: IndexProcedure ;
+BEGIN
+   j := LowIndice (i) ;
+   q := p ;
+   WHILE j <= HighIndice (i) DO
+      assert (q = p) ;
+      p (GetIndice (i, j)) ;
+      INC (j)
+   END
+END ForeachIndiceInIndexDo ;
+
+
+END Indexing.
diff --git a/gcc/m2/mc/README b/gcc/m2/mc/README
new file mode 100644
index 00000000000..ec1933dfc39
--- /dev/null
+++ b/gcc/m2/mc/README
@@ -0,0 +1,65 @@
+In this directory is the source to the bootstrap tool mc.  The tool
+converts PIM4 Modula-2 into C or C++ and it implements some of the GNU
+Modula-2 extensions.  It uses the same lexical and grammar as GNU
+Modula-2, but restricts some of the features.
+
+Local modules are not supported and constant aggregate types are not
+supported (with the exception of SET constant aggregate types).  It
+has the ability to translate Modula-2 into C/C++, it uses the same
+name space convension as GNU Modula-2 and it issues source file
+directives in the target language which match the original source.
+
+The tool mc uses multiple passes primarily to keep the implementation
+simple.  The function of each pass is defined here:
+
+Pass 1
+   define module symbols (def, imp, program, local) and find their source
+   files if appropriate.
+   parse definition modules and any extended opaque implementation module
+   and the implementation/program module.
+   define root decls for all CONST, TYPE, PROCEDURE, VAR, symbols
+   (the left hand side for all declarations).
+   push and pop scope symbols as the source is parsed.
+   populate the export lists for the def modules
+
+Pass 2
+   parse definition modules and any extended opaque implementation module
+   and the implementation/program module.
+     complete declaration of the right hand side of TYPE:
+       equivalence:  TYPE foo = bar ;
+       equivalence:  TYPE foo = bar.x ;
+       enumerations: TYPE foo = (a, b, c) ;
+     completely define enumeration types and place them into
+     a per module list of enumerations.
+
+Pass 3
+   parse definition modules and any extended opaque implementation module
+   and the implementation/program module.
+      process the import lists for the def
+      introducing the symbol from another modules export list.
+        remembering to populate the enum and all fields if they are imported.
+      mark any opaque type (in the definition module).
+      create placeholders for expression and constexpression
+        and put these into a list.
+      complete const/type/var/procedure declarations (using
+        expression placeholders).
+
+Pass 4
+   parse definition modules and any extended opaque implementation module
+   and the implementation/program module.
+     build expressions and constexpressions
+     and attach them to their placeholders.
+   at this point all definition module symbols are completely finished.
+   at this point const/types should be completely declared for the
+   implementation/program module
+
+Pass 5
+   only parse the implementation or program module
+   build a tree for all procedure and main init code.
+   build expressions and constexpressions
+   and attach them to their placeholders.
+
+for each exported symbol, s
+   topological sort and define s
+
+topological sort and define init code
diff --git a/gcc/m2/mc/alists.def b/gcc/m2/mc/alists.def
new file mode 100644
index 00000000000..0f0ee3fb53b
--- /dev/null
+++ b/gcc/m2/mc/alists.def
@@ -0,0 +1,112 @@
+(* alists.def address lists module.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE alists ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   alist ;
+   performOperation = PROCEDURE (ADDRESS) ;
+
+
+(*
+   initList - creates a new alist, l.
+*)
+
+PROCEDURE initList () : alist ;
+
+
+(*
+   killList - deletes the complete alist, l.
+*)
+
+PROCEDURE killList (VAR l: alist) ;
+
+
+(*
+   putItemIntoList - places an ADDRESS, c, into alist, l.
+*)
+
+PROCEDURE putItemIntoList (l: alist; c: ADDRESS) ;
+
+
+(*
+   getItemFromList - retrieves the nth ADDRESS from alist, l.
+*)
+
+PROCEDURE getItemFromList (l: alist; n: CARDINAL) : ADDRESS ;
+
+
+(*
+   getIndexOfList - returns the index for ADDRESS, c, in alist, l.
+                    If more than one CARDINAL, c, exists the index
+                    for the first is returned.
+*)
+
+PROCEDURE getIndexOfList (l: alist; c: ADDRESS) : CARDINAL ;
+
+
+(*
+   noOfItemsInList - returns the number of items in alist, l.
+*)
+
+PROCEDURE noOfItemsInList (l: alist) : CARDINAL ;
+
+
+(*
+   includeItemIntoList - adds an ADDRESS, c, into a alist providing
+                         the value does not already exist.
+*)
+
+PROCEDURE includeItemIntoList (l: alist; c: ADDRESS) ;
+
+
+(*
+   removeItemFromList - removes an ADDRESS, c, from a alist.
+                        It assumes that this value only appears once.
+*)
+
+PROCEDURE removeItemFromList (l: alist; c: ADDRESS) ;
+
+
+(*
+   isItemInList - returns true if a ADDRESS, c, was found in alist, l.
+*)
+
+PROCEDURE isItemInList (l: alist; c: ADDRESS) : BOOLEAN ;
+
+
+(*
+   foreachItemInListDo - calls procedure, P, foreach item in alist, l.
+*)
+
+PROCEDURE foreachItemInListDo (l: alist; p: performOperation) ;
+
+
+(*
+   duplicateList - returns a duplicate alist derived from, l.
+*)
+
+PROCEDURE duplicateList (l: alist) : alist ;
+
+
+END alists.
diff --git a/gcc/m2/mc/alists.mod b/gcc/m2/mc/alists.mod
new file mode 100644
index 00000000000..a65a73c138b
--- /dev/null
+++ b/gcc/m2/mc/alists.mod
@@ -0,0 +1,305 @@
+(* alists.mod address lists module.
+
+Copyright (C) 2015-2022 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 alists ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+CONST
+   MaxnoOfelements = 5 ;
+
+TYPE
+   alist = POINTER TO RECORD
+              noOfelements: CARDINAL ;
+              elements    : ARRAY [1..MaxnoOfelements] OF ADDRESS ;
+              next        : alist ;
+           END ;
+
+
+(*
+   initList - creates a new alist, l.
+*)
+
+PROCEDURE initList () : alist ;
+VAR
+   l: alist ;
+BEGIN
+   NEW (l) ;
+   WITH l^ DO
+      noOfelements := 0 ;
+      next := NIL
+   END ;
+   RETURN l
+END initList ;
+
+
+(*
+   killList - deletes the complete alist, l.
+*)
+
+PROCEDURE killList (VAR l: alist) ;
+BEGIN
+   IF l#NIL
+   THEN
+      IF l^.next#NIL
+      THEN
+         killList (l^.next)
+      END ;
+      DISPOSE (l)
+   END
+END killList ;
+
+
+(*
+   putItemIntoList - places an ADDRESS, c, into alist, l.
+*)
+
+PROCEDURE putItemIntoList (l: alist; c: ADDRESS) ;
+BEGIN
+   WITH l^ DO
+      IF noOfelements<MaxnoOfelements
+      THEN
+         INC (noOfelements) ;
+         elements[noOfelements] := c
+      ELSIF next#NIL
+      THEN
+         putItemIntoList (next, c)
+      ELSE
+         next := initList () ;
+         putItemIntoList (next, c)
+      END
+   END
+END putItemIntoList ;
+
+
+(*
+   getItemFromList - retrieves the nth WORD from alist, l.
+*)
+
+PROCEDURE getItemFromList (l: alist; n: CARDINAL) : ADDRESS ;
+BEGIN
+   WHILE l#NIL DO
+      WITH l^ DO
+         IF n<=noOfelements
+         THEN
+            RETURN elements[n]
+         ELSE
+            DEC (n, noOfelements)
+         END
+      END ;
+      l := l^.next
+   END ;
+   RETURN 0
+END getItemFromList ;
+
+
+(*
+   getIndexOfList - returns the index for WORD, c, in alist, l.
+                    If more than one WORD, c, exists the index
+                    for the first is returned.
+*)
+
+PROCEDURE getIndexOfList (l: alist; c: ADDRESS) : CARDINAL ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN 0
+   ELSE
+      WITH l^ DO
+         i := 1 ;
+         WHILE i<=noOfelements DO
+            IF elements[i]=c
+            THEN
+               RETURN i
+            ELSE
+               INC(i)
+            END
+         END ;
+         RETURN noOfelements + getIndexOfList (next, c)
+      END
+   END
+END getIndexOfList ;
+
+
+(*
+   noOfItemsInList - returns the number of items in alist, l.
+*)
+
+PROCEDURE noOfItemsInList (l: alist) : CARDINAL ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN 0
+   ELSE
+      t := 0 ;
+      REPEAT
+         WITH l^ DO
+            INC (t, noOfelements)
+         END ;
+         l := l^.next
+      UNTIL l=NIL;
+      RETURN t
+   END
+END noOfItemsInList ;
+
+
+(*
+   includeItemIntoList - adds an ADDRESS, c, into a alist providing
+                         the value does not already exist.
+*)
+
+PROCEDURE includeItemIntoList (l: alist; c: ADDRESS) ;
+BEGIN
+   IF NOT isItemInList (l, c)
+   THEN
+      putItemIntoList (l, c)
+   END
+END includeItemIntoList ;
+
+
+(*
+   removeItem - remove an element at index, i, from the alist data type.
+*)
+
+PROCEDURE removeItem (p, l: alist; i: CARDINAL) ;
+BEGIN
+   WITH l^ DO
+      DEC (noOfelements) ;
+      WHILE i<=noOfelements DO
+         elements[i] := elements[i+1] ;
+         INC (i)
+      END ;
+      IF (noOfelements=0) AND (p#NIL)
+      THEN
+         p^.next := l^.next ;
+         DISPOSE (l)
+      END
+   END
+END removeItem ;
+
+
+(*
+   removeItemFromList - removes a ADDRESS, c, from a alist.
+                        It assumes that this value only appears once.
+*)
+
+PROCEDURE removeItemFromList (l: alist; c: ADDRESS) ;
+VAR
+   p    : alist ;
+   i    : CARDINAL ;
+   found: BOOLEAN ;
+BEGIN
+   IF l#NIL
+   THEN
+      found := FALSE ;
+      p := NIL ;
+      REPEAT
+         WITH l^ DO
+            i := 1 ;
+            WHILE (i<=noOfelements) AND (elements[i]#c) DO
+               INC (i)
+            END ;
+         END ;
+         IF (i<=l^.noOfelements) AND (l^.elements[i]=c)
+         THEN
+            found := TRUE
+         ELSE
+            p := l ;
+            l := l^.next
+         END
+      UNTIL (l=NIL) OR found ;
+      IF found
+      THEN
+         removeItem (p, l, i)
+      END
+   END
+END removeItemFromList ;
+
+
+(*
+   isItemInList - returns true if a ADDRESS, c, was found in alist, l.
+*)
+
+PROCEDURE isItemInList (l: alist; c: ADDRESS) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   REPEAT
+      WITH l^ DO
+         i := 1 ;
+         WHILE i<=noOfelements DO
+            IF elements[i]=c
+            THEN
+               RETURN TRUE
+            ELSE
+               INC (i)
+            END
+         END
+      END ;
+      l := l^.next
+   UNTIL l=NIL ;
+   RETURN FALSE
+END isItemInList ;
+
+
+(*
+   foreachItemInListDo - calls procedure, P, foreach item in alist, l.
+*)
+
+PROCEDURE foreachItemInListDo (l: alist; p: performOperation) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   n := noOfItemsInList(l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      p (getItemFromList (l, i)) ;
+      INC(i)
+   END
+END foreachItemInListDo ;
+
+
+(*
+   duplicateList - returns a duplicate alist derived from, l.
+*)
+
+PROCEDURE duplicateList (l: alist) : alist ;
+VAR
+   m   : alist ;
+   n, i: CARDINAL ;
+BEGIN
+   m := initList () ;
+   n := noOfItemsInList (l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      putItemIntoList (m, getItemFromList (l, i)) ;
+      INC (i)
+   END ;
+   RETURN m
+END duplicateList ;
+
+
+END alists.
diff --git a/gcc/m2/mc/decl.def b/gcc/m2/mc/decl.def
new file mode 100644
index 00000000000..820312bbc5a
--- /dev/null
+++ b/gcc/m2/mc/decl.def
@@ -0,0 +1,1442 @@
+(* decl.def declaration nodes used to create the AST.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE decl ; (*!m2pim*)
+
+FROM nameKey IMPORT Name ;
+FROM symbolKey IMPORT performOperation ;
+FROM mcReserved IMPORT toktype ;
+FROM mcComment IMPORT commentDesc ;
+
+TYPE
+   node ;
+   isNodeF = PROCEDURE (node) : BOOLEAN ;
+
+
+(*
+   getDeclaredMod - returns the token number associated with the nodes declaration
+                    in the implementation or program module.
+*)
+
+PROCEDURE getDeclaredMod (n: node) : CARDINAL ;
+
+
+(*
+   getDeclaredDef - returns the token number associated with the nodes declaration
+                    in the definition module.
+*)
+
+PROCEDURE getDeclaredDef (n: node) : CARDINAL ;
+
+
+(*
+   getFirstUsed - returns the token number associated with the first use of
+                  node, n.
+*)
+
+PROCEDURE getFirstUsed (n: node) : CARDINAL ;
+
+
+(*
+   isDef - return TRUE if node, n, is a definition module.
+*)
+
+PROCEDURE isDef (n: node) : BOOLEAN ;
+
+
+(*
+   isImp - return TRUE if node, n, is an implementation module.
+*)
+
+PROCEDURE isImp (n: node) : BOOLEAN ;
+
+
+(*
+   isImpOrModule - returns TRUE if, n, is a program module or implementation module.
+*)
+
+PROCEDURE isImpOrModule (n: node) : BOOLEAN ;
+
+
+(*
+   isVisited - returns TRUE if the node was visited.
+*)
+
+PROCEDURE isVisited (n: node) : BOOLEAN ;
+
+
+(*
+   unsetVisited - unset the visited flag on a def/imp/module node.
+*)
+
+PROCEDURE unsetVisited (n: node) ;
+
+
+(*
+   setVisited - set the visited flag on a def/imp/module node.
+*)
+
+PROCEDURE setVisited (n: node) ;
+
+
+(*
+   setEnumsComplete - sets the field inside the def or imp or module, n.
+*)
+
+PROCEDURE setEnumsComplete (n: node) ;
+
+
+(*
+   getEnumsComplete - gets the field from the def or imp or module, n.
+*)
+
+PROCEDURE getEnumsComplete (n: node) : BOOLEAN ;
+
+
+(*
+   resetEnumPos - resets the index into the saved list of enums inside
+                  module, n.
+*)
+
+PROCEDURE resetEnumPos (n: node) ;
+
+
+(*
+   getNextEnum - returns the next enumeration node.
+*)
+
+PROCEDURE getNextEnum () : node ;
+
+
+(*
+   isModule - return TRUE if node, n, is a program module.
+*)
+
+PROCEDURE isModule (n: node) : BOOLEAN ;
+
+
+(*
+   isMainModule - return TRUE if node, n, is the main module specified
+                  by the source file.  This might be a definition,
+                  implementation or program module.
+*)
+
+PROCEDURE isMainModule (n: node) : BOOLEAN ;
+
+
+(*
+   setMainModule - sets node, n, as the main module to be compiled.
+*)
+
+PROCEDURE setMainModule (n: node) ;
+
+
+(*
+   setCurrentModule - sets node, n, as the current module being compiled.
+*)
+
+PROCEDURE setCurrentModule (n: node) ;
+
+
+(*
+   lookupDef - returns a definition module node named, n.
+*)
+
+PROCEDURE lookupDef (n: Name) : node ;
+
+
+(*
+   lookupImp - returns an implementation module node named, n.
+*)
+
+PROCEDURE lookupImp (n: Name) : node ;
+
+
+(*
+   lookupModule - returns a module node named, n.
+*)
+
+PROCEDURE lookupModule (n: Name) : node ;
+
+
+(*
+   putDefForC - the definition module was defined FOR "C".
+*)
+
+PROCEDURE putDefForC (n: node) ;
+
+
+(*
+   lookupInScope - looks up a symbol named, n, from, scope.
+*)
+
+PROCEDURE lookupInScope (scope: node; n: Name) : node ;
+
+
+(*
+   isConst - returns TRUE if node, n, is a const.
+*)
+
+PROCEDURE isConst (n: node) : BOOLEAN ;
+
+
+(*
+   isType - returns TRUE if node, n, is a type.
+*)
+
+PROCEDURE isType (n: node) : BOOLEAN ;
+
+
+(*
+   putType - places, exp, as the type alias to des.
+             TYPE des = exp ;
+*)
+
+PROCEDURE putType (des, exp: node) ;
+
+
+(*
+   getType - returns the type associated with node, n.
+*)
+
+PROCEDURE getType (n: node) : node ;
+
+
+(*
+   skipType - skips over type aliases.
+*)
+
+PROCEDURE skipType (n: node) : node ;
+
+
+(*
+   putTypeHidden - marks type, des, as being a hidden type.
+                   TYPE des ;
+*)
+
+PROCEDURE putTypeHidden (des: node) ;
+
+
+(*
+   isTypeHidden - returns TRUE if type, n, is hidden.
+*)
+
+PROCEDURE isTypeHidden (n: node) : BOOLEAN ;
+
+
+(*
+   hasHidden - returns TRUE if module, n, has a hidden type.
+*)
+
+PROCEDURE hasHidden (n: node) : BOOLEAN ;
+
+
+(*
+   isVar - returns TRUE if node, n, is a type.
+*)
+
+PROCEDURE isVar (n: node) : BOOLEAN ;
+
+
+(*
+   isTemporary - returns TRUE if node, n, is a variable and temporary.
+*)
+
+PROCEDURE isTemporary (n: node) : BOOLEAN ;
+
+
+(*
+   isExported - returns TRUE if symbol, n, is exported from
+                the definition module.
+*)
+
+PROCEDURE isExported (n: node) : BOOLEAN ;
+
+
+(*
+   getDeclScope - returns the node representing the
+                  current declaration scope.
+*)
+
+PROCEDURE getDeclScope () : node ;
+
+
+(*
+   getScope - returns the scope associated with node, n.
+*)
+
+PROCEDURE getScope (n: node) : node ;
+
+
+(*
+   isLiteral - returns TRUE if, n, is a literal.
+*)
+
+PROCEDURE isLiteral (n: node) : BOOLEAN ;
+
+
+(*
+   isConstSet - returns TRUE if, n, is a constant set.
+*)
+
+PROCEDURE isConstSet (n: node) : BOOLEAN ;
+
+
+(*
+   isEnumerationField - returns TRUE if, n, is an enumeration field.
+*)
+
+PROCEDURE isEnumerationField (n: node) : BOOLEAN ;
+
+
+(*
+   isEnumeration - returns TRUE if node, n, is an enumeration type.
+*)
+
+PROCEDURE isEnumeration (n: node) : BOOLEAN ;
+
+
+(*
+   isUnbounded - returns TRUE if, n, is an unbounded array.
+*)
+
+PROCEDURE isUnbounded (n: node) : BOOLEAN ;
+
+
+(*
+   isParameter - returns TRUE if, n, is a parameter.
+*)
+
+PROCEDURE isParameter (n: node) : BOOLEAN ;
+
+
+(*
+   isVarParam - returns TRUE if, n, is a var parameter.
+*)
+
+PROCEDURE isVarParam (n: node) : BOOLEAN ;
+
+
+(*
+   isParam - returns TRUE if, n, is a non var parameter.
+*)
+
+PROCEDURE isParam (n: node) : BOOLEAN ;
+
+
+(*
+   isNonVarParam - is an alias to isParam.
+*)
+
+PROCEDURE isNonVarParam (n: node) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE addOptParameter (proc: node; id: Name; type, init: node) : node ;
+
+
+(*
+   isOptarg - returns TRUE if, n, is an optarg.
+*)
+
+PROCEDURE isOptarg (n: node) : BOOLEAN ;
+
+
+(*
+   isRecord - returns TRUE if, n, is a record.
+*)
+
+PROCEDURE isRecord (n: node) : BOOLEAN ;
+
+
+(*
+   isRecordField - returns TRUE if, n, is a record field.
+*)
+
+PROCEDURE isRecordField (n: node) : BOOLEAN ;
+
+
+(*
+   isVarientField - returns TRUE if, n, is a varient field.
+*)
+
+PROCEDURE isVarientField (n: node) : BOOLEAN ;
+
+
+(*
+   isArray - returns TRUE if, n, is an array.
+*)
+
+PROCEDURE isArray (n: node) : BOOLEAN ;
+
+
+(*
+   isProcType - returns TRUE if, n, is a procedure type.
+*)
+
+PROCEDURE isProcType (n: node) : BOOLEAN ;
+
+
+(*
+   isPointer - returns TRUE if, n, is a pointer.
+*)
+
+PROCEDURE isPointer (n: node) : BOOLEAN ;
+
+
+(*
+   isProcedure - returns TRUE if, n, is a procedure.
+*)
+
+PROCEDURE isProcedure (n: node) : BOOLEAN ;
+
+
+(*
+   isVarient - returns TRUE if, n, is a varient record.
+*)
+
+PROCEDURE isVarient (n: node) : BOOLEAN ;
+
+
+(*
+   isSet - returns TRUE if, n, is a set type.
+*)
+
+PROCEDURE isSet (n: node) : BOOLEAN ;
+
+
+(*
+   isSubrange - returns TRUE if, n, is a subrange type.
+*)
+
+PROCEDURE isSubrange (n: node) : BOOLEAN ;
+
+
+(*
+   isZtype - returns TRUE if, n, is the Z type.
+*)
+
+PROCEDURE isZtype (n: node) : BOOLEAN ;
+
+
+(*
+   isRtype - returns TRUE if, n, is the R type.
+*)
+
+PROCEDURE isRtype (n: node) : BOOLEAN ;
+
+
+(*
+   makeConst - create, initialise and return a const node.
+*)
+
+PROCEDURE makeConst (n: Name) : node ;
+
+
+(*
+   putConst - places value, v, into node, n.
+*)
+
+PROCEDURE putConst (n: node; v: node) ;
+
+
+(*
+   makeType - create, initialise and return a type node.
+*)
+
+PROCEDURE makeType (n: Name) : node ;
+
+
+(*
+   makeTypeImp - lookup a type in the definition module
+                 and return it.  Otherwise create a new type.
+*)
+
+PROCEDURE makeTypeImp (n: Name) : node ;
+
+
+(*
+   makeVar - create, initialise and return a var node.
+*)
+
+PROCEDURE makeVar (n: Name) : node ;
+
+
+(*
+   putVar - places, type, as the type for var.
+*)
+
+PROCEDURE putVar (var, type, decl: node) ;
+
+
+(*
+   makeVarDecl - creates a variable declaration list from
+                 identlist, i, and, type, in the current scope.
+*)
+
+PROCEDURE makeVarDecl (i: node; type: node) : node ;
+
+
+(*
+   makeEnum - creates an enumerated type and returns the node.
+*)
+
+PROCEDURE makeEnum () : node ;
+
+
+(*
+   makeEnumField - returns an enumeration field, named, n.
+*)
+
+PROCEDURE makeEnumField (e: node; n: Name) : node ;
+
+
+(*
+   makeSubrange - returns a subrange node, built from range: low..high.
+*)
+
+PROCEDURE makeSubrange (low, high: node) : node ;
+
+
+(*
+   putSubrangeType - assigns, type, to the subrange type, sub.
+*)
+
+PROCEDURE putSubrangeType (sub, type: node) ;
+
+
+(*
+   makePointer - returns a pointer of, type, node.
+*)
+
+PROCEDURE makePointer (type: node) : node ;
+
+
+(*
+   makeSet - returns a set of, type, node.
+*)
+
+PROCEDURE makeSet (type: node) : node ;
+
+
+(*
+   makeArray - returns a node representing ARRAY subrange OF type.
+*)
+
+PROCEDURE makeArray (subr, type: node) : node ;
+
+
+(*
+   putUnbounded - sets array, n, as unbounded.
+*)
+
+PROCEDURE putUnbounded (n: node) ;
+
+
+(*
+   makeRecord - creates and returns a record node.
+*)
+
+PROCEDURE makeRecord () : node ;
+
+
+(*
+   makeVarient - creates a new symbol, a varient symbol for record or varient field
+                 symbol, r.
+*)
+
+PROCEDURE makeVarient (r: node) : node ;
+
+
+(*
+   addFieldsToRecord - adds fields, i, of type, t, into a record, r.
+                       It returns, r.
+*)
+
+PROCEDURE addFieldsToRecord (r, v, i, t: node) : node ;
+
+
+(*
+   buildVarientSelector - builds a field of name, tag, of, type, t, varient, r.
+*)
+
+PROCEDURE buildVarientSelector (r, v: node; tag: Name; type: node) ;
+
+
+(*
+   buildVarientFieldRecord - builds a varient field into a varient symbol, v.
+                             The varient field is returned.
+*)
+
+PROCEDURE buildVarientFieldRecord (v: node; p: node) : node ;
+
+
+(*
+   getSymName - returns the name of symbol, n.
+*)
+
+PROCEDURE getSymName (n: node) : Name ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE import (m, n: node) : node ;
+
+
+(*
+   lookupExported - attempts to lookup a node named, i, from definition
+                    module, n.  The node is returned if found.
+                    NIL is returned if not found.
+*)
+
+PROCEDURE lookupExported (n: node; i: Name) : node ;
+
+
+(*
+   lookupSym - returns the symbol named, n, from the scope stack.
+*)
+
+PROCEDURE lookupSym (n: Name) : node ;
+
+
+(*
+   addImportedModule - add module, i, to be imported by, m.
+                       If scoped then module, i, is added to the
+                       module, m, scope.
+*)
+
+PROCEDURE addImportedModule (m, i: node; scoped: BOOLEAN) ;
+
+
+(*
+   setSource - sets the source filename for module, n, to s.
+*)
+
+PROCEDURE setSource (n: node; s: Name) ;
+
+
+(*
+   getSource - returns the source filename for module, n.
+*)
+
+PROCEDURE getSource (n: node) : Name ;
+
+
+(*
+   getMainModule - returns the main module node.
+*)
+
+PROCEDURE getMainModule () : node ;
+
+
+(*
+   getCurrentModule - returns the current module being compiled.
+*)
+
+PROCEDURE getCurrentModule () : node ;
+
+
+(*
+   foreachDefModuleDo - foreach definition node, n, in the module universe,
+                        call p (n).
+*)
+
+PROCEDURE foreachDefModuleDo (p: performOperation) ;
+
+
+(*
+   foreachModModuleDo - foreach implementation or module node, n, in the module universe,
+                        call p (n).
+*)
+
+PROCEDURE foreachModModuleDo (p: performOperation) ;
+
+
+(*
+   enterScope - pushes symbol, n, to the scope stack.
+*)
+
+PROCEDURE enterScope (n: node) ;
+
+
+(*
+   leaveScope - removes the top level scope and all enumeration transparent scopes.
+*)
+
+PROCEDURE leaveScope ;
+
+
+(*
+   makeProcedure - create, initialise and return a procedure node.
+*)
+
+PROCEDURE makeProcedure (n: Name) : node ;
+
+
+(*
+   putCommentDefProcedure - remembers the procedure comment (if it exists) as a
+                            definition module procedure heading.  NIL is placed
+                            if there is no procedure comment available.
+*)
+
+PROCEDURE putCommentDefProcedure (n: node) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE putCommentModProcedure (n: node) ;
+
+
+(*
+   makeProcType - returns a proctype node.
+*)
+
+PROCEDURE makeProcType () : node ;
+
+
+(*
+   putReturnType - sets the return type of procedure or proctype, proc, to, type.
+*)
+
+PROCEDURE putReturnType (proc, type: node) ;
+
+
+(*
+   putOptReturn - sets, proctype or procedure, proc, to have an optional return type.
+*)
+
+PROCEDURE putOptReturn (proc: node) ;
+
+
+(*
+   makeVarParameter - returns a var parameter node with namelist and type.
+                      Where the parameters are declared as l: type.
+*)
+
+PROCEDURE makeVarParameter (l: node; type, proc: node; isused: BOOLEAN) : node ;
+
+
+(*
+   makeNonVarParameter - returns a non var parameter node with namelist and type.
+                         Where the parameters are declared as l: type.
+*)
+
+PROCEDURE makeNonVarParameter (l: node; type, proc: node; isused: BOOLEAN) : node ;
+
+
+(*
+   paramEnter - reset the parameter count.
+*)
+
+PROCEDURE paramEnter (n: node) ;
+
+
+(*
+   paramLeave - set paramater checking to TRUE from now onwards.
+*)
+
+PROCEDURE paramLeave (n: node) ;
+
+
+(*
+   makeIdentList - returns a node which will be used to maintain an ident list.
+*)
+
+PROCEDURE makeIdentList () : node ;
+
+
+(*
+   putIdent - places ident, i, into identlist, n.
+*)
+
+PROCEDURE putIdent (n: node; i: Name) : BOOLEAN ;
+
+
+(*
+   addVarParameters - adds the identlist, i, of, type, to be VAR parameters
+                      in procedure, n.
+*)
+
+PROCEDURE addVarParameters (n: node; i: node; type: node; isused: BOOLEAN) ;
+
+
+(*
+   addNonVarParameters - adds the identlist, i, of, type, to be parameters
+                         in procedure, n.
+*)
+
+PROCEDURE addNonVarParameters (n: node; i: node; type: node; isused: BOOLEAN) ;
+
+
+(*
+   makeVarargs - returns a varargs node.
+*)
+
+PROCEDURE makeVarargs () : node ;
+
+
+(*
+   isVarargs - returns TRUE if, n, is a varargs node.
+*)
+
+PROCEDURE isVarargs (n: node) : BOOLEAN ;
+
+
+(*
+   addParameter - adds a parameter, param, to procedure or proctype, proc.
+*)
+
+PROCEDURE addParameter (proc, param: node) ;
+
+
+(*
+   makeBinaryTok - creates and returns a boolean type node with,
+                   l, and, r, nodes.
+*)
+
+PROCEDURE makeBinaryTok (op: toktype; l, r: node) : node ;
+
+
+(*
+   makeUnaryTok - creates and returns a boolean type node with,
+                  e, node.
+*)
+
+PROCEDURE makeUnaryTok (op: toktype; e: node) : node ;
+
+
+(*
+   makeComponentRef - build a componentref node which accesses, field,
+                      within, record, rec.
+*)
+
+PROCEDURE makeComponentRef (rec, field: node) : node ;
+
+
+(*
+   makePointerRef - build a pointerref node which accesses, field,
+                    within, pointer to record, ptr.
+*)
+
+PROCEDURE makePointerRef (ptr, field: node) : node ;
+
+
+(*
+   isPointerRef - returns TRUE if, n, is a pointerref node.
+*)
+
+PROCEDURE isPointerRef (n: node) : BOOLEAN ;
+
+
+(*
+   makeDeRef - dereferences the pointer defined by, n.
+*)
+
+PROCEDURE makeDeRef (n: node) : node ;
+
+
+(*
+   makeArrayRef - build an arrayref node which access element,
+                  index, in, array.  array is a variable/expression/constant
+                  which has a type array.
+*)
+
+PROCEDURE makeArrayRef (array, index: node) : node ;
+
+
+(*
+   getLastOp - return the right most non leaf node.
+*)
+
+PROCEDURE getLastOp (n: node) : node ;
+
+
+(*
+   getCardinal - returns the cardinal type node.
+*)
+
+PROCEDURE getCardinal () : node ;
+
+
+(*
+   makeLiteralInt - creates and returns a literal node based on an integer type.
+*)
+
+PROCEDURE makeLiteralInt (n: Name) : node ;
+
+
+(*
+   makeLiteralReal - creates and returns a literal node based on a real type.
+*)
+
+PROCEDURE makeLiteralReal (n: Name) : node ;
+
+
+(*
+   makeString - creates and returns a node containing string, n.
+*)
+
+PROCEDURE makeString (n: Name) : node ;
+
+
+(*
+   makeSetValue - creates and returns a setvalue node.
+*)
+
+PROCEDURE makeSetValue () : node ;
+
+
+(*
+   isSetValue - returns TRUE if, n, is a setvalue node.
+*)
+
+PROCEDURE isSetValue (n: node) : BOOLEAN ;
+
+
+(*
+   putSetValue - assigns the type, t, to the set value, n.  The
+                 node, n, is returned.
+*)
+
+PROCEDURE putSetValue (n, t: node) : node ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE includeSetValue (n: node; l, h: node) : node ;
+
+
+(*
+   getBuiltinConst - creates and returns a builtin const if available.
+*)
+
+PROCEDURE getBuiltinConst (n: Name) : node ;
+
+
+(*
+   makeExpList - creates and returns an expList node.
+*)
+
+PROCEDURE makeExpList () : node ;
+
+
+(*
+   isExpList - returns TRUE if, n, is an explist node.
+*)
+
+PROCEDURE isExpList (n: node) : BOOLEAN ;
+
+
+(*
+   putExpList - places, expression, e, within the explist, n.
+*)
+
+PROCEDURE putExpList (n: node; e: node) ;
+
+
+(*
+   makeConstExp - returns a constexp node.
+*)
+
+PROCEDURE makeConstExp () : node ;
+
+
+(*
+   getNextConstExp - returns the next constexp node.
+*)
+
+PROCEDURE getNextConstExp () : node ;
+
+
+(*
+   setConstExpComplete - sets the field inside the def or imp or module, n.
+*)
+
+PROCEDURE setConstExpComplete (n: node) ;
+
+
+(*
+   fixupConstExp - assign fixup expression, e, into the argument of, c.
+*)
+
+PROCEDURE fixupConstExp (c, e: node) : node ;
+
+
+(*
+   resetConstExpPos - resets the index into the saved list of constexps inside
+                      module, n.
+*)
+
+PROCEDURE resetConstExpPos (n: node) ;
+
+
+(*
+   makeFuncCall - builds a function call to c with param list, n.
+*)
+
+PROCEDURE makeFuncCall (c, n: node) : node ;
+
+
+(*
+   makeStatementSequence - create and return a statement sequence node.
+*)
+
+PROCEDURE makeStatementSequence () : node ;
+
+
+(*
+   isStatementSequence - returns TRUE if node, n, is a statement sequence.
+*)
+
+PROCEDURE isStatementSequence (n: node) : BOOLEAN ;
+
+
+(*
+   addStatement - adds node, n, as a statement to statememt sequence, s.
+*)
+
+PROCEDURE addStatement (s: node; n: node) ;
+
+
+(*
+   addCommentBody - adds a body comment to a statement sequence node.
+*)
+
+PROCEDURE addCommentBody (n: node) ;
+
+
+(*
+   addCommentAfter - adds an after comment to a statement sequence node.
+*)
+
+PROCEDURE addCommentAfter (n: node) ;
+
+
+(*
+   addIfComments - adds the, body, and, after, comments to if node, n.
+*)
+
+PROCEDURE addIfComments (n: node; body, after: node) ;
+
+
+(*
+   addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n.
+*)
+
+PROCEDURE addElseComments (n: node; body, after: node) ;
+
+
+(*
+   addIfEndComments - adds the, body, and, after, comments to an, if, node, n.
+*)
+
+PROCEDURE addIfEndComments (n: node; body, after: node) ;
+
+
+(*
+   makeReturn - creates and returns a return node.
+*)
+
+PROCEDURE makeReturn () : node ;
+
+
+(*
+   isReturn - returns TRUE if node, n, is a return.
+*)
+
+PROCEDURE isReturn (n: node) : BOOLEAN ;
+
+
+(*
+   putReturn - assigns node, e, as the expression on the return node.
+*)
+
+PROCEDURE putReturn (n: node; e: node) ;
+
+
+(*
+   makeWhile - creates and returns a while node.
+*)
+
+PROCEDURE makeWhile () : node ;
+
+
+(*
+   putWhile - places an expression, e, and statement sequence, s, into the while
+              node, n.
+*)
+
+PROCEDURE putWhile (n: node; e, s: node) ;
+
+
+(*
+   isWhile - returns TRUE if node, n, is a while.
+*)
+
+PROCEDURE isWhile (n: node) : BOOLEAN ;
+
+
+(*
+   addWhileDoComment - adds body and after comments to while node, w.
+*)
+
+PROCEDURE addWhileDoComment (w: node; body, after: node) ;
+
+
+(*
+   addWhileEndComment - adds body and after comments to the end of a while node, w.
+*)
+
+PROCEDURE addWhileEndComment (w: node; body, after: node) ;
+
+
+(*
+   makeAssignment - creates and returns an assignment node.
+                    The designator is, d, and expression, e.
+*)
+
+PROCEDURE makeAssignment (d, e: node) : node ;
+
+
+(*
+   putBegin - assigns statements, s, to be the normal part in
+              block, b.  The block may be a procedure or module,
+              or implementation node.
+*)
+
+PROCEDURE putBegin (b: node; s: node) ;
+
+
+(*
+   putFinally - assigns statements, s, to be the final part in
+                block, b.  The block may be a module
+                or implementation node.
+*)
+
+PROCEDURE putFinally (b: node; s: node) ;
+
+
+(*
+   makeExit - creates and returns an exit node.
+*)
+
+PROCEDURE makeExit (l: node; n: CARDINAL) : node ;
+
+
+(*
+   isExit - returns TRUE if node, n, is an exit.
+*)
+
+PROCEDURE isExit (n: node) : BOOLEAN ;
+
+
+(*
+   makeLoop - creates and returns a loop node.
+*)
+
+PROCEDURE makeLoop () : node ;
+
+
+(*
+   isLoop - returns TRUE if, n, is a loop node.
+*)
+
+PROCEDURE isLoop (n: node) : BOOLEAN ;
+
+
+(*
+   putLoop - places statement sequence, s, into loop, l.
+*)
+
+PROCEDURE putLoop (l, s: node) ;
+
+
+(*
+   makeComment - creates and returns a comment node.
+*)
+
+PROCEDURE makeComment (a: ARRAY OF CHAR) : node ;
+
+
+(*
+   makeCommentS - creates and returns a comment node.
+*)
+
+PROCEDURE makeCommentS (c: commentDesc) : node ;
+
+
+(*
+   makeIf - creates and returns an if node.  The if node
+            will have expression, e, and statement sequence, s,
+            as the then component.
+*)
+
+PROCEDURE makeIf (e, s: node) : node ;
+
+
+(*
+   isIf - returns TRUE if, n, is an if node.
+*)
+
+PROCEDURE isIf (n: node) : BOOLEAN ;
+
+
+(*
+   makeElsif - creates and returns an elsif node.
+               This node has an expression, e, and statement
+               sequence, s.
+*)
+
+PROCEDURE makeElsif (i, e, s: node) : node ;
+
+
+(*
+   isElsif - returns TRUE if node, n, is an elsif node.
+*)
+
+PROCEDURE isElsif (n: node) : BOOLEAN ;
+
+
+(*
+   putElse - the else is grafted onto the if/elsif node, i,
+             and the statement sequence will be, s.
+*)
+
+PROCEDURE putElse (i, s: node) ;
+
+
+(*
+   makeFor - creates and returns a for node.
+*)
+
+PROCEDURE makeFor () : node ;
+
+
+(*
+   isFor - returns TRUE if node, n, is a for node.
+*)
+
+PROCEDURE isFor (n: node) : BOOLEAN ;
+
+
+(*
+   putFor - assigns the fields of the for node with
+            ident, i,
+            start, s,
+            end, e,
+            increment, i,
+            statements, sq.
+*)
+
+PROCEDURE putFor (f, i, s, e, b, sq: node) ;
+
+
+(*
+   makeRepeat - creates and returns a repeat node.
+*)
+
+PROCEDURE makeRepeat () : node ;
+
+
+(*
+   isRepeat - returns TRUE if node, n, is a repeat node.
+*)
+
+PROCEDURE isRepeat (n: node) : BOOLEAN ;
+
+
+(*
+   putRepeat - places statements, s, and expression, e, into
+               repeat statement, n.
+*)
+
+PROCEDURE putRepeat (n, s, e: node) ;
+
+
+(*
+   addRepeatComment - adds body and after comments to repeat node, r.
+*)
+
+PROCEDURE addRepeatComment (r: node; body, after: node) ;
+
+
+(*
+   addUntilComment - adds body and after comments to the until section of a repeat node, r.
+*)
+
+PROCEDURE addUntilComment (r: node; body, after: node) ;
+
+
+(*
+   makeCase - builds and returns a case statement node.
+*)
+
+PROCEDURE makeCase () : node ;
+
+
+(*
+   isCase - returns TRUE if node, n, is a case statement.
+*)
+
+PROCEDURE isCase (n: node) : BOOLEAN ;
+
+
+(*
+   putCaseExpression - places expression, e, into case statement, n.
+                       n is returned.
+*)
+
+PROCEDURE putCaseExpression (n: node; e: node) : node ;
+
+
+(*
+   putCaseElse - places else statement, e, into case statement, n.
+                 n is returned.
+*)
+
+PROCEDURE putCaseElse (n: node; e: node) : node ;
+
+
+(*
+   putCaseStatement - places a caselist, l, and associated
+                      statement sequence, s, into case statement, n.
+                      n is returned.
+*)
+
+PROCEDURE putCaseStatement (n: node; l: node; s: node) : node ;
+
+
+(*
+   makeCaseLabelList - creates and returns a caselabellist node.
+*)
+
+PROCEDURE makeCaseLabelList (l, s: node) : node ;
+
+
+(*
+   isCaseLabelList - returns TRUE if, n, is a caselabellist.
+*)
+
+PROCEDURE isCaseLabelList (n: node) : BOOLEAN ;
+
+
+(*
+   makeCaseList - creates and returns a case statement node.
+*)
+
+PROCEDURE makeCaseList () : node ;
+
+
+(*
+   isCaseList - returns TRUE if, n, is a case list.
+*)
+
+PROCEDURE isCaseList (n: node) : BOOLEAN ;
+
+
+(*
+   putCaseRange - places the case range lo..hi into caselist, n.
+*)
+
+PROCEDURE putCaseRange (n: node; lo, hi: node) : node ;
+
+
+(*
+   makeRange - creates and returns a case range.
+*)
+
+PROCEDURE makeRange (lo, hi: node) : node ;
+
+
+(*
+   isRange - returns TRUE if node, n, is a range.
+*)
+
+PROCEDURE isRange (n: node) : BOOLEAN ;
+
+
+(*
+   setNoReturn - sets noreturn field inside procedure.
+*)
+
+PROCEDURE setNoReturn (n: node; value: BOOLEAN) ;
+
+
+(*
+   dupExpr - duplicate the expression nodes, it does not duplicate
+             variables, literals, constants but only the expression
+             operators (including function calls and parameter lists).
+*)
+
+PROCEDURE dupExpr (n: node) : node ;
+
+
+(*
+   setLangC - set the target language as ansi C.
+*)
+
+PROCEDURE setLangC ;
+
+
+(*
+   setLangCP - set the target language as C++.
+*)
+
+PROCEDURE setLangCP ;
+
+
+(*
+   setLangM2 - set the target language as Modula-2.
+*)
+
+PROCEDURE setLangM2 ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE out ;
+
+
+END decl.
diff --git a/gcc/m2/mc/decl.mod b/gcc/m2/mc/decl.mod
new file mode 100644
index 00000000000..b0bf5eba1d3
--- /dev/null
+++ b/gcc/m2/mc/decl.mod
@@ -0,0 +1,16953 @@
+(* decl.mod declaration nodes used to create the AST.
+
+Copyright (C) 2015-2022 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 decl ; (*!m2pim*)
+
+FROM ASCII IMPORT lf, tab ;
+FROM symbolKey IMPORT symbolTree, initTree, getSymKey, putSymKey, foreachNodeDo ;
+FROM mcDebug IMPORT assert ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM nameKey IMPORT NulName, makeKey, lengthKey, makekey, keyToCharStar ;
+FROM SFIO IMPORT OpenToWrite, WriteS ;
+FROM FIO IMPORT File, Close, FlushBuffer, StdOut, WriteLine, WriteChar ;
+FROM DynamicStrings IMPORT String, InitString, EqualArray, InitStringCharStar, KillString, ConCat, Mark, RemoveWhitePostfix, RemoveWhitePrefix ;
+FROM StringConvert IMPORT CardinalToString, ostoc ;
+FROM mcOptions IMPORT getOutputFile, getDebugTopological, getHPrefix, getIgnoreFQ, getExtendedOpaque, writeGPLheader, getGccConfigSystem, getScaffoldDynamic, getScaffoldMain ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ;
+FROM libc IMPORT printf, memset ;
+FROM mcMetaError IMPORT metaError1, metaError2, metaError3, metaErrors1, metaErrors2 ;
+FROM mcError IMPORT errorAbort0, flushErrors ;
+
+FROM mcLexBuf IMPORT findFileNameFromToken, tokenToLineNo, tokenToColumnNo,
+                     getProcedureComment, getBodyComment, getAfterComment,
+		     lastcomment ;
+
+FROM mcComment IMPORT commentDesc, isProcedureComment, isAfterComment, isBodyComment, getContent, initComment, addText ;
+
+FROM StrLib IMPORT StrEqual, StrLen ;
+
+FROM mcPretty IMPORT pretty, initPretty, dupPretty, killPretty, print, prints, raw,
+                     setNeedSpace, noSpace, setindent, getindent, getcurpos,
+		     getseekpos, getcurline,
+		     pushPretty, popPretty ;
+
+FROM Indexing IMPORT Index, InitIndex, ForeachIndiceInIndexDo,
+                     IncludeIndiceIntoIndex, IsIndiceInIndex,
+		     HighIndice, LowIndice, GetIndice, RemoveIndiceFromIndex,
+		     PutIndice, InBounds ;
+
+IMPORT DynamicStrings ;
+IMPORT alists, wlists ;
+IMPORT keyc ;
+IMPORT mcStream ;
+
+FROM alists IMPORT alist ;
+FROM wlists IMPORT wlist ;
+
+
+CONST
+   indentation     = 3 ;
+   indentationC    = 2 ;
+   debugScopes     = FALSE ;
+   debugDecl       = FALSE ;
+   caseException   = TRUE ;
+   returnException = TRUE ;
+   (* this is a work around to avoid ever having to handle dangling else.  *)
+   forceCompoundStatement = TRUE ;    (* TRUE will avoid dangling else, by always using {}.  *)
+   enableDefForCStrings   = FALSE ;   (* currently disabled.  *)
+   enableMemsetOnAllocation = TRUE ;  (* Should we memset (..., 0, ...) the allocated mem?  *)
+   forceQualified  = TRUE ;
+
+TYPE
+   language = (ansiC, ansiCP, pim4) ;
+
+   nodeT = (explist, funccall,
+            exit, return, stmtseq, comment, halt,
+            new, dispose, inc, dec, incl, excl,
+	    length,
+            (* base constants.  *)
+	    nil, true, false,
+            (* system types.  *)
+   	    address, loc, byte, word,
+            csizet, cssizet,
+            (* base types.  *)
+	    char,
+	    cardinal, longcard, shortcard,
+            integer, longint, shortint,
+	    real, longreal, shortreal,
+	    bitset, boolean, proc,
+	    ztype, rtype,
+	    complex, longcomplex, shortcomplex,
+	    (* language features and compound type attributes.  *)
+            type, record, varient, var, enumeration,
+            subrange, array, subscript,
+            string, const, literal, varparam, param, varargs, optarg,
+	    pointer, recordfield, varientfield, enumerationfield,
+            set, proctype,
+	    (* blocks.  *)
+	    procedure, def, imp, module,
+	    (* statements.  *)
+            loop, while, for, repeat,
+	    case, caselabellist, caselist, range,
+	    assignment,
+	    if, elsif,
+	    (* expressions.  *)
+	    constexp,
+	    neg,
+	    cast, val,
+	    plus, sub, div, mod, mult, divide, in,
+	    adr, size, tsize, ord, float, trunc, chr, abs, cap,
+	    high, throw, unreachable,
+	    cmplx, re, im,
+	    min, max,
+            componentref, pointerref, arrayref, deref,
+	    equal, notequal, less, greater, greequal, lessequal,
+	    lsl, lsr, lor, land, lnot, lxor,
+	    and, or, not, identlist, vardecl, setvalue) ;
+
+    node = POINTER TO nodeRec ;
+
+    nodeRec =         RECORD
+                         CASE kind: nodeT OF
+
+                         unreachable,
+			 throw,
+                         new,
+                         dispose,
+                         inc,
+                         dec,
+                         incl,
+                         excl,
+                         halt            : intrinsicF: intrinsicT |
+			 explist         : explistF: explistT |
+                         exit            : exitF   : exitT |
+			 return          : returnF : returnT |
+			 stmtseq         : stmtF   : stmtT |
+			 comment         : commentF: commentT |
+                         (* base constants.  *)
+                         nil,
+			 true,
+			 false,
+			 (* system types.  *)
+                         address,
+			 loc,
+                         byte,
+			 word,
+                         csizet,
+                         cssizet         : |
+                         (* base types.  *)
+			 boolean,
+ 			 proc,
+                         char,
+                         integer,
+                         cardinal,
+                         longcard,
+                         shortcard,
+                         longint,
+                         shortint,
+                         real,
+                         longreal,
+			 shortreal,
+                         bitset,
+                         ztype,
+                         rtype,
+			 complex,
+			 longcomplex,
+			 shortcomplex    :  |
+                         (* language features and compound type attributes.  *)
+                         type            :  typeF            : typeT |
+                         record          :  recordF          : recordT |
+                         varient         :  varientF         : varientT |
+                         var             :  varF             : varT |
+                         enumeration     :  enumerationF     : enumerationT |
+                         subrange        :  subrangeF        : subrangeT |
+                         subscript       :  subscriptF       : subscriptT |
+                         array           :  arrayF           : arrayT |
+                         string          :  stringF          : stringT |
+                         const           :  constF           : constT |
+                         literal         :  literalF         : literalT |
+			 varparam        :  varparamF        : varparamT |
+                         param           :  paramF           : paramT |
+			 varargs         :  varargsF         : varargsT |
+			 optarg          :  optargF          : optargT |
+			 pointer         :  pointerF         : pointerT |
+                         recordfield     :  recordfieldF     : recordfieldT |
+			 varientfield    :  varientfieldF    : varientfieldT |
+			 enumerationfield:  enumerationfieldF: enumerationfieldT |
+                         set             :  setF             : setT |
+			 proctype        :  proctypeF        : proctypeT |
+                         (* blocks.  *)
+                         procedure       :  procedureF       : procedureT |
+                         def             :  defF             : defT |
+			 imp             :  impF             : impT |
+			 module          :  moduleF          : moduleT |
+                         (* statements.  *)
+                         loop            :  loopF            : loopT |
+                         while           :  whileF           : whileT |
+                         for             :  forF             : forT |
+                         repeat          :  repeatF          : repeatT |
+			 case            :  caseF            : caseT |
+                         caselabellist   :  caselabellistF   : caselabellistT |
+			 caselist        :  caselistF        : caselistT |
+			 range           :  rangeF           : rangeT |
+                         if              :  ifF              : ifT |
+                         elsif           :  elsifF           : elsifT |
+			 assignment      :  assignmentF      : assignmentT |
+                         (* expressions.  *)
+ 			 arrayref        :  arrayrefF        : arrayrefT |
+                         pointerref      :  pointerrefF      : pointerrefT |
+                         componentref    :  componentrefF    : componentrefT |
+			 cmplx,
+			 and,
+			 or,
+                         equal,
+                         notequal,
+			 less,
+			 greater,
+			 greequal,
+			 lessequal,
+                         val,
+                         cast,
+                         plus,
+                         sub,
+                         div,
+			 mod,
+			 mult,
+			 divide,
+			 in              :  binaryF          : binaryT |
+			 constexp,
+			 deref,
+			 abs,
+			 chr,
+			 cap,
+                         high,
+                         ord,
+			 float,
+			 trunc,
+			 re,
+			 im,
+			 not,
+			 neg,
+                         adr,
+                         size,
+			 tsize,
+			 min,
+			 max             :  unaryF           : unaryT |
+			 identlist       :  identlistF       : identlistT |
+			 vardecl         :  vardeclF         : vardeclT |
+                         funccall        :  funccallF        : funccallT |
+			 setvalue        :  setvalueF        : setvalueT
+
+                         END ;
+                         at: where ;
+                      END ;
+
+       intrinsicT = RECORD
+                       args            : node ;
+                       noArgs          : CARDINAL ;
+                       type            : node ;
+                       intrinsicComment: commentPair ;
+                       postUnreachable : BOOLEAN ;
+                    END ;
+
+       fixupInfo = RECORD
+                      count: CARDINAL ;
+                      info : Index ;
+                   END ;
+
+       explistT = RECORD
+                     exp:  Index ;
+                  END ;
+
+       setvalueT = RECORD
+                      type:  node ;
+		      values:  Index ;
+                   END ;
+
+       identlistT = RECORD
+                       names : wlist ;
+		       cnamed: BOOLEAN ;
+                    END ;
+
+       funccallT = RECORD
+                      function       : node ;
+		      args           : node ;
+		      type           : node ;
+		      funccallComment: commentPair ;
+                   END ;
+
+       commentT = RECORD
+                     content:  commentDesc ;
+                  END ;
+
+       stmtT = RECORD
+                  statements:  Index ;
+               END ;
+
+       returnT = RECORD
+                    exp          : node ;
+                    scope        : node ;
+		    returnComment: commentPair ;
+                 END ;
+
+       exitT = RECORD
+                  loop:  node ;
+               END ;
+
+       vardeclT = RECORD
+                     names:  wlist ;
+		     type :  node ;
+		     scope:  node ;
+                  END ;
+
+       typeT = RECORD
+                  name      :  Name ;
+		  type      :  node ;
+		  scope     :  node ;
+		  isHidden,
+		  isInternal:  BOOLEAN ;
+               END ;
+
+       recordT = RECORD
+		    localSymbols:  symbolTree ;
+                    listOfSons  :  Index ;
+		    scope       :  node ;
+                 END ;
+
+       varientT = RECORD
+		     listOfSons:  Index ;
+		     varient   :  node ;
+		     tag       :  node ;
+		     scope     :  node ;
+                  END ;
+
+       varT = RECORD
+                 name          :  Name ;
+		 type          :  node ;
+		 decl          :  node ;
+		 scope         :  node ;
+		 isInitialised,
+		 isParameter,
+		 isVarParameter,
+                 isUsed        :  BOOLEAN ;
+                 cname         :  cnameT ;
+              END ;
+
+       enumerationT = RECORD
+			 noOfElements: CARDINAL ;
+                         localSymbols: symbolTree ;
+			 listOfSons  : Index ;
+                         low, high   : node ;
+			 scope       : node ;
+                      END ;
+
+       subrangeT = RECORD
+		      low,
+		      high :  node ;
+		      type :  node ;
+		      scope:  node ;
+                   END ;
+
+       subscriptT = RECORD
+                       type:  node ;
+		       expr:  node ;
+                    END ;
+
+       arrayT = RECORD
+		   subr       :  node ;
+		   type,
+		   scope      :  node ;
+		   isUnbounded:  BOOLEAN ;
+                END ;
+
+       stringT = RECORD
+                    name            :  Name ;
+		    length          :  CARDINAL ;
+		    isCharCompatible:  BOOLEAN ;
+		    cstring         :  String ;
+		    clength         :  CARDINAL ;
+		    cchar           :  String ;
+                 END ;
+
+       literalT = RECORD
+                     name :  Name ;
+		     type :  node ;
+                  END ;
+
+       constT = RECORD
+                   name :  Name ;
+		   type :  node ;
+                   value:  node ;
+                   scope:  node ;
+                END ;
+
+       varparamT = RECORD
+                      namelist   :  node ;
+                      type       :  node ;
+		      scope      :  node ;
+                      isUnbounded:  BOOLEAN ;
+                      isForC     :  BOOLEAN ;
+                      isUsed     :  BOOLEAN ;
+                   END ;
+
+       paramT = RECORD
+                   namelist   :  node ;
+                   type       :  node ;
+                   scope      :  node ;
+                   isUnbounded:  BOOLEAN ;
+                   isForC     :  BOOLEAN ;
+                   isUsed     :  BOOLEAN ;
+                END ;
+
+       varargsT = RECORD
+                     scope    :  node ;
+                  END ;
+
+       optargT = RECORD
+                    namelist  :  node ;
+		    type      :  node ;
+		    scope     :  node ;
+		    init      :  node ;
+                 END ;
+
+       pointerT = RECORD
+                     type :  node ;
+                     scope:  node ;
+                  END ;
+
+       recordfieldT = RECORD
+                         name   :  Name ;
+			 type   :  node ;
+			 tag    :  BOOLEAN ;
+			 parent :  node ;
+			 varient:  node ;
+			 scope  :  node ;
+			 cname  :  cnameT ;
+                      END ;
+
+       varientfieldT = RECORD
+                          name      :  Name ;
+			  parent    :  node ;
+			  varient   :  node ;
+                          simple    :  BOOLEAN ;
+			  listOfSons:  Index ;
+			  scope     :  node ;
+                       END ;
+
+       enumerationfieldT = RECORD
+                              name :  Name ;
+                              type :  node ;
+			      scope:  node ;
+                              value:  CARDINAL ;
+                              cname:  cnameT ;
+                           END ;
+
+       setT = RECORD
+                 type :  node ;
+                 scope:  node ;
+              END ;
+
+       componentrefT = RECORD
+                          rec       :  node ;
+                          field     :  node ;
+                          resultType:  node ;
+                       END ;
+
+       pointerrefT = RECORD
+                        ptr       :  node ;
+                        field     :  node ;
+                        resultType:  node ;
+                     END ;
+
+       arrayrefT = RECORD
+                      array     :  node ;
+                      index     :  node ;
+                      resultType:  node ;
+                   END ;
+
+       commentPair = RECORD
+			after,
+                        body :  node ;
+                     END ;
+
+       assignmentT = RECORD
+                        des,
+                        expr         :  node ;
+			assignComment: commentPair ;
+                     END ;
+
+       ifT = RECORD
+                expr,
+                elsif,      (* either else or elsif must be NIL.  *)
+                then,
+                else        :  node ;
+		ifComment,
+		elseComment,  (* used for else or elsif *)
+		endComment  : commentPair ;
+             END ;
+
+       elsifT = RECORD
+                   expr,
+                   elsif,     (* either else or elsif must be NIL.  *)
+                   then,
+                   else       :  node ;
+                   elseComment:  commentPair ;  (* used for else or elsif *)
+                END ;
+
+       loopT = RECORD
+                  statements:  node ;
+		  labelno   :  CARDINAL ;  (* 0 means no label.  *)
+               END ;
+
+       whileT = RECORD
+                   expr,
+                   statements:  node ;
+                   doComment,
+                   endComment:  commentPair ;
+                END ;
+
+       repeatT = RECORD
+                    expr,
+                    statements   :  node ;
+                    repeatComment,
+		    untilComment :  commentPair ;
+                 END ;
+
+       caseT = RECORD
+                  expression   :  node ;
+                  caseLabelList:  Index ;
+		  else         :  node ;
+               END ;
+
+       caselabellistT = RECORD
+                           caseList  :  node ;
+			   statements:  node ;
+                        END ;
+
+       caselistT = RECORD
+                      rangePairs:  Index ;
+                   END ;
+
+       rangeT = RECORD
+                   lo,
+                   hi:  node ;
+                END ;
+
+       forT = RECORD
+                 des,
+                 start,
+		 end,
+                 increment,
+                 statements:  node ;
+              END ;
+
+       statementT = RECORD
+                       sequence:  Index ;
+                    END ;
+
+       scopeT = RECORD
+                   symbols   :  symbolTree ;
+                   constants,
+                   types,
+		   procedures,
+                   variables :  Index ;
+                END ;
+
+       procedureT = RECORD
+                       name           :  Name ;
+                       decls          :  scopeT ;
+                       scope          :  node ;
+                       parameters     :  Index ;
+                       isForC,
+		       built,
+		       checking,
+                       returnopt,
+		       vararg,
+		       noreturnused,
+		       noreturn       :  BOOLEAN ;
+		       paramcount     :  CARDINAL ;
+                       optarg         :  node ;
+		       returnType     :  node ;
+                       beginStatements:  node ;
+                       cname          :  cnameT ;
+		       defComment,
+		       modComment     :  commentDesc ;
+                    END ;
+
+       proctypeT = RECORD
+                      parameters:  Index ;
+                      returnopt,
+                      vararg    :  BOOLEAN ;
+                      optarg    :  node ;
+		      scope     :  node ;
+                      returnType:  node ;
+                   END ;
+
+       binaryT = RECORD
+                    left,
+		    right,
+                    resultType:  node ;
+                 END ;
+
+       unaryT = RECORD
+                   arg,
+                   resultType:  node ;
+                END ;
+
+       moduleT = RECORD
+                    name             :  Name ;
+                    source           :  Name ;
+                    importedModules  :  Index ;
+                    constFixup,
+                    enumFixup        :  fixupInfo ;
+                    decls            :  scopeT ;
+                    beginStatements,
+                    finallyStatements:  node ;
+                    enumsComplete,
+		    constsComplete,
+		    visited          :  BOOLEAN ;
+                    com              :  commentPair ;
+                 END ;
+
+       defT = RECORD
+                 name             :  Name ;
+                 source           :  Name ;
+		 hasHidden,
+                 forC             :  BOOLEAN ;
+                 exported,
+                 importedModules  :  Index ;
+                 constFixup,
+                 enumFixup        :  fixupInfo ;
+                 decls            :  scopeT ;
+		 enumsComplete,
+                 constsComplete,
+                 visited          :  BOOLEAN ;
+                 com              :  commentPair ;
+              END ;
+
+       impT = RECORD
+                 name             :  Name ;
+                 source           :  Name ;
+                 importedModules  :  Index ;
+                 constFixup,
+                 enumFixup        :  fixupInfo ;
+                 beginStatements,
+                 finallyStatements:  node ;
+		 definitionModule :  node ;
+                 decls            :  scopeT ;
+                 enumsComplete,
+                 constsComplete,
+                 visited          :  BOOLEAN ;
+                 com              :  commentPair ;
+              END ;
+
+       where = RECORD
+                  defDeclared,
+                  modDeclared,
+                  firstUsed  :  CARDINAL ;
+               END ;
+
+       outputStates = (text, punct, space) ;
+
+       nodeProcedure = PROCEDURE (node) ;
+
+       dependentState = (completed, blocked, partial, recursive) ;
+
+       cnameT = RECORD
+                   name :  Name ;
+                   init :  BOOLEAN ;
+                END ;
+
+VAR
+   outputFile    : File ;
+   lang          : language ;
+   bitsperunitN,
+   bitsperwordN,
+   bitspercharN,
+   unitsperwordN,
+   mainModule,
+   currentModule,
+   defModule,
+   systemN,
+   addressN,
+   locN,
+   byteN,
+   wordN,
+   csizetN,
+   cssizetN,
+   adrN,
+   sizeN,
+   tsizeN,
+   newN,
+   disposeN,
+   lengthN,
+   incN,
+   decN,
+   inclN,
+   exclN,
+   highN,
+   m2rtsN,
+   haltN,
+   throwN,
+   chrN,
+   capN,
+   absN,
+   floatN,
+   truncN,
+   ordN,
+   valN,
+   minN,
+   maxN,
+   booleanN,
+   procN,
+   charN,
+   integerN,
+   cardinalN,
+   longcardN,
+   shortcardN,
+   longintN,
+   shortintN,
+   bitsetN,
+   bitnumN,
+   ztypeN,
+   rtypeN,
+   complexN,
+   longcomplexN,
+   shortcomplexN,
+   cmplxN,
+   reN,
+   imN,
+   realN,
+   longrealN,
+   shortrealN,
+   nilN,
+   trueN,
+   falseN        : node ;
+   scopeStack,
+   defUniverseI,
+   modUniverseI  : Index ;
+   modUniverse,
+   defUniverse   : symbolTree ;
+   baseSymbols   : symbolTree ;
+   outputState   : outputStates ;
+   doP           : pretty ;
+   todoQ,
+   partialQ,
+   doneQ         : alist ;
+   mustVisitScope,
+   simplified    : BOOLEAN ;
+   tempCount     : CARDINAL ;
+
+
+(*
+   newNode - create and return a new node of kind k.
+*)
+
+PROCEDURE newNode (k: nodeT) : node ;
+VAR
+   d: node ;
+BEGIN
+   NEW (d) ;
+   IF enableMemsetOnAllocation
+   THEN
+      d := memset (d, 0, SIZE (d^))
+   END ;
+   IF d=NIL
+   THEN
+      HALT
+   ELSE
+      d^.kind := k ;
+      d^.at.defDeclared := 0 ;
+      d^.at.modDeclared := 0 ;
+      d^.at.firstUsed := 0 ;
+      RETURN d
+   END
+END newNode ;
+
+
+(*
+   disposeNode - dispose node, n.
+*)
+
+PROCEDURE disposeNode (VAR n: node) ;
+BEGIN
+   DISPOSE (n) ;
+   n := NIL
+END disposeNode ;
+
+
+(*
+   getDeclaredDef - returns the token number associated with the nodes declaration
+                    in the definition module.
+*)
+
+PROCEDURE getDeclaredDef (n: node) : CARDINAL ;
+BEGIN
+   RETURN n^.at.defDeclared
+END getDeclaredDef ;
+
+
+(*
+   getDeclaredMod - returns the token number associated with the nodes declaration
+                    in the implementation or program module.
+*)
+
+PROCEDURE getDeclaredMod (n: node) : CARDINAL ;
+BEGIN
+   RETURN n^.at.modDeclared
+END getDeclaredMod ;
+
+
+(*
+   getFirstUsed - returns the token number associated with the first use of
+                  node, n.
+*)
+
+PROCEDURE getFirstUsed (n: node) : CARDINAL ;
+BEGIN
+   RETURN n^.at.firstUsed
+END getFirstUsed ;
+
+
+(*
+   setVisited - set the visited flag on a def/imp/module node.
+*)
+
+PROCEDURE setVisited (n: node) ;
+BEGIN
+   CASE n^.kind OF
+
+   def   :  n^.defF.visited := TRUE |
+   imp   :  n^.impF.visited := TRUE |
+   module:  n^.moduleF.visited := TRUE
+
+   END
+END setVisited ;
+
+
+(*
+   unsetVisited - unset the visited flag on a def/imp/module node.
+*)
+
+PROCEDURE unsetVisited (n: node) ;
+BEGIN
+   CASE n^.kind OF
+
+   def   :  n^.defF.visited := FALSE |
+   imp   :  n^.impF.visited := FALSE |
+   module:  n^.moduleF.visited := FALSE
+
+   END
+END unsetVisited ;
+
+
+(*
+   isVisited - returns TRUE if the node was visited.
+*)
+
+PROCEDURE isVisited (n: node) : BOOLEAN ;
+BEGIN
+   CASE n^.kind OF
+
+   def   :  RETURN n^.defF.visited |
+   imp   :  RETURN n^.impF.visited |
+   module:  RETURN n^.moduleF.visited
+
+   END
+END isVisited ;
+
+
+(*
+   isDef - return TRUE if node, n, is a definition module.
+*)
+
+PROCEDURE isDef (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind = def
+END isDef ;
+
+
+(*
+   isImp - return TRUE if node, n, is an implementation module.
+*)
+
+PROCEDURE isImp (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind = imp
+END isImp ;
+
+
+(*
+   isModule - return TRUE if node, n, is a program module.
+*)
+
+PROCEDURE isModule (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind = module
+END isModule ;
+
+
+(*
+   isImpOrModule - returns TRUE if, n, is a program module or implementation module.
+*)
+
+PROCEDURE isImpOrModule (n: node) : BOOLEAN ;
+BEGIN
+   RETURN isImp (n) OR isModule (n)
+END isImpOrModule ;
+
+
+(*
+   isProcedure - returns TRUE if node, n, is a procedure.
+*)
+
+PROCEDURE isProcedure (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind = procedure
+END isProcedure ;
+
+
+(*
+   isConst - returns TRUE if node, n, is a const.
+*)
+
+PROCEDURE isConst (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind = const
+END isConst ;
+
+
+(*
+   isType - returns TRUE if node, n, is a type.
+*)
+
+PROCEDURE isType (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind = type
+END isType ;
+
+
+(*
+   isVar - returns TRUE if node, n, is a type.
+*)
+
+PROCEDURE isVar (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind = var
+END isVar ;
+
+
+(*
+   isTemporary - returns TRUE if node, n, is a variable and temporary.
+*)
+
+PROCEDURE isTemporary (n: node) : BOOLEAN ;
+BEGIN
+   RETURN FALSE
+END isTemporary ;
+
+
+(*
+   isExported - returns TRUE if symbol, n, is exported from
+                the definition module.
+*)
+
+PROCEDURE isExported (n: node) : BOOLEAN ;
+VAR
+   s: node ;
+BEGIN
+   s := getScope (n) ;
+   IF s#NIL
+   THEN
+      CASE s^.kind OF
+
+      def:  RETURN IsIndiceInIndex (s^.defF.exported, n)
+
+      ELSE
+         RETURN FALSE
+      END
+   END ;
+   RETURN FALSE
+END isExported ;
+
+
+(*
+   isLocal - returns TRUE if symbol, n, is locally declared in a procedure.
+*)
+
+PROCEDURE isLocal (n: node) : BOOLEAN ;
+VAR
+   s: node ;
+BEGIN
+   s := getScope (n) ;
+   IF s#NIL
+   THEN
+      RETURN isProcedure (s)
+   END ;
+   RETURN FALSE
+END isLocal ;
+
+
+(*
+   lookupExported - attempts to lookup a node named, i, from definition
+                    module, n.  The node is returned if found.
+                    NIL is returned if not found.
+*)
+
+PROCEDURE lookupExported (n: node; i: Name) : node ;
+VAR
+   r: node ;
+BEGIN
+   assert (isDef (n)) ;
+   r := getSymKey (n^.defF.decls.symbols, i) ;
+   IF (r#NIL) AND isExported (r)
+   THEN
+      RETURN r
+   END ;
+   RETURN NIL
+END lookupExported ;
+
+
+(*
+   importEnumFields - if, n, is an enumeration type import the all fields into module, m.
+*)
+
+PROCEDURE importEnumFields (m, n: node) ;
+VAR
+   r, e: node ;
+   i, h: CARDINAL ;
+BEGIN
+   assert (isDef (m) OR isModule (m) OR isImp (m)) ;
+   n := skipType (n) ;
+   IF (n#NIL) AND isEnumeration (n)
+   THEN
+      i := LowIndice (n^.enumerationF.listOfSons) ;
+      h := HighIndice (n^.enumerationF.listOfSons) ;
+      WHILE i<=h DO
+         e := GetIndice (n^.enumerationF.listOfSons, i) ;
+         r := import (m, e) ;
+         IF e#r
+         THEN
+            metaError2 ('enumeration field {%1ad} cannot be imported implicitly into {%2d} due to a name clash',
+                        e, m)
+         END ;
+         INC (i)
+      END
+   END
+END importEnumFields ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE import (m, n: node) : node ;
+VAR
+   name: Name ;
+   r   : node ;
+BEGIN
+   assert (isDef (m) OR isModule (m) OR isImp (m)) ;
+   name := getSymName (n) ;
+   r := lookupInScope (m, name) ;
+   IF r=NIL
+   THEN
+      CASE m^.kind OF
+
+      def   :  putSymKey (m^.defF.decls.symbols, name, n) |
+      imp   :  putSymKey (m^.impF.decls.symbols, name, n) |
+      module:  putSymKey (m^.moduleF.decls.symbols, name, n)
+
+      END ;
+      importEnumFields (m, n) ;
+      RETURN n
+   END ;
+   RETURN r
+END import ;
+
+
+(*
+   isZtype - returns TRUE if, n, is the Z type.
+*)
+
+PROCEDURE isZtype (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n = ztypeN
+END isZtype ;
+
+
+(*
+   isRtype - returns TRUE if, n, is the R type.
+*)
+
+PROCEDURE isRtype (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n = rtypeN
+END isRtype ;
+
+
+(*
+   isComplex - returns TRUE if, n, is the complex type.
+*)
+
+PROCEDURE isComplex (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n = complexN
+END isComplex ;
+
+
+(*
+   isLongComplex - returns TRUE if, n, is the longcomplex type.
+*)
+
+PROCEDURE isLongComplex (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n = longcomplexN
+END isLongComplex ;
+
+
+(*
+   isShortComplex - returns TRUE if, n, is the shortcomplex type.
+*)
+
+PROCEDURE isShortComplex (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n = shortcomplexN
+END isShortComplex ;
+
+
+(*
+   isLiteral - returns TRUE if, n, is a literal.
+*)
+
+PROCEDURE isLiteral (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = literal
+END isLiteral ;
+
+
+(*
+   isConstSet - returns TRUE if, n, is a constant set.
+*)
+
+PROCEDURE isConstSet (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   IF isLiteral (n) OR isConst (n)
+   THEN
+      RETURN isSet (skipType (getType (n)))
+   END ;
+   RETURN FALSE
+END isConstSet ;
+
+
+(*
+   isEnumerationField - returns TRUE if, n, is an enumeration field.
+*)
+
+PROCEDURE isEnumerationField (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = enumerationfield
+END isEnumerationField ;
+
+
+(*
+   isUnbounded - returns TRUE if, n, is an unbounded array.
+*)
+
+PROCEDURE isUnbounded (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN (n^.kind = array) AND (n^.arrayF.isUnbounded)
+END isUnbounded ;
+
+
+(*
+   isParameter - returns TRUE if, n, is a parameter.
+*)
+
+PROCEDURE isParameter (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN (n^.kind = param) OR (n^.kind = varparam)
+END isParameter ;
+
+
+(*
+   isVarParam - returns TRUE if, n, is a var parameter.
+*)
+
+PROCEDURE isVarParam (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = varparam
+END isVarParam ;
+
+
+(*
+   isParam - returns TRUE if, n, is a non var parameter.
+*)
+
+PROCEDURE isParam (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = param
+END isParam ;
+
+
+(*
+   isNonVarParam - is an alias to isParam.
+*)
+
+PROCEDURE isNonVarParam (n: node) : BOOLEAN ;
+BEGIN
+   RETURN isParam (n)
+END isNonVarParam ;
+
+
+(*
+   isRecord - returns TRUE if, n, is a record.
+*)
+
+PROCEDURE isRecord (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = record
+END isRecord ;
+
+
+(*
+   isRecordField - returns TRUE if, n, is a record field.
+*)
+
+PROCEDURE isRecordField (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = recordfield
+END isRecordField ;
+
+
+(*
+   isArray - returns TRUE if, n, is an array.
+*)
+
+PROCEDURE isArray (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = array
+END isArray ;
+
+
+(*
+   isProcType - returns TRUE if, n, is a procedure type.
+*)
+
+PROCEDURE isProcType (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = proctype
+END isProcType ;
+
+
+(*
+   isAProcType - returns TRUE if, n, is a proctype or proc node.
+*)
+
+PROCEDURE isAProcType (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN isProcType (n) OR (n = procN)
+END isAProcType ;
+
+
+(*
+   isProcedure - returns TRUE if, n, is a procedure.
+*)
+
+PROCEDURE isProcedure (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = procedure
+END isProcedure ;
+
+
+(*
+   isPointer - returns TRUE if, n, is a pointer.
+*)
+
+PROCEDURE isPointer (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = pointer
+END isPointer ;
+
+
+(*
+   isVarient - returns TRUE if, n, is a varient record.
+*)
+
+PROCEDURE isVarient (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = varient
+END isVarient ;
+
+
+(*
+   isVarientField - returns TRUE if, n, is a varient field.
+*)
+
+PROCEDURE isVarientField (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = varientfield
+END isVarientField ;
+
+
+(*
+   isSet - returns TRUE if, n, is a set type.
+*)
+
+PROCEDURE isSet (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = set
+END isSet ;
+
+
+(*
+   isSubrange - returns TRUE if, n, is a subrange type.
+*)
+
+PROCEDURE isSubrange (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = subrange
+END isSubrange ;
+
+
+(*
+   isMainModule - return TRUE if node, n, is the main module specified
+                  by the source file.  This might be a definition,
+                  implementation or program module.
+*)
+
+PROCEDURE isMainModule (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n = mainModule
+END isMainModule ;
+
+
+(*
+   setMainModule - sets node, n, as the main module to be compiled.
+*)
+
+PROCEDURE setMainModule (n: node) ;
+BEGIN
+   assert (n#NIL) ;
+   mainModule := n
+END setMainModule ;
+
+
+(*
+   getMainModule - returns the main module node.
+*)
+
+PROCEDURE getMainModule () : node ;
+BEGIN
+   RETURN mainModule
+END getMainModule ;
+
+
+(*
+   setCurrentModule - sets node, n, as the current module being compiled.
+*)
+
+PROCEDURE setCurrentModule (n: node) ;
+BEGIN
+   assert (n#NIL) ;
+   currentModule := n
+END setCurrentModule ;
+
+
+(*
+   getCurrentModule - returns the current module being compiled.
+*)
+
+PROCEDURE getCurrentModule () : node ;
+BEGIN
+   RETURN currentModule
+END getCurrentModule ;
+
+
+(*
+   initFixupInfo - initialize the fixupInfo record.
+*)
+
+PROCEDURE initFixupInfo () : fixupInfo ;
+VAR
+   f: fixupInfo ;
+BEGIN
+   f.count := 0 ;
+   f.info := InitIndex (1) ;
+   RETURN f
+END initFixupInfo ;
+
+
+(*
+   makeDef - returns a definition module node named, n.
+*)
+
+PROCEDURE makeDef (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := newNode (def) ;
+   WITH d^ DO
+      defF.name := n ;
+      defF.source := NulName ;
+      defF.hasHidden := FALSE ;
+      defF.forC := FALSE ;
+      defF.exported := InitIndex (1) ;
+      defF.importedModules := InitIndex (1) ;
+      defF.constFixup := initFixupInfo () ;
+      defF.enumFixup := initFixupInfo () ;
+      initDecls (defF.decls) ;
+      defF.enumsComplete := FALSE ;
+      defF.constsComplete := FALSE ;
+      defF.visited := FALSE ;
+      initPair (defF.com)
+   END ;
+   RETURN d
+END makeDef ;
+
+
+(*
+   makeImp - returns an implementation module node named, n.
+*)
+
+PROCEDURE makeImp (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := newNode (imp) ;
+   WITH d^ DO
+      impF.name := n ;
+      impF.source := NulName ;
+      impF.importedModules := InitIndex (1) ;
+      impF.constFixup := initFixupInfo () ;
+      impF.enumFixup := initFixupInfo () ;
+      initDecls (impF.decls) ;
+      impF.beginStatements := NIL ;
+      impF.finallyStatements := NIL ;
+      impF.definitionModule := NIL ;
+      impF.enumsComplete := FALSE ;
+      impF.constsComplete := FALSE ;
+      impF.visited := FALSE ;
+      initPair (impF.com)
+   END ;
+   RETURN d
+END makeImp ;
+
+
+(*
+   makeModule - returns a module node named, n.
+*)
+
+PROCEDURE makeModule (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := newNode (module) ;
+   WITH d^ DO
+      moduleF.name := n ;
+      moduleF.source := NulName ;
+      moduleF.importedModules := InitIndex (1) ;
+      moduleF.constFixup := initFixupInfo () ;
+      moduleF.enumFixup := initFixupInfo () ;
+      initDecls (moduleF.decls) ;
+      moduleF.beginStatements := NIL ;
+      moduleF.finallyStatements := NIL ;
+      moduleF.enumsComplete := FALSE ;
+      moduleF.constsComplete := FALSE ;
+      moduleF.visited := FALSE ;
+      initPair (moduleF.com)
+   END ;
+   RETURN d
+END makeModule ;
+
+
+(*
+   putDefForC - the definition module was defined FOR "C".
+*)
+
+PROCEDURE putDefForC (n: node) ;
+BEGIN
+   assert (isDef (n)) ;
+   n^.defF.forC := TRUE
+END putDefForC ;
+
+
+(*
+   isDefForC - returns TRUE if the definition module was defined FOR "C".
+*)
+
+PROCEDURE isDefForC (n: node) : BOOLEAN ;
+BEGIN
+   RETURN isDef (n) AND n^.defF.forC
+END isDefForC ;
+
+
+(*
+   lookupDef - returns a definition module node named, n.
+*)
+
+PROCEDURE lookupDef (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := getSymKey (defUniverse, n) ;
+   IF d=NIL
+   THEN
+      d := makeDef (n) ;
+      putSymKey (defUniverse, n, d) ;
+      IncludeIndiceIntoIndex (defUniverseI, d)
+   END ;
+   RETURN d
+END lookupDef ;
+
+
+(*
+   lookupImp - returns an implementation module node named, n.
+*)
+
+PROCEDURE lookupImp (n: Name) : node ;
+VAR
+   m: node ;
+BEGIN
+   m := getSymKey (modUniverse, n) ;
+   IF m=NIL
+   THEN
+      m := makeImp (n) ;
+      putSymKey (modUniverse, n, m) ;
+      IncludeIndiceIntoIndex (modUniverseI, m)
+   END ;
+   assert (NOT isModule (m)) ;
+   RETURN m
+END lookupImp ;
+
+
+(*
+   lookupModule - returns a module node named, n.
+*)
+
+PROCEDURE lookupModule (n: Name) : node ;
+VAR
+   m: node ;
+BEGIN
+   m := getSymKey (modUniverse, n) ;
+   IF m=NIL
+   THEN
+      m := makeModule (n) ;
+      putSymKey (modUniverse, n, m) ;
+      IncludeIndiceIntoIndex (modUniverseI, m)
+   END ;
+   assert (NOT isImp (m)) ;
+   RETURN m
+END lookupModule ;
+
+
+(*
+   setSource - sets the source filename for module, n, to s.
+*)
+
+PROCEDURE setSource (n: node; s: Name) ;
+BEGIN
+   WITH n^ DO
+      CASE kind OF
+
+      def   :  defF.source := s |
+      module:  moduleF.source := s |
+      imp   :  impF.source := s
+
+      END
+   END
+END setSource ;
+
+
+(*
+   getSource - returns the source filename for module, n.
+*)
+
+PROCEDURE getSource (n: node) : Name ;
+BEGIN
+   WITH n^ DO
+      CASE kind OF
+
+      def   :  RETURN defF.source |
+      module:  RETURN moduleF.source |
+      imp   :  RETURN impF.source
+
+      END
+   END
+END getSource ;
+
+
+(*
+   initDecls - initialize the decls, scopeT.
+*)
+
+PROCEDURE initDecls (VAR decls: scopeT) ;
+BEGIN
+   decls.symbols := initTree () ;
+   decls.constants := InitIndex (1) ;
+   decls.types := InitIndex (1) ;
+   decls.procedures := InitIndex (1) ;
+   decls.variables := InitIndex (1)
+END initDecls ;
+
+
+(*
+   enterScope - pushes symbol, n, to the scope stack.
+*)
+
+PROCEDURE enterScope (n: node) ;
+BEGIN
+   IF IsIndiceInIndex (scopeStack, n)
+   THEN
+      HALT
+   ELSE
+      IncludeIndiceIntoIndex (scopeStack, n)
+   END ;
+   IF debugScopes
+   THEN
+      printf ("enter scope\n") ;
+      dumpScopes
+   END
+END enterScope ;
+
+
+(*
+   leaveScope - removes the top level scope.
+*)
+
+PROCEDURE leaveScope ;
+VAR
+   i: CARDINAL ;
+   n: node ;
+BEGIN
+   i := HighIndice (scopeStack) ;
+   n := GetIndice (scopeStack, i) ;
+   RemoveIndiceFromIndex (scopeStack, n) ;
+   IF debugScopes
+   THEN
+      printf ("leave scope\n") ;
+      dumpScopes
+   END
+END leaveScope ;
+
+
+(*
+   getDeclScope - returns the node representing the
+                  current declaration scope.
+*)
+
+PROCEDURE getDeclScope () : node ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := HighIndice (scopeStack) ;
+   RETURN GetIndice (scopeStack, i)
+END getDeclScope ;
+
+
+(*
+   addTo - adds node, d, to scope decls and returns, d.
+           It stores, d, in the symbols tree associated with decls.
+*)
+
+PROCEDURE addTo (VAR decls: scopeT; d: node) : node ;
+VAR
+   n: Name ;
+BEGIN
+   n := getSymName (d) ;
+   IF n#NulName
+   THEN
+      IF getSymKey (decls.symbols, n)=NIL
+      THEN
+         putSymKey (decls.symbols, n, d)
+      ELSE
+         metaError1 ('{%1DMad} was declared', d) ;
+         metaError1 ('{%1k} and is being declared again', n)
+      END
+   END ;
+   IF isConst (d)
+   THEN
+      IncludeIndiceIntoIndex (decls.constants, d)
+   ELSIF isVar (d)
+   THEN
+      IncludeIndiceIntoIndex (decls.variables, d)
+   ELSIF isType (d)
+   THEN
+      IncludeIndiceIntoIndex (decls.types, d)
+   ELSIF isProcedure (d)
+   THEN
+      IncludeIndiceIntoIndex (decls.procedures, d) ;
+      IF debugDecl
+      THEN
+         printf ("%d procedures on the dynamic array\n",
+                 HighIndice (decls.procedures))
+      END
+   END ;
+   RETURN d
+END addTo ;
+
+
+(*
+   export - export node, n, from definition module, d.
+*)
+
+PROCEDURE export (d, n: node) ;
+BEGIN
+   assert (isDef (d)) ;
+   IncludeIndiceIntoIndex (d^.defF.exported, n)
+END export ;
+
+
+(*
+   addToScope - adds node, n, to the current scope and returns, n.
+*)
+
+PROCEDURE addToScope (n: node) : node ;
+VAR
+   s: node ;
+   i: CARDINAL ;
+BEGIN
+   i := HighIndice (scopeStack) ;
+   s := GetIndice (scopeStack, i) ;
+   IF isProcedure (s)
+   THEN
+      IF debugDecl
+      THEN
+         outText (doP, "adding ") ;
+         doNameC (doP, n) ;
+         outText (doP, " to procedure\n")
+      END ;
+      RETURN addTo (s^.procedureF.decls, n)
+   ELSIF isModule (s)
+   THEN
+      IF debugDecl
+      THEN
+         outText (doP, "adding ") ;
+         doNameC (doP, n) ;
+         outText (doP, " to module\n")
+      END ;
+      RETURN addTo (s^.moduleF.decls, n)
+   ELSIF isDef (s)
+   THEN
+      IF debugDecl
+      THEN
+         outText (doP, "adding ") ;
+         doNameC (doP, n) ;
+         outText (doP, " to definition module\n")
+      END ;
+      export (s, n) ;
+      RETURN addTo (s^.defF.decls, n)
+   ELSIF isImp (s)
+   THEN
+      IF debugDecl
+      THEN
+         outText (doP, "adding ") ;
+         doNameC (doP, n) ;
+         outText (doP, " to implementation module\n")
+      END ;
+      RETURN addTo (s^.impF.decls, n)
+   END ;
+   HALT
+END addToScope ;
+
+
+(*
+   addModuleToScope - adds module, i, to module, m, scope.
+*)
+
+PROCEDURE addModuleToScope (m, i: node) ;
+BEGIN
+   assert (getDeclScope () = m) ;
+   IF lookupSym (getSymName (i))=NIL
+   THEN
+      i := addToScope (i)
+   END
+END addModuleToScope ;
+
+
+(*
+   addImportedModule - add module, i, to be imported by, m.
+                       If scoped then module, i, is added to the
+                       module, m, scope.
+*)
+
+PROCEDURE addImportedModule (m, i: node; scoped: BOOLEAN) ;
+BEGIN
+   assert (isDef (i) OR isModule (i)) ;
+   IF isDef (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.defF.importedModules, i)
+   ELSIF isImp (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.impF.importedModules, i)
+   ELSIF isModule (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.moduleF.importedModules, i)
+   ELSE
+      HALT
+   END ;
+   IF scoped
+   THEN
+      addModuleToScope (m, i)
+   END
+END addImportedModule ;
+
+
+(*
+   completedEnum - assign boolean enumsComplete to TRUE if a definition,
+                   implementation or module symbol.
+*)
+
+PROCEDURE completedEnum (n: node) ;
+BEGIN
+   assert (isDef (n) OR isImp (n) OR isModule (n)) ;
+   IF isDef (n)
+   THEN
+      n^.defF.enumsComplete := TRUE
+   ELSIF isImp (n)
+   THEN
+      n^.impF.enumsComplete := TRUE
+   ELSIF isModule (n)
+   THEN
+      n^.moduleF.enumsComplete := TRUE
+   END
+END completedEnum ;
+
+
+(*
+   setUnary - sets a unary node to contain, arg, a, and type, t.
+*)
+
+PROCEDURE setUnary (u: node; k: nodeT; a, t: node) ;
+BEGIN
+   CASE k OF
+
+   constexp,
+   deref,
+   chr,
+   cap,
+   abs,
+   float,
+   trunc,
+   ord,
+   high,
+   throw,
+   re,
+   im,
+   not,
+   neg,
+   adr,
+   size,
+   tsize,
+   min,
+   max     :  u^.kind := k ;
+              u^.unaryF.arg := a ;
+	      u^.unaryF.resultType := t
+
+   END
+END setUnary ;
+
+
+(*
+   makeConst - create, initialise and return a const node.
+*)
+
+PROCEDURE makeConst (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := newNode (const) ;
+   WITH d^ DO
+      constF.name := n ;
+      constF.type := NIL ;
+      constF.scope := getDeclScope () ;
+      constF.value := NIL
+   END ;
+   RETURN addToScope (d)
+END makeConst ;
+
+
+(*
+   makeType - create, initialise and return a type node.
+*)
+
+PROCEDURE makeType (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := newNode (type) ;
+   WITH d^ DO
+      typeF.name := n ;
+      typeF.type := NIL ;
+      typeF.scope := getDeclScope () ;
+      typeF.isHidden := FALSE ;
+      typeF.isInternal := FALSE
+   END ;
+   RETURN addToScope (d)
+END makeType ;
+
+
+(*
+   makeTypeImp - lookup a type in the definition module
+                 and return it.  Otherwise create a new type.
+*)
+
+PROCEDURE makeTypeImp (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := lookupSym (n) ;
+   IF d#NIL
+   THEN
+      d^.typeF.isHidden := FALSE ;
+      RETURN addToScope (d)
+   ELSE
+      d := newNode (type) ;
+      WITH d^ DO
+         typeF.name := n ;
+         typeF.type := NIL ;
+         typeF.scope := getDeclScope () ;
+         typeF.isHidden := FALSE
+      END ;
+      RETURN addToScope (d)
+   END
+END makeTypeImp ;
+
+
+(*
+   makeVar - create, initialise and return a var node.
+*)
+
+PROCEDURE makeVar (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := newNode (var) ;
+   WITH d^ DO
+      varF.name := n ;
+      varF.type := NIL ;
+      varF.decl := NIL ;
+      varF.scope := getDeclScope () ;
+      varF.isInitialised := FALSE ;
+      varF.isParameter := FALSE ;
+      varF.isVarParameter := FALSE ;
+      initCname (varF.cname)
+   END ;
+   RETURN addToScope (d)
+END makeVar ;
+
+
+(*
+   putVar - places, type, as the type for var.
+*)
+
+PROCEDURE putVar (var, type, decl: node) ;
+BEGIN
+   assert (var#NIL) ;
+   assert (isVar (var)) ;
+   var^.varF.type := type ;
+   var^.varF.decl := decl
+END putVar ;
+
+
+(*
+   putVarBool - assigns the four booleans associated with a variable.
+*)
+
+PROCEDURE putVarBool (v: node; init, param, isvar, isused: BOOLEAN) ;
+BEGIN
+   assert (isVar (v)) ;
+   v^.varF.isInitialised := init ;
+   v^.varF.isParameter := param ;
+   v^.varF.isVarParameter := isvar ;
+   v^.varF.isUsed := isused
+END putVarBool ;
+
+
+(*
+   checkPtr - in C++ we need to create a typedef for a pointer
+              in case we need to use reinterpret_cast.
+*)
+
+PROCEDURE checkPtr (n: node) : node ;
+VAR
+   s: String ;
+   p: node ;
+BEGIN
+   IF lang = ansiCP
+   THEN
+      IF isPointer (n)
+      THEN
+         s := tempName () ;
+         p := makeType (makekey (DynamicStrings.string (s))) ;
+         putType (p, n) ;
+         s := KillString (s) ;
+	 RETURN p
+      END
+   END ;
+   RETURN n
+END checkPtr ;
+
+
+(*
+   makeVarDecl - create a vardecl node and create a shadow variable in the
+                 current scope.
+*)
+
+PROCEDURE makeVarDecl (i: node; type: node) : node ;
+VAR
+   d, v: node ;
+   j, n: CARDINAL ;
+BEGIN
+   type := checkPtr (type) ;
+   d := newNode (vardecl) ;
+   WITH d^ DO
+      vardeclF.names := i^.identlistF.names ;
+      vardeclF.type := type ;
+      vardeclF.scope := getDeclScope ()
+   END ;
+   n := wlists.noOfItemsInList (d^.vardeclF.names) ;
+   j := 1 ;
+   WHILE j<=n DO
+      v := lookupSym (wlists.getItemFromList (d^.vardeclF.names, j)) ;
+      assert (isVar (v)) ;
+      putVar (v, type, d) ;
+      INC (j)
+   END ;
+   RETURN d
+END makeVarDecl ;
+
+
+(*
+   isVarDecl - returns TRUE if, n, is a vardecl node.
+*)
+
+PROCEDURE isVarDecl (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = vardecl
+END isVarDecl ;
+
+
+(*
+   makeVariablesFromParameters - creates variables which are really parameters.
+*)
+
+PROCEDURE makeVariablesFromParameters (proc, id, type: node; isvar, isused: BOOLEAN) ;
+VAR
+   v   : node ;
+   i, n: CARDINAL ;
+   m   : Name ;
+   s   : String ;
+BEGIN
+   assert (isProcedure (proc)) ;
+   assert (isIdentList (id)) ;
+   i := 1 ;
+   n := wlists.noOfItemsInList (id^.identlistF.names) ;
+   WHILE i<=n DO
+      m := wlists.getItemFromList (id^.identlistF.names, i) ;
+      v := makeVar (m) ;
+      putVar (v, type, NIL) ;
+      putVarBool (v, TRUE, TRUE, isvar, isused) ;
+      IF debugScopes
+      THEN
+         printf ("adding parameter variable into top scope\n") ;
+         dumpScopes ;
+         printf (" variable name is: ") ;
+         s := InitStringCharStar (keyToCharStar (m)) ;
+         IF KillString (WriteS (StdOut, s))=NIL
+         THEN
+         END ;
+         printf ("\n")
+      END ;
+      INC (i)
+   END
+END makeVariablesFromParameters ;
+
+
+(*
+   addProcedureToScope - add a procedure name n and node d to the
+                         current scope.
+*)
+
+PROCEDURE addProcedureToScope (d: node; n: Name) : node ;
+VAR
+   m: node ;
+   i: CARDINAL ;
+BEGIN
+   i := HighIndice (scopeStack) ;
+   m := GetIndice (scopeStack, i) ;
+   IF isDef (m) AND
+      (getSymName (m) = makeKey ('M2RTS')) AND
+      (getSymName (d) = makeKey ('HALT'))
+   THEN
+      haltN := d ;
+      putSymKey (baseSymbols, n, haltN)
+   END ;
+   RETURN addToScope (d)
+END addProcedureToScope ;
+
+
+(*
+   makeProcedure - create, initialise and return a procedure node.
+*)
+
+PROCEDURE makeProcedure (n: Name) : node ;
+VAR
+   d: node ;
+BEGIN
+   d := lookupSym (n) ;
+   IF d=NIL
+   THEN
+      d := newNode (procedure) ;
+      WITH d^ DO
+         procedureF.name := n ;
+         initDecls (procedureF.decls) ;
+         procedureF.scope := getDeclScope () ;
+         procedureF.parameters := InitIndex (1) ;
+         procedureF.isForC := isDefForCNode (getDeclScope ()) ;
+	 procedureF.built := FALSE ;
+         procedureF.returnopt := FALSE ;
+         procedureF.optarg := NIL ;
+	 procedureF.noreturnused := FALSE ;
+         procedureF.noreturn := FALSE ;
+         procedureF.vararg := FALSE ;
+         procedureF.checking := FALSE ;
+	 procedureF.paramcount := 0 ;
+         procedureF.returnType := NIL ;
+         procedureF.beginStatements := NIL ;
+         initCname (procedureF.cname) ;
+	 procedureF.defComment := NIL ;
+	 procedureF.modComment := NIL ;
+      END
+   END ;
+   RETURN addProcedureToScope (d, n)
+END makeProcedure ;
+
+
+(*
+   putCommentDefProcedure - remembers the procedure comment (if it exists) as a
+                            definition module procedure heading.  NIL is placed
+                            if there is no procedure comment available.
+*)
+
+PROCEDURE putCommentDefProcedure (n: node) ;
+BEGIN
+   assert (isProcedure (n)) ;
+   IF isProcedureComment (lastcomment)
+   THEN
+      n^.procedureF.defComment := lastcomment
+   END
+END putCommentDefProcedure ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE putCommentModProcedure (n: node) ;
+BEGIN
+   assert (isProcedure (n)) ;
+   IF isProcedureComment (lastcomment)
+   THEN
+      n^.procedureF.modComment := lastcomment
+   END
+END putCommentModProcedure ;
+
+
+(*
+   paramEnter - reset the parameter count.
+*)
+
+PROCEDURE paramEnter (n: node) ;
+BEGIN
+   assert (isProcedure (n)) ;
+   n^.procedureF.paramcount := 0
+END paramEnter ;
+
+
+(*
+   paramLeave - set paramater checking to TRUE from now onwards.
+*)
+
+PROCEDURE paramLeave (n: node) ;
+BEGIN
+   assert (isProcedure (n)) ;
+   n^.procedureF.checking := TRUE ;
+   IF isImp (currentModule) OR isModule (currentModule)
+   THEN
+      n^.procedureF.built := TRUE
+   END
+END paramLeave ;
+
+
+(*
+   putReturnType - sets the return type of procedure or proctype, proc, to, type.
+*)
+
+PROCEDURE putReturnType (proc, type: node) ;
+BEGIN
+   assert (isProcedure (proc) OR isProcType (proc)) ;
+   IF isProcedure (proc)
+   THEN
+      proc^.procedureF.returnType := type
+   ELSE
+      proc^.proctypeF.returnType := type
+   END
+END putReturnType ;
+
+
+(*
+   putOptReturn - sets, proctype or procedure, proc, to have an optional return type.
+*)
+
+PROCEDURE putOptReturn (proc: node) ;
+BEGIN
+   assert (isProcedure (proc) OR isProcType (proc)) ;
+   IF isProcedure (proc)
+   THEN
+      proc^.procedureF.returnopt := TRUE
+   ELSE
+      proc^.proctypeF.returnopt := TRUE
+   END
+END putOptReturn ;
+
+
+(*
+   makeProcType - returns a proctype node.
+*)
+
+PROCEDURE makeProcType () : node ;
+VAR
+   d: node ;
+BEGIN
+   d := newNode (proctype) ;
+   WITH d^ DO
+      proctypeF.scope := getDeclScope () ;
+      proctypeF.parameters := InitIndex (1) ;
+      proctypeF.returnopt := FALSE ;
+      proctypeF.optarg := NIL ;
+      proctypeF.vararg := FALSE ;
+      proctypeF.returnType := NIL
+   END ;
+   RETURN d
+END makeProcType ;
+
+
+(*
+   putProcTypeReturn - sets the return type of, proc, to, type.
+*)
+
+PROCEDURE putProcTypeReturn (proc, type: node) ;
+BEGIN
+   assert (isProcType (proc)) ;
+   proc^.proctypeF.returnType := type
+END putProcTypeReturn ;
+
+
+(*
+   putProcTypeOptReturn - sets, proc, to have an optional return type.
+*)
+
+PROCEDURE putProcTypeOptReturn (proc: node) ;
+BEGIN
+   assert (isProcType (proc)) ;
+   proc^.proctypeF.returnopt := TRUE
+END putProcTypeOptReturn ;
+
+
+(*
+   makeNonVarParameter - returns a non var parameter node with, name: type.
+*)
+
+PROCEDURE makeNonVarParameter (l: node; type, proc: node; isused: BOOLEAN) : node ;
+VAR
+   d: node ;
+BEGIN
+   assert ((l=NIL) OR isIdentList (l)) ;
+   d := newNode (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
+END makeNonVarParameter ;
+
+
+(*
+   makeVarParameter - returns a var parameter node with, name: type.
+*)
+
+PROCEDURE makeVarParameter (l: node; type, proc: node; isused: BOOLEAN) : node ;
+VAR
+   d: node ;
+BEGIN
+   assert ((l=NIL) OR isIdentList (l)) ;
+   d := newNode (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
+END makeVarParameter ;
+
+
+(*
+   makeVarargs - returns a varargs node.
+*)
+
+PROCEDURE makeVarargs () : node ;
+VAR
+   d: node ;
+BEGIN
+   d := newNode (varargs) ;
+   d^.varargsF.scope := NIL ;
+   RETURN d
+END makeVarargs ;
+
+
+(*
+   isVarargs - returns TRUE if, n, is a varargs node.
+*)
+
+PROCEDURE isVarargs (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = varargs
+END isVarargs ;
+
+
+(*
+   addParameter - adds a parameter, param, to procedure or proctype, proc.
+*)
+
+PROCEDURE addParameter (proc, param: node) ;
+BEGIN
+   assert (isVarargs (param) OR isParam (param) OR isVarParam (param) OR isOptarg (param)) ;
+   CASE proc^.kind OF
+
+   procedure:  IncludeIndiceIntoIndex (proc^.procedureF.parameters, param) ;
+               IF isVarargs (param)
+               THEN
+                  proc^.procedureF.vararg := TRUE
+               END ;
+	       IF isOptarg (param)
+               THEN
+                  proc^.procedureF.optarg := param
+               END |
+   proctype :  IncludeIndiceIntoIndex (proc^.proctypeF.parameters, param) ;
+               IF isVarargs (param)
+               THEN
+                  proc^.proctypeF.vararg := TRUE
+               END ;
+               IF isOptarg (param)
+               THEN
+                  proc^.proctypeF.optarg := param
+               END
+
+   END
+END addParameter ;
+
+
+(*
+   isOptarg - returns TRUE if, n, is an optarg.
+*)
+
+PROCEDURE isOptarg (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = optarg
+END isOptarg ;
+
+
+(*
+   makeOptParameter - creates and returns an optarg.
+*)
+
+PROCEDURE makeOptParameter (l, type, init: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (optarg) ;
+   n^.optargF.namelist := l ;
+   n^.optargF.type := type ;
+   n^.optargF.init := init ;
+   n^.optargF.scope := NIL ;
+   RETURN n
+END makeOptParameter ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE addOptParameter (proc: node; id: Name; type, init: node) : node ;
+VAR
+   p, l: node ;
+BEGIN
+   assert (isProcedure (proc)) ;
+   l := makeIdentList () ;
+   assert (putIdent (l, id)) ;
+   checkMakeVariables (proc, l, type, FALSE, TRUE) ;
+   IF NOT proc^.procedureF.checking
+   THEN
+      p := makeOptParameter (l, type, init) ;
+      addParameter (proc, p)
+   END ;
+   RETURN p
+END addOptParameter ;
+
+
+VAR
+   globalNode: node ;
+
+
+(*
+   setwatch - assign the globalNode to n.
+*)
+
+PROCEDURE setwatch (n: node) : BOOLEAN ;
+BEGIN
+   globalNode := n ;
+   RETURN TRUE
+END setwatch ;
+
+
+(*
+   runwatch - set the globalNode to an identlist.
+*)
+
+PROCEDURE runwatch () : BOOLEAN ;
+BEGIN
+   RETURN globalNode^.kind = identlist
+END runwatch ;
+
+
+(*
+   makeIdentList - returns a node which will be used to maintain an ident list.
+*)
+
+PROCEDURE makeIdentList () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (identlist) ;
+   n^.identlistF.names := wlists.initList () ;
+   n^.identlistF.cnamed := FALSE ;
+   RETURN n
+END makeIdentList ;
+
+
+(*
+   isIdentList - returns TRUE if, n, is an identlist.
+*)
+
+PROCEDURE isIdentList (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = identlist
+END isIdentList ;
+
+
+(*
+   putIdent - places ident, i, into identlist, n.  It returns TRUE if
+              ident, i, is unique.
+*)
+
+PROCEDURE putIdent (n: node; i: Name) : BOOLEAN ;
+BEGIN
+   assert (isIdentList (n)) ;
+   IF wlists.isItemInList (n^.identlistF.names, i)
+   THEN
+      RETURN FALSE
+   ELSE
+      wlists.putItemIntoList (n^.identlistF.names, i) ;
+      RETURN TRUE
+   END
+END putIdent ;
+
+
+(*
+   identListLen - returns the length of identlist.
+*)
+
+PROCEDURE identListLen (n: node) : CARDINAL ;
+BEGIN
+   IF n=NIL
+   THEN
+      RETURN 0
+   ELSE
+      assert (isIdentList (n)) ;
+      RETURN wlists.noOfItemsInList (n^.identlistF.names)
+   END
+END identListLen ;
+
+
+(*
+   checkParameters - placeholder for future parameter checking.
+*)
+
+PROCEDURE checkParameters (p: node; i: node; type: node; isvar, isused: BOOLEAN) ;
+BEGIN
+   (* do check.  *)
+   disposeNode (i)
+END checkParameters ;
+
+(*
+(*
+   avoidCnames - checks each name in, n, against C reserved
+                 keywords and macros.
+*)
+
+PROCEDURE avoidCnames (n: node) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   assert (isIdentList (n)) ;
+   IF NOT n^.identlistF.cnamed
+   THEN
+      n^.identlistF.cnamed := TRUE ;
+      j := wlists.noOfItemsInList (n^.identlistF.names) ;
+      i := 1 ;
+      WHILE i<=j DO
+         wlists.replaceItemInList (n^.identlistF.names,
+                                   i,
+                                   keyc.cnamen (wlists.getItemFromList (n^.identlistF.names, i), FALSE)) ;
+         INC (i)
+      END
+   END
+END avoidCnames ;
+*)
+
+
+(*
+   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.
+*)
+
+PROCEDURE checkMakeVariables (n, i, type: node; isvar, isused: BOOLEAN) ;
+BEGIN
+   IF (isImp (currentModule) OR isModule (currentModule)) AND
+      (NOT n^.procedureF.built)
+   THEN
+      makeVariablesFromParameters (n, i, type, isvar, isused)
+   END ;
+END checkMakeVariables ;
+
+
+(*
+   addVarParameters - adds the identlist, i, of, type, to be VAR parameters
+                      in procedure, n.
+*)
+
+PROCEDURE addVarParameters (n: node; i: node; type: node; isused: BOOLEAN) ;
+VAR
+   p: node ;
+BEGIN
+   assert (isIdentList (i)) ;
+   assert (isProcedure (n)) ;
+   checkMakeVariables (n, i, type, TRUE, isused) ;
+   IF n^.procedureF.checking
+   THEN
+      checkParameters (n, i, type, TRUE, isused)  (* will destroy, i.  *)
+   ELSE
+      p := makeVarParameter (i, type, n, isused) ;
+      IncludeIndiceIntoIndex (n^.procedureF.parameters, p) ;
+   END ;
+END addVarParameters ;
+
+
+(*
+   addNonVarParameters - adds the identlist, i, of, type, to be parameters
+                         in procedure, n.
+*)
+
+PROCEDURE addNonVarParameters (n: node; i: node; type: node; isused: BOOLEAN) ;
+VAR
+   p: node ;
+BEGIN
+   assert (isIdentList (i)) ;
+   assert (isProcedure (n)) ;
+   checkMakeVariables (n, i, type, FALSE, isused) ;
+   IF n^.procedureF.checking
+   THEN
+      checkParameters (n, i, type, FALSE, isused)  (* will destroy, i.  *)
+   ELSE
+      p := makeNonVarParameter (i, type, n, isused) ;
+      IncludeIndiceIntoIndex (n^.procedureF.parameters, p)
+   END ;
+END addNonVarParameters ;
+
+
+(*
+   makeSubrange - returns a subrange node, built from range: low..high.
+*)
+
+PROCEDURE makeSubrange (low, high: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (subrange) ;
+   n^.subrangeF.low := low ;
+   n^.subrangeF.high := high ;
+   n^.subrangeF.type := NIL ;
+   n^.subrangeF.scope := getDeclScope () ;
+   RETURN n
+END makeSubrange ;
+
+
+(*
+   putSubrangeType - assigns, type, to the subrange type, sub.
+*)
+
+PROCEDURE putSubrangeType (sub, type: node) ;
+BEGIN
+   assert (isSubrange (sub)) ;
+   sub^.subrangeF.type := type
+END putSubrangeType ;
+
+
+(*
+   makeSet - returns a set of, type, node.
+*)
+
+PROCEDURE makeSet (type: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (set) ;
+   n^.setF.type := type ;
+   n^.setF.scope := getDeclScope () ;
+   RETURN n
+END makeSet ;
+
+
+(*
+   makeSetValue - creates and returns a setvalue node.
+*)
+
+PROCEDURE makeSetValue () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (setvalue) ;
+   n^.setvalueF.type := bitsetN ;
+   n^.setvalueF.values := InitIndex (1) ;
+   RETURN n
+END makeSetValue ;
+
+
+(*
+   isSetValue - returns TRUE if, n, is a setvalue node.
+*)
+
+PROCEDURE isSetValue (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = setvalue
+END isSetValue ;
+
+
+(*
+   putSetValue - assigns the type, t, to the set value, n.  The
+                 node, n, is returned.
+*)
+
+PROCEDURE putSetValue (n, t: node) : node ;
+BEGIN
+   assert (isSetValue (n)) ;
+   n^.setvalueF.type := t ;
+   RETURN n
+END putSetValue ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE includeSetValue (n: node; l, h: node) : node ;
+BEGIN
+   assert (isSetValue (n)) ;
+   IncludeIndiceIntoIndex (n^.setvalueF.values, l) ;
+   RETURN n
+END includeSetValue ;
+
+
+(*
+   makePointer - returns a pointer of, type, node.
+*)
+
+PROCEDURE makePointer (type: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (pointer) ;
+   n^.pointerF.type := type ;
+   n^.pointerF.scope := getDeclScope () ;
+   RETURN n
+END makePointer ;
+
+
+(*
+   makeArray - returns a node representing ARRAY subr OF type.
+*)
+
+PROCEDURE makeArray (subr, type: node) : node ;
+VAR
+   n, s: node ;
+BEGIN
+   s := skipType (subr) ;
+   assert (isSubrange (s) OR isOrdinal (s) OR isEnumeration (s)) ;
+   n := newNode (array) ;
+   n^.arrayF.subr := subr ;
+   n^.arrayF.type := type ;
+   n^.arrayF.scope := getDeclScope () ;
+   n^.arrayF.isUnbounded := FALSE ;
+   RETURN n
+END makeArray ;
+
+
+(*
+   makeRecord - creates and returns a record node.
+*)
+
+PROCEDURE makeRecord () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (record) ;
+   n^.recordF.localSymbols := initTree () ;
+   n^.recordF.listOfSons := InitIndex (1) ;
+   n^.recordF.scope := getDeclScope () ;
+   RETURN n
+END makeRecord ;
+
+
+(*
+   addFieldsToRecord - adds fields, i, of type, t, into a record, r.
+                       It returns, r.
+*)
+
+PROCEDURE addFieldsToRecord (r, v, i, t: node) : node ;
+VAR
+   p, fj: node ;
+   j, n : CARDINAL ;
+   fn   : Name ;
+BEGIN
+   IF isRecord (r)
+   THEN
+      p := r ;
+      v := NIL
+   ELSE
+      p := getRecord (getParent (r)) ;
+      assert (isVarientField (r)) ;
+      assert (isVarient (v)) ;
+      putFieldVarient (r, v)
+   END ;
+   n := wlists.noOfItemsInList (i^.identlistF.names) ;
+   j := 1 ;
+   WHILE j<=n DO
+      fn := wlists.getItemFromList (i^.identlistF.names, j) ;
+      fj := getSymKey (p^.recordF.localSymbols, n) ;
+      IF fj=NIL
+      THEN
+         fj := putFieldRecord (r, fn, t, v)
+      ELSE
+         metaErrors2 ('record field {%1ad} has already been declared inside a {%2Dd} {%2a}',
+                      'attempting to declare a duplicate record field', fj, p)
+      END ;
+      INC (j)
+   END ;
+   RETURN r;
+END addFieldsToRecord ;
+
+
+(*
+   makeVarient - creates a new symbol, a varient symbol for record or varient field
+                 symbol, r.
+*)
+
+PROCEDURE makeVarient (r: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (varient) ;
+   WITH n^ DO
+      varientF.listOfSons := InitIndex (1) ;
+      (* do we need to remember our parent (r) ?  *)
+      (* if so use this   n^.varientF.parent := r  *)
+      IF isRecord (r)
+      THEN
+         varientF.varient := NIL
+      ELSE
+         varientF.varient := r
+      END ;
+      varientF.tag := NIL ;
+      varientF.scope := getDeclScope () ;
+   END ;
+   (* now add, n, to the record/varient, r, field list *)
+   WITH r^ DO
+      CASE kind OF
+
+      record      :  IncludeIndiceIntoIndex (recordF.listOfSons, n) |
+      varientfield:  IncludeIndiceIntoIndex (varientfieldF.listOfSons, n)
+
+      END
+   END ;
+   RETURN n
+END makeVarient ;
+
+
+(*
+   buildVarientFieldRecord - builds a varient field into a varient symbol, v.
+                             The varient field is returned.
+*)
+
+PROCEDURE buildVarientFieldRecord (v: node; p: node) : node ;
+VAR
+   f: node ;
+BEGIN
+   assert (isVarient (v)) ;
+   f := makeVarientField (v, p) ;
+   assert (isVarientField (f)) ;
+   putFieldVarient (f, v) ;
+   RETURN f
+END buildVarientFieldRecord ;
+
+
+(*
+   makeVarientField - create a varient field within varient, v,
+                      The new varient field is returned.
+*)
+
+PROCEDURE makeVarientField (v: node; p: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (varientfield) ;
+   WITH n^.varientfieldF DO
+      name := NulName ;
+      parent := p ;
+      varient := v ;
+      simple := FALSE ;
+      listOfSons := InitIndex (1) ;
+      scope := getDeclScope ()
+   END ;
+   RETURN n
+END makeVarientField ;
+
+
+(*
+   putFieldVarient - places the field varient, f, as a brother to, the
+                     varient symbol, v, and also tells, f, that its varient
+                     parent is, v.
+*)
+
+PROCEDURE putFieldVarient (f, v: node) ;
+BEGIN
+   assert (isVarient (v)) ;
+   assert (isVarientField (f)) ;
+   WITH v^ DO
+      CASE kind OF
+
+      varient:  IncludeIndiceIntoIndex (varientF.listOfSons, f)
+
+      END
+   END ;
+   WITH f^ DO
+      CASE kind OF
+
+      varientfield:  varientfieldF.varient := v
+
+      END
+   END
+END putFieldVarient ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE putFieldRecord (r: node; tag: Name; type, v: node) : node ;
+VAR
+   f, n, p: node ;
+BEGIN
+   n := newNode (recordfield) ;
+   WITH r^ DO
+      CASE kind OF
+
+      record:  IncludeIndiceIntoIndex (recordF.listOfSons, n) ;
+               (* ensure that field, n, is in the parents Local Symbols.  *)
+               IF tag#NulName
+               THEN
+                  IF getSymKey (recordF.localSymbols, tag) = NulName
+                  THEN
+                     putSymKey (recordF.localSymbols, tag, n)
+                  ELSE
+                     f := getSymKey (recordF.localSymbols, tag) ;
+                     metaErrors1 ('field record {%1Dad} has already been declared',
+                                  'field record duplicate', f)
+                  END
+               END |
+      varientfield:  IncludeIndiceIntoIndex (varientfieldF.listOfSons, n) ;
+                     p := getParent (r) ;
+                     assert (p^.kind=record) ;
+                     IF tag#NulName
+                     THEN
+                        putSymKey (p^.recordF.localSymbols, tag, n)
+                     END
+
+      END
+   END ;
+   (* 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 := NIL ;
+   initCname (n^.recordfieldF.cname) ;
+   (*
+   IF r^.kind=record
+   THEN
+      doRecordM2 (doP, r)
+   END ;
+   *)
+   RETURN n
+END putFieldRecord ;
+
+
+(*
+   buildVarientSelector - builds a field of name, tag, of, type onto:
+                          record or varient field, r.
+                          varient, v.
+*)
+
+PROCEDURE buildVarientSelector (r, v: node; tag: Name; type: node) ;
+VAR
+   f: node ;
+BEGIN
+   assert (isRecord (r) OR isVarientField (r)) ;
+   IF isRecord (r) OR isVarientField (r)
+   THEN
+      IF (type=NIL) AND (tag=NulName)
+      THEN
+         metaError1 ('expecting a tag field in the declaration of a varient record {%1Ua}', r)
+      ELSIF type=NIL
+      THEN
+         f := lookupSym (tag) ;
+         putVarientTag (v, f)
+      ELSE
+         f := putFieldRecord (r, tag, type, v) ;
+	 assert (isRecordField (f)) ;
+         f^.recordfieldF.tag := TRUE ;
+         putVarientTag (v, f)
+      END
+   END
+END buildVarientSelector ;
+
+
+(*
+   ensureOrder - ensures that, a, and, b, exist in, i, and also
+                 ensure that, a, is before, b.
+*)
+
+PROCEDURE ensureOrder (i: Index; a, b: node) ;
+BEGIN
+   assert (IsIndiceInIndex (i, a)) ;
+   assert (IsIndiceInIndex (i, b)) ;
+   RemoveIndiceFromIndex (i, a) ;
+   RemoveIndiceFromIndex (i, b) ;
+   IncludeIndiceIntoIndex (i, a) ;
+   IncludeIndiceIntoIndex (i, b) ;
+   assert (IsIndiceInIndex (i, a)) ;
+   assert (IsIndiceInIndex (i, b))
+END ensureOrder ;
+
+
+(*
+   putVarientTag - places tag into variant v.
+*)
+
+PROCEDURE putVarientTag (v: node; tag: node) ;
+VAR
+   p: node ;
+BEGIN
+   assert (isVarient (v)) ;
+   CASE v^.kind OF
+
+   varient:  v^.varientF.tag := tag
+
+   END
+END putVarientTag ;
+
+
+(*
+   getParent - returns the parent field of recordfield or varientfield symbol, n.
+*)
+
+PROCEDURE getParent (n: node) : node ;
+BEGIN
+   CASE n^.kind OF
+
+   recordfield:  RETURN n^.recordfieldF.parent |
+   varientfield:  RETURN n^.varientfieldF.parent
+
+   END
+END getParent ;
+
+
+(*
+   getRecord - returns the record associated with node, n.
+               (Parental record).
+*)
+
+PROCEDURE getRecord (n: node) : node ;
+BEGIN
+   assert (n^.kind # varient) ;  (* if this fails then we need to add parent field to varient.  *)
+   CASE n^.kind OF
+
+   record      :  RETURN n |
+   varientfield:  RETURN getRecord (getParent (n))
+
+   END
+END getRecord ;
+
+
+(*
+   putUnbounded - sets array, n, as unbounded.
+*)
+
+PROCEDURE putUnbounded (n: node) ;
+BEGIN
+   assert (n^.kind = array) ;
+   n^.arrayF.isUnbounded := TRUE
+END putUnbounded ;
+
+
+(*
+   isConstExp - return TRUE if the node kind is a constexp.
+*)
+
+PROCEDURE isConstExp (c: node) : BOOLEAN ;
+BEGIN
+   assert (c#NIL) ;
+   RETURN c^.kind = constexp
+END isConstExp ;
+
+
+(*
+   addEnumToModule - adds enumeration type, e, into the list of enums
+                     in module, m.
+*)
+
+PROCEDURE addEnumToModule (m, e: node) ;
+BEGIN
+   assert (isEnumeration (e) OR isEnumerationField (e)) ;
+   assert (isModule (m) OR isDef (m) OR isImp (m)) ;
+   IF isModule (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.moduleF.enumFixup.info, e)
+   ELSIF isDef (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.defF.enumFixup.info, e)
+   ELSIF isImp (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.impF.enumFixup.info, e)
+   END
+END addEnumToModule ;
+
+
+(*
+   getNextFixup - return the next fixup from from f.
+*)
+
+PROCEDURE getNextFixup (VAR f: fixupInfo) : node ;
+BEGIN
+   INC (f.count) ;
+   RETURN GetIndice (f.info, f.count)
+END getNextFixup ;
+
+
+(*
+   getNextEnum - returns the next enumeration node.
+*)
+
+PROCEDURE getNextEnum () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := NIL ;
+   assert (isDef (currentModule) OR isImp (currentModule) OR isModule (currentModule)) ;
+   WITH currentModule^ DO
+      IF isDef (currentModule)
+      THEN
+         n := getNextFixup (defF.enumFixup)
+      ELSIF isImp (currentModule)
+      THEN
+         n := getNextFixup (impF.enumFixup)
+      ELSIF isModule (currentModule)
+      THEN
+         n := getNextFixup (moduleF.enumFixup)
+      END
+   END ;
+   assert (n # NIL) ;
+   assert (isEnumeration (n) OR isEnumerationField (n)) ;
+   RETURN n
+END getNextEnum ;
+
+
+(*
+   resetEnumPos - resets the index into the saved list of enums inside
+                  module, n.
+*)
+
+PROCEDURE resetEnumPos (n: node) ;
+BEGIN
+   assert (isDef (n) OR isImp (n) OR isModule (n)) ;
+   IF isDef (n)
+   THEN
+      n^.defF.enumFixup.count := 0
+   ELSIF isImp (n)
+   THEN
+      n^.impF.enumFixup.count := 0
+   ELSIF isModule (n)
+   THEN
+      n^.moduleF.enumFixup.count := 0
+   END
+END resetEnumPos ;
+
+
+(*
+   getEnumsComplete - gets the field from the def or imp or module, n.
+*)
+
+PROCEDURE getEnumsComplete (n: node) : BOOLEAN ;
+BEGIN
+   CASE n^.kind OF
+
+   def   :  RETURN n^.defF.enumsComplete |
+   imp   :  RETURN n^.impF.enumsComplete |
+   module:  RETURN n^.moduleF.enumsComplete
+
+   END
+END getEnumsComplete ;
+
+
+(*
+   setEnumsComplete - sets the field inside the def or imp or module, n.
+*)
+
+PROCEDURE setEnumsComplete (n: node) ;
+BEGIN
+   CASE n^.kind OF
+
+   def   :  n^.defF.enumsComplete := TRUE |
+   imp   :  n^.impF.enumsComplete := TRUE |
+   module:  n^.moduleF.enumsComplete := TRUE
+
+   END
+END setEnumsComplete ;
+
+
+(*
+   doMakeEnum - create an enumeration type and add it to the current module.
+*)
+
+PROCEDURE doMakeEnum () : node ;
+VAR
+   e: node ;
+BEGIN
+   e := newNode (enumeration) ;
+   WITH e^ DO
+      enumerationF.noOfElements := 0 ;
+      enumerationF.localSymbols := initTree () ;
+      enumerationF.scope := getDeclScope () ;
+      enumerationF.listOfSons := InitIndex (1) ;
+      enumerationF.low := NIL ;
+      enumerationF.high := NIL ;
+   END ;
+   addEnumToModule (currentModule, e) ;
+   RETURN e
+END doMakeEnum ;
+
+
+(*
+   makeEnum - creates an enumerated type and returns the node.
+*)
+
+PROCEDURE makeEnum () : node ;
+BEGIN
+   IF (currentModule#NIL) AND getEnumsComplete (currentModule)
+   THEN
+      RETURN getNextEnum ()
+   ELSE
+      RETURN doMakeEnum ()
+   END
+END makeEnum ;
+
+
+(*
+   doMakeEnumField - create an enumeration field name and add it to enumeration e.
+                     Return the new field.
+*)
+
+PROCEDURE doMakeEnumField (e: node; n: Name) : node ;
+VAR
+   f: node ;
+BEGIN
+   assert (isEnumeration (e)) ;
+   f := lookupSym (n) ;
+   IF f=NIL
+   THEN
+      f := newNode (enumerationfield) ;
+      putSymKey (e^.enumerationF.localSymbols, n, f) ;
+      IncludeIndiceIntoIndex (e^.enumerationF.listOfSons, f) ;
+      WITH f^ DO
+         enumerationfieldF.name := n ;
+         enumerationfieldF.type := e ;
+         enumerationfieldF.scope := getDeclScope () ;
+         enumerationfieldF.value := e^.enumerationF.noOfElements ;
+         initCname (enumerationfieldF.cname)
+      END ;
+      INC (e^.enumerationF.noOfElements) ;
+      assert (GetIndice (e^.enumerationF.listOfSons, e^.enumerationF.noOfElements) = f) ;
+      addEnumToModule (currentModule, f) ;
+      IF e^.enumerationF.low = NIL
+      THEN
+         e^.enumerationF.low := f
+      END ;
+      e^.enumerationF.high := f ;
+      RETURN addToScope (f)
+   ELSE
+      metaErrors2 ('cannot create enumeration field {%1k} as the name is already in use',
+                   '{%2DMad} was declared elsewhere', n, f)
+   END ;
+   RETURN f
+END doMakeEnumField ;
+
+
+(*
+   makeEnumField - returns an enumeration field, named, n.
+*)
+
+PROCEDURE makeEnumField (e: node; n: Name) : node ;
+BEGIN
+   IF (currentModule#NIL) AND getEnumsComplete (currentModule)
+   THEN
+      RETURN getNextEnum ()
+   ELSE
+      RETURN doMakeEnumField (e, n)
+   END
+END makeEnumField ;
+
+
+(*
+   isEnumeration - returns TRUE if node, n, is an enumeration type.
+*)
+
+PROCEDURE isEnumeration (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind = enumeration
+END isEnumeration ;
+
+
+(*
+   makeExpList - creates and returns an expList node.
+*)
+
+PROCEDURE makeExpList () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (explist) ;
+   n^.explistF.exp := InitIndex (1) ;
+   RETURN n
+END makeExpList ;
+
+
+(*
+   isExpList - returns TRUE if, n, is an explist node.
+*)
+
+PROCEDURE isExpList (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = explist
+END isExpList ;
+
+
+(*
+   putExpList - places, expression, e, within the explist, n.
+*)
+
+PROCEDURE putExpList (n: node; e: node) ;
+BEGIN
+   assert (n # NIL) ;
+   assert (isExpList (n)) ;
+   PutIndice (n^.explistF.exp, HighIndice (n^.explistF.exp) + 1, e)
+END putExpList ;
+
+
+(*
+   getExpList - returns the, n, th argument in an explist.
+*)
+
+PROCEDURE getExpList (p: node; n: CARDINAL) : node ;
+BEGIN
+   assert (p#NIL) ;
+   assert (isExpList (p)) ;
+   assert (n <= HighIndice (p^.explistF.exp)) ;
+   RETURN GetIndice (p^.explistF.exp, n)
+END getExpList ;
+
+
+(*
+   expListLen - returns the length of explist, p.
+*)
+
+PROCEDURE expListLen (p: node) : CARDINAL ;
+BEGIN
+   IF p = NIL
+   THEN
+      RETURN 0
+   ELSE
+      assert (isExpList (p)) ;
+      RETURN HighIndice (p^.explistF.exp)
+   END
+END expListLen ;
+
+
+(*
+   getConstExpComplete - gets the field from the def or imp or module, n.
+*)
+
+PROCEDURE getConstExpComplete (n: node) : BOOLEAN ;
+BEGIN
+   CASE n^.kind OF
+
+   def   :  RETURN n^.defF.constsComplete |
+   imp   :  RETURN n^.impF.constsComplete |
+   module:  RETURN n^.moduleF.constsComplete
+
+   END
+END getConstExpComplete ;
+
+
+(*
+   setConstExpComplete - sets the field inside the def or imp or module, n.
+*)
+
+PROCEDURE setConstExpComplete (n: node) ;
+BEGIN
+   CASE n^.kind OF
+
+   def   :  n^.defF.constsComplete := TRUE |
+   imp   :  n^.impF.constsComplete := TRUE |
+   module:  n^.moduleF.constsComplete := TRUE
+
+   END
+END setConstExpComplete ;
+
+
+(*
+   getNextConstExp - returns the next constexp node.
+*)
+
+PROCEDURE getNextConstExp () : node ;
+VAR
+   n: node ;
+BEGIN
+   assert (isDef (currentModule) OR isImp (currentModule) OR isModule (currentModule)) ;
+   WITH currentModule^ DO
+      IF isDef (currentModule)
+      THEN
+         RETURN getNextFixup (defF.constFixup)
+      ELSIF isImp (currentModule)
+      THEN
+         RETURN getNextFixup (impF.constFixup)
+      ELSIF isModule (currentModule)
+      THEN
+         RETURN getNextFixup (moduleF.constFixup)
+      END
+   END ;
+   RETURN n
+END getNextConstExp ;
+
+
+(*
+   resetConstExpPos - resets the index into the saved list of constexps inside
+                      module, n.
+*)
+
+PROCEDURE resetConstExpPos (n: node) ;
+BEGIN
+   assert (isDef (n) OR isImp (n) OR isModule (n)) ;
+   IF isDef (n)
+   THEN
+      n^.defF.constFixup.count := 0
+   ELSIF isImp (n)
+   THEN
+      n^.impF.constFixup.count := 0
+   ELSIF isModule (n)
+   THEN
+      n^.moduleF.constFixup.count := 0
+   END
+END resetConstExpPos ;
+
+
+(*
+   addConstToModule - adds const exp, e, into the list of constant
+                      expressions in module, m.
+*)
+
+PROCEDURE addConstToModule (m, e: node) ;
+BEGIN
+   assert (isModule (m) OR isDef (m) OR isImp (m)) ;
+   IF isModule (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.moduleF.constFixup.info, e)
+   ELSIF isDef (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.defF.constFixup.info, e)
+   ELSIF isImp (m)
+   THEN
+      IncludeIndiceIntoIndex (m^.impF.constFixup.info, e)
+   END
+END addConstToModule ;
+
+
+(*
+   doMakeConstExp - create a constexp node and add it to the current module.
+*)
+
+PROCEDURE doMakeConstExp () : node ;
+VAR
+   c: node ;
+BEGIN
+   c := makeUnary (constexp, NIL, NIL) ;
+   addConstToModule (currentModule, c) ;
+   RETURN c
+END doMakeConstExp ;
+
+
+(*
+   makeConstExp - returns a constexp node.
+*)
+
+PROCEDURE makeConstExp () : node ;
+BEGIN
+   IF (currentModule#NIL) AND getConstExpComplete (currentModule)
+   THEN
+      RETURN getNextConstExp ()
+   ELSE
+      RETURN doMakeConstExp ()
+   END
+END makeConstExp ;
+
+
+(*
+   fixupConstExp - assign fixup expression, e, into the argument of, c.
+*)
+
+PROCEDURE fixupConstExp (c, e: node) : node ;
+BEGIN
+   assert (isConstExp (c)) ;
+   c^.unaryF.arg := e ;
+   RETURN c
+END fixupConstExp ;
+
+
+(*
+   isAnyType - return TRUE if node n is any type kind.
+*)
+
+PROCEDURE isAnyType (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   CASE n^.kind OF
+
+   address,
+   loc,
+   byte,
+   word,
+   char,
+   cardinal,
+   longcard,
+   shortcard,
+   integer,
+   longint,
+   shortint,
+   complex,
+   longcomplex,
+   shortcomplex,
+   bitset,
+   boolean,
+   proc,
+   type     :  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isAnyType ;
+
+
+(*
+   makeVal - creates a VAL (type, expression) node.
+*)
+
+PROCEDURE makeVal (params: node) : node ;
+BEGIN
+   assert (isExpList (params)) ;
+   IF expListLen (params) = 2
+   THEN
+      RETURN makeBinary (val,
+                         getExpList (params, 1),
+                         getExpList (params, 2),
+                         getExpList (params, 1))
+   ELSE
+      HALT
+   END
+END makeVal ;
+
+
+(*
+   makeCast - creates a cast node TYPENAME (expr).
+*)
+
+PROCEDURE makeCast (c, p: node) : node ;
+BEGIN
+   assert (isExpList (p)) ;
+   IF expListLen (p) = 1
+   THEN
+      RETURN makeBinary (cast, c, getExpList (p, 1), c)
+   ELSE
+      HALT
+   END
+END makeCast ;
+
+
+(*
+   makeIntrisicProc - create an intrinsic node.
+*)
+
+PROCEDURE makeIntrinsicProc (k: nodeT; noArgs: CARDINAL; p: node) : node ;
+VAR
+   f: node ;
+BEGIN
+   f := newNode (k) ;
+   f^.intrinsicF.args := p ;
+   f^.intrinsicF.noArgs := noArgs ;
+   f^.intrinsicF.type := NIL ;
+   f^.intrinsicF.postUnreachable := (k = halt) ;
+   initPair (f^.intrinsicF.intrinsicComment) ;
+   RETURN f
+END makeIntrinsicProc ;
+
+
+(*
+   makeIntrinsicUnaryType - create an intrisic unary type.
+*)
+
+PROCEDURE makeIntrinsicUnaryType (k: nodeT; paramList: node; returnType: node) : node ;
+BEGIN
+   RETURN makeUnary (k, getExpList (paramList, 1), returnType)
+END makeIntrinsicUnaryType ;
+
+
+(*
+   makeIntrinsicBinaryType - create an intrisic binary type.
+*)
+
+PROCEDURE makeIntrinsicBinaryType (k: nodeT; paramList: node; returnType: node) : node ;
+BEGIN
+   RETURN makeBinary (k, getExpList (paramList, 1), getExpList (paramList, 2), returnType)
+END makeIntrinsicBinaryType ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE checkIntrinsic (c, n: node) : node ;
+BEGIN
+   IF isAnyType (c)
+   THEN
+      RETURN makeCast (c, n)
+   ELSIF c = maxN
+   THEN
+      RETURN makeIntrinsicUnaryType (max, n, NIL)
+   ELSIF c = minN
+   THEN
+      RETURN makeIntrinsicUnaryType (min, n, NIL)
+   ELSIF c = haltN
+   THEN
+      RETURN makeIntrinsicProc (halt, expListLen (n), n)
+   ELSIF c = valN
+   THEN
+      RETURN makeVal (n)
+   ELSIF c = adrN
+   THEN
+      RETURN makeIntrinsicUnaryType (adr, n, addressN)
+   ELSIF c = sizeN
+   THEN
+      RETURN makeIntrinsicUnaryType (size, n, cardinalN)
+   ELSIF c = tsizeN
+   THEN
+      RETURN makeIntrinsicUnaryType (tsize, n, cardinalN)
+   ELSIF c = floatN
+   THEN
+      RETURN makeIntrinsicUnaryType (float, n, realN)
+   ELSIF c = truncN
+   THEN
+      RETURN makeIntrinsicUnaryType (trunc, n, integerN)
+   ELSIF c = ordN
+   THEN
+      RETURN makeIntrinsicUnaryType (ord, n, cardinalN)
+   ELSIF c = chrN
+   THEN
+      RETURN makeIntrinsicUnaryType (chr, n, charN)
+   ELSIF c = capN
+   THEN
+      RETURN makeIntrinsicUnaryType (cap, n, charN)
+   ELSIF c = absN
+   THEN
+      RETURN makeIntrinsicUnaryType (abs, n, NIL)
+   ELSIF c = imN
+   THEN
+      RETURN makeIntrinsicUnaryType (im, n, NIL)
+   ELSIF c = reN
+   THEN
+      RETURN makeIntrinsicUnaryType (re, n, NIL)
+   ELSIF c = cmplxN
+   THEN
+      RETURN makeIntrinsicBinaryType (cmplx, n, NIL)
+   ELSIF c = highN
+   THEN
+      RETURN makeIntrinsicUnaryType (high, n, cardinalN)
+   ELSIF c = incN
+   THEN
+      RETURN makeIntrinsicProc (inc, expListLen (n), n)
+   ELSIF c = decN
+   THEN
+      RETURN makeIntrinsicProc (dec, expListLen (n), n)
+   ELSIF c = inclN
+   THEN
+      RETURN makeIntrinsicProc (incl, expListLen (n), n)
+   ELSIF c = exclN
+   THEN
+      RETURN makeIntrinsicProc (excl, expListLen (n), n)
+   ELSIF c = newN
+   THEN
+      RETURN makeIntrinsicProc (new, 1, n)
+   ELSIF c = disposeN
+   THEN
+      RETURN makeIntrinsicProc (dispose, 1, n)
+   ELSIF c = lengthN
+   THEN
+      RETURN makeIntrinsicUnaryType (length, n, cardinalN)
+   ELSIF c = throwN
+   THEN
+      keyc.useThrow ;
+      RETURN makeIntrinsicProc (throw, 1, n)
+   END ;
+   RETURN NIL
+END checkIntrinsic ;
+
+
+(*
+   checkCHeaders - check to see if the function is a C system function and
+                   requires a header file included.
+*)
+
+PROCEDURE checkCHeaders (c: node) ;
+VAR
+   name: Name ;
+   s   : node ;
+BEGIN
+   IF isProcedure (c)
+   THEN
+      s := getScope (c) ;
+      IF getSymName (s) = makeKey ('libc')
+      THEN
+         name := getSymName (c) ;
+         IF (name = makeKey ('read')) OR
+            (name = makeKey ('write')) OR
+            (name = makeKey ('open')) OR
+            (name = makeKey ('close'))
+         THEN
+            keyc.useUnistd
+         END
+      END
+   END
+END checkCHeaders ;
+
+
+(*
+   makeFuncCall - builds a function call to c with param list, n.
+*)
+
+PROCEDURE makeFuncCall (c, n: node) : node ;
+VAR
+   f: node ;
+BEGIN
+   assert ((n=NIL) OR isExpList (n)) ;
+   IF (c = haltN) AND
+      (getMainModule () # lookupDef (makeKey ('M2RTS'))) AND
+      (getMainModule () # lookupImp (makeKey ('M2RTS')))
+   THEN
+      addImportedModule (getMainModule (), lookupDef (makeKey ('M2RTS')), FALSE)
+   END ;
+   f := checkIntrinsic (c, n) ;
+   checkCHeaders (c) ;
+   IF f = NIL
+   THEN
+      f := newNode (funccall) ;
+      f^.funccallF.function := c ;
+      f^.funccallF.args := n ;
+      f^.funccallF.type := NIL ;
+      initPair (f^.funccallF.funccallComment)
+   END ;
+   RETURN f
+END makeFuncCall ;
+
+
+(*
+   isFuncCall - returns TRUE if, n, is a function/procedure call.
+*)
+
+PROCEDURE isFuncCall (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = funccall
+END isFuncCall ;
+
+
+(*
+   putType - places, exp, as the type alias to des.
+             TYPE des = exp ;
+*)
+
+PROCEDURE putType (des, exp: node) ;
+BEGIN
+   assert (des#NIL) ;
+   assert (isType (des)) ;
+   des^.typeF.type := exp
+END putType ;
+
+
+(*
+   putTypeHidden - marks type, des, as being a hidden type.
+                   TYPE des ;
+*)
+
+PROCEDURE putTypeHidden (des: node) ;
+VAR
+   s: node ;
+BEGIN
+   assert (des#NIL) ;
+   assert (isType (des)) ;
+   des^.typeF.isHidden := TRUE ;
+   s := getScope (des) ;
+   assert (isDef (s)) ;
+   s^.defF.hasHidden := TRUE
+END putTypeHidden ;
+
+
+(*
+   isTypeHidden - returns TRUE if type, n, is hidden.
+*)
+
+PROCEDURE isTypeHidden (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   assert (isType (n)) ;
+   RETURN n^.typeF.isHidden
+END isTypeHidden ;
+
+
+(*
+   hasHidden - returns TRUE if module, n, has a hidden type.
+*)
+
+PROCEDURE hasHidden (n: node) : BOOLEAN ;
+BEGIN
+   assert (isDef (n)) ;
+   RETURN n^.defF.hasHidden
+END hasHidden ;
+
+
+(*
+   putTypeInternal - marks type, des, as being an internally generated type.
+*)
+
+PROCEDURE putTypeInternal (des: node) ;
+BEGIN
+   assert (des#NIL) ;
+   assert (isType (des)) ;
+   des^.typeF.isInternal := TRUE
+END putTypeInternal ;
+
+
+(*
+   isTypeInternal - returns TRUE if type, n, is internal.
+*)
+
+PROCEDURE isTypeInternal (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   assert (isType (n)) ;
+   RETURN n^.typeF.isInternal
+END isTypeInternal ;
+
+
+(*
+   putConst - places value, v, into node, n.
+*)
+
+PROCEDURE putConst (n: node; v: node) ;
+BEGIN
+   assert (isConst (n)) ;
+   n^.constF.value := v
+END putConst ;
+
+
+(*
+   makeLiteralInt - creates and returns a literal node based on an integer type.
+*)
+
+PROCEDURE makeLiteralInt (n: Name) : node ;
+VAR
+   m: node ;
+   s: String ;
+BEGIN
+   m := newNode (literal) ;
+   s := InitStringCharStar (keyToCharStar (n)) ;
+   WITH m^ DO
+      literalF.name := n ;
+      IF DynamicStrings.char (s, -1)='C'
+      THEN
+         literalF.type := charN
+      ELSE
+         literalF.type := ztypeN
+      END
+   END ;
+   s := KillString (s) ;
+   RETURN m
+END makeLiteralInt ;
+
+
+(*
+   makeLiteralReal - creates and returns a literal node based on a real type.
+*)
+
+PROCEDURE makeLiteralReal (n: Name) : node ;
+VAR
+   m: node ;
+BEGIN
+   m := newNode (literal) ;
+   WITH m^ DO
+      literalF.name := n ;
+      literalF.type := rtypeN
+   END ;
+   RETURN m
+END makeLiteralReal ;
+
+
+(*
+   makeString - creates and returns a node containing string, n.
+*)
+
+PROCEDURE makeString (n: Name) : node ;
+VAR
+   m: node ;
+BEGIN
+   m := newNode (string) ;
+   WITH m^ DO
+      stringF.name := n ;
+      stringF.length := lengthKey (n) ;
+      stringF.isCharCompatible := (stringF.length <= 3) ;
+      stringF.cstring := toCstring (n) ;
+      stringF.clength := lenCstring (stringF.cstring) ;
+      IF stringF.isCharCompatible
+      THEN
+         stringF.cchar := toCchar (n)
+      ELSE
+         stringF.cchar := NIL
+      END
+   END ;
+   RETURN m
+END makeString ;
+
+
+(*
+   getBuiltinConst - creates and returns a builtin const if available.
+*)
+
+PROCEDURE getBuiltinConst (n: Name) : node ;
+BEGIN
+   IF n=makeKey ('BITS_PER_UNIT')
+   THEN
+      RETURN bitsperunitN
+   ELSIF n=makeKey ('BITS_PER_WORD')
+   THEN
+      RETURN bitsperwordN
+   ELSIF n=makeKey ('BITS_PER_CHAR')
+   THEN
+      RETURN bitspercharN
+   ELSIF n=makeKey ('UNITS_PER_WORD')
+   THEN
+      RETURN unitsperwordN
+   ELSE
+      RETURN NIL
+   END
+END getBuiltinConst ;
+
+
+(*
+   lookupInScope - looks up a symbol named, n, from, scope.
+*)
+
+PROCEDURE lookupInScope (scope: node; n: Name) : node ;
+BEGIN
+   CASE scope^.kind OF
+
+   def      :  RETURN getSymKey (scope^.defF.decls.symbols, n) |
+   module   :  RETURN getSymKey (scope^.moduleF.decls.symbols, n) |
+   imp      :  RETURN getSymKey (scope^.impF.decls.symbols, n) |
+   procedure:  RETURN getSymKey (scope^.procedureF.decls.symbols, n) |
+   record   :  RETURN getSymKey (scope^.recordF.localSymbols, n)
+
+   END
+END lookupInScope ;
+
+
+(*
+   lookupBase - return node named n from the base symbol scope.
+*)
+
+PROCEDURE lookupBase (n: Name) : node ;
+VAR
+   m: node ;
+BEGIN
+   m := getSymKey (baseSymbols, n) ;
+   IF m=procN
+   THEN
+      keyc.useProc
+   ELSIF (m=complexN) OR (m=longcomplexN) OR (m=shortcomplexN)
+   THEN
+      keyc.useComplex
+   END ;
+   RETURN m
+END lookupBase ;
+
+
+(*
+   dumpScopes - display the names of all the scopes stacked.
+*)
+
+PROCEDURE dumpScopes ;
+VAR
+   h: CARDINAL ;
+   s: node ;
+BEGIN
+   h := HighIndice (scopeStack) ;
+   printf ("total scopes stacked %d\n", h);
+
+   WHILE h>=1 DO
+      s := GetIndice (scopeStack, h) ;
+      out2 (" scope [%d] is %s\n", h, s) ;
+      DEC (h)
+   END
+END dumpScopes ;
+
+
+(*
+   out0 - write string a to StdOut.
+*)
+
+PROCEDURE out0 (a: ARRAY OF CHAR) ;
+VAR
+   m: String ;
+BEGIN
+   m := Sprintf0 (InitString (a)) ;
+   m := KillString (WriteS (StdOut, m))
+END out0 ;
+
+
+(*
+   out1 - write string a to StdOut using format specifier a.
+*)
+
+PROCEDURE out1 (a: ARRAY OF CHAR; s: node) ;
+VAR
+   m: String ;
+   d: CARDINAL ;
+BEGIN
+   m := getFQstring (s) ;
+   IF EqualArray (m, '')
+   THEN
+      d := VAL (CARDINAL, VAL (LONGCARD, s)) ;
+      m := KillString (m) ;
+      m := Sprintf1 (InitString ('[%d]'), d)
+   END ;
+   m := Sprintf1 (InitString (a), m) ;
+   m := KillString (WriteS (StdOut, m))
+END out1 ;
+
+
+(*
+   out2 - write string a to StdOut using format specifier a.
+*)
+
+PROCEDURE out2 (a: ARRAY OF CHAR; c: CARDINAL; s: node) ;
+VAR
+   m, m1: String ;
+BEGIN
+   m1 := getString (s) ;
+   m := Sprintf2 (InitString (a), c, m1) ;
+   m := KillString (WriteS (StdOut, m)) ;
+   m1 := KillString (m1)
+END out2 ;
+
+
+(*
+   out3 - write string a to StdOut using format specifier a.
+*)
+
+PROCEDURE out3 (a: ARRAY OF CHAR; l: CARDINAL; n: Name; s: node) ;
+VAR
+   m, m1, m2: String ;
+BEGIN
+   m1 := InitStringCharStar (keyToCharStar (n)) ;
+   m2 := getString (s) ;
+   m := Sprintf3 (InitString (a), l, m1, m2) ;
+   m := KillString (WriteS (StdOut, m)) ;
+   m1 := KillString (m1) ;
+   m2 := KillString (m2)
+END out3 ;
+
+
+(*
+   lookupSym - returns the symbol named, n, from the scope stack.
+*)
+
+PROCEDURE lookupSym (n: Name) : node ;
+VAR
+   s, m: node ;
+   l, h: CARDINAL ;
+BEGIN
+   l := LowIndice (scopeStack) ;
+   h := HighIndice (scopeStack) ;
+
+   WHILE h>=l DO
+      s := GetIndice (scopeStack, h) ;
+      m := lookupInScope (s, n) ;
+      IF debugScopes AND (m=NIL)
+      THEN
+         out3 (" [%d] search for symbol name %s in scope %s\n", h, n, s)
+      END ;
+      IF m#NIL
+      THEN
+         IF debugScopes
+         THEN
+            out3 (" [%d] search for symbol name %s in scope %s (found)\n", h, n, s)
+         END ;
+         RETURN m
+      END ;
+      DEC (h)
+   END ;
+   RETURN lookupBase (n)
+END lookupSym ;
+
+
+(*
+   getSymName - returns the name of symbol, n.
+*)
+
+PROCEDURE getSymName (n: node) : Name ;
+BEGIN
+   WITH n^ DO
+      CASE kind OF
+
+      new             :  RETURN makeKey ('NEW') |
+      dispose         :  RETURN makeKey ('DISPOSE') |
+      length          :  RETURN makeKey ('LENGTH') |
+      inc             :  RETURN makeKey ('INC') |
+      dec             :  RETURN makeKey ('DEC') |
+      incl            :  RETURN makeKey ('INCL') |
+      excl            :  RETURN makeKey ('EXCL') |
+      nil             :  RETURN makeKey ('NIL') |
+      true            :  RETURN makeKey ('TRUE') |
+      false           :  RETURN makeKey ('FALSE') |
+      address         :  RETURN makeKey ('ADDRESS') |
+      loc             :  RETURN makeKey ('LOC') |
+      byte            :  RETURN makeKey ('BYTE') |
+      word            :  RETURN makeKey ('WORD') |
+      csizet          :  RETURN makeKey ('CSIZE_T') |
+      cssizet         :  RETURN makeKey ('CSSIZE_T') |
+      (* base types.  *)
+      boolean         :  RETURN makeKey ('BOOLEAN') |
+      proc            :  RETURN makeKey ('PROC') |
+      char            :  RETURN makeKey ('CHAR') |
+      cardinal        :  RETURN makeKey ('CARDINAL') |
+      longcard        :  RETURN makeKey ('LONGCARD') |
+      shortcard       :  RETURN makeKey ('SHORTCARD') |
+      integer         :  RETURN makeKey ('INTEGER') |
+      longint         :  RETURN makeKey ('LONGINT') |
+      shortint        :  RETURN makeKey ('SHORTINT') |
+      real            :  RETURN makeKey ('REAL') |
+      longreal        :  RETURN makeKey ('LONGREAL') |
+      shortreal       :  RETURN makeKey ('SHORTREAL') |
+      bitset          :  RETURN makeKey ('BITSET') |
+      ztype           :  RETURN makeKey ('_ZTYPE') |
+      rtype           :  RETURN makeKey ('_RTYPE') |
+      complex         :  RETURN makeKey ('COMPLEX') |
+      longcomplex     :  RETURN makeKey ('LONGCOMPLEX') |
+      shortcomplex    :  RETURN makeKey ('SHORTCOMPLEX') |
+
+      (* language features and compound type attributes.  *)
+      type            :  RETURN typeF.name |
+      record          :  RETURN NulName |
+      varient         :  RETURN NulName |
+      var             :  RETURN varF.name |
+      enumeration     :  RETURN NulName |
+      subrange        :  RETURN NulName |
+      pointer         :  RETURN NulName |
+      array           :  RETURN NulName |
+      string          :  RETURN stringF.name |
+      const           :  RETURN constF.name |
+      literal         :  RETURN literalF.name |
+      varparam        :  RETURN NulName |
+      param           :  RETURN NulName |
+      optarg          :  RETURN NulName |
+      recordfield     :  RETURN recordfieldF.name |
+      varientfield    :  RETURN varientfieldF.name |
+      enumerationfield:  RETURN enumerationfieldF.name |
+      set             :  RETURN NulName |
+      proctype        :  RETURN NulName |
+      subscript       :  RETURN NulName |
+      (* blocks.  *)
+      procedure       :  RETURN procedureF.name |
+      def             :  RETURN defF.name |
+      imp             :  RETURN impF.name |
+      module          :  RETURN moduleF.name |
+      (* statements.  *)
+      loop,
+      while,
+      for,
+      repeat,
+      if,
+      elsif,
+      assignment      :  RETURN NulName |
+      (* expressions.  *)
+      constexp,
+      deref,
+      arrayref,
+      componentref,
+      cast,
+      val,
+      plus,
+      sub,
+      div,
+      mod,
+      mult,
+      divide,
+      in,
+      neg,
+      equal,
+      notequal,
+      less,
+      greater,
+      greequal,
+      lessequal       :  RETURN NulName |
+      adr             :  RETURN makeKey ('ADR') |
+      size            :  RETURN makeKey ('SIZE') |
+      tsize           :  RETURN makeKey ('TSIZE') |
+      chr             :  RETURN makeKey ('CHR') |
+      abs             :  RETURN makeKey ('ABS') |
+      ord             :  RETURN makeKey ('ORD') |
+      float           :  RETURN makeKey ('FLOAT') |
+      trunc           :  RETURN makeKey ('TRUNC') |
+      high            :  RETURN makeKey ('HIGH') |
+      throw           :  RETURN makeKey ('THROW') |
+      unreachable     :  RETURN makeKey ('builtin_unreachable') |
+      cmplx           :  RETURN makeKey ('CMPLX') |
+      re              :  RETURN makeKey ('RE') |
+      im              :  RETURN makeKey ('IM') |
+      max             :  RETURN makeKey ('MAX') |
+      min             :  RETURN makeKey ('MIN') |
+      funccall        :  RETURN NulName |
+      identlist       :  RETURN NulName
+
+      ELSE
+         HALT
+      END
+   END
+END getSymName ;
+
+
+(*
+   isUnary - returns TRUE if, n, is an unary node.
+*)
+
+PROCEDURE isUnary (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   CASE n^.kind OF
+
+   length,
+   re,
+   im,
+   deref,
+   high,
+   chr,
+   cap,
+   abs,
+   ord,
+   float,
+   trunc,
+   constexp,
+   not,
+   neg,
+   adr,
+   size,
+   tsize,
+   min,
+   max     :  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isUnary ;
+
+
+(*
+   isBinary - returns TRUE if, n, is an binary node.
+*)
+
+PROCEDURE isBinary (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   CASE n^.kind OF
+
+   cmplx,
+   and,
+   or,
+   equal,
+   notequal,
+   less,
+   greater,
+   greequal,
+   lessequal,
+   val,
+   cast,
+   plus,
+   sub,
+   div,
+   mod,
+   mult,
+   divide,
+   in      :  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isBinary ;
+
+
+(*
+   makeUnary - create a unary expression node with, e, as the argument
+               and res as the return type.
+*)
+
+PROCEDURE makeUnary (k: nodeT; e: node; res: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   IF k=plus
+   THEN
+      RETURN e
+   ELSE
+      n := newNode (k) ;
+      WITH n^ DO
+         CASE kind OF
+
+         min,
+         max,
+         throw,
+         re,
+         im,
+         deref,
+         high,
+         chr,
+	 cap,
+         abs,
+         ord,
+         float,
+         trunc,
+         length,
+         constexp,
+         not,
+         neg,
+         adr,
+         size,
+         tsize:  WITH unaryF DO
+                    arg := e ;
+                    resultType := res
+                 END
+
+         END
+      END
+   END ;
+   RETURN n
+END makeUnary ;
+
+
+(*
+   isLeafString - returns TRUE if n is a leaf node which is a string constant.
+*)
+
+PROCEDURE isLeafString (n: node) : BOOLEAN ;
+BEGIN
+   RETURN isString (n) OR
+          (isLiteral (n) AND (getType (n) = charN)) OR
+	  (isConst (n) AND (getExprType (n) = charN))
+END isLeafString ;
+
+
+(*
+   getLiteralStringContents - return the contents of a literal node as a string.
+*)
+
+PROCEDURE getLiteralStringContents (n: node) : String ;
+VAR
+   number,
+   content,
+   s      : String ;
+BEGIN
+   assert (n^.kind = literal) ;
+   s := InitStringCharStar (keyToCharStar (n^.literalF.name)) ;
+   content := NIL ;
+   IF n^.literalF.type = charN
+   THEN
+      IF DynamicStrings.char (s, -1) = 'C'
+      THEN
+         IF DynamicStrings.Length (s) > 1
+         THEN
+            number := DynamicStrings.Slice (s, 0, -1) ;
+            content := DynamicStrings.InitStringChar (VAL (CHAR, ostoc (number))) ;
+            number := DynamicStrings.KillString (number)
+         ELSE
+            content := DynamicStrings.InitStringChar ('C')
+         END
+      ELSE
+         content := DynamicStrings.Dup (s)
+      END
+   ELSE
+      metaError1 ('cannot obtain string contents from {%1k}', n^.literalF.name)
+   END ;
+   s := DynamicStrings.KillString (s) ;
+   RETURN content
+END getLiteralStringContents ;
+
+
+(*
+   getStringContents - return the string contents of a constant, literal,
+                       string or a constexp node.
+*)
+
+PROCEDURE getStringContents (n: node) : String ;
+BEGIN
+   IF isConst (n)
+   THEN
+      RETURN getStringContents (n^.constF.value)
+   ELSIF isLiteral (n)
+   THEN
+      RETURN getLiteralStringContents (n)
+   ELSIF isString (n)
+   THEN
+      RETURN getString (n)
+   ELSIF isConstExp (n)
+   THEN
+      RETURN getStringContents (n^.unaryF.arg)
+   END ;
+   HALT
+END getStringContents ;
+
+
+(*
+   addNames -
+*)
+
+PROCEDURE addNames (a, b: node) : Name ;
+VAR
+   sa, sb: String ;
+   n     : Name ;
+BEGIN
+   sa := DynamicStrings.InitStringCharStar (keyToCharStar (getSymName (a))) ;
+   sb := DynamicStrings.InitStringCharStar (keyToCharStar (getSymName (b))) ;
+   sa := ConCat (sa, sb) ;
+   n := makekey (DynamicStrings.string (sa)) ;
+   sa := KillString (sa) ;
+   sb := KillString (sb) ;
+   RETURN n
+END addNames ;
+
+
+(*
+   resolveString -
+*)
+
+PROCEDURE resolveString (n: node) : node ;
+BEGIN
+   WHILE isConst (n) OR isConstExp (n) DO
+      IF isConst (n)
+      THEN
+         n := n^.constF.value
+      ELSE
+         n := n^.unaryF.arg
+      END
+   END ;
+   IF n^.kind = plus
+   THEN
+      n := makeString (addNames (resolveString (n^.binaryF.left),
+                                 resolveString (n^.binaryF.right)))
+   END ;
+   RETURN n
+END resolveString ;
+
+
+(*
+   foldBinary -
+*)
+
+PROCEDURE foldBinary (k: nodeT; l, r: node; res: node) : node ;
+VAR
+   n : node ;
+   ls,
+   rs: String ;
+BEGIN
+   n := NIL ;
+   IF (k = plus) AND isLeafString (l) AND isLeafString (r)
+   THEN
+      ls := getStringContents (l) ;
+      rs := getStringContents (r) ;
+      ls := DynamicStrings.Add (ls, rs) ;
+      n := makeString (makekey (DynamicStrings.string (ls))) ;
+      ls := DynamicStrings.KillString (ls) ;
+      rs := DynamicStrings.KillString (rs)
+   END ;
+   RETURN n
+END foldBinary ;
+
+
+(*
+   makeBinary - create a binary node with left/right/result type:  l, r and resultType.
+*)
+
+PROCEDURE makeBinary (k: nodeT; l, r: node; resultType: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := foldBinary (k, l, r, resultType) ;
+   IF n = NIL
+   THEN
+      n := doMakeBinary (k, l, r, resultType)
+   END ;
+   RETURN n
+END makeBinary ;
+
+
+(*
+   doMakeBinary - returns a binary node containing left/right/result values
+                  l, r, res, with a node operator, k.
+*)
+
+PROCEDURE doMakeBinary (k: nodeT; l, r: node; res: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (k) ;
+   WITH n^ DO
+      CASE kind OF
+
+      cmplx,
+      equal,
+      notequal,
+      less,
+      greater,
+      greequal,
+      lessequal,
+      and,
+      or,
+      cast,
+      val,
+      plus,
+      sub,
+      div,
+      mod,
+      mult,
+      divide,
+      in  :  WITH binaryF DO
+                left := l ;
+                right := r ;
+                resultType := res
+             END
+
+      END
+   END ;
+   RETURN n
+END doMakeBinary ;
+
+
+(*
+   doMakeComponentRef -
+*)
+
+PROCEDURE doMakeComponentRef (rec, field: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (componentref) ;
+   n^.componentrefF.rec := rec ;
+   n^.componentrefF.field := field ;
+   n^.componentrefF.resultType := getType (field) ;
+   RETURN n
+END doMakeComponentRef ;
+
+
+(*
+   makeComponentRef - build a componentref node which accesses, field,
+                      within, record, rec.
+*)
+
+PROCEDURE makeComponentRef (rec, field: node) : node ;
+VAR
+   n, a: node ;
+BEGIN
+(*
+   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)
+   THEN
+      a := rec^.unaryF.arg ;
+      rec^.kind := pointerref ;
+      rec^.pointerrefF.ptr := a ;
+      rec^.pointerrefF.field := field ;
+      rec^.pointerrefF.resultType := getType (field) ;
+      RETURN rec
+   ELSE
+      RETURN doMakeComponentRef (rec, field)
+   END
+END makeComponentRef ;
+
+
+(*
+   isComponentRef -
+*)
+
+PROCEDURE isComponentRef (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = componentref
+END isComponentRef ;
+
+
+(*
+   makePointerRef - build a pointerref node which accesses, field,
+                    within, pointer to record, ptr.
+*)
+
+PROCEDURE makePointerRef (ptr, field: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (pointerref) ;
+   n^.pointerrefF.ptr := ptr ;
+   n^.pointerrefF.field := field ;
+   n^.pointerrefF.resultType := getType (field) ;
+   RETURN n
+END makePointerRef ;
+
+
+(*
+   isPointerRef - returns TRUE if, n, is a pointerref node.
+*)
+
+PROCEDURE isPointerRef (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = pointerref
+END isPointerRef ;
+
+
+(*
+   makeArrayRef - build an arrayref node which access element,
+                  index, in, array.  array is a variable/expression/constant
+                  which has a type array.
+*)
+
+PROCEDURE makeArrayRef (array, index: node) : node ;
+VAR
+   n, t: node ;
+   i, j: CARDINAL ;
+BEGIN
+   n := newNode (arrayref) ;
+   n^.arrayrefF.array := array ;
+   n^.arrayrefF.index := index ;
+   t := array ;
+   j := expListLen (index) ;
+   i := 1 ;
+   t := skipType (getType (t)) ;
+   REPEAT
+      IF isArray (t)
+      THEN
+         t := skipType (getType (t))
+      ELSE
+         metaError2 ('cannot access {%1N} dimension of array {%2a}', i, t)
+      END ;
+      INC (i)
+   UNTIL i > j ;
+   n^.arrayrefF.resultType := t ;
+   RETURN n
+END makeArrayRef ;
+
+
+(*
+   isArrayRef - returns TRUE if the node was an arrayref.
+*)
+
+PROCEDURE isArrayRef (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = arrayref
+END isArrayRef ;
+
+
+(*
+   makeDeRef - dereferences the pointer defined by, n.
+*)
+
+PROCEDURE makeDeRef (n: node) : node ;
+VAR
+   t: node ;
+BEGIN
+   t := skipType (getType (n)) ;
+   assert (isPointer (t)) ;
+   RETURN makeUnary (deref, n, getType (t))
+END makeDeRef ;
+
+
+(*
+   isDeref - returns TRUE if, n, is a deref node.
+*)
+
+PROCEDURE isDeref (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = deref
+END isDeref ;
+
+
+(*
+   makeBase - create a base type or constant.
+              It only supports the base types and constants
+              enumerated below.
+*)
+
+PROCEDURE makeBase (k: nodeT) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (k) ;
+   WITH n^ DO
+      CASE k OF
+
+      new,
+      dispose,
+      length,
+      inc,
+      dec,
+      incl,
+      excl,
+      nil,
+      true,
+      false,
+      address,
+      loc,
+      byte,
+      word,
+      csizet,
+      cssizet,
+      char,
+      cardinal,
+      longcard,
+      shortcard,
+      integer,
+      longint,
+      shortint,
+      real,
+      longreal,
+      shortreal,
+      bitset,
+      boolean,
+      proc,
+      ztype,
+      rtype,
+      complex,
+      longcomplex,
+      shortcomplex,
+      adr,
+      chr,
+      cap,
+      abs,
+      float,
+      trunc,
+      ord,
+      high,
+      throw,
+      re,
+      im,
+      cmplx,
+      size,
+      tsize,
+      val,
+      min,
+      max     :  (* legal kind.  *) |
+
+      ELSE
+         HALT
+      END
+   END ;
+   RETURN n
+END makeBase ;
+
+
+(*
+   makeBinaryTok - creates and returns a boolean type node with,
+                   l, and, r, nodes.
+*)
+
+PROCEDURE makeBinaryTok (op: toktype; l, r: node) : node ;
+BEGIN
+   IF op=equaltok
+   THEN
+      RETURN makeBinary (equal, l, r, booleanN)
+   ELSIF (op=hashtok) OR (op=lessgreatertok)
+   THEN
+      RETURN makeBinary (notequal, l, r, booleanN)
+   ELSIF op=lesstok
+   THEN
+      RETURN makeBinary (less, l, r, booleanN)
+   ELSIF op=greatertok
+   THEN
+      RETURN makeBinary (greater, l, r, booleanN)
+   ELSIF op=greaterequaltok
+   THEN
+      RETURN makeBinary (greequal, l, r, booleanN)
+   ELSIF op=lessequaltok
+   THEN
+      RETURN makeBinary (lessequal, l, r, booleanN)
+   ELSIF op=andtok
+   THEN
+      RETURN makeBinary (and, l, r, booleanN)
+   ELSIF op=ortok
+   THEN
+      RETURN makeBinary (or, l, r, booleanN)
+   ELSIF op=plustok
+   THEN
+      RETURN makeBinary (plus, l, r, NIL)
+   ELSIF op=minustok
+   THEN
+      RETURN makeBinary (sub, l, r, NIL)
+   ELSIF op=divtok
+   THEN
+      RETURN makeBinary (div, l, r, NIL)
+   ELSIF op=timestok
+   THEN
+      RETURN makeBinary (mult, l, r, NIL)
+   ELSIF op=modtok
+   THEN
+      RETURN makeBinary (mod, l, r, NIL)
+   ELSIF op=intok
+   THEN
+      RETURN makeBinary (in, l, r, NIL)
+   ELSIF op=dividetok
+   THEN
+      RETURN makeBinary (divide, l, r, NIL)
+   ELSE
+      HALT  (* most likely op needs a clause as above.  *)
+   END
+END makeBinaryTok ;
+
+
+(*
+   makeUnaryTok - creates and returns a boolean type node with,
+                  e, node.
+*)
+
+PROCEDURE makeUnaryTok (op: toktype; e: node) : node ;
+BEGIN
+   IF op=nottok
+   THEN
+      RETURN makeUnary (not, e, booleanN)
+   ELSIF op=plustok
+   THEN
+      RETURN makeUnary (plus, e, NIL)
+   ELSIF op=minustok
+   THEN
+      RETURN makeUnary (neg, e, NIL)
+   ELSE
+      HALT  (* most likely op needs a clause as above.  *)
+   END
+END makeUnaryTok ;
+
+
+(*
+   isOrdinal - returns TRUE if, n, is an ordinal type.
+*)
+
+PROCEDURE isOrdinal (n: node) : BOOLEAN ;
+BEGIN
+   CASE n^.kind OF
+
+   address,
+   loc,
+   byte,
+   word,
+   csizet,
+   cssizet,
+   char,
+   integer,
+   longint,
+   shortint,
+   cardinal,
+   longcard,
+   shortcard,
+   bitset   :  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isOrdinal ;
+
+
+(*
+   getType - returns the type associated with node, n.
+*)
+
+PROCEDURE getType (n: node) : node ;
+BEGIN
+   WITH n^ DO
+      CASE kind OF
+
+      new,
+      dispose         :  RETURN NIL |
+      length          :  RETURN cardinalN |
+      inc,
+      dec,
+      incl,
+      excl            :  RETURN NIL |
+      nil             :  RETURN addressN |
+      true,
+      false           :  RETURN booleanN |
+      address         :  RETURN n |
+      loc             :  RETURN n |
+      byte            :  RETURN n |
+      word            :  RETURN n |
+      csizet          :  RETURN n |
+      cssizet         :  RETURN n |
+      (* base types.  *)
+      boolean         :  RETURN n |
+      proc            :  RETURN n |
+      char            :  RETURN n |
+      cardinal        :  RETURN n |
+      longcard        :  RETURN n |
+      shortcard       :  RETURN n |
+      integer         :  RETURN n |
+      longint         :  RETURN n |
+      shortint        :  RETURN n |
+      real            :  RETURN n |
+      longreal        :  RETURN n |
+      shortreal       :  RETURN n |
+      bitset          :  RETURN n |
+      ztype           :  RETURN n |
+      rtype           :  RETURN n |
+      complex         :  RETURN n |
+      longcomplex     :  RETURN n |
+      shortcomplex    :  RETURN n |
+
+      (* language features and compound type attributes.  *)
+      type            :  RETURN typeF.type |
+      record          :  RETURN n |
+      varient         :  RETURN n |
+      var             :  RETURN varF.type |
+      enumeration     :  RETURN n |
+      subrange        :  RETURN subrangeF.type |
+      array           :  RETURN arrayF.type |
+      string          :  RETURN charN |
+      const           :  RETURN constF.type |
+      literal         :  RETURN literalF.type |
+      varparam        :  RETURN varparamF.type |
+      param           :  RETURN paramF.type |
+      optarg          :  RETURN optargF.type |
+      pointer         :  RETURN pointerF.type |
+      recordfield     :  RETURN recordfieldF.type |
+      varientfield    :  RETURN n |
+      enumerationfield:  RETURN enumerationfieldF.type |
+      set             :  RETURN setF.type |
+      proctype        :  RETURN proctypeF.returnType |
+      subscript       :  RETURN subscriptF.type |
+      (* blocks.  *)
+      procedure       :  RETURN procedureF.returnType |
+      throw           :  RETURN NIL |
+      unreachable     :  RETURN NIL |
+      def,
+      imp,
+      module,
+      (* statements.  *)
+      loop,
+      while,
+      for,
+      repeat,
+      if,
+      elsif,
+      assignment      :  HALT |
+      (* expressions.  *)
+      cmplx,
+      cast,
+      val,
+      plus,
+      sub,
+      div,
+      mod,
+      mult,
+      divide          :  RETURN binaryF.resultType |
+      in              :  RETURN booleanN |
+      max,
+      min,
+      re,
+      im,
+      abs,
+      constexp,
+      deref,
+      neg,
+      adr,
+      size,
+      tsize           :  RETURN unaryF.resultType |
+      and,
+      or,
+      not,
+      equal,
+      notequal,
+      less,
+      greater,
+      greequal,
+      lessequal       :  RETURN booleanN |
+      trunc           :  RETURN integerN |
+      float           :  RETURN realN |
+      high            :  RETURN cardinalN |
+      ord             :  RETURN cardinalN |
+      chr             :  RETURN charN |
+      cap             :  RETURN charN |
+      arrayref        :  RETURN arrayrefF.resultType |
+      componentref    :  RETURN componentrefF.resultType |
+      pointerref      :  RETURN pointerrefF.resultType |
+      funccall        :  RETURN funccallF.type |
+      setvalue        :  RETURN setvalueF.type
+
+      END
+   END ;
+   HALT
+END getType ;
+
+
+(*
+   mixTypes -
+*)
+
+PROCEDURE mixTypes (a, b: node) : node ;
+BEGIN
+   IF (a = addressN) OR (b = addressN)
+   THEN
+      RETURN addressN
+   END ;
+   RETURN a
+END mixTypes ;
+
+
+(*
+   doSetExprType -
+*)
+
+PROCEDURE doSetExprType (VAR t: node; n: node) : node ;
+BEGIN
+   IF t = NIL
+   THEN
+      t := n
+   END ;
+   RETURN t
+END doSetExprType ;
+
+
+(*
+   getMaxMinType -
+*)
+
+PROCEDURE getMaxMinType (n: node) : node ;
+BEGIN
+   IF isVar (n) OR isConst (n)
+   THEN
+      RETURN getType (n)
+   ELSIF isConstExp (n)
+   THEN
+      n := getExprType (n^.unaryF.arg) ;
+      IF n = bitsetN
+      THEN
+         RETURN ztypeN
+      ELSE
+         RETURN n
+      END
+   ELSE
+      RETURN n
+   END
+END getMaxMinType ;
+
+
+(*
+   doGetFuncType -
+*)
+
+PROCEDURE doGetFuncType (n: node) : node ;
+BEGIN
+   assert (isFuncCall (n)) ;
+   RETURN doSetExprType (n^.funccallF.type, getType (n^.funccallF.function))
+END doGetFuncType ;
+
+
+(*
+   doGetExprType - works out the type which is associated with node, n.
+*)
+
+PROCEDURE doGetExprType (n: node) : node ;
+BEGIN
+   WITH n^ DO
+      CASE kind OF
+
+      max,
+      min             :  RETURN getMaxMinType (n^.unaryF.arg) |
+      cast,
+      val             :  RETURN doSetExprType (n^.binaryF.resultType, n^.binaryF.left) |
+      halt,
+      new,
+      dispose         :  RETURN NIL |
+      inc,
+      dec,
+      incl,
+      excl            :  RETURN NIL |
+      nil             :  RETURN addressN |
+      true,
+      false           :  RETURN booleanN |
+      address         :  RETURN n |
+      loc             :  RETURN n |
+      byte            :  RETURN n |
+      word            :  RETURN n |
+      csizet          :  RETURN n |
+      cssizet         :  RETURN n |
+      (* base types.  *)
+      boolean         :  RETURN n |
+      proc            :  RETURN n |
+      char            :  RETURN n |
+      cardinal        :  RETURN n |
+      longcard        :  RETURN n |
+      shortcard       :  RETURN n |
+      integer         :  RETURN n |
+      longint         :  RETURN n |
+      shortint        :  RETURN n |
+      real            :  RETURN n |
+      longreal        :  RETURN n |
+      shortreal       :  RETURN n |
+      bitset          :  RETURN n |
+      ztype           :  RETURN n |
+      rtype           :  RETURN n |
+      complex         :  RETURN n |
+      longcomplex     :  RETURN n |
+      shortcomplex    :  RETURN n |
+
+      (* language features and compound type attributes.  *)
+      type            :  RETURN typeF.type |
+      record          :  RETURN n |
+      varient         :  RETURN n |
+      var             :  RETURN varF.type |
+      enumeration     :  RETURN n |
+      subrange        :  RETURN subrangeF.type |
+      array           :  RETURN arrayF.type |
+      string          :  RETURN charN |
+      const           :  RETURN doSetExprType (constF.type, getExprType (constF.value)) |
+      literal         :  RETURN literalF.type |
+      varparam        :  RETURN varparamF.type |
+      param           :  RETURN paramF.type |
+      optarg          :  RETURN optargF.type |
+      pointer         :  RETURN pointerF.type |
+      recordfield     :  RETURN recordfieldF.type |
+      varientfield    :  RETURN n |
+      enumerationfield:  RETURN enumerationfieldF.type |
+      set             :  RETURN setF.type |
+      proctype        :  RETURN proctypeF.returnType |
+      subscript       :  RETURN subscriptF.type |
+      (* blocks.  *)
+      procedure       :  RETURN procedureF.returnType |
+      throw           :  RETURN NIL |
+      unreachable     :  RETURN NIL |
+      def,
+      imp,
+      module,
+      (* statements.  *)
+      loop,
+      while,
+      for,
+      repeat,
+      if,
+      elsif,
+      assignment      :  HALT |
+      (* expressions.  *)
+      plus,
+      sub,
+      div,
+      mod,
+      mult,
+      divide          :  RETURN doSetExprType (binaryF.resultType, mixTypes (getExprType (binaryF.left), getExprType (binaryF.right))) |
+      in,
+      and,
+      or,
+      equal,
+      notequal,
+      less,
+      greater,
+      greequal,
+      lessequal       :  RETURN doSetExprType (binaryF.resultType, booleanN) |
+      cmplx           :  RETURN doSetExprType (binaryF.resultType, complexN) |
+      abs,
+      constexp,
+      deref,
+      neg             :  RETURN doSetExprType (unaryF.resultType, getExprType (unaryF.arg)) |
+      adr             :  RETURN doSetExprType (unaryF.resultType, addressN) |
+      size,
+      tsize           :  RETURN doSetExprType (unaryF.resultType, cardinalN) |
+      high,
+      ord             :  RETURN doSetExprType (unaryF.resultType, cardinalN) |
+      float           :  RETURN doSetExprType (unaryF.resultType, realN) |
+      trunc           :  RETURN doSetExprType (unaryF.resultType, integerN) |
+      chr             :  RETURN doSetExprType (unaryF.resultType, charN) |
+      cap             :  RETURN doSetExprType (unaryF.resultType, charN) |
+      not             :  RETURN doSetExprType (unaryF.resultType, booleanN) |
+      re              :  RETURN doSetExprType (unaryF.resultType, realN) |
+      im              :  RETURN doSetExprType (unaryF.resultType, realN) |
+      arrayref        :  RETURN arrayrefF.resultType |
+      componentref    :  RETURN componentrefF.resultType |
+      pointerref      :  RETURN pointerrefF.resultType |
+      funccall        :  RETURN doSetExprType (funccallF.type, doGetFuncType (n)) |
+      setvalue        :  RETURN setvalueF.type
+
+      END
+   END ;
+   HALT
+END doGetExprType ;
+
+
+(*
+   getExprType - return the expression type.
+*)
+
+PROCEDURE getExprType (n: node) : node ;
+VAR
+   t: node ;
+BEGIN
+   IF isFuncCall (n) AND (getType (n) # NIL) AND isProcType (skipType (getType (n)))
+   THEN
+      RETURN getType (skipType (getType (n)))
+   END ;
+   t := getType (n) ;
+   IF t = NIL
+   THEN
+      t := doGetExprType (n)
+   END ;
+   RETURN t
+END getExprType ;
+
+
+(*
+   skipType - skips over type aliases.
+*)
+
+PROCEDURE skipType (n: node) : node ;
+BEGIN
+   WHILE (n#NIL) AND isType (n) DO
+      IF getType (n) = NIL
+      THEN
+         (* this will occur if, n, is an opaque type.  *)
+         RETURN n
+      END ;
+      n := getType (n)
+   END ;
+   RETURN n
+END skipType ;
+
+
+(*
+   getScope - returns the scope associated with node, n.
+*)
+
+PROCEDURE getScope (n: node) : node ;
+BEGIN
+   WITH n^ DO
+      CASE kind OF
+
+      stmtseq,
+      exit,
+      return,
+      comment,
+      identlist,
+      setvalue,
+      halt,
+      new,
+      dispose,
+      length,
+      inc,
+      dec,
+      incl,
+      excl,
+      nil,
+      true,
+      false           :  RETURN NIL |
+      address,
+      loc,
+      byte,
+      word,
+      csizet,
+      cssizet         : RETURN systemN |
+      (* base types.  *)
+      boolean,
+      proc,
+      char,
+      cardinal,
+      longcard,
+      shortcard,
+      integer,
+      longint,
+      shortint,
+      real,
+      longreal,
+      shortreal,
+      bitset,
+      ztype,
+      rtype,
+      complex,
+      longcomplex,
+      shortcomplex    :  RETURN NIL |
+      (* language features and compound type attributes.  *)
+      type            :  RETURN typeF.scope |
+      record          :  RETURN recordF.scope |
+      varient         :  RETURN varientF.scope |
+      var             :  RETURN varF.scope |
+      enumeration     :  RETURN enumerationF.scope |
+      subrange        :  RETURN subrangeF.scope |
+      array           :  RETURN arrayF.scope |
+      string          :  RETURN NIL |
+      const           :  RETURN constF.scope |
+      literal         :  RETURN NIL |
+      varparam        :  RETURN varparamF.scope |
+      param           :  RETURN paramF.scope |
+      optarg          :  RETURN optargF.scope |
+      pointer         :  RETURN pointerF.scope |
+      recordfield     :  RETURN recordfieldF.scope |
+      varientfield    :  RETURN varientfieldF.scope |
+      enumerationfield:  RETURN enumerationfieldF.scope |
+      set             :  RETURN setF.scope |
+      proctype        :  RETURN proctypeF.scope |
+      subscript       :  RETURN NIL |
+      (* blocks.  *)
+      procedure       :  RETURN procedureF.scope |
+      def,
+      imp,
+      module,
+      (* statements.  *)
+      case,
+      loop,
+      while,
+      for,
+      repeat,
+      if,
+      elsif,
+      assignment      :  RETURN NIL |
+      (* expressions.  *)
+      componentref,
+      pointerref,
+      arrayref,
+      chr,
+      cap,
+      ord,
+      float,
+      trunc,
+      high,
+      cast,
+      val,
+      plus,
+      sub,
+      div,
+      mod,
+      mult,
+      divide,
+      in              :  RETURN NIL |
+      neg             :  RETURN NIL |
+      lsl,
+      lsr,
+      lor,
+      land,
+      lnot,
+      lxor,
+      and,
+      or,
+      not,
+      constexp,
+      deref,
+      equal,
+      notequal,
+      less,
+      greater,
+      greequal,
+      lessequal       :  RETURN NIL |
+      adr,
+      size,
+      tsize,
+      throw           :  RETURN systemN |
+      unreachable,
+      cmplx, re, im,
+      min,
+      max             :  RETURN NIL |
+      vardecl         :  RETURN vardeclF.scope |
+      funccall        :  RETURN NIL |
+      explist         :  RETURN NIL |
+      caselabellist   :  RETURN NIL |
+      caselist        :  RETURN NIL |
+      range           :  RETURN NIL |
+      varargs         :  RETURN varargsF.scope
+
+      END
+   END
+END getScope ;
+
+
+(*
+   foreachDefModuleDo - foreach definition node, n, in the module universe,
+                        call p (n).
+*)
+
+PROCEDURE foreachDefModuleDo (p: performOperation) ;
+BEGIN
+   ForeachIndiceInIndexDo (defUniverseI, p)
+END foreachDefModuleDo ;
+
+
+(*
+   foreachModModuleDo - foreach implementation or module node, n, in the module universe,
+                        call p (n).
+*)
+
+PROCEDURE foreachModModuleDo (p: performOperation) ;
+BEGIN
+   ForeachIndiceInIndexDo (modUniverseI, p)
+END foreachModModuleDo ;
+
+
+(*
+   openOutput -
+*)
+
+PROCEDURE openOutput ;
+VAR
+   s: String ;
+BEGIN
+   s := getOutputFile () ;
+   IF EqualArray (s, '-')
+   THEN
+      outputFile := StdOut
+   ELSE
+      outputFile := OpenToWrite (s)
+   END ;
+   mcStream.setDest (outputFile)
+END openOutput ;
+
+
+(*
+   closeOutput -
+*)
+
+PROCEDURE closeOutput ;
+VAR
+   s: String ;
+BEGIN
+   s := getOutputFile () ;
+   outputFile := mcStream.combine () ;
+   IF NOT EqualArray (s, '-')
+   THEN
+      Close (outputFile)
+   END
+END closeOutput ;
+
+
+(*
+   write - outputs a single char, ch.
+*)
+
+PROCEDURE write (ch: CHAR) ;
+BEGIN
+   WriteChar (outputFile, ch) ;
+   FlushBuffer (outputFile)
+END write ;
+
+
+(*
+   writeln -
+*)
+
+PROCEDURE writeln ;
+BEGIN
+   WriteLine (outputFile) ;
+   FlushBuffer (outputFile)
+END writeln ;
+
+
+(*
+   doIncludeC - include header file for definition module, n.
+*)
+
+PROCEDURE doIncludeC (n: node) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   IF getExtendedOpaque ()
+   THEN
+      (* no include in this case.  *)
+   ELSIF isDef (n)
+   THEN
+      print (doP, '#   include "') ;
+      prints (doP, getHPrefix ()) ;
+      prints (doP, s) ;
+      print (doP, '.h"\n') ;
+      foreachNodeDo (n^.defF.decls.symbols, addDoneDef)
+   END ;
+   s := KillString (s)
+END doIncludeC ;
+
+
+(*
+   getSymScope - returns the scope where node, n, was declared.
+*)
+
+PROCEDURE getSymScope (n: node) : node ;
+BEGIN
+   WITH n^ DO
+      CASE kind OF
+
+      const    :  RETURN constF.scope |
+      type     :  RETURN typeF.scope |
+      var      :  RETURN varF.scope |
+      procedure:  RETURN procedureF.scope
+
+      END
+   END ;
+   HALT
+END getSymScope ;
+
+
+(*
+   isQualifiedForced - should the node be written with a module prefix?
+*)
+
+PROCEDURE isQualifiedForced (n: node) : BOOLEAN ;
+BEGIN
+   RETURN (forceQualified AND
+           (isType (n) OR isRecord (n) OR isArray (n) OR isEnumeration (n) OR isEnumerationField (n)))
+END isQualifiedForced ;
+
+
+(*
+   getFQstring -
+*)
+
+PROCEDURE getFQstring (n: node) : String ;
+VAR
+   i, s: String ;
+BEGIN
+   IF getScope (n) = NIL
+   THEN
+      RETURN InitStringCharStar (keyToCharStar (getSymName (n)))
+   ELSIF isQualifiedForced (n)
+   THEN
+      i := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+      s := InitStringCharStar (keyToCharStar (getSymName (getScope (n)))) ;
+      RETURN Sprintf2 (InitString ("%s_%s"), s, i)
+   ELSIF (NOT isExported (n)) OR getIgnoreFQ ()
+   THEN
+      RETURN InitStringCharStar (keyToCharStar (getSymName (n)))
+   ELSE
+      i := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+      s := InitStringCharStar (keyToCharStar (getSymName (getScope (n)))) ;
+      RETURN Sprintf2 (InitString ("%s_%s"), s, i)
+   END
+END getFQstring ;
+
+
+(*
+   getFQDstring -
+*)
+
+PROCEDURE getFQDstring (n: node; scopes: BOOLEAN) : String ;
+VAR
+   i, s: String ;
+BEGIN
+   IF getScope (n) = NIL
+   THEN
+      RETURN InitStringCharStar (keyToCharStar (getDName (n, scopes)))
+   ELSIF isQualifiedForced (n)
+   THEN
+      (* we assume a qualified name will never conflict.  *)
+      i := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+      s := InitStringCharStar (keyToCharStar (getSymName (getScope (n)))) ;
+      RETURN Sprintf2 (InitString ("%s_%s"), s, i)
+   ELSIF (NOT isExported (n)) OR getIgnoreFQ ()
+   THEN
+      RETURN InitStringCharStar (keyToCharStar (getDName (n, scopes)))
+   ELSE
+      (* we assume a qualified name will never conflict.  *)
+      i := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+      s := InitStringCharStar (keyToCharStar (getSymName (getScope (n)))) ;
+      RETURN Sprintf2 (InitString ("%s_%s"), s, i)
+   END
+END getFQDstring ;
+
+
+(*
+   getString - returns the name as a string.
+*)
+
+PROCEDURE getString (n: node) : String ;
+BEGIN
+   IF getSymName (n) = NulName
+   THEN
+      RETURN InitString ('')
+   ELSE
+      RETURN InitStringCharStar (keyToCharStar (getSymName (n)))
+   END
+END getString ;
+
+
+(*
+   getCardinal - returns the cardinal type node.
+*)
+
+PROCEDURE getCardinal () : node ;
+BEGIN
+   RETURN cardinalN
+END getCardinal ;
+
+
+(*
+   doNone - call HALT.
+*)
+
+PROCEDURE doNone (n: node) ;
+BEGIN
+   HALT
+END doNone ;
+
+
+(*
+   doNothing - does nothing!
+*)
+
+PROCEDURE doNothing (n: node) ;
+BEGIN
+END doNothing ;
+
+
+(*
+   doConstC -
+*)
+
+PROCEDURE doConstC (n: node) ;
+BEGIN
+   IF NOT alists.isItemInList (doneQ, n)
+   THEN
+      print (doP, "#   define ") ;
+      doFQNameC (doP, n) ;
+      setNeedSpace (doP) ;
+      doExprC (doP, n^.constF.value) ;
+      print (doP, '\n') ;
+      alists.includeItemIntoList (doneQ, n)
+   END
+END doConstC ;
+
+
+(*
+   needsParen - returns TRUE if expression, n, needs to be enclosed in ().
+*)
+
+PROCEDURE needsParen (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   WITH n^ DO
+      CASE kind OF
+
+      nil,
+      true,
+      false           :  RETURN FALSE |
+      constexp        :  RETURN needsParen (unaryF.arg) |
+      neg             :  RETURN needsParen (unaryF.arg) |
+      not             :  RETURN needsParen (unaryF.arg) |
+      adr,
+      size,
+      tsize,
+      ord,
+      float,
+      trunc,
+      chr,
+      cap,
+      high            :  RETURN FALSE |
+      deref           :  RETURN FALSE |
+      equal,
+      notequal,
+      less,
+      greater,
+      greequal,
+      lessequal       :  RETURN TRUE |
+      componentref    :  RETURN FALSE |
+      pointerref      :  RETURN FALSE |
+      cast            :  RETURN TRUE |
+      val             :  RETURN TRUE |
+      abs             :  RETURN FALSE |
+      plus,
+      sub,
+      div,
+      mod,
+      mult,
+      divide,
+      in              :  RETURN TRUE |
+      literal,
+      const,
+      enumerationfield,
+      string          :  RETURN FALSE |
+      max             :  RETURN TRUE |
+      min             :  RETURN TRUE |
+      var             :  RETURN FALSE |
+      arrayref        :  RETURN FALSE |
+      and,
+      or              :  RETURN TRUE |
+      funccall        :  RETURN TRUE |
+      recordfield     :  RETURN FALSE |
+      loc,
+      byte,
+      word,
+      type,
+      char,
+      cardinal,
+      longcard,
+      shortcard,
+      integer,
+      longint,
+      shortint,
+      real,
+      longreal,
+      shortreal,
+      complex,
+      longcomplex,
+      shortcomplex,
+      bitset,
+      boolean,
+      proc            :  RETURN FALSE |
+      setvalue        :  RETURN FALSE |
+      address         :  RETURN TRUE |
+      procedure       :  RETURN FALSE |
+      length,
+      cmplx, re, im   :  RETURN TRUE
+
+      END
+   END ;
+   RETURN TRUE
+END needsParen ;
+
+
+(*
+   doUnary -
+*)
+
+PROCEDURE doUnary (p: pretty; op: ARRAY OF CHAR; expr, type: node; l, r: BOOLEAN) ;
+BEGIN
+   IF l
+   THEN
+      setNeedSpace (p)
+   END ;
+   print (p, op) ;
+   IF r
+   THEN
+      setNeedSpace (p)
+   END ;
+   IF needsParen (expr)
+   THEN
+      outText (p, '(') ;
+      doExprC (p, expr) ;
+      outText (p, ')')
+   ELSE
+      doExprC (p, expr)
+   END
+END doUnary ;
+
+
+(*
+   doSetSub - perform  l & (~ r)
+*)
+
+PROCEDURE doSetSub (p: pretty; left, right: node) ;
+BEGIN
+   IF needsParen (left)
+   THEN
+      outText (p, '(') ;
+      doExprC (p, left) ;
+      outText (p, ')')
+   ELSE
+      doExprC (p, left)
+   END ;
+   setNeedSpace (p) ;
+   outText (p, '&') ;
+   setNeedSpace (p) ;
+   IF needsParen (right)
+   THEN
+      outText (p, '(~(') ;
+      doExprC (p, right) ;
+      outText (p, '))')
+   ELSE
+      outText (p, '(~') ;
+      doExprC (p, right) ;
+      outText (p, ')')
+   END
+END doSetSub ;
+
+
+(*
+   doPolyBinary -
+*)
+
+PROCEDURE doPolyBinary (p: pretty; op: nodeT; left, right: node; l, r: BOOLEAN) ;
+VAR
+   lt, rt: node ;
+BEGIN
+   lt := skipType (getExprType (left)) ;
+   rt := skipType (getExprType (right)) ;
+   IF ((lt # NIL) AND (isSet (lt) OR isBitset (lt))) OR
+      ((rt # NIL) AND (isSet (rt) OR isBitset (rt)))
+   THEN
+      CASE op OF
+
+      plus   :  doBinary (p, '|', left, right, l, r, FALSE) |
+      sub    :  doSetSub (p, left, right) |
+      mult   :  doBinary (p, '&', left, right, l, r, FALSE) |
+      divide :  doBinary (p, '^', left, right, l, r, FALSE)
+
+      END
+   ELSE
+      CASE op OF
+
+      plus   :  doBinary (p, '+', left, right, l, r, FALSE) |
+      sub    :  doBinary (p, '-', left, right, l, r, FALSE) |
+      mult   :  doBinary (p, '*', left, right, l, r, FALSE) |
+      divide :  doBinary (p, '/', left, right, l, r, FALSE)
+
+      END
+   END
+END doPolyBinary ;
+
+
+(*
+   doBinary -
+*)
+
+PROCEDURE doBinary (p: pretty; op: ARRAY OF CHAR; left, right: node; l, r, unpackProc: BOOLEAN) ;
+BEGIN
+   IF needsParen (left)
+   THEN
+      outText (p, '(') ;
+      doExprCup (p, left, unpackProc) ;
+      outText (p, ')')
+   ELSE
+      doExprCup (p, left, unpackProc)
+   END ;
+   IF l
+   THEN
+      setNeedSpace (p)
+   END ;
+   outText (p, op) ;
+   IF r
+   THEN
+      setNeedSpace (p)
+   END ;
+   IF needsParen (right)
+   THEN
+      outText (p, '(') ;
+      doExprCup (p, right, unpackProc) ;
+      outText (p, ')')
+   ELSE
+      doExprCup (p, right, unpackProc)
+   END
+END doBinary ;
+
+
+(*
+   doPostUnary -
+*)
+
+PROCEDURE doPostUnary (p: pretty; op: ARRAY OF CHAR; expr: node) ;
+BEGIN
+   doExprC (p, expr) ;
+   outText (p, op)
+END doPostUnary ;
+
+
+(*
+   doDeRefC -
+*)
+
+PROCEDURE doDeRefC (p: pretty; expr: node) ;
+BEGIN
+   outText (p, '(*') ;
+   doExprC (p, expr) ;
+   outText (p, ')')
+END doDeRefC ;
+
+
+(*
+   doGetLastOp - returns, a, if b is a terminal otherwise walk right.
+*)
+
+PROCEDURE doGetLastOp (a, b: node) : node ;
+BEGIN
+   WITH b^ DO
+      CASE kind OF
+
+      nil             :  RETURN a |
+      true            :  RETURN a |
+      false           :  RETURN a |
+      constexp        :  RETURN doGetLastOp (b, unaryF.arg) |
+      neg             :  RETURN doGetLastOp (b, unaryF.arg) |
+      not             :  RETURN doGetLastOp (b, unaryF.arg) |
+      adr             :  RETURN doGetLastOp (b, unaryF.arg) |
+      size            :  RETURN doGetLastOp (b, unaryF.arg) |
+      tsize           :  RETURN doGetLastOp (b, unaryF.arg) |
+      ord             :  RETURN doGetLastOp (b, unaryF.arg) |
+      float,
+      trunc           :  RETURN doGetLastOp (b, unaryF.arg) |
+      chr             :  RETURN doGetLastOp (b, unaryF.arg) |
+      cap             :  RETURN doGetLastOp (b, unaryF.arg) |
+      high            :  RETURN doGetLastOp (b, unaryF.arg) |
+      deref           :  RETURN doGetLastOp (b, unaryF.arg) |
+      re,
+      im              :  RETURN doGetLastOp (b, unaryF.arg) |
+      equal           :  RETURN doGetLastOp (b, binaryF.right) |
+      notequal        :  RETURN doGetLastOp (b, binaryF.right) |
+      less            :  RETURN doGetLastOp (b, binaryF.right) |
+      greater         :  RETURN doGetLastOp (b, binaryF.right) |
+      greequal        :  RETURN doGetLastOp (b, binaryF.right) |
+      lessequal       :  RETURN doGetLastOp (b, binaryF.right) |
+      componentref    :  RETURN doGetLastOp (b, componentrefF.field) |
+      pointerref      :  RETURN doGetLastOp (b, pointerrefF.field) |
+      cast            :  RETURN doGetLastOp (b, binaryF.right) |
+      val             :  RETURN doGetLastOp (b, binaryF.right) |
+      plus            :  RETURN doGetLastOp (b, binaryF.right) |
+      sub             :  RETURN doGetLastOp (b, binaryF.right) |
+      div             :  RETURN doGetLastOp (b, binaryF.right) |
+      mod             :  RETURN doGetLastOp (b, binaryF.right) |
+      mult            :  RETURN doGetLastOp (b, binaryF.right) |
+      divide          :  RETURN doGetLastOp (b, binaryF.right) |
+      in              :  RETURN doGetLastOp (b, binaryF.right) |
+      and             :  RETURN doGetLastOp (b, binaryF.right) |
+      or              :  RETURN doGetLastOp (b, binaryF.right) |
+      cmplx           :  RETURN doGetLastOp (b, binaryF.right) |
+      literal         :  RETURN a |
+      const           :  RETURN a |
+      enumerationfield:  RETURN a |
+      string          :  RETURN a |
+      max             :  RETURN doGetLastOp (b, unaryF.arg) |
+      min             :  RETURN doGetLastOp (b, unaryF.arg) |
+      var             :  RETURN a |
+      arrayref        :  RETURN a |
+      funccall        :  RETURN a |
+      procedure       :  RETURN a |
+      recordfield     :  RETURN a
+
+      END
+   END
+END doGetLastOp ;
+
+
+(*
+   getLastOp - return the right most non leaf node.
+*)
+
+PROCEDURE getLastOp (n: node) : node ;
+BEGIN
+   RETURN doGetLastOp (n, n)
+END getLastOp ;
+
+
+(*
+   doComponentRefC -
+*)
+
+PROCEDURE doComponentRefC (p: pretty; l, r: node) ;
+BEGIN
+   doExprC (p, l) ;
+   outText (p, '.') ;
+   doExprC (p, r)
+END doComponentRefC ;
+
+
+(*
+   doPointerRefC -
+*)
+
+PROCEDURE doPointerRefC (p: pretty; l, r: node) ;
+BEGIN
+   doExprC (p, l) ;
+   outText (p, '->') ;
+   doExprC (p, r)
+END doPointerRefC ;
+
+
+(*
+   doPreBinary -
+*)
+
+PROCEDURE doPreBinary (p: pretty; op: ARRAY OF CHAR; left, right: node; l, r: BOOLEAN) ;
+BEGIN
+   IF l
+   THEN
+      setNeedSpace (p)
+   END ;
+   outText (p, op) ;
+   IF r
+   THEN
+      setNeedSpace (p)
+   END ;
+   outText (p, '(') ;
+   doExprC (p, left) ;
+   outText (p, ',') ;
+   setNeedSpace (p) ;
+   doExprC (p, right) ;
+   outText (p, ')')
+END doPreBinary ;
+
+
+(*
+   doConstExpr -
+*)
+
+PROCEDURE doConstExpr (p: pretty; n: node) ;
+BEGIN
+   doFQNameC (p, n)
+END doConstExpr ;
+
+
+(*
+   doEnumerationField -
+*)
+
+PROCEDURE doEnumerationField (p: pretty; n: node) ;
+BEGIN
+   doFQDNameC (p, n, FALSE)
+END doEnumerationField ;
+
+
+(*
+   isZero - returns TRUE if node, n, is zero.
+*)
+
+PROCEDURE isZero (n: node) : BOOLEAN ;
+BEGIN
+   IF isConstExp (n)
+   THEN
+      RETURN isZero (n^.unaryF.arg)
+   END ;
+   RETURN getSymName (n)=makeKey ('0')
+END isZero ;
+
+
+(*
+   doArrayRef -
+*)
+
+PROCEDURE doArrayRef (p: pretty; n: node) ;
+VAR
+   t   : node ;
+   i, c: CARDINAL ;
+BEGIN
+   assert (n # NIL) ;
+   assert (isArrayRef (n)) ;
+   t := skipType (getType (n^.arrayrefF.array)) ;
+   IF isUnbounded (t)
+   THEN
+      outTextN (p, getSymName (n^.arrayrefF.array))
+   ELSE
+      doExprC (p, n^.arrayrefF.array) ;
+      assert (isArray (t)) ;
+      outText (p, '.array')
+   END ;
+   outText (p, '[') ;
+   i := 1 ;
+   c := expListLen (n^.arrayrefF.index) ;
+   WHILE i<=c DO
+      doExprC (p, getExpList (n^.arrayrefF.index, i)) ;
+      IF isUnbounded (t)
+      THEN
+         assert (c = 1)
+      ELSE
+         doSubtractC (p, getMin (t^.arrayF.subr)) ;
+	 IF i<c
+         THEN
+            assert (isArray (t)) ;
+            outText (p, '].array[') ;
+            t := skipType (getType (t))
+         END
+      END ;
+      INC (i)
+   END ;
+   outText (p, ']')
+END doArrayRef ;
+
+
+(*
+   doProcedure -
+*)
+
+PROCEDURE doProcedure (p: pretty; n: node) ;
+BEGIN
+   assert (isProcedure (n)) ;
+   doFQDNameC (p, n, TRUE)
+END doProcedure ;
+
+
+(*
+   doRecordfield -
+*)
+
+PROCEDURE doRecordfield (p: pretty; n: node) ;
+BEGIN
+   doDNameC (p, n, FALSE)
+END doRecordfield ;
+
+
+(*
+   doCastC -
+*)
+
+PROCEDURE doCastC (p: pretty; t, e: node) ;
+VAR
+   et: node ;
+BEGIN
+   outText (p, '(') ;
+   doTypeNameC (p, t) ;
+   outText (p, ')') ;
+   setNeedSpace (p) ;
+   et := skipType (getType (e)) ;
+   IF (et # NIL) AND isAProcType (et) AND isAProcType (skipType (t))
+   THEN
+      outText (p, '{(') ;
+      doFQNameC (p, t) ;
+      outText (p, '_t)') ;
+      setNeedSpace (p) ;
+      doExprC (p, e) ;
+      outText (p, '.proc}')
+   ELSE
+      outText (p, '(') ;
+      doExprC (p, e) ;
+      outText (p, ')')
+   END
+END doCastC ;
+
+
+(*
+   doSetValueC -
+*)
+
+PROCEDURE doSetValueC (p: pretty; n: node) ;
+VAR
+   lo  : node ;
+   i, h: CARDINAL ;
+BEGIN
+   assert (isSetValue (n)) ;
+   lo := getSetLow (n) ;
+   IF n^.setvalueF.type # NIL
+   THEN
+      outText (p, '(') ;
+      doTypeNameC (p, n^.setvalueF.type) ;
+      noSpace (p) ;
+      outText (p, ')') ;
+      setNeedSpace (p)
+   END ;
+   IF HighIndice (n^.setvalueF.values) = 0
+   THEN
+      outText (p, '0')
+   ELSE
+      i := LowIndice (n^.setvalueF.values) ;
+      h := HighIndice (n^.setvalueF.values) ;
+      outText (p, '(') ;
+      WHILE i<=h DO
+         outText (p, '(1') ;
+         setNeedSpace (p) ;
+         outText (p, '<<') ;
+         setNeedSpace (p) ;
+         outText (p, '(') ;
+         doExprC (p, GetIndice (n^.setvalueF.values, i)) ;
+         doSubtractC (p, lo) ;
+         outText (p, ')') ;
+         outText (p, ')') ;
+         IF i<h
+         THEN
+            setNeedSpace (p) ;
+            outText (p, '|') ;
+            setNeedSpace (p)
+         END ;
+         INC (i)
+      END ;
+      outText (p, ')')
+   END
+END doSetValueC ;
+
+
+(*
+   getSetLow - returns the low value of the set type from
+               expression, n.
+*)
+
+PROCEDURE getSetLow (n: node) : node ;
+VAR
+   type: node ;
+BEGIN
+   IF getType (n) = NIL
+   THEN
+      RETURN makeLiteralInt (makeKey ('0'))
+   ELSE
+      type := skipType (getType (n)) ;
+      IF isSet (type)
+      THEN
+         RETURN getMin (skipType (getType (type)))
+      ELSE
+         RETURN makeLiteralInt (makeKey ('0'))
+      END
+   END
+END getSetLow ;
+
+
+(*
+   doInC - performs (((1 << (l)) & (r)) != 0)
+*)
+
+PROCEDURE doInC (p: pretty; l, r: node) ;
+VAR
+   lo: node ;
+BEGIN
+   lo := getSetLow (r) ;
+   outText (p, '(((1') ;
+   setNeedSpace (p) ;
+   outText (p, '<<') ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   doExprC (p, l) ;
+   doSubtractC (p, lo) ;
+   outText (p, '))') ;
+   setNeedSpace (p) ;
+   outText (p, '&') ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   doExprC (p, r) ;
+   outText (p, '))') ;
+   setNeedSpace (p) ;
+   outText (p, '!=') ;
+   setNeedSpace (p) ;
+   outText (p, '0)')
+END doInC ;
+
+
+(*
+   doThrowC -
+*)
+
+PROCEDURE doThrowC (p: pretty; n: node) ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   outText (p, "throw") ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   IF expListLen (n^.intrinsicF.args) = 1
+   THEN
+      doExprC (p, getExpList (n^.intrinsicF.args, 1))
+   END ;
+   outText (p, ')')
+END doThrowC ;
+
+
+(*
+   doUnreachableC -
+*)
+
+PROCEDURE doUnreachableC (p: pretty; n: node) ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   outText (p, "__builtin_unreachable") ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   assert (expListLen (n^.intrinsicF.args) = 0) ;
+   outText (p, ')')
+END doUnreachableC ;
+
+
+(*
+   outNull -
+*)
+
+PROCEDURE outNull (p: pretty) ;
+BEGIN
+   keyc.useNull ;
+   outText (p, 'NULL')
+END outNull ;
+
+
+(*
+   outTrue -
+*)
+
+PROCEDURE outTrue (p: pretty) ;
+BEGIN
+   keyc.useTrue ;
+   outText (p, 'TRUE')
+END outTrue ;
+
+
+(*
+   outFalse -
+*)
+
+PROCEDURE outFalse (p: pretty) ;
+BEGIN
+   keyc.useFalse ;
+   outText (p, 'FALSE')
+END outFalse ;
+
+
+(*
+   doExprC -
+*)
+
+PROCEDURE doExprC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (n#NIL) ;
+   t := getExprType (n) ;
+   WITH n^ DO
+      CASE kind OF
+
+      nil             :  outNull (p) |
+      true            :  outTrue (p) |
+      false           :  outFalse (p) |
+      constexp        :  doUnary (p, '', unaryF.arg, unaryF.resultType, FALSE, FALSE) |
+      neg             :  doUnary (p, '-', unaryF.arg, unaryF.resultType, FALSE, FALSE) |
+      not             :  doUnary (p, '!', unaryF.arg, unaryF.resultType, FALSE, TRUE) |
+      val             :  doValC (p, n) |
+      adr             :  doAdrC (p, n) |
+      size,
+      tsize           :  doSizeC (p, n) |
+      float           :  doConvertC (p, n, "(double)") |
+      trunc           :  doConvertC (p, n, "(int)") |
+      ord             :  doConvertC (p, n, "(unsigned int)") |
+      chr             :  doConvertC (p, n, "(char)") |
+      cap             :  doCapC (p, n) |
+      abs             :  doAbsC (p, n) |
+      high            :  doFuncHighC (p, n^.unaryF.arg) |
+      length          :  doLengthC (p, n) |
+      min             :  doMinC (p, n) |
+      max             :  doMaxC (p, n) |
+      throw           :  doThrowC (p, n) |
+      unreachable     :  doUnreachableC (p, n) |
+      re              :  doReC (p, n) |
+      im              :  doImC (p, n) |
+      cmplx           :  doCmplx (p, n) |
+
+      deref           :  doDeRefC (p, unaryF.arg) |
+      equal           :  doBinary (p, '==', binaryF.left, binaryF.right, TRUE, TRUE, TRUE) |
+      notequal        :  doBinary (p, '!=', binaryF.left, binaryF.right, TRUE, TRUE, TRUE) |
+      less            :  doBinary (p, '<', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      greater         :  doBinary (p, '>', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      greequal        :  doBinary (p, '>=', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      lessequal       :  doBinary (p, '<=', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      componentref    :  doComponentRefC (p, componentrefF.rec, componentrefF.field) |
+      pointerref      :  doPointerRefC (p, pointerrefF.ptr, pointerrefF.field) |
+      cast            :  doCastC (p, binaryF.left, binaryF.right) |
+      plus            :  doPolyBinary (p, plus, binaryF.left, binaryF.right, FALSE, FALSE) |
+      sub             :  doPolyBinary (p, sub, binaryF.left, binaryF.right, FALSE, FALSE) |
+      div             :  doBinary (p, '/', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      mod             :  doBinary (p, '%', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      mult            :  doPolyBinary (p, mult, binaryF.left, binaryF.right, FALSE, FALSE) |
+      divide          :  doPolyBinary (p, divide, binaryF.left, binaryF.right, FALSE, FALSE) |
+      in              :  doInC (p, binaryF.left, binaryF.right) |
+      and             :  doBinary (p, '&&', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      or              :  doBinary (p, '||', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      literal         :  doLiteralC (p, n) |
+      const           :  doConstExpr (p, n) |
+      enumerationfield:  doEnumerationField (p, n) |
+      string          :  doStringC (p, n) |
+      var             :  doVar (p, n) |
+      arrayref        :  doArrayRef (p, n) |
+      funccall        :  doFuncExprC (p, n) |
+      procedure       :  doProcedure (p, n) |
+      recordfield     :  doRecordfield (p, n) |
+      setvalue        :  doSetValueC (p, n) |
+      char,
+      cardinal,
+      longcard,
+      shortcard,
+      integer,
+      longint,
+      shortint,
+      complex,
+      longcomplex,
+      shortcomplex,
+      real,
+      longreal,
+      shortreal,
+      bitset,
+      boolean,
+      proc            :  doBaseC (p, n) |
+      address,
+      loc,
+      byte,
+      word,
+      csizet,
+      cssizet         :  doSystemC (p, n) |
+      type            :  doTypeNameC (p, n) |
+      pointer         :  doTypeNameC (p, n)
+
+      END
+   END
+END doExprC ;
+
+
+(*
+   doExprCup -
+*)
+
+PROCEDURE doExprCup (p: pretty; n: node; unpackProc: BOOLEAN) ;
+VAR
+   t: node ;
+BEGIN
+   doExprC (p, n) ;
+   IF unpackProc
+   THEN
+      t := skipType (getExprType (n)) ;
+      IF (t # NIL) AND isAProcType (t)
+      THEN
+         outText (p, '.proc')
+      END
+   END
+END doExprCup ;
+
+
+(*
+   doExprM2 -
+*)
+
+PROCEDURE doExprM2 (p: pretty; n: node) ;
+BEGIN
+   assert (n#NIL) ;
+   WITH n^ DO
+      CASE kind OF
+
+      nil             :  outText (p, 'NIL') |
+      true            :  outText (p, 'TRUE') |
+      false           :  outText (p, 'FALSE') |
+      constexp        :  doUnary (p, '', unaryF.arg, unaryF.resultType, FALSE, FALSE) |
+      neg             :  doUnary (p, '-', unaryF.arg, unaryF.resultType, FALSE, FALSE) |
+      not             :  doUnary (p, 'NOT', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      adr             :  doUnary (p, 'ADR', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      size            :  doUnary (p, 'SIZE', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      tsize           :  doUnary (p, 'TSIZE', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      float           :  doUnary (p, 'FLOAT', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      trunc           :  doUnary (p, 'TRUNC', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      ord             :  doUnary (p, 'ORD', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      chr             :  doUnary (p, 'CHR', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      cap             :  doUnary (p, 'CAP', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      high            :  doUnary (p, 'HIGH', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      re              :  doUnary (p, 'RE', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      im              :  doUnary (p, 'IM', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      deref           :  doPostUnary (p, '^', unaryF.arg) |
+      equal           :  doBinary (p, '=', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      notequal        :  doBinary (p, '#', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      less            :  doBinary (p, '<', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      greater         :  doBinary (p, '>', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      greequal        :  doBinary (p, '>=', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      lessequal       :  doBinary (p, '<=', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      componentref    :  doBinary (p, '.', componentrefF.rec, componentrefF.field, FALSE, FALSE, FALSE) |
+      pointerref      :  doBinary (p, '^.', pointerrefF.ptr, pointerrefF.field, FALSE, FALSE, FALSE) |
+      cast            :  doPreBinary (p, 'CAST', binaryF.left, binaryF.right, TRUE, TRUE) |
+      val             :  doPreBinary (p, 'VAL', binaryF.left, binaryF.right, TRUE, TRUE) |
+      cmplx           :  doPreBinary (p, 'CMPLX', binaryF.left, binaryF.right, TRUE, TRUE) |
+      plus            :  doBinary (p, '+', binaryF.left, binaryF.right, FALSE, FALSE, FALSE) |
+      sub             :  doBinary (p, '-', binaryF.left, binaryF.right, FALSE, FALSE, FALSE) |
+      div             :  doBinary (p, 'DIV', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      mod             :  doBinary (p, 'MOD', binaryF.left, binaryF.right, TRUE, TRUE, FALSE) |
+      mult            :  doBinary (p, '*', binaryF.left, binaryF.right, FALSE, FALSE, FALSE) |
+      divide          :  doBinary (p, '/', binaryF.left, binaryF.right, FALSE, FALSE, FALSE) |
+      literal         :  doLiteral (p, n) |
+      const           :  doConstExpr (p, n) |
+      enumerationfield:  doEnumerationField (p, n) |
+      string          :  doString (p, n) |
+      max             :  doUnary (p, 'MAX', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      min             :  doUnary (p, 'MIN', unaryF.arg, unaryF.resultType, TRUE, TRUE) |
+      var             :  doVar (p, n)
+
+      END
+   END
+END doExprM2 ;
+
+
+(*
+   doVar -
+*)
+
+PROCEDURE doVar (p: pretty; n: node) ;
+BEGIN
+   assert (isVar (n)) ;
+   IF n^.varF.isVarParameter
+   THEN
+      outText (p, '(*') ;
+      doFQDNameC (p, n, TRUE) ;
+      outText (p, ')')
+   ELSE
+      doFQDNameC (p, n, TRUE)
+   END
+END doVar ;
+
+
+(*
+   doLiteralC -
+*)
+
+PROCEDURE doLiteralC (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   assert (isLiteral (n)) ;
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   IF n^.literalF.type=charN
+   THEN
+      IF DynamicStrings.char (s, -1)='C'
+      THEN
+         s := DynamicStrings.Slice (DynamicStrings.Mark (s), 0, -1) ;
+	 IF DynamicStrings.char (s, 0)#'0'
+         THEN
+            s := DynamicStrings.ConCat (InitString('0'), DynamicStrings.Mark (s))
+         END
+      END ;
+      outText (p, "(char)") ;
+      setNeedSpace (p)
+   ELSIF DynamicStrings.char (s, -1) = 'H'
+   THEN
+      outText (p, "0x") ;
+      s := DynamicStrings.Slice (DynamicStrings.Mark (s), 0, -1)
+   ELSIF DynamicStrings.char (s, -1) = 'B'
+   THEN
+      outText (p, "0") ;
+      s := DynamicStrings.Slice (DynamicStrings.Mark (s), 0, -1)
+   END ;
+   outTextS (p, s) ;
+   s := KillString (s)
+END doLiteralC ;
+
+
+(*
+   doLiteral -
+*)
+
+PROCEDURE doLiteral (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   assert (isLiteral (n)) ;
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   IF n^.literalF.type=charN
+   THEN
+      IF DynamicStrings.char (s, -1)='C'
+      THEN
+         s := DynamicStrings.Slice (DynamicStrings.Mark (s), 0, -1) ;
+	 IF DynamicStrings.char (s, 0)#'0'
+         THEN
+            s := DynamicStrings.ConCat (InitString('0'), DynamicStrings.Mark (s))
+         END
+      END ;
+      outText (p, "(char)") ;
+      setNeedSpace (p)
+   END ;
+   outTextS (p, s) ;
+   s := KillString (s)
+END doLiteral ;
+
+
+(*
+   isString - returns TRUE if node, n, is a string.
+*)
+
+PROCEDURE isString (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind=string
+END isString ;
+
+
+(*
+   doString -
+*)
+
+PROCEDURE doString (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   assert (isString (n)) ;
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   outTextS (p, s) ;
+   s := KillString (s)
+   ; HALT
+   (*
+   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
+   *)
+END doString ;
+
+
+(*
+   replaceChar - replace every occurance of, ch, by, a and return modified string, s.
+*)
+
+PROCEDURE replaceChar (s: String; ch: CHAR; a: ARRAY OF CHAR) : String ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := 0 ;
+   LOOP
+      i := DynamicStrings.Index (s, ch, i) ;
+      IF i = 0
+      THEN
+         s := ConCat (InitString (a), DynamicStrings.Slice (s, 1, 0)) ;
+         i := StrLen (a)
+      ELSIF i > 0
+      THEN
+         s := ConCat (ConCat (DynamicStrings.Slice (s, 0, i), Mark (InitString (a))), DynamicStrings.Slice (s, i+1, 0)) ;
+         INC (i, StrLen (a))
+      ELSE
+         RETURN s
+      END
+   END
+END replaceChar ;
+
+
+(*
+   toCstring - translates string, n, into a C string
+               and returns the new String.
+*)
+
+PROCEDURE toCstring (n: Name) : String ;
+VAR
+   s: String ;
+BEGIN
+   s := DynamicStrings.Slice (InitStringCharStar (keyToCharStar (n)), 1, -1) ;
+   RETURN replaceChar (replaceChar (s, '\', '\\'), '"', '\"')
+END toCstring ;
+
+
+(*
+   toCchar -
+*)
+
+PROCEDURE toCchar (n: Name) : String ;
+VAR
+   s: String ;
+BEGIN
+   s := DynamicStrings.Slice (InitStringCharStar (keyToCharStar (n)), 1, -1) ;
+   RETURN replaceChar (replaceChar (s, '\', '\\'), "'", "\'")
+END toCchar ;
+
+
+(*
+   countChar -
+*)
+
+PROCEDURE countChar (s: String; ch: CHAR) : CARDINAL ;
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+BEGIN
+   c := 0 ;
+   i := 0 ;
+   LOOP
+      i := DynamicStrings.Index (s, ch, i) ;
+      IF i >= 0
+      THEN
+         INC (i) ;
+         INC (c)
+      ELSE
+         RETURN c
+      END
+   END
+END countChar ;
+
+
+(*
+   lenCstring -
+*)
+
+PROCEDURE lenCstring (s: String) : CARDINAL ;
+BEGIN
+   RETURN DynamicStrings.Length (s) - countChar (s, '\')
+END lenCstring ;
+
+
+(*
+   outCstring -
+*)
+
+PROCEDURE outCstring (p: pretty; s: node; aString: BOOLEAN) ;
+BEGIN
+   IF aString
+   THEN
+      outText (p, '"') ;
+      outRawS (p, s^.stringF.cstring) ;
+      outText (p, '"')
+   ELSE
+      outText (p, "'") ;
+      outRawS (p, s^.stringF.cchar) ;
+      outText (p, "'")
+   END
+END outCstring ;
+
+
+(*
+   doStringC -
+*)
+
+PROCEDURE doStringC (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   assert (isString (n)) ;
+   outCstring (p, n, NOT n^.stringF.isCharCompatible)
+(*
+   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)
+*)
+END doStringC ;
+
+
+(*
+   isPunct -
+*)
+
+PROCEDURE isPunct (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch = '.') OR (ch = '(') OR (ch = ')') OR
+          (ch = '^') OR (ch = ':') OR (ch = ';') OR
+	  (ch = '{') OR (ch = '}') OR (ch = ',') OR
+	  (ch = '*')
+END isPunct ;
+
+
+(*
+   isWhite -
+*)
+
+PROCEDURE isWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch = ' ') OR (ch = tab) OR (ch = lf)
+END isWhite ;
+
+
+(*
+   outText -
+*)
+
+PROCEDURE outText (p: pretty; a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString (a) ;
+   outTextS (p, s) ;
+   s := KillString (s)
+END outText ;
+
+
+(*
+   outRawS -
+*)
+
+PROCEDURE outRawS (p: pretty; s: String) ;
+BEGIN
+   raw (p, s)
+END outRawS ;
+
+
+(*
+   outKm2 -
+*)
+
+PROCEDURE outKm2 (p: pretty; a: ARRAY OF CHAR) : pretty ;
+VAR
+   i: CARDINAL ;
+   s: String ;
+BEGIN
+   IF StrEqual (a, 'RECORD')
+   THEN
+      p := pushPretty (p) ;
+      i := getcurpos (p) ;
+      setindent (p, i) ;
+      outText (p, a) ;
+      p := pushPretty (p) ;
+      setindent (p, i + indentation)
+   ELSIF StrEqual (a, 'END')
+   THEN
+      p := popPretty (p) ;
+      outText (p, a) ;
+      p := popPretty (p)
+   END ;
+   RETURN p
+END outKm2 ;
+
+
+(*
+   outKc -
+*)
+
+PROCEDURE outKc (p: pretty; a: ARRAY OF CHAR) : pretty ;
+VAR
+   i   : INTEGER ;
+   c   : CARDINAL ;
+   s, t: String ;
+BEGIN
+   s := InitString (a) ;
+   i := DynamicStrings.Index (s, '\', 0) ;
+   IF i=-1
+   THEN
+      t := NIL
+   ELSE
+      t := DynamicStrings.Slice (s, i, 0) ;
+      s := DynamicStrings.Slice (Mark (s), 0, i)
+   END ;
+   IF DynamicStrings.char (s, 0)='{'
+   THEN
+      p := pushPretty (p) ;
+      c := getcurpos (p) ;
+      setindent (p, c) ;
+      outTextS (p, s) ;
+      p := pushPretty (p) ;
+      setindent (p, c + indentationC)
+   ELSIF DynamicStrings.char (s, 0)='}'
+   THEN
+      p := popPretty (p) ;
+      outTextS (p, s) ;
+      p := popPretty (p)
+   END ;
+   outTextS (p, t) ;
+   t := KillString (t) ;
+   s := KillString (s) ;
+   RETURN p
+END outKc ;
+
+
+(*
+   outTextS -
+*)
+
+PROCEDURE outTextS (p: pretty; s: String) ;
+BEGIN
+   IF s # NIL
+   THEN
+      prints (p, s)
+   END
+END outTextS ;
+
+
+(*
+   outCard -
+*)
+
+PROCEDURE outCard (p: pretty; c: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   s := CardinalToString (c, 0, ' ', 10, FALSE) ;
+   outTextS (p, s) ;
+   s := KillString (s)
+END outCard ;
+
+
+(*
+   outTextN -
+*)
+
+PROCEDURE outTextN (p: pretty; n: Name) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar (keyToCharStar (n)) ;
+   prints (p, s) ;
+   s := KillString (s)
+END outTextN ;
+
+
+(*
+   doTypeAliasC -
+*)
+
+PROCEDURE doTypeAliasC (p: pretty; n: node; VAR m: node) ;
+BEGIN
+   print (p, "typedef") ; setNeedSpace (p) ;
+   IF isTypeHidden (n) AND (isDef (getMainModule ()) OR (getScope (n) # getMainModule ()))
+   THEN
+      outText (p, "void *")
+   ELSE
+      doTypeC (p, getType (n), m)
+   END ;
+   IF m#NIL
+   THEN
+      doFQNameC (p, m)
+   END ;
+   print (p, ';\n\n')
+END doTypeAliasC ;
+
+
+(*
+   doEnumerationC -
+*)
+
+PROCEDURE doEnumerationC (p: pretty; n: node) ;
+VAR
+   i, h: CARDINAL ;
+   s   : node ;
+   t   : String ;
+BEGIN
+   outText (p, "enum {") ;
+   i := LowIndice (n^.enumerationF.listOfSons) ;
+   h := HighIndice (n^.enumerationF.listOfSons) ;
+   WHILE i <= h DO
+      s := GetIndice (n^.enumerationF.listOfSons, i) ;
+      doFQDNameC (p, s, FALSE) ;
+      IF i < h
+      THEN
+         outText (p, ",") ; setNeedSpace (p)
+      END ;
+      INC (i)
+   END ;
+   outText (p, "}")
+END doEnumerationC ;
+
+
+(*
+   doNamesC -
+*)
+
+PROCEDURE doNamesC (p: pretty; n: Name) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar (keyToCharStar (n)) ;
+   outTextS (p, s) ;
+   s := KillString (s)
+END doNamesC ;
+
+
+(*
+   doNameC -
+*)
+
+PROCEDURE doNameC (p: pretty; n: node) ;
+BEGIN
+   IF (n#NIL) AND (getSymName (n)#NulName)
+   THEN
+      doNamesC (p, getSymName (n))
+   END
+END doNameC ;
+
+
+(*
+   initCname -
+*)
+
+PROCEDURE initCname (VAR c: cnameT) ;
+BEGIN
+   c.init := FALSE
+END initCname ;
+
+
+(*
+   doCname -
+*)
+
+PROCEDURE doCname (n: Name; VAR c: cnameT; scopes: BOOLEAN) : Name ;
+VAR
+   s: String ;
+BEGIN
+   IF c.init
+   THEN
+      RETURN c.name
+   ELSE
+      c.init := TRUE ;
+      s := keyc.cname (n, scopes) ;
+      IF s=NIL
+      THEN
+         c.name := n
+      ELSE
+         c.name := makekey (DynamicStrings.string (s)) ;
+         s := KillString (s)
+      END ;
+      RETURN c.name
+   END
+END doCname ;
+
+
+(*
+   getDName -
+*)
+
+PROCEDURE getDName (n: node; scopes: BOOLEAN) : Name ;
+VAR
+   m: Name ;
+BEGIN
+   m := getSymName (n) ;
+   CASE n^.kind OF
+
+   procedure       :  RETURN doCname (m, n^.procedureF.cname, scopes) |
+   var             :  RETURN doCname (m, n^.varF.cname, scopes) |
+   recordfield     :  RETURN doCname (m, n^.recordfieldF.cname, scopes) |
+   enumerationfield:  RETURN doCname (m, n^.enumerationfieldF.cname, scopes)
+
+   ELSE
+   END ;
+   RETURN m
+END getDName ;
+
+
+(*
+   doDNameC -
+*)
+
+PROCEDURE doDNameC (p: pretty; n: node; scopes: BOOLEAN) ;
+BEGIN
+   IF (n#NIL) AND (getSymName (n)#NulName)
+   THEN
+      doNamesC (p, getDName (n, scopes))
+   END
+END doDNameC ;
+
+
+(*
+   doFQDNameC -
+*)
+
+PROCEDURE doFQDNameC (p: pretty; n: node; scopes: BOOLEAN) ;
+VAR
+   s: String ;
+BEGIN
+   s := getFQDstring (n, scopes) ;
+   outTextS (p, s) ;
+   s := KillString (s)
+END doFQDNameC ;
+
+
+(*
+   doFQNameC -
+*)
+
+PROCEDURE doFQNameC (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   s := getFQstring (n) ;
+   outTextS (p, s) ;
+   s := KillString (s)
+END doFQNameC ;
+
+
+(*
+   doNameM2 -
+*)
+
+PROCEDURE doNameM2 (p: pretty; n: node) ;
+BEGIN
+   doNameC (p, n)
+END doNameM2 ;
+
+
+(*
+   doUsed -
+*)
+
+PROCEDURE doUsed (p: pretty; used: BOOLEAN) ;
+BEGIN
+   IF NOT used
+   THEN
+      setNeedSpace (p) ;
+      outText (p, "__attribute__((unused))")
+   END
+END doUsed ;
+
+
+(*
+   doHighC -
+*)
+
+PROCEDURE doHighC (p: pretty; a: node; n: Name; isused: BOOLEAN) ;
+BEGIN
+   IF isArray (a) AND isUnbounded (a)
+   THEN
+      (* need to display high.  *)
+      print (p, ",") ; setNeedSpace (p) ;
+      doTypeNameC (p, cardinalN) ; setNeedSpace (p) ;
+      print (p, "_") ; outTextN (p, n) ; print (p, "_high") ;
+      doUsed (p, isused)
+   END
+END doHighC ;
+
+
+(*
+   doParamConstCast -
+*)
+
+PROCEDURE doParamConstCast (p: pretty; n: node) ;
+VAR
+   ptype: node ;
+BEGIN
+   ptype := getType (n) ;
+   IF isArray (ptype) AND isUnbounded (ptype) AND (lang = ansiCP)
+   THEN
+      outText (p, "const") ;
+      setNeedSpace (p)
+   END
+END doParamConstCast ;
+
+
+(*
+   getParameterVariable - returns the variable which shadows the parameter
+                          named, m, in parameter block, n.
+*)
+
+PROCEDURE getParameterVariable (n: node; m: Name) : node ;
+VAR
+   p: node ;
+BEGIN
+   assert (isParam (n) OR isVarParam (n)) ;
+   IF isParam (n)
+   THEN
+      p := n^.paramF.scope
+   ELSE
+      p := n^.varparamF.scope
+   END ;
+   assert (isProcedure (p)) ;
+   RETURN lookupInScope (p, m)
+END getParameterVariable ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE doParamTypeEmit (p: pretty; paramnode, paramtype: node) ;
+BEGIN
+   assert (isParam (paramnode) OR isVarParam (paramnode)) ;
+   IF isForC (paramnode) AND isProcType (skipType (paramtype))
+   THEN
+      doFQNameC (p, paramtype) ;
+      outText (p, "_C")
+   ELSE
+      doTypeNameC (p, paramtype)
+   END
+END doParamTypeEmit ;
+
+
+(*
+   doParamC - emit parameter for C/C++.
+*)
+
+PROCEDURE doParamC (p: pretty; n: node) ;
+VAR
+   v,
+   ptype: node ;
+   i    : Name ;
+   c, t : CARDINAL ;
+   l    : wlist ;
+BEGIN
+   assert (isParam (n)) ;
+   ptype := getType (n) ;
+   IF n^.paramF.namelist = NIL
+   THEN
+      doParamConstCast (p, n) ;
+      doTypeNameC (p, ptype) ;
+      doUsed (p, n^.paramF.isUsed) ;
+      IF isArray (ptype) AND isUnbounded (ptype)
+      THEN
+         outText (p, ',') ; setNeedSpace (p) ;
+         outText (p, 'unsigned int')
+      END
+   ELSE
+      assert (isIdentList (n^.paramF.namelist)) ;
+      l := n^.paramF.namelist^.identlistF.names ;
+      IF l=NIL
+      THEN
+         doParamConstCast (p, n) ;
+         doParamTypeEmit (p, n, ptype) ;
+         IF isArray (ptype) AND isUnbounded (ptype)
+         THEN
+            doUsed (p, n^.paramF.isUsed) ;
+            outText (p, ',') ; setNeedSpace (p) ;
+            outText (p, 'unsigned int')
+         END
+      ELSE
+         t := wlists.noOfItemsInList (l) ;
+         c := 1 ;
+         WHILE c <= t DO
+            doParamConstCast (p, n) ;
+            doParamTypeEmit (p, n, ptype) ;
+            i := wlists.getItemFromList (l, c) ;
+            IF isArray (ptype) AND isUnbounded (ptype)
+            THEN
+               noSpace (p)
+            ELSE
+               setNeedSpace (p)
+            END ;
+            v := getParameterVariable (n, i) ;
+            IF v=NIL
+            THEN
+               doNamesC (p, keyc.cnamen (i, TRUE))
+            ELSE
+               doFQDNameC (p, v, TRUE)
+            END ;
+            IF isArray (ptype) AND isUnbounded (ptype)
+            THEN
+               outText (p, '_')
+            END ;
+            doUsed (p, n^.paramF.isUsed) ;
+            doHighC (p, ptype, i, n^.paramF.isUsed) ;
+            IF c<t
+            THEN
+               outText (p, ',') ; setNeedSpace (p)
+            END ;
+            INC (c)
+         END
+      END
+   END
+END doParamC ;
+
+
+(*
+   doVarParamC - emit a VAR parameter for C/C++.
+*)
+
+PROCEDURE doVarParamC (p: pretty; n: node) ;
+VAR
+   v,
+   ptype: node ;
+   i    : Name ;
+   c, t : CARDINAL ;
+   l    : wlist ;
+BEGIN
+   assert (isVarParam (n)) ;
+   ptype := getType (n) ;
+   IF n^.varparamF.namelist = NIL
+   THEN
+      doTypeNameC (p, ptype) ;
+      (* doTypeC (p, ptype, n) ; *)
+      IF NOT isArray (ptype)
+      THEN
+         setNeedSpace (p) ;
+         outText (p, "*")
+      END ;
+      doUsed (p, n^.varparamF.isUsed) ;
+      IF isArray (ptype) AND isUnbounded (ptype)
+      THEN
+         outText (p, ',') ; setNeedSpace (p) ;
+         outText (p, 'unsigned int')
+      END
+   ELSE
+      assert (isIdentList (n^.varparamF.namelist)) ;
+      l := n^.varparamF.namelist^.identlistF.names ;
+      IF l=NIL
+      THEN
+         doParamTypeEmit (p, n, ptype) ;
+         doUsed (p, n^.varparamF.isUsed)
+      ELSE
+         t := wlists.noOfItemsInList (l) ;
+         c := 1 ;
+         WHILE c <= t DO
+            doParamTypeEmit (p, n, ptype) ;
+	    IF NOT isArray (ptype)
+            THEN
+               setNeedSpace (p) ;
+               outText (p, "*")
+            END ;
+            i := wlists.getItemFromList (l, c) ;
+            v := getParameterVariable (n, i) ;
+            IF v=NIL
+            THEN
+               doNamesC (p, keyc.cnamen (i, TRUE))
+            ELSE
+               doFQDNameC (p, v, TRUE)
+            END ;
+            doUsed (p, n^.varparamF.isUsed) ;
+            doHighC (p, ptype, i, n^.varparamF.isUsed) ;
+            IF c<t
+            THEN
+               outText (p, ',') ; setNeedSpace (p)
+            END ;
+            INC (c)
+         END
+      END
+   END
+END doVarParamC ;
+
+
+(*
+   doOptargC -
+*)
+
+PROCEDURE doOptargC (p: pretty; n: node) ;
+VAR
+   ptype: node ;
+   i    : Name ;
+   t    : CARDINAL ;
+   l    : wlist ;
+BEGIN
+   assert (isOptarg (n)) ;
+   ptype := getType (n) ;
+   assert (n^.optargF.namelist # NIL) ;
+   assert (isIdentList (n^.paramF.namelist)) ;
+   l := n^.paramF.namelist^.identlistF.names ;
+   assert (l # NIL) ;
+   t := wlists.noOfItemsInList (l) ;
+   assert (t = 1) ;
+   doTypeNameC (p, ptype) ;
+   i := wlists.getItemFromList (l, 1) ;
+   setNeedSpace (p) ;
+   doNamesC (p, i)
+END doOptargC ;
+
+
+(*
+   doParameterC -
+*)
+
+PROCEDURE doParameterC (p: pretty; n: node) ;
+BEGIN
+   IF isParam (n)
+   THEN
+      doParamC (p, n)
+   ELSIF isVarParam (n)
+   THEN
+      doVarParamC (p, n)
+   ELSIF isVarargs (n)
+   THEN
+      print (p, "...")
+   ELSIF isOptarg (n)
+   THEN
+      doOptargC (p, n)
+   END
+END doParameterC ;
+
+
+(*
+   doProcTypeC -
+*)
+
+PROCEDURE doProcTypeC (p: pretty; t, n: node) ;
+BEGIN
+   assert (isType (t)) ;
+   outputPartial (t) ;
+   doCompletePartialProcType (p, t, n)
+END doProcTypeC ;
+
+
+(*
+   doTypesC -
+*)
+
+PROCEDURE doTypesC (n: node) ;
+VAR
+   m: node ;
+BEGIN
+   IF isType (n)
+   THEN
+      m := getType (n) ;
+      IF isProcType (m)
+      THEN
+         doProcTypeC (doP, n, m)
+      ELSIF isType (m) OR isPointer (m)
+      THEN
+         outText (doP, "typedef") ; setNeedSpace (doP) ;
+         doTypeC (doP, m, m) ;
+	 IF isType (m)
+         THEN
+            setNeedSpace (doP)
+         END ;
+         doTypeNameC (doP, n) ;
+         outText (doP, ";\n\n")
+      ELSIF isEnumeration (m)
+      THEN
+         outText (doP, "typedef") ; setNeedSpace (doP) ;
+         doTypeC (doP, m, m) ;
+         setNeedSpace (doP) ;
+	 doTypeNameC (doP, n) ;
+         outText (doP, ";\n\n")
+      ELSE
+         outText (doP, "typedef") ; setNeedSpace (doP) ;
+         doTypeC (doP, m, m) ;
+	 IF isType (m)
+         THEN
+            setNeedSpace (doP)
+         END ;
+         doTypeNameC (doP, n) ;
+         outText (doP, ";\n\n")
+      END
+   END
+END doTypesC ;
+
+
+(*
+   doCompletePartialC -
+*)
+
+PROCEDURE doCompletePartialC (n: node) ;
+VAR
+   m: node ;
+BEGIN
+   IF isType (n)
+   THEN
+      m := getType (n) ;
+      IF isRecord (m)
+      THEN
+         doCompletePartialRecord (doP, n, m)
+      ELSIF isArray (m)
+      THEN
+         doCompletePartialArray (doP, n, m)
+      ELSIF isProcType (m)
+      THEN
+         doCompletePartialProcType (doP, n, m)
+      END
+   END
+END doCompletePartialC ;
+
+
+(*
+   doCompletePartialRecord -
+*)
+
+PROCEDURE doCompletePartialRecord (p: pretty; t, r: node) ;
+VAR
+   i, h: CARDINAL ;
+   f   : node ;
+BEGIN
+   assert (isRecord (r)) ;
+   assert (isType (t)) ;
+   outText (p, "struct") ; setNeedSpace (p) ;
+   doFQNameC (p, t) ;
+   outText (p, "_r") ; setNeedSpace (p) ;
+   p := outKc (p, "{\n") ;
+   i := LowIndice (r^.recordF.listOfSons) ;
+   h := HighIndice (r^.recordF.listOfSons) ;
+   WHILE i<=h DO
+      f := GetIndice (r^.recordF.listOfSons, i) ;
+      IF isRecordField (f)
+      THEN
+         IF NOT f^.recordfieldF.tag
+         THEN
+            setNeedSpace (p) ;
+            doRecordFieldC (p, f) ;
+            outText (p, ";\n")
+         END
+      ELSIF isVarient (f)
+      THEN
+         doVarientC (p, f) ;
+         outText (p, ";\n")
+      ELSIF isVarientField (f)
+      THEN
+         doVarientFieldC (p, f)
+      END ;
+      INC (i)
+   END ;
+   p := outKc (p, "};\n\n")
+END doCompletePartialRecord ;
+
+
+(*
+   doCompletePartialArray -
+*)
+
+PROCEDURE doCompletePartialArray (p: pretty; t, r: node) ;
+VAR
+   type, s: node ;
+BEGIN
+   assert (isArray (r)) ;
+   type := r^.arrayF.type ;
+   s := NIL ;
+   outText (p, "struct") ; setNeedSpace (p) ;
+   doFQNameC (p, t) ;
+   outText (p, "_a {") ;
+   setNeedSpace (p) ;
+   doTypeC (p, type, s) ;
+   setNeedSpace (p) ;
+   outText (p, "array[") ;
+   doSubrC (p, r^.arrayF.subr) ;
+   outText (p, "];") ;
+   setNeedSpace (p) ;
+   outText (p, "};\n")
+END doCompletePartialArray ;
+
+
+(*
+   lookupConst -
+*)
+
+PROCEDURE lookupConst (type: node; n: Name) : node ;
+BEGIN
+   RETURN makeLiteralInt (n)
+END lookupConst ;
+
+
+(*
+   doMin -
+*)
+
+PROCEDURE doMin (n: node) : node ;
+BEGIN
+   IF n=booleanN
+   THEN
+      RETURN falseN
+   ELSIF n=integerN
+   THEN
+      keyc.useIntMin ;
+      RETURN lookupConst (integerN, makeKey ('INT_MIN'))
+   ELSIF n=cardinalN
+   THEN
+      keyc.useUIntMin ;
+      RETURN lookupConst (cardinalN, makeKey ('UINT_MIN'))
+   ELSIF n=longintN
+   THEN
+      keyc.useLongMin ;
+      RETURN lookupConst (longintN, makeKey ('LONG_MIN'))
+   ELSIF n=longcardN
+   THEN
+      keyc.useULongMin ;
+      RETURN lookupConst (longcardN, makeKey ('LONG_MIN'))
+   ELSIF n=charN
+   THEN
+      keyc.useCharMin ;
+      RETURN lookupConst (charN, makeKey ('CHAR_MIN'))
+   ELSIF n=bitsetN
+   THEN
+      assert (isSubrange (bitnumN)) ;
+      RETURN bitnumN^.subrangeF.low
+   ELSIF n=locN
+   THEN
+      keyc.useUCharMin ;
+      RETURN lookupConst (locN, makeKey ('UCHAR_MIN'))
+   ELSIF n=byteN
+   THEN
+      keyc.useUCharMin ;
+      RETURN lookupConst (byteN, makeKey ('UCHAR_MIN'))
+   ELSIF n=wordN
+   THEN
+      keyc.useUIntMin ;
+      RETURN lookupConst (wordN, makeKey ('UCHAR_MIN'))
+   ELSIF n=addressN
+   THEN
+      RETURN lookupConst (addressN, makeKey ('((void *) 0)'))
+   ELSE
+      HALT  (* finish the cacading elsif statement.  *)
+   END
+END doMin ;
+
+
+(*
+   doMax -
+*)
+
+PROCEDURE doMax (n: node) : node ;
+BEGIN
+   IF n=booleanN
+   THEN
+      RETURN trueN
+   ELSIF n=integerN
+   THEN
+      keyc.useIntMax ;
+      RETURN lookupConst (integerN, makeKey ('INT_MAX'))
+   ELSIF n=cardinalN
+   THEN
+      keyc.useUIntMax ;
+      RETURN lookupConst (cardinalN, makeKey ('UINT_MAX'))
+   ELSIF n=longintN
+   THEN
+      keyc.useLongMax ;
+      RETURN lookupConst (longintN, makeKey ('LONG_MAX'))
+   ELSIF n=longcardN
+   THEN
+      keyc.useULongMax ;
+      RETURN lookupConst (longcardN, makeKey ('ULONG_MAX'))
+   ELSIF n=charN
+   THEN
+      keyc.useCharMax ;
+      RETURN lookupConst (charN, makeKey ('CHAR_MAX'))
+   ELSIF n=bitsetN
+   THEN
+      assert (isSubrange (bitnumN)) ;
+      RETURN bitnumN^.subrangeF.high
+   ELSIF n=locN
+   THEN
+      keyc.useUCharMax ;
+      RETURN lookupConst (locN, makeKey ('UCHAR_MAX'))
+   ELSIF n=byteN
+   THEN
+      keyc.useUCharMax ;
+      RETURN lookupConst (byteN, makeKey ('UCHAR_MAX'))
+   ELSIF n=wordN
+   THEN
+      keyc.useUIntMax ;
+      RETURN lookupConst (wordN, makeKey ('UINT_MAX'))
+   ELSIF n=addressN
+   THEN
+      metaError1 ('trying to obtain MAX ({%1ad}) is illegal', n) ;
+      RETURN NIL
+   ELSE
+      HALT  (* finish the cacading elsif statement.  *)
+   END
+END doMax ;
+
+
+(*
+   getMax -
+*)
+
+PROCEDURE getMax (n: node) : node ;
+BEGIN
+   n := skipType (n) ;
+   IF isSubrange (n)
+   THEN
+      RETURN n^.subrangeF.high
+   ELSIF isEnumeration (n)
+   THEN
+      RETURN n^.enumerationF.high
+   ELSE
+      assert (isOrdinal (n)) ;
+      RETURN doMax (n)
+   END
+END getMax ;
+
+
+(*
+   getMin -
+*)
+
+PROCEDURE getMin (n: node) : node ;
+BEGIN
+   n := skipType (n) ;
+   IF isSubrange (n)
+   THEN
+      RETURN n^.subrangeF.low
+   ELSIF isEnumeration (n)
+   THEN
+      RETURN n^.enumerationF.low
+   ELSE
+      assert (isOrdinal (n)) ;
+      RETURN doMin (n)
+   END
+END getMin ;
+
+
+(*
+   doSubtractC -
+*)
+
+PROCEDURE doSubtractC (p: pretty; s: node) ;
+BEGIN
+   IF NOT isZero (s)
+   THEN
+      outText (p, "-") ;
+      doExprC (p, s)
+   END
+END doSubtractC ;
+
+
+(*
+   doSubrC -
+*)
+
+PROCEDURE doSubrC (p: pretty; s: node) ;
+VAR
+   low, high: node ;
+BEGIN
+   s := skipType (s) ;
+   IF isOrdinal (s)
+   THEN
+      low := getMin (s) ;
+      high := getMax (s) ;
+      doExprC (p, high) ;
+      doSubtractC (p, low) ;
+      outText (p, "+1")
+   ELSIF isEnumeration (s)
+   THEN
+      low := getMin (s) ;
+      high := getMax (s) ;
+      doExprC (p, high) ;
+      doSubtractC (p, low) ;
+      outText (p, "+1")
+   ELSE
+      assert (isSubrange (s)) ;
+      IF (s^.subrangeF.high = NIL) OR (s^.subrangeF.low = NIL)
+      THEN
+         doSubrC (p, getType (s))
+      ELSE
+         doExprC (p, s^.subrangeF.high) ;
+         doSubtractC (p, s^.subrangeF.low) ;
+         outText (p, "+1")
+      END
+   END
+END doSubrC ;
+
+
+(*
+   doCompletePartialProcType -
+*)
+
+PROCEDURE doCompletePartialProcType (p: pretty; t, n: node) ;
+VAR
+   i, h: CARDINAL ;
+   v, u: node ;
+BEGIN
+   assert (isProcType (n)) ;
+   u := NIL ;
+   outText (p, "typedef") ; setNeedSpace (p) ;
+   doTypeC (p, n^.proctypeF.returnType, u) ; setNeedSpace (p) ;
+   outText (p, "(*") ;
+   doFQNameC (p, t) ;
+   outText (p, "_t) (") ;
+   i := LowIndice (n^.proctypeF.parameters) ;
+   h := HighIndice (n^.proctypeF.parameters) ;
+   WHILE i <= h DO
+      v := GetIndice (n^.proctypeF.parameters, i) ;
+      doParameterC (p, v) ;
+      noSpace (p) ;
+      IF i < h
+      THEN
+         outText (p, ",") ; setNeedSpace (p)
+      END ;
+      INC (i)
+   END ;
+   IF h=0
+   THEN
+      outText (p, "void")
+   END ;
+   outText (p, ");\n") ;
+   IF isDefForCNode (n)
+   THEN
+      (* emit a C named type which differs from the m2 proctype.  *)
+      outText (p, "typedef") ; setNeedSpace (p) ;
+      doFQNameC (p, t) ;
+      outText (p, "_t") ; setNeedSpace (p) ;
+      doFQNameC (p, t) ;
+      outText (p, "_C;\n\n")
+   END ;
+   outText (p, "struct") ; setNeedSpace (p) ;
+   doFQNameC (p, t) ;
+   outText (p, "_p {") ; setNeedSpace (p) ;
+   doFQNameC (p, t) ;
+   outText (p, "_t proc; };\n\n")
+END doCompletePartialProcType ;
+
+
+(*
+   isBase -
+*)
+
+PROCEDURE isBase (n: node) : BOOLEAN ;
+BEGIN
+   CASE n^.kind OF
+
+   char,
+   cardinal,
+   longcard,
+   shortcard,
+   integer,
+   longint,
+   shortint,
+   complex,
+   longcomplex,
+   shortcomplex,
+   real,
+   longreal,
+   shortreal,
+   bitset,
+   boolean,
+   proc     :  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isBase ;
+
+
+(*
+   doBaseC -
+*)
+
+PROCEDURE doBaseC (p: pretty; n: node) ;
+BEGIN
+   CASE n^.kind OF
+
+   char        :  outText (p, 'char') |
+   cardinal    :  outText (p, 'unsigned int') |
+   longcard    :  outText (p, 'long unsigned int') |
+   shortcard   :  outText (p, 'short unsigned int') |
+   integer     :  outText (p, 'int') |
+   longint     :  outText (p, 'long int') |
+   shortint    :  outText (p, 'short int') |
+   complex     :  outText (p, 'double complex') |
+   longcomplex :  outText (p, 'long double complex') |
+   shortcomplex:  outText (p, 'float complex') |
+   real        :  outText (p, 'double') |
+   longreal    :  outText (p, 'long double') |
+   shortreal   :  outText (p, 'float') |
+   bitset      :  outText (p, 'unsigned int') |
+   boolean     :  outText (p, 'unsigned int') |
+   proc        :  outText (p, 'PROC')
+
+   END ;
+   setNeedSpace (p)
+END doBaseC ;
+
+
+(*
+   isSystem -
+*)
+
+PROCEDURE isSystem (n: node) : BOOLEAN ;
+BEGIN
+   CASE n^.kind OF
+
+   address:  RETURN TRUE |
+   loc    :  RETURN TRUE |
+   byte   :  RETURN TRUE |
+   word   :  RETURN TRUE |
+   csizet :  RETURN TRUE |
+   cssizet:  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isSystem ;
+
+
+(*
+   doSystemC -
+*)
+
+PROCEDURE doSystemC (p: pretty; n: node) ;
+BEGIN
+   CASE n^.kind OF
+
+   address:  outText (p, 'void *') |
+   loc    :  outText (p, 'unsigned char') ; setNeedSpace (p) |
+   byte   :  outText (p, 'unsigned char') ; setNeedSpace (p) |
+   word   :  outText (p, 'unsigned int') ; setNeedSpace (p) |
+   csizet :  outText (p, 'size_t') ; setNeedSpace (p) ; keyc.useSize_t |
+   cssizet:  outText (p, 'ssize_t') ; setNeedSpace (p) ; keyc.useSSize_t
+
+   END
+END doSystemC ;
+
+
+(*
+   doArrayC -
+*)
+
+PROCEDURE doArrayC (p: pretty; n: node) ;
+VAR
+   t, s, u: node ;
+BEGIN
+   assert (isArray (n)) ;
+   t := n^.arrayF.type ;
+   s := n^.arrayF.subr ;
+   u := NIL ;
+   IF s=NIL
+   THEN
+      doTypeC (p, t, u) ;
+      setNeedSpace (p) ;
+      outText (p, "*")
+   ELSE
+      outText (p, "struct") ;
+      setNeedSpace (p) ;
+      outText (p, "{") ;
+      setNeedSpace (p) ;
+      doTypeC (p, t, u) ;
+      setNeedSpace (p) ;
+      outText (p, "array[") ;
+      IF isZero (getMin (s))
+      THEN
+         doExprC (p, getMax (s))
+      ELSE
+         doExprC (p, getMax (s)) ;
+         doSubtractC (p, getMin (s))
+      END ;
+      outText (p, "];") ;
+      setNeedSpace (p) ;
+      outText (p, "}") ;
+      setNeedSpace (p)
+   END
+END doArrayC ;
+
+
+(*
+   doPointerC -
+*)
+
+PROCEDURE doPointerC (p: pretty; n: node; VAR m: node) ;
+VAR
+   t, s: node ;
+BEGIN
+   t := n^.pointerF.type ;
+   s := NIL ;
+   doTypeC (p, t, s) ;
+   setNeedSpace (p) ;
+   outText (p, "*")
+END doPointerC ;
+
+
+(*
+   doRecordFieldC -
+*)
+
+PROCEDURE doRecordFieldC (p: pretty; f: node) ;
+VAR
+   m: node ;
+BEGIN
+   m := NIL ;
+   setNeedSpace (p) ;
+   doTypeC (p, f^.recordfieldF.type, m) ;
+   doDNameC (p, f, FALSE)
+END doRecordFieldC ;
+
+
+(*
+   doVarientFieldC -
+*)
+
+PROCEDURE doVarientFieldC (p: pretty; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   assert (isVarientField (n)) ;
+   IF NOT n^.varientfieldF.simple
+   THEN
+      outText (p, "struct") ; setNeedSpace (p) ;
+      p := outKc (p, "{\n")
+   END ;
+   i := LowIndice (n^.varientfieldF.listOfSons) ;
+   t := HighIndice (n^.varientfieldF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientfieldF.listOfSons, i) ;
+      IF isRecordField (q)
+      THEN
+         IF NOT q^.recordfieldF.tag
+         THEN
+            doRecordFieldC (p, q) ;
+            outText (p, ";\n")
+         END
+      ELSIF isVarient (q)
+      THEN
+         doVarientC (p, q) ;
+         outText (p, ";\n")
+      ELSE
+         HALT
+      END ;
+      INC (i)
+   END ;
+   IF NOT n^.varientfieldF.simple
+   THEN
+      p := outKc (p, "};\n")
+   END
+END doVarientFieldC ;
+
+
+(*
+   doVarientC -
+*)
+
+PROCEDURE doVarientC (p: pretty; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   assert (isVarient (n)) ;
+   IF n^.varientF.tag # NIL
+   THEN
+      IF isRecordField (n^.varientF.tag)
+      THEN
+         doRecordFieldC (p, n^.varientF.tag) ;
+	 outText (p, ";  /* case tag */\n")
+      ELSIF isVarientField (n^.varientF.tag)
+      THEN
+         HALT
+         (* doVarientFieldC (p, n^.varientF.tag) *)
+      ELSE
+         HALT
+      END
+   END ;
+   outText (p, "union") ;
+   setNeedSpace (p) ;
+   p := outKc (p, "{\n") ;
+   i := LowIndice (n^.varientF.listOfSons) ;
+   t := HighIndice (n^.varientF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientF.listOfSons, i) ;
+      IF isRecordField (q)
+      THEN
+         IF NOT q^.recordfieldF.tag
+         THEN
+            doRecordFieldC (p, q) ;
+            outText (p, ";\n")
+         END
+      ELSIF isVarientField (q)
+      THEN
+         doVarientFieldC (p, q)
+      ELSE
+         HALT
+      END ;
+      INC (i)
+   END ;
+   p := outKc (p, "}")
+END doVarientC ;
+
+
+(*
+   doRecordC -
+*)
+
+PROCEDURE doRecordC (p: pretty; n: node; VAR m: node) ;
+VAR
+   i, h: CARDINAL ;
+   f   : node ;
+BEGIN
+   assert (isRecord (n)) ;
+   outText (p, "struct") ;
+   setNeedSpace (p) ;
+   p := outKc (p, "{") ;
+   i := LowIndice (n^.recordF.listOfSons) ;
+   h := HighIndice (n^.recordF.listOfSons) ;
+   setindent (p, getcurpos (p) + indentation) ;
+   outText (p, "\n") ;
+   WHILE i<=h DO
+      f := GetIndice (n^.recordF.listOfSons, i) ;
+      IF isRecordField (f)
+      THEN
+         IF NOT f^.recordfieldF.tag
+         THEN
+            doRecordFieldC (p, f) ;
+            outText (p, ";\n")
+         END
+      ELSIF isVarient (f)
+      THEN
+         doVarientC (p, f) ;
+         outText (p, ";\n")
+      ELSIF isVarientField (f)
+      THEN
+         doVarientFieldC (p, f)
+      END ;
+      INC (i)
+   END ;
+   p := outKc (p, "}") ;
+   setNeedSpace (p)
+END doRecordC ;
+
+
+(*
+   isBitset -
+*)
+
+PROCEDURE isBitset (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n = bitsetN
+END isBitset ;
+
+
+(*
+   isNegative - returns TRUE if expression, n, is negative.
+*)
+
+PROCEDURE isNegative (n: node) : BOOLEAN ;
+BEGIN
+   (* --fixme-- needs to be completed.  *)
+   RETURN FALSE
+END isNegative ;
+
+
+(*
+   doSubrangeC -
+*)
+
+PROCEDURE doSubrangeC (p: pretty; n: node) ;
+BEGIN
+   assert (isSubrange (n)) ;
+   IF isNegative (n^.subrangeF.low)
+   THEN
+      outText (p, "int") ; setNeedSpace (p)
+   ELSE
+      outText (p, "unsigned int") ; setNeedSpace (p)
+   END
+END doSubrangeC ;
+
+
+(*
+   doSetC - generates a C type which holds the set.
+            Currently we only support sets of size WORD.
+*)
+
+PROCEDURE doSetC (p: pretty; n: node) ;
+BEGIN
+   assert (isSet (n)) ;
+   outText (p, "unsigned int") ; setNeedSpace (p)
+END doSetC ;
+
+
+(*
+   doTypeC -
+*)
+
+PROCEDURE doTypeC (p: pretty; n: node; VAR m: node) ;
+BEGIN
+   IF n=NIL
+   THEN
+      outText (p, "void")
+   ELSIF isBase (n)
+   THEN
+      doBaseC (p, n)
+   ELSIF isSystem (n)
+   THEN
+      doSystemC (p, n)
+   ELSIF isEnumeration (n)
+   THEN
+      doEnumerationC (p, n)
+   ELSIF isType (n)
+   THEN
+      doFQNameC (p, n) ;
+      setNeedSpace (p)
+      (* doTypeAliasC (p, n, n) *)  (* type, n, has a name, so we choose this over, m.  *)
+(*
+   ELSIF isProcType (n) OR isArray (n) OR isRecord (n)
+   THEN
+      HALT  (* n should have been simplified.  *)
+*)
+   ELSIF isProcType (n)
+   THEN
+      doProcTypeC (p, n, m)
+   ELSIF isArray (n)
+   THEN
+      doArrayC (p, n)
+   ELSIF isRecord (n)
+   THEN
+      doRecordC (p, n, m)
+   ELSIF isPointer (n)
+   THEN
+      doPointerC (p, n, m)
+   ELSIF isSubrange (n)
+   THEN
+      doSubrangeC (p, n)
+   ELSIF isSet (n)
+   THEN
+      doSetC (p, n)
+   ELSE
+      (* --fixme--  *)
+      print (p, "to do ...  typedef etc etc ") ; doFQNameC (p, n) ; print (p, ";\n") ;
+      HALT
+   END
+END doTypeC ;
+
+
+(*
+   doArrayNameC - it displays the array declaration (it might be an unbounded).
+*)
+
+PROCEDURE doArrayNameC (p: pretty; n: node) ;
+BEGIN
+   doTypeNameC (p, getType (n)) ; setNeedSpace (p) ; outText (p, "*")
+END doArrayNameC ;
+
+
+(*
+   doRecordNameC - emit the C/C++ record name <name of n>"_r".
+*)
+
+PROCEDURE doRecordNameC (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   s := getFQstring (n) ;
+   s := ConCat (s, Mark (InitString ("_r"))) ;
+   outTextS (p, s) ;
+   s := KillString (s)
+END doRecordNameC ;
+
+
+(*
+   doPointerNameC - emit the C/C++ pointer type <name of n>*.
+*)
+
+PROCEDURE doPointerNameC (p: pretty; n: node) ;
+BEGIN
+   doTypeNameC (p, getType (n)) ; setNeedSpace (p) ; outText (p, "*")
+END doPointerNameC ;
+
+
+(*
+   doTypeNameC -
+*)
+
+PROCEDURE doTypeNameC (p: pretty; n: node) ;
+VAR
+   t: String ;
+BEGIN
+   IF n=NIL
+   THEN
+      outText (p, "void") ;
+      setNeedSpace (p)
+   ELSIF isBase (n)
+   THEN
+      doBaseC (p, n)
+   ELSIF isSystem (n)
+   THEN
+      doSystemC (p, n)
+   ELSIF isEnumeration (n)
+   THEN
+      print (p, "is enumeration type name required\n")
+   ELSIF isType (n)
+   THEN
+      doFQNameC (p, n) ;
+   ELSIF isProcType (n)
+   THEN
+      doFQNameC (p, n) ;
+      outText (p, "_t")
+   ELSIF isArray (n)
+   THEN
+      doArrayNameC (p, n)
+   ELSIF isRecord (n)
+   THEN
+      doRecordNameC (p, n)
+   ELSIF isPointer (n)
+   THEN
+      doPointerNameC (p, n)
+   ELSIF isSubrange (n)
+   THEN
+      doSubrangeC (p, n)
+   ELSE
+      print (p, "is type unknown required\n") ;
+      stop
+   END
+END doTypeNameC ;
+
+
+(*
+   isExternal - returns TRUE if symbol, n, was declared in another module.
+*)
+
+PROCEDURE isExternal (n: node) : BOOLEAN ;
+VAR
+   s: node ;
+BEGIN
+   s := getScope (n) ;
+   RETURN (s # NIL) AND isDef (s) AND
+           ((isImp (getMainModule ()) AND (s # lookupDef (getSymName (getMainModule ())))) OR
+            isModule (getMainModule ()))
+END isExternal ;
+
+
+(*
+   doVarC -
+*)
+
+PROCEDURE doVarC (n: node) ;
+VAR
+   s: node ;
+BEGIN
+   IF isDef (getMainModule ())
+   THEN
+      print (doP, "EXTERN") ; setNeedSpace (doP)
+   ELSIF (NOT isExported (n)) AND (NOT isLocal (n))
+   THEN
+      print (doP, "static") ; setNeedSpace (doP)
+   ELSIF getExtendedOpaque ()
+   THEN
+      IF isExternal (n)
+      THEN
+         (* different module declared this variable, therefore it is extern.  *)
+         print (doP, "extern") ; setNeedSpace (doP)
+      END
+   END ;
+   s := NIL ;
+   doTypeC (doP, getType (n), s) ;
+   setNeedSpace (doP) ;
+   doFQDNameC (doP, n, FALSE) ;
+   print (doP, ";\n")
+END doVarC ;
+
+
+(*
+   doExternCP -
+*)
+
+PROCEDURE doExternCP (p: pretty) ;
+BEGIN
+   IF lang = ansiCP
+   THEN
+      outText (p, 'extern "C"') ; setNeedSpace (p)
+   END
+END doExternCP ;
+
+
+(*
+   doProcedureCommentText -
+*)
+
+PROCEDURE doProcedureCommentText (p: pretty; s: String) ;
+BEGIN
+   (* remove \n from the start of the comment.  *)
+   WHILE (DynamicStrings.Length (s) > 0) AND (DynamicStrings.char (s, 0) = lf) DO
+      s := DynamicStrings.Slice (s, 1, 0)
+   END ;
+   outTextS (p, s)
+END doProcedureCommentText ;
+
+
+(*
+   doProcedureComment -
+*)
+
+PROCEDURE doProcedureComment (p: pretty; s: String) ;
+BEGIN
+   IF s # NIL
+   THEN
+      outText (p, '\n/*\n') ;
+      doProcedureCommentText (p, s) ;
+      outText (p, '*/\n\n')
+   END
+END doProcedureComment ;
+
+
+(*
+   doProcedureHeadingC -
+*)
+
+PROCEDURE doProcedureHeadingC (n: node; prototype: BOOLEAN) ;
+VAR
+   i, h: CARDINAL ;
+   p, q: node ;
+BEGIN
+   assert (isProcedure (n)) ;
+   noSpace (doP) ;
+   IF isDef (getMainModule ())
+   THEN
+      doProcedureComment (doP, getContent (n^.procedureF.defComment)) ;
+      outText (doP, "EXTERN") ; setNeedSpace (doP)
+   ELSIF isExported (n)
+   THEN
+      doProcedureComment (doP, getContent (n^.procedureF.modComment)) ;
+      doExternCP (doP)
+   ELSE
+      doProcedureComment (doP, getContent (n^.procedureF.modComment)) ;
+      outText (doP, "static") ; setNeedSpace (doP)
+   END ;
+   q := NIL ;
+   doTypeC (doP, n^.procedureF.returnType, q) ; setNeedSpace (doP) ;
+   doFQDNameC (doP, n, FALSE) ;
+   setNeedSpace (doP) ;
+   outText (doP, "(") ;
+   i := LowIndice (n^.procedureF.parameters) ;
+   h := HighIndice (n^.procedureF.parameters) ;
+   WHILE i <= h DO
+      p := GetIndice (n^.procedureF.parameters, i) ;
+      doParameterC (doP, p) ;
+      noSpace (doP) ;
+      IF i < h
+      THEN
+         print (doP, ",") ; setNeedSpace (doP)
+      END ;
+      INC (i)
+   END ;
+   IF h=0
+   THEN
+      outText (doP, "void")
+   END ;
+   print (doP, ")") ;
+   IF n^.procedureF.noreturn AND prototype
+   THEN
+      setNeedSpace (doP) ;
+      outText (doP, "__attribute__ ((noreturn))")
+   END
+END doProcedureHeadingC ;
+
+
+(*
+   checkDeclareUnboundedParamCopyC -
+*)
+
+PROCEDURE checkDeclareUnboundedParamCopyC (p: pretty; n: node) : BOOLEAN ;
+VAR
+   t   : node ;
+   i, c: CARDINAL ;
+   l   : wlist ;
+   seen: BOOLEAN ;
+BEGIN
+   seen := FALSE ;
+   t := getType (n) ;
+   l := n^.paramF.namelist^.identlistF.names ;
+   IF isArray (t) AND isUnbounded (t) AND (l#NIL)
+   THEN
+      t := getType (t) ;
+      c := wlists.noOfItemsInList (l) ;
+      i := 1 ;
+      WHILE i <= c DO
+         doTypeNameC (p, t) ;
+         setNeedSpace (p) ;
+         doNamesC (p, wlists.getItemFromList (l, i)) ;
+         outText (p, '[_');
+         doNamesC (p, wlists.getItemFromList (l, i)) ;
+         outText (p, '_high+1];\n');
+         seen := TRUE ;
+         INC (i)
+      END
+   END ;
+   RETURN seen
+END checkDeclareUnboundedParamCopyC ;
+
+
+(*
+   checkUnboundedParamCopyC -
+*)
+
+PROCEDURE checkUnboundedParamCopyC (p: pretty; n: node) ;
+VAR
+   t, s: node ;
+   i, c: CARDINAL ;
+   l   : wlist ;
+BEGIN
+   t := getType (n) ;
+   l := n^.paramF.namelist^.identlistF.names ;
+   IF isArray (t) AND isUnbounded (t) AND (l#NIL)
+   THEN
+      c := wlists.noOfItemsInList (l) ;
+      i := 1 ;
+      t := getType (t) ;
+      s := skipType (t) ;
+      WHILE i <= c DO
+         keyc.useMemcpy ;
+         outText (p, 'memcpy (') ;
+         doNamesC (p, wlists.getItemFromList (l, i)) ;
+         outText (p, ',') ;
+         setNeedSpace (p) ;
+         doNamesC (p, wlists.getItemFromList (l, i)) ;
+         outText (p, '_, ') ;
+         IF (s = charN) OR (s = byteN) OR (s = locN)
+         THEN
+            outText (p, '_') ;
+            doNamesC (p, wlists.getItemFromList (l, i)) ;
+            outText (p, '_high+1);\n')
+         ELSE
+            outText (p, '(_') ;
+            doNamesC (p, wlists.getItemFromList (l, i)) ;
+            outText (p, '_high+1)') ;
+            setNeedSpace (p) ;
+            doMultiplyBySize (p, t) ;
+            outText (p, ');\n')
+         END ;
+         INC (i)
+      END
+   END
+END checkUnboundedParamCopyC ;
+
+
+(*
+   doUnboundedParamCopyC -
+*)
+
+PROCEDURE doUnboundedParamCopyC (p: pretty; n: node) ;
+VAR
+   i, h: CARDINAL ;
+   q   : node ;
+   seen: BOOLEAN ;
+BEGIN
+   assert (isProcedure (n)) ;
+   i := LowIndice (n^.procedureF.parameters) ;
+   h := HighIndice (n^.procedureF.parameters) ;
+   seen := FALSE ;
+   WHILE i <= h DO
+      q := GetIndice (n^.procedureF.parameters, i) ;
+      IF isParam (q)
+      THEN
+         seen := checkDeclareUnboundedParamCopyC (p, q) OR seen
+      END ;
+      INC (i)
+   END ;
+   IF seen
+   THEN
+      outText (p, "\n") ;
+      outText (p, "/* make a local copy of each unbounded array.  */\n") ;
+      i := LowIndice (n^.procedureF.parameters) ;
+      WHILE i <= h DO
+         q := GetIndice (n^.procedureF.parameters, i) ;
+         IF isParam (q)
+         THEN
+            checkUnboundedParamCopyC (p, q)
+         END ;
+         INC (i)
+      END
+   END
+END doUnboundedParamCopyC ;
+
+
+(*
+   doPrototypeC -
+*)
+
+PROCEDURE doPrototypeC (n: node) ;
+BEGIN
+   IF NOT isExported (n)
+   THEN
+      keyc.enterScope (n) ;
+      doProcedureHeadingC (n, TRUE) ;
+      print (doP, ";\n") ;
+      keyc.leaveScope (n)
+   END
+END doPrototypeC ;
+
+
+(*
+   addTodo - adds, n, to the todo list.
+*)
+
+PROCEDURE addTodo (n: node) ;
+BEGIN
+   IF (n#NIL) AND
+      (NOT alists.isItemInList (partialQ, n)) AND
+      (NOT alists.isItemInList (doneQ, n))
+   THEN
+      assert (NOT isVarient (n)) ;
+      assert (NOT isVarientField (n)) ;
+      assert (NOT isDef (n)) ;
+      alists.includeItemIntoList (todoQ, n)
+   END
+END addTodo ;
+
+
+(*
+   addVariablesTodo -
+*)
+
+PROCEDURE addVariablesTodo (n: node) ;
+BEGIN
+   IF isVar (n)
+   THEN
+      IF n^.varF.isParameter OR n^.varF.isVarParameter
+      THEN
+         addDone (n) ;
+         addTodo (getType (n))
+      ELSE
+         addTodo (n)
+      END
+   END
+END addVariablesTodo ;
+
+
+(*
+   addTypesTodo -
+*)
+
+PROCEDURE addTypesTodo (n: node) ;
+BEGIN
+   IF isUnbounded (n)
+   THEN
+      addDone (n)
+   ELSE
+      addTodo (n)
+   END
+END addTypesTodo ;
+
+
+(*
+   tempName -
+*)
+
+PROCEDURE tempName () : String ;
+BEGIN
+   INC (tempCount) ;
+   RETURN Sprintf1 (InitString ("_T%d"), tempCount) ;
+END tempName ;
+
+
+(*
+   makeIntermediateType -
+*)
+
+PROCEDURE makeIntermediateType (s: String; p: node) : node ;
+VAR
+   n: Name ;
+   o: node ;
+BEGIN
+   n := makekey (DynamicStrings.string (s)) ;
+   enterScope (getScope (p)) ;
+   o := p ;
+   p := makeType (makekey (DynamicStrings.string (s))) ;
+   putType (p, o) ;
+   putTypeInternal (p) ;
+   leaveScope ;
+   RETURN p
+END makeIntermediateType ;
+
+
+(*
+   simplifyType -
+*)
+
+PROCEDURE simplifyType (l: alist; VAR p: node) ;
+VAR
+   s: String ;
+BEGIN
+   IF (p#NIL) AND (isRecord (p) OR isArray (p) OR isProcType (p)) AND (NOT isUnbounded (p))
+   THEN
+      s := tempName () ;
+      p := makeIntermediateType (s, p) ;
+      s := KillString (s) ;
+      simplified := FALSE
+   END ;
+   simplifyNode (l, p)
+END simplifyType ;
+
+
+(*
+   simplifyVar -
+*)
+
+PROCEDURE simplifyVar (l: alist; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   v,
+   d, o: node ;
+BEGIN
+   assert (isVar (n)) ;
+   o := n^.varF.type ;
+   simplifyType (l, n^.varF.type) ;
+   IF o # n^.varF.type
+   THEN
+      (* simplification has occurred, make sure that all other variables of this type
+         use the new type.  *)
+      d := n^.varF.decl ;
+      assert (isVarDecl (d)) ;
+      t := wlists.noOfItemsInList (d^.vardeclF.names) ;
+      i := 1 ;
+      WHILE i<=t DO
+         v := lookupInScope (n^.varF.scope, wlists.getItemFromList (d^.vardeclF.names, i)) ;
+         assert (isVar (v)) ;
+         v^.varF.type := n^.varF.type ;
+         INC (i)
+      END
+   END
+END simplifyVar ;
+
+
+(*
+   simplifyRecord -
+*)
+
+PROCEDURE simplifyRecord (l: alist; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   i := LowIndice (n^.recordF.listOfSons) ;
+   t := HighIndice (n^.recordF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.recordF.listOfSons, i) ;
+      simplifyNode (l, q) ;
+      INC (i)
+   END
+END simplifyRecord ;
+
+
+(*
+   simplifyVarient -
+*)
+
+PROCEDURE simplifyVarient (l: alist; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   simplifyNode (l, n^.varientF.tag) ;
+   i := LowIndice (n^.varientF.listOfSons) ;
+   t := HighIndice (n^.varientF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientF.listOfSons, i) ;
+      simplifyNode (l, q) ;
+      INC (i)
+   END
+END simplifyVarient ;
+
+
+(*
+   simplifyVarientField -
+*)
+
+PROCEDURE simplifyVarientField (l: alist; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   i := LowIndice (n^.varientfieldF.listOfSons) ;
+   t := HighIndice (n^.varientfieldF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientfieldF.listOfSons, i) ;
+      simplifyNode (l, q) ;
+      INC (i)
+   END
+END simplifyVarientField ;
+
+
+(*
+   doSimplifyNode -
+*)
+
+PROCEDURE doSimplifyNode (l: alist; n: node) ;
+BEGIN
+   IF n=NIL
+   THEN
+      (* nothing.  *)
+   ELSIF isType (n)
+   THEN
+      (* no need to simplify a type.  *)
+      simplifyNode (l, getType (n))
+   ELSIF isVar (n)
+   THEN
+      simplifyVar (l, n)
+   ELSIF isRecord (n)
+   THEN
+      simplifyRecord (l, n)
+   ELSIF isRecordField (n)
+   THEN
+      simplifyType (l, n^.recordfieldF.type)
+   ELSIF isArray (n)
+   THEN
+      simplifyType (l, n^.arrayF.type)
+   ELSIF isVarient (n)
+   THEN
+      simplifyVarient (l, n)
+   ELSIF isVarientField (n)
+   THEN
+      simplifyVarientField (l, n)
+   ELSIF isPointer (n)
+   THEN
+      simplifyType (l, n^.pointerF.type)
+   END
+END doSimplifyNode ;
+
+
+(*
+   simplifyNode -
+*)
+
+PROCEDURE simplifyNode (l: alist; n: node) ;
+BEGIN
+   IF NOT alists.isItemInList (l, n)
+   THEN
+      alists.includeItemIntoList (l, n) ;
+      doSimplifyNode (l, n)
+   END
+END simplifyNode ;
+
+
+(*
+   doSimplify -
+*)
+
+PROCEDURE doSimplify (n: node) ;
+VAR
+   l: alist ;
+BEGIN
+   l := alists.initList () ;
+   simplifyNode (l, n) ;
+   alists.killList (l)
+END doSimplify ;
+
+
+(*
+   simplifyTypes -
+*)
+
+PROCEDURE simplifyTypes (s: scopeT) ;
+BEGIN
+   REPEAT
+      simplified := TRUE ;
+      ForeachIndiceInIndexDo (s.types, doSimplify) ;
+      ForeachIndiceInIndexDo (s.variables, doSimplify)
+   UNTIL simplified
+END simplifyTypes ;
+
+
+(*
+   outDeclsDefC -
+*)
+
+PROCEDURE outDeclsDefC (p: pretty; n: node) ;
+VAR
+   s: scopeT ;
+BEGIN
+   s := n^.defF.decls ;
+   simplifyTypes (s) ;
+   includeConstType (s) ;
+
+   doP := p ;
+
+   topologicallyOut (doConstC, doTypesC, doVarC,
+                     outputPartial,
+                     doNone, doCompletePartialC, doNone) ;
+
+   (* try and output types, constants before variables and procedures.  *)
+   includeDefVarProcedure (n) ;
+
+   topologicallyOut (doConstC, doTypesC, doVarC,
+                     outputPartial,
+                     doNone, doCompletePartialC, doNone) ;
+
+   ForeachIndiceInIndexDo (s.procedures, doPrototypeC)
+END outDeclsDefC ;
+
+
+(*
+   includeConstType -
+*)
+
+PROCEDURE includeConstType (s: scopeT) ;
+BEGIN
+   ForeachIndiceInIndexDo (s.constants, addTodo) ;
+   ForeachIndiceInIndexDo (s.types, addTypesTodo)
+END includeConstType ;
+
+
+(*
+   includeVarProcedure -
+*)
+
+PROCEDURE includeVarProcedure (s: scopeT) ;
+BEGIN
+   ForeachIndiceInIndexDo (s.procedures, addTodo) ;
+   ForeachIndiceInIndexDo (s.variables, addVariablesTodo)
+END includeVarProcedure ;
+
+
+(*
+   includeVar -
+*)
+
+PROCEDURE includeVar (s: scopeT) ;
+BEGIN
+   ForeachIndiceInIndexDo (s.variables, addTodo)
+END includeVar ;
+
+
+(*
+   includeExternals -
+*)
+
+PROCEDURE includeExternals (n: node) ;
+VAR
+   l: alist ;
+BEGIN
+   l := alists.initList () ;
+   visitNode (l, n, addExported) ;
+   alists.killList (l)
+END includeExternals ;
+
+
+(*
+   checkSystemInclude -
+*)
+
+PROCEDURE checkSystemInclude (n: node) ;
+BEGIN
+
+END checkSystemInclude ;
+
+
+(*
+   addExported -
+*)
+
+PROCEDURE addExported (n: node) ;
+VAR
+   s: node ;
+BEGIN
+   s := getScope (n) ;
+   IF (s # NIL) AND isDef (s) AND (s # defModule)
+   THEN
+      IF isType (n) OR isVar (n) OR isConst (n)
+      THEN
+         addTodo (n)
+      END
+   END
+END addExported ;
+
+
+(*
+   addExternal - only adds, n, if this symbol is external to the
+                 implementation module and is not a hidden type.
+*)
+
+PROCEDURE addExternal (n: node) ;
+BEGIN
+   IF (getScope (n) = defModule) AND isType (n) AND
+      isTypeHidden (n) AND (NOT getExtendedOpaque ())
+   THEN
+      (* do nothing.  *)
+   ELSIF NOT isDef (n)
+   THEN
+      addTodo (n)
+   END
+END addExternal ;
+
+
+(*
+   includeDefConstType -
+*)
+
+PROCEDURE includeDefConstType (n: node) ;
+VAR
+   d: node ;
+BEGIN
+   IF isImp (n)
+   THEN
+      defModule := lookupDef (getSymName (n)) ;
+      IF defModule#NIL
+      THEN
+         simplifyTypes (defModule^.defF.decls) ;
+         includeConstType (defModule^.defF.decls) ;
+	 foreachNodeDo (defModule^.defF.decls.symbols, addExternal)
+      END
+   END
+END includeDefConstType ;
+
+
+(*
+   runIncludeDefConstType -
+*)
+
+PROCEDURE runIncludeDefConstType (n: node) ;
+VAR
+   d: node ;
+BEGIN
+   IF isDef (n)
+   THEN
+      simplifyTypes (n^.defF.decls) ;
+      includeConstType (n^.defF.decls) ;
+      foreachNodeDo (n^.defF.decls.symbols, addExternal)
+   END
+END runIncludeDefConstType ;
+
+
+(*
+   joinProcedures - copies procedures from definition module,
+                    d, into implementation module, i.
+*)
+
+PROCEDURE joinProcedures (i, d: node) ;
+VAR
+   h, j: CARDINAL ;
+BEGIN
+   assert (isDef (d)) ;
+   assert (isImp (i)) ;
+   j := 1 ;
+   h := HighIndice (d^.defF.decls.procedures) ;
+   WHILE j<=h DO
+      IncludeIndiceIntoIndex (i^.impF.decls.procedures,
+                              GetIndice (d^.defF.decls.procedures, j)) ;
+      INC (j)
+   END
+END joinProcedures ;
+
+
+(*
+   includeDefVarProcedure -
+*)
+
+PROCEDURE includeDefVarProcedure (n: node) ;
+VAR
+   d: node ;
+BEGIN
+   IF isImp (n)
+   THEN
+      defModule := lookupDef (getSymName (n)) ;
+      IF defModule#NIL
+      THEN
+(*
+         includeVar (defModule^.defF.decls) ;
+         simplifyTypes (defModule^.defF.decls) ;
+*)
+         joinProcedures (n, defModule)
+      END
+   ELSIF isDef (n)
+   THEN
+      includeVar (n^.defF.decls) ;
+      simplifyTypes (n^.defF.decls)
+   END
+END includeDefVarProcedure ;
+
+
+(*
+   foreachModuleDo -
+*)
+
+PROCEDURE foreachModuleDo (n: node; p: performOperation) ;
+BEGIN
+   foreachDefModuleDo (p) ;
+   foreachModModuleDo (p)
+END foreachModuleDo ;
+
+
+(*
+   outDeclsImpC -
+*)
+
+PROCEDURE outDeclsImpC (p: pretty; s: scopeT) ;
+BEGIN
+   simplifyTypes (s) ;
+   includeConstType (s) ;
+
+   doP := p ;
+
+   topologicallyOut (doConstC, doTypesC, doVarC,
+                     outputPartial,
+                     doNone, doCompletePartialC, doNone) ;
+
+   (* try and output types, constants before variables and procedures.  *)
+   includeVarProcedure (s) ;
+
+   topologicallyOut (doConstC, doTypesC, doVarC,
+                     outputPartial,
+                     doNone, doCompletePartialC, doNone) ;
+
+END outDeclsImpC ;
+
+
+(*
+   doStatementSequenceC -
+*)
+
+PROCEDURE doStatementSequenceC (p: pretty; s: node) ;
+VAR
+   i, h: CARDINAL ;
+BEGIN
+   assert (isStatementSequence (s)) ;
+   h := HighIndice (s^.stmtF.statements) ;
+   i := 1 ;
+   WHILE i<=h DO
+      doStatementsC (p, GetIndice (s^.stmtF.statements, i)) ;
+      INC (i)
+   END
+END doStatementSequenceC ;
+
+
+(*
+   isStatementSequenceEmpty -
+*)
+
+PROCEDURE isStatementSequenceEmpty (s: node) : BOOLEAN ;
+BEGIN
+   assert (isStatementSequence (s)) ;
+   RETURN HighIndice (s^.stmtF.statements) = 0
+END isStatementSequenceEmpty ;
+
+
+(*
+   isSingleStatement - returns TRUE if the statement sequence, s, has
+                       only one statement.
+*)
+
+PROCEDURE isSingleStatement (s: node) : BOOLEAN ;
+VAR
+   h: CARDINAL ;
+BEGIN
+   assert (isStatementSequence (s)) ;
+   h := HighIndice (s^.stmtF.statements) ;
+   IF (h = 0) OR (h > 1)
+   THEN
+      RETURN FALSE
+   END ;
+   s := GetIndice (s^.stmtF.statements, 1) ;
+   RETURN (NOT isStatementSequence (s)) OR isSingleStatement (s)
+END isSingleStatement ;
+
+
+(*
+   doCommentC -
+*)
+
+PROCEDURE doCommentC (p: pretty; s: node) ;
+VAR
+   c: String ;
+BEGIN
+   IF s # NIL
+   THEN
+      assert (isComment (s)) ;
+      IF NOT isProcedureComment (s^.commentF.content)
+      THEN
+         IF isAfterComment (s^.commentF.content)
+         THEN
+            setNeedSpace (p) ;
+            outText (p, " /* ")
+         ELSE
+            outText (p, "/* ")
+         END ;
+         c := getContent (s^.commentF.content) ;
+         c := RemoveWhitePrefix (RemoveWhitePostfix (c)) ;
+         outTextS (p, c) ;
+         outText (p, "  */\n")
+      END
+   END
+END doCommentC ;
+
+
+(*
+   doAfterCommentC - emit an after comment, c, or a newline if, c, is empty.
+*)
+
+PROCEDURE doAfterCommentC (p: pretty; c: node) ;
+BEGIN
+   IF c = NIL
+   THEN
+      outText (p, "\n")
+   ELSE
+      doCommentC (p, c)
+   END
+END doAfterCommentC ;
+
+
+(*
+   doReturnC - issue a return statement and also place in an after comment if one exists.
+*)
+
+PROCEDURE doReturnC (p: pretty; s: node) ;
+BEGIN
+   assert (isReturn (s)) ;
+   doCommentC (p, s^.returnF.returnComment.body) ;
+   outText (p, "return") ;
+   IF s^.returnF.scope#NIL
+   THEN
+      setNeedSpace (p) ;
+      IF (NOT isProcedure (s^.returnF.scope)) OR (getType (s^.returnF.scope)=NIL)
+      THEN
+         metaError1 ('{%1DMad} has no return type', s^.returnF.scope) ;
+      ELSE
+         doExprCastC (p, s^.returnF.exp, getType (s^.returnF.scope))
+      END
+   END ;
+   outText (p, ";") ;
+   doAfterCommentC (p, s^.returnF.returnComment.after)
+END doReturnC ;
+
+
+(*
+   isZtypeEquivalent -
+*)
+
+PROCEDURE isZtypeEquivalent (type: node) : BOOLEAN ;
+BEGIN
+   CASE type^.kind OF
+
+   cardinal,
+   longcard,
+   shortcard,
+   integer,
+   longint,
+   shortint,
+   ztype    :  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isZtypeEquivalent ;
+
+
+(*
+   isEquivalentType - returns TRUE if type1 and type2 are equivalent.
+*)
+
+PROCEDURE isEquivalentType (type1, type2: node) : BOOLEAN ;
+BEGIN
+   type1 := skipType (type1) ;
+   type2 := skipType (type2) ;
+   RETURN ((type1 = type2) OR
+           (isZtypeEquivalent (type1) AND isZtypeEquivalent (type2)))
+END isEquivalentType ;
+
+
+(*
+   doExprCastC - build a cast if necessary.
+*)
+
+PROCEDURE doExprCastC (p: pretty; e, type: node) ;
+VAR
+   stype: node ;
+BEGIN
+   stype := skipType (type) ;
+   IF (NOT isEquivalentType (type, getExprType (e))) AND
+      (NOT ((e^.kind = nil) AND (isPointer (stype) OR (stype^.kind = address))))
+   THEN
+      IF lang = ansiCP
+      THEN
+         (* potentially a cast is required.  *)
+         IF isPointer (type) OR (type = addressN)
+         THEN
+            outText (p, 'reinterpret_cast<') ;
+            doTypeNameC (p, type) ;
+            noSpace (p) ;
+            outText (p, '> (') ;
+            doExprC (p, e) ;
+	    outText (p, ')') ;
+            RETURN
+         ELSE
+            outText (p, 'static_cast<') ;
+            IF isProcType (skipType (type))
+            THEN
+               doTypeNameC (p, type) ;
+               outText (p, "_t")
+            ELSE
+               doTypeNameC (p, type)
+            END ;
+            noSpace (p) ;
+            outText (p, '> (') ;
+            doExprC (p, e) ;
+	    outText (p, ')') ;
+            RETURN
+         END
+      END
+   END ;
+   doExprC (p, e)
+END doExprCastC ;
+
+
+(*
+   requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ.
+*)
+
+PROCEDURE requiresUnpackProc (s: node) : BOOLEAN ;
+BEGIN
+   assert (isAssignment (s)) ;
+   RETURN isProcedure (s^.assignmentF.expr) OR
+          (skipType (getType (s^.assignmentF.des)) # skipType (getType (s^.assignmentF.expr)))
+END requiresUnpackProc ;
+
+
+(*
+   doAssignmentC -
+*)
+
+PROCEDURE doAssignmentC (p: pretty; s: node) ;
+BEGIN
+   assert (isAssignment (s)) ;
+   doCommentC (p, s^.assignmentF.assignComment.body) ;
+   doExprCup (p, s^.assignmentF.des, requiresUnpackProc (s)) ;
+   setNeedSpace (p) ;
+   outText (p, "=") ;
+   setNeedSpace (p) ;
+   doExprCastC (p, s^.assignmentF.expr, getType (s^.assignmentF.des)) ;
+   outText (p, ";") ;
+   doAfterCommentC (p, s^.assignmentF.assignComment.after)
+END doAssignmentC ;
+
+
+(*
+   containsStatement -
+*)
+
+PROCEDURE containsStatement (s: node) : BOOLEAN ;
+BEGIN
+   RETURN (s # NIL) AND isStatementSequence (s) AND (NOT isStatementSequenceEmpty (s))
+END containsStatement ;
+
+
+(*
+   doCompoundStmt -
+*)
+
+PROCEDURE doCompoundStmt (p: pretty; s: node) ;
+BEGIN
+   IF (s = NIL) OR (isStatementSequence (s) AND isStatementSequenceEmpty (s))
+   THEN
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      outText (p, "{}  /* empty.  */\n") ;
+      p := popPretty (p)
+   ELSIF isStatementSequence (s) AND isSingleStatement (s) AND (NOT forceCompoundStatement)
+   THEN
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      doStatementSequenceC (p, s) ;
+      p := popPretty (p)
+   ELSE
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      outText (p, "{\n") ;
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      doStatementSequenceC (p, s) ;
+      p := popPretty (p) ;
+      outText (p, "}\n") ;
+      p := popPretty (p)
+   END
+END doCompoundStmt ;
+
+
+(*
+   doElsifC -
+*)
+
+PROCEDURE doElsifC (p: pretty; s: node) ;
+BEGIN
+   assert (isElsif (s)) ;
+   outText (p, "else if") ;
+   setNeedSpace (p) ;
+   outText (p, "(") ;
+   doExprC (p, s^.elsifF.expr) ;
+   outText (p, ")\n") ;
+   assert ((s^.elsifF.else = NIL) OR (s^.elsifF.elsif = NIL)) ;
+   IF forceCompoundStatement OR
+      (hasIfAndNoElse (s^.elsifF.then) AND
+       ((s^.elsifF.else # NIL) OR (s^.elsifF.elsif # NIL)))
+   THEN
+      (* avoid dangling else.  *)
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      outText (p, "{\n") ;
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      outText (p, "/* avoid dangling else.  */\n") ;
+      doStatementSequenceC (p, s^.elsifF.then) ;
+      p := popPretty (p) ;
+      outText (p, "}\n") ;
+      p := popPretty (p)
+   ELSE
+      doCompoundStmt (p, s^.elsifF.then)
+   END ;
+   IF containsStatement (s^.elsifF.else)
+   THEN
+      outText (p, "else\n") ;
+      IF forceCompoundStatement
+      THEN
+         (* avoid dangling else.  *)
+         p := pushPretty (p) ;
+         setindent (p, getindent (p) + indentationC) ;
+         outText (p, "{\n") ;
+         p := pushPretty (p) ;
+         setindent (p, getindent (p) + indentationC) ;
+         outText (p, "/* avoid dangling else.  */\n") ;
+         doStatementSequenceC (p, s^.elsifF.else) ;
+         p := popPretty (p) ;
+         outText (p, "}\n") ;
+         p := popPretty (p)
+      ELSE
+         doCompoundStmt (p, s^.elsifF.else)
+      END
+   ELSIF (s^.elsifF.elsif#NIL) AND isElsif (s^.elsifF.elsif)
+   THEN
+      doElsifC (p, s^.elsifF.elsif)
+   END
+END doElsifC ;
+
+
+(*
+   noIfElse -
+*)
+
+PROCEDURE noIfElse (n: node) : BOOLEAN ;
+BEGIN
+   RETURN (n # NIL) AND isIf (n) AND (n^.ifF.else = NIL) AND (n^.ifF.elsif = NIL)
+END noIfElse ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE noIfElseChained (n: node) : BOOLEAN ;
+VAR
+   e: node ;
+BEGIN
+   IF n # NIL
+   THEN
+      IF isIf (n)
+      THEN
+         IF n^.ifF.else # NIL
+         THEN
+            (* we do have an else, continue to check this statement.  *)
+            RETURN hasIfAndNoElse (n^.ifF.else)
+         ELSIF n^.ifF.elsif = NIL
+         THEN
+            (* neither else or elsif.  *)
+            RETURN TRUE
+         ELSE
+            (* test elsif for lack of else.  *)
+            e := n^.ifF.elsif ;
+	    assert (isElsif (e)) ;
+            RETURN noIfElseChained (e)
+         END
+      ELSIF isElsif (n)
+      THEN
+         IF n^.elsifF.else # NIL
+         THEN
+            (* we do have an else, continue to check this statement.  *)
+            RETURN hasIfAndNoElse (n^.elsifF.else)
+         ELSIF n^.elsifF.elsif = NIL
+         THEN
+            (* neither else or elsif.  *)
+            RETURN TRUE
+         ELSE
+            (* test elsif for lack of else.  *)
+            e := n^.elsifF.elsif ;
+	    assert (isElsif (e)) ;
+            RETURN noIfElseChained (e)
+         END
+      END
+   END ;
+   RETURN FALSE
+END noIfElseChained ;
+
+
+(*
+   hasIfElse -
+*)
+
+PROCEDURE hasIfElse (n: node) : BOOLEAN ;
+BEGIN
+   IF n # NIL
+   THEN
+      IF isStatementSequence (n)
+      THEN
+         IF isStatementSequenceEmpty (n)
+         THEN
+            RETURN FALSE
+         ELSIF isSingleStatement (n)
+         THEN
+            n := GetIndice (n^.stmtF.statements, 1) ;
+	    RETURN isIfElse (n)
+         END
+      END
+   END ;
+   RETURN FALSE
+END hasIfElse ;
+
+
+(*
+   isIfElse -
+*)
+
+PROCEDURE isIfElse (n: node) : BOOLEAN ;
+BEGIN
+   RETURN (n # NIL) AND isIf (n) AND ((n^.ifF.else # NIL) OR (n^.ifF.elsif # NIL))
+END isIfElse ;
+
+
+(*
+   hasIfAndNoElse - returns TRUE if statement, n, is a single statement
+                    which is an IF and it has no else statement.
+*)
+
+PROCEDURE hasIfAndNoElse (n: node) : BOOLEAN ;
+BEGIN
+   IF n # NIL
+   THEN
+      IF isStatementSequence (n)
+      THEN
+         IF isStatementSequenceEmpty (n)
+         THEN
+            RETURN FALSE
+         ELSIF isSingleStatement (n)
+         THEN
+            n := GetIndice (n^.stmtF.statements, 1) ;
+	    RETURN hasIfAndNoElse (n)
+         ELSE
+            n := GetIndice (n^.stmtF.statements, HighIndice (n^.stmtF.statements)) ;
+	    RETURN hasIfAndNoElse (n)
+         END
+      ELSIF isElsif (n) OR isIf (n)
+      THEN
+         RETURN noIfElseChained (n)
+      END
+   END ;
+   RETURN FALSE
+END hasIfAndNoElse ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE doIfC (p: pretty; s: node) ;
+BEGIN
+   assert (isIf (s)) ;
+   doCommentC (p, s^.ifF.ifComment.body) ;
+   outText (p, "if") ;
+   setNeedSpace (p) ;
+   outText (p, "(") ;
+   doExprC (p, s^.ifF.expr) ;
+   outText (p, ")") ;
+   doAfterCommentC (p, s^.ifF.ifComment.after) ;
+   IF hasIfAndNoElse (s^.ifF.then) AND
+      ((s^.ifF.else # NIL) OR (s^.ifF.elsif # NIL))
+   THEN
+      (* avoid dangling else.  *)
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      outText (p, "{\n") ;
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      outText (p, "/* avoid dangling else.  */\n") ;
+      doStatementSequenceC (p, s^.ifF.then) ;
+      p := popPretty (p) ;
+      outText (p, "}\n") ;
+      p := popPretty (p)
+   ELSIF noIfElse (s) AND hasIfElse (s^.ifF.then)
+   THEN
+      (* gcc does not like legal non dangling else, as it is poor style.
+         So we will avoid getting a warning.  *)
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      outText (p, "{\n") ;
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      outText (p, "/* avoid gcc warning by using compound statement even if not strictly necessary.  */\n") ;
+      doStatementSequenceC (p, s^.ifF.then) ;
+      p := popPretty (p) ;
+      outText (p, "}\n") ;
+      p := popPretty (p)
+   ELSE
+      doCompoundStmt (p, s^.ifF.then)
+   END ;
+   assert ((s^.ifF.else = NIL) OR (s^.ifF.elsif = NIL)) ;
+   IF containsStatement (s^.ifF.else)
+   THEN
+      doCommentC (p, s^.ifF.elseComment.body) ;
+      outText (p, "else") ;
+      doAfterCommentC (p, s^.ifF.elseComment.after) ;
+      doCompoundStmt (p, s^.ifF.else)
+   ELSIF (s^.ifF.elsif#NIL) AND isElsif (s^.ifF.elsif)
+   THEN
+      doCommentC (p, s^.ifF.elseComment.body) ;
+      doCommentC (p, s^.ifF.elseComment.after) ;
+      doElsifC (p, s^.ifF.elsif)
+   END ;
+   doCommentC (p, s^.ifF.endComment.after) ;
+   doCommentC (p, s^.ifF.endComment.body)
+END doIfC ;
+
+
+(*
+   doForIncCP -
+*)
+
+PROCEDURE doForIncCP (p: pretty; s: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (isFor (s)) ;
+   t := skipType (getType (s^.forF.des)) ;
+   IF isEnumeration (t)
+   THEN
+      IF s^.forF.increment = NIL
+      THEN
+         doExprC (p, s^.forF.des) ;
+         outText (p, "= static_cast<") ;
+         doTypeNameC (p, getType (s^.forF.des)) ;
+	 noSpace (p) ;
+         outText (p, ">(static_cast<int>(") ;
+         doExprC (p, s^.forF.des) ;
+         outText (p, "+1))")
+      ELSE
+         doExprC (p, s^.forF.des) ;
+         outText (p, "= static_cast<") ;
+         doTypeNameC (p, getType (s^.forF.des)) ;
+         noSpace (p) ;
+         outText (p, ">(static_cast<int>(") ;
+         doExprC (p, s^.forF.des) ;
+         outText (p, "+") ;
+         doExprC (p, s^.forF.increment) ;
+         outText (p, "))")
+      END
+   ELSE
+      doForIncC (p, s)
+   END
+END doForIncCP ;
+
+
+(*
+   doForIncC -
+*)
+
+PROCEDURE doForIncC (p: pretty; s: node) ;
+BEGIN
+   IF s^.forF.increment = NIL
+   THEN
+      doExprC (p, s^.forF.des) ;
+      outText (p, "++")
+   ELSE
+      doExprC (p, s^.forF.des) ;
+      outText (p, "=") ;
+      doExprC (p, s^.forF.des) ;
+      outText (p, "+") ;
+      doExprC (p, s^.forF.increment)
+   END
+END doForIncC ;
+
+
+(*
+   doForInc -
+*)
+
+PROCEDURE doForInc (p: pretty; s: node) ;
+BEGIN
+   IF lang = ansiCP
+   THEN
+      doForIncCP (p, s)
+   ELSE
+      doForIncC (p, s)
+   END
+END doForInc ;
+
+
+(*
+   doForC -
+*)
+
+PROCEDURE doForC (p: pretty; s: node) ;
+BEGIN
+   assert (isFor (s)) ;
+   outText (p, "for (") ;
+   doExprC (p, s^.forF.des) ;
+   outText (p, "=") ;
+   doExprC (p, s^.forF.start) ;
+   outText (p, ";") ;
+   setNeedSpace (p) ;
+   doExprC (p, s^.forF.des) ;
+   outText (p, "<=") ;
+   doExprC (p, s^.forF.end) ;
+   outText (p, ";") ;
+   setNeedSpace (p) ;
+   doForInc (p, s) ;
+   outText (p, ")\n") ;
+   doCompoundStmt (p, s^.forF.statements)
+END doForC ;
+
+
+(*
+   doRepeatC -
+*)
+
+PROCEDURE doRepeatC (p: pretty; s: node) ;
+BEGIN
+   assert (isRepeat (s)) ;
+   doCommentC (p, s^.repeatF.repeatComment.body) ;
+   outText (p, "do {") ;
+   doAfterCommentC (p, s^.repeatF.repeatComment.after) ;
+   p := pushPretty (p) ;
+   setindent (p, getindent (p) + indentationC) ;
+   doStatementSequenceC (p, s^.repeatF.statements) ;
+   doCommentC (p, s^.repeatF.untilComment.body) ;
+   p := popPretty (p) ;
+   outText (p, "} while (! (") ;
+   doExprC (p, s^.repeatF.expr) ;
+   outText (p, "));") ;
+   doAfterCommentC (p, s^.repeatF.untilComment.after)
+END doRepeatC ;
+
+
+(*
+   doWhileC -
+*)
+
+PROCEDURE doWhileC (p: pretty; s: node) ;
+BEGIN
+   assert (isWhile (s)) ;
+   doCommentC (p, s^.whileF.doComment.body) ;
+   outText (p, "while (") ;
+   doExprC (p, s^.whileF.expr) ;
+   outText (p, ")") ;
+   doAfterCommentC (p, s^.whileF.doComment.after) ;
+   doCompoundStmt (p, s^.whileF.statements) ;
+   doCommentC (p, s^.whileF.endComment.body) ;
+   doCommentC (p, s^.whileF.endComment.after)
+END doWhileC ;
+
+
+(*
+   doFuncHighC -
+*)
+
+PROCEDURE doFuncHighC (p: pretty; a: node) ;
+VAR
+   s, n: node ;
+BEGIN
+   IF isLiteral (a) AND (getType (a) = charN)
+   THEN
+      outCard (p, 0)
+   ELSIF isString (a)
+   THEN
+      outCard (p, a^.stringF.length-2)
+   ELSIF isConst (a) AND isString (a^.constF.value)
+   THEN
+      doFuncHighC (p, a^.constF.value)
+   ELSIF isUnbounded (getType (a))
+   THEN
+      outText (p, '_') ;
+      outTextN (p, getSymName (a)) ;
+      outText (p, '_high')
+   ELSIF isArray (skipType (getType (a)))
+   THEN
+      n := skipType (getType (a)) ;
+      s := n^.arrayF.subr ;
+      IF isZero (getMin (s))
+      THEN
+         doExprC (p, getMax (s))
+      ELSE
+         outText (p, '(') ;
+         doExprC (p, getMax (s)) ;
+         doSubtractC (p, getMin (s)) ;
+         outText (p, ')')
+      END
+   ELSE
+      (* output sizeof (a) in bytes for the high.  *)
+      outText (p, '(sizeof') ;
+      setNeedSpace (p) ;
+      outText (p, '(') ;
+      doExprC (p, a) ;
+      outText (p, ')-1)')
+   END
+END doFuncHighC ;
+
+
+(*
+   doMultiplyBySize -
+*)
+
+PROCEDURE doMultiplyBySize (p: pretty; a: node) ;
+BEGIN
+   IF (a # charN) AND (a # byteN) AND (a # locN)
+   THEN
+      setNeedSpace (p) ;
+      outText (p, '* sizeof (') ;
+      doTypeNameC (p, a) ;
+      noSpace (p) ;
+      outText (p, ')')
+   END
+END doMultiplyBySize ;
+
+
+(*
+   doTotype -
+*)
+
+PROCEDURE doTotype (p: pretty; a, t: node) ;
+BEGIN
+   IF (NOT isString (a)) AND (NOT isLiteral (a))
+   THEN
+      IF isVar (a)
+      THEN
+         IF (a^.varF.isParameter OR a^.varF.isVarParameter) AND
+	    isUnbounded (getType (a)) AND (skipType (getType (getType (a))) = skipType (getType (t)))
+         THEN
+            (* do not multiply by size as the existing high value is correct.  *)
+            RETURN
+         END ;
+         a := getType (a) ;
+         IF isArray (a)
+         THEN
+            doMultiplyBySize (p, skipType (getType (a)))
+         END
+      END
+   END ;
+   IF t = wordN
+   THEN
+      setNeedSpace (p) ;
+      outText (p, '/ sizeof (') ;
+      doTypeNameC (p, wordN) ;
+      noSpace (p) ;
+      outText (p, ')')
+   END
+END doTotype ;
+
+
+(*
+   doFuncUnbounded -
+*)
+
+PROCEDURE doFuncUnbounded (p: pretty; actual, formalParam, formal, func: node) ;
+VAR
+   h: node ;
+   s: String ;
+BEGIN
+   assert (isUnbounded (formal)) ;
+   outText (p, '(') ;
+   IF (lang = ansiCP) AND isParam (formalParam)
+   THEN
+      outText (p, "const") ;
+      setNeedSpace (p)
+   END ;
+   doTypeC (p, getType (formal), formal) ;
+   setNeedSpace (p) ;
+   outText (p, '*)') ;
+   setNeedSpace (p) ;
+   IF isLiteral (actual) AND (getType (actual) = charN)
+   THEN
+      outText (p, '"\0') ;
+      s := InitStringCharStar (keyToCharStar (actual^.literalF.name)) ;
+      s := DynamicStrings.Slice (DynamicStrings.Mark (s), 0, -1) ;
+      outTextS (p, s) ;
+      outText (p, '"') ;
+      s := KillString (s)
+   ELSIF isString (actual)
+   THEN
+      outCstring (p, actual, TRUE)
+   ELSIF isConst (actual)
+   THEN
+      actual := resolveString (actual) ;
+      assert (isString (actual)) ;
+      outCstring (p, actual, TRUE)
+   ELSIF isFuncCall (actual)
+   THEN
+      IF getExprType (actual) = NIL
+      THEN
+         metaError3 ('there is no return type to the procedure function {%3ad} which is being passed as the parameter {%1ad} to {%2ad}', formal, func, actual)
+      ELSE
+         outText (p, '&') ;
+         doExprC (p, actual)
+      END
+   ELSIF isUnbounded (getType (actual))
+   THEN
+      doFQNameC (p, actual)
+      (* doExprC (p, actual).  *)
+   ELSE
+      outText (p, '&') ;
+      doExprC (p, actual) ;
+      IF isArray (skipType (getType (actual)))
+      THEN
+         outText (p, '.array[0]')
+      END
+   END ;
+   IF NOT (enableDefForCStrings AND isDefForC (getScope (func)))
+   THEN
+      outText (p, ',') ;
+      setNeedSpace (p) ;
+      doFuncHighC (p, actual) ;
+      doTotype (p, actual, formal)
+   END
+END doFuncUnbounded ;
+
+
+(*
+   doProcedureParamC -
+*)
+
+PROCEDURE doProcedureParamC (p: pretty; actual, formal: node) ;
+BEGIN
+   IF isForC (formal)
+   THEN
+      outText (p, '(') ;
+      doFQNameC (p, getType (formal)) ;
+      outText (p, "_C") ;
+      outText (p, ')') ;
+      setNeedSpace (p) ;
+      doExprC (p, actual)
+   ELSE
+      outText (p, '(') ;
+      doTypeNameC (p, getType (formal)) ;
+      outText (p, ')') ;
+      setNeedSpace (p) ;
+      outText (p, '{') ;
+      outText (p, '(') ;
+      doFQNameC (p, getType (formal)) ;
+      outText (p, '_t)') ;
+      setNeedSpace (p) ;
+      doExprC (p, actual) ;
+      outText (p, '}')
+    END
+END doProcedureParamC ;
+
+
+(*
+   doAdrExprC -
+*)
+
+PROCEDURE doAdrExprC (p: pretty; n: node) ;
+BEGIN
+   IF isDeref (n)
+   THEN
+      (* (* no point in issuing & ( * n )  *) *)
+      doExprC (p, n^.unaryF.arg)
+   ELSIF isVar (n) AND n^.varF.isVarParameter
+   THEN
+      (* (* no point in issuing & ( * n )  *) *)
+      doFQNameC (p, n)
+   ELSE
+      outText (p, '&') ;
+      doExprC (p, n)
+   END
+END doAdrExprC ;
+
+
+(*
+   typePair -
+*)
+
+PROCEDURE typePair (a, b, x, y: node) : BOOLEAN ;
+BEGIN
+   RETURN ((a = x) AND (b = y)) OR ((a = y) AND (b = x))
+END typePair ;
+
+
+(*
+   needsCast - return TRUE if the actual type parameter needs to be cast to
+               the formal type.
+*)
+
+PROCEDURE needsCast (at, ft: node) : BOOLEAN ;
+BEGIN
+   at := skipType (at) ;
+   ft := skipType (ft) ;
+   IF (at = nilN) OR (at^.kind = nil) OR
+      (at = ft) OR
+      typePair (at, ft, cardinalN, wordN) OR
+      typePair (at, ft, cardinalN, ztypeN) OR
+      typePair (at, ft, integerN, ztypeN) OR
+      typePair (at, ft, longcardN, ztypeN) OR
+      typePair (at, ft, shortcardN, ztypeN) OR
+      typePair (at, ft, longintN, ztypeN) OR
+      typePair (at, ft, shortintN, ztypeN) OR
+      typePair (at, ft, realN, rtypeN) OR
+      typePair (at, ft, longrealN, rtypeN) OR
+      typePair (at, ft, shortrealN, rtypeN)
+   THEN
+      RETURN FALSE
+   ELSE
+      RETURN TRUE
+   END
+END needsCast ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE checkSystemCast (p: pretty; actual, formal: node) : CARDINAL ;
+VAR
+   at, ft: node ;
+BEGIN
+   at := getExprType (actual) ;
+   ft := getType (formal) ;
+   IF needsCast (at, ft)
+   THEN
+      IF lang = ansiCP
+      THEN
+         IF isString (actual) AND (skipType (ft) = addressN)
+         THEN
+            outText (p, "const_cast<void*> (reinterpret_cast<const void*> (") ;
+	    RETURN 2
+         ELSIF isPointer (skipType (ft)) OR (skipType (ft) = addressN)
+         THEN
+            IF actual = nilN
+            THEN
+               IF isVarParam (formal)
+               THEN
+                  metaError1 ('NIL is being passed to a VAR parameter {%1DMad}', formal)
+               END ;
+               (* NULL is compatible with pointers/address.  *)
+               RETURN 0
+            ELSE
+               outText (p, 'reinterpret_cast<') ;
+               doTypeNameC (p, ft) ;
+               IF isVarParam (formal)
+               THEN
+                  outText (p, '*')
+               END ;
+               noSpace (p) ;
+               outText (p, '> (')
+            END
+         ELSE
+            outText (p, 'static_cast<') ;
+            doTypeNameC (p, ft) ;
+            IF isVarParam (formal)
+            THEN
+               outText (p, '*')
+            END ;
+            noSpace (p) ;
+            outText (p, '> (')
+         END ;
+         RETURN 1
+      ELSE
+         outText (p, '(') ;
+         doTypeNameC (p, ft) ;
+	 IF isVarParam (formal)
+         THEN
+            outText (p, '*')
+         END ;
+         noSpace (p) ;
+         outText (p, ')') ;
+         setNeedSpace (p)
+      END
+   END ;
+   RETURN 0
+END checkSystemCast ;
+
+
+(*
+   emitN -
+*)
+
+PROCEDURE emitN (p: pretty; a: ARRAY OF CHAR; n: CARDINAL) ;
+BEGIN
+   WHILE n>0 DO
+      outText (p, a) ;
+      DEC (n)
+   END
+END emitN ;
+
+
+(*
+   isForC - return true if node n is a varparam, param or procedure
+            which was declared inside a definition module for "C".
+*)
+
+PROCEDURE isForC (n: node) : BOOLEAN ;
+BEGIN
+   IF isVarParam (n)
+   THEN
+      RETURN n^.varparamF.isForC
+   ELSIF isParam (n)
+   THEN
+      RETURN n^.paramF.isForC
+   ELSIF isProcedure (n)
+   THEN
+      RETURN n^.procedureF.isForC
+   END ;
+   RETURN FALSE
+END isForC ;
+
+
+(*
+   isDefForCNode - return TRUE if node n was declared inside a definition module for "C".
+*)
+
+PROCEDURE isDefForCNode (n: node) : BOOLEAN ;
+VAR
+   name: Name ;
+BEGIN
+   WHILE (n # NIL) AND (NOT (isImp (n) OR isDef (n) OR isModule (n))) DO
+      n := getScope (n)
+   END ;
+   IF (n # NIL) AND isImp (n)
+   THEN
+      name := getSymName (n) ;
+      n := lookupDef (name) ;
+   END ;
+   RETURN (n # NIL) AND isDef (n) AND isDefForC (n)
+END isDefForCNode ;
+
+
+(*
+   doFuncParamC -
+*)
+
+PROCEDURE doFuncParamC (p: pretty; actual, formal, func: node) ;
+VAR
+   ft, at: node ;
+   lbr   : CARDINAL ;
+BEGIN
+   IF formal = NIL
+   THEN
+      doExprC (p, actual)
+   ELSE
+      ft := skipType (getType (formal)) ;
+      IF isUnbounded (ft)
+      THEN
+         doFuncUnbounded (p, actual, formal, ft, func)
+      ELSE
+         IF isAProcType (ft) AND isProcedure (actual)
+         THEN
+            IF isVarParam (formal)
+            THEN
+               metaError1 ('{%1MDad} cannot be passed as a VAR parameter', actual)
+            ELSE
+               doProcedureParamC (p, actual, formal)
+            END
+         ELSIF (getType (actual) # NIL) AND isProcType (skipType (getType (actual))) AND isAProcType (ft) AND isForC (formal)
+         THEN
+            IF isVarParam (formal)
+            THEN
+               metaError2 ('{%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}',
+                           actual, formal)
+            ELSE
+               outText (p, '(') ;
+               doFQNameC (p, getType (formal)) ;
+               outText (p, "_C") ;
+               outText (p, ')') ;
+               setNeedSpace (p) ;
+               doExprC (p, actual) ;
+               outText (p, ".proc")
+            END
+         ELSIF (getType (actual) # NIL) AND isProcType (skipType (getType (actual))) AND (getType (actual) # getType (formal))
+         THEN
+            IF isVarParam (formal)
+            THEN
+               metaError2 ('{%1MDad} cannot be passed as a VAR parameter as the parameter requires a cast to the formal type {%2MDtad}',
+                           actual, formal)
+            ELSE
+               doCastC (p, getType (formal), actual)
+            END
+         ELSE
+            lbr := checkSystemCast (p, actual, formal) ;
+            IF isVarParam (formal)
+            THEN
+               doAdrExprC (p, actual)
+            ELSE
+               doExprC (p, actual)
+            END ;
+            emitN (p, ")", lbr)
+         END
+      END
+   END
+END doFuncParamC ;
+
+
+(*
+   getNthParamType - return the type of parameter, i, in list, l.
+                     If the parameter is a vararg NIL is returned.
+*)
+
+PROCEDURE getNthParamType (l: Index; i: CARDINAL) : node ;
+VAR
+   p: node ;
+BEGIN
+   p := getNthParam (l, i) ;
+   IF p # NIL
+   THEN
+      RETURN getType (p)
+   END ;
+   RETURN NIL
+END getNthParamType ;
+
+
+(*
+   getNthParam - return the parameter, i, in list, l.
+                 If the parameter is a vararg NIL is returned.
+*)
+
+PROCEDURE getNthParam (l: Index; i: CARDINAL) : node ;
+VAR
+   p      : node ;
+   j, k, h: CARDINAL ;
+BEGIN
+   IF l # NIL
+   THEN
+      j := LowIndice (l) ;
+      h := HighIndice (l) ;
+      WHILE j <= h DO
+         p := GetIndice (l, j) ;
+         IF isParam (p)
+         THEN
+            k := identListLen (p^.paramF.namelist)
+         ELSIF isVarParam (p)
+         THEN
+            k := identListLen (p^.varparamF.namelist)
+         ELSE
+            assert (isVarargs (p)) ;
+            RETURN NIL
+         END ;
+         IF i <= k
+         THEN
+            RETURN p
+         ELSE
+            DEC (i, k) ;
+            INC (j)
+         END
+      END
+   END ;
+   RETURN NIL
+END getNthParam ;
+
+
+(*
+   doFuncArgsC -
+*)
+
+PROCEDURE doFuncArgsC (p: pretty; s: node; l: Index; needParen: BOOLEAN) ;
+VAR
+   actual, formal: node ;
+   i, n          : CARDINAL ;
+BEGIN
+   IF needParen
+   THEN
+      outText (p, "(")
+   END ;
+   IF s^.funccallF.args # NIL
+   THEN
+      i := 1 ;
+      n := expListLen (s^.funccallF.args) ;
+      WHILE i<=n DO
+         actual := getExpList (s^.funccallF.args, i) ;
+         formal := getNthParam (l, i) ;
+         doFuncParamC (p, actual, formal, s^.funccallF.function) ;
+         IF i<n
+         THEN
+            outText (p, ",") ;
+            setNeedSpace (p)
+         END ;
+         INC (i)
+      END
+   END ;
+   IF needParen
+   THEN
+      noSpace (p) ;
+      outText (p, ")")
+   END
+END doFuncArgsC ;
+
+
+(*
+   doProcTypeArgsC -
+*)
+
+PROCEDURE doProcTypeArgsC (p: pretty; s: node; args: Index; needParen: BOOLEAN) ;
+VAR
+   a, b: node ;
+   i, n: CARDINAL ;
+BEGIN
+   IF needParen
+   THEN
+      outText (p, "(")
+   END ;
+   IF s^.funccallF.args # NIL
+   THEN
+      i := 1 ;
+      n := expListLen (s^.funccallF.args) ;
+      WHILE i<=n DO
+         a := getExpList (s^.funccallF.args, i) ;
+         b := GetIndice (args, i) ;
+         doFuncParamC (p, a, b, s^.funccallF.function) ;
+         IF i<n
+         THEN
+            outText (p, ",") ;
+            setNeedSpace (p)
+         END ;
+         INC (i)
+      END
+   END ;
+   IF needParen
+   THEN
+      noSpace (p) ;
+      outText (p, ")")
+   END
+END doProcTypeArgsC ;
+
+
+(*
+   doAdrArgC -
+*)
+
+PROCEDURE doAdrArgC (p: pretty; n: node) ;
+BEGIN
+   IF isDeref (n)
+   THEN
+      (* & and * cancel each other out.  *)
+      doExprC (p, n^.unaryF.arg)
+   ELSIF isVar (n) AND (n^.varF.isVarParameter)
+   THEN
+      (* & and * cancel each other out.  *)
+      outTextN (p, getSymName (n))   (* --fixme-- does the caller need to cast it?  *)
+   ELSE
+      IF isString (n)
+      THEN
+         IF lang = ansiCP
+         THEN
+            outText (p, "const_cast<void*> (reinterpret_cast<const void*>") ;
+            outText (p, "(") ;
+            doExprC (p, n) ;
+            outText (p, "))")
+         ELSE
+            doExprC (p, n)
+         END
+      ELSE
+         outText (p, "&") ;
+         doExprC (p, n)
+      END
+   END
+END doAdrArgC ;
+
+
+(*
+   doAdrC -
+*)
+
+PROCEDURE doAdrC (p: pretty; n: node) ;
+BEGIN
+   assert (isUnary (n)) ;
+   doAdrArgC (p, n^.unaryF.arg)
+END doAdrC ;
+
+
+(*
+   doInc -
+*)
+
+PROCEDURE doInc (p: pretty; n: node) ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   IF lang = ansiCP
+   THEN
+      doIncDecCP (p, n, "+")
+   ELSE
+      doIncDecC (p, n, "+=")
+   END
+END doInc ;
+
+
+(*
+   doDec -
+*)
+
+PROCEDURE doDec (p: pretty; n: node) ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   IF lang = ansiCP
+   THEN
+      doIncDecCP (p, n, "-")
+   ELSE
+      doIncDecC (p, n, "-=")
+   END
+END doDec ;
+
+
+(*
+   doIncDecC -
+*)
+
+PROCEDURE doIncDecC (p: pretty; n: node; op: ARRAY OF CHAR) ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   IF n^.intrinsicF.args # NIL
+   THEN
+      doExprC (p, getExpList (n^.intrinsicF.args, 1)) ;
+      setNeedSpace (p) ;
+      outText (p, op) ;
+      setNeedSpace (p) ;
+      IF expListLen (n^.intrinsicF.args) = 1
+      THEN
+         outText (p, '1')
+      ELSE
+         doExprC (p, getExpList (n^.intrinsicF.args, 2))
+      END
+   END
+END doIncDecC ;
+
+
+(*
+   doIncDecCP -
+*)
+
+PROCEDURE doIncDecCP (p: pretty; n: node; op: ARRAY OF CHAR) ;
+VAR
+   lhs,
+   type: node ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   IF n^.intrinsicF.args # NIL
+   THEN
+      lhs := getExpList (n^.intrinsicF.args, 1) ;
+      doExprC (p, lhs) ;
+      setNeedSpace (p) ;
+      type := getType (lhs) ;
+      IF isPointer (type) OR (type = addressN)
+      THEN
+         (* cast to (char * ) and then back again after the arithmetic is complete.  *)
+         outText (p, "=") ;
+	 setNeedSpace (p) ;
+         outText (p, 'reinterpret_cast<') ;
+         doTypeNameC (p, type) ;
+         noSpace (p) ;
+         outText (p, '> (reinterpret_cast<char *> (') ;
+         doExprC (p, lhs) ;
+         noSpace (p) ;
+         outText (p, ')') ;
+         outText (p, op) ;
+         IF expListLen (n^.intrinsicF.args) = 1
+         THEN
+            outText (p, '1')
+         ELSE
+            doExprC (p, getExpList (n^.intrinsicF.args, 2))
+         END ;
+         outText (p, ')')
+      ELSIF isEnumeration (skipType (type))
+      THEN
+         outText (p, "= static_cast<") ;
+         doTypeNameC (p, type) ;
+         noSpace (p) ;
+         outText (p, ">(static_cast<int>(") ;
+         doExprC (p, lhs) ;
+         outText (p, ")") ;
+         outText (p, op) ;
+         IF expListLen (n^.intrinsicF.args) = 1
+         THEN
+            outText (p, '1')
+         ELSE
+            doExprC (p, getExpList (n^.intrinsicF.args, 2))
+         END ;
+         outText (p, ")")
+      ELSE
+         outText (p, op) ;
+         outText (p, "=") ;
+         setNeedSpace (p) ;
+         IF expListLen (n^.intrinsicF.args) = 1
+         THEN
+            outText (p, '1')
+         ELSE
+            doExprC (p, getExpList (n^.intrinsicF.args, 2))
+         END
+      END
+   END
+END doIncDecCP ;
+
+
+(*
+   doInclC -
+*)
+
+PROCEDURE doInclC (p: pretty; n: node) ;
+VAR
+   lo: node ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   IF n^.intrinsicF.args # NIL
+   THEN
+      IF expListLen (n^.intrinsicF.args) = 2
+      THEN
+         doExprC (p, getExpList (n^.intrinsicF.args, 1)) ;
+         lo := getSetLow (getExpList (n^.intrinsicF.args, 1)) ;
+         setNeedSpace (p) ;
+         outText (p, '|=') ;
+         setNeedSpace (p) ;
+         outText (p, '(1') ;
+         setNeedSpace (p) ;
+         outText (p, '<<') ;
+         setNeedSpace (p) ;
+         outText (p, '(') ;
+         doExprC (p, getExpList (n^.intrinsicF.args, 2)) ;
+         doSubtractC (p, lo) ;
+         setNeedSpace (p) ;
+         outText (p, '))')
+      ELSE
+         HALT (* metaError0 ('expecting two parameters to INCL') *)
+      END
+   END
+END doInclC ;
+
+
+(*
+   doExclC -
+*)
+
+PROCEDURE doExclC (p: pretty; n: node) ;
+VAR
+   lo: node ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   IF n^.intrinsicF.args # NIL
+   THEN
+      IF expListLen (n^.intrinsicF.args) = 2
+      THEN
+         doExprC (p, getExpList (n^.intrinsicF.args, 1)) ;
+         lo := getSetLow (getExpList (n^.intrinsicF.args, 1)) ;
+         setNeedSpace (p) ;
+         outText (p, '&=') ;
+         setNeedSpace (p) ;
+         outText (p, '(~(1') ;
+         setNeedSpace (p) ;
+         outText (p, '<<') ;
+         setNeedSpace (p) ;
+         outText (p, '(') ;
+         doExprC (p, getExpList (n^.intrinsicF.args, 2)) ;
+         doSubtractC (p, lo) ;
+         setNeedSpace (p) ;
+         outText (p, ')))')
+      ELSE
+         HALT (* metaError0 ('expecting two parameters to EXCL') *)
+      END
+   END
+END doExclC ;
+
+
+(*
+   doNewC -
+*)
+
+PROCEDURE doNewC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   IF n^.intrinsicF.args = NIL
+   THEN
+      HALT
+   ELSE
+      IF expListLen (n^.intrinsicF.args) = 1
+      THEN
+         keyc.useStorage ;
+         outText (p, 'Storage_ALLOCATE') ;
+         setNeedSpace (p) ;
+         outText (p, '((void **)') ;
+         setNeedSpace (p) ;
+         outText (p, '&') ;
+         doExprC (p, getExpList (n^.intrinsicF.args, 1)) ;
+         outText (p, ',') ;
+         setNeedSpace (p) ;
+         t := skipType (getType (getExpList (n^.intrinsicF.args, 1))) ;
+         IF isPointer (t)
+         THEN
+            t := getType (t) ;
+            outText (p, 'sizeof') ;
+            setNeedSpace (p) ;
+            outText (p, '(') ;
+            doTypeNameC (p, t) ;
+            noSpace (p) ;
+            outText (p, '))')
+         ELSE
+            metaError1 ('expecting a pointer type variable as the argument to NEW, rather than {%1ad}', t)
+         END
+      END
+   END
+END doNewC ;
+
+
+(*
+   doDisposeC -
+*)
+
+PROCEDURE doDisposeC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   IF n^.intrinsicF.args = NIL
+   THEN
+      HALT
+   ELSE
+      IF expListLen (n^.intrinsicF.args) = 1
+      THEN
+         keyc.useStorage ;
+         outText (p, 'Storage_DEALLOCATE') ;
+         setNeedSpace (p) ;
+         outText (p, '((void **)') ;
+         setNeedSpace (p) ;
+         outText (p, '&') ;
+         doExprC (p, getExpList (n^.intrinsicF.args, 1)) ;
+         outText (p, ',') ;
+         setNeedSpace (p) ;
+         t := skipType (getType (getExpList (n^.intrinsicF.args, 1))) ;
+         IF isPointer (t)
+         THEN
+            t := getType (t) ;
+            outText (p, 'sizeof') ;
+            setNeedSpace (p) ;
+            outText (p, '(') ;
+            doTypeNameC (p, t) ;
+            noSpace (p) ;
+            outText (p, '))')
+         ELSE
+            metaError1 ('expecting a pointer type variable as the argument to DISPOSE, rather than {%1ad}', t)
+         END
+      ELSE
+         HALT (* metaError0 ('expecting a single parameter to DISPOSE') *)
+      END
+   END
+END doDisposeC ;
+
+
+(*
+   doCapC -
+*)
+
+PROCEDURE doCapC (p: pretty; n: node) ;
+BEGIN
+   assert (isUnary (n)) ;
+   IF n^.unaryF.arg = NIL
+   THEN
+      HALT (* metaError0 ('expecting a single parameter to CAP') *)
+   ELSE
+      keyc.useCtype ;
+      IF getGccConfigSystem ()
+      THEN
+         outText (p, 'TOUPPER')
+      ELSE
+         outText (p, 'toupper')
+      END ;
+      setNeedSpace (p) ;
+      outText (p, '(') ;
+      doExprC (p, n^.unaryF.arg) ;
+      outText (p, ')')
+   END
+END doCapC ;
+
+
+(*
+   doLengthC -
+*)
+
+PROCEDURE doLengthC (p: pretty; n: node) ;
+BEGIN
+   assert (isUnary (n)) ;
+   IF n^.unaryF.arg = NIL
+   THEN
+      HALT (* metaError0 ('expecting a single parameter to LENGTH') *)
+   ELSE
+      keyc.useM2RTS ;
+      outText (p, 'M2RTS_Length') ;
+      setNeedSpace (p) ;
+      outText (p, '(') ;
+      doExprC (p, n^.unaryF.arg) ;
+      outText (p, ',') ;
+      setNeedSpace (p) ;
+      doFuncHighC (p, n^.unaryF.arg) ;
+      outText (p, ')')
+   END
+END doLengthC ;
+
+
+(*
+   doAbsC -
+*)
+
+PROCEDURE doAbsC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (isUnary (n)) ;
+   IF n^.unaryF.arg = NIL
+   THEN
+      HALT
+   ELSE
+      t := getExprType (n)
+   END ;
+   IF t = longintN
+   THEN
+      keyc.useLabs ;
+      outText (p, "labs")
+   ELSIF t = integerN
+   THEN
+      keyc.useAbs ;
+      outText (p, "abs")
+   ELSIF t = realN
+   THEN
+      keyc.useFabs ;
+      outText (p, "fabs")
+   ELSIF t = longrealN
+   THEN
+      keyc.useFabsl ;
+      outText (p, "fabsl")
+   ELSIF t = cardinalN
+   THEN
+      (* do nothing.  *)
+   ELSE
+      HALT
+   END ;
+   setNeedSpace (p) ;
+   outText (p, "(") ;
+   doExprC (p, n^.unaryF.arg) ;
+   outText (p, ")")
+END doAbsC ;
+
+
+(*
+   doValC -
+*)
+
+PROCEDURE doValC (p: pretty; n: node) ;
+BEGIN
+   assert (isBinary (n)) ;
+   outText (p, '(') ;
+   doTypeNameC (p, n^.binaryF.left) ;
+   outText (p, ')') ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   doExprC (p, n^.binaryF.right) ;
+   outText (p, ')')
+END doValC ;
+
+
+(*
+   doMinC -
+*)
+
+PROCEDURE doMinC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (isUnary (n)) ;
+   t := getExprType (n^.unaryF.arg) ;
+   doExprC (p, getMin (t)) ;
+END doMinC ;
+
+
+(*
+   doMaxC -
+*)
+
+PROCEDURE doMaxC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (isUnary (n)) ;
+   t := getExprType (n^.unaryF.arg) ;
+   doExprC (p, getMax (t)) ;
+END doMaxC ;
+
+
+(*
+   isIntrinsic - returns if, n, is an intrinsic procedure.
+                 The intrinsic functions are represented as unary and binary nodes.
+*)
+
+PROCEDURE isIntrinsic (n: node) : BOOLEAN ;
+BEGIN
+   CASE n^.kind OF
+
+   unreachable,
+   throw,
+   inc,
+   dec,
+   incl,
+   excl,
+   new,
+   dispose,
+   halt   :  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isIntrinsic ;
+
+
+(*
+   doHalt -
+*)
+
+PROCEDURE doHalt (p: pretty; n: node) ;
+BEGIN
+   assert (n^.kind = halt) ;
+   IF (n^.intrinsicF.args = NIL) OR (expListLen (n^.intrinsicF.args) = 0)
+   THEN
+      outText (p, 'M2RTS_HALT') ;
+      setNeedSpace (p) ;
+      outText (p, '(-1)')
+   ELSIF expListLen (n^.intrinsicF.args) = 1
+   THEN
+      outText (p, 'M2RTS_HALT') ;
+      setNeedSpace (p) ;
+      outText (p, '(') ;
+      doExprC (p, getExpList (n^.intrinsicF.args, 1)) ;
+      outText (p, ')')
+   END
+END doHalt ;
+
+
+(*
+   doCreal - emit the appropriate creal function.
+*)
+
+PROCEDURE doCreal (p: pretty; t: node) ;
+BEGIN
+   CASE t^.kind OF
+
+   complex     :  keyc.useComplex ;
+                  outText (p, "creal") |
+   longcomplex :  keyc.useComplex ;
+                  outText (p, "creall") |
+   shortcomplex:  keyc.useComplex ;
+                  outText (p, "crealf")
+
+   END
+END doCreal ;
+
+
+(*
+   doCimag - emit the appropriate cimag function.
+*)
+
+PROCEDURE doCimag (p: pretty; t: node) ;
+BEGIN
+   CASE t^.kind OF
+
+   complex     :  keyc.useComplex ;
+                  outText (p, "cimag") |
+   longcomplex :  keyc.useComplex ;
+                  outText (p, "cimagl") |
+   shortcomplex:  keyc.useComplex ;
+                  outText (p, "cimagf")
+
+   END
+END doCimag ;
+
+
+(*
+   doReC -
+*)
+
+PROCEDURE doReC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (n^.kind = re) ;
+   IF n^.unaryF.arg # NIL
+   THEN
+      t := getExprType (n^.unaryF.arg)
+   ELSE
+      HALT
+   END ;
+   doCreal (p, t) ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   doExprC (p, n^.unaryF.arg) ;
+   outText (p, ')')
+END doReC ;
+
+
+(*
+   doImC -
+*)
+
+PROCEDURE doImC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (n^.kind = im) ;
+   IF n^.unaryF.arg # NIL
+   THEN
+      t := getExprType (n^.unaryF.arg)
+   ELSE
+      HALT
+   END ;
+   doCimag (p, t) ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   doExprC (p, n^.unaryF.arg) ;
+   outText (p, ')')
+END doImC ;
+
+
+(*
+   doCmplx -
+*)
+
+PROCEDURE doCmplx (p: pretty; n: node) ;
+BEGIN
+   assert (isBinary (n)) ;
+   keyc.useComplex ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   doExprC (p, n^.binaryF.left) ;
+   outText (p, ')') ;
+   setNeedSpace (p) ;
+   outText (p, '+') ;
+   setNeedSpace (p) ;
+   outText (p, '(') ;
+   doExprC (p, n^.binaryF.right) ;
+   setNeedSpace (p) ;
+   outText (p, '*') ;
+   setNeedSpace (p) ;
+   outText (p, 'I') ;
+   outText (p, ')')
+END doCmplx ;
+
+
+(*
+   doIntrinsicC -
+*)
+
+PROCEDURE doIntrinsicC (p: pretty; n: node) ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   doCommentC (p, n^.intrinsicF.intrinsicComment.body) ;
+   CASE n^.kind OF
+
+   unreachable: doUnreachableC (p, n) |
+   throw      : doThrowC (p, n) |
+   halt       : doHalt (p, n) |
+   inc        : doInc (p, n) |
+   dec        : doDec (p, n) |
+   incl       : doInclC (p, n) |
+   excl       : doExclC (p, n) |
+   new        : doNewC (p, n) |
+   dispose    : doDisposeC (p, n)
+
+   END ;
+   outText (p, ";") ;
+   doAfterCommentC (p, n^.intrinsicF.intrinsicComment.after)
+END doIntrinsicC ;
+
+
+(*
+   isIntrinsicFunction - returns true if, n, is an instrinsic function.
+*)
+
+PROCEDURE isIntrinsicFunction (n: node) : BOOLEAN ;
+BEGIN
+   CASE n^.kind OF
+
+   val,
+   adr,
+   size,
+   tsize,
+   float,
+   trunc,
+   ord,
+   chr,
+   cap,
+   abs,
+   high,
+   length,
+   min,
+   max,
+   re,
+   im,
+   cmplx:  RETURN TRUE
+
+   ELSE
+      RETURN FALSE
+   END
+END isIntrinsicFunction ;
+
+
+(*
+   doSizeC -
+*)
+
+PROCEDURE doSizeC (p: pretty; n: node) ;
+BEGIN
+   assert (isUnary (n)) ;
+   outText (p, "sizeof (") ;
+   doExprC (p, n^.unaryF.arg) ;
+   outText (p, ")")
+END doSizeC ;
+
+
+(*
+   doConvertC -
+*)
+
+PROCEDURE doConvertC (p: pretty; n: node; conversion: ARRAY OF CHAR) ;
+BEGIN
+   assert (isUnary (n)) ;
+   setNeedSpace (p) ;
+   outText (p, "(") ;
+   outText (p, conversion) ;
+   setNeedSpace (p) ;
+   outText (p, "(") ;
+   doExprC (p, n^.unaryF.arg) ;
+   outText (p, "))")
+END doConvertC ;
+
+
+(*  not needed?
+   val:     doValC (p, n) |
+   adr:     doAdrC (p, n) |
+   size,
+   tsize:   doSizeC (p, n) |
+   float:   doConvertC (p, n, "(double)") |
+   trunc:   doConvertC (p, n, "(int)") |
+   ord:     doConvertC (p, n, "(unsigned int)") |
+   chr:     doConvertC (p, n, "(char)") |
+   cap:     doCapC (p, n) |
+   abs:     doAbsC (p, n) |
+   high:    doFuncHighC (p, n^.unaryF.arg, 1)) |
+   length:  doLengthC (p, n) |
+   min:     doMinC (p, n) |
+   max:     doMaxC (p, n) |
+   throw:   doThrowC (p, n) |
+   re:      doReC (p, n) |
+   im:      doImC (p, n) |
+   cmplx:   doCmplx (p, n)
+*)
+
+
+(*
+   getFuncFromExpr -
+*)
+
+PROCEDURE getFuncFromExpr (n: node) : node ;
+BEGIN
+   n := skipType (getType (n)) ;
+   WHILE (n # procN) AND (NOT isProcType (n)) DO
+      n := skipType (getType (n))
+   END ;
+   RETURN n
+END getFuncFromExpr ;
+
+
+(*
+   doFuncExprC -
+*)
+
+PROCEDURE doFuncExprC (p: pretty; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (isFuncCall (n)) ;
+   IF isProcedure (n^.funccallF.function)
+   THEN
+      doFQDNameC (p, n^.funccallF.function, TRUE) ;
+      setNeedSpace (p) ;
+      doFuncArgsC (p, n, n^.funccallF.function^.procedureF.parameters, TRUE)
+   ELSE
+      outText (p, "(*") ;
+      doExprC (p, n^.funccallF.function) ;
+      outText (p, ".proc") ;
+      outText (p, ")") ;
+      t := getFuncFromExpr (n^.funccallF.function) ;
+      setNeedSpace (p) ;
+      IF t = procN
+      THEN
+         doProcTypeArgsC (p, n, NIL, TRUE)
+      ELSE
+         assert (isProcType (t)) ;
+         doProcTypeArgsC (p, n, t^.proctypeF.parameters, TRUE)
+      END
+   END
+END doFuncExprC ;
+
+
+(*
+   doFuncCallC -
+*)
+
+PROCEDURE doFuncCallC (p: pretty; n: node) ;
+BEGIN
+   doCommentC (p, n^.funccallF.funccallComment.body) ;
+   doFuncExprC (p, n) ;
+   outText (p, ";") ;
+   doAfterCommentC (p, n^.funccallF.funccallComment.after)
+END doFuncCallC ;
+
+
+(*
+   doCaseStatementC -
+*)
+
+PROCEDURE doCaseStatementC (p: pretty; n: node; needBreak: BOOLEAN) ;
+BEGIN
+   p := pushPretty (p) ;
+   setindent (p, getindent (p) + indentationC) ;
+   doStatementSequenceC (p, n) ;
+   IF needBreak
+   THEN
+      outText (p, "break;\n")
+   END ;
+   p := popPretty (p)
+END doCaseStatementC ;
+
+
+(*
+   doExceptionC -
+*)
+
+PROCEDURE doExceptionC (p: pretty; a: ARRAY OF CHAR; n: node) ;
+VAR
+   w: CARDINAL ;
+BEGIN
+   w := getDeclaredMod (n) ;
+   outText (p, a) ;
+   setNeedSpace (p) ;
+   outText (p, '("') ;
+   outTextS (p, findFileNameFromToken (w, 0)) ;
+   outText (p, '",') ;
+   setNeedSpace (p) ;
+   outCard (p, tokenToLineNo (w, 0)) ;
+   outText (p, ',') ;
+   setNeedSpace (p) ;
+   outCard (p, tokenToColumnNo (w, 0)) ;
+   outText (p, ');\n') ;
+   outText (p, '__builtin_unreachable ();\n')
+END doExceptionC ;
+
+
+(*
+   doExceptionCP -
+*)
+
+PROCEDURE doExceptionCP (p: pretty; a: ARRAY OF CHAR; n: node) ;
+VAR
+   w: CARDINAL ;
+BEGIN
+   w := getDeclaredMod (n) ;
+   outText (p, a) ;
+   setNeedSpace (p) ;
+   outText (p, '("') ;
+   outTextS (p, findFileNameFromToken (w, 0)) ;
+   outText (p, '",') ;
+   setNeedSpace (p) ;
+   outCard (p, tokenToLineNo (w, 0)) ;
+   outText (p, ',') ;
+   setNeedSpace (p) ;
+   outCard (p, tokenToColumnNo (w, 0)) ;
+   outText (p, ');\n') ;
+   outText (p, '__builtin_unreachable ();\n')
+END doExceptionCP ;
+
+
+(*
+   doException -
+*)
+
+PROCEDURE doException (p: pretty; a: ARRAY OF CHAR; n: node) ;
+BEGIN
+   keyc.useException ;
+   IF lang = ansiCP
+   THEN
+      doExceptionCP (p, a, n)
+   ELSE
+      doExceptionC (p, a, n)
+   END
+END doException ;
+
+
+(*
+   doRangeListC -
+*)
+
+PROCEDURE doRangeListC (p: pretty; c: node) ;
+VAR
+   r   : node ;
+   i, h: CARDINAL ;
+BEGIN
+   assert (isCaseList (c)) ;
+   i := 1 ;
+   h := HighIndice (c^.caselistF.rangePairs) ;
+   WHILE i<=h DO
+      r := GetIndice (c^.caselistF.rangePairs, i) ;
+      assert ((r^.rangeF.hi = NIL) OR (r^.rangeF.lo = r^.rangeF.hi)) ;
+      outText (p, "case") ;
+      setNeedSpace (p) ;
+      doExprC (p, r^.rangeF.lo) ;
+      outText (p, ":\n") ;
+      INC (i)
+   END
+END doRangeListC ;
+
+
+(*
+   doRangeIfListC -
+*)
+
+PROCEDURE doRangeIfListC (p: pretty; e, c: node) ;
+VAR
+   r   : node ;
+   i, h: CARDINAL ;
+BEGIN
+   assert (isCaseList (c)) ;
+   i := 1 ;
+   h := HighIndice (c^.caselistF.rangePairs) ;
+   WHILE i<=h DO
+      r := GetIndice (c^.caselistF.rangePairs, i) ;
+      IF (r^.rangeF.lo # r^.rangeF.hi) AND (r^.rangeF.hi # NIL)
+      THEN
+         outText (p, "((") ;
+         doExprC (p, e) ;
+         outText (p, ")") ;
+         setNeedSpace (p) ;
+         outText (p, ">=") ;
+         setNeedSpace (p) ;
+         doExprC (p, r^.rangeF.lo) ;
+         outText (p, ")") ;
+         setNeedSpace (p) ;
+         outText (p, "&&") ;
+         setNeedSpace (p) ;
+         outText (p, "((") ;
+         doExprC (p, e) ;
+         outText (p, ")") ;
+         setNeedSpace (p) ;
+         outText (p, "<=") ;
+         setNeedSpace (p) ;
+         doExprC (p, r^.rangeF.hi) ;
+         outText (p, ")")
+      ELSE
+         outText (p, "((") ;
+         doExprC (p, e) ;
+         outText (p, ")") ;
+         setNeedSpace (p) ;
+         outText (p, "==") ;
+         setNeedSpace (p) ;
+         doExprC (p, r^.rangeF.lo) ;
+         outText (p, ")")
+      END ;
+      IF i<h
+      THEN
+         setNeedSpace (p) ;
+         outText (p, "||") ;
+         setNeedSpace (p)
+      END ;
+      INC (i)
+   END
+END doRangeIfListC ;
+
+
+(*
+   doCaseLabels -
+*)
+
+PROCEDURE doCaseLabels (p: pretty; n: node; needBreak: BOOLEAN) ;
+BEGIN
+   assert (isCaseLabelList (n)) ;
+   doRangeListC (p, n^.caselabellistF.caseList) ;
+   p := pushPretty (p) ;
+   setindent (p, getindent (p) + indentationC) ;
+   doStatementSequenceC (p, n^.caselabellistF.statements) ;
+   IF needBreak
+   THEN
+      outText (p, "break;\n\n")
+   END ;
+   p := popPretty (p)
+END doCaseLabels ;
+
+
+(*
+   doCaseLabelListC -
+*)
+
+PROCEDURE doCaseLabelListC (p: pretty; n: node; haveElse: BOOLEAN) ;
+VAR
+   i, h: CARDINAL ;
+   c   : node ;
+BEGIN
+   assert (isCase (n)) ;
+   i := 1 ;
+   h := HighIndice (n^.caseF.caseLabelList) ;
+   WHILE i<=h DO
+      c := GetIndice (n^.caseF.caseLabelList, i) ;
+      doCaseLabels (p, c, (i<h) OR haveElse OR caseException) ;
+      INC (i)
+   END
+END doCaseLabelListC ;
+
+
+(*
+   doCaseIfLabels -
+*)
+
+PROCEDURE doCaseIfLabels (p: pretty; e, n: node;
+                          i, h: CARDINAL) ;
+BEGIN
+   assert (isCaseLabelList (n)) ;
+   IF i > 1
+   THEN
+      outText (p, "else") ;
+      setNeedSpace (p) ;
+   END ;
+   outText (p, "if") ;
+   setNeedSpace (p) ;
+   outText (p, "(") ;
+   doRangeIfListC (p, e, n^.caselabellistF.caseList) ;
+   outText (p, ")\n") ;
+   IF h = 1
+   THEN
+      doCompoundStmt (p, n^.caselabellistF.statements)
+   ELSE
+      outText (p, "{\n") ;
+      doStatementSequenceC (p, n^.caselabellistF.statements) ;
+      outText (p, "}\n")
+   END
+END doCaseIfLabels ;
+
+
+(*
+   doCaseIfLabelListC -
+*)
+
+PROCEDURE doCaseIfLabelListC (p: pretty; n: node) ;
+VAR
+   i, h: CARDINAL ;
+   c   : node ;
+BEGIN
+   assert (isCase (n)) ;
+   i := 1 ;
+   h := HighIndice (n^.caseF.caseLabelList) ;
+   WHILE i<=h DO
+      c := GetIndice (n^.caseF.caseLabelList, i) ;
+      doCaseIfLabels (p, n^.caseF.expression, c, i, h) ;
+      INC (i)
+   END
+END doCaseIfLabelListC ;
+
+
+(*
+   doCaseElseC -
+*)
+
+PROCEDURE doCaseElseC (p: pretty; n: node) ;
+BEGIN
+   assert (isCase (n)) ;
+   IF n^.caseF.else = NIL
+   THEN
+      IF caseException
+      THEN
+         outText (p, "\ndefault:\n") ;
+         p := pushPretty (p) ;
+         setindent (p, getindent (p) + indentationC) ;
+         doException (p, 'CaseException', n) ;
+         p := popPretty (p)
+      END
+   ELSE
+      outText (p, "\ndefault:\n") ;
+      doCaseStatementC (p, n^.caseF.else, TRUE)
+   END
+END doCaseElseC ;
+
+
+(*
+   doCaseIfElseC -
+*)
+
+PROCEDURE doCaseIfElseC (p: pretty; n: node) ;
+BEGIN
+   assert (isCase (n)) ;
+   IF n^.caseF.else = NIL
+   THEN
+      IF TRUE
+      THEN
+         outText (p, "\n") ;
+         outText (p, "else {\n") ;
+         p := pushPretty (p) ;
+         setindent (p, getindent (p) + indentationC) ;
+         doException (p, 'CaseException', n) ;
+         p := popPretty (p) ;
+         outText (p, "}\n")
+      END
+   ELSE
+      outText (p, "\n") ;
+      outText (p, "else {\n") ;
+      doCaseStatementC (p, n^.caseF.else, FALSE) ;
+      outText (p, "}\n")
+   END
+END doCaseIfElseC ;
+
+
+(*
+   canUseSwitchCaseLabels - returns TRUE if all the case labels are
+                            single values and not ranges.
+*)
+
+PROCEDURE canUseSwitchCaseLabels (n: node) : BOOLEAN ;
+VAR
+   i, h: CARDINAL ;
+   r, l: node ;
+BEGIN
+   assert (isCaseLabelList (n)) ;
+   l := n^.caselabellistF.caseList ;
+   i := 1 ;
+   h := HighIndice (l^.caselistF.rangePairs) ;
+   WHILE i<=h DO
+      r := GetIndice (l^.caselistF.rangePairs, i) ;
+      IF (r^.rangeF.hi # NIL) AND (r^.rangeF.lo # r^.rangeF.hi)
+      THEN
+         RETURN FALSE
+      END ;
+      INC (i)
+   END ;
+   RETURN TRUE
+END canUseSwitchCaseLabels ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE canUseSwitch (n: node) : BOOLEAN ;
+VAR
+   i, h: CARDINAL ;
+   c   : node ;
+BEGIN
+   assert (isCase (n)) ;
+   i := 1 ;
+   h := HighIndice (n^.caseF.caseLabelList) ;
+   WHILE i<=h DO
+      c := GetIndice (n^.caseF.caseLabelList, i) ;
+      IF NOT canUseSwitchCaseLabels (c)
+      THEN
+         RETURN FALSE
+      END ;
+      INC (i)
+   END ;
+   RETURN TRUE
+END canUseSwitch ;
+
+
+(*
+   doCaseC -
+*)
+
+PROCEDURE doCaseC (p: pretty; n: node) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   assert (isCase (n)) ;
+   IF canUseSwitch (n)
+   THEN
+      i := getindent (p) ;
+      outText (p, "switch") ;
+      setNeedSpace (p) ;
+      outText (p, "(") ;
+      doExprC (p, n^.caseF.expression) ;
+      p := pushPretty (p) ;
+      outText (p, ")") ;
+      setindent (p, i + indentationC) ;
+      outText (p, "\n{\n") ;
+      p := pushPretty (p) ;
+      setindent (p, getindent (p) + indentationC) ;
+      doCaseLabelListC (p, n, n^.caseF.else # NIL) ;
+      doCaseElseC (p, n) ;
+      p := popPretty (p) ;
+      outText (p, "}\n") ;
+      p := popPretty (p)
+   ELSE
+      doCaseIfLabelListC (p, n) ;
+      doCaseIfElseC (p, n)
+   END
+END doCaseC ;
+
+
+(*
+   doLoopC -
+*)
+
+PROCEDURE doLoopC (p: pretty; s: node) ;
+BEGIN
+   assert (isLoop (s)) ;
+   outText (p, 'for (;;)\n') ;
+   outText (p, "{\n") ;
+   p := pushPretty (p) ;
+   setindent (p, getindent (p) + indentationC) ;
+   doStatementSequenceC (p, s^.loopF.statements) ;
+   p := popPretty (p) ;
+   outText (p, "}\n")
+END doLoopC ;
+
+
+(*
+   doExitC -
+*)
+
+PROCEDURE doExitC (p: pretty; s: node) ;
+BEGIN
+   assert (isExit (s)) ;
+   outText (p, "/* exit.  */\n")
+END doExitC ;
+
+
+(*
+   doStatementsC -
+*)
+
+PROCEDURE doStatementsC (p: pretty; s: node) ;
+BEGIN
+   IF s = NIL
+   THEN
+      (* do nothing.  *)
+   ELSIF isStatementSequence (s)
+   THEN
+      doStatementSequenceC (p, s)
+   ELSIF isComment (s)
+   THEN
+      doCommentC (p, s)
+   ELSIF isExit (s)
+   THEN
+      doExitC (p, s)
+   ELSIF isReturn (s)
+   THEN
+      doReturnC (p, s)
+   ELSIF isAssignment (s)
+   THEN
+      doAssignmentC (p, s)
+   ELSIF isIf (s)
+   THEN
+      doIfC (p, s)
+   ELSIF isFor (s)
+   THEN
+      doForC (p, s)
+   ELSIF isRepeat (s)
+   THEN
+      doRepeatC (p, s)
+   ELSIF isWhile (s)
+   THEN
+      doWhileC (p, s)
+   ELSIF isIntrinsic (s)
+   THEN
+      doIntrinsicC (p, s)
+   ELSIF isFuncCall (s)
+   THEN
+      doFuncCallC (p, s)
+   ELSIF isCase (s)
+   THEN
+      doCaseC (p, s)
+   ELSIF isLoop (s)
+   THEN
+      doLoopC (p, s)
+   ELSIF isExit (s)
+   THEN
+      doExitC (p, s)
+   ELSE
+      HALT  (* need to handle another s^.kind.  *)
+   END
+END doStatementsC ;
+
+
+PROCEDURE stop ; END stop ;
+
+(*
+   doLocalVarC -
+*)
+
+PROCEDURE doLocalVarC (p: pretty; s: scopeT) ;
+BEGIN
+   includeVarProcedure (s) ;
+   debugLists ;
+
+   topologicallyOut (doConstC, doTypesC, doVarC,
+                     outputPartial,
+                     doNone, doCompletePartialC, doNone)
+END doLocalVarC ;
+
+
+(*
+   doLocalConstTypesC -
+*)
+
+PROCEDURE doLocalConstTypesC (p: pretty; s: scopeT) ;
+BEGIN
+   simplifyTypes (s) ;
+   includeConstType (s) ;
+
+   doP := p ;
+
+   topologicallyOut (doConstC, doTypesC, doVarC,
+                     outputPartial,
+                     doNone, doCompletePartialC, doNone) ;
+
+END doLocalConstTypesC ;
+
+
+(*
+   addParamDone -
+*)
+
+PROCEDURE addParamDone (n: node) ;
+BEGIN
+   IF isVar (n) AND n^.varF.isParameter
+   THEN
+      addDone (n) ;
+      addDone (getType (n))
+   END
+END addParamDone ;
+
+
+(*
+   includeParameters -
+*)
+
+PROCEDURE includeParameters (n: node) ;
+BEGIN
+   assert (isProcedure (n)) ;
+   ForeachIndiceInIndexDo (n^.procedureF.decls.variables, addParamDone)
+END includeParameters ;
+
+
+(*
+   isHalt -
+*)
+
+PROCEDURE isHalt (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = halt
+END isHalt ;
+
+
+(*
+   isReturnOrHalt -
+*)
+
+PROCEDURE isReturnOrHalt (n: node) : BOOLEAN ;
+BEGIN
+   RETURN isHalt (n) OR isReturn (n)
+END isReturnOrHalt ;
+
+
+(*
+   isLastStatementReturn -
+*)
+
+PROCEDURE isLastStatementReturn (n: node) : BOOLEAN ;
+BEGIN
+   RETURN isLastStatement (n, isReturnOrHalt)
+END isLastStatementReturn ;
+
+
+(*
+   isLastStatementSequence -
+*)
+
+PROCEDURE isLastStatementSequence (n: node; q: isNodeF) : BOOLEAN ;
+VAR
+   h  : CARDINAL ;
+BEGIN
+   assert (isStatementSequence (n)) ;
+   h := HighIndice (n^.stmtF.statements) ;
+   IF h > 0
+   THEN
+      RETURN isLastStatement (GetIndice (n^.stmtF.statements, h), q)
+   END ;
+   RETURN FALSE
+END isLastStatementSequence ;
+
+
+(*
+   isLastStatementIf -
+*)
+
+PROCEDURE isLastStatementIf (n: node; q: isNodeF) : BOOLEAN ;
+VAR
+   ret: BOOLEAN ;
+BEGIN
+   assert (isIf (n)) ;
+   ret := TRUE ;
+   IF (n^.ifF.elsif # NIL) AND ret
+   THEN
+      ret := isLastStatement (n^.ifF.elsif, q)
+   END ;
+   IF (n^.ifF.then # NIL) AND ret
+   THEN
+      ret := isLastStatement (n^.ifF.then, q)
+   END ;
+   IF (n^.ifF.else # NIL) AND ret
+   THEN
+      ret := isLastStatement (n^.ifF.else, q)
+   END ;
+   RETURN ret
+END isLastStatementIf ;
+
+
+(*
+   isLastStatementElsif -
+*)
+
+PROCEDURE isLastStatementElsif (n: node; q: isNodeF) : BOOLEAN ;
+VAR
+   ret: BOOLEAN ;
+BEGIN
+   assert (isElsif (n)) ;
+   ret := TRUE ;
+   IF (n^.elsifF.elsif # NIL) AND ret
+   THEN
+      ret := isLastStatement (n^.elsifF.elsif, q)
+   END ;
+   IF (n^.elsifF.then # NIL) AND ret
+   THEN
+      ret := isLastStatement (n^.elsifF.then, q)
+   END ;
+   IF (n^.elsifF.else # NIL) AND ret
+   THEN
+      ret := isLastStatement (n^.elsifF.else, q)
+   END ;
+   RETURN ret
+END isLastStatementElsif ;
+
+
+(*
+   isLastStatementCase -
+*)
+
+PROCEDURE isLastStatementCase (n: node; q: isNodeF) : BOOLEAN ;
+VAR
+   ret : BOOLEAN ;
+   i, h: CARDINAL ;
+   c   : node ;
+BEGIN
+   ret := TRUE ;
+   assert (isCase (n)) ;
+   i := 1 ;
+   h := HighIndice (n^.caseF.caseLabelList) ;
+   WHILE i<=h DO
+      c := GetIndice (n^.caseF.caseLabelList, i) ;
+      assert (isCaseLabelList (c)) ;
+      ret := ret AND isLastStatement (c^.caselabellistF.statements, q) ;
+      INC (i)
+   END ;
+   IF n^.caseF.else # NIL
+   THEN
+      ret := ret AND isLastStatement (n^.caseF.else, q)
+   END ;
+   RETURN ret
+END isLastStatementCase ;
+
+
+(*
+   isLastStatement - returns TRUE if the last statement in, n, is, q.
+*)
+
+PROCEDURE isLastStatement (n: node; q: isNodeF) : BOOLEAN ;
+VAR
+   ret: BOOLEAN ;
+BEGIN
+   IF n = NIL
+   THEN
+      RETURN FALSE
+   ELSIF isStatementSequence (n)
+   THEN
+      RETURN isLastStatementSequence (n, q)
+   ELSIF isProcedure (n)
+   THEN
+      assert (isProcedure (n)) ;
+      RETURN isLastStatement (n^.procedureF.beginStatements, q)
+   ELSIF isIf (n)
+   THEN
+      RETURN isLastStatementIf (n, q)
+   ELSIF isElsif (n)
+   THEN
+      RETURN isLastStatementElsif (n, q)
+   ELSIF isCase (n)
+   THEN
+      RETURN isLastStatementCase (n, q)
+   ELSIF q (n)
+   THEN
+      RETURN TRUE
+   END ;
+   RETURN FALSE
+END isLastStatement ;
+
+
+(*
+   doProcedureC -
+*)
+
+PROCEDURE doProcedureC (n: node) ;
+VAR
+   s: CARDINAL ;
+BEGIN
+   outText (doP, "\n") ;
+   includeParameters (n) ;
+
+   keyc.enterScope (n) ;
+
+   doProcedureHeadingC (n, FALSE) ;
+   outText (doP, "\n") ;
+   doP := outKc (doP, "{\n") ;
+   s := getcurline (doP) ;
+   doLocalConstTypesC (doP, n^.procedureF.decls) ;
+   doLocalVarC (doP, n^.procedureF.decls) ;
+   doUnboundedParamCopyC (doP, n) ;
+
+   IF s # getcurline (doP)
+   THEN
+      outText (doP, "\n")
+   END ;
+
+   doStatementsC (doP, n^.procedureF.beginStatements) ;
+   IF n^.procedureF.returnType # NIL
+   THEN
+      IF returnException
+      THEN
+         IF isLastStatementReturn (n)
+	 THEN
+            outText (doP, "/* static analysis guarentees a RETURN statement will be used before here.  */\n") ;
+            outText (doP, "__builtin_unreachable ();\n") ;
+         ELSE
+            doException (doP, 'ReturnException', n)
+         END
+      END
+   END ;
+   doP := outKc (doP, "}\n") ;
+   keyc.leaveScope (n)
+END doProcedureC ;
+
+
+(*
+   outProceduresC -
+*)
+
+PROCEDURE outProceduresC (p: pretty; s: scopeT) ;
+BEGIN
+   doP := p ;
+   IF debugDecl
+   THEN
+      printf ("seen %d procedures\n", HighIndice (s.procedures))
+   END ;
+
+   ForeachIndiceInIndexDo (s.procedures, doProcedureC)
+END outProceduresC ;
+
+
+(*
+   output -
+*)
+
+PROCEDURE output (n: node; c, t, v: nodeProcedure) ;
+BEGIN
+   IF isConst (n)
+   THEN
+      c (n)
+   ELSIF isVar (n)
+   THEN
+      v (n)
+   ELSE
+      t (n)
+   END
+END output ;
+
+
+(*
+   allDependants -
+*)
+
+PROCEDURE allDependants (n: node) : dependentState ;
+VAR
+   l: alist ;
+   s: dependentState ;
+BEGIN
+   l := alists.initList () ;
+   s := walkDependants (l, n) ;
+   alists.killList (l) ;
+   RETURN s
+END allDependants ;
+
+
+(*
+   walkDependants -
+*)
+
+PROCEDURE walkDependants (l: alist; n: node) : dependentState ;
+BEGIN
+   IF (n=NIL) OR alists.isItemInList (doneQ, n)
+   THEN
+      RETURN completed
+   ELSIF alists.isItemInList (l, n)
+   THEN
+      RETURN recursive
+   ELSE
+      alists.includeItemIntoList (l, n) ;
+      RETURN doDependants (l, n)
+   END
+END walkDependants ;
+
+
+(*
+   walkType -
+*)
+
+PROCEDURE walkType (l: alist; n: node) : dependentState ;
+VAR
+   t: node ;
+BEGIN
+   t := getType (n) ;
+   IF alists.isItemInList (doneQ, t)
+   THEN
+      RETURN completed
+   ELSIF alists.isItemInList (partialQ, t)
+   THEN
+      RETURN blocked
+   ELSE
+      queueBlocked (t) ;
+      RETURN blocked
+   END
+END walkType ;
+
+
+(*
+   db -
+*)
+
+PROCEDURE db (a: ARRAY OF CHAR; n: node) ;
+BEGIN
+   IF getDebugTopological ()
+   THEN
+      outText (doP, a) ;
+      IF n#NIL
+      THEN
+         outTextS (doP, gen (n))
+      END
+   END
+END db ;
+
+
+(*
+   dbt -
+*)
+
+PROCEDURE dbt (a: ARRAY OF CHAR) ;
+BEGIN
+   IF getDebugTopological ()
+   THEN
+      outText (doP, a)
+   END
+END dbt ;
+
+
+(*
+   dbs -
+*)
+
+PROCEDURE dbs (s: dependentState; n: node) ;
+BEGIN
+   IF getDebugTopological ()
+   THEN
+      CASE s OF
+
+      completed:  outText (doP, '{completed ') |
+      blocked  :  outText (doP, '{blocked ') |
+      partial  :  outText (doP, '{partial ') |
+      recursive:  outText (doP, '{recursive ')
+
+      END ;
+      IF n#NIL
+      THEN
+         outTextS (doP, gen (n))
+      END ;
+      outText (doP, '}\n')
+   END
+END dbs ;
+
+
+(*
+   dbq -
+*)
+
+PROCEDURE dbq (n: node) ;
+BEGIN
+   IF getDebugTopological ()
+   THEN
+      IF alists.isItemInList (todoQ, n)
+      THEN
+         db ('{T', n) ; outText (doP, '}')
+      ELSIF alists.isItemInList (partialQ, n)
+      THEN
+         db ('{P', n) ; outText (doP, '}')
+      ELSIF alists.isItemInList (doneQ, n)
+      THEN
+         db ('{D', n) ; outText (doP, '}')
+      END
+   END
+END dbq ;
+
+
+(*
+   walkRecord -
+*)
+
+PROCEDURE walkRecord (l: alist; n: node) : dependentState ;
+VAR
+   s   : dependentState ;
+   o,
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   i := LowIndice (n^.recordF.listOfSons) ;
+   t := HighIndice (n^.recordF.listOfSons) ;
+   db ('\nwalking ', n) ; o := getindent (doP) ; setindent (doP, getcurpos (doP)+3) ;
+   dbq (n) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.recordF.listOfSons, i) ;
+      db ('', q) ;
+      IF isRecordField (q) AND q^.recordfieldF.tag
+      THEN
+         (* do nothing as it is a tag selector processed in the varient.  *)
+      ELSE
+         s := walkDependants (l, q) ;
+         IF s#completed
+         THEN
+            dbs (s, q) ;
+            addTodo (n) ;
+            dbq (n) ;
+            db ('\n', NIL) ;
+            setindent (doP, o) ;
+            RETURN s
+         END
+      END ;
+      INC (i)
+   END ;
+   db ('{completed', n) ; dbt ('}\n') ;
+   setindent (doP, o) ;
+   RETURN completed
+END walkRecord ;
+
+
+(*
+   walkVarient -
+*)
+
+PROCEDURE walkVarient (l: alist; n: node) : dependentState ;
+VAR
+   s   : dependentState ;
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   db ('\nwalking', n) ;
+   s := walkDependants (l, n^.varientF.tag) ;
+   IF s#completed
+   THEN
+      dbs (s, n^.varientF.tag) ;
+      dbq (n^.varientF.tag) ;
+      db ('\n', NIL) ;
+      RETURN s
+   END ;
+   i := LowIndice (n^.varientF.listOfSons) ;
+   t := HighIndice (n^.varientF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientF.listOfSons, i) ;
+      db ('', q) ;
+      s := walkDependants (l, q) ;
+      IF s#completed
+      THEN
+         dbs (s, q) ;
+         db ('\n', NIL) ;
+         RETURN s
+      END ;
+      INC (i)
+   END ;
+   db ('{completed', n) ; dbt ('}\n') ;
+   RETURN completed
+END walkVarient ;
+
+
+(*
+   queueBlocked -
+*)
+
+PROCEDURE queueBlocked (n: node) ;
+BEGIN
+   IF NOT (alists.isItemInList (doneQ, n) OR alists.isItemInList (partialQ, n))
+   THEN
+      addTodo (n)
+   END
+END queueBlocked ;
+
+
+(*
+   walkVar -
+*)
+
+PROCEDURE walkVar (l: alist; n: node) : dependentState ;
+VAR
+   t: node ;
+BEGIN
+   t := getType (n) ;
+   IF alists.isItemInList (doneQ, t)
+   THEN
+      RETURN completed
+   ELSE
+      queueBlocked (t) ;
+      RETURN blocked
+   END
+END walkVar ;
+
+
+(*
+   walkEnumeration -
+*)
+
+PROCEDURE walkEnumeration (l: alist; n: node) : dependentState ;
+VAR
+   s   : dependentState ;
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   i := LowIndice (n^.enumerationF.listOfSons) ;
+   t := HighIndice (n^.enumerationF.listOfSons) ;
+   s := completed ;
+   WHILE i<=t DO
+      q := GetIndice (n^.enumerationF.listOfSons, i) ;
+      s := walkDependants (l, q) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      INC (i)
+   END ;
+   RETURN s
+END walkEnumeration ;
+
+
+(*
+   walkSubrange -
+*)
+
+PROCEDURE walkSubrange (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   WITH n^.subrangeF DO
+      s := walkDependants (l, low) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      s := walkDependants (l, high) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      s := walkDependants (l, type) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END
+   END ;
+   RETURN completed
+END walkSubrange ;
+
+
+(*
+   walkSubscript -
+*)
+
+PROCEDURE walkSubscript (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   WITH n^.subscriptF DO
+      s := walkDependants (l, expr) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      s := walkDependants (l, type) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END
+   END ;
+   RETURN completed
+END walkSubscript ;
+
+
+(*
+   walkPointer -
+*)
+
+PROCEDURE walkPointer (l: alist; n: node) : dependentState ;
+VAR
+   t: node ;
+BEGIN
+   (* if the type of, n, is done or partial then we can output pointer.  *)
+   t := getType (n) ;
+   IF alists.isItemInList (partialQ, t) OR alists.isItemInList (doneQ, t)
+   THEN
+      (* pointer to partial can always generate a complete type.  *)
+      RETURN completed
+   END ;
+   RETURN walkType (l, n)
+END walkPointer ;
+
+
+(*
+   walkArray -
+*)
+
+PROCEDURE walkArray (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   WITH n^.arrayF DO
+(*
+      s := walkDependants (l, type) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+*)
+      (* an array can only be declared if its data type has already been emitted.  *)
+      IF NOT alists.isItemInList (doneQ, type)
+      THEN
+         s := walkDependants (l, type) ;
+         queueBlocked (type) ;
+         IF s=completed
+         THEN
+            (* downgrade the completed to partial as it has not yet been written.  *)
+            RETURN partial
+         ELSE
+            RETURN s
+         END
+      END ;
+      RETURN walkDependants (l, subr)
+   END
+END walkArray ;
+
+
+(*
+   walkConst -
+*)
+
+PROCEDURE walkConst (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   WITH n^.constF DO
+      s := walkDependants (l, type) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      s := walkDependants (l, value) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END
+   END ;
+   RETURN completed
+END walkConst ;
+
+
+(*
+   walkVarParam -
+*)
+
+PROCEDURE walkVarParam (l: alist; n: node) : dependentState ;
+VAR
+   t: node ;
+BEGIN
+   t := getType (n) ;
+   IF alists.isItemInList (partialQ, t)
+   THEN
+      (* parameter can be issued from a partial.  *)
+      RETURN completed
+   END ;
+   RETURN walkDependants (l, t)
+END walkVarParam ;
+
+
+(*
+   walkParam -
+*)
+
+PROCEDURE walkParam (l: alist; n: node) : dependentState ;
+VAR
+   t: node ;
+BEGIN
+   t := getType (n) ;
+   IF alists.isItemInList (partialQ, t)
+   THEN
+      (* parameter can be issued from a partial.  *)
+      RETURN completed
+   END ;
+   RETURN walkDependants (l, t)
+END walkParam ;
+
+
+(*
+   walkOptarg -
+*)
+
+PROCEDURE walkOptarg (l: alist; n: node) : dependentState ;
+VAR
+   t: node ;
+BEGIN
+   t := getType (n) ;
+   IF alists.isItemInList (partialQ, t)
+   THEN
+      (* parameter can be issued from a partial.  *)
+      RETURN completed
+   END ;
+   RETURN walkDependants (l, t)
+END walkOptarg ;
+
+
+(*
+   walkRecordField -
+*)
+
+PROCEDURE walkRecordField (l: alist; n: node) : dependentState ;
+VAR
+   t: node ;
+   s: dependentState ;
+BEGIN
+   assert (isRecordField (n)) ;
+   t := getType (n) ;
+   IF alists.isItemInList (partialQ, t)
+   THEN
+      dbs (partial, n) ;
+      RETURN partial
+   ELSIF alists.isItemInList (doneQ, t)
+   THEN
+      dbs (completed, n) ;
+      RETURN completed
+   ELSE
+      addTodo (t) ;
+      dbs (blocked, n) ;
+      dbq (n) ;
+      dbq (t) ;
+      (*  s := walkDependants (l, t) *)
+      RETURN blocked
+   END
+END walkRecordField ;
+
+
+(*
+   walkVarientField -
+*)
+
+PROCEDURE walkVarientField (l: alist; n: node) : dependentState ;
+VAR
+   s   : dependentState ;
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   i := LowIndice (n^.varientfieldF.listOfSons) ;
+   t := HighIndice (n^.varientfieldF.listOfSons) ;
+   s := completed ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientfieldF.listOfSons, i) ;
+      s := walkDependants (l, q) ;
+      IF s#completed
+      THEN
+         dbs (s, n) ;
+         RETURN s
+      END ;
+      INC (i)
+   END ;
+   n^.varientfieldF.simple := (t <= 1) ;
+   dbs (s, n) ;
+   RETURN s
+END walkVarientField ;
+
+
+(*
+   walkEnumerationField -
+*)
+
+PROCEDURE walkEnumerationField (l: alist; n: node) : dependentState ;
+BEGIN
+   RETURN completed
+END walkEnumerationField ;
+
+
+(*
+   walkSet -
+*)
+
+PROCEDURE walkSet (l: alist; n: node) : dependentState ;
+BEGIN
+   RETURN walkDependants (l, getType (n))
+END walkSet ;
+
+
+(*
+   walkProcType -
+*)
+
+PROCEDURE walkProcType (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+   t: node ;
+BEGIN
+   t := getType (n) ;
+   IF alists.isItemInList (partialQ, t)
+   THEN
+      (* proctype can be generated from partial types.  *)
+   ELSE
+      s := walkDependants (l, t) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END
+   END ;
+   RETURN walkParameters (l, n^.proctypeF.parameters)
+END walkProcType ;
+
+
+(*
+   walkProcedure -
+*)
+
+PROCEDURE walkProcedure (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   s := walkDependants (l, getType (n)) ;
+   IF s#completed
+   THEN
+      RETURN s
+   END ;
+   RETURN walkParameters (l, n^.procedureF.parameters)
+END walkProcedure ;
+
+
+(*
+   walkParameters -
+*)
+
+PROCEDURE walkParameters (l: alist; p: Index) : dependentState ;
+VAR
+   s   : dependentState ;
+   i, h: CARDINAL ;
+   q   : node ;
+BEGIN
+   i := LowIndice (p) ;
+   h := HighIndice (p) ;
+   WHILE i<=h DO
+      q := GetIndice (p, i) ;
+      s := walkDependants (l, q) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      INC (i)
+   END ;
+   RETURN completed
+END walkParameters ;
+
+
+(*
+   walkFuncCall -
+*)
+
+PROCEDURE walkFuncCall (l: alist; n: node) : dependentState ;
+BEGIN
+   RETURN completed
+END walkFuncCall ;
+
+
+(*
+   walkUnary -
+*)
+
+PROCEDURE walkUnary (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   WITH n^.unaryF DO
+      s := walkDependants (l, arg) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      RETURN walkDependants (l, resultType)
+   END
+END walkUnary ;
+
+
+(*
+   walkBinary -
+*)
+
+PROCEDURE walkBinary (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   WITH n^.binaryF DO
+      s := walkDependants (l, left) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      s := walkDependants (l, right) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      RETURN walkDependants (l, resultType)
+   END
+END walkBinary ;
+
+
+(*
+   walkComponentRef -
+*)
+
+PROCEDURE walkComponentRef (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   WITH n^.componentrefF DO
+      s := walkDependants (l, rec) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      s := walkDependants (l, field) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      RETURN walkDependants (l, resultType)
+   END
+END walkComponentRef ;
+
+
+(*
+   walkPointerRef -
+*)
+
+PROCEDURE walkPointerRef (l: alist; n: node) : dependentState ;
+VAR
+   s: dependentState ;
+BEGIN
+   WITH n^.pointerrefF DO
+      s := walkDependants (l, ptr) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      s := walkDependants (l, field) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      RETURN walkDependants (l, resultType)
+   END
+END walkPointerRef ;
+
+
+(*
+   walkSetValue -
+*)
+
+PROCEDURE walkSetValue (l: alist; n: node) : dependentState ;
+VAR
+   s   : dependentState ;
+   i, j: CARDINAL ;
+BEGIN
+   assert (isSetValue (n)) ;
+   WITH n^.setvalueF DO
+      s := walkDependants (l, type) ;
+      IF s#completed
+      THEN
+         RETURN s
+      END ;
+      i := LowIndice (values) ;
+      j := HighIndice (values) ;
+      WHILE  i <= j DO
+         s := walkDependants (l, GetIndice (values, i)) ;
+	 IF s#completed
+         THEN
+            RETURN s
+         END ;
+         INC (i)
+      END
+   END ;
+   RETURN completed
+END walkSetValue ;
+
+
+(*
+   doDependants - return the dependentState depending upon whether
+                  all dependants have been declared.
+*)
+
+PROCEDURE doDependants (l: alist; n: node) : dependentState ;
+BEGIN
+   WITH n^ DO
+      CASE kind OF
+
+      throw,          (* --fixme--  *)
+      varargs,
+      address,
+      loc,
+      byte,
+      word,
+      csizet,
+      cssizet,
+      (* base types.  *)
+      boolean,
+      char,
+      cardinal,
+      longcard,
+      shortcard,
+      integer,
+      longint,
+      shortint,
+      real,
+      longreal,
+      shortreal,
+      bitset,
+      ztype,
+      rtype,
+      complex,
+      longcomplex,
+      shortcomplex,
+      proc            :  RETURN completed |
+      (* language features and compound type attributes.  *)
+      type            :  RETURN walkType (l, n) |
+      record          :  RETURN walkRecord (l, n) |
+      varient         :  RETURN walkVarient (l, n) |
+      var             :  RETURN walkVar (l, n) |
+      enumeration     :  RETURN walkEnumeration (l, n) |
+      subrange        :  RETURN walkSubrange (l, n) |
+      pointer         :  RETURN walkPointer (l, n) |
+      array           :  RETURN walkArray (l, n) |
+      string          :  RETURN completed |
+      const           :  RETURN walkConst (l, n) |
+      literal         :  RETURN completed |
+      varparam        :  RETURN walkVarParam (l, n) |
+      param           :  RETURN walkParam (l, n) |
+      optarg          :  RETURN walkOptarg (l, n) |
+      recordfield     :  RETURN walkRecordField (l, n) |
+      varientfield    :  RETURN walkVarientField (l, n) |
+      enumerationfield:  RETURN walkEnumerationField (l, n) |
+      set             :  RETURN walkSet (l, n) |
+      proctype        :  RETURN walkProcType (l, n) |
+      subscript       :  RETURN walkSubscript (l, n) |
+      (* blocks.  *)
+      procedure       :  RETURN walkProcedure (l, n) |
+      def,
+      imp,
+      module,
+      (* statements.  *)
+      loop,
+      while,
+      for,
+      repeat,
+      if,
+      elsif,
+      assignment      :  HALT |
+      (* expressions.  *)
+      componentref    :  RETURN walkComponentRef (l, n) |
+      pointerref      :  RETURN walkPointerRef (l, n) |
+      not,
+      abs,
+      min,
+      max,
+      chr,
+      cap,
+      ord,
+      float,
+      trunc,
+      high            :  RETURN walkUnary (l, n) |
+      cast,
+      val,
+      plus,
+      sub,
+      div,
+      mod,
+      mult,
+      divide          :  RETURN walkBinary (l, n) |
+      constexp,
+      neg,
+      adr,
+      size,
+      tsize,
+      deref           :  RETURN walkUnary (l, n) |
+      equal,
+      notequal,
+      less,
+      greater,
+      greequal,
+      lessequal       :  RETURN walkBinary (l, n) |
+      funccall        :  RETURN walkFuncCall (l, n) |
+      setvalue        :  RETURN walkSetValue (l, n)
+
+      END
+   END
+END doDependants ;
+
+
+(*
+   tryComplete - returns TRUE if node, n, can be and was completed.
+*)
+
+PROCEDURE tryComplete (n: node; c, t, v: nodeProcedure) : BOOLEAN ;
+BEGIN
+   IF isEnumeration (n)
+   THEN
+      (* can always emit enumerated types.  *)
+      output (n, c, t, v) ;
+      RETURN TRUE
+   ELSIF isType (n) AND isTypeHidden (n) AND (getType (n)=NIL)
+   THEN
+      (* can always emit hidden types.  *)
+      outputHidden (n) ;
+      RETURN TRUE
+   ELSIF allDependants (n) = completed
+   THEN
+      output (n, c, t, v) ;
+      RETURN TRUE
+   END ;
+   RETURN FALSE
+END tryComplete ;
+
+
+(*
+   tryCompleteFromPartial -
+*)
+
+PROCEDURE tryCompleteFromPartial (n: node; t: nodeProcedure) : BOOLEAN ;
+BEGIN
+   IF isType (n) AND (getType (n)#NIL) AND isPointer (getType (n)) AND (allDependants (getType (n)) = completed)
+   THEN
+      (* alists.includeItemIntoList (partialQ, getType (n)) ; *)
+      outputHiddenComplete (n) ;
+      RETURN TRUE
+   ELSIF allDependants (n) = completed
+   THEN
+      t (n) ;
+      RETURN TRUE
+   END ;
+   RETURN FALSE
+END tryCompleteFromPartial ;
+
+
+(*
+   visitIntrinsicFunction -
+*)
+
+PROCEDURE visitIntrinsicFunction (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isIntrinsicFunction (n)) ;
+   CASE n^.kind OF
+
+   val,
+   cmplx:  WITH n^.binaryF DO
+             visitNode (v, left, p) ;
+             visitNode (v, right, p) ;
+             visitNode (v, resultType, p)
+           END |
+   length,
+   adr,
+   size,
+   tsize,
+   float,
+   trunc,
+   ord,
+   chr,
+   cap,
+   abs,
+   high,
+   min,
+   max,
+   re,
+   im   : WITH n^.unaryF DO
+             visitNode (v, arg, p) ;
+             visitNode (v, resultType, p)
+          END
+
+   END
+END visitIntrinsicFunction ;
+
+
+(*
+   visitUnary -
+*)
+
+PROCEDURE visitUnary (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isUnary (n)) ;
+   WITH n^.unaryF DO
+      visitNode (v, arg, p) ;
+      visitNode (v, resultType, p)
+   END
+END visitUnary ;
+
+
+(*
+   visitBinary -
+*)
+
+PROCEDURE visitBinary (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   WITH n^.binaryF DO
+      visitNode (v, left, p) ;
+      visitNode (v, right, p) ;
+      visitNode (v, resultType, p)
+   END
+END visitBinary ;
+
+
+(*
+   visitBoolean -
+*)
+
+PROCEDURE visitBoolean (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   visitNode (v, falseN, p) ;
+   visitNode (v, trueN, p)
+END visitBoolean ;
+
+
+(*
+   visitScope -
+*)
+
+PROCEDURE visitScope (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   IF mustVisitScope
+   THEN
+      visitNode (v, n, p)
+   END
+END visitScope ;
+
+
+(*
+   visitType -
+*)
+
+PROCEDURE visitType (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isType (n)) ;
+   visitNode (v, n^.typeF.type, p) ;
+   visitScope (v, n^.typeF.scope, p)
+END visitType ;
+
+
+(*
+   visitIndex -
+*)
+
+PROCEDURE visitIndex (v: alist; i: Index; p: nodeProcedure) ;
+VAR
+   j, h: CARDINAL ;
+BEGIN
+   j := 1 ;
+   h := HighIndice (i) ;
+   WHILE j <= h DO
+      visitNode (v, GetIndice (i, j), p) ;
+      INC (j)
+   END
+END visitIndex ;
+
+
+(*
+   visitRecord -
+*)
+
+PROCEDURE visitRecord (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isRecord (n)) ;
+   visitScope (v, n^.recordF.scope, p) ;
+   visitIndex (v, n^.recordF.listOfSons, p)
+END visitRecord ;
+
+
+(*
+   visitVarient -
+*)
+
+PROCEDURE visitVarient (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitVarient ;
+
+
+(*
+   visitVar -
+*)
+
+PROCEDURE visitVar (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isVar (n)) ;
+   visitNode (v, n^.varF.type, p) ;
+   visitNode (v, n^.varF.decl, p) ;
+   visitScope (v, n^.varF.scope, p)
+END visitVar ;
+
+
+(*
+   visitEnumeration -
+*)
+
+PROCEDURE visitEnumeration (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isEnumeration (n)) ;
+   visitIndex (v, n^.enumerationF.listOfSons, p) ;
+   visitScope (v, n^.enumerationF.scope, p)
+END visitEnumeration ;
+
+
+(*
+   visitSubrange -
+*)
+
+PROCEDURE visitSubrange (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitSubrange ;
+
+
+(*
+   visitPointer -
+*)
+
+PROCEDURE visitPointer (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isPointer (n)) ;
+   visitNode (v, n^.pointerF.type, p) ;
+   visitScope (v, n^.pointerF.scope, p)
+END visitPointer ;
+
+
+(*
+   visitArray -
+*)
+
+PROCEDURE visitArray (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isArray (n)) ;
+   visitNode (v, n^.arrayF.subr, p) ;
+   visitNode (v, n^.arrayF.type, p) ;
+   visitScope (v, n^.arrayF.scope, p)
+END visitArray ;
+
+
+(*
+   visitConst -
+*)
+
+PROCEDURE visitConst (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isConst (n)) ;
+   visitNode (v, n^.constF.type, p) ;
+   visitNode (v, n^.constF.value, p) ;
+   visitScope (v, n^.constF.scope, p)
+END visitConst ;
+
+
+(*
+   visitVarParam -
+*)
+
+PROCEDURE visitVarParam (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isVarParam (n)) ;
+   visitNode (v, n^.varparamF.namelist, p) ;
+   visitNode (v, n^.varparamF.type, p) ;
+   visitScope (v, n^.varparamF.scope, p)
+END visitVarParam ;
+
+
+(*
+   visitParam -
+*)
+
+PROCEDURE visitParam (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isParam (n)) ;
+   visitNode (v, n^.paramF.namelist, p) ;
+   visitNode (v, n^.paramF.type, p) ;
+   visitScope (v, n^.paramF.scope, p)
+END visitParam ;
+
+
+(*
+   visitOptarg -
+*)
+
+PROCEDURE visitOptarg (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitOptarg ;
+
+
+(*
+   visitRecordField -
+*)
+
+PROCEDURE visitRecordField (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitRecordField ;
+
+
+(*
+   visitVarientField -
+*)
+
+PROCEDURE visitVarientField (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitVarientField ;
+
+
+(*
+   visitEnumerationField -
+*)
+
+PROCEDURE visitEnumerationField (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isEnumerationField (n)) ;
+   visitNode (v, n^.enumerationfieldF.type, p) ;
+   visitScope (v, n^.enumerationfieldF.scope, p)
+END visitEnumerationField ;
+
+
+(*
+   visitSet -
+*)
+
+PROCEDURE visitSet (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isSet (n)) ;
+   visitNode (v, n^.setF.type, p) ;
+   visitScope (v, n^.setF.scope, p)
+END visitSet ;
+
+
+(*
+   visitProcType -
+*)
+
+PROCEDURE visitProcType (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitProcType ;
+
+
+(*
+   visitSubscript -
+*)
+
+PROCEDURE visitSubscript (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+(*
+   assert (isSubscript (n)) ;
+   visitNode (v, n^.subscriptF.type, p) ;
+   visitNode (v, n^.subscriptF.expr, p)
+*)
+END visitSubscript ;
+
+
+(*
+   visitDecls -
+*)
+
+PROCEDURE visitDecls (v: alist; s: scopeT; p: nodeProcedure) ;
+BEGIN
+   visitIndex (v, s.constants, p) ;
+   visitIndex (v, s.types, p) ;
+   visitIndex (v, s.procedures, p) ;
+   visitIndex (v, s.variables, p)
+END visitDecls ;
+
+
+(*
+   visitProcedure -
+*)
+
+PROCEDURE visitProcedure (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitProcedure ;
+
+
+(*
+   visitDef -
+*)
+
+PROCEDURE visitDef (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isDef (n)) ;
+   visitDecls (v, n^.defF.decls, p)
+END visitDef ;
+
+
+(*
+   visitImp -
+*)
+
+PROCEDURE visitImp (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isImp (n)) ;
+   visitDecls (v, n^.impF.decls, p) ;
+   visitNode (v, n^.impF.beginStatements, p) ;
+   visitNode (v, n^.impF.finallyStatements, p)
+   (* --fixme-- do we need to visit definitionModule?  *)
+END visitImp ;
+
+
+(*
+   visitModule -
+*)
+
+PROCEDURE visitModule (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isModule (n)) ;
+   visitDecls (v, n^.moduleF.decls, p) ;
+   visitNode (v, n^.moduleF.beginStatements, p) ;
+   visitNode (v, n^.moduleF.finallyStatements, p)
+END visitModule ;
+
+
+(*
+   visitLoop -
+*)
+
+PROCEDURE visitLoop (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isLoop (n)) ;
+   visitNode (v, n^.loopF.statements, p)
+END visitLoop ;
+
+
+(*
+   visitWhile -
+*)
+
+PROCEDURE visitWhile (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isWhile (n)) ;
+   visitNode (v, n^.whileF.expr, p) ;
+   visitNode (v, n^.whileF.statements, p)
+END visitWhile ;
+
+
+(*
+   visitRepeat -
+*)
+
+PROCEDURE visitRepeat (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isRepeat (n)) ;
+   visitNode (v, n^.repeatF.expr, p) ;
+   visitNode (v, n^.repeatF.statements, p)
+END visitRepeat ;
+
+
+(*
+   visitCase -
+*)
+
+PROCEDURE visitCase (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isCase (n)) ;
+   visitNode (v, n^.caseF.expression, p) ;
+   visitIndex (v, n^.caseF.caseLabelList, p) ;
+   visitNode (v, n^.caseF.else, p)
+END visitCase ;
+
+
+(*
+   visitCaseLabelList -
+*)
+
+PROCEDURE visitCaseLabelList (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isCaseLabelList (n)) ;
+   visitNode (v, n^.caselabellistF.caseList, p) ;
+   visitNode (v, n^.caselabellistF.statements, p)
+END visitCaseLabelList ;
+
+
+(*
+   visitCaseList -
+*)
+
+PROCEDURE visitCaseList (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isCaseList (n)) ;
+   visitIndex (v, n^.caselistF.rangePairs, p)
+END visitCaseList ;
+
+
+(*
+   visitRange -
+*)
+
+PROCEDURE visitRange (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isRange (n)) ;
+   visitNode (v, n^.rangeF.lo, p) ;
+   visitNode (v, n^.rangeF.hi, p)
+END visitRange ;
+
+
+(*
+   visitIf -
+*)
+
+PROCEDURE visitIf (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitIf ;
+
+
+(*
+   visitElsif -
+*)
+
+PROCEDURE visitElsif (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitElsif ;
+
+
+(*
+   visitFor -
+*)
+
+PROCEDURE visitFor (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (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)
+END visitFor ;
+
+
+(*
+   visitAssignment -
+*)
+
+PROCEDURE visitAssignment (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isAssignment (n)) ;
+   visitNode (v, n^.assignmentF.des, p) ;
+   visitNode (v, n^.assignmentF.expr, p)
+END visitAssignment ;
+
+
+(*
+   visitComponentRef -
+*)
+
+PROCEDURE visitComponentRef (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isComponentRef (n)) ;
+   visitNode (v, n^.componentrefF.rec, p) ;
+   visitNode (v, n^.componentrefF.field, p) ;
+   visitNode (v, n^.componentrefF.resultType, p)
+END visitComponentRef ;
+
+
+(*
+   visitPointerRef -
+*)
+
+PROCEDURE visitPointerRef (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isPointerRef (n)) ;
+   visitNode (v, n^.pointerrefF.ptr, p) ;
+   visitNode (v, n^.pointerrefF.field, p) ;
+   visitNode (v, n^.pointerrefF.resultType, p)
+END visitPointerRef ;
+
+
+(*
+   visitArrayRef -
+*)
+
+PROCEDURE visitArrayRef (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isArrayRef (n)) ;
+   visitNode (v, n^.arrayrefF.array, p) ;
+   visitNode (v, n^.arrayrefF.index, p) ;
+   visitNode (v, n^.arrayrefF.resultType, p)
+END visitArrayRef ;
+
+
+(*
+   visitFunccall -
+*)
+
+PROCEDURE visitFunccall (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isFuncCall (n)) ;
+   visitNode (v, n^.funccallF.function, p) ;
+   visitNode (v, n^.funccallF.args, p) ;
+   visitNode (v, n^.funccallF.type, p)
+END visitFunccall ;
+
+
+(*
+   visitVarDecl -
+*)
+
+PROCEDURE visitVarDecl (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isVarDecl (n)) ;
+   visitNode (v, n^.vardeclF.type, p) ;
+   visitScope (v, n^.vardeclF.scope, p)
+END visitVarDecl ;
+
+
+(*
+   visitExplist -
+*)
+
+PROCEDURE visitExplist (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isExpList (n)) ;
+   visitIndex (v, n^.explistF.exp, p)
+END visitExplist ;
+
+
+(*
+   visitExit -
+*)
+
+PROCEDURE visitExit (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isExit (n)) ;
+   visitNode (v, n^.exitF.loop, p)
+END visitExit ;
+
+
+(*
+   visitReturn -
+*)
+
+PROCEDURE visitReturn (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isReturn (n)) ;
+   visitNode (v, n^.returnF.exp, p)
+END visitReturn ;
+
+
+(*
+   visitStmtSeq -
+*)
+
+PROCEDURE visitStmtSeq (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isStatementSequence (n)) ;
+   visitIndex (v, n^.stmtF.statements, p)
+END visitStmtSeq ;
+
+
+(*
+   visitVarargs -
+*)
+
+PROCEDURE visitVarargs (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isVarargs (n)) ;
+   visitScope (v, n^.varargsF.scope, p)
+END visitVarargs ;
+
+
+(*
+   visitSetValue -
+*)
+
+PROCEDURE visitSetValue (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isSetValue (n)) ;
+   visitNode (v, n^.setvalueF.type, p) ;
+   visitIndex (v, n^.setvalueF.values, p)
+END visitSetValue ;
+
+
+(*
+   visitIntrinsic -
+*)
+
+PROCEDURE visitIntrinsic (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (isIntrinsic (n)) ;
+   visitNode (v, n^.intrinsicF.args, p)
+END visitIntrinsic ;
+
+
+(*
+   visitDependants - helper procedure function called from visitNode.
+                     node n has just been visited, this procedure will
+                     visit node, n, dependants.
+*)
+
+PROCEDURE visitDependants (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   assert (n # NIL) ;
+   assert (alists.isItemInList (v, n)) ;
+   CASE n^.kind OF
+
+   explist         :  visitExplist (v, n, p) |
+   funccall        :  visitFunccall (v, n, p) |
+   exit            :  visitExit (v, n, p) |
+   return          :  visitReturn (v, n, p) |
+   stmtseq         :  visitStmtSeq (v, n, p) |
+   comment         :  |
+   length          :  visitIntrinsicFunction (v, n, p) |
+   unreachable,
+   throw,
+   halt,
+   new,
+   dispose,
+   inc,
+   dec,
+   incl,
+   excl            :  visitIntrinsic (v, n, p) |
+   boolean         :  visitBoolean (v, n, p) |
+   nil,
+   false,
+   true            :  |
+   varargs         :  visitVarargs (v, n, p) |
+   address,
+   loc,
+   byte,
+   word,
+   csizet,
+   cssizet,
+   (* base types.  *)
+   char,
+   cardinal,
+   longcard,
+   shortcard,
+   integer,
+   longint,
+   shortint,
+   real,
+   longreal,
+   shortreal,
+   bitset,
+   ztype,
+   rtype,
+   complex,
+   longcomplex,
+   shortcomplex,
+   proc            :  |
+   (* language features and compound type attributes.  *)
+   type            :  visitType (v, n, p) |
+   record          :  visitRecord (v, n, p) |
+   varient         :  visitVarient (v, n, p) |
+   var             :  visitVar (v, n, p) |
+   enumeration     :  visitEnumeration (v, n, p) |
+   subrange        :  visitSubrange (v, n, p) |
+   pointer         :  visitPointer (v, n, p) |
+   array           :  visitArray (v, n, p) |
+   string          :  |
+   const           :  visitConst (v, n, p) |
+   literal         :  |
+   varparam        :  visitVarParam (v, n, p) |
+   param           :  visitParam (v, n, p) |
+   optarg          :  visitOptarg (v, n, p) |
+   recordfield     :  visitRecordField (v, n, p) |
+   varientfield    :  visitVarientField (v, n, p) |
+   enumerationfield:  visitEnumerationField (v, n, p) |
+   set             :  visitSet (v, n, p) |
+   proctype        :  visitProcType (v, n, p) |
+   subscript       :  visitSubscript (v, n, p) |
+   (* blocks.  *)
+   procedure       :  visitProcedure (v, n, p) |
+   def             :  visitDef (v, n, p) |
+   imp             :  visitImp (v, n, p) |
+   module          :  visitModule (v, n, p) |
+   (* statements.  *)
+   loop            :  visitLoop (v, n, p) |
+   while           :  visitWhile (v, n, p) |
+   for             :  visitFor (v, n, p) |
+   repeat          :  visitRepeat (v, n, p) |
+   case            :  visitCase (v, n, p) |
+   caselabellist   :  visitCaseLabelList (v, n, p) |
+   caselist        :  visitCaseList (v, n, p) |
+   range           :  visitRange (v, n, p) |
+   if              :  visitIf (v, n, p) |
+   elsif           :  visitElsif (v, n, p) |
+   assignment      :  visitAssignment (v, n, p) |
+   (* expressions.  *)
+   componentref    :  visitComponentRef (v, n, p) |
+   pointerref      :  visitPointerRef (v, n, p) |
+   arrayref        :  visitArrayRef (v, n, p) |
+   cmplx,
+   equal,
+   notequal,
+   less,
+   greater,
+   greequal,
+   lessequal,
+   and,
+   or,
+   in,
+   cast,
+   val,
+   plus,
+   sub,
+   div,
+   mod,
+   mult,
+   divide         :  visitBinary (v, n, p) |
+   re             :  visitUnary (v, n, p) |
+   im             :  visitUnary (v, n, p) |
+   abs            :  visitUnary (v, n, p) |
+   chr            :  visitUnary (v, n, p) |
+   cap            :  visitUnary (v, n, p) |
+   high           :  visitUnary (v, n, p) |
+   ord            :  visitUnary (v, n, p) |
+   float          :  visitUnary (v, n, p) |
+   trunc          :  visitUnary (v, n, p) |
+   not            :  visitUnary (v, n, p) |
+   neg            :  visitUnary (v, n, p) |
+   adr            :  visitUnary (v, n, p) |
+   size           :  visitUnary (v, n, p) |
+   tsize          :  visitUnary (v, n, p) |
+   min            :  visitUnary (v, n, p) |
+   max            :  visitUnary (v, n, p) |
+   constexp       :  visitUnary (v, n, p) |
+   deref          :  visitUnary (v, n, p) |
+   identlist      :  |
+   vardecl        :  visitVarDecl (v, n, p) |
+   setvalue       :  visitSetValue (v, n, p)
+
+   END
+END visitDependants ;
+
+
+(*
+   visitNode - visits node, n, if it is not already in the alist, v.
+               It calls p(n) if the node is unvisited.
+*)
+
+PROCEDURE visitNode (v: alist; n: node; p: nodeProcedure) ;
+BEGIN
+   IF (n#NIL) AND (NOT alists.isItemInList (v, n))
+   THEN
+      alists.includeItemIntoList (v, n) ;
+      p (n) ;
+      visitDependants (v, n, p)
+   END
+END visitNode ;
+
+
+(*
+   genKind - returns a string depending upon the kind of node, n.
+*)
+
+PROCEDURE genKind (n: node) : String ;
+BEGIN
+   CASE n^.kind OF
+
+   (* types, no need to generate a kind string as it it contained in the name.  *)
+   nil,
+   true,
+   false,
+   address,
+   loc,
+   byte,
+   word,
+   csizet,
+   cssizet,
+   char,
+   cardinal,
+   longcard,
+   shortcard,
+   integer,
+   longint,
+   shortint,
+   real,
+   longreal,
+   shortreal,
+   bitset,
+   boolean,
+   proc,
+   ztype,
+   rtype,
+   complex,
+   longcomplex,
+   shortcomplex    :  RETURN NIL |
+
+   (* language features and compound type attributes.  *)
+   type            :  RETURN InitString ('type') |
+   record          :  RETURN InitString ('record') |
+   varient         :  RETURN InitString ('varient') |
+   var             :  RETURN InitString ('var') |
+   enumeration     :  RETURN InitString ('enumeration') |
+   subrange        :  RETURN InitString ('subrange') |
+   array           :  RETURN InitString ('array') |
+   subscript       :  RETURN InitString ('subscript') |
+   string          :  RETURN InitString ('string') |
+   const           :  RETURN InitString ('const') |
+   literal         :  RETURN InitString ('literal') |
+   varparam        :  RETURN InitString ('varparam') |
+   param           :  RETURN InitString ('param') |
+   varargs         :  RETURN InitString ('varargs') |
+   pointer         :  RETURN InitString ('pointer') |
+   recordfield     :  RETURN InitString ('recordfield') |
+   varientfield    :  RETURN InitString ('varientfield') |
+   enumerationfield:  RETURN InitString ('enumerationfield') |
+   set             :  RETURN InitString ('set') |
+   proctype        :  RETURN InitString ('proctype') |
+   (* blocks.  *)
+   procedure       :  RETURN InitString ('procedure') |
+   def             :  RETURN InitString ('def') |
+   imp             :  RETURN InitString ('imp') |
+   module          :  RETURN InitString ('module') |
+   (* statements.  *)
+   loop            :  RETURN InitString ('loop') |
+   while           :  RETURN InitString ('while') |
+   for             :  RETURN InitString ('for') |
+   repeat          :  RETURN InitString ('repeat') |
+   assignment      :  RETURN InitString ('assignment') |
+   if              :  RETURN InitString ('if') |
+   elsif           :  RETURN InitString ('elsif') |
+   (* expressions.  *)
+   constexp        :  RETURN InitString ('constexp') |
+   neg             :  RETURN InitString ('neg') |
+   cast            :  RETURN InitString ('cast') |
+   val             :  RETURN InitString ('val') |
+   plus            :  RETURN InitString ('plus') |
+   sub             :  RETURN InitString ('sub') |
+   div             :  RETURN InitString ('div') |
+   mod             :  RETURN InitString ('mod') |
+   mult            :  RETURN InitString ('mult') |
+   divide          :  RETURN InitString ('divide') |
+   adr             :  RETURN InitString ('adr') |
+   size            :  RETURN InitString ('size') |
+   tsize           :  RETURN InitString ('tsize') |
+   chr             :  RETURN InitString ('chr') |
+   ord             :  RETURN InitString ('ord') |
+   float           :  RETURN InitString ('float') |
+   trunc           :  RETURN InitString ('trunc') |
+   high            :  RETURN InitString ('high') |
+   componentref    :  RETURN InitString ('componentref') |
+   pointerref      :  RETURN InitString ('pointerref') |
+   arrayref        :  RETURN InitString ('arrayref') |
+   deref           :  RETURN InitString ('deref') |
+   equal           :  RETURN InitString ('equal') |
+   notequal        :  RETURN InitString ('notequal') |
+   less            :  RETURN InitString ('less') |
+   greater         :  RETURN InitString ('greater') |
+   greequal        :  RETURN InitString ('greequal') |
+   lessequal       :  RETURN InitString ('lessequal') |
+   lsl             :  RETURN InitString ('lsl') |
+   lsr             :  RETURN InitString ('lsr') |
+   lor             :  RETURN InitString ('lor') |
+   land            :  RETURN InitString ('land') |
+   lnot            :  RETURN InitString ('lnot') |
+   lxor            :  RETURN InitString ('lxor') |
+   and             :  RETURN InitString ('and') |
+   or              :  RETURN InitString ('or') |
+   not             :  RETURN InitString ('not') |
+   identlist       :  RETURN InitString ('identlist') |
+   vardecl         :  RETURN InitString ('vardecl')
+
+   END ;
+   HALT
+END genKind ;
+
+
+(*
+   gen - generate a small string describing node, n.
+*)
+
+PROCEDURE gen (n: node) : String ;
+VAR
+   s: String ;
+   d: CARDINAL ;
+BEGIN
+   d := VAL (CARDINAL, VAL (LONGCARD, n)) ;
+   s := Sprintf1 (InitString ('< %d '), d) ;  (* use 0x%x once FormatStrings has been released.  *)
+   s := ConCat (s, genKind (n)) ;
+   s := ConCat (s, InitString (' ')) ;
+   s := ConCat (s, getFQstring (n)) ;
+   s := ConCat (s, InitString (' >')) ;
+   RETURN s
+END gen ;
+
+
+(*
+   dumpQ -
+*)
+
+PROCEDURE dumpQ (q: ARRAY OF CHAR; l: alist) ;
+VAR
+   m   : String ;
+   n   : node ;
+   d,
+   h, i: CARDINAL ;
+BEGIN
+   m := Sprintf0 (InitString ('Queue ')) ;
+   m := KillString (WriteS (StdOut, m)) ;
+   m := Sprintf0 (InitString (q)) ;
+   m := KillString (WriteS (StdOut, m)) ;
+   m := Sprintf0 (InitString ('\n')) ;
+   m := KillString (WriteS (StdOut, m)) ;
+   i := 1 ;
+   h := alists.noOfItemsInList (l) ;
+   WHILE i<=h DO
+      n := alists.getItemFromList (l, i) ;
+      m := KillString (WriteS (StdOut, gen (n))) ;
+      INC (i)
+   END ;
+   m := Sprintf0 (InitString ('\n')) ;
+   m := KillString (WriteS (StdOut, m))
+END dumpQ ;
+
+
+(*
+   dumpLists -
+*)
+
+PROCEDURE dumpLists ;
+VAR
+   m: String ;
+BEGIN
+   IF getDebugTopological ()
+   THEN
+      m := Sprintf0 (InitString ('\n')) ;
+      m := KillString (WriteS (StdOut, m)) ;
+      dumpQ ('todo', todoQ) ;
+      dumpQ ('partial', partialQ) ;
+      dumpQ ('done', doneQ)
+   END
+END dumpLists ;
+
+
+(*
+   outputHidden -
+*)
+
+PROCEDURE outputHidden (n: node) ;
+BEGIN
+   outText (doP, "#if !defined (") ; doFQNameC (doP, n) ; outText (doP, "_D)\n") ;
+   outText (doP, "#  define ") ; doFQNameC (doP, n) ; outText (doP, "_D\n") ;
+   outText (doP, "   typedef void *") ; doFQNameC (doP, n) ; outText (doP, ";\n") ;
+   outText (doP, "#endif\n\n")
+END outputHidden ;
+
+
+(*
+   outputHiddenComplete -
+*)
+
+PROCEDURE outputHiddenComplete (n: node) ;
+VAR
+   t: node ;
+BEGIN
+   assert (isType (n)) ;
+   t := getType (n) ;
+   assert (isPointer (t)) ;
+   outText (doP, "#define ") ; doFQNameC (doP, n) ; outText (doP, "_D\n") ;
+   outText (doP, "typedef ") ; doTypeNameC (doP, getType (t)) ;
+   setNeedSpace (doP) ; outText (doP, "*") ; doFQNameC (doP, n) ; outText (doP, ";\n")
+END outputHiddenComplete ;
+
+
+(*
+   tryPartial -
+*)
+(*
+PROCEDURE tryPartial (n: node; pt: nodeProcedure) : BOOLEAN ;
+VAR
+   q          : node ;
+   seenPointer: BOOLEAN ;
+BEGIN
+   IF (n#NIL) AND isType (n)
+   THEN
+      seenPointer := FALSE ;
+      q := getType (n) ;
+      WHILE isPointer (q) DO
+         seenPointer := TRUE ;
+         q := getType (q)
+      END ;
+      IF q # NIL
+      THEN
+         IF isRecord (q) OR isProcType (q)
+         THEN
+            pt (n) ;
+            addTodo (q) ;
+            RETURN TRUE
+         ELSIF isArray (q) AND (seenPointer OR alists.isItemInList (doneQ, getType (q)))
+         THEN
+            pt (n) ;
+            addTodo (q) ;
+            RETURN TRUE
+         ELSIF isType (q) AND seenPointer
+         THEN
+            pt (n) ;
+            addTodo (q) ;
+            RETURN TRUE
+         END
+      END
+   END ;
+   RETURN FALSE
+END tryPartial ;
+*)
+
+
+(*
+   tryPartial -
+*)
+
+PROCEDURE tryPartial (n: node; pt: nodeProcedure) : BOOLEAN ;
+VAR
+   q: node ;
+BEGIN
+   IF (n#NIL) AND isType (n)
+   THEN
+      q := getType (n) ;
+      WHILE isPointer (q) DO
+         q := getType (q)
+      END ;
+      IF q # NIL
+      THEN
+         IF isRecord (q) OR isProcType (q)
+         THEN
+            pt (n) ;
+            addTodo (q) ;
+            RETURN TRUE
+         ELSIF isArray (q)
+         THEN
+            pt (n) ;
+            addTodo (q) ;
+            RETURN TRUE
+         END
+      END
+   END ;
+   RETURN FALSE
+END tryPartial ;
+
+
+(*
+   outputPartialRecordArrayProcType -
+*)
+
+PROCEDURE outputPartialRecordArrayProcType (n, q: node; indirection: CARDINAL) ;
+VAR
+   s: String ;
+BEGIN
+   outText (doP, "typedef struct") ; setNeedSpace (doP) ;
+   s := getFQstring (n) ;
+   IF isRecord (q)
+   THEN
+      s := ConCat (s, Mark (InitString ("_r")))
+   ELSIF isArray (q)
+   THEN
+      s := ConCat (s, Mark (InitString ("_a")))
+   ELSIF isProcType (q)
+   THEN
+      s := ConCat (s, Mark (InitString ("_p")))
+   END ;
+   outTextS (doP, s) ;
+   setNeedSpace (doP) ;
+   s := KillString (s) ;
+   WHILE indirection>0 DO
+      outText (doP, "*") ;
+      DEC (indirection)
+   END ;
+   doFQNameC (doP, n) ;
+   outText (doP, ";\n\n")
+END outputPartialRecordArrayProcType ;
+
+
+(*
+   outputPartial -
+*)
+
+PROCEDURE outputPartial (n: node) ;
+VAR
+   q          : node ;
+   indirection: CARDINAL ;
+BEGIN
+   q := getType (n) ;
+   indirection := 0 ;
+   WHILE isPointer (q) DO
+      q := getType (q) ;
+      INC (indirection)
+   END ;
+   outputPartialRecordArrayProcType (n, q, indirection)
+END outputPartial ;
+
+
+(*
+   tryOutputTodo -
+*)
+
+PROCEDURE tryOutputTodo (c, t, v, pt: nodeProcedure) ;
+VAR
+   i, n: CARDINAL ;
+   d   : node ;
+BEGIN
+   i := 1 ;
+   n := alists.noOfItemsInList (todoQ) ;
+   WHILE i<=n DO
+      d := alists.getItemFromList (todoQ, i) ;
+      IF tryComplete (d, c, t, v)
+      THEN
+         alists.removeItemFromList (todoQ, d) ;
+	 alists.includeItemIntoList (doneQ, d) ;
+         i := 1
+      ELSIF tryPartial (d, pt)
+      THEN
+         alists.removeItemFromList (todoQ, d) ;
+         alists.includeItemIntoList (partialQ, d) ;
+         i := 1
+      ELSE
+         INC (i)
+      END ;
+      n := alists.noOfItemsInList (todoQ)
+   END
+END tryOutputTodo ;
+
+
+(*
+   tryOutputPartial -
+*)
+
+PROCEDURE tryOutputPartial (t: nodeProcedure) ;
+VAR
+   i, n: CARDINAL ;
+   d   : node ;
+BEGIN
+   i := 1 ;
+   n := alists.noOfItemsInList (partialQ) ;
+   WHILE i<=n DO
+      d := alists.getItemFromList (partialQ, i) ;
+      IF tryCompleteFromPartial (d, t)
+      THEN
+         alists.removeItemFromList (partialQ, d) ;
+         alists.includeItemIntoList (doneQ, d) ;
+         i := 1 ;
+         DEC (n)
+      ELSE
+         INC (i)
+      END
+   END
+END tryOutputPartial ;
+
+
+(*
+   debugList -
+*)
+
+PROCEDURE debugList (a: ARRAY OF CHAR; l: alist) ;
+VAR
+   i, h: CARDINAL ;
+   n   : node ;
+BEGIN
+   h := alists.noOfItemsInList (l) ;
+   IF h>0
+   THEN
+      outText (doP, a) ;
+      outText (doP, ' still contains node(s)\n') ;
+      i := 1 ;
+      REPEAT
+         n := alists.getItemFromList (l, i) ;
+         dbg (n) ;
+         INC (i)
+      UNTIL i > h
+   END
+END debugList ;
+
+
+(*
+   debugLists -
+*)
+
+PROCEDURE debugLists ;
+BEGIN
+   IF getDebugTopological ()
+   THEN
+      debugList ('todo', todoQ) ;
+      debugList ('partial', partialQ)
+   END
+END debugLists ;
+
+
+(*
+   addEnumConst -
+*)
+
+PROCEDURE addEnumConst (n: node) ;
+VAR
+   s: String ;
+BEGIN
+   IF isConst (n) OR isEnumeration (n)
+   THEN
+      addTodo (n)
+   END
+END addEnumConst ;
+
+
+(*
+   populateTodo -
+*)
+
+PROCEDURE populateTodo (p: nodeProcedure) ;
+VAR
+   n   : node ;
+   i, h: CARDINAL ;
+   l   : alist ;
+BEGIN
+   h := alists.noOfItemsInList (todoQ) ;
+   i := 1 ;
+   WHILE i <= h DO
+      n := alists.getItemFromList (todoQ, i) ;
+      l := alists.initList () ;
+      visitNode (l, n, p) ;
+      alists.killList (l) ;
+      h := alists.noOfItemsInList (todoQ) ;
+      INC (i)
+   END
+END populateTodo ;
+
+
+(*
+   topologicallyOut -
+*)
+
+PROCEDURE topologicallyOut (c, t, v, tp,
+                            pc, pt, pv: nodeProcedure) ;
+VAR
+   tol, pal,
+   to,  pa : CARDINAL ;
+BEGIN
+   populateTodo (addEnumConst) ;
+   tol := 0 ;
+   pal := 0 ;
+   to := alists.noOfItemsInList (todoQ) ;
+   pa := alists.noOfItemsInList (partialQ) ;
+   WHILE (tol#to) OR (pal#pa) DO
+      dumpLists ;
+      tryOutputTodo (c, t, v, tp) ;
+      dumpLists ;
+      tryOutputPartial (pt) ;
+      tol := to ;
+      pal := pa ;
+      to := alists.noOfItemsInList (todoQ) ;
+      pa := alists.noOfItemsInList (partialQ)
+   END ;
+   dumpLists ;
+   debugLists
+END topologicallyOut ;
+
+
+(*
+   scaffoldStatic -
+*)
+
+PROCEDURE scaffoldStatic (p: pretty; n: node) ;
+BEGIN
+   outText (p, "\n") ;
+   doExternCP (p) ;
+   outText (p, "void") ;
+   setNeedSpace (p) ;
+   outText (p, "_M2_") ;
+   doFQNameC (p, n) ;
+   outText (p, "_init") ;
+   setNeedSpace (p) ;
+   outText (p, "(__attribute__((unused)) int argc") ;
+   outText (p, ",__attribute__((unused)) char *argv[]") ;
+   outText (p, ",__attribute__((unused)) char *envp[])\n");
+   p := outKc (p, "{\n") ;
+   doStatementsC (p, n^.impF.beginStatements) ;
+   p := outKc (p, "}\n") ;
+   outText (p, "\n") ;
+   doExternCP (p) ;
+   outText (p, "void") ;
+   setNeedSpace (p) ;
+   outText (p, "_M2_") ;
+   doFQNameC (p, n) ;
+   outText (p, "_finish") ;
+   setNeedSpace (p) ;
+   outText (p, "(__attribute__((unused)) int argc") ;
+   outText (p, ",__attribute__((unused)) char *argv[]") ;
+   outText (p, ",__attribute__((unused)) char *envp[])\n");
+   p := outKc (p, "{\n") ;
+   doStatementsC (p, n^.impF.finallyStatements) ;
+   p := outKc (p, "}\n")
+END scaffoldStatic ;
+
+
+(*
+   emitCtor -
+*)
+
+PROCEDURE emitCtor (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   outText (p, "\n") ;
+   outText (p, "static void") ;
+   setNeedSpace (p) ;
+   outText (p, "ctorFunction ()\n") ;
+   doFQNameC (p, n) ;
+   p := outKc (p, "{\n") ;
+   outText (p, 'M2RTS_RegisterModule ("') ;
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   prints (p, s) ;
+   outText (p, '",\n') ;
+   outText (p, 'init, fini, dependencies);\n') ;
+   p := outKc (p, "}\n\n") ;
+   p := outKc (p, "struct ") ;
+   prints (p, s) ;
+   p := outKc (p, "_module_m2 { ") ;
+   prints (p, s) ;
+   p := outKc (p, "_module_m2 (); ~") ;
+   prints (p, s) ;
+   p := outKc (p, "_module_m2 (); } global_module_") ;
+   prints (p, s) ;
+   outText (p, ';\n\n') ;
+   prints (p, s) ;
+   p := outKc (p, "_module_m2::") ;
+   prints (p, s) ;
+   p := outKc (p, "_module_m2 ()\n") ;
+   p := outKc (p, "{\n") ;
+   outText (p, 'M2RTS_RegisterModule ("') ;
+   prints (p, s) ;
+   outText (p, '", init, fini, dependencies);') ;
+   p := outKc (p, "}\n") ;
+   prints (p, s) ;
+   p := outKc (p, "_module_m2::~") ;
+   prints (p, s) ;
+   p := outKc (p, "_module_m2 ()\n") ;
+   p := outKc (p, "{\n") ;
+   p := outKc (p, "}\n") ;
+   s := KillString (s)
+END emitCtor ;
+
+
+(*
+   scaffoldDynamic -
+*)
+
+PROCEDURE scaffoldDynamic (p: pretty; n: node) ;
+BEGIN
+   outText (p, "\n") ;
+   doExternCP (p) ;
+   outText (p, "void") ;
+   setNeedSpace (p) ;
+   outText (p, "_M2_") ;
+   doFQNameC (p, n) ;
+   outText (p, "_init") ;
+   setNeedSpace (p) ;
+   outText (p, "(__attribute__((unused)) int argc,") ;
+   outText (p, " __attribute__((unused)) char *argv[]") ;
+   outText (p, " __attribute__((unused)) char *envp[])\n") ;
+   p := outKc (p, "{\n") ;
+   doStatementsC (p, n^.impF.beginStatements) ;
+   p := outKc (p, "}\n") ;
+   outText (p, "\n") ;
+   doExternCP (p) ;
+   outText (p, "void") ;
+   setNeedSpace (p) ;
+   outText (p, "_M2_") ;
+   doFQNameC (p, n) ;
+   outText (p, "_fini") ;
+   setNeedSpace (p) ;
+   outText (p, "(__attribute__((unused)) int argc,") ;
+   outText (p, " __attribute__((unused)) char *argv[]") ;
+   outText (p, " __attribute__((unused)) char *envp[])\n") ;
+   p := outKc (p, "{\n") ;
+   doStatementsC (p, n^.impF.finallyStatements) ;
+   p := outKc (p, "}\n") ;
+   emitCtor (p, n)
+END scaffoldDynamic ;
+
+
+(*
+   scaffoldMain -
+*)
+
+PROCEDURE scaffoldMain (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   outText (p, "int\n") ;
+   outText (p, "main") ;
+   setNeedSpace (p) ;
+   outText (p, "(int argc, char *argv[], char *envp[])\n") ;
+   p := outKc (p, "{\n") ;
+   outText (p, "M2RTS_ConstructModules (") ;
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   prints (p, s) ;
+   outText (p, ", argc, argv, envp);\n");
+   outText (p, "M2RTS_DeconstructModules (") ;
+   prints (p, s) ;
+   outText (p, ", argc, argv, envp);\n");
+   outText (p, "return 0;") ;
+   p := outKc (p, "}\n") ;
+   s := KillString (s)
+END scaffoldMain ;
+
+
+(*
+   outImpInitC - emit the init/fini functions and main function if required.
+*)
+
+PROCEDURE outImpInitC (p: pretty; n: node) ;
+BEGIN
+   IF getScaffoldDynamic ()
+   THEN
+      scaffoldDynamic (p, n)
+   ELSE
+      scaffoldStatic (p, n)
+   END ;
+   IF getScaffoldMain ()
+   THEN
+      scaffoldMain (p, n)
+   END
+END outImpInitC ;
+
+
+(*
+   runSimplifyTypes -
+*)
+
+PROCEDURE runSimplifyTypes (n: node) ;
+BEGIN
+   IF isImp (n)
+   THEN
+      simplifyTypes (n^.impF.decls)
+   ELSIF isModule (n)
+   THEN
+      simplifyTypes (n^.moduleF.decls)
+   ELSIF isDef (n)
+   THEN
+      simplifyTypes (n^.defF.decls)
+   END
+END runSimplifyTypes ;
+
+
+(*
+   outDefC -
+*)
+
+PROCEDURE outDefC (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   assert (isDef (n)) ;
+   outputFile := mcStream.openFrag (1) ;  (* first fragment.  *)
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   print (p, "/* do not edit automatically generated by mc from ") ;
+   prints (p, s) ; print (p, ".  */\n") ;
+   writeGPLheader (outputFile) ;
+   doCommentC (p, n^.defF.com.body) ;
+   print (p, "\n\n#if !defined (_") ; prints (p, s) ; print (p, "_H)\n") ;
+   print (p, "#   define _") ; prints (p, s) ; print (p, "_H\n\n") ;
+
+   keyc.genConfigSystem (p) ;
+
+   print (p, "#   ifdef __cplusplus\n") ;
+   print (p, 'extern "C" {\n') ;
+   print (p, "#   endif\n") ;
+
+   outputFile := mcStream.openFrag (3) ;  (* third fragment.  *)
+
+   doP := p ;
+   ForeachIndiceInIndexDo (n^.defF.importedModules, doIncludeC) ;
+
+   print (p, "\n") ;
+   print (p, "#   if defined (_") ; prints (p, s) ; print (p, "_C)\n") ;
+   print (p, "#      define EXTERN\n") ;
+   print (p, "#   else\n") ;
+   print (p, '#      define EXTERN extern\n') ;
+   print (p, "#   endif\n\n") ;
+
+   outDeclsDefC (p, n) ;
+   runPrototypeDefC (n) ;
+
+   print (p, "#   ifdef __cplusplus\n") ;
+   print (p, "}\n") ;
+   print (p, "#   endif\n") ;
+
+   print (p, "\n") ;
+   print (p, "#   undef EXTERN\n") ;
+   print (p, "#endif\n") ;
+
+   outputFile := mcStream.openFrag (2) ;  (* second fragment.  *)
+   keyc.genDefs (p) ;
+
+   s := KillString (s)
+END outDefC ;
+
+
+(*
+   runPrototypeExported -
+*)
+
+PROCEDURE runPrototypeExported (n: node) ;
+BEGIN
+   IF isExported (n)
+   THEN
+      keyc.enterScope (n) ;
+      doProcedureHeadingC (n, TRUE) ;
+      print (doP, ";\n") ;
+      keyc.leaveScope (n)
+   END
+END runPrototypeExported ;
+
+
+(*
+   runPrototypeDefC -
+*)
+
+PROCEDURE runPrototypeDefC (n: node) ;
+BEGIN
+   IF isDef (n)
+   THEN
+      ForeachIndiceInIndexDo (n^.defF.decls.procedures, runPrototypeExported)
+   END
+END runPrototypeDefC ;
+
+
+(*
+   outImpC -
+*)
+
+PROCEDURE outImpC (p: pretty; n: node) ;
+VAR
+   s        : String ;
+   defModule: node ;
+BEGIN
+   assert (isImp (n)) ;
+   outputFile := mcStream.openFrag (1) ;  (* first fragment.  *)
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   print (p, "/* do not edit automatically generated by mc from ") ;
+   prints (p, s) ; print (p, ".  */\n") ;
+   writeGPLheader (outputFile) ;
+   doCommentC (p, n^.impF.com.body) ;
+   outText (p, "\n") ;
+   outputFile := mcStream.openFrag (3) ;  (* third fragment.  *)
+   IF getExtendedOpaque ()
+   THEN
+      doP := p ;
+      (* ForeachIndiceInIndexDo (n^.impF.importedModules, doIncludeC) ; *)
+
+      includeExternals (n) ;
+      foreachModuleDo (n, runSimplifyTypes) ;
+      printf ("/*  --extended-opaque seen therefore no #include will be used and everything will be declared in full.  */\n") ;
+      foreachDefModuleDo (runIncludeDefConstType) ;
+      includeDefVarProcedure (n) ;
+      outDeclsImpC (p, n^.impF.decls) ;
+      foreachDefModuleDo (runPrototypeDefC)
+   ELSE
+      s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+      (* we don't want to include the .h file for this implementation module.  *)
+      print (p, "#define _") ; prints (p, s) ; print (p, "_H\n") ;
+      print (p, "#define _") ; prints (p, s) ; print (p, "_C\n\n") ;
+      s := KillString (s) ;
+
+      doP := p ;
+      ForeachIndiceInIndexDo (n^.impF.importedModules, doIncludeC) ;
+      print (p, "\n") ;
+      includeDefConstType (n) ;
+      includeDefVarProcedure (n) ;
+      outDeclsImpC (p, n^.impF.decls) ;
+
+      defModule := lookupDef (getSymName (n)) ;
+      IF defModule # NIL
+      THEN
+         runPrototypeDefC (defModule)
+      END
+   END ;
+
+   ForeachIndiceInIndexDo (n^.impF.decls.procedures, doPrototypeC) ;
+
+   outProceduresC (p, n^.impF.decls) ;
+   outImpInitC (p, n) ;
+
+   outputFile := mcStream.openFrag (2) ;  (* second fragment.  *)
+   keyc.genConfigSystem (p) ;
+   keyc.genDefs (p)
+END outImpC ;
+
+
+(*
+   outDeclsModuleC -
+*)
+
+PROCEDURE outDeclsModuleC (p: pretty; s: scopeT) ;
+BEGIN
+   simplifyTypes (s) ;
+   includeConstType (s) ;
+
+   doP := p ;
+
+   topologicallyOut (doConstC, doTypesC, doVarC,
+                     outputPartial,
+                     doNone, doCompletePartialC, doNone) ;
+
+   (* try and output types, constants before variables and procedures.  *)
+   includeVarProcedure (s) ;
+
+   topologicallyOut (doConstC, doTypesC, doVarC,
+                     outputPartial,
+                     doNone, doCompletePartialC, doNone) ;
+
+   ForeachIndiceInIndexDo (s.procedures, doPrototypeC)
+END outDeclsModuleC ;
+
+
+(*
+   outModuleInitC -
+*)
+
+PROCEDURE outModuleInitC (p: pretty; n: node) ;
+BEGIN
+   outText (p, "\n") ;
+   doExternCP (p) ;
+   outText (p, "void") ;
+   setNeedSpace (p) ;
+   outText (p, "_M2_") ;
+   doFQNameC (p, n) ;
+   outText (p, "_init") ;
+   setNeedSpace (p) ;
+   outText (p, "(__attribute__((unused)) int argc") ;
+   outText (p, ",__attribute__((unused)) char *argv[]") ;
+   outText (p, ",__attribute__((unused)) char *envp[])\n");
+   p := outKc (p, "{\n") ;
+   doStatementsC (p, n^.moduleF.beginStatements) ;
+   p := outKc (p, "}\n") ;
+   outText (p, "\n") ;
+   doExternCP (p) ;
+   outText (p, "void") ;
+   setNeedSpace (p) ;
+   outText (p, "_M2_") ;
+   doFQNameC (p, n) ;
+   outText (p, "_finish") ;
+   setNeedSpace (p) ;
+   outText (p, "(__attribute__((unused)) int argc") ;
+   outText (p, ",__attribute__((unused)) char *argv[]") ;
+   outText (p, ",__attribute__((unused)) char *envp[])\n");
+   p := outKc (p, "{\n") ;
+   doStatementsC (p, n^.moduleF.finallyStatements) ;
+   p := outKc (p, "}\n")
+END outModuleInitC ;
+
+
+(*
+   outModuleC -
+*)
+
+PROCEDURE outModuleC (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   assert (isModule (n)) ;
+   outputFile := mcStream.openFrag (1) ;  (* first fragment.  *)
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   print (p, "/* do not edit automatically generated by mc from ") ;
+   prints (p, s) ; print (p, ".  */\n") ;
+   writeGPLheader (outputFile) ;
+   doCommentC (p, n^.moduleF.com.body) ;
+   outText (p, "\n") ;
+   outputFile := mcStream.openFrag (3) ;  (* third fragment.  *)
+   IF getExtendedOpaque ()
+   THEN
+      doP := p ;
+      includeExternals (n) ;
+      foreachModuleDo (n, runSimplifyTypes) ;
+      printf ("/*  --extended-opaque seen therefore no #include will be used and everything will be declared in full.  */\n") ;
+      foreachDefModuleDo (runIncludeDefConstType) ;
+      outDeclsModuleC (p, n^.moduleF.decls) ;
+      foreachDefModuleDo (runPrototypeDefC)
+   ELSE
+      doP := p ;
+      ForeachIndiceInIndexDo (n^.moduleF.importedModules, doIncludeC) ;
+      print (p, "\n") ;
+      outDeclsModuleC (p, n^.moduleF.decls)
+   END ;
+
+   ForeachIndiceInIndexDo (n^.moduleF.decls.procedures, doPrototypeC) ;
+
+   outProceduresC (p, n^.moduleF.decls) ;
+   outModuleInitC (p, n) ;
+
+   outputFile := mcStream.openFrag (2) ;  (* second fragment.  *)
+   keyc.genConfigSystem (p) ;
+   keyc.genDefs (p)
+END outModuleC ;
+
+
+(*
+   outC -
+*)
+
+PROCEDURE outC (p: pretty; n: node) ;
+BEGIN
+   keyc.enterScope (n) ;
+   IF isDef (n)
+   THEN
+      outDefC (p, n)
+   ELSIF isImp (n)
+   THEN
+      outImpC (p, n)
+   ELSIF isModule (n)
+   THEN
+      outModuleC (p, n)
+   ELSE
+      HALT
+   END ;
+   keyc.leaveScope (n)
+END outC ;
+
+
+(*
+   doIncludeM2 - include modules in module, n.
+*)
+
+PROCEDURE doIncludeM2 (n: node) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   print (doP, 'IMPORT ') ;
+   prints (doP, s) ;
+   print (doP, ' ;\n') ;
+   s := KillString (s) ;
+
+   IF isDef (n)
+   THEN
+      foreachNodeDo (n^.defF.decls.symbols, addDone)
+   ELSIF isImp (n)
+   THEN
+      foreachNodeDo (n^.impF.decls.symbols, addDone)
+   ELSIF isModule (n)
+   THEN
+      foreachNodeDo (n^.moduleF.decls.symbols, addDone)
+   END
+END doIncludeM2 ;
+
+
+(*
+   doConstM2 -
+*)
+
+PROCEDURE doConstM2 (n: node) ;
+BEGIN
+   print (doP, "CONST\n") ;
+   doFQNameC (doP, n) ;
+   setNeedSpace (doP) ;
+   doExprC (doP, n^.constF.value) ;
+   print (doP, '\n')
+END doConstM2 ;
+
+
+(*
+   doProcTypeM2 -
+*)
+
+PROCEDURE doProcTypeM2 (p: pretty; n: node) ;
+BEGIN
+   outText (p, "proc type to do..")
+END doProcTypeM2 ;
+
+
+(*
+   doRecordFieldM2 -
+*)
+
+PROCEDURE doRecordFieldM2 (p: pretty; f: node) ;
+BEGIN
+   doNameM2 (p, f) ;
+   outText (p, ":") ;
+   setNeedSpace (p) ;
+   doTypeM2 (p, getType (f)) ;
+   setNeedSpace (p)
+END doRecordFieldM2 ;
+
+
+(*
+   doVarientFieldM2 -
+*)
+
+PROCEDURE doVarientFieldM2 (p: pretty; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   assert (isVarientField (n)) ;
+   doNameM2 (p, n) ;
+   outText (p, ":") ;
+   setNeedSpace (p) ;
+   i := LowIndice (n^.varientfieldF.listOfSons) ;
+   t := HighIndice (n^.varientfieldF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientfieldF.listOfSons, i) ;
+      IF isRecordField (q)
+      THEN
+         doRecordFieldM2 (p, q) ;
+         outText (p, ";\n")
+      ELSIF isVarient (q)
+      THEN
+         doVarientM2 (p, q) ;
+         outText (p, ";\n")
+      ELSE
+         HALT
+      END ;
+      INC (i)
+   END
+END doVarientFieldM2 ;
+
+
+(*
+   doVarientM2 -
+*)
+
+PROCEDURE doVarientM2 (p: pretty; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   assert (isVarient (n)) ;
+   outText (p, "CASE") ; setNeedSpace (p) ;
+   IF n^.varientF.tag # NIL
+   THEN
+      IF isRecordField (n^.varientF.tag)
+      THEN
+         doRecordFieldM2 (p, n^.varientF.tag)
+      ELSIF isVarientField (n^.varientF.tag)
+      THEN
+         doVarientFieldM2 (p, n^.varientF.tag)
+      ELSE
+         HALT
+      END
+   END ;
+   setNeedSpace (p) ;
+   outText (p, "OF\n") ;
+   i := LowIndice (n^.varientF.listOfSons) ;
+   t := HighIndice (n^.varientF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientF.listOfSons, i) ;
+      IF isRecordField (q)
+      THEN
+         IF NOT q^.recordfieldF.tag
+         THEN
+            doRecordFieldM2 (p, q) ;
+            outText (p, ";\n")
+         END
+      ELSIF isVarientField (q)
+      THEN
+         doVarientFieldM2 (p, q)
+      ELSE
+         HALT
+      END ;
+      INC (i)
+   END ;
+   outText (p, "END") ; setNeedSpace (p)
+END doVarientM2 ;
+
+
+(*
+   doRecordM2 -
+*)
+
+PROCEDURE doRecordM2 (p: pretty; n: node) ;
+VAR
+   i, h: CARDINAL ;
+   f   : node ;
+BEGIN
+   assert (isRecord (n)) ;
+   p := outKm2 (p, "RECORD") ;
+   i := LowIndice (n^.recordF.listOfSons) ;
+   h := HighIndice (n^.recordF.listOfSons) ;
+   outText (p, "\n") ;
+   WHILE i<=h DO
+      f := GetIndice (n^.recordF.listOfSons, i) ;
+      IF isRecordField (f)
+      THEN
+         IF NOT f^.recordfieldF.tag
+         THEN
+            doRecordFieldM2 (p, f) ;
+            outText (p, ";\n")
+         END
+      ELSIF isVarient (f)
+      THEN
+         doVarientM2 (p, f) ;
+         outText (p, ";\n")
+      ELSIF isVarientField (f)
+      THEN
+         doVarientFieldM2 (p, f)
+      END ;
+      INC (i)
+   END ;
+   p := outKm2 (p, "END") ; setNeedSpace (p)
+END doRecordM2 ;
+
+
+(*
+   doPointerM2 -
+*)
+
+PROCEDURE doPointerM2 (p: pretty; n: node) ;
+BEGIN
+   outText (p, "POINTER TO") ;
+   setNeedSpace (doP) ;
+   doTypeM2 (p, getType (n)) ;
+   setNeedSpace (p) ;
+   outText (p, ";\n")
+END doPointerM2 ;
+
+
+(*
+   doTypeAliasM2 -
+*)
+
+PROCEDURE doTypeAliasM2 (p: pretty; n: node) ;
+BEGIN
+   doTypeNameC (p, n) ;
+   setNeedSpace (p) ;
+   outText (doP, "=") ;
+   setNeedSpace (p) ;
+   doTypeM2 (p, getType (n)) ;
+   setNeedSpace (p) ;
+   outText (p, "\n")
+END doTypeAliasM2 ;
+
+
+(*
+   doEnumerationM2 -
+*)
+
+PROCEDURE doEnumerationM2 (p: pretty; n: node) ;
+VAR
+   i, h: CARDINAL ;
+   s   : node ;
+   t   : String ;
+BEGIN
+   outText (p, "(") ;
+   i := LowIndice (n^.enumerationF.listOfSons) ;
+   h := HighIndice (n^.enumerationF.listOfSons) ;
+   WHILE i <= h DO
+      s := GetIndice (n^.enumerationF.listOfSons, i) ;
+      doFQNameC (p, s) ;
+      IF i < h
+      THEN
+         outText (p, ",") ; setNeedSpace (p)
+      END ;
+      INC (i)
+   END ;
+   outText (p, ")")
+END doEnumerationM2 ;
+
+
+(*
+   doBaseM2 -
+*)
+
+PROCEDURE doBaseM2 (p: pretty; n: node) ;
+BEGIN
+   CASE n^.kind OF
+
+   char,
+   cardinal,
+   longcard,
+   shortcard,
+   integer,
+   longint,
+   shortint,
+   complex,
+   longcomplex,
+   shortcomplex,
+   real,
+   longreal,
+   shortreal,
+   bitset,
+   boolean,
+   proc        :  doNameM2 (p, n)
+
+   END ;
+   setNeedSpace (p)
+END doBaseM2 ;
+
+
+(*
+   doSystemM2 -
+*)
+
+PROCEDURE doSystemM2 (p: pretty; n: node) ;
+BEGIN
+   CASE n^.kind OF
+
+   address,
+   loc,
+   byte   ,
+   word   ,
+   csizet ,
+   cssizet:  doNameM2 (p, n)
+
+   END
+END doSystemM2 ;
+
+
+(*
+   doTypeM2 -
+*)
+
+PROCEDURE doTypeM2 (p: pretty; n: node) ;
+BEGIN
+   IF isBase (n)
+   THEN
+      doBaseM2 (p, n)
+   ELSIF isSystem (n)
+   THEN
+      doSystemM2 (p, n)
+   ELSIF isType (n)
+   THEN
+      doTypeAliasM2 (p, n)
+   ELSIF isProcType (n)
+   THEN
+      doProcTypeM2 (p, n)
+   ELSIF isPointer (n)
+   THEN
+      doPointerM2 (p, n)
+   ELSIF isEnumeration (n)
+   THEN
+      doEnumerationM2 (p, n)
+   ELSIF isRecord (n)
+   THEN
+      doRecordM2 (p, n)
+   END
+END doTypeM2 ;
+
+
+(*
+   doTypesM2 -
+*)
+
+PROCEDURE doTypesM2 (n: node) ;
+VAR
+   m: node ;
+BEGIN
+   outText (doP, "TYPE\n") ;
+   doTypeM2 (doP, n)
+END doTypesM2 ;
+
+
+(*
+   doVarM2 -
+*)
+
+PROCEDURE doVarM2 (n: node) ;
+BEGIN
+   assert (isVar (n)) ;
+   doNameC (doP, n) ;
+   outText (doP, ":") ;
+   setNeedSpace (doP) ;
+   doTypeM2 (doP, getType (n)) ;
+   setNeedSpace (doP) ;
+   outText (doP, ";\n")
+END doVarM2 ;
+
+
+(*
+   doVarsM2 -
+*)
+
+PROCEDURE doVarsM2 (n: node) ;
+VAR
+   m: node ;
+BEGIN
+   outText (doP, "VAR\n") ;
+   doVarM2 (n)
+END doVarsM2 ;
+
+
+(*
+   doTypeNameM2 -
+*)
+
+PROCEDURE doTypeNameM2 (p: pretty; n: node) ;
+BEGIN
+   doNameM2 (p, n)
+END doTypeNameM2 ;
+
+
+(*
+   doParamM2 -
+*)
+
+PROCEDURE doParamM2 (p: pretty; n: node) ;
+VAR
+   ptype: node ;
+   i    : Name ;
+   c, t : CARDINAL ;
+   l    : wlist ;
+BEGIN
+   assert (isParam (n)) ;
+   ptype := getType (n) ;
+   IF n^.paramF.namelist = NIL
+   THEN
+      doTypeNameM2 (p, ptype)
+   ELSE
+      assert (isIdentList (n^.paramF.namelist)) ;
+      l := n^.paramF.namelist^.identlistF.names ;
+      IF l=NIL
+      THEN
+         doTypeNameM2 (p, ptype)
+      ELSE
+         t := wlists.noOfItemsInList (l) ;
+         c := 1 ;
+         WHILE c <= t DO
+            i := wlists.getItemFromList (l, c) ;
+            setNeedSpace (p) ;
+            doNamesC (p, i) ;
+            IF c<t
+            THEN
+               outText (p, ',') ; setNeedSpace (p)
+            END ;
+            INC (c)
+         END ;
+         outText (p, ':') ; setNeedSpace (p) ;
+         doTypeNameM2 (p, ptype)
+      END
+   END
+END doParamM2 ;
+
+
+(*
+   doVarParamM2 -
+*)
+
+PROCEDURE doVarParamM2 (p: pretty; n: node) ;
+VAR
+   ptype: node ;
+   i    : Name ;
+   c, t : CARDINAL ;
+   l    : wlist ;
+BEGIN
+   assert (isVarParam (n)) ;
+   outText (p, 'VAR') ; setNeedSpace (p) ;
+   ptype := getType (n) ;
+   IF n^.varparamF.namelist = NIL
+   THEN
+      doTypeNameM2 (p, ptype)
+   ELSE
+      assert (isIdentList (n^.varparamF.namelist)) ;
+      l := n^.varparamF.namelist^.identlistF.names ;
+      IF l=NIL
+      THEN
+         doTypeNameM2 (p, ptype)
+      ELSE
+         t := wlists.noOfItemsInList (l) ;
+         c := 1 ;
+         WHILE c <= t DO
+            i := wlists.getItemFromList (l, c) ;
+            setNeedSpace (p) ;
+            doNamesC (p, i) ;
+            IF c<t
+            THEN
+               outText (p, ',') ; setNeedSpace (p)
+            END ;
+            INC (c)
+         END ;
+         outText (p, ':') ; setNeedSpace (p) ;
+         doTypeNameM2 (p, ptype)
+      END
+   END
+END doVarParamM2 ;
+
+
+(*
+   doParameterM2 -
+*)
+
+PROCEDURE doParameterM2 (p: pretty; n: node) ;
+BEGIN
+   IF isParam (n)
+   THEN
+      doParamM2 (p, n)
+   ELSIF isVarParam (n)
+   THEN
+      doVarParamM2 (p, n)
+   ELSIF isVarargs (n)
+   THEN
+      print (p, "...")
+   END
+END doParameterM2 ;
+
+
+(*
+   doPrototypeM2 -
+*)
+
+PROCEDURE doPrototypeM2 (n: node) ;
+VAR
+   i, h: CARDINAL ;
+   p   : node ;
+BEGIN
+   assert (isProcedure (n)) ;
+   noSpace (doP) ;
+
+   doNameM2 (doP, n) ;
+   setNeedSpace (doP) ;
+   outText (doP, "(") ;
+   i := LowIndice (n^.procedureF.parameters) ;
+   h := HighIndice (n^.procedureF.parameters) ;
+   WHILE i <= h DO
+      p := GetIndice (n^.procedureF.parameters, i) ;
+      doParameterM2 (doP, p) ;
+      noSpace (doP) ;
+      IF i < h
+      THEN
+         print (doP, ";") ; setNeedSpace (doP)
+      END ;
+      INC (i)
+   END ;
+   outText (doP, ")") ;
+   IF n^.procedureF.returnType#NIL
+   THEN
+      setNeedSpace (doP) ;
+      outText (doP, ":") ;
+      doTypeM2 (doP, n^.procedureF.returnType) ; setNeedSpace (doP)
+   END ;
+   outText (doP, ";\n")
+END doPrototypeM2 ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE outputPartialM2 (n: node) ;
+VAR
+   q: node ;
+BEGIN
+   q := getType (n) ;
+   IF isRecord (q)
+   THEN
+      doTypeM2 (doP, n)
+   ELSIF isArray (q)
+   THEN
+      doTypeM2 (doP, n)
+   ELSIF isProcType (q)
+   THEN
+      doTypeM2 (doP, n)
+   END
+END outputPartialM2 ;
+
+
+(*
+   outDeclsDefM2 -
+*)
+
+PROCEDURE outDeclsDefM2 (p: pretty; s: scopeT) ;
+BEGIN
+   simplifyTypes (s) ;
+   includeConstType (s) ;
+
+   doP := p ;
+
+   topologicallyOut (doConstM2, doTypesM2, doVarsM2,
+                     outputPartialM2,
+                     doNothing, doNothing, doNothing) ;
+
+   includeVarProcedure (s) ;
+
+   topologicallyOut (doConstM2, doTypesM2, doVarsM2,
+                     outputPartialM2,
+                     doNothing, doNothing, doNothing) ;
+
+   ForeachIndiceInIndexDo (s.procedures, doPrototypeM2)
+END outDeclsDefM2 ;
+
+
+(*
+   outDefM2 -
+*)
+
+PROCEDURE outDefM2 (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar (keyToCharStar (getSource (n))) ;
+   print (p, "(* automatically created by mc from ") ; prints (p, s) ; print (p, ".  *)\n\n") ;
+   s := KillString (s) ;
+   s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   print (p, "DEFINITION MODULE ") ; prints (p, s) ; print (p, " ;\n\n") ;
+
+   doP := p ;
+   ForeachIndiceInIndexDo (n^.defF.importedModules, doIncludeM2) ;
+
+   print (p, "\n") ;
+
+   outDeclsDefM2 (p, n^.defF.decls) ;
+
+   print (p, "\n") ;
+   print (p, "END ") ;
+   prints (p, s) ;
+   print (p, ".\n") ;
+   s := KillString (s)
+END outDefM2 ;
+
+
+(*
+   outDeclsImpM2 -
+*)
+
+PROCEDURE outDeclsImpM2 (p: pretty; s: scopeT) ;
+BEGIN
+   simplifyTypes (s) ;
+   includeConstType (s) ;
+
+   doP := p ;
+
+   topologicallyOut (doConstM2, doTypesM2, doVarM2,
+                     outputPartialM2,
+                     doNothing, doNothing, doNothing) ;
+
+   includeVarProcedure (s) ;
+
+   topologicallyOut (doConstM2, doTypesM2, doVarsM2,
+                     outputPartialM2,
+                     doNothing, doNothing, doNothing) ;
+
+   outText (p, "\n") ;
+   ForeachIndiceInIndexDo (s.procedures, doPrototypeC)
+END outDeclsImpM2 ;
+
+
+(*
+   outImpM2 -
+*)
+
+PROCEDURE outImpM2 (p: pretty; n: node) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitStringCharStar (keyToCharStar (getSource (n))) ;
+   print (p, "(* automatically created by mc from ") ; prints (p, s) ; print (p, ".  *)\n\n") ;
+   print (p, "IMPLEMENTATION MODULE ") ; prints (p, s) ; print (p, " ;\n\n") ;
+
+   doP := p ;
+   ForeachIndiceInIndexDo (n^.impF.importedModules, doIncludeM2) ;
+   print (p, "\n") ;
+
+   includeDefConstType (n) ;
+   outDeclsImpM2 (p, n^.impF.decls) ;
+
+   print (p, "\n") ;
+   print (p, "END ") ;
+   prints (p, s) ;
+   print (p, ".\n") ;
+
+   s := KillString (s)
+END outImpM2 ;
+
+
+(*
+   outModuleM2 -
+*)
+
+PROCEDURE outModuleM2 (p: pretty; n: node) ;
+BEGIN
+
+END outModuleM2 ;
+
+
+(*
+   outM2 -
+*)
+
+PROCEDURE outM2 (p: pretty; n: node) ;
+BEGIN
+   IF isDef (n)
+   THEN
+      outDefM2 (p, n)
+   ELSIF isImp (n)
+   THEN
+      outImpM2 (p, n)
+   ELSIF isModule (n)
+   THEN
+      outModuleM2 (p, n)
+   ELSE
+      HALT
+   END
+END outM2 ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE out ;
+VAR
+   p: pretty ;
+BEGIN
+   openOutput ;
+   p := initPretty (write, writeln) ;
+   CASE lang OF
+
+   ansiC :  outC (p, getMainModule ()) |
+   ansiCP:  outC (p, getMainModule ()) |
+   pim4  :  outM2 (p, getMainModule ())
+
+   END ;
+   closeOutput
+END out ;
+
+
+(*
+   setLangC -
+*)
+
+PROCEDURE setLangC ;
+BEGIN
+   lang := ansiC
+END setLangC ;
+
+
+(*
+   setLangCP -
+*)
+
+PROCEDURE setLangCP ;
+BEGIN
+   lang := ansiCP ;
+   keyc.cp
+END setLangCP ;
+
+
+(*
+   setLangM2 -
+*)
+
+PROCEDURE setLangM2 ;
+BEGIN
+   lang := pim4
+END setLangM2 ;
+
+
+(*
+   addDone - adds node, n, to the doneQ.
+*)
+
+PROCEDURE addDone (n: node) ;
+BEGIN
+   alists.includeItemIntoList (doneQ, n)
+END addDone ;
+
+
+(*
+   addDoneDef - adds node, n, to the doneQ providing
+                it is not an opaque of the main module we are compiling.
+*)
+
+PROCEDURE addDoneDef (n: node) ;
+BEGIN
+   IF isDef (n)
+   THEN
+      addDone (n) ;
+      RETURN
+   END ;
+   IF (NOT isDef (n)) AND (lookupImp (getSymName (getScope (n))) = getMainModule ())
+   THEN
+      metaError1 ('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', n) ;
+      flushErrors ;
+      errorAbort0 ('terminating compilation')
+   ELSE
+      addDone (n)
+   END
+END addDoneDef ;
+
+
+(*
+   dbgAdd -
+*)
+
+PROCEDURE dbgAdd (l: alist; n: node) : node ;
+BEGIN
+   IF n#NIL
+   THEN
+      alists.includeItemIntoList (l, n)
+   END ;
+   RETURN n
+END dbgAdd ;
+
+
+(*
+   dbgType -
+*)
+
+PROCEDURE dbgType (l: alist; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   t := dbgAdd (l, getType (n)) ;
+   out1 ("<%s type", n) ;
+   IF t = NIL
+   THEN
+      out0 (", type = NIL\n")
+   ELSE
+      out1 (", type = %s>\n", t)
+   END
+END dbgType ;
+
+
+(*
+   dbgPointer -
+*)
+
+PROCEDURE dbgPointer (l: alist; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   t := dbgAdd (l, getType (n)) ;
+   out1 ("<%s pointer", n) ;
+   out1 (" to %s>\n", t)
+END dbgPointer ;
+
+
+(*
+   dbgRecord -
+*)
+
+PROCEDURE dbgRecord (l: alist; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   out1 ("<%s record:\n", n) ;
+   i := LowIndice (n^.recordF.listOfSons) ;
+   t := HighIndice (n^.recordF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.recordF.listOfSons, i) ;
+      IF isRecordField (q)
+      THEN
+         out1 (" <recordfield %s", q)
+      ELSIF isVarientField (q)
+      THEN
+         out1 (" <varientfield %s", q)
+      ELSIF isVarient (q)
+      THEN
+         out1 (" <varient %s", q)
+      ELSE
+         HALT
+      END ;
+      q := dbgAdd (l, getType (q)) ;
+      out1 (": %s>\n", q) ;
+      INC (i)
+   END ;
+   outText (doP, ">\n")
+END dbgRecord ;
+
+
+(*
+   dbgVarient -
+*)
+
+PROCEDURE dbgVarient (l: alist; n: node) ;
+VAR
+   i, t: CARDINAL ;
+   q   : node ;
+BEGIN
+   out1 ("<%s varient: ", n) ;
+   out1 ("tag %s", n^.varientF.tag) ;
+   q := getType (n^.varientF.tag) ;
+   IF q=NIL
+   THEN
+      outText (doP, "\n")
+   ELSE
+      out1 (": %s\n", q) ;
+      q := dbgAdd (l, q)
+   END ;
+   i := LowIndice (n^.varientF.listOfSons) ;
+   t := HighIndice (n^.varientF.listOfSons) ;
+   WHILE i<=t DO
+      q := GetIndice (n^.varientF.listOfSons, i) ;
+      IF isRecordField (q)
+      THEN
+         out1 (" <recordfield %s", q)
+      ELSIF isVarientField (q)
+      THEN
+         out1 (" <varientfield %s", q)
+      ELSIF isVarient (q)
+      THEN
+         out1 (" <varient %s", q)
+      ELSE
+         HALT
+      END ;
+      q := dbgAdd (l, getType (q)) ;
+      out1 (": %s>\n", q) ;
+      INC (i)
+   END ;
+   outText (doP, ">\n")
+END dbgVarient ;
+
+
+(*
+   dbgEnumeration -
+*)
+
+PROCEDURE dbgEnumeration (l: alist; n: node) ;
+VAR
+   e   : node ;
+   i, h: CARDINAL ;
+BEGIN
+   outText (doP, "< enumeration ") ;
+   i := LowIndice (n^.enumerationF.listOfSons) ;
+   h := HighIndice (n^.enumerationF.listOfSons) ;
+   WHILE i<=h DO
+      e := GetIndice (n^.enumerationF.listOfSons, i) ;
+      out1 ("%s, ", e) ;
+      INC (i)
+   END ;
+   outText (doP, ">\n")
+END dbgEnumeration ;
+
+
+(*
+   dbgVar -
+*)
+
+PROCEDURE dbgVar (l: alist; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   t := dbgAdd (l, getType (n)) ;
+   out1 ("<%s var", n) ;
+   out1 (", type = %s>\n", t)
+END dbgVar ;
+
+
+(*
+   dbgSubrange -
+*)
+
+PROCEDURE dbgSubrange (l: alist; n: node) ;
+BEGIN
+   IF n^.subrangeF.low = NIL
+   THEN
+      out1 ('%s', n^.subrangeF.type)
+   ELSE
+      out1 ('[%s', n^.subrangeF.low) ;
+      out1 ('..%s]', n^.subrangeF.high)
+   END
+END dbgSubrange ;
+
+
+(*
+   dbgArray -
+*)
+
+PROCEDURE dbgArray (l: alist; n: node) ;
+VAR
+   t: node ;
+BEGIN
+   t := dbgAdd (l, getType (n)) ;
+   out1 ("<%s array ", n) ;
+   IF n^.arrayF.subr # NIL
+   THEN
+      dbgSubrange (l, n^.arrayF.subr)
+   END ;
+   out1 (" of %s>\n", t)
+END dbgArray ;
+
+
+(*
+   doDbg -
+*)
+
+PROCEDURE doDbg (l: alist; n: node) ;
+BEGIN
+   IF n=NIL
+   THEN
+      (* do nothing.  *)
+   ELSIF isSubrange (n)
+   THEN
+      dbgSubrange (l, n)
+   ELSIF isType (n)
+   THEN
+      dbgType (l, n)
+   ELSIF isRecord (n)
+   THEN
+      dbgRecord (l, n)
+   ELSIF isVarient (n)
+   THEN
+      dbgVarient (l, n)
+   ELSIF isEnumeration (n)
+   THEN
+      dbgEnumeration (l, n)
+   ELSIF isPointer (n)
+   THEN
+      dbgPointer (l, n)
+   ELSIF isArray (n)
+   THEN
+      dbgArray (l, n)
+   ELSIF isVar (n)
+   THEN
+      dbgVar (l, n)
+   END
+END doDbg ;
+
+
+(*
+   dbg -
+*)
+
+PROCEDURE dbg (n: node) ;
+VAR
+   l: alist ;
+   o: pretty ;
+   f: File ;
+   s: String ;
+   i: CARDINAL ;
+BEGIN
+   o := doP ;
+   f := outputFile ;
+   outputFile := StdOut ;
+   doP := initPretty (write, writeln) ;
+
+   l := alists.initList () ;
+   alists.includeItemIntoList (l, n) ;
+   i := 1 ;
+   out1 ("dbg (%s)\n", n) ;
+   REPEAT
+      n := alists.getItemFromList (l, i) ;
+      doDbg (l, n) ;
+      INC (i)
+   UNTIL i>alists.noOfItemsInList (l) ;
+   doP := o ;
+   outputFile := f
+END dbg ;
+
+
+(*
+   makeStatementSequence - create and return a statement sequence node.
+*)
+
+PROCEDURE makeStatementSequence () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (stmtseq) ;
+   n^.stmtF.statements := InitIndex (1) ;
+   RETURN n
+END makeStatementSequence ;
+
+
+(*
+   addStatement - adds node, n, as a statement to statememt sequence, s.
+*)
+
+PROCEDURE addStatement (s: node; n: node) ;
+BEGIN
+   IF n#NIL
+   THEN
+      assert (isStatementSequence (s)) ;
+      PutIndice (s^.stmtF.statements, HighIndice (s^.stmtF.statements) + 1, n) ;
+      IF isIntrinsic (n) AND (n^.intrinsicF.postUnreachable)
+      THEN
+         n^.intrinsicF.postUnreachable := FALSE ;
+         addStatement (s, makeIntrinsicProc (unreachable, 0, NIL))
+      END
+   END
+END addStatement ;
+
+
+(*
+   isStatementSequence - returns TRUE if node, n, is a statement sequence.
+*)
+
+PROCEDURE isStatementSequence (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = stmtseq
+END isStatementSequence ;
+
+
+(*
+   addGenericBody - adds comment node to funccall, return, assignment
+                    nodes.
+*)
+
+PROCEDURE addGenericBody (n, c: node);
+BEGIN
+   CASE n^.kind OF
+
+   unreachable,
+   throw,
+   halt,
+   new,
+   dispose,
+   inc,
+   dec,
+   incl,
+   excl      :  n^.intrinsicF.intrinsicComment.body := c |
+   funccall  :  n^.funccallF.funccallComment.body := c |
+   return    :  n^.returnF.returnComment.body := c |
+   assignment:  n^.assignmentF.assignComment.body := c |
+   module    :  n^.moduleF.com.body := c |
+   def       :  n^.defF.com.body := c |
+   imp       :  n^.impF.com.body := c
+
+   ELSE
+   END
+END addGenericBody;
+
+
+(*
+   addGenericAfter - adds comment node to funccall, return, assignment
+                     nodes.
+*)
+
+PROCEDURE addGenericAfter (n, c: node);
+BEGIN
+   CASE n^.kind OF
+
+   unreachable,
+   throw,
+   halt,
+   new,
+   dispose,
+   inc,
+   dec,
+   incl,
+   excl      :  n^.intrinsicF.intrinsicComment.after := c |
+   funccall  :  n^.funccallF.funccallComment.after := c |
+   return    :  n^.returnF.returnComment.after := c |
+   assignment:  n^.assignmentF.assignComment.after := c |
+   module    :  n^.moduleF.com.after := c |
+   def       :  n^.defF.com.after := c |
+   imp       :  n^.impF.com.after := c
+
+   ELSE
+   END
+END addGenericAfter ;
+
+
+(*
+   addCommentBody - adds a body comment to a statement sequence node.
+*)
+
+PROCEDURE addCommentBody (n: node) ;
+VAR
+   b: commentDesc ;
+BEGIN
+   IF n # NIL
+   THEN
+      b := getBodyComment () ;
+      IF b # NIL
+      THEN
+         addGenericBody (n, makeCommentS (b))
+      END
+   END
+END addCommentBody ;
+
+
+(*
+   addCommentAfter - adds an after comment to a statement sequence node.
+*)
+
+PROCEDURE addCommentAfter (n: node) ;
+VAR
+   a: commentDesc ;
+BEGIN
+   IF n # NIL
+   THEN
+      a := getAfterComment () ;
+      IF a # NIL
+      THEN
+         addGenericAfter (n, makeCommentS (a))
+      END
+   END
+END addCommentAfter ;
+
+
+(*
+   addIfComments - adds the, body, and, after, comments to if node, n.
+*)
+
+PROCEDURE addIfComments (n: node; body, after: node) ;
+BEGIN
+   assert (isIf (n)) ;
+   n^.ifF.ifComment.after := after ;
+   n^.ifF.ifComment.body := body
+END addIfComments ;
+
+
+(*
+   addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n.
+*)
+
+PROCEDURE addElseComments (n: node; body, after: node) ;
+BEGIN
+   assert (isIf (n) OR isElsif (n)) ;
+   IF isIf (n)
+   THEN
+      n^.ifF.elseComment.after := after ;
+      n^.ifF.elseComment.body := body
+   ELSE
+      n^.elsifF.elseComment.after := after ;
+      n^.elsifF.elseComment.body := body
+   END
+END addElseComments ;
+
+
+(*
+   addIfEndComments - adds the, body, and, after, comments to an, if, node, n.
+*)
+
+PROCEDURE addIfEndComments (n: node; body, after: node) ;
+BEGIN
+   assert (isIf (n)) ;
+   n^.ifF.endComment.after := after ;
+   n^.ifF.endComment.body := body
+END addIfEndComments ;
+
+
+(*
+   makeReturn - creates and returns a return node.
+*)
+
+PROCEDURE makeReturn () : node ;
+VAR
+   type,
+   n   : node ;
+BEGIN
+   n := newNode (return) ;
+   n^.returnF.exp := NIL ;
+   IF isProcedure (getDeclScope ())
+   THEN
+      n^.returnF.scope := getDeclScope ()
+   ELSE
+      n^.returnF.scope := NIL
+   END ;
+   initPair (n^.returnF.returnComment) ;
+   RETURN n
+END makeReturn ;
+
+
+(*
+   isReturn - returns TRUE if node, n, is a return.
+*)
+
+PROCEDURE isReturn (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = return
+END isReturn ;
+
+
+(*
+   putReturn - assigns node, e, as the expression on the return node.
+*)
+
+PROCEDURE putReturn (n: node; e: node) ;
+BEGIN
+   assert (isReturn (n)) ;
+   n^.returnF.exp := e
+END putReturn ;
+
+
+(*
+   makeWhile - creates and returns a while node.
+*)
+
+PROCEDURE makeWhile () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (while) ;
+   n^.whileF.expr := NIL ;
+   n^.whileF.statements := NIL ;
+   initPair (n^.whileF.doComment) ;
+   initPair (n^.whileF.endComment) ;
+   RETURN n
+END makeWhile ;
+
+
+(*
+   putWhile - places an expression, e, and statement sequence, s, into the while
+              node, n.
+*)
+
+PROCEDURE putWhile (n: node; e, s: node) ;
+BEGIN
+   assert (isWhile (n)) ;
+   n^.whileF.expr := e ;
+   n^.whileF.statements := s
+END putWhile ;
+
+
+(*
+   isWhile - returns TRUE if node, n, is a while.
+*)
+
+PROCEDURE isWhile (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = while
+END isWhile ;
+
+
+(*
+   addWhileDoComment - adds body and after comments to while node, w.
+*)
+
+PROCEDURE addWhileDoComment (w: node; body, after: node) ;
+BEGIN
+   assert (isWhile (w)) ;
+   w^.whileF.doComment.after := after ;
+   w^.whileF.doComment.body := body
+END addWhileDoComment ;
+
+
+(*
+   addWhileEndComment - adds body and after comments to the end of a while node, w.
+*)
+
+PROCEDURE addWhileEndComment (w: node; body, after: node) ;
+BEGIN
+   assert (isWhile (w)) ;
+   w^.whileF.endComment.after := after ;
+   w^.whileF.endComment.body := body
+END addWhileEndComment ;
+
+
+(*
+   makeAssignment - creates and returns an assignment node.
+                    The designator is, d, and expression, e.
+*)
+
+PROCEDURE makeAssignment (d, e: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (assignment) ;
+   n^.assignmentF.des := d ;
+   n^.assignmentF.expr := e ;
+   initPair (n^.assignmentF.assignComment) ;
+   RETURN n
+END makeAssignment ;
+
+
+(*
+   isAssignment -
+*)
+
+PROCEDURE isAssignment (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = assignment
+END isAssignment ;
+
+
+(*
+   putBegin - assigns statements, s, to be the normal part in
+              block, b.  The block may be a procedure or module,
+              or implementation node.
+*)
+
+PROCEDURE putBegin (b: node; s: node) ;
+BEGIN
+   assert (isImp (b) OR isProcedure (b) OR isModule (b)) ;
+   CASE b^.kind OF
+
+   imp      :  b^.impF.beginStatements := s |
+   module   :  b^.moduleF.beginStatements := s |
+   procedure:  b^.procedureF.beginStatements := s
+
+   END
+END putBegin ;
+
+
+(*
+   putFinally - assigns statements, s, to be the final part in
+                block, b.  The block may be a module
+                or implementation node.
+*)
+
+PROCEDURE putFinally (b: node; s: node) ;
+BEGIN
+   assert (isImp (b) OR isProcedure (b) OR isModule (b)) ;
+   CASE b^.kind OF
+
+   imp      :  b^.impF.finallyStatements := s |
+   module   :  b^.moduleF.finallyStatements := s
+
+   END
+END putFinally ;
+
+
+(*
+   makeExit - creates and returns an exit node.
+*)
+
+PROCEDURE makeExit (l: node; n: CARDINAL) : node ;
+VAR
+   e: node ;
+BEGIN
+   assert (isLoop (l)) ;
+   e := newNode (exit) ;
+   e^.exitF.loop := l ;
+   l^.loopF.labelno := n ;
+   RETURN e
+END makeExit ;
+
+
+(*
+   isExit - returns TRUE if node, n, is an exit.
+*)
+
+PROCEDURE isExit (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = exit
+END isExit ;
+
+
+(*
+   makeLoop - creates and returns a loop node.
+*)
+
+PROCEDURE makeLoop () : node ;
+VAR
+   l: node ;
+BEGIN
+   l := newNode (loop) ;
+   l^.loopF.statements := NIL ;
+   l^.loopF.labelno := 0 ;
+   RETURN l
+END makeLoop ;
+
+
+(*
+   putLoop - places statement sequence, s, into loop, l.
+*)
+
+PROCEDURE putLoop (l, s: node) ;
+BEGIN
+   assert (isLoop (l)) ;
+   l^.loopF.statements := s
+END putLoop ;
+
+
+(*
+   isLoop - returns TRUE if, n, is a loop node.
+*)
+
+PROCEDURE isLoop (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = loop
+END isLoop ;
+
+
+(*
+   makeComment - creates and returns a comment node.
+*)
+
+PROCEDURE makeComment (a: ARRAY OF CHAR) : node ;
+VAR
+   c: commentDesc ;
+   s: String ;
+BEGIN
+   c := initComment (TRUE) ;
+   s := InitString (a) ;
+   addText (c, DynamicStrings.string (s)) ;
+   s := KillString (s) ;
+   RETURN makeCommentS (c)
+END makeComment ;
+
+
+(*
+   makeCommentS - creates and returns a comment node.
+*)
+
+PROCEDURE makeCommentS (c: commentDesc) : node ;
+VAR
+   n: node ;
+BEGIN
+   IF c = NIL
+   THEN
+      RETURN NIL
+   ELSE
+      n := newNode (comment) ;
+      n^.commentF.content := c ;
+      RETURN n
+   END
+END makeCommentS ;
+
+
+(*
+   isComment - returns TRUE if node, n, is a comment.
+*)
+
+PROCEDURE isComment (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = comment
+END isComment ;
+
+
+(*
+   initPair - initialise the commentPair, c.
+*)
+
+PROCEDURE initPair (VAR c: commentPair) ;
+BEGIN
+   c.after := NIL ;
+   c.body := NIL
+END initPair ;
+
+
+(*
+   makeIf - creates and returns an if node.  The if node
+            will have expression, e, and statement sequence, s,
+            as the then component.
+*)
+
+PROCEDURE makeIf (e, s: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (if) ;
+   n^.ifF.expr := e ;
+   n^.ifF.then := s ;
+   n^.ifF.else := NIL ;
+   n^.ifF.elsif := NIL ;
+   initPair (n^.ifF.ifComment) ;
+   initPair (n^.ifF.elseComment) ;
+   initPair (n^.ifF.endComment) ;
+   RETURN n
+END makeIf ;
+
+
+(*
+   isIf - returns TRUE if, n, is an if node.
+*)
+
+PROCEDURE isIf (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = if
+END isIf ;
+
+
+(*
+   makeElsif - creates and returns an elsif node.
+               This node has an expression, e, and statement
+               sequence, s.
+*)
+
+PROCEDURE makeElsif (i, e, s: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (elsif) ;
+   n^.elsifF.expr := e ;
+   n^.elsifF.then := s ;
+   n^.elsifF.elsif := NIL ;
+   n^.elsifF.else := NIL ;
+   initPair (n^.elsifF.elseComment) ;
+   assert (isIf (i) OR isElsif (i)) ;
+   IF isIf (i)
+   THEN
+      i^.ifF.elsif := n ;
+      assert (i^.ifF.else = NIL)
+   ELSE
+      i^.elsifF.elsif := n ;
+      assert (i^.elsifF.else = NIL)
+   END ;
+   RETURN n
+END makeElsif ;
+
+
+(*
+   isElsif - returns TRUE if node, n, is an elsif node.
+*)
+
+PROCEDURE isElsif (n: node) : BOOLEAN ;
+BEGIN
+   RETURN n^.kind = elsif
+END isElsif ;
+
+
+(*
+   putElse - the else is grafted onto the if/elsif node, i,
+             and the statement sequence will be, s.
+*)
+
+PROCEDURE putElse (i, s: node) ;
+BEGIN
+   assert (isIf (i) OR isElsif (i)) ;
+   IF isIf (i)
+   THEN
+      assert (i^.ifF.elsif = NIL) ;
+      assert (i^.ifF.else = NIL) ;
+      i^.ifF.else := s
+   ELSE
+      assert (i^.elsifF.elsif = NIL) ;
+      assert (i^.elsifF.else = NIL) ;
+      i^.elsifF.else := s
+   END
+END putElse ;
+
+
+(*
+   makeFor - creates and returns a for node.
+*)
+
+PROCEDURE makeFor () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (for) ;
+   n^.forF.des := NIL ;
+   n^.forF.start := NIL ;
+   n^.forF.end := NIL ;
+   n^.forF.increment := NIL ;
+   n^.forF.statements := NIL ;
+   RETURN n
+END makeFor ;
+
+
+(*
+   isFor - returns TRUE if node, n, is a for node.
+*)
+
+PROCEDURE isFor (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = for
+END isFor ;
+
+
+(*
+   putFor - assigns the fields of the for node with
+            ident, i,
+            start, s,
+            end, e,
+            increment, i,
+            statements, sq.
+*)
+
+PROCEDURE putFor (f, i, s, e, b, sq: node) ;
+BEGIN
+   assert (isFor (f)) ;
+   f^.forF.des := i ;
+   f^.forF.start := s ;
+   f^.forF.end := e ;
+   f^.forF.increment := b ;
+   f^.forF.statements := sq
+END putFor ;
+
+
+(*
+   makeRepeat - creates and returns a repeat node.
+*)
+
+PROCEDURE makeRepeat () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (repeat) ;
+   n^.repeatF.expr := NIL ;
+   n^.repeatF.statements := NIL ;
+   initPair (n^.repeatF.repeatComment) ;
+   initPair (n^.repeatF.untilComment) ;
+   RETURN n
+END makeRepeat ;
+
+
+(*
+   isRepeat - returns TRUE if node, n, is a repeat node.
+*)
+
+PROCEDURE isRepeat (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = repeat
+END isRepeat ;
+
+
+(*
+   putRepeat - places statements, s, and expression, e, into
+               repeat statement, n.
+*)
+
+PROCEDURE putRepeat (n, s, e: node) ;
+BEGIN
+   n^.repeatF.expr := e ;
+   n^.repeatF.statements := s
+END putRepeat ;
+
+
+(*
+   addRepeatComment - adds body and after comments to repeat node, r.
+*)
+
+PROCEDURE addRepeatComment (r: node; body, after: node) ;
+BEGIN
+   assert (isRepeat (r)) ;
+   r^.repeatF.repeatComment.after := after ;
+   r^.repeatF.repeatComment.body := body
+END addRepeatComment ;
+
+
+(*
+   addUntilComment - adds body and after comments to the until section of a repeat node, r.
+*)
+
+PROCEDURE addUntilComment (r: node; body, after: node) ;
+BEGIN
+   assert (isRepeat (r)) ;
+   r^.repeatF.untilComment.after := after ;
+   r^.repeatF.untilComment.body := body
+END addUntilComment ;
+
+
+(*
+   makeCase - builds and returns a case statement node.
+*)
+
+PROCEDURE makeCase () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (case) ;
+   n^.caseF.expression := NIL ;
+   n^.caseF.caseLabelList := InitIndex (1) ;
+   n^.caseF.else := NIL ;
+   RETURN n
+END makeCase ;
+
+
+(*
+   isCase - returns TRUE if node, n, is a case statement.
+*)
+
+PROCEDURE isCase (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = case
+END isCase ;
+
+
+(*
+   putCaseExpression - places expression, e, into case statement, n.
+                       n is returned.
+*)
+
+PROCEDURE putCaseExpression (n: node; e: node) : node ;
+BEGIN
+   assert (isCase (n)) ;
+   n^.caseF.expression := e ;
+   RETURN n
+END putCaseExpression ;
+
+
+(*
+   putCaseElse - places else statement, e, into case statement, n.
+                 n is returned.
+*)
+
+PROCEDURE putCaseElse (n: node; e: node) : node ;
+BEGIN
+   assert (isCase (n)) ;
+   n^.caseF.else := e ;
+   RETURN n
+END putCaseElse ;
+
+
+(*
+   putCaseStatement - places a caselist, l, and associated
+                      statement sequence, s, into case statement, n.
+                      n is returned.
+*)
+
+PROCEDURE putCaseStatement (n: node; l: node; s: node) : node ;
+BEGIN
+   assert (isCase (n)) ;
+   assert (isCaseList (l)) ;
+   IncludeIndiceIntoIndex (n^.caseF.caseLabelList, makeCaseLabelList (l, s)) ;
+   RETURN n
+END putCaseStatement ;
+
+
+(*
+   makeCaseLabelList - creates and returns a caselabellist node.
+*)
+
+PROCEDURE makeCaseLabelList (l, s: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (caselabellist) ;
+   n^.caselabellistF.caseList := l ;
+   n^.caselabellistF.statements := s ;
+   RETURN n
+END makeCaseLabelList ;
+
+
+(*
+   isCaseLabelList - returns TRUE if, n, is a caselabellist.
+*)
+
+PROCEDURE isCaseLabelList (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = caselabellist
+END isCaseLabelList ;
+
+
+(*
+   makeCaseList - creates and returns a case statement node.
+*)
+
+PROCEDURE makeCaseList () : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (caselist) ;
+   n^.caselistF.rangePairs := InitIndex (1) ;
+   RETURN n
+END makeCaseList ;
+
+
+(*
+   isCaseList - returns TRUE if, n, is a case list.
+*)
+
+PROCEDURE isCaseList (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = caselist
+END isCaseList ;
+
+
+(*
+   putCaseRange - places the case range lo..hi into caselist, n.
+*)
+
+PROCEDURE putCaseRange (n: node; lo, hi: node) : node ;
+BEGIN
+   assert (isCaseList (n)) ;
+   IncludeIndiceIntoIndex (n^.caselistF.rangePairs, makeRange (lo, hi)) ;
+   RETURN n
+END putCaseRange ;
+
+
+(*
+   makeRange - creates and returns a case range.
+*)
+
+PROCEDURE makeRange (lo, hi: node) : node ;
+VAR
+   n: node ;
+BEGIN
+   n := newNode (range) ;
+   n^.rangeF.lo := lo ;
+   n^.rangeF.hi := hi ;
+   RETURN n
+END makeRange ;
+
+
+(*
+   isRange - returns TRUE if node, n, is a range.
+*)
+
+PROCEDURE isRange (n: node) : BOOLEAN ;
+BEGIN
+   assert (n # NIL) ;
+   RETURN n^.kind = range
+END isRange ;
+
+
+(*
+   dupExplist -
+*)
+
+PROCEDURE dupExplist (n: node) : node ;
+VAR
+   m: node ;
+   i: CARDINAL ;
+BEGIN
+   assert (isExpList (n)) ;
+   m := makeExpList () ;
+   i := LowIndice (n^.explistF.exp) ;
+   WHILE i <= HighIndice (n^.explistF.exp) DO
+      putExpList (m, dupExpr (GetIndice (n^.explistF.exp, i))) ;
+      INC (i)
+   END ;
+   RETURN m
+END dupExplist ;
+
+
+(*
+   dupArrayref -
+*)
+
+PROCEDURE dupArrayref (n: node) : node ;
+BEGIN
+   assert (isArrayRef (n)) ;
+   RETURN makeArrayRef (dupExpr (n^.arrayrefF.array), dupExpr (n^.arrayrefF.index))
+END dupArrayref ;
+
+
+(*
+   dupPointerref -
+*)
+
+PROCEDURE dupPointerref (n: node) : node ;
+BEGIN
+   assert (isPointerRef (n)) ;
+   RETURN makePointerRef (dupExpr (n^.pointerrefF.ptr), dupExpr (n^.pointerrefF.field))
+END dupPointerref ;
+
+
+(*
+   dupComponentref -
+*)
+
+PROCEDURE dupComponentref (n: node) : node ;
+BEGIN
+   assert (isComponentRef (n)) ;
+   RETURN doMakeComponentRef (dupExpr (n^.componentrefF.rec), dupExpr (n^.componentrefF.field))
+END dupComponentref ;
+
+
+(*
+   dupBinary -
+*)
+
+PROCEDURE dupBinary (n: node) : node ;
+BEGIN
+   (* assert (isBinary (n)) ; *)
+   RETURN makeBinary (n^.kind,
+                      dupExpr (n^.binaryF.left), dupExpr (n^.binaryF.right),
+                      n^.binaryF.resultType)
+END dupBinary ;
+
+
+(*
+   dupUnary -
+*)
+
+PROCEDURE dupUnary (n: node) : node ;
+BEGIN
+   (* assert (isUnary (n)) ; *)
+   RETURN makeUnary (n^.kind, dupExpr (n^.unaryF.arg), n^.unaryF.resultType)
+END dupUnary ;
+
+
+(*
+   dupFunccall -
+*)
+
+PROCEDURE dupFunccall (n: node) : node ;
+VAR
+   m: node ;
+BEGIN
+   assert (isFuncCall (n)) ;
+   m := makeFuncCall (dupExpr (n^.funccallF.function), dupExpr (n^.funccallF.args)) ;
+   m^.funccallF.type := n^.funccallF.type ;
+   RETURN m
+END dupFunccall ;
+
+
+(*
+   dupSetValue -
+*)
+
+PROCEDURE dupSetValue (n: node) : node ;
+VAR
+   m: node ;
+   i: CARDINAL ;
+BEGIN
+   m := newNode (setvalue) ;
+   m^.setvalueF.type := n^.setvalueF.type ;
+   i := LowIndice (n^.setvalueF.values) ;
+   WHILE i <= HighIndice (n^.setvalueF.values) DO
+      m := putSetValue (m, dupExpr (GetIndice (n^.setvalueF.values, i))) ;
+      INC (i)
+   END ;
+   RETURN m
+END dupSetValue ;
+
+
+(*
+   dupExpr - duplicate the expression nodes, it does not duplicate
+             variables, literals, constants but only the expression
+             operators (including function calls and parameter lists).
+*)
+
+PROCEDURE dupExpr (n: node) : node ;
+BEGIN
+   IF n = NIL
+   THEN
+      RETURN NIL
+   ELSE
+      RETURN doDupExpr (n)
+   END
+END dupExpr ;
+
+
+(*
+   doDupExpr -
+*)
+
+PROCEDURE doDupExpr (n: node) : node ;
+BEGIN
+   assert (n # NIL) ;
+   CASE n^.kind OF
+
+   explist         : RETURN dupExplist (n) |
+   exit,
+   return,
+   stmtseq,
+   comment         : HALT |  (* should not be duplicating code.  *)
+   length          : HALT |  (* length should have been converted into unary.  *)
+   (* base constants.  *)
+   nil,
+   true,
+   false,
+   (* system types.  *)
+   address,
+   loc,
+   byte,
+   word,
+   csizet,
+   cssizet,
+   (* base types.  *)
+   boolean,
+   proc,
+   char,
+   integer,
+   cardinal,
+   longcard,
+   shortcard,
+   longint,
+   shortint,
+   real,
+   longreal,
+   shortreal,
+   bitset,
+   ztype,
+   rtype,
+   complex,
+   longcomplex,
+   shortcomplex     :  RETURN n |
+   (* language features and compound type attributes.  *)
+   type,
+   record,
+   varient,
+   var,
+   enumeration,
+   subrange,
+   subscript,
+   array,
+   string,
+   const,
+   literal,
+   varparam,
+   param,
+   varargs,
+   optarg,
+   pointer,
+   recordfield,
+   varientfield,
+   enumerationfield,
+   set,
+   proctype        :  RETURN n |
+   (* blocks.  *)
+   procedure,
+   def,
+   imp,
+   module          :  RETURN n |
+   (* statements.  *)
+   loop,
+   while,
+   for,
+   repeat,
+   case,
+   caselabellist,
+   caselist,
+   range,
+   if,
+   elsif,
+   assignment      :  RETURN n |
+   (* expressions.  *)
+   arrayref        :  RETURN dupArrayref (n) |
+   pointerref      :  RETURN dupPointerref (n) |
+   componentref    :  RETURN dupComponentref (n) |
+   cmplx,
+   and,
+   or,
+   equal,
+   notequal,
+   less,
+   greater,
+   greequal,
+   lessequal,
+   cast,
+   val,
+   plus,
+   sub,
+   div,
+   mod,
+   mult,
+   divide,
+   in              :  RETURN dupBinary (n) |
+   re,
+   im,
+   constexp,
+   deref,
+   abs,
+   chr,
+   cap,
+   high,
+   float,
+   trunc,
+   ord,
+   not,
+   neg,
+   adr,
+   size,
+   tsize,
+   min,
+   max             :  RETURN dupUnary (n) |
+   identlist       :  RETURN n |
+   vardecl         :  RETURN n |
+   funccall        :  RETURN dupFunccall (n) |
+   setvalue        :  RETURN dupSetValue (n)
+
+   END
+END doDupExpr ;
+
+
+(*
+   setNoReturn - sets noreturn field inside procedure.
+*)
+
+PROCEDURE setNoReturn (n: node; value: BOOLEAN) ;
+BEGIN
+   assert (n#NIL) ;
+   assert (isProcedure (n)) ;
+   IF n^.procedureF.noreturnused AND (n^.procedureF.noreturn # value)
+   THEN
+      metaError1 ('{%1DMad} definition module and implementation module have different <* noreturn *> attributes', n) ;
+   END ;
+   n^.procedureF.noreturn := value ;
+   n^.procedureF.noreturnused := TRUE
+END setNoReturn ;
+
+
+(*
+   makeSystem -
+*)
+
+PROCEDURE makeSystem ;
+BEGIN
+   systemN := lookupDef (makeKey ('SYSTEM')) ;
+
+   addressN := makeBase (address) ;
+   locN := makeBase (loc) ;
+   byteN := makeBase (byte) ;
+   wordN := makeBase (word) ;
+   csizetN := makeBase (csizet) ;
+   cssizetN := makeBase (cssizet) ;
+
+   adrN := makeBase (adr) ;
+   tsizeN := makeBase (tsize) ;
+   throwN := makeBase (throw) ;
+
+   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) ;
+
+   assert (sizeN#NIL) ;  (* assumed to be built already.  *)
+   sizeN := addToScope (sizeN) ;  (* also export size from system.  *)
+   leaveScope ;
+
+   addDone (addressN) ;
+   addDone (locN) ;
+   addDone (byteN) ;
+   addDone (wordN) ;
+   addDone (csizetN) ;
+   addDone (cssizetN)
+END makeSystem ;
+
+
+(*
+   makeM2rts -
+*)
+
+PROCEDURE makeM2rts ;
+BEGIN
+   m2rtsN := lookupDef (makeKey ('M2RTS'))
+END makeM2rts ;
+
+
+(*
+   makeBitnum -
+*)
+
+PROCEDURE makeBitnum () : node ;
+VAR
+   b: node ;
+BEGIN
+   b := newNode (subrange) ;
+   b^.subrangeF.type := NIL ;
+   b^.subrangeF.scope := NIL ;
+   b^.subrangeF.low := lookupConst (b, makeKey ('0')) ;
+   b^.subrangeF.high := lookupConst (b, makeKey ('31')) ;
+   RETURN b
+END makeBitnum ;
+
+
+(*
+   makeBaseSymbols -
+*)
+
+PROCEDURE makeBaseSymbols ;
+BEGIN
+   baseSymbols := initTree () ;
+
+   booleanN := makeBase (boolean) ;
+   charN := makeBase (char) ;
+   procN := makeBase (proc) ;
+   cardinalN := makeBase (cardinal) ;
+   longcardN := makeBase (longcard) ;
+   shortcardN := makeBase (shortcard) ;
+   integerN := makeBase (integer) ;
+   longintN := makeBase (longint) ;
+   shortintN := makeBase (shortint) ;
+   bitsetN := makeBase (bitset) ;
+   bitnumN := makeBitnum () ;
+   ztypeN := makeBase (ztype) ;
+   rtypeN := makeBase (rtype) ;
+   complexN := makeBase (complex) ;
+   longcomplexN := makeBase (longcomplex) ;
+   shortcomplexN := makeBase (shortcomplex) ;
+   realN := makeBase (real) ;
+   longrealN := makeBase (longreal) ;
+   shortrealN := makeBase (shortreal) ;
+
+   nilN := makeBase (nil) ;
+   trueN := makeBase (true) ;
+   falseN := makeBase (false) ;
+
+   sizeN := makeBase (size) ;
+   minN := makeBase (min) ;
+   maxN := makeBase (max) ;
+   floatN := makeBase (float) ;
+   truncN := makeBase (trunc) ;
+   ordN := makeBase (ord) ;
+   valN := makeBase (val) ;
+   chrN := makeBase (chr) ;
+   capN := makeBase (cap) ;
+   absN := makeBase (abs) ;
+   newN := makeBase (new) ;
+   disposeN := makeBase (dispose) ;
+   lengthN := makeBase (length) ;
+   incN := makeBase (inc) ;
+   decN := makeBase (dec) ;
+   inclN := makeBase (incl) ;
+   exclN := makeBase (excl) ;
+   highN := makeBase (high) ;
+   imN := makeBase (im) ;
+   reN := makeBase (re) ;
+   cmplxN := makeBase (cmplx) ;
+
+   putSymKey (baseSymbols, makeKey ('BOOLEAN'), booleanN) ;
+   putSymKey (baseSymbols, makeKey ('PROC'), procN) ;
+   putSymKey (baseSymbols, makeKey ('CHAR'), charN) ;
+   putSymKey (baseSymbols, makeKey ('CARDINAL'), cardinalN) ;
+   putSymKey (baseSymbols, makeKey ('SHORTCARD'), shortcardN) ;
+   putSymKey (baseSymbols, makeKey ('LONGCARD'), longcardN) ;
+   putSymKey (baseSymbols, makeKey ('INTEGER'), integerN) ;
+   putSymKey (baseSymbols, makeKey ('LONGINT'), longintN) ;
+   putSymKey (baseSymbols, makeKey ('SHORTINT'), shortintN) ;
+   putSymKey (baseSymbols, makeKey ('BITSET'), bitsetN) ;
+   putSymKey (baseSymbols, makeKey ('REAL'), realN) ;
+   putSymKey (baseSymbols, makeKey ('SHORTREAL'), shortrealN) ;
+   putSymKey (baseSymbols, makeKey ('LONGREAL'), longrealN) ;
+   putSymKey (baseSymbols, makeKey ('COMPLEX'), complexN) ;
+   putSymKey (baseSymbols, makeKey ('LONGCOMPLEX'), longcomplexN) ;
+   putSymKey (baseSymbols, makeKey ('SHORTCOMPLEX'), shortcomplexN) ;
+
+   putSymKey (baseSymbols, makeKey ('NIL'), nilN) ;
+   putSymKey (baseSymbols, makeKey ('TRUE'), trueN) ;
+   putSymKey (baseSymbols, makeKey ('FALSE'), falseN) ;
+   putSymKey (baseSymbols, makeKey ('SIZE'), sizeN) ;
+   putSymKey (baseSymbols, makeKey ('MIN'), minN) ;
+   putSymKey (baseSymbols, makeKey ('MAX'), maxN) ;
+   putSymKey (baseSymbols, makeKey ('FLOAT'), floatN) ;
+   putSymKey (baseSymbols, makeKey ('TRUNC'), truncN) ;
+   putSymKey (baseSymbols, makeKey ('ORD'), ordN) ;
+   putSymKey (baseSymbols, makeKey ('VAL'), valN) ;
+   putSymKey (baseSymbols, makeKey ('CHR'), chrN) ;
+   putSymKey (baseSymbols, makeKey ('CAP'), capN) ;
+   putSymKey (baseSymbols, makeKey ('ABS'), absN) ;
+   putSymKey (baseSymbols, makeKey ('NEW'), newN) ;
+   putSymKey (baseSymbols, makeKey ('DISPOSE'), disposeN) ;
+   putSymKey (baseSymbols, makeKey ('LENGTH'), lengthN) ;
+   putSymKey (baseSymbols, makeKey ('INC'), incN) ;
+   putSymKey (baseSymbols, makeKey ('DEC'), decN) ;
+   putSymKey (baseSymbols, makeKey ('INCL'), inclN) ;
+   putSymKey (baseSymbols, makeKey ('EXCL'), exclN) ;
+   putSymKey (baseSymbols, makeKey ('HIGH'), highN) ;
+   putSymKey (baseSymbols, makeKey ('CMPLX'), cmplxN) ;
+   putSymKey (baseSymbols, makeKey ('RE'), reN) ;
+   putSymKey (baseSymbols, makeKey ('IM'), 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)
+
+END makeBaseSymbols ;
+
+
+(*
+   makeBuiltins -
+*)
+
+PROCEDURE makeBuiltins ;
+BEGIN
+   bitsperunitN := makeLiteralInt (makeKey ('8')) ;
+   bitsperwordN := makeLiteralInt (makeKey ('32')) ;
+   bitspercharN := makeLiteralInt (makeKey ('8')) ;
+   unitsperwordN := makeLiteralInt (makeKey ('4')) ;
+
+   addDone (bitsperunitN) ;
+   addDone (bitsperwordN) ;
+   addDone (bitspercharN) ;
+   addDone (unitsperwordN)
+END makeBuiltins ;
+
+
+(*
+   init -
+*)
+
+PROCEDURE init ;
+BEGIN
+   lang := ansiC ;
+   outputFile := StdOut ;
+   doP := initPretty (write, writeln) ;
+   todoQ := alists.initList () ;
+   partialQ := alists.initList () ;
+   doneQ := alists.initList () ;
+   modUniverse := initTree () ;
+   defUniverse := initTree () ;
+   modUniverseI := InitIndex (1) ;
+   defUniverseI := InitIndex (1) ;
+   scopeStack := InitIndex (1) ;
+   makeBaseSymbols ;
+   makeSystem ;
+   makeBuiltins ;
+   makeM2rts ;
+   outputState := punct ;
+   tempCount := 0 ;
+   mustVisitScope := FALSE
+END init ;
+
+
+BEGIN
+   init
+END decl.
diff --git a/gcc/m2/mc/decl.mod-extra b/gcc/m2/mc/decl.mod-extra
new file mode 100644
index 00000000000..51f6de160f8
--- /dev/null
+++ b/gcc/m2/mc/decl.mod-extra
@@ -0,0 +1,64 @@
+
+
+(*
+   doLiteral -
+*)
+
+PROCEDURE doLiteral (n: node) ;
+VAR
+   s: String ;
+BEGIN
+   assert (isLiteral (n)) ;
+   s := keyToCharStar (getSymName (n)) ;
+   IF n^.literalF.type=charN
+   THEN
+      IF DynamicStrings.char (s, -1)='C'
+      THEN
+         s := DynamicStrings.Slice (DynamicStrings.Mark (s), 0, -1) ;
+	 IF DynamicStrings.char (s, 0)#'0'
+         THEN
+            s := DynamicStrings.ConCat (InitString('0'), DynamicStrings.Mark (s))
+         END
+      END ;
+      outText ("(char) ")
+   END ;
+   outTextS (s) ;
+   s := KillString (s)
+END doLiteral ;
+
+
+(*
+   isString - returns TRUE if node, n, is a string.
+*)
+
+PROCEDURE isString (n: node) : BOOLEAN ;
+BEGIN
+   assert (n#NIL) ;
+   RETURN n^.kind=string
+END isString ;
+
+
+(*
+   doString -
+*)
+
+PROCEDURE doString (n: node) ;
+VAR
+   s: String ;
+BEGIN
+   assert (isString (n)) ;
+   s := keyToCharStar (getSymName (n)) ;
+   IF DynamicStrings.Index (s, '"')=-1
+   THEN
+      outText ('"') ;
+      outTextS (s) ;
+      outText ('"')
+   ELSIF DynamicStrings.Index (s, "'")=-1
+   THEN
+      outText ('"') ;
+      outTextS (s) ;
+      outText ('"')
+   ELSE
+      metaError1 ('illegal string {%1k}', n)
+   END
+END doString ;
diff --git a/gcc/m2/mc/keyc.def b/gcc/m2/mc/keyc.def
new file mode 100644
index 00000000000..08a54507e67
--- /dev/null
+++ b/gcc/m2/mc/keyc.def
@@ -0,0 +1,324 @@
+(* keyc.def provides an interface to emitting symbols which.
+
+Copyright (C) 2016-2022 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/>.  *)
+
+DEFINITION MODULE keyc ;
+
+FROM mcPretty IMPORT pretty ;
+FROM DynamicStrings IMPORT String ;
+FROM decl IMPORT node ;
+FROM nameKey IMPORT Name ;
+
+
+(*
+   useUnistd - need to use unistd.h call using open/close/read/write require this header.
+*)
+
+PROCEDURE useUnistd ;
+
+
+(*
+   useThrow - use the throw function.
+*)
+
+PROCEDURE useThrow ;
+
+
+(*
+   useStorage - indicate we have used storage.
+*)
+
+PROCEDURE useStorage ;
+
+
+(*
+   useFree - indicate we have used free.
+*)
+
+PROCEDURE useFree ;
+
+
+(*
+   useMalloc - indicate we have used malloc.
+*)
+
+PROCEDURE useMalloc ;
+
+
+(*
+   useProc - indicate we have used proc.
+*)
+
+PROCEDURE useProc ;
+
+
+(*
+   useTrue - indicate we have used TRUE.
+*)
+
+PROCEDURE useTrue ;
+
+
+(*
+   useFalse - indicate we have used FALSE.
+*)
+
+PROCEDURE useFalse ;
+
+
+(*
+   useNull - indicate we have used NULL.
+*)
+
+PROCEDURE useNull ;
+
+
+(*
+   useMemcpy - indicate we have used memcpy.
+*)
+
+PROCEDURE useMemcpy ;
+
+
+(*
+   useIntMin - indicate we have used INT_MIN.
+*)
+
+PROCEDURE useIntMin ;
+
+
+(*
+   useUIntMin - indicate we have used UINT_MIN.
+*)
+
+PROCEDURE useUIntMin ;
+
+
+(*
+   useLongMin - indicate we have used LONG_MIN.
+*)
+
+PROCEDURE useLongMin ;
+
+
+(*
+   useULongMin - indicate we have used ULONG_MIN.
+*)
+
+PROCEDURE useULongMin ;
+
+
+(*
+   useCharMin - indicate we have used CHAR_MIN.
+*)
+
+PROCEDURE useCharMin ;
+
+
+(*
+   useUCharMin - indicate we have used UCHAR_MIN.
+*)
+
+PROCEDURE useUCharMin ;
+
+
+(*
+   useIntMax - indicate we have used INT_MAX.
+*)
+
+PROCEDURE useIntMax ;
+
+
+(*
+   useUIntMax - indicate we have used UINT_MAX.
+*)
+
+PROCEDURE useUIntMax ;
+
+
+(*
+   useLongMax - indicate we have used LONG_MAX.
+*)
+
+PROCEDURE useLongMax ;
+
+
+(*
+   useULongMax - indicate we have used ULONG_MAX.
+*)
+
+PROCEDURE useULongMax ;
+
+
+(*
+   useCharMax - indicate we have used CHAR_MAX.
+*)
+
+PROCEDURE useCharMax ;
+
+
+(*
+   useUCharMax - indicate we have used UChar_MAX.
+*)
+
+PROCEDURE useUCharMax ;
+
+
+(*
+   useSize_t - indicate we have used size_t.
+*)
+
+PROCEDURE useSize_t ;
+
+
+(*
+   useSSize_t - indicate we have used ssize_t.
+*)
+
+PROCEDURE useSSize_t ;
+
+
+(*
+   useLabs - indicate we have used labs.
+*)
+
+PROCEDURE useLabs ;
+
+
+(*
+   useAbs - indicate we have used abs.
+*)
+
+PROCEDURE useAbs ;
+
+
+(*
+   useFabs - indicate we have used fabs.
+*)
+
+PROCEDURE useFabs ;
+
+
+(*
+   useFabsl - indicate we have used fabsl.
+*)
+
+PROCEDURE useFabsl ;
+
+
+(*
+   useException - use the exceptions module, mcrts.
+*)
+
+PROCEDURE useException ;
+
+
+(*
+   useComplex - use the complex data type.
+*)
+
+PROCEDURE useComplex ;
+
+
+(*
+   useM2RTS - indicate we have used M2RTS in the converted code.
+*)
+
+PROCEDURE useM2RTS ;
+
+
+(*
+   useStrlen - indicate we have used strlen in the converted code.
+*)
+
+PROCEDURE useStrlen ;
+
+
+(*
+   useCtype - indicate we have used the toupper function.
+*)
+
+PROCEDURE useCtype ;
+
+
+(*
+   genDefs - generate definitions or includes for all
+             macros and prototypes used.
+*)
+
+PROCEDURE genDefs (p: pretty) ;
+
+
+(*
+   genConfigSystem - generate include files for config.h and system.h
+                     within the GCC framework.
+*)
+
+PROCEDURE genConfigSystem (p: pretty) ;
+
+
+(*
+   enterScope - enter a scope defined by, n.
+*)
+
+PROCEDURE enterScope (n: node) ;
+
+
+(*
+   leaveScope - leave the scope defined by, n.
+*)
+
+PROCEDURE leaveScope (n: node) ;
+
+
+(*
+   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).
+*)
+
+PROCEDURE cname (n: Name; scopes: BOOLEAN) : String ;
+
+
+(*
+   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).
+*)
+
+PROCEDURE cnamen (n: Name; scopes: BOOLEAN) : Name ;
+
+
+(*
+   cp - include C++ keywords and standard declarations to avoid.
+*)
+
+PROCEDURE cp ;
+
+
+END keyc.
diff --git a/gcc/m2/mc/keyc.mod b/gcc/m2/mc/keyc.mod
new file mode 100644
index 00000000000..c1deb1f1e0b
--- /dev/null
+++ b/gcc/m2/mc/keyc.mod
@@ -0,0 +1,1153 @@
+(* keyc maintains the C name scope and avoids C/C++ name conflicts.
+   Copyright (C) 2016-2022 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. *)
+
+IMPLEMENTATION MODULE keyc ;
+
+FROM mcPretty IMPORT pretty, print, prints, setNeedSpace, noSpace ;
+FROM Storage IMPORT ALLOCATE ;
+FROM DynamicStrings IMPORT InitString, KillString, ConCat, ConCatChar,
+                           Mark, string, InitStringCharStar ;
+FROM symbolKey IMPORT symbolTree, getSymKey, putSymKey, initTree, killTree ;
+FROM nameKey IMPORT makeKey, makekey, keyToCharStar ;
+FROM mcOptions IMPORT getHPrefix, getGccConfigSystem ;
+
+
+TYPE
+   scope = POINTER TO RECORD
+                         scoped : node ;
+			 symbols: symbolTree ;
+			 next   : scope ;
+                      END ;
+
+VAR
+   stack,
+   freeList  : scope ;
+   keywords,
+   macros    : symbolTree ;
+
+   initializedCP,
+   initializedGCC,
+
+   seenIntMin,
+   seenUIntMin,
+   seenLongMin,
+   seenULongMin,
+   seenCharMin,
+   seenUCharMin,
+   seenIntMax,
+   seenUIntMax,
+   seenLongMax,
+   seenULongMax,
+   seenCharMax,
+   seenUCharMax,
+   seenLabs,
+   seenAbs,
+   seenFabs,
+   seenFabsl,
+   seenSize_t,
+   seenSSize_t,
+
+   seenUnistd,
+   seenSysTypes,
+   seenThrow,
+   seenFree,
+   seenMalloc,
+   seenStorage,
+   seenProc,
+   seenTrue,
+   seenFalse,
+   seenNull,
+   seenMemcpy,
+   seenException,
+   seenComplex,
+   seenM2RTS,
+   seenStrlen,
+   seenCtype    : BOOLEAN ;
+
+
+(*
+   checkGccConfigSystem - issues the GCC include config.h, include system.h
+                          instead of the standard host include.
+*)
+
+PROCEDURE checkGccConfigSystem (p: pretty) ;
+BEGIN
+   IF getGccConfigSystem ()
+   THEN
+      IF NOT initializedGCC
+      THEN
+         initializedGCC := TRUE ;
+         print (p, '#include "config.h"\n');
+         print (p, '#include "system.h"\n');
+      END
+   END
+END checkGccConfigSystem ;
+
+
+(*
+   useStorage - indicate we have used storage.
+*)
+
+PROCEDURE useStorage ;
+BEGIN
+   seenStorage := TRUE
+END useStorage ;
+
+
+(*
+   useFree - indicate we have used free.
+*)
+
+PROCEDURE useFree ;
+BEGIN
+   seenFree := TRUE
+END useFree ;
+
+
+(*
+   useMalloc - indicate we have used malloc.
+*)
+
+PROCEDURE useMalloc ;
+BEGIN
+   seenMalloc := TRUE
+END useMalloc ;
+
+
+(*
+   useProc - indicate we have used proc.
+*)
+
+PROCEDURE useProc ;
+BEGIN
+   seenProc := TRUE
+END useProc ;
+
+
+(*
+   useTrue - indicate we have used TRUE.
+*)
+
+PROCEDURE useTrue ;
+BEGIN
+   seenTrue := TRUE
+END useTrue ;
+
+
+(*
+   useFalse - indicate we have used FALSE.
+*)
+
+PROCEDURE useFalse ;
+BEGIN
+   seenFalse := TRUE
+END useFalse ;
+
+
+(*
+   useNull - indicate we have used NULL.
+*)
+
+PROCEDURE useNull ;
+BEGIN
+   seenNull := TRUE
+END useNull ;
+
+
+(*
+   useMemcpy - indicate we have used memcpy.
+*)
+
+PROCEDURE useMemcpy ;
+BEGIN
+   seenMemcpy := TRUE
+END useMemcpy ;
+
+
+(*
+   useIntMin - indicate we have used INT_MIN.
+*)
+
+PROCEDURE useIntMin ;
+BEGIN
+   seenIntMin := TRUE
+END useIntMin ;
+
+
+(*
+   useUIntMin - indicate we have used UINT_MIN.
+*)
+
+PROCEDURE useUIntMin ;
+BEGIN
+   seenUIntMin := TRUE
+END useUIntMin ;
+
+
+(*
+   useLongMin - indicate we have used LONG_MIN.
+*)
+
+PROCEDURE useLongMin ;
+BEGIN
+   seenLongMin := TRUE
+END useLongMin ;
+
+
+(*
+   useULongMin - indicate we have used ULONG_MIN.
+*)
+
+PROCEDURE useULongMin ;
+BEGIN
+   seenULongMin := TRUE
+END useULongMin ;
+
+
+(*
+   useCharMin - indicate we have used CHAR_MIN.
+*)
+
+PROCEDURE useCharMin ;
+BEGIN
+   seenCharMin := TRUE
+END useCharMin ;
+
+
+(*
+   useUCharMin - indicate we have used UCHAR_MIN.
+*)
+
+PROCEDURE useUCharMin ;
+BEGIN
+   seenUCharMin := TRUE
+END useUCharMin ;
+
+
+(*
+   useUIntMin - indicate we have used UINT_MIN.
+*)
+
+PROCEDURE useUIntMin ;
+BEGIN
+   seenUIntMin := TRUE
+END useUIntMin ;
+
+
+(*
+   useIntMax - indicate we have used INT_MAX.
+*)
+
+PROCEDURE useIntMax ;
+BEGIN
+   seenIntMax := TRUE
+END useIntMax ;
+
+
+(*
+   useUIntMax - indicate we have used UINT_MAX.
+*)
+
+PROCEDURE useUIntMax ;
+BEGIN
+   seenUIntMax := TRUE
+END useUIntMax ;
+
+
+(*
+   useLongMax - indicate we have used LONG_MAX.
+*)
+
+PROCEDURE useLongMax ;
+BEGIN
+   seenLongMax := TRUE
+END useLongMax ;
+
+
+(*
+   useULongMax - indicate we have used ULONG_MAX.
+*)
+
+PROCEDURE useULongMax ;
+BEGIN
+   seenULongMax := TRUE
+END useULongMax ;
+
+
+(*
+   useCharMax - indicate we have used CHAR_MAX.
+*)
+
+PROCEDURE useCharMax ;
+BEGIN
+   seenCharMax := TRUE
+END useCharMax ;
+
+
+(*
+   useUCharMax - indicate we have used UChar_MAX.
+*)
+
+PROCEDURE useUCharMax ;
+BEGIN
+   seenUCharMax := TRUE
+END useUCharMax ;
+
+
+(*
+   useUIntMax - indicate we have used UINT_MAX.
+*)
+
+PROCEDURE useUIntMax ;
+BEGIN
+   seenUIntMax := TRUE
+END useUIntMax ;
+
+
+(*
+   useSize_t - indicate we have used size_t.
+*)
+
+PROCEDURE useSize_t ;
+BEGIN
+   seenSize_t := TRUE
+END useSize_t ;
+
+
+(*
+   useSSize_t - indicate we have used ssize_t.
+*)
+
+PROCEDURE useSSize_t ;
+BEGIN
+   seenSSize_t := TRUE ;
+   seenSysTypes := TRUE
+END useSSize_t ;
+
+
+(*
+   useLabs - indicate we have used labs.
+*)
+
+PROCEDURE useLabs ;
+BEGIN
+   seenLabs := TRUE
+END useLabs ;
+
+
+(*
+   useAbs - indicate we have used abs.
+*)
+
+PROCEDURE useAbs ;
+BEGIN
+   seenAbs := TRUE
+END useAbs ;
+
+
+(*
+   useFabs - indicate we have used fabs.
+*)
+
+PROCEDURE useFabs ;
+BEGIN
+   seenFabs := TRUE
+END useFabs ;
+
+
+(*
+   useFabsl - indicate we have used fabsl.
+*)
+
+PROCEDURE useFabsl ;
+BEGIN
+   seenFabsl := TRUE
+END useFabsl ;
+
+
+(*
+   useM2RTS - indicate we have used M2RTS in the converted code.
+*)
+
+PROCEDURE useM2RTS ;
+BEGIN
+   seenM2RTS := TRUE
+END useM2RTS ;
+
+
+(*
+   useStrlen - indicate we have used strlen in the converted code.
+*)
+
+PROCEDURE useStrlen ;
+BEGIN
+   seenStrlen := TRUE
+END useStrlen ;
+
+
+(*
+   useCtype - indicate we have used the toupper function.
+*)
+
+PROCEDURE useCtype ;
+BEGIN
+   seenCtype := TRUE
+END useCtype ;
+
+
+(*
+   checkCtype -
+*)
+
+PROCEDURE checkCtype (p: pretty) ;
+BEGIN
+   IF seenCtype
+   THEN
+      checkGccConfigSystem (p);
+      IF getGccConfigSystem ()
+      THEN
+         (* GCC header files use a safe variant.  *)
+         print (p, "#include <safe-ctype.h>\n")
+      ELSE
+         print (p, "#include <ctype.h>\n")
+      END
+   END
+END checkCtype ;
+
+
+(*
+   checkAbs - check to see if the abs family, size_t or ssize_t have been used.
+*)
+
+PROCEDURE checkAbs (p: pretty) ;
+BEGIN
+   IF seenLabs OR seenAbs OR seenFabs OR seenFabsl OR seenSize_t OR seenSSize_t
+   THEN
+      checkGccConfigSystem (p);
+      IF NOT getGccConfigSystem ()
+      THEN
+         print (p, "#include <stdlib.h>\n")
+      END
+   END
+END checkAbs ;
+
+
+(*
+   checkLimits -
+*)
+
+PROCEDURE checkLimits (p: pretty) ;
+BEGIN
+   IF seenMemcpy OR seenIntMin OR seenUIntMin OR
+      seenLongMin OR seenULongMin OR seenCharMin OR
+      seenUCharMin OR seenUIntMin OR seenIntMax OR
+      seenUIntMax OR seenLongMax OR seenULongMax OR
+      seenCharMax OR seenUCharMax OR seenUIntMax
+   THEN
+      checkGccConfigSystem (p);
+      IF NOT getGccConfigSystem ()
+      THEN
+         print (p, "#include <limits.h>\n")
+      END
+   END
+END checkLimits ;
+
+
+(*
+   checkFreeMalloc -
+*)
+
+PROCEDURE checkFreeMalloc (p: pretty) ;
+BEGIN
+   IF seenFree OR seenMalloc
+   THEN
+      checkGccConfigSystem (p);
+      IF NOT getGccConfigSystem ()
+      THEN
+         print (p, "#include <stdlib.h>\n")
+      END
+   END
+END checkFreeMalloc ;
+
+
+(*
+   checkStorage -
+*)
+
+PROCEDURE checkStorage (p: pretty) ;
+BEGIN
+   IF seenStorage
+   THEN
+      print (p, '#   include "') ;
+      prints (p, getHPrefix ()) ;
+      print (p, 'Storage.h"\n')
+   END
+END checkStorage ;
+
+
+(*
+   checkProc -
+*)
+
+PROCEDURE checkProc (p: pretty) ;
+BEGIN
+   IF seenProc
+   THEN
+      print (p, "#   if !defined (PROC_D)\n") ;
+      print (p, "#      define PROC_D\n") ;
+      print (p, "       typedef void (*PROC_t) (void);\n") ;
+      print (p, "       typedef struct { PROC_t proc; } PROC;\n") ;
+      print (p, "#   endif\n\n")
+   END
+END checkProc ;
+
+
+(*
+   checkTrue -
+*)
+
+PROCEDURE checkTrue (p: pretty) ;
+BEGIN
+   IF seenTrue
+   THEN
+      print (p, "#   if !defined (TRUE)\n") ;
+      print (p, "#      define TRUE (1==1)\n") ;
+      print (p, "#   endif\n\n")
+   END
+END checkTrue ;
+
+
+(*
+   checkFalse -
+*)
+
+PROCEDURE checkFalse (p: pretty) ;
+BEGIN
+   IF seenFalse
+   THEN
+      print (p, "#   if !defined (FALSE)\n") ;
+      print (p, "#      define FALSE (1==0)\n") ;
+      print (p, "#   endif\n\n")
+   END
+END checkFalse ;
+
+
+(*
+   checkNull -
+*)
+
+PROCEDURE checkNull (p: pretty) ;
+BEGIN
+   IF seenNull
+   THEN
+      checkGccConfigSystem (p);
+      IF NOT getGccConfigSystem ()
+      THEN
+         print (p, "#include <stddef.h>\n")
+      END
+   END
+END checkNull ;
+
+
+(*
+   checkMemcpy -
+*)
+
+PROCEDURE checkMemcpy (p: pretty) ;
+BEGIN
+   IF seenMemcpy OR seenStrlen
+   THEN
+      checkGccConfigSystem (p);
+      IF NOT getGccConfigSystem ()
+      THEN
+         print (p, "#include <string.h>\n")
+      END
+   END
+END checkMemcpy ;
+
+
+(*
+   checkM2RTS -
+*)
+
+PROCEDURE checkM2RTS (p: pretty) ;
+BEGIN
+   IF seenM2RTS
+   THEN
+      print (p, '#   include "') ;
+      prints (p, getHPrefix ()) ;
+      print (p, 'M2RTS.h"\n')
+   END
+END checkM2RTS ;
+
+
+(*
+   useException - use the exceptions module, mcrts.
+*)
+
+PROCEDURE useException ;
+BEGIN
+   seenException := TRUE
+END useException ;
+
+
+(*
+   checkException - check to see if exceptions were used.
+*)
+
+PROCEDURE checkException (p: pretty) ;
+BEGIN
+   IF seenException
+   THEN
+      print (p, '#   include "Gmcrts.h"\n')
+   END
+END checkException ;
+
+
+(*
+   useThrow - use the throw function.
+*)
+
+PROCEDURE useThrow ;
+BEGIN
+   seenThrow := TRUE
+END useThrow ;
+
+
+(*
+   checkThrow - check to see if the throw function is used.
+*)
+
+PROCEDURE checkThrow (p: pretty) ;
+BEGIN
+   IF seenThrow
+   THEN
+      (* print (p, '#   include "sys/cdefs.h"\n') ; *)
+      print (p, '#ifndef __cplusplus\n') ;
+      print (p, 'extern void throw (unsigned int);\n') ;
+      print (p, '#endif\n')
+   END
+END checkThrow ;
+
+
+(*
+   useUnistd - need to use unistd.h call using open/close/read/write require this header.
+*)
+
+PROCEDURE useUnistd ;
+BEGIN
+   seenUnistd := TRUE
+END useUnistd ;
+
+
+(*
+   checkUnistd - check to see if the unistd.h header file is required.
+*)
+
+PROCEDURE checkUnistd (p: pretty) ;
+BEGIN
+   IF seenUnistd
+   THEN
+      checkGccConfigSystem (p);
+      IF NOT getGccConfigSystem ()
+      THEN
+         print (p, '#include <unistd.h>\n')
+      END
+   END
+END checkUnistd ;
+
+
+(*
+   useComplex - use the complex data type.
+*)
+
+PROCEDURE useComplex ;
+BEGIN
+   seenComplex := TRUE
+END useComplex ;
+
+
+(*
+   checkComplex - check to see if the type complex was used.
+*)
+
+PROCEDURE checkComplex (p: pretty) ;
+BEGIN
+   IF seenComplex
+   THEN
+      checkGccConfigSystem (p);
+      IF NOT getGccConfigSystem ()
+      THEN
+         print (p, '#   include <complex.h>\n')
+      END
+   END
+END checkComplex ;
+
+
+(*
+   checkSysTypes - emit header for sys/types.h if necessary.
+*)
+
+PROCEDURE checkSysTypes (p: pretty) ;
+BEGIN
+   IF seenSysTypes
+   THEN
+      checkGccConfigSystem (p);
+      IF NOT getGccConfigSystem ()
+      THEN
+         print (p, '#   include <sys/types.h>\n')
+      END
+   END
+END checkSysTypes ;
+
+
+(*
+   fixNullPointerConst - fixup for NULL on some C++11 systems.
+*)
+
+PROCEDURE fixNullPointerConst (p: pretty) ;
+BEGIN
+   IF seenNull
+   THEN
+      print (p, '#if defined(__cplusplus)\n') ;
+      print (p, '#   undef NULL\n') ;
+      print (p, '#   define NULL 0\n') ;
+      print (p, '#endif\n')
+   END
+END fixNullPointerConst ;
+
+
+(*
+   genDefs - generate definitions or includes for all
+             macros and prototypes used.
+*)
+
+PROCEDURE genDefs (p: pretty) ;
+BEGIN
+   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)
+END genDefs ;
+
+
+(*
+   genConfigSystem - generate include files for config.h and system.h
+                     within the GCC framework.
+*)
+
+PROCEDURE genConfigSystem (p: pretty) ;
+BEGIN
+   checkGccConfigSystem (p)
+END genConfigSystem ;
+
+
+(*
+   new -
+*)
+
+PROCEDURE new (n: node) : scope ;
+VAR
+   s: scope ;
+BEGIN
+   IF freeList = NIL
+   THEN
+      NEW (s)
+   ELSE
+      s := freeList ;
+      freeList := freeList^.next
+   END ;
+   RETURN s
+END new ;
+
+
+(*
+   enterScope - enter a scope defined by, n.
+*)
+
+PROCEDURE enterScope (n: node) ;
+VAR
+   s: scope ;
+BEGIN
+   s := new (n) ;
+   WITH s^ DO
+      scoped := n ;
+      symbols := initTree () ;
+      next := stack
+   END ;
+   stack := s
+END enterScope ;
+
+
+(*
+   leaveScope - leave the scope defined by, n.
+*)
+
+PROCEDURE leaveScope (n: node) ;
+VAR
+   s: scope ;
+BEGIN
+   IF n = stack^.scoped
+   THEN
+      s := stack ;
+      stack := stack^.next ;
+      WITH s^ DO
+         scoped := NIL ;
+         killTree (symbols) ;
+         next := NIL
+      END
+   ELSE
+      HALT
+   END
+END leaveScope ;
+
+
+(*
+   mangle1 - returns TRUE if name is unique if we add _
+             to its end.
+*)
+
+PROCEDURE mangle1 (n: Name; VAR m: String; scopes: BOOLEAN) : BOOLEAN ;
+BEGIN
+   m := KillString (m) ;
+   m := InitStringCharStar (keyToCharStar (n)) ;
+   m := ConCatChar (m, '_') ;
+   RETURN NOT clash (makekey (string (m)), scopes)
+END mangle1 ;
+
+
+(*
+   mangle2 - returns TRUE if name is unique if we prepend _
+             to, n.
+*)
+
+PROCEDURE mangle2 (n: Name; VAR m: String; scopes: BOOLEAN) : BOOLEAN ;
+BEGIN
+   m := KillString (m) ;
+   m := InitStringCharStar (keyToCharStar (n)) ;
+   m := ConCat (InitString ('_'), Mark (m)) ;
+   RETURN NOT clash (makekey (string (m)), scopes)
+END mangle2 ;
+
+
+(*
+   mangleN - keep adding '_' to the end of n until it
+             no longer clashes.
+*)
+
+PROCEDURE mangleN (n: Name; VAR m: String; scopes: BOOLEAN) : BOOLEAN ;
+BEGIN
+   m := KillString (m) ;
+   m := InitStringCharStar (keyToCharStar (n)) ;
+   LOOP
+      m := ConCatChar (m, '_') ;
+      IF NOT clash (makekey (string (m)), scopes)
+      THEN
+         RETURN TRUE
+      END
+   END
+END mangleN ;
+
+
+(*
+   clash - returns TRUE if there is a clash with name, n,
+           in the current scope or C keywords or C macros.
+*)
+
+PROCEDURE clash (n: Name; scopes: BOOLEAN) : BOOLEAN ;
+BEGIN
+   IF (getSymKey (macros, n) # NIL) OR
+      (getSymKey (keywords, n) # NIL)
+   THEN
+      RETURN TRUE
+   END ;
+   RETURN scopes AND (getSymKey (stack^.symbols, n) # NIL)
+END clash ;
+
+
+(*
+   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).
+*)
+
+PROCEDURE cname (n: Name; scopes: BOOLEAN) : String ;
+VAR
+   m: String ;
+BEGIN
+   m := NIL ;
+   IF clash (n, scopes)
+   THEN
+      IF mangle1 (n, m, scopes) OR mangle2 (n, m, scopes) OR mangleN (n, m, scopes)
+      THEN
+         IF scopes
+         THEN
+            (* no longer a clash with, m, so add it to the current scope.  *)
+            n := makekey (string (m)) ;
+            putSymKey (stack^.symbols, n, m)
+         END
+      ELSE
+         (* mangleN must always succeed.  *)
+         HALT
+      END
+   ELSIF scopes
+   THEN
+      (* no clash, add it to the current scope.  *)
+      putSymKey (stack^.symbols, n, InitStringCharStar (keyToCharStar (n)))
+   END ;
+   RETURN m
+END cname ;
+
+
+(*
+   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).
+*)
+
+PROCEDURE cnamen (n: Name; scopes: BOOLEAN) : Name ;
+VAR
+   m: String ;
+BEGIN
+   m := NIL ;
+   IF clash (n, scopes)
+   THEN
+      IF mangle1 (n, m, scopes) OR mangle2 (n, m, scopes) OR mangleN (n, m, scopes)
+      THEN
+         n := makekey (string (m)) ;
+         IF scopes
+         THEN
+            (* no longer a clash with, m, so add it to the current scope.  *)
+            putSymKey (stack^.symbols, n, m)
+         END
+      ELSE
+         (* mangleN must always succeed.  *)
+         HALT
+      END
+   ELSIF scopes
+   THEN
+      (* no clash, add it to the current scope.  *)
+      putSymKey (stack^.symbols, n, InitStringCharStar (keyToCharStar (n)))
+   END ;
+   m := KillString (m) ;
+   RETURN n
+END cnamen ;
+
+
+(*
+   cp - include C++ keywords and standard declarations to avoid.
+*)
+
+PROCEDURE cp ;
+BEGIN
+   IF NOT initializedCP
+   THEN
+      initializedCP := TRUE ;
+      initCP
+   END
+END cp ;
+
+
+(*
+   initCP - add the extra keywords and standard definitions used by C++.
+*)
+
+PROCEDURE initCP ;
+BEGIN
+   add (keywords, 'delete') ;
+   add (keywords, 'try') ;
+   add (keywords, 'catch') ;
+   add (keywords, 'operator') ;
+   add (keywords, 'complex') ;
+   add (keywords, 'export') ;
+   add (keywords, 'public')
+END initCP ;
+
+
+(*
+   add -
+*)
+
+PROCEDURE add (s: symbolTree; a: ARRAY OF CHAR) ;
+BEGIN
+   putSymKey (s, makeKey (a), InitString (a))
+END add ;
+
+
+(*
+   initMacros - macros and library function names to avoid.
+*)
+
+PROCEDURE initMacros ;
+BEGIN
+   macros := initTree () ;
+   add (macros, 'FILE') ;
+   add (macros, 'EOF') ;
+   add (macros, 'stdio') ;
+   add (macros, 'stdout') ;
+   add (macros, 'stderr') ;
+   add (macros, 'write') ;
+   add (macros, 'read') ;
+   add (macros, 'exit') ;
+   add (macros, 'abs') ;
+   add (macros, 'optarg') ;
+   add (macros, 'div') ;
+   add (macros, 'sin') ;
+   add (macros, 'cos') ;
+   add (macros, 'tan') ;
+   add (macros, 'log10') ;
+   add (macros, 'trunc') ;
+   add (macros, 'I') ;
+   add (macros, 'csqrt') ;
+   add (macros, 'strlen') ;
+   add (macros, 'strcpy') ;
+   add (macros, 'free') ;
+   add (macros, 'malloc') ;
+   add (macros, 'time') ;
+   add (macros, 'main') ;
+   add (macros, 'true') ;
+   add (macros, 'false') ;
+   add (macros, 'sigfpe')
+END initMacros ;
+
+
+(*
+   initKeywords - keywords to avoid.
+*)
+
+PROCEDURE initKeywords ;
+BEGIN
+   keywords := initTree () ;
+   add (keywords, 'auto') ;
+   add (keywords, 'break') ;
+   add (keywords, 'case') ;
+   add (keywords, 'char') ;
+   add (keywords, 'const') ;
+   add (keywords, 'continue') ;
+   add (keywords, 'default') ;
+   add (keywords, 'do') ;
+   add (keywords, 'double') ;
+   add (keywords, 'else') ;
+   add (keywords, 'enum') ;
+   add (keywords, 'extern') ;
+   add (keywords, 'float') ;
+   add (keywords, 'for') ;
+   add (keywords, 'goto') ;
+   add (keywords, 'if') ;
+   add (keywords, 'int') ;
+   add (keywords, 'long') ;
+   add (keywords, 'register') ;
+   add (keywords, 'return') ;
+   add (keywords, 'short') ;
+   add (keywords, 'signed') ;
+   add (keywords, 'sizeof') ;
+   add (keywords, 'static') ;
+   add (keywords, 'struct') ;
+   add (keywords, 'switch') ;
+   add (keywords, 'typedef') ;
+   add (keywords, 'union') ;
+   add (keywords, 'unsigned') ;
+   add (keywords, 'void') ;
+   add (keywords, 'volatile') ;
+   add (keywords, 'while') ;
+   add (keywords, 'and') ;
+   add (keywords, 'or') ;
+   add (keywords, 'not') ;
+   add (keywords, 'throw') ;
+   add (keywords, 'new')
+END initKeywords ;
+
+
+(*
+   init -
+*)
+
+PROCEDURE init ;
+BEGIN
+   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 ;
+   seenUIntMin := FALSE ;
+   seenIntMax := FALSE ;
+   seenUIntMax := FALSE ;
+   seenLongMax := FALSE ;
+   seenULongMax := FALSE ;
+   seenCharMax := FALSE ;
+   seenUCharMax := FALSE ;
+   seenUIntMax := 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 := NIL ;
+   freeList := NIL ;
+   initKeywords ;
+   initMacros
+END init ;
+
+
+BEGIN
+   init
+END keyc.
diff --git a/gcc/m2/mc/lists.def b/gcc/m2/mc/lists.def
new file mode 100644
index 00000000000..f91fcddfefe
--- /dev/null
+++ b/gcc/m2/mc/lists.def
@@ -0,0 +1,112 @@
+(* lists.def Provides an unordered list manipulation package.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE lists ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM symbolKey IMPORT performOperation ;
+
+TYPE
+   list ;
+
+
+(*
+   initList - creates a new list, l.
+*)
+
+PROCEDURE initList () : list ;
+
+
+(*
+   killList - deletes the complete list, l.
+*)
+
+PROCEDURE killList (VAR l: list) ;
+
+
+(*
+   putItemIntoList - places an ADDRESS, c, into list, l.
+*)
+
+PROCEDURE putItemIntoList (l: list; c: ADDRESS) ;
+
+
+(*
+   getItemFromList - retrieves the nth ADDRESS from list, l.
+*)
+
+PROCEDURE getItemFromList (l: list; n: CARDINAL) : ADDRESS ;
+
+
+(*
+   getIndexOfList - returns the index for ADDRESS, c, in list, l.
+                    If more than one CARDINAL, c, exists the index
+                    for the first is returned.
+*)
+
+PROCEDURE getIndexOfList (l: list; c: ADDRESS) : CARDINAL ;
+
+
+(*
+   noOfItemsInList - returns the number of items in list, l.
+*)
+
+PROCEDURE noOfItemsInList (l: list) : CARDINAL ;
+
+
+(*
+   includeItemIntoList - adds an ADDRESS, c, into a list providing
+                         the value does not already exist.
+*)
+
+PROCEDURE includeItemIntoList (l: list; c: ADDRESS) ;
+
+
+(*
+   removeItemFromList - removes an ADDRESS, c, from a list.
+                        It assumes that this value only appears once.
+*)
+
+PROCEDURE removeItemFromList (l: list; c: ADDRESS) ;
+
+
+(*
+   isItemInList - returns true if a ADDRESS, c, was found in list, l.
+*)
+
+PROCEDURE isItemInList (l: list; c: ADDRESS) : BOOLEAN ;
+
+
+(*
+   foreachItemInListDo - calls procedure, P, foreach item in list, l.
+*)
+
+PROCEDURE foreachItemInListDo (l: list; p: performOperation) ;
+
+
+(*
+   duplicateList - returns a duplicate list derived from, l.
+*)
+
+PROCEDURE duplicateList (l: list) : list ;
+
+
+END lists.
diff --git a/gcc/m2/mc/lists.mod b/gcc/m2/mc/lists.mod
new file mode 100644
index 00000000000..b796a7bdd2c
--- /dev/null
+++ b/gcc/m2/mc/lists.mod
@@ -0,0 +1,304 @@
+(* Dynamic list library for pointers.
+   Copyright (C) 2015-2022 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. *)
+
+IMPLEMENTATION MODULE lists ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+CONST
+   MaxnoOfelements = 5 ;
+
+TYPE
+   list = POINTER TO RECORD
+             noOfelements: CARDINAL ;
+             elements    : ARRAY [1..MaxnoOfelements] OF ADDRESS ;
+             next        : list ;
+          END ;
+
+
+(*
+   initList - creates a new list, l.
+*)
+
+PROCEDURE initList () : list ;
+VAR
+   l: list ;
+BEGIN
+   NEW (l) ;
+   WITH l^ DO
+      noOfelements := 0 ;
+      next := NIL
+   END ;
+   RETURN l
+END initList ;
+
+
+(*
+   killList - deletes the complete list, l.
+*)
+
+PROCEDURE killList (VAR l: list) ;
+BEGIN
+   IF l#NIL
+   THEN
+      IF l^.next#NIL
+      THEN
+         killList (l^.next)
+      END ;
+      DISPOSE (l)
+   END
+END killList ;
+
+
+(*
+   putItemIntoList - places an ADDRESS, c, into list, l.
+*)
+
+PROCEDURE putItemIntoList (l: list; c: ADDRESS) ;
+BEGIN
+   WITH l^ DO
+      IF noOfelements<MaxnoOfelements
+      THEN
+         INC (noOfelements) ;
+         elements[noOfelements] := c
+      ELSIF next#NIL
+      THEN
+         putItemIntoList (next, c)
+      ELSE
+         next := initList () ;
+         putItemIntoList (next, c)
+      END
+   END
+END putItemIntoList ;
+
+
+(*
+   getItemFromList - retrieves the nth WORD from list, l.
+*)
+
+PROCEDURE getItemFromList (l: list; n: CARDINAL) : ADDRESS ;
+BEGIN
+   WHILE l#NIL DO
+      WITH l^ DO
+         IF n<=noOfelements
+         THEN
+            RETURN elements[n]
+         ELSE
+            DEC (n, noOfelements)
+         END
+      END ;
+      l := l^.next
+   END ;
+   RETURN 0
+END getItemFromList ;
+
+
+(*
+   getIndexOfList - returns the index for WORD, c, in list, l.
+                    If more than one WORD, c, exists the index
+                    for the first is returned.
+*)
+
+PROCEDURE getIndexOfList (l: list; c: ADDRESS) : CARDINAL ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN 0
+   ELSE
+      WITH l^ DO
+         i := 1 ;
+         WHILE i<=noOfelements DO
+            IF elements[i]=c
+            THEN
+               RETURN i
+            ELSE
+               INC(i)
+            END
+         END ;
+         RETURN noOfelements + getIndexOfList (next, c)
+      END
+   END
+END getIndexOfList ;
+
+
+(*
+   noOfItemsInList - returns the number of items in list, l.
+*)
+
+PROCEDURE noOfItemsInList (l: list) : CARDINAL ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN 0
+   ELSE
+      t := 0 ;
+      REPEAT
+         WITH l^ DO
+            INC (t, noOfelements)
+         END ;
+         l := l^.next
+      UNTIL l=NIL;
+      RETURN t
+   END
+END noOfItemsInList ;
+
+
+(*
+   includeItemIntoList - adds an ADDRESS, c, into a list providing
+                         the value does not already exist.
+*)
+
+PROCEDURE includeItemIntoList (l: list; c: ADDRESS) ;
+BEGIN
+   IF NOT isItemInList (l, c)
+   THEN
+      putItemIntoList (l, c)
+   END
+END includeItemIntoList ;
+
+
+(*
+   removeItem - remove an element at index, i, from the list data type.
+*)
+
+PROCEDURE removeItem (p, l: list; i: CARDINAL) ;
+BEGIN
+   WITH l^ DO
+      DEC (noOfelements) ;
+      WHILE i<=noOfelements DO
+         elements[i] := elements[i+1] ;
+         INC (i)
+      END ;
+      IF (noOfelements=0) AND (p#NIL)
+      THEN
+         p^.next := l^.next ;
+         DISPOSE (l)
+      END
+   END
+END removeItem ;
+
+
+(*
+   removeItemFromList - removes a ADDRESS, c, from a list.
+                        It assumes that this value only appears once.
+*)
+
+PROCEDURE removeItemFromList (l: list; c: ADDRESS) ;
+VAR
+   p    : list ;
+   i    : CARDINAL ;
+   found: BOOLEAN ;
+BEGIN
+   IF l#NIL
+   THEN
+      found := FALSE ;
+      p := NIL ;
+      REPEAT
+         WITH l^ DO
+            i := 1 ;
+            WHILE (i<=noOfelements) AND (elements[i]#c) DO
+               INC (i)
+            END ;
+         END ;
+         IF (i<=l^.noOfelements) AND (l^.elements[i]=c)
+         THEN
+            found := TRUE
+         ELSE
+            p := l ;
+            l := l^.next
+         END
+      UNTIL (l=NIL) OR found ;
+      IF found
+      THEN
+         removeItem (p, l, i)
+      END
+   END
+END removeItemFromList ;
+
+
+(*
+   isItemInList - returns true if a ADDRESS, c, was found in list, l.
+*)
+
+PROCEDURE isItemInList (l: list; c: ADDRESS) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   REPEAT
+      WITH l^ DO
+         i := 1 ;
+         WHILE i<=noOfelements DO
+            IF elements[i]=c
+            THEN
+               RETURN TRUE
+            ELSE
+               INC (i)
+            END
+         END
+      END ;
+      l := l^.next
+   UNTIL l=NIL ;
+   RETURN FALSE
+END isItemInList ;
+
+
+(*
+   foreachItemInListDo - calls procedure, P, foreach item in list, l.
+*)
+
+PROCEDURE foreachItemInListDo (l: list; p: performOperation) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   n := noOfItemsInList(l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      p (getItemFromList (l, i)) ;
+      INC(i)
+   END
+END foreachItemInListDo ;
+
+
+(*
+   duplicateList - returns a duplicate list derived from, l.
+*)
+
+PROCEDURE duplicateList (l: list) : list ;
+VAR
+   m   : list ;
+   n, i: CARDINAL ;
+BEGIN
+   m := initList () ;
+   n := noOfItemsInList (l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      putItemIntoList (m, getItemFromList (l, i)) ;
+      INC (i)
+   END ;
+   RETURN m
+END duplicateList ;
+
+
+END lists.
diff --git a/gcc/m2/mc/m2flex.def b/gcc/m2/mc/m2flex.def
new file mode 100644
index 00000000000..d2808f28619
--- /dev/null
+++ b/gcc/m2/mc/m2flex.def
@@ -0,0 +1,78 @@
+(* m2flex.def provides a Modula-2 definition module for m2.flex.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE m2flex ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   CloseSource - provided for semantic sugar
+*)
+
+PROCEDURE CloseSource ;
+
+
+(*
+   OpenSource - returns TRUE if file, s, can be opened and
+                all tokens are taken from this file.
+*)
+
+PROCEDURE OpenSource (s: ADDRESS) : BOOLEAN ;
+
+
+(*
+   GetToken - returns the ADDRESS of the next token.
+*)
+
+PROCEDURE GetToken () : ADDRESS ;
+
+
+(*
+   GetLineNo - returns the current line number.
+*)
+
+PROCEDURE GetLineNo () : CARDINAL ;
+
+
+(*
+   GetColumnNo - returns the column where the current token starts.
+*)
+
+PROCEDURE GetColumnNo () : CARDINAL ;
+
+
+(*
+   M2Error - displays the error message, s, after the code line and pointer
+             to the erroneous token.
+*)
+
+PROCEDURE M2Error (s: ADDRESS) ;
+
+
+(*
+   GetTotalLines - returns the total number of lines parsed.
+*)
+
+PROCEDURE GetTotalLines () : CARDINAL ;
+
+
+END m2flex.
diff --git a/gcc/m2/mc/mc.flex b/gcc/m2/mc/mc.flex
new file mode 100644
index 00000000000..b4aac79fc87
--- /dev/null
+++ b/gcc/m2/mc/mc.flex
@@ -0,0 +1,745 @@
+%{
+/* mc.flex implements lexical analysis for Modula-2.
+
+Copyright (C) 2004-2022 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 "mcReserved.h"
+#include "mcLexBuf.h"
+#include "mcComment.h"
+
+#include <time.h>
+#include <ctype.h>
+
+#if !defined(TRUE)
+#  define TRUE (1==1)
+#endif
+#if !defined(FALSE)
+#  define FALSE (1==0)
+#endif
+
+#define START_FILE(F,L)
+#define END_FILE()
+#define START_LINE(N,S)
+#define TIMEVAR_PUSH_LEX
+#define TIMEVAR_POP_LEX
+
+
+  /* m2.flex - provides a lexical analyser for GNU Modula-2.  */
+
+  struct lineInfo {
+    char            *linebuf;          /* Line contents.  */
+    unsigned int     linelen;          /* Length.  */
+    int              tokenpos;         /* Start position of token within line.  */
+    int              toklen;           /* A copy of yylen (length of token).  */
+    int              nextpos;          /* Position after token.  */
+    int              actualline;       /* Line number of this line.  */
+    int              column;           /* First column number of token on this line.  */
+    int              inuse;            /* Do we need to keep this line info?  */
+    struct lineInfo *next;
+  };
+
+  struct functionInfo {
+    char                *name;         /* Function name.  */
+    int                  module;       /* Is it really a module?  */
+    struct functionInfo *next;         /* List of nested functions.  */
+  };
+
+  static int                  lineno      =1;   /* A running count of the file line number.  */
+  static char                *filename    =NULL;
+  static int                  commentLevel=0;
+  static struct lineInfo     *currentLine=NULL;
+  static struct functionInfo *currentFunction=NULL;
+  static int                  seenFunctionStart=FALSE;
+  static int                  seenEnd=FALSE;
+  static int                  seenModuleStart=FALSE;
+  static int                  isDefinitionModule=FALSE;
+  static int                  totalLines=0;
+  static int                  seenOnlySpaces=TRUE;
+  static void                *currentComment = NULL;
+  static FILE                *inputFile = NULL;
+
+        void mcflex_mcError           (const char *);
+static  void pushLine                 (void);
+static  void popLine                  (void);
+static  void finishedLine             (void);
+static  void resetpos                 (void);
+static  void consumeLine              (void);
+static  void updatepos                (void);
+static  void skippos                  (void);
+static  void poperrorskip             (const char *);
+static  void endOfComment             (void);
+static  void handleDate               (void);
+static  void handleLine               (void);
+static  void handleFile               (void);
+static  void handleFunction           (void);
+static  void handleColumn             (void);
+static  void pushFunction             (char *function, int module);
+static  void popFunction              (void);
+static  void checkFunction            (void);
+        int  mcflex_getColumnNo       (void);
+	int  mcflex_openSource        (char *s);
+	int  mcflex_getLineNo         (void);
+	void mcflex_closeSource       (void);
+	char *mcflex_getToken         (void);
+        void _M2_mcflex_init          (void);
+        int  mcflex_getTotalLines     (void);
+extern  void  yylex                   (void);
+
+#if !defined(TRUE)
+#    define TRUE  (1==1)
+#endif
+#if !defined(FALSE)
+#    define FALSE (1==0)
+#endif
+
+#define YY_DECL void yylex (void)
+%}
+
+%x COMMENT COMMENT1 LINE0 LINE1 LINE2
+
+%%
+
+"(*"                       { updatepos();
+                             commentLevel=1; pushLine(); skippos(); currentComment = mcComment_initComment (seenOnlySpaces);
+			     BEGIN COMMENT; }
+<COMMENT>"*)"              { endOfComment(); }
+<COMMENT>"(*"              { commentLevel++; pushLine(); updatepos(); skippos(); }
+<COMMENT>"<*"              { if (commentLevel == 1) {
+                               updatepos();
+                               pushLine();
+                               skippos();
+                               BEGIN COMMENT1;
+                             } else
+                               updatepos(); skippos();
+                           }
+<COMMENT>\n                { mcComment_addText (currentComment, yytext); consumeLine(); }
+<COMMENT>.                 { mcComment_addText (currentComment, yytext); updatepos(); skippos(); }
+<COMMENT1>.                { updatepos(); skippos(); }
+<COMMENT1>"*>"             { updatepos(); skippos(); finishedLine(); BEGIN COMMENT; }
+<COMMENT1>\n.*             { consumeLine(); }
+<COMMENT1>"*)"             { poperrorskip("unterminated source code directive, missing *>");
+                             endOfComment(); }
+<COMMENT1><<EOF>>          { poperrorskip("unterminated source code directive, missing *>"); BEGIN COMMENT; }
+<COMMENT><<EOF>>           { poperrorskip("unterminated comment found at the end of the file, missing *)"); BEGIN INITIAL; }
+
+^\#.*                      { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
+\n\#.*                     { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
+<LINE0>\#[ \t]*            { updatepos(); }
+<LINE0>[0-9]+[ \t]*\"      { updatepos(); lineno=atoi(yytext)-1; BEGIN LINE1; }
+<LINE0>\n                  { mcflex_mcError("missing initial quote after #line directive"); resetpos(); BEGIN INITIAL; }
+<LINE0>[^\n]
+<LINE1>[^\"\n]+            { mcflex_mcError("missing final quote after #line directive"); resetpos(); BEGIN INITIAL; }
+<LINE1>.*\"                { updatepos();
+                             filename = (char *)realloc(filename, yyleng+1);
+			     strcpy(filename, yytext);
+                             filename[yyleng-1] = (char)0;  /* remove trailing quote */
+                             START_FILE (filename, lineno);
+                             BEGIN LINE2;
+                           }
+<LINE2>[ \t]*              { updatepos(); }
+<LINE2>\n                  { mcLexBuf_setFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>2[ \t]*\n           { mcLexBuf_setFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>1[ \t]*\n           { mcLexBuf_setFile(filename); updatepos(); BEGIN INITIAL; }
+
+\n[^\#].*                  { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+\n                         { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+
+\"[^\"\n]*\"               { updatepos(); mcLexBuf_addTokCharStar(mcReserved_stringtok, yytext); return; }
+\"[^\"\n]*$                { updatepos();
+                             mcflex_mcError("missing terminating quote, \"");
+                             resetpos(); return;
+                           }
+
+'[^'\n]*'                  { updatepos(); mcLexBuf_addTokCharStar(mcReserved_stringtok, yytext); return; }
+'[^'\n]*$                  { updatepos();
+                             mcflex_mcError("missing terminating quote, '");
+                             resetpos(); return;
+                           }
+
+<<EOF>>                    { updatepos(); mcLexBuf_addTok(mcReserved_eoftok); return; }
+\+                         { updatepos(); mcLexBuf_addTok(mcReserved_plustok); return; }
+-                          { updatepos(); mcLexBuf_addTok(mcReserved_minustok); return; }
+"*"                        { updatepos(); mcLexBuf_addTok(mcReserved_timestok); return; }
+\/                         { updatepos(); mcLexBuf_addTok(mcReserved_dividetok); return; }
+:=                         { updatepos(); mcLexBuf_addTok(mcReserved_becomestok); return; }
+\&                         { updatepos(); mcLexBuf_addTok(mcReserved_ambersandtok); return; }
+\.                         { updatepos(); mcLexBuf_addTok(mcReserved_periodtok); return; }
+\,                         { updatepos(); mcLexBuf_addTok(mcReserved_commatok); return; }
+\;                         { updatepos(); mcLexBuf_addTok(mcReserved_semicolontok); return; }
+\(                         { updatepos(); mcLexBuf_addTok(mcReserved_lparatok); return; }
+\)                         { updatepos(); mcLexBuf_addTok(mcReserved_rparatok); return; }
+\[                         { updatepos(); mcLexBuf_addTok(mcReserved_lsbratok); return; }
+\]                         { updatepos(); mcLexBuf_addTok(mcReserved_rsbratok); return; }
+\(\!                       { updatepos(); mcLexBuf_addTok(mcReserved_lsbratok); return; }
+\!\)                       { updatepos(); mcLexBuf_addTok(mcReserved_rsbratok); return; }
+\^                         { updatepos(); mcLexBuf_addTok(mcReserved_uparrowtok); return; }
+\@                         { updatepos(); mcLexBuf_addTok(mcReserved_uparrowtok); return; }
+\{                         { updatepos(); mcLexBuf_addTok(mcReserved_lcbratok); return; }
+\}                         { updatepos(); mcLexBuf_addTok(mcReserved_rcbratok); return; }
+\(\:                       { updatepos(); mcLexBuf_addTok(mcReserved_lcbratok); return; }
+\:\)                       { updatepos(); mcLexBuf_addTok(mcReserved_rcbratok); return; }
+\'                         { updatepos(); mcLexBuf_addTok(mcReserved_singlequotetok); return; }
+\=                         { updatepos(); mcLexBuf_addTok(mcReserved_equaltok); return; }
+\#                         { updatepos(); mcLexBuf_addTok(mcReserved_hashtok); return; }
+\<                         { updatepos(); mcLexBuf_addTok(mcReserved_lesstok); return; }
+\>                         { updatepos(); mcLexBuf_addTok(mcReserved_greatertok); return; }
+\<\>                       { updatepos(); mcLexBuf_addTok(mcReserved_lessgreatertok); return; }
+\<\=                       { updatepos(); mcLexBuf_addTok(mcReserved_lessequaltok); return; }
+\>\=                       { updatepos(); mcLexBuf_addTok(mcReserved_greaterequaltok); return; }
+"<*"                       { updatepos(); mcLexBuf_addTok(mcReserved_ldirectivetok); return; }
+"*>"                       { updatepos(); mcLexBuf_addTok(mcReserved_rdirectivetok); return; }
+\.\.                       { updatepos(); mcLexBuf_addTok(mcReserved_periodperiodtok); return; }
+\.\.\.                     { updatepos(); mcLexBuf_addTok(mcReserved_periodperiodperiodtok); return; }
+\:                         { updatepos(); mcLexBuf_addTok(mcReserved_colontok); return; }
+\"                         { updatepos(); mcLexBuf_addTok(mcReserved_doublequotestok); return; }
+\|                         { updatepos(); mcLexBuf_addTok(mcReserved_bartok); return; }
+\!                         { updatepos(); mcLexBuf_addTok(mcReserved_bartok); return; }
+\~                         { updatepos(); mcLexBuf_addTok(mcReserved_nottok); return; }
+AND                        { updatepos(); mcLexBuf_addTok(mcReserved_andtok); return; }
+ARRAY                      { updatepos(); mcLexBuf_addTok(mcReserved_arraytok); return; }
+BEGIN                      { updatepos(); mcLexBuf_addTok(mcReserved_begintok); return; }
+BY                         { updatepos(); mcLexBuf_addTok(mcReserved_bytok); return; }
+CASE                       { updatepos(); mcLexBuf_addTok(mcReserved_casetok); return; }
+CONST                      { updatepos(); mcLexBuf_addTok(mcReserved_consttok); return; }
+DEFINITION                 { updatepos(); isDefinitionModule = TRUE;
+                             mcLexBuf_addTok(mcReserved_definitiontok); return; }
+DIV                        { updatepos(); mcLexBuf_addTok(mcReserved_divtok); return; }
+DO                         { updatepos(); mcLexBuf_addTok(mcReserved_dotok); return; }
+ELSE                       { updatepos(); mcLexBuf_addTok(mcReserved_elsetok); return; }
+ELSIF                      { updatepos(); mcLexBuf_addTok(mcReserved_elsiftok); return; }
+END                        { updatepos(); seenEnd=TRUE;
+                             mcLexBuf_addTok(mcReserved_endtok); return; }
+EXCEPT                     { updatepos(); mcLexBuf_addTok(mcReserved_excepttok); return; }
+EXIT                       { updatepos(); mcLexBuf_addTok(mcReserved_exittok); return; }
+EXPORT                     { updatepos(); mcLexBuf_addTok(mcReserved_exporttok); return; }
+FINALLY                    { updatepos(); mcLexBuf_addTok(mcReserved_finallytok); return; }
+FOR                        { updatepos(); mcLexBuf_addTok(mcReserved_fortok); return; }
+FROM                       { updatepos(); mcLexBuf_addTok(mcReserved_fromtok); return; }
+IF                         { updatepos(); mcLexBuf_addTok(mcReserved_iftok); return; }
+IMPLEMENTATION             { updatepos(); mcLexBuf_addTok(mcReserved_implementationtok); return; }
+IMPORT                     { updatepos(); mcLexBuf_addTok(mcReserved_importtok); return; }
+IN                         { updatepos(); mcLexBuf_addTok(mcReserved_intok); return; }
+LOOP                       { updatepos(); mcLexBuf_addTok(mcReserved_looptok); return; }
+MOD                        { updatepos(); mcLexBuf_addTok(mcReserved_modtok); return; }
+MODULE                     { updatepos(); seenModuleStart=TRUE;
+                             mcLexBuf_addTok(mcReserved_moduletok); return; }
+NOT                        { updatepos(); mcLexBuf_addTok(mcReserved_nottok); return; }
+OF                         { updatepos(); mcLexBuf_addTok(mcReserved_oftok); return; }
+OR                         { updatepos(); mcLexBuf_addTok(mcReserved_ortok); return; }
+PACKEDSET                  { updatepos(); mcLexBuf_addTok(mcReserved_packedsettok); return; }
+POINTER                    { updatepos(); mcLexBuf_addTok(mcReserved_pointertok); return; }
+PROCEDURE                  { updatepos(); seenFunctionStart=TRUE;
+                             mcLexBuf_addTok(mcReserved_proceduretok); return; }
+QUALIFIED                  { updatepos(); mcLexBuf_addTok(mcReserved_qualifiedtok); return; }
+UNQUALIFIED                { updatepos(); mcLexBuf_addTok(mcReserved_unqualifiedtok); return; }
+RECORD                     { updatepos(); mcLexBuf_addTok(mcReserved_recordtok); return; }
+REM                        { updatepos(); mcLexBuf_addTok(mcReserved_remtok); return; }
+REPEAT                     { updatepos(); mcLexBuf_addTok(mcReserved_repeattok); return; }
+RETRY                      { updatepos(); mcLexBuf_addTok(mcReserved_retrytok); return; }
+RETURN                     { updatepos(); mcLexBuf_addTok(mcReserved_returntok); return; }
+SET                        { updatepos(); mcLexBuf_addTok(mcReserved_settok); return; }
+THEN                       { updatepos(); mcLexBuf_addTok(mcReserved_thentok); return; }
+TO                         { updatepos(); mcLexBuf_addTok(mcReserved_totok); return; }
+TYPE                       { updatepos(); mcLexBuf_addTok(mcReserved_typetok); return; }
+UNTIL                      { updatepos(); mcLexBuf_addTok(mcReserved_untiltok); return; }
+VAR                        { updatepos(); mcLexBuf_addTok(mcReserved_vartok); return; }
+WHILE                      { updatepos(); mcLexBuf_addTok(mcReserved_whiletok); return; }
+WITH                       { updatepos(); mcLexBuf_addTok(mcReserved_withtok); return; }
+ASM                        { updatepos(); mcLexBuf_addTok(mcReserved_asmtok); return; }
+VOLATILE                   { updatepos(); mcLexBuf_addTok(mcReserved_volatiletok); return; }
+\_\_DATE\_\_               { updatepos(); handleDate(); return; }
+\_\_LINE\_\_               { updatepos(); handleLine(); return; }
+\_\_FILE\_\_               { updatepos(); handleFile(); return; }
+\_\_FUNCTION\_\_           { updatepos(); handleFunction(); return; }
+\_\_COLUMN\_\_             { updatepos(); handleColumn(); return; }
+\_\_ATTRIBUTE\_\_          { updatepos(); mcLexBuf_addTok(mcReserved_attributetok); return; }
+\_\_BUILTIN\_\_            { updatepos(); mcLexBuf_addTok(mcReserved_builtintok); return; }
+\_\_INLINE\_\_             { updatepos(); mcLexBuf_addTok(mcReserved_inlinetok); return; }
+
+
+(([0-9]*\.[0-9]+)(E[+-]?[0-9]+)?) { updatepos(); mcLexBuf_addTokCharStar(mcReserved_realtok, yytext); return; }
+[a-zA-Z_][a-zA-Z0-9_]*     { checkFunction(); updatepos(); mcLexBuf_addTokCharStar(mcReserved_identtok, yytext); return; }
+[0-9]+                     { updatepos(); mcLexBuf_addTokCharStar(mcReserved_integertok, yytext); return; }
+[0-9]+B                    { updatepos(); mcLexBuf_addTokCharStar(mcReserved_integertok, yytext); return; }
+[0-9]+C                    { updatepos(); mcLexBuf_addTokCharStar(mcReserved_integertok, yytext); return; }
+[0-9A-F]+H                 { updatepos(); mcLexBuf_addTokCharStar(mcReserved_integertok, yytext); return; }
+[\t\r ]+                   { currentLine->tokenpos += yyleng;  /* ignore whitespace */; }
+.                          { updatepos(); mcflex_mcError("unrecognised symbol"); skippos(); }
+
+%%
+
+/* Hand built routines.  */
+
+/* handleFile handles the __FILE__ construct by wraping it in double quotes and putting
+   it into the token buffer as a string.  */
+
+static void
+handleFile (void)
+{
+  char *s = (char *)alloca (strlen (filename) + 2 + 1);
+
+  strcpy (s, "\"");
+  strcat (s, filename);
+  strcat (s, "\"");
+  mcLexBuf_addTokCharStar (mcReserved_stringtok, s);
+}
+
+/* handleLine handles the __LINE__ construct by passing an integer to
+   the token buffer.  */
+
+static void
+handleLine (void)
+{
+  mcLexBuf_addTokInteger(mcReserved_integertok, lineno);
+}
+
+/* handleColumn handles the __COLUMN__ construct by passing an integer to
+   the token buffer.  */
+
+static void
+handleColumn (void)
+{
+  mcLexBuf_addTokInteger(mcReserved_integertok, mcflex_getColumnNo());
+}
+
+/* handleDate handles the __DATE__ construct by passing the date
+   as a string to the token buffer.  */
+
+static void
+handleDate (void)
+{
+  time_t  clock = time ((long *)0);
+  char   *sdate = ctime (&clock);
+  char   *s     = (char *)alloca (strlen (sdate)+2+1);
+  char   *p     = index(sdate, '\n');
+
+  if (p != NULL) {
+    *p = (char) 0;
+  }
+  strcpy (s, "\"");
+  strcat (s, sdate);
+  strcat (s, "\"");
+  mcLexBuf_addTokCharStar (mcReserved_stringtok, s);
+}
+
+/* handleFunction handles the __FUNCTION__ construct by wrapping
+   it in double quotes and putting it into the token buffer as a string.  */
+
+static void
+handleFunction (void)
+{
+  if (currentFunction == NULL)
+    mcLexBuf_addTokCharStar (mcReserved_stringtok, (char *)("\"\""));
+  else if (currentFunction->module)
+    {
+      char *s = (char *) alloca (strlen (yytext) +
+				 strlen ("\"module  initialization\"") + 1);
+      strcpy (s, "\"module ");
+      strcat (s, currentFunction->name);
+      strcat (s, " initialization\"");
+      mcLexBuf_addTokCharStar (mcReserved_stringtok, s);
+    }
+  else
+    {
+      char *function = currentFunction->name;
+      char *s = (char *)alloca (strlen (function) + 2 + 1);
+      strcpy (s, "\"");
+      strcat (s, function);
+      strcat (s, "\"");
+      mcLexBuf_addTokCharStar (mcReserved_stringtok, s);
+    }
+}
+
+/* pushFunction pushes the function name onto the stack.  */
+
+static void
+pushFunction (char *function, int module)
+{
+  if (currentFunction == NULL)
+    {
+      currentFunction = (struct functionInfo *)malloc (sizeof (struct functionInfo));
+      currentFunction->name = strdup (function);
+      currentFunction->next = NULL;
+      currentFunction->module = module;
+    }
+  else
+    {
+      struct functionInfo *f = (struct functionInfo *)malloc (sizeof (struct functionInfo));
+      f->name = strdup (function);
+      f->next = currentFunction;
+      f->module = module;
+      currentFunction = f;
+    }
+}
+
+/* popFunction pops the current function.  */
+
+static void
+popFunction (void)
+{
+  if (currentFunction != NULL && currentFunction->next != NULL)
+    {
+      struct functionInfo *f = currentFunction;
+
+      currentFunction = currentFunction->next;
+      if (f->name != NULL)
+	free (f->name);
+      free (f);
+    }
+}
+
+/* endOfComment - handles the end of comment.  */
+
+static void
+endOfComment (void)
+{
+  if (commentLevel == 1) {
+    mcLexBuf_addTokComment (mcReserved_commenttok, currentComment);
+  }
+  commentLevel--;
+  updatepos ();
+  skippos ();
+  if (commentLevel==0) {
+    BEGIN INITIAL;
+    finishedLine ();
+  } else
+    popLine ();
+}
+
+/* mcflex_mcError displays the error message s after the code line and pointer
+   to the erroneous token.  */
+
+void
+mcflex_mcError (const char *s)
+{
+  if (currentLine->linebuf != NULL) {
+    int i=1;
+
+    printf("%s:%d:%s\n", filename, currentLine->actualline, currentLine->linebuf);
+    printf("%s:%d:%*s", filename, currentLine->actualline, 1+currentLine->tokenpos, "^");
+    while (i<currentLine->toklen) {
+      putchar('^');
+      i++;
+    }
+    putchar('\n');
+  }
+  printf("%s:%d:%s\n", filename, currentLine->actualline, s);
+}
+
+static void
+poperrorskip (const char *s)
+{
+  int nextpos =currentLine->nextpos;
+  int tokenpos=currentLine->tokenpos;
+
+  popLine();
+  mcflex_mcError(s);
+  if (currentLine != NULL) {
+    currentLine->nextpos  = nextpos;
+    currentLine->tokenpos = tokenpos;
+  }
+}
+
+/* consumeLine reads a line into a buffer, it then pushes back the whole
+   line except the initial \n.  */
+
+static void
+consumeLine (void)
+{
+  if (currentLine->linelen<yyleng) {
+    currentLine->linebuf = (char *)realloc (currentLine->linebuf, yyleng);
+    currentLine->linelen = yyleng;
+  }
+  strcpy(currentLine->linebuf, yytext+1);  /* Copy all except the initial \n */
+  lineno++;
+  totalLines++;
+  currentLine->actualline = lineno;
+  currentLine->tokenpos=0;
+  currentLine->nextpos=0;
+  currentLine->column=0;
+  START_LINE (lineno, yyleng);
+  yyless(1);                  /* Push back all but the \n */
+  seenOnlySpaces=TRUE;
+}
+
+/* detectSpaces scan yytext to see if only spaces have been seen.  */
+
+static void
+detectSpaces (void)
+{
+  char *p = yytext;
+  int   i = 0;
+
+  if ((strcmp (yytext, "(*") != 0) &&
+      (strcmp (yytext, "*)") != 0))
+    {
+      while (i < strlen (p))
+        {
+          if (! isspace (p[i]))
+            seenOnlySpaces = FALSE;
+          else if (p[i] == '\n')
+            seenOnlySpaces = TRUE;
+          i++;
+        }
+    }
+}
+
+/* updatepos updates the current token position.
+   Should be used when a rule matches a token.  */
+
+static void
+updatepos (void)
+{
+  seenFunctionStart    = FALSE;
+  seenEnd              = FALSE;
+  seenModuleStart      = FALSE;
+  currentLine->nextpos = currentLine->tokenpos+yyleng;
+  currentLine->toklen  = yyleng;
+  if (currentLine->column == 0)
+    currentLine->column = currentLine->tokenpos;
+  if (commentLevel == 0)
+    detectSpaces ();
+}
+
+/* checkFunction checks to see whether we have seen the start
+   or end of a function.  */
+
+static void
+checkFunction (void)
+{
+  if (! isDefinitionModule) {
+    if (seenModuleStart)
+      pushFunction(yytext, 1);
+    if (seenFunctionStart)
+      pushFunction(yytext, 0);
+    if (seenEnd && currentFunction != NULL &&
+	(strcmp(currentFunction->name, yytext) == 0))
+      popFunction();
+  }
+  seenFunctionStart = FALSE;
+  seenEnd           = FALSE;
+  seenModuleStart   = FALSE;
+}
+
+/* skippos skips over this token. This function should be called
+   if we are not returning and thus not calling getToken.  */
+
+static void
+skippos (void)
+{
+  currentLine->tokenpos = currentLine->nextpos;
+}
+
+/* initLine initializes a currentLine.  */
+
+static void initLine (void)
+{
+  currentLine = (struct lineInfo *)malloc (sizeof(struct lineInfo));
+
+  if (currentLine == NULL)
+    perror("malloc");
+  currentLine->linebuf    = NULL;
+  currentLine->linelen    = 0;
+  currentLine->tokenpos   = 0;
+  currentLine->toklen     = 0;
+  currentLine->nextpos    = 0;
+  currentLine->actualline = lineno;
+  currentLine->column     = 0;
+  currentLine->inuse      = TRUE;
+  currentLine->next       = NULL;
+}
+
+/* pushLine pushes a new line structure.  */
+
+static void
+pushLine (void)
+{
+  if (currentLine == NULL)
+    initLine();
+  else if (currentLine->inuse) {
+      struct lineInfo *l = (struct lineInfo *)malloc (sizeof(struct lineInfo));
+
+      if (currentLine->linebuf == NULL) {
+	l->linebuf  = NULL;
+	l->linelen  = 0;
+      } else {
+	l->linebuf    = (char *)strdup (currentLine->linebuf);
+	l->linelen    = strlen (l->linebuf)+1;
+      }
+      l->tokenpos   = currentLine->tokenpos;
+      l->toklen     = currentLine->toklen;
+      l->nextpos    = currentLine->nextpos;
+      l->actualline = currentLine->actualline;
+      l->column     = currentLine->column;
+      l->next       = currentLine;
+      currentLine   = l;
+  }
+  currentLine->inuse = TRUE;
+}
+
+/* popLine pops a line structure.  */
+
+static void
+popLine (void)
+{
+  if (currentLine != NULL) {
+    struct lineInfo *l = currentLine;
+
+    if (currentLine->linebuf != NULL)
+      free(currentLine->linebuf);
+    currentLine = l->next;
+    free(l);
+  }
+}
+
+/* resetpos resets the position of the next token to the start of the line.  */
+
+static void
+resetpos (void)
+{
+  if (currentLine != NULL)
+    currentLine->nextpos = 0;
+}
+
+/* finishedLine indicates that the current line does not need to be preserved
+   when a pushLine occurs.  */
+
+static void
+finishedLine (void)
+{
+  currentLine->inuse = FALSE;
+}
+
+/* mcflex_getToken returns a new token.  */
+
+char *
+mcflex_getToken (void)
+{
+  TIMEVAR_PUSH_LEX;
+  if (currentLine == NULL)
+    initLine ();
+  currentLine->tokenpos = currentLine->nextpos;
+  yylex ();
+  TIMEVAR_POP_LEX;
+  return yytext;
+}
+
+/* closeSource - provided for semantic sugar.  */
+
+void
+mcflex_closeSource (void)
+{
+  END_FILE ();
+}
+
+/* openSource returns TRUE if file s can be opened and
+   all tokens are taken from this file.  */
+
+int
+mcflex_openSource (char *s)
+{
+  FILE *newInputFile = fopen (s, "r");
+
+  if (newInputFile == NULL)
+    return FALSE;
+  else
+    {
+      isDefinitionModule = FALSE;
+      while (currentFunction != NULL)
+	{
+	  struct functionInfo *f = currentFunction;
+	  currentFunction = f->next;
+	  if (f->name != NULL)
+	    free (f->name);
+	  free (f);
+	}
+      yy_delete_buffer (YY_CURRENT_BUFFER);
+      if (inputFile != NULL)
+	fclose (inputFile);
+      inputFile = newInputFile;
+      yy_switch_to_buffer (yy_create_buffer (inputFile, YY_BUF_SIZE));
+      filename = strdup (s);
+      lineno =1;
+      if (currentLine != NULL)
+	currentLine->actualline = lineno;
+      START_FILE (filename, lineno);
+      return TRUE;
+    }
+}
+
+/* mcflex_getLineNo returns the current line number.  */
+
+int
+mcflex_getLineNo (void)
+{
+  if (currentLine != NULL)
+    return currentLine->actualline;
+  else
+    return 0;
+}
+
+/* mcflex_getColumnNo returns the column where the current
+   token starts.  */
+
+int
+mcflex_getColumnNo (void)
+{
+  if (currentLine != NULL)
+    return currentLine->column;
+  else
+    return 0;
+}
+
+/* getTotalLines returns the total number of lines parsed.  */
+
+int
+mcflex_getTotalLines (void)
+{
+  return totalLines;
+}
+
+/* yywrap is called when end of file is seen.  We push an eof token
+   and tell the lexical analysis to stop.  */
+
+int
+yywrap (void)
+{
+  updatepos ();
+  mcLexBuf_addTok (mcReserved_eoftok);
+  return 1;
+}
+
+void
+_M2_mcflex_init (void)
+{
+}
+
+void
+_M2_mcflex_finish (void)
+{
+}
+
+/* This is a gross hack to satisfy linking.  */
+
+void
+_M2_mcflex_ctor (void)
+{
+}
diff --git a/gcc/m2/mc/mcComment.def b/gcc/m2/mc/mcComment.def
new file mode 100644
index 00000000000..1de552666b2
--- /dev/null
+++ b/gcc/m2/mc/mcComment.def
@@ -0,0 +1,116 @@
+(* mcComment.def provides a module to remember the comments.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcComment ;  (*!m2pim*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String ;
+FROM nameKey IMPORT Name ;
+
+TYPE
+   commentDesc ;
+
+
+(*
+   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.  The new comment descriptor is returned.
+		 If onlySpaces is TRUE then an inbody comment is created.
+		 If onlySpaces is FALSE then an after statement comment is created.
+*)
+
+PROCEDURE initComment (onlySpaces: BOOLEAN) : commentDesc ;
+
+
+(*
+   addText - cs is a C string (null terminated) which contains comment text.
+*)
+
+PROCEDURE addText (cd: commentDesc; cs: ADDRESS) ;
+
+
+(*
+   getContent - returns the content of comment, cd.
+*)
+
+PROCEDURE getContent (cd: commentDesc) : String ;
+
+
+(*
+   getCommentCharStar - returns the contents of the comment, cd.
+*)
+
+PROCEDURE getCommentCharStar (cd: commentDesc) : ADDRESS ;
+
+
+(*
+   setProcedureComment - changes the type of comment, cd, to a
+                         procedure heading comment,
+                         providing it has the procname as the first word.
+*)
+
+PROCEDURE setProcedureComment (cd: commentDesc; procname: Name) ;
+
+
+(*
+   getProcedureComment - returns the procedure comment if available.
+*)
+
+PROCEDURE getProcedureComment (cd: commentDesc) : String ;
+
+
+(*
+   getAfterStatementComment - returns the after comment if available.
+*)
+
+PROCEDURE getAfterStatementComment (cd: commentDesc) : String ;
+
+
+(*
+   getInbodyStatementComment - returns the statement comment if available.
+*)
+
+PROCEDURE getInbodyStatementComment (cd: commentDesc) : String ;
+
+
+(*
+   isProcedureComment - returns TRUE if, cd, is a procedure comment.
+*)
+
+PROCEDURE isProcedureComment (cd: commentDesc) : BOOLEAN ;
+
+
+(*
+   isBodyComment - returns TRUE if, cd, is a body comment.
+*)
+
+PROCEDURE isBodyComment (cd: commentDesc) : BOOLEAN ;
+
+
+(*
+   isAfterComment - returns TRUE if, cd, is an after comment.
+*)
+
+PROCEDURE isAfterComment (cd: commentDesc) : BOOLEAN ;
+
+
+END mcComment.
diff --git a/gcc/m2/mc/mcComment.h b/gcc/m2/mc/mcComment.h
new file mode 100644
index 00000000000..5f69fc9b4c9
--- /dev/null
+++ b/gcc/m2/mc/mcComment.h
@@ -0,0 +1,40 @@
+/* mcComment interface to comment module.
+
+Copyright (C) 2018-2022 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/>.  */
+
+#ifndef mcCommentH
+#define mcCommentH
+
+/* addText the text cs is appended to the current comment.  */
+
+extern void mcComment_addText (void *cd, char *cs);
+
+
+/* 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.  The new comment descriptor is returned.
+   If onlySpaces is TRUE then an inbody comment is created.
+   If onlySpaces is FALSE then an after statement comment is created.  */
+
+extern void *mcComment_initComment (unsigned int onlySpaces);
+
+
+#endif
diff --git a/gcc/m2/mc/mcComment.mod b/gcc/m2/mc/mcComment.mod
new file mode 100644
index 00000000000..fa6cae3299b
--- /dev/null
+++ b/gcc/m2/mc/mcComment.mod
@@ -0,0 +1,293 @@
+(* mcComment.mod provides a module to remember the comments.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+IMPLEMENTATION MODULE mcComment ;   (*!m2pim*)
+
+FROM DynamicStrings IMPORT String, InitString, ConCat, RemoveWhitePrefix, Mark, KillString, InitStringCharStar, EqualCharStar, Length, Slice, string, char ;
+FROM Storage IMPORT ALLOCATE ;
+FROM nameKey IMPORT Name, keyToCharStar, lengthKey, NulName ;
+FROM mcDebug IMPORT assert ;
+FROM ASCII IMPORT nl ;
+FROM libc IMPORT printf ;
+
+
+TYPE
+   commentType = (unknown, procedureHeading, inBody, afterStatement) ;
+
+   commentDesc = POINTER TO RECORD
+                               type    :  commentType ;
+			       content :  String ;
+			       procName:  Name ;
+			       used    :  BOOLEAN ;
+                            END ;
+
+
+
+(*
+   isProcedureComment - returns TRUE if, cd, is a procedure comment.
+*)
+
+PROCEDURE isProcedureComment (cd: commentDesc) : BOOLEAN ;
+BEGIN
+   RETURN (cd # NIL) AND (cd^.type = procedureHeading)
+END isProcedureComment;
+
+
+(*
+   isBodyComment - returns TRUE if, cd, is a body comment.
+*)
+
+PROCEDURE isBodyComment (cd: commentDesc) : BOOLEAN ;
+BEGIN
+   RETURN (cd # NIL) AND (cd^.type = inBody)
+END isBodyComment;
+
+
+(*
+   isAfterComment - returns TRUE if, cd, is an after comment.
+*)
+
+PROCEDURE isAfterComment (cd: commentDesc) : BOOLEAN ;
+BEGIN
+   RETURN (cd # NIL) AND (cd^.type = afterStatement)
+END isAfterComment;
+
+
+(*
+   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.
+*)
+
+PROCEDURE initComment (onlySpaces: BOOLEAN) : commentDesc ;
+VAR
+   cd: commentDesc ;
+BEGIN
+   NEW (cd) ;
+   assert (cd # NIL) ;
+   WITH cd^ DO
+      IF onlySpaces
+      THEN
+         type := inBody
+      ELSE
+         type := afterStatement
+      END ;
+      content := InitString ('') ;
+      procName := NulName ;
+      used := FALSE
+   END ;
+   RETURN cd
+END initComment ;
+
+
+(*
+   addText - cs is a C string (null terminated) which contains comment text.
+             This is appended to the comment, cd.
+*)
+
+PROCEDURE addText (cd: commentDesc; cs: ADDRESS) ;
+BEGIN
+   IF cd # NIL
+   THEN
+      cd^.content := ConCat (cd^.content, InitStringCharStar (cs))
+   END
+END addText ;
+
+
+(*
+   Min - returns the lower of, a, and, b.
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a < b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Min ;
+
+
+(*
+   RemoveNewlines -
+*)
+
+PROCEDURE RemoveNewlines (s: String) : String ;
+BEGIN
+   WHILE Length (s) > 0 DO
+      IF char (s, 0) = nl
+      THEN
+         s := RemoveWhitePrefix (Slice (s, 1, 0))
+      ELSE
+         RETURN RemoveWhitePrefix (s)
+      END
+   END ;
+   RETURN s
+END RemoveNewlines ;
+
+
+(*
+   seenProcedure - returns TRUE if the name, procName, appears as the first word
+                   in the comment.
+*)
+
+PROCEDURE seenProcedure (cd: commentDesc; procName: Name) : BOOLEAN ;
+VAR
+   s   : String ;
+   a   : ADDRESS ;
+   i, h: CARDINAL ;
+   res : BOOLEAN ;
+BEGIN
+   a := keyToCharStar (procName) ;
+   s := RemoveNewlines (cd^.content) ;
+   s := Slice (Mark (s), 0, Min (Length (s), lengthKey (procName))) ;
+   res := EqualCharStar (s, a) ;
+   s := KillString (s) ;
+   RETURN res
+END seenProcedure ;
+
+
+(*
+   setProcedureComment - changes the type of comment, cd, to a
+                         procedure heading comment,
+                         providing it has the procname as the first word.
+*)
+
+PROCEDURE setProcedureComment (cd: commentDesc; procname: Name) ;
+BEGIN
+   IF cd # NIL
+   THEN
+      IF seenProcedure (cd, procname)
+      THEN
+         cd^.type := procedureHeading ;
+         cd^.procName := procname
+      END
+   END
+END setProcedureComment ;
+
+
+(*
+   getContent - returns the content of comment, cd.
+*)
+
+PROCEDURE getContent (cd: commentDesc) : String ;
+BEGIN
+   IF cd # NIL
+   THEN
+      RETURN cd^.content
+   END ;
+   RETURN NIL
+END getContent ;
+
+
+(*
+   getCommentCharStar - returns the C string content of comment, cd.
+*)
+
+PROCEDURE getCommentCharStar (cd: commentDesc) : ADDRESS ;
+VAR
+   s: String ;
+BEGIN
+   s := getContent (cd) ;
+   IF s = NIL
+   THEN
+      RETURN NIL
+   ELSE
+      RETURN string (s)
+   END
+END getCommentCharStar ;
+
+
+(*
+   getProcedureComment - returns the current procedure comment if available.
+*)
+
+PROCEDURE getProcedureComment (cd: commentDesc) : String ;
+BEGIN
+   IF (cd^.type = procedureHeading) AND (NOT cd^.used)
+   THEN
+      cd^.used := TRUE ;
+      RETURN cd^.content
+   END ;
+   RETURN NIL
+END getProcedureComment ;
+
+
+(*
+   getAfterStatementComment - returns the current statement after comment if available.
+*)
+
+PROCEDURE getAfterStatementComment (cd: commentDesc) : String ;
+BEGIN
+   IF (cd^.type = afterStatement) AND (NOT cd^.used)
+   THEN
+      cd^.used := TRUE ;
+      RETURN cd^.content
+   END ;
+   RETURN NIL
+END getAfterStatementComment ;
+
+
+(*
+   getInbodyStatementComment - returns the current statement after comment if available.
+*)
+
+PROCEDURE getInbodyStatementComment (cd: commentDesc) : String ;
+BEGIN
+   IF (cd^.type = inBody) AND (NOT cd^.used)
+   THEN
+      cd^.used := TRUE ;
+      RETURN cd^.content
+   END ;
+   RETURN NIL
+END getInbodyStatementComment ;
+
+
+(*
+   dumpComment -
+*)
+
+PROCEDURE dumpComment (cd: commentDesc) ;
+BEGIN
+   printf ("comment : ");
+   WITH cd^ DO
+      CASE type OF
+
+      unknown         :  printf ("unknown") |
+      procedureHeading:  printf ("procedureheading") |
+      inBody          :  printf ("inbody") |
+      afterStatement  :  printf ("afterstatement")
+
+      END ;
+      IF used
+      THEN
+         printf (" used")
+      ELSE
+         printf (" unused")
+      END ;
+      printf (" contents = %s\n", string (content))
+   END
+END dumpComment ;
+
+
+END mcComment.
diff --git a/gcc/m2/mc/mcComp.def b/gcc/m2/mc/mcComp.def
new file mode 100644
index 00000000000..ed10d760b7a
--- /dev/null
+++ b/gcc/m2/mc/mcComp.def
@@ -0,0 +1,41 @@
+(* mcComp.def provides a procedure which coordinates all passes of mc.
+
+Copyright (C) 2011-2022 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/>.  *)
+
+DEFINITION MODULE mcComp ;
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   compile - translate file, s, using a 6 pass technique.
+*)
+
+PROCEDURE compile (s: String) ;
+
+
+(*
+   getPassNo - return the pass no.
+*)
+
+PROCEDURE getPassNo () : CARDINAL ;
+
+
+END mcComp.
diff --git a/gcc/m2/mc/mcComp.mod b/gcc/m2/mc/mcComp.mod
new file mode 100644
index 00000000000..b1cfb364652
--- /dev/null
+++ b/gcc/m2/mc/mcComp.mod
@@ -0,0 +1,477 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcComp ;
+
+
+FROM FIO IMPORT StdErr ;
+FROM libc IMPORT exit ;
+
+FROM decl IMPORT node, isNodeF, isDef, isImp, isModule, isMainModule,
+                 setMainModule, setCurrentModule, getSource, isImpOrModule,
+                 lookupDef, lookupModule, lookupImp, setSource, getSymName,
+		 foreachDefModuleDo, foreachModModuleDo,
+		 getMainModule, out, hasHidden,
+		 setVisited, unsetVisited, isVisited ;
+
+FROM symbolKey IMPORT performOperation ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM mcReserved IMPORT toktype ;
+FROM mcSearch IMPORT findSourceDefFile, findSourceModFile ;
+FROM mcLexBuf IMPORT openSource, closeSource, currenttoken, getToken, reInitialize, currentstring ;
+FROM mcFileName IMPORT calculateFileName ;
+FROM mcPreprocess IMPORT preprocessModule ;
+
+FROM FormatStrings IMPORT Sprintf1 ;
+
+IMPORT mcflex ;
+IMPORT mcp1 ;
+IMPORT mcp2 ;
+IMPORT mcp3 ;
+IMPORT mcp4 ;
+IMPORT mcp5 ;
+IMPORT mcComment ;
+
+
+FROM mcError IMPORT writeFormat0, flushErrors, flushWarnings ;
+FROM nameKey IMPORT Name, NulName, getKey, keyToCharStar, makekey ;
+FROM mcPrintf IMPORT fprintf1 ;
+FROM mcQuiet IMPORT qprintf0, qprintf1, qprintf2 ;
+FROM DynamicStrings IMPORT String, InitString, KillString, InitStringCharStar, Dup, Mark, string ;
+FROM mcOptions IMPORT getExtendedOpaque ;
+
+CONST
+   Debugging = FALSE ;
+
+TYPE
+   parserFunction = PROCEDURE () : BOOLEAN ;
+   openFunction = PROCEDURE (node, BOOLEAN) : BOOLEAN ;
+
+VAR
+   currentPass: CARDINAL ;
+
+
+(*
+   doCompile - translate file, s, using a 6 pass technique.
+*)
+
+PROCEDURE doCompile (s: String) ;
+VAR
+   n: node ;
+BEGIN
+   n := initParser (s) ;
+   doPass (TRUE, TRUE, 1, p1, 'lexical analysis, modules, root decls and C preprocessor') ;
+   doPass (TRUE, TRUE, 2, p2, '[all modules] type equivalence and enumeration types') ;
+   doPass (TRUE, TRUE, 3, p3, '[all modules] import lists, types, variables and procedure declarations') ;
+   doPass (TRUE, TRUE, 4, p4, '[all modules] constant expressions') ;
+
+   IF NOT isDef (n)
+   THEN
+      IF isImp (n)
+      THEN
+         qprintf0 ('Parse implementation module\n') ;
+         doPass (FALSE, TRUE, 5, p5, '[implementation module] build code tree for all procedures and module initializations')
+      ELSE
+         qprintf0 ('Parse program module\n') ;
+         doPass (FALSE, TRUE, 5, p5, '[program module] build code tree for all procedures and module initializations')
+      END ;
+   END ;
+
+   qprintf0 ('walk tree converting it to C/C++\n') ;
+   out
+END doCompile ;
+
+
+(*
+   compile - check, s, is non NIL before calling doCompile.
+*)
+
+PROCEDURE compile (s: String) ;
+BEGIN
+   IF s#NIL
+   THEN
+      doCompile (s)
+   END
+END compile ;
+
+
+(*
+   examineCompilationUnit - opens the source file to obtain the module name and kind of module.
+*)
+
+PROCEDURE examineCompilationUnit () : node ;
+BEGIN
+   (* stop if we see eof, ';' or '[' *)
+   WHILE (currenttoken#eoftok) AND (currenttoken#semicolontok) AND (currenttoken#lsbratok) DO
+      IF currenttoken=definitiontok
+      THEN
+         getToken ;
+         IF currenttoken=moduletok
+         THEN
+            getToken ;
+	    IF currenttoken=fortok
+            THEN
+               getToken ;
+	       IF currenttoken=stringtok
+               THEN
+                  getToken
+               ELSE
+                  mcflex.mcError (string (InitString ('expecting language string after FOR keyword'))) ;
+                  exit (1)
+               END
+            END ;
+            IF currenttoken=identtok
+            THEN
+               RETURN lookupDef (makekey (currentstring))
+            END
+         ELSE
+            mcflex.mcError (string (InitString ('MODULE missing after DEFINITION keyword')))
+         END
+      ELSIF currenttoken=implementationtok
+      THEN
+         getToken ;
+         IF currenttoken=moduletok
+         THEN
+            getToken ;
+            IF currenttoken=identtok
+            THEN
+               RETURN lookupImp (makekey (currentstring))
+            END
+         ELSE
+            mcflex.mcError (string (InitString ('MODULE missing after IMPLEMENTATION keyword')))
+         END
+      ELSIF currenttoken=moduletok
+      THEN
+         getToken ;
+         IF currenttoken=identtok
+         THEN
+            RETURN lookupModule (makekey (currentstring))
+         END
+      END ;
+      getToken
+   END ;
+   mcflex.mcError (string (InitString ('failed to find module name'))) ;
+   exit (1)
+END examineCompilationUnit ;
+
+
+(*
+   peepInto - peeps into source, s, and initializes a definition/implementation or
+              program module accordingly.
+*)
+
+PROCEDURE peepInto (s: String) : node ;
+VAR
+   n       : node ;
+   fileName: String ;
+BEGIN
+   fileName := preprocessModule (s) ;
+   IF openSource (fileName)
+   THEN
+      n := examineCompilationUnit () ;
+      setSource (n, makekey (string (fileName))) ;
+      setMainModule (n) ;
+      closeSource ;
+      reInitialize ;
+      RETURN n
+   ELSE
+      fprintf1 (StdErr, 'failed to open %s\n', s) ;
+      exit (1)
+   END
+END peepInto ;
+
+
+(*
+   initParser - returns the node of the module found in the source file.
+*)
+
+PROCEDURE initParser (s: String) : node ;
+BEGIN
+   qprintf1 ('Compiling: %s\n', s) ;
+   RETURN peepInto (s)
+END initParser ;
+
+
+(*
+   p1 - wrap the pass procedure with the correct parameter values.
+*)
+
+PROCEDURE p1 (n: node) ;
+BEGIN
+   IF isDef (n)
+   THEN
+      pass (1, n, mcp1.CompilationUnit, isDef, openDef) ;
+      IF hasHidden (n) AND getExtendedOpaque ()
+      THEN
+         pass (1, lookupImp (getSymName (n)), mcp1.CompilationUnit, isImp, openMod)
+      END
+   ELSE
+      pass (1, n, mcp1.CompilationUnit, isImpOrModule, openMod)
+   END
+END p1 ;
+
+
+(*
+   p2 - wrap the pass procedure with the correct parameter values.
+*)
+
+PROCEDURE p2 (n: node) ;
+BEGIN
+   IF isDef (n)
+   THEN
+      pass (2, n, mcp2.CompilationUnit, isDef, openDef) ;
+      IF hasHidden (n) AND getExtendedOpaque ()
+      THEN
+         pass (2, lookupImp (getSymName (n)), mcp2.CompilationUnit, isImp, openMod)
+      END
+   ELSE
+      pass (2, n, mcp2.CompilationUnit, isImpOrModule, openMod)
+   END
+END p2 ;
+
+
+(*
+   p3 - wrap the pass procedure with the correct parameter values.
+*)
+
+PROCEDURE p3 (n: node) ;
+BEGIN
+   IF isDef (n)
+   THEN
+      pass (3, n, mcp3.CompilationUnit, isDef, openDef) ;
+      IF hasHidden (n) AND getExtendedOpaque ()
+      THEN
+         pass (3, lookupImp (getSymName (n)), mcp3.CompilationUnit, isImp, openMod)
+      END
+   ELSE
+      pass (3, n, mcp3.CompilationUnit, isImpOrModule, openMod)
+   END
+END p3 ;
+
+
+(*
+   p4 - wrap the pass procedure with the correct parameter values.
+*)
+
+PROCEDURE p4 (n: node) ;
+BEGIN
+   IF isDef (n)
+   THEN
+      pass (4, n, mcp4.CompilationUnit, isDef, openDef) ;
+      IF hasHidden (n) AND getExtendedOpaque ()
+      THEN
+         pass (4, lookupImp (getSymName (n)), mcp4.CompilationUnit, isImp, openMod)
+      END
+   ELSE
+      pass (4, n, mcp4.CompilationUnit, isImpOrModule, openMod)
+   END
+END p4 ;
+
+
+(*
+   p5 - wrap the pass procedure with the correct parameter values.
+*)
+
+PROCEDURE p5 (n: node) ;
+BEGIN
+   pass (5, n, mcp5.CompilationUnit, isImpOrModule, openMod)
+END p5 ;
+
+
+(*
+   doOpen -
+*)
+
+PROCEDURE doOpen (n: node; symName, fileName: String; exitOnFailure: BOOLEAN) : BOOLEAN ;
+VAR
+   postProcessed: String ;
+BEGIN
+   qprintf2('   Module %-20s : %s\n', symName, fileName) ;
+   postProcessed := preprocessModule (fileName) ;
+   setSource (n, makekey (string (postProcessed))) ;
+   setCurrentModule (n) ;
+   IF openSource (postProcessed)
+   THEN
+      RETURN TRUE
+   END ;
+   fprintf1 (StdErr, 'failed to open %s\n', fileName) ;
+   IF exitOnFailure
+   THEN
+      exit (1)
+   END ;
+   RETURN FALSE
+END doOpen ;
+
+
+(*
+   openDef - try and open the definition module source file.
+             Returns true/false if successful/unsuccessful or
+             exitOnFailure.
+*)
+
+PROCEDURE openDef (n: node; exitOnFailure: BOOLEAN) : BOOLEAN ;
+VAR
+   sourceName: Name ;
+   symName,
+   fileName  : String ;
+BEGIN
+   sourceName := getSource (n) ;
+   symName := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   IF sourceName=NulName
+   THEN
+      IF NOT findSourceDefFile (symName, fileName)
+      THEN
+         fprintf1 (StdErr, 'failed to find definition module %s.def\n', symName) ;
+         IF exitOnFailure
+         THEN
+            exit (1)
+         END
+      END
+   ELSE
+      fileName := InitStringCharStar (keyToCharStar (sourceName))
+   END ;
+   RETURN doOpen (n, symName, fileName, exitOnFailure)
+END openDef ;
+
+
+(*
+   openMod - try and open the implementation/program module source file.
+             Returns true/false if successful/unsuccessful or
+             exitOnFailure.
+*)
+
+PROCEDURE openMod (n: node; exitOnFailure: BOOLEAN) : BOOLEAN ;
+VAR
+   sourceName: Name ;
+   symName,
+   fileName  : String ;
+BEGIN
+   sourceName := getSource (n) ;
+   symName := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+   IF sourceName=NulName
+   THEN
+      IF NOT findSourceModFile (symName, fileName)
+      THEN
+         IF isImp (n)
+         THEN
+            fprintf1 (StdErr, 'failed to find implementation module %s.mod\n', symName)
+         ELSE
+            fprintf1 (StdErr, 'failed to find program module %s.mod\n', symName)
+         END ;
+         IF exitOnFailure
+         THEN
+            exit (1)
+         END
+      END
+   ELSE
+      fileName := InitStringCharStar (keyToCharStar (sourceName))
+   END ;
+   RETURN doOpen (n, symName, fileName, exitOnFailure)
+END openMod ;
+
+
+(*
+   pass -
+*)
+
+PROCEDURE pass (no: CARDINAL; n: node; f: parserFunction;
+                isnode: isNodeF; open: openFunction) ;
+BEGIN
+   IF isnode (n) AND (NOT isVisited (n))
+   THEN
+      setVisited (n) ;
+      IF open (n, TRUE)
+      THEN
+         IF NOT f ()
+         THEN
+            writeFormat0 ('compilation failed') ;
+            closeSource ;
+            RETURN
+         END ;
+         closeSource
+      END
+   END
+END pass ;
+
+
+(*
+   doPass -
+*)
+
+PROCEDURE doPass (parseDefs, parseMain: BOOLEAN;
+                  no: CARDINAL; p: performOperation; desc: ARRAY OF CHAR) ;
+VAR
+   descs: String ;
+BEGIN
+   setToPassNo (no) ;
+   descs := InitString (desc) ;
+   qprintf2 ('Pass %d: %s\n', no, descs) ;
+   foreachDefModuleDo (unsetVisited) ;
+   foreachModModuleDo (unsetVisited) ;
+   IF parseMain
+   THEN
+      unsetVisited (getMainModule ()) ;
+      IF parseDefs AND isImp (getMainModule ())
+      THEN
+         (* we need to parse the definition module of a corresponding implementation module.  *)
+         p (lookupDef (getSymName (getMainModule ())))
+      END ;
+      p (getMainModule ())
+   END ;
+   IF parseDefs
+   THEN
+      foreachDefModuleDo (p)
+   END ;
+   flushWarnings ; flushErrors ;
+   setToPassNo (0)
+END doPass ;
+
+
+(*
+   setToPassNo -
+*)
+
+PROCEDURE setToPassNo (n: CARDINAL) ;
+BEGIN
+   currentPass := n
+END setToPassNo ;
+
+
+(*
+   getPassNo - return the pass no.
+*)
+
+PROCEDURE getPassNo () : CARDINAL ;
+BEGIN
+   RETURN currentPass
+END getPassNo ;
+
+
+(*
+   init - initialise data structures for this module.
+*)
+
+PROCEDURE init ;
+BEGIN
+   setToPassNo (0)
+END init ;
+
+
+BEGIN
+   init
+END mcComp.
diff --git a/gcc/m2/mc/mcDebug.def b/gcc/m2/mc/mcDebug.def
new file mode 100644
index 00000000000..9473a144bcf
--- /dev/null
+++ b/gcc/m2/mc/mcDebug.def
@@ -0,0 +1,40 @@
+(* mcDebug.def provides simple assert and writeDebug facility.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcDebug ;
+
+
+(*
+   assert - tests the boolean, q. If false then an error is reported
+            and the execution is terminated.
+*)
+
+PROCEDURE assert (q: BOOLEAN) ;
+
+
+(*
+   writeDebug - only writes a string if the debugging mode is on.
+*)
+
+PROCEDURE writeDebug (a: ARRAY OF CHAR) ;
+
+
+END mcDebug.
diff --git a/gcc/m2/mc/mcDebug.mod b/gcc/m2/mc/mcDebug.mod
new file mode 100644
index 00000000000..01a77519f23
--- /dev/null
+++ b/gcc/m2/mc/mcDebug.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcDebug ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM mcOptions IMPORT getInternalDebugging ;
+FROM mcError IMPORT internalError ;
+
+
+(*
+   assert - tests the boolean, q. If false then an error is reported
+            and the execution is terminated.
+*)
+
+PROCEDURE assert (q: BOOLEAN) ;
+BEGIN
+   IF NOT q
+   THEN
+      internalError ('assert failed', __FILE__, __LINE__)
+   END
+END assert ;
+
+
+(*
+   writeDebug - only writes a string if internal debugging is on.
+*)
+
+PROCEDURE writeDebug (a: ARRAY OF CHAR) ;
+BEGIN
+   IF getInternalDebugging ()
+   THEN
+      WriteString(a) ; WriteLn
+   END
+END writeDebug ;
+
+
+END mcDebug.
diff --git a/gcc/m2/mc/mcError.def b/gcc/m2/mc/mcError.def
new file mode 100644
index 00000000000..dcc98223e57
--- /dev/null
+++ b/gcc/m2/mc/mcError.def
@@ -0,0 +1,178 @@
+(* mcError.def provides an interface between the string handling modules.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcError ;
+
+
+FROM SYSTEM IMPORT BYTE ;
+FROM DynamicStrings IMPORT String ;
+
+TYPE
+   error ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE internalError (a: ARRAY OF CHAR; file: ARRAY OF CHAR; line: CARDINAL) ;
+
+
+
+(* ***************************************************************************
+   The following routines are used for normal syntax and semantic error reporting
+   *************************************************************************** *)
+
+
+(*
+   writeFormat0 - displays the source module and line together
+                  with the encapsulated format string.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE writeFormat0 (a: ARRAY OF CHAR) ;
+
+
+(*
+   writeFormat1 - displays the source module and line together
+                  with the encapsulated format string.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE writeFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+
+
+(*
+   writeFormat2 - displays the module and line together with the encapsulated
+                  format strings.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE writeFormat2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+
+
+(*
+   writeFormat3 - displays the module and line together with the encapsulated
+                  format strings.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE writeFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+
+
+(*
+   newError - creates and returns a new error handle.
+*)
+
+PROCEDURE newError (atTokenNo: CARDINAL) : error ;
+
+
+(*
+   newWarning - creates and returns a new error handle suitable for a warning.
+                A warning will not stop compilation.
+*)
+
+PROCEDURE newWarning (atTokenNo: CARDINAL) : error ;
+
+
+(*
+   chainError - creates and returns a new error handle, this new error
+                is associated with, e, and is chained onto the end of, e.
+*)
+
+PROCEDURE chainError (atTokenNo: CARDINAL; e: error) : error ;
+
+
+(*
+   errorFormat routines provide a printf capability for the error handle.
+*)
+
+PROCEDURE errorFormat0 (e: error; a: ARRAY OF CHAR) ;
+PROCEDURE errorFormat1 (e: error; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+PROCEDURE errorFormat2 (e: error; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+PROCEDURE errorFormat3 (e: error; a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+PROCEDURE errorString  (e: error; str: String) ;
+
+
+(* ***************************************************************************
+   The following routines are useful for positioning and warnings and errors
+   at tokens. The strings are emitted later, so the caller must not destroy
+   the strings.
+   *************************************************************************** *)
+
+PROCEDURE errorStringAt (s: String; tok: CARDINAL) ;
+PROCEDURE errorStringAt2 (s: String; tok1, tok2: CARDINAL) ;
+PROCEDURE errorStringsAt2 (s1, s2: String; tok1, tok2: CARDINAL) ;
+PROCEDURE warnStringAt (s: String; tok: CARDINAL) ;
+PROCEDURE warnStringAt2 (s: String; tok1, tok2: CARDINAL) ;
+PROCEDURE warnStringsAt2 (s1, s2: String; tok1, tok2: CARDINAL) ;
+
+
+(*
+   warnFormat0 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*)
+
+PROCEDURE warnFormat0 (a: ARRAY OF CHAR) ;
+
+
+(*
+   warnFormat1 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*)
+
+PROCEDURE warnFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+
+
+(*
+   flushErrors - switches the output channel to the error channel
+                 and then writes out all errors.
+                 If an error is present the compilation is terminated.
+                 All warnings are ignored.
+*)
+
+PROCEDURE flushErrors ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE flushWarnings ;
+
+
+(*
+   errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
+*)
+
+PROCEDURE errorAbort0 (a: ARRAY OF CHAR) ;
+
+
+END mcError.
diff --git a/gcc/m2/mc/mcError.mod b/gcc/m2/mc/mcError.mod
new file mode 100644
index 00000000000..3b6c73cad75
--- /dev/null
+++ b/gcc/m2/mc/mcError.mod
@@ -0,0 +1,806 @@
+(* mcError.mod provides an interface between the string handling modules.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+IMPLEMENTATION MODULE mcError ;
+
+FROM ASCII IMPORT nul, nl ;
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, ConCat, ConCatChar, Mark, string, KillString, Dup ;
+FROM FIO IMPORT StdOut, WriteNBytes, Close, FlushBuffer ;
+FROM StrLib IMPORT StrLen, StrEqual ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2RTS IMPORT ExitOnHalt ;
+FROM SYSTEM IMPORT ADDRESS ;
+IMPORT StdIO ;
+
+FROM nameKey IMPORT Name, keyToCharStar ;
+FROM mcLexBuf IMPORT findFileNameFromToken, tokenToLineNo, tokenToColumnNo, getTokenNo ;
+FROM mcPrintf IMPORT printf0, printf1, printf2 ;
+
+
+CONST
+   Debugging  =  TRUE ;
+   DebugTrace = FALSE ;
+   Xcode      =  TRUE ;
+
+TYPE
+   error = POINTER TO RECORD
+                         parent,
+                         child,
+                         next  : error ;
+                         fatal : BOOLEAN ;
+                         s     : String ;
+                         token : CARDINAL ;  (* index of token causing the error *)
+                      END ;
+
+VAR
+   head      : error ;
+   inInternal: BOOLEAN ;
+
+
+(*
+   cast - casts a := b
+*)
+
+PROCEDURE cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF HIGH(a)=HIGH(b)
+   THEN
+      FOR i := 0 TO HIGH(a) DO
+         a[i] := b[i]
+      END
+   END
+END cast ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE translateNameToCharStar (VAR a: ARRAY OF CHAR;
+                                   n: CARDINAL) : BOOLEAN ;
+VAR
+   argno,
+   i, h : CARDINAL ;
+BEGIN
+   argno := 1 ;
+   i := 0 ;
+   h := StrLen (a) ;
+   WHILE i<h DO
+      IF (a[i]='%') AND (i+1<h)
+      THEN
+         IF (a[i+1]='a') AND (argno=n)
+         THEN
+            a[i+1] := 's' ;
+            RETURN TRUE
+         END ;
+         INC (argno) ;
+         IF argno>n
+         THEN
+            (* all done *)
+            RETURN FALSE
+         END
+      END ;
+      INC (i)
+   END ;
+   RETURN FALSE
+END translateNameToCharStar ;
+
+
+(*
+   outString - writes the contents of String to stdout.
+               The string, s, is destroyed.
+*)
+
+PROCEDURE outString (file: String; line, col: CARDINAL; s: String) ;
+VAR
+   leader : String ;
+   p, q   : POINTER TO CHAR ;
+   space,
+   newline: BOOLEAN ;
+BEGIN
+   INC (col) ;
+   IF Xcode
+   THEN
+      leader := Sprintf2(Mark(InitString('%s:%d:')), file, line)
+   ELSE
+      leader := Sprintf3(Mark(InitString('%s:%d:%d:')), file, line, col)
+   END ;
+   p := string(s) ;
+   newline := TRUE ;
+   space := FALSE ;
+   WHILE (p#NIL) AND (p^#nul) DO
+      IF newline
+      THEN
+         q := string (leader) ;
+         WHILE (q#NIL) AND (q^#nul) DO
+            StdIO.Write (q^) ;
+            INC (q)
+         END
+      END ;
+      newline := (p^=nl) ;
+      space := (p^=' ') ;
+      IF newline AND Xcode
+      THEN
+         printf1 ('(pos: %d)', col)
+      END ;
+      StdIO.Write (p^) ;
+      INC (p)
+   END ;
+   IF NOT newline
+   THEN
+      IF Xcode
+      THEN
+         IF NOT space
+         THEN
+            StdIO.Write (' ')
+         END ;
+         printf1 ('(pos: %d)', col)
+      END ;
+      StdIO.Write (nl)
+   END ;
+   FlushBuffer (StdOut) ;
+   IF NOT Debugging
+   THEN
+      s      := KillString (s) ;
+      leader := KillString (leader)
+   END
+END outString ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE internalError (a: ARRAY OF CHAR; file: ARRAY OF CHAR; line: CARDINAL) ;
+BEGIN
+   ExitOnHalt (1) ;
+   IF NOT inInternal
+   THEN
+      inInternal := TRUE ;
+      flushErrors ;
+      outString (findFileNameFromToken (getTokenNo (), 0),
+                 tokenToLineNo (getTokenNo (), 0),
+                 tokenToColumnNo (getTokenNo (), 0),
+                 Mark(InitString ('*** fatal error ***')))
+   END ;
+   outString (Mark (InitString (file)), line, 0,
+              ConCat (Mark (InitString('*** internal error *** ')), Mark (InitString (a)))) ;
+   HALT
+END internalError ;
+
+
+(* ***************************************************************************
+   The following routines are used for normal syntax and semantic error reporting
+   *************************************************************************** *)
+
+
+(*
+   writeFormat0 - displays the source module and line together
+                  with the encapsulated format string.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE writeFormat0 (a: ARRAY OF CHAR) ;
+VAR
+   e: error ;
+BEGIN
+   e := newError (getTokenNo ()) ;
+   WITH e^ DO
+      s := Sprintf0 (Mark (InitString(a)))
+   END
+END writeFormat0 ;
+
+
+(*
+   WarnFormat0 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*)
+
+PROCEDURE warnFormat0 (a: ARRAY OF CHAR) ;
+VAR
+   e: error ;
+BEGIN
+   e := newWarning (getTokenNo()) ;
+   WITH e^ DO
+      s := Sprintf0 (Mark (InitString (a)))
+   END
+END warnFormat0 ;
+
+
+(*
+   DoFormat1 -
+*)
+
+PROCEDURE doFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) : String ;
+VAR
+   s: String ;
+   n: Name ;
+BEGIN
+   IF translateNameToCharStar(a, 1)
+   THEN
+      cast(n, w) ;
+      s := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      s := Sprintf1 (Mark (InitString (a)), s)
+   ELSE
+      s := Sprintf1 (Mark (InitString (a)), w)
+   END ;
+   RETURN s
+END doFormat1 ;
+
+
+(*
+   writeFormat1 - displays the source module and line together
+                  with the encapsulated format string.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE writeFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   e: error ;
+BEGIN
+   e := newError (getTokenNo ()) ;
+   e^.s := doFormat1 (a, w)
+END writeFormat1 ;
+
+
+(*
+   warnFormat1 - displays the source module and line together
+                 with the encapsulated format string.
+                 Used for simple warning messages tied to the current token.
+*)
+
+PROCEDURE warnFormat1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   e: error ;
+BEGIN
+   e := newWarning (getTokenNo ()) ;
+   e^.s := doFormat1 (a, w)
+END warnFormat1 ;
+
+
+(*
+   doFormat2 -
+*)
+
+PROCEDURE doFormat2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) : String ;
+VAR
+   n     : Name ;
+   s,
+   s1, s2: String ;
+   b     : BITSET ;
+BEGIN
+   b := {} ;
+   IF translateNameToCharStar (a, 1)
+   THEN
+      cast (n, w1) ;
+      s1 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 1)
+   END ;
+   IF translateNameToCharStar(a, 2)
+   THEN
+      cast (n, w2) ;
+      s2 := Mark (InitStringCharStar (keyToCharStar(n))) ;
+      INCL (b, 2)
+   END ;
+   CASE b OF
+
+   {}   :  s := Sprintf2 (Mark (InitString (a)), w1, w2) |
+   {1}  :  s := Sprintf2 (Mark (InitString (a)), s1, w2) |
+   {2}  :  s := Sprintf2 (Mark (InitString (a)), w1, s2) |
+   {1,2}:  s := Sprintf2 (Mark (InitString (a)), s1, s2)
+
+   ELSE
+      HALT
+   END ;
+   RETURN s
+END doFormat2 ;
+
+
+(*
+   writeFormat2 - displays the module and line together with the encapsulated
+                  format strings.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE writeFormat2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+VAR
+   e: error ;
+BEGIN
+   e := newError (getTokenNo()) ;
+   e^.s := doFormat2 (a, w1, w2)
+END writeFormat2 ;
+
+
+PROCEDURE doFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) : String ;
+VAR
+   n            : Name ;
+   s, s1, s2, s3: String ;
+   b            : BITSET ;
+BEGIN
+   b := {} ;
+   IF translateNameToCharStar (a, 1)
+   THEN
+      cast (n, w1) ;
+      s1 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL(b, 1)
+   END ;
+   IF translateNameToCharStar (a, 2)
+   THEN
+      cast (n, w2) ;
+      s2 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 2)
+   END ;
+   IF translateNameToCharStar (a, 3)
+   THEN
+      cast(n, w3) ;
+      s3 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 3)
+   END ;
+   CASE b OF
+
+   {}     :  s := Sprintf3 (Mark (InitString (a)), w1, w2, w3) |
+   {1}    :  s := Sprintf3 (Mark (InitString (a)), s1, w2, w3) |
+   {2}    :  s := Sprintf3 (Mark (InitString (a)), w1, s2, w3) |
+   {1,2}  :  s := Sprintf3 (Mark (InitString (a)), s1, s2, w3) |
+   {3}    :  s := Sprintf3 (Mark (InitString (a)), w1, w2, s3) |
+   {1,3}  :  s := Sprintf3 (Mark (InitString (a)), s1, w2, s3) |
+   {2,3}  :  s := Sprintf3 (Mark (InitString (a)), w1, s2, s3) |
+   {1,2,3}:  s := Sprintf3 (Mark (InitString (a)), s1, s2, s3)
+
+   ELSE
+      HALT
+   END ;
+   RETURN s
+END doFormat3 ;
+
+
+(*
+   writeFormat3 - displays the module and line together with the encapsulated
+                  format strings.
+                  Used for simple error messages tied to the current token.
+*)
+
+PROCEDURE writeFormat3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+VAR
+   e: error ;
+BEGIN
+   e := newError (getTokenNo ()) ;
+   e^.s := doFormat3 (a, w1, w2, w3)
+END writeFormat3 ;
+
+
+(*
+   newError - creates and returns a new error handle.
+*)
+
+PROCEDURE newError (atTokenNo: CARDINAL) : error ;
+VAR
+   e, f: error ;
+BEGIN
+   NEW (e) ;
+   WITH e^ DO
+      s      := NIL ;
+      token  := atTokenNo ;
+      next   := NIL ;
+      parent := NIL ;
+      child  := NIL ;
+      fatal  := TRUE
+   END ;
+   IF (head=NIL) OR (head^.token>atTokenNo)
+   THEN
+      e^.next := head ;
+      head    := e
+   ELSE
+      f := head ;
+      WHILE (f^.next#NIL) AND (f^.next^.token<atTokenNo) DO
+         f := f^.next
+      END ;
+      e^.next := f^.next ;
+      f^.next := e
+   END ;
+   RETURN e
+END newError ;
+
+
+(*
+   newWarning - creates and returns a new error handle suitable for a warning.
+                A warning will not stop compilation.
+*)
+
+PROCEDURE newWarning (atTokenNo: CARDINAL) : error ;
+VAR
+   e: error ;
+BEGIN
+   e := newError (atTokenNo) ;
+   e^.fatal := FALSE ;
+   RETURN e
+END newWarning ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE chainError (atTokenNo: CARDINAL; e: error) : error ;
+VAR
+   f: error ;
+BEGIN
+   IF e=NIL
+   THEN
+      RETURN newError (atTokenNo)
+   ELSE
+      NEW (f) ;
+      WITH f^ DO
+         s      := NIL ;
+         token  := atTokenNo ;
+         next   := e^.child ;
+         parent := e ;
+         child  := NIL ;
+         fatal  := e^.fatal
+      END ;
+      e^.child := f
+   END ;
+   RETURN f
+END chainError ;
+
+
+(*
+   errorFormat routines provide a printf capability for the error handle.
+*)
+
+PROCEDURE errorFormat0 (e: error; a: ARRAY OF CHAR) ;
+BEGIN
+   WITH e^ DO
+      IF s=NIL
+      THEN
+         s := Sprintf0 (Mark (InitString (a)))
+      ELSE
+         s := ConCat(s, Mark(Sprintf0 (Mark (InitString (a)))))
+      END
+   END
+END errorFormat0 ;
+
+
+PROCEDURE errorFormat1 (e: error; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   s1: String ;
+BEGIN
+   s1 := doFormat1 (a, w) ;
+   WITH e^ DO
+      IF s=NIL
+      THEN
+         s := s1
+      ELSE
+         s := ConCat (s, Mark (s1))
+      END
+   END
+END errorFormat1 ;
+
+
+PROCEDURE errorFormat2 (e: error; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+VAR
+   s1: String ;
+BEGIN
+   s1 := doFormat2 (a, w1, w2) ;
+   WITH e^ DO
+      IF s=NIL
+      THEN
+         s := s1
+      ELSE
+         s := ConCat (s, Mark (s1))
+      END
+   END
+END errorFormat2 ;
+
+
+PROCEDURE errorFormat3 (e: error; a: ARRAY OF CHAR;
+                        w1, w2, w3: ARRAY OF BYTE) ;
+VAR
+   s1: String ;
+BEGIN
+   s1 := doFormat3 (a, w1, w2, w3) ;
+   WITH e^ DO
+      IF s=NIL
+      THEN
+         s := s1
+      ELSE
+         s := ConCat (s, Mark (s1))
+      END
+   END
+END errorFormat3 ;
+
+
+PROCEDURE errorString (e: error; str: String) ;
+BEGIN
+   WITH e^ DO
+      s := str
+   END
+END errorString ;
+
+
+(*
+   init - initializes the error list.
+*)
+
+PROCEDURE init ;
+BEGIN
+   head := NIL ;
+   inInternal := FALSE
+END init ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE checkIncludes (token: CARDINAL; depth: CARDINAL) ;
+VAR
+   included: String ;
+   lineno  : CARDINAL ;
+BEGIN
+   included := findFileNameFromToken (token, depth+1) ;
+   IF included#NIL
+   THEN
+      lineno := tokenToLineNo (token, depth+1) ;
+      IF depth=0
+      THEN
+         printf2('In file included from %s:%d', included, lineno)
+      ELSE
+         printf2('                 from %s:%d', included, lineno)
+      END ;
+      IF findFileNameFromToken (token, depth+2)=NIL
+      THEN
+         printf0(':\n')
+      ELSE
+         printf0(',\n')
+      END ;
+      checkIncludes (token, depth+1)
+   END
+END checkIncludes ;
+
+
+(*
+   flushAll - flushes all errors in list, e.
+*)
+
+PROCEDURE flushAll (e: error; FatalStatus: BOOLEAN) : BOOLEAN ;
+VAR
+   f      : error ;
+   written: BOOLEAN ;
+BEGIN
+   written := FALSE ;
+   IF e#NIL
+   THEN
+      REPEAT
+         WITH e^ DO
+            IF (FatalStatus=fatal) AND (s#NIL)
+            THEN
+               checkIncludes (token, 0) ;
+               IF fatal
+               THEN
+                  s := ConCat (InitString (' error: '), Mark (s))
+               ELSE
+                  s := ConCat (InitString(' warning: '), Mark (s))
+               END ;
+               outString (findFileNameFromToken (token, 0),
+                          tokenToLineNo (token, 0), tokenToColumnNo (token, 0), s) ;
+               IF (child#NIL) AND flushAll (child, FatalStatus)
+               THEN
+               END ;
+               s := NIL ;
+               written := TRUE
+            END
+         END ;
+         f := e ;
+         e := e^.next ;
+         IF NOT Debugging
+         THEN
+            WITH f^ DO
+               s := KillString(s)
+            END ;
+            DISPOSE (f)
+         END ;
+      UNTIL e=NIL
+   END ;
+   RETURN written
+END flushAll ;
+
+
+(*
+   flushErrors - switches the output channel to the error channel
+                 and then writes out all errors.
+*)
+
+PROCEDURE flushErrors ;
+BEGIN
+   IF DebugTrace
+   THEN
+      printf0 ('\nFlushing all errors\n') ;
+      printf0 ('===================\n')
+   END ;
+   IF flushAll (head, TRUE)
+   THEN
+      ExitOnHalt (1) ;
+      HALT
+   END
+END flushErrors ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE flushWarnings ;
+BEGIN
+   IF flushAll (head, FALSE)
+   THEN
+   END
+END flushWarnings ;
+
+
+(*
+   errorStringsAt2 - given error strings, s1, and, s2, it places these
+                     strings at token positions, tok1 and tok2, respectively.
+                     Both strings are consumed.
+*)
+
+PROCEDURE errorStringsAt2 (s1, s2: String; tok1, tok2: CARDINAL) ;
+VAR
+   e: error ;
+BEGIN
+   IF s1=s2
+   THEN
+      s2 := Dup (s1)
+   END ;
+   e := newError (tok1) ;
+   errorString (e, s1) ;
+   errorString (chainError (tok2, e), s2)
+END errorStringsAt2 ;
+
+
+(*
+   errorStringAt2 - given an error string, s, it places this
+                    string at token positions, tok1 and tok2, respectively.
+                    The string is consumed.
+*)
+
+PROCEDURE errorStringAt2 (s: String; tok1, tok2: CARDINAL) ;
+BEGIN
+   errorStringsAt2 (s, s, tok1, tok2)
+END errorStringAt2 ;
+
+
+(*
+   errorStringAt - given an error string, s, it places this
+                   string at token position, tok.
+                   The string is consumed.
+*)
+
+PROCEDURE errorStringAt (s: String; tok: CARDINAL) ;
+VAR
+   e: error ;
+BEGIN
+   e := newError (tok) ;
+   errorString (e, s)
+END errorStringAt ;
+
+
+(*
+   warnStringsAt2 - given warning strings, s1, and, s2, it places these
+                    strings at token positions, tok1 and tok2, respectively.
+                    Both strings are consumed.
+*)
+
+PROCEDURE warnStringsAt2 (s1, s2: String; tok1, tok2: CARDINAL) ;
+VAR
+   e: error ;
+BEGIN
+   IF s1=s2
+   THEN
+      s2 := Dup (s1)
+   END ;
+   e := newWarning (tok1) ;
+   errorString (e, s1) ;
+   errorString (chainError (tok2, e), s2)
+END warnStringsAt2 ;
+
+
+(*
+   warnStringAt2 - given an warning string, s, it places this
+                   string at token positions, tok1 and tok2, respectively.
+                   The string is consumed.
+*)
+
+PROCEDURE warnStringAt2 (s: String; tok1, tok2: CARDINAL) ;
+BEGIN
+   warnStringsAt2 (s, s, tok1, tok2)
+END warnStringAt2 ;
+
+
+(*
+   warnStringAt - given an error string, s, it places this
+                  string at token position, tok.
+                  The string is consumed.
+*)
+
+PROCEDURE warnStringAt (s: String; tok: CARDINAL) ;
+VAR
+   e: error ;
+BEGIN
+   e := newWarning (tok) ;
+   errorString (e, s)
+END warnStringAt ;
+
+
+(*
+   errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
+*)
+
+PROCEDURE errorAbort0 (a: ARRAY OF CHAR) ;
+BEGIN
+   flushWarnings ;
+   IF NOT StrEqual (a, '')
+   THEN
+      writeFormat0(a)
+   END ;
+   IF NOT flushAll(head, TRUE)
+   THEN
+      writeFormat0 ('unidentified error') ;
+      IF flushAll (head, TRUE)
+      THEN
+      END
+   END ;
+   ExitOnHalt (1) ;
+   HALT
+END errorAbort0 ;
+
+
+BEGIN
+   init
+END mcError.
diff --git a/gcc/m2/mc/mcFileName.def b/gcc/m2/mc/mcFileName.def
new file mode 100644
index 00000000000..132a1a70b42
--- /dev/null
+++ b/gcc/m2/mc/mcFileName.def
@@ -0,0 +1,64 @@
+(* mcFileName.def Provides a procedure to calculate a system file name.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcFileName ;
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   calculateFileName - calculates and returns a new string filename
+                       given a module and an extension. This file name
+                       length will be operating system specific.
+                       String, Extension, is concatenated onto
+                       Module and thus it is safe to `Mark' the extension
+                       for garbage collection.
+*)
+
+PROCEDURE calculateFileName (module, extension: String) : String ;
+
+
+(*
+   calculateStemName - calculates the stem name for given a module.
+                       This name length will be operating system and
+      	       	       compiler specific.
+*)
+
+PROCEDURE calculateStemName (module: String) : String ;
+
+
+(*
+   extractExtension - given a, filename, return the filename without
+                      the extension, Ext.
+*)
+
+PROCEDURE extractExtension (filename, ext: String) : String ;
+
+
+(*
+   extractModule - given a, filename, return the module name including any
+                   extension. A new string is returned.
+*)
+
+PROCEDURE extractModule (filename: String) : String ;
+
+
+END mcFileName.
diff --git a/gcc/m2/mc/mcFileName.mod b/gcc/m2/mc/mcFileName.mod
new file mode 100644
index 00000000000..517e9ba1e09
--- /dev/null
+++ b/gcc/m2/mc/mcFileName.mod
@@ -0,0 +1,102 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcFileName ;
+
+
+FROM ASCII IMPORT nul ;
+FROM DynamicStrings IMPORT InitString, Mark, Slice, Dup, ConCatChar, ConCat, Length, Equal, Index ;
+
+
+CONST
+   MaxFileName = 0 ;   (* zero means no limits *)
+   MaxStemName = 0 ;
+   Directory   = '/' ;
+
+
+(*
+   currently there are no limits on filename length, this may
+   be incorrect on some systems.
+*)
+
+
+(*
+   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.
+*)
+
+PROCEDURE calculateFileName (module, extension: String) : String ;
+BEGIN
+   IF MaxFileName=0
+   THEN
+      RETURN ConCat (ConCatChar (Slice (module, 0, MaxFileName), '.'), extension)
+   ELSE
+      RETURN ConCat (ConCatChar (Slice (module, 0, MaxFileName-Length (extension)-1), '.'), extension)
+   END
+END calculateFileName ;
+
+
+(*
+   calculateStemName - calculates the stem name for given a module.
+                       This name length will be operating system and
+      	       	       compiler specific.
+*)
+
+PROCEDURE calculateStemName (module: String) : String ;
+BEGIN
+   RETURN Slice (module, 0, MaxStemName)
+END calculateStemName ;
+
+
+(*
+   extractExtension - given a, filename, return the filename without
+                      the extension, Ext.
+*)
+
+PROCEDURE extractExtension (filename, ext: String) : String ;
+BEGIN
+   IF Equal (ext, Mark (Slice (filename, -Length (ext), 0)))
+   THEN
+      RETURN Slice (filename, 0, -Length (ext))
+   ELSE
+      RETURN filename
+   END
+END extractExtension ;
+
+
+(*
+   extractModule - given a, filename, return the module name including any
+                   extension. A new string is returned.
+*)
+
+PROCEDURE extractModule (filename: String) : String ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := Index (filename, Directory, 0) ;
+   IF i=-1
+   THEN
+      RETURN Dup (filename)
+   ELSE
+      RETURN Slice (filename, i+1, 0)
+   END
+END extractModule ;
+
+
+END mcFileName.
diff --git a/gcc/m2/mc/mcLexBuf.def b/gcc/m2/mc/mcLexBuf.def
new file mode 100644
index 00000000000..e38e4eef93a
--- /dev/null
+++ b/gcc/m2/mc/mcLexBuf.def
@@ -0,0 +1,244 @@
+(* mcLexBuf.def provides a buffer for the all the tokens created by m2.lex.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcLexBuf ;
+
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM mcReserved IMPORT toktype ;
+FROM DynamicStrings IMPORT String ;
+FROM mcComment IMPORT commentDesc ;
+
+
+VAR
+   currenttoken  : toktype ;
+   currentstring : ADDRESS ;
+   currentcolumn : CARDINAL ;
+   currentinteger: INTEGER ;
+   lastcomment,
+   currentcomment: commentDesc ;
+
+
+(*
+   getProcedureComment - returns the procedure comment if it exists,
+                         or NIL otherwise.
+*)
+
+PROCEDURE getProcedureComment () : commentDesc ;
+
+
+(*
+   getBodyComment - returns the body comment if it exists,
+                    or NIL otherwise.
+*)
+
+PROCEDURE getBodyComment () : commentDesc ;
+
+
+(*
+   getAfterComment - returns the after comment if it exists,
+                     or NIL otherwise.
+*)
+
+PROCEDURE getAfterComment () : commentDesc ;
+
+
+(*
+   openSource - Attempts to open the source file, s.
+                The success of the operation is returned.
+*)
+
+PROCEDURE openSource (s: String) : BOOLEAN ;
+
+
+(*
+   closeSource - closes the current open file.
+*)
+
+PROCEDURE closeSource ;
+
+
+(*
+   reInitialize - re-initialize the all the data structures.
+*)
+
+PROCEDURE reInitialize ;
+
+
+(*
+   resetForNewPass - reset the buffer pointers to the beginning ready for
+                     a new pass
+*)
+
+PROCEDURE resetForNewPass ;
+
+
+(*
+   getToken - gets the next token into currenttoken.
+*)
+
+PROCEDURE getToken ;
+
+
+(*
+   insertToken - inserts a symbol, token, infront of the current token
+                 ready for the next pass.
+*)
+
+PROCEDURE insertToken (token: toktype) ;
+
+
+(*
+   insertTokenAndRewind - inserts a symbol, token, infront of the current token
+                          and then moves the token stream back onto the inserted token.
+*)
+
+PROCEDURE insertTokenAndRewind (token: toktype) ;
+
+
+(*
+   getPreviousTokenLineNo - returns the line number of the previous token.
+*)
+
+PROCEDURE getPreviousTokenLineNo () : CARDINAL ;
+
+
+(*
+   getLineNo - returns the current line number where the symbol occurs in
+               the source file.
+*)
+
+PROCEDURE getLineNo () : CARDINAL ;
+
+
+(*
+   getTokenNo - returns the current token number.
+*)
+
+PROCEDURE getTokenNo () : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE tokenToLineNo (tokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+
+
+(*
+   getColumnNo - returns the current column where the symbol occurs in
+                 the source file.
+*)
+
+PROCEDURE getColumnNo () : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE tokenToColumnNo (tokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findFileNameFromToken (tokenNo: CARDINAL; depth: CARDINAL) : String ;
+
+
+(*
+   getFileName - returns a String defining the current file.
+*)
+
+PROCEDURE getFileName () : String ;
+
+
+(* ***********************************************************************
+ *
+ * These functions allow m2.lex to deliver tokens into the buffer
+ *
+ ************************************************************************* *)
+
+(*
+   addTok - adds a token to the buffer.
+*)
+
+PROCEDURE addTok (t: toktype) ;
+
+
+(*
+   addTokCharStar - adds a token to the buffer and an additional string, s.
+                    A copy of string, s, is made.
+*)
+
+PROCEDURE addTokCharStar (t: toktype; s: ADDRESS) ;
+
+
+(*
+   addTokInteger - adds a token and an integer to the buffer.
+*)
+
+PROCEDURE addTokInteger (t: toktype; i: INTEGER) ;
+
+
+(*
+   addTokComment - adds a token to the buffer and a comment descriptor, com.
+*)
+
+PROCEDURE addTokComment (t: toktype; com: commentDesc) ;
+
+
+(*
+   setFile - sets the current filename to, filename.
+*)
+
+PROCEDURE setFile (filename: ADDRESS) ;
+
+
+(*
+   pushFile - indicates that, filename, has just been included.
+*)
+
+PROCEDURE pushFile (filename: ADDRESS) ;
+
+
+(*
+   popFile - indicates that we are returning to, filename, having finished
+             an include.
+*)
+
+PROCEDURE popFile (filename: ADDRESS) ;
+
+
+END mcLexBuf.
diff --git a/gcc/m2/mc/mcLexBuf.h b/gcc/m2/mc/mcLexBuf.h
new file mode 100644
index 00000000000..220e42aeb21
--- /dev/null
+++ b/gcc/m2/mc/mcLexBuf.h
@@ -0,0 +1,224 @@
+/* mcLexBuf.h provides a C interface to the mcLexBuf module.
+
+Copyright (C) 2015-2022 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/>.  */
+
+#ifndef mcLexBufH
+#define mcLexBufH
+
+
+#include "mcReserved.h"
+
+extern mcReserved_toktype mcLexBuf_currenttoken;
+extern void *mcLexBuf_currentstring;
+extern unsigned int mcLexBuf_currentcolumn;
+extern int mcLexBuf_currentinteger;
+extern void *mcLexBuf_currentcomment;
+
+
+/*
+   openSource - Attempts to open the source file, s.
+                The success of the operation is returned.
+*/
+
+extern unsigned int mcLexBuf_openSource (void *s);
+
+
+/*
+   closeSource - closes the current open file.
+*/
+
+extern void mcLexBuf_closeSource(void);
+
+
+/*
+   reInitialize - re-initialize the all the data structures.
+*/
+
+extern void mcLexBuf_reInitialize(void);
+
+
+/*
+   resetForNewPass - reset the buffer pointers to the beginning ready for
+                     a new pass
+*/
+
+extern void mcLexBuf_resetForNewPass(void);
+
+
+/*
+   getToken - gets the next token into currenttoken.
+*/
+
+extern void mcLexBuf_getToken(void);
+
+
+/*
+   insertToken - inserts a symbol, token, infront of the current token
+                 ready for the next pass.
+*/
+
+extern 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 void mcLexBuf_insertTokenAndRewind(mcReserved_toktype token);
+
+
+/*
+   getPreviousTokenLineNo - returns the line number of the previous token.
+*/
+
+extern unsigned int mcLexBuf_getPreviousTokenLineNo(void);
+
+
+/*
+   getLineNo - returns the current line number where the symbol occurs in
+               the source file.
+*/
+
+extern unsigned int mcLexBuf_getLineNo(void);
+
+
+/*
+   getTokenNo - returns the current token number.
+*/
+
+extern 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 unsigned int mcLexBuf_tokenToLineNo(unsigned int TokenNo,
+					   unsigned int depth);
+
+
+/*
+   getColumnNo - returns the current column where the symbol occurs in
+                 the source file.
+*/
+
+extern 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 unsigned int mcLexBuf_tokenToColumnNo(unsigned int TokenNo,
+					     unsigned int depth);
+
+
+/*
+   tokenToLocation - returns the location_t corresponding to, TokenNo.
+*/
+
+extern int mcLexBuf_tokenToLocation(unsigned int TokenNo);
+
+
+/*
+   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 void *mcLexBuf_findFileNameFromToken(unsigned int TokenNo,
+					    unsigned int depth);
+
+
+/*
+   getFileName - returns a String defining the current file.
+*/
+
+extern void *mcLexBuf_getFileName(void);
+
+
+/* ***********************************************************************
+ *
+ * These functions allow m2.lex to deliver tokens into the buffer
+ *
+ ************************************************************************* */
+
+/*
+   addTok - adds a token to the buffer.
+*/
+
+extern 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 void mcLexBuf_addTokCharStar (mcReserved_toktype t, void *s);
+
+
+/*
+   addTokInteger - adds a token and an integer to the buffer.
+*/
+
+extern void mcLexBuf_addTokInteger (mcReserved_toktype t, int i);
+
+
+/*
+   addTokComment - adds a token to the buffer and a comment descriptor, com.
+*/
+
+extern void mcLexBuf_addTokComment (mcReserved_toktype t, void *com);
+
+
+/*
+   setFile - sets the current filename to, filename.
+*/
+
+extern void mcLexBuf_setFile(void *filename);
+
+
+/*
+   pushFile - indicates that, filename, has just been included.
+*/
+
+extern void mcLexBuf_pushFile(void *filename);
+
+
+/*
+   popFile - indicates that we are returning to, filename, having finished
+             an include.
+*/
+
+extern void mcLexBuf_popFile(void *filename);
+
+#endif
diff --git a/gcc/m2/mc/mcLexBuf.mod b/gcc/m2/mc/mcLexBuf.mod
new file mode 100644
index 00000000000..89c77420891
--- /dev/null
+++ b/gcc/m2/mc/mcLexBuf.mod
@@ -0,0 +1,1197 @@
+(* mcLexBuf.mod provides a buffer for the all the tokens created by m2.lex.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+IMPLEMENTATION MODULE mcLexBuf ;
+
+IMPORT mcflex ;
+
+FROM libc IMPORT strlen ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM DynamicStrings IMPORT string, InitString, InitStringCharStar, Equal, Mark, KillString ;
+FROM FormatStrings IMPORT Sprintf1 ;
+FROM nameKey IMPORT NulName, Name, makekey, keyToCharStar ;
+FROM mcReserved IMPORT toktype ;
+FROM mcComment IMPORT isProcedureComment, isBodyComment, isAfterComment, getContent ;
+FROM mcPrintf IMPORT printf0, printf1, printf2, printf3 ;
+FROM mcDebug IMPORT assert ;
+
+
+CONST
+   MaxBucketSize = 100 ;
+   Debugging     = FALSE ;
+
+TYPE
+   sourceList = POINTER TO RECORD
+                              left,
+                              right: sourceList ;
+                              name : String ;
+                              line : CARDINAL ;
+                              col  : CARDINAL ;
+                           END ;
+
+   tokenDesc = RECORD
+                  token: toktype ;
+                  str  : Name ;
+                  int  : INTEGER ;
+		  com  : commentDesc ;
+                  line : CARDINAL ;
+                  col  : CARDINAL ;
+                  file : sourceList ;
+               END ;
+
+   tokenBucket = POINTER TO RECORD
+                               buf : ARRAY [0..MaxBucketSize] OF tokenDesc ;
+                               len : CARDINAL ;
+                               next: tokenBucket ;
+                            END ;
+
+   listDesc = RECORD
+                 head,
+                 tail            : tokenBucket ;
+                 lastBucketOffset: CARDINAL ;
+              END ;
+
+VAR
+   procedureComment,
+   bodyComment,
+   afterComment     : commentDesc ;
+   currentSource    : sourceList ;
+   useBufferedTokens,
+   currentUsed      : BOOLEAN ;
+   listOfTokens     : listDesc ;
+   nextTokNo        : CARDINAL ;
+
+
+(*
+   debugLex - display the last, n, tokens.
+*)
+
+PROCEDURE debugLex (n: CARDINAL) ;
+VAR
+   c,
+   i, o, t: CARDINAL ;
+   b      : tokenBucket ;
+BEGIN
+   IF nextTokNo > n
+   THEN
+      o := nextTokNo - n
+   ELSE
+      o := 0
+   END ;
+   i := 0 ;
+   REPEAT
+      t := o + i ;
+      IF nextTokNo = t
+      THEN
+         printf0 ("nextTokNo ")
+      END ;
+      b := findtokenBucket (t) ;
+      IF b = NIL
+      THEN
+         t := o + i ;
+         printf1 ("end of buf  (%d is further ahead than the buffer contents)\n", t)
+      ELSE
+         c := o + i ;
+         printf2 ("entry %d  %d ", c, t) ;
+         displayToken (b^.buf[t].token) ;
+	 printf0 ("\n") ;
+         INC (i)
+      END
+   UNTIL b = NIL
+END debugLex ;
+
+
+(*
+   getProcedureComment - returns the procedure comment if it exists,
+                         or NIL otherwise.
+*)
+
+PROCEDURE getProcedureComment () : commentDesc ;
+BEGIN
+   RETURN procedureComment
+END getProcedureComment ;
+
+
+(*
+   getBodyComment - returns the body comment if it exists,
+                    or NIL otherwise.  The body comment is
+                    removed if found.
+*)
+
+PROCEDURE getBodyComment () : commentDesc ;
+VAR
+   b: commentDesc ;
+BEGIN
+   b := bodyComment ;
+   bodyComment := NIL ;
+   RETURN b
+END getBodyComment ;
+
+
+(*
+   seekTo -
+*)
+
+PROCEDURE seekTo (t: CARDINAL) ;
+VAR
+   b: tokenBucket ;
+BEGIN
+   nextTokNo := t ;
+   IF t > 0
+   THEN
+      DEC (t) ;
+      b := findtokenBucket (t) ;
+      IF b = NIL
+      THEN
+         updateFromBucket (b, t)
+      END
+   END
+END seekTo ;
+
+
+(*
+   peeptokenBucket -
+*)
+
+PROCEDURE peeptokenBucket (VAR t: CARDINAL) : tokenBucket ;
+VAR
+   ct : toktype ;
+   old,
+   n  : CARDINAL ;
+   b, c: tokenBucket ;
+BEGIN
+   ct := currenttoken ;
+   IF Debugging
+   THEN
+      debugLex (5)
+   END ;
+   old := getTokenNo () ;
+   REPEAT
+      n := t ;
+      b := findtokenBucket (n) ;
+      IF b = NIL
+      THEN
+         doGetToken ;
+         n := t ;
+         b := findtokenBucket (n) ;
+         IF (b = NIL) OR (currenttoken = eoftok)
+         THEN
+            (* bailing out.  *)
+            nextTokNo := old + 1 ;
+            b := findtokenBucket (old) ;
+            updateFromBucket (b, old) ;
+            RETURN NIL
+         END
+      END ;
+   UNTIL (b # NIL) OR (currenttoken = eoftok) ;
+   t := n ;
+   nextTokNo := old + 1 ;
+   IF Debugging
+   THEN
+      printf2 ("nextTokNo = %d, old = %d\n", nextTokNo, old)
+   END ;
+   b := findtokenBucket (old) ;
+   IF Debugging
+   THEN
+      printf1 ("  adjusted old = %d\n", old)
+   END ;
+   IF b # NIL
+   THEN
+      updateFromBucket (b, old)
+   END ;
+   IF Debugging
+   THEN
+      debugLex (5)
+   END ;
+   assert (ct = currenttoken) ;
+   RETURN b
+END peeptokenBucket ;
+
+
+(*
+   peepAfterComment - peeps ahead looking for an after statement comment.  It stops at an END token
+                      or if the line number changes.
+*)
+
+PROCEDURE peepAfterComment ;
+VAR
+   oldTokNo,
+   t,
+   peep,
+   cno,
+   nextline,
+   curline : CARDINAL ;
+   b       : tokenBucket ;
+   finished: BOOLEAN ;
+BEGIN
+   oldTokNo := nextTokNo ;
+   cno := getTokenNo () ;
+   curline := tokenToLineNo (cno, 0) ;
+   nextline := curline ;
+   peep := 0 ;
+   finished := FALSE ;
+   REPEAT
+      t := cno + peep ;
+      b := peeptokenBucket (t) ;
+      IF (b = NIL) OR (currenttoken = eoftok)
+      THEN
+         finished := TRUE
+      ELSE
+         nextline := b^.buf[t].line ;
+	 IF nextline = curline
+         THEN
+            CASE b^.buf[t].token OF
+
+            eoftok,
+            endtok    :  finished := TRUE |
+            commenttok:  IF isAfterComment (b^.buf[t].com)
+                         THEN
+	                    afterComment := b^.buf[t].com
+                         END
+	    ELSE
+	    END
+	 ELSE
+            finished := TRUE
+         END
+      END ;
+      INC (peep)
+   UNTIL finished ;
+   seekTo (oldTokNo)
+END peepAfterComment ;
+
+
+(*
+   getAfterComment - returns the after comment if it exists,
+                     or NIL otherwise.  The after comment is
+                     removed if found.
+*)
+
+PROCEDURE getAfterComment () : commentDesc ;
+VAR
+   a: commentDesc ;
+BEGIN
+   peepAfterComment ;
+   a := afterComment ;
+   afterComment := NIL ;
+   RETURN a
+END getAfterComment ;
+
+
+(*
+   init - initializes the token list and source list.
+*)
+
+PROCEDURE init ;
+BEGIN
+   currenttoken := eoftok ;
+   nextTokNo := 0 ;
+   currentSource := NIL ;
+   listOfTokens.head := NIL ;
+   listOfTokens.tail := NIL ;
+   useBufferedTokens := FALSE ;
+   procedureComment := NIL ;
+   bodyComment := NIL ;
+   afterComment := NIL ;
+   lastcomment := NIL
+END init ;
+
+
+(*
+   addTo - adds a new element to the end of sourceList, currentSource.
+*)
+
+PROCEDURE addTo (l: sourceList) ;
+BEGIN
+   l^.right := currentSource ;
+   l^.left  := currentSource^.left ;
+   currentSource^.left^.right := l ;
+   currentSource^.left := l ;
+   WITH l^.left^ DO
+      line := mcflex.getLineNo() ;
+      col  := mcflex.getColumnNo()
+   END
+END addTo ;
+
+
+(*
+   subFrom - subtracts, l, from the source list.
+*)
+
+PROCEDURE subFrom (l: sourceList) ;
+BEGIN
+   l^.left^.right := l^.right ;
+   l^.right^.left := l^.left
+END subFrom ;
+
+
+(*
+   newElement - returns a new sourceList
+*)
+
+PROCEDURE newElement (s: ADDRESS) : sourceList ;
+VAR
+   l: sourceList ;
+BEGIN
+   NEW (l) ;
+   IF l=NIL
+   THEN
+      HALT
+   ELSE
+      WITH l^ DO
+         name  := InitStringCharStar (s) ;
+         left  := NIL ;
+         right := NIL
+      END
+   END ;
+   RETURN l
+END newElement ;
+
+
+(*
+   newList - initializes an empty list with the classic dummy header element.
+*)
+
+PROCEDURE newList () : sourceList ;
+VAR
+   l: sourceList ;
+BEGIN
+   NEW (l) ;
+   WITH l^ DO
+      left  := l ;
+      right := l ;
+      name  := NIL
+   END ;
+   RETURN l
+END newList ;
+
+
+(*
+   checkIfNeedToDuplicate - checks to see whether the currentSource has
+                            been used, if it has then duplicate the list.
+*)
+
+PROCEDURE checkIfNeedToDuplicate ;
+VAR
+   l, h: sourceList ;
+BEGIN
+   IF currentUsed
+   THEN
+      l := currentSource^.right ;
+      h := currentSource ;
+      currentSource := newList() ;
+      WHILE l#h DO
+         addTo (newElement (l^.name)) ;
+         l := l^.right
+      END
+   END
+END checkIfNeedToDuplicate ;
+
+
+(*
+   pushFile - indicates that, filename, has just been included.
+*)
+
+PROCEDURE pushFile (filename: ADDRESS) ;
+VAR
+   l: sourceList ;
+BEGIN
+   checkIfNeedToDuplicate ;
+   addTo (newElement (filename)) ;
+   IF Debugging
+   THEN
+      IF currentSource^.right#currentSource
+      THEN
+         l := currentSource ;
+         REPEAT
+            printf3 ('name = %s, line = %d, col = %d\n', l^.name, l^.line, l^.col) ;
+            l := l^.right
+         UNTIL l=currentSource
+      END
+   END
+END pushFile ;
+
+
+(*
+   popFile - indicates that we are returning to, filename, having finished
+             an include.
+*)
+
+PROCEDURE popFile (filename: ADDRESS) ;
+VAR
+   l: sourceList ;
+BEGIN
+   checkIfNeedToDuplicate ;
+   IF (currentSource#NIL) AND (currentSource^.left#currentSource)
+   THEN
+      l := currentSource^.left ;  (* last element *)
+      subFrom (l) ;
+      DISPOSE (l) ;
+      IF (currentSource^.left#currentSource) AND
+         (NOT Equal(currentSource^.name, Mark (InitStringCharStar (filename))))
+      THEN
+         (* mismatch in source file names after preprocessing files *)
+      END
+   ELSE
+      (* source file list is empty, cannot pop an include.. *)
+   END
+END popFile ;
+
+
+(*
+   killList - kills the sourceList providing that it has not been used.
+*)
+
+PROCEDURE killList ;
+VAR
+   l, k: sourceList ;
+BEGIN
+   IF (NOT currentUsed) AND (currentSource#NIL)
+   THEN
+      l := currentSource ;
+      REPEAT
+         k := l ;
+         l := l^.right ;
+         DISPOSE (k)
+      UNTIL l=currentSource
+   END
+END killList ;
+
+
+(*
+   reInitialize - re-initialize the all the data structures.
+*)
+
+PROCEDURE reInitialize ;
+VAR
+   s, t: tokenBucket ;
+BEGIN
+   IF listOfTokens.head#NIL
+   THEN
+      t := listOfTokens.head ;
+      REPEAT
+         s := t ;
+         t := t^.next ;
+         DISPOSE (s) ;
+      UNTIL t=NIL ;
+      currentUsed := FALSE ;
+      killList
+   END ;
+   init
+END reInitialize ;
+
+
+(*
+   setFile - sets the current filename to, filename.
+*)
+
+PROCEDURE setFile (filename: ADDRESS) ;
+BEGIN
+   killList ;
+   currentUsed   := FALSE ;
+   currentSource := newList() ;
+   addTo (newElement (filename))
+END setFile ;
+
+
+(*
+   openSource - attempts to open the source file, s.
+                The success of the operation is returned.
+*)
+
+PROCEDURE openSource (s: String) : BOOLEAN ;
+BEGIN
+   IF useBufferedTokens
+   THEN
+      getToken ;
+      RETURN TRUE
+   ELSE
+      IF mcflex.openSource (string (s))
+      THEN
+         setFile (string (s)) ;
+         syncOpenWithBuffer ;
+         getToken ;
+         RETURN TRUE
+      ELSE
+         RETURN FALSE
+      END
+   END
+END openSource ;
+
+
+(*
+   closeSource - closes the current open file.
+*)
+
+PROCEDURE closeSource ;
+BEGIN
+   IF useBufferedTokens
+   THEN
+      WHILE currenttoken#eoftok DO
+         getToken
+      END
+   ELSE
+      (* a subsequent call to mcflex.OpenSource will really close the file *)
+   END
+END closeSource ;
+
+
+(*
+   resetForNewPass - reset the buffer pointers to the beginning ready for
+                     a new pass
+*)
+
+PROCEDURE resetForNewPass ;
+BEGIN
+   nextTokNo := 0 ;
+   useBufferedTokens := TRUE
+END resetForNewPass ;
+
+
+(*
+   displayToken -
+*)
+
+PROCEDURE displayToken (t: toktype) ;
+BEGIN
+   CASE t OF
+
+   eoftok: printf0('eoftok\n') |
+   plustok: printf0('plustok\n') |
+   minustok: printf0('minustok\n') |
+   timestok: printf0('timestok\n') |
+   dividetok: printf0('dividetok\n') |
+   becomestok: printf0('becomestok\n') |
+   ambersandtok: printf0('ambersandtok\n') |
+   periodtok: printf0('periodtok\n') |
+   commatok: printf0('commatok\n') |
+   commenttok: printf0('commenttok\n') |
+   semicolontok: printf0('semicolontok\n') |
+   lparatok: printf0('lparatok\n') |
+   rparatok: printf0('rparatok\n') |
+   lsbratok: printf0('lsbratok\n') |
+   rsbratok: printf0('rsbratok\n') |
+   lcbratok: printf0('lcbratok\n') |
+   rcbratok: printf0('rcbratok\n') |
+   uparrowtok: printf0('uparrowtok\n') |
+   singlequotetok: printf0('singlequotetok\n') |
+   equaltok: printf0('equaltok\n') |
+   hashtok: printf0('hashtok\n') |
+   lesstok: printf0('lesstok\n') |
+   greatertok: printf0('greatertok\n') |
+   lessgreatertok: printf0('lessgreatertok\n') |
+   lessequaltok: printf0('lessequaltok\n') |
+   greaterequaltok: printf0('greaterequaltok\n') |
+   periodperiodtok: printf0('periodperiodtok\n') |
+   colontok: printf0('colontok\n') |
+   doublequotestok: printf0('doublequotestok\n') |
+   bartok: printf0('bartok\n') |
+   andtok: printf0('andtok\n') |
+   arraytok: printf0('arraytok\n') |
+   begintok: printf0('begintok\n') |
+   bytok: printf0('bytok\n') |
+   casetok: printf0('casetok\n') |
+   consttok: printf0('consttok\n') |
+   definitiontok: printf0('definitiontok\n') |
+   divtok: printf0('divtok\n') |
+   dotok: printf0('dotok\n') |
+   elsetok: printf0('elsetok\n') |
+   elsiftok: printf0('elsiftok\n') |
+   endtok: printf0('endtok\n') |
+   exittok: printf0('exittok\n') |
+   exporttok: printf0('exporttok\n') |
+   fortok: printf0('fortok\n') |
+   fromtok: printf0('fromtok\n') |
+   iftok: printf0('iftok\n') |
+   implementationtok: printf0('implementationtok\n') |
+   importtok: printf0('importtok\n') |
+   intok: printf0('intok\n') |
+   looptok: printf0('looptok\n') |
+   modtok: printf0('modtok\n') |
+   moduletok: printf0('moduletok\n') |
+   nottok: printf0('nottok\n') |
+   oftok: printf0('oftok\n') |
+   ortok: printf0('ortok\n') |
+   pointertok: printf0('pointertok\n') |
+   proceduretok: printf0('proceduretok\n') |
+   qualifiedtok: printf0('qualifiedtok\n') |
+   unqualifiedtok: printf0('unqualifiedtok\n') |
+   recordtok: printf0('recordtok\n') |
+   repeattok: printf0('repeattok\n') |
+   returntok: printf0('returntok\n') |
+   settok: printf0('settok\n') |
+   thentok: printf0('thentok\n') |
+   totok: printf0('totok\n') |
+   typetok: printf0('typetok\n') |
+   untiltok: printf0('untiltok\n') |
+   vartok: printf0('vartok\n') |
+   whiletok: printf0('whiletok\n') |
+   withtok: printf0('withtok\n') |
+   asmtok: printf0('asmtok\n') |
+   volatiletok: printf0('volatiletok\n') |
+   periodperiodperiodtok: printf0('periodperiodperiodtok\n') |
+   datetok: printf0('datetok\n') |
+   linetok: printf0('linetok\n') |
+   filetok: printf0('filetok\n') |
+   integertok: printf0('integertok\n') |
+   identtok: printf0('identtok\n') |
+   realtok: printf0('realtok\n') |
+   stringtok: printf0('stringtok\n')
+
+   ELSE
+      printf0 ('unknown tok (--fixme--)\n')
+   END
+END displayToken ;
+
+
+(*
+   updateFromBucket - updates the global variables:  currenttoken,
+                      currentstring, currentcolumn and currentinteger
+                      from tokenBucket, b, and, offset.
+*)
+
+PROCEDURE updateFromBucket (b: tokenBucket; offset: CARDINAL) ;
+BEGIN
+   WITH b^.buf[offset] DO
+      currenttoken   := token ;
+      currentstring  := keyToCharStar (str) ;
+      currentcolumn  := col ;
+      currentinteger := int ;
+      currentcomment := com ;
+      IF currentcomment # NIL
+      THEN
+         lastcomment := currentcomment
+      END ;
+      IF Debugging
+      THEN
+         printf3 ('line %d (# %d  %d) ', line, offset, nextTokNo)
+      END
+   END
+END updateFromBucket ;
+
+
+(*
+   getToken - gets the next token into currenttoken.
+*)
+
+PROCEDURE getToken ;
+BEGIN
+   REPEAT
+      doGetToken ;
+      IF currenttoken = commenttok
+      THEN
+	 IF isProcedureComment (currentcomment)
+	 THEN
+            procedureComment := currentcomment ;
+            bodyComment := NIL ;
+            afterComment := NIL ;
+	 ELSIF isBodyComment (currentcomment)
+	 THEN
+            bodyComment := currentcomment ;
+            afterComment := NIL
+	 ELSIF isAfterComment (currentcomment)
+	 THEN
+            procedureComment := NIL ;
+            bodyComment := NIL ;
+            afterComment := currentcomment
+	 END
+      END
+   UNTIL currenttoken # commenttok
+END getToken ;
+
+
+(*
+   doGetToken - fetch the next token into currenttoken.
+*)
+
+PROCEDURE doGetToken ;
+VAR
+   a: ADDRESS ;
+   t: CARDINAL ;
+   b: tokenBucket ;
+BEGIN
+   IF useBufferedTokens
+   THEN
+      t := nextTokNo ;
+      b := findtokenBucket (t) ;
+      updateFromBucket (b, t)
+   ELSE
+      IF listOfTokens.tail=NIL
+      THEN
+         a := mcflex.getToken () ;
+         IF listOfTokens.tail=NIL
+         THEN
+            HALT
+         END
+      END ;
+      IF nextTokNo>=listOfTokens.lastBucketOffset
+      THEN
+         (* nextTokNo is in the last bucket or needs to be read.  *)
+         IF nextTokNo-listOfTokens.lastBucketOffset<listOfTokens.tail^.len
+         THEN
+            IF Debugging
+            THEN
+               printf0 ('fetching token from buffer (updateFromBucket)\n')
+            END ;
+            updateFromBucket (listOfTokens.tail,
+                              nextTokNo-listOfTokens.lastBucketOffset)
+         ELSE
+            IF Debugging
+            THEN
+               printf0 ('calling flex to place token into buffer\n')
+            END ;
+            (* call the lexical phase to place a new token into the last bucket.  *)
+            a := mcflex.getToken () ;
+            getToken ; (* and call ourselves again to collect the token from bucket.  *)
+            RETURN
+         END
+      ELSE
+         IF Debugging
+         THEN
+            printf0 ('fetching token from buffer\n')
+         END ;
+         t := nextTokNo ;
+         b := findtokenBucket (t) ;
+         updateFromBucket (b, t)
+      END
+   END ;
+   IF Debugging
+   THEN
+      displayToken (currenttoken)
+   END ;
+   INC (nextTokNo)
+END doGetToken ;
+
+
+(*
+   syncOpenWithBuffer - synchronise the buffer with the start of a file.
+                        Skips all the tokens to do with the previous file.
+*)
+
+PROCEDURE syncOpenWithBuffer ;
+BEGIN
+   IF listOfTokens.tail#NIL
+   THEN
+      WITH listOfTokens.tail^ DO
+         nextTokNo := listOfTokens.lastBucketOffset+len
+      END
+   END
+END syncOpenWithBuffer ;
+
+
+(*
+   insertToken - inserts a symbol, token, infront of the current token
+                 ready for the next pass.
+*)
+
+PROCEDURE insertToken (token: toktype) ;
+BEGIN
+   IF listOfTokens.tail#NIL
+   THEN
+      WITH listOfTokens.tail^ DO
+         IF len>0
+         THEN
+            buf[len-1].token := token
+         END
+      END ;
+      addTokToList (currenttoken, NulName, 0, NIL,
+                    getLineNo (), getColumnNo (), currentSource) ;
+      getToken
+   END
+END insertToken ;
+
+
+(*
+   insertTokenAndRewind - inserts a symbol, token, infront of the current token
+                          and then moves the token stream back onto the inserted token.
+*)
+
+PROCEDURE insertTokenAndRewind (token: toktype) ;
+BEGIN
+   IF listOfTokens.tail#NIL
+   THEN
+      WITH listOfTokens.tail^ DO
+         IF len>0
+         THEN
+            buf[len-1].token := token
+         END
+      END ;
+      addTokToList (currenttoken, NulName, 0, NIL,
+                    getLineNo(), getColumnNo(), currentSource) ;
+      currenttoken := token
+   END
+END insertTokenAndRewind ;
+
+
+(*
+   getPreviousTokenLineNo - returns the line number of the previous token.
+*)
+
+PROCEDURE getPreviousTokenLineNo () : CARDINAL ;
+BEGIN
+   RETURN getLineNo()
+END getPreviousTokenLineNo ;
+
+
+(*
+   getLineNo - returns the current line number where the symbol occurs in
+               the source file.
+*)
+
+PROCEDURE getLineNo () : CARDINAL ;
+BEGIN
+   IF nextTokNo=0
+   THEN
+      RETURN 0
+   ELSE
+      RETURN tokenToLineNo (getTokenNo (), 0)
+   END
+END getLineNo ;
+
+
+(*
+   getColumnNo - returns the current column where the symbol occurs in
+                 the source file.
+*)
+
+PROCEDURE getColumnNo () : CARDINAL ;
+BEGIN
+   IF nextTokNo=0
+   THEN
+      RETURN 0
+   ELSE
+      RETURN tokenToColumnNo (getTokenNo (), 0)
+   END
+END getColumnNo ;
+
+
+(*
+   getTokenNo - returns the current token number.
+*)
+
+PROCEDURE getTokenNo () : CARDINAL ;
+BEGIN
+   IF nextTokNo=0
+   THEN
+      RETURN 0
+   ELSE
+      RETURN nextTokNo-1
+   END
+END getTokenNo ;
+
+
+(*
+   findtokenBucket - returns the tokenBucket corresponding to the tokenNo.
+*)
+
+PROCEDURE findtokenBucket (VAR tokenNo: CARDINAL) : tokenBucket ;
+VAR
+   b: tokenBucket ;
+BEGIN
+   b := listOfTokens.head ;
+   WHILE b#NIL DO
+      WITH b^ DO
+         IF tokenNo<len
+         THEN
+            RETURN b
+         ELSE
+            DEC (tokenNo, len)
+         END
+      END ;
+      b := b^.next
+   END ;
+   RETURN NIL
+END findtokenBucket ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE tokenToLineNo (tokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+VAR
+   b: tokenBucket ;
+   l: sourceList ;
+BEGIN
+   b := findtokenBucket (tokenNo) ;
+   IF b=NIL
+   THEN
+      RETURN 0
+   ELSE
+      IF depth=0
+      THEN
+         RETURN b^.buf[tokenNo].line
+      ELSE
+         l := b^.buf[tokenNo].file^.left ;
+         WHILE depth>0 DO
+            l := l^.left ;
+            IF l=b^.buf[tokenNo].file^.left
+            THEN
+               RETURN 0
+            END ;
+            DEC (depth)
+         END ;
+         RETURN l^.line
+      END
+   END
+END tokenToLineNo ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE tokenToColumnNo (tokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ;
+VAR
+   b: tokenBucket ;
+   l: sourceList ;
+BEGIN
+   b := findtokenBucket (tokenNo) ;
+   IF b=NIL
+   THEN
+      RETURN 0
+   ELSE
+      IF depth=0
+      THEN
+         RETURN b^.buf[tokenNo].col
+      ELSE
+         l := b^.buf[tokenNo].file^.left ;
+         WHILE depth>0 DO
+            l := l^.left ;
+            IF l=b^.buf[tokenNo].file^.left
+            THEN
+               RETURN 0
+            END ;
+            DEC (depth)
+         END ;
+         RETURN l^.col
+      END
+   END
+END tokenToColumnNo ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findFileNameFromToken (tokenNo: CARDINAL; depth: CARDINAL) : String ;
+VAR
+   b: tokenBucket ;
+   l: sourceList ;
+BEGIN
+   b := findtokenBucket (tokenNo) ;
+   IF b=NIL
+   THEN
+      RETURN NIL
+   ELSE
+      l := b^.buf[tokenNo].file^.left ;
+      WHILE depth>0 DO
+         l := l^.left ;
+         IF l=b^.buf[tokenNo].file^.left
+         THEN
+            RETURN NIL
+         END ;
+         DEC (depth)
+      END ;
+      RETURN l^.name
+   END
+END findFileNameFromToken ;
+
+
+(*
+   getFileName - returns a String defining the current file.
+*)
+
+PROCEDURE getFileName () : String ;
+BEGIN
+   RETURN findFileNameFromToken (getTokenNo (), 0)
+END getFileName ;
+
+
+PROCEDURE stop ; BEGIN END stop ;
+
+
+(*
+   addTokToList - adds a token to a dynamic list.
+*)
+
+PROCEDURE addTokToList (t: toktype; n: Name;
+                        i: INTEGER; comment: commentDesc;
+			l: CARDINAL; c: CARDINAL; f: sourceList) ;
+VAR
+   b: tokenBucket ;
+BEGIN
+   IF listOfTokens.head=NIL
+   THEN
+      NEW (listOfTokens.head) ;
+      IF listOfTokens.head=NIL
+      THEN
+         (* list error *)
+      END ;
+      listOfTokens.tail := listOfTokens.head ;
+      listOfTokens.tail^.len := 0
+   ELSIF listOfTokens.tail^.len=MaxBucketSize
+   THEN
+      assert (listOfTokens.tail^.next=NIL) ;
+      NEW (listOfTokens.tail^.next) ;
+      IF listOfTokens.tail^.next=NIL
+      THEN
+         (* list error *)
+      ELSE
+         listOfTokens.tail := listOfTokens.tail^.next ;
+         listOfTokens.tail^.len := 0
+      END ;
+      INC (listOfTokens.lastBucketOffset, MaxBucketSize)
+   END ;
+   WITH listOfTokens.tail^ DO
+      next := NIL ;
+      assert (len # MaxBucketSize) ;
+      WITH buf[len] DO
+         token := t ;
+         str   := n ;
+         int   := i ;
+	 com   := comment ;
+         line  := l ;
+         col   := c ;
+         file  := f
+      END ;
+      INC (len)
+   END
+END addTokToList ;
+
+
+(*
+   isLastTokenEof - returns TRUE if the last token was an eoftok
+*)
+
+PROCEDURE isLastTokenEof () : BOOLEAN ;
+VAR
+   t: CARDINAL ;
+   b: tokenBucket ;
+BEGIN
+   IF listOfTokens.tail#NIL
+   THEN
+      IF listOfTokens.tail^.len=0
+      THEN
+         b := listOfTokens.head ;
+         IF b=listOfTokens.tail
+         THEN
+            RETURN FALSE
+         END ;
+         WHILE b^.next#listOfTokens.tail DO
+            b := b^.next
+         END ;
+      ELSE
+         b := listOfTokens.tail
+      END ;
+      WITH b^ DO
+         assert (len>0) ;     (* len should always be >0 *)
+         RETURN buf[len-1].token=eoftok
+      END
+   END ;
+   RETURN FALSE
+END isLastTokenEof ;
+
+
+(* ***********************************************************************
+ *
+ * These functions allow m2.flex to deliver tokens into the buffer
+ *
+ ************************************************************************* *)
+
+(*
+   addTok - adds a token to the buffer.
+*)
+
+PROCEDURE addTok (t: toktype) ;
+BEGIN
+   IF NOT ((t=eoftok) AND isLastTokenEof())
+   THEN
+      addTokToList (t, NulName, 0, NIL,
+                    mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ;
+      currentUsed := TRUE
+   END
+END addTok ;
+
+
+(*
+   addTokCharStar - adds a token to the buffer and an additional string, s.
+                    A copy of string, s, is made.
+*)
+
+PROCEDURE addTokCharStar (t: toktype; s: ADDRESS) ;
+BEGIN
+   IF strlen(s)>80
+   THEN
+      stop
+   END ;
+   addTokToList (t, makekey (s), 0, NIL,
+		 mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ;
+   currentUsed := TRUE
+END addTokCharStar ;
+
+
+(*
+   addTokInteger - adds a token and an integer to the buffer.
+*)
+
+PROCEDURE addTokInteger (t: toktype; i: INTEGER) ;
+VAR
+   s: String ;
+   c,
+   l: CARDINAL ;
+BEGIN
+   l := mcflex.getLineNo () ;
+   c := mcflex.getColumnNo () ;
+   s := Sprintf1 (Mark (InitString ('%d')), i) ;
+   addTokToList (t, makekey(string(s)), i, NIL, l, c, currentSource) ;
+   s := KillString (s) ;
+   currentUsed := TRUE
+END addTokInteger ;
+
+
+(*
+   addTokComment - adds a token to the buffer and a comment descriptor, com.
+*)
+
+PROCEDURE addTokComment (t: toktype; com: commentDesc) ;
+BEGIN
+   addTokToList (t, NulName, 0, com,
+		 mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ;
+   currentUsed := TRUE
+END addTokComment ;
+
+
+BEGIN
+   init
+END mcLexBuf.
diff --git a/gcc/m2/mc/mcMetaError.def b/gcc/m2/mc/mcMetaError.def
new file mode 100644
index 00000000000..718d92b10f0
--- /dev/null
+++ b/gcc/m2/mc/mcMetaError.def
@@ -0,0 +1,128 @@
+(* mcMetaError.def provides a set of high level error routines.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcMetaError ;
+
+(* Provides a set of high level error routines.  These
+   routines utilise M2Error and provides the programmer
+   with an easier method to obtain useful symbol table
+   information.  *)
+
+FROM SYSTEM IMPORT BYTE ;
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+    All the procedures below expect the n, n1, n2, n3, n4 to be nodes
+    or Name or Cardinal.
+    and m, m1, m2, m3 are error messages and format specifiers.
+    The format specifiers are:
+
+    {%1a}     symbol name for the first symbol.
+    {%1q}     qualified name for the first symbol.
+    {%1t}     type name for the first symbol.
+    {%1ts}    skips type pseudonyms.
+    {%1d}     symbol description
+    {%1td}    type symbol description.
+    {%1k}     operand is a Name not a symbol.
+    {%1N}     operand is a CARDINAL, generate english description of
+              the number (count), ie 1st, 2nd, 3rd, 4th, 19th.
+    {%1n}     operand is a CARDINAL, convert to a number.
+
+    {%1D}     sets the error message to where symbol 1 was declared.
+              The declaration will choose the definition module, then
+              implementation (or program) module.
+    {%1M}     sets the error message to where symbol 1 was declared.
+              The declaration will choose the implementation or program
+              module and if these do not exist then it falls back to
+              the definition module.
+    {%1U}     sets the error message to where symbol 1 was first used.
+    {%E}      error (default)
+    {%W}      message is a warning, not an error.
+    %%        %
+    %{        {
+    %}        }
+
+    the error messages may also embed optional strings such as:
+
+    {%1a:this string is emitted if the symbol name is non null}
+    {!%1a:this string is emitted if the symbol name is null}
+    {!%1a:{%1d}}
+           if the symbol name does not exist then print a description
+           of the symbol.
+    {%1atd} was incompatible with the return type of the procedure
+           means print the symbol name (if null then print the type name
+           if null then print out the description) followed by the
+           string "was incompatible with the return type of the procedure"
+
+    Note all replaced names or descriptions are enclosed in quotes, like:
+    'foo', which matches the behaviour of gcc.  Also note temporary names
+    are treated as null.  Finally the order of format specifiers does
+    matter, {%1td} means get type name and use it if non null, otherwise
+    describe the symbol.
+*)
+
+(*
+   ebnf := { percent | lbra | any } =:
+
+   percent := '%' anych =:
+
+   lbra := '{' [ '!' ] percenttoken '}' =:
+
+   percenttoken := '%' ( '1' op | '2' op | '3' op | '4' op ) =:
+
+   op := {'a'|'q'|'t'|'d'|'k'|'n'|'s'|'D'|'U'|'E'|'W'} then =:
+
+   then := [ ':' ebnf ] =:
+*)
+
+PROCEDURE metaError1 (m: ARRAY OF CHAR; s: ARRAY OF BYTE) ;
+PROCEDURE metaError2 (m: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ;
+PROCEDURE metaError3 (m: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ;
+PROCEDURE metaError4 (m: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ;
+
+PROCEDURE metaErrors1 (m1, m2: ARRAY OF CHAR; s: ARRAY OF BYTE) ;
+PROCEDURE metaErrors2 (m1, m2: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ;
+PROCEDURE metaErrors3 (m1, m2: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ;
+PROCEDURE metaErrors4 (m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ;
+
+PROCEDURE metaErrorT1 (tok: CARDINAL; m: ARRAY OF CHAR; s: ARRAY OF BYTE) ;
+PROCEDURE metaErrorT2 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ;
+PROCEDURE metaErrorT3 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ;
+PROCEDURE metaErrorT4 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ;
+
+PROCEDURE metaErrorsT1 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s: ARRAY OF BYTE) ;
+PROCEDURE metaErrorsT2 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ;
+PROCEDURE metaErrorsT3 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ;
+PROCEDURE metaErrorsT4 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ;
+
+PROCEDURE metaErrorString1 (m: String; s: ARRAY OF BYTE) ;
+PROCEDURE metaErrorString2 (m: String; s1, s2: ARRAY OF BYTE) ;
+PROCEDURE metaErrorString3 (m: String; s1, s2, s3: ARRAY OF BYTE) ;
+PROCEDURE metaErrorString4 (m: String; s1, s2, s3, s4: ARRAY OF BYTE) ;
+
+PROCEDURE metaErrorStringT1 (tok: CARDINAL; m: String; s: ARRAY OF BYTE) ;
+PROCEDURE metaErrorStringT2 (tok: CARDINAL; m: String; s1, s2: ARRAY OF BYTE) ;
+PROCEDURE metaErrorStringT3 (tok: CARDINAL; m: String; s1, s2, s3: ARRAY OF BYTE) ;
+PROCEDURE metaErrorStringT4 (tok: CARDINAL; m: String; s1, s2, s3, s4: ARRAY OF BYTE) ;
+
+
+END mcMetaError.
diff --git a/gcc/m2/mc/mcMetaError.mod b/gcc/m2/mc/mcMetaError.mod
new file mode 100644
index 00000000000..3769ffe5d18
--- /dev/null
+++ b/gcc/m2/mc/mcMetaError.mod
@@ -0,0 +1,1034 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcMetaError ;
+
+
+FROM nameKey IMPORT Name, keyToCharStar, NulName ;
+FROM StrLib IMPORT StrLen ;
+FROM mcLexBuf IMPORT getTokenNo ;
+FROM mcError IMPORT error, newError, newWarning, errorString, internalError, chainError, flushErrors ;
+FROM FIO IMPORT StdOut, WriteLine ;
+FROM SFIO IMPORT WriteS ;
+FROM StringConvert IMPORT ctos ;
+FROM varargs IMPORT vararg ;
+
+IMPORT varargs ;
+
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar,
+                           ConCat, ConCatChar, Mark, string, KillString,
+                           Dup, char, Length, Mult ;
+
+FROM decl IMPORT node, isType, isTemporary, getType, getSymName, getScope, isDef,
+                 isExported, isZtype, isRtype, skipType, getDeclaredMod, getDeclaredDef,
+		 getFirstUsed, isLiteral, isConst, isConstSet, isArray, isVar,
+		 isEnumeration, isEnumerationField, isUnbounded, isProcType, isProcedure,
+		 isPointer, isParameter, isVarParam, isRecord, isRecordField,
+		 isVarient, isModule, isImp, isSet, isSubrange ;
+
+TYPE
+   errorType = (newerror, newwarning, chained) ;
+
+
+(*
+   ebnf := { percent
+             | lbra
+             | any                  % copy ch %
+           }
+         =:
+
+   percent := '%' anych             % copy anych %
+            =:
+
+   lbra := '{' [ '!' ] percenttoken '}' =:
+
+   percenttoken := '%' (
+                         '1'        % doOperand(1) %
+                             op
+                       | '2'        % doOperand(2) %
+                             op
+                       | '3'        % doOperand(3) %
+                             op
+                       | '4'        % doOperand(4) %
+                             op
+                       )
+                       } =:
+
+   op := {'a'|'q'|'t'|'d'|'n'|'s'|'D'|'I'|'U'|'E'|'W'} then =:
+
+   then := [ ':' ebnf ] =:
+*)
+
+
+(*
+   internalFormat - produces an informative internal error.
+*)
+
+PROCEDURE internalFormat (s: String; i: INTEGER; m: ARRAY OF CHAR) ;
+VAR
+   e: error ;
+BEGIN
+   e := newError (getTokenNo()) ;
+   s := WriteS (StdOut, s) ;
+   WriteLine (StdOut) ;
+   s := KillString (s) ;
+   IF i>0
+   THEN
+      DEC(i)
+   END ;
+   s := Mult (InitString (' '), i) ;
+   s := ConCatChar (s, '^') ;
+   s := WriteS (StdOut, s) ;
+   WriteLine (StdOut) ;
+   internalError (m, __FILE__, __LINE__)
+END internalFormat ;
+
+
+(*
+   x - checks to see that a=b.
+*)
+
+PROCEDURE x (a, b: String) : String ;
+BEGIN
+   IF a#b
+   THEN
+      internalError('different string returned', __FILE__, __LINE__)
+   END ;
+   RETURN a
+END x ;
+
+
+(*
+   isWhite - returns TRUE if, ch, is a space.
+*)
+
+PROCEDURE isWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN ch=' '
+END isWhite ;
+
+
+(*
+   then := [ ':' ebnf ] =:
+*)
+
+PROCEDURE then (VAR e: error; VAR t: errorType;
+                VAR r: String; s: String;
+                sym: vararg;
+                VAR i: INTEGER; l: INTEGER;
+                o: String; positive: BOOLEAN) ;
+BEGIN
+   IF char (s, i) = ':'
+   THEN
+      INC (i) ;
+      ebnf (e, t, r, s, sym, i, l) ;
+      IF (i<l) AND (char (s, i) # '}')
+      THEN
+         internalFormat (s, i, 'expecting to see }')
+      END
+   END
+END then ;
+
+
+(*
+   doNumber -
+*)
+
+PROCEDURE doNumber (bol: CARDINAL;
+                    sym: vararg; o: String;
+                    VAR quotes: BOOLEAN) : String ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   IF Length(o) > 0
+   THEN
+      RETURN o
+   ELSE
+      quotes := FALSE ;
+      varargs.next (sym, bol) ;
+      varargs.arg (sym, c) ;
+      RETURN ConCat (o, ctos (c, 0, ' '))
+   END
+END doNumber ;
+
+
+(*
+   doCount -
+*)
+
+PROCEDURE doCount (bol: CARDINAL;
+                   sym: vararg; o: String;
+                   VAR quotes: BOOLEAN) : String ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   IF Length(o) > 0
+   THEN
+      RETURN o
+   ELSE
+      quotes := FALSE ;
+      varargs.next (sym, bol) ;
+      varargs.arg (sym, c) ;
+      o := ConCat (o, ctos (c, 0, ' ')) ;
+      CASE c MOD 100 OF
+
+      11..13:  o := ConCat (o, Mark (InitString ('th')))
+
+      ELSE
+         CASE c MOD 10 OF
+
+         1:  o := ConCat (o, Mark (InitString ('st'))) |
+         2:  o := ConCat (o, Mark (InitString ('nd'))) |
+         3:  o := ConCat (o, Mark (InitString ('rd')))
+
+         ELSE
+            o := ConCat (o, Mark (InitString ('th')))
+         END
+      END ;
+      RETURN o
+   END
+END doCount ;
+
+
+PROCEDURE doAscii (bol: CARDINAL; sym: vararg; o: String) : String ;
+VAR
+   n: node ;
+BEGIN
+   varargs.next (sym, bol) ;
+   varargs.arg (sym, n) ;
+   IF (Length (o) > 0) OR isTemporary (n)
+   THEN
+      RETURN o
+   ELSE
+      RETURN ConCat (o, InitStringCharStar (keyToCharStar (getSymName (n))))
+   END
+END doAscii ;
+
+
+PROCEDURE doName (bol: CARDINAL; sym: vararg; o: String; VAR quotes: BOOLEAN) : String ;
+VAR
+   n: node ;
+BEGIN
+   varargs.next (sym, bol) ;
+   varargs.arg (sym, n) ;
+   IF (Length (o) > 0) OR isTemporary (n)
+   THEN
+      RETURN o
+   ELSE
+      IF isZtype (n)
+      THEN
+         quotes := FALSE ;
+         RETURN ConCat (o, Mark (InitString ('the ZType')))
+      ELSIF isRtype (n)
+      THEN
+         quotes := FALSE ;
+         RETURN ConCat (o, Mark (InitString ('the RType')))
+      ELSIF getSymName (n) # NulName
+      THEN
+         RETURN ConCat (o, InitStringCharStar (keyToCharStar (getSymName (n))))
+      ELSE
+         RETURN o
+      END
+   END
+END doName ;
+
+
+PROCEDURE doQualified (bol: CARDINAL; sym: vararg; o: String) : String ;
+VAR
+   s, n: node ;
+   mod : vararg ;
+BEGIN
+   varargs.next (sym, bol) ;
+   varargs.arg (sym, n) ;
+   IF (Length (o) > 0) OR isTemporary (n)
+   THEN
+      RETURN o
+   ELSE
+      s := getScope (n) ;
+      mod := varargs.start1 (s) ;
+      IF isDef(s) AND isExported(n)
+      THEN
+         o := x (o, doAscii (0, mod, o)) ;
+         o := x (o, ConCatChar (o, '.')) ;
+         o := x (o, ConCat (o, InitStringCharStar (keyToCharStar (getSymName (n)))))
+      ELSE
+         o := x (o, doAscii (bol, sym, o))
+      END ;
+      varargs.end (mod) ;
+      RETURN o
+   END
+END doQualified ;
+
+
+(*
+   doType - returns a string containing the type name of
+            sym.  It will skip pseudonym types.  It also
+            returns the type symbol found.
+*)
+
+PROCEDURE doType (bol: CARDINAL;
+                  VAR sym: vararg; o: String) : String ;
+VAR
+   n: node ;
+BEGIN
+   varargs.next (sym, bol) ;
+   varargs.arg (sym, n) ;
+   IF (Length (o) > 0) OR (getType (n) = NIL)
+   THEN
+      RETURN o
+   ELSE
+      n := skipType (getType (n)) ;
+      varargs.next (sym, bol) ;
+      varargs.replace (sym, n) ;
+      RETURN x (o, doAscii (bol, sym, o))
+   END
+END doType ;
+
+
+(*
+   doSkipType - will skip all pseudonym types.  It also
+                returns the type symbol found and name.
+*)
+
+PROCEDURE doSkipType (bol: CARDINAL; VAR sym: vararg; o: String) : String ;
+VAR
+   n: node ;
+BEGIN
+   varargs.next (sym, bol) ;
+   varargs.arg (sym, n) ;
+   IF Length (o) > 0
+   THEN
+      RETURN o
+   ELSE
+      n := skipType (getType (n)) ;
+      varargs.next (sym, bol) ;
+      varargs.replace (sym, n) ;
+      IF getSymName(n) = NulName
+      THEN
+         RETURN o
+      ELSE
+         RETURN x (o, doAscii (bol, sym, o))
+      END
+   END
+END doSkipType ;
+
+
+PROCEDURE doKey (bol: CARDINAL; sym: vararg; o: String) : String ;
+VAR
+   n: Name ;
+BEGIN
+   IF Length (o) > 0
+   THEN
+      RETURN o
+   ELSE
+      varargs.next (sym, bol) ;
+      varargs.arg (sym, n) ;
+      RETURN ConCat (o, InitStringCharStar (keyToCharStar (n)))
+   END
+END doKey ;
+
+
+(*
+   doError - creates and returns an error note.
+*)
+
+PROCEDURE doError (e: error; t: errorType; tok: CARDINAL) : error ;
+BEGIN
+   CASE t OF
+
+   chained:    IF e=NIL
+               THEN
+                  internalError ('should not be chaining an error onto an empty error note', __FILE__, __LINE__)
+               ELSE
+                  e := chainError (tok, e)
+               END |
+   newerror:   IF e=NIL
+               THEN
+                  e := newError (tok)
+               END |
+   newwarning: IF e=NIL
+               THEN
+                  e := newWarning (tok)
+               END
+
+   ELSE
+      internalError ('unexpected enumeration value', __FILE__, __LINE__)
+   END ;
+   RETURN e
+END doError ;
+
+
+(*
+   doDeclaredDef - creates an error note where sym[bol] was declared.
+*)
+
+PROCEDURE doDeclaredDef (e: error; t: errorType;
+                         bol: CARDINAL;
+                         sym: vararg) : error ;
+VAR
+   n: node ;
+BEGIN
+   IF bol <= varargs.nargs (sym)
+   THEN
+      varargs.next (sym, bol) ;
+      varargs.arg (sym, n) ;
+      e := doError (e, t, getDeclaredDef (n))
+   END ;
+   RETURN e
+END doDeclaredDef ;
+
+
+(*
+   doDeclaredMod - creates an error note where sym[bol] was declared.
+*)
+
+PROCEDURE doDeclaredMod (e: error; t: errorType;
+                         bol: CARDINAL;
+                         sym: vararg) : error ;
+VAR
+   n: node ;
+BEGIN
+   IF bol <= varargs.nargs (sym)
+   THEN
+      varargs.next (sym, bol) ;
+      varargs.arg (sym, n) ;
+      e := doError (e, t, getDeclaredMod (n))
+   END ;
+   RETURN e
+END doDeclaredMod ;
+
+
+(*
+   doUsed - creates an error note where sym[bol] was first used.
+*)
+
+PROCEDURE doUsed (e: error; t: errorType;
+                  bol: CARDINAL;
+                  sym: vararg) : error ;
+VAR
+   n: node ;
+BEGIN
+   IF bol <= varargs.nargs (sym)
+   THEN
+      varargs.next (sym, bol) ;
+      varargs.arg (sym, n) ;
+      e := doError (e, t, getFirstUsed (n))
+   END ;
+   RETURN e
+END doUsed ;
+
+
+(*
+   ConCatWord - joins sentances, a, b, together.
+*)
+
+PROCEDURE ConCatWord (a, b: String) : String ;
+BEGIN
+   IF (Length(a) = 1) AND (char (a, 0) = 'a')
+   THEN
+      a := x (a, ConCatChar (a, 'n'))
+   ELSIF (Length(a) > 1) AND (char (a, -1) = 'a') AND isWhite (char (a, -2))
+   THEN
+      a := x (a, ConCatChar (a, 'n'))
+   END ;
+   IF (Length(a) > 0) AND (NOT isWhite (char (a, -1)))
+   THEN
+      a := x (a, ConCatChar (a, ' '))
+   END ;
+   RETURN x (a, ConCat (a, b))
+END ConCatWord ;
+
+
+(*
+   symDesc -
+*)
+
+PROCEDURE symDesc (n: node; o: String) : String ;
+BEGIN
+   IF isLiteral (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('literal')))
+   ELSIF isConstSet (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('constant set')))
+(*
+   ELSIF IsConstructor(n)
+   THEN
+      RETURN( ConCatWord (o, Mark (InitString ('constructor'))) )
+*)
+   ELSIF isConst (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('constant')))
+   ELSIF isArray (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('array')))
+   ELSIF isVar (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('variable')))
+   ELSIF isEnumeration (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('enumeration type')))
+   ELSIF isEnumerationField (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('enumeration field')))
+   ELSIF isUnbounded (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('unbounded parameter')))
+   ELSIF isProcType (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('procedure type')))
+   ELSIF isProcedure (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('procedure')))
+   ELSIF isPointer (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('pointer')))
+   ELSIF isParameter (n)
+   THEN
+      IF isVarParam (n)
+      THEN
+         RETURN ConCatWord (o, Mark (InitString ('var parameter')))
+      ELSE
+         RETURN ConCatWord (o, Mark (InitString ('parameter')))
+      END
+   ELSIF isType (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('type')))
+   ELSIF isRecord (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('record')))
+   ELSIF isRecordField (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('record field')))
+   ELSIF isVarient (n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('varient record')))
+   ELSIF isModule(n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('module')))
+   ELSIF isDef(n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('definition module')))
+   ELSIF isImp(n)
+   THEN
+      RETURN ConCatWord (o, Mark (InitString ('implementation module')))
+   ELSIF isSet (n)
+   THEN
+      RETURN ConCatWord(o, Mark (InitString ('set')))
+   ELSIF isSubrange (n)
+   THEN
+      RETURN ConCatWord(o, Mark (InitString ('subrange')))
+   ELSE
+      RETURN o
+   END
+END symDesc ;
+
+
+(*
+   doDesc -
+*)
+
+PROCEDURE doDesc (bol: CARDINAL;
+                  sym: vararg; o: String;
+                  VAR quotes: BOOLEAN) : String ;
+VAR
+   n: node ;
+BEGIN
+   IF Length (o) = 0
+   THEN
+      varargs.next (sym, bol) ;
+      varargs.arg (sym, n) ;
+      o := symDesc (n, o) ;
+      IF Length (o) > 0
+      THEN
+         quotes := FALSE
+      END
+   END ;
+   RETURN o
+END doDesc ;
+
+
+(*
+   addQuoted - if, o, is not empty then add it to, r.
+*)
+
+PROCEDURE addQuoted (r, o: String; quotes: BOOLEAN) : String ;
+BEGIN
+   IF Length (o) > 0
+   THEN
+      IF NOT isWhite (char (r, -1))
+      THEN
+         r := x (r, ConCatChar (r, " "))
+      END ;
+      IF quotes
+      THEN
+         r := x (r, ConCatChar (r, "'"))
+      END ;
+      r := x (r, ConCat (r, o)) ;
+      IF quotes
+      THEN
+         r := x (r, ConCatChar (r, "'"))
+      END
+   END ;
+   RETURN r
+END addQuoted ;
+
+
+(*
+   op := {'a'|'q'|'t'|'d'|'k'|'n'|'s'|'D'|'I'|'U'|'E'|'W'} then =:
+*)
+
+PROCEDURE op (VAR e: error; VAR t: errorType;
+              VAR r: String; s: String;
+              sym: vararg;
+              VAR i: INTEGER; l: INTEGER;
+              bol: CARDINAL; positive: BOOLEAN) ;
+VAR
+   o     : String ;
+   c     : vararg ;
+   quotes: BOOLEAN ;
+BEGIN
+   c := varargs.copy (sym) ;
+   o := InitString ('') ;
+   quotes := TRUE ;
+   WHILE (i<l) AND (char (s, i)#'}') DO
+      CASE char(s, i) OF
+
+      'a':  o := x(o, doName (bol, sym, o, quotes)) |
+      'q':  o := x(o, doQualified (bol, sym, o)) |
+      't':  o := x(o, doType (bol, sym, o)) |
+      'd':  o := x(o, doDesc (bol, sym, o, quotes)) |
+      'n':  o := x(o, doNumber (bol, sym, o, quotes)) |
+      'N':  o := x(o, doCount (bol, sym, o, quotes)) |
+      's':  o := x(o, doSkipType (bol, sym, o)) |
+      'k':  o := x(o, doKey (bol, sym, o)) |
+      'D':  e := doDeclaredDef (e, t, bol, sym) |
+      'M':  e := doDeclaredMod (e, t, bol, sym) |
+      'U':  e := doUsed (e, t, bol, sym) |
+      'E':  t := newerror |
+      'W':  t := newwarning |
+      ':':  varargs.end (sym) ;
+            sym := varargs.copy (c) ;
+            then (e, t, r, s, sym, i, l, o, positive) ;
+            o := KillString (o) ;
+            o := InitString ('') ;
+            IF (i<l) AND (char (s, i) # '}')
+            THEN
+               internalFormat (s, i, 'expecting to see }')
+            END ;
+            DEC (i)
+
+      ELSE
+         internalFormat (s, i, 'expecting one of [aqtdnNsDUEW:]')
+      END ;
+      INC (i) ;
+   END ;
+   r := x (r, addQuoted (r, o, quotes)) ;
+   o := KillString (o)
+END op ;
+
+
+(*
+   percenttoken := '%' (
+                         '1'        % doOperand(1) %
+                             op
+                       | '2'        % doOperand(2) %
+                             op
+                       | '3'        % doOperand(3) %
+                             op
+                       | '4'        % doOperand(4) %
+                             op
+                       )
+                       } =:
+*)
+
+PROCEDURE percenttoken (VAR e: error; t: errorType;
+                        VAR r: String; s: String;
+                        sym: vararg;
+                        VAR i: INTEGER; l: INTEGER; positive: BOOLEAN) ;
+BEGIN
+   IF char (s, i) = '%'
+   THEN
+      INC (i) ;
+      CASE char (s, i) OF
+
+      '1':  INC (i) ;
+            op (e, t, r, s, sym, i, l, 0, positive) |
+      '2':  INC (i) ;
+            op (e, t, r, s, sym, i, l, 1, positive) |
+      '3':  INC (i) ;
+            op (e, t, r, s, sym, i, l, 2, positive) |
+      '4':  INC (i) ;
+            op (e, t, r, s, sym, i, l, 3, positive)
+
+      ELSE
+         internalFormat (s, i, 'expecting one of [123]')
+      END ;
+      IF (i<l) AND (char (s, i) # '}')
+      THEN
+         internalFormat (s, i, 'expecting to see }')
+      END
+   END
+END percenttoken ;
+
+
+(*
+   percent := '%' anych           % copy anych %
+            =:
+*)
+
+PROCEDURE percent (VAR r: String; s: String;
+                   sym: vararg;
+                   VAR i: INTEGER; l: INTEGER) ;
+BEGIN
+   IF char(s, i)='%'
+   THEN
+      INC (i) ;
+      IF i<l
+      THEN
+         r := x (r, ConCatChar (r, char (s, i))) ;
+         INC (i)
+      END
+   END
+END percent ;
+
+
+(*
+   lbra := '{' [ '!' ] percenttoken '}' =:
+*)
+
+PROCEDURE lbra (VAR e: error; VAR t: errorType;
+                VAR r: String; s: String;
+                sym: vararg;
+                VAR i: INTEGER; l: INTEGER) ;
+VAR
+   positive: BOOLEAN ;
+BEGIN
+   IF char (s, i) = '{'
+   THEN
+      positive := TRUE ;
+      INC (i) ;
+      IF char (s, i) = '!'
+      THEN
+         positive := FALSE ;
+         INC (i) ;
+      END ;
+      IF char (s, i) # '%'
+      THEN
+         internalFormat (s, i, 'expecting to see %')
+      END ;
+      percenttoken (e, t, r, s, sym, i, l, positive) ;
+      IF (i<l) AND (char (s, i) # '}')
+      THEN
+         internalFormat (s, i, 'expecting to see }')
+      END
+   END
+END lbra ;
+
+
+PROCEDURE stop ; BEGIN END stop ;
+
+(*
+   ebnf := { percent
+             | lbra
+             | any                    % copy ch %
+           }
+         =:
+*)
+
+PROCEDURE ebnf (VAR e: error; VAR t: errorType;
+                VAR r: String; s: String;
+                sym: vararg;
+                VAR i: INTEGER; l: INTEGER) ;
+BEGIN
+   WHILE i<l DO
+      CASE char(s, i) OF
+
+      '%':  percent (r, s, sym, i, l) |
+      '{':  lbra (e, t, r, s, sym, i, l) ;
+            IF (i<l) AND (char (s, i) # '}')
+            THEN
+               internalFormat (s, i, 'expecting to see }')
+            END |
+      '}':  RETURN
+
+      ELSE
+         IF ((isWhite (char(s, i)) AND (Length (r) > 0) AND (NOT isWhite (char (r, -1)))) OR
+            (NOT isWhite (char (s, i))))
+         THEN
+            r := x (r, ConCatChar (r, char (s, i)))
+         END
+      END ;
+      INC (i)
+   END
+END ebnf ;
+
+
+(*
+   doFormat -
+*)
+
+PROCEDURE doFormat (VAR e: error; VAR t: errorType;
+                    s: String; sym: vararg) : String ;
+VAR
+   r   : String ;
+   i, l: INTEGER ;
+BEGIN
+   r := InitString ('') ;
+   i := 0 ;
+   l := Length (s) ;
+   ebnf (e, t, r, s, sym, i, l) ;
+   s := KillString (s) ;
+   RETURN r
+END doFormat ;
+
+
+PROCEDURE metaErrorStringT1 (tok: CARDINAL; m: String; s: ARRAY OF BYTE) ;
+VAR
+   str: String ;
+   e  : error ;
+   sym: vararg ;
+   t  : errorType ;
+BEGIN
+   e := NIL ;
+   sym := varargs.start1 (s) ;
+   t := newerror ;
+   str := doFormat (e, t, m, sym) ;
+   e := doError (e, t, tok) ;
+   errorString (e, str) ;
+   varargs.end (sym)
+END metaErrorStringT1 ;
+
+
+PROCEDURE metaErrorT1 (tok: CARDINAL; m: ARRAY OF CHAR; s: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorStringT1 (tok, InitString (m), s)
+END metaErrorT1 ;
+
+
+PROCEDURE metaErrorStringT2 (tok: CARDINAL; m: String; s1, s2: ARRAY OF BYTE) ;
+VAR
+   str: String ;
+   e  : error ;
+   sym: vararg ;
+   t  : errorType ;
+BEGIN
+   e := NIL ;
+   sym := varargs.start2 (s1, s2) ;
+   t := newerror ;
+   str := doFormat (e, t, m, sym) ;
+   e := doError (e, t, tok) ;
+   errorString (e, str) ;
+   varargs.end (sym)
+END metaErrorStringT2 ;
+
+
+PROCEDURE metaErrorT2 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorStringT2 (tok, InitString (m), s1, s2)
+END metaErrorT2 ;
+
+
+PROCEDURE metaErrorStringT3 (tok: CARDINAL; m: String; s1, s2, s3: ARRAY OF BYTE) ;
+VAR
+   str: String ;
+   e  : error ;
+   sym: vararg ;
+   t  : errorType ;
+BEGIN
+   e := NIL ;
+   sym := varargs.start3 (s1, s2, s3) ;
+   t := newerror ;
+   str := doFormat (e, t, m, sym) ;
+   e := doError (e, t, tok) ;
+   errorString (e, str) ;
+   varargs.end (sym)
+END metaErrorStringT3 ;
+
+
+PROCEDURE metaErrorT3 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorStringT3 (tok, InitString (m), s1, s2, s3)
+END metaErrorT3 ;
+
+
+PROCEDURE metaErrorStringT4 (tok: CARDINAL; m: String; s1, s2, s3, s4: ARRAY OF BYTE) ;
+VAR
+   str: String ;
+   e  : error ;
+   sym: vararg ;
+   t  : errorType ;
+BEGIN
+   e := NIL ;
+   sym := varargs.start4 (s1, s2, s3, s4) ;
+   t := newerror ;
+   str := doFormat (e, t, m, sym) ;
+   e := doError (e, t, tok) ;
+   errorString (e, str) ;
+   varargs.end (sym)
+END metaErrorStringT4 ;
+
+
+PROCEDURE metaErrorT4 (tok: CARDINAL; m: ARRAY OF CHAR;
+                       s1, s2, s3, s4: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorStringT4 (tok, InitString (m), s1, s2, s3, s4)
+END metaErrorT4 ;
+
+
+PROCEDURE metaError1 (m: ARRAY OF CHAR; s: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorT1 (getTokenNo (), m, s)
+END metaError1 ;
+
+
+PROCEDURE metaError2 (m: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorT2 (getTokenNo (), m, s1, s2)
+END metaError2 ;
+
+
+PROCEDURE metaError3 (m: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorT3 (getTokenNo (), m, s1, s2, s3)
+END metaError3 ;
+
+
+PROCEDURE metaError4 (m: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorT4 (getTokenNo (), m, s1, s2, s3, s4)
+END metaError4 ;
+
+
+(*
+   wrapErrors -
+*)
+
+PROCEDURE wrapErrors (tok: CARDINAL;
+                      m1, m2: ARRAY OF CHAR;
+                      sym: vararg) ;
+VAR
+   e, f: error ;
+   str : String ;
+   t   : errorType ;
+BEGIN
+   e := NIL ;
+   t := newerror ;
+   str := doFormat (e, t, InitString(m1), sym) ;
+   e := doError (e, t, tok) ;
+   errorString (e, str) ;
+   f := e ;
+   t := chained ;
+   str := doFormat (f, t, InitString (m2), sym) ;
+   IF e=f
+   THEN
+      t := chained ;
+      f := doError (e, t, tok)
+   END ;
+   errorString (f, str)
+END wrapErrors ;
+
+
+PROCEDURE metaErrorsT1 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s: ARRAY OF BYTE) ;
+VAR
+   sym: vararg ;
+BEGIN
+   sym := varargs.start1 (s) ;
+   wrapErrors (tok, m1, m2, sym) ;
+   varargs.end (sym)
+END metaErrorsT1 ;
+
+
+PROCEDURE metaErrorsT2 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ;
+VAR
+   sym: vararg ;
+BEGIN
+   sym := varargs.start2 (s1, s2) ;
+   wrapErrors (tok, m1, m2, sym) ;
+   varargs.end (sym)
+END metaErrorsT2 ;
+
+
+PROCEDURE metaErrorsT3 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ;
+VAR
+   sym: vararg ;
+BEGIN
+   sym := varargs.start3 (s1, s2, s3) ;
+   wrapErrors (tok, m1, m2, sym) ;
+   varargs.end (sym)
+END metaErrorsT3 ;
+
+
+PROCEDURE metaErrorsT4 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ;
+VAR
+   sym: vararg ;
+BEGIN
+   sym := varargs.start4 (s1, s2, s3, s4) ;
+   wrapErrors (tok, m1, m2, sym) ;
+   varargs.end (sym)
+END metaErrorsT4 ;
+
+
+PROCEDURE metaErrors1 (m1, m2: ARRAY OF CHAR; s: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorsT1 (getTokenNo (), m1, m2, s)
+END metaErrors1 ;
+
+
+PROCEDURE metaErrors2 (m1, m2: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorsT2 (getTokenNo (), m1, m2, s1, s2)
+END metaErrors2 ;
+
+
+PROCEDURE metaErrors3 (m1, m2: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorsT3 (getTokenNo (), m1, m2, s1, s2, s3)
+END metaErrors3 ;
+
+
+PROCEDURE metaErrors4 (m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorsT4 (getTokenNo (), m1, m2, s1, s2, s3, s4)
+END metaErrors4 ;
+
+
+PROCEDURE metaErrorString1 (m: String; s: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorStringT1 (getTokenNo (), m, s)
+END metaErrorString1 ;
+
+
+PROCEDURE metaErrorString2 (m: String; s1, s2: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorStringT2 (getTokenNo (), m, s1, s2)
+END metaErrorString2 ;
+
+
+PROCEDURE metaErrorString3 (m: String; s1, s2, s3: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorStringT3 (getTokenNo (), m, s1, s2, s3)
+END metaErrorString3 ;
+
+
+PROCEDURE metaErrorString4 (m: String; s1, s2, s3, s4: ARRAY OF BYTE) ;
+BEGIN
+   metaErrorStringT4 (getTokenNo (), m, s1, s2, s3, s4)
+END metaErrorString4 ;
+
+
+END mcMetaError.
diff --git a/gcc/m2/mc/mcOptions.def b/gcc/m2/mc/mcOptions.def
new file mode 100644
index 00000000000..a26865a8985
--- /dev/null
+++ b/gcc/m2/mc/mcOptions.def
@@ -0,0 +1,137 @@
+(* mcOptions.def handles the options for mc.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcOptions ;
+
+
+FROM DynamicStrings IMPORT String ;
+FROM FIO IMPORT File ;
+
+
+(*
+   handleOptions - iterates over all options setting appropriate
+                   values and returns the single source file
+                   if found at the end of the arguments.
+*)
+
+PROCEDURE handleOptions () : String ;
+
+
+(*
+   getQuiet - return the value of quiet.
+*)
+
+PROCEDURE getQuiet () : BOOLEAN ;
+
+
+(*
+   getVerbose - return the value of verbose.
+*)
+
+PROCEDURE getVerbose () : BOOLEAN ;
+
+
+(*
+   getInternalDebugging - return the value of internalDebugging.
+*)
+
+PROCEDURE getInternalDebugging () : BOOLEAN ;
+
+
+(*
+   CppCommandLine - returns the Cpp command line and all arguments.
+*)
+
+PROCEDURE getCppCommandLine () : String ;
+
+
+(*
+   getOutputFile - sets the output filename to output.
+*)
+
+PROCEDURE getOutputFile () : String ;
+
+
+(*
+   getExtendedOpaque - return the extendedOpaque value.
+*)
+
+PROCEDURE getExtendedOpaque () : BOOLEAN ;
+
+
+(*
+   setDebugTopological - sets the flag debugTopological to value.
+*)
+
+PROCEDURE setDebugTopological (value: BOOLEAN) ;
+
+
+(*
+   getDebugTopological - returns the flag value of the command
+                         line option --debug-top.
+*)
+
+PROCEDURE getDebugTopological () : BOOLEAN ;
+
+
+(*
+   getHPrefix - saves the H file prefix.
+*)
+
+PROCEDURE getHPrefix () : String ;
+
+
+(*
+   getIgnoreFQ - returns the ignorefq flag.
+*)
+
+PROCEDURE getIgnoreFQ () : BOOLEAN ;
+
+
+(*
+   getGccConfigSystem - return the value of the gccConfigSystem flag.
+*)
+
+PROCEDURE getGccConfigSystem () : BOOLEAN ;
+
+
+(*
+   getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*)
+
+PROCEDURE getScaffoldDynamic () : BOOLEAN ;
+
+
+(*
+   getScaffoldMain - return true if the --scaffold-main option was present.
+*)
+
+PROCEDURE getScaffoldMain () : BOOLEAN ;
+
+
+(*
+   writeGPLheader - writes out the GPL or the GLPL as a comment.
+*)
+
+PROCEDURE writeGPLheader (f: File) ;
+
+
+END mcOptions.
diff --git a/gcc/m2/mc/mcOptions.mod b/gcc/m2/mc/mcOptions.mod
new file mode 100644
index 00000000000..acd80a2c0e9
--- /dev/null
+++ b/gcc/m2/mc/mcOptions.mod
@@ -0,0 +1,718 @@
+(* Copyright (C) 2015-2022 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. *)
+
+IMPLEMENTATION MODULE mcOptions ;
+
+FROM SArgs IMPORT GetArg, Narg ;
+FROM mcSearch IMPORT prependSearchPath ;
+FROM libc IMPORT exit, printf ;
+FROM mcPrintf IMPORT printf0 ;
+FROM Debug IMPORT Halt ;
+FROM StrLib IMPORT StrLen ;
+FROM decl IMPORT setLangC, setLangCP, setLangM2 ;
+
+FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
+                           InitStringCharStar, ConCatChar, ConCat, KillString,
+                           Dup, string, char ;
+
+IMPORT FIO ;
+IMPORT SFIO ;
+
+CONST
+   YEAR = '2021' ;
+
+VAR
+   langC,
+   langCPP,
+   langM2,
+   gplHeader,
+   glplHeader,
+   summary,
+   contributed,
+   scaffoldMain,
+   scaffoldDynamic,
+   caseRuntime,
+   arrayRuntime,
+   returnRuntime,
+   gccConfigSystem,
+   ignoreFQ,
+   debugTopological,
+   extendedOpaque,
+   internalDebugging,
+   verbose,
+   quiet            : BOOLEAN ;
+   projectContents,
+   summaryContents,
+   contributedContents,
+   hPrefix,
+   outputFile,
+   cppArgs,
+   cppProgram       : String ;
+
+
+(*
+   displayVersion - displays the version of the compiler.
+*)
+
+PROCEDURE displayVersion (mustExit: BOOLEAN) ;
+BEGIN
+   printf0 ('Copyright (C) ' + YEAR + ' Free Software Foundation, Inc.\n') ;
+   printf0 ('License GPLv2: GNU GPL version 2 or later <http://gnu.org/licenses/gpl.html>\n') ;
+   printf0 ('This is free software: you are free to change and redistribute it.\n') ;
+   printf0 ('There is NO WARRANTY, to the extent permitted by law.\n') ;
+   IF mustExit
+   THEN
+      exit (0)
+   END
+END displayVersion ;
+
+
+(*
+   displayHelp - display the mc help summary.
+*)
+
+PROCEDURE displayHelp ;
+BEGIN
+   printf0 ("usage: mc [--cpp] [-g] [--quiet] [--extended-opaque] [-q] [-v]") ;
+   printf0 (" [--verbose] [--version] [--help] [-h] [-Ipath] [--olang=c]") ;
+   printf0 (" [--olang=c++] [--olang=m2] [--debug-top]") ;
+   printf0 (' [--gpl-header] [--glpl-header] [--summary="foo"]') ;
+   printf0 (' [--contributed="foo"] [--project="foo"]') ;
+   printf0 (" [--h-file-prefix=foo] [--automatic] [-o=foo] filename\n") ;
+
+   printf0 ("  --cpp               preprocess through the C preprocessor\n") ;
+   printf0 ("  -g                  emit debugging directives in the output language") ;
+   printf0 ("                      so that the debugger will refer to the source\n") ;
+   printf0 ("  -q --quiet          no output unless an error occurs\n") ;
+   printf0 ("  -v --verbose        display preprocessor if invoked\n") ;
+   printf0 ("  --version           display version and exit\n") ;
+   printf0 ("  -h --help           display this help message\n") ;
+   printf0 ("  -Ipath              set the module search path\n") ;
+   printf0 ("  --olang=c           generate ansi C output\n") ;
+   printf0 ("  --olang=c++         generate ansi C++ output\n") ;
+   printf0 ("  --olang=m2          generate PIM4 output\n") ;
+   printf0 ("  --extended-opaque   parse definition and implementation modules to\n") ;
+   printf0 ("                      generate full type debugging of opaque types\n") ;
+   printf0 ("  --debug-top         debug topological data structure resolving (internal)\n") ;
+   printf0 ("  --h-file-prefix=foo set the h file prefix to foo\n") ;
+   printf0 ("  -o=foo              set the output file to foo\n") ;
+   printf0 ("  --ignore-fq         do not generate fully qualified idents\n") ;
+   printf0 ("  --gcc-config-system do not use standard host include files, use gcc config and system instead\n");
+   printf0 ("  --gpl-header        generate a GPL3 header comment at the top of the file\n") ;
+   printf0 ("  --glpl-header       generate a GLPL3 header comment at the top of the file\n") ;
+   printf0 ('  --summary="foo"     generate a one line summary comment at the top of the file\n') ;
+   printf0 ('  --contributed="foo" generate a one line contribution comment near the top of the file\n') ;
+   printf0 ('  --project="foo"     include the project name within the GPL3 or GLPL3 header\n') ;
+   printf0 ('  --automatic         generate a comment at the start of the file warning not to edit as it was automatically generated\n') ;
+   printf0 ('  --scaffold-dynamic  generate dynamic module initialization code for C++\n') ;
+   printf0 ('  --scaffold-main     generate main function which calls upon the dynamic initialization support in M2RTS\n') ;
+   printf0 ("  filename            the source file must be the last option\n") ;
+   exit (0)
+END displayHelp ;
+
+
+(*
+   commentBegin - issue a start of comment for the appropriate language.
+*)
+
+PROCEDURE commentBegin (f: File) ;
+BEGIN
+   IF langC OR langCPP
+   THEN
+      FIO.WriteString (f, '/* ')
+   ELSIF langM2
+   THEN
+      FIO.WriteString (f, '(* ')
+   END
+END commentBegin ;
+
+
+(*
+   commentEnd - issue an end of comment for the appropriate language.
+*)
+
+PROCEDURE commentEnd (f: File) ;
+BEGIN
+   IF langC OR langCPP
+   THEN
+      FIO.WriteString (f, ' */') ; FIO.WriteLine (f)
+   ELSIF langM2
+   THEN
+      FIO.WriteString (f, ' *)') ; FIO.WriteLine (f)
+   END
+END commentEnd ;
+
+
+(*
+   comment - write a comment to file, f, and also a newline.
+*)
+
+PROCEDURE comment (f: File; a: ARRAY OF CHAR) ;
+BEGIN
+   FIO.WriteString (f, a) ; FIO.WriteLine (f)
+END comment ;
+
+
+(*
+   commentS - write a comment to file, f, and also a newline.
+*)
+
+PROCEDURE commentS (f: File; s: String) ;
+BEGIN
+   s := SFIO.WriteS (f, s) ; FIO.WriteLine (f)
+END commentS ;
+
+
+(*
+   gplBody -
+*)
+
+PROCEDURE gplBody (f: File) ;
+BEGIN
+   comment (f, 'Copyright (C) ' + YEAR + ' Free Software Foundation, Inc.') ;
+   IF contributed
+   THEN
+      FIO.WriteString (f, "Contributed by ") ;
+      contributedContents := SFIO.WriteS (f, contributedContents) ;
+      FIO.WriteString (f, ".") ;
+      FIO.WriteLine (f)
+   END ;
+   FIO.WriteLine (f) ;
+   FIO.WriteString (f, "This file is part of ") ;
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   FIO.WriteString (f, ".") ;
+   FIO.WriteLine (f) ; FIO.WriteLine (f) ;
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   comment (f, " is software; you can redistribute it and/or modify") ;
+   comment (f, "it under the terms of the GNU General Public License as published by") ;
+   comment (f, "the Free Software Foundation; either version 3, or (at your option)") ;
+   comment (f, "any later version.") ;
+   FIO.WriteLine (f) ;
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   comment (f, " is distributed in the hope that it will be useful, but") ;
+   comment (f, "WITHOUT ANY WARRANTY; without even the implied warranty of") ;
+   comment (f, "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU") ;
+   comment (f, "General Public License for more details.") ;
+   FIO.WriteLine (f) ;
+   comment (f, "You should have received a copy of the GNU General Public License") ;
+   FIO.WriteString (f, "along with ") ;
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   comment (f, "; see the file COPYING.  If not,") ;
+   FIO.WriteString (f, "see <https://www.gnu.org/licenses/>. ")
+END gplBody ;
+
+
+(*
+   glplBody -
+*)
+
+PROCEDURE glplBody (f: File) ;
+BEGIN
+   comment (f, 'Copyright (C) ' + YEAR + ' Free Software Foundation, Inc.') ;
+   IF contributed
+   THEN
+      FIO.WriteString (f, "Contributed by ") ;
+      contributedContents := SFIO.WriteS (f, contributedContents) ;
+      FIO.WriteString (f, ".") ;
+      FIO.WriteLine (f)
+   END ;
+   FIO.WriteLine (f) ;
+   FIO.WriteString (f, "This file is part of ") ;
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   FIO.WriteString (f, ".") ;
+   FIO.WriteLine (f) ; FIO.WriteLine (f) ;
+
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   comment (f, " is free software; you can redistribute it and/or modify") ;
+   comment (f, "it under the terms of the GNU General Public License as published by") ;
+   comment (f, "the Free Software Foundation; either version 3, or (at your option)") ;
+   comment (f, "any later version.") ;
+   FIO.WriteLine (f) ;
+
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   comment (f, " is software; you can redistribute it and/or modify") ;
+   comment (f, "it under the terms of the GNU Lesser General Public License") ;
+   comment (f, "as published by the Free Software Foundation; either version 3,") ;
+   comment (f, "or (at your option) any later version.") ;
+   FIO.WriteLine (f) ;
+
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   comment (f, " is distributed in the hope that it will be useful, but") ;
+   comment (f, "WITHOUT ANY WARRANTY; without even the implied warranty of") ;
+   comment (f, "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU") ;
+   comment (f, "General Public License for more details.") ;
+   FIO.WriteLine (f) ;
+
+   comment (f, "You should have received a copy of the GNU General Public License") ;
+   FIO.WriteString (f, "along with ") ;
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   comment (f, "; see the file COPYING3.  If not see") ;
+   comment (f, "<http://www.gnu.org/licenses/>.") ;
+
+   FIO.WriteLine (f) ;
+   comment (f, "You should have received a copy of the GNU Lesser General Public License") ;
+   FIO.WriteString (f, "along with ") ;
+   projectContents := SFIO.WriteS (f, projectContents) ;
+   comment (f, "; see the file COPYING.  If not,") ;
+   FIO.WriteString (f, "see <https://www.gnu.org/licenses/>. ")
+END glplBody ;
+
+
+(*
+   issueGPL - writes out the summary, GPL/LGPL and/or contributed as a single comment.
+*)
+
+PROCEDURE issueGPL (f: File) ;
+BEGIN
+   IF summary OR contributed OR gplHeader OR glplHeader
+   THEN
+      commentBegin (f) ;
+      IF summary
+      THEN
+         commentS (f, summaryContents) ;
+         FIO.WriteLine (f)
+      END ;
+      IF gplHeader
+      THEN
+         gplBody (f)
+      END ;
+      IF glplHeader
+      THEN
+         glplBody (f)
+      END ;
+      commentEnd (f) ;
+      FIO.WriteLine (f)
+   END
+END issueGPL ;
+
+
+(*
+   writeGPLheader - writes out the GPL or the LGPL as a comment.
+*)
+
+PROCEDURE writeGPLheader (f: File) ;
+BEGIN
+   issueGPL (f)
+END writeGPLheader ;
+
+
+(*
+   getCppCommandLine - returns the Cpp command line and all arguments.
+*)
+
+PROCEDURE getCppCommandLine () : String ;
+VAR
+   s: String ;
+BEGIN
+   IF EqualArray (cppProgram, '')
+   THEN
+      RETURN NIL
+   ELSE
+      s := Dup (cppProgram) ;
+      s := ConCat (ConCatChar(s, ' '), cppArgs) ;
+      IF getQuiet ()
+      THEN
+         s := ConCat (ConCatChar(s, ' '), Mark (InitString ('-quiet')))
+      END ;
+      RETURN s
+   END
+END getCppCommandLine ;
+
+
+(*
+   setOutputFile - sets the output filename to output.
+*)
+
+PROCEDURE setOutputFile (output: String) ;
+BEGIN
+   outputFile := output
+END setOutputFile ;
+
+
+(*
+   getOutputFile - sets the output filename to output.
+*)
+
+PROCEDURE getOutputFile () : String ;
+BEGIN
+   RETURN outputFile
+END getOutputFile ;
+
+
+(*
+   setQuiet - sets the quiet flag to, value.
+*)
+
+PROCEDURE setQuiet (value: BOOLEAN) ;
+BEGIN
+   quiet := value
+END setQuiet ;
+
+
+(*
+   getQuiet - return the value of quiet.
+*)
+
+PROCEDURE getQuiet () : BOOLEAN ;
+BEGIN
+   RETURN quiet
+END getQuiet ;
+
+
+(*
+   setVerbose - sets the verbose flag to, value.
+*)
+
+PROCEDURE setVerbose (value: BOOLEAN) ;
+BEGIN
+   verbose := value
+END setVerbose ;
+
+
+(*
+   getVerbose - return the value of verbose.
+*)
+
+PROCEDURE getVerbose () : BOOLEAN ;
+BEGIN
+   RETURN verbose
+END getVerbose ;
+
+
+(*
+   setExtendedOpaque - set extendedOpaque to value.
+*)
+
+PROCEDURE setExtendedOpaque (value: BOOLEAN) ;
+BEGIN
+   extendedOpaque := value
+END setExtendedOpaque ;
+
+
+(*
+   getExtendedOpaque - return the extendedOpaque value.
+*)
+
+PROCEDURE getExtendedOpaque () : BOOLEAN ;
+BEGIN
+   RETURN extendedOpaque
+END getExtendedOpaque ;
+
+
+(*
+   setSearchPath - set the search path for the module sources.
+*)
+
+PROCEDURE setSearchPath (arg: String) ;
+BEGIN
+   prependSearchPath (arg)
+END setSearchPath ;
+
+
+(*
+   setInternalDebugging - turn on/off internal debugging.
+*)
+
+PROCEDURE setInternalDebugging (value: BOOLEAN) ;
+BEGIN
+   internalDebugging := value
+END setInternalDebugging ;
+
+
+(*
+   getInternalDebugging - return the value of internalDebugging.
+*)
+
+PROCEDURE getInternalDebugging () : BOOLEAN ;
+BEGIN
+   RETURN internalDebugging
+END getInternalDebugging ;
+
+
+(*
+   setDebugTopological - sets the flag debugTopological to value.
+*)
+
+PROCEDURE setDebugTopological (value: BOOLEAN) ;
+BEGIN
+   debugTopological := value
+END setDebugTopological ;
+
+
+(*
+   getDebugTopological - returns the flag value of the command
+                         line option --debug-top.
+*)
+
+PROCEDURE getDebugTopological () : BOOLEAN ;
+BEGIN
+   RETURN debugTopological
+END getDebugTopological ;
+
+
+(*
+   setHPrefix - saves the H file prefix.
+*)
+
+PROCEDURE setHPrefix (s: String) ;
+BEGIN
+   hPrefix := s
+END setHPrefix ;
+
+
+(*
+   getHPrefix - saves the H file prefix.
+*)
+
+PROCEDURE getHPrefix () : String ;
+BEGIN
+   RETURN hPrefix
+END getHPrefix ;
+
+
+(*
+   setIgnoreFQ - sets the ignorefq flag.
+*)
+
+PROCEDURE setIgnoreFQ (value: BOOLEAN) ;
+BEGIN
+   ignoreFQ := value
+END setIgnoreFQ ;
+
+
+(*
+   getIgnoreFQ - returns the ignorefq flag.
+*)
+
+PROCEDURE getIgnoreFQ () : BOOLEAN ;
+BEGIN
+   RETURN ignoreFQ
+END getIgnoreFQ ;
+
+
+(*
+   getGccConfigSystem - return the value of the gccConfigSystem flag.
+*)
+
+PROCEDURE getGccConfigSystem () : BOOLEAN ;
+BEGIN
+   RETURN gccConfigSystem
+END getGccConfigSystem ;
+
+
+(*
+   getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*)
+
+PROCEDURE getScaffoldDynamic () : BOOLEAN ;
+BEGIN
+   RETURN scaffoldDynamic
+END getScaffoldDynamic ;
+
+
+(*
+   getScaffoldMain - return true if the --scaffold-main option was present.
+*)
+
+PROCEDURE getScaffoldMain () : BOOLEAN ;
+BEGIN
+   RETURN scaffoldMain
+END getScaffoldMain ;
+
+
+(*
+   optionIs - returns TRUE if the first len (right) characters
+              match left.
+*)
+
+PROCEDURE optionIs (left: ARRAY OF CHAR; right: String) : BOOLEAN ;
+VAR
+   s: String ;
+BEGIN
+   IF Length (right) = StrLen (left)
+   THEN
+      RETURN EqualArray (right, left)
+   ELSIF  Length (right) > StrLen (left)
+   THEN
+      s := Mark (Slice (right, 0, StrLen (left))) ;
+      RETURN EqualArray (s, left)
+   ELSE
+      RETURN FALSE
+   END
+END optionIs ;
+
+
+(*
+   setLang - set the appropriate output language.
+*)
+
+PROCEDURE setLang (arg: String) ;
+BEGIN
+   (* must check the longest distinctive string first.  *)
+   IF optionIs ("c++", arg)
+   THEN
+      setLangCP ;
+      langCPP := TRUE
+   ELSIF optionIs ("c", arg)
+   THEN
+      setLangC ;
+      langC := TRUE
+   ELSIF optionIs ("m2", arg)
+   THEN
+      setLangM2 ;
+      langM2 := TRUE
+   ELSE
+      displayHelp
+   END
+END setLang ;
+
+
+(*
+   handleOption -
+*)
+
+PROCEDURE handleOption (arg: String) ;
+BEGIN
+   IF optionIs ("--quiet", arg) OR optionIs ("-q", arg)
+   THEN
+      setQuiet (TRUE)
+   ELSIF optionIs ("--verbose", arg) OR optionIs ("-v", arg)
+   THEN
+      setVerbose (TRUE)
+   ELSIF optionIs ("--version", arg)
+   THEN
+      displayVersion (TRUE)
+   ELSIF optionIs ("--olang=", arg)
+   THEN
+      setLang (Slice (arg, 8, 0))
+   ELSIF optionIs ("-I", arg)
+   THEN
+      setSearchPath (Slice (arg, 2, 0))
+   ELSIF optionIs ("--help", arg) OR optionIs ("-h", arg)
+   THEN
+      displayHelp
+   ELSIF optionIs ("--cpp", arg)
+   THEN
+      cppProgram := InitString ('cpp')
+   ELSIF optionIs ("-o=", arg)
+   THEN
+      setOutputFile (Slice (arg, 3, 0))
+   ELSIF optionIs ("--extended-opaque", arg)
+   THEN
+      setExtendedOpaque (TRUE)
+   ELSIF optionIs ("--debug-top", arg)
+   THEN
+      setDebugTopological (TRUE)
+   ELSIF optionIs ("--h-file-prefix=", arg)
+   THEN
+      setHPrefix (Slice (arg, 16, 0))
+   ELSIF optionIs ("--ignore-fq", arg)
+   THEN
+      setIgnoreFQ (TRUE)
+   ELSIF optionIs ("--gpl-header", arg)
+   THEN
+      gplHeader := TRUE
+   ELSIF optionIs ("--glpl-header", arg)
+   THEN
+      glplHeader := TRUE
+   ELSIF optionIs ('--summary="', arg)
+   THEN
+      summary := TRUE ;
+      summaryContents := Slice (arg, 11, -1)
+   ELSIF optionIs ('--contributed="', arg)
+   THEN
+      contributed := TRUE ;
+      contributedContents := Slice (arg, 13, -1)
+   ELSIF optionIs ('--project="', arg)
+   THEN
+      projectContents := Slice (arg, 10, -1)
+   ELSIF optionIs ('--gcc-config-system', arg)
+   THEN
+      gccConfigSystem := TRUE
+   ELSIF optionIs ('--scaffold-main', arg)
+   THEN
+      scaffoldMain := TRUE
+   ELSIF optionIs ('--scaffold-dynamic', arg)
+   THEN
+      scaffoldDynamic := TRUE
+   END
+END handleOption ;
+
+
+(*
+   handleOptions - iterates over all options setting appropriate
+                   values and returns the single source file
+                   if found at the end of the arguments.
+*)
+
+PROCEDURE handleOptions () : String ;
+VAR
+   i  : CARDINAL ;
+   arg: String ;
+BEGIN
+   i := 1 ;
+   WHILE GetArg (arg, i) DO
+      IF Length (arg) > 0
+      THEN
+         IF char (arg, 0)='-'
+         THEN
+            handleOption (arg)
+         ELSE
+            IF NOT summary
+            THEN
+               summaryContents := ConCatChar (ConCat (InitString ('automatically created by mc from '),
+                                                      arg), '.') ;
+               summary := FALSE
+            END ;
+            RETURN arg
+         END
+      END ;
+      INC (i)
+   END ;
+   RETURN NIL
+END handleOptions ;
+
+
+BEGIN
+   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 ;
+   hPrefix := InitString ('') ;
+   cppArgs := InitString ('') ;
+   cppProgram := InitString ('') ;
+   outputFile := InitString ('-') ;
+   summaryContents := InitString ('') ;
+   contributedContents := InitString ('') ;
+   projectContents := InitString ('GNU Modula-2')
+END mcOptions.
diff --git a/gcc/m2/mc/mcPreprocess.def b/gcc/m2/mc/mcPreprocess.def
new file mode 100644
index 00000000000..84fab264f2a
--- /dev/null
+++ b/gcc/m2/mc/mcPreprocess.def
@@ -0,0 +1,41 @@
+(* mcPreprocess.def provides a mechanism to invoke the C preprocessor.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcPreprocess ;
+
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE preprocessModule (filename: String) : String ;
+
+
+END mcPreprocess.
diff --git a/gcc/m2/mc/mcPreprocess.mod b/gcc/m2/mc/mcPreprocess.mod
new file mode 100644
index 00000000000..439124b4780
--- /dev/null
+++ b/gcc/m2/mc/mcPreprocess.mod
@@ -0,0 +1,132 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcPreprocess ;
+
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+FROM DynamicStrings IMPORT string, InitString, Mark, KillString, EqualArray, InitStringCharStar,
+                           Dup, ConCat, ConCatChar, RIndex, Slice ;
+
+FROM libc IMPORT system, exit, unlink, printf ;
+FROM alists IMPORT alist, initList, killList, includeItemIntoList, foreachItemInListDo ;
+FROM M2RTS IMPORT InstallTerminationProcedure ;
+FROM FIO IMPORT StdErr, StdOut ;
+FROM mcPrintf IMPORT fprintf1 ;
+FROM mcOptions IMPORT getVerbose, getCppCommandLine ;
+
+
+VAR
+   listOfFiles: alist ;
+
+
+(*
+   makeTempFile -
+*)
+
+PROCEDURE makeTempFile (ext: String) : String ;
+BEGIN
+   RETURN ConCat (InitString ('/tmp/mctemp.'), ext)
+END makeTempFile ;
+
+
+(*
+   onExitDelete -
+*)
+
+PROCEDURE onExitDelete (filename: String) : String ;
+BEGIN
+   includeItemIntoList (listOfFiles, Dup (filename)) ;
+   RETURN filename
+END onExitDelete ;
+
+
+(*
+   removeFile - removes a single file, s.
+*)
+
+PROCEDURE removeFile (a: ADDRESS) ;
+VAR
+   s: String ;
+BEGIN
+   s := a ;
+   IF unlink (string (s))#0
+   THEN
+   END
+END removeFile ;
+
+
+(*
+   removeFiles -
+*)
+
+PROCEDURE removeFiles ;
+BEGIN
+   foreachItemInListDo (listOfFiles, removeFile)
+END removeFiles ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE preprocessModule (filename: String) : String ;
+VAR
+   tempfile,
+   command,
+   commandLine: String ;
+   pos        : CARDINAL ;
+BEGIN
+   command := getCppCommandLine () ;
+   IF EqualArray (command, '')
+   THEN
+      RETURN filename
+   ELSE
+      tempfile := InitStringCharStar (makeTempFile (InitString ('cpp'))) ;
+      commandLine := Dup (command) ;
+      commandLine := ConCat (ConCat (ConCat (ConCatChar (Dup (commandLine), ' '), filename),
+                                     Mark (InitString(' -o '))),
+                             tempfile) ;
+      IF getVerbose ()
+      THEN
+         fprintf1 (StdOut, "%s\n", commandLine)
+      END ;
+      IF system (string (commandLine))#0
+      THEN
+         fprintf1(StdErr, 'C preprocessor failed when preprocessing %s\n', filename) ;
+         exit(1)
+      END ;
+      commandLine := KillString (commandLine) ;
+      RETURN onExitDelete (tempfile)
+   END
+END preprocessModule ;
+
+
+BEGIN
+   listOfFiles := initList () ;
+   IF NOT InstallTerminationProcedure (removeFiles)
+   THEN
+      HALT
+   END
+END mcPreprocess.
diff --git a/gcc/m2/mc/mcPretty.def b/gcc/m2/mc/mcPretty.def
new file mode 100644
index 00000000000..9d2a5d63fb2
--- /dev/null
+++ b/gcc/m2/mc/mcPretty.def
@@ -0,0 +1,140 @@
+(* mcPretty.def provides an interface to the pretty printing of output code.
+
+Copyright (C) 2016-2022 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/>.  *)
+
+DEFINITION MODULE mcPretty ;
+
+
+FROM DynamicStrings IMPORT String ;
+
+TYPE
+   pretty ;
+   writeProc = PROCEDURE (CHAR) ;
+   writeLnProc = PROCEDURE ;
+
+
+(*
+   initPretty - initialise a pretty print data structure.
+*)
+
+PROCEDURE initPretty (w: writeProc; l: writeLnProc) : pretty ;
+
+
+(*
+   dupPretty - duplicate a pretty print data structure.
+*)
+
+PROCEDURE dupPretty (p: pretty) : pretty ;
+
+
+(*
+   killPretty - destroy a pretty print data structure.
+                Post condition:  p is assigned to NIL.
+*)
+
+PROCEDURE killPretty (VAR p: pretty) ;
+
+
+(*
+   pushPretty - duplicate, p.  Push, p, and return the duplicate.
+*)
+
+PROCEDURE pushPretty (p: pretty) : pretty ;
+
+
+(*
+   popPretty - pops the pretty object from the stack.
+*)
+
+PROCEDURE popPretty (p: pretty) : pretty ;
+
+
+(*
+   getindent - returns the current indent value.
+*)
+
+PROCEDURE getindent (p: pretty) : CARDINAL ;
+
+
+(*
+   setindent - sets the current indent to, n.
+*)
+
+PROCEDURE setindent (p: pretty; n: CARDINAL) ;
+
+
+(*
+   getcurpos - returns the current cursor position.
+*)
+
+PROCEDURE getcurpos (s: pretty) : CARDINAL ;
+
+
+(*
+   getseekpos - returns the seek position.
+*)
+
+PROCEDURE getseekpos (s: pretty) : CARDINAL ;
+
+
+(*
+   getcurline - returns the current line number.
+*)
+
+PROCEDURE getcurline (s: pretty) : CARDINAL ;
+
+
+(*
+   setNeedSpace - sets needSpace flag to TRUE.
+*)
+
+PROCEDURE setNeedSpace (s: pretty) ;
+
+
+(*
+   noSpace - unset needsSpace.
+*)
+
+PROCEDURE noSpace (s: pretty) ;
+
+
+(*
+   print - print a string using, p.
+*)
+
+PROCEDURE print (p: pretty; a: ARRAY OF CHAR) ;
+
+
+(*
+   prints - print a string using, p.
+*)
+
+PROCEDURE prints (p: pretty; s: String) ;
+
+
+(*
+   raw - print out string, s, without any translation of
+         escape sequences.
+*)
+
+PROCEDURE raw (p: pretty; s: String) ;
+
+
+END mcPretty.
diff --git a/gcc/m2/mc/mcPretty.mod b/gcc/m2/mc/mcPretty.mod
new file mode 100644
index 00000000000..344e0a610fe
--- /dev/null
+++ b/gcc/m2/mc/mcPretty.mod
@@ -0,0 +1,304 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcPretty ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Length, char ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+
+TYPE
+   pretty = POINTER TO RECORD
+                          write      : writeProc ;
+			  writeln    : writeLnProc ;
+                          needsSpace,
+                          needsIndent: BOOLEAN ;
+			  seekPos,
+			  curLine,
+                          curPos,
+		          indent     : CARDINAL ;
+			  stacked    : pretty ;
+                       END ;
+
+
+(*
+   initPretty - initialise a pretty print data structure.
+*)
+
+PROCEDURE initPretty (w: writeProc; l: writeLnProc) : pretty ;
+VAR
+   p: pretty ;
+BEGIN
+   NEW (p) ;
+   WITH p^ DO
+      write := w ;
+      writeln := l ;
+      needsSpace := FALSE ;
+      needsIndent := FALSE ;
+      curPos := 0 ;
+      curLine := 0 ;
+      seekPos := 0 ;
+      indent := 0 ;
+      stacked := NIL
+   END ;
+   RETURN p
+END initPretty ;
+
+
+(*
+   dupPretty - duplicate a pretty print data structure.
+*)
+
+PROCEDURE dupPretty (p: pretty) : pretty ;
+VAR
+   q: pretty ;
+BEGIN
+   NEW (q) ;
+   q^ := p^ ;
+   RETURN q
+END dupPretty ;
+
+
+(*
+   killPretty - destroy a pretty print data structure.
+                Post condition:  p is assigned to NIL.
+*)
+
+PROCEDURE killPretty (VAR p: pretty) ;
+BEGIN
+   p := NIL ;
+   RETURN ;
+   DISPOSE (p) ;
+   p := NIL
+END killPretty ;
+
+
+(*
+   pushPretty - duplicate, p.  Push, p, and return the duplicate.
+*)
+
+PROCEDURE pushPretty (p: pretty) : pretty ;
+VAR
+   q: pretty ;
+BEGIN
+   q := dupPretty (p) ;
+   q^.stacked := p ;
+   RETURN q
+END pushPretty ;
+
+
+(*
+   popPretty - pops the pretty object from the stack.
+*)
+
+PROCEDURE popPretty (p: pretty) : pretty ;
+VAR
+   q: pretty ;
+BEGIN
+   q := p^.stacked ;
+   q^.needsIndent := p^.needsIndent ;
+   q^.needsSpace := p^.needsSpace ;
+   q^.curPos := p^.curPos ;
+   q^.seekPos := p^.seekPos ;
+   q^.curLine := p^.curLine ;
+   killPretty (p) ;
+   RETURN q
+END popPretty ;
+
+
+(*
+   getindent - returns the current indent value.
+*)
+
+PROCEDURE getindent (p: pretty) : CARDINAL ;
+BEGIN
+   RETURN p^.indent
+END getindent ;
+
+
+(*
+   setindent - sets the current indent to, n.
+*)
+
+PROCEDURE setindent (p: pretty; n: CARDINAL) ;
+BEGIN
+   p^.indent := n
+END setindent ;
+
+
+(*
+   getcurpos - returns the current cursor position.
+*)
+
+PROCEDURE getcurpos (s: pretty) : CARDINAL ;
+BEGIN
+   IF s^.needsSpace
+   THEN
+      RETURN s^.curPos+1
+   ELSE
+      RETURN s^.curPos
+   END
+END getcurpos ;
+
+
+(*
+   getcurline - returns the current line number.
+*)
+
+PROCEDURE getcurline (s: pretty) : CARDINAL ;
+BEGIN
+   RETURN s^.curLine
+END getcurline ;
+
+
+(*
+   getseekpos - returns the seek position.
+*)
+
+PROCEDURE getseekpos (s: pretty) : CARDINAL ;
+BEGIN
+   RETURN s^.seekPos
+END getseekpos ;
+
+
+(*
+   setneedSpace - sets needSpace flag to TRUE.
+*)
+
+PROCEDURE setNeedSpace (s: pretty) ;
+BEGIN
+   s^.needsSpace := TRUE
+END setNeedSpace ;
+
+
+(*
+   noSpace - unset needsSpace.
+*)
+
+PROCEDURE noSpace (s: pretty) ;
+BEGIN
+   s^.needsSpace := FALSE
+END noSpace ;
+
+
+(*
+   flushSpace -
+*)
+
+PROCEDURE flushSpace (p: pretty) ;
+BEGIN
+   IF p^.needsSpace
+   THEN
+      p^.write (' ') ;
+      p^.needsSpace := FALSE ;
+      INC (p^.curPos) ;
+      INC (p^.seekPos)
+   END
+END flushSpace ;
+
+
+(*
+   flushIndent -
+*)
+
+PROCEDURE flushIndent (p: pretty) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   flushSpace (p) ;
+   IF p^.needsIndent
+   THEN
+      WHILE p^.curPos<p^.indent DO
+         p^.write (' ') ;
+         INC (p^.curPos) ;
+         INC (p^.seekPos)
+      END ;
+      p^.needsIndent := FALSE
+   END
+END flushIndent ;
+
+
+(*
+   print - print a string using, p.
+*)
+
+PROCEDURE print (p: pretty; a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   s := InitString (a) ;
+   prints (p, s) ;
+   s := KillString (s)
+END print ;
+
+
+(*
+   prints - print a string using, p.
+*)
+
+PROCEDURE prints (p: pretty; s: String) ;
+VAR
+   l, i: CARDINAL ;
+BEGIN
+   l := Length (s) ;
+   i := 0 ;
+   flushSpace (p) ;
+   WHILE i<l DO
+      IF (i+2<=l) AND (char (s, i)='\') AND (char (s, i+1)='n')
+      THEN
+         p^.needsIndent := TRUE ;
+         p^.needsSpace := FALSE ;
+         p^.curPos := 0 ;
+         p^.writeln ;
+         INC (p^.seekPos) ;
+         INC (p^.curLine) ;
+         INC (i)
+      ELSE
+         flushIndent (p) ;
+         p^.write (char (s, i)) ;
+         INC (p^.curPos) ;
+         INC (p^.seekPos)
+      END ;
+      INC (i)
+   END
+END prints ;
+
+
+(*
+   raw - print out string, s, without any translation of
+         escape sequences.
+*)
+
+PROCEDURE raw (p: pretty; s: String) ;
+VAR
+   l, i: CARDINAL ;
+BEGIN
+   l := Length (s) ;
+   i := 0 ;
+   flushSpace (p) ;
+   flushIndent (p) ;
+   WHILE i < l DO
+      p^.write (char (s, i)) ;
+      INC (p^.curPos) ;
+      INC (p^.seekPos) ;
+      INC (i)
+   END
+END raw ;
+
+
+END mcPretty.
diff --git a/gcc/m2/mc/mcPrintf.def b/gcc/m2/mc/mcPrintf.def
new file mode 100644
index 00000000000..29376a0c417
--- /dev/null
+++ b/gcc/m2/mc/mcPrintf.def
@@ -0,0 +1,57 @@
+(* mcPrintf.def provides a poor mans printf capability.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcPrintf ;
+
+
+(* Provides a poor mans printf capability. It requires NameKey
+   as it will translate %a into a namekey.
+   It supports %a, %d, %c and %s.  *)
+
+FROM SYSTEM IMPORT BYTE ;
+FROM FIO IMPORT File ;
+
+
+(*
+   printf0 - writes out an array to, StdOut, after the escape sequences have been
+             translated.
+*)
+
+PROCEDURE printf0 (a: ARRAY OF CHAR) ;
+PROCEDURE printf1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+PROCEDURE printf2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+PROCEDURE printf3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+PROCEDURE printf4 (a: ARRAY OF CHAR; w1, w2, w3, w4: ARRAY OF BYTE) ;
+
+
+(*
+   fprintf0 - writes out an array to, file, after the escape sequences have been
+              translated.
+*)
+
+PROCEDURE fprintf0 (file: File; a: ARRAY OF CHAR) ;
+PROCEDURE fprintf1 (file: File; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+PROCEDURE fprintf2 (file: File; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+PROCEDURE fprintf3 (file: File; a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+PROCEDURE fprintf4 (file: File; a: ARRAY OF CHAR; w1, w2, w3, w4: ARRAY OF BYTE) ;
+
+
+END mcPrintf.
diff --git a/gcc/m2/mc/mcPrintf.mod b/gcc/m2/mc/mcPrintf.mod
new file mode 100644
index 00000000000..7d960c0d48d
--- /dev/null
+++ b/gcc/m2/mc/mcPrintf.mod
@@ -0,0 +1,308 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcPrintf ;
+
+FROM SFIO IMPORT WriteS ;
+FROM FIO IMPORT StdOut ;
+FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, Mark ;
+FROM StrLib IMPORT StrLen ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4 ;
+FROM nameKey IMPORT Name, keyToCharStar ;
+
+
+(*
+   isDigit - returns TRUE if, ch, is a character 0..9
+*)
+
+PROCEDURE isDigit (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch>='0') AND (ch<='9')
+END isDigit ;
+
+
+(*
+   cast - casts a := b
+*)
+
+PROCEDURE cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF HIGH (a) = HIGH (b)
+   THEN
+      FOR i := 0 TO HIGH (a) DO
+         a[i] := b[i]
+      END
+   ELSE
+      HALT
+   END
+END cast ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE TranslateNameToCharStar (VAR a: ARRAY OF CHAR;
+                                   n: CARDINAL) : BOOLEAN ;
+VAR
+   argno,
+   i, h : CARDINAL ;
+BEGIN
+   argno := 1 ;
+   i := 0 ;
+   h := StrLen (a) ;
+   WHILE i<h DO
+      IF (a[i]='%') AND (i+1<h)
+      THEN
+         IF (a[i+1]='a') AND (argno=n)
+         THEN
+            a[i+1] := 's' ;
+            RETURN TRUE
+         END ;
+         INC (argno) ;
+         IF argno>n
+         THEN
+            (* all done *)
+            RETURN FALSE
+         END
+      END ;
+      INC (i)
+   END ;
+   RETURN FALSE
+END TranslateNameToCharStar ;
+
+
+(*
+   fprintf0 - writes out an array to, file, after the escape sequences
+              have been translated.
+*)
+
+PROCEDURE fprintf0 (file: File; a: ARRAY OF CHAR) ;
+BEGIN
+   IF KillString (WriteS (file, Sprintf0 (InitString (a)))) = NIL
+   THEN
+   END
+END fprintf0 ;
+
+
+PROCEDURE fprintf1 (file: File; a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   s, t: String ;
+   n   : Name ;
+BEGIN
+   IF TranslateNameToCharStar (a, 1)
+   THEN
+      cast (n, w) ;
+      s := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      t := Mark (InitString (a)) ;
+      s := Sprintf1 (t, s)
+   ELSE
+      t := Mark (InitString (a)) ;
+      s := Sprintf1 (t, w)
+   END ;
+   IF KillString (WriteS (file, s)) = NIL
+   THEN
+   END
+END fprintf1 ;
+
+
+PROCEDURE fprintf2 (file: File; a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+VAR
+   n     : Name ;
+   s,
+   s1, s2: String ;
+   b     : BITSET ;
+BEGIN
+   b := {} ;
+   IF TranslateNameToCharStar (a, 1)
+   THEN
+      cast (n, w1) ;
+      s1 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 1)
+   END ;
+   IF TranslateNameToCharStar (a, 2)
+   THEN
+      cast (n, w2) ;
+      s2 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 2)
+   END ;
+   CASE b OF
+
+   {}   :  s := Sprintf2 (Mark (InitString (a)), w1, w2) |
+   {1}  :  s := Sprintf2 (Mark (InitString (a)), s1, w2) |
+   {2}  :  s := Sprintf2 (Mark (InitString (a)), w1, s2) |
+   {1,2}:  s := Sprintf2 (Mark (InitString (a)), s1, s2)
+
+   ELSE
+      HALT
+   END ;
+   IF KillString (WriteS (file, s)) = NIL
+   THEN
+   END
+END fprintf2 ;
+
+
+PROCEDURE fprintf3 (file: File; a: ARRAY OF CHAR;
+                    w1, w2, w3: ARRAY OF BYTE) ;
+VAR
+   n            : Name ;
+   s, s1, s2, s3: String ;
+   b            : BITSET ;
+BEGIN
+   b := {} ;
+   IF TranslateNameToCharStar (a, 1)
+   THEN
+      cast (n, w1) ;
+      s1 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 1)
+   END ;
+   IF TranslateNameToCharStar (a, 2)
+   THEN
+      cast (n, w2) ;
+      s2 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 2)
+   END ;
+   IF TranslateNameToCharStar (a, 3)
+   THEN
+      cast (n, w3) ;
+      s3 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 3)
+   END ;
+   CASE b OF
+
+   {}     :  s := Sprintf3 (Mark (InitString (a)), w1, w2, w3) |
+   {1}    :  s := Sprintf3 (Mark (InitString (a)), s1, w2, w3) |
+   {2}    :  s := Sprintf3 (Mark (InitString (a)), w1, s2, w3) |
+   {1,2}  :  s := Sprintf3 (Mark (InitString (a)), s1, s2, w3) |
+   {3}    :  s := Sprintf3 (Mark (InitString (a)), w1, w2, s3) |
+   {1,3}  :  s := Sprintf3 (Mark (InitString (a)), s1, w2, s3) |
+   {2,3}  :  s := Sprintf3 (Mark (InitString (a)), w1, s2, s3) |
+   {1,2,3}:  s := Sprintf3 (Mark (InitString (a)), s1, s2, s3)
+
+   ELSE
+      HALT
+   END ;
+   IF KillString(WriteS(file, s))=NIL
+   THEN
+   END
+END fprintf3 ;
+
+
+PROCEDURE fprintf4 (file: File; a: ARRAY OF CHAR;
+                    w1, w2, w3, w4: ARRAY OF BYTE) ;
+VAR
+   n                : Name ;
+   s, s1, s2, s3, s4: String ;
+   b                : BITSET ;
+BEGIN
+   b := {} ;
+   IF TranslateNameToCharStar (a, 1)
+   THEN
+      cast (n, w1) ;
+      s1 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 1)
+   END ;
+   IF TranslateNameToCharStar (a, 2)
+   THEN
+      cast (n, w2) ;
+      s2 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 2)
+   END ;
+   IF TranslateNameToCharStar (a, 3)
+   THEN
+      cast (n, w3) ;
+      s3 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 3)
+   END ;
+   IF TranslateNameToCharStar (a, 4)
+   THEN
+      cast (n, w4) ;
+      s4 := Mark (InitStringCharStar (keyToCharStar (n))) ;
+      INCL (b, 4)
+   END ;
+   CASE b OF
+
+   {}       :  s := Sprintf4 (Mark(InitString (a)), w1, w2, w3, w4) |
+   {1}      :  s := Sprintf4 (Mark(InitString (a)), s1, w2, w3, w4) |
+   {2}      :  s := Sprintf4 (Mark(InitString (a)), w1, s2, w3, w4) |
+   {1,2}    :  s := Sprintf4 (Mark(InitString (a)), s1, s2, w3, w4) |
+   {3}      :  s := Sprintf4 (Mark(InitString (a)), w1, w2, s3, w4) |
+   {1,3}    :  s := Sprintf4 (Mark(InitString (a)), s1, w2, s3, w4) |
+   {2,3}    :  s := Sprintf4 (Mark(InitString (a)), w1, s2, s3, w4) |
+   {1,2,3}  :  s := Sprintf4 (Mark(InitString (a)), s1, s2, s3, w4) |
+   {4}      :  s := Sprintf4 (Mark(InitString (a)), w1, w2, w3, s4) |
+   {1,4}    :  s := Sprintf4 (Mark(InitString (a)), s1, w2, w3, s4) |
+   {2,4}    :  s := Sprintf4 (Mark(InitString (a)), w1, s2, w3, s4) |
+   {1,2,4}  :  s := Sprintf4 (Mark(InitString (a)), s1, s2, w3, s4) |
+   {3,4}    :  s := Sprintf4 (Mark(InitString (a)), w1, w2, s3, s4) |
+   {1,3,4}  :  s := Sprintf4 (Mark(InitString (a)), s1, w2, s3, s4) |
+   {2,3,4}  :  s := Sprintf4 (Mark(InitString (a)), w1, s2, s3, s4) |
+   {1,2,3,4}:  s := Sprintf4 (Mark(InitString (a)), s1, s2, s3, s4)
+
+   ELSE
+      HALT
+   END ;
+   IF KillString (WriteS (file, s)) = NIL
+   THEN
+   END
+END fprintf4 ;
+
+
+(*
+   printf0 - writes out an array to, StdOut, after the escape
+             sequences have been translated.
+*)
+
+PROCEDURE printf0 (a: ARRAY OF CHAR) ;
+BEGIN
+   fprintf0 (StdOut, a)
+END printf0 ;
+
+
+PROCEDURE printf1 (a: ARRAY OF CHAR;
+                   w: ARRAY OF BYTE) ;
+BEGIN
+   fprintf1 (StdOut, a, w)
+END printf1 ;
+
+
+PROCEDURE printf2 (a: ARRAY OF CHAR;
+                   w1, w2: ARRAY OF BYTE) ;
+BEGIN
+   fprintf2 (StdOut, a, w1, w2)
+END printf2 ;
+
+
+PROCEDURE printf3 (a: ARRAY OF CHAR;
+                   w1, w2, w3: ARRAY OF BYTE) ;
+BEGIN
+   fprintf3 (StdOut, a, w1, w2, w3)
+END printf3 ;
+
+
+PROCEDURE printf4 (a: ARRAY OF CHAR;
+                   w1, w2, w3, w4: ARRAY OF BYTE) ;
+BEGIN
+   fprintf4 (StdOut, a, w1, w2, w3, w4)
+END printf4 ;
+
+
+END mcPrintf.
diff --git a/gcc/m2/mc/mcQuiet.def b/gcc/m2/mc/mcQuiet.def
new file mode 100644
index 00000000000..d3a302237ec
--- /dev/null
+++ b/gcc/m2/mc/mcQuiet.def
@@ -0,0 +1,39 @@
+(* mcQuiet.def provides a wrapper to mcPrintf, each call is only passed.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcQuiet ;
+
+
+(* Provides a wrapper to mcPrintf, each call is only passed
+   to its corresponding mcPrintf routine providing the --quiet
+   flag was not used.  *)
+
+FROM SYSTEM IMPORT BYTE ;
+
+
+PROCEDURE qprintf0 (a: ARRAY OF CHAR) ;
+PROCEDURE qprintf1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+PROCEDURE qprintf2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+PROCEDURE qprintf3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+PROCEDURE qprintf4 (a: ARRAY OF CHAR; w1, w2, w3, w4: ARRAY OF BYTE) ;
+
+
+END mcQuiet.
diff --git a/gcc/m2/mc/mcQuiet.mod b/gcc/m2/mc/mcQuiet.mod
new file mode 100644
index 00000000000..d18349c6040
--- /dev/null
+++ b/gcc/m2/mc/mcQuiet.mod
@@ -0,0 +1,69 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcQuiet ;
+
+FROM mcOptions IMPORT getQuiet ;
+FROM mcPrintf IMPORT printf0, printf1, printf2, printf3, printf4 ;
+
+
+PROCEDURE qprintf0 (a: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT getQuiet ()
+   THEN
+      printf0 (a)
+   END
+END qprintf0 ;
+
+
+PROCEDURE qprintf1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+BEGIN
+   IF NOT getQuiet ()
+   THEN
+      printf1 (a, w)
+   END
+END qprintf1 ;
+
+
+PROCEDURE qprintf2 (a: ARRAY OF CHAR; w1, w2: ARRAY OF BYTE) ;
+BEGIN
+   IF NOT getQuiet ()
+   THEN
+      printf2 (a, w1, w2)
+   END
+END qprintf2 ;
+
+
+PROCEDURE qprintf3 (a: ARRAY OF CHAR; w1, w2, w3: ARRAY OF BYTE) ;
+BEGIN
+   IF NOT getQuiet ()
+   THEN
+      printf3 (a, w1, w2, w3)
+   END
+END qprintf3 ;
+
+
+PROCEDURE qprintf4 (a: ARRAY OF CHAR; w1, w2, w3, w4: ARRAY OF BYTE) ;
+BEGIN
+   IF NOT getQuiet ()
+   THEN
+      printf4 (a, w1, w2, w3, w4)
+   END
+END qprintf4 ;
+
+
+END mcQuiet.
diff --git a/gcc/m2/mc/mcReserved.def b/gcc/m2/mc/mcReserved.def
new file mode 100644
index 00000000000..5de01ac7e68
--- /dev/null
+++ b/gcc/m2/mc/mcReserved.def
@@ -0,0 +1,52 @@
+(* mcReserved.def defines the toktype.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcReserved ;
+
+
+TYPE
+   toktype = (eoftok, plustok, minustok, timestok, dividetok,
+              becomestok, ambersandtok, periodtok, commatok,
+              semicolontok, lparatok, rparatok, lsbratok, rsbratok,
+              lcbratok, rcbratok, uparrowtok, singlequotetok,
+              equaltok, hashtok, lesstok, greatertok, lessgreatertok,
+              lessequaltok, greaterequaltok,
+              ldirectivetok, rdirectivetok,
+              periodperiodtok,
+              colontok, doublequotestok, bartok, andtok,
+              arraytok, begintok, bytok, casetok, consttok,
+              definitiontok, divtok, dotok, elsetok, elsiftok,
+              endtok, excepttok, exittok, exporttok, finallytok,
+              fortok, fromtok, iftok, implementationtok,
+              importtok, intok, looptok, modtok,
+              moduletok, nottok, oftok, ortok,
+              packedsettok, pointertok, proceduretok,
+              qualifiedtok, unqualifiedtok,
+              recordtok, remtok, repeattok, retrytok, returntok,
+              settok, thentok,
+              totok, typetok, untiltok, vartok, whiletok, withtok,
+              asmtok, volatiletok, periodperiodperiodtok,
+              datetok, linetok, filetok,
+              attributetok, builtintok, inlinetok,
+              integertok, identtok, realtok, stringtok,
+	      commenttok) ;
+
+END mcReserved.
diff --git a/gcc/m2/mc/mcReserved.h b/gcc/m2/mc/mcReserved.h
new file mode 100644
index 00000000000..7778490ae09
--- /dev/null
+++ b/gcc/m2/mc/mcReserved.h
@@ -0,0 +1,62 @@
+/* mcReserved.h provides a C version of the Modula-2 tokens.
+
+Copyright (C) 2015-2022 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/>.  */
+
+#ifndef mcReservedH
+#define mcReservedH
+
+
+/* additional tokens which extend PIM Modula-2 slightly */
+
+typedef enum mcReserved_toktype {
+  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 ;
+
+#endif
diff --git a/gcc/m2/mc/mcReserved.mod b/gcc/m2/mc/mcReserved.mod
new file mode 100644
index 00000000000..892533bb106
--- /dev/null
+++ b/gcc/m2/mc/mcReserved.mod
@@ -0,0 +1,21 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcReserved ;
+
+END mcReserved.
diff --git a/gcc/m2/mc/mcSearch.def b/gcc/m2/mc/mcSearch.def
new file mode 100644
index 00000000000..98e69a24bd0
--- /dev/null
+++ b/gcc/m2/mc/mcSearch.def
@@ -0,0 +1,107 @@
+(* mcSearch.def mcSearch provides a mechanism to search selected directories.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcSearch ;
+
+
+(* mcSearch provides a mechanism to search selected directories
+   in an attempt to locate and open a given source file.  *)
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   initSearchPath - initialise the compiler search, 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
+*)
+
+PROCEDURE initSearchPath (path: String) ;
+
+
+(*
+   prependSearchPath - prepends a new path to the initial search path.
+*)
+
+PROCEDURE prependSearchPath (path: String) ;
+
+
+(*
+   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.
+                    FindSourceFile sets FullPath to a new string if successful.
+*)
+
+PROCEDURE findSourceFile (FileName: String;
+                          VAR fullPath: String) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findSourceDefFile (stem: String; VAR fullPath: String) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findSourceModFile (stem: String; VAR fullPath: String) : BOOLEAN ;
+
+
+(*
+   setDefExtension - sets the default extension for definition modules to, ext.
+                     The string, ext, should be deallocated by the caller at
+                     an appropriate time.
+*)
+
+PROCEDURE setDefExtension (ext: String) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE setModExtension (ext: String) ;
+
+
+END mcSearch.
diff --git a/gcc/m2/mc/mcSearch.mod b/gcc/m2/mc/mcSearch.mod
new file mode 100644
index 00000000000..44c60d3980e
--- /dev/null
+++ b/gcc/m2/mc/mcSearch.mod
@@ -0,0 +1,295 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcSearch ;
+
+
+FROM SFIO IMPORT Exists ;
+FROM mcFileName IMPORT calculateFileName ;
+
+FROM DynamicStrings IMPORT InitString, InitStringChar,
+                           KillString, ConCat, ConCatChar, Index, Slice,
+                           Add, EqualArray, Dup, Mark,
+                           PushAllocation, PopAllocationExemption,
+                           InitStringDB, InitStringCharStarDB,
+                           InitStringCharDB, MultDB, DupDB, SliceDB ;
+
+
+CONST
+   Directory    =   '/' ;
+
+VAR
+   Def, Mod,
+   UserPath,
+   InitialPath: String ;
+
+(*
+#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__)
+*)
+
+
+(*
+   doDSdbEnter -
+*)
+
+PROCEDURE doDSdbEnter ;
+BEGIN
+   PushAllocation
+END doDSdbEnter ;
+
+
+(*
+   doDSdbExit -
+*)
+
+PROCEDURE doDSdbExit (s: String) ;
+BEGIN
+   s := PopAllocationExemption (TRUE, s)
+END doDSdbExit ;
+
+
+(*
+   DSdbEnter -
+*)
+
+PROCEDURE DSdbEnter ;
+BEGIN
+END DSdbEnter ;
+
+
+(*
+   DSdbExit -
+*)
+
+PROCEDURE DSdbExit (s: String) ;
+BEGIN
+END DSdbExit ;
+
+
+(*
+#define DSdbEnter doDSdbEnter
+#define DSdbExit  doDSdbExit
+*)
+
+
+(*
+   prependSearchPath - prepends a new path to the initial search path.
+*)
+
+PROCEDURE prependSearchPath (path: String) ;
+BEGIN
+   DSdbEnter ;
+   IF EqualArray (UserPath, '')
+   THEN
+      UserPath := KillString (UserPath) ;
+      UserPath := Dup (path)
+   ELSE
+      UserPath := ConCat (ConCatChar (UserPath, ':'), path)
+   END ;
+   DSdbExit (UserPath)
+END prependSearchPath ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findSourceFile (FileName: String;
+                          VAR fullPath: String) : BOOLEAN ;
+VAR
+   completeSearchPath: String ;
+   start, end        : INTEGER ;
+   newpath           : String ;
+BEGIN
+   IF EqualArray (UserPath, '')
+   THEN
+      IF EqualArray (InitialPath, '')
+      THEN
+         completeSearchPath := InitString ('.')
+      ELSE
+         completeSearchPath := Dup (InitialPath)
+      END
+   ELSE
+      completeSearchPath := ConCat (ConCatChar (Dup (UserPath), ':'), InitialPath)
+   END ;
+   start := 0 ;
+   end   := Index (completeSearchPath, ':', CARDINAL (start)) ;
+   REPEAT
+      IF end=-1
+      THEN
+         end := 0
+      END ;
+      newpath := Slice (completeSearchPath, start, end) ;
+      IF EqualArray (newpath, '.')
+      THEN
+         newpath := KillString (newpath) ;
+         newpath := Dup (FileName)
+      ELSE
+         newpath := ConCat (ConCatChar (newpath, Directory), FileName)
+      END ;
+      IF Exists (newpath)
+      THEN
+         fullPath := newpath ;
+         completeSearchPath := KillString (completeSearchPath) ;
+         RETURN TRUE
+      END ;
+      newpath := KillString (newpath) ;
+      IF end#0
+      THEN
+         start := end+1 ;
+         end   := Index (completeSearchPath, ':', CARDINAL (start))
+      END
+   UNTIL end=0 ;
+
+   fullPath := NIL ;
+   newpath := KillString (newpath) ;
+   completeSearchPath :=  KillString (completeSearchPath) ;
+   RETURN FALSE
+END findSourceFile ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findSourceDefFile (stem: String; VAR fullPath: String) : BOOLEAN ;
+VAR
+   f: String ;
+BEGIN
+   IF Def#NIL
+   THEN
+      f := calculateFileName (stem, Def) ;
+      IF findSourceFile (f, fullPath)
+      THEN
+         RETURN TRUE
+      END ;
+      f := KillString (f)
+   END ;
+   (* and try the GNU Modula-2 default extension *)
+   f := calculateFileName (stem, Mark (InitString ('def'))) ;
+   RETURN findSourceFile (f, fullPath)
+END findSourceDefFile ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findSourceModFile (stem: String; VAR fullPath: String) : BOOLEAN ;
+VAR
+   f: String ;
+BEGIN
+   IF Mod#NIL
+   THEN
+      f := calculateFileName (stem, Mod) ;
+      IF findSourceFile (f, fullPath)
+      THEN
+         RETURN TRUE
+      END ;
+      f := KillString (f)
+   END ;
+   (* and try the GNU Modula-2 default extension *)
+   f := calculateFileName (stem, Mark (InitString ('mod'))) ;
+   RETURN findSourceFile (f, fullPath)
+END findSourceModFile ;
+
+
+(*
+   setDefExtension - sets the default extension for definition modules to, ext.
+                     The string, ext, should be deallocated by the caller at
+                     an appropriate time.
+*)
+
+PROCEDURE setDefExtension (ext: String) ;
+BEGIN
+   Def := KillString (Def) ;
+   Def := Dup (ext)
+END setDefExtension ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE setModExtension (ext: String) ;
+BEGIN
+   Mod := KillString (Mod) ;
+   Mod := Dup (ext)
+END setModExtension ;
+
+
+(*
+   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
+*)
+
+PROCEDURE initSearchPath (path: String) ;
+BEGIN
+   IF InitialPath#NIL
+   THEN
+      InitialPath := KillString (InitialPath)
+   END ;
+   InitialPath := path
+END initSearchPath ;
+
+
+(*
+   Init - initializes the search path.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   UserPath    := InitString ('') ;
+   InitialPath := InitStringChar ('.') ;
+   Def := NIL ;
+   Mod := NIL
+END Init ;
+
+
+BEGIN
+   Init
+END mcSearch.
diff --git a/gcc/m2/mc/mcStack.def b/gcc/m2/mc/mcStack.def
new file mode 100644
index 00000000000..ae3109a661d
--- /dev/null
+++ b/gcc/m2/mc/mcStack.def
@@ -0,0 +1,84 @@
+(* mcStack.def provides a stack data type and associated procedures.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcStack ;
+
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   stack ;
+
+
+(*
+   init - create and return a stack.
+*)
+
+PROCEDURE init () : stack ;
+
+
+(*
+   kill - deletes stack, s.
+*)
+
+PROCEDURE kill (VAR s: stack) ;
+
+
+(*
+   push - an address, a, onto the stack, s.
+          It returns, a.
+*)
+
+PROCEDURE push (s: stack; a: ADDRESS) : ADDRESS ;
+
+
+(*
+   pop - and return the top element from stack, s.
+*)
+
+PROCEDURE pop (s: stack) : ADDRESS ;
+
+
+(*
+   replace - performs a pop; push (a); return a.
+*)
+
+PROCEDURE replace (s: stack; a: ADDRESS) : ADDRESS ;
+
+
+(*
+   depth - returns the depth of the stack.
+*)
+
+PROCEDURE depth (s: stack) : CARDINAL ;
+
+
+(*
+   access - returns the, i, th stack element.
+            The top of stack is defined by:
+
+            access (s, depth (s)).
+*)
+
+PROCEDURE access (s: stack; i: CARDINAL) : ADDRESS ;
+
+
+END mcStack.
diff --git a/gcc/m2/mc/mcStack.mod b/gcc/m2/mc/mcStack.mod
new file mode 100644
index 00000000000..c2eba3d1829
--- /dev/null
+++ b/gcc/m2/mc/mcStack.mod
@@ -0,0 +1,145 @@
+(* Copyright (C) 2015-2022 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.  *)
+
+IMPLEMENTATION MODULE mcStack ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+FROM Indexing IMPORT Index, InitIndex, LowIndice, HighIndice, GetIndice, PutIndice,
+                     DeleteIndice, KillIndex ;
+
+
+TYPE
+   stack = POINTER TO RECORD
+                         list : Index ;
+			 count: CARDINAL ;
+                      END ;
+
+(*
+   init - create and return a stack.
+*)
+
+PROCEDURE init () : stack ;
+VAR
+   s: stack ;
+BEGIN
+   NEW (s) ;
+   WITH s^ DO
+      list := InitIndex (1) ;
+      count := 0
+   END ;
+   RETURN s
+END init ;
+
+
+(*
+   kill - deletes stack, s.
+*)
+
+PROCEDURE kill (VAR s: stack) ;
+BEGIN
+   s^.list := KillIndex (s^.list) ;
+   DISPOSE (s) ;
+   s := NIL
+END kill ;
+
+
+(*
+   push - an address, a, onto the stack, s.
+          It returns, a.
+*)
+
+PROCEDURE push (s: stack; a: ADDRESS) : ADDRESS ;
+BEGIN
+   WITH s^ DO
+      IF count=0
+      THEN
+         PutIndice (list, LowIndice (list), a)
+      ELSE
+         PutIndice (list, HighIndice (list)+1, a)
+      END ;
+      INC (count)
+   END ;
+   RETURN a
+END push ;
+
+
+(*
+   pop - and return the top element from stack, s.
+*)
+
+PROCEDURE pop (s: stack) : ADDRESS ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   WITH s^ DO
+      IF count = 0
+      THEN
+         HALT
+      ELSE
+         DEC (count) ;
+         a := GetIndice (list, HighIndice (list)) ;
+	 DeleteIndice (list, HighIndice (list)) ;
+         RETURN a
+      END
+   END
+END pop ;
+
+
+(*
+   replace - performs a pop; push (a); return a.
+*)
+
+PROCEDURE replace (s: stack; a: ADDRESS) : ADDRESS ;
+VAR
+   b: ADDRESS ;
+BEGIN
+   b := pop (s) ;
+   RETURN push (s, a)
+END replace ;
+
+
+(*
+   depth - returns the depth of the stack.
+*)
+
+PROCEDURE depth (s: stack) : CARDINAL ;
+BEGIN
+   RETURN s^.count
+END depth ;
+
+
+(*
+   access - returns the, i, th stack element.
+            The top of stack is defined by:
+
+            access (s, depth (s)).
+*)
+
+PROCEDURE access (s: stack; i: CARDINAL) : ADDRESS ;
+BEGIN
+   IF (i>s^.count) OR (i=0)
+   THEN
+      HALT
+   ELSE
+      RETURN GetIndice (s^.list, i)
+   END
+END access ;
+
+
+END mcStack.
diff --git a/gcc/m2/mc/mcStream.def b/gcc/m2/mc/mcStream.def
new file mode 100644
index 00000000000..701206238cc
--- /dev/null
+++ b/gcc/m2/mc/mcStream.def
@@ -0,0 +1,59 @@
+(* mcStream.def provides an interface to create a file from fragments.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcStream ;
+
+
+FROM FIO IMPORT File ;
+
+(*
+   openFrag - create and open fragment, id, and return the file.
+              The file should not be closed by the user.
+*)
+
+PROCEDURE openFrag (id: CARDINAL) : File ;
+
+
+(*
+   setDest - informs the stream module and all fragments must be copied
+             info, f.
+*)
+
+PROCEDURE setDest (f: File) ;
+
+
+(*
+   combine - closes all fragments and then writes them in
+             order to the destination file.  The dest file
+             is returned.
+*)
+
+PROCEDURE combine () : File ;
+
+
+(*
+   removeFiles - remove any fragment.
+*)
+
+PROCEDURE removeFiles ;
+
+
+END mcStream.
diff --git a/gcc/m2/mc/mcStream.mod b/gcc/m2/mc/mcStream.mod
new file mode 100644
index 00000000000..d752d642ce6
--- /dev/null
+++ b/gcc/m2/mc/mcStream.mod
@@ -0,0 +1,180 @@
+(* mcStream.mod provides an interface to create a file from fragments.
+
+Copyright (C) 2015-2022 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 mcStream ;
+
+
+FROM FIO IMPORT File, OpenToWrite, OpenToRead, EOF, ReadNBytes, WriteNBytes, Close, getFileName ;
+FROM libc IMPORT unlink, printf, getpid ;
+FROM Indexing IMPORT InitIndex, InBounds, HighIndice, LowIndice, PutIndice, GetIndice, Index, ForeachIndiceInIndexDo ;
+FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, string ;
+FROM FormatStrings IMPORT Sprintf2 ;
+FROM SYSTEM IMPORT ADR ;
+FROM Storage IMPORT ALLOCATE ;
+
+IMPORT alists ;
+IMPORT SFIO ;
+
+
+TYPE
+   ptrToFile = POINTER TO File ;
+
+VAR
+   listOfFiles: alists.alist ;
+   frag       : Index ;
+   destFile   : File ;
+   seenDest   : BOOLEAN ;
+
+
+(*
+   removeLater -
+*)
+
+PROCEDURE removeLater (filename: String) : String ;
+BEGIN
+   alists.includeItemIntoList (listOfFiles, filename) ;
+   RETURN filename
+END removeLater ;
+
+
+(*
+   removeNow - removes a single file, s.
+*)
+
+PROCEDURE removeNow (s: String) ;
+BEGIN
+   IF unlink (string (s)) # 0
+   THEN
+   END
+END removeNow ;
+
+
+(*
+   removeFiles - remove any fragment.
+*)
+
+PROCEDURE removeFiles ;
+BEGIN
+   alists.foreachItemInListDo (listOfFiles, removeNow) ;
+   alists.killList (listOfFiles) ;
+   listOfFiles := alists.initList ()
+END removeFiles ;
+
+
+(*
+   createTemporaryFile -
+*)
+
+PROCEDURE createTemporaryFile (id: CARDINAL) : File ;
+VAR
+   s: String ;
+   f: File ;
+   p: INTEGER ;
+BEGIN
+   s := InitString ('/tmp/frag-%d-%d.frag') ;
+   p := getpid () ;
+   s := removeLater (Sprintf2 (s, p, id)) ;
+   f := SFIO.OpenToWrite (s) ;
+   RETURN f
+END createTemporaryFile ;
+
+
+(*
+   openFrag - create and open fragment, id, and return the file.
+              The file should not be closed by the user.
+*)
+
+PROCEDURE openFrag (id: CARDINAL) : File ;
+VAR
+   f: File ;
+   p: ptrToFile ;
+BEGIN
+   f := createTemporaryFile (id) ;
+   NEW (p) ;
+   p^ := f ;
+   PutIndice (frag, id, p) ;
+   RETURN f
+END openFrag ;
+
+
+(*
+   copy - copies contents of f to the destination file.
+*)
+
+PROCEDURE copy (p: ptrToFile) ;
+CONST
+   maxBuffer = 4096 ;
+VAR
+   buffer: ARRAY [0..maxBuffer] OF CHAR ;
+   b     : CARDINAL ;
+   s     : String ;
+   f     : File ;
+BEGIN
+   IF p # NIL
+   THEN
+      f := p^ ;
+      s := InitStringCharStar(getFileName (f)) ;
+      Close (f) ;
+      f := SFIO.OpenToRead (s) ;
+      WHILE NOT EOF (f) DO
+         b := ReadNBytes (f, HIGH (buffer), ADR (buffer)) ;
+         b := WriteNBytes (destFile, b, ADR (buffer))
+      END ;
+      Close (f)
+   END
+END copy ;
+
+
+(*
+   setDest - informs the stream module and all fragments must be copied
+             info, f.
+*)
+
+PROCEDURE setDest (f: File) ;
+BEGIN
+   seenDest := TRUE ;
+   destFile := f
+END setDest ;
+
+
+(*
+   combine - closes all fragments and then writes them in
+             order to the destination file.  The dest file
+             is returned.
+*)
+
+PROCEDURE combine () : File ;
+BEGIN
+   IF NOT seenDest
+   THEN
+      HALT
+   END ;
+   ForeachIndiceInIndexDo (frag, copy) ;
+   removeFiles ;
+   RETURN destFile
+END combine ;
+
+
+BEGIN
+   listOfFiles := alists.initList () ;
+   seenDest := FALSE ;
+   frag := InitIndex (1)
+END mcStream.
diff --git a/gcc/m2/mc/mcflex.def b/gcc/m2/mc/mcflex.def
new file mode 100644
index 00000000000..708886dcd57
--- /dev/null
+++ b/gcc/m2/mc/mcflex.def
@@ -0,0 +1,78 @@
+(* mcflex.def provides a Modula-2 definition module for the C lexical.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcflex ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   closeSource - provided for semantic sugar
+*)
+
+PROCEDURE closeSource ;
+
+
+(*
+   OpenSource - returns TRUE if file, s, can be opened and
+                all tokens are taken from this file.
+*)
+
+PROCEDURE openSource (s: ADDRESS) : BOOLEAN ;
+
+
+(*
+   getToken - returns the ADDRESS of the next token.
+*)
+
+PROCEDURE getToken () : ADDRESS ;
+
+
+(*
+   getLineNo - returns the current line number.
+*)
+
+PROCEDURE getLineNo () : CARDINAL ;
+
+
+(*
+   getColumnNo - returns the column where the current token starts.
+*)
+
+PROCEDURE getColumnNo () : CARDINAL ;
+
+
+(*
+   mcError - displays the error message, s, after the code line and pointer
+             to the erroneous token.
+*)
+
+PROCEDURE mcError (s: ADDRESS) ;
+
+
+(*
+   getTotalLines - returns the total number of lines parsed.
+*)
+
+PROCEDURE getTotalLines () : CARDINAL ;
+
+
+END mcflex.
diff --git a/gcc/m2/mc/mcp1.bnf b/gcc/m2/mc/mcp1.bnf
new file mode 100644
index 00000000000..e41102e67e0
--- /dev/null
+++ b/gcc/m2/mc/mcp1.bnf
@@ -0,0 +1,1101 @@
+--
+-- mc-1.bnf grammar and associated actions for mcp1.
+--
+-- Copyright (C) 2015-2022 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/>.
+% module mcp1 begin
+(* output from mc-1.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+IMPLEMENTATION MODULE mcp1 ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark,
+                           ConCat, ConCatChar ;
+
+FROM mcError IMPORT errorStringAt ;
+FROM nameKey IMPORT NulName, Name, makekey ;
+FROM mcPrintf IMPORT printf0, printf1 ;
+FROM mcDebug IMPORT assert ;
+FROM mcReserved IMPORT toktype ;
+FROM mcComment IMPORT setProcedureComment ;
+
+FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken,
+                     insertTokenAndRewind, getTokenNo, lastcomment ;
+
+FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName,
+                 lookupSym, putDefForC,
+                 makeProcedure, makeType, makeTypeImp, makeVar, makeConst,
+		 enterScope, leaveScope, putTypeHidden,
+		 addImportedModule, getCurrentModule,
+		 putCommentDefProcedure, putCommentModProcedure ;
+
+
+CONST
+   Pass1     = TRUE ;
+   Debugging = FALSE ;
+
+VAR
+   WasNoError: BOOLEAN ;
+   curident  : Name ;
+   curproc,
+   curmodule : node ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   errorStringAt (s, getTokenNo ()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString (InitString (a))
+END ErrorArray ;
+
+
+(*
+   checkEndName - if module does not have, name, then issue an error containing, desc.
+*)
+
+PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF getSymName (module)#name
+   THEN
+      s := InitString ('inconsistent module name found with this ') ;
+      s := ConCat (s, Mark (InitString (desc))) ;
+      ErrorString (s)
+   END
+END checkEndName ;
+
+% declaration mcp1 begin
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (*
+      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 NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      getToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError (stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop (s0, s1, s2) ;
+
+   str := ConCat (InitString ('syntax error,'), Mark (str)) ;
+   errorStringAt (str, getTokenNo ())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken (t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0 ('inserting token\n')
+      END ;
+      insertToken (t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken (t) ;
+      insertTokenAndRewind (t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      getToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   RETURN( WasNoError )
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   curident := makekey(currentstring) ;
+(*
+   PushTF(makekey(currentstring), identtok)
+*)
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+(*
+   PushTF(makekey(currentstring), stringtok) ;
+   BuildString
+*)
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+(*
+   PushTF(makekey(currentstring), integertok) ;
+   BuildNumber
+*)
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+(*
+   PushTF(makekey(currentstring), realtok) ;
+   BuildNumber
+*)
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+
+(*
+   registerImport - looks up module, ident, and adds it to the
+                    current module import list.
+*)
+
+PROCEDURE registerImport (ident: Name; scoped: BOOLEAN) ;
+VAR
+   n: node ;
+BEGIN
+   n := lookupDef (ident) ;
+   addImportedModule (getCurrentModule (), n, scoped)
+END registerImport ;
+
+
+% module mcp1 end
+END mcp1.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuild procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit := DefinitionModule | ImplementationOrProgramModule
+          =:
+
+ProgramModule := "MODULE"
+                  Ident                                                % curmodule := lookupModule (curident) %
+		                                                       % enterScope (curmodule) %
+                  [ Priority
+                  ]
+                  ";"
+                  { Import }
+                  Block
+                  Ident                                                % checkEndName (curmodule, curident, 'program module') %
+		                                                       % leaveScope %
+
+                  "."
+                  =:
+
+ImplementationModule := "IMPLEMENTATION" "MODULE"
+                         Ident                                         % curmodule := lookupImp (curident) %
+			                                               % enterScope (lookupDef (curident)) %
+                                                                       % enterScope (curmodule) %
+                         [ Priority
+                         ] ";"
+                         { Import }
+                         Block
+                         Ident                                         % checkEndName (curmodule, curident, 'implementation module') %
+                                                                       % leaveScope ; leaveScope %
+                         "."
+                      =:
+
+ImplementationOrProgramModule := ImplementationModule | ProgramModule
+                               =:
+
+Number := Integer | Real =:
+
+--
+--  Qualident needs some care as we must only parse module.module.ident
+--  and not ident.recordfield.  We leave the ident.recordfield to be parsed by
+--  SubDesignator.  Note that Qualident is called by SubDesignator so if
+--  IsAutoPushOff then we just consume tokens.
+--
+
+Qualident :=
+             Ident { "." Ident }
+           =:
+
+ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ]
+                 =:
+
+Relation := "="
+            | "#"
+            | "<>"
+            | "<"
+            | "<="
+            | ">"
+            | ">="
+            | "IN"
+         =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm
+                                    } =:
+
+UnaryOrConstTerm := "+"
+                    ConstTerm
+                    |
+                    "-"
+                    ConstTerm
+                    |
+                    ConstTerm =:
+
+AddOperator :=   "+"
+               | "-"
+               | "OR"
+            =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor
+                         } =:
+
+MulOperator := "*"
+               | "/"
+               | "DIV"
+               | "MOD"
+               | "REM"
+               | "AND"
+               | "&"
+            =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" | "NOT" ConstFactor
+               | ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string =:
+
+ComponentElement := ConstExpression [ ".." ConstExpression ]
+                  =:
+
+ComponentValue := ComponentElement [ 'BY' ConstExpression ]
+                =:
+
+ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+                     =:
+
+Constructor := '{'
+                  [ ArraySetRecordValue ]
+               '}' =:
+
+ConstSetOrQualidentOrFunction := Qualident
+                                 [ Constructor | ConstActualParameters
+                                                                       ]
+                                   |
+                                     Constructor =:
+
+ConstActualParameters :=
+                         ActualParameters
+                       =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("
+                  ConstAttributeExpression
+                  ")" ")" =:
+
+ConstAttributeExpression :=
+                            Ident
+                                  | "<" Qualident ',' Ident
+                                                              ">"
+                          =:
+
+ByteAlignment := '<*' AttributeExpression '*>'
+               =:
+
+OptAlignmentExpression := [ AlignmentExpression ] =:
+
+AlignmentExpression := "(" ConstExpression ")" =:
+
+Alignment := [ ByteAlignment ] =:
+
+TypeDeclaration := Ident                                             % VAR n: node ; %
+                                                                     % n := makeTypeImp (curident) %
+                         "=" Type Alignment
+                 =:
+
+Type := ( SimpleType | ArrayType
+          | RecordType
+          | SetType
+          | PointerType
+          | ProcedureType )
+      =:
+
+SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+
+Enumeration := "(" ( IdentList )
+               ")"
+             =:
+
+IdentList := Ident { "," Ident }
+           =:
+
+SubrangeType := "[" ConstExpression  ".." ConstExpression "]"
+              =:
+
+ArrayType := "ARRAY"
+              SimpleType
+              { ","
+                SimpleType
+              } "OF"
+             Type
+           =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
+
+DefaultRecordAttributes := '<*'
+                                AttributeExpression
+
+                                                    '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                            { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression := Ident PragmaConstExpression =:
+
+PragmaConstExpression := [ '(' ConstExpression ')' ] =:
+
+AttributeExpression := Ident '(' ConstExpression ')' =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+-- at present FieldListStatement is as follows:
+FieldListStatement := [ FieldList ] =:
+-- later replace it with FieldList to comply with PIM2
+
+-- sadly the PIM rules are not LL1 as Ident and Qualident have the same first
+-- symbols. We rewrite FieldList to inline qualident
+-- was
+-- FieldList := IdentList ":"
+--                           Type |
+--             "CASE" [ Ident ":" ] Qualident "OF" Varient { "|" Varient }
+--                    [ "ELSE" FieldListSequence ] "END" =:
+
+FieldList := IdentList ":"
+                           Type RecordFieldPragma
+             |
+             "CASE"
+                    CaseTag "OF"
+                                 Varient { "|" Varient }
+              [ "ELSE"
+                FieldListSequence
+              ] "END"
+           =:
+
+TagIdent := [ Ident ] =:
+
+CaseTag :=  TagIdent [":" Qualident ] =:
+
+Varient := [
+             VarientCaseLabelList ":" FieldListSequence
+                                                        ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression [ ".." ConstExpression ]
+                   =:
+
+--
+--  the following rules are a copy of the ConstExpression ebnf rules but without
+--  any actions all prefixed with Silent.
+--  At present they are only used by CaseLabels, if this continues to be true we
+--  might consider restricting the SilentConstExpression.  Eg it makes no sence to allow
+--  String in these circumstances!
+--
+
+SilentConstExpression :=
+                         SilentSimpleConstExpr
+                         [ SilentRelation SilentSimpleConstExpr ]
+                      =:
+
+SilentRelation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
+
+SilentSimpleConstExpr := SilentUnaryOrConstTerm { SilentAddOperator SilentConstTerm } =:
+
+SilentUnaryOrConstTerm := "+" SilentConstTerm | "-" SilentConstTerm | SilentConstTerm =:
+
+SilentAddOperator := "+" | "-" | "OR" =:
+
+SilentConstTerm := SilentConstFactor { SilentMulOperator SilentConstFactor } =:
+
+SilentMulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
+
+SilentConstFactor := Number | SilentConstString | SilentConstSetOrQualidentOrFunction |
+                     "(" SilentConstExpression ")" | "NOT" SilentConstFactor
+                     | SilentConstAttribute =:
+
+SilentConstString := string =:
+
+SilentConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" SilentConstAttributeExpression ")" ")" =:
+
+SilentConstAttributeExpression := Ident | "<" Ident ',' SilentConstString ">" =:
+
+SilentComponentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
+
+SilentComponentValue := SilentComponentElement [ 'BY' SilentConstExpression ] =:
+
+SilentArraySetRecordValue := SilentComponentValue { ',' SilentComponentValue } =:
+
+SilentConstructor := '{'
+                         [ SilentArraySetRecordValue ] '}' =:
+
+SilentConstSetOrQualidentOrFunction := SilentConstructor | Qualident
+                                       [ SilentConstructor | SilentActualParameters ] =:
+
+SilentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
+
+SilentActualParameters := "(" [ SilentExpList ] ")" =:
+
+SilentExpList := SilentConstExpression { "," SilentConstExpression } =:
+
+-- end of the Silent constant rules
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+
+PointerType := "POINTER" "TO" Type
+             =:
+
+ProcedureType := "PROCEDURE" [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+VarIdent := Ident		                                     % VAR n: node ; %
+                                                                     % n := makeVar (curident) %
+                  [ "[" ConstExpression "]" ]
+             =:
+
+VarIdentList := VarIdent { "," VarIdent } =:
+
+VariableDeclaration := VarIdentList ":" Type Alignment =:
+
+Designator := Qualident
+              { SubDesignator } =:
+
+SubDesignator := "."
+                 Ident
+                 | "[" ArrayExpList
+                   "]"
+                 | "^"
+               =:
+
+ArrayExpList :=
+                Expression
+                { ","
+                   Expression
+                }
+              =:
+
+ExpList := Expression { "," Expression }
+         =:
+
+Expression := SimpleExpression [ Relation SimpleExpression ]
+           =:
+
+SimpleExpression := UnaryOrTerm { AddOperator Term } =:
+
+UnaryOrTerm := "+" Term
+               | "-" Term
+               | Term
+	     =:
+
+Term := Factor { MulOperator Factor
+               } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" ( Factor
+          | ConstAttribute
+                                ) =:
+
+SetOrDesignatorOrFunction := Qualident
+                              [ Constructor |
+                                SimpleDes [ ActualParameters ]
+                              ]                                |
+                              Constructor =:
+
+-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+SimpleDes := { SubDesignator } =:
+
+ActualParameters := "(" [ ExpList ] ")" =:
+
+ExitStatement := "EXIT"
+               =:
+
+ReturnStatement := "RETURN" [ Expression ]
+                 =:
+
+Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               ExitStatement | ReturnStatement | RetryStatement
+             ]
+          =:
+
+RetryStatement := "RETRY"
+                =:
+
+AssignmentOrProcedureCall := Designator
+                             ( ":=" Expression |
+                                    ActualParameters |                     % (* epsilon *) %
+                             )
+			   =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence := Statement { ";" Statement }
+                  =:
+
+IfStatement := "IF"
+                    Expression "THEN"
+                StatementSequence
+              { "ELSIF"
+
+                        Expression "THEN"
+                                          StatementSequence
+              }
+              [ "ELSE"
+                      StatementSequence ] "END"
+            =:
+
+CaseStatement := "CASE"
+                        Expression
+                                   "OF" Case { "|" Case }
+                 CaseEndStatement
+               =:
+
+CaseEndStatement := "END"
+                    | "ELSE"
+                           StatementSequence "END"
+                 =:
+
+Case := [ CaseLabelList ":" StatementSequence ]
+      =:
+
+CaseLabelList := CaseLabels { "," CaseLabels } =:
+
+CaseLabels := ConstExpression [ ".." ConstExpression ]
+            =:
+
+WhileStatement := "WHILE" Expression "DO"
+                      StatementSequence
+		  "END"
+                =:
+
+RepeatStatement := "REPEAT"
+                       StatementSequence
+	           "UNTIL" Expression
+                 =:
+
+ForStatement :=
+                "FOR" Ident ":=" Expression "TO" Expression [ "BY" ConstExpression ] "DO"
+                    StatementSequence
+                "END"
+              =:
+
+LoopStatement := "LOOP"
+                      StatementSequence
+                 "END"
+               =:
+
+WithStatement := "WITH" Designator "DO"
+                     StatementSequence
+                 "END"
+               =:
+
+ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock
+                        Ident
+                      =:
+
+DefProcedureIdent := Ident                                                % curproc := makeProcedure (curident) ;
+                                                                            setProcedureComment (lastcomment, curident) ;
+                                                                            putCommentDefProcedure (curproc) ;
+                                                                          %
+                   =:
+
+ProcedureIdent := Ident                                                   % curproc := lookupSym (curident) ;
+                                                                            IF curproc=NIL
+                                                                            THEN
+                                                                               curproc := makeProcedure (curident)
+                                                                            END ;
+                                                                            setProcedureComment (lastcomment, curident) ;
+                                                                            putCommentModProcedure (curproc) ;
+									  %
+                =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ]
+                      =:
+
+ProcedureHeading := "PROCEDURE"
+                    DefineBuiltinProcedure ( ProcedureIdent               % enterScope (curproc) %
+                                             [ FormalParameters ] AttributeNoReturn )
+                  =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE" Builtin ( DefProcedureIdent [ DefFormalParameters ] AttributeNoReturn )
+                     =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END"    % leaveScope %
+                =:
+
+Block := { Declaration } InitialBlock FinalBlock "END"
+       =:
+
+InitialBlock := [ "BEGIN" InitialBlockBody ] =:
+
+FinalBlock := [ "FINALLY" FinalBlockBody ] =:
+
+InitialBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+FinalBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+ProcedureBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence
+                 =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration ";" } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+AttributeUnused := [ "<*" Ident "*>" ] =:
+
+MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
+
+NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
+
+OptArg := "[" Ident ":" FormalType [ "=" ConstExpression ] "]" =:
+
+DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
+
+FormalType := { "ARRAY" "OF" } Qualident =:
+
+ModuleDeclaration := "MODULE" Ident [ Priority ] ";"
+                        { Import } [ Export ]
+                      Block Ident
+                     =:
+
+Priority := "[" ConstExpression "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"
+                                 IdentList |
+                     "UNQUALIFIED"
+                                 IdentList |
+                     IdentList ) ";" =:
+
+FromImport := "FROM" Ident					       % registerImport (curident, FALSE) %
+                           "IMPORT" IdentList ";"
+            =:
+
+ImportModuleList := Ident                                              % registerImport (curident, TRUE) %
+                          { "," Ident                                  % registerImport (curident, TRUE) %
+			              }
+                  =:
+
+WithoutFromImport := "IMPORT" ImportModuleList ";"
+                   =:
+
+Import := FromImport | WithoutFromImport =:
+
+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 %
+                  =:
+
+
+DefTypeDeclaration := { Ident                                          % VAR n: node ; %
+		                                                       % n := makeType (curident) %
+                        ( ";"                                          % putTypeHidden (n) %
+			      | "=" Type Alignment ";" ) }
+		    =:
+
+ConstantDeclaration := Ident                                           % VAR n: node ; %
+	                                                               % n := makeConst (curident) %
+                             "=" ConstExpression
+                     =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE" { DefTypeDeclaration } |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+AsmOperands := string [ AsmOperandSpec ]
+             =:
+
+AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+                =:
+
+AsmList := [ AsmElement ] { ',' AsmElement } =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ]
+                =:
+
+AsmElement := AsmOperandName string '(' Expression ')'
+            =:
+
+TrashList := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/mc/mcp1.def b/gcc/m2/mc/mcp1.def
new file mode 100644
index 00000000000..d09669bed23
--- /dev/null
+++ b/gcc/m2/mc/mcp1.def
@@ -0,0 +1,33 @@
+(* mcp1.def provides an interface to the pass 1 parser.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcp1 ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END mcp1.
diff --git a/gcc/m2/mc/mcp2.bnf b/gcc/m2/mc/mcp2.bnf
new file mode 100644
index 00000000000..fa4c918ac0f
--- /dev/null
+++ b/gcc/m2/mc/mcp2.bnf
@@ -0,0 +1,1136 @@
+--
+-- mc-2.bnf grammar and associated actions for mcp2.
+--
+-- Copyright (C) 2015-2022 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/>.
+% module mcp2 begin
+(* output from mc-2.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+IMPLEMENTATION MODULE mcp2 ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark,
+                           ConCat, ConCatChar ;
+
+FROM mcError IMPORT errorStringAt ;
+FROM nameKey IMPORT NulName, Name, makekey ;
+FROM mcPrintf IMPORT printf0, printf1 ;
+FROM mcDebug IMPORT assert ;
+FROM mcReserved IMPORT toktype ;
+
+FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken,
+                     insertTokenAndRewind, getTokenNo ;
+
+FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName,
+                 makeType, makeVar, makeConst,
+		 enterScope, leaveScope,
+		 addImportedModule, getCurrentModule,
+		 makeEnum, makeEnumField, putType, lookupSym, isDef,
+		 lookupInScope, setEnumsComplete ;
+
+
+CONST
+   Pass1     = FALSE ;
+   Debugging = FALSE ;
+
+VAR
+   WasNoError: BOOLEAN ;
+   curident  : Name ;
+   typeDes,
+   typeExp,
+   curproc,
+   curmodule : node ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   errorStringAt (s, getTokenNo ()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString (InitString (a))
+END ErrorArray ;
+
+
+(*
+   checkEndName - if module does not have, name, then issue an error containing, desc.
+*)
+
+PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF getSymName (module)#name
+   THEN
+      s := InitString ('inconsistent module name found with this ') ;
+      s := ConCat (s, Mark (InitString (desc))) ;
+      ErrorString (s)
+   END
+END checkEndName ;
+
+% declaration mcp2 begin
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (*
+      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 NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      getToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError (stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop (s0, s1, s2) ;
+
+   str := ConCat (InitString ('syntax error,'), Mark (str)) ;
+   errorStringAt (str, getTokenNo ())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken (t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0 ('inserting token\n')
+      END ;
+      insertToken (t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken (t) ;
+      insertTokenAndRewind (t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      getToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   RETURN( WasNoError )
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   curident := makekey (currentstring) ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+(*
+   PushTF(makekey(currentstring), stringtok) ;
+   BuildString
+*)
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+(*
+   PushTF(makekey(currentstring), integertok) ;
+   BuildNumber
+*)
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+(*
+   PushTF(makekey(currentstring), realtok) ;
+   BuildNumber
+*)
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+
+(*
+   registerImport - looks up module, ident, and adds it to the
+                    current module import list.
+*)
+
+PROCEDURE registerImport (ident: Name; scoped: BOOLEAN) ;
+VAR
+   n: node ;
+BEGIN
+   n := lookupDef (ident) ;
+   addImportedModule (getCurrentModule (), n, scoped)
+END registerImport ;
+
+
+% module mcp2 end
+END mcp2.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuild procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit := DefinitionModule | ImplementationOrProgramModule
+          =:
+
+ProgramModule := "MODULE"
+                  Ident                                                % curmodule := lookupModule (curident) %
+		                                                       % enterScope (curmodule) %
+                  [ Priority
+                  ]
+                  ";"
+                  { Import }
+                  Block
+                  Ident                                                % checkEndName (curmodule, curident, 'program module') %
+		                                                       % leaveScope %
+		                                                       % setEnumsComplete (curmodule) %
+                  "."
+                  =:
+
+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) %
+                         "."
+                      =:
+
+ImplementationOrProgramModule := ImplementationModule | ProgramModule
+                               =:
+
+Number := Integer | Real =:
+
+--
+--  Qualident needs some care as we must only parse module.module.ident
+--  and not ident.recordfield.  We leave the ident.recordfield to be parsed by
+--  SubDesignator.  Note that Qualident is called by SubDesignator so if
+--  IsAutoPushOff then we just consume tokens.
+--
+
+Qualident :=
+             Ident { "." Ident }
+           =:
+
+ConstantDeclaration := Ident "=" ConstExpression
+                     =:
+
+ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ] =:
+
+Relation := "="
+            | "#"
+            | "<>"
+            | "<"
+            | "<="
+            | ">"
+            | ">="
+            | "IN"
+         =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
+
+UnaryOrConstTerm := "+"
+                    ConstTerm
+                    |
+                    "-"
+                    ConstTerm
+                    |
+                    ConstTerm =:
+
+AddOperator :=   "+"
+               | "-"
+               | "OR"
+            =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor
+                         } =:
+
+MulOperator := "*"
+               | "/"
+               | "DIV"
+               | "MOD"
+               | "REM"
+               | "AND"
+               | "&"
+            =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" | "NOT" ConstFactor
+               | ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string =:
+
+ComponentElement := ConstExpression [ ".." ConstExpression ]
+                  =:
+
+ComponentValue := ComponentElement [ 'BY' ConstExpression ]
+                =:
+
+ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+                     =:
+
+Constructor := '{'
+                  [ ArraySetRecordValue ]
+               '}' =:
+
+ConstSetOrQualidentOrFunction := Qualident
+                                 [ Constructor | ConstActualParameters
+                                                                       ]
+                                   |
+                                     Constructor =:
+
+ConstActualParameters :=
+                         ActualParameters
+                       =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("
+                  ConstAttributeExpression
+                  ")" ")" =:
+
+ConstAttributeExpression :=
+                            Ident
+                                  | "<" Qualident ',' Ident
+                                                              ">"
+                          =:
+
+ByteAlignment := '<*' AttributeExpression '*>'
+               =:
+
+OptAlignmentExpression := [ AlignmentExpression ] =:
+
+AlignmentExpression := "(" ConstExpression ")" =:
+
+Alignment := [ ByteAlignment ] =:
+
+TypeDeclaration := Ident                                                % typeDes := lookupSym (curident) %
+                         "=" Type Alignment
+                 =:
+
+Type := ( DefSimpleType | ArrayType
+          | RecordType
+          | SetType
+          | PointerType
+          | ProcedureType )
+      =:
+
+SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+
+EnumIdentList :=                                                        % VAR n, f: node ; %
+                                                                        % n := makeEnum () %
+                    Ident                                               % f := makeEnumField (n, curident) %
+		          { "," Ident                                   % f := makeEnumField (n, curident) %
+			              }
+                  =:
+
+Enumeration := "(" ( EnumIdentList )
+               ")"
+             =:
+
+IdentList := Ident { "," Ident }
+           =:
+
+SubrangeType := "[" ConstExpression  ".." ConstExpression "]"
+              =:
+
+ArrayType := "ARRAY"
+              SimpleType
+              { ","
+                SimpleType
+              } "OF"
+             Type
+           =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
+
+DefaultRecordAttributes := '<*'
+                                AttributeExpression
+
+                                                    '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                            { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression := Ident PragmaConstExpression =:
+
+PragmaConstExpression := [ '(' ConstExpression ')' ] =:
+
+AttributeExpression := Ident '(' ConstExpression ')' =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+-- at present FieldListStatement is as follows:
+FieldListStatement := [ FieldList ] =:
+-- later replace it with FieldList to comply with PIM2
+
+-- sadly the PIM rules are not LL1 as Ident and Qualident have the same first
+-- symbols. We rewrite FieldList to inline qualident
+-- was
+-- FieldList := IdentList ":"
+--                           Type |
+--             "CASE" [ Ident ":" ] Qualident "OF" Varient { "|" Varient }
+--                    [ "ELSE" FieldListSequence ] "END" =:
+
+FieldList := IdentList ":"
+                           Type RecordFieldPragma
+             |
+             "CASE"
+                    CaseTag "OF"
+                                 Varient { "|" Varient }
+              [ "ELSE"
+                FieldListSequence
+              ] "END"
+           =:
+
+TagIdent := [ Ident ] =:
+
+CaseTag :=  TagIdent [":" Qualident ] =:
+
+Varient := [
+             VarientCaseLabelList ":" FieldListSequence
+                                                        ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression [ ".." ConstExpression ]
+                   =:
+
+--
+--  the following rules are a copy of the ConstExpression ebnf rules but without
+--  any actions all prefixed with Silent.
+--  At present they are only used by CaseLabels, if this continues to be true we
+--  might consider restricting the SilentConstExpression.  Eg it makes no sence to allow
+--  String in these circumstances!
+--
+
+SilentConstExpression :=
+                         SilentSimpleConstExpr
+                         [ SilentRelation SilentSimpleConstExpr ]
+                      =:
+
+SilentRelation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
+
+SilentSimpleConstExpr := SilentUnaryOrConstTerm { SilentAddOperator SilentConstTerm } =:
+
+SilentUnaryOrConstTerm := "+" SilentConstTerm | "-" SilentConstTerm | SilentConstTerm =:
+
+SilentAddOperator := "+" | "-" | "OR" =:
+
+SilentConstTerm := SilentConstFactor { SilentMulOperator SilentConstFactor } =:
+
+SilentMulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
+
+SilentConstFactor := Number | SilentConstString | SilentConstSetOrQualidentOrFunction |
+                     "(" SilentConstExpression ")" | "NOT" SilentConstFactor
+                     | SilentConstAttribute =:
+
+SilentConstString := string =:
+
+SilentConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" SilentConstAttributeExpression ")" ")" =:
+
+SilentConstAttributeExpression := Ident | "<" Ident ',' SilentConstString ">" =:
+
+SilentComponentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
+
+SilentComponentValue := SilentComponentElement [ 'BY' SilentConstExpression ] =:
+
+SilentArraySetRecordValue := SilentComponentValue { ',' SilentComponentValue } =:
+
+SilentConstructor := '{'
+                         [ SilentArraySetRecordValue ] '}' =:
+
+SilentConstSetOrQualidentOrFunction := SilentConstructor | Qualident
+                                       [ SilentConstructor | SilentActualParameters ] =:
+
+SilentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
+
+SilentActualParameters := "(" [ SilentExpList ] ")" =:
+
+SilentExpList := SilentConstExpression { "," SilentConstExpression } =:
+
+-- end of the Silent constant rules
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+
+PointerType := "POINTER" "TO" Type
+             =:
+
+ProcedureType := "PROCEDURE" [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+
+VarIdent := Ident [ "[" ConstExpression "]" ]
+          =:
+
+VarIdentList := VarIdent { "," VarIdent }
+              =:
+
+VariableDeclaration := VarIdentList ":"
+                       Type Alignment
+                     =:
+
+DefVarIdent := Ident
+                     [ "[" ConstExpression "]" ]
+             =:
+
+DefVarIdentList := DefVarIdent { "," DefVarIdent }
+                 =:
+
+DefVariableDeclaration :=                                               % typeDes := NIL %
+                          DefVarIdentList ":" Type Alignment
+                        =:
+
+Designator := Qualident
+              { SubDesignator } =:
+
+SubDesignator := "."
+                 Ident
+                 | "[" ArrayExpList
+                   "]"
+                 | "^"
+               =:
+
+ArrayExpList :=
+                Expression
+                { ","
+                   Expression
+                }
+              =:
+
+ExpList := Expression { "," Expression }
+         =:
+
+Expression := SimpleExpression [ Relation SimpleExpression ]
+           =:
+
+SimpleExpression := UnaryOrTerm { AddOperator Term } =:
+
+UnaryOrTerm := "+" Term
+               | "-" Term
+               | Term
+	     =:
+
+Term := Factor { MulOperator Factor
+               } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" ( Factor
+          | ConstAttribute
+                                ) =:
+
+SetOrDesignatorOrFunction := Qualident
+                              [ Constructor |
+                                SimpleDes [ ActualParameters ]
+                              ]                                |
+                              Constructor =:
+
+-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+SimpleDes := { SubDesignator } =:
+
+ActualParameters := "(" [ ExpList ] ")" =:
+
+ExitStatement := "EXIT"
+               =:
+
+ReturnStatement := "RETURN" [ Expression ]
+                 =:
+
+Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               ExitStatement | ReturnStatement | RetryStatement
+             ]
+          =:
+
+RetryStatement := "RETRY"
+                =:
+
+AssignmentOrProcedureCall := Designator
+                             ( ":=" Expression
+                                |
+                                  ActualParameters |                     % (* epsilon *) %
+                             )
+                           =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence := Statement { ";" Statement }
+                  =:
+
+IfStatement := "IF"
+                    Expression "THEN"
+                StatementSequence
+              { "ELSIF"
+
+                        Expression "THEN"
+                                          StatementSequence
+              }
+              [ "ELSE"
+                      StatementSequence ] "END"
+            =:
+
+CaseStatement := "CASE"
+                        Expression
+                                   "OF" Case { "|" Case }
+                 CaseEndStatement
+               =:
+
+CaseEndStatement := "END"
+                    | "ELSE"
+                           StatementSequence "END"
+                 =:
+
+Case := [ CaseLabelList ":" StatementSequence ]
+      =:
+
+CaseLabelList := CaseLabels { "," CaseLabels } =:
+
+CaseLabels := ConstExpression [ ".." ConstExpression ]
+            =:
+
+WhileStatement := "WHILE" Expression "DO"
+                      StatementSequence
+		  "END"
+                =:
+
+RepeatStatement := "REPEAT"
+                       StatementSequence
+	           "UNTIL" Expression
+                 =:
+
+ForStatement :=
+                "FOR" Ident ":=" Expression "TO" Expression [ "BY" ConstExpression ] "DO"
+                    StatementSequence
+                "END"
+              =:
+
+LoopStatement := "LOOP"
+                      StatementSequence
+                 "END"
+               =:
+
+WithStatement := "WITH" Designator "DO"
+                     StatementSequence
+                 "END"
+               =:
+
+ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock
+                        Ident
+                      =:
+
+ProcedureIdent := Ident                                                   % curproc := lookupSym (curident) %
+                =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ]
+                      =:
+
+ProcedureHeading := "PROCEDURE" DefineBuiltinProcedure ( ProcedureIdent            % enterScope (curproc) %
+                                                         [ FormalParameters ]
+                                                         AttributeNoReturn )
+                  =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE" Builtin ( ProcedureIdent
+                                             [ DefFormalParameters ]
+                                             AttributeNoReturn )
+                     =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END"             % leaveScope %
+                =:
+
+Block := { Declaration } InitialBlock FinalBlock "END"
+       =:
+
+InitialBlock := [ "BEGIN" InitialBlockBody ] =:
+
+FinalBlock := [ "FINALLY" FinalBlockBody ] =:
+
+InitialBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+FinalBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+ProcedureBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence
+                 =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration ";" } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+AttributeUnused := [ "<*" Ident "*>" ] =:
+
+MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
+
+NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
+
+OptArg := "[" Ident ":" FormalType [ "=" ConstExpression ] "]" =:
+
+DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
+
+FormalType := { "ARRAY" "OF" } Qualident =:
+
+ModuleDeclaration := "MODULE" Ident [ Priority ] ";"
+                        { Import } [ Export ]
+                      Block Ident
+                     =:
+
+Priority := "[" ConstExpression "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"
+                                 IdentList |
+                     "UNQUALIFIED"
+                                 IdentList |
+                     IdentList ) ";" =:
+
+FromImport := "FROM" Ident "IMPORT" IdentList ";"
+            =:
+
+ImportModuleList := Ident { "," Ident }
+                  =:
+
+WithoutFromImport := "IMPORT" ImportModuleList ";"
+                   =:
+
+Import := FromImport | WithoutFromImport =:
+
+DefinitionModule := "DEFINITION" "MODULE" [ "FOR" string ] Ident ";"   % curmodule := lookupDef (curident) %
+    		                                                       % enterScope (curmodule) %
+                      { Import } [ Export ]
+                      { Definition }
+                    "END" Ident "."                                    % checkEndName (curmodule, curident, 'definition module') %
+                                                                       % leaveScope %
+		                                                       % 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 %
+			          ]
+              =:
+
+DefOptSubrange := [ SubrangeType |                                      % putType (typeDes, typeExp) %
+                  ]
+                =:
+
+DefTypeEquiv := DefQualident DefOptSubrange =:
+
+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 %
+                  =:
+
+DefEnumeration := "(" DefEnumIdentList ")" =:
+
+DefSimpleType := DefTypeEquiv | DefEnumeration | SubrangeType
+	       =:
+
+DefType := DefSimpleType | ArrayType | RecordType | SetType |
+           PointerType | ProcedureType
+         =:
+
+DefTypeDeclaration := { Ident                                           % typeDes := lookupSym (curident) %
+                        ( ";" | "=" DefType Alignment ";" ) }
+		    =:
+
+DefConstantDeclaration := Ident
+                                "=" ConstExpression
+                        =:
+
+Definition := "CONST" { DefConstantDeclaration ";" } |
+              "TYPE" { DefTypeDeclaration } |
+              "VAR" { DefVariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+AsmOperands := string [ AsmOperandSpec ]
+             =:
+
+AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+                =:
+
+AsmList := [ AsmElement ] { ',' AsmElement } =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ]
+                =:
+
+AsmElement := AsmOperandName string '(' Expression ')'
+            =:
+
+TrashList := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/mc/mcp2.def b/gcc/m2/mc/mcp2.def
new file mode 100644
index 00000000000..a96afd3d21f
--- /dev/null
+++ b/gcc/m2/mc/mcp2.def
@@ -0,0 +1,32 @@
+(* mcp2.def provides an interface to the pass 2 parser.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcp2 ;
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END mcp2.
diff --git a/gcc/m2/mc/mcp3.bnf b/gcc/m2/mc/mcp3.bnf
new file mode 100644
index 00000000000..8d26b86ffdf
--- /dev/null
+++ b/gcc/m2/mc/mcp3.bnf
@@ -0,0 +1,1328 @@
+--
+-- mc-3.bnf grammar and associated actions for mcp3.
+--
+-- Copyright (C) 2015-2022 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/>.
+% module mcp3 begin
+(* output from mc-3.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+IMPLEMENTATION MODULE mcp3 ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark,
+                           ConCat, ConCatChar ;
+
+FROM mcError IMPORT errorStringAt ;
+FROM nameKey IMPORT NulName, Name, makekey, makeKey ;
+FROM mcPrintf IMPORT printf0, printf1 ;
+FROM mcDebug IMPORT assert ;
+FROM mcReserved IMPORT toktype ;
+FROM mcMetaError IMPORT metaError1, metaError2 ;
+FROM mcStack IMPORT stack ;
+
+IMPORT mcStack ;
+
+FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken,
+                     insertTokenAndRewind, getTokenNo ;
+
+FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName,
+                 putTypeHidden,
+		 enterScope, leaveScope,
+		 putType, lookupSym, isDef, makeSubrange,
+                 makeSet, makePointer, makeProcType,
+		 putReturnType, putOptReturn,
+		 addParameter, paramEnter, paramLeave,
+		 makeVarargs, makeVarParameter, makeNonVarParameter,
+		 putSubrangeType, putConst,
+		 makeArray, putUnbounded, getCardinal,
+		 makeRecord, isRecord, isRecordField, isVarientField, makeVarient,
+		 addFieldsToRecord, isVarient, buildVarientSelector,
+ 		 buildVarientFieldRecord, makeVarDecl, addOptParameter,
+		 makeIdentList, putIdent, addVarParameters, addNonVarParameters,
+		 lookupInScope, import, lookupExported, isImp, isModule, isConst,
+		 makeLiteralInt, makeLiteralReal, makeString, getBuiltinConst,
+		 getNextEnum, resetEnumPos, makeConstExp, setConstExpComplete,
+		 makeEnum, makeEnumField, setNoReturn ;
+
+
+CONST
+   Pass1     = FALSE ;
+   Debugging = FALSE ;
+
+VAR
+   WasNoError : BOOLEAN ;
+   curisused  : BOOLEAN ;
+   curstring,
+   curident   : Name ;
+   curproc,
+   frommodule,
+   typeDes,
+   typeExp,
+   curmodule  : node ;
+   stk        : stack ;
+
+
+(*
+   push -
+*)
+
+PROCEDURE push (n: node) : node ;
+BEGIN
+   RETURN mcStack.push (stk, n)
+END push ;
+
+
+(*
+   pop -
+*)
+
+PROCEDURE pop () : node ;
+BEGIN
+   RETURN mcStack.pop (stk)
+END pop ;
+
+
+(*
+   replace -
+*)
+
+PROCEDURE replace (n: node) : node ;
+BEGIN
+   RETURN mcStack.replace (stk, n)
+END replace ;
+
+
+(*
+   peep - returns the top node on the stack without removing it.
+*)
+
+PROCEDURE peep () : node ;
+BEGIN
+   RETURN push (pop ())
+END peep ;
+
+
+(*
+   depth - returns the depth of the stack.
+*)
+
+PROCEDURE depth () : CARDINAL ;
+BEGIN
+   RETURN mcStack.depth (stk)
+END depth ;
+
+
+(*
+   checkDuplicate -
+*)
+
+PROCEDURE checkDuplicate (b: BOOLEAN) ;
+BEGIN
+
+END checkDuplicate ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   errorStringAt (s, getTokenNo ()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString (InitString (a))
+END ErrorArray ;
+
+
+(*
+   checkParameterAttribute -
+*)
+
+PROCEDURE checkParameterAttribute ;
+BEGIN
+   IF makeKey ("unused") # curident
+   THEN
+      metaError1 ('attribute {%1k} is not allowed in the formal parameter section, currently only unused is allowed', curident)
+   END
+END checkParameterAttribute ;
+
+
+(*
+   checkReturnAttribute -
+*)
+
+PROCEDURE checkReturnAttribute ;
+BEGIN
+   IF makeKey ("noreturn") # curident
+   THEN
+      metaError1 ('attribute {%1k} is not allowed in the procedure return type, only noreturn is allowed', curident)
+   END
+END checkReturnAttribute ;
+
+
+(*
+   pushNunbounded -
+*)
+
+PROCEDURE pushNunbounded (c: CARDINAL) ;
+VAR
+   type,
+   array,
+   subrange: node ;
+BEGIN
+   WHILE c#0 DO
+      type := pop () ;
+      subrange := makeSubrange (NIL, NIL) ;
+      putSubrangeType (subrange, getCardinal ()) ;
+
+      array := makeArray (subrange, type) ;
+      putUnbounded (array) ;
+      type := push (array) ;
+      DEC (c)
+   END
+END pushNunbounded ;
+
+
+(*
+   makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*)
+
+PROCEDURE makeIndexedArray (c: CARDINAL; t: node) : node ;
+VAR
+   i: node ;
+BEGIN
+   WHILE c>0 DO
+      t := makeArray (pop (), t) ;
+      DEC (c)
+   END ;
+   RETURN t
+END makeIndexedArray ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE importInto (m: node; name: Name; current: node) ;
+VAR
+   s, o: node ;
+BEGIN
+   assert (isDef (m)) ;
+   assert (isDef (current) OR isModule (current) OR isImp (current)) ;
+   s := lookupExported (m, name) ;
+   IF s=NIL
+   THEN
+      metaError2 ('{%1k} was not exported from definition module {%2a}', name, m)
+   ELSE
+      o := import (current, s) ;
+      IF s#o
+      THEN
+         metaError2 ('{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}',
+                     s, o)
+      END
+   END
+END importInto ;
+
+
+(*
+   checkEndName - if module does not have, name, then issue an error containing, desc.
+*)
+
+PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF getSymName (module)#name
+   THEN
+      s := InitString ('inconsistent module name found with this ') ;
+      s := ConCat (s, Mark (InitString (desc))) ;
+      ErrorString (s)
+   END
+END checkEndName ;
+
+% declaration mcp3 begin
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (*
+      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 NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      getToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError (stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop (s0, s1, s2) ;
+
+   str := ConCat (InitString ('syntax error,'), Mark (str)) ;
+   errorStringAt (str, getTokenNo ())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken (t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0 ('inserting token\n')
+      END ;
+      insertToken (t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken (t) ;
+      insertTokenAndRewind (t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      getToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   stk := mcStack.init () ;
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   mcStack.kill (stk) ;
+   RETURN WasNoError
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   curident := makekey (currentstring) ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   curstring := makekey (currentstring) ;
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module mcp3 end
+END mcp3.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuild procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit := DefinitionModule | ImplementationOrProgramModule
+          =:
+
+ProgramModule := "MODULE"
+                  Ident                                                % curmodule := lookupModule (curident) %
+		                                                       % enterScope (curmodule) %
+								       % resetEnumPos (curmodule) %
+                  [ Priority
+                  ]
+                  ";"
+                  { Import }
+                  Block
+                  Ident                                                % checkEndName (curmodule, curident, 'program module') %
+   		                                                       % setConstExpComplete (curmodule) %
+		                                                       % leaveScope %
+
+                  "."
+                  =:
+
+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 %
+                         "."
+                      =:
+
+ImplementationOrProgramModule := ImplementationModule | ProgramModule
+                               =:
+
+Number := Integer | Real =:
+
+Qualident :=
+             Ident { "." Ident }
+           =:
+
+ConstantDeclaration :=                                                  % VAR d, e: node ; %
+                       Ident                                            % d := lookupSym (curident) %
+		             "=" ConstExpression                        % e := pop () %
+			                                                % assert (isConst (d)) %
+                                                                        % putConst (d, e) %
+                     =:
+
+ConstExpressionNop := SimpleConstExpr                                   % VAR n: node ; %
+                                      [ Relation SimpleConstExpr ]
+				                                        % n := makeConstExp () %
+                    =:
+
+ConstExpression :=                                                      % VAR n: node ; %
+				                                        % n := push (makeConstExp ()) %
+                   SimpleConstExpr
+                                   [ Relation SimpleConstExpr ]
+                 =:
+
+Relation := "="
+            | "#"
+            | "<>"
+            | "<"
+            | "<="
+            | ">"
+            | ">="
+            | "IN"
+         =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
+
+UnaryOrConstTerm := "+" ConstTerm | "-" ConstTerm | ConstTerm =:
+
+AddOperator := "+" | "-" | "OR" =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor } =:
+
+MulOperator := "*"
+               | "/"
+               | "DIV"
+               | "MOD"
+               | "REM"
+               | "AND"
+               | "&"
+            =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpressionNop ")" | "NOT" ConstFactor
+               | ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string =:
+
+ComponentElement := ConstExpressionNop [ ".." ConstExpressionNop ] =:
+
+ComponentValue := ComponentElement [ 'BY' ConstExpressionNop ] =:
+
+ArraySetRecordValue := ComponentValue { ',' ComponentValue } =:
+
+Constructor := '{'[ ArraySetRecordValue ] '}' =:
+
+ConstSetOrQualidentOrFunction := Qualident
+                                    [ Constructor |
+				      ConstActualParameters
+				    ] | Constructor =:
+
+ConstActualParameters := "(" [ ConstExpList ] ")" =:
+
+ConstExpList := ConstExpressionNop { "," ConstExpressionNop } =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("
+                  ConstAttributeExpression
+                  ")" ")" =:
+
+ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =:
+
+ByteAlignment := '<*' AttributeExpression '*>' =:
+
+OptAlignmentExpression := [ AlignmentExpression ] =:
+
+AlignmentExpression := "(" ConstExpressionNop ")" =:
+
+Alignment := [ ByteAlignment ] =:
+
+IdentList := Ident { "," Ident }
+           =:
+
+PushIdentList :=                                                        % VAR n: node ; %
+                                                                        % n := makeIdentList () %
+                 Ident                                                  % checkDuplicate (putIdent (n, curident)) %
+		       { "," Ident                                      % checkDuplicate (putIdent (n, curident)) %
+		                   }                                    % 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) %
+                                                          "]"
+              =:
+
+ArrayType := "ARRAY"                                                    % VAR c: CARDINAL ; t, n: node ; %
+                                                                        % c := 0 %
+                     SimpleType                                         % INC (c) %
+                                { ","
+                                      SimpleType                        % INC (c) %
+                                                 } "OF"
+                                                        Type            % n := push (makeIndexedArray (c, pop ())) %
+           =:
+
+RecordType := "RECORD"                                                  % VAR n: node ; %
+                                                                        % n := push (makeRecord ()) %
+                                                                        % n := push (NIL)    (* no varient *) %
+                       [ DefaultRecordAttributes ]
+		       FieldListSequence                                % assert (pop ()=NIL) %
+	      "END" =:
+
+DefaultRecordAttributes := '<*'
+                                AttributeExpression
+
+                                                    '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                            { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression := Ident PragmaConstExpression =:
+
+PragmaConstExpression := [ '(' ConstExpressionNop ')' ] =:
+
+AttributeExpression := Ident '(' ConstExpressionNop ')' =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+FieldListStatement := [ FieldList ] =:
+
+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 ()) %
+           =:
+
+TagIdent :=  Ident |                                                    % curident := 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) %
+         =:
+
+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 ()) %
+                                                           =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels :=                                                    % VAR l, h: node ; %
+                                                                        % h := NIL %
+                     ConstExpression                                    % l := pop () %
+                                     [ ".." ConstExpression             % h := pop () %
+				                            ]           % (* l, h  could be saved if necessary.  *) %
+                   =:
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType                     % VAR n: node ; %
+                                                                       % n := push (makeSet (pop ())) %
+         =:
+
+PointerType := "POINTER" "TO" Type                                     % VAR n: node ; %
+                                                                       % n := push (makePointer (pop ())) %
+             =:
+
+ProcedureType := "PROCEDURE"                                           % curproc := push (makeProcType ()) %
+                             [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" PushQualident                                     % putReturnType (curproc, pop ()) %
+                                                                       % putOptReturn (curproc) %
+                               "]" | PushQualident                     % putReturnType (curproc, pop ()) %
+	       =:
+
+ProcedureParameters := ProcedureParameter                              % addParameter (curproc, pop ()) %
+                       { "," ProcedureParameter                        % addParameter (curproc, pop ()) %
+		                                } =:
+
+ProcedureParameter := "..."                                            % VAR n: node ; %
+                                                                       % n := push (makeVarargs ()) %
+                            | "VAR" FormalType                         % n := push (makeVarParameter (NIL, pop (), curproc, TRUE)) %
+			                       | FormalType            % n := push (makeNonVarParameter (NIL, pop (), curproc, TRUE)) %
+					                    =:
+
+
+VarIdent :=                                                             % VAR n, a: node ; %
+                                                                        % n := pop () %
+            Ident                                                       % checkDuplicate (putIdent (n, curident)) %
+	                                                                % n := push (n) %
+                  [ "[" ConstExpression                                 % a := pop ()  (* could store, a, into, n.  *) %
+		                        "]" ]
+             =:
+
+VarIdentList :=                                                         % VAR n: node ; %
+                                                                        % n := makeIdentList () %
+                                                                        % n := push (n) %
+                 VarIdent { "," VarIdent }
+              =:
+
+VariableDeclaration :=                                                  % VAR v, d: node ; %
+                       VarIdentList                                     % v := pop () %
+			            ":" Type                            % d := makeVarDecl (v, pop ()) %
+			                     Alignment
+                     =:
+
+Designator := Qualident
+              { SubDesignator } =:
+
+SubDesignator := "."
+                 Ident
+                 | "[" ArrayExpList
+                   "]"
+                 | "^"
+               =:
+
+ArrayExpList :=
+                Expression
+                { ","
+                   Expression
+                }
+              =:
+
+ExpList := Expression { "," Expression }
+         =:
+
+Expression := SimpleExpression [ Relation SimpleExpression ]
+           =:
+
+SimpleExpression := UnaryOrTerm { AddOperator Term } =:
+
+UnaryOrTerm := "+" Term
+               | "-" Term
+               | Term
+	     =:
+
+Term := Factor { MulOperator Factor
+               } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" ( Factor
+          | ConstAttribute
+                                ) =:
+
+SetOrDesignatorOrFunction := Qualident
+                              [ Constructor |
+                                SimpleDes [ ActualParameters ]
+                              ]                                |
+                              Constructor =:
+
+-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+SimpleDes := { SubDesignator } =:
+
+ActualParameters := "(" [ ExpList ] ")" =:
+
+ExitStatement := "EXIT"
+               =:
+
+ReturnStatement := "RETURN" [ Expression ]
+                 =:
+
+Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               ExitStatement | ReturnStatement | RetryStatement
+             ]
+          =:
+
+RetryStatement := "RETRY"
+                =:
+
+AssignmentOrProcedureCall := Designator
+                             ( ":=" Expression
+                                |
+                                  ActualParameters |                     % (* epsilon *) %
+                             )
+                           =:
+
+StatementSequence := Statement { ";" Statement }
+                  =:
+
+IfStatement := "IF"
+                    Expression "THEN"
+                StatementSequence
+              { "ELSIF"
+
+                        Expression "THEN"
+                                          StatementSequence
+              }
+              [ "ELSE"
+                      StatementSequence ] "END"
+            =:
+
+CaseStatement := "CASE"
+                        Expression
+                                   "OF" Case { "|" Case }
+                 CaseEndStatement
+               =:
+
+CaseEndStatement := "END"
+                    | "ELSE"
+                           StatementSequence "END"
+                 =:
+
+Case := [ CaseLabelList ":" StatementSequence ]
+      =:
+
+CaseLabelList := CaseLabels { "," CaseLabels } =:
+
+CaseLabels := ConstExpressionNop [ ".." ConstExpressionNop ]
+            =:
+
+WhileStatement := "WHILE" Expression "DO"
+                      StatementSequence
+		  "END"
+                =:
+
+RepeatStatement := "REPEAT"
+                       StatementSequence
+	           "UNTIL" Expression
+                 =:
+
+ForStatement := "FOR" Ident ":=" Expression "TO" Expression
+		    [ "BY" ConstExpressionNop ] "DO"
+                       StatementSequence
+                "END"
+              =:
+
+LoopStatement := "LOOP"
+                      StatementSequence
+                 "END"
+               =:
+
+WithStatement := "WITH" Designator "DO"
+                     StatementSequence
+                 "END"
+               =:
+
+ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock
+                        Ident                                          % leaveScope %
+                      =:
+
+ProcedureIdent := Ident                                                % curproc := lookupSym (curident) %
+                                                                       % enterScope (curproc) %
+                =:
+
+DefProcedureIdent := Ident                                             % curproc := lookupSym (curident) %
+                   =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ]
+                      =:
+
+ProcedureHeading := "PROCEDURE" DefineBuiltinProcedure ( ProcedureIdent [ FormalParameters ] AttributeNoReturn )
+                  =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE" Builtin ( DefProcedureIdent [ DefFormalParameters ] AttributeNoReturn )
+                     =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END"
+                =:
+
+Block := { Declaration } InitialBlock FinalBlock "END"
+       =:
+
+InitialBlock := [ "BEGIN" InitialBlockBody ] =:
+
+FinalBlock := [ "FINALLY" FinalBlockBody ] =:
+
+InitialBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+FinalBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+ProcedureBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence
+                 =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "("                                            % paramEnter (curproc) %
+                           [ DefMultiFPSection ] ")"                  % paramLeave (curproc) %
+			                             FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "("                                               % paramEnter (curproc) %
+                        [ MultiFPSection ] ")"                        % paramLeave (curproc) %
+			                       FormalReturn =:
+
+AttributeNoReturn := [ NoReturn |                                     % setNoReturn (curproc, FALSE) %
+                                  ] =:
+
+NoReturn := "<*" Ident                                                % setNoReturn (curproc, TRUE) %
+                                                                      % checkReturnAttribute %
+                       "*>" =:
+
+AttributeUnused := [ Unused ] =:
+
+Unused := "<*" Ident                                                  % curisused := FALSE %
+                                                                      % checkParameterAttribute %
+                     "*>" =:
+
+MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..."                                    % addParameter (curproc, makeVarargs ()) %
+                                   =:
+
+ExtendedFP := OptArg | "..."
+                             =:
+
+VarFPSection := "VAR" PushIdentList                                   % VAR l, t: node ; %
+                                    ":" FormalType                    % t := pop () %
+				                                      % l := pop () %
+                                                                      % curisused := TRUE %
+                                                  [ AttributeUnused ]
+                                                                      % addVarParameters (curproc, l, t, curisused) %
+              =:
+
+NonVarFPSection := PushIdentList                                      % VAR l, t: node ; %
+                                 ":" FormalType                       % t := pop () %
+				                                      % l := pop () %
+                                                                      % curisused := TRUE %
+                                                [ AttributeUnused ]
+								      % 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) %
+       =:
+
+
+DefOptArg :=                                                          % VAR p, init, type: node ; id: Name ; %
+             "[" Ident                                                % id := curident %
+	               ":" FormalType                                 % type := pop () %
+		                      "=" ConstExpression             % init := pop () %
+	                                                  "]"         % p := addOptParameter (curproc, id, type, init) %
+						              =:
+
+
+FormalType :=                                                         % VAR c: CARDINAL ; %
+                                                                      % VAR n, a, s: node ; %
+                                                                      % c := 0 %
+              { "ARRAY" "OF"                                          % INC (c) %
+	                     } PushQualident                          % pushNunbounded (c) %
+	    =:
+
+ModuleDeclaration := "MODULE" Ident [ Priority ] ";"
+                        { Import } [ Export ]
+                        Block Ident
+                   =:
+
+Priority := "[" ConstExpressionNop "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"
+                                 IdentList |
+                     "UNQUALIFIED"
+                                 IdentList |
+                     IdentList ) ";" =:
+
+FromIdentList := Ident                                                 % importInto (frommodule, curident, curmodule) %
+                       { "," Ident                                     % importInto (frommodule, curident, curmodule) %
+		                   }
+           =:
+
+FromImport := "FROM" Ident                                             % frommodule := lookupDef (curident) %
+                           "IMPORT" FromIdentList ";"
+               =:
+
+ImportModuleList := Ident { "," Ident } =:
+
+WithoutFromImport := "IMPORT" ImportModuleList ";"
+                   =:
+
+Import := FromImport | WithoutFromImport =:
+
+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 %
+                  =:
+
+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 %
+			          ]
+              =:
+
+OptSubrange := [ SubrangeType
+                                                                       % VAR q, s: node ; %
+                                                                       % s := pop () %
+                                                                       % q := pop () %
+								       % putSubrangeType (s, q) %
+								       % typeExp := push (s) %
+                                 ]
+                =:
+
+TypeEquiv := PushQualident OptSubrange =:
+
+EnumIdentList :=                                                        % VAR f: node ; %
+                                                                        % typeExp := push (makeEnum ()) %
+                    Ident                                               % f := makeEnumField (typeExp, curident) %
+		          { "," Ident                                   % f := makeEnumField (typeExp, curident) %
+			              }
+                  =:
+
+Enumeration := "(" EnumIdentList ")" =:
+
+SimpleType :=                                                          % VAR d: CARDINAL ; %
+                                                                       % d := depth () %
+              ( TypeEquiv | Enumeration | SubrangeType )               % assert (d = depth () - 1) %
+	    =:
+
+Type := SimpleType | ArrayType | RecordType | SetType |
+        PointerType | ProcedureType
+      =:
+
+TypeDeclaration := { Ident                                                % typeDes := lookupSym (curident) %
+                           ( ";" | "=" Type                               % putType (typeDes, pop ()) %
+			                       Alignment ";" ) }
+		    =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE" { TypeDeclaration } |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+AsmOperands := string [ AsmOperandSpec ]
+             =:
+
+AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+                =:
+
+AsmList := [ AsmElement ] { ',' AsmElement } =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ]
+                =:
+
+AsmElement := AsmOperandName string '(' Expression ')'
+            =:
+
+TrashList := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/mc/mcp3.def b/gcc/m2/mc/mcp3.def
new file mode 100644
index 00000000000..e3a39df3397
--- /dev/null
+++ b/gcc/m2/mc/mcp3.def
@@ -0,0 +1,33 @@
+(* mcp3.def provides an interface to the pass 3 parser.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE mcp3 ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END mcp3.
diff --git a/gcc/m2/mc/mcp4.bnf b/gcc/m2/mc/mcp4.bnf
new file mode 100644
index 00000000000..b9f13f97008
--- /dev/null
+++ b/gcc/m2/mc/mcp4.bnf
@@ -0,0 +1,1267 @@
+--
+-- mc-4.bnf grammar and associated actions for mcp4.
+--
+-- Copyright (C) 2016-2022 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/>.
+% module mcp4 begin
+(* output from mc-4.bnf, automatically generated do not edit.
+
+Copyright (C) 2016-2022 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/>.  *)
+
+IMPLEMENTATION MODULE mcp4 ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark,
+                           ConCat, ConCatChar ;
+
+FROM mcError IMPORT errorStringAt ;
+FROM nameKey IMPORT NulName, Name, makekey ;
+FROM mcPrintf IMPORT printf0, printf1 ;
+FROM mcDebug IMPORT assert ;
+FROM mcReserved IMPORT toktype ;
+FROM mcMetaError IMPORT metaError1, metaError2 ;
+FROM mcStack IMPORT stack ;
+
+IMPORT mcStack ;
+
+FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken,
+                     insertTokenAndRewind, getTokenNo ;
+
+FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName,
+		 enterScope, leaveScope,
+		 putType, lookupSym, isDef, makeSubrange,
+                 makeSet, makePointer, makeProcType,
+		 addParameter,
+		 makeVarargs, makeVarParameter, makeNonVarParameter,
+		 putSubrangeType, putConst,
+		 makeArray, putUnbounded, getCardinal, makeBinaryTok, makeUnaryTok,
+		 makeRecord, isRecord, isRecordField, isVarientField, makeVarient,
+		 addFieldsToRecord, isVarient, buildVarientSelector,
+ 		 buildVarientFieldRecord, makeVarDecl, paramEnter, paramLeave,
+		 makeIdentList, putIdent, addVarParameters, addNonVarParameters,
+		 lookupInScope, import, lookupExported, isImp, isModule, isConst,
+		 makeLiteralInt, makeLiteralReal, makeString, getBuiltinConst,
+		 getNextConstExp, fixupConstExp, makeFuncCall,
+		 makeExpList, putExpList, isExpList,
+		 makeSetValue, putSetValue, includeSetValue,
+                 addCommentBody,
+		 resetConstExpPos ;
+
+
+CONST
+   Pass1     = FALSE ;
+   Debugging = FALSE ;
+
+VAR
+   WasNoError : BOOLEAN ;
+   curstring,
+   curident   : Name ;
+   curproc,
+   typeDes,
+   typeExp,
+   curmodule  : node ;
+   stk        : stack ;
+
+
+(*
+   push -
+*)
+
+PROCEDURE push (n: node) : node ;
+BEGIN
+   RETURN mcStack.push (stk, n)
+END push ;
+
+
+(*
+   pop -
+*)
+
+PROCEDURE pop () : node ;
+BEGIN
+   RETURN mcStack.pop (stk)
+END pop ;
+
+
+(*
+   replace -
+*)
+
+PROCEDURE replace (n: node) : node ;
+BEGIN
+   RETURN mcStack.replace (stk, n)
+END replace ;
+
+
+(*
+   peep - returns the top node on the stack without removing it.
+*)
+
+PROCEDURE peep () : node ;
+BEGIN
+   RETURN push (pop ())
+END peep ;
+
+
+(*
+   depth - returns the depth of the stack.
+*)
+
+PROCEDURE depth () : CARDINAL ;
+BEGIN
+   RETURN mcStack.depth (stk)
+END depth ;
+
+
+(*
+   checkDuplicate -
+*)
+
+PROCEDURE checkDuplicate (b: BOOLEAN) ;
+BEGIN
+
+END checkDuplicate ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   errorStringAt (s, getTokenNo ()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString (InitString (a))
+END ErrorArray ;
+
+
+(*
+   pushNunbounded -
+*)
+
+PROCEDURE pushNunbounded (c: CARDINAL) ;
+VAR
+   type,
+   array,
+   subrange: node ;
+BEGIN
+   WHILE c#0 DO
+      type := pop () ;
+      subrange := makeSubrange (NIL, NIL) ;
+      putSubrangeType (subrange, getCardinal ()) ;
+
+      array := makeArray (subrange, type) ;
+      putUnbounded (array) ;
+      type := push (array) ;
+      DEC (c)
+   END
+END pushNunbounded ;
+
+
+(*
+   makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*)
+
+PROCEDURE makeIndexedArray (c: CARDINAL; t: node) : node ;
+VAR
+   i: node ;
+BEGIN
+   WHILE c>0 DO
+      t := makeArray (pop (), t) ;
+      DEC (c)
+   END ;
+   RETURN t
+END makeIndexedArray ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE importInto (m: node; name: Name; current: node) ;
+VAR
+   s, o: node ;
+BEGIN
+   assert (isDef (m)) ;
+   assert (isDef (current) OR isModule (current) OR isImp (current)) ;
+   s := lookupExported (m, name) ;
+   IF s=NIL
+   THEN
+      metaError2 ('{%1k} was not exported from definition module {%2a}', name, m)
+   ELSE
+      o := import (current, s) ;
+      IF s#o
+      THEN
+         metaError2 ('{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}',
+                     s, o)
+      END
+   END
+END importInto ;
+
+
+(*
+   checkEndName - if module does not have, name, then issue an error containing, desc.
+*)
+
+PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF getSymName (module)#name
+   THEN
+      s := InitString ('inconsistent module name found with this ') ;
+      s := ConCat (s, Mark (InitString (desc))) ;
+      ErrorString (s)
+   END
+END checkEndName ;
+
+% declaration mcp4 begin
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (*
+      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 NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      getToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError (stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop (s0, s1, s2) ;
+
+   str := ConCat (InitString ('syntax error,'), Mark (str)) ;
+   errorStringAt (str, getTokenNo ())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken (t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0 ('inserting token\n')
+      END ;
+      insertToken (t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken (t) ;
+      insertTokenAndRewind (t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      getToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   stk := mcStack.init () ;
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   mcStack.kill (stk) ;
+   RETURN WasNoError
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   curident := makekey (currentstring) ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   curstring := makekey (currentstring) ;
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+VAR
+   n: node ;
+BEGIN
+   n := push (makeLiteralInt (makekey (currentstring))) ;
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+VAR
+   n: node ;
+BEGIN
+   n := push (makeLiteralReal (makekey (currentstring))) ;
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module mcp4 end
+END mcp4.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuild procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit := DefinitionModule | ImplementationOrProgramModule
+          =:
+
+ProgramModule := "MODULE"
+                  Ident                                                % curmodule := lookupModule (curident) %
+		                                                       % enterScope (curmodule) %
+                                                                       % resetConstExpPos (curmodule) %
+                  [ Priority
+                  ]
+                  ";"
+                  { Import }
+                  Block
+                  Ident                                                % checkEndName (curmodule, curident, 'program module') %
+		                                                       % leaveScope %
+
+                  "."
+                  =:
+
+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 %
+                         "."
+                      =:
+
+ImplementationOrProgramModule := ImplementationModule | ProgramModule
+                               =:
+
+Number := Integer | Real =:
+
+Qualident :=
+             Ident { "." Ident }
+           =:
+
+ConstantDeclaration :=                                                  % VAR d, e: node ; %
+                       Ident                                            % d := lookupSym (curident) %
+		             "=" ConstExpression                        % e := pop () %
+			                                                % assert (isConst (d)) %
+                                                                        % 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 ()) %
+                 =:
+
+Relation := "="
+            | "#"
+            | "<>"
+            | "<"
+            | "<="
+            | ">"
+            | ">="
+            | "IN"
+         =:
+
+SimpleConstExpr :=                                                      % VAR op: toktype ; n: node ; %
+                   UnaryOrConstTerm                                     % n := pop () %
+		                    {                                   % op := currenttoken %
+                                      AddOperator ConstTerm             % n := makeBinaryTok (op, n, pop ()) %
+                                                            }           % n := push (n) %
+							      =:
+
+UnaryOrConstTerm :=                                                     % VAR n: node ; %
+                    "+"
+                    ConstTerm                                           % n := push (makeUnaryTok (plustok, pop ())) %
+                    |
+                    "-"
+                    ConstTerm                                           % n := push (makeUnaryTok (minustok, pop ())) %
+                    |
+                    ConstTerm =:
+
+AddOperator :=   "+"
+               | "-"
+               | "OR"
+            =:
+
+ConstTerm :=                                                            % VAR op: toktype ; n: node ; %
+             ConstFactor                                                % n := pop () %
+                         {                                              % op := currenttoken %
+			   MulOperator ConstFactor                      % n := makeBinaryTok (op, n, pop ()) %
+                                                   }                    % n := push (n) %
+						     =:
+
+MulOperator := "*"
+               | "/"
+               | "DIV"
+               | "MOD"
+               | "REM"
+               | "AND"
+               | "&"
+            =:
+
+NotConstFactor := "NOT" ConstFactor                                     % VAR n: node ; %
+                                                                        % n := push (makeUnaryTok (nottok, pop ())) %
+                =:
+
+ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpression ")" | NotConstFactor
+               | ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string                                                   % VAR n: node ; %
+                                                                        % n := push (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)) %
+                       =:
+
+ConstComponentValue := ConstComponentElement [ 'BY'                     % ErrorArray ('implementation restriction BY not allowed') %
+                                                    ConstExpression ]
+                     =:
+
+ConstArraySetRecordValue := ConstComponentValue { ',' ConstComponentValue }
+                          =:
+
+ConstConstructor := '{'                                                 % VAR n: node ; %
+                                                                        % n := push (makeSetValue ()) %
+                        [ ConstArraySetRecordValue ]
+                    '}' =:
+
+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 ()) %
+			       =:
+
+ConstActualParameters := "("                                             % VAR n: node ; %
+                                                                         % n := push (makeExpList ()) %
+                             [ ConstExpList ] ")"                        % assert (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 ())) %
+                                                      }
+              =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("
+                  ConstAttributeExpression
+                  ")" ")" =:
+
+ConstAttributeExpression :=
+                            Ident                                       % VAR n: node ; %
+			                                                % n := push (getBuiltinConst (curident)) %
+                                  | "<" Qualident ',' Ident
+                                                              ">"
+                          =:
+
+ByteAlignment := '<*' AttributeExpression '*>'
+               =:
+
+OptAlignmentExpression := [ AlignmentExpression ] =:
+
+AlignmentExpression := "(" ConstExpression ")" =:
+
+Alignment := [ ByteAlignment ] =:
+
+IdentList := Ident { "," Ident }
+           =:
+
+PushIdentList :=                                                        % VAR n: node ; %
+                                                                        % n := makeIdentList () %
+                 Ident                                                  % checkDuplicate (putIdent (n, curident)) %
+		       { "," Ident                                      % checkDuplicate (putIdent (n, curident)) %
+		                   }                                    % n := push (n) %
+               =:
+
+
+SubrangeType := "[" ConstExpression ".." ConstExpression "]" =:
+
+ArrayType := "ARRAY" SimpleType { "," SimpleType } "OF" Type =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ]
+		       FieldListSequence
+	      "END" =:
+
+DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                            { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression := Ident PragmaConstExpression =:
+
+PragmaConstExpression := [ '(' ConstExpression ')' ] =:
+
+AttributeExpression := Ident '(' ConstExpression ')' =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+FieldListStatement := [ FieldList ] =:
+
+FieldList := IdentList ":" Type RecordFieldPragma
+             | "CASE" CaseTag "OF" Varient { "|" Varient }
+              [ "ELSE"
+                      FieldListSequence
+              ] "END"
+           =:
+
+TagIdent :=  Ident |                                                    % curident := NulName %
+          =:
+
+CaseTag := TagIdent [ ":" Qualident ]
+         =:
+
+Varient :=  [ VarientCaseLabelList ":" FieldListSequence ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpression [ ".." ConstExpression ]
+                   =:
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+
+PointerType := "POINTER" "TO" Type =:
+
+ProcedureType := "PROCEDURE" [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident
+	       =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+
+VarIdent := Ident [ "[" ConstExpression                                % VAR n: node ; %
+                                                                       % n := pop () %
+                                        "]" ]
+          =:
+
+VarIdentList := VarIdent { "," VarIdent }
+              =:
+
+VariableDeclaration := VarIdentList ":"
+                       Type Alignment
+                     =:
+
+Designator := Qualident
+              { SubDesignator } =:
+
+SubDesignator := "."
+                 Ident
+                 | "[" ArrayExpList
+                   "]"
+                 | "^"
+               =:
+
+ArrayExpList :=
+                Expression
+                { ","
+                   Expression
+                }
+              =:
+
+ExpList := Expression { "," Expression }
+         =:
+
+Expression := SimpleExpression [ Relation SimpleExpression ]
+           =:
+
+SimpleExpression := UnaryOrTerm { AddOperator Term } =:
+
+UnaryOrTerm := "+" Term
+               | "-" Term
+               | Term
+	     =:
+
+Term := Factor { MulOperator Factor
+               } =:
+
+Factor := Number | string | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" ( Factor
+          | ConstAttribute
+                                ) =:
+
+ComponentElement := Expression
+                               [ ".." Expression                        % ErrorArray ('implementation restriction range not allowed') %
+			                         ]
+                  =:
+
+ComponentValue := ComponentElement [ 'BY'                               % ErrorArray ('implementation restriction BY not allowed') %
+                                          Expression ]
+                =:
+
+ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+                     =:
+
+Constructor := '{' [ ArraySetRecordValue ] '}' =:
+
+SetOrDesignatorOrFunction := Qualident
+                              [ Constructor |
+                                SimpleDes [ ActualParameters ]
+                              ]                                |
+                              Constructor =:
+
+-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+SimpleDes := { SubDesignator } =:
+
+ActualParameters := "(" [ ExpList ] ")" =:
+
+ExitStatement := "EXIT"
+               =:
+
+ReturnStatement := "RETURN" [ Expression ]
+                 =:
+
+Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               ExitStatement | ReturnStatement | RetryStatement
+             ]
+          =:
+
+RetryStatement := "RETRY"
+                =:
+
+AssignmentOrProcedureCall := Designator
+                             ( ":=" Expression
+                                |
+                                  ActualParameters |                     % (* epsilon *) %
+                             )
+                           =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+StatementSequence := Statement { ";" Statement }
+                  =:
+
+IfStatement := "IF"
+                    Expression "THEN"
+                StatementSequence
+              { "ELSIF"
+
+                        Expression "THEN"
+                                          StatementSequence
+              }
+              [ "ELSE"
+                      StatementSequence ] "END"
+            =:
+
+CaseStatement := "CASE"
+                        Expression
+                                   "OF" Case { "|" Case }
+                 CaseEndStatement
+               =:
+
+CaseEndStatement := "END"
+                    | "ELSE"
+                           StatementSequence "END"
+                 =:
+
+Case := [ CaseLabelList ":" StatementSequence ]
+      =:
+
+CaseLabelList := CaseLabels { "," CaseLabels } =:
+
+CaseLabels := ConstExpression [ ".." ConstExpression ]
+            =:
+
+WhileStatement := "WHILE" Expression "DO"
+                      StatementSequence
+		  "END"
+                =:
+
+RepeatStatement := "REPEAT"
+                       StatementSequence
+	           "UNTIL" Expression
+                 =:
+
+ForStatement :=
+                "FOR" Ident ":=" Expression "TO" Expression [ "BY" ConstExpression ] "DO"
+                    StatementSequence
+                "END"
+              =:
+
+LoopStatement := "LOOP"
+                      StatementSequence
+                 "END"
+               =:
+
+WithStatement := "WITH" Designator "DO"
+                     StatementSequence
+                 "END"
+               =:
+
+ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock
+                        Ident                                          % leaveScope %
+                      =:
+
+ProcedureIdent := Ident                                                % curproc := lookupSym (curident) %
+                                                                       % enterScope (curproc) %
+                =:
+
+DefProcedureIdent := Ident                                             % curproc := lookupSym (curident) %
+                   =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ]
+                      =:
+
+ProcedureHeading := "PROCEDURE" DefineBuiltinProcedure ( ProcedureIdent
+                                                         [ FormalParameters ]
+                                                         AttributeNoReturn )
+                  =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE" Builtin ( DefProcedureIdent
+                                             [ DefFormalParameters ]
+                                             AttributeNoReturn )
+                     =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END"
+                =:
+
+Block := { Declaration } InitialBlock FinalBlock "END"
+       =:
+
+InitialBlock := [ "BEGIN" InitialBlockBody ] =:
+
+FinalBlock := [ "FINALLY" FinalBlockBody ] =:
+
+InitialBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+FinalBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+ProcedureBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
+
+NormalPart := StatementSequence =:
+
+ExceptionalPart := StatementSequence
+                 =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "("                                            % paramEnter (curproc) %
+                           [ DefMultiFPSection ] ")"                  % paramLeave (curproc) %
+			                             FormalReturn =:
+
+DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "("                                               % paramEnter (curproc) %
+                        [ MultiFPSection ] ")"                        % paramLeave (curproc) %
+			                       FormalReturn =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+AttributeUnused := [ "<*" Ident "*>" ] =:
+
+MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" PushIdentList ":" FormalType [ AttributeUnused ] =:
+
+NonVarFPSection := PushIdentList ":" FormalType [ AttributeUnused ] =:
+
+OptArg := "[" Ident ":" FormalType [ "=" ConstExpression ] "]" =:
+
+DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
+
+FormalType := { "ARRAY" "OF" } PushQualident =:
+
+ModuleDeclaration := "MODULE" Ident [ Priority ] ";"
+                        { Import } [ Export ]
+                        Block Ident
+                   =:
+
+Priority := "[" ConstExpression "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"
+                                 IdentList |
+                     "UNQUALIFIED"
+                                 IdentList |
+                     IdentList ) ";" =:
+
+FromIdentList := Ident { "," Ident } =:
+
+FromImport := "FROM" Ident "IMPORT" FromIdentList ";"
+            =:
+
+ImportModuleList := Ident { "," Ident } =:
+
+WithoutFromImport := "IMPORT" ImportModuleList ";"
+                   =:
+
+Import := FromImport | WithoutFromImport =:
+
+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 %
+                  =:
+
+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 %
+			          ]
+              =:
+
+OptSubrange := [ SubrangeType ] =:
+
+TypeEquiv := PushQualident OptSubrange =:
+
+EnumIdentList := Ident { "," Ident } =:
+
+Enumeration := "(" EnumIdentList ")" =:
+
+SimpleType := TypeEquiv | Enumeration | SubrangeType =:
+
+Type := SimpleType | ArrayType | RecordType | SetType |
+        PointerType | ProcedureType
+      =:
+
+TypeDeclaration := { Ident ( ";" | "=" Type    Alignment ";" ) } =:
+
+
+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 %
+			          ]
+              =:
+
+DefTypeEquiv := DefQualident OptSubrange =:
+
+DefEnumIdentList := Ident { "," Ident } =:
+
+DefEnumeration := "(" DefEnumIdentList ")" =:
+
+DefSimpleType := DefTypeEquiv | DefEnumeration | SubrangeType
+	       =:
+
+DefType := DefSimpleType | ArrayType | RecordType | SetType |
+           PointerType | ProcedureType
+         =:
+
+DefTypeDeclaration := { Ident ( ";" | "=" DefType Alignment ";" ) } =:
+
+DefConstantDeclaration := Ident "=" ConstExpression =:
+
+Definition := "CONST" { DefConstantDeclaration ";" } |
+              "TYPE" { DefTypeDeclaration } |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+AsmOperands := string [ AsmOperandSpec ]
+             =:
+
+AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+                =:
+
+AsmList := [ AsmElement ] { ',' AsmElement } =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ]
+                =:
+
+AsmElement := AsmOperandName string '(' Expression ')'
+            =:
+
+TrashList := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/mc/mcp4.def b/gcc/m2/mc/mcp4.def
new file mode 100644
index 00000000000..ea3b8a63913
--- /dev/null
+++ b/gcc/m2/mc/mcp4.def
@@ -0,0 +1,33 @@
+(* mcp4.def provides an interface to the pass 4 parser.
+
+Copyright (C) 2016-2022 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/>.  *)
+
+DEFINITION MODULE mcp4 ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END mcp4.
diff --git a/gcc/m2/mc/mcp5.bnf b/gcc/m2/mc/mcp5.bnf
new file mode 100644
index 00000000000..6e843bf301b
--- /dev/null
+++ b/gcc/m2/mc/mcp5.bnf
@@ -0,0 +1,1568 @@
+--
+-- mc-5.bnf grammar and associated actions for mcp5.
+--
+-- Copyright (C) 2016-2022 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/>.
+% module mcp5 begin
+
+(* output from mc-5.bnf, automatically generated do not edit.
+
+Copyright (C) 2016-2022 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/>.  *)
+
+IMPLEMENTATION MODULE mcp5 ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark,
+                           ConCat, ConCatChar ;
+
+FROM mcError IMPORT errorStringAt, flushErrors ;
+FROM nameKey IMPORT NulName, Name, makekey ;
+FROM mcPrintf IMPORT printf0, printf1 ;
+FROM mcDebug IMPORT assert ;
+FROM mcReserved IMPORT toktype ;
+FROM mcComment IMPORT setProcedureComment ;
+FROM mcMetaError IMPORT metaError1, metaError2 ;
+FROM mcStack IMPORT stack ;
+
+IMPORT mcStack ;
+
+FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken,
+                     insertTokenAndRewind, getTokenNo, lastcomment,
+                     getBodyComment, getAfterComment ;
+
+FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName,
+		 enterScope, leaveScope,
+		 makeEnum, makeEnumField, putType, lookupSym, isDef, makeSubrange,
+                 makeSet, makePointer,
+		 addParameter,
+		 makeVarargs, makeVarParameter, makeNonVarParameter,
+		 putSubrangeType, putConst, getType, skipType,
+		 makeArray, putUnbounded, getCardinal, makeBinaryTok, makeUnaryTok,
+		 makeRecord, isRecord, isRecordField, isVarientField, makeVarient,
+		 addFieldsToRecord, isVarient, buildVarientSelector,
+ 		 buildVarientFieldRecord, paramEnter, paramLeave,
+		 makeIdentList, putIdent, addVarParameters, addNonVarParameters,
+		 lookupInScope, import, lookupExported, isImp, isModule, isConst,
+		 makeLiteralInt, makeLiteralReal, makeString, getBuiltinConst,
+		 getNextEnum, makeComponentRef, makeArrayRef, makeDeRef,
+		 makePointerRef,
+		 makeExpList, putExpList, isExpList, isArray, isPointer, isVar,
+		 isConst, isParameter,
+		 makeStatementSequence, addStatement, putBegin, putFinally,
+		 makeReturn, putReturn, makeExit, makeComment,
+		 isStatementSequence, isWhile, makeWhile, putWhile,
+		 makeAssignment, makeFuncCall, isReturn,
+		 makeIf, makeElsif, putElse, isIf,
+		 makeFor, putFor, isFor,
+		 makeRepeat, putRepeat,
+		 resetConstExpPos, getNextConstExp,
+		 makeSetValue, putSetValue, includeSetValue,
+		 makeCase, putCaseExpression, putCaseElse,
+		 putCaseStatement, makeCaseList, putCaseRange,
+		 dupExpr, makeLoop, putLoop, isLoop,
+		 addCommentBody, addCommentAfter, addIfComments,
+		 addElseComments, addIfEndComments,
+		 addWhileDoComment, addWhileEndComment,
+                 addRepeatComment, addUntilComment,
+		 makeCommentS ;
+
+
+CONST
+   Pass1     = FALSE ;
+   Debugging = FALSE ;
+
+VAR
+   WasNoError : BOOLEAN ;
+   curstring,
+   curident   : Name ;
+   curproc,
+   frommodule,
+   qualid,
+   typeDes,
+   typeExp,
+   curmodule  : node ;
+   loopNo     : CARDINAL ;
+   loopStk,
+   stmtStk,
+   withStk,
+   stk        : stack ;
+
+
+(*
+   followNode -
+*)
+
+PROCEDURE followNode (n: node) ;
+BEGIN
+   IF isVar (n)
+   THEN
+      printf0 ("variable: ")
+   ELSIF isParameter (n)
+   THEN
+      printf0 ("parameter: ")
+   END ;
+   n := skipType (getType (n)) ;
+   IF isArray (n)
+   THEN
+      printf0 ("array\n")
+   ELSIF isPointer (n)
+   THEN
+      printf0 ("pointer\n")
+   ELSIF isRecord (n)
+   THEN
+      printf0 ("record\n")
+   ELSE
+      printf0 ("other\n")
+   END
+END followNode ;
+
+
+(*
+   push -
+*)
+
+PROCEDURE push (n: node) : node ;
+BEGIN
+   RETURN mcStack.push (stk, n)
+END push ;
+
+
+(*
+   pop -
+*)
+
+PROCEDURE pop () : node ;
+BEGIN
+   RETURN mcStack.pop (stk)
+END pop ;
+
+
+(*
+   replace -
+*)
+
+PROCEDURE replace (n: node) : node ;
+BEGIN
+   RETURN mcStack.replace (stk, n)
+END replace ;
+
+
+(*
+   peep - returns the top node on the stack without removing it.
+*)
+
+PROCEDURE peep () : node ;
+BEGIN
+   RETURN push (pop ())
+END peep ;
+
+
+(*
+   depth - returns the depth of the stack.
+*)
+
+PROCEDURE depth () : CARDINAL ;
+BEGIN
+   RETURN mcStack.depth (stk)
+END depth ;
+
+
+(*
+   checkDuplicate -
+*)
+
+PROCEDURE checkDuplicate (b: BOOLEAN) ;
+BEGIN
+
+END checkDuplicate ;
+
+
+(*
+   isQualident - returns TRUE if, n, is a qualident.
+*)
+
+PROCEDURE isQualident (n: node) : BOOLEAN ;
+VAR
+   type: node ;
+BEGIN
+   IF isDef (n)
+   THEN
+      RETURN TRUE
+   ELSE
+      type := skipType (getType (n)) ;
+      RETURN (type # NIL) AND isRecord (type)
+   END ;
+   RETURN FALSE
+END isQualident ;
+
+
+
+(*
+   startWith -
+*)
+
+PROCEDURE startWith (n: node) ;
+BEGIN
+   n := mcStack.push (withStk, n)
+END startWith ;
+
+
+(*
+   endWith -
+*)
+
+PROCEDURE endWith ;
+VAR
+   n: node ;
+BEGIN
+   n := mcStack.pop (withStk)
+END endWith ;
+
+
+(*
+   lookupWithSym -
+*)
+
+PROCEDURE lookupWithSym (i: Name) : node ;
+VAR
+   d      : CARDINAL ;
+   n, m, t: node ;
+BEGIN
+   d := mcStack.depth (withStk) ;
+   WHILE d # 0 DO
+      n := mcStack.access (withStk, d) ;
+      t := skipType (getType (n)) ;
+      m := lookupInScope (t, i) ;
+      IF m # NIL
+      THEN
+         n := dupExpr (n) ;
+         RETURN makeComponentRef (n, m)
+      END ;
+      DEC (d)
+   END ;
+   RETURN lookupSym (i)
+END lookupWithSym ;
+
+
+(*
+   pushStmt - push a node, n, to the statement stack and return node, n.
+*)
+
+PROCEDURE pushStmt (n: node) : node ;
+BEGIN
+   RETURN mcStack.push (stmtStk, n)
+END pushStmt ;
+
+
+(*
+   popStmt - pop the top node from the statement stack.
+*)
+
+PROCEDURE popStmt () : node ;
+BEGIN
+   RETURN mcStack.pop (stmtStk)
+END popStmt ;
+
+
+(*
+   peepStmt - return the top node from the statement stack,
+              but leave the stack unchanged.
+*)
+
+PROCEDURE peepStmt () : node ;
+BEGIN
+   RETURN pushStmt (popStmt ())
+END peepStmt ;
+
+
+(*
+   pushLoop - push a node, n, to the loop stack and return node, n.
+*)
+
+PROCEDURE pushLoop (n: node) : node ;
+BEGIN
+   RETURN mcStack.push (loopStk, n)
+END pushLoop ;
+
+
+(*
+   popLoop - pop the top node from the loop stack.
+*)
+
+PROCEDURE popLoop () : node ;
+BEGIN
+   RETURN mcStack.pop (loopStk)
+END popLoop ;
+
+
+(*
+   peepLoop - return the top node from the loop stack,
+              but leave the stack unchanged.
+*)
+
+PROCEDURE peepLoop () : node ;
+BEGIN
+   RETURN pushLoop (popLoop ())
+END peepLoop ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+   errorStringAt (s, getTokenNo ()) ;
+   WasNoError := FALSE
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+   ErrorString (InitString (a))
+END ErrorArray ;
+
+
+(*
+   pushNunbounded -
+*)
+
+PROCEDURE pushNunbounded (c: CARDINAL) ;
+VAR
+   type,
+   array,
+   subrange: node ;
+BEGIN
+   WHILE c#0 DO
+      type := pop () ;
+      subrange := makeSubrange (NIL, NIL) ;
+      putSubrangeType (subrange, getCardinal ()) ;
+
+      array := makeArray (subrange, type) ;
+      putUnbounded (array) ;
+      type := push (array) ;
+      DEC (c)
+   END
+END pushNunbounded ;
+
+
+(*
+   makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*)
+
+PROCEDURE makeIndexedArray (c: CARDINAL; t: node) : node ;
+VAR
+   i: node ;
+BEGIN
+   WHILE c>0 DO
+      t := makeArray (pop (), t) ;
+      DEC (c)
+   END ;
+   RETURN t
+END makeIndexedArray ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE importInto (m: node; name: Name; current: node) ;
+VAR
+   s, o: node ;
+BEGIN
+   assert (isDef (m)) ;
+   assert (isDef (current) OR isModule (current) OR isImp (current)) ;
+   s := lookupExported (m, name) ;
+   IF s=NIL
+   THEN
+      metaError2 ('{%1k} was not exported from definition module {%2a}', name, m)
+   ELSE
+      o := import (current, s) ;
+      IF s#o
+      THEN
+         metaError2 ('{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}',
+                     s, o)
+      END
+   END
+END importInto ;
+
+
+(*
+   checkEndName - if module does not have, name, then issue an error containing, desc.
+*)
+
+PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+BEGIN
+   IF getSymName (module)#name
+   THEN
+      s := InitString ('inconsistent module name found with this ') ;
+      s := ConCat (s, Mark (InitString (desc))) ;
+      ErrorString (s)
+   END
+END checkEndName ;
+
+% declaration mcp5 begin
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (*
+      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 NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      getToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	   ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+           ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   THEN
+      SyntaxError (stopset0, stopset1, stopset2)
+   END
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   str: String ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      s0 := SetOfStop0{t}
+   ELSIF ORD(t)<64
+   THEN
+      s1 := SetOfStop1{t}
+   ELSE
+      s2 := SetOfStop2{t}
+   END ;
+   str := DescribeStop (s0, s1, s2) ;
+
+   str := ConCat (InitString ('syntax error,'), Mark (str)) ;
+   errorStringAt (str, getTokenNo ())
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+   WarnMissingToken (t) ;
+   IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
+   THEN
+      IF Debugging
+      THEN
+         printf0 ('inserting token\n')
+      END ;
+      insertToken (t)
+   END
+END MissingToken ;
+
+
+(*
+   CheckAndInsert -
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      WarnMissingToken (t) ;
+      insertTokenAndRewind (t) ;
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END CheckAndInsert ;
+
+
+(*
+   InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   IF ((ORD(t)<32) AND (t IN stopset0)) OR
+      ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
+      ((ORD(t)>=64) AND (t IN stopset2))
+   THEN
+      RETURN( TRUE )
+   ELSE
+      RETURN( FALSE )
+   END
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   (* and again (see above re: ORD)
+    *)
+   IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+     	    ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
+      (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
+   THEN
+      (* 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(semicolontok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
+         CheckAndInsert(commatok, stopset0, stopset1, stopset2)
+      THEN
+      END
+   END
+END PeepToken ;
+
+
+(*
+   Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=t
+   THEN
+      getToken ;
+      IF Pass1
+      THEN
+         PeepToken(stopset0, stopset1, stopset2)
+      END
+   ELSE
+      MissingToken(t)
+   END ;
+   SyntaxCheck(stopset0, stopset1, stopset2)
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   stk := mcStack.init () ;
+   withStk := mcStack.init () ;
+   stmtStk := mcStack.init () ;
+   loopStk := mcStack.init () ;
+   loopNo := 0 ;
+   WasNoError := TRUE ;
+   FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
+   mcStack.kill (stk) ;
+   mcStack.kill (withStk) ;
+   mcStack.kill (stmtStk) ;
+   mcStack.kill (loopStk) ;
+   RETURN WasNoError
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   curident := makekey (currentstring) ;
+   Expect(identtok, stopset0, stopset1, stopset2)
+END Ident ;
+
+
+(*
+   string -
+*)
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   curstring := makekey (currentstring) ;
+   Expect(stringtok, stopset0, stopset1, stopset2)
+END string ;
+
+
+(*
+   Integer -
+*)
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+VAR
+   n: node ;
+BEGIN
+   n := push (makeLiteralInt (makekey (currentstring))) ;
+   Expect(integertok, stopset0, stopset1, stopset2)
+END Integer ;
+
+
+(*
+   Real -
+*)
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+VAR
+   n: node ;
+BEGIN
+   n := push (makeLiteralReal (makekey (currentstring))) ;
+   Expect(realtok, stopset0, stopset1, stopset2)
+END Real ;
+
+% module mcp5 end
+END mcp5.
+% rules
+error       'ErrorArray' 'ErrorString'
+tokenfunc   'currenttoken'
+
+token   ''                eoftok      -- internal token
+token   '+'               plustok
+token   '-'               minustok
+token   '*'               timestok
+token   '/'               dividetok
+token   ':='              becomestok
+token   '&'               ambersandtok
+token   "."               periodtok
+token   ","               commatok
+token   ";"               semicolontok
+token   '('               lparatok
+token   ')'               rparatok
+token   '['               lsbratok   -- left  square brackets
+token   ']'               rsbratok   -- right square brackets
+token   '{'               lcbratok   -- left  curly brackets
+token   '}'               rcbratok   -- right curly brackets
+token   '^'               uparrowtok
+token   "'"               singlequotetok
+token   '='               equaltok
+token   '#'               hashtok
+token   '<'               lesstok
+token   '>'               greatertok
+token   '<>'              lessgreatertok
+token   '<='              lessequaltok
+token   '>='              greaterequaltok
+token   '<*'              ldirectivetok
+token   '*>'              rdirectivetok
+token   '..'              periodperiodtok
+token   ':'               colontok
+token   '"'               doublequotestok
+token   '|'               bartok
+token   'AND'             andtok
+token   'ARRAY'           arraytok
+token   'BEGIN'           begintok
+token   'BY'              bytok
+token   'CASE'            casetok
+token   'CONST'           consttok
+token   'DEFINITION'      definitiontok
+token   'DIV'             divtok
+token   'DO'              dotok
+token   'ELSE'            elsetok
+token   'ELSIF'           elsiftok
+token   'END'             endtok
+token   'EXCEPT'          excepttok
+token   'EXIT'            exittok
+token   'EXPORT'          exporttok
+token   'FINALLY'         finallytok
+token   'FOR'             fortok
+token   'FROM'            fromtok
+token   'IF'              iftok
+token   'IMPLEMENTATION'  implementationtok
+token   'IMPORT'          importtok
+token   'IN'              intok
+token   'LOOP'            looptok
+token   'MOD'             modtok
+token   'MODULE'          moduletok
+token   'NOT'             nottok
+token   'OF'              oftok
+token   'OR'              ortok
+token   'PACKEDSET'       packedsettok
+token   'POINTER'         pointertok
+token   'PROCEDURE'       proceduretok
+token   'QUALIFIED'       qualifiedtok
+token   'UNQUALIFIED'     unqualifiedtok
+token   'RECORD'          recordtok
+token   'REM'             remtok
+token   'REPEAT'          repeattok
+token   'RETRY'           retrytok
+token   'RETURN'          returntok
+token   'SET'             settok
+token   'THEN'            thentok
+token   'TO'              totok
+token   'TYPE'            typetok
+token   'UNTIL'           untiltok
+token   'VAR'             vartok
+token   'WHILE'           whiletok
+token   'WITH'            withtok
+token   'ASM'             asmtok
+token   'VOLATILE'        volatiletok
+token   '...'             periodperiodperiodtok
+token   '__DATE__'        datetok
+token   '__LINE__'        linetok
+token   '__FILE__'        filetok
+token   '__ATTRIBUTE__'   attributetok
+token   '__BUILTIN__'     builtintok
+token   '__INLINE__'      inlinetok
+token   'integer number'  integertok
+token   'identifier'      identtok
+token   'real number'     realtok
+token   'string'          stringtok
+
+special Ident             first { < identtok > } follow { }
+special Integer           first { < integertok > } follow { }
+special Real              first { < realtok > } follow { }
+special string            first { < stringtok > } follow { }
+
+BNF
+
+-- the following are provided by the module m2flex and also handbuild procedures below
+-- Ident := Letter { ( Letter | Digit ) } =:
+-- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
+--           Digit { HexDigit } " H " =:
+-- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
+-- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
+-- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
+-- Digit := OctalDigit | " 8 " | " 9 " =:
+-- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
+-- String
+
+FileUnit := DefinitionModule | ImplementationOrProgramModule
+          =:
+
+ProgramModule := "MODULE"
+                  Ident                                                % curmodule := lookupModule (curident) %
+                                                                       % addCommentBody (curmodule) %
+		                                                       % enterScope (curmodule) %
+								       % resetConstExpPos (curmodule) %
+                  [ Priority ] ";"
+                  { Import }
+                  Block
+                  Ident                                                % checkEndName (curmodule, curident, 'program module') %
+		                                                       % leaveScope %
+
+                  "."
+                  =:
+
+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 %
+                         "."
+                      =:
+
+ImplementationOrProgramModule := ImplementationModule | ProgramModule =:
+
+ConstInteger := Integer                                                % VAR i: node ; %
+                                                                       % i := pop () %
+	      =:
+
+ConstReal := Real                                                      % VAR r: node ; %
+                                                                       % r := pop () %
+	      =:
+
+ConstNumber := ConstInteger | ConstReal =:
+
+Number := Integer | Real =:
+
+Qualident := Ident { "." Ident } =:
+
+ConstantDeclaration := Ident "=" ConstExpressionNop =:
+
+ConstExpressionNop :=                                                  % VAR c: node ; %
+                                                                       % c := getNextConstExp () %
+                      SimpleConstExpr [ Relation SimpleConstExpr ] =:
+
+ConstExpression :=                                                     % VAR c: node ; %
+                                                                       % c := push (getNextConstExp ()) %
+                   SimpleConstExpr [ Relation SimpleConstExpr ] =:
+
+Relation := "="
+            | "#"
+            | "<>"
+            | "<"
+            | "<="
+            | ">"
+            | ">="
+            | "IN"
+         =:
+
+SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
+
+UnaryOrConstTerm :=
+                    "+"
+                    ConstTerm
+                    |
+                    "-"
+                    ConstTerm
+                    |
+                    ConstTerm
+		  =:
+
+AddOperator :=   "+"
+               | "-"
+               | "OR"
+             =:
+
+ConstTerm := ConstFactor { MulOperator ConstFactor } =:
+
+MulOperator := "*"
+               | "/"
+               | "DIV"
+               | "MOD"
+               | "REM"
+               | "AND"
+               | "&"
+            =:
+
+NotConstFactor := "NOT" ConstFactor                                     % VAR n: node ; %
+                                                                        % n := push (makeUnaryTok (nottok, pop ())) %
+                =:
+
+ConstFactor := ConstNumber | ConstString | ConstSetOrQualidentOrFunction |
+               "(" ConstExpressionNop ")" | NotConstFactor
+               | ConstAttribute =:
+
+-- to help satisfy LL1
+
+ConstString := string =:
+
+ConstComponentElement := ConstExpressionNop [ ".." ConstExpressionNop ]
+                  =:
+
+ConstComponentValue := ConstComponentElement [ 'BY' ConstExpressionNop ]
+                     =:
+
+ConstArraySetRecordValue := ConstComponentValue { ',' ConstComponentValue }
+                          =:
+
+ConstConstructor := '{'
+                       [ ConstArraySetRecordValue ]
+                    '}' =:
+
+ConstSetOrQualidentOrFunction := Qualident
+                                 [ ConstConstructor | ConstActualParameters ]
+                                   |
+                                     ConstConstructor =:
+
+ConstActualParameters := "(" [ ConstExpList ] ")" =:
+
+ConstExpList := ConstExpressionNop { "," ConstExpressionNop }
+              =:
+
+ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("
+                  ConstAttributeExpression
+                  ")" ")" =:
+
+ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =:
+
+ByteAlignment := '<*' AttributeExpression '*>'
+               =:
+
+OptAlignmentExpression := [ AlignmentExpression ] =:
+
+AlignmentExpression := "(" ConstExpressionNop ")" =:
+
+Alignment := [ ByteAlignment ] =:
+
+IdentList := Ident { "," Ident }
+           =:
+
+SubrangeType := "[" ConstExpressionNop ".." ConstExpressionNop "]" =:
+
+ArrayType := "ARRAY" SimpleType { "," SimpleType } "OF" Type =:
+
+RecordType := "RECORD" [ DefaultRecordAttributes ]
+		       FieldListSequence
+	      "END" =:
+
+DefaultRecordAttributes := '<*' AttributeExpression '*>' =:
+
+RecordFieldPragma := [ '<*' FieldPragmaExpression
+                            { ',' FieldPragmaExpression } '*>' ] =:
+
+FieldPragmaExpression := Ident PragmaConstExpression =:
+
+PragmaConstExpression := [ '(' ConstExpressionNop ')' ] =:
+
+AttributeExpression := Ident '(' ConstExpressionNop ')' =:
+
+FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
+
+FieldListStatement := [ FieldList ] =:
+
+FieldList := IdentList ":" Type RecordFieldPragma
+             | "CASE" CaseTag "OF" Varient { "|" Varient }
+              [ "ELSE"
+                      FieldListSequence
+              ] "END"
+           =:
+
+TagIdent :=  Ident |                                                    % curident := NulName %
+          =:
+
+CaseTag := TagIdent [ ":" Qualident ]
+         =:
+
+Varient :=  [ VarientCaseLabelList ":" FieldListSequence ] =:
+
+VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
+
+VarientCaseLabels := ConstExpressionNop [ ".." ConstExpressionNop ]
+                   =:
+
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+
+PointerType := "POINTER" "TO" Type =:
+
+ProcedureType := "PROCEDURE" [ FormalTypeList ] =:
+
+FormalTypeList := "(" ( ")" FormalReturn |
+                        ProcedureParameters ")" FormalReturn ) =:
+
+FormalReturn := [ ":" OptReturnType ] =:
+
+OptReturnType := "[" Qualident "]" | Qualident
+	       =:
+
+ProcedureParameters := ProcedureParameter
+                       { "," ProcedureParameter } =:
+
+ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
+
+
+VarIdent := Ident [ "[" ConstExpressionNop "]" ]
+          =:
+
+VarIdentList := VarIdent { "," VarIdent }  =:
+
+VariableDeclaration :=  VarIdentList ":" Type Alignment
+                     =:
+
+Designator := PushQualident { SubDesignator } =:
+
+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
+                 )
+               =:
+
+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 %
+                                      )
+            =:
+
+
+
+ArrayExpList :=                                                         % VAR l: node ; %
+                                                                        % l := push (makeExpList ()) %
+                Expression                                              % putExpList (l, pop ()) %
+                                                                        % assert (isExpList (peep ())) %
+                { ","
+                   Expression                                           % putExpList (l, pop ()) %
+                                                                        % assert (isExpList (peep ())) %
+                }
+              =:
+
+ExpList :=                                                              % VAR p, n: node ; %
+                                                                        % p := peep () %
+									% assert (isExpList (p)) %
+                Expression                                              % putExpList (p, pop ()) %
+                                                                        % assert (isExpList (peep ())) %
+                           { "," Expression                             % putExpList (p, pop ()) %
+                                                                        % assert (isExpList (peep ())) %
+			                    }
+         =:
+
+
+Expression :=                                                           % VAR c, l, r: node ; op: toktype ; %
+              SimpleExpression                                          % op := currenttoken %
+	                       [ Relation                               % l := pop () %
+			                  SimpleExpression              % r := pop () %
+					                                % r := push (makeBinaryTok (op, l, r)) %
+					                   ]
+           =:
+
+SimpleExpression :=                                                     % VAR op: toktype ; n: node ; %
+                    UnaryOrTerm {                                       % op := currenttoken %
+		                                                        % n := pop () %
+				  AddOperator Term                      % n := push (makeBinaryTok (op, n, pop ())) %
+					           }
+						     =:
+
+UnaryOrTerm :=                                                          % VAR n: node ; %
+               "+" Term                                                 % n := push (makeUnaryTok (plustok, pop ())) %
+               | "-" Term                                               % n := push (makeUnaryTok (minustok, pop ())) %
+               | Term
+	     =:
+
+Term :=                                                                 % VAR op: toktype ; n: node ; %
+        Factor {                                                        % op := currenttoken %
+	         MulOperator                                            % n := pop () %
+		             Factor                                     % n := push (makeBinaryTok (op, n, pop ())) %
+                                    } =:
+
+PushString := string                                                    % VAR n: node ; %
+                                                                        % n := push (makeString (curstring)) %
+            =:
+
+Factor := Number | PushString | SetOrDesignatorOrFunction |
+          "(" Expression ")" | "NOT" ( Factor                           % VAR n: node ; %
+                                                                        % n := push (makeUnaryTok (nottok, pop ())) %
+          | ConstAttribute
+                                                                        % n := push (makeUnaryTok (nottok, pop ())) %
+                                ) =:
+
+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)) %
+                       =:
+
+ComponentValue := ComponentElement [ 'BY'                               % ErrorArray ('implementation restriction BY not allowed') %
+                                          Expression ]
+                =:
+
+ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+                     =:
+
+Constructor := '{'                                                      % VAR n: node ; %
+                                                                        % n := push (makeSetValue ()) %
+                        [ ArraySetRecordValue ]
+               '}' =:
+
+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 =:
+
+-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
+SimpleDes := { SubDesignator } =:
+
+ActualParameters := "("                                                  % VAR n: node ; %
+                                                                         % n := push (makeExpList ()) %
+                        [ ExpList ] ")"                                  % assert (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 %
+               =:
+
+ReturnStatement :=                                                       % VAR n: node ; %
+                                                                         % n := pushStmt (makeReturn ()) %
+                   "RETURN" [ Expression                                 % putReturn (n, pop ()) %
+		                         ]                               % addCommentBody (peepStmt ()) %
+                                                                         % addCommentAfter (peepStmt ()) %
+					                                 % assert (isReturn (peepStmt ())) %
+                 =:
+
+Statement := ( AssignmentOrProcedureCall | IfStatement | CaseStatement |
+               WhileStatement | RepeatStatement | LoopStatement |
+               ForStatement | WithStatement | AsmStatement |
+               ExitStatement | ReturnStatement | RetryStatement |        % VAR s: node ; %
+                                                                         % s := pushStmt (NIL) %
+             )
+           =:
+
+RetryStatement :=                                                        % VAR s: node ; %
+                                                                         % s := pushStmt (makeComment ("retry")) %
+                  "RETRY"
+                =:
+
+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 ()) %
+                           =:
+
+-- these two break LL1 as both start with a Designator
+-- ProcedureCall := Designator [ ActualParameters ] =:
+-- Assignment := Designator ":=" Expression =:
+
+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 ())) %
+				               }
+                  =:
+
+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) %
+            =:
+
+CaseStatement :=                                                         % VAR s, e: node ; %
+                                                                         % s := pushStmt (makeCase ()) %
+                 "CASE"
+                        Expression                                       % s := putCaseExpression (s, pop ()) %
+                                   "OF" Case { "|" Case }
+                 CaseEndStatement
+               =:
+
+CaseEndStatement :=                                                      % VAR c: node ; %
+                    "END"
+                      | "ELSE"
+                                                                         % c := peepStmt () %
+                             StatementSequence                           % c := putCaseElse (c, popStmt ()) %
+                                               "END"
+                 =:
+
+Case := [ CaseLabelList ":"                                              % VAR l, c: node ; %
+                                                                         % l := pop () %
+									 % c := peepStmt () %
+                            StatementSequence                            % c := putCaseStatement (c, l, popStmt ()) %
+			                      ]
+      =:
+
+CaseLabelList :=                                                         % VAR l: node ; %
+                                                                         % l := push (makeCaseList ()) %
+                 CaseLabels { "," CaseLabels } =:
+
+CaseLabels :=                                                            % VAR lo, hi, l: node ; %
+                                                                         % lo := NIL ; hi := NIL %
+									 % l := peep () %
+              ConstExpression                                            % lo := pop () %
+	                      [ ".." ConstExpression                     % hi := pop () %
+			                             ]                   % l := 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) %
+                =:
+
+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) %
+                 =:
+
+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"
+              =:
+
+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 ())) %
+               =:
+
+WithStatement := "WITH" Designator "DO"                                  % startWith (pop ()) %
+                     StatementSequence
+                 "END"                                                   % endWith %
+               =:
+
+ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock
+                        Ident                                            % leaveScope %
+                      =:
+
+ProcedureIdent := Ident                                                  % curproc := lookupSym (curident) %
+                                                                         % enterScope (curproc) %
+                                                                         % setProcedureComment (lastcomment, curident) %
+
+                =:
+
+DefProcedureIdent := Ident                                               % curproc := lookupSym (curident) %
+                   =:
+
+DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ]
+                      =:
+
+ProcedureHeading := "PROCEDURE" DefineBuiltinProcedure ( ProcedureIdent
+                                                         [ FormalParameters ]
+                                                         AttributeNoReturn )
+                  =:
+
+Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
+
+DefProcedureHeading := "PROCEDURE" Builtin ( DefProcedureIdent
+                                             [ DefFormalParameters ]
+                                             AttributeNoReturn )
+                     =:
+
+-- introduced procedure block so we can produce more informative
+-- error messages
+
+ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END"
+                =:
+
+Block := { Declaration } InitialBlock FinalBlock "END"
+       =:
+
+InitialBlock := [ "BEGIN" InitialBlockBody ] =:
+
+FinalBlock := [ "FINALLY" FinalBlockBody ] =:
+
+InitialBlockBody := NormalPart                                         % putBegin (curmodule, popStmt ()) %
+                               [ "EXCEPT" ExceptionalPart ] =:
+
+FinalBlockBody := NormalPart                                           % putFinally (curmodule, popStmt ()) %
+                             [ "EXCEPT" ExceptionalPart ] =:
+
+ProcedureBlockBody := ProcedureNormalPart
+                      [ "EXCEPT" ExceptionalPart ] =:
+
+ProcedureNormalPart := StatementSequence                               % putBegin (curproc, popStmt ()) %
+                     =:
+
+NormalPart := StatementSequence
+            =:
+
+ExceptionalPart := StatementSequence
+                 =:
+
+Declaration := "CONST" { ConstantDeclaration ";" } |
+               "TYPE" { TypeDeclaration } |
+               "VAR" { VariableDeclaration ";" } |
+               ProcedureDeclaration ";" |
+               ModuleDeclaration ";" =:
+
+DefFormalParameters := "("                                             % paramEnter (curproc) %
+                           [ DefMultiFPSection ] ")"                   % paramLeave (curproc) %
+			                             FormalReturn =:
+
+AttributeNoReturn := [ "<*" Ident "*>" ] =:
+
+AttributeUnused := [ "<*" Ident "*>" ] =:
+
+DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =:
+
+FormalParameters := "("                                                % paramEnter (curproc) %
+                        [ MultiFPSection ] ")"                         % paramLeave (curproc) %
+			                       FormalReturn =:
+
+MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =:
+
+FPSection := NonVarFPSection | VarFPSection =:
+
+DefExtendedFP := DefOptArg | "..." =:
+
+ExtendedFP := OptArg | "..." =:
+
+VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ]
+              =:
+
+NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ]
+                 =:
+
+OptArg := "[" Ident ":" FormalType [ "=" ConstExpressionNop ] "]" =:
+
+DefOptArg := "[" Ident ":" FormalType "=" ConstExpressionNop "]" =:
+
+FormalType := { "ARRAY" "OF" } Qualident =:
+
+ModuleDeclaration := "MODULE" Ident [ Priority ] ";"
+                        { Import } [ Export ]
+                        Block Ident
+                   =:
+
+Priority := "[" ConstExpressionNop "]" =:
+
+Export := "EXPORT" ( "QUALIFIED"
+                                 IdentList |
+                     "UNQUALIFIED"
+                                 IdentList |
+                     IdentList ) ";" =:
+
+FromIdentList := Ident { "," Ident } =:
+
+FromImport := "FROM" Ident "IMPORT" FromIdentList ";"
+            =:
+
+ImportModuleList := Ident { "," Ident } =:
+
+WithoutFromImport := "IMPORT" ImportModuleList ";"
+                   =:
+
+Import := FromImport | WithoutFromImport =:
+
+DefinitionModule := "DEFINITION" "MODULE" [ "FOR" string ] Ident ";"    % curmodule := lookupDef (curident) %
+     		                                                        % enterScope (curmodule) %
+                      { Import } [ Export ]
+                      { Definition }
+                    "END" Ident "."                                     % checkEndName (curmodule, curident, 'definition module') %
+                                                                        % 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 %
+			          ]
+              =:
+
+OptSubrange := [ SubrangeType ]  =:
+
+TypeEquiv := Qualident OptSubrange =:
+
+EnumIdentList := Ident { "," Ident } =:
+
+Enumeration := "(" EnumIdentList ")" =:
+
+SimpleType := TypeEquiv | Enumeration | SubrangeType =:
+
+Type := SimpleType | ArrayType | RecordType | SetType |
+        PointerType | ProcedureType
+      =:
+
+TypeDeclaration := { Ident ( ";" | "=" Type    Alignment ";" ) }
+		    =:
+
+Definition := "CONST" { ConstantDeclaration ";" } |
+              "TYPE" { TypeDeclaration } |
+              "VAR" { VariableDeclaration ";" } |
+              DefProcedureHeading ";" =:
+
+AsmStatement :=                                                      % VAR s: node ; %
+                                                                     % s := pushStmt (makeComment ("asm")) %
+                'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
+
+AsmOperands := string [ AsmOperandSpec ]
+             =:
+
+AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
+                =:
+
+AsmList := [ AsmElement ] { ',' AsmElement } =:
+
+NamedOperand := '[' Ident ']' =:
+
+AsmOperandName := [ NamedOperand ]
+                =:
+
+AsmElement := AsmOperandName string '(' Expression ')'
+            =:
+
+TrashList := [ string ] { ',' string } =:
+
+FNB
diff --git a/gcc/m2/mc/mcp5.def b/gcc/m2/mc/mcp5.def
new file mode 100644
index 00000000000..462cfd5869d
--- /dev/null
+++ b/gcc/m2/mc/mcp5.def
@@ -0,0 +1,33 @@
+(* mcp5.def provides an interface to the pass 5 parser.
+
+Copyright (C) 2016-2022 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/>.  *)
+
+DEFINITION MODULE mcp5 ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+
+
+END mcp5.
diff --git a/gcc/m2/mc/nameKey.def b/gcc/m2/mc/nameKey.def
new file mode 100644
index 00000000000..87cd4f0f0c3
--- /dev/null
+++ b/gcc/m2/mc/nameKey.def
@@ -0,0 +1,101 @@
+(* nameKey.def provides a dynamic binary tree name to key.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE nameKey ;
+
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+CONST
+   NulName = 0 ;  (* No legal name.                      *)
+                  (* NulName is not present in the Tree  *)
+
+TYPE
+   Name = CARDINAL ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE makeKey (a: ARRAY OF CHAR) : Name ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE makekey (a: ADDRESS) : Name ;
+
+
+(*
+   getKey - returns the name, a, of the key, key.
+*)
+
+PROCEDURE getKey (key: Name; VAR a: ARRAY OF CHAR) ;
+
+
+(*
+   lengthKey - returns the length of a Key.
+*)
+
+PROCEDURE lengthKey (key: Name) : CARDINAL ;
+
+
+(*
+   isKey - returns TRUE if string, a, is currently a key.
+*)
+
+PROCEDURE isKey (a: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   writeKey - Display the symbol represented by Key.
+*)
+
+PROCEDURE writeKey (key: Name) ;
+
+
+(*
+   isSameExcludingCase - returns TRUE if key1 and key2 are
+                         the same. It is case insensitive.
+*)
+
+PROCEDURE isSameExcludingCase (key1, key2: Name) : BOOLEAN ;
+
+
+(*
+   keyToCharStar - returns the C char * string equivalent for, key.
+*)
+
+PROCEDURE keyToCharStar (key: Name) : ADDRESS ;
+
+
+END nameKey.
diff --git a/gcc/m2/mc/nameKey.mod b/gcc/m2/mc/nameKey.mod
new file mode 100644
index 00000000000..13762a8ab5d
--- /dev/null
+++ b/gcc/m2/mc/nameKey.mod
@@ -0,0 +1,398 @@
+(* nameKey.mod provides a dynamic binary tree name to key.
+
+Copyright (C) 2015-2022 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 nameKey ;
+
+
+FROM SYSTEM IMPORT ADR ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, InBounds ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StdIO IMPORT Write ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrLib IMPORT StrLen ;
+FROM libc IMPORT strlen ;
+FROM ASCII IMPORT nul ;
+
+
+TYPE
+   ptrToChar  = POINTER TO CHAR ;
+
+   nameNode   = POINTER TO RECORD
+                   data : ptrToChar ;
+                   key  : Name ;
+                   left,
+                   right: nameNode ;
+                END ;
+
+   comparison = (less, equal, greater) ;
+
+VAR
+   binaryTree: nameNode ;
+   keyIndex  : Index ;
+   lastIndice: CARDINAL ;
+
+
+(*
+   getKey - returns the name, a, of the key, Key.
+*)
+
+PROCEDURE getKey (key: Name; VAR a: ARRAY OF CHAR) ;
+VAR
+   p       : ptrToChar ;
+   i, higha: CARDINAL ;
+BEGIN
+   p := keyToCharStar (key) ;
+   i := 0 ;
+   higha := HIGH (a) ;
+   WHILE (p#NIL) AND (i<=higha) AND (p^#nul) DO
+      a[i] := p^ ;
+      INC (p) ;
+      INC (i)
+   END ;
+   IF i<=higha
+   THEN
+      a[i] := nul
+   END
+END getKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE isKey (a: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   child : nameNode ;
+   p     : ptrToChar ;
+   i,
+   higha : CARDINAL ;
+BEGIN
+   (* firstly set up the initial values of child, using sentinal node *)
+   child := binaryTree^.left ;
+   IF child#NIL
+   THEN
+      REPEAT
+         i := 0 ;
+         higha := HIGH (a) ;
+         p := keyToCharStar (child^.key) ;
+         WHILE (i<=higha) AND (a[i]#nul) DO
+            IF a[i]<p^
+            THEN
+               child := child^.left ;
+               i := higha
+            ELSIF a[i]>p^
+            THEN
+               child := child^.right ;
+               i := higha
+            ELSE
+               IF (a[i]=nul) OR (i=higha)
+               THEN
+                  IF p^=nul
+                  THEN
+                     RETURN TRUE
+                  ELSE
+                     child := child^.left
+                  END
+               END ;
+               INC (p)
+            END ;
+            INC (i)
+         END ;
+      UNTIL child=NIL
+   END ;
+   RETURN FALSE
+END isKey ;
+
+
+(*
+   doMakeKey - finds the name, n, in the tree or else create a name.
+               If a name is found then the string, n, is deallocated.
+*)
+
+PROCEDURE doMakeKey (n: ptrToChar; higha: CARDINAL) : Name ;
+VAR
+   result: comparison ;
+   father,
+   child : nameNode ;
+   k     : Name ;
+BEGIN
+   result := findNodeAndParentInTree (n, child, father) ;
+   IF child=NIL
+   THEN
+      IF result=less
+      THEN
+         NEW (child) ;
+         father^.left := child
+      ELSIF result=greater
+      THEN
+         NEW (child) ;
+         father^.right := child
+      END ;
+      WITH child^ DO
+         right := NIL ;
+         left := NIL ;
+         INC (lastIndice) ;
+         key := lastIndice ;
+         data := n ;
+         PutIndice (keyIndex, key, n)
+      END ;
+      k := lastIndice
+   ELSE
+      DEALLOCATE (n, higha+1) ;
+      k := child^.key
+   END ;
+   RETURN k
+END doMakeKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE makeKey (a: ARRAY OF CHAR) : Name ;
+VAR
+   n, p  : ptrToChar ;
+   i,
+   higha : CARDINAL ;
+BEGIN
+   higha := StrLen(a) ;
+   ALLOCATE (p, higha+1) ;
+   IF p=NIL
+   THEN
+      HALT      (* out of memory error *)
+   ELSE
+      n := p ;
+      i := 0 ;
+      WHILE i<higha DO
+         p^ := a[i] ;
+         INC(i) ;
+         INC(p)
+      END ;
+      p^ := nul ;
+
+      RETURN doMakeKey (n, higha)
+   END
+END makeKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE makekey (a: ADDRESS) : Name ;
+VAR
+   n,
+   p, pa : ptrToChar ;
+   i,
+   higha : CARDINAL ;
+BEGIN
+   IF a=NIL
+   THEN
+      RETURN NulName
+   ELSE
+      higha := strlen (a) ;
+      ALLOCATE (p, higha+1) ;
+      IF p=NIL
+      THEN
+         HALT      (* out of memory error *)
+      ELSE
+         n  := p ;
+         pa := a ;
+         i  := 0 ;
+         WHILE i<higha DO
+            p^ := pa^ ;
+            INC (i) ;
+            INC (p) ;
+            INC (pa)
+         END ;
+         p^ := nul ;
+
+         RETURN doMakeKey (n, higha)
+      END
+   END
+END makekey ;
+
+
+(*
+   lengthKey - returns the StrLen of Key.
+*)
+
+PROCEDURE lengthKey (key: Name) : CARDINAL ;
+VAR
+   i: CARDINAL ;
+   p: ptrToChar ;
+BEGIN
+   p := keyToCharStar (key) ;
+   i := 0 ;
+   WHILE p^#nul DO
+      INC (i) ;
+      INC (p)
+   END ;
+   RETURN i
+END lengthKey ;
+
+
+(*
+   compare - return the result of Names[i] with Names[j]
+*)
+
+PROCEDURE compare (pi: ptrToChar; j: Name) : comparison ;
+VAR
+   pj: ptrToChar ;
+   c1, c2: CHAR ;
+BEGIN
+   pj := keyToCharStar(j) ;
+   c1 := pi^ ;
+   c2 := pj^ ;
+   WHILE (c1#nul) OR (c2#nul) DO
+      IF c1<c2
+      THEN
+         RETURN less
+      ELSIF c1>c2
+      THEN
+         RETURN greater
+      ELSE
+         INC (pi) ;
+         INC (pj) ;
+         c1 := pi^ ;
+         c2 := pj^
+      END
+   END ;
+   RETURN equal
+END compare ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findNodeAndParentInTree (n: ptrToChar; VAR child, father: nameNode) : comparison ;
+VAR
+   result: comparison ;
+BEGIN
+   (* firstly set up the initial values of child and father, using sentinal node *)
+   father := binaryTree ;
+   child := binaryTree^.left ;
+   IF child=NIL
+   THEN
+      RETURN less
+   ELSE
+      REPEAT
+         result := compare (n, child^.key) ;
+         IF result=less
+         THEN
+            father := child ;
+            child := child^.left
+         ELSIF result=greater
+         THEN
+            father := child ;
+            child := child^.right
+         END
+      UNTIL (child=NIL) OR (result=equal) ;
+      RETURN result
+   END
+END findNodeAndParentInTree ;
+
+
+(*
+   isSameExcludingCase - returns TRUE if key1 and key2 are
+                         the same. It is case insensitive.
+                         This function deliberately inlines CAP for speed.
+*)
+
+PROCEDURE isSameExcludingCase (key1, key2: Name) : BOOLEAN ;
+VAR
+   pi, pj: ptrToChar ;
+   c1, c2: CHAR ;
+BEGIN
+   IF key1=key2
+   THEN
+      RETURN TRUE
+   ELSE
+      pi := keyToCharStar(key1) ;
+      pj := keyToCharStar(key2) ;
+      c1 := pi^ ;
+      c2 := pj^ ;
+      WHILE (c1#nul) AND (c2#nul) DO
+         IF (c1=c2) OR
+            (((c1>='A') AND (c1<='Z')) AND (c2=CHR(ORD(c1)-ORD('A')+ORD('a')))) OR
+            (((c2>='A') AND (c2<='Z')) AND (c1=CHR(ORD(c2)-ORD('A')+ORD('a'))))
+         THEN
+            INC (pi) ;
+            INC (pj) ;
+            c1 := pi^ ;
+            c2 := pj^
+         ELSE
+            (* difference found *)
+            RETURN FALSE
+         END
+      END ;
+      RETURN c1=c2
+   END
+END isSameExcludingCase ;
+
+
+(*
+   keyToCharStar - returns the C char * string equivalent for, key.
+*)
+
+PROCEDURE keyToCharStar (key: Name) : ADDRESS ;
+BEGIN
+   IF (key=NulName) OR (NOT InBounds (keyIndex, key))
+   THEN
+      RETURN NIL
+   ELSE
+      RETURN GetIndice (keyIndex, key)
+   END
+END keyToCharStar ;
+
+
+PROCEDURE writeKey (key: Name) ;
+VAR
+   s: ptrToChar ;
+BEGIN
+   s := keyToCharStar (key) ;
+   WHILE (s#NIL) AND (s^#nul) DO
+      Write (s^) ;
+      INC (s)
+   END
+END writeKey ;
+
+
+BEGIN
+   lastIndice := 0 ;
+   keyIndex := InitIndex(1) ;
+   NEW (binaryTree) ;
+   binaryTree^.left := NIL
+END nameKey.
diff --git a/gcc/m2/mc/symbolKey.def b/gcc/m2/mc/symbolKey.def
new file mode 100644
index 00000000000..62c32de37af
--- /dev/null
+++ b/gcc/m2/mc/symbolKey.def
@@ -0,0 +1,104 @@
+(* symbolKey.def provides binary tree operations for storing symbols.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE symbolKey ;
+
+(* Provides binary tree operations for storing symbols.
+   Used by the decl module to provide scoping of symbols.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM nameKey IMPORT Name ;
+
+
+CONST
+   NulKey = NIL ;
+
+TYPE
+   symbolTree ;
+
+   isSymbol         = PROCEDURE (ADDRESS) : BOOLEAN ;
+   performOperation = PROCEDURE (ADDRESS) ;
+
+
+(*
+   initTree - initializes a symbolTree pointed to by t.
+*)
+
+PROCEDURE initTree () : symbolTree ;
+
+
+(*
+   killTree - destroys the symbolTree pointed to by t.
+*)
+
+PROCEDURE killTree (VAR t: symbolTree) ;
+
+
+(*
+   getSymKey - searches the symbolTree t for an entry name. If
+               found then the key is returned otherwise NulKey
+               is returned.
+*)
+
+PROCEDURE getSymKey (t: symbolTree; name: Name) : ADDRESS ;
+
+
+(*
+   putSymKey - puts an symbol entry, name, in the symbolTree t.
+               SymKey is the value stored with name.
+*)
+
+PROCEDURE putSymKey (t: symbolTree; name: Name; key: ADDRESS) ;
+
+
+(*
+   delSymKey - deletes a symbol entry name in the symbolTree, t.
+*)
+
+PROCEDURE delSymKey (t: symbolTree; name: Name) ;
+
+
+(*
+   isEmptyTree - returns true if symbolTree, t, is empty.
+*)
+
+PROCEDURE isEmptyTree (t: symbolTree) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE doesTreeContainAny (t: symbolTree; p: isSymbol) : BOOLEAN ;
+
+
+(*
+   foreachNodeDo - for each node in symbolTree, t, a procedure, p,
+                   is called with the node symbol as its parameter.
+                   It traverse the tree in order.
+*)
+
+PROCEDURE foreachNodeDo (t: symbolTree; p: performOperation) ;
+
+
+END symbolKey.
diff --git a/gcc/m2/mc/symbolKey.mod b/gcc/m2/mc/symbolKey.mod
new file mode 100644
index 00000000000..6ccc2191a25
--- /dev/null
+++ b/gcc/m2/mc/symbolKey.mod
@@ -0,0 +1,298 @@
+(* symbolKey.mod provides binary tree operations for storing symbols.
+
+Copyright (C) 2015-2022 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 symbolKey ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM Debug IMPORT Halt ;
+
+FROM nameKey IMPORT writeKey ;
+
+
+TYPE
+   symbolTree = POINTER TO RECORD
+                   name : Name ;   (* The sorted entity *)
+                   key  : ADDRESS ;   (* The value entity  *)
+                   left,
+                   right: symbolTree ;
+                END ;
+
+
+PROCEDURE initTree () : symbolTree ;
+VAR
+   t: symbolTree ;
+BEGIN
+   NEW (t) ;
+   WITH t^ DO
+      left := NIL ;
+      right := NIL
+   END ;
+   RETURN t
+END initTree ;
+
+
+PROCEDURE killTree (VAR t: symbolTree) ;
+BEGIN
+   IF t#NIL
+   THEN
+      killTree (t^.left) ;
+      killTree (t^.right) ;
+      DISPOSE (t) ;
+      t := NIL
+   END
+END killTree ;
+
+
+PROCEDURE getSymKey (t: symbolTree; name: Name) : ADDRESS ;
+VAR
+   father,
+   child : symbolTree ;
+BEGIN
+   IF t=NIL
+   THEN
+      RETURN NulKey
+   ELSE
+      findNodeAndParentInTree (t, name, child, father) ;
+      IF child=NIL
+      THEN
+         RETURN NulKey
+      ELSE
+         RETURN child^.key
+      END
+   END
+END getSymKey ;
+
+
+PROCEDURE putSymKey (t: symbolTree; name: Name; key: ADDRESS) ;
+VAR
+   father,
+   child : symbolTree ;
+BEGIN
+   findNodeAndParentInTree (t, name, child, father) ;
+   IF child=NIL
+   THEN
+      (* no child found, now is name less than father or greater? *)
+      IF father=t
+      THEN
+         (* empty tree, add it to the left branch of t *)
+         NEW(child) ;
+         father^.left := child
+      ELSE
+         IF name<father^.name
+         THEN
+            NEW (child) ;
+            father^.left := child
+         ELSIF name>father^.name
+         THEN
+            NEW (child) ;
+            father^.right := child
+         END
+      END ;
+      WITH child^ DO
+         right   := NIL ;
+         left    := NIL
+      END ;
+      child^.key  := key ;
+      child^.name := name
+   ELSE
+      Halt ('symbol already stored', __LINE__, __FILE__)
+   END
+END putSymKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE delSymKey (t: symbolTree; name: Name) ;
+VAR
+   i, child, father: symbolTree ;
+BEGIN
+   findNodeAndParentInTree (t, name, child, father) ;  (* find father and child of the node *)
+   IF (child#NIL) AND (child^.name=name)
+   THEN
+      (* Have found the node to be deleted *)
+      IF father^.right=child
+      THEN
+         (* Node is child and this is greater than the father. *)
+         (* Greater being on the right.                        *)
+         (* Connect child^.left onto the father^.right.        *)
+         (* Connect child^.right onto the end of the right     *)
+         (* most branch of child^.left.                        *)
+         IF child^.left#NIL
+         THEN
+            (* Scan for right most node of child^.left *)
+            i := child^.left ;
+            WHILE i^.right#NIL DO
+               i := i^.right
+            END ;
+            i^.right      := child^.right ;
+            father^.right := child^.left
+         ELSE
+            (* No child^.left node therefore link over child   *)
+            (* (as in a single linked list) to child^.right    *)
+            father^.right := child^.right
+         END ;
+         DISPOSE (child)
+      ELSE
+         (* Assert that father^.left=child will always be true *)
+         (* Perform exactly the mirror image of the above code *)
+
+         (* Connect child^.right onto the father^.left.        *)
+         (* Connect child^.left onto the end of the left most  *)
+         (* branch of child^.right                             *)
+         IF child^.right#NIL
+         THEN
+            (* Scan for left most node of child^.right *)
+            i := child^.right ;
+            WHILE i^.left#NIL DO
+               i := i^.left
+            END ;
+            i^.left      := child^.left ;
+            father^.left := child^.right
+         ELSE
+            (* No child^.right node therefore link over c      *)
+            (* (as in a single linked list) to child^.left.    *)
+            father^.left := child^.left
+         END ;
+         DISPOSE (child)
+      END
+   ELSE
+      Halt ('trying to delete a symbol that is not in the tree - the compiler never expects this to occur',
+            __LINE__, __FILE__)
+   END
+END delSymKey ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE findNodeAndParentInTree (t: symbolTree; n: Name;
+                                   VAR child, father: symbolTree) ;
+BEGIN
+   (* remember to skip the sentinal value and assign father and child *)
+   father := t ;
+   IF t=NIL
+   THEN
+      Halt ('parameter t should never be NIL', __LINE__, __FILE__)
+   END ;
+   child := t^.left ;
+   IF child#NIL
+   THEN
+      REPEAT
+         IF n<child^.name
+         THEN
+            father := child ;
+            child := child^.left
+         ELSIF n>child^.name
+         THEN
+            father := child ;
+            child := child^.right
+         END
+      UNTIL (child=NIL) OR (n=child^.name)
+   END
+END findNodeAndParentInTree ;
+
+
+(*
+   isEmptyTree - returns true if symbolTree, t, is empty.
+*)
+
+PROCEDURE isEmptyTree (t: symbolTree) : BOOLEAN ;
+BEGIN
+   RETURN t^.left=NIL
+END isEmptyTree ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE doesTreeContainAny (t: symbolTree; p: isSymbol) : BOOLEAN ;
+BEGIN
+   RETURN searchForAny (t^.left, p)
+END doesTreeContainAny ;
+
+
+(*
+   searchForAny - performs the search required for doesTreeContainAny.
+                  The root node always contains a nul data value,
+                  therefore we must skip over it.
+*)
+
+PROCEDURE searchForAny (t: symbolTree; p: isSymbol) : BOOLEAN ;
+BEGIN
+   IF t=NIL
+   THEN
+      RETURN FALSE
+   ELSE
+      RETURN p (t^.key) OR
+             searchForAny (t^.left, p) OR
+             searchForAny (t^.right, p)
+   END
+END searchForAny ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE foreachNodeDo (t: symbolTree; p: performOperation) ;
+BEGIN
+   searchAndDo (t^.left, p)
+END foreachNodeDo ;
+
+
+(*
+   searchAndDo - searches all the nodes in symbolTree, t, and
+                 calls procedure, p, with a node as its parameter.
+                 It traverse the tree in order.
+*)
+
+PROCEDURE searchAndDo (t: symbolTree; p: performOperation) ;
+BEGIN
+   IF t#NIL
+   THEN
+      WITH t^ DO
+         searchAndDo (right, p) ;
+         p (key) ;
+         searchAndDo (left, p)
+      END
+   END
+END searchAndDo ;
+
+
+END symbolKey.
diff --git a/gcc/m2/mc/top.mod b/gcc/m2/mc/top.mod
new file mode 100644
index 00000000000..0dd638d604c
--- /dev/null
+++ b/gcc/m2/mc/top.mod
@@ -0,0 +1,60 @@
+(* top.mod main top level program module for mc.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+MODULE top ;
+
+FROM mcOptions IMPORT handleOptions ;
+FROM mcComp IMPORT compile ;
+FROM M2RTS IMPORT ExitOnHalt ;
+FROM mcStream IMPORT removeFiles ;
+FROM libc IMPORT atexit, perror ;
+
+
+(*
+   wrapRemoveFiles - call removeFiles and return 0.
+*)
+
+PROCEDURE wrapRemoveFiles () : INTEGER ;
+BEGIN
+   removeFiles ;
+   RETURN 0
+END wrapRemoveFiles ;
+
+
+(*
+   init - translate the source file after handling all the
+          program arguments.
+*)
+
+PROCEDURE init ;
+BEGIN
+   IF atexit (wrapRemoveFiles) # 0
+   THEN
+      perror ("atexit failed")
+   END ;
+   ExitOnHalt (1) ;
+   compile (handleOptions ())
+END init ;
+
+
+BEGIN
+   init
+END top.
diff --git a/gcc/m2/mc/varargs.def b/gcc/m2/mc/varargs.def
new file mode 100644
index 00000000000..cf2c75a1a8c
--- /dev/null
+++ b/gcc/m2/mc/varargs.def
@@ -0,0 +1,105 @@
+(* varargs.def provides a basic vararg facility for GNU Modula-2.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE varargs ;
+
+
+FROM SYSTEM IMPORT BYTE ;
+
+
+TYPE
+   vararg ;
+
+
+(*
+   nargs - returns the number of arguments wrapped in, v.
+*)
+
+PROCEDURE nargs (v: vararg) : CARDINAL ;
+
+
+(*
+   arg - fills in, a, with the next argument.  The size of, a, must
+         be an exact match with the original vararg parameter.
+*)
+
+PROCEDURE arg (v: vararg; VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   next - assigns the next arg to be collected as, i.
+*)
+
+PROCEDURE next (v: vararg; i: CARDINAL) ;
+
+
+(*
+   copy - returns a copy of, v.
+*)
+
+PROCEDURE copy (v: vararg) : vararg ;
+
+
+(*
+   replace - fills the next argument with, a.  The size of, a,
+             must be an exact match with the original vararg
+             parameter.
+*)
+
+PROCEDURE replace (v: vararg; VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   end - destructor for vararg, v.
+*)
+
+PROCEDURE end (VAR v: vararg) ;
+
+
+(*
+   start1 - wraps up argument, a, into a vararg.
+*)
+
+PROCEDURE start1 (a: ARRAY OF BYTE) : vararg ;
+
+
+(*
+   start2 - wraps up arguments, a, b, into a vararg.
+*)
+
+PROCEDURE start2 (a, b: ARRAY OF BYTE) : vararg ;
+
+
+(*
+   start3 - wraps up arguments, a, b, c, into a vararg.
+*)
+
+PROCEDURE start3 (a, b, c: ARRAY OF BYTE) : vararg ;
+
+
+(*
+   start4 - wraps up arguments, a, b, c, d, into a vararg.
+*)
+
+PROCEDURE start4 (a, b, c, d: ARRAY OF BYTE) : vararg ;
+
+
+END varargs.
diff --git a/gcc/m2/mc/varargs.mod b/gcc/m2/mc/varargs.mod
new file mode 100644
index 00000000000..d52fb1f1449
--- /dev/null
+++ b/gcc/m2/mc/varargs.mod
@@ -0,0 +1,290 @@
+(* varargs.mod provides a basic vararg facility for GNU Modula-2.
+
+Copyright (C) 2015-2022 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 varargs ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM libc IMPORT memcpy ;
+FROM SYSTEM IMPORT ADDRESS, TSIZE, ADR, BYTE ;
+
+
+CONST
+   MaxArg = 4 ;
+
+TYPE
+   vararg = POINTER TO RECORD
+                          nArgs   : CARDINAL ;
+			  i       : CARDINAL ;
+			  contents: ADDRESS ;
+			  size    : CARDINAL ;
+			  arg     : ARRAY [0..MaxArg] OF argDesc ;
+                       END ;
+
+   argDesc = RECORD
+                ptr: ADDRESS ;
+                len: CARDINAL ;
+             END ;
+
+   ptrToByte = POINTER TO BYTE ;
+
+
+(*
+   arg - fills in, a, with the next argument.  The size of, a, must be an exact
+         match with the original vararg parameter.
+*)
+
+PROCEDURE arg (v: vararg; VAR a: ARRAY OF BYTE) ;
+VAR
+   p: POINTER TO BYTE ;
+   j: CARDINAL ;
+BEGIN
+   WITH v^ DO
+      IF i=nArgs
+      THEN
+         HALT  (* too many calls to arg.  *)
+      ELSE
+         IF HIGH(a)+1=arg[i].len
+         THEN
+            p := arg[i].ptr ;
+            j := 0 ;
+            WHILE j<=HIGH (a) DO
+               a[j] := p^ ;
+               INC (p) ;
+               INC (j)
+            END
+         ELSE
+            HALT  (* parameter mismatch.  *)
+         END ;
+         INC (i)
+      END
+   END
+END arg ;
+
+
+(*
+   nargs - returns the number of arguments wrapped in, v.
+*)
+
+PROCEDURE nargs (v: vararg) : CARDINAL ;
+BEGIN
+   RETURN v^.nArgs
+END nargs ;
+
+
+(*
+   copy - returns a copy of, v.
+*)
+
+PROCEDURE copy (v: vararg) : vararg ;
+VAR
+   c     : vararg ;
+   j,
+   offset: CARDINAL ;
+BEGIN
+   NEW (c) ;
+   WITH c^ DO
+      i := v^.i ;
+      nArgs := v^.nArgs ;
+      size := v^.size ;
+      ALLOCATE (contents, size) ;
+      contents := memcpy (contents, v^.contents, size) ;
+      FOR j := 0 TO nArgs DO
+         offset := VAL (CARDINAL, VAL (ptrToByte, v^.contents) - VAL (ptrToByte, v^.arg[j].ptr)) ;
+         arg[j].ptr := VAL (ptrToByte, VAL (ptrToByte, contents) + offset) ;
+         arg[j].len := v^.arg[j].len ;
+      END
+   END ;
+   RETURN c
+END copy ;
+
+
+(*
+   replace - fills the next argument with, a.  The size of, a,
+             must be an exact match with the original vararg
+             parameter.
+*)
+
+PROCEDURE replace (v: vararg; VAR a: ARRAY OF BYTE) ;
+VAR
+   p: POINTER TO BYTE ;
+   j: CARDINAL ;
+BEGIN
+   WITH v^ DO
+      IF i=nArgs
+      THEN
+         HALT  (* too many calls to arg.  *)
+      ELSE
+         IF HIGH(a)+1=arg[i].len
+         THEN
+            p := arg[i].ptr ;
+            j := 0 ;
+            WHILE j<=HIGH (a) DO
+               p^ := a[j] ;
+               INC (p) ;
+               INC (j)
+            END
+         ELSE
+            HALT  (* parameter mismatch.  *)
+         END
+      END
+   END
+END replace ;
+
+
+(*
+   next - assigns the next arg to be collected as, i.
+*)
+
+PROCEDURE next (v: vararg; i: CARDINAL) ;
+BEGIN
+   v^.i := i
+END next ;
+
+
+(*
+   end - destructor for vararg, v.
+*)
+
+PROCEDURE end (VAR v: vararg) ;
+BEGIN
+   IF v#NIL
+   THEN
+      DEALLOCATE (v^.contents, TSIZE (vararg)) ;
+      DISPOSE (v)
+   END
+END end ;
+
+
+(*
+   start1 - wraps up argument, a, into a vararg.
+*)
+
+PROCEDURE start1 (a: ARRAY OF BYTE) : vararg ;
+VAR
+   v: vararg ;
+BEGIN
+   NEW (v) ;
+   WITH v^ DO
+      i := 0 ;
+      nArgs := 1 ;
+      size := HIGH (a) + 1;
+      ALLOCATE (contents, size) ;
+      contents := memcpy (contents, ADR (a), size) ;
+      arg[0].ptr := contents ;
+      arg[0].len := size
+   END ;
+   RETURN v
+END start1 ;
+
+
+(*
+   start2 - wraps up arguments, a, b, into a vararg.
+*)
+
+PROCEDURE start2 (a, b: ARRAY OF BYTE) : vararg ;
+VAR
+   v: vararg ;
+   p: POINTER TO BYTE ;
+BEGIN
+   NEW (v) ;
+   WITH v^ DO
+      i := 0 ;
+      nArgs := 2 ;
+      size := HIGH (a) + HIGH (b) + 2 ;
+      ALLOCATE (contents, size) ;
+      p := memcpy (contents, ADR (a), HIGH (a) + 1) ;
+      arg[0].ptr := p ;
+      arg[0].len := HIGH (a) + 1 ;
+      INC (p, arg[0].len) ;
+      p := memcpy (p, ADR (b), HIGH (b) + 1) ;
+      arg[1].ptr := p ;
+      arg[1].len := HIGH (b) + 1
+   END ;
+   RETURN v
+END start2 ;
+
+
+(*
+   start3 - wraps up arguments, a, b, c, into a vararg.
+*)
+
+PROCEDURE start3 (a, b, c: ARRAY OF BYTE) : vararg ;
+VAR
+   v: vararg ;
+   p: POINTER TO BYTE ;
+BEGIN
+   NEW (v) ;
+   WITH v^ DO
+      i := 0 ;
+      nArgs := 3 ;
+      size := HIGH (a) + HIGH (b) + HIGH (c) + 3 ;
+      ALLOCATE (contents, size) ;
+      p := memcpy (contents, ADR (a), HIGH (a) + 1) ;
+      arg[0].ptr := p ;
+      arg[0].len := HIGH (a) + 1 ;
+      INC (p, arg[0].len) ;
+      p := memcpy (p, ADR (b), HIGH (b) + 1) ;
+      arg[1].ptr := p ;
+      arg[1].len := HIGH (b) + 1 ;
+      INC (p, arg[1].len) ;
+      p := memcpy (p, ADR (c), HIGH (c) + 1) ;
+      arg[2].ptr := p ;
+      arg[2].len := HIGH (c) + 1
+   END ;
+   RETURN v
+END start3 ;
+
+
+(*
+   start4 - wraps up arguments, a, b, c, d, into a vararg.
+*)
+
+PROCEDURE start4 (a, b, c, d: ARRAY OF BYTE) : vararg ;
+VAR
+   v: vararg ;
+   p: POINTER TO BYTE ;
+BEGIN
+   NEW (v) ;
+   WITH v^ DO
+      i := 0 ;
+      nArgs := 4 ;
+      size := HIGH (a) + HIGH (b) + HIGH (c) + HIGH (d) + 4 ;
+      ALLOCATE (contents, size) ;
+      p := memcpy (contents, ADR (a), HIGH (a) + 1) ;
+      arg[0].len := HIGH (a) + 1 ;
+      INC (p, arg[0].len) ;
+      p := memcpy (p, ADR (b), HIGH (b) + 1) ;
+      arg[1].ptr := p ;
+      arg[1].len := HIGH (b) + 1 ;
+      INC (p, arg[1].len) ;
+      p := memcpy (p, ADR (c), HIGH (c) + 1) ;
+      arg[2].ptr := p ;
+      arg[2].len := HIGH (c) + 1 ;
+      INC (p, arg[2].len) ;
+      p := memcpy (p, ADR (c), HIGH (c) + 1) ;
+      arg[3].ptr := p ;
+      arg[3].len := HIGH (c) + 1
+   END ;
+   RETURN v
+END start4 ;
+
+
+END varargs.
diff --git a/gcc/m2/mc/wlists.def b/gcc/m2/mc/wlists.def
new file mode 100644
index 00000000000..fb072dd980b
--- /dev/null
+++ b/gcc/m2/mc/wlists.def
@@ -0,0 +1,122 @@
+(* wlists.def word lists module.
+
+Copyright (C) 2015-2022 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/>.  *)
+
+DEFINITION MODULE wlists ;
+
+
+FROM SYSTEM IMPORT WORD ;
+
+TYPE
+   wlist ;
+   performOperation = PROCEDURE (WORD) ;
+
+
+(*
+   initList - creates a new wlist, l.
+*)
+
+PROCEDURE initList () : wlist ;
+
+
+(*
+   killList - deletes the complete wlist, l.
+*)
+
+PROCEDURE killList (VAR l: wlist) ;
+
+
+(*
+   putItemIntoList - places an WORD, c, into wlist, l.
+*)
+
+PROCEDURE putItemIntoList (l: wlist; c: WORD) ;
+
+
+(*
+   getItemFromList - retrieves the nth WORD from wlist, l.
+*)
+
+PROCEDURE getItemFromList (l: wlist; n: CARDINAL) : WORD ;
+
+
+(*
+   getIndexOfList - returns the index for WORD, c, in wlist, l.
+                    If more than one CARDINAL, c, exists the index
+                    for the first is returned.
+*)
+
+PROCEDURE getIndexOfList (l: wlist; c: WORD) : CARDINAL ;
+
+
+(*
+   noOfItemsInList - returns the number of items in wlist, l.
+*)
+
+PROCEDURE noOfItemsInList (l: wlist) : CARDINAL ;
+
+
+(*
+   includeItemIntoList - adds an WORD, c, into a wlist providing
+                         the value does not already exist.
+*)
+
+PROCEDURE includeItemIntoList (l: wlist; c: WORD) ;
+
+
+(*
+   removeItemFromList - removes an WORD, c, from a wlist.
+                        It assumes that this value only appears once.
+*)
+
+PROCEDURE removeItemFromList (l: wlist; c: WORD) ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE replaceItemInList (l: wlist; n: CARDINAL; w: WORD) ;
+
+
+(*
+   isItemInList - returns true if a WORD, c, was found in wlist, l.
+*)
+
+PROCEDURE isItemInList (l: wlist; c: WORD) : BOOLEAN ;
+
+
+(*
+   foreachItemInListDo - calls procedure, P, foreach item in wlist, l.
+*)
+
+PROCEDURE foreachItemInListDo (l: wlist; p: performOperation) ;
+
+
+(*
+   duplicateList - returns a duplicate wlist derived from, l.
+*)
+
+PROCEDURE duplicateList (l: wlist) : wlist ;
+
+
+END wlists.
diff --git a/gcc/m2/mc/wlists.mod b/gcc/m2/mc/wlists.mod
new file mode 100644
index 00000000000..54c2978c22e
--- /dev/null
+++ b/gcc/m2/mc/wlists.mod
@@ -0,0 +1,327 @@
+(* wlists.mod word lists module.
+
+Copyright (C) 2015-2022 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 wlists ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+
+CONST
+   maxNoOfElements = 5 ;
+
+TYPE
+   wlist = POINTER TO RECORD
+              noOfElements: CARDINAL ;
+              elements    : ARRAY [1..maxNoOfElements] OF WORD ;
+              next        : wlist ;
+           END ;
+
+
+(*
+   initList - creates a new wlist, l.
+*)
+
+PROCEDURE initList () : wlist ;
+VAR
+   l: wlist ;
+BEGIN
+   NEW (l) ;
+   WITH l^ DO
+      noOfElements := 0 ;
+      next := NIL
+   END ;
+   RETURN l
+END initList ;
+
+
+(*
+   killList - deletes the complete wlist, l.
+*)
+
+PROCEDURE killList (VAR l: wlist) ;
+BEGIN
+   IF l#NIL
+   THEN
+      IF l^.next#NIL
+      THEN
+         killList (l^.next)
+      END ;
+      DISPOSE (l)
+   END
+END killList ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE replaceItemInList (l: wlist; n: CARDINAL; w: WORD) ;
+BEGIN
+   WHILE l#NIL DO
+      WITH l^ DO
+         IF n<=noOfElements
+         THEN
+            elements[n] := w
+         ELSE
+            DEC (n, noOfElements)
+         END
+      END ;
+      l := l^.next
+   END
+END replaceItemInList ;
+
+
+(*
+   putItemIntoList - places an WORD, c, into wlist, l.
+*)
+
+PROCEDURE putItemIntoList (l: wlist; c: WORD) ;
+BEGIN
+   WITH l^ DO
+      IF noOfElements<maxNoOfElements
+      THEN
+         INC (noOfElements) ;
+         elements[noOfElements] := c
+      ELSIF next#NIL
+      THEN
+         putItemIntoList (next, c)
+      ELSE
+         next := initList () ;
+         putItemIntoList (next, c)
+      END
+   END
+END putItemIntoList ;
+
+
+(*
+   getItemFromList - retrieves the nth WORD from wlist, l.
+*)
+
+PROCEDURE getItemFromList (l: wlist; n: CARDINAL) : WORD ;
+BEGIN
+   WHILE l#NIL DO
+      WITH l^ DO
+         IF n<=noOfElements
+         THEN
+            RETURN elements[n]
+         ELSE
+            DEC (n, noOfElements)
+         END
+      END ;
+      l := l^.next
+   END ;
+   RETURN 0
+END getItemFromList ;
+
+
+(*
+   getIndexOfList - returns the index for WORD, c, in wlist, l.
+                    If more than one WORD, c, exists the index
+                    for the first is returned.
+*)
+
+PROCEDURE getIndexOfList (l: wlist; c: WORD) : CARDINAL ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN 0
+   ELSE
+      WITH l^ DO
+         i := 1 ;
+         WHILE i<=noOfElements DO
+            IF elements[i]=c
+            THEN
+               RETURN i
+            ELSE
+               INC(i)
+            END
+         END ;
+         RETURN noOfElements + getIndexOfList (next, c)
+      END
+   END
+END getIndexOfList ;
+
+
+(*
+   noOfItemsInList - returns the number of items in wlist, l.
+*)
+
+PROCEDURE noOfItemsInList (l: wlist) : CARDINAL ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   IF l=NIL
+   THEN
+      RETURN 0
+   ELSE
+      t := 0 ;
+      REPEAT
+         WITH l^ DO
+            INC (t, noOfElements)
+         END ;
+         l := l^.next
+      UNTIL l=NIL;
+      RETURN t
+   END
+END noOfItemsInList ;
+
+
+(*
+   includeItemIntoList - adds an WORD, c, into a wlist providing
+                         the value does not already exist.
+*)
+
+PROCEDURE includeItemIntoList (l: wlist; c: WORD) ;
+BEGIN
+   IF NOT isItemInList (l, c)
+   THEN
+      putItemIntoList (l, c)
+   END
+END includeItemIntoList ;
+
+
+(*
+   removeItem - remove an element at index, i, from the wlist data type.
+*)
+
+PROCEDURE removeItem (p, l: wlist; i: CARDINAL) ;
+BEGIN
+   WITH l^ DO
+      DEC (noOfElements) ;
+      WHILE i<=noOfElements DO
+         elements[i] := elements[i+1] ;
+         INC (i)
+      END ;
+      IF (noOfElements=0) AND (p#NIL)
+      THEN
+         p^.next := l^.next ;
+         DISPOSE (l)
+      END
+   END
+END removeItem ;
+
+
+(*
+   removeItemFromList - removes a WORD, c, from a wlist.
+                        It assumes that this value only appears once.
+*)
+
+PROCEDURE removeItemFromList (l: wlist; c: WORD) ;
+VAR
+   p    : wlist ;
+   i    : CARDINAL ;
+   found: BOOLEAN ;
+BEGIN
+   IF l#NIL
+   THEN
+      found := FALSE ;
+      p := NIL ;
+      REPEAT
+         WITH l^ DO
+            i := 1 ;
+            WHILE (i<=noOfElements) AND (elements[i]#c) DO
+               INC (i)
+            END ;
+         END ;
+         IF (i<=l^.noOfElements) AND (l^.elements[i]=c)
+         THEN
+            found := TRUE
+         ELSE
+            p := l ;
+            l := l^.next
+         END
+      UNTIL (l=NIL) OR found ;
+      IF found
+      THEN
+         removeItem (p, l, i)
+      END
+   END
+END removeItemFromList ;
+
+
+(*
+   isItemInList - returns true if a WORD, c, was found in wlist, l.
+*)
+
+PROCEDURE isItemInList (l: wlist; c: WORD) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   REPEAT
+      WITH l^ DO
+         i := 1 ;
+         WHILE i<=noOfElements DO
+            IF elements[i]=c
+            THEN
+               RETURN TRUE
+            ELSE
+               INC (i)
+            END
+         END
+      END ;
+      l := l^.next
+   UNTIL l=NIL ;
+   RETURN FALSE
+END isItemInList ;
+
+
+(*
+   foreachItemInListDo - calls procedure, P, foreach item in wlist, l.
+*)
+
+PROCEDURE foreachItemInListDo (l: wlist; p: performOperation) ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   n := noOfItemsInList(l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      p (getItemFromList (l, i)) ;
+      INC(i)
+   END
+END foreachItemInListDo ;
+
+
+(*
+   duplicateList - returns a duplicate wlist derived from, l.
+*)
+
+PROCEDURE duplicateList (l: wlist) : wlist ;
+VAR
+   m   : wlist ;
+   n, i: CARDINAL ;
+BEGIN
+   m := initList () ;
+   n := noOfItemsInList (l) ;
+   i := 1 ;
+   WHILE i<=n DO
+      putItemIntoList (m, getItemFromList (l, i)) ;
+      INC (i)
+   END ;
+   RETURN m
+END duplicateList ;
+
+
+END wlists.
diff --git a/gcc/m2/pge-boot/GASCII.c b/gcc/m2/pge-boot/GASCII.c
new file mode 100644
index 00000000000..a4101d20ede
--- /dev/null
+++ b/gcc/m2/pge-boot/GASCII.c
@@ -0,0 +1,84 @@
+/* do not edit automatically generated by mc from ASCII.  */
+/* ASCII.mod dummy companion module for the definition.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GASCII.h b/gcc/m2/pge-boot/GASCII.h
new file mode 100644
index 00000000000..f3c943cd0f9
--- /dev/null
+++ b/gcc/m2/pge-boot/GASCII.h
@@ -0,0 +1,94 @@
+/* do not edit automatically generated by mc from ASCII.  */
+/* ASCII.def Defines all ascii constants.
+
+Copyright (C) 2001-2021 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 (_ASCII_H)
+#   define _ASCII_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_ASCII_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   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
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GArgs.c b/gcc/m2/pge-boot/GArgs.c
new file mode 100644
index 00000000000..e8ad8723eae
--- /dev/null
+++ b/gcc/m2/pge-boot/GArgs.c
@@ -0,0 +1,118 @@
+/* do not edit automatically generated by mc from Args.  */
+/* Args.mod provide access to command line arguments.
+
+Copyright (C) 2001-2021 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 (((*(*Source).array[i]).array[j] != ASCII_nul) && (j < High))
+        {
+          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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GArgs.h b/gcc/m2/pge-boot/GArgs.h
new file mode 100644
index 00000000000..166a49eb91e
--- /dev/null
+++ b/gcc/m2/pge-boot/GArgs.h
@@ -0,0 +1,69 @@
+/* do not edit automatically generated by mc from Args.  */
+/* Args.def provide access to command line arguments.
+
+Copyright (C) 2001-2021 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 (_Args_H)
+#   define _Args_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Args_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   GetArg - returns the nth argument from the command line.
+            The success of the operation is returned.
+*/
+
+EXTERN unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n);
+
+/*
+   Narg - returns the number of arguments available from
+          command line.
+*/
+
+EXTERN unsigned int Args_Narg (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GAssertion.c b/gcc/m2/pge-boot/GAssertion.c
new file mode 100644
index 00000000000..9a4cda4c161
--- /dev/null
+++ b/gcc/m2/pge-boot/GAssertion.c
@@ -0,0 +1,69 @@
+/* do not edit automatically generated by mc from Assertion.  */
+/* Assertion.mod provides an assert procedure.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GAssertion.h b/gcc/m2/pge-boot/GAssertion.h
new file mode 100644
index 00000000000..c84cd7cb400
--- /dev/null
+++ b/gcc/m2/pge-boot/GAssertion.h
@@ -0,0 +1,62 @@
+/* do not edit automatically generated by mc from Assertion.  */
+/* Assertion.def provides an assert procedure.
+
+Copyright (C) 2001-2021 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 (_Assertion_H)
+#   define _Assertion_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Assertion_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Assert - tests the boolean Condition, if it fails then HALT
+            is called.
+*/
+
+EXTERN void Assertion_Assert (unsigned int Condition);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GBreak.h b/gcc/m2/pge-boot/GBreak.h
new file mode 100644
index 00000000000..47a210d1005
--- /dev/null
+++ b/gcc/m2/pge-boot/GBreak.h
@@ -0,0 +1,55 @@
+/* do not edit automatically generated by mc from Break.  */
+/* Break.def provides a dummy compatibility library for legacy systems.
+
+Copyright (C) 2001-2021 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 (_Break_H)
+#   define _Break_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Break_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GBuiltins.c b/gcc/m2/pge-boot/GBuiltins.c
new file mode 100644
index 00000000000..826fa1003e9
--- /dev/null
+++ b/gcc/m2/pge-boot/GBuiltins.c
@@ -0,0 +1,43 @@
+/* GBuiltins.c dummy module to aid linking mc projects.
+
+Copyright (C) 2016-2022 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)
+{
+}
diff --git a/gcc/m2/pge-boot/GCmdArgs.h b/gcc/m2/pge-boot/GCmdArgs.h
new file mode 100644
index 00000000000..50c365230df
--- /dev/null
+++ b/gcc/m2/pge-boot/GCmdArgs.h
@@ -0,0 +1,69 @@
+/* do not edit automatically generated by mc from CmdArgs.  */
+/* CmdArgs.def provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2021 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 (_CmdArgs_H)
+#   define _CmdArgs_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_CmdArgs_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   GetArg - returns the nth argument from the command line, CmdLine
+            the success of the operation is returned.
+*/
+
+EXTERN 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 unsigned int CmdArgs_Narg (const char *CmdLine_, unsigned int _CmdLine_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GDebug.c b/gcc/m2/pge-boot/GDebug.c
new file mode 100644
index 00000000000..3518c9bf702
--- /dev/null
+++ b/gcc/m2/pge-boot/GDebug.c
@@ -0,0 +1,168 @@
+/* do not edit automatically generated by mc from Debug.  */
+/* Debug.mod provides some simple debugging routines.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GDebug.h b/gcc/m2/pge-boot/GDebug.h
new file mode 100644
index 00000000000..cfeef7567f7
--- /dev/null
+++ b/gcc/m2/pge-boot/GDebug.h
@@ -0,0 +1,72 @@
+/* do not edit automatically generated by mc from Debug.  */
+/* Debug.def provides some simple debugging routines.
+
+Copyright (C) 2001-2021 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 (_Debug_H)
+#   define _Debug_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Debug_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Halt - writes a message in the format:
+          Module:Line:Message
+
+          It then terminates by calling HALT.
+*/
+
+EXTERN 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 void Debug_DebugString (const char *a_, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GDynamicStrings.c b/gcc/m2/pge-boot/GDynamicStrings.c
new file mode 100644
index 00000000000..70031e89c6e
--- /dev/null
+++ b/gcc/m2/pge-boot/GDynamicStrings.c
@@ -0,0 +1,2689 @@
+/* do not edit automatically generated by mc from DynamicStrings.  */
+/* DynamicStrings.mod provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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] != a->contents.buf.array[i])
+                {
+                  M2RTS_HALT (-1);
+                  __builtin_unreachable ();
+                }
+              if (b->contents.buf.array[i] != b->contents.buf.array[i])
+                {
+                  M2RTS_HALT (-1);
+                  __builtin_unreachable ();
+                }
+              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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1258, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1288, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1320, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1388, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1405, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1517, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1629, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 1651, (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-git-devel-modula2/gcc/m2/gm2-libs/DynamicStrings.mod", 62, 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GDynamicStrings.h b/gcc/m2/pge-boot/GDynamicStrings.h
new file mode 100644
index 00000000000..c0f3d5d995d
--- /dev/null
+++ b/gcc/m2/pge-boot/GDynamicStrings.h
@@ -0,0 +1,334 @@
+/* do not edit automatically generated by mc from DynamicStrings.  */
+/* DynamicStrings.def provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2021 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 (_DynamicStrings_H)
+#   define _DynamicStrings_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_DynamicStrings_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (DynamicStrings_String_D)
+#  define DynamicStrings_String_D
+   typedef void *DynamicStrings_String;
+#endif
+
+
+/*
+   InitString - creates and returns a String type object.
+                Initial contents are, a.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high);
+
+/*
+   KillString - frees String, s, and its contents.
+                NIL is returned.
+*/
+
+EXTERN 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 void DynamicStrings_Fin (DynamicStrings_String s);
+
+/*
+   InitStringCharStar - initializes and returns a String to contain
+                        the C string.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_InitStringCharStar (void * a);
+
+/*
+   InitStringChar - initializes and returns a String to contain the
+                    single character, ch.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_InitStringChar (char ch);
+
+/*
+   Mark - marks String, s, ready for garbage collection.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s);
+
+/*
+   Length - returns the length of the String, s.
+*/
+
+EXTERN unsigned int DynamicStrings_Length (DynamicStrings_String s);
+
+/*
+   ConCat - returns String, a, after the contents of, b,
+            have been appended.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+   ConCatChar - returns String, a, after character, ch,
+                has been appended.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch);
+
+/*
+   Assign - assigns the contents of, b, into, a.
+            String, a, is returned.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+   Dup - duplicate a String, s, returning the copy of s.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s);
+
+/*
+   Add - returns a new String which contains the contents of a and b.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+   Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+EXTERN 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 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 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.
+          If n<=0 then an empty string is returned.
+*/
+
+EXTERN 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 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 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 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 DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment);
+
+/*
+   RemoveWhitePrefix - removes any leading white space from String, s.
+                       A new string is returned.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s);
+
+/*
+   RemoveWhitePostfix - removes any leading white space from String, s.
+                        A new string is returned.
+*/
+
+EXTERN 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 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 DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s);
+
+/*
+   CopyOut - copies string, s, to a.
+*/
+
+EXTERN void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s);
+
+/*
+   char - returns the character, ch, at position, i, in String, s.
+          As Slice the index can be negative so:
+
+          char(s, 0) will return the first character
+          char(s, 1) will return the second character
+          char(s, -1) will return the last character
+          char(s, -2) will return the penultimate character
+
+          a nul character is returned if the index is out of range.
+*/
+
+EXTERN char DynamicStrings_char (DynamicStrings_String s, int i);
+
+/*
+   string - returns the C style char * of String, s.
+*/
+
+EXTERN void * DynamicStrings_string (DynamicStrings_String s);
+
+/*
+   InitStringDB - the debug version of InitString.
+*/
+
+EXTERN 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 DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+   InitStringCharDB - the debug version of InitStringChar.
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+   MultDB - the debug version of MultDB.
+*/
+
+EXTERN 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 DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+   SliceDB - debug version of Slice.
+*/
+
+EXTERN 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 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 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.
+
+                            The string, e, is returned unmodified,
+*/
+
+EXTERN DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GEnvironment.h b/gcc/m2/pge-boot/GEnvironment.h
new file mode 100644
index 00000000000..0a3c4653557
--- /dev/null
+++ b/gcc/m2/pge-boot/GEnvironment.h
@@ -0,0 +1,73 @@
+/* do not edit automatically generated by mc from Environment.  */
+/* Environment.def provides access to the environment settings of a process.
+
+Copyright (C) 2001-2021 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 (_Environment_H)
+#   define _Environment_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Environment_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   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 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 unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GFIO.c b/gcc/m2/pge-boot/GFIO.c
new file mode 100644
index 00000000000..536828ed96a
--- /dev/null
+++ b/gcc/m2/pge-boot/GFIO.c
@@ -0,0 +1,2331 @@
+/* do not edit automatically generated by mc from FIO.  */
+/* FIO.mod provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2022 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-git-devel-modula2/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;  /* reduce the amount for future direct  */
+                  /* 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)
+    {
+      /* avoid dangling else.  */
+      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;
+            }
+          else
+            {
+              return -1;
+            }
+        }
+    }
+  else
+    {
+      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;
+        }
+    }
+  ReturnException ("../../gcc-git-devel-modula2/gcc/m2/gm2-libs/FIO.def", 25, 1);
+  __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;
+        }
+    }
+  ReturnException ("../../gcc-git-devel-modula2/gcc/m2/gm2-libs/FIO.def", 25, 1);
+  __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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+  FIO_FlushOutErr ();
+}
diff --git a/gcc/m2/pge-boot/GFIO.h b/gcc/m2/pge-boot/GFIO.h
new file mode 100644
index 00000000000..5f24a4c6762
--- /dev/null
+++ b/gcc/m2/pge-boot/GFIO.h
@@ -0,0 +1,300 @@
+/* do not edit automatically generated by mc from FIO.  */
+/* FIO.def provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2021 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 (_FIO_H)
+#   define _FIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_FIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef unsigned int FIO_File;
+
+EXTERN FIO_File FIO_StdIn;
+EXTERN FIO_File FIO_StdOut;
+EXTERN FIO_File FIO_StdErr;
+
+/*
+   IsNoError - returns a TRUE if no error has occured on file, f.
+*/
+
+EXTERN unsigned int FIO_IsNoError (FIO_File f);
+
+/*
+   IsActive - returns TRUE if the file, f, is still active.
+*/
+
+EXTERN unsigned int FIO_IsActive (FIO_File f);
+
+/*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+EXTERN unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high);
+
+/*
+   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 FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high);
+
+/*
+   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 FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high);
+
+/*
+   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.
+                   newfile, determines whether a file should be
+                   created if towrite is TRUE or whether the
+                   previous file should be left alone,
+                   allowing this descriptor to seek
+                   and modify an existing file.
+*/
+
+EXTERN 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 void FIO_Close (FIO_File f);
+EXTERN unsigned int FIO_exists (void * fname, unsigned int flength);
+EXTERN FIO_File FIO_openToRead (void * fname, unsigned int flength);
+EXTERN FIO_File FIO_openToWrite (void * fname, unsigned int flength);
+EXTERN FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile);
+
+/*
+   FlushBuffer - flush contents of the FIO file, f, to libc.
+*/
+
+EXTERN 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 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 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 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 void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+
+/*
+   WriteChar - writes a single character to file, f.
+*/
+
+EXTERN void FIO_WriteChar (FIO_File f, char ch);
+
+/*
+   EOF - tests to see whether a file, f, has reached end of file.
+*/
+
+EXTERN unsigned int FIO_EOF (FIO_File f);
+
+/*
+   EOLN - tests to see whether a file, f, is about to read a newline.
+          It does NOT consume the newline.  It reads the next character
+          and then immediately unreads the character.
+*/
+
+EXTERN unsigned int FIO_EOLN (FIO_File f);
+
+/*
+   WasEOLN - tests to see whether a file, f, has just read a newline
+             character.
+*/
+
+EXTERN 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 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,
+                end of file or end of line seen.
+*/
+
+EXTERN void FIO_UnReadChar (FIO_File f, char ch);
+
+/*
+   WriteLine - writes out a linefeed to file, f.
+*/
+
+EXTERN void FIO_WriteLine (FIO_File f);
+
+/*
+   WriteString - writes a string to file, f.
+*/
+
+EXTERN 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 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 void FIO_WriteCardinal (FIO_File f, unsigned int c);
+
+/*
+   ReadCardinal - reads a CARDINAL from file, f.
+                  It reads a bit image of a CARDINAL
+                  from file, f.
+*/
+
+EXTERN unsigned int FIO_ReadCardinal (FIO_File f);
+
+/*
+   GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+                           Useful when combining FIO.mod with select
+                           (in Selective.def - but note the comments in
+                            Selective about using read/write primatives)
+*/
+
+EXTERN int FIO_GetUnixFileDescriptor (FIO_File f);
+
+/*
+   SetPositionFromBeginning - sets the position from the beginning
+                              of the file.
+*/
+
+EXTERN void FIO_SetPositionFromBeginning (FIO_File f, long int pos);
+
+/*
+   SetPositionFromEnd - sets the position from the end of the file.
+*/
+
+EXTERN void FIO_SetPositionFromEnd (FIO_File f, long int pos);
+
+/*
+   FindPosition - returns the current absolute position in file, f.
+*/
+
+EXTERN long int FIO_FindPosition (FIO_File f);
+
+/*
+   GetFileName - assigns, a, with the filename associated with, f.
+*/
+
+EXTERN void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high);
+
+/*
+   getFileName - returns the address of the filename associated with, f.
+*/
+
+EXTERN void * FIO_getFileName (FIO_File f);
+
+/*
+   getFileNameLength - returns the number of characters associated with
+                       filename, f.
+*/
+
+EXTERN unsigned int FIO_getFileNameLength (FIO_File f);
+
+/*
+   FlushOutErr - flushes, StdOut, and, StdErr.
+*/
+
+EXTERN void FIO_FlushOutErr (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GFormatStrings.h b/gcc/m2/pge-boot/GFormatStrings.h
new file mode 100644
index 00000000000..668a2fdb955
--- /dev/null
+++ b/gcc/m2/pge-boot/GFormatStrings.h
@@ -0,0 +1,99 @@
+/* do not edit automatically generated by mc from FormatStrings.  */
+/* FormatStrings.def provides a pseudo printf capability.
+
+Copyright (C) 2005-2021 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 (_FormatStrings_H)
+#   define _FormatStrings_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GDynamicStrings.h"
+
+#   if defined (_FormatStrings_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Sprintf0 - returns a String containing, fmt, after it has had its
+              escape sequences translated.
+*/
+
+EXTERN DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt);
+
+/*
+   Sprintf1 - returns a String containing, fmt, together with
+              encapsulated entity, w. It only formats the
+              first %s or %d with n.
+*/
+
+EXTERN DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high);
+
+/*
+   Sprintf2 - returns a string, fmt, which has been formatted.
+*/
+
+EXTERN 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, fmt, which has been formatted.
+*/
+
+EXTERN 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, fmt, which has been formatted.
+*/
+
+EXTERN 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 DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GFpuIO.h b/gcc/m2/pge-boot/GFpuIO.h
new file mode 100644
index 00000000000..fd070ee05d8
--- /dev/null
+++ b/gcc/m2/pge-boot/GFpuIO.h
@@ -0,0 +1,67 @@
+/* do not edit automatically generated by mc from FpuIO.  */
+/* FpuIO.def Implements a fixed format input/output for REAL/LONGREAL.
+
+Copyright (C) 2001-2021 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 (_FpuIO_H)
+#   define _FpuIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_FpuIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN void FpuIO_ReadReal (double *x);
+EXTERN void FpuIO_WriteReal (double x, unsigned int TotalWidth, unsigned int FractionWidth);
+EXTERN void FpuIO_StrToReal (const char *a_, unsigned int _a_high, double *x);
+EXTERN void FpuIO_RealToStr (double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high);
+EXTERN void FpuIO_ReadLongReal (long double *x);
+EXTERN void FpuIO_WriteLongReal (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+EXTERN void FpuIO_StrToLongReal (const char *a_, unsigned int _a_high, long double *x);
+EXTERN void FpuIO_LongRealToStr (long double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high);
+EXTERN void FpuIO_ReadLongInt (long int *x);
+EXTERN void FpuIO_WriteLongInt (long int x, unsigned int n);
+EXTERN void FpuIO_StrToLongInt (const char *a_, unsigned int _a_high, long int *x);
+EXTERN void FpuIO_LongIntToStr (long int x, unsigned int n, char *a, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GIO.c b/gcc/m2/pge-boot/GIO.c
new file mode 100644
index 00000000000..de62c058838
--- /dev/null
+++ b/gcc/m2/pge-boot/GIO.c
@@ -0,0 +1,479 @@
+/* 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-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GIO.h b/gcc/m2/pge-boot/GIO.h
new file mode 100644
index 00000000000..dc40066bd51
--- /dev/null
+++ b/gcc/m2/pge-boot/GIO.h
@@ -0,0 +1,88 @@
+/* do not edit automatically generated by mc from IO.  */
+/* IO.def provides Read, Write, Errors procedures mapping onto 0, 1 and 2.
+
+Copyright (C) 2001-2021 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 (_IO_H)
+#   define _IO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_IO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN void IO_Read (char *ch);
+EXTERN void IO_Write (char ch);
+EXTERN void IO_Error (char ch);
+
+/*
+   UnBufferedMode - places file descriptor, fd, into an unbuffered mode.
+*/
+
+EXTERN void IO_UnBufferedMode (int fd, unsigned int input);
+
+/*
+   BufferedMode - places file descriptor, fd, into a buffered mode.
+*/
+
+EXTERN 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 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 void IO_EchoOff (int fd, unsigned int input);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GIndexing.c b/gcc/m2/pge-boot/GIndexing.c
new file mode 100644
index 00000000000..02e0c3d6ec4
--- /dev/null
+++ b/gcc/m2/pge-boot/GIndexing.c
@@ -0,0 +1,493 @@
+/* do not edit automatically generated by mc from Indexing.  */
+/* Indexing.mod provides a dynamic indexing mechanism for CARDINAL.
+
+Copyright (C) 2003-2021 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-git-devel-modula2/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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GIndexing.h b/gcc/m2/pge-boot/GIndexing.h
new file mode 100644
index 00000000000..ea0492db50d
--- /dev/null
+++ b/gcc/m2/pge-boot/GIndexing.h
@@ -0,0 +1,146 @@
+/* do not edit automatically generated by mc from Indexing.  */
+/* Indexing.def provides a dynamic indexing mechanism for CARDINAL.
+
+Copyright (C) 2003-2021 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 (_Indexing_H)
+#   define _Indexing_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_Indexing_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (Indexing_Index_D)
+#  define Indexing_Index_D
+   typedef void *Indexing_Index;
+#endif
+
+typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure;
+
+typedef void (*Indexing_IndexProcedure_t) (void *);
+struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
+
+
+/*
+   InitIndex - creates and returns an Index.
+*/
+
+EXTERN Indexing_Index Indexing_InitIndex (unsigned int low);
+
+/*
+   KillIndex - returns Index to free storage.
+*/
+
+EXTERN Indexing_Index Indexing_KillIndex (Indexing_Index i);
+
+/*
+   DebugIndex - turns on debugging within an index.
+*/
+
+EXTERN Indexing_Index Indexing_DebugIndex (Indexing_Index i);
+
+/*
+   InBounds - returns TRUE if indice, n, is within the bounds
+              of the dynamic array.
+*/
+
+EXTERN unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n);
+
+/*
+   HighIndice - returns the last legally accessible indice of this array.
+*/
+
+EXTERN unsigned int Indexing_HighIndice (Indexing_Index i);
+
+/*
+   LowIndice - returns the first legally accessible indice of this array.
+*/
+
+EXTERN unsigned int Indexing_LowIndice (Indexing_Index i);
+
+/*
+   PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+EXTERN void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a);
+
+/*
+   GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+EXTERN void * Indexing_GetIndice (Indexing_Index i, unsigned int n);
+
+/*
+   IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+EXTERN unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a);
+
+/*
+   RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+EXTERN void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a);
+
+/*
+   DeleteIndice - delete i[j] from the array.
+*/
+
+EXTERN 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 void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a);
+
+/*
+   ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+EXTERN void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GLists.c b/gcc/m2/pge-boot/GLists.c
new file mode 100644
index 00000000000..14b93c2c6c4
--- /dev/null
+++ b/gcc/m2/pge-boot/GLists.c
@@ -0,0 +1,427 @@
+/* do not edit automatically generated by mc from Lists.  */
+/* Lists.mod provides an unordered list manipulation package.
+
+Copyright (C) 2001-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GLists.h b/gcc/m2/pge-boot/GLists.h
new file mode 100644
index 00000000000..9ec28d9ed7f
--- /dev/null
+++ b/gcc/m2/pge-boot/GLists.h
@@ -0,0 +1,127 @@
+/* do not edit automatically generated by mc from Lists.  */
+/* Lists.def provides an unordered list manipulation package.
+
+Copyright (C) 2001-2022 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 (_Lists_H)
+#   define _Lists_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GSymbolKey.h"
+
+#   if defined (_Lists_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (Lists_List_D)
+#  define Lists_List_D
+   typedef void *Lists_List;
+#endif
+
+
+/*
+   InitList - creates a new list, l.
+*/
+
+EXTERN void Lists_InitList (Lists_List *l);
+
+/*
+   KillList - deletes the complete list, l.
+*/
+
+EXTERN void Lists_KillList (Lists_List *l);
+
+/*
+   PutItemIntoList - places a CARDINAL, c, into list, l.
+*/
+
+EXTERN void Lists_PutItemIntoList (Lists_List l, unsigned int c);
+
+/*
+   GetItemFromList - retrieves the nth WORD from list, l.
+*/
+
+EXTERN unsigned int Lists_GetItemFromList (Lists_List l, unsigned int n);
+
+/*
+   GetIndexOfList - returns the index for WORD, c, in list, l.
+                    If more than one CARDINAL, c, exists the index
+                    for the first is returned.
+*/
+
+EXTERN unsigned int Lists_GetIndexOfList (Lists_List l, unsigned int c);
+
+/*
+   NoOfItemsInList - returns the number of items in list, l.
+*/
+
+EXTERN unsigned int Lists_NoOfItemsInList (Lists_List l);
+
+/*
+   IncludeItemIntoList - adds a WORD, c, into a list providing
+                         the value does not already exist.
+*/
+
+EXTERN 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 void Lists_RemoveItemFromList (Lists_List l, unsigned int c);
+
+/*
+   IsItemInList - returns true if a WORD, c, was found in list, l.
+*/
+
+EXTERN unsigned int Lists_IsItemInList (Lists_List l, unsigned int c);
+
+/*
+   ForeachItemInListDo - calls procedure, P, foreach item in list, l.
+*/
+
+EXTERN void Lists_ForeachItemInListDo (Lists_List l, SymbolKey_PerformOperation P);
+
+/*
+   DuplicateList - returns a duplicate list derived from, l.
+*/
+
+EXTERN Lists_List Lists_DuplicateList (Lists_List l);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GM2Dependent.c b/gcc/m2/pge-boot/GM2Dependent.c
new file mode 100644
index 00000000000..227a551fb0a
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2Dependent.c
@@ -0,0 +1,1162 @@
+/* do not edit automatically generated by mc from M2Dependent.  */
+/* M2Dependent.mod implements the run time module dependencies.
+
+Copyright (C) 2022 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 "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;
+                           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 ModuleTrace;
+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, int argc, void * argv, void * envp);
+
+/*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, 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 * name, 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 * dependantmodule);
+
+/*
+   CreateModule - creates a new module entry and returns the
+                  ModuleChain.
+*/
+
+static M2Dependent_ModuleChain CreateModule (void * name, 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);
+
+/*
+   LookupModuleN - lookup module from the state list.  The string is limited
+                   to nchar.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar);
+
+/*
+   LookupModule - lookup and return the ModuleChain pointer containing
+                  module name from a particular list.
+*/
+
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name);
+
+/*
+   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);
+
+/*
+   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);
+
+/*
+   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 * dependantmodule);
+
+/*
+   ResolveDependencies - resolve dependencies for currentmodule.
+*/
+
+static void ResolveDependencies (void * currentmodule);
+
+/*
+   DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_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);
+
+/*
+   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);
+
+/*
+   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,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.
+                     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, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+  M2Dependent_ModuleChain mptr;
+
+  Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
+  mptr->name = name;
+  mptr->init = init;
+  mptr->fini = fini;
+  mptr->dependency.proc = dependencies;
+  mptr->dependency.state = M2Dependent_unregistered;
+  mptr->prev = NULL;
+  mptr->next = NULL;
+  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 ();
+}
+
+
+/*
+   LookupModuleN - lookup module from the state list.  The string is limited
+                   to nchar.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar)
+{
+  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), nchar)) == 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)
+{
+  return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))));
+  /* 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 ((str[i] == '\\') && (i < high))
+        {
+          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 (((a != NULL) && (b != NULL)) && (n > 0))
+    {
+      /* avoid gcc warning by using compound statement even if not strictly necessary.  */
+      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 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, arg);
+    }
+}
+
+
+/*
+   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)
+{
+  if (mptr == NULL)
+    {
+      traceprintf (DependencyTrace, (const char *) "   module has not been registered via a global constructor\\n", 60);
+    }
+  else
+    {
+      if (onChain (M2Dependent_started, mptr))
+        {
+          traceprintf (DependencyTrace, (const char *) "   processing...\\n", 18);
+        }
+      else
+        {
+          moveTo (M2Dependent_started, mptr);
+          traceprintf2 (DependencyTrace, (const char *) "   starting: %s\\n", 17, currentmodule);
+          (*mptr->dependency.proc.proc) ();  /* Invoke and process the dependency graph.  */
+          traceprintf2 (DependencyTrace, (const char *) "   finished: %s\\n", 17, currentmodule);  /* 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 * dependantmodule)
+{
+  M2Dependent_ModuleChain mptr;
+
+  traceprintf2 (DependencyTrace, (const char *) "  module %s", 11, modulename);
+  if (dependantmodule == NULL)
+    {
+      /* avoid dangling else.  */
+      traceprintf2 (DependencyTrace, (const char *) " has finished its import graph\\n", 32, modulename);
+      mptr = LookupModule (M2Dependent_unordered, modulename);
+      if (mptr != NULL)
+        {
+          traceprintf2 (DependencyTrace, (const char *) "  module %s is now ordered\\n", 28, modulename);
+          moveTo (M2Dependent_ordered, mptr);
+        }
+    }
+  else
+    {
+      traceprintf2 (DependencyTrace, (const char *) " imports from %s\\n", 18, dependantmodule);
+      mptr = LookupModule (M2Dependent_ordered, dependantmodule);
+      if (mptr == NULL)
+        {
+          traceprintf2 (DependencyTrace, (const char *) "  module %s is not ordered\\n", 28, dependantmodule);
+          mptr = LookupModule (M2Dependent_unordered, dependantmodule);
+          if (mptr == NULL)
+            {
+              traceprintf2 (DependencyTrace, (const char *) "  module %s is not unordered\\n", 30, dependantmodule);
+              mptr = LookupModule (M2Dependent_started, dependantmodule);
+              if (mptr == NULL)
+                {
+                  traceprintf2 (DependencyTrace, (const char *) "  module %s has not started\\n", 29, dependantmodule);
+                  traceprintf2 (DependencyTrace, (const char *) "  module %s attempting to import from", 37, modulename);
+                  traceprintf2 (DependencyTrace, (const char *) " %s which has not registered itself via a constructor\\n", 55, dependantmodule);
+                }
+              else
+                {
+                  traceprintf2 (DependencyTrace, (const char *) "  module %s has registered itself and has started\\n", 51, dependantmodule);
+                }
+            }
+          else
+            {
+              traceprintf2 (DependencyTrace, (const char *) "  module %s resolving\\n", 23, dependantmodule);
+              ResolveDependant (mptr, dependantmodule);
+            }
+        }
+      else
+        {
+          traceprintf2 (DependencyTrace, (const char *) "  module %s ", 12, modulename);
+          traceprintf2 (DependencyTrace, (const char *) " dependant %s is ordered\\n", 26, dependantmodule);
+        }
+    }
+}
+
+
+/*
+   ResolveDependencies - resolve dependencies for currentmodule.
+*/
+
+static void ResolveDependencies (void * currentmodule)
+{
+  M2Dependent_ModuleChain mptr;
+
+  mptr = LookupModule (M2Dependent_unordered, currentmodule);
+  while (mptr != NULL)
+    {
+      traceprintf2 (DependencyTrace, (const char *) "   attempting to resolve the dependants for %s\\n", 48, currentmodule);
+      ResolveDependant (mptr, currentmodule);
+      mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
+    }
+}
+
+
+/*
+   DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high)
+{
+  M2Dependent_ModuleChain mptr;
+  unsigned int count;
+  char name[_name_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (name, name_, _name_high+1);
+
+  if (Modules.array[state-M2Dependent_unregistered] != NULL)
+    {
+      libc_printf ((const char *) "%s modules\\n", 12, &name);
+      mptr = Modules.array[state-M2Dependent_unregistered];
+      count = 0;
+      do {
+        libc_printf ((const char *) "  %d  %s", 8, count, mptr->name);
+        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.  */
+    }
+}
+
+
+/*
+   ForceDependencies - if the user has specified a forced order then we override
+                       the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void)
+{
+  M2Dependent_ModuleChain mptr;
+  M2Dependent_ModuleChain userChain;
+  unsigned int count;
+  M2LINK_PtrToChar pc;
+  M2LINK_PtrToChar start;
+
+  if (M2LINK_ForcedModuleInitOrder != NULL)
+    {
+      userChain = NULL;
+      pc = M2LINK_ForcedModuleInitOrder;
+      start = pc;
+      count = 0;
+      while ((*pc) != ASCII_nul)
+        {
+          if ((*pc) == ',')
+            {
+              mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
+              if (mptr != NULL)
+                {
+                  mptr->dependency.forced = TRUE;
+                  moveTo (M2Dependent_user, mptr);
+                }
+              pc += 1;
+              start = pc;
+              count = 0;
+            }
+          else
+            {
+              pc += 1;
+              count += 1;
+            }
+        }
+      if (start != pc)
+        {
+          mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
+          if (mptr != NULL)
+            {
+              mptr->dependency.forced = TRUE;
+              moveTo (M2Dependent_user, mptr);
+            }
+        }
+      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)
+        {
+          Modules.array[M2Dependent_ordered-M2Dependent_unregistered] = appl->next;
+        }
+    }
+}
+
+
+/*
+   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,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.
+                     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;
+  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;
+          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 *) "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, int argc, void * argv, void * envp)
+{
+  M2Dependent_ModuleChain mptr;
+  M2Dependent_ArgCVEnvP nulp;
+
+  CheckInitialized ();
+  traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
+  mptr = LookupModule (M2Dependent_unordered, applicationmodule);
+  if (mptr != NULL)
+    {
+      mptr->dependency.appl = TRUE;
+    }
+  traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
+  DumpModuleData (PreTrace);
+  ResolveDependencies (applicationmodule);
+  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)
+    {
+      traceprintf2 (ModuleTrace, (const char *) "  module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+      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)
+          {
+            traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+          }
+        else
+          {
+            traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+          }
+        if (mptr->dependency.appl)
+          {
+            traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, mptr->name);
+            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, int argc, void * argv, void * envp)
+{
+  M2Dependent_ModuleChain mptr;
+
+  traceprintf2 (ModuleTrace, (const char *) "application module finishing: %s\\n", 34, applicationmodule);
+  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)
+          {
+            traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s for C\\n", 29, mptr->name);
+          }
+        else
+          {
+            traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s\\n", 23, mptr->name);
+          }
+        (*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 * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+  CheckInitialized ();
+  if (! M2LINK_StaticInitialization)
+    {
+      traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
+      moveTo (M2Dependent_unordered, CreateModule (name, init, fini, 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 * dependantmodule)
+{
+  CheckInitialized ();
+  if (! M2LINK_StaticInitialization)
+    {
+      PerformRequestDependant (modulename, dependantmodule);
+    }
+}
+
+extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+  CheckInitialized ();
+}
+
+extern "C" void _M2_M2Dependent_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GM2Dependent.h b/gcc/m2/pge-boot/GM2Dependent.h
new file mode 100644
index 00000000000..7cdbee63d26
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2Dependent.h
@@ -0,0 +1,78 @@
+/* do not edit automatically generated by mc from M2Dependent.  */
+/* M2Dependent.def defines the run time module dependencies interface.
+
+Copyright (C) 2022 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 (_M2Dependent_H)
+#   define _M2Dependent_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_M2Dependent_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
+
+typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
+struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
+
+EXTERN void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, 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 void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*/
+
+EXTERN void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GM2EXCEPTION.c b/gcc/m2/pge-boot/GM2EXCEPTION.c
new file mode 100644
index 00000000000..8c341514555
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2EXCEPTION.c
@@ -0,0 +1,88 @@
+/* do not edit automatically generated by mc from M2EXCEPTION.  */
+/* M2EXCEPTION.mod implement M2Exception and IsM2Exception.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GM2EXCEPTION.h b/gcc/m2/pge-boot/GM2EXCEPTION.h
new file mode 100644
index 00000000000..7289c2b3761
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2EXCEPTION.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from M2EXCEPTION.  */
+/* M2EXCEPTION.def enumerates all exceptions.
+
+Copyright (C) 2001-2021 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 (_M2EXCEPTION_H)
+#   define _M2EXCEPTION_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_M2EXCEPTION_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+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 M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void);
+EXTERN unsigned int M2EXCEPTION_IsM2Exception (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GM2LINK.c b/gcc/m2/pge-boot/GM2LINK.c
new file mode 100644
index 00000000000..302f219ed5f
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2LINK.c
@@ -0,0 +1,27 @@
+/* GM2LINK.c a handwritten module for mc.
+
+Copyright (C) 2022 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;
diff --git a/gcc/m2/pge-boot/GM2LINK.h b/gcc/m2/pge-boot/GM2LINK.h
new file mode 100644
index 00000000000..9807ab19d7e
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2LINK.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from M2LINK.  */
+/* M2LINK.def defines the linking mode used in Modula-2.
+
+Copyright (C) 2022 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 (_M2LINK_H)
+#   define _M2LINK_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_M2LINK_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef char *M2LINK_PtrToChar;
+
+EXTERN M2LINK_PtrToChar M2LINK_ForcedModuleInitOrder;
+EXTERN unsigned int M2LINK_StaticInitialization;
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GM2RTS.c b/gcc/m2/pge-boot/GM2RTS.c
new file mode 100644
index 00000000000..adeb301db59
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2RTS.c
@@ -0,0 +1,747 @@
+/* do not edit automatically generated by mc from M2RTS.  */
+/* M2RTS.mod Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2021 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;
+
+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, int argc, void * argv, void * envp);
+
+/*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, 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, 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 * dependantmodule);
+
+/*
+   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.
+*/
+
+extern "C" void M2RTS_Halt (const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __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 *file_, unsigned int _file_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);
+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);
+
+/*
+   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 (2, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+   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, int argc, void * argv, void * envp)
+{
+  M2Dependent_ConstructModules (applicationmodule, argc, argv, envp);
+}
+
+
+/*
+   DeconstructModules - resolve dependencies and then call each
+                        module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+{
+  M2Dependent_DeconstructModules (applicationmodule, 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, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+  M2Dependent_RegisterModule (name, (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 * dependantmodule)
+{
+  M2Dependent_RequestDependant (modulename, dependantmodule);
+}
+
+
+/*
+   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.
+*/
+
+extern "C" void M2RTS_Halt (const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high)
+{
+  char file[_file_high+1];
+  char function[_function_high+1];
+  char description[_description_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (file, file_, _file_high+1);
+  memcpy (function, function_, _function_high+1);
+  memcpy (description, description_, _description_high+1);
+
+  M2RTS_ErrorMessage ((const char *) description, _description_high, (const char *) file, _file_high, line, (const char *) function, _function_high);
+  M2RTS_HALT (-1);
+  __builtin_unreachable ();
+}
+
+
+/*
+   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 *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high)
+{
+  typedef struct ErrorMessage__T2_a ErrorMessage__T2;
+
+  struct ErrorMessage__T2_a { char array[10+1]; };
+  ErrorMessage__T2 LineNo;
+  char message[_message_high+1];
+  char file[_file_high+1];
+  char function[_function_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (message, message_, _message_high+1);
+  memcpy (file, file_, _file_high+1);
+  memcpy (function, function_, _function_high+1);
+
+  ErrorString ((const char *) file, _file_high);
+  ErrorString ((const char *) ":", 1);
+  NumberIO_CardToStr (line, 0, (char *) &LineNo.array[0], 10);
+  ErrorString ((const char *) &LineNo.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);
+  LineNo.array[0] = ASCII_nl;
+  LineNo.array[1] = ASCII_nul;
+  ErrorString ((const char *) &LineNo.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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GM2RTS.h b/gcc/m2/pge-boot/GM2RTS.h
new file mode 100644
index 00000000000..fd0ffa4ccec
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2RTS.h
@@ -0,0 +1,182 @@
+/* do not edit automatically generated by mc from M2RTS.  */
+/* M2RTS.def Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2021 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 (_M2RTS_H)
+#   define _M2RTS_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_M2RTS_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+EXTERN void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2RTS_DeconstructModules (void * applicationmodule, 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 void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*/
+
+EXTERN void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+
+/*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE is the
+                                 procedure is installed.
+*/
+
+EXTERN unsigned int M2RTS_InstallTerminationProcedure (PROC p);
+
+/*
+   ExecuteInitialProcedures - executes the initial procedures installed
+                              by InstallInitialProcedure.
+*/
+
+EXTERN void M2RTS_ExecuteInitialProcedures (void);
+
+/*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the main
+                             program module.
+*/
+
+EXTERN unsigned int M2RTS_InstallInitialProcedure (PROC p);
+
+/*
+   ExecuteTerminationProcedures - calls each installed termination procedure
+                                  in reverse order.
+*/
+
+EXTERN void M2RTS_ExecuteTerminationProcedures (void);
+
+/*
+   Terminate - provides compatibility for pim.  It call exit with
+               the exitcode provided in a prior call to ExitOnHalt
+               (or zero if ExitOnHalt was never called).  It does
+               not call ExecuteTerminationProcedures.
+*/
+
+EXTERN void M2RTS_Terminate (void) __attribute__ ((noreturn));
+
+/*
+   HALT - terminate the current program.  The procedure Terminate
+          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 void M2RTS_HALT (int exitcode) __attribute__ ((noreturn));
+
+/*
+   Halt - provides a more user friendly version of HALT, which takes
+          four parameters to aid debugging.
+*/
+
+EXTERN void M2RTS_Halt (const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+
+/*
+   ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*/
+
+EXTERN void M2RTS_ExitOnHalt (int e);
+
+/*
+   ErrorMessage - emits an error message to stderr and then calls exit (1).
+*/
+
+EXTERN void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *file_, unsigned int _file_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 unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
+EXTERN void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GNameKey.c b/gcc/m2/pge-boot/GNameKey.c
new file mode 100644
index 00000000000..491c310e721
--- /dev/null
+++ b/gcc/m2/pge-boot/GNameKey.c
@@ -0,0 +1,612 @@
+/* do not edit automatically generated by mc from NameKey.  */
+/* NameKey.mod provides a dynamic binary tree name to key.
+
+Copyright (C) 2001-2022 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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GNameKey.h b/gcc/m2/pge-boot/GNameKey.h
new file mode 100644
index 00000000000..a841d3b83d2
--- /dev/null
+++ b/gcc/m2/pge-boot/GNameKey.h
@@ -0,0 +1,117 @@
+/* do not edit automatically generated by mc from NameKey.  */
+/* NameKey.def provides a dynamic binary tree name to key.
+
+Copyright (C) 2001-2022 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 (_NameKey_H)
+#   define _NameKey_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_NameKey_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define NameKey_NulName 0
+typedef unsigned int NameKey_Name;
+
+
+/*
+   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 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 NameKey_Name NameKey_makekey (void * a);
+
+/*
+   GetKey - returns the name, a, of the key, key.
+*/
+
+EXTERN void NameKey_GetKey (NameKey_Name key, char *a, unsigned int _a_high);
+
+/*
+   LengthKey - returns the StrLen of a Key.
+*/
+
+EXTERN unsigned int NameKey_LengthKey (NameKey_Name Key);
+
+/*
+   IsKey - returns TRUE if string, a, is currently a key.
+*/
+
+EXTERN unsigned int NameKey_IsKey (const char *a_, unsigned int _a_high);
+
+/*
+   WriteKey - Display the symbol represented by Key.
+*/
+
+EXTERN void NameKey_WriteKey (NameKey_Name key);
+
+/*
+   IsSameExcludingCase - returns TRUE if key1 and key2 are
+                         the same. It is case insensitive.
+*/
+
+EXTERN unsigned int NameKey_IsSameExcludingCase (NameKey_Name key1, NameKey_Name key2);
+
+/*
+   KeyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+EXTERN void * NameKey_KeyToCharStar (NameKey_Name key);
+
+/*
+   CharKey - returns the key[i] character.
+*/
+
+EXTERN char NameKey_CharKey (NameKey_Name key, unsigned int i);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GNumberIO.c b/gcc/m2/pge-boot/GNumberIO.c
new file mode 100644
index 00000000000..fb02da9115c
--- /dev/null
+++ b/gcc/m2/pge-boot/GNumberIO.c
@@ -0,0 +1,777 @@
+/* do not edit automatically generated by mc from NumberIO.  */
+/* NumberIO.mod provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GNumberIO.h b/gcc/m2/pge-boot/GNumberIO.h
new file mode 100644
index 00000000000..efebe4ee793
--- /dev/null
+++ b/gcc/m2/pge-boot/GNumberIO.h
@@ -0,0 +1,78 @@
+/* do not edit automatically generated by mc from NumberIO.  */
+/* NumberIO.def provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2021 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 (_NumberIO_H)
+#   define _NumberIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_NumberIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN void NumberIO_ReadCard (unsigned int *x);
+EXTERN void NumberIO_WriteCard (unsigned int x, unsigned int n);
+EXTERN void NumberIO_ReadHex (unsigned int *x);
+EXTERN void NumberIO_WriteHex (unsigned int x, unsigned int n);
+EXTERN void NumberIO_ReadInt (int *x);
+EXTERN void NumberIO_WriteInt (int x, unsigned int n);
+EXTERN void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x);
+EXTERN void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x);
+EXTERN void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x);
+EXTERN void NumberIO_ReadOct (unsigned int *x);
+EXTERN void NumberIO_WriteOct (unsigned int x, unsigned int n);
+EXTERN void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x);
+EXTERN void NumberIO_ReadBin (unsigned int *x);
+EXTERN void NumberIO_WriteBin (unsigned int x, unsigned int n);
+EXTERN void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+EXTERN void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x);
+EXTERN void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x);
+EXTERN void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x);
+EXTERN void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GOutput.c b/gcc/m2/pge-boot/GOutput.c
new file mode 100644
index 00000000000..f2aa3f3d465
--- /dev/null
+++ b/gcc/m2/pge-boot/GOutput.c
@@ -0,0 +1,315 @@
+/* do not edit automatically generated by mc from Output.  */
+/* Output.mod redirect output.
+
+Copyright (C) 2021-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GOutput.h b/gcc/m2/pge-boot/GOutput.h
new file mode 100644
index 00000000000..0c48eddd259
--- /dev/null
+++ b/gcc/m2/pge-boot/GOutput.h
@@ -0,0 +1,119 @@
+/* do not edit automatically generated by mc from Output.  */
+/* Output.def redirect output.
+
+Copyright (C) 2021-2022 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 (_Output_H)
+#   define _Output_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GNameKey.h"
+#   include "GDynamicStrings.h"
+
+#   if defined (_Output_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Open - attempt to open filename as the output file.
+          TRUE is returned if success, FALSE otherwise.
+*/
+
+EXTERN unsigned int Output_Open (const char *filename_, unsigned int _filename_high);
+
+/*
+   Close - close the output file.
+*/
+
+EXTERN void Output_Close (void);
+
+/*
+   Write - write a single character to the output file.
+*/
+
+EXTERN void Output_Write (char ch);
+
+/*
+   WriteString - write an unformatted string to the output.
+*/
+
+EXTERN void Output_WriteString (const char *s_, unsigned int _s_high);
+
+/*
+   KillWriteS - write a string to the output and free the string afterwards.
+*/
+
+EXTERN void Output_KillWriteS (DynamicStrings_String s);
+
+/*
+   WriteS - write a string to the output.  The string is not freed.
+*/
+
+EXTERN void Output_WriteS (DynamicStrings_String s);
+
+/*
+   WriteKey - write a key to the output.
+*/
+
+EXTERN void Output_WriteKey (NameKey_Name key);
+
+/*
+   WriteLn - write a newline to the output.
+*/
+
+EXTERN void Output_WriteLn (void);
+
+/*
+   WriteCard - write a cardinal using fieldlength characters.
+*/
+
+EXTERN void Output_WriteCard (unsigned int card, unsigned int fieldlength);
+
+/*
+   StartBuffer - create a buffer into which any output is redirected.
+*/
+
+EXTERN void Output_StartBuffer (void);
+
+/*
+   EndBuffer - end the redirection and return the contents of the buffer.
+*/
+
+EXTERN DynamicStrings_String Output_EndBuffer (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GPushBackInput.c b/gcc/m2/pge-boot/GPushBackInput.c
new file mode 100644
index 00000000000..835dfe96a4c
--- /dev/null
+++ b/gcc/m2/pge-boot/GPushBackInput.c
@@ -0,0 +1,489 @@
+/* do not edit automatically generated by mc from PushBackInput.  */
+/* PushBackInput.mod provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 61);
+    }
+  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-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 61);
+        }
+    }
+}
+
+
+/*
+   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-git-devel-modula2/gcc/m2/gm2-libs/PushBackInput.mod", 61);
+        }
+    }
+}
+
+
+/*
+   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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GPushBackInput.h b/gcc/m2/pge-boot/GPushBackInput.h
new file mode 100644
index 00000000000..68ab44bf2dd
--- /dev/null
+++ b/gcc/m2/pge-boot/GPushBackInput.h
@@ -0,0 +1,142 @@
+/* do not edit automatically generated by mc from PushBackInput.  */
+/* PushBackInput.def provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2021 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 (_PushBackInput_H)
+#   define _PushBackInput_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GFIO.h"
+#   include "GDynamicStrings.h"
+
+#   if defined (_PushBackInput_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Open - opens a file for reading.
+*/
+
+EXTERN 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 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 char PushBackInput_PutCh (char ch);
+
+/*
+   PutString - pushes a string onto the push back stack.
+*/
+
+EXTERN 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 void PushBackInput_PutStr (DynamicStrings_String s);
+
+/*
+   Error - emits an error message with the appropriate file, line combination.
+*/
+
+EXTERN 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 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 void PushBackInput_WarnString (DynamicStrings_String s);
+
+/*
+   Close - closes the opened file.
+*/
+
+EXTERN void PushBackInput_Close (FIO_File f);
+
+/*
+   GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*/
+
+EXTERN unsigned int PushBackInput_GetExitStatus (void);
+
+/*
+   SetDebug - sets the debug flag on or off.
+*/
+
+EXTERN void PushBackInput_SetDebug (unsigned int d);
+
+/*
+   GetColumnPosition - returns the column position of the current character.
+*/
+
+EXTERN unsigned int PushBackInput_GetColumnPosition (void);
+
+/*
+   GetCurrentLine - returns the current line number.
+*/
+
+EXTERN unsigned int PushBackInput_GetCurrentLine (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GRTExceptions.c b/gcc/m2/pge-boot/GRTExceptions.c
new file mode 100644
index 00000000000..4ab1379af83
--- /dev/null
+++ b/gcc/m2/pge-boot/GRTExceptions.c
@@ -0,0 +1,1224 @@
+/* do not edit automatically generated by mc from RTExceptions.  */
+/* RTExceptions.mod runtime exception handler routines.
+
+Copyright (C) 2008-2021 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);
+
+/*
+   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);
+
+/*
+   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) ();
+    }
+}
+
+
+/*
+   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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 612, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 624, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 636, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 648, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 660, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 672, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 684, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 696, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 708, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 720, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 732, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 744, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 756, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 768, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod")), 780, 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-git-devel-modula2/gcc/m2/gm2-libs/RTExceptions.mod", 60, 598, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+    }
+  else
+    {
+      return currentEHB;
+    }
+  ReturnException ("../../gcc-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+  TidyUp ();
+}
diff --git a/gcc/m2/pge-boot/GRTExceptions.h b/gcc/m2/pge-boot/GRTExceptions.h
new file mode 100644
index 00000000000..6a00a981b90
--- /dev/null
+++ b/gcc/m2/pge-boot/GRTExceptions.h
@@ -0,0 +1,190 @@
+/* do not edit automatically generated by mc from RTExceptions.  */
+/* RTExceptions.def runtime exception handler routines.
+
+Copyright (C) 2008-2021 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 (_RTExceptions_H)
+#   define _RTExceptions_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_RTExceptions_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (RTExceptions_EHBlock_D)
+#  define RTExceptions_EHBlock_D
+   typedef void *RTExceptions_EHBlock;
+#endif
+
+typedef struct RTExceptions_ProcedureHandler_p RTExceptions_ProcedureHandler;
+
+typedef void (*RTExceptions_ProcedureHandler_t) (void);
+struct RTExceptions_ProcedureHandler_p { RTExceptions_ProcedureHandler_t proc; };
+
+
+/*
+   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 void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message);
+
+/*
+   SetExceptionBlock - sets, source, as the active EHB.
+*/
+
+EXTERN void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source);
+
+/*
+   GetExceptionBlock - returns the active EHB.
+*/
+
+EXTERN RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void);
+
+/*
+   GetTextBuffer - returns the address of the EHB buffer.
+*/
+
+EXTERN void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e);
+
+/*
+   GetTextBufferSize - return the size of the EHB text buffer.
+*/
+
+EXTERN unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e);
+
+/*
+   GetNumber - return the exception number associated with,
+               source.
+*/
+
+EXTERN unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source);
+
+/*
+   InitExceptionBlock - creates and returns a new exception block.
+*/
+
+EXTERN RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void);
+
+/*
+   KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*/
+
+EXTERN RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e);
+
+/*
+   PushHandler - install a handler in EHB, e.
+*/
+
+EXTERN void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p);
+
+/*
+   PopHandler - removes the handler associated with, number, from
+                EHB, e.
+*/
+
+EXTERN 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 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 void RTExceptions_BaseExceptionsThrow (void);
+
+/*
+   IsInExceptionState - returns TRUE if the program is currently
+                        in the exception state.
+*/
+
+EXTERN unsigned int RTExceptions_IsInExceptionState (void);
+
+/*
+   SetExceptionState - returns the current exception state and
+                       then sets the current exception state to,
+                       to.
+*/
+
+EXTERN unsigned int RTExceptions_SetExceptionState (unsigned int to);
+
+/*
+   SwitchExceptionState - assigns, from, with the current exception
+                          state and then assigns the current exception
+                          to, to.
+*/
+
+EXTERN void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to);
+
+/*
+   GetBaseExceptionBlock - returns the initial language exception block
+                           created.
+*/
+
+EXTERN RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void);
+
+/*
+   SetExceptionSource - sets the current exception source to, source.
+*/
+
+EXTERN void RTExceptions_SetExceptionSource (void * source);
+
+/*
+   GetExceptionSource - returns the current exception source.
+*/
+
+EXTERN void * RTExceptions_GetExceptionSource (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GRTco.c b/gcc/m2/pge-boot/GRTco.c
new file mode 100644
index 00000000000..f960885d359
--- /dev/null
+++ b/gcc/m2/pge-boot/GRTco.c
@@ -0,0 +1,126 @@
+/* RTco.c provides dummy access to thread primitives.
+
+Copyright (C) 2019-2022 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)
+{
+}
+
+
+EXTERN
+void
+_M2_RTco_init (void)
+{
+}
+
+EXTERN
+void
+_M2_RTco_finish (void)
+{
+}
diff --git a/gcc/m2/pge-boot/GSArgs.h b/gcc/m2/pge-boot/GSArgs.h
new file mode 100644
index 00000000000..d0fcc3760d3
--- /dev/null
+++ b/gcc/m2/pge-boot/GSArgs.h
@@ -0,0 +1,72 @@
+/* do not edit automatically generated by mc from SArgs.  */
+/* SArgs.def provides a String interface to the command line arguments.
+
+Copyright (C) 2001-2021 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 (_SArgs_H)
+#   define _SArgs_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_SArgs_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   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 unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int n);
+
+/*
+   Narg - returns the number of arguments available from
+          command line.
+*/
+
+EXTERN unsigned int SArgs_Narg (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GSEnvironment.h b/gcc/m2/pge-boot/GSEnvironment.h
new file mode 100644
index 00000000000..f3615703921
--- /dev/null
+++ b/gcc/m2/pge-boot/GSEnvironment.h
@@ -0,0 +1,73 @@
+/* do not edit automatically generated by mc from SEnvironment.  */
+/* SEnvironment.def provides access to the environment of a process.
+
+Copyright (C) 2001-2021 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 (_SEnvironment_H)
+#   define _SEnvironment_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_SEnvironment_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   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 unsigned int SEnvironment_GetEnvironment (DynamicStrings_String Env, DynamicStrings_String *dest);
+
+/*
+   PutEnvironment - change or add an environment variable definition EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*/
+
+EXTERN unsigned int SEnvironment_PutEnvironment (DynamicStrings_String EnvDef);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GSFIO.c b/gcc/m2/pge-boot/GSFIO.c
new file mode 100644
index 00000000000..7d204de5305
--- /dev/null
+++ b/gcc/m2/pge-boot/GSFIO.c
@@ -0,0 +1,215 @@
+/* do not edit automatically generated by mc from SFIO.  */
+/* SFIO.mod provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GSFIO.h b/gcc/m2/pge-boot/GSFIO.h
new file mode 100644
index 00000000000..36be78de9fb
--- /dev/null
+++ b/gcc/m2/pge-boot/GSFIO.h
@@ -0,0 +1,110 @@
+/* do not edit automatically generated by mc from SFIO.  */
+/* SFIO.def provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2021 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 (_SFIO_H)
+#   define _SFIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+#   include "GFIO.h"
+
+#   if defined (_SFIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+EXTERN 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 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 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 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 DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s);
+
+/*
+   ReadS - reads a string, s, from, file. It returns the String, s.
+           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 DynamicStrings_String SFIO_ReadS (FIO_File file);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GSYSTEM.c b/gcc/m2/pge-boot/GSYSTEM.c
new file mode 100644
index 00000000000..a2855ac605c
--- /dev/null
+++ b/gcc/m2/pge-boot/GSYSTEM.c
@@ -0,0 +1,38 @@
+/* GSYSTEM.c a handwritten dummy module for mc.
+
+Copyright (C) 2018-2022 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)
+{
+}
diff --git a/gcc/m2/pge-boot/GSYSTEM.h b/gcc/m2/pge-boot/GSYSTEM.h
new file mode 100644
index 00000000000..9f6b1f70461
--- /dev/null
+++ b/gcc/m2/pge-boot/GSYSTEM.h
@@ -0,0 +1,112 @@
+/* do not edit automatically generated by mc from SYSTEM.  */
+/* SYSTEM.def provides access to the SYSTEM dependent module.
+
+Copyright (C) 2001-2021 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 (_SYSTEM_H)
+#   define _SYSTEM_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_SYSTEM_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define SYSTEM_BITSPERBYTE 8
+#   define SYSTEM_BYTESPERWORD 4
+
+/*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*/
+
+EXTERN void SYSTEM_ShiftVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int ShiftCount);
+
+/*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*/
+
+EXTERN void SYSTEM_ShiftLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
+
+/*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*/
+
+EXTERN void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
+
+/*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger
+               sets.
+*/
+
+EXTERN void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount);
+
+/*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*/
+
+EXTERN void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
+
+/*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*/
+
+EXTERN void SYSTEM_RotateRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GScan.h b/gcc/m2/pge-boot/GScan.h
new file mode 100644
index 00000000000..d968eebc50d
--- /dev/null
+++ b/gcc/m2/pge-boot/GScan.h
@@ -0,0 +1,93 @@
+/* do not edit automatically generated by mc from Scan.  */
+/* Scan.def Provides a primitive symbol fetching from input.
+
+Copyright (C) 2001-2021 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 (_Scan_H)
+#   define _Scan_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_Scan_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+ OpenSource - opens a source file for reading.                  */
+
+EXTERN unsigned int Scan_OpenSource (const char *a_, unsigned int _a_high);
+
+/*
+ CloseSource - closes the current source file from reading.     */
+
+EXTERN void Scan_CloseSource (void);
+
+/*
+ GetNextSymbol gets the next source symbol and returns it in a. */
+
+EXTERN void Scan_GetNextSymbol (char *a, unsigned int _a_high);
+EXTERN void Scan_WriteError (const char *a_, unsigned int _a_high);
+
+/*
+   TerminateOnError - exits with status 1 if we call WriteError.
+*/
+
+EXTERN void Scan_TerminateOnError (void);
+
+/*
+   DefineComments - defines the start of comments within the source
+                    file.
+
+                    The characters in Start define the comment start
+                    and characters in End define the end.
+                    The BOOLEAN eoln determine whether the comment
+                    is terminated by end of line. If eoln is TRUE
+                    then End is ignored.
+
+                    If this procedure is never called then no comments
+                    are allowed.
+*/
+
+EXTERN void Scan_DefineComments (const char *Start_, unsigned int _Start_high, const char *End_, unsigned int _End_high, unsigned int eoln);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GSelective.c b/gcc/m2/pge-boot/GSelective.c
new file mode 100644
index 00000000000..17be47c129d
--- /dev/null
+++ b/gcc/m2/pge-boot/GSelective.c
@@ -0,0 +1,275 @@
+/* GSelective.c provides access to select for Modula-2.
+
+Copyright (C) 2016-2022 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 ()
+{
+}
diff --git a/gcc/m2/pge-boot/GStdIO.c b/gcc/m2/pge-boot/GStdIO.c
new file mode 100644
index 00000000000..2d630868597
--- /dev/null
+++ b/gcc/m2/pge-boot/GStdIO.c
@@ -0,0 +1,267 @@
+/* do not edit automatically generated by mc from StdIO.  */
+/* StdIO.mod provides general Read and Write procedures.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/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-git-devel-modula2/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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GStdIO.h b/gcc/m2/pge-boot/GStdIO.h
new file mode 100644
index 00000000000..34a8870c85a
--- /dev/null
+++ b/gcc/m2/pge-boot/GStdIO.h
@@ -0,0 +1,119 @@
+/* do not edit automatically generated by mc from StdIO.  */
+/* StdIO.def provides general Read and Write procedures.
+
+Copyright (C) 2001-2021 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 (_StdIO_H)
+#   define _StdIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_StdIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct StdIO_ProcWrite_p StdIO_ProcWrite;
+
+typedef struct StdIO_ProcRead_p StdIO_ProcRead;
+
+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; };
+
+
+/*
+   Read - is the generic procedure that all higher application layers
+          should use to receive a character.
+*/
+
+EXTERN void StdIO_Read (char *ch);
+
+/*
+   Write - is the generic procedure that all higher application layers
+           should use to emit a character.
+*/
+
+EXTERN 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 void StdIO_PushOutput (StdIO_ProcWrite p);
+
+/*
+   PopOutput - restores Write to use the previous output procedure.
+*/
+
+EXTERN void StdIO_PopOutput (void);
+
+/*
+   GetCurrentOutput - returns the current output procedure.
+*/
+
+EXTERN 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 void StdIO_PushInput (StdIO_ProcRead p);
+
+/*
+   PopInput - restores Write to use the previous output procedure.
+*/
+
+EXTERN void StdIO_PopInput (void);
+
+/*
+   GetCurrentInput - returns the current input procedure.
+*/
+
+EXTERN StdIO_ProcRead StdIO_GetCurrentInput (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GStorage.c b/gcc/m2/pge-boot/GStorage.c
new file mode 100644
index 00000000000..e0e18f3ec10
--- /dev/null
+++ b/gcc/m2/pge-boot/GStorage.c
@@ -0,0 +1,72 @@
+/* do not edit automatically generated by mc from Storage.  */
+/* Storage.mod provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GStorage.h b/gcc/m2/pge-boot/GStorage.h
new file mode 100644
index 00000000000..517f255b236
--- /dev/null
+++ b/gcc/m2/pge-boot/GStorage.h
@@ -0,0 +1,86 @@
+/* do not edit automatically generated by mc from Storage.  */
+/* Storage.def provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2021 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 (_Storage_H)
+#   define _Storage_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_Storage_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   ALLOCATE - attempt to allocate memory from the heap.
+              NIL is returned in, a, if ALLOCATE fails.
+*/
+
+EXTERN void Storage_ALLOCATE (void * *a, unsigned int Size);
+
+/*
+   DEALLOCATE - return, Size, bytes to the heap.
+                The variable, a, is set to NIL.
+*/
+
+EXTERN void Storage_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 void Storage_REALLOCATE (void * *a, unsigned int Size);
+
+/*
+   Available - returns TRUE if, Size, bytes can be allocated.
+*/
+
+EXTERN unsigned int Storage_Available (unsigned int Size);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GStrCase.c b/gcc/m2/pge-boot/GStrCase.c
new file mode 100644
index 00000000000..6e8003a9af0
--- /dev/null
+++ b/gcc/m2/pge-boot/GStrCase.c
@@ -0,0 +1,175 @@
+/* do not edit automatically generated by mc from StrCase.  */
+/* StrCase.mod provides procedure to convert between text case.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GStrCase.h b/gcc/m2/pge-boot/GStrCase.h
new file mode 100644
index 00000000000..6294d60c99a
--- /dev/null
+++ b/gcc/m2/pge-boot/GStrCase.h
@@ -0,0 +1,85 @@
+/* do not edit automatically generated by mc from StrCase.  */
+/* StrCase.def provides procedure to convert between text case.
+
+Copyright (C) 2001-2021 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 (_StrCase_H)
+#   define _StrCase_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_StrCase_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   StrToUpperCase - converts string, a, to uppercase returning the
+                    result in, b.
+*/
+
+EXTERN 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 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 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 char StrCase_Lower (char ch);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GStrIO.c b/gcc/m2/pge-boot/GStrIO.c
new file mode 100644
index 00000000000..180bdb07de5
--- /dev/null
+++ b/gcc/m2/pge-boot/GStrIO.c
@@ -0,0 +1,277 @@
+/* do not edit automatically generated by mc from StrIO.  */
+/* StrIO.mod provides simple string input output routines.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GStrIO.h b/gcc/m2/pge-boot/GStrIO.h
new file mode 100644
index 00000000000..6ec85184705
--- /dev/null
+++ b/gcc/m2/pge-boot/GStrIO.h
@@ -0,0 +1,76 @@
+/* do not edit automatically generated by mc from StrIO.  */
+/* StrIO.def Provides simple string input output routines.
+
+Copyright (C) 2001-2021 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 (_StrIO_H)
+#   define _StrIO_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_StrIO_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   WriteLn - writes a carriage return and a newline
+             character.
+*/
+
+EXTERN 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 void StrIO_ReadString (char *a, unsigned int _a_high);
+
+/*
+   WriteString - writes a string to the default output.
+*/
+
+EXTERN void StrIO_WriteString (const char *a_, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GStrLib.c b/gcc/m2/pge-boot/GStrLib.c
new file mode 100644
index 00000000000..c2c7921c6dd
--- /dev/null
+++ b/gcc/m2/pge-boot/GStrLib.c
@@ -0,0 +1,346 @@
+/* do not edit automatically generated by mc from StrLib.  */
+/* StrLib.mod provides string manipulation procedures.
+
+Copyright (C) 2001-2021 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GStrLib.h b/gcc/m2/pge-boot/GStrLib.h
new file mode 100644
index 00000000000..fa916ecab5f
--- /dev/null
+++ b/gcc/m2/pge-boot/GStrLib.h
@@ -0,0 +1,101 @@
+/* do not edit automatically generated by mc from StrLib.  */
+/* StrLib.def provides string manipulation procedures.
+
+Copyright (C) 2001-2021 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 (_StrLib_H)
+#   define _StrLib_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_StrLib_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   StrConCat - combines a and b into c.
+*/
+
+EXTERN 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 unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+
+/*
+   StrEqual - performs a = b on two strings.
+*/
+
+EXTERN unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+
+/*
+   StrLen - returns the length of string, a.
+*/
+
+EXTERN 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 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 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 void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GStringConvert.h b/gcc/m2/pge-boot/GStringConvert.h
new file mode 100644
index 00000000000..40d6c0bdf16
--- /dev/null
+++ b/gcc/m2/pge-boot/GStringConvert.h
@@ -0,0 +1,317 @@
+/* do not edit automatically generated by mc from StringConvert.  */
+/* StringConvert.def provides functions to convert numbers to and from strings.
+
+Copyright (C) 2001-2021 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 (_StringConvert_H)
+#   define _StringConvert_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_StringConvert_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   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 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
+                      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 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 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 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 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 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 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 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 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 short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+   stoi - decimal string to INTEGER
+*/
+
+EXTERN int StringConvert_stoi (DynamicStrings_String s);
+
+/*
+   itos - integer to decimal string.
+*/
+
+EXTERN DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign);
+
+/*
+   ctos - cardinal to decimal string.
+*/
+
+EXTERN DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding);
+
+/*
+   stoc - decimal string to CARDINAL
+*/
+
+EXTERN unsigned int StringConvert_stoc (DynamicStrings_String s);
+
+/*
+   hstoi - hexidecimal string to INTEGER
+*/
+
+EXTERN int StringConvert_hstoi (DynamicStrings_String s);
+
+/*
+   ostoi - octal string to INTEGER
+*/
+
+EXTERN int StringConvert_ostoi (DynamicStrings_String s);
+
+/*
+   bstoi - binary string to INTEGER
+*/
+
+EXTERN int StringConvert_bstoi (DynamicStrings_String s);
+
+/*
+   hstoc - hexidecimal string to CARDINAL
+*/
+
+EXTERN unsigned int StringConvert_hstoc (DynamicStrings_String s);
+
+/*
+   ostoc - octal string to CARDINAL
+*/
+
+EXTERN unsigned int StringConvert_ostoc (DynamicStrings_String s);
+
+/*
+   bstoc - binary string to CARDINAL
+*/
+
+EXTERN unsigned int StringConvert_bstoc (DynamicStrings_String s);
+
+/*
+   StringToLongreal - returns a LONGREAL and sets found to TRUE
+                      if a legal number is seen.
+*/
+
+EXTERN long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found);
+
+/*
+   LongrealToString - converts a LONGREAL number, Real, which has,
+                      TotalWidth, and FractionWidth into a string.
+
+                      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'
+
+                      If TotalWidth is 0 then the function
+                      will return the value of x which is converted
+                      into as a fixed point number with exhaustive
+                      precision.
+*/
+
+EXTERN DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+   stor - returns a REAL given a string.
+*/
+
+EXTERN double StringConvert_stor (DynamicStrings_String s);
+
+/*
+   stolr - returns a LONGREAL given a string.
+*/
+
+EXTERN 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 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 DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GSymbolKey.c b/gcc/m2/pge-boot/GSymbolKey.c
new file mode 100644
index 00000000000..f164265373e
--- /dev/null
+++ b/gcc/m2/pge-boot/GSymbolKey.c
@@ -0,0 +1,556 @@
+/* do not edit automatically generated by mc from SymbolKey.  */
+/* SymbolKey.mod binary tree operations for storing symbols.
+
+Copyright (C) 2001-2022 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-git-devel-modula2/gcc/m2/gm2-compiler/SymbolKey.mod", 61);
+    }
+  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-git-devel-modula2/gcc/m2/gm2-compiler/SymbolKey.mod", 61);
+    }
+}
+
+
+/*
+   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-git-devel-modula2/gcc/m2/gm2-compiler/SymbolKey.mod", 61);
+    }
+}
+
+
+/*
+   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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GSymbolKey.h b/gcc/m2/pge-boot/GSymbolKey.h
new file mode 100644
index 00000000000..c5cb914bf79
--- /dev/null
+++ b/gcc/m2/pge-boot/GSymbolKey.h
@@ -0,0 +1,141 @@
+/* do not edit automatically generated by mc from SymbolKey.  */
+/* SymbolKey.def binary tree operations for storing symbols.
+
+Copyright (C) 2001-2022 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 (_SymbolKey_H)
+#   define _SymbolKey_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+#   include "GNameKey.h"
+
+#   if defined (_SymbolKey_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define SymbolKey_NulKey 0
+#if !defined (SymbolKey_SymbolTree_D)
+#  define SymbolKey_SymbolTree_D
+   typedef void *SymbolKey_SymbolTree;
+#endif
+
+typedef struct SymbolKey_IsSymbol_p SymbolKey_IsSymbol;
+
+typedef struct SymbolKey_PerformOperation_p SymbolKey_PerformOperation;
+
+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; };
+
+
+/*
+   InitTree - Initializes a SymbolTree pointed to by t.
+*/
+
+EXTERN void SymbolKey_InitTree (SymbolKey_SymbolTree *t);
+
+/*
+   KillTree - Destroys the SymbolTree pointed to by t.
+*/
+
+EXTERN void SymbolKey_KillTree (SymbolKey_SymbolTree *t);
+
+/*
+   GetSymKey - Searches the SymbolTree t for an entry NameKey. If
+               found then the SymKey is returned. NulKey = not found.
+*/
+
+EXTERN unsigned int SymbolKey_GetSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey);
+
+/*
+   PutSymKey - Puts an symbol entry NameKey in the SymbolTree t.
+               SymKey is the value stored with NameKey.
+*/
+
+EXTERN void SymbolKey_PutSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey, unsigned int SymKey);
+
+/*
+   DelSymKey - Deletes a symbol entry NameKey in the SymbolTree t.
+*/
+
+EXTERN void SymbolKey_DelSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey);
+
+/*
+   IsEmptyTree - returns true if SymbolTree, t, is empty.
+*/
+
+EXTERN 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.
+*/
+
+EXTERN 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.
+                   It traverse the tree in order.
+*/
+
+EXTERN void SymbolKey_ForeachNodeDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P);
+
+/*
+   ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*/
+
+EXTERN unsigned int SymbolKey_ContainsSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey);
+
+/*
+   NoOfNodes - returns the number of nodes in the tree t.
+*/
+
+EXTERN 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 void SymbolKey_ForeachNodeConditionDo (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GSysExceptions.c b/gcc/m2/pge-boot/GSysExceptions.c
new file mode 100644
index 00000000000..f6cddf92fe1
--- /dev/null
+++ b/gcc/m2/pge-boot/GSysExceptions.c
@@ -0,0 +1,237 @@
+/* GSysExceptions.c low level module interfacing exceptions to the OS.
+
+Copyright (C) 2016-2022 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_finish (void)
+{
+}
diff --git a/gcc/m2/pge-boot/GSysExceptions.h b/gcc/m2/pge-boot/GSysExceptions.h
new file mode 100644
index 00000000000..c5a9884ed14
--- /dev/null
+++ b/gcc/m2/pge-boot/GSysExceptions.h
@@ -0,0 +1,62 @@
+/* do not edit automatically generated by mc from SysExceptions.  */
+/* SysExceptions.def provides a mechanism for the underlying libraries to.
+
+Copyright (C) 2009-2021 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 (_SysExceptions_H)
+#   define _SysExceptions_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_SysExceptions_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef struct SysExceptions_PROCEXCEPTION_p SysExceptions_PROCEXCEPTION;
+
+typedef void (*SysExceptions_PROCEXCEPTION_t) (void *);
+struct SysExceptions_PROCEXCEPTION_p { SysExceptions_PROCEXCEPTION_t proc; };
+
+EXTERN void SysExceptions_InitExceptionHandlers (SysExceptions_PROCEXCEPTION indexf, SysExceptions_PROCEXCEPTION range, SysExceptions_PROCEXCEPTION casef, SysExceptions_PROCEXCEPTION invalidloc, SysExceptions_PROCEXCEPTION function, SysExceptions_PROCEXCEPTION wholevalue, SysExceptions_PROCEXCEPTION wholediv, SysExceptions_PROCEXCEPTION realvalue, SysExceptions_PROCEXCEPTION realdiv, SysExceptions_PROCEXCEPTION complexvalue, SysExceptions_PROCEXCEPTION complexdiv, SysExceptions_PROCEXCEPTION protection, SysExceptions_PROCEXCEPTION systemf, SysExceptions_PROCEXCEPTION coroutine, SysExceptions_PROCEXCEPTION exception);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GSysStorage.c b/gcc/m2/pge-boot/GSysStorage.c
new file mode 100644
index 00000000000..fe74700ecab
--- /dev/null
+++ b/gcc/m2/pge-boot/GSysStorage.c
@@ -0,0 +1,249 @@
+/* do not edit automatically generated by mc from SysStorage.  */
+/* SysStorage.mod provides dynamic allocation for the system components.
+
+Copyright (C) 2001-2021 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-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 58);
+    }
+  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-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 58);
+        }
+    }
+  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-git-devel-modula2/gcc/m2/gm2-libs/SysStorage.mod", 58);
+        }
+      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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GSysStorage.h b/gcc/m2/pge-boot/GSysStorage.h
new file mode 100644
index 00000000000..ab5872768e0
--- /dev/null
+++ b/gcc/m2/pge-boot/GSysStorage.h
@@ -0,0 +1,95 @@
+/* do not edit automatically generated by mc from SysStorage.  */
+/* SysStorage.def provides dynamic allocation for the system components.
+
+Copyright (C) 2001-2021 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 (_SysStorage_H)
+#   define _SysStorage_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_SysStorage_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   ALLOCATE - attempt to allocate memory from the heap.
+              NIL is returned in, a, if ALLOCATE fails.
+*/
+
+EXTERN void SysStorage_ALLOCATE (void * *a, unsigned int size);
+
+/*
+   DEALLOCATE - return, size, bytes to the heap.
+                The variable, a, is set to NIL.
+*/
+
+EXTERN 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 void SysStorage_REALLOCATE (void * *a, unsigned int size);
+
+/*
+   Available - returns TRUE if, size, bytes can be allocated.
+*/
+
+EXTERN 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 void SysStorage_Init (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GTimeString.h b/gcc/m2/pge-boot/GTimeString.h
new file mode 100644
index 00000000000..6d71e55349b
--- /dev/null
+++ b/gcc/m2/pge-boot/GTimeString.h
@@ -0,0 +1,62 @@
+/* do not edit automatically generated by mc from TimeString.  */
+/* TimeString.def provides time related string manipulation procedures.
+
+Copyright (C) 2001-2021 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 (_TimeString_H)
+#   define _TimeString_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_TimeString_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   GetTimeString - places the time in ascii format into array, a.
+
+*/
+
+EXTERN void TimeString_GetTimeString (char *a, unsigned int _a_high);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GUnixArgs.cc b/gcc/m2/pge-boot/GUnixArgs.cc
new file mode 100644
index 00000000000..1180f351b24
--- /dev/null
+++ b/gcc/m2/pge-boot/GUnixArgs.cc
@@ -0,0 +1,91 @@
+/* UnixArgs.cc record argc, argv as global variables.
+
+Copyright (C) 2009-2022 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 "m2rts.h"
+
+
+extern "C" int UnixArgs_GetArgC (void);
+extern "C" char **UnixArgs_GetArgV (void);
+extern "C" char **UnixArgs_GetEnvV (void);
+
+static int UnixArgs_ArgC;
+static char **UnixArgs_ArgV;
+static char **UnixArgs_EnvV;
+
+
+/* GetArgC returns argc.  */
+
+extern "C" int
+UnixArgs_GetArgC (void)
+{
+  return UnixArgs_ArgC;
+}
+
+
+/* GetArgV returns argv.  */
+
+extern "C" char **
+UnixArgs_GetArgV (void)
+{
+  return UnixArgs_ArgV;
+}
+
+
+/* GetEnvV returns envv.  */
+
+extern "C" char **
+UnixArgs_GetEnvV (void)
+{
+  return UnixArgs_EnvV;
+}
+
+
+extern "C" void
+_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+{
+  UnixArgs_ArgC = argc;
+  UnixArgs_ArgV = argv;
+  UnixArgs_EnvV = envp;
+}
+
+extern "C" void
+_M2_UnixArgs_finish (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_UnixArgs_dep (void)
+{
+}
+
+struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
+
+_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
+{
+  M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_finish,
+			_M2_UnixArgs_dep);
+}
diff --git a/gcc/m2/pge-boot/GUnixArgs.h b/gcc/m2/pge-boot/GUnixArgs.h
new file mode 100644
index 00000000000..4960ba0a232
--- /dev/null
+++ b/gcc/m2/pge-boot/GUnixArgs.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from UnixArgs.  */
+/* UnixArgs.def Implements access to the arguments argc, argv, envp.
+
+Copyright (C) 2001-2021 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 (_UnixArgs_H)
+#   define _UnixArgs_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_UnixArgs_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN int UnixArgs_GetArgC (void);
+EXTERN void * UnixArgs_GetArgV (void);
+EXTERN void * UnixArgs_GetEnvV (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Gabort.c b/gcc/m2/pge-boot/Gabort.c
new file mode 100644
index 00000000000..5ebd94de3ac
--- /dev/null
+++ b/gcc/m2/pge-boot/Gabort.c
@@ -0,0 +1,30 @@
+/* Gabort.c a GCC style abort function.
+
+Copyright (C) 2022 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);
+}
diff --git a/gcc/m2/pge-boot/Gbnflex.c b/gcc/m2/pge-boot/Gbnflex.c
new file mode 100644
index 00000000000..8272826f946
--- /dev/null
+++ b/gcc/m2/pge-boot/Gbnflex.c
@@ -0,0 +1,602 @@
+/* do not edit automatically generated by mc from bnflex.  */
+/* bnflex.mod provides a simple lexical package for pg.
+
+Copyright (C) 2001-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/Gbnflex.h b/gcc/m2/pge-boot/Gbnflex.h
new file mode 100644
index 00000000000..8e55bed0c8c
--- /dev/null
+++ b/gcc/m2/pge-boot/Gbnflex.h
@@ -0,0 +1,147 @@
+/* do not edit automatically generated by mc from bnflex.  */
+/* bnflex.def provides a simple lexical package for pg.
+
+Copyright (C) 2001-2022 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 (_bnflex_H)
+#   define _bnflex_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GNameKey.h"
+
+#   if defined (_bnflex_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+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;
+
+
+/*
+   OpenSource - Attempts to open the source file, a.
+                The success of the operation is returned.
+*/
+
+EXTERN unsigned int bnflex_OpenSource (const char *a_, unsigned int _a_high);
+
+/*
+   CloseSource - Closes the current open file.
+*/
+
+EXTERN void bnflex_CloseSource (void);
+
+/*
+   GetChar - returns the current character on the input stream.
+*/
+
+EXTERN char bnflex_GetChar (void);
+
+/*
+   PutChar - pushes a character onto the push back stack, it also
+             returns the character which has been pushed.
+*/
+
+EXTERN 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 unsigned int bnflex_SymIs (bnflex_TokenType t);
+
+/*
+   IsSym - returns the result of the comparison between the current token
+           type and t.
+*/
+
+EXTERN unsigned int bnflex_IsSym (bnflex_TokenType t);
+
+/*
+   GetCurrentTokenType - returns the type of current token.
+*/
+
+EXTERN bnflex_TokenType bnflex_GetCurrentTokenType (void);
+
+/*
+   GetCurrentToken - returns the NameKey of the current token.
+*/
+
+EXTERN NameKey_Name bnflex_GetCurrentToken (void);
+
+/*
+   SkipUntilWhite - skips all characters until white space is seen.
+*/
+
+EXTERN void bnflex_SkipUntilWhite (void);
+
+/*
+   SkipWhite - skips all white space.
+*/
+
+EXTERN void bnflex_SkipWhite (void);
+
+/*
+   SkipUntilEoln - skips until a lf is seen. It consumes the lf.
+*/
+
+EXTERN void bnflex_SkipUntilEoln (void);
+
+/*
+   AdvanceToken - advances to the next token.
+*/
+
+EXTERN void bnflex_AdvanceToken (void);
+
+/*
+   IsReserved - returns TRUE if the name is a reserved word.
+*/
+
+EXTERN unsigned int bnflex_IsReserved (NameKey_Name name);
+
+/*
+   PushBackToken - pushes a token back onto input.
+*/
+
+EXTERN void bnflex_PushBackToken (NameKey_Name t);
+
+/*
+   SetDebugging - sets the debugging flag.
+*/
+
+EXTERN void bnflex_SetDebugging (unsigned int flag);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Gcbuiltin.c b/gcc/m2/pge-boot/Gcbuiltin.c
new file mode 100644
index 00000000000..76592136c15
--- /dev/null
+++ b/gcc/m2/pge-boot/Gcbuiltin.c
@@ -0,0 +1,173 @@
+/* Gcbuiltin.c provides access to some math intrinsic functions.
+
+Copyright (C) 2016-2022 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);
+}
diff --git a/gcc/m2/pge-boot/Gdtoa.c b/gcc/m2/pge-boot/Gdtoa.c
new file mode 100644
index 00000000000..07ef6be7013
--- /dev/null
+++ b/gcc/m2/pge-boot/Gdtoa.c
@@ -0,0 +1,184 @@
+/* Gdtoa.c provides access to double string conversion.
+
+Copyright (C) 2016-2022 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
diff --git a/gcc/m2/pge-boot/Gdtoa.h b/gcc/m2/pge-boot/Gdtoa.h
new file mode 100644
index 00000000000..6f624ac7304
--- /dev/null
+++ b/gcc/m2/pge-boot/Gdtoa.h
@@ -0,0 +1,76 @@
+/* do not edit automatically generated by mc from dtoa.  */
+/* dtoa.def provides routines to convert between a C double.
+
+Copyright (C) 2008-2021 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 (_dtoa_H)
+#   define _dtoa_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_dtoa_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef enum {dtoa_maxsignificant, dtoa_decimaldigits} dtoa_Mode;
+
+
+/*
+   strtod - returns a REAL given a string, s.  It will set
+            error to TRUE if the number is too large.
+*/
+
+EXTERN double dtoa_strtod (void * s, unsigned int *error);
+
+/*
+   dtoa - converts a REAL, d, into a string.  The address of the
+          string is returned.
+          mode       indicates the type of conversion required.
+          ndigits    determines the number of digits according to mode.
+          decpt      the position of the decimal point.
+          sign       does the string have a sign?
+*/
+
+EXTERN void * dtoa_dtoa (double d, dtoa_Mode mode, int ndigits, int *decpt, unsigned int *sign);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Gerrno.c b/gcc/m2/pge-boot/Gerrno.c
new file mode 100644
index 00000000000..36e577704c5
--- /dev/null
+++ b/gcc/m2/pge-boot/Gerrno.c
@@ -0,0 +1,54 @@
+/* Gerrno.c provides access to errno for Modula-2.
+
+Copyright (C) 2016-2022 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_finish (int argc, char *p)
+{
+}
+
+#   ifdef __cplusplus
+}
+#   endif
diff --git a/gcc/m2/pge-boot/Gerrno.h b/gcc/m2/pge-boot/Gerrno.h
new file mode 100644
index 00000000000..b890d6aa5ca
--- /dev/null
+++ b/gcc/m2/pge-boot/Gerrno.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from errno.  */
+/* errno.def provides a Modula-2 interface to the C errno.
+
+Copyright (C) 2005-2021 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 (_errno_H)
+#   define _errno_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_errno_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#   define errno_EINTR 4
+#   define errno_ERANGE 34
+#   define errno_EAGAIN 11
+EXTERN int errno_geterrno (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Gldtoa.c b/gcc/m2/pge-boot/Gldtoa.c
new file mode 100644
index 00000000000..84e6954af3f
--- /dev/null
+++ b/gcc/m2/pge-boot/Gldtoa.c
@@ -0,0 +1,107 @@
+/* Gldtoa.c provides access to long double string conversion.
+
+Copyright (C) 2016-2022 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
diff --git a/gcc/m2/pge-boot/Gldtoa.h b/gcc/m2/pge-boot/Gldtoa.h
new file mode 100644
index 00000000000..c7b16260b17
--- /dev/null
+++ b/gcc/m2/pge-boot/Gldtoa.h
@@ -0,0 +1,76 @@
+/* do not edit automatically generated by mc from ldtoa.  */
+/* ldtoa.def provides routines to convert between a C long double.
+
+Copyright (C) 2008-2021 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 (_ldtoa_H)
+#   define _ldtoa_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_ldtoa_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef enum {ldtoa_maxsignificant, ldtoa_decimaldigits} ldtoa_Mode;
+
+
+/*
+   strtold - returns a LONGREAL given a C string, s.  It will set
+             error to TRUE if the number is too large or badly formed.
+*/
+
+EXTERN long double ldtoa_strtold (void * s, unsigned int *error);
+
+/*
+   ldtoa - converts a LONGREAL, d, into a string.  The address of the
+           string is returned.
+           mode       indicates the type of conversion required.
+           ndigits    determines the number of digits according to mode.
+           decpt      the position of the decimal point.
+           sign       does the string have a sign?
+*/
+
+EXTERN void * ldtoa_ldtoa (long double d, ldtoa_Mode mode, int ndigits, int *decpt, unsigned int *sign);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Glibc.c b/gcc/m2/pge-boot/Glibc.c
new file mode 100644
index 00000000000..501da7803a1
--- /dev/null
+++ b/gcc/m2/pge-boot/Glibc.c
@@ -0,0 +1,242 @@
+/* Glibc.c provides access to some libc functions.
+
+Copyright (C) 2016-2022 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
+void *
+libc_malloc (unsigned int size)
+{
+  return malloc (size);
+}
+
+EXTERN
+void
+libc_free (void *p)
+{
+  free (p);
+}
+
+EXTERN
+char *
+libc_strcpy (char *dest, char *src)
+{
+  return strcpy (dest, src);
+}
+
+EXTERN
+char *
+libc_strncpy (char *dest, char *src, int n)
+{
+  return strncpy (dest, src, n);
+}
+
+EXTERN
+int
+libc_unlink (char *p)
+{
+  return unlink (p);
+}
+
+EXTERN
+int
+libc_system (char *command)
+{
+  return system (command);
+}
+
+EXTERN
+void *
+libc_memcpy (void *dest, void *src, int n)
+{
+  return memcpy (dest, src, n);
+}
+
+EXTERN
+char *
+libc_getenv (char *name)
+{
+  return getenv (name);
+}
+
+EXTERN
+int
+libc_putenv (char *name)
+{
+  return putenv (name);
+}
+
+EXTERN
+int
+libc_creat (char *p, mode_t mode)
+{
+  return creat (p, mode);
+}
+
+EXTERN
+int
+libc_open (char *p, int flags, mode_t mode)
+{
+  return open (p, flags, mode);
+}
+
+EXTERN
+off_t
+libc_lseek (int fd, off_t offset, int whence)
+{
+  return lseek (fd, offset, whence);
+}
+
+EXTERN
+void *
+libc_realloc (void *ptr, size_t size)
+{
+  return realloc (ptr, size);
+}
+
+EXTERN
+void *
+libc_memset (void *s, int c, size_t n)
+{
+  return memset (s, c, n);
+}
+
+EXTERN
+void *
+libc_memmove (void *dest, void *src, size_t n)
+{
+  return memmove (dest, src, n);
+}
+
+EXTERN
+int
+libc_getpid (void)
+{
+  return getpid ();
+}
+
+EXTERN
+unsigned int
+libc_sleep (unsigned int s)
+{
+  return sleep (s);
+}
+
+EXTERN
+int
+libc_atexit (void (*function) (void))
+{
+  return atexit (function);
+}
diff --git a/gcc/m2/pge-boot/Glibc.h b/gcc/m2/pge-boot/Glibc.h
new file mode 100644
index 00000000000..ad4197066cc
--- /dev/null
+++ b/gcc/m2/pge-boot/Glibc.h
@@ -0,0 +1,412 @@
+/* do not edit automatically generated by mc from libc.  */
+/* libc.def provides an interface to the C library functions.
+
+Copyright (C) 2001-2021 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 (_libc_H)
+#   define _libc_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_libc_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef long int libc_time_t;
+
+typedef struct libc_tm_r libc_tm;
+
+typedef struct libc_timeb_r libc_timeb;
+
+typedef struct libc_exitP_p libc_exitP;
+
+typedef libc_tm *libc_ptrToTM;
+
+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; };
+
+EXTERN ssize_t libc_write (int d, void * buf, size_t nbytes);
+EXTERN ssize_t libc_read (int d, void * buf, size_t nbytes);
+EXTERN int libc_system (void * a);
+
+/*
+     abort - generate a fault
+
+     abort() first closes all open files if possible, then sends
+     an IOT signal to the process.  This signal usually results
+     in termination with a core dump, which may be used for
+     debugging.
+
+     It is possible for abort() to return control if is caught or
+     ignored, in which case the value returned is that of the
+     kill(2V) system call.
+*/
+
+EXTERN void libc_abort (void) __attribute__ ((noreturn));
+
+/*
+     malloc - memory allocator.
+
+     void *malloc(size_t size);
+
+     malloc() returns a pointer to a block of at least size
+     bytes, which is appropriately aligned.  If size is zero,
+     malloc() returns a non-NULL pointer, but this pointer should
+     not be dereferenced.
+*/
+
+EXTERN void * libc_malloc (size_t size);
+
+/*
+     free - memory deallocator.
+
+     free (void *ptr);
+
+     free() releases a previously allocated block.  Its argument
+     is a pointer to a block previously allocated by malloc,
+     calloc, realloc, malloc, or memalign.
+*/
+
+EXTERN void libc_free (void * ptr);
+EXTERN void * libc_realloc (void * ptr, size_t size);
+
+/*
+   isatty - does this descriptor refer to a terminal.
+*/
+
+EXTERN int libc_isatty (int fd);
+
+/*
+   exit - returns control to the invoking process. Result, r, is
+          returned.
+*/
+
+EXTERN void libc_exit (int r) __attribute__ ((noreturn));
+
+/*
+   getenv - returns the C string for the equivalent C environment
+            variable.
+*/
+
+EXTERN void * libc_getenv (void * s);
+
+/*
+   putenv - change or add an environment variable.
+*/
+
+EXTERN int libc_putenv (void * s);
+
+/*
+   getpid - returns the UNIX process identification number.
+*/
+
+EXTERN int libc_getpid (void);
+
+/*
+   dup - duplicates the file descriptor, d.
+*/
+
+EXTERN int libc_dup (int d);
+
+/*
+   close - closes the file descriptor, d.
+*/
+
+EXTERN int libc_close (int d);
+
+/*
+   open - open the file, filename with flag and mode.
+*/
+
+EXTERN int libc_open (void * filename, int oflag, ...);
+
+/*
+   creat - creates a new file
+*/
+
+EXTERN int libc_creat (void * filename, unsigned int mode);
+
+/*
+   lseek - calls unix lseek:
+
+           off_t lseek(int fildes, off_t offset, int whence);
+*/
+
+EXTERN long int libc_lseek (int fd, long int offset, int whence);
+
+/*
+   perror - writes errno and string. (ARRAY OF CHAR is translated onto ADDRESS).
+*/
+
+EXTERN void libc_perror (const char *string_, unsigned int _string_high);
+
+/*
+   readv - reads an io vector of bytes.
+*/
+
+EXTERN int libc_readv (int fd, void * v, int n);
+
+/*
+   writev - writes an io vector of bytes.
+*/
+
+EXTERN int libc_writev (int fd, void * v, int n);
+
+/*
+   getcwd - copies the absolute pathname of the
+            current working directory to the array pointed to by buf,
+            which is of length size.
+
+            If the current absolute path name would require a buffer
+            longer than size elements, NULL is returned, and errno is
+            set to ERANGE; an application should check for this error,
+            and allocate a larger buffer if necessary.
+*/
+
+EXTERN void * libc_getcwd (void * buf, size_t size);
+
+/*
+   chown - The  owner  of  the  file  specified  by  path or by fd is
+           changed.  Only the super-user may change the  owner  of  a
+           file.   The  owner  of  a file may change the group of the
+           file to any group of which that owner is  a  member.   The
+           super-user may change the group arbitrarily.
+
+           If  the owner or group is specified as -1, then that ID is
+           not changed.
+
+           On success, zero is returned.  On error, -1  is  returned,
+           and errno is set appropriately.
+*/
+
+EXTERN int libc_chown (void * filename, int uid, int gid);
+
+/*
+   strlen - returns the length of string, a.
+*/
+
+EXTERN size_t libc_strlen (void * a);
+
+/*
+   strcpy - copies string, src, into, dest.
+            It returns dest.
+*/
+
+EXTERN void * libc_strcpy (void * dest, void * src);
+
+/*
+   strncpy - copies string, src, into, dest, copying at most, n, bytes.
+             It returns dest.
+*/
+
+EXTERN void * libc_strncpy (void * dest, void * src, unsigned int n);
+
+/*
+   unlink - removes file and returns 0 if successful.
+*/
+
+EXTERN int libc_unlink (void * file);
+
+/*
+   memcpy - copy memory area
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memcpy(void *dest, const void *src, size_t n);
+   It returns dest.
+*/
+
+EXTERN void * libc_memcpy (void * dest, void * src, size_t size);
+
+/*
+   memset - fill memory with a constant byte
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memset(void *s, int c, size_t n);
+   It returns s.
+*/
+
+EXTERN void * libc_memset (void * s, int c, size_t size);
+
+/*
+   memmove - copy memory areas which may overlap
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memmove(void *dest, const void *src, size_t n);
+   It returns dest.
+*/
+
+EXTERN void * libc_memmove (void * dest, void * src, size_t size);
+EXTERN int libc_printf (const char *format_, unsigned int _format_high, ...);
+
+/*
+   setenv - sets environment variable, name, to value.
+            It will overwrite an existing value if, overwrite,
+            is true.  It returns 0 on success and -1 for an error.
+*/
+
+EXTERN int libc_setenv (void * name, void * value, int overwrite);
+
+/*
+   srand - initialize the random number seed.
+*/
+
+EXTERN void libc_srand (int seed);
+
+/*
+   rand - return a random integer.
+*/
+
+EXTERN int libc_rand (void);
+
+/*
+   time - returns a pointer to the time_t value. If, a,
+          is not NIL then the libc value is copied into
+          memory at address, a.
+*/
+
+EXTERN libc_time_t libc_time (void * a);
+
+/*
+   localtime - returns a pointer to the libc copy of the tm
+               structure.
+*/
+
+EXTERN void * libc_localtime (libc_time_t *t);
+
+/*
+   ftime - return date and time.
+*/
+
+EXTERN int libc_ftime (libc_timeb *t);
+
+/*
+   shutdown - shutdown a socket, s.
+              if how = 0, then no more reads are allowed.
+              if how = 1, then no more writes are allowed.
+              if how = 2, then mo more reads or writes are allowed.
+*/
+
+EXTERN int libc_shutdown (int s, int how);
+
+/*
+   rename - change the name or location of a file
+*/
+
+EXTERN int libc_rename (void * oldpath, void * newpath);
+
+/*
+   setjmp - returns 0 if returning directly, and non-zero
+            when returning from longjmp using the saved
+            context.
+*/
+
+EXTERN int libc_setjmp (void * env);
+
+/*
+   longjmp - restores the environment saved by the last call
+             of setjmp with the corresponding env argument.
+             After longjmp is completed, program execution
+             continues as if the corresponding call of setjmp
+             had just returned the value val.  The value of
+             val must not be zero.
+*/
+
+EXTERN void libc_longjmp (void * env, int val);
+
+/*
+   atexit - execute, proc, when the function exit is called.
+*/
+
+EXTERN int libc_atexit (libc_exitP_C proc);
+
+/*
+   ttyname - returns a pointer to a string determining the ttyname.
+*/
+
+EXTERN void * libc_ttyname (int filedes);
+
+/*
+   sleep - calling thread sleeps for seconds.
+*/
+
+EXTERN unsigned int libc_sleep (unsigned int seconds);
+
+/*
+   execv - execute a file.
+*/
+
+EXTERN int libc_execv (void * pathname, void * argv);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Glibm.c b/gcc/m2/pge-boot/Glibm.c
new file mode 100644
index 00000000000..16c669386d0
--- /dev/null
+++ b/gcc/m2/pge-boot/Glibm.c
@@ -0,0 +1,224 @@
+/* Glibm.c provides access to some libm functions.
+
+Copyright (C) 2016-2022 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);
+}
diff --git a/gcc/m2/pge-boot/Glibm.h b/gcc/m2/pge-boot/Glibm.h
new file mode 100644
index 00000000000..9fe86a58e0e
--- /dev/null
+++ b/gcc/m2/pge-boot/Glibm.h
@@ -0,0 +1,97 @@
+/* do not edit automatically generated by mc from libm.  */
+/* libm.def provides access to libm.
+
+Copyright (C) 2003-2021 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 (_libm_H)
+#   define _libm_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+
+#   if defined (_libm_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+EXTERN double libm_sin (double x);
+EXTERN long double libm_sinl (long double x);
+EXTERN float libm_sinf (float x);
+EXTERN double libm_cos (double x);
+EXTERN long double libm_cosl (long double x);
+EXTERN float libm_cosf (float x);
+EXTERN double libm_tan (double x);
+EXTERN long double libm_tanl (long double x);
+EXTERN float libm_tanf (float x);
+EXTERN double libm_sqrt (double x);
+EXTERN long double libm_sqrtl (long double x);
+EXTERN float libm_sqrtf (float x);
+EXTERN double libm_asin (double x);
+EXTERN long double libm_asinl (long double x);
+EXTERN float libm_asinf (float x);
+EXTERN double libm_acos (double x);
+EXTERN long double libm_acosl (long double x);
+EXTERN float libm_acosf (float x);
+EXTERN double libm_atan (double x);
+EXTERN long double libm_atanl (long double x);
+EXTERN float libm_atanf (float x);
+EXTERN double libm_atan2 (double x, double y);
+EXTERN long double libm_atan2l (long double x, long double y);
+EXTERN float libm_atan2f (float x, float y);
+EXTERN double libm_exp (double x);
+EXTERN long double libm_expl (long double x);
+EXTERN float libm_expf (float x);
+EXTERN double libm_log (double x);
+EXTERN long double libm_logl (long double x);
+EXTERN float libm_logf (float x);
+EXTERN double libm_exp10 (double x);
+EXTERN long double libm_exp10l (long double x);
+EXTERN float libm_exp10f (float x);
+EXTERN double libm_pow (double x, double y);
+EXTERN long double libm_powl (long double x, long double y);
+EXTERN float libm_powf (float x, float y);
+EXTERN double libm_floor (double x);
+EXTERN long double libm_floorl (long double x);
+EXTERN float libm_floorf (float x);
+EXTERN double libm_ceil (double x);
+EXTERN long double libm_ceill (long double x);
+EXTERN float libm_ceilf (float x);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Gmcrts.c b/gcc/m2/pge-boot/Gmcrts.c
new file mode 100644
index 00000000000..c965e596bfc
--- /dev/null
+++ b/gcc/m2/pge-boot/Gmcrts.c
@@ -0,0 +1,54 @@
+/* Gmcrts.c implements case and return exceptions.
+
+Copyright (C) 2016-2022 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
diff --git a/gcc/m2/pge-boot/Gmcrts.h b/gcc/m2/pge-boot/Gmcrts.h
new file mode 100644
index 00000000000..0e04751d930
--- /dev/null
+++ b/gcc/m2/pge-boot/Gmcrts.h
@@ -0,0 +1,37 @@
+/* Gmcrts.h provides prototypes to case and return exceptions.
+
+Copyright (C) 2016-2022 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(MCRTS_H)
+#define MCRTS_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void CaseException (const char *s, unsigned int high, unsigned int lineno);
+void ReturnException (const char *s, unsigned int high, unsigned int lineno);
+/* void throw (int n);  */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff --git a/gcc/m2/pge-boot/Gnetwork.h b/gcc/m2/pge-boot/Gnetwork.h
new file mode 100644
index 00000000000..6ea86d01e4b
--- /dev/null
+++ b/gcc/m2/pge-boot/Gnetwork.h
@@ -0,0 +1,56 @@
+/* Gnetwork.h provides prototypes to htonl and htons.
+
+Copyright (C) 2016-2022 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(_network_H)
+#define _network_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#if !defined(PROC_D)
+#define PROC_D
+typedef void (*PROC_t) (void);
+typedef struct
+{
+  PROC_t proc;
+} PROC;
+#endif
+
+#if defined(_network_C)
+#define EXTERN
+#else
+#define EXTERN extern
+#endif
+
+/* htons returns a network ordered SHORTCARD.  */
+
+EXTERN short unsigned int network_htons (short unsigned int s);
+
+/* htonl returns a network ordered CARDINAL.  */
+
+EXTERN unsigned int network_htonl (unsigned int s);
+
+#ifdef __cplusplus
+}
+#endif
+
+#undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Gpge.c b/gcc/m2/pge-boot/Gpge.c
new file mode 100644
index 00000000000..bd986846bed
--- /dev/null
+++ b/gcc/m2/pge-boot/Gpge.c
@@ -0,0 +1,9753 @@
+/* do not edit automatically generated by mc from pge.  */
+/* pge.mod master source file of the ebnf parser generator.
+
+Copyright (C) 2003-2022 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-2022 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_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/Gtermios.cc b/gcc/m2/pge-boot/Gtermios.cc
new file mode 100644
index 00000000000..79c22005804
--- /dev/null
+++ b/gcc/m2/pge-boot/Gtermios.cc
@@ -0,0 +1,1947 @@
+/* Gtermios.c handwritten module for mc.
+
+Copyright (C) 2010-2022 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 HAVE_TERMIOS_H
+# include <termios.h>
+#endif
+
+#ifdef TERMIOS_NEEDS_XOPEN_SOURCE
+#define _XOPEN_SOURCE
+#endif
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+#define EXPORT(X) termios##_##X
+
+typedef enum {
+  vintr,
+  vquit,
+  verase,
+  vkill,
+  veof,
+  vtime,
+  vmin,
+  vswtc,
+  vstart,
+  vstop,
+  vsusp,
+  veol,
+  vreprint,
+  vdiscard,
+  vwerase,
+  vlnext,
+  veol2
+} ControlChar;
+
+typedef enum {
+  /* input flag bits.  */
+  ignbrk,
+  ibrkint,
+  ignpar,
+  iparmrk,
+  inpck,
+  istrip,
+  inlcr,
+  igncr,
+  icrnl,
+  iuclc,
+  ixon,
+  ixany,
+  ixoff,
+  imaxbel,
+  /* output flag bits.  */
+  opost,
+  olcuc,
+  onlcr,
+  ocrnl,
+  onocr,
+  onlret,
+  ofill,
+  ofdel,
+  onl0,
+  onl1,
+  ocr0,
+  ocr1,
+  ocr2,
+  ocr3,
+  otab0,
+  otab1,
+  otab2,
+  otab3,
+  obs0,
+  obs1,
+  off0,
+  off1,
+  ovt0,
+  ovt1,
+  /* baud rate.  */
+  b0,
+  b50,
+  b75,
+  b110,
+  b135,
+  b150,
+  b200,
+  b300,
+  b600,
+  b1200,
+  b1800,
+  b2400,
+  b4800,
+  b9600,
+  b19200,
+  b38400,
+  b57600,
+  b115200,
+  b240400,
+  b460800,
+  b500000,
+  b576000,
+  b921600,
+  b1000000,
+  b1152000,
+  b1500000,
+  b2000000,
+  b2500000,
+  b3000000,
+  b3500000,
+  b4000000,
+  maxbaud,
+  crtscts,
+  /* character size.  */
+  cs5,
+  cs6,
+  cs7,
+  cs8,
+  cstopb,
+  cread,
+  parenb,
+  parodd,
+  hupcl,
+  clocal,
+  /* local flags.  */
+  lisig,
+  licanon,
+  lxcase,
+  lecho,
+  lechoe,
+  lechok,
+  lechonl,
+  lnoflsh,
+  ltopstop,
+  lechoctl,
+  lechoprt,
+  lechoke,
+  lflusho,
+  lpendin,
+  liexten
+} Flag;
+
+int
+doSetUnset (tcflag_t *bitset, unsigned int mask, int value)
+{
+  if (value)
+    (*bitset) |= mask;
+  else
+    (*bitset) &= (~mask);
+  return 1;
+}
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* InitTermios - new data structure.  */
+
+void *
+EXPORT (InitTermios) (void)
+{
+  struct termios *p = (struct termios *)malloc (sizeof (struct termios));
+
+  memset (p, 0, sizeof (struct termios));
+  return p;
+}
+
+/* KillTermios - delete data structure.  */
+
+void *
+EXPORT (KillTermios) (struct termios *p)
+{
+  free (p);
+  return NULL;
+}
+
+/* tcsnow - return the value of TCSANOW.  */
+
+int
+EXPORT (tcsnow) (void)
+{
+  return TCSANOW;
+}
+
+/* tcsdrain - return the value of TCSADRAIN.  */
+
+int
+EXPORT (tcsdrain) (void)
+{
+  return TCSADRAIN;
+}
+
+/* tcsflush - return the value of TCSAFLUSH.  */
+
+int
+EXPORT (tcsflush) (void)
+{
+  return TCSAFLUSH;
+}
+
+/* cfgetospeed - return output baud rate.  */
+
+int
+EXPORT (cfgetospeed) (struct termios *t)
+{
+  return cfgetospeed (t);
+}
+
+/* cfgetispeed - return input baud rate.  */
+
+int
+EXPORT (cfgetispeed) (struct termios *t)
+{
+  return cfgetispeed (t);
+}
+
+/* cfsetospeed - set output baud rate.  */
+
+int
+EXPORT (cfsetospeed) (struct termios *t, unsigned int b)
+{
+  return cfsetospeed (t, b);
+}
+
+/* cfsetispeed - set input baud rate.  */
+
+int
+EXPORT (cfsetispeed) (struct termios *t, unsigned int b)
+{
+  return cfsetispeed (t, b);
+}
+
+/* cfsetspeed - set input and output baud rate.  */
+
+int
+EXPORT (cfsetspeed) (struct termios *t, unsigned int b)
+{
+  int val = cfsetispeed (t, b);
+  if (val == 0)
+    return cfsetospeed (t, b);
+  cfsetospeed (t, b);
+  return val;
+}
+
+/* tcgetattr - get state of, fd, into, t.  */
+
+int
+EXPORT (tcgetattr) (int fd, struct termios *t)
+{
+  return tcgetattr (fd, t);
+}
+
+/* tcsetattr - set state of, fd, to, t, using option.  */
+
+int
+EXPORT (tcsetattr) (int fd, int option, struct termios *t)
+{
+  return tcsetattr (fd, option, t);
+}
+
+/* cfmakeraw - sets the terminal to raw mode.  */
+
+void
+EXPORT (cfmakeraw) (struct termios *t)
+{
+#if defined(HAVE_CFMAKERAW)
+  return cfmakeraw (t);
+#endif
+}
+
+/* tcsendbreak - send zero bits for duration.  */
+
+int
+EXPORT (tcsendbreak) (int fd, int duration)
+{
+  return tcsendbreak (fd, duration);
+}
+
+/* tcdrain - waits for pending output to be written on, fd.  */
+
+int
+EXPORT (tcdrain) (int fd)
+{
+  return tcdrain (fd);
+}
+
+/* tcflushi - flush input.  */
+
+int
+EXPORT (tcflushi) (int fd)
+{
+#if defined(TCIFLUSH)
+  return tcflush (fd, TCIFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflusho - flush output.  */
+
+int
+EXPORT (tcflusho) (int fd)
+{
+#if defined(TCOFLUSH)
+  return tcflush (fd, TCOFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflushio - flush input and output.  */
+
+int
+EXPORT (tcflushio) (int fd)
+{
+#if defined(TCIOFLUSH)
+  return tcflush (fd, TCIOFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoni - restart input on, fd.  */
+
+int
+EXPORT (tcflowoni) (int fd)
+{
+#if defined(TCION)
+  return tcflow (fd, TCION);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoffi - stop input on, fd.  */
+
+int
+EXPORT (tcflowoffi) (int fd)
+{
+#if defined(TCIOFF)
+  return tcflow (fd, TCIOFF);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowono - restart output on, fd.  */
+
+int
+EXPORT (tcflowono) (int fd)
+{
+#if defined(TCOON)
+  return tcflow (fd, TCOON);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoffo - stop output on, fd.  */
+
+int
+EXPORT (tcflowoffo) (int fd)
+{
+#if defined(TCOOFF)
+  return tcflow (fd, TCOOFF);
+#else
+  return 1;
+#endif
+}
+
+/* GetFlag - sets a flag value from, t, in, b, and returns TRUE if,
+   t, supports, f.  */
+
+int
+EXPORT (GetFlag) (struct termios *t, Flag f, int *b)
+{
+  switch (f)
+    {
+
+    case ignbrk:
+#if defined(IGNBRK)
+      *b = ((t->c_iflag & IGNBRK) == IGNBRK);
+      return 1;
+#else
+      return 0;
+#endif
+    case ibrkint:
+#if defined(BRKINT)
+      *b = ((t->c_iflag & BRKINT) == BRKINT);
+      return 1;
+#else
+      return 0;
+#endif
+    case ignpar:
+#if defined(IGNPAR)
+      *b = ((t->c_iflag & IGNPAR) == IGNPAR);
+      return 1;
+#else
+      return 0;
+#endif
+    case iparmrk:
+#if defined(PARMRK)
+      *b = ((t->c_iflag & PARMRK) == PARMRK);
+      return 1;
+#else
+      return 0;
+#endif
+    case inpck:
+#if defined(INPCK)
+      *b = ((t->c_iflag & INPCK) == INPCK);
+      return 1;
+#else
+      return 0;
+#endif
+    case istrip:
+#if defined(ISTRIP)
+      *b = ((t->c_iflag & ISTRIP) == ISTRIP);
+      return 1;
+#else
+      return 0;
+#endif
+    case inlcr:
+#if defined(INLCR)
+      *b = ((t->c_iflag & INLCR) == INLCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case igncr:
+#if defined(IGNCR)
+      *b = ((t->c_iflag & IGNCR) == IGNCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case icrnl:
+#if defined(ICRNL)
+      *b = ((t->c_iflag & ICRNL) == ICRNL);
+      return 1;
+#else
+      return 0;
+#endif
+    case iuclc:
+#if defined(IUCLC)
+      *b = ((t->c_iflag & IUCLC) == IUCLC);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixon:
+#if defined(IXON)
+      *b = ((t->c_iflag & IXON) == IXON);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixany:
+#if defined(IXANY)
+      *b = ((t->c_iflag & IXANY) == IXANY);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixoff:
+#if defined(IXOFF)
+      *b = ((t->c_iflag & IXOFF) == IXOFF);
+      return 1;
+#else
+      return 0;
+#endif
+    case imaxbel:
+#if defined(IMAXBEL)
+      *b = ((t->c_iflag & IMAXBEL) == IMAXBEL);
+      return 1;
+#else
+      return 0;
+#endif
+    case opost:
+#if defined(OPOST)
+      *b = ((t->c_oflag & OPOST) == OPOST);
+      return 1;
+#else
+      return 0;
+#endif
+    case olcuc:
+#if defined(OLCUC)
+      *b = ((t->c_oflag & OLCUC) == OLCUC);
+      return 1;
+#else
+      return 0;
+#endif
+    case onlcr:
+#if defined(ONLCR)
+      *b = ((t->c_oflag & ONLCR) == ONLCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocrnl:
+#if defined(OCRNL)
+      *b = ((t->c_oflag & OCRNL) == OCRNL);
+      return 1;
+#else
+      return 0;
+#endif
+    case onocr:
+#if defined(ONOCR)
+      *b = ((t->c_oflag & ONOCR) == ONOCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case onlret:
+#if defined(ONLRET)
+      *b = ((t->c_oflag & ONLRET) == ONLRET);
+      return 1;
+#else
+      return 0;
+#endif
+    case ofill:
+#if defined(OFILL)
+      *b = ((t->c_oflag & OFILL) == OFILL);
+      return 1;
+#else
+      return 0;
+#endif
+    case ofdel:
+#if defined(OFDEL)
+      *b = ((t->c_oflag & OFDEL) == OFDEL);
+      return 1;
+#else
+      return 0;
+#endif
+    case onl0:
+#if defined(NL0)
+      *b = ((t->c_oflag & NL0) == NL0);
+      return 1;
+#else
+      return 0;
+#endif
+    case onl1:
+#if defined(NL1)
+      *b = ((t->c_oflag & NL1) == NL1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr0:
+#if defined(CR0)
+      *b = ((t->c_oflag & CR0) == CR0);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr1:
+#if defined(CR1)
+      *b = ((t->c_oflag & CR1) == CR1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr2:
+#if defined(CR2)
+      *b = ((t->c_oflag & CR2) == CR2);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr3:
+#if defined(CR3)
+      *b = ((t->c_oflag & CR3) == CR3);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab0:
+#if defined(TAB0)
+      *b = ((t->c_oflag & TAB0) == TAB0);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab1:
+#if defined(TAB1)
+      *b = ((t->c_oflag & TAB1) == TAB1);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab2:
+#if defined(TAB2)
+      *b = ((t->c_oflag & TAB2) == TAB2);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab3:
+#if defined(TAB3)
+      *b = ((t->c_oflag & TAB3) == TAB3);
+      return 1;
+#else
+      return 0;
+#endif
+    case obs0:
+#if defined(BS0)
+      *b = ((t->c_oflag & BS0) == BS0);
+      return 1;
+#else
+      return 0;
+#endif
+    case obs1:
+#if defined(BS1)
+      *b = ((t->c_oflag & BS1) == BS1);
+      return 1;
+#else
+      return 0;
+#endif
+    case off0:
+#if defined(FF0)
+      *b = ((t->c_oflag & FF0) == FF0);
+      return 1;
+#else
+      return 0;
+#endif
+    case off1:
+#if defined(FF1)
+      *b = ((t->c_oflag & FF1) == FF1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ovt0:
+#if defined(VT0)
+      *b = ((t->c_oflag & VT0) == VT0);
+      return 1;
+#else
+      return 0;
+#endif
+    case ovt1:
+#if defined(VT1)
+      *b = ((t->c_oflag & VT1) == VT1);
+      return 1;
+#else
+      return 0;
+#endif
+    case b0:
+#if defined(B0)
+      *b = ((t->c_cflag & B0) == B0);
+      return 1;
+#else
+      return 0;
+#endif
+    case b50:
+#if defined(B50)
+      *b = ((t->c_cflag & B50) == B50);
+      return 1;
+#else
+      return 0;
+#endif
+    case b75:
+#if defined(B75)
+      *b = ((t->c_cflag & B75) == B75);
+      return 1;
+#else
+      return 0;
+#endif
+    case b110:
+#if defined(B110)
+      *b = ((t->c_cflag & B110) == B110);
+      return 1;
+#else
+      return 0;
+#endif
+    case b135:
+#if defined(B134)
+      *b = ((t->c_cflag & B134) == B134);
+      return 1;
+#else
+      return 0;
+#endif
+    case b150:
+#if defined(B150)
+      *b = ((t->c_cflag & B150) == B150);
+      return 1;
+#else
+      return 0;
+#endif
+    case b200:
+#if defined(B200)
+      *b = ((t->c_cflag & B200) == B200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b300:
+#if defined(B300)
+      *b = ((t->c_cflag & B300) == B300);
+      return 1;
+#else
+      return 0;
+#endif
+    case b600:
+#if defined(B600)
+      *b = ((t->c_cflag & B600) == B600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1200:
+#if defined(B1200)
+      *b = ((t->c_cflag & B1200) == B1200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1800:
+#if defined(B1800)
+      *b = ((t->c_cflag & B1800) == B1800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2400:
+#if defined(B2400)
+      *b = ((t->c_cflag & B2400) == B2400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b4800:
+#if defined(B4800)
+      *b = ((t->c_cflag & B4800) == B4800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b9600:
+#if defined(B9600)
+      *b = ((t->c_cflag & B9600) == B9600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b19200:
+#if defined(B19200)
+      *b = ((t->c_cflag & B19200) == B19200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b38400:
+#if defined(B38400)
+      *b = ((t->c_cflag & B38400) == B38400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b57600:
+#if defined(B57600)
+      *b = ((t->c_cflag & B57600) == B57600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b115200:
+#if defined(B115200)
+      *b = ((t->c_cflag & B115200) == B115200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b240400:
+#if defined(B230400)
+      *b = ((t->c_cflag & B230400) == B230400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b460800:
+#if defined(B460800)
+      *b = ((t->c_cflag & B460800) == B460800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b500000:
+#if defined(B500000)
+      *b = ((t->c_cflag & B500000) == B500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b576000:
+#if defined(B576000)
+      *b = ((t->c_cflag & B576000) == B576000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b921600:
+#if defined(B921600)
+      *b = ((t->c_cflag & B921600) == B921600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1000000:
+#if defined(B1000000)
+      *b = ((t->c_cflag & B1000000) == B1000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1152000:
+#if defined(B1152000)
+      *b = ((t->c_cflag & B1152000) == B1152000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1500000:
+#if defined(B1500000)
+      *b = ((t->c_cflag & B1500000) == B1500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2000000:
+#if defined(B2000000)
+      *b = ((t->c_cflag & B2000000) == B2000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2500000:
+#if defined(B2500000)
+      *b = ((t->c_cflag & B2500000) == B2500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b3000000:
+#if defined(B3000000)
+      *b = ((t->c_cflag & B3000000) == B3000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b3500000:
+#if defined(B3500000)
+      *b = ((t->c_cflag & B3500000) == B3500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b4000000:
+#if defined(B4000000)
+      *b = ((t->c_cflag & B4000000) == B4000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case maxbaud:
+#if defined(__MAX_BAUD)
+      *b = ((t->c_cflag & __MAX_BAUD) == __MAX_BAUD);
+      return 1;
+#else
+      return 0;
+#endif
+    case crtscts:
+#if defined(CRTSCTS)
+      *b = ((t->c_cflag & CRTSCTS) == CRTSCTS);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs5:
+#if defined(CS5)
+      *b = ((t->c_cflag & CS5) == CS5);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs6:
+#if defined(CS6)
+      *b = ((t->c_cflag & CS6) == CS6);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs7:
+#if defined(CS7)
+      *b = ((t->c_cflag & CS7) == CS7);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs8:
+#if defined(CS8)
+      *b = ((t->c_cflag & CS8) == CS8);
+      return 1;
+#else
+      return 0;
+#endif
+    case cstopb:
+#if defined(CSTOPB)
+      *b = ((t->c_cflag & CSTOPB) == CSTOPB);
+      return 1;
+#else
+      return 0;
+#endif
+    case cread:
+#if defined(CREAD)
+      *b = ((t->c_cflag & CREAD) == CREAD);
+      return 1;
+#else
+      return 0;
+#endif
+    case parenb:
+#if defined(PARENB)
+      *b = ((t->c_cflag & PARENB) == PARENB);
+      return 1;
+#else
+      return 0;
+#endif
+    case parodd:
+#if defined(PARODD)
+      *b = ((t->c_cflag & PARODD) == PARODD);
+      return 1;
+#else
+      return 0;
+#endif
+    case hupcl:
+#if defined(HUPCL)
+      *b = ((t->c_cflag & HUPCL) == HUPCL);
+      return 1;
+#else
+      return 0;
+#endif
+    case clocal:
+#if defined(CLOCAL)
+      *b = ((t->c_cflag & CLOCAL) == CLOCAL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lisig:
+#if defined(ISIG)
+      *b = ((t->c_lflag & ISIG) == ISIG);
+      return 1;
+#else
+      return 0;
+#endif
+    case licanon:
+#if defined(ICANON)
+      *b = ((t->c_lflag & ICANON) == ICANON);
+      return 1;
+#else
+      return 0;
+#endif
+    case lxcase:
+#if defined(XCASE)
+      *b = ((t->c_lflag & XCASE) == XCASE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lecho:
+#if defined(ECHO)
+      *b = ((t->c_lflag & ECHO) == ECHO);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoe:
+#if defined(ECHOE)
+      *b = ((t->c_lflag & ECHOE) == ECHOE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechok:
+#if defined(ECHOK)
+      *b = ((t->c_lflag & ECHOK) == ECHOK);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechonl:
+#if defined(ECHONL)
+      *b = ((t->c_lflag & ECHONL) == ECHONL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lnoflsh:
+#if defined(NOFLSH)
+      *b = ((t->c_lflag & NOFLSH) == NOFLSH);
+      return 1;
+#else
+      return 0;
+#endif
+    case ltopstop:
+#if defined(TOSTOP)
+      *b = ((t->c_lflag & TOSTOP) == TOSTOP);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoctl:
+#if defined(ECHOCTL)
+      *b = ((t->c_lflag & ECHOCTL) == ECHOCTL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoprt:
+#if defined(ECHOPRT)
+      *b = ((t->c_lflag & ECHOPRT) == ECHOPRT);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoke:
+#if defined(ECHOKE)
+      *b = ((t->c_lflag & ECHOKE) == ECHOKE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lflusho:
+#if defined(FLUSHO)
+      *b = ((t->c_lflag & FLUSHO) == FLUSHO);
+      return 1;
+#else
+      return 0;
+#endif
+    case lpendin:
+#if defined(PENDIN)
+      *b = ((t->c_lflag & PENDIN) == PENDIN);
+      return 1;
+#else
+      return 0;
+#endif
+    case liexten:
+#if defined(IEXTEN)
+      *b = ((t->c_lflag & IEXTEN) == IEXTEN);
+      return 1;
+#else
+      return 0;
+#endif
+    }
+  return 0;
+}
+
+/* SetFlag - sets a flag value in, t, to, b, and returns TRUE if this
+   flag value is supported.  */
+
+int
+EXPORT (SetFlag) (struct termios *t, Flag f, int b)
+{
+  switch (f)
+    {
+    case ignbrk:
+#if defined(IGNBRK)
+      return doSetUnset (&t->c_iflag, IGNBRK, b);
+#else
+      return 0;
+#endif
+    case ibrkint:
+#if defined(BRKINT)
+      return doSetUnset (&t->c_iflag, BRKINT, b);
+#else
+      return 0;
+#endif
+    case ignpar:
+#if defined(IGNPAR)
+      return doSetUnset (&t->c_iflag, IGNPAR, b);
+#else
+      return 0;
+#endif
+    case iparmrk:
+#if defined(PARMRK)
+      return doSetUnset (&t->c_iflag, PARMRK, b);
+#else
+      return 0;
+#endif
+    case inpck:
+#if defined(INPCK)
+      return doSetUnset (&t->c_iflag, INPCK, b);
+#else
+      return 0;
+#endif
+    case istrip:
+#if defined(ISTRIP)
+      return doSetUnset (&t->c_iflag, ISTRIP, b);
+#else
+      return 0;
+#endif
+    case inlcr:
+#if defined(INLCR)
+      return doSetUnset (&t->c_iflag, INLCR, b);
+#else
+      return 0;
+#endif
+    case igncr:
+#if defined(IGNCR)
+      return doSetUnset (&t->c_iflag, IGNCR, b);
+#else
+      return 0;
+#endif
+    case icrnl:
+#if defined(ICRNL)
+      return doSetUnset (&t->c_iflag, ICRNL, b);
+#else
+      return 0;
+#endif
+    case iuclc:
+#if defined(IUCLC)
+      return doSetUnset (&t->c_iflag, IUCLC, b);
+#else
+      return 0;
+#endif
+    case ixon:
+#if defined(IXON)
+      return doSetUnset (&t->c_iflag, IXON, b);
+#else
+      return 0;
+#endif
+    case ixany:
+#if defined(IXANY)
+      return doSetUnset (&t->c_iflag, IXANY, b);
+#else
+      return 0;
+#endif
+    case ixoff:
+#if defined(IXOFF)
+      return doSetUnset (&t->c_iflag, IXOFF, b);
+#else
+      return 0;
+#endif
+    case imaxbel:
+#if defined(IMAXBEL)
+      return doSetUnset (&t->c_iflag, IMAXBEL, b);
+#else
+      return 0;
+#endif
+    case opost:
+#if defined(OPOST)
+      return doSetUnset (&t->c_oflag, OPOST, b);
+#else
+      return 0;
+#endif
+    case olcuc:
+#if defined(OLCUC)
+      return doSetUnset (&t->c_oflag, OLCUC, b);
+#else
+      return 0;
+#endif
+    case onlcr:
+#if defined(ONLCR)
+      return doSetUnset (&t->c_oflag, ONLCR, b);
+#else
+      return 0;
+#endif
+    case ocrnl:
+#if defined(OCRNL)
+      return doSetUnset (&t->c_oflag, OCRNL, b);
+#else
+      return 0;
+#endif
+    case onocr:
+#if defined(ONOCR)
+      return doSetUnset (&t->c_oflag, ONOCR, b);
+#else
+      return 0;
+#endif
+    case onlret:
+#if defined(ONLRET)
+      return doSetUnset (&t->c_oflag, ONLRET, b);
+#else
+      return 0;
+#endif
+    case ofill:
+#if defined(OFILL)
+      return doSetUnset (&t->c_oflag, OFILL, b);
+#else
+      return 0;
+#endif
+    case ofdel:
+#if defined(OFDEL)
+      return doSetUnset (&t->c_oflag, OFDEL, b);
+#else
+      return 0;
+#endif
+    case onl0:
+#if defined(NL0)
+      return doSetUnset (&t->c_oflag, NL0, b);
+#else
+      return 0;
+#endif
+    case onl1:
+#if defined(NL1)
+      return doSetUnset (&t->c_oflag, NL1, b);
+#else
+      return 0;
+#endif
+    case ocr0:
+#if defined(CR0)
+      return doSetUnset (&t->c_oflag, CR0, b);
+#else
+      return 0;
+#endif
+    case ocr1:
+#if defined(CR1)
+      return doSetUnset (&t->c_oflag, CR1, b);
+#else
+      return 0;
+#endif
+    case ocr2:
+#if defined(CR2)
+      return doSetUnset (&t->c_oflag, CR2, b);
+#else
+      return 0;
+#endif
+    case ocr3:
+#if defined(CR3)
+      return doSetUnset (&t->c_oflag, CR3, b);
+#else
+      return 0;
+#endif
+    case otab0:
+#if defined(TAB0)
+      return doSetUnset (&t->c_oflag, TAB0, b);
+#else
+      return 0;
+#endif
+    case otab1:
+#if defined(TAB1)
+      return doSetUnset (&t->c_oflag, TAB1, b);
+#else
+      return 0;
+#endif
+    case otab2:
+#if defined(TAB2)
+      return doSetUnset (&t->c_oflag, TAB2, b);
+#else
+      return 0;
+#endif
+    case otab3:
+#if defined(TAB3)
+      return doSetUnset (&t->c_oflag, TAB3, b);
+#else
+      return 0;
+#endif
+    case obs0:
+#if defined(BS0)
+      return doSetUnset (&t->c_oflag, BS0, b);
+#else
+      return 0;
+#endif
+    case obs1:
+#if defined(BS1)
+      return doSetUnset (&t->c_oflag, BS1, b);
+#else
+      return 0;
+#endif
+    case off0:
+#if defined(FF0)
+      return doSetUnset (&t->c_oflag, FF0, b);
+#else
+      return 0;
+#endif
+    case off1:
+#if defined(FF1)
+      return doSetUnset (&t->c_oflag, FF1, b);
+#else
+      return 0;
+#endif
+    case ovt0:
+#if defined(VT0)
+      return doSetUnset (&t->c_oflag, VT0, b);
+#else
+      return 0;
+#endif
+    case ovt1:
+#if defined(VT1)
+      return doSetUnset (&t->c_oflag, VT1, b);
+#else
+      return 0;
+#endif
+    case b0:
+#if defined(B0)
+      return doSetUnset (&t->c_cflag, B0, b);
+#else
+      return 0;
+#endif
+    case b50:
+#if defined(B50)
+      return doSetUnset (&t->c_cflag, B50, b);
+#else
+      return 0;
+#endif
+    case b75:
+#if defined(B75)
+      return doSetUnset (&t->c_cflag, B75, b);
+#else
+      return 0;
+#endif
+    case b110:
+#if defined(B110)
+      return doSetUnset (&t->c_cflag, B110, b);
+#else
+      return 0;
+#endif
+    case b135:
+#if defined(B134)
+      return doSetUnset (&t->c_cflag, B134, b);
+#else
+      return 0;
+#endif
+    case b150:
+#if defined(B150)
+      return doSetUnset (&t->c_cflag, B150, b);
+#else
+      return 0;
+#endif
+    case b200:
+#if defined(B200)
+      return doSetUnset (&t->c_cflag, B200, b);
+#else
+      return 0;
+#endif
+    case b300:
+#if defined(B300)
+      return doSetUnset (&t->c_cflag, B300, b);
+#else
+      return 0;
+#endif
+    case b600:
+#if defined(B600)
+      return doSetUnset (&t->c_cflag, B600, b);
+#else
+      return 0;
+#endif
+    case b1200:
+#if defined(B1200)
+      return doSetUnset (&t->c_cflag, B1200, b);
+#else
+      return 0;
+#endif
+    case b1800:
+#if defined(B1800)
+      return doSetUnset (&t->c_cflag, B1800, b);
+#else
+      return 0;
+#endif
+    case b2400:
+#if defined(B2400)
+      return doSetUnset (&t->c_cflag, B2400, b);
+#else
+      return 0;
+#endif
+    case b4800:
+#if defined(B4800)
+      return doSetUnset (&t->c_cflag, B4800, b);
+#else
+      return 0;
+#endif
+    case b9600:
+#if defined(B9600)
+      return doSetUnset (&t->c_cflag, B9600, b);
+#else
+      return 0;
+#endif
+    case b19200:
+#if defined(B19200)
+      return doSetUnset (&t->c_cflag, B19200, b);
+#else
+      return 0;
+#endif
+    case b38400:
+#if defined(B38400)
+      return doSetUnset (&t->c_cflag, B38400, b);
+#else
+      return 0;
+#endif
+    case b57600:
+#if defined(B57600)
+      return doSetUnset (&t->c_cflag, B57600, b);
+#else
+      return 0;
+#endif
+    case b115200:
+#if defined(B115200)
+      return doSetUnset (&t->c_cflag, B115200, b);
+#else
+      return 0;
+#endif
+    case b240400:
+#if defined(B230400)
+      return doSetUnset (&t->c_cflag, B230400, b);
+#else
+      return 0;
+#endif
+    case b460800:
+#if defined(B460800)
+      return doSetUnset (&t->c_cflag, B460800, b);
+#else
+      return 0;
+#endif
+    case b500000:
+#if defined(B500000)
+      return doSetUnset (&t->c_cflag, B500000, b);
+#else
+      return 0;
+#endif
+    case b576000:
+#if defined(B576000)
+      return doSetUnset (&t->c_cflag, B576000, b);
+#else
+      return 0;
+#endif
+    case b921600:
+#if defined(B921600)
+      return doSetUnset (&t->c_cflag, B921600, b);
+#else
+      return 0;
+#endif
+    case b1000000:
+#if defined(B1000000)
+      return doSetUnset (&t->c_cflag, B1000000, b);
+#else
+      return 0;
+#endif
+    case b1152000:
+#if defined(B1152000)
+      return doSetUnset (&t->c_cflag, B1152000, b);
+#else
+      return 0;
+#endif
+    case b1500000:
+#if defined(B1500000)
+      return doSetUnset (&t->c_cflag, B1500000, b);
+#else
+      return 0;
+#endif
+    case b2000000:
+#if defined(B2000000)
+      return doSetUnset (&t->c_cflag, B2000000, b);
+#else
+      return 0;
+#endif
+    case b2500000:
+#if defined(B2500000)
+      return doSetUnset (&t->c_cflag, B2500000, b);
+#else
+      return 0;
+#endif
+    case b3000000:
+#if defined(B3000000)
+      return doSetUnset (&t->c_cflag, B3000000, b);
+#else
+      return 0;
+#endif
+    case b3500000:
+#if defined(B3500000)
+      return doSetUnset (&t->c_cflag, B3500000, b);
+#else
+      return 0;
+#endif
+    case b4000000:
+#if defined(B4000000)
+      return doSetUnset (&t->c_cflag, B4000000, b);
+#else
+      return 0;
+#endif
+    case maxbaud:
+#if defined(__MAX_BAUD)
+      return doSetUnset (&t->c_cflag, __MAX_BAUD, b);
+#else
+      return 0;
+#endif
+    case crtscts:
+#if defined(CRTSCTS)
+      return doSetUnset (&t->c_cflag, CRTSCTS, b);
+#else
+      return 0;
+#endif
+    case cs5:
+#if defined(CS5)
+      return doSetUnset (&t->c_cflag, CS5, b);
+#else
+      return 0;
+#endif
+    case cs6:
+#if defined(CS6)
+      return doSetUnset (&t->c_cflag, CS6, b);
+#else
+      return 0;
+#endif
+    case cs7:
+#if defined(CS7)
+      return doSetUnset (&t->c_cflag, CS7, b);
+#else
+      return 0;
+#endif
+    case cs8:
+#if defined(CS8)
+      return doSetUnset (&t->c_cflag, CS8, b);
+#else
+      return 0;
+#endif
+    case cstopb:
+#if defined(CSTOPB)
+      return doSetUnset (&t->c_cflag, CSTOPB, b);
+#else
+      return 0;
+#endif
+    case cread:
+#if defined(CREAD)
+      return doSetUnset (&t->c_cflag, CREAD, b);
+#else
+      return 0;
+#endif
+    case parenb:
+#if defined(PARENB)
+      return doSetUnset (&t->c_cflag, PARENB, b);
+#else
+      return 0;
+#endif
+    case parodd:
+#if defined(PARODD)
+      return doSetUnset (&t->c_cflag, PARODD, b);
+#else
+      return 0;
+#endif
+    case hupcl:
+#if defined(HUPCL)
+      return doSetUnset (&t->c_cflag, HUPCL, b);
+#else
+      return 0;
+#endif
+    case clocal:
+#if defined(CLOCAL)
+      return doSetUnset (&t->c_cflag, CLOCAL, b);
+#else
+      return 0;
+#endif
+    case lisig:
+#if defined(ISIG)
+      return doSetUnset (&t->c_lflag, ISIG, b);
+#else
+      return 0;
+#endif
+    case licanon:
+#if defined(ICANON)
+      return doSetUnset (&t->c_lflag, ICANON, b);
+#else
+      return 0;
+#endif
+    case lxcase:
+#if defined(XCASE)
+      return doSetUnset (&t->c_lflag, XCASE, b);
+#else
+      return 0;
+#endif
+    case lecho:
+#if defined(ECHO)
+      return doSetUnset (&t->c_lflag, ECHO, b);
+#else
+      return 0;
+#endif
+    case lechoe:
+#if defined(ECHOE)
+      return doSetUnset (&t->c_lflag, ECHOE, b);
+#else
+      return 0;
+#endif
+    case lechok:
+#if defined(ECHOK)
+      return doSetUnset (&t->c_lflag, ECHOK, b);
+#else
+      return 0;
+#endif
+    case lechonl:
+#if defined(ECHONL)
+      return doSetUnset (&t->c_lflag, ECHONL, b);
+#else
+      return 0;
+#endif
+    case lnoflsh:
+#if defined(NOFLSH)
+      return doSetUnset (&t->c_lflag, NOFLSH, b);
+#else
+      return 0;
+#endif
+    case ltopstop:
+#if defined(TOSTOP)
+      return doSetUnset (&t->c_lflag, TOSTOP, b);
+#else
+      return 0;
+#endif
+    case lechoctl:
+#if defined(ECHOCTL)
+      return doSetUnset (&t->c_lflag, ECHOCTL, b);
+#else
+      return 0;
+#endif
+    case lechoprt:
+#if defined(ECHOPRT)
+      return doSetUnset (&t->c_lflag, ECHOPRT, b);
+#else
+      return 0;
+#endif
+    case lechoke:
+#if defined(ECHOKE)
+      return doSetUnset (&t->c_lflag, ECHOKE, b);
+#else
+      return 0;
+#endif
+    case lflusho:
+#if defined(FLUSHO)
+      return doSetUnset (&t->c_lflag, FLUSHO, b);
+#else
+      return 0;
+#endif
+    case lpendin:
+#if defined(PENDIN)
+      return doSetUnset (&t->c_lflag, PENDIN, b);
+#else
+      return 0;
+#endif
+    case liexten:
+#if defined(IEXTEN)
+      return doSetUnset (&t->c_lflag, IEXTEN, b);
+#else
+      return 0;
+#endif
+    }
+  return 0;
+}
+
+/* GetChar - sets a CHAR, ch, value from, t, and returns TRUE if this
+   value is supported.  */
+
+int
+EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch)
+{
+  switch (c)
+    {
+
+    case vintr:
+#if defined(VINTR)
+      *ch = t->c_cc[VINTR];
+      return 1;
+#else
+      return 0;
+#endif
+    case vquit:
+#if defined(VQUIT)
+      *ch = t->c_cc[VQUIT];
+      return 1;
+#else
+      return 0;
+#endif
+    case verase:
+#if defined(VERASE)
+      *ch = t->c_cc[VERASE];
+      return 1;
+#else
+      return 0;
+#endif
+    case vkill:
+#if defined(VKILL)
+      *ch = t->c_cc[VKILL];
+      return 1;
+#else
+      return 0;
+#endif
+    case veof:
+#if defined(VEOF)
+      *ch = t->c_cc[VEOF];
+      return 1;
+#else
+      return 0;
+#endif
+    case vtime:
+#if defined(VTIME)
+      *ch = t->c_cc[VTIME];
+      return 1;
+#else
+      return 0;
+#endif
+    case vmin:
+#if defined(VMIN)
+      *ch = t->c_cc[VMIN];
+      return 1;
+#else
+      return 0;
+#endif
+    case vswtc:
+#if defined(VSWTC)
+      *ch = t->c_cc[VSWTC];
+      return 1;
+#else
+      return 0;
+#endif
+    case vstart:
+#if defined(VSTART)
+      *ch = t->c_cc[VSTART];
+      return 1;
+#else
+      return 0;
+#endif
+    case vstop:
+#if defined(VSTOP)
+      *ch = t->c_cc[VSTOP];
+      return 1;
+#else
+      return 0;
+#endif
+    case vsusp:
+#if defined(VSUSP)
+      *ch = t->c_cc[VSUSP];
+      return 1;
+#else
+      return 0;
+#endif
+    case veol:
+#if defined(VEOL)
+      *ch = t->c_cc[VEOL];
+      return 1;
+#else
+      return 0;
+#endif
+    case vreprint:
+#if defined(VREPRINT)
+      *ch = t->c_cc[VREPRINT];
+      return 1;
+#else
+      return 0;
+#endif
+    case vdiscard:
+#if defined(VDISCARD)
+      *ch = t->c_cc[VDISCARD];
+      return 1;
+#else
+      return 0;
+#endif
+    case vwerase:
+#if defined(VWERASE)
+      *ch = t->c_cc[VWERASE];
+      return 1;
+#else
+      return 0;
+#endif
+    case vlnext:
+#if defined(VLNEXT)
+      *ch = t->c_cc[VLNEXT];
+      return 1;
+#else
+      return 0;
+#endif
+    case veol2:
+#if defined(VEOL2)
+      *ch = t->c_cc[VEOL2];
+      return 1;
+#else
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+
+/* SetChar - sets a CHAR value in, t, and returns TRUE if, c, is
+   supported.  */
+
+int
+EXPORT (SetChar) (struct termios *t, ControlChar c, char ch)
+{
+  switch (c)
+    {
+
+    case vintr:
+#if defined(VINTR)
+      t->c_cc[VINTR] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vquit:
+#if defined(VQUIT)
+      t->c_cc[VQUIT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case verase:
+#if defined(VERASE)
+      t->c_cc[VERASE] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vkill:
+#if defined(VKILL)
+      t->c_cc[VKILL] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veof:
+#if defined(VEOF)
+      t->c_cc[VEOF] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vtime:
+#if defined(VTIME)
+      t->c_cc[VTIME] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vmin:
+#if defined(VMIN)
+      t->c_cc[VMIN] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vswtc:
+#if defined(VSWTC)
+      t->c_cc[VSWTC] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vstart:
+#if defined(VSTART)
+      t->c_cc[VSTART] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vstop:
+#if defined(VSTOP)
+      t->c_cc[VSTOP] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vsusp:
+#if defined(VSUSP)
+      t->c_cc[VSUSP] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veol:
+#if defined(VEOL)
+      t->c_cc[VEOL] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vreprint:
+#if defined(VREPRINT)
+      t->c_cc[VREPRINT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vdiscard:
+#if defined(VDISCARD)
+      t->c_cc[VDISCARD] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vwerase:
+#if defined(VWERASE)
+      t->c_cc[VWERASE] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vlnext:
+#if defined(VLNEXT)
+      t->c_cc[VLNEXT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veol2:
+#if defined(VEOL2)
+      t->c_cc[VEOL2] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+
+void
+_M2_termios_init (void)
+{
+}
+
+void
+_M2_termios_finish (void)
+{
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/pge-boot/Gtermios.h b/gcc/m2/pge-boot/Gtermios.h
new file mode 100644
index 00000000000..e8b79774187
--- /dev/null
+++ b/gcc/m2/pge-boot/Gtermios.h
@@ -0,0 +1,207 @@
+/* do not edit automatically generated by mc from termios.  */
+/* termios.def provides a procedural interface to termios.
+
+Copyright (C) 2005-2021 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 (_termios_H)
+#   define _termios_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_termios_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef void *termios_TERMIOS;
+
+typedef enum {termios_vintr, termios_vquit, termios_verase, termios_vkill, termios_veof, termios_vtime, termios_vmin, termios_vswtc, termios_vstart, termios_vstop, termios_vsusp, termios_veol, termios_vreprint, termios_vdiscard, termios_vwerase, termios_vlnext, termios_veol2} termios_ControlChar;
+
+typedef enum {termios_ignbrk, termios_ibrkint, termios_ignpar, termios_iparmrk, termios_inpck, termios_istrip, termios_inlcr, termios_igncr, termios_icrnl, termios_iuclc, termios_ixon, termios_ixany, termios_ixoff, termios_imaxbel, termios_opost, termios_olcuc, termios_onlcr, termios_ocrnl, termios_onocr, termios_onlret, termios_ofill, termios_ofdel, termios_onl0, termios_onl1, termios_ocr0, termios_ocr1, termios_ocr2, termios_ocr3, termios_otab0, termios_otab1, termios_otab2, termios_otab3, termios_obs0, termios_obs1, termios_off0, termios_off1, termios_ovt0, termios_ovt1, termios_b0, termios_b50, termios_b75, termios_b110, termios_b135, termios_b150, termios_b200, termios_b300, termios_b600, termios_b1200, termios_b1800, termios_b2400, termios_b4800, termios_b9600, termios_b19200, termios_b38400, termios_b57600, termios_b115200, termios_b240400, termios_b460800, termios_b500000, termios_b576000, termios_b921600, termios_b1000000, termios_b1152000, termios_b1500000, termios_b2000000, termios_b2500000, termios_b3000000, termios_b3500000, termios_b4000000, termios_maxbaud, termios_crtscts, termios_cs5, termios_cs6, termios_cs7, termios_cs8, termios_cstopb, termios_cread, termios_parenb, termios_parodd, termios_hupcl, termios_clocal, termios_lisig, termios_licanon, termios_lxcase, termios_lecho, termios_lechoe, termios_lechok, termios_lechonl, termios_lnoflsh, termios_ltopstop, termios_lechoctl, termios_lechoprt, termios_lechoke, termios_lflusho, termios_lpendin, termios_liexten} termios_Flag;
+
+
+/*
+   InitTermios - new data structure.
+*/
+
+EXTERN termios_TERMIOS termios_InitTermios (void);
+
+/*
+   KillTermios - delete data structure.
+*/
+
+EXTERN termios_TERMIOS termios_KillTermios (termios_TERMIOS t);
+
+/*
+   cfgetospeed - return output baud rate.
+*/
+
+EXTERN int termios_cfgetospeed (termios_TERMIOS t);
+
+/*
+   cfgetispeed - return input baud rate.
+*/
+
+EXTERN int termios_cfgetispeed (termios_TERMIOS t);
+
+/*
+   cfsetospeed - set output baud rate.
+*/
+
+EXTERN int termios_cfsetospeed (termios_TERMIOS t, unsigned int b);
+
+/*
+   cfsetispeed - set input baud rate.
+*/
+
+EXTERN int termios_cfsetispeed (termios_TERMIOS t, unsigned int b);
+
+/*
+   cfsetspeed - set input and output baud rate.
+*/
+
+EXTERN int termios_cfsetspeed (termios_TERMIOS t, unsigned int b);
+
+/*
+   tcgetattr - get state of, fd, into, t.
+*/
+
+EXTERN int termios_tcgetattr (int fd, termios_TERMIOS t);
+EXTERN int termios_tcsnow (void);
+EXTERN int termios_tcsdrain (void);
+EXTERN int termios_tcsflush (void);
+
+/*
+   tcsetattr - set state of, fd, to, t, using option.
+*/
+
+EXTERN int termios_tcsetattr (int fd, int option, termios_TERMIOS t);
+
+/*
+   cfmakeraw - sets, t, to raw mode.
+*/
+
+EXTERN void termios_cfmakeraw (termios_TERMIOS t);
+
+/*
+   tcsendbreak - send zero bits for duration.
+*/
+
+EXTERN int termios_tcsendbreak (int fd, int duration);
+
+/*
+   tcdrain - waits for pending output to be written on, fd.
+*/
+
+EXTERN int termios_tcdrain (int fd);
+
+/*
+   tcflushi - flush input.
+*/
+
+EXTERN int termios_tcflushi (int fd);
+
+/*
+   tcflusho - flush output.
+*/
+
+EXTERN int termios_tcflusho (int fd);
+
+/*
+   tcflushio - flush input and output.
+*/
+
+EXTERN int termios_tcflushio (int fd);
+
+/*
+   tcflowoni - restart input on, fd.
+*/
+
+EXTERN int termios_tcflowoni (int fd);
+
+/*
+   tcflowoffi - stop input on, fd.
+*/
+
+EXTERN int termios_tcflowoffi (int fd);
+
+/*
+   tcflowono - restart output on, fd.
+*/
+
+EXTERN int termios_tcflowono (int fd);
+
+/*
+   tcflowoffo - stop output on, fd.
+*/
+
+EXTERN int termios_tcflowoffo (int fd);
+
+/*
+   GetFlag - sets a flag value from, t, in, b, and returns TRUE
+             if, t, supports, f.
+*/
+
+EXTERN unsigned int termios_GetFlag (termios_TERMIOS t, termios_Flag f, unsigned int *b);
+
+/*
+   SetFlag - sets a flag value in, t, to, b, and returns TRUE if
+             this flag value is supported.
+*/
+
+EXTERN unsigned int termios_SetFlag (termios_TERMIOS t, termios_Flag f, unsigned int b);
+
+/*
+   GetChar - sets a CHAR, ch, value from, t, and returns TRUE if
+             this value is supported.
+*/
+
+EXTERN unsigned int termios_GetChar (termios_TERMIOS t, termios_ControlChar c, char *ch);
+
+/*
+   SetChar - sets a CHAR value in, t, and returns TRUE if, c,
+             is supported.
+*/
+
+EXTERN unsigned int termios_SetChar (termios_TERMIOS t, termios_ControlChar c, char ch);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/Gwrapc.c b/gcc/m2/pge-boot/Gwrapc.c
new file mode 100644
index 00000000000..d98a5e41102
--- /dev/null
+++ b/gcc/m2/pge-boot/Gwrapc.c
@@ -0,0 +1,183 @@
+/* Gwrapc.c wrap libc functions for mc.
+
+Copyright (C) 2005-2022 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
diff --git a/gcc/m2/pge-boot/Gwrapc.h b/gcc/m2/pge-boot/Gwrapc.h
new file mode 100644
index 00000000000..8bd4a2d81f8
--- /dev/null
+++ b/gcc/m2/pge-boot/Gwrapc.h
@@ -0,0 +1,125 @@
+/* do not edit automatically generated by mc from wrapc.  */
+/* wrapc.def provides access to more of the C library.
+
+Copyright (C) 2001-2021 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 (_wrapc_H)
+#   define _wrapc_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_wrapc_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+
+/*
+   strtime - returns the C string for the equivalent C asctime
+             function.
+*/
+
+EXTERN void * wrapc_strtime (void);
+
+/*
+   filesize - assigns the size of a file, f, into low, high and
+              returns zero if successful.
+*/
+
+EXTERN int wrapc_filesize (int f, unsigned int *low, unsigned int *high);
+
+/*
+   fileinode - return the inode associated with file, f.
+*/
+
+EXTERN int wrapc_fileinode (int f, unsigned int *low, unsigned int *high);
+
+/*
+   filemtime - returns the mtime of a file, f.
+*/
+
+EXTERN int wrapc_filemtime (int f);
+
+/*
+   getrand - returns a random number between 0..n-1
+*/
+
+EXTERN int wrapc_getrand (int n);
+
+/*
+   getusername - returns a C string describing the current user.
+*/
+
+EXTERN void * wrapc_getusername (void);
+
+/*
+   getnameuidgid - fills in the, uid, and, gid, which represents
+                   user, name.
+*/
+
+EXTERN void wrapc_getnameuidgid (void * name, int *uid, int *gid);
+EXTERN int wrapc_signbit (double r);
+EXTERN int wrapc_signbitf (float s);
+EXTERN int wrapc_signbitl (long double l);
+
+/*
+   isfinite - provide non builtin alternative to the gcc builtin isfinite.
+              Returns 1 if x is finite and 0 if it is not.
+*/
+
+EXTERN int wrapc_isfinite (double x);
+
+/*
+   isfinitef - provide non builtin alternative to the gcc builtin isfinite.
+               Returns 1 if x is finite and 0 if it is not.
+*/
+
+EXTERN int wrapc_isfinitef (float x);
+
+/*
+   isfinitel - provide non builtin alternative to the gcc builtin isfinite.
+               Returns 1 if x is finite and 0 if it is not.
+*/
+
+EXTERN int wrapc_isfinitel (long double x);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/README b/gcc/m2/pge-boot/README
new file mode 100644
index 00000000000..0281636c44d
--- /dev/null
+++ b/gcc/m2/pge-boot/README
@@ -0,0 +1,2 @@
+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
diff --git a/gcc/m2/pge-boot/m2rts.h b/gcc/m2/pge-boot/m2rts.h
new file mode 100644
index 00000000000..57e6e90d94d
--- /dev/null
+++ b/gcc/m2/pge-boot/m2rts.h
@@ -0,0 +1,41 @@
+/* m2rts.h provides a C interface to M2RTS.mod.
+
+Copyright (C) 2019-2022 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/>.  */
+
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
+extern "C" void M2RTS_RegisterModule (const char *modulename,
+				      proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void _M2_M2RTS_init (void);
+
+extern "C" void M2RTS_ConstructModules (const char *,
+					int argc, char *argv[], char *envp[]);
+extern "C" void M2RTS_Terminate (void);
+extern "C" void M2RTS_DeconstructModules (void);
+
+extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn));
diff --git a/gcc/m2/pge-boot/main.c b/gcc/m2/pge-boot/main.c
new file mode 100644
index 00000000000..3c7656a1d53
--- /dev/null
+++ b/gcc/m2/pge-boot/main.c
@@ -0,0 +1,123 @@
+extern "C" void _M2_RTExceptions_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_RTExceptions_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2EXCEPTION_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2EXCEPTION_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2RTS_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2RTS_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysExceptions_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysExceptions_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrLib_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrLib_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_errno_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_errno_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_termios_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_termios_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_IO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_IO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StdIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StdIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Debug_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Debug_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysStorage_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysStorage_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Storage_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Storage_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_DynamicStrings_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_DynamicStrings_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Assertion_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Assertion_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Indexing_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Indexing_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NameKey_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NameKey_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NumberIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NumberIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_PushBackInput_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_PushBackInput_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SymbolKey_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SymbolKey_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_UnixArgs_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_UnixArgs_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_FIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_FIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SFIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SFIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrCase_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrCase_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_bnflex_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_bnflex_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Lists_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Lists_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Args_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Args_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Output_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Output_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_pge_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_pge_finish (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_finish (argc, argv, envp);
+   _M2_Output_finish (argc, argv, envp);
+   _M2_Args_finish (argc, argv, envp);
+   _M2_Lists_finish (argc, argv, envp);
+   _M2_bnflex_finish (argc, argv, envp);
+   _M2_StrCase_finish (argc, argv, envp);
+   _M2_SFIO_finish (argc, argv, envp);
+   _M2_FIO_finish (argc, argv, envp);
+   _M2_UnixArgs_finish (argc, argv, envp);
+   _M2_SymbolKey_finish (argc, argv, envp);
+   _M2_PushBackInput_finish (argc, argv, envp);
+   _M2_NumberIO_finish (argc, argv, envp);
+   _M2_NameKey_finish (argc, argv, envp);
+   _M2_Indexing_finish (argc, argv, envp);
+   _M2_Assertion_finish (argc, argv, envp);
+   _M2_DynamicStrings_finish (argc, argv, envp);
+   _M2_StrIO_finish (argc, argv, envp);
+   _M2_Storage_finish (argc, argv, envp);
+   _M2_SysStorage_finish (argc, argv, envp);
+   _M2_Debug_finish (argc, argv, envp);
+   _M2_StdIO_finish (argc, argv, envp);
+   _M2_IO_finish (argc, argv, envp);
+   _M2_termios_finish (argc, argv, envp);
+   _M2_errno_finish (argc, argv, envp);
+   _M2_StrLib_finish (argc, argv, envp);
+   _M2_SysExceptions_finish (argc, argv, envp);
+   _M2_M2RTS_finish (argc, argv, envp);
+   _M2_M2EXCEPTION_finish (argc, argv, envp);
+   _M2_RTExceptions_finish (argc, argv, envp);
+   return(0);
+}
diff --git a/gcc/m2/pge-boot/network.c b/gcc/m2/pge-boot/network.c
new file mode 100644
index 00000000000..74ebe51f3d4
--- /dev/null
+++ b/gcc/m2/pge-boot/network.c
@@ -0,0 +1,40 @@
+/* network.c provide access to htons and htonl.
+
+Copyright (C) 2010-2022 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);
+}
diff --git a/gcc/m2/plugin/README b/gcc/m2/plugin/README
new file mode 100644
index 00000000000..0099b519266
--- /dev/null
+++ b/gcc/m2/plugin/README
@@ -0,0 +1,2 @@
+This directory contains the Modula-2 plugin which will elevate runtime
+warnings into compiler errors if they are known to be reachable.
diff --git a/gcc/m2/plugin/m2rte.cc b/gcc/m2/plugin/m2rte.cc
new file mode 100644
index 00000000000..0f2e1390967
--- /dev/null
+++ b/gcc/m2/plugin/m2rte.cc
@@ -0,0 +1,335 @@
+/* m2rte.cc a plugin to detect runtime exceptions at compiletime.
+
+Copyright (C) 2017-2022 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 "gcc-plugin.h"
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+#include "tree-pass.h"
+#include "diagnostic-core.h"
+#include "flags.h"
+#include "intl.h"
+#include "plugin.h"
+#include "tree.h"
+#include "gimple.h"
+#include "gimplify.h"
+#include "gimple-iterator.h"
+#include "gimplify-me.h"
+#include "gimple-pretty-print.h"
+#include "plugin-version.h"
+#include "diagnostic.h"
+#include "context.h"
+
+#include "rtegraph.h"
+extern bool ggc_force_collect;
+extern void ggc_collect (void);
+
+#undef DEBUG_BASICBLOCK
+
+int plugin_is_GPL_compatible;
+
+void debug_tree (tree);
+
+/* All dialects of Modula-2 issue some or all of these runtime error calls.
+   This plugin detects whether a runtime error will be called in the first
+   basic block of a reachable function.  */
+
+static const char *m2_runtime_error_calls[] = {
+  "M2RTS_AssignmentException",
+  "M2RTS_ReturnException",
+  "M2RTS_IncException",
+  "M2RTS_DecException",
+  "M2RTS_InclException",
+  "M2RTS_ExclException",
+  "M2RTS_ShiftException",
+  "M2RTS_RotateException",
+  "M2RTS_StaticArraySubscriptException",
+  "M2RTS_DynamicArraySubscriptException",
+  "M2RTS_ForLoopBeginException",
+  "M2RTS_ForLoopToException",
+  "M2RTS_ForLoopEndException",
+  "M2RTS_PointerNilException",
+  "M2RTS_NoReturnException",
+  "M2RTS_CaseException",
+  "M2RTS_WholeNonPosDivException",
+  "M2RTS_WholeNonPosModException",
+  "M2RTS_WholeZeroDivException",
+  "M2RTS_WholeZeroRemException",
+  "M2RTS_WholeValueException",
+  "M2RTS_RealValueException",
+  "M2RTS_ParameterException",
+  "M2RTS_NoException",
+  NULL,
+};
+
+
+#if defined(DEBUG_BASICBLOCK)
+/* pretty_function display the name of the function.  */
+
+static void
+pretty_function (tree fndecl)
+{
+  if (fndecl != NULL && (DECL_NAME (fndecl) != NULL))
+    {
+      const char *n = IDENTIFIER_POINTER (DECL_NAME (fndecl));
+      fprintf (stderr, "PROCEDURE %s ;\n", n);
+    }
+}
+#endif
+
+void
+print_rtl (FILE *outf, const_rtx rtx_first);
+
+/* strend returns true if string name has ending.  */
+
+static bool
+strend (const char *name, const char *ending)
+{
+  unsigned int len = strlen (name);
+  return (len > strlen (ending)
+	  && (strcmp (&name[len-strlen (ending)], ending) == 0));
+}
+
+/* is_constructor returns true if the function name is that of a module
+   constructor or deconstructor.  */
+
+static bool
+is_constructor (tree fndecl)
+{
+  const char *name = IDENTIFIER_POINTER (DECL_NAME (fndecl));
+  unsigned int len = strlen (name);
+
+  return ((len > strlen ("_M2_"))
+	  && (strncmp (name, "_M2_", strlen ("_M2_")) == 0)
+	  && (strend (name, "_init") || strend (name, "_finish")));
+}
+
+/* is_external returns true if the function is extern.  */
+
+static bool
+is_external (tree function)
+{
+  return (! DECL_EXTERNAL (function))
+    && TREE_PUBLIC (function)
+    && TREE_STATIC (function);
+}
+
+/* is_external returns true if the function is a call to a Modula-2
+   runtime exception handler.  */
+
+static bool
+is_rte (tree fndecl)
+{
+  const char *n = IDENTIFIER_POINTER (DECL_NAME (fndecl));
+
+  for (int i = 0; m2_runtime_error_calls[i] != NULL; i++)
+    if (strcmp (m2_runtime_error_calls[i], n) == 0)
+      return true;
+  return false;
+}
+
+/* examine_call extract the function tree from the gimple call
+   statement and check whether it is a call to a runtime exception.  */
+
+static void
+examine_call (gimple *stmt)
+{
+  tree fndecl = gimple_call_fndecl (stmt);
+  rtenode *func = rtegraph_lookup (stmt, fndecl, true);
+  // rtegraph_dump ();
+  if (fndecl != NULL && (DECL_NAME (fndecl) != NULL))
+    {
+      /* Firstly check if the function is a runtime exception.  */
+      if (is_rte (fndecl))
+	{
+	  /* Remember runtime exception call.  */
+	  rtegraph_include_rtscall (func);
+	  /* Add the callee to the list of candidates to be queried reachable.  */
+	  rtegraph_candidates_include (func);
+	  return;
+	}
+    }
+  /* Add it to the list of calls.  */
+  rtegraph_include_function_call (func);
+}
+
+
+/* examine_function_decl, check if the current function is a module
+   constructor/deconstructor.  Also check if the current function is
+   declared as external.  */
+
+static void
+examine_function_decl (rtenode *rt)
+{
+  tree fndecl = rtegraph_get_func (rt);
+  if (fndecl != NULL && (DECL_NAME (fndecl) != NULL))
+    {
+      /* Check if the function is a module constructor.  */
+      if (is_constructor (fndecl))
+	rtegraph_constructors_include (rt);
+      /* Can it be called externally?  */
+      if (is_external (fndecl))
+	rtegraph_externs_include (rt);
+    }
+}
+
+
+/* Check and warn if STMT is a self-assign statement.  */
+
+static void
+runtime_exception_inevitable (gimple *stmt)
+{
+  if (is_gimple_call (stmt))
+    examine_call (stmt);
+}
+
+
+namespace {
+
+const pass_data pass_data_exception_detection =
+{
+  GIMPLE_PASS, /* type */
+  "runtime_exception_inevitable", /* name */
+  OPTGROUP_NONE, /* optinfo_flags */
+  TV_NONE, /* tv_id */
+  PROP_gimple_lcf , /* properties_required */
+  0, /* properties_provided */
+  0, /* properties_destroyed */
+  0, /* todo_flags_start */
+  0, /* todo_flags_finish */
+};
+
+class pass_warn_exception_inevitable : public gimple_opt_pass
+{
+public:
+  pass_warn_exception_inevitable(gcc::context *ctxt)
+    : gimple_opt_pass(pass_data_exception_detection, ctxt)
+  {}
+
+  virtual unsigned int execute (function *);
+};
+
+/* execute checks the first basic block of function fun to see if it
+   calls a runtime exception.  */
+
+unsigned int
+pass_warn_exception_inevitable::execute (function *fun)
+{
+  gimple_stmt_iterator gsi;
+  basic_block bb;
+  /* Record a function declaration.  */
+  rtenode *fn = rtegraph_lookup (fun->gimple_body, fun->decl, false);
+
+  rtegraph_set_current_function (fn);
+  /* Check if the current function is a module constructor/deconstructor.
+     Also check if the current function is declared as external.  */
+  examine_function_decl (fn);
+
+#if defined(DEBUG_BASICBLOCK)
+  pretty_function (fun->decl);
+  int basic_count = 0;
+#endif
+  FOR_EACH_BB_FN (bb, fun)
+    {
+#if defined(DEBUG_BASICBLOCK)
+      int stmt_count = 0;
+#endif
+      for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi))
+	{
+#if defined(DEBUG_BASICBLOCK)
+	  printf ("  [%d][%d]  [basic block][statement]\n",
+		  basic_count, stmt_count);
+	  stmt_count++;
+#endif
+	  runtime_exception_inevitable (gsi_stmt (gsi));
+#if defined(DEBUG_BASICBLOCK)
+	  debug (gsi_stmt (gsi));
+#endif
+	}
+      /* We only care about the first basic block in each function.
+         We could continue to search if this edge falls though (top
+         of a loop for example) but for now this is cautiously safe.
+         --fixme--  */
+      return 0;
+#if defined(DEBUG_BASICBLOCK)
+      basic_count++;
+#endif
+    }
+  return 0;
+}
+
+/* analyse_graph discovers any reachable call to a runtime exception in the
+   first basic block of a reachable function.  It then calls rtegraph_finish
+   to tidy up and return all dynamic memory used.  */
+
+void analyse_graph (void *gcc_data, void *user_data)
+{
+  rtegraph_discover ();
+  rtegraph_finish ();
+}
+
+} // anon namespace
+
+
+static gimple_opt_pass *
+make_pass_warn_exception_inevitable (gcc::context *ctxt)
+{
+  return new pass_warn_exception_inevitable (ctxt);
+}
+
+
+/* plugin_init, check the version and register the plugin.  */
+
+int
+plugin_init (struct plugin_name_args *plugin_info,
+	     struct plugin_gcc_version *version)
+{
+  struct register_pass_info pass_info;
+  const char *plugin_name = plugin_info->base_name;
+
+  if (!plugin_default_version_check (version, &gcc_version))
+    {
+      fprintf (stderr, "incorrect GCC version (%s) this plugin was built for GCC version %s\n",
+	       version->basever, gcc_version.basever);
+      return 1;
+    }
+
+  /* Runtime exception inevitable detection.  This plugin is most effective if
+     it is run after all optimizations.  This is plugged in at the end of
+     gimple range of optimizations.  */
+  pass_info.pass = make_pass_warn_exception_inevitable (g);
+  pass_info.reference_pass_name = "*warn_function_noreturn";
+
+  pass_info.ref_pass_instance_number = 1;
+  pass_info.pos_op = PASS_POS_INSERT_AFTER;
+
+  rtegraph_init ();
+
+  register_callback (plugin_name,
+		     PLUGIN_PASS_MANAGER_SETUP,
+		     NULL,
+		     &pass_info);
+  register_callback (plugin_name,
+		     PLUGIN_FINISH, analyse_graph, NULL);
+  return 0;
+}
diff --git a/gcc/m2/target-independent/Builtins.texi b/gcc/m2/target-independent/Builtins.texi
new file mode 100644
index 00000000000..6ab1f2b32e0
--- /dev/null
+++ b/gcc/m2/target-independent/Builtins.texi
@@ -0,0 +1,340 @@
+
+@example
+DEFINITION MODULE Builtins ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+(* floating point intrinsic procedure functions *)
+
+@findex isfinitef
+PROCEDURE __BUILTIN__ isfinitef (x: SHORTREAL) : BOOLEAN ;
+@findex isfinite
+PROCEDURE __BUILTIN__ isfinite (x: REAL) : BOOLEAN ;
+@findex isfinitel
+PROCEDURE __BUILTIN__ isfinitel (x: LONGREAL) : BOOLEAN ;
+
+@findex sinf
+PROCEDURE __BUILTIN__ sinf (x: SHORTREAL) : SHORTREAL ;
+@findex sin
+PROCEDURE __BUILTIN__ sin (x: REAL) : REAL ;
+@findex sinl
+PROCEDURE __BUILTIN__ sinl (x: LONGREAL) : LONGREAL ;
+
+@findex cosf
+PROCEDURE __BUILTIN__ cosf (x: SHORTREAL) : SHORTREAL ;
+@findex cos
+PROCEDURE __BUILTIN__ cos (x: REAL) : REAL ;
+@findex cosl
+PROCEDURE __BUILTIN__ cosl (x: LONGREAL) : LONGREAL ;
+
+@findex sqrtf
+PROCEDURE __BUILTIN__ sqrtf (x: SHORTREAL) : SHORTREAL ;
+@findex sqrt
+PROCEDURE __BUILTIN__ sqrt (x: REAL) : REAL ;
+@findex sqrtl
+PROCEDURE __BUILTIN__ sqrtl (x: LONGREAL) : LONGREAL ;
+
+@findex atan2f
+PROCEDURE __BUILTIN__ atan2f (x, y: SHORTREAL) : SHORTREAL ;
+@findex atan2
+PROCEDURE __BUILTIN__ atan2 (x, y: REAL) : REAL ;
+@findex atan2l
+PROCEDURE __BUILTIN__ atan2l (x, y: LONGREAL) : LONGREAL ;
+
+@findex fabsf
+PROCEDURE __BUILTIN__ fabsf (x: SHORTREAL) : SHORTREAL ;
+@findex fabs
+PROCEDURE __BUILTIN__ fabs (x: REAL) : REAL ;
+@findex fabsl
+PROCEDURE __BUILTIN__ fabsl (x: LONGREAL) : LONGREAL ;
+
+@findex logf
+PROCEDURE __BUILTIN__ logf (x: SHORTREAL) : SHORTREAL ;
+@findex log
+PROCEDURE __BUILTIN__ log (x: REAL) : REAL ;
+@findex logl
+PROCEDURE __BUILTIN__ logl (x: LONGREAL) : LONGREAL ;
+
+@findex expf
+PROCEDURE __BUILTIN__ expf (x: SHORTREAL) : SHORTREAL ;
+@findex exp
+PROCEDURE __BUILTIN__ exp (x: REAL) : REAL ;
+@findex expl
+PROCEDURE __BUILTIN__ expl (x: LONGREAL) : LONGREAL ;
+
+@findex log10f
+PROCEDURE __BUILTIN__ log10f (x: SHORTREAL) : SHORTREAL ;
+@findex log10
+PROCEDURE __BUILTIN__ log10 (x: REAL) : REAL ;
+@findex log10l
+PROCEDURE __BUILTIN__ log10l (x: LONGREAL) : LONGREAL ;
+
+@findex exp10f
+PROCEDURE __BUILTIN__ exp10f (x: SHORTREAL) : SHORTREAL ;
+@findex exp10
+PROCEDURE __BUILTIN__ exp10 (x: REAL) : REAL ;
+@findex exp10l
+PROCEDURE __BUILTIN__ exp10l (x: LONGREAL) : LONGREAL ;
+
+@findex ilogbf
+PROCEDURE __BUILTIN__ ilogbf (x: SHORTREAL) : INTEGER ;
+@findex ilogb
+PROCEDURE __BUILTIN__ ilogb (x: REAL) : INTEGER ;
+@findex ilogbl
+PROCEDURE __BUILTIN__ ilogbl (x: LONGREAL) : INTEGER ;
+
+@findex huge_val
+PROCEDURE __BUILTIN__ huge_val () : REAL ;
+@findex huge_valf
+PROCEDURE __BUILTIN__ huge_valf () : SHORTREAL ;
+@findex huge_vall
+PROCEDURE __BUILTIN__ huge_vall () : LONGREAL ;
+
+@findex significand
+PROCEDURE __BUILTIN__ significand (r: REAL) : REAL ;
+@findex significandf
+PROCEDURE __BUILTIN__ significandf (s: SHORTREAL) : SHORTREAL ;
+@findex significandl
+PROCEDURE __BUILTIN__ significandl (l: LONGREAL) : LONGREAL ;
+
+@findex modf
+PROCEDURE __BUILTIN__ modf (x: REAL; VAR y: REAL) : REAL ;
+@findex modff
+PROCEDURE __BUILTIN__ modff (x: SHORTREAL;
+                             VAR y: SHORTREAL) : SHORTREAL ;
+@findex modfl
+PROCEDURE __BUILTIN__ modfl (x: LONGREAL; VAR y: LONGREAL) : LONGREAL ;
+
+@findex signbit
+PROCEDURE __BUILTIN__ signbit (r: REAL) : INTEGER ;
+@findex signbitf
+PROCEDURE __BUILTIN__ signbitf (s: SHORTREAL) : INTEGER ;
+@findex signbitl
+PROCEDURE __BUILTIN__ signbitl (l: LONGREAL) : INTEGER ;
+
+@findex nextafter
+PROCEDURE __BUILTIN__ nextafter (x, y: REAL) : REAL ;
+@findex nextafterf
+PROCEDURE __BUILTIN__ nextafterf (x, y: SHORTREAL) : SHORTREAL ;
+@findex nextafterl
+PROCEDURE __BUILTIN__ nextafterl (x, y: LONGREAL) : LONGREAL ;
+
+@findex nexttoward
+PROCEDURE __BUILTIN__ nexttoward (x, y: REAL) : LONGREAL ;
+@findex nexttowardf
+PROCEDURE __BUILTIN__ nexttowardf (x, y: SHORTREAL) : LONGREAL ;
+@findex nexttowardl
+PROCEDURE __BUILTIN__ nexttowardl (x, y: LONGREAL) : LONGREAL ;
+
+@findex scalb
+PROCEDURE __BUILTIN__ scalb (x, n: REAL) : REAL ;
+@findex scalbf
+PROCEDURE __BUILTIN__ scalbf (x, n: SHORTREAL) : SHORTREAL ;
+@findex scalbl
+PROCEDURE __BUILTIN__ scalbl (x, n: LONGREAL) : LONGREAL ;
+
+@findex scalbln
+PROCEDURE __BUILTIN__ scalbln (x: REAL; n: LONGINT) : REAL ;
+@findex scalblnf
+PROCEDURE __BUILTIN__ scalblnf (x: SHORTREAL; n: LONGINT) : SHORTREAL ;
+@findex scalblnl
+PROCEDURE __BUILTIN__ scalblnl (x: LONGREAL; n: LONGINT) : LONGREAL ;
+
+@findex scalbn
+PROCEDURE __BUILTIN__ scalbn (x: REAL; n: INTEGER) : REAL ;
+@findex scalbnf
+PROCEDURE __BUILTIN__ scalbnf (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+@findex scalbnl
+PROCEDURE __BUILTIN__ scalbnl (x: LONGREAL; n: INTEGER) : LONGREAL ;
+
+(* complex arithmetic intrincic procedure functions *)
+
+@findex cabsf
+PROCEDURE __BUILTIN__ cabsf (z: SHORTCOMPLEX) : SHORTREAL ;
+@findex cabs
+PROCEDURE __BUILTIN__ cabs (z: COMPLEX) : REAL ;
+@findex cabsl
+PROCEDURE __BUILTIN__ cabsl (z: LONGCOMPLEX) : LONGREAL ;
+
+@findex cargf
+PROCEDURE __BUILTIN__ cargf (z: SHORTCOMPLEX) : SHORTREAL ;
+@findex carg
+PROCEDURE __BUILTIN__ carg (z: COMPLEX) : REAL ;
+@findex cargl
+PROCEDURE __BUILTIN__ cargl (z: LONGCOMPLEX) : LONGREAL ;
+
+@findex conjf
+PROCEDURE __BUILTIN__ conjf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex conj
+PROCEDURE __BUILTIN__ conj (z: COMPLEX) : COMPLEX ;
+@findex conjl
+PROCEDURE __BUILTIN__ conjl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex cpowerf
+PROCEDURE __BUILTIN__ cpowerf (base: SHORTCOMPLEX;
+                               exp: SHORTREAL) : SHORTCOMPLEX ;
+@findex cpower
+PROCEDURE __BUILTIN__ cpower (base: COMPLEX; exp: REAL) : COMPLEX ;
+@findex cpowerl
+PROCEDURE __BUILTIN__ cpowerl (base: LONGCOMPLEX;
+                               exp: LONGREAL) : LONGCOMPLEX ;
+
+@findex csqrtf
+PROCEDURE __BUILTIN__ csqrtf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex csqrt
+PROCEDURE __BUILTIN__ csqrt (z: COMPLEX) : COMPLEX ;
+@findex csqrtl
+PROCEDURE __BUILTIN__ csqrtl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex cexpf
+PROCEDURE __BUILTIN__ cexpf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex cexp
+PROCEDURE __BUILTIN__ cexp (z: COMPLEX) : COMPLEX ;
+@findex cexpl
+PROCEDURE __BUILTIN__ cexpl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex clnf
+PROCEDURE __BUILTIN__ clnf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex cln
+PROCEDURE __BUILTIN__ cln (z: COMPLEX) : COMPLEX ;
+@findex clnl
+PROCEDURE __BUILTIN__ clnl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex csinf
+PROCEDURE __BUILTIN__ csinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex csin
+PROCEDURE __BUILTIN__ csin (z: COMPLEX) : COMPLEX ;
+@findex csinl
+PROCEDURE __BUILTIN__ csinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex ccosf
+PROCEDURE __BUILTIN__ ccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex ccos
+PROCEDURE __BUILTIN__ ccos (z: COMPLEX) : COMPLEX ;
+@findex ccosl
+PROCEDURE __BUILTIN__ ccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex ctanf
+PROCEDURE __BUILTIN__ ctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex ctan
+PROCEDURE __BUILTIN__ ctan (z: COMPLEX) : COMPLEX ;
+@findex ctanl
+PROCEDURE __BUILTIN__ ctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex carcsinf
+PROCEDURE __BUILTIN__ carcsinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex carcsin
+PROCEDURE __BUILTIN__ carcsin (z: COMPLEX) : COMPLEX ;
+@findex carcsinl
+PROCEDURE __BUILTIN__ carcsinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex carccosf
+PROCEDURE __BUILTIN__ carccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex carccos
+PROCEDURE __BUILTIN__ carccos (z: COMPLEX) : COMPLEX ;
+@findex carccosl
+PROCEDURE __BUILTIN__ carccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex carctanf
+PROCEDURE __BUILTIN__ carctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex carctan
+PROCEDURE __BUILTIN__ carctan (z: COMPLEX) : COMPLEX ;
+@findex carctanl
+PROCEDURE __BUILTIN__ carctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+(* memory and string intrincic procedure functions *)
+
+@findex alloca
+PROCEDURE __BUILTIN__ alloca (i: CARDINAL) : ADDRESS ;
+@findex memcpy
+PROCEDURE __BUILTIN__ memcpy (dest, src: ADDRESS;
+                              nbytes: CARDINAL) : ADDRESS ;
+@findex index
+PROCEDURE __BUILTIN__ index (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex rindex
+PROCEDURE __BUILTIN__ rindex (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex memcmp
+PROCEDURE __BUILTIN__ memcmp (s1, s2: ADDRESS;
+                              nbytes: CARDINAL) : INTEGER ;
+@findex memset
+PROCEDURE __BUILTIN__ memset (s: ADDRESS; c: INTEGER;
+                              nbytes: CARDINAL) : ADDRESS ;
+@findex memmove
+PROCEDURE __BUILTIN__ memmove (s1, s2: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+@findex strcat
+PROCEDURE __BUILTIN__ strcat (dest, src: ADDRESS) : ADDRESS ;
+@findex strncat
+PROCEDURE __BUILTIN__ strncat (dest, src: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+@findex strcpy
+PROCEDURE __BUILTIN__ strcpy (dest, src: ADDRESS) : ADDRESS ;
+@findex strncpy
+PROCEDURE __BUILTIN__ strncpy (dest, src: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+@findex strcmp
+PROCEDURE __BUILTIN__ strcmp (s1, s2: ADDRESS) : INTEGER ;
+@findex strncmp
+PROCEDURE __BUILTIN__ strncmp (s1, s2: ADDRESS;
+                               nbytes: CARDINAL) : INTEGER ;
+@findex strlen
+PROCEDURE __BUILTIN__ strlen (s: ADDRESS) : INTEGER ;
+@findex strstr
+PROCEDURE __BUILTIN__ strstr (haystack, needle: ADDRESS) : ADDRESS ;
+@findex strpbrk
+PROCEDURE __BUILTIN__ strpbrk (s, accept: ADDRESS) : ADDRESS ;
+@findex strspn
+PROCEDURE __BUILTIN__ strspn (s, accept: ADDRESS) : CARDINAL ;
+@findex strcspn
+PROCEDURE __BUILTIN__ strcspn (s, accept: ADDRESS) : CARDINAL ;
+@findex strchr
+PROCEDURE __BUILTIN__ strchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex strrchr
+PROCEDURE __BUILTIN__ strrchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+
+(*
+   longjmp - this GCC builtin restricts the val to always 1.
+*)
+(* do not use these two builtins, as gcc, only really
+   anticipates that the Ada front end should use them
+   and it only uses them in its runtime exception handling.
+   We leave them here in the hope that someday they will
+   behave more like their libc counterparts.  *)
+
+@findex longjmp
+PROCEDURE __BUILTIN__ longjmp (env: ADDRESS; val: INTEGER) ;
+@findex setjmp
+PROCEDURE __BUILTIN__ setjmp (env: ADDRESS) : INTEGER ;
+
+
+(*
+   frame_address - returns the address of the frame.
+                   The current frame is obtained if level is 0,
+                   the next level up if level is 1 etc.
+*)
+
+@findex frame_address
+PROCEDURE __BUILTIN__ frame_address (level: CARDINAL) : ADDRESS ;
+
+
+(*
+   return_address - returns the return address of function.
+                    The current function return address is
+                    obtained if level is 0,
+                    the next level up if level is 1 etc.
+*)
+
+@findex return_address
+PROCEDURE __BUILTIN__ return_address (level: CARDINAL) : ADDRESS ;
+
+
+(*
+   alloca_trace - this is a no-op which is used for internal debugging.
+*)
+
+@findex alloca_trace
+PROCEDURE alloca_trace (returned: ADDRESS; nBytes: CARDINAL) : ADDRESS ;
+
+
+END Builtins.
+@end example
diff --git a/gcc/m2/target-independent/SYSTEM-iso.texi b/gcc/m2/target-independent/SYSTEM-iso.texi
new file mode 100644
index 00000000000..ece68a1fcdc
--- /dev/null
+++ b/gcc/m2/target-independent/SYSTEM-iso.texi
@@ -0,0 +1,251 @@
+
+@example
+DEFINITION MODULE SYSTEM;
+
+  (* Gives access to system programming facilities that are probably
+     non portable. *)
+
+  (* The constants and types define underlying properties of storage *)
+
+EXPORT QUALIFIED BITSPERLOC, LOCSPERWORD,
+                 LOC, BYTE, WORD, ADDRESS, CSIZE_T, CSSIZE_T, (* 
+                 Target specific data types.  *)
+                 ADDADR, SUBADR, DIFADR, MAKEADR, ADR, ROTATE,
+                 SHIFT, CAST, TSIZE,
+
+                 (* Internal GM2 compiler functions *)
+                 ShiftVal, ShiftLeft, ShiftRight,
+                 RotateVal, RotateLeft, RotateRight,
+                 THROW, TBITSIZE ;
+
+CONST
+                  (* <implementation-defined constant> ; *)
+@findex BITSPERLOC (const)
+  BITSPERLOC    = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
+                  (* <implementation-defined constant> ; *)
+@findex LOCSPERWORD (const)
+  LOCSPERWORD   = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
+                  (* <implementation-defined constant> ; *)
+@findex LOCSPERBYTE (const)
+  LOCSPERBYTE = 8 DIV BITSPERLOC ;
+
+(* Note that the full list of system and sized datatypes include:
+   LOC, WORD, BYTE, ADDRESS,
+
+   (and the non language standard target types)
+
+   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+   WORD16, WORD32, WORD64, BITSET8, BITSET16,
+   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
+   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.
+
+   Also note that the non-standard data types will
+   move into another module in the future.  *)
+
+(*
+   All the data types and procedures below are declared internally.
+   ===============================================================
+
+TYPE
+   (* Target specific data types.  *)
+
+TYPE
+  LOC; (* A system basic type. Values are the uninterpreted
+          contents of the smallest addressable unit of storage *)
+@findex ADDRESS (type)
+  ADDRESS = POINTER TO LOC;
+@findex WORD (type)
+  WORD = ARRAY [0 .. LOCSPERWORD-1] OF LOC;
+
+  (* BYTE and LOCSPERBYTE are provided if appropriate for machine *)
+
+TYPE
+@findex BYTE (type)
+  BYTE = ARRAY [0 .. LOCSPERBYTE-1] OF LOC;
+
+@findex ADDADR
+PROCEDURE ADDADR (addr: ADDRESS; offset: CARDINAL): ADDRESS;
+  (* Returns address given by (addr + offset), or may raise
+     an exception if this address is not valid.
+  *)
+
+@findex SUBADR
+PROCEDURE SUBADR (addr: ADDRESS; offset: CARDINAL): ADDRESS;
+  (* Returns address given by (addr - offset), or may raise an
+     exception if this address is not valid.
+  *)
+
+@findex DIFADR
+PROCEDURE DIFADR (addr1, addr2: ADDRESS): INTEGER;
+  (* Returns the difference between addresses (addr1 - addr2),
+     or may raise an exception if the arguments are invalid
+     or address space is non-contiguous.
+  *)
+
+@findex MAKEADR
+PROCEDURE MAKEADR (high: <some type>; ...): ADDRESS;
+  (* Returns an address constructed from a list of values whose
+     types are implementation-defined, or may raise an
+     exception if this address is not valid.
+
+     In GNU Modula-2, MAKEADR can take any number of arguments
+     which are mapped onto the type ADDRESS. The first parameter
+     maps onto the high address bits and subsequent parameters map
+     onto lower address bits. For example:
+
+     a := MAKEADR(BYTE(0FEH), BYTE(0DCH), BYTE(0BAH), BYTE(098H),
+                  BYTE(076H), BYTE(054H), BYTE(032H), BYTE(010H)) ;
+
+     then the value of, a, on a 64 bit machine is: 0FEDCBA9876543210H
+
+     The parameters do not have to be the same type, but constants
+     _must_ be typed.
+  *)
+
+@findex ADR
+PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
+  (* Returns the address of variable v. *)
+
+@findex ROTATE
+PROCEDURE ROTATE (val: <a packedset type>;
+                  num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by rotating up/right
+     or down/right by the absolute value of num.  The direction is
+     down/right if the sign of num is negative, otherwise the direction
+     is up/left.
+  *)
+
+@findex SHIFT
+PROCEDURE SHIFT (val: <a packedset type>;
+                 num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by shifting up/left
+     or down/right by the absolute value of num, introducing
+     zeros as necessary.  The direction is down/right if the sign of
+     num is negative, otherwise the direction is up/left.
+  *)
+
+@findex CAST
+PROCEDURE CAST (<targettype>; val: <anytype>): <targettype>;
+  (* CAST is a type transfer function.  Given the expression
+     denoted by val, it returns a value of the type <targettype>.
+     An invalid value for the target value or a
+     physical address alignment problem may raise an exception.
+  *)
+
+@findex TSIZE
+PROCEDURE TSIZE (<type>; ... ): CARDINAL;
+  (* Returns the number of LOCS used to store a value of the
+     specified <type>.   The extra parameters, if present,
+     are used to distinguish variants in a variant record.
+  *)
+
+@findex THROW
+PROCEDURE THROW (i: INTEGER) ;
+  (*
+     THROW is a GNU extension and was not part of the PIM or ISO
+     standards.  It throws an exception which will be caught by the
+     EXCEPT block (assuming it exists).  This is a compiler builtin
+     function which interfaces to the GCC exception handling runtime
+     system.
+     GCC uses the term throw, hence the naming distinction between
+     the GCC builtin and the Modula-2 runtime library procedure Raise.
+     The later library procedure Raise will call SYSTEM.THROW after
+     performing various housekeeping activities.
+  *)
+
+@findex TBITSIZE
+PROCEDURE TBITSIZE (<type>) : CARDINAL ;
+  (* Returns the minimum number of bits necessary to represent
+     <type>.  This procedure function is only useful for determining
+     the number of bits used for any type field within a packed RECORD.
+     It is not particularly useful elsewhere since <type> might be
+     optimized for speed, for example a BOOLEAN could occupy a WORD.
+  *)
+*)
+
+
+(* The following procedures are invoked by GNU Modula-2 to
+   shift non word set types. They are not part of ISO Modula-2
+   but are used to implement the SHIFT procedure defined above. *)
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+@findex ShiftVal
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*)
+
+@findex ShiftLeft
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex ShiftRight
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger
+               sets.
+*)
+
+@findex RotateVal
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex RotateLeft
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*)
+
+@findex RotateRight
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+
+
+END SYSTEM.
+@end example
diff --git a/gcc/m2/target-independent/SYSTEM-pim.texi b/gcc/m2/target-independent/SYSTEM-pim.texi
new file mode 100644
index 00000000000..e2afa9d67cc
--- /dev/null
+++ b/gcc/m2/target-independent/SYSTEM-pim.texi
@@ -0,0 +1,190 @@
+
+@example
+DEFINITION MODULE SYSTEM ;
+
+EXPORT QUALIFIED BITSPERBYTE, BYTESPERWORD,
+                 ADDRESS, WORD, BYTE, CSIZE_T, CSSIZE_T, (* 
+                 Target specific data types.  *)
+                 ADR, TSIZE, ROTATE, SHIFT, THROW, TBITSIZE ;
+                 (* SIZE is also exported if -fpim2 is used.  *)
+
+CONST
+@findex BITSPERBYTE (const)
+  BITSPERBYTE   = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
+@findex BYTESPERWORD (const)
+  BYTESPERWORD  = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
+
+(* Note that the full list of system and sized datatypes include:
+   LOC, WORD, BYTE, ADDRESS,
+
+   (and the non language standard target types)
+
+   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+   WORD16, WORD32, WORD64, BITSET8, BITSET16,
+   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
+   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.
+
+   Also note that the non-standard data types will
+   move into another module in the future.  *)
+
+
+(* The following types are supported on this target:
+TYPE
+   (* Target specific data types.  *)
+*)
+
+
+(*
+   all the functions below are declared internally to gm2
+   ======================================================
+
+@findex ADR
+PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
+  (* Returns the address of variable v. *)
+
+@findex SIZE
+PROCEDURE SIZE (v: <type>) : ZType;
+  (* Returns the number of BYTES used to store a v of
+     any specified <type>.  Only available if -fpim2 is used.
+  *)
+
+@findex TSIZE
+PROCEDURE TSIZE (<type>) : CARDINAL;
+  (* Returns the number of BYTES used to store a value of the
+     specified <type>.
+  *)
+
+@findex ROTATE
+PROCEDURE ROTATE (val: <a set type>;
+                  num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by rotating up/right
+     or down/right by the absolute value of num.  The direction is
+     down/right if the sign of num is negative, otherwise the direction
+     is up/left.
+  *)
+
+@findex SHIFT
+PROCEDURE SHIFT (val: <a set type>;
+                 num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by shifting up/left
+     or down/right by the absolute value of num, introducing
+     zeros as necessary.  The direction is down/right if the sign of
+     num is negative, otherwise the direction is up/left.
+  *)
+
+@findex THROW
+PROCEDURE THROW (i: INTEGER) ;
+  (*
+     THROW is a GNU extension and was not part of the PIM or ISO
+     standards.  It throws an exception which will be caught by the
+     EXCEPT block (assuming it exists).  This is a compiler builtin
+     function which interfaces to the GCC exception handling runtime
+     system.
+     GCC uses the term throw, hence the naming distinction between
+     the GCC builtin and the Modula-2 runtime library procedure Raise.
+     The later library procedure Raise will call SYSTEM.THROW after
+     performing various housekeeping activities.
+  *)
+
+@findex TBITSIZE
+PROCEDURE TBITSIZE (<type>) : CARDINAL ;
+  (* Returns the minimum number of bits necessary to represent
+     <type>.  This procedure function is only useful for determining
+     the number of bits used for any type field within a packed RECORD.
+     It is not particularly useful elsewhere since <type> might be
+     optimized for speed, for example a BOOLEAN could occupy a WORD.
+  *)
+*)
+
+(* The following procedures are invoked by GNU Modula-2 to
+   shift non word sized set types. They are not strictly part
+   of the core PIM Modula-2, however they are used
+   to implement the SHIFT procedure defined above,
+   which are in turn used by the Logitech compatible libraries.
+
+   Users will access these procedures by using the procedure
+   SHIFT above and GNU Modula-2 will map SHIFT onto one of
+   the following procedures.
+*)
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+@findex ShiftVal
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*)
+
+@findex ShiftLeft
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex ShiftRight
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      ShiftCount: CARDINAL) ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger
+               sets.
+*)
+
+@findex RotateVal
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex RotateLeft
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*)
+
+@findex RotateRight
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+
+
+END SYSTEM.
+@end example
diff --git a/gcc/m2/target-independent/gm2-libs.texi b/gcc/m2/target-independent/gm2-libs.texi
new file mode 100644
index 00000000000..09627bde702
--- /dev/null
+++ b/gcc/m2/target-independent/gm2-libs.texi
@@ -0,0 +1,14967 @@
+@c Copyright (C) 2000-2022 Free Software Foundation, Inc.
+@c This file is part of GNU Modula-2.
+
+@c Permission is granted to copy, distribute and/or modify this document
+@c under the terms of the GNU Free Documentation License, Version 1.2 or
+@c any later version published by the Free Software Foundation.
+@menu
+* Base libraries::Basic M2F compatible libraries
+* PIM and Logitech 3.0 Compatible::PIM and Logitech 3.0 compatible libraries
+* PIM coroutine support::PIM compatible process support
+* M2 ISO Libraries::ISO defined libraries
+@end menu
+
+@c ============================================================
+
+@node Base libraries, PIM and Logitech 3.0 Compatible, , Libraries
+@section Base libraries
+
+@c README.texi describes the pim libraries.
+@c Copyright @copyright{} 2000-2022 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+These are the base libraries for the GNU Modula-2 compiler.  These
+modules originally came from the M2F compiler and have been cleaned up
+and extended.  They provide a basic interface to the underlying
+operating system via libc.  They also include a number of libraries to
+allow access to compiler built-ins. Perhaps the largest difference to
+PIM and ISO libraries is the @code{DynamicString} module which
+declares the type @code{String}.  The heavy use of this opaque data
+type results in a number of equivalent modules that can either handle
+@code{ARRAY OF CHAR} or @code{String}.
+
+These modules have been extensively tested and are used throughout
+building the GNU Modula-2 compiler.
+@menu
+* gm2-libs/ASCII::ASCII.def
+* gm2-libs/Args::Args.def
+* gm2-libs/Assertion::Assertion.def
+* gm2-libs/Break::Break.def
+* gm2-libs/Builtins::Builtins.def
+* gm2-libs/COROUTINES::COROUTINES.def
+* gm2-libs/CmdArgs::CmdArgs.def
+* gm2-libs/Debug::Debug.def
+* gm2-libs/DynamicStrings::DynamicStrings.def
+* gm2-libs/Environment::Environment.def
+* gm2-libs/FIO::FIO.def
+* gm2-libs/FormatStrings::FormatStrings.def
+* gm2-libs/FpuIO::FpuIO.def
+* gm2-libs/GetOpt::GetOpt.def
+* gm2-libs/IO::IO.def
+* gm2-libs/Indexing::Indexing.def
+* gm2-libs/LMathLib0::LMathLib0.def
+* gm2-libs/LegacyReal::LegacyReal.def
+* gm2-libs/M2Dependent::M2Dependent.def
+* gm2-libs/M2EXCEPTION::M2EXCEPTION.def
+* gm2-libs/M2LINK::M2LINK.def
+* gm2-libs/M2RTS::M2RTS.def
+* gm2-libs/MathLib0::MathLib0.def
+* gm2-libs/MemUtils::MemUtils.def
+* gm2-libs/NumberIO::NumberIO.def
+* gm2-libs/OptLib::OptLib.def
+* gm2-libs/PushBackInput::PushBackInput.def
+* gm2-libs/RTExceptions::RTExceptions.def
+* gm2-libs/RTint::RTint.def
+* gm2-libs/SArgs::SArgs.def
+* gm2-libs/SCmdArgs::SCmdArgs.def
+* gm2-libs/SEnvironment::SEnvironment.def
+* gm2-libs/SFIO::SFIO.def
+* gm2-libs/SMathLib0::SMathLib0.def
+* gm2-libs/SYSTEM::SYSTEM.def
+* gm2-libs/Scan::Scan.def
+* gm2-libs/Selective::Selective.def
+* gm2-libs/StdIO::StdIO.def
+* gm2-libs/Storage::Storage.def
+* gm2-libs/StrCase::StrCase.def
+* gm2-libs/StrIO::StrIO.def
+* gm2-libs/StrLib::StrLib.def
+* gm2-libs/StringConvert::StringConvert.def
+* gm2-libs/SysExceptions::SysExceptions.def
+* gm2-libs/SysStorage::SysStorage.def
+* gm2-libs/TimeString::TimeString.def
+* gm2-libs/UnixArgs::UnixArgs.def
+* gm2-libs/cbuiltin::cbuiltin.def
+* gm2-libs/cgetopt::cgetopt.def
+* gm2-libs/cxxabi::cxxabi.def
+* gm2-libs/dtoa::dtoa.def
+* gm2-libs/errno::errno.def
+* gm2-libs/gdbif::gdbif.def
+* gm2-libs/ldtoa::ldtoa.def
+* gm2-libs/libc::libc.def
+* gm2-libs/libm::libm.def
+* gm2-libs/sckt::sckt.def
+* gm2-libs/termios::termios.def
+* gm2-libs/wrapc::wrapc.def
+@end menu
+
+@node gm2-libs/ASCII, gm2-libs/Args, , Base libraries
+@subsection gm2-libs/ASCII
+
+@example
+DEFINITION MODULE ASCII ;
+
+EXPORT QUALIFIED
+     nul, soh, stx, etx, eot, enq, ack, bel,
+     bs , ht , nl , vt , np , cr , so , si ,
+     dle, dc1, dc2, dc3, dc4, nak, syn, etb,
+     can, em , sub, esc, fs , gs , rs , us ,
+     sp ,  (* All the above are in order *)
+     lf, ff, eof, del, tab, EOL ;
+
+(*
+   Note that lf, eof and EOL are added.
+*)
+
+CONST
+@findex nul (const)
+@findex soh (const)
+@findex stx (const)
+@findex etx (const)
+     nul=000C; soh=001C; stx=002C; etx=003C;
+@findex eot (const)
+@findex enq (const)
+@findex ack (const)
+@findex bel (const)
+     eot=004C; enq=005C; ack=006C; bel=007C;
+@findex bs (const)
+@findex ht (const)
+@findex nl (const)
+@findex vt (const)
+     bs =010C; ht =011C; nl =012C; vt =013C;
+@findex np (const)
+@findex cr (const)
+@findex so (const)
+@findex si (const)
+     np =014C; cr =015C; so =016C; si =017C;
+@findex dle (const)
+@findex dc1 (const)
+@findex dc2 (const)
+@findex dc3 (const)
+     dle=020C; dc1=021C; dc2=022C; dc3=023C;
+@findex dc4 (const)
+@findex nak (const)
+@findex syn (const)
+@findex etb (const)
+     dc4=024C; nak=025C; syn=026C; etb=027C;
+@findex can (const)
+@findex em (const)
+@findex sub (const)
+@findex esc (const)
+     can=030C; em =031C; sub=032C; esc=033C;
+@findex fs (const)
+@findex gs (const)
+@findex rs (const)
+@findex us (const)
+     fs =034C; gs =035C; rs =036C; us =037C;
+@findex sp (const)
+     sp =040C; (* All the above are in order *)
+@findex lf (const)
+@findex ff (const)
+@findex eof (const)
+@findex tab (const)
+     lf =nl  ; ff =np  ; eof=eot ; tab=ht  ;
+@findex del (const)
+@findex EOL (const)
+     del=177C; EOL=nl  ;
+
+END ASCII.
+@end example
+@page
+
+@node gm2-libs/Args, gm2-libs/Assertion, gm2-libs/ASCII, Base libraries
+@subsection gm2-libs/Args
+
+@example
+DEFINITION MODULE Args ;
+
+EXPORT QUALIFIED GetArg, Narg ;
+
+
+(*
+   GetArg - returns the nth argument from the command line.
+            The success of the operation is returned.
+*)
+
+@findex GetArg
+PROCEDURE GetArg (VAR a: ARRAY OF CHAR; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line.
+*)
+
+@findex Narg
+PROCEDURE Narg () : CARDINAL ;
+
+
+END Args.
+@end example
+@page
+
+@node gm2-libs/Assertion, gm2-libs/Break, gm2-libs/Args, Base libraries
+@subsection gm2-libs/Assertion
+
+@example
+DEFINITION MODULE Assertion ;
+
+EXPORT QUALIFIED Assert ;
+
+
+(*
+   Assert - tests the boolean Condition, if it fails then HALT
+            is called.
+*)
+
+@findex Assert
+PROCEDURE Assert (Condition: BOOLEAN) ;
+
+
+END Assertion.
+@end example
+@page
+
+@node gm2-libs/Break, gm2-libs/Builtins, gm2-libs/Assertion, Base libraries
+@subsection gm2-libs/Break
+
+@example
+DEFINITION MODULE Break ;
+
+END Break.
+@end example
+@page
+
+@node gm2-libs/Builtins, gm2-libs/COROUTINES, gm2-libs/Break, Base libraries
+@subsection gm2-libs/Builtins
+
+@example
+DEFINITION MODULE Builtins ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+(* floating point intrinsic procedure functions *)
+
+@findex isfinitef
+PROCEDURE __BUILTIN__ isfinitef (x: SHORTREAL) : BOOLEAN ;
+@findex isfinite
+PROCEDURE __BUILTIN__ isfinite (x: REAL) : BOOLEAN ;
+@findex isfinitel
+PROCEDURE __BUILTIN__ isfinitel (x: LONGREAL) : BOOLEAN ;
+
+@findex sinf
+PROCEDURE __BUILTIN__ sinf (x: SHORTREAL) : SHORTREAL ;
+@findex sin
+PROCEDURE __BUILTIN__ sin (x: REAL) : REAL ;
+@findex sinl
+PROCEDURE __BUILTIN__ sinl (x: LONGREAL) : LONGREAL ;
+
+@findex cosf
+PROCEDURE __BUILTIN__ cosf (x: SHORTREAL) : SHORTREAL ;
+@findex cos
+PROCEDURE __BUILTIN__ cos (x: REAL) : REAL ;
+@findex cosl
+PROCEDURE __BUILTIN__ cosl (x: LONGREAL) : LONGREAL ;
+
+@findex sqrtf
+PROCEDURE __BUILTIN__ sqrtf (x: SHORTREAL) : SHORTREAL ;
+@findex sqrt
+PROCEDURE __BUILTIN__ sqrt (x: REAL) : REAL ;
+@findex sqrtl
+PROCEDURE __BUILTIN__ sqrtl (x: LONGREAL) : LONGREAL ;
+
+@findex atan2f
+PROCEDURE __BUILTIN__ atan2f (x, y: SHORTREAL) : SHORTREAL ;
+@findex atan2
+PROCEDURE __BUILTIN__ atan2 (x, y: REAL) : REAL ;
+@findex atan2l
+PROCEDURE __BUILTIN__ atan2l (x, y: LONGREAL) : LONGREAL ;
+
+@findex fabsf
+PROCEDURE __BUILTIN__ fabsf (x: SHORTREAL) : SHORTREAL ;
+@findex fabs
+PROCEDURE __BUILTIN__ fabs (x: REAL) : REAL ;
+@findex fabsl
+PROCEDURE __BUILTIN__ fabsl (x: LONGREAL) : LONGREAL ;
+
+@findex logf
+PROCEDURE __BUILTIN__ logf (x: SHORTREAL) : SHORTREAL ;
+@findex log
+PROCEDURE __BUILTIN__ log (x: REAL) : REAL ;
+@findex logl
+PROCEDURE __BUILTIN__ logl (x: LONGREAL) : LONGREAL ;
+
+@findex expf
+PROCEDURE __BUILTIN__ expf (x: SHORTREAL) : SHORTREAL ;
+@findex exp
+PROCEDURE __BUILTIN__ exp (x: REAL) : REAL ;
+@findex expl
+PROCEDURE __BUILTIN__ expl (x: LONGREAL) : LONGREAL ;
+
+@findex log10f
+PROCEDURE __BUILTIN__ log10f (x: SHORTREAL) : SHORTREAL ;
+@findex log10
+PROCEDURE __BUILTIN__ log10 (x: REAL) : REAL ;
+@findex log10l
+PROCEDURE __BUILTIN__ log10l (x: LONGREAL) : LONGREAL ;
+
+@findex exp10f
+PROCEDURE __BUILTIN__ exp10f (x: SHORTREAL) : SHORTREAL ;
+@findex exp10
+PROCEDURE __BUILTIN__ exp10 (x: REAL) : REAL ;
+@findex exp10l
+PROCEDURE __BUILTIN__ exp10l (x: LONGREAL) : LONGREAL ;
+
+@findex ilogbf
+PROCEDURE __BUILTIN__ ilogbf (x: SHORTREAL) : INTEGER ;
+@findex ilogb
+PROCEDURE __BUILTIN__ ilogb (x: REAL) : INTEGER ;
+@findex ilogbl
+PROCEDURE __BUILTIN__ ilogbl (x: LONGREAL) : INTEGER ;
+
+@findex huge_val
+PROCEDURE __BUILTIN__ huge_val () : REAL ;
+@findex huge_valf
+PROCEDURE __BUILTIN__ huge_valf () : SHORTREAL ;
+@findex huge_vall
+PROCEDURE __BUILTIN__ huge_vall () : LONGREAL ;
+
+@findex significand
+PROCEDURE __BUILTIN__ significand (r: REAL) : REAL ;
+@findex significandf
+PROCEDURE __BUILTIN__ significandf (s: SHORTREAL) : SHORTREAL ;
+@findex significandl
+PROCEDURE __BUILTIN__ significandl (l: LONGREAL) : LONGREAL ;
+
+@findex modf
+PROCEDURE __BUILTIN__ modf (x: REAL; VAR y: REAL) : REAL ;
+@findex modff
+PROCEDURE __BUILTIN__ modff (x: SHORTREAL;
+                             VAR y: SHORTREAL) : SHORTREAL ;
+@findex modfl
+PROCEDURE __BUILTIN__ modfl (x: LONGREAL; VAR y: LONGREAL) : LONGREAL ;
+
+@findex signbit
+PROCEDURE __BUILTIN__ signbit (r: REAL) : INTEGER ;
+@findex signbitf
+PROCEDURE __BUILTIN__ signbitf (s: SHORTREAL) : INTEGER ;
+@findex signbitl
+PROCEDURE __BUILTIN__ signbitl (l: LONGREAL) : INTEGER ;
+
+@findex nextafter
+PROCEDURE __BUILTIN__ nextafter (x, y: REAL) : REAL ;
+@findex nextafterf
+PROCEDURE __BUILTIN__ nextafterf (x, y: SHORTREAL) : SHORTREAL ;
+@findex nextafterl
+PROCEDURE __BUILTIN__ nextafterl (x, y: LONGREAL) : LONGREAL ;
+
+@findex nexttoward
+PROCEDURE __BUILTIN__ nexttoward (x, y: REAL) : LONGREAL ;
+@findex nexttowardf
+PROCEDURE __BUILTIN__ nexttowardf (x, y: SHORTREAL) : LONGREAL ;
+@findex nexttowardl
+PROCEDURE __BUILTIN__ nexttowardl (x, y: LONGREAL) : LONGREAL ;
+
+@findex scalb
+PROCEDURE __BUILTIN__ scalb (x, n: REAL) : REAL ;
+@findex scalbf
+PROCEDURE __BUILTIN__ scalbf (x, n: SHORTREAL) : SHORTREAL ;
+@findex scalbl
+PROCEDURE __BUILTIN__ scalbl (x, n: LONGREAL) : LONGREAL ;
+
+@findex scalbln
+PROCEDURE __BUILTIN__ scalbln (x: REAL; n: LONGINT) : REAL ;
+@findex scalblnf
+PROCEDURE __BUILTIN__ scalblnf (x: SHORTREAL; n: LONGINT) : SHORTREAL ;
+@findex scalblnl
+PROCEDURE __BUILTIN__ scalblnl (x: LONGREAL; n: LONGINT) : LONGREAL ;
+
+@findex scalbn
+PROCEDURE __BUILTIN__ scalbn (x: REAL; n: INTEGER) : REAL ;
+@findex scalbnf
+PROCEDURE __BUILTIN__ scalbnf (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+@findex scalbnl
+PROCEDURE __BUILTIN__ scalbnl (x: LONGREAL; n: INTEGER) : LONGREAL ;
+
+(* complex arithmetic intrincic procedure functions *)
+
+@findex cabsf
+PROCEDURE __BUILTIN__ cabsf (z: SHORTCOMPLEX) : SHORTREAL ;
+@findex cabs
+PROCEDURE __BUILTIN__ cabs (z: COMPLEX) : REAL ;
+@findex cabsl
+PROCEDURE __BUILTIN__ cabsl (z: LONGCOMPLEX) : LONGREAL ;
+
+@findex cargf
+PROCEDURE __BUILTIN__ cargf (z: SHORTCOMPLEX) : SHORTREAL ;
+@findex carg
+PROCEDURE __BUILTIN__ carg (z: COMPLEX) : REAL ;
+@findex cargl
+PROCEDURE __BUILTIN__ cargl (z: LONGCOMPLEX) : LONGREAL ;
+
+@findex conjf
+PROCEDURE __BUILTIN__ conjf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex conj
+PROCEDURE __BUILTIN__ conj (z: COMPLEX) : COMPLEX ;
+@findex conjl
+PROCEDURE __BUILTIN__ conjl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex cpowerf
+PROCEDURE __BUILTIN__ cpowerf (base: SHORTCOMPLEX;
+                               exp: SHORTREAL) : SHORTCOMPLEX ;
+@findex cpower
+PROCEDURE __BUILTIN__ cpower (base: COMPLEX; exp: REAL) : COMPLEX ;
+@findex cpowerl
+PROCEDURE __BUILTIN__ cpowerl (base: LONGCOMPLEX;
+                               exp: LONGREAL) : LONGCOMPLEX ;
+
+@findex csqrtf
+PROCEDURE __BUILTIN__ csqrtf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex csqrt
+PROCEDURE __BUILTIN__ csqrt (z: COMPLEX) : COMPLEX ;
+@findex csqrtl
+PROCEDURE __BUILTIN__ csqrtl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex cexpf
+PROCEDURE __BUILTIN__ cexpf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex cexp
+PROCEDURE __BUILTIN__ cexp (z: COMPLEX) : COMPLEX ;
+@findex cexpl
+PROCEDURE __BUILTIN__ cexpl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex clnf
+PROCEDURE __BUILTIN__ clnf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex cln
+PROCEDURE __BUILTIN__ cln (z: COMPLEX) : COMPLEX ;
+@findex clnl
+PROCEDURE __BUILTIN__ clnl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex csinf
+PROCEDURE __BUILTIN__ csinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex csin
+PROCEDURE __BUILTIN__ csin (z: COMPLEX) : COMPLEX ;
+@findex csinl
+PROCEDURE __BUILTIN__ csinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex ccosf
+PROCEDURE __BUILTIN__ ccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex ccos
+PROCEDURE __BUILTIN__ ccos (z: COMPLEX) : COMPLEX ;
+@findex ccosl
+PROCEDURE __BUILTIN__ ccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex ctanf
+PROCEDURE __BUILTIN__ ctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex ctan
+PROCEDURE __BUILTIN__ ctan (z: COMPLEX) : COMPLEX ;
+@findex ctanl
+PROCEDURE __BUILTIN__ ctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex carcsinf
+PROCEDURE __BUILTIN__ carcsinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex carcsin
+PROCEDURE __BUILTIN__ carcsin (z: COMPLEX) : COMPLEX ;
+@findex carcsinl
+PROCEDURE __BUILTIN__ carcsinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex carccosf
+PROCEDURE __BUILTIN__ carccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex carccos
+PROCEDURE __BUILTIN__ carccos (z: COMPLEX) : COMPLEX ;
+@findex carccosl
+PROCEDURE __BUILTIN__ carccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex carctanf
+PROCEDURE __BUILTIN__ carctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex carctan
+PROCEDURE __BUILTIN__ carctan (z: COMPLEX) : COMPLEX ;
+@findex carctanl
+PROCEDURE __BUILTIN__ carctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+(* memory and string intrincic procedure functions *)
+
+@findex alloca
+PROCEDURE __BUILTIN__ alloca (i: CARDINAL) : ADDRESS ;
+@findex memcpy
+PROCEDURE __BUILTIN__ memcpy (dest, src: ADDRESS;
+                              nbytes: CARDINAL) : ADDRESS ;
+@findex index
+PROCEDURE __BUILTIN__ index (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex rindex
+PROCEDURE __BUILTIN__ rindex (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex memcmp
+PROCEDURE __BUILTIN__ memcmp (s1, s2: ADDRESS;
+                              nbytes: CARDINAL) : INTEGER ;
+@findex memset
+PROCEDURE __BUILTIN__ memset (s: ADDRESS; c: INTEGER;
+                              nbytes: CARDINAL) : ADDRESS ;
+@findex memmove
+PROCEDURE __BUILTIN__ memmove (s1, s2: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+@findex strcat
+PROCEDURE __BUILTIN__ strcat (dest, src: ADDRESS) : ADDRESS ;
+@findex strncat
+PROCEDURE __BUILTIN__ strncat (dest, src: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+@findex strcpy
+PROCEDURE __BUILTIN__ strcpy (dest, src: ADDRESS) : ADDRESS ;
+@findex strncpy
+PROCEDURE __BUILTIN__ strncpy (dest, src: ADDRESS;
+                               nbytes: CARDINAL) : ADDRESS ;
+@findex strcmp
+PROCEDURE __BUILTIN__ strcmp (s1, s2: ADDRESS) : INTEGER ;
+@findex strncmp
+PROCEDURE __BUILTIN__ strncmp (s1, s2: ADDRESS;
+                               nbytes: CARDINAL) : INTEGER ;
+@findex strlen
+PROCEDURE __BUILTIN__ strlen (s: ADDRESS) : INTEGER ;
+@findex strstr
+PROCEDURE __BUILTIN__ strstr (haystack, needle: ADDRESS) : ADDRESS ;
+@findex strpbrk
+PROCEDURE __BUILTIN__ strpbrk (s, accept: ADDRESS) : ADDRESS ;
+@findex strspn
+PROCEDURE __BUILTIN__ strspn (s, accept: ADDRESS) : CARDINAL ;
+@findex strcspn
+PROCEDURE __BUILTIN__ strcspn (s, accept: ADDRESS) : CARDINAL ;
+@findex strchr
+PROCEDURE __BUILTIN__ strchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex strrchr
+PROCEDURE __BUILTIN__ strrchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+
+(*
+   longjmp - this GCC builtin restricts the val to always 1.
+*)
+(* do not use these two builtins, as gcc, only really
+   anticipates that the Ada front end should use them
+   and it only uses them in its runtime exception handling.
+   We leave them here in the hope that someday they will
+   behave more like their libc counterparts.  *)
+
+@findex longjmp
+PROCEDURE __BUILTIN__ longjmp (env: ADDRESS; val: INTEGER) ;
+@findex setjmp
+PROCEDURE __BUILTIN__ setjmp (env: ADDRESS) : INTEGER ;
+
+
+(*
+   frame_address - returns the address of the frame.
+                   The current frame is obtained if level is 0,
+                   the next level up if level is 1 etc.
+*)
+
+@findex frame_address
+PROCEDURE __BUILTIN__ frame_address (level: CARDINAL) : ADDRESS ;
+
+
+(*
+   return_address - returns the return address of function.
+                    The current function return address is
+                    obtained if level is 0,
+                    the next level up if level is 1 etc.
+*)
+
+@findex return_address
+PROCEDURE __BUILTIN__ return_address (level: CARDINAL) : ADDRESS ;
+
+
+(*
+   alloca_trace - this is a no-op which is used for internal debugging.
+*)
+
+@findex alloca_trace
+PROCEDURE alloca_trace (returned: ADDRESS; nBytes: CARDINAL) : ADDRESS ;
+
+
+END Builtins.
+@end example
+@page
+
+@node gm2-libs/COROUTINES, gm2-libs/CmdArgs, gm2-libs/Builtins, Base libraries
+@subsection gm2-libs/COROUTINES
+
+@example
+DEFINITION MODULE FOR "C" COROUTINES ;
+
+CONST
+   UnassignedPriority = 0 ;
+
+TYPE
+@findex INTERRUPTSOURCE (type)
+   INTERRUPTSOURCE = CARDINAL ;
+@findex PROTECTION (type)
+   PROTECTION = [UnassignedPriority..7] ;
+
+END COROUTINES.
+@end example
+@page
+
+@node gm2-libs/CmdArgs, gm2-libs/Debug, gm2-libs/COROUTINES, Base libraries
+@subsection gm2-libs/CmdArgs
+
+@example
+DEFINITION MODULE CmdArgs ;
+
+EXPORT QUALIFIED GetArg, Narg ;
+
+
+(*
+   GetArg - returns the nth argument from the command line, CmdLine
+            the success of the operation is returned.
+*)
+
+@findex GetArg
+PROCEDURE GetArg (CmdLine: ARRAY OF CHAR;
+                  n: CARDINAL; VAR Argi: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line, CmdLine.
+*)
+
+@findex Narg
+PROCEDURE Narg (CmdLine: ARRAY OF CHAR) : CARDINAL ;
+
+
+END CmdArgs.
+@end example
+@page
+
+@node gm2-libs/Debug, gm2-libs/DynamicStrings, gm2-libs/CmdArgs, Base libraries
+@subsection gm2-libs/Debug
+
+@example
+DEFINITION MODULE Debug ;
+
+(*
+    Description: provides some simple debugging routines.
+*)
+
+EXPORT QUALIFIED Halt, DebugString ;
+
+
+(*
+   Halt - writes a message in the format:
+          Module:Line:Message
+
+          It then terminates by calling HALT.
+*)
+
+@findex Halt
+PROCEDURE Halt (Message: ARRAY OF CHAR;
+                LineNo: CARDINAL;
+                Module: ARRAY OF CHAR) ;
+
+
+(*
+   DebugString - writes a string to the debugging device (Scn.Write).
+                 It interprets \n as carriage return, linefeed.
+*)
+
+@findex DebugString
+PROCEDURE DebugString (a: ARRAY OF CHAR) ;
+
+
+END Debug.
+@end example
+@page
+
+@node gm2-libs/DynamicStrings, gm2-libs/Environment, gm2-libs/Debug, Base libraries
+@subsection gm2-libs/DynamicStrings
+
+@example
+DEFINITION MODULE DynamicStrings ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED String,
+                 InitString, KillString, Fin, InitStringCharStar,
+                 InitStringChar, Index, RIndex,
+                 Mark, Length, ConCat, ConCatChar, Assign, Dup, Add,
+                 Equal, EqualCharStar, EqualArray, ToUpper, ToLower,
+                 CopyOut, Mult, Slice,
+                 RemoveWhitePrefix, RemoveWhitePostfix, RemoveComment,
+                 char, string,
+                 InitStringDB, InitStringCharStarDB, InitStringCharDB,
+                 MultDB, DupDB, SliceDB,
+                 PushAllocation, PopAllocation, PopAllocationExemption ;
+
+TYPE
+@findex String (type)
+   String ;
+
+
+(*
+   InitString - creates and returns a String type object.
+                Initial contents are, a.
+*)
+
+@findex InitString
+PROCEDURE InitString (a: ARRAY OF CHAR) : String ;
+
+
+(*
+   KillString - frees String, s, and its contents.
+                NIL is returned.
+*)
+
+@findex KillString
+PROCEDURE KillString (s: String) : String ;
+
+
+(*
+   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.
+*)
+
+@findex Fin
+PROCEDURE Fin (s: String) ;
+
+
+(*
+   InitStringCharStar - initializes and returns a String to contain
+                        the C string.
+*)
+
+@findex InitStringCharStar
+PROCEDURE InitStringCharStar (a: ADDRESS) : String ;
+
+
+(*
+   InitStringChar - initializes and returns a String to contain the
+                    single character, ch.
+*)
+
+@findex InitStringChar
+PROCEDURE InitStringChar (ch: CHAR) : String ;
+
+
+(*
+   Mark - marks String, s, ready for garbage collection.
+*)
+
+@findex Mark
+PROCEDURE Mark (s: String) : String ;
+
+
+(*
+   Length - returns the length of the String, s.
+*)
+
+@findex Length
+PROCEDURE Length (s: String) : CARDINAL ;
+
+
+(*
+   ConCat - returns String, a, after the contents of, b,
+            have been appended.
+*)
+
+@findex ConCat
+PROCEDURE ConCat (a, b: String) : String ;
+
+
+(*
+   ConCatChar - returns String, a, after character, ch,
+                has been appended.
+*)
+
+@findex ConCatChar
+PROCEDURE ConCatChar (a: String; ch: CHAR) : String ;
+
+
+(*
+   Assign - assigns the contents of, b, into, a.
+            String, a, is returned.
+*)
+
+@findex Assign
+PROCEDURE Assign (a, b: String) : String ;
+
+
+(*
+   Dup - duplicate a String, s, returning the copy of s.
+*)
+
+@findex Dup
+PROCEDURE Dup (s: String) : String ;
+
+
+(*
+   Add - returns a new String which contains the contents of a and b.
+*)
+
+@findex Add
+PROCEDURE Add (a, b: String) : String ;
+
+
+(*
+   Equal - returns TRUE if String, a, and, b, are equal.
+*)
+
+@findex Equal
+PROCEDURE Equal (a, b: String) : BOOLEAN ;
+
+
+(*
+   EqualCharStar - returns TRUE if contents of String, s, is
+                   the same as the string, a.
+*)
+
+@findex EqualCharStar
+PROCEDURE EqualCharStar (s: String; a: ADDRESS) : BOOLEAN ;
+
+
+(*
+   EqualArray - returns TRUE if contents of String, s, is the
+                same as the string, a.
+*)
+
+@findex EqualArray
+PROCEDURE EqualArray (s: String; a: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   Mult - returns a new string which is n concatenations of String, s.
+          If n<=0 then an empty string is returned.
+*)
+
+@findex Mult
+PROCEDURE Mult (s: String; n: CARDINAL) : String ;
+
+
+(*
+   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
+*)
+
+@findex Slice
+PROCEDURE Slice (s: String; low, high: INTEGER) : String ;
+
+
+(*
+   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.
+*)
+
+@findex Index
+PROCEDURE Index (s: String; ch: CHAR; o: CARDINAL) : INTEGER ;
+
+
+(*
+   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.
+*)
+
+@findex RIndex
+PROCEDURE RIndex (s: String; ch: CHAR; o: CARDINAL) : INTEGER ;
+
+
+(*
+   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.
+*)
+
+@findex RemoveComment
+PROCEDURE RemoveComment (s: String; comment: CHAR) : String ;
+
+
+(*
+   RemoveWhitePrefix - removes any leading white space from String, s.
+                       A new string is returned.
+*)
+
+@findex RemoveWhitePrefix
+PROCEDURE RemoveWhitePrefix (s: String) : String ;
+
+
+(*
+   RemoveWhitePostfix - removes any leading white space from String, s.
+                        A new string is returned.
+*)
+
+@findex RemoveWhitePostfix
+PROCEDURE RemoveWhitePostfix (s: String) : String ;
+
+
+(*
+   ToUpper - returns string, s, after it has had its lower case
+             characters replaced by upper case characters.
+             The string, s, is not duplicated.
+*)
+
+@findex ToUpper
+PROCEDURE ToUpper (s: String) : String ;
+
+
+(*
+   ToLower - returns string, s, after it has had its upper case
+             characters replaced by lower case characters.
+             The string, s, is not duplicated.
+*)
+
+@findex ToLower
+PROCEDURE ToLower (s: String) : String ;
+
+
+(*
+   CopyOut - copies string, s, to a.
+*)
+
+@findex CopyOut
+PROCEDURE CopyOut (VAR a: ARRAY OF CHAR; s: String) ;
+
+
+(*
+   char - returns the character, ch, at position, i, in String, s.
+          As Slice the index can be negative so:
+
+          char(s, 0) will return the first character
+          char(s, 1) will return the second character
+          char(s, -1) will return the last character
+          char(s, -2) will return the penultimate character
+
+          a nul character is returned if the index is out of range.
+*)
+
+@findex char
+PROCEDURE char (s: String; i: INTEGER) : CHAR ;
+
+
+(*
+   string - returns the C style char * of String, s.
+*)
+
+@findex string
+PROCEDURE string (s: String) : ADDRESS ;
+
+
+(*
+   to easily debug an application using this library one could use
+   use the following macro processing defines:
+
+   #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__)
+
+   and then invoke gm2 with the -fcpp flag.
+*)
+
+
+(*
+   InitStringDB - the debug version of InitString.
+*)
+
+@findex InitStringDB
+PROCEDURE InitStringDB (a: ARRAY OF CHAR;
+                        file: ARRAY OF CHAR; line: CARDINAL) : String ;
+
+
+(*
+   InitStringCharStarDB - the debug version of InitStringCharStar.
+*)
+
+@findex InitStringCharStarDB
+PROCEDURE InitStringCharStarDB (a: ADDRESS;
+                                file: ARRAY OF CHAR;
+                                line: CARDINAL) : String ;
+
+
+(*
+   InitStringCharDB - the debug version of InitStringChar.
+*)
+
+@findex InitStringCharDB
+PROCEDURE InitStringCharDB (ch: CHAR;
+                            file: ARRAY OF CHAR;
+                            line: CARDINAL) : String ;
+
+
+(*
+   MultDB - the debug version of MultDB.
+*)
+
+@findex MultDB
+PROCEDURE MultDB (s: String; n: CARDINAL;
+                  file: ARRAY OF CHAR; line: CARDINAL) : String ;
+
+
+(*
+   DupDB - the debug version of Dup.
+*)
+
+@findex DupDB
+PROCEDURE DupDB (s: String;
+                 file: ARRAY OF CHAR; line: CARDINAL) : String ;
+
+
+(*
+   SliceDB - debug version of Slice.
+*)
+
+@findex SliceDB
+PROCEDURE SliceDB (s: String; low, high: INTEGER;
+                   file: ARRAY OF CHAR; line: CARDINAL) : String ;
+
+(*
+   PushAllocation - pushes the current allocation/deallocation lists.
+*)
+
+@findex PushAllocation
+PROCEDURE PushAllocation ;
+
+
+(*
+   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.
+*)
+
+@findex PopAllocation
+PROCEDURE PopAllocation (halt: BOOLEAN) ;
+
+
+(*
+   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.
+
+                            The string, e, is returned unmodified,
+*)
+
+@findex PopAllocationExemption
+PROCEDURE PopAllocationExemption (halt: BOOLEAN; e: String) : String ;
+
+
+END DynamicStrings.
+@end example
+@page
+
+@node gm2-libs/Environment, gm2-libs/FIO, gm2-libs/DynamicStrings, Base libraries
+@subsection gm2-libs/Environment
+
+@example
+DEFINITION MODULE Environment ;
+
+EXPORT QUALIFIED GetEnvironment, PutEnvironment ;
+
+
+(*
+   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.
+*)
+
+@findex GetEnvironment
+PROCEDURE GetEnvironment (Env: ARRAY OF CHAR;
+                          VAR dest: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   PutEnvironment - change or add an environment variable definition
+                    EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*)
+
+@findex PutEnvironment
+PROCEDURE PutEnvironment (EnvDef: ARRAY OF CHAR) : BOOLEAN ;
+
+
+END Environment.
+@end example
+@page
+
+@node gm2-libs/FIO, gm2-libs/FormatStrings, gm2-libs/Environment, Base libraries
+@subsection gm2-libs/FIO
+
+@example
+DEFINITION MODULE FIO ;
+
+(* Provides a simple buffered file input/output library.  *)
+
+
+FROM SYSTEM IMPORT ADDRESS, BYTE ;
+
+EXPORT QUALIFIED (* types *)
+                 File,
+                 (* procedures *)
+                 OpenToRead, OpenToWrite, OpenForRandom, Close,
+                 EOF, EOLN, WasEOLN, IsNoError, Exists, IsActive,
+                 exists, openToRead, openToWrite, openForRandom,
+                 SetPositionFromBeginning,
+                 SetPositionFromEnd,
+                 FindPosition,
+                 ReadChar, ReadString,
+                 WriteChar, WriteString, WriteLine,
+                 WriteCardinal, ReadCardinal,
+                 UnReadChar,
+                 WriteNBytes, ReadNBytes,
+                 FlushBuffer,
+                 GetUnixFileDescriptor,
+                 GetFileName, getFileName, getFileNameLength,
+                 FlushOutErr,
+                 (* variables *)
+                 StdIn, StdOut, StdErr ;
+
+TYPE
+@findex File (type)
+   File = CARDINAL ;
+
+(* the following variables are initialized to their UNIX equivalents *)
+VAR
+@findex StdIn (var)
+@findex StdOut (var)
+@findex StdErr (var)
+   StdIn, StdOut, StdErr: File ;
+
+
+
+(*
+   IsNoError - returns a TRUE if no error has occured on file, f.
+*)
+
+@findex IsNoError
+PROCEDURE IsNoError (f: File) : BOOLEAN ;
+
+
+(*
+   IsActive - returns TRUE if the file, f, is still active.
+*)
+
+@findex IsActive
+PROCEDURE IsActive (f: File) : BOOLEAN ;
+
+
+(*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*)
+
+@findex Exists
+PROCEDURE Exists (fname: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+@findex OpenToRead
+PROCEDURE OpenToRead (fname: ARRAY OF CHAR) : File ;
+
+
+(*
+   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.
+*)
+
+@findex OpenToWrite
+PROCEDURE OpenToWrite (fname: ARRAY OF CHAR) : File ;
+
+
+(*
+   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.
+                   newfile, determines whether a file should be
+                   created if towrite is TRUE or whether the
+                   previous file should be left alone,
+                   allowing this descriptor to seek
+                   and modify an existing file.
+*)
+
+@findex OpenForRandom
+PROCEDURE OpenForRandom (fname: ARRAY OF CHAR;
+                         towrite, newfile: BOOLEAN) : File ;
+
+
+(*
+   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.
+*)
+
+@findex Close
+PROCEDURE Close (f: File) ;
+
+
+(* the following functions are functionally equivalent to the above
+   except they allow C style names.
+*)
+
+@findex exists
+PROCEDURE exists        (fname: ADDRESS; flength: CARDINAL) : BOOLEAN ;
+@findex openToRead
+PROCEDURE openToRead    (fname: ADDRESS; flength: CARDINAL) : File ;
+@findex openToWrite
+PROCEDURE openToWrite   (fname: ADDRESS; flength: CARDINAL) : File ;
+@findex openForRandom
+PROCEDURE openForRandom (fname: ADDRESS; flength: CARDINAL;
+                         towrite, newfile: BOOLEAN) : File ;
+
+
+(*
+   FlushBuffer - flush contents of the FIO file, f, to libc.
+*)
+
+@findex FlushBuffer
+PROCEDURE FlushBuffer (f: File) ;
+
+
+(*
+   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.
+*)
+
+@findex ReadNBytes
+PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL;
+                      dest: ADDRESS) : CARDINAL ;
+
+
+(*
+   ReadAny - reads HIGH(a) bytes into, a. All input
+             is fully buffered, unlike ReadNBytes and thus is more
+             suited to small reads.
+*)
+
+@findex ReadAny
+PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   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.
+*)
+
+@findex WriteNBytes
+PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL;
+                       src: ADDRESS) : CARDINAL ;
+
+
+(*
+   WriteAny - writes HIGH(a) bytes onto, file, f. All output
+              is fully buffered, unlike WriteNBytes and thus is more
+              suited to small writes.
+*)
+
+@findex WriteAny
+PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   WriteChar - writes a single character to file, f.
+*)
+
+@findex WriteChar
+PROCEDURE WriteChar (f: File; ch: CHAR) ;
+
+
+(*
+   EOF - tests to see whether a file, f, has reached end of file.
+*)
+
+@findex EOF
+PROCEDURE EOF (f: File) : BOOLEAN ;
+
+
+(*
+   EOLN - tests to see whether a file, f, is about to read a newline.
+          It does NOT consume the newline.  It reads the next character
+          and then immediately unreads the character.
+*)
+
+@findex EOLN
+PROCEDURE EOLN (f: File) : BOOLEAN ;
+
+
+(*
+   WasEOLN - tests to see whether a file, f, has just read a newline
+             character.
+*)
+
+@findex WasEOLN
+PROCEDURE WasEOLN (f: File) : BOOLEAN ;
+
+
+(*
+   ReadChar - returns a character read from file, f.
+              Sensible to check with IsNoError or EOF after calling
+              this function.
+*)
+
+@findex ReadChar
+PROCEDURE ReadChar (f: File) : CHAR ;
+
+
+(*
+   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,
+                end of file or end of line seen.
+*)
+
+@findex UnReadChar
+PROCEDURE UnReadChar (f: File ; ch: CHAR) ;
+
+
+(*
+   WriteLine - writes out a linefeed to file, f.
+*)
+
+@findex WriteLine
+PROCEDURE WriteLine (f: File) ;
+
+
+(*
+   WriteString - writes a string to file, f.
+*)
+
+@findex WriteString
+PROCEDURE WriteString (f: File; a: ARRAY OF CHAR) ;
+
+
+(*
+   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.
+*)
+
+@findex ReadString
+PROCEDURE ReadString (f: File; VAR a: ARRAY OF CHAR) ;
+
+
+(*
+   WriteCardinal - writes a CARDINAL to file, f.
+                   It writes the binary image of the CARDINAL.
+                   to file, f.
+*)
+
+@findex WriteCardinal
+PROCEDURE WriteCardinal (f: File; c: CARDINAL) ;
+
+
+(*
+   ReadCardinal - reads a CARDINAL from file, f.
+                  It reads a bit image of a CARDINAL
+                  from file, f.
+*)
+
+@findex ReadCardinal
+PROCEDURE ReadCardinal (f: File) : CARDINAL ;
+
+
+(*
+   GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+                           Useful when combining FIO.mod with select
+                           (in Selective.def - but note the comments in
+                            Selective about using read/write primatives)
+*)
+
+@findex GetUnixFileDescriptor
+PROCEDURE GetUnixFileDescriptor (f: File) : INTEGER ;
+
+
+(*
+   SetPositionFromBeginning - sets the position from the beginning
+                              of the file.
+*)
+
+@findex SetPositionFromBeginning
+PROCEDURE SetPositionFromBeginning (f: File; pos: LONGINT) ;
+
+
+(*
+   SetPositionFromEnd - sets the position from the end of the file.
+*)
+
+@findex SetPositionFromEnd
+PROCEDURE SetPositionFromEnd (f: File; pos: LONGINT) ;
+
+
+(*
+   FindPosition - returns the current absolute position in file, f.
+*)
+
+@findex FindPosition
+PROCEDURE FindPosition (f: File) : LONGINT ;
+
+
+(*
+   GetFileName - assigns, a, with the filename associated with, f.
+*)
+
+@findex GetFileName
+PROCEDURE GetFileName (f: File; VAR a: ARRAY OF CHAR) ;
+
+
+(*
+   getFileName - returns the address of the filename associated with, f.
+*)
+
+@findex getFileName
+PROCEDURE getFileName (f: File) : ADDRESS ;
+
+
+(*
+   getFileNameLength - returns the number of characters associated with
+                       filename, f.
+*)
+
+@findex getFileNameLength
+PROCEDURE getFileNameLength (f: File) : CARDINAL ;
+
+
+(*
+   FlushOutErr - flushes, StdOut, and, StdErr.
+*)
+
+@findex FlushOutErr
+PROCEDURE FlushOutErr ;
+
+
+END FIO.
+@end example
+@page
+
+@node gm2-libs/FormatStrings, gm2-libs/FpuIO, gm2-libs/FIO, Base libraries
+@subsection gm2-libs/FormatStrings
+
+@example
+DEFINITION MODULE FormatStrings ;
+
+FROM SYSTEM IMPORT BYTE ;
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4,
+                 HandleEscape ;
+
+
+(*
+   Sprintf0 - returns a String containing, fmt, after it has had its
+              escape sequences translated.
+*)
+
+@findex Sprintf0
+PROCEDURE Sprintf0 (fmt: String) : String ;
+
+
+(*
+   Sprintf1 - returns a String containing, fmt, together with
+              encapsulated entity, w. It only formats the
+              first %s or %d with n.
+*)
+
+@findex Sprintf1
+PROCEDURE Sprintf1 (fmt: String; w: ARRAY OF BYTE) : String ;
+
+
+(*
+   Sprintf2 - returns a string, fmt, which has been formatted.
+*)
+
+@findex Sprintf2
+PROCEDURE Sprintf2 (fmt: String; w1, w2: ARRAY OF BYTE) : String ;
+
+
+(*
+   Sprintf3 - returns a string, fmt, which has been formatted.
+*)
+
+@findex Sprintf3
+PROCEDURE Sprintf3 (fmt: String; w1, w2, w3: ARRAY OF BYTE) : String ;
+
+
+(*
+   Sprintf4 - returns a string, fmt, which has been formatted.
+*)
+
+@findex Sprintf4
+PROCEDURE Sprintf4 (fmt: String;
+                    w1, w2, w3, w4: ARRAY OF BYTE) : String ;
+
+
+(*
+   HandleEscape - translates \a, \b, \e, \f, \n, \r, \x[hex] \[octal]
+                  into their respective ascii codes.  It also converts
+                  \[any] into a single [any] character.
+*)
+
+@findex HandleEscape
+PROCEDURE HandleEscape (s: String) : String ;
+
+
+END FormatStrings.
+@end example
+@page
+
+@node gm2-libs/FpuIO, gm2-libs/GetOpt, gm2-libs/FormatStrings, Base libraries
+@subsection gm2-libs/FpuIO
+
+@example
+DEFINITION MODULE FpuIO ;
+
+EXPORT QUALIFIED ReadReal, WriteReal, StrToReal, RealToStr,
+                 ReadLongReal, WriteLongReal, StrToLongReal,
+                 LongRealToStr,
+                 ReadLongInt, WriteLongInt, StrToLongInt,
+                 LongIntToStr ;
+
+
+@findex ReadReal
+PROCEDURE ReadReal (VAR x: REAL) ;
+@findex WriteReal
+PROCEDURE WriteReal (x: REAL; TotalWidth, FractionWidth: CARDINAL) ;
+@findex StrToReal
+PROCEDURE StrToReal (a: ARRAY OF CHAR ; VAR x: REAL) ;
+@findex RealToStr
+PROCEDURE RealToStr (x: REAL; TotalWidth, FractionWidth: CARDINAL;
+                     VAR a: ARRAY OF CHAR) ;
+
+@findex ReadLongReal
+PROCEDURE ReadLongReal (VAR x: LONGREAL) ;
+@findex WriteLongReal
+PROCEDURE WriteLongReal (x: LONGREAL;
+                         TotalWidth, FractionWidth: CARDINAL) ;
+@findex StrToLongReal
+PROCEDURE StrToLongReal (a: ARRAY OF CHAR ; VAR x: LONGREAL) ;
+@findex LongRealToStr
+PROCEDURE LongRealToStr (x: LONGREAL;
+                         TotalWidth, FractionWidth: CARDINAL;
+                         VAR a: ARRAY OF CHAR) ;
+
+@findex ReadLongInt
+PROCEDURE ReadLongInt (VAR x: LONGINT) ;
+@findex WriteLongInt
+PROCEDURE WriteLongInt (x: LONGINT; n: CARDINAL) ;
+@findex StrToLongInt
+PROCEDURE StrToLongInt (a: ARRAY OF CHAR ; VAR x: LONGINT) ;
+@findex LongIntToStr
+PROCEDURE LongIntToStr (x: LONGINT; n: CARDINAL; VAR a: ARRAY OF CHAR) ;
+
+
+END FpuIO.
+@end example
+@page
+
+@node gm2-libs/GetOpt, gm2-libs/IO, gm2-libs/FpuIO, Base libraries
+@subsection gm2-libs/GetOpt
+
+@example
+DEFINITION MODULE GetOpt ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String ;
+
+CONST
+@findex no_argument (const)
+   no_argument = 0 ;
+@findex required_argument (const)
+   required_argument = 1 ;
+@findex optional_argument (const)
+   optional_argument = 2 ;
+
+TYPE
+@findex LongOptions (type)
+   LongOptions ;
+@findex PtrToInteger (type)
+   PtrToInteger = POINTER TO INTEGER ;
+
+(*
+   GetOpt - call C getopt and fill in the parameters:
+            optarg, optind, opterr and optop.
+*)
+
+@findex GetOpt
+PROCEDURE GetOpt (argc: INTEGER; argv: ADDRESS; optstring: String;
+                  VAR optarg: String;
+                  VAR optind, opterr, optopt: INTEGER) : CHAR ;
+
+
+(*
+   InitLongOptions - creates and returns a LongOptions empty array.
+*)
+
+@findex InitLongOptions
+PROCEDURE InitLongOptions () : LongOptions ;
+
+
+(*
+   AddLongOption - appends long option @{name, has_arg, flag, val@} to the
+                   array of options and new long options array is
+                   returned.
+                   The old array, lo, should no longer be used.
+
+   (from man 3 getopt)
+       The meanings of the different fields are:
+
+       name   is the name of the long option.
+
+       has_arg
+              is: no_argument (or 0) if the option does not take an
+              argument; required_argument (or  1) if the option
+              requires an argument; or optional_argument (or 2) if
+              the option takes an optional argument.
+
+       flag   specifies how results are returned for a long option.
+              If flag is NULL, then getopt_long() returns val.
+              (For example, the calling program may set val to the
+              equivalent short option character).  Otherwise,
+              getopt_long() returns 0, and flag points to a
+              variable which is set to val if the option is found,
+              but left unchanged if the option is not found.
+
+       val    is the value to return, or to load into the variable
+              pointed to by flag.
+
+       The last element of the array has to be filled with zeros.
+*)
+
+@findex AddLongOption
+PROCEDURE AddLongOption (lo: LongOptions;
+                         name: String; has_arg: INTEGER;
+                         flag: PtrToInteger;
+                         val: INTEGER) : LongOptions ;
+
+
+(*
+   KillLongOptions - returns NIL and also frees up memory
+                     associated with, lo.
+*)
+
+@findex KillLongOptions
+PROCEDURE KillLongOptions (lo: LongOptions) : LongOptions ;
+
+
+(*
+   GetOptLong - works like GetOpt but will accept long options (using
+                two dashes).  If the program only accepts long options
+                then optstring should be an empty string, not NIL.
+*)
+
+@findex GetOptLong
+PROCEDURE GetOptLong (argc: INTEGER; argv: ADDRESS; optstring: String;
+                      longopts: LongOptions;
+                      VAR longindex: INTEGER) : INTEGER ;
+
+
+(*
+   GetOptLongOnly - works like GetOptLong except that a single dash
+                    can be used for a long option.
+*)
+
+@findex GetOptLongOnly
+PROCEDURE GetOptLongOnly (argc: INTEGER; argv: ADDRESS;
+                          optstring: String; longopts: LongOptions;
+                          VAR longindex: INTEGER) : INTEGER ;
+
+
+END GetOpt.
+@end example
+@page
+
+@node gm2-libs/IO, gm2-libs/Indexing, gm2-libs/GetOpt, Base libraries
+@subsection gm2-libs/IO
+
+@example
+DEFINITION MODULE IO ;
+
+(*
+   Description: provides Read, Write, Errors procedures that map onto UNIX
+                file descriptors 0, 1 and 2. This is achieved by using
+                FIO if we are in buffered mode and using libc.write
+                if not.
+*)
+
+EXPORT QUALIFIED Read, Write, Error,
+                 UnBufferedMode, BufferedMode,
+                 EchoOn, EchoOff ;
+
+
+@findex Read
+PROCEDURE Read (VAR ch: CHAR) ;
+@findex Write
+PROCEDURE Write (ch: CHAR) ;
+@findex Error
+PROCEDURE Error (ch: CHAR) ;
+
+
+(*
+   UnBufferedMode - places file descriptor, fd, into an unbuffered mode.
+*)
+
+@findex UnBufferedMode
+PROCEDURE UnBufferedMode (fd: INTEGER; input: BOOLEAN) ;
+
+
+(*
+   BufferedMode - places file descriptor, fd, into a buffered mode.
+*)
+
+@findex BufferedMode
+PROCEDURE BufferedMode (fd: INTEGER; input: BOOLEAN) ;
+
+
+(*
+   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.
+*)
+
+@findex EchoOn
+PROCEDURE EchoOn (fd: INTEGER; input: BOOLEAN) ;
+
+
+(*
+   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.
+*)
+
+@findex EchoOff
+PROCEDURE EchoOff (fd: INTEGER; input: BOOLEAN) ;
+
+
+END IO.
+@end example
+@page
+
+@node gm2-libs/Indexing, gm2-libs/LMathLib0, gm2-libs/IO, Base libraries
+@subsection gm2-libs/Indexing
+
+@example
+DEFINITION MODULE Indexing ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED Index, InitIndex, KillIndex, GetIndice, PutIndice,
+                 HighIndice, LowIndice, InBounds, IsIndiceInIndex,
+                 RemoveIndiceFromIndex, IncludeIndiceIntoIndex,
+                 ForeachIndiceInIndexDo, DeleteIndice, DebugIndex ;
+
+TYPE
+@findex Index (type)
+   Index ;
+@findex IndexProcedure (type)
+   IndexProcedure = PROCEDURE (ADDRESS) ;
+
+
+(*
+   InitIndex - creates and returns an Index.
+*)
+
+@findex InitIndex
+PROCEDURE InitIndex (low: CARDINAL) : Index ;
+
+
+(*
+   KillIndex - returns Index to free storage.
+*)
+
+@findex KillIndex
+PROCEDURE KillIndex (i: Index) : Index ;
+
+
+(*
+   DebugIndex - turns on debugging within an index.
+*)
+
+@findex DebugIndex
+PROCEDURE DebugIndex (i: Index) : Index ;
+
+
+(*
+   InBounds - returns TRUE if indice, n, is within the bounds
+              of the dynamic array.
+*)
+
+@findex InBounds
+PROCEDURE InBounds (i: Index; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   HighIndice - returns the last legally accessible indice of this array.
+*)
+
+@findex HighIndice
+PROCEDURE HighIndice (i: Index) : CARDINAL ;
+
+
+(*
+   LowIndice - returns the first legally accessible indice of this array.
+*)
+
+@findex LowIndice
+PROCEDURE LowIndice (i: Index) : CARDINAL ;
+
+
+(*
+   PutIndice - places, a, into the dynamic array at position i[n]
+*)
+
+@findex PutIndice
+PROCEDURE PutIndice (i: Index; n: CARDINAL; a: ADDRESS) ;
+
+
+(*
+   GetIndice - retrieves, element i[n] from the dynamic array.
+*)
+
+@findex GetIndice
+PROCEDURE GetIndice (i: Index; n: CARDINAL) : ADDRESS ;
+
+
+(*
+   IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*)
+
+@findex IsIndiceInIndex
+PROCEDURE IsIndiceInIndex (i: Index; a: ADDRESS) : BOOLEAN ;
+
+
+(*
+   RemoveIndiceFromIndex - removes, a, from Index, i.
+*)
+
+@findex RemoveIndiceFromIndex
+PROCEDURE RemoveIndiceFromIndex (i: Index; a: ADDRESS) ;
+
+
+(*
+   DeleteIndice - delete i[j] from the array.
+*)
+
+@findex DeleteIndice
+PROCEDURE DeleteIndice (i: Index; j: CARDINAL) ;
+
+
+(*
+   IncludeIndiceIntoIndex - if the indice is not in the index, then
+                            add it at the end.
+*)
+
+@findex IncludeIndiceIntoIndex
+PROCEDURE IncludeIndiceIntoIndex (i: Index; a: ADDRESS) ;
+
+
+(*
+   ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*)
+
+@findex ForeachIndiceInIndexDo
+PROCEDURE ForeachIndiceInIndexDo (i: Index; p: IndexProcedure) ;
+
+
+END Indexing.
+@end example
+@page
+
+@node gm2-libs/LMathLib0, gm2-libs/LegacyReal, gm2-libs/Indexing, Base libraries
+@subsection gm2-libs/LMathLib0
+
+@example
+DEFINITION MODULE LMathLib0 ;
+
+CONST
+   pi   = 3.1415926535897932384626433832795028841972;
+   exp1 = 2.7182818284590452353602874713526624977572;
+
+
+@findex sqrt
+PROCEDURE __BUILTIN__ sqrt (x: LONGREAL) : LONGREAL ;
+@findex exp
+PROCEDURE exp (x: LONGREAL) : LONGREAL ;
+@findex ln
+PROCEDURE ln (x: LONGREAL) : LONGREAL ;
+@findex sin
+PROCEDURE __BUILTIN__ sin (x: LONGREAL) : LONGREAL ;
+@findex cos
+PROCEDURE __BUILTIN__ cos (x: LONGREAL) : LONGREAL ;
+@findex tan
+PROCEDURE tan (x: LONGREAL) : LONGREAL ;
+@findex arctan
+PROCEDURE arctan (x: LONGREAL) : LONGREAL ;
+@findex entier
+PROCEDURE entier (x: LONGREAL) : INTEGER ;
+
+
+END LMathLib0.
+@end example
+@page
+
+@node gm2-libs/LegacyReal, gm2-libs/M2Dependent, gm2-libs/LMathLib0, Base libraries
+@subsection gm2-libs/LegacyReal
+
+@example
+DEFINITION MODULE LegacyReal ;
+
+TYPE
+   REAL = SHORTREAL ;
+
+
+END LegacyReal.
+@end example
+@page
+
+@node gm2-libs/M2Dependent, gm2-libs/M2EXCEPTION, gm2-libs/LegacyReal, Base libraries
+@subsection gm2-libs/M2Dependent
+
+@example
+DEFINITION MODULE M2Dependent ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+@findex ArgCVEnvP (type)
+   ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+@findex ConstructModules
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+
+@findex DeconstructModules
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+@findex RegisterModule
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*)
+
+@findex RequestDependant
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+
+END M2Dependent.
+@end example
+@page
+
+@node gm2-libs/M2EXCEPTION, gm2-libs/M2LINK, gm2-libs/M2Dependent, Base libraries
+@subsection gm2-libs/M2EXCEPTION
+
+@example
+DEFINITION MODULE M2EXCEPTION;
+
+
+(* This enumerated list of exceptions must match the exceptions in gm2-libs-iso to
+   allow mixed module dialect projects.  *)
+
+TYPE
+@findex M2Exceptions (type)
+  M2Exceptions =
+    (indexException,     rangeException,         caseSelectException,  invalidLocation,
+     functionException,  wholeValueException,    wholeDivException,    realValueException,
+     realDivException,   complexValueException,  complexDivException,  protException,
+     sysException,       coException,            exException
+    );
+
+
+(* 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).  *)
+
+@findex M2Exception
+PROCEDURE M2Exception () : M2Exceptions;
+
+(* 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.  *)
+
+@findex IsM2Exception
+PROCEDURE IsM2Exception () : BOOLEAN;
+
+
+END M2EXCEPTION.
+@end example
+@page
+
+@node gm2-libs/M2LINK, gm2-libs/M2RTS, gm2-libs/M2EXCEPTION, Base libraries
+@subsection gm2-libs/M2LINK
+
+@example
+DEFINITION MODULE FOR "C" M2LINK ;
+
+
+TYPE
+@findex PtrToChar (type)
+   PtrToChar = POINTER TO CHAR ;
+
+(* These variables are set by the compiler in the program module
+   according to linking command line options.  *)
+
+VAR
+@findex ForcedModuleInitOrder (var)
+   ForcedModuleInitOrder: PtrToChar ;
+@findex StaticInitialization (var)
+   StaticInitialization : BOOLEAN ;
+
+
+@findex END M2LINK. (var)
+END M2LINK.
+@end example
+@page
+
+@node gm2-libs/M2RTS, gm2-libs/MathLib0, gm2-libs/M2LINK, Base libraries
+@subsection gm2-libs/M2RTS
+
+@example
+DEFINITION MODULE M2RTS ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+@findex ArgCVEnvP (type)
+   ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+@findex ConstructModules
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+
+@findex DeconstructModules
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+@findex RegisterModule
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*)
+
+@findex RequestDependant
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+
+(*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE is the
+                                 procedure is installed.
+*)
+
+@findex InstallTerminationProcedure
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   ExecuteInitialProcedures - executes the initial procedures installed
+                              by InstallInitialProcedure.
+*)
+
+@findex ExecuteInitialProcedures
+PROCEDURE ExecuteInitialProcedures ;
+
+
+(*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the main
+                             program module.
+*)
+
+@findex InstallInitialProcedure
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   ExecuteTerminationProcedures - calls each installed termination procedure
+                                  in reverse order.
+*)
+
+@findex ExecuteTerminationProcedures
+PROCEDURE ExecuteTerminationProcedures ;
+
+
+(*
+   Terminate - provides compatibility for pim.  It call exit with
+               the exitcode provided in a prior call to ExitOnHalt
+               (or zero if ExitOnHalt was never called).  It does
+               not call ExecuteTerminationProcedures.
+*)
+
+@findex Terminate
+PROCEDURE Terminate <* noreturn *> ;
+
+
+(*
+   HALT - terminate the current program.  The procedure Terminate
+          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.
+*)
+
+@findex HALT
+PROCEDURE HALT ([exitcode: INTEGER = -1]) <* noreturn *> ;
+
+
+(*
+   Halt - provides a more user friendly version of HALT, which takes
+          four parameters to aid debugging.
+*)
+
+@findex Halt
+PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+                function: ARRAY OF CHAR; description: ARRAY OF CHAR)
+		<* noreturn *> ;
+
+
+(*
+   ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*)
+
+@findex ExitOnHalt
+PROCEDURE ExitOnHalt (e: INTEGER) ;
+
+
+(*
+   ErrorMessage - emits an error message to stderr and then calls exit (1).
+*)
+
+@findex ErrorMessage
+PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
+                        file: ARRAY OF CHAR;
+                        line: CARDINAL;
+                        function: ARRAY OF CHAR) <* 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.
+*)
+
+@findex Length
+PROCEDURE Length (a: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   The following are the runtime exception handler routines.
+*)
+
+@findex AssignmentException
+PROCEDURE AssignmentException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ReturnException
+PROCEDURE ReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex IncException
+PROCEDURE IncException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex DecException
+PROCEDURE DecException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex InclException
+PROCEDURE InclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ExclException
+PROCEDURE ExclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ShiftException
+PROCEDURE ShiftException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex RotateException
+PROCEDURE RotateException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex StaticArraySubscriptException
+PROCEDURE StaticArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex DynamicArraySubscriptException
+PROCEDURE DynamicArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ForLoopBeginException
+PROCEDURE ForLoopBeginException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ForLoopToException
+PROCEDURE ForLoopToException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ForLoopEndException
+PROCEDURE ForLoopEndException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex PointerNilException
+PROCEDURE PointerNilException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex NoReturnException
+PROCEDURE NoReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex CaseException
+PROCEDURE CaseException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeNonPosDivException
+PROCEDURE WholeNonPosDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeNonPosModException
+PROCEDURE WholeNonPosModException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeZeroDivException
+PROCEDURE WholeZeroDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeZeroRemException
+PROCEDURE WholeZeroRemException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeValueException
+PROCEDURE WholeValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex RealValueException
+PROCEDURE RealValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ParameterException
+PROCEDURE ParameterException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex NoException
+PROCEDURE NoException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+
+
+END M2RTS.
+@end example
+@page
+
+@node gm2-libs/MathLib0, gm2-libs/MemUtils, gm2-libs/M2RTS, Base libraries
+@subsection gm2-libs/MathLib0
+
+@example
+DEFINITION MODULE MathLib0 ;
+
+CONST
+   pi   = 3.1415926535897932384626433832795028841972;
+   exp1 = 2.7182818284590452353602874713526624977572;
+
+
+@findex sqrt
+PROCEDURE __BUILTIN__ sqrt (x: REAL) : REAL ;
+@findex exp
+PROCEDURE exp (x: REAL) : REAL ;
+@findex ln
+PROCEDURE ln (x: REAL) : REAL ;
+@findex sin
+PROCEDURE __BUILTIN__ sin (x: REAL) : REAL ;
+@findex cos
+PROCEDURE __BUILTIN__ cos (x: REAL) : REAL ;
+@findex tan
+PROCEDURE tan (x: REAL) : REAL ;
+@findex arctan
+PROCEDURE arctan (x: REAL) : REAL ;
+@findex entier
+PROCEDURE entier (x: REAL) : INTEGER ;
+
+
+END MathLib0.
+@end example
+@page
+
+@node gm2-libs/MemUtils, gm2-libs/NumberIO, gm2-libs/MathLib0, Base libraries
+@subsection gm2-libs/MemUtils
+
+@example
+DEFINITION MODULE MemUtils ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED MemCopy, MemZero ;
+
+
+(*
+   MemCopy - copys a region of memory to the required destination.
+*)
+
+@findex MemCopy
+PROCEDURE MemCopy (from: ADDRESS; length: CARDINAL; to: ADDRESS) ;
+
+
+(*
+   MemZero - sets a region of memory: a..a+length to zero.
+*)
+
+@findex MemZero
+PROCEDURE MemZero (a: ADDRESS; length: CARDINAL) ;
+
+
+END MemUtils.
+@end example
+@page
+
+@node gm2-libs/NumberIO, gm2-libs/OptLib, gm2-libs/MemUtils, Base libraries
+@subsection gm2-libs/NumberIO
+
+@example
+DEFINITION MODULE NumberIO ;
+
+EXPORT QUALIFIED ReadCard, WriteCard, ReadHex, WriteHex, ReadInt, WriteInt,
+                 CardToStr, StrToCard, StrToHex, HexToStr, StrToInt, IntToStr,
+                 ReadOct, WriteOct, OctToStr, StrToOct,
+                 ReadBin, WriteBin, BinToStr, StrToBin,
+                 StrToBinInt, StrToHexInt, StrToOctInt ;
+
+
+@findex ReadCard
+PROCEDURE ReadCard (VAR x: CARDINAL) ;
+
+@findex WriteCard
+PROCEDURE WriteCard (x, n: CARDINAL) ;
+
+@findex ReadHex
+PROCEDURE ReadHex (VAR x: CARDINAL) ;
+
+@findex WriteHex
+PROCEDURE WriteHex (x, n: CARDINAL) ;
+
+@findex ReadInt
+PROCEDURE ReadInt (VAR x: INTEGER) ;
+
+@findex WriteInt
+PROCEDURE WriteInt (x: INTEGER ; n: CARDINAL) ;
+
+@findex CardToStr
+PROCEDURE CardToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+@findex StrToCard
+PROCEDURE StrToCard (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+
+@findex HexToStr
+PROCEDURE HexToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+@findex StrToHex
+PROCEDURE StrToHex (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+
+@findex IntToStr
+PROCEDURE IntToStr (x: INTEGER ; n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+@findex StrToInt
+PROCEDURE StrToInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+
+@findex ReadOct
+PROCEDURE ReadOct (VAR x: CARDINAL) ;
+
+@findex WriteOct
+PROCEDURE WriteOct (x, n: CARDINAL) ;
+
+@findex OctToStr
+PROCEDURE OctToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+@findex StrToOct
+PROCEDURE StrToOct (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+
+@findex ReadBin
+PROCEDURE ReadBin (VAR x: CARDINAL) ;
+
+@findex WriteBin
+PROCEDURE WriteBin (x, n: CARDINAL) ;
+
+@findex BinToStr
+PROCEDURE BinToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+@findex StrToBin
+PROCEDURE StrToBin (a: ARRAY OF CHAR ; VAR x: CARDINAL) ;
+
+@findex StrToBinInt
+PROCEDURE StrToBinInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+
+@findex StrToHexInt
+PROCEDURE StrToHexInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+
+@findex StrToOctInt
+PROCEDURE StrToOctInt (a: ARRAY OF CHAR ; VAR x: INTEGER) ;
+
+
+END NumberIO.
+@end example
+@page
+
+@node gm2-libs/OptLib, gm2-libs/PushBackInput, gm2-libs/NumberIO, Base libraries
+@subsection gm2-libs/OptLib
+
+@example
+DEFINITION MODULE OptLib ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String ;
+
+TYPE
+@findex Option (type)
+   Option ;
+
+
+(*
+   InitOption - constructor for Option.
+*)
+
+@findex InitOption
+PROCEDURE InitOption (argc: INTEGER; argv: ADDRESS) : Option ;
+
+
+(*
+   KillOption - deconstructor for Option.
+*)
+
+@findex KillOption
+PROCEDURE KillOption (o: Option) : Option ;
+
+
+(*
+   Dup - duplicate the option array inside, o.
+         Notice that this does not duplicate all the contents
+         (strings) of argv.
+         Shallow copy of the top level indices.
+*)
+
+@findex Dup
+PROCEDURE Dup (o: Option) : Option ;
+
+
+(*
+   Slice - return a new option which has elements [low:high] from the
+           options, o.
+*)
+
+@findex Slice
+PROCEDURE Slice (o: Option; low, high: INTEGER) : Option ;
+
+
+(*
+   IndexStrCmp - returns the index in the argv array which matches
+                 string, s.  -1 is returned if the string is not found.
+*)
+
+@findex IndexStrCmp
+PROCEDURE IndexStrCmp (o: Option; s: String) : INTEGER ;
+
+
+(*
+   IndexStrNCmp - returns the index in the argv array where the first
+                  characters are matched by string, s.
+                  -1 is returned if the string is not found.
+*)
+
+@findex IndexStrNCmp
+PROCEDURE IndexStrNCmp (o: Option; s: String) : INTEGER ;
+
+
+(*
+   ConCat - returns the concatenation of a and b.
+*)
+
+@findex ConCat
+PROCEDURE ConCat (a, b: Option) : Option ;
+
+
+(*
+   GetArgv - return the argv component of option.
+*)
+
+@findex GetArgv
+PROCEDURE GetArgv (o: Option) : ADDRESS ;
+
+
+(*
+   GetArgc - return the argc component of option.
+*)
+
+@findex GetArgc
+PROCEDURE GetArgc (o: Option) : INTEGER ;
+
+
+END OptLib.
+@end example
+@page
+
+@node gm2-libs/PushBackInput, gm2-libs/RTExceptions, gm2-libs/OptLib, Base libraries
+@subsection gm2-libs/PushBackInput
+
+@example
+DEFINITION MODULE PushBackInput ;
+
+FROM FIO IMPORT File ;
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED Open, PutCh, GetCh, Error, WarnError, WarnString,
+                 Close, SetDebug, GetExitStatus, PutStr,
+                 PutString, GetColumnPosition, GetCurrentLine ;
+
+
+(*
+   Open - opens a file for reading.
+*)
+
+@findex Open
+PROCEDURE Open (a: ARRAY OF CHAR) : File ;
+
+
+(*
+   GetCh - gets a character from either the push back stack or
+           from file, f.
+*)
+
+@findex GetCh
+PROCEDURE GetCh (f: File) : CHAR ;
+
+
+(*
+   PutCh - pushes a character onto the push back stack, it also
+           returns the character which has been pushed.
+*)
+
+@findex PutCh
+PROCEDURE PutCh (ch: CHAR) : CHAR ;
+
+
+(*
+   PutString - pushes a string onto the push back stack.
+*)
+
+@findex PutString
+PROCEDURE PutString (a: ARRAY OF CHAR) ;
+
+
+(*
+   PutStr - pushes a dynamic string onto the push back stack.
+            The string, s, is not deallocated.
+*)
+
+@findex PutStr
+PROCEDURE PutStr (s: String) ;
+
+
+(*
+   Error - emits an error message with the appropriate file, line combination.
+*)
+
+@findex Error
+PROCEDURE Error (a: ARRAY OF CHAR) ;
+
+
+(*
+   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.
+*)
+
+@findex WarnError
+PROCEDURE WarnError (a: ARRAY OF CHAR) ;
+
+
+(*
+   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.
+*)
+
+@findex WarnString
+PROCEDURE WarnString (s: String) ;
+
+
+(*
+   Close - closes the opened file.
+*)
+
+@findex Close
+PROCEDURE Close (f: File) ;
+
+
+(*
+   GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*)
+
+@findex GetExitStatus
+PROCEDURE GetExitStatus () : CARDINAL ;
+
+
+(*
+   SetDebug - sets the debug flag on or off.
+*)
+
+@findex SetDebug
+PROCEDURE SetDebug (d: BOOLEAN) ;
+
+
+(*
+   GetColumnPosition - returns the column position of the current character.
+*)
+
+@findex GetColumnPosition
+PROCEDURE GetColumnPosition () : CARDINAL ;
+
+
+(*
+   GetCurrentLine - returns the current line number.
+*)
+
+@findex GetCurrentLine
+PROCEDURE GetCurrentLine () : CARDINAL ;
+
+
+END PushBackInput.
+@end example
+@page
+
+@node gm2-libs/RTExceptions, gm2-libs/RTint, gm2-libs/PushBackInput, Base libraries
+@subsection gm2-libs/RTExceptions
+
+@example
+DEFINITION MODULE RTExceptions ;
+
+(* Runtime exception handler routines.  This should
+   be considered as a system module for GNU Modula-2
+   and allow the compiler to interface with exception
+   handling.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED EHBlock,
+                 Raise, SetExceptionBlock, GetExceptionBlock,
+                 GetTextBuffer, GetTextBufferSize, GetNumber,
+                 InitExceptionBlock, KillExceptionBlock,
+                 PushHandler, PopHandler,
+                 BaseExceptionsThrow, DefaultErrorCatch,
+                 IsInExceptionState, SetExceptionState,
+                 SwitchExceptionState, GetBaseExceptionBlock,
+                 SetExceptionSource, GetExceptionSource ;
+
+TYPE
+@findex EHBlock (type)
+   EHBlock ;
+@findex ProcedureHandler (type)
+   ProcedureHandler = PROCEDURE ;
+
+
+(*
+   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.
+*)
+
+@findex Raise
+PROCEDURE Raise (number: CARDINAL;
+                 file: ADDRESS; line: CARDINAL;
+                 column: CARDINAL; function: ADDRESS;
+                 message: ADDRESS) ;
+
+
+(*
+   SetExceptionBlock - sets, source, as the active EHB.
+*)
+
+@findex SetExceptionBlock
+PROCEDURE SetExceptionBlock (source: EHBlock) ;
+
+
+(*
+   GetExceptionBlock - returns the active EHB.
+*)
+
+@findex GetExceptionBlock
+PROCEDURE GetExceptionBlock () : EHBlock ;
+
+
+(*
+   GetTextBuffer - returns the address of the EHB buffer.
+*)
+
+@findex GetTextBuffer
+PROCEDURE GetTextBuffer (e: EHBlock) : ADDRESS ;
+
+
+(*
+   GetTextBufferSize - return the size of the EHB text buffer.
+*)
+
+@findex GetTextBufferSize
+PROCEDURE GetTextBufferSize (e: EHBlock) : CARDINAL ;
+
+
+(*
+   GetNumber - return the exception number associated with,
+               source.
+*)
+
+@findex GetNumber
+PROCEDURE GetNumber (source: EHBlock) : CARDINAL ;
+
+
+(*
+   InitExceptionBlock - creates and returns a new exception block.
+*)
+
+@findex InitExceptionBlock
+PROCEDURE InitExceptionBlock () : EHBlock ;
+
+
+(*
+   KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*)
+
+@findex KillExceptionBlock
+PROCEDURE KillExceptionBlock (e: EHBlock) : EHBlock ;
+
+
+(*
+   PushHandler - install a handler in EHB, e.
+*)
+
+@findex PushHandler
+PROCEDURE PushHandler (e: EHBlock; number: CARDINAL; p: ProcedureHandler) ;
+
+
+(*
+   PopHandler - removes the handler associated with, number, from
+                EHB, e.
+*)
+
+@findex PopHandler
+PROCEDURE PopHandler (e: EHBlock; number: CARDINAL) ;
+
+
+(*
+   DefaultErrorCatch - displays the current error message in
+                       the current exception block and then
+                       calls HALT.
+*)
+
+@findex DefaultErrorCatch
+PROCEDURE DefaultErrorCatch ;
+
+
+(*
+   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.
+*)
+
+@findex BaseExceptionsThrow
+PROCEDURE BaseExceptionsThrow ;
+
+
+(*
+   IsInExceptionState - returns TRUE if the program is currently
+                        in the exception state.
+*)
+
+@findex IsInExceptionState
+PROCEDURE IsInExceptionState () : BOOLEAN ;
+
+
+(*
+   SetExceptionState - returns the current exception state and
+                       then sets the current exception state to,
+                       to.
+*)
+
+@findex SetExceptionState
+PROCEDURE SetExceptionState (to: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SwitchExceptionState - assigns, from, with the current exception
+                          state and then assigns the current exception
+                          to, to.
+*)
+
+@findex SwitchExceptionState
+PROCEDURE SwitchExceptionState (VAR from: BOOLEAN; to: BOOLEAN) ;
+
+
+(*
+   GetBaseExceptionBlock - returns the initial language exception block
+                           created.
+*)
+
+@findex GetBaseExceptionBlock
+PROCEDURE GetBaseExceptionBlock () : EHBlock ;
+
+
+(*
+   SetExceptionSource - sets the current exception source to, source.
+*)
+
+@findex SetExceptionSource
+PROCEDURE SetExceptionSource (source: ADDRESS) ;
+
+
+(*
+   GetExceptionSource - returns the current exception source.
+*)
+
+@findex GetExceptionSource
+PROCEDURE GetExceptionSource () : ADDRESS ;
+
+
+END RTExceptions.
+@end example
+@page
+
+@node gm2-libs/RTint, gm2-libs/SArgs, gm2-libs/RTExceptions, Base libraries
+@subsection gm2-libs/RTint
+
+@example
+DEFINITION MODULE RTint ;
+
+(* Provides users of the COROUTINES library with the
+   ability to create interrupt sources based on
+   file descriptors and timeouts.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+@findex DispatchVector (type)
+   DispatchVector = PROCEDURE (CARDINAL, CARDINAL, ADDRESS) ;
+
+
+(*
+   InitInputVector - returns an interrupt vector which is associated
+                     with the file descriptor, fd.
+*)
+
+@findex InitInputVector
+PROCEDURE InitInputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitOutputVector - returns an interrupt vector which is associated
+                      with the file descriptor, fd.
+*)
+
+@findex InitOutputVector
+PROCEDURE InitOutputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
+
+
+(*
+   InitTimeVector - returns an interrupt vector associated with
+                    the relative time.
+*)
+
+@findex InitTimeVector
+PROCEDURE InitTimeVector (micro, secs: CARDINAL; pri: CARDINAL) : CARDINAL ;
+
+
+(*
+   ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt
+                     at the new relative time.
+*)
+
+@findex ReArmTimeVector
+PROCEDURE ReArmTimeVector (vec: CARDINAL; micro, secs: CARDINAL) ;
+
+
+(*
+   GetTimeVector - assigns, micro, and, secs, with the remaining
+                   time before this interrupt will expire.
+                   This value is only updated when a Listen
+                   occurs.
+*)
+
+@findex GetTimeVector
+PROCEDURE GetTimeVector (vec: CARDINAL; VAR micro, secs: CARDINAL) ;
+
+
+(*
+   AttachVector - adds the pointer, p, to be associated with the interrupt
+                  vector. It returns the previous value attached to this
+                  vector.
+*)
+
+@findex AttachVector
+PROCEDURE AttachVector (vec: CARDINAL; p: ADDRESS) : ADDRESS ;
+
+
+(*
+   IncludeVector - includes, vec, into the dispatcher list of
+                   possible interrupt causes.
+*)
+
+@findex IncludeVector
+PROCEDURE IncludeVector (vec: CARDINAL) ;
+
+
+(*
+   ExcludeVector - excludes, vec, from the dispatcher list of
+                   possible interrupt causes.
+*)
+
+@findex ExcludeVector
+PROCEDURE ExcludeVector (vec: CARDINAL) ;
+
+
+(*
+   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.
+*)
+
+@findex Listen
+PROCEDURE Listen (untilInterrupt: BOOLEAN;
+                  call: DispatchVector;
+                  pri: CARDINAL) ;
+
+
+(*
+   Init - allows the user to force the initialize order.
+*)
+
+@findex Init
+PROCEDURE Init ;
+
+
+END RTint.
+@end example
+@page
+
+@node gm2-libs/SArgs, gm2-libs/SCmdArgs, gm2-libs/RTint, Base libraries
+@subsection gm2-libs/SArgs
+
+@example
+DEFINITION MODULE SArgs ;
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED GetArg, Narg ;
+
+
+(*
+   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.
+*)
+
+@findex GetArg
+PROCEDURE GetArg (VAR s: String ; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line.
+*)
+
+@findex Narg
+PROCEDURE Narg() : CARDINAL ;
+
+
+END SArgs.
+@end example
+@page
+
+@node gm2-libs/SCmdArgs, gm2-libs/SEnvironment, gm2-libs/SArgs, Base libraries
+@subsection gm2-libs/SCmdArgs
+
+@example
+DEFINITION MODULE SCmdArgs ;
+
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED GetArg, Narg ;
+
+
+(*
+   GetArg - returns the nth argument from the command line, CmdLine
+            the success of the operation is returned.
+*)
+
+@findex GetArg
+PROCEDURE GetArg (CmdLine: String;
+                  n: CARDINAL; VAR Argi: String) : BOOLEAN ;
+
+
+(*
+   Narg - returns the number of arguments available from
+          command line, CmdLine.
+*)
+
+@findex Narg
+PROCEDURE Narg (CmdLine: String) : CARDINAL ;
+
+
+END SCmdArgs.
+@end example
+@page
+
+@node gm2-libs/SEnvironment, gm2-libs/SFIO, gm2-libs/SCmdArgs, Base libraries
+@subsection gm2-libs/SEnvironment
+
+@example
+DEFINITION MODULE SEnvironment ;
+
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED GetEnvironment ;
+
+
+(*
+   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.
+*)
+
+@findex GetEnvironment
+PROCEDURE GetEnvironment (Env: String;
+                          VAR dest: String) : BOOLEAN ;
+
+
+(*
+   PutEnvironment - change or add an environment variable definition EnvDef.
+                    TRUE is returned if the environment variable was
+                    set or changed successfully.
+*)
+
+@findex PutEnvironment
+PROCEDURE PutEnvironment (EnvDef: String) : BOOLEAN ;
+
+
+END SEnvironment.
+@end example
+@page
+
+@node gm2-libs/SFIO, gm2-libs/SMathLib0, gm2-libs/SEnvironment, Base libraries
+@subsection gm2-libs/SFIO
+
+@example
+DEFINITION MODULE SFIO ;
+
+FROM DynamicStrings IMPORT String ;
+FROM FIO IMPORT File ;
+
+EXPORT QUALIFIED OpenToRead, OpenToWrite, OpenForRandom, Exists, WriteS, ReadS ;
+
+
+(*
+   Exists - returns TRUE if a file named, fname exists for reading.
+*)
+
+@findex Exists
+PROCEDURE Exists (fname: String) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+@findex OpenToRead
+PROCEDURE OpenToRead (fname: String) : File ;
+
+
+(*
+   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.
+*)
+
+@findex OpenToWrite
+PROCEDURE OpenToWrite (fname: String) : File ;
+
+
+(*
+   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.
+*)
+
+@findex OpenForRandom
+PROCEDURE OpenForRandom (fname: String; towrite, newfile: BOOLEAN) : File ;
+
+
+(*
+   WriteS - writes a string, s, to, file. It returns the String, s.
+*)
+
+@findex WriteS
+PROCEDURE WriteS (file: File; s: String) : String ;
+
+
+(*
+   ReadS - reads a string, s, from, file. It returns the String, s.
+           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.
+*)
+
+@findex ReadS
+PROCEDURE ReadS (file: File) : String ;
+
+
+END SFIO.
+@end example
+@page
+
+@node gm2-libs/SMathLib0, gm2-libs/SYSTEM, gm2-libs/SFIO, Base libraries
+@subsection gm2-libs/SMathLib0
+
+@example
+DEFINITION MODULE SMathLib0 ;
+
+CONST
+   pi   = 3.1415926535897932384626433832795028841972;
+   exp1 = 2.7182818284590452353602874713526624977572;
+
+
+@findex sqrt
+PROCEDURE __BUILTIN__ sqrt (x: SHORTREAL) : SHORTREAL ;
+@findex exp
+PROCEDURE exp (x: SHORTREAL) : SHORTREAL ;
+@findex ln
+PROCEDURE ln (x: SHORTREAL) : SHORTREAL ;
+@findex sin
+PROCEDURE __BUILTIN__ sin (x: SHORTREAL) : SHORTREAL ;
+@findex cos
+PROCEDURE __BUILTIN__ cos (x: SHORTREAL) : SHORTREAL ;
+@findex tan
+PROCEDURE tan (x: SHORTREAL) : SHORTREAL ;
+@findex arctan
+PROCEDURE arctan (x: SHORTREAL) : SHORTREAL ;
+@findex entier
+PROCEDURE entier (x: SHORTREAL) : INTEGER ;
+
+
+END SMathLib0.
+@end example
+@page
+
+@node gm2-libs/SYSTEM, gm2-libs/Scan, gm2-libs/SMathLib0, Base libraries
+@subsection gm2-libs/SYSTEM
+
+@example
+DEFINITION MODULE SYSTEM ;
+
+EXPORT QUALIFIED BITSPERBYTE, BYTESPERWORD,
+                 ADDRESS, WORD, BYTE, CSIZE_T, CSSIZE_T, (* 
+                 Target specific data types.  *)
+                 ADR, TSIZE, ROTATE, SHIFT, THROW, TBITSIZE ;
+                 (* SIZE is also exported if -fpim2 is used.  *)
+
+CONST
+@findex BITSPERBYTE (const)
+  BITSPERBYTE   = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
+@findex BYTESPERWORD (const)
+  BYTESPERWORD  = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
+
+(* Note that the full list of system and sized datatypes include:
+   LOC, WORD, BYTE, ADDRESS,
+
+   (and the non language standard target types)
+
+   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+   WORD16, WORD32, WORD64, BITSET8, BITSET16,
+   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
+   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.
+
+   Also note that the non-standard data types will
+   move into another module in the future.  *)
+
+
+(* The following types are supported on this target:
+TYPE
+   (* Target specific data types.  *)
+*)
+
+
+(*
+   all the functions below are declared internally to gm2
+   ======================================================
+
+@findex ADR
+PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
+  (* Returns the address of variable v. *)
+
+@findex SIZE
+PROCEDURE SIZE (v: <type>) : ZType;
+  (* Returns the number of BYTES used to store a v of
+     any specified <type>.  Only available if -fpim2 is used.
+  *)
+
+@findex TSIZE
+PROCEDURE TSIZE (<type>) : CARDINAL;
+  (* Returns the number of BYTES used to store a value of the
+     specified <type>.
+  *)
+
+@findex ROTATE
+PROCEDURE ROTATE (val: <a set type>;
+                  num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by rotating up/right
+     or down/right by the absolute value of num.  The direction is
+     down/right if the sign of num is negative, otherwise the direction
+     is up/left.
+  *)
+
+@findex SHIFT
+PROCEDURE SHIFT (val: <a set type>;
+                 num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by shifting up/left
+     or down/right by the absolute value of num, introducing
+     zeros as necessary.  The direction is down/right if the sign of
+     num is negative, otherwise the direction is up/left.
+  *)
+
+@findex THROW
+PROCEDURE THROW (i: INTEGER) ;
+  (*
+     THROW is a GNU extension and was not part of the PIM or ISO
+     standards.  It throws an exception which will be caught by the
+     EXCEPT block (assuming it exists).  This is a compiler builtin
+     function which interfaces to the GCC exception handling runtime
+     system.
+     GCC uses the term throw, hence the naming distinction between
+     the GCC builtin and the Modula-2 runtime library procedure Raise.
+     The later library procedure Raise will call SYSTEM.THROW after
+     performing various housekeeping activities.
+  *)
+
+@findex TBITSIZE
+PROCEDURE TBITSIZE (<type>) : CARDINAL ;
+  (* Returns the minimum number of bits necessary to represent
+     <type>.  This procedure function is only useful for determining
+     the number of bits used for any type field within a packed RECORD.
+     It is not particularly useful elsewhere since <type> might be
+     optimized for speed, for example a BOOLEAN could occupy a WORD.
+  *)
+*)
+
+(* The following procedures are invoked by GNU Modula-2 to
+   shift non word sized set types. They are not strictly part
+   of the core PIM Modula-2, however they are used
+   to implement the SHIFT procedure defined above,
+   which are in turn used by the Logitech compatible libraries.
+
+   Users will access these procedures by using the procedure
+   SHIFT above and GNU Modula-2 will map SHIFT onto one of
+   the following procedures.
+*)
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+@findex ShiftVal
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*)
+
+@findex ShiftLeft
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex ShiftRight
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      ShiftCount: CARDINAL) ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger
+               sets.
+*)
+
+@findex RotateVal
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex RotateLeft
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*)
+
+@findex RotateRight
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+
+
+END SYSTEM.
+@end example
+@page
+
+@node gm2-libs/Scan, gm2-libs/Selective, gm2-libs/SYSTEM, Base libraries
+@subsection gm2-libs/Scan
+
+@example
+DEFINITION MODULE Scan ;
+
+(* Provides a primitive symbol fetching from input.
+   Symbols are delimited by spaces and tabs.
+   Limitation only allows one source file at
+   a time to deliver symbols.  *)
+
+
+EXPORT QUALIFIED GetNextSymbol, WriteError,
+                 OpenSource, CloseSource,
+                 TerminateOnError, DefineComments ;
+
+
+(* OpenSource - opens a source file for reading.                  *)
+
+@findex OpenSource
+PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(* CloseSource - closes the current source file from reading.     *)
+
+@findex CloseSource
+PROCEDURE CloseSource ;
+
+
+(* GetNextSymbol gets the next source symbol and returns it in a. *)
+
+@findex GetNextSymbol
+PROCEDURE GetNextSymbol (VAR a: ARRAY OF CHAR) ;
+
+
+(* WriteError writes a message, a, under the source line, which   *)
+(* attempts to pinpoint the Symbol at fault.                      *)
+
+@findex WriteError
+PROCEDURE WriteError (a: ARRAY OF CHAR) ;
+
+
+(*
+   TerminateOnError - exits with status 1 if we call WriteError.
+*)
+
+@findex TerminateOnError
+PROCEDURE TerminateOnError ;
+
+
+(*
+   DefineComments - defines the start of comments within the source
+                    file.
+
+                    The characters in Start define the comment start
+                    and characters in End define the end.
+                    The BOOLEAN eoln determine whether the comment
+                    is terminated by end of line. If eoln is TRUE
+                    then End is ignored.
+
+                    If this procedure is never called then no comments
+                    are allowed.
+*)
+
+@findex DefineComments
+PROCEDURE DefineComments (Start, End: ARRAY OF CHAR; eoln: BOOLEAN) ;
+
+
+END Scan.
+@end example
+@page
+
+@node gm2-libs/Selective, gm2-libs/StdIO, gm2-libs/Scan, Base libraries
+@subsection gm2-libs/Selective
+
+@example
+DEFINITION MODULE Selective ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED SetOfFd, Timeval,
+                 InitSet, KillSet, InitTime, KillTime,
+                 GetTime, SetTime,
+                 FdZero, FdSet, FdClr, FdIsSet, Select,
+                 MaxFdsPlusOne, WriteCharRaw, ReadCharRaw,
+                 GetTimeOfDay ;
+
+TYPE
+@findex SetOfFd (type)
+   SetOfFd = ADDRESS ;    (* Hidden type in Selective.c *)
+@findex Timeval (type)
+   Timeval = ADDRESS ;    (* Hidden type in Selective.c *)
+
+
+@findex Select
+PROCEDURE Select (nooffds: CARDINAL;
+                  readfds, writefds, exceptfds: SetOfFd;
+                  timeout: Timeval) : INTEGER ;
+
+@findex InitTime
+PROCEDURE InitTime (sec, usec: CARDINAL) : Timeval ;
+@findex KillTime
+PROCEDURE KillTime (t: Timeval) : Timeval ;
+@findex GetTime
+PROCEDURE GetTime (t: Timeval; VAR sec, usec: CARDINAL) ;
+@findex SetTime
+PROCEDURE SetTime (t: Timeval; sec, usec: CARDINAL) ;
+@findex InitSet
+PROCEDURE InitSet () : SetOfFd ;
+@findex KillSet
+PROCEDURE KillSet (s: SetOfFd) : SetOfFd ;
+@findex FdZero
+PROCEDURE FdZero (s: SetOfFd) ;
+@findex FdSet
+PROCEDURE FdSet (fd: INTEGER; s: SetOfFd) ;
+@findex FdClr
+PROCEDURE FdClr (fd: INTEGER; s: SetOfFd) ;
+@findex FdIsSet
+PROCEDURE FdIsSet (fd: INTEGER; s: SetOfFd) : BOOLEAN ;
+@findex MaxFdsPlusOne
+PROCEDURE MaxFdsPlusOne (a, b: INTEGER) : INTEGER ;
+
+(* you must use the raw routines with select - not the FIO buffered routines *)
+@findex WriteCharRaw
+PROCEDURE WriteCharRaw (fd: INTEGER; ch: CHAR) ;
+@findex ReadCharRaw
+PROCEDURE ReadCharRaw (fd: INTEGER) : CHAR ;
+
+(*
+   GetTimeOfDay - fills in a record, Timeval, filled in with the
+                  current system time in seconds and microseconds.
+                  It returns zero (see man 3p gettimeofday)
+*)
+
+@findex GetTimeOfDay
+PROCEDURE GetTimeOfDay (tv: Timeval) : INTEGER ;
+
+
+END Selective.
+@end example
+@page
+
+@node gm2-libs/StdIO, gm2-libs/Storage, gm2-libs/Selective, Base libraries
+@subsection gm2-libs/StdIO
+
+@example
+DEFINITION MODULE StdIO ;
+
+EXPORT QUALIFIED ProcRead, ProcWrite,
+                 Read, Write,
+                 PushOutput, PopOutput, GetCurrentOutput,
+                 PushInput, PopInput, GetCurrentInput ;
+
+
+TYPE
+@findex ProcWrite (type)
+   ProcWrite = PROCEDURE (CHAR) ;
+@findex ProcRead (type)
+   ProcRead  = PROCEDURE (VAR CHAR) ;
+
+
+(*
+   Read - is the generic procedure that all higher application layers
+          should use to receive a character.
+*)
+
+@findex Read
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   Write - is the generic procedure that all higher application layers
+           should use to emit a character.
+*)
+
+@findex Write
+PROCEDURE Write (ch: CHAR) ;
+
+
+(*
+   PushOutput - pushes the current Write procedure onto a stack,
+                any future references to Write will actually invoke
+                procedure, p.
+*)
+
+@findex PushOutput
+PROCEDURE PushOutput (p: ProcWrite) ;
+
+
+(*
+   PopOutput - restores Write to use the previous output procedure.
+*)
+
+@findex PopOutput
+PROCEDURE PopOutput ;
+
+
+(*
+   GetCurrentOutput - returns the current output procedure.
+*)
+
+@findex GetCurrentOutput
+PROCEDURE GetCurrentOutput () : ProcWrite ;
+
+
+(*
+   PushInput - pushes the current Read procedure onto a stack,
+               any future references to Read will actually invoke
+               procedure, p.
+*)
+
+@findex PushInput
+PROCEDURE PushInput (p: ProcRead) ;
+
+
+(*
+   PopInput - restores Write to use the previous output procedure.
+*)
+
+@findex PopInput
+PROCEDURE PopInput ;
+
+
+(*
+   GetCurrentInput - returns the current input procedure.
+*)
+
+@findex GetCurrentInput
+PROCEDURE GetCurrentInput () : ProcRead ;
+
+
+END StdIO.
+@end example
+@page
+
+@node gm2-libs/Storage, gm2-libs/StrCase, gm2-libs/StdIO, Base libraries
+@subsection gm2-libs/Storage
+
+@example
+DEFINITION MODULE Storage ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED ALLOCATE, DEALLOCATE, REALLOCATE, Available ;
+
+
+
+(*
+   ALLOCATE - attempt to allocate memory from the heap.
+              NIL is returned in, a, if ALLOCATE fails.
+*)
+
+@findex ALLOCATE
+PROCEDURE ALLOCATE (VAR a: ADDRESS ; Size: CARDINAL) ;
+
+
+(*
+   DEALLOCATE - return, Size, bytes to the heap.
+                The variable, a, is set to NIL.
+*)
+
+@findex DEALLOCATE
+PROCEDURE DEALLOCATE (VAR a: ADDRESS ; Size: CARDINAL) ;
+
+
+(*
+   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.
+*)
+
+@findex REALLOCATE
+PROCEDURE REALLOCATE (VAR a: ADDRESS; Size: CARDINAL) ;
+
+
+(*
+   Available - returns TRUE if, Size, bytes can be allocated.
+*)
+
+@findex Available
+PROCEDURE Available (Size: CARDINAL) : BOOLEAN ;
+
+
+END Storage.
+@end example
+@page
+
+@node gm2-libs/StrCase, gm2-libs/StrIO, gm2-libs/Storage, Base libraries
+@subsection gm2-libs/StrCase
+
+@example
+DEFINITION MODULE StrCase ;
+
+
+EXPORT QUALIFIED StrToUpperCase, StrToLowerCase, Cap, Lower ;
+
+
+(*
+   StrToUpperCase - converts string, a, to uppercase returning the
+                    result in, b.
+*)
+
+@findex StrToUpperCase
+PROCEDURE StrToUpperCase (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+
+
+(*
+   StrToLowerCase - converts string, a, to lowercase returning the
+                    result in, b.
+*)
+
+@findex StrToLowerCase
+PROCEDURE StrToLowerCase (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+
+
+(*
+   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.
+*)
+
+@findex Cap
+PROCEDURE Cap (ch: CHAR) : CHAR ;
+
+
+(*
+   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.
+*)
+
+@findex Lower
+PROCEDURE Lower (ch: CHAR) : CHAR ;
+
+
+END StrCase.
+@end example
+@page
+
+@node gm2-libs/StrIO, gm2-libs/StrLib, gm2-libs/StrCase, Base libraries
+@subsection gm2-libs/StrIO
+
+@example
+DEFINITION MODULE StrIO ;
+
+EXPORT QUALIFIED ReadString, WriteString,
+                 WriteLn ;
+
+
+(*
+   WriteLn - writes a carriage return and a newline
+             character.
+*)
+
+@findex WriteLn
+PROCEDURE WriteLn ;
+
+
+(*
+   ReadString - reads a sequence of characters into a string.
+                Line editing accepts Del, Ctrl H, Ctrl W and
+                Ctrl U.
+*)
+
+@findex ReadString
+PROCEDURE ReadString (VAR a: ARRAY OF CHAR) ;
+
+
+(*
+   WriteString - writes a string to the default output.
+*)
+
+@findex WriteString
+PROCEDURE WriteString (a: ARRAY OF CHAR) ;
+
+
+END StrIO.
+@end example
+@page
+
+@node gm2-libs/StrLib, gm2-libs/StringConvert, gm2-libs/StrIO, Base libraries
+@subsection gm2-libs/StrLib
+
+@example
+DEFINITION MODULE StrLib ;
+
+EXPORT QUALIFIED StrConCat, StrLen, StrCopy, StrEqual, StrLess,
+      	       	 IsSubString, StrRemoveWhitePrefix ;
+
+
+(*
+   StrConCat - combines a and b into c.
+*)
+
+@findex StrConCat
+PROCEDURE StrConCat (a, b: ARRAY OF CHAR; VAR c: ARRAY OF CHAR) ;
+
+
+(*
+   StrLess - returns TRUE if string, a, alphabetically occurs before
+             string, b.
+*)
+
+@findex StrLess
+PROCEDURE StrLess (a, b: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   StrEqual - performs a = b on two strings.
+*)
+
+@findex StrEqual
+PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   StrLen - returns the length of string, a.
+*)
+
+@findex StrLen
+PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+@findex StrCopy
+PROCEDURE StrCopy (src: ARRAY OF CHAR ; VAR dest: ARRAY OF CHAR) ;
+
+
+(*
+   IsSubString - returns true if b is a subcomponent of a.
+*)
+
+@findex IsSubString
+PROCEDURE IsSubString (a, b: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+                          space infront of a.
+*)
+
+@findex StrRemoveWhitePrefix
+PROCEDURE StrRemoveWhitePrefix (a: ARRAY OF CHAR; VAR b: ARRAY OF CHAR) ;
+
+
+END StrLib.
+@end example
+@page
+
+@node gm2-libs/StringConvert, gm2-libs/SysExceptions, gm2-libs/StrLib, Base libraries
+@subsection gm2-libs/StringConvert
+
+@example
+DEFINITION MODULE StringConvert ;
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED IntegerToString, StringToInteger,
+                 StringToLongInteger, LongIntegerToString,
+                 StringToCardinal, CardinalToString,
+                 StringToLongCardinal, LongCardinalToString,
+                 StringToShortCardinal, ShortCardinalToString,
+                 StringToLongreal, LongrealToString,
+                 ToSigFig,
+                 stoi, itos, ctos, stoc, hstoi, ostoi, bstoi,
+                 hstoc, ostoc, bstoc,
+                 stor, stolr ;
+
+
+(*
+   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.
+*)
+
+@findex IntegerToString
+PROCEDURE IntegerToString (i: INTEGER; width: CARDINAL; padding: CHAR; sign: BOOLEAN;
+                           base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+(*
+   CardinalToString - converts CARDINAL, 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.
+*)
+
+@findex CardinalToString
+PROCEDURE CardinalToString (c: CARDINAL; width: CARDINAL; padding: CHAR;
+                            base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+(*
+   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.
+*)
+
+@findex StringToInteger
+PROCEDURE StringToInteger (s: String; base: CARDINAL; VAR found: BOOLEAN) : INTEGER ;
+
+
+(*
+   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.
+*)
+
+@findex StringToCardinal
+PROCEDURE StringToCardinal (s: String; base: CARDINAL; VAR found: BOOLEAN) : CARDINAL ;
+
+
+(*
+   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.
+*)
+
+@findex LongIntegerToString
+PROCEDURE LongIntegerToString (i: LONGINT; width: CARDINAL; padding: CHAR;
+                               sign: BOOLEAN; base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+
+(*
+   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.
+*)
+
+@findex StringToLongInteger
+PROCEDURE StringToLongInteger (s: String; base: CARDINAL; VAR found: BOOLEAN) : LONGINT ;
+
+
+(*
+   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.
+*)
+
+@findex LongCardinalToString
+PROCEDURE LongCardinalToString (c: LONGCARD; width: CARDINAL; padding: CHAR;
+                                base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+(*
+   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.
+*)
+
+@findex StringToLongCardinal
+PROCEDURE StringToLongCardinal (s: String; base: CARDINAL; VAR found: BOOLEAN) : LONGCARD ;
+
+
+(*
+   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.
+*)
+
+@findex ShortCardinalToString
+PROCEDURE ShortCardinalToString (c: SHORTCARD; width: CARDINAL; padding: CHAR;
+                                 base: CARDINAL; lower: BOOLEAN) : String ;
+
+
+(*
+   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.
+*)
+
+@findex StringToShortCardinal
+PROCEDURE StringToShortCardinal (s: String; base: CARDINAL;
+                                 VAR found: BOOLEAN) : SHORTCARD ;
+
+
+(*
+   stoi - decimal string to INTEGER
+*)
+
+@findex stoi
+PROCEDURE stoi (s: String) : INTEGER ;
+
+
+(*
+   itos - integer to decimal string.
+*)
+
+@findex itos
+PROCEDURE itos (i: INTEGER; width: CARDINAL; padding: CHAR; sign: BOOLEAN) : String ;
+
+
+(*
+   ctos - cardinal to decimal string.
+*)
+
+@findex ctos
+PROCEDURE ctos (c: CARDINAL; width: CARDINAL; padding: CHAR) : String ;
+
+
+(*
+   stoc - decimal string to CARDINAL
+*)
+
+@findex stoc
+PROCEDURE stoc (s: String) : CARDINAL ;
+
+
+(*
+   hstoi - hexidecimal string to INTEGER
+*)
+
+@findex hstoi
+PROCEDURE hstoi (s: String) : INTEGER ;
+
+
+(*
+   ostoi - octal string to INTEGER
+*)
+
+@findex ostoi
+PROCEDURE ostoi (s: String) : INTEGER ;
+
+
+(*
+   bstoi - binary string to INTEGER
+*)
+
+@findex bstoi
+PROCEDURE bstoi (s: String) : INTEGER ;
+
+
+(*
+   hstoc - hexidecimal string to CARDINAL
+*)
+
+@findex hstoc
+PROCEDURE hstoc (s: String) : CARDINAL ;
+
+
+(*
+   ostoc - octal string to CARDINAL
+*)
+
+@findex ostoc
+PROCEDURE ostoc (s: String) : CARDINAL ;
+
+
+(*
+   bstoc - binary string to CARDINAL
+*)
+
+@findex bstoc
+PROCEDURE bstoc (s: String) : CARDINAL ;
+
+
+(*
+   StringToLongreal - returns a LONGREAL and sets found to TRUE
+                      if a legal number is seen.
+*)
+
+@findex StringToLongreal
+PROCEDURE StringToLongreal (s: String; VAR found: BOOLEAN) : LONGREAL ;
+
+
+(*
+   LongrealToString - converts a LONGREAL number, Real, which has,
+                      TotalWidth, and FractionWidth into a string.
+
+                      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'
+
+                      If TotalWidth is 0 then the function
+                      will return the value of x which is converted
+                      into as a fixed point number with exhaustive
+                      precision.
+*)
+
+@findex LongrealToString
+PROCEDURE LongrealToString (x: LONGREAL;
+                            TotalWidth, FractionWidth: CARDINAL) : String ;
+
+
+(*
+   stor - returns a REAL given a string.
+*)
+
+@findex stor
+PROCEDURE stor (s: String) : REAL ;
+
+
+(*
+   stolr - returns a LONGREAL given a string.
+*)
+
+@findex stolr
+PROCEDURE stolr (s: String) : LONGREAL ;
+
+
+(*
+   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
+*)
+
+@findex ToSigFig
+PROCEDURE ToSigFig (s: String; n: CARDINAL) : String ;
+
+
+(*
+   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
+*)
+
+@findex ToDecimalPlaces
+PROCEDURE ToDecimalPlaces (s: String; n: CARDINAL) : String ;
+
+
+END StringConvert.
+@end example
+@page
+
+@node gm2-libs/SysExceptions, gm2-libs/SysStorage, gm2-libs/StringConvert, Base libraries
+@subsection gm2-libs/SysExceptions
+
+@example
+DEFINITION MODULE SysExceptions ;
+
+(* Provides a mechanism for the underlying libraries to
+   configure the exception routines.  This mechanism
+   is used by both the ISO and PIM libraries.
+   It is written to be ISO compliant and this also
+   allows for mixed dialect projects.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+@findex PROCEXCEPTION (type)
+   PROCEXCEPTION = PROCEDURE (ADDRESS) ;
+
+@findex InitExceptionHandlers
+PROCEDURE InitExceptionHandlers (indexf, range, casef, invalidloc,
+                                 function, wholevalue, wholediv,
+                                 realvalue, realdiv, complexvalue,
+                                 complexdiv, protection, systemf,
+                                 coroutine, exception: PROCEXCEPTION) ;
+
+
+END SysExceptions.
+@end example
+@page
+
+@node gm2-libs/SysStorage, gm2-libs/TimeString, gm2-libs/SysExceptions, Base libraries
+@subsection gm2-libs/SysStorage
+
+@example
+DEFINITION MODULE SysStorage ;
+
+(*  Provides dynamic allocation for the system components.
+    This allows the application to use the traditional Storage module
+    which can be handled differently.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED ALLOCATE, DEALLOCATE, REALLOCATE, Available, Init ;
+
+
+(*
+   ALLOCATE - attempt to allocate memory from the heap.
+              NIL is returned in, a, if ALLOCATE fails.
+*)
+
+@findex ALLOCATE
+PROCEDURE ALLOCATE (VAR a: ADDRESS ; size: CARDINAL) ;
+
+
+(*
+   DEALLOCATE - return, size, bytes to the heap.
+                The variable, a, is set to NIL.
+*)
+
+@findex DEALLOCATE
+PROCEDURE DEALLOCATE (VAR a: ADDRESS ; size: CARDINAL) ;
+
+
+(*
+   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.
+*)
+
+@findex REALLOCATE
+PROCEDURE REALLOCATE (VAR a: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   Available - returns TRUE if, size, bytes can be allocated.
+*)
+
+@findex Available
+PROCEDURE Available (size: CARDINAL) : BOOLEAN;
+
+
+(*
+   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.
+*)
+
+@findex Init
+PROCEDURE Init ;
+
+
+END SysStorage.
+@end example
+@page
+
+@node gm2-libs/TimeString, gm2-libs/UnixArgs, gm2-libs/SysStorage, Base libraries
+@subsection gm2-libs/TimeString
+
+@example
+DEFINITION MODULE TimeString ;
+
+EXPORT QUALIFIED GetTimeString ;
+
+
+(*
+   GetTimeString - places the time in ascii format into array, a.
+
+*)
+
+@findex GetTimeString
+PROCEDURE GetTimeString (VAR a: ARRAY OF CHAR) ;
+
+
+END TimeString.
+@end example
+@page
+
+@node gm2-libs/UnixArgs, gm2-libs/cbuiltin, gm2-libs/TimeString, Base libraries
+@subsection gm2-libs/UnixArgs
+
+@example
+DEFINITION MODULE UnixArgs ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED GetArgC, GetArgV, GetEnvV ;
+
+@findex GetArgC
+PROCEDURE GetArgC () : INTEGER ;
+@findex GetArgV
+PROCEDURE GetArgV () : ADDRESS ;
+@findex GetEnvV
+PROCEDURE GetEnvV () : ADDRESS ;
+
+
+END UnixArgs.
+@end example
+@page
+
+@node gm2-libs/cbuiltin, gm2-libs/cgetopt, gm2-libs/UnixArgs, Base libraries
+@subsection gm2-libs/cbuiltin
+
+@example
+DEFINITION MODULE FOR "C" cbuiltin ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT UNQUALIFIED alloca, memcpy,
+		   isfinite, isfinitef, isfinitel,
+		   isinf_sign, isinf_signf, isinf_signl,
+                   sinf, sinl, sin,
+                   cosf, cosl, cos,
+                   atan2f, atan2l, atan2,
+                   sqrtf, sqrtl, sqrt,
+                   fabsf, fabsl, fabs,
+                   logf, logl, log,
+                   expf, expl, exp,
+                   log10f, log10l, log10,
+                   exp10f, exp10l, exp10,
+                   ilogbf, ilogbl, ilogb,
+                   significand, significandf, significandl,
+                   modf, modff, modfl,
+                   nextafter, nextafterf, nextafterl,
+                   nexttoward, nexttowardf, nexttowardl,
+                   scalb, scalbf, scalbl,
+                   scalbn, scalbnf, scalbnl,
+                   scalbln, scalblnf, scalblnl,
+
+                   cabsf, cabsl, cabs,
+                   cargf, carg, cargl,
+                   conjf, conj, conjl,
+                   cpowf, cpow, cpowl,
+                   csqrtf, csqrt, csqrtl,
+                   cexpf, cexp, cexpl,
+                   clogf, clog, clogl,
+                   csinf, csin, csinl,
+                   ccosf, ccos, ccosl,
+                   ctanf, ctan, ctanl,
+                   casinf, casin, casinl,
+                   cacosf, cacos, cacosl,
+                   catanf, catan, catanl,
+
+                   index, rindex,
+                   memcmp, memset, memmove,
+                   strcat, strncat, strcpy, strncpy, strcmp, strncmp,
+                   strlen, strstr, strpbrk, strspn, strcspn, strchr, strrchr ;
+
+@findex alloca
+PROCEDURE alloca (i: CARDINAL) : ADDRESS ;
+@findex memcpy
+PROCEDURE memcpy (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+@findex isfinite
+PROCEDURE isfinite (x: REAL) : BOOLEAN ;
+@findex isfinitel
+PROCEDURE isfinitel (x: LONGREAL) : BOOLEAN ;
+@findex isfinitef
+PROCEDURE isfinitef (x: SHORTREAL) : BOOLEAN ;
+@findex isinf_sign
+PROCEDURE isinf_sign (x: REAL) : BOOLEAN ;
+@findex isinf_signl
+PROCEDURE isinf_signl (x: LONGREAL) : BOOLEAN ;
+@findex isinf_signf
+PROCEDURE isinf_signf (x: SHORTREAL) : BOOLEAN ;
+@findex sinf
+PROCEDURE sinf (x: SHORTREAL) : SHORTREAL ;
+@findex sin
+PROCEDURE sin (x: REAL) : REAL ;
+@findex sinl
+PROCEDURE sinl (x: LONGREAL) : LONGREAL ;
+@findex cosf
+PROCEDURE cosf (x: SHORTREAL) : SHORTREAL ;
+@findex cos
+PROCEDURE cos (x: REAL) : REAL ;
+@findex cosl
+PROCEDURE cosl (x: LONGREAL) : LONGREAL ;
+@findex atan2f
+PROCEDURE atan2f (x, y: SHORTREAL) : SHORTREAL ;
+@findex atan2
+PROCEDURE atan2 (x, y: REAL) : REAL ;
+@findex atan2l
+PROCEDURE atan2l (x, y: LONGREAL) : LONGREAL ;
+@findex sqrtf
+PROCEDURE sqrtf (x: SHORTREAL) : SHORTREAL ;
+@findex sqrt
+PROCEDURE sqrt (x: REAL) : REAL ;
+@findex sqrtl
+PROCEDURE sqrtl (x: LONGREAL) : LONGREAL ;
+@findex fabsf
+PROCEDURE fabsf (x: SHORTREAL) : SHORTREAL ;
+@findex fabs
+PROCEDURE fabs (x: REAL) : REAL ;
+@findex fabsl
+PROCEDURE fabsl (x: LONGREAL) : LONGREAL ;
+@findex logf
+PROCEDURE logf (x: SHORTREAL) : SHORTREAL ;
+@findex log
+PROCEDURE log (x: REAL) : REAL ;
+@findex logl
+PROCEDURE logl (x: LONGREAL) : LONGREAL ;
+@findex expf
+PROCEDURE expf (x: SHORTREAL) : SHORTREAL ;
+@findex exp
+PROCEDURE exp (x: REAL) : REAL ;
+@findex expl
+PROCEDURE expl (x: LONGREAL) : LONGREAL ;
+@findex log10f
+PROCEDURE log10f (x: SHORTREAL) : SHORTREAL ;
+@findex log10
+PROCEDURE log10 (x: REAL) : REAL ;
+@findex log10l
+PROCEDURE log10l (x: LONGREAL) : LONGREAL ;
+@findex exp10f
+PROCEDURE exp10f (x: SHORTREAL) : SHORTREAL ;
+@findex exp10
+PROCEDURE exp10 (x: REAL) : REAL ;
+@findex exp10l
+PROCEDURE exp10l (x: LONGREAL) : LONGREAL ;
+@findex ilogbf
+PROCEDURE ilogbf (x: SHORTREAL) : INTEGER ;
+@findex ilogb
+PROCEDURE ilogb (x: REAL) : INTEGER ;
+@findex ilogbl
+PROCEDURE ilogbl (x: LONGREAL) : INTEGER ;
+
+@findex significand
+PROCEDURE significand (r: REAL) : REAL ;
+@findex significandf
+PROCEDURE significandf (s: SHORTREAL) : SHORTREAL ;
+@findex significandl
+PROCEDURE significandl (l: LONGREAL) : LONGREAL ;
+
+@findex modf
+PROCEDURE modf (x: REAL; VAR y: REAL) : REAL ;
+@findex modff
+PROCEDURE modff (x: SHORTREAL; VAR y: SHORTREAL) : SHORTREAL ;
+@findex modfl
+PROCEDURE modfl (x: LONGREAL; VAR y: LONGREAL) : LONGREAL ;
+
+@findex nextafter
+PROCEDURE nextafter (x, y: REAL) : REAL ;
+@findex nextafterf
+PROCEDURE nextafterf (x, y: SHORTREAL) : SHORTREAL ;
+@findex nextafterl
+PROCEDURE nextafterl (x, y: LONGREAL) : LONGREAL ;
+
+@findex nexttoward
+PROCEDURE nexttoward (x, y: REAL) : REAL ;
+@findex nexttowardf
+PROCEDURE nexttowardf (x, y: SHORTREAL) : SHORTREAL ;
+@findex nexttowardl
+PROCEDURE nexttowardl (x, y: LONGREAL) : LONGREAL ;
+
+@findex scalb
+PROCEDURE scalb (x, n: REAL) : REAL ;
+@findex scalbf
+PROCEDURE scalbf (x, n: SHORTREAL) : SHORTREAL ;
+@findex scalbl
+PROCEDURE scalbl (x, n: LONGREAL) : LONGREAL ;
+
+@findex scalbn
+PROCEDURE scalbn (x: REAL; n: INTEGER) : REAL ;
+@findex scalbnf
+PROCEDURE scalbnf (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
+@findex scalbnl
+PROCEDURE scalbnl (x: LONGREAL; n: INTEGER) : LONGREAL ;
+
+@findex scalbln
+PROCEDURE scalbln (x: REAL; n: LONGINT) : REAL ;
+@findex scalblnf
+PROCEDURE scalblnf (x: SHORTREAL; n: LONGINT) : SHORTREAL ;
+@findex scalblnl
+PROCEDURE scalblnl (x: LONGREAL; n: LONGINT) : LONGREAL ;
+
+@findex cabsf
+PROCEDURE cabsf (z: SHORTCOMPLEX) : SHORTREAL ;
+@findex cabs
+PROCEDURE cabs (z: COMPLEX) : REAL ;
+@findex cabsl
+PROCEDURE cabsl (z: LONGCOMPLEX) : LONGREAL ;
+
+@findex cargf
+PROCEDURE cargf (z: SHORTCOMPLEX) : SHORTREAL ;
+@findex carg
+PROCEDURE carg (z: COMPLEX) : REAL ;
+@findex cargl
+PROCEDURE cargl (z: LONGCOMPLEX) : LONGREAL ;
+
+@findex conjf
+PROCEDURE conjf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex conj
+PROCEDURE conj (z: COMPLEX) : COMPLEX ;
+@findex conjl
+PROCEDURE conjl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex cpowf
+PROCEDURE cpowf (base: SHORTCOMPLEX; exp: SHORTREAL) : SHORTCOMPLEX ;
+@findex cpow
+PROCEDURE cpow (base: COMPLEX; exp: REAL) : COMPLEX ;
+@findex cpowl
+PROCEDURE cpowl (base: LONGCOMPLEX; exp: LONGREAL) : LONGCOMPLEX ;
+
+@findex csqrtf
+PROCEDURE csqrtf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex csqrt
+PROCEDURE csqrt (z: COMPLEX) : COMPLEX ;
+@findex csqrtl
+PROCEDURE csqrtl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex cexpf
+PROCEDURE cexpf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex cexp
+PROCEDURE cexp (z: COMPLEX) : COMPLEX ;
+@findex cexpl
+PROCEDURE cexpl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex clogf
+PROCEDURE clogf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex clog
+PROCEDURE clog (z: COMPLEX) : COMPLEX ;
+@findex clogl
+PROCEDURE clogl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex csinf
+PROCEDURE csinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex csin
+PROCEDURE csin (z: COMPLEX) : COMPLEX ;
+@findex csinl
+PROCEDURE csinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex ccosf
+PROCEDURE ccosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex ccos
+PROCEDURE ccos (z: COMPLEX) : COMPLEX ;
+@findex ccosl
+PROCEDURE ccosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex ctanf
+PROCEDURE ctanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex ctan
+PROCEDURE ctan (z: COMPLEX) : COMPLEX ;
+@findex ctanl
+PROCEDURE ctanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex casinf
+PROCEDURE casinf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex casin
+PROCEDURE casin (z: COMPLEX) : COMPLEX ;
+@findex casinl
+PROCEDURE casinl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex cacosf
+PROCEDURE cacosf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex cacos
+PROCEDURE cacos (z: COMPLEX) : COMPLEX ;
+@findex cacosl
+PROCEDURE cacosl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex catanf
+PROCEDURE catanf (z: SHORTCOMPLEX) : SHORTCOMPLEX ;
+@findex catan
+PROCEDURE catan (z: COMPLEX) : COMPLEX ;
+@findex catanl
+PROCEDURE catanl (z: LONGCOMPLEX) : LONGCOMPLEX ;
+
+@findex index
+PROCEDURE index (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex rindex
+PROCEDURE rindex (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex memcmp
+PROCEDURE memcmp (s1, s2: ADDRESS; n: CARDINAL) : INTEGER ;
+@findex memmove
+PROCEDURE memmove (s1, s2: ADDRESS; n: CARDINAL) : ADDRESS ;
+@findex memset
+PROCEDURE memset (s: ADDRESS; c: INTEGER; n: CARDINAL) : ADDRESS ;
+@findex strcat
+PROCEDURE strcat (dest, src: ADDRESS) : ADDRESS ;
+@findex strncat
+PROCEDURE strncat (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+@findex strcpy
+PROCEDURE strcpy (dest, src: ADDRESS) : ADDRESS ;
+@findex strncpy
+PROCEDURE strncpy (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+@findex strcmp
+PROCEDURE strcmp (s1, s2: ADDRESS) : INTEGER ;
+@findex strncmp
+PROCEDURE strncmp (s1, s2: ADDRESS; n: CARDINAL) : INTEGER ;
+@findex strlen
+PROCEDURE strlen (s: ADDRESS) : INTEGER ;
+@findex strstr
+PROCEDURE strstr (haystack, needle: ADDRESS) : ADDRESS ;
+@findex strpbrk
+PROCEDURE strpbrk (s, accept: ADDRESS) : ADDRESS ;
+@findex strspn
+PROCEDURE strspn (s, accept: ADDRESS) : CARDINAL ;
+@findex strcspn
+PROCEDURE strcspn (s, accept: ADDRESS) : CARDINAL ;
+@findex strchr
+PROCEDURE strchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+@findex strrchr
+PROCEDURE strrchr (s: ADDRESS; c: INTEGER) : ADDRESS ;
+
+END cbuiltin.
+@end example
+@page
+
+@node gm2-libs/cgetopt, gm2-libs/cxxabi, gm2-libs/cbuiltin, Base libraries
+@subsection gm2-libs/cgetopt
+
+@example
+DEFINITION MODULE cgetopt ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+@findex Options (type)
+   Options = ADDRESS ;
+
+VAR
+@findex optarg (var)
+   optarg                : ADDRESS ;
+@findex optind (var)
+@findex opterr (var)
+@findex optopt (var)
+   optind, opterr, optopt: INTEGER ;
+
+
+(*
+   getopt - the getopt() function parses the command-line arguments.
+            Its arguments argc and argv are the argument count and array as
+            passed to the main() function on program invocation.  An element of
+            argv that starts with '-' (and is not exactly "-" or "--") is an
+            option element.  The characters of this element (aside from the
+            initial '-') are option characters.  If getopt() is called
+            repeatedly, it returns successively each of the option characters
+            from each of the option elements.
+*)
+
+@findex getopt
+PROCEDURE getopt (argc: INTEGER; argv: ADDRESS; optstring: ADDRESS) : CHAR ;
+
+
+(*
+   getopt_long - works like getopt() except that it also accepts long options,
+                 started with two dashes.  (If the program accepts only long
+                 options, then optstring should be specified as an empty string (""),
+                 not NULL.)  Long option names may be abbreviated if the abbreviation
+                 is unique or is an exact match for some defined option.  A
+                 long option may take a parameter, of the form --arg=param or
+                 --arg param.
+*)
+
+@findex getopt_long
+PROCEDURE getopt_long (argc: INTEGER; argv: ADDRESS; optstring: ADDRESS;
+                       longopts: ADDRESS; VAR longindex: INTEGER) : INTEGER ;
+
+
+(*
+   getopt_long_only - a wrapper for the C getopt_long_only.
+*)
+
+@findex getopt_long_only
+PROCEDURE getopt_long_only (argc: INTEGER; argv: ADDRESS; optstring: ADDRESS;
+                            longopts: ADDRESS; VAR longindex: INTEGER) : INTEGER ;
+
+
+(*
+   InitOptions - constructor for empty Options.
+*)
+
+@findex InitOptions
+PROCEDURE InitOptions () : Options ;
+
+
+(*
+   KillOptions - deconstructor for empty Options.
+*)
+
+@findex KillOptions
+PROCEDURE KillOptions (o: Options) : Options ;
+
+
+(*
+   SetOption - set option[index] with @{name, has_arg, flag, val@}.
+*)
+
+@findex SetOption
+PROCEDURE SetOption (o: Options; index: CARDINAL;
+                     name: ADDRESS; has_arg: BOOLEAN;
+                     VAR flag: INTEGER; val: INTEGER) ;
+
+
+(*
+   GetLongOptionArray - return a pointer to the C array containing all
+                        long options.
+*)
+
+@findex GetLongOptionArray
+PROCEDURE GetLongOptionArray (o: Options) : ADDRESS ;
+
+
+END cgetopt.
+@end example
+@page
+
+@node gm2-libs/cxxabi, gm2-libs/dtoa, gm2-libs/cgetopt, Base libraries
+@subsection gm2-libs/cxxabi
+
+@example
+DEFINITION MODULE FOR "C" cxxabi ;
+
+(* This should only be used by the compiler and it matches the
+    g++ implementation.  *)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT UNQUALIFIED __cxa_begin_catch, __cxa_end_catch, __cxa_rethrow ;
+
+
+@findex __cxa_begin_catch
+PROCEDURE __cxa_begin_catch (a: ADDRESS) : ADDRESS ;
+@findex __cxa_end_catch
+PROCEDURE __cxa_end_catch ;
+@findex __cxa_rethrow
+PROCEDURE __cxa_rethrow ;
+
+
+END cxxabi.
+@end example
+@page
+
+@node gm2-libs/dtoa, gm2-libs/errno, gm2-libs/cxxabi, Base libraries
+@subsection gm2-libs/dtoa
+
+@example
+DEFINITION MODULE dtoa ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+@findex Mode (type)
+   Mode = (maxsignificant, decimaldigits) ;
+
+
+(*
+   strtod - returns a REAL given a string, s.  It will set
+            error to TRUE if the number is too large.
+*)
+
+@findex strtod
+PROCEDURE strtod (s: ADDRESS; VAR error: BOOLEAN) : REAL ;
+
+
+(*
+   dtoa - converts a REAL, d, into a string.  The address of the
+          string is returned.
+          mode       indicates the type of conversion required.
+          ndigits    determines the number of digits according to mode.
+          decpt      the position of the decimal point.
+          sign       does the string have a sign?
+*)
+
+@findex dtoa
+PROCEDURE dtoa (d        : REAL;
+                mode     : Mode;
+                ndigits  : INTEGER;
+	        VAR decpt: INTEGER;
+	        VAR sign : BOOLEAN) : ADDRESS ;
+
+
+END dtoa.
+@end example
+@page
+
+@node gm2-libs/errno, gm2-libs/gdbif, gm2-libs/dtoa, Base libraries
+@subsection gm2-libs/errno
+
+@example
+DEFINITION MODULE errno ;
+
+CONST
+    EINTR  =  4 ;   (* system call interrupted *)
+    ERANGE = 34 ;   (* result is too large     *)
+    EAGAIN = 11 ;   (* retry the system call   *)
+
+@findex geterrno
+PROCEDURE geterrno () : INTEGER ;
+
+
+END errno.
+@end example
+@page
+
+@node gm2-libs/gdbif, gm2-libs/ldtoa, gm2-libs/errno, Base libraries
+@subsection gm2-libs/gdbif
+
+@example
+DEFINITION MODULE gdbif ;
+
+(*  Provides interactive connectivity with gdb useful for debugging
+    Modula-2 shared libraries.  *)
+
+EXPORT UNQUALIFIED sleepSpin, finishSpin, connectSpin ;
+
+
+(*
+   finishSpin - sets boolean mustWait to FALSE.
+*)
+
+@findex finishSpin
+PROCEDURE finishSpin ;
+
+
+(*
+   sleepSpin - waits for the boolean variable mustWait to become FALSE.
+               It sleeps for a second between each test of the variable.
+*)
+
+@findex sleepSpin
+PROCEDURE sleepSpin ;
+
+
+(*
+   connectSpin - breakpoint placeholder.  Its only purpose is to allow users
+                 to set a breakpoint.  This procedure is called once
+                 sleepSpin is released from its spin (via a call from
+                 finishSpin).
+*)
+
+@findex connectSpin
+PROCEDURE connectSpin ;
+
+
+END gdbif.
+@end example
+@page
+
+@node gm2-libs/ldtoa, gm2-libs/libc, gm2-libs/gdbif, Base libraries
+@subsection gm2-libs/ldtoa
+
+@example
+DEFINITION MODULE ldtoa ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+@findex Mode (type)
+   Mode = (maxsignificant, decimaldigits) ;
+
+
+(*
+   strtold - returns a LONGREAL given a C string, s.  It will set
+             error to TRUE if the number is too large or badly formed.
+*)
+
+@findex strtold
+PROCEDURE strtold (s: ADDRESS; VAR error: BOOLEAN) : LONGREAL ;
+
+
+(*
+   ldtoa - converts a LONGREAL, d, into a string.  The address of the
+           string is returned.
+           mode       indicates the type of conversion required.
+           ndigits    determines the number of digits according to mode.
+           decpt      the position of the decimal point.
+           sign       does the string have a sign?
+*)
+
+@findex ldtoa
+PROCEDURE ldtoa (d        : LONGREAL;
+                 mode     : Mode;
+                 ndigits  : INTEGER;
+                 VAR decpt: INTEGER;
+                 VAR sign : BOOLEAN) : ADDRESS ;
+
+
+END ldtoa.
+@end example
+@page
+
+@node gm2-libs/libc, gm2-libs/libm, gm2-libs/ldtoa, Base libraries
+@subsection gm2-libs/libc
+
+@example
+DEFINITION MODULE FOR "C" libc ;
+
+FROM SYSTEM IMPORT ADDRESS, CSIZE_T, CSSIZE_T ;
+
+EXPORT UNQUALIFIED time_t, timeb, tm, ptrToTM,
+                   write, read,
+                   system, abort,
+                   malloc, free,
+                   exit, isatty,
+                   getenv, putenv, getpid,
+                   dup, close, open, lseek,
+                   readv, writev,
+                   perror, creat,
+                   getcwd, chown, strlen, strcpy, strncpy,
+                   unlink, setenv,
+                   memcpy, memset, memmove, printf, realloc,
+                   rand, srand,
+                   time, localtime, ftime,
+                   shutdown, rename, setjmp, longjmp, atexit,
+                   ttyname, sleep, execv ;
+
+
+TYPE
+@findex time_t (type)
+   time_t = LONGINT ;
+
+@findex ptrToTM (type)
+   ptrToTM = POINTER TO tm ;
+@findex tm (type)
+   tm = RECORD
+           tm_sec: INTEGER ;     (* Seconds.     [0-60] (1 leap second) *)
+           tm_min: INTEGER ;     (* Minutes.     [0-59]   *)
+           tm_hour: INTEGER ;    (* Hours.       [0-23]   *)
+           tm_mday: INTEGER ;    (* Day.         [1-31]   *)
+           tm_mon: INTEGER ;     (* Month.       [0-11]   *)
+           tm_year: INTEGER ;    (* Year - 1900.          *)
+           tm_wday: INTEGER ;    (* Day of week. [0-6]    *)
+           tm_yday: INTEGER ;    (* Days in year.[0-365]  *)
+           tm_isdst: INTEGER ;   (* DST.         [-1/0/1] *)
+           tm_gmtoff: LONGINT ;  (* Seconds east of UTC.  *)
+           tm_zone: ADDRESS ;    (* char * zone name      *)
+@findex END (type)
+        END ;
+
+@findex timeb (type)
+   timeb = RECORD
+              time    : time_t ;
+              millitm : SHORTCARD ;
+              timezone: SHORTCARD ;
+              dstflag : SHORTCARD ;
+@findex END (type)
+           END ;
+
+@findex exitP (type)
+   exitP = PROCEDURE () : INTEGER ;
+
+
+(*
+     ssize_t write (int d, void *buf, size_t nbytes)
+*)
+
+@findex write
+PROCEDURE write (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : [ CSSIZE_T ] ;
+
+
+(*
+     ssize_t read (int d, void *buf, size_t nbytes)
+*)
+
+@findex read
+PROCEDURE read (d: INTEGER; buf: ADDRESS; nbytes: CSIZE_T) : [ CSSIZE_T ] ;
+
+
+(*
+     int system(string)
+     char *string;
+*)
+
+@findex system
+PROCEDURE system (a: ADDRESS) : [ INTEGER ] ;
+
+
+(*
+     abort - generate a fault
+
+     abort() first closes all open files if possible, then sends
+     an IOT signal to the process.  This signal usually results
+     in termination with a core dump, which may be used for
+     debugging.
+
+     It is possible for abort() to return control if is caught or
+     ignored, in which case the value returned is that of the
+     kill(2V) system call.
+*)
+
+@findex abort
+PROCEDURE abort <* noreturn *> ;
+
+
+(*
+     malloc - memory allocator.
+
+     void *malloc(size_t size);
+
+     malloc() returns a pointer to a block of at least size
+     bytes, which is appropriately aligned.  If size is zero,
+     malloc() returns a non-NULL pointer, but this pointer should
+     not be dereferenced.
+*)
+
+@findex malloc
+PROCEDURE malloc (size: CSIZE_T) : ADDRESS ;
+
+
+(*
+     free - memory deallocator.
+
+     free (void *ptr);
+
+     free() releases a previously allocated block.  Its argument
+     is a pointer to a block previously allocated by malloc,
+     calloc, realloc, malloc, or memalign.
+*)
+
+@findex free
+PROCEDURE free (ptr: ADDRESS) ;
+
+
+(*
+     void *realloc (void *ptr, size_t size);
+
+     realloc changes the size of the memory block pointed to
+     by ptr to size bytes. The contents will be  unchanged  to
+     the minimum of the old and new sizes; newly allocated memory
+     will be uninitialized. If ptr is NIL, the call is
+     equivalent  to malloc(size); if size is equal to zero, the
+     call is equivalent to free(ptr). Unless ptr is NIL, it
+     must have been returned by an earlier call to malloc(),
+     realloc.
+*)
+
+@findex realloc
+PROCEDURE realloc (ptr: ADDRESS; size: CSIZE_T) : ADDRESS ;
+
+
+(*
+   isatty - does this descriptor refer to a terminal.
+*)
+
+@findex isatty
+PROCEDURE isatty (fd: INTEGER) : INTEGER ;
+
+
+(*
+   exit - returns control to the invoking process. Result, r, is
+          returned.
+*)
+
+@findex exit
+PROCEDURE exit (r: INTEGER) <* noreturn *> ;
+
+
+(*
+   getenv - returns the C string for the equivalent C environment
+            variable.
+*)
+
+@findex getenv
+PROCEDURE getenv (s: ADDRESS) : ADDRESS ;
+
+
+(*
+   putenv - change or add an environment variable.
+*)
+
+@findex putenv
+PROCEDURE putenv (s: ADDRESS) : INTEGER ;
+
+
+(*
+   getpid - returns the UNIX process identification number.
+*)
+
+@findex getpid
+PROCEDURE getpid () : INTEGER ;
+
+
+(*
+   dup - duplicates the file descriptor, d.
+*)
+
+@findex dup
+PROCEDURE dup (d: INTEGER) : INTEGER ;
+
+
+(*
+   close - closes the file descriptor, d.
+*)
+
+@findex close
+PROCEDURE close (d: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   open - open the file, filename with flag and mode.
+*)
+
+@findex open
+PROCEDURE open (filename: ADDRESS; oflag: INTEGER; ...) : INTEGER ;
+
+
+(*
+   creat - creates a new file
+*)
+
+@findex creat
+PROCEDURE creat (filename: ADDRESS; mode: CARDINAL) : INTEGER;
+
+
+(*
+   lseek - calls unix lseek:
+
+           off_t lseek(int fildes, off_t offset, int whence);
+*)
+
+@findex lseek
+PROCEDURE lseek (fd: INTEGER; offset: LONGINT; whence: INTEGER) : LONGINT ;
+
+
+(*
+   perror - writes errno and string. (ARRAY OF CHAR is translated onto ADDRESS).
+*)
+
+@findex perror
+PROCEDURE perror (string: ARRAY OF CHAR);
+
+
+(*
+   readv - reads an io vector of bytes.
+*)
+
+@findex readv
+PROCEDURE readv (fd: INTEGER; v: ADDRESS; n: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   writev - writes an io vector of bytes.
+*)
+
+@findex writev
+PROCEDURE writev (fd: INTEGER; v: ADDRESS; n: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   getcwd - copies the absolute pathname of the
+            current working directory to the array pointed to by buf,
+            which is of length size.
+
+            If the current absolute path name would require a buffer
+            longer than size elements, NULL is returned, and errno is
+            set to ERANGE; an application should check for this error,
+            and allocate a larger buffer if necessary.
+*)
+
+@findex getcwd
+PROCEDURE getcwd (buf: ADDRESS; size: CSIZE_T) : ADDRESS ;
+
+
+(*
+   chown - The  owner  of  the  file  specified  by  path or by fd is
+           changed.  Only the super-user may change the  owner  of  a
+           file.   The  owner  of  a file may change the group of the
+           file to any group of which that owner is  a  member.   The
+           super-user may change the group arbitrarily.
+
+           If  the owner or group is specified as -1, then that ID is
+           not changed.
+
+           On success, zero is returned.  On error, -1  is  returned,
+           and errno is set appropriately.
+*)
+
+@findex chown
+PROCEDURE chown (filename: ADDRESS; uid, gid: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   strlen - returns the length of string, a.
+*)
+
+@findex strlen
+PROCEDURE strlen (a: ADDRESS) : CSIZE_T ;
+
+
+(*
+   strcpy - copies string, src, into, dest.
+            It returns dest.
+*)
+
+@findex strcpy
+PROCEDURE strcpy (dest, src: ADDRESS) : [ ADDRESS ] ;
+
+
+(*
+   strncpy - copies string, src, into, dest, copying at most, n, bytes.
+             It returns dest.
+*)
+
+@findex strncpy
+PROCEDURE strncpy (dest, src: ADDRESS; n: CARDINAL) : [ ADDRESS ] ;
+
+
+(*
+   unlink - removes file and returns 0 if successful.
+*)
+
+@findex unlink
+PROCEDURE unlink (file: ADDRESS) : [ INTEGER ] ;
+
+
+(*
+   memcpy - copy memory area
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memcpy(void *dest, const void *src, size_t n);
+   It returns dest.
+*)
+
+@findex memcpy
+PROCEDURE memcpy (dest, src: ADDRESS; size: CSIZE_T) : [ ADDRESS ] ;
+
+
+(*
+   memset - fill memory with a constant byte
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memset(void *s, int c, size_t n);
+   It returns s.
+*)
+
+@findex memset
+PROCEDURE memset (s: ADDRESS; c: INTEGER; size: CSIZE_T) : [ ADDRESS ] ;
+
+
+(*
+   memmove - copy memory areas which may overlap
+
+   SYNOPSIS
+
+   #include <string.h>
+
+   void *memmove(void *dest, const void *src, size_t n);
+   It returns dest.
+*)
+
+@findex memmove
+PROCEDURE memmove (dest, src: ADDRESS; size: CSIZE_T) : [ ADDRESS ] ;
+
+
+(*
+   int printf(const char *format, ...);
+*)
+
+@findex printf
+PROCEDURE printf (format: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+
+
+(*
+   setenv - sets environment variable, name, to value.
+            It will overwrite an existing value if, overwrite,
+            is true.  It returns 0 on success and -1 for an error.
+*)
+
+@findex setenv
+PROCEDURE setenv (name: ADDRESS; value: ADDRESS; overwrite: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   srand - initialize the random number seed.
+*)
+
+@findex srand
+PROCEDURE srand (seed: INTEGER) ;
+
+
+(*
+   rand - return a random integer.
+*)
+
+@findex rand
+PROCEDURE rand () : INTEGER ;
+
+
+(*
+   time - returns a pointer to the time_t value. If, a,
+          is not NIL then the libc value is copied into
+          memory at address, a.
+*)
+
+@findex time
+PROCEDURE time (a: ADDRESS) : time_t ;
+
+
+(*
+   localtime - returns a pointer to the libc copy of the tm
+               structure.
+*)
+
+@findex localtime
+PROCEDURE localtime (VAR t: time_t) : ADDRESS ;
+
+
+(*
+   ftime - return date and time.
+*)
+
+@findex ftime
+PROCEDURE ftime (VAR t: timeb) : [ INTEGER ] ;
+
+
+(*
+   shutdown - shutdown a socket, s.
+              if how = 0, then no more reads are allowed.
+              if how = 1, then no more writes are allowed.
+              if how = 2, then mo more reads or writes are allowed.
+*)
+
+@findex shutdown
+PROCEDURE shutdown (s: INTEGER; how: INTEGER) : [ INTEGER ] ;
+
+
+(*
+   rename - change the name or location of a file
+*)
+
+@findex rename
+PROCEDURE rename (oldpath, newpath: ADDRESS) : [ INTEGER ] ;
+
+
+(*
+   setjmp - returns 0 if returning directly, and non-zero
+            when returning from longjmp using the saved
+            context.
+*)
+
+@findex setjmp
+PROCEDURE setjmp (env: ADDRESS) : INTEGER ;
+
+
+(*
+   longjmp - restores the environment saved by the last call
+             of setjmp with the corresponding env argument.
+             After longjmp is completed, program execution
+             continues as if the corresponding call of setjmp
+             had just returned the value val.  The value of
+             val must not be zero.
+*)
+
+@findex longjmp
+PROCEDURE longjmp (env: ADDRESS; val: INTEGER) ;
+
+
+(*
+   atexit - execute, proc, when the function exit is called.
+*)
+
+@findex atexit
+PROCEDURE atexit (proc: exitP) : [ INTEGER ] ;
+
+
+(*
+   ttyname - returns a pointer to a string determining the ttyname.
+*)
+
+@findex ttyname
+PROCEDURE ttyname (filedes: INTEGER) : ADDRESS ;
+
+
+(*
+   sleep - calling thread sleeps for seconds.
+*)
+
+@findex sleep
+PROCEDURE sleep (seconds: CARDINAL) : [ CARDINAL ] ;
+
+
+(*
+   execv - execute a file.
+*)
+
+@findex execv
+PROCEDURE execv (pathname: ADDRESS; argv: ADDRESS) : [ INTEGER ] ;
+
+
+END libc.
+@end example
+@page
+
+@node gm2-libs/libm, gm2-libs/sckt, gm2-libs/libc, Base libraries
+@subsection gm2-libs/libm
+
+@example
+DEFINITION MODULE FOR "C" libm ;
+
+(* Users are strongly advised to use MathLib0 or RealMath as calls
+   to functions within these modules will generate inline code.
+   This module is used by MathLib0 and RealMath when inline code cannot
+   be generated.  *)
+
+EXPORT UNQUALIFIED sin, sinl, sinf,
+                   cos, cosl, cosf,
+                   tan, tanl, tanf,
+                   sqrt, sqrtl, sqrtf,
+                   asin, asinl, asinf,
+                   acos, acosl, acosf,
+                   atan, atanl, atanf,
+                   atan2, atan2l, atan2f,
+                   exp, expl, expf,
+                   log, logl, logf,
+                   exp10, exp10l, exp10f,
+                   pow, powl, powf,
+                   floor, floorl, floorf,
+                   ceil, ceill, ceilf ;
+
+@findex sin
+PROCEDURE sin (x: REAL) : REAL ;
+@findex sinl
+PROCEDURE sinl (x: LONGREAL) : LONGREAL ;
+@findex sinf
+PROCEDURE sinf (x: SHORTREAL) : SHORTREAL ;
+@findex cos
+PROCEDURE cos (x: REAL) : REAL ;
+@findex cosl
+PROCEDURE cosl (x: LONGREAL) : LONGREAL ;
+@findex cosf
+PROCEDURE cosf (x: SHORTREAL) : SHORTREAL ;
+@findex tan
+PROCEDURE tan (x: REAL) : REAL ;
+@findex tanl
+PROCEDURE tanl (x: LONGREAL) : LONGREAL ;
+@findex tanf
+PROCEDURE tanf (x: SHORTREAL) : SHORTREAL ;
+@findex sqrt
+PROCEDURE sqrt (x: REAL) : REAL ;
+@findex sqrtl
+PROCEDURE sqrtl (x: LONGREAL) : LONGREAL ;
+@findex sqrtf
+PROCEDURE sqrtf (x: SHORTREAL) : SHORTREAL ;
+@findex asin
+PROCEDURE asin (x: REAL) : REAL ;
+@findex asinl
+PROCEDURE asinl (x: LONGREAL) : LONGREAL ;
+@findex asinf
+PROCEDURE asinf (x: SHORTREAL) : SHORTREAL ;
+@findex acos
+PROCEDURE acos (x: REAL) : REAL ;
+@findex acosl
+PROCEDURE acosl (x: LONGREAL) : LONGREAL ;
+@findex acosf
+PROCEDURE acosf (x: SHORTREAL) : SHORTREAL ;
+@findex atan
+PROCEDURE atan (x: REAL) : REAL ;
+@findex atanl
+PROCEDURE atanl (x: LONGREAL) : LONGREAL ;
+@findex atanf
+PROCEDURE atanf (x: SHORTREAL) : SHORTREAL ;
+@findex atan2
+PROCEDURE atan2 (x, y: REAL) : REAL ;
+@findex atan2l
+PROCEDURE atan2l (x, y: LONGREAL) : LONGREAL ;
+@findex atan2f
+PROCEDURE atan2f (x, y: SHORTREAL) : SHORTREAL ;
+@findex exp
+PROCEDURE exp (x: REAL) : REAL ;
+@findex expl
+PROCEDURE expl (x: LONGREAL) : LONGREAL ;
+@findex expf
+PROCEDURE expf (x: SHORTREAL) : SHORTREAL ;
+@findex log
+PROCEDURE log (x: REAL) : REAL ;
+@findex logl
+PROCEDURE logl (x: LONGREAL) : LONGREAL ;
+@findex logf
+PROCEDURE logf (x: SHORTREAL) : SHORTREAL ;
+@findex exp10
+PROCEDURE exp10 (x: REAL) : REAL ;
+@findex exp10l
+PROCEDURE exp10l (x: LONGREAL) : LONGREAL ;
+@findex exp10f
+PROCEDURE exp10f (x: SHORTREAL) : SHORTREAL ;
+@findex pow
+PROCEDURE pow (x, y: REAL) : REAL ;
+@findex powl
+PROCEDURE powl (x, y: LONGREAL) : LONGREAL ;
+@findex powf
+PROCEDURE powf (x, y: SHORTREAL) : SHORTREAL ;
+@findex floor
+PROCEDURE floor (x: REAL) : REAL ;
+@findex floorl
+PROCEDURE floorl (x: LONGREAL) : LONGREAL ;
+@findex floorf
+PROCEDURE floorf (x: SHORTREAL) : SHORTREAL ;
+@findex ceil
+PROCEDURE ceil (x: REAL) : REAL ;
+@findex ceill
+PROCEDURE ceill (x: LONGREAL) : LONGREAL ;
+@findex ceilf
+PROCEDURE ceilf (x: SHORTREAL) : SHORTREAL ;
+
+END libm.
+@end example
+@page
+
+@node gm2-libs/sckt, gm2-libs/termios, gm2-libs/libm, Base libraries
+@subsection gm2-libs/sckt
+
+@example
+DEFINITION MODULE sckt ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT UNQUALIFIED tcpServerState,
+                   tcpServerEstablish, tcpServerEstablishPort,
+                   tcpServerAccept, getLocalIP,
+                   tcpServerPortNo, tcpServerIP, tcpServerSocketFd,
+                   tcpServerClientIP, tcpServerClientPortNo,
+                   tcpClientState,
+                   tcpClientSocket, tcpClientSocketIP, tcpClientConnect,
+                   tcpClientPortNo, tcpClientIP, tcpClientSocketFd ;
+
+TYPE
+@findex tcpServerState (type)
+   tcpServerState = ADDRESS ;
+@findex tcpClientState (type)
+   tcpClientState = ADDRESS ;
+
+
+(*
+   tcpServerEstablish - returns a tcpState containing the relevant
+                        information about a socket declared to receive
+                        tcp connections.
+*)
+
+@findex tcpServerEstablish
+PROCEDURE tcpServerEstablish () : tcpServerState ;
+
+
+(*
+   tcpServerEstablishPort - returns a tcpState containing the relevant
+                            information about a socket declared to receive
+                            tcp connections.  This method attempts to use
+                            the port specified by the parameter.
+*)
+
+@findex tcpServerEstablishPort
+PROCEDURE tcpServerEstablishPort (port: CARDINAL) : tcpServerState ;
+
+
+(*
+   tcpServerAccept - returns a file descriptor once a client has connected and
+                     been accepted.
+*)
+
+@findex tcpServerAccept
+PROCEDURE tcpServerAccept (s: tcpServerState) : INTEGER ;
+
+
+(*
+   tcpServerPortNo - returns the portNo from structure, s.
+*)
+
+@findex tcpServerPortNo
+PROCEDURE tcpServerPortNo (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpSocketFd - returns the sockFd from structure, s.
+*)
+
+@findex tcpServerSocketFd
+PROCEDURE tcpServerSocketFd (s: tcpServerState) : INTEGER ;
+
+
+(*
+   getLocalIP - returns the IP address of this machine.
+*)
+
+@findex getLocalIP
+PROCEDURE getLocalIP (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpServerIP - returns the IP address from structure, s.
+*)
+
+@findex tcpServerIP
+PROCEDURE tcpServerIP (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpServerClientIP - returns the IP address of the client who
+                       has connected to server, s.
+*)
+
+@findex tcpServerClientIP
+PROCEDURE tcpServerClientIP (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpServerClientPortNo - returns the port number of the client who
+                           has connected to server, s.
+*)
+
+@findex tcpServerClientPortNo
+PROCEDURE tcpServerClientPortNo (s: tcpServerState) : CARDINAL ;
+
+
+(*
+   tcpClientSocket - returns a file descriptor (socket) which has
+                     connected to, serverName:portNo.
+*)
+
+@findex tcpClientSocket
+PROCEDURE tcpClientSocket (serverName: ADDRESS; portNo: CARDINAL) : tcpClientState ;
+
+
+(*
+   tcpClientSocketIP - returns a file descriptor (socket) which has
+                       connected to, ip:portNo.
+*)
+
+@findex tcpClientSocketIP
+PROCEDURE tcpClientSocketIP (ip: CARDINAL; portNo: CARDINAL) : tcpClientState ;
+
+
+(*
+   tcpClientConnect - returns the file descriptor associated with, s,
+                      once a connect has been performed.
+*)
+
+@findex tcpClientConnect
+PROCEDURE tcpClientConnect (s: tcpClientState) : INTEGER ;
+
+
+(*
+   tcpClientPortNo - returns the portNo from structure, s.
+*)
+
+@findex tcpClientPortNo
+PROCEDURE tcpClientPortNo (s: tcpClientState) : INTEGER ;
+
+
+(*
+   tcpClientSocketFd - returns the sockFd from structure, s.
+*)
+
+@findex tcpClientSocketFd
+PROCEDURE tcpClientSocketFd (s: tcpClientState) : INTEGER ;
+
+
+(*
+   tcpClientIP - returns the IP address from structure, s.
+*)
+
+@findex tcpClientIP
+PROCEDURE tcpClientIP (s: tcpClientState) : CARDINAL ;
+
+
+END sckt.
+@end example
+@page
+
+@node gm2-libs/termios, gm2-libs/wrapc, gm2-libs/sckt, Base libraries
+@subsection gm2-libs/termios
+
+@example
+DEFINITION MODULE termios ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+@findex TERMIOS (type)
+   TERMIOS = ADDRESS ;
+
+@findex ControlChar (type)
+   ControlChar = (vintr, vquit, verase, vkill, veof, vtime, vmin,
+                  vswtc, vstart, vstop, vsusp, veol, vreprint, vdiscard,
+                  vwerase, vlnext, veol2) ;
+
+@findex Flag (type)
+   Flag = (
+           (* input flag bits *)
+           ignbrk, ibrkint, ignpar, iparmrk, inpck, istrip, inlcr,
+           igncr, icrnl, iuclc, ixon, ixany, ixoff, imaxbel,
+           (* output flag bits *)
+           opost, olcuc, onlcr, ocrnl, onocr, onlret, ofill, ofdel,
+           onl0, onl1, ocr0, ocr1, ocr2, ocr3,
+           otab0, otab1, otab2, otab3, obs0, obs1, off0, off1, ovt0, ovt1,
+           (* baud rate *)
+           b0, b50, b75, b110, b135, b150, b200, b300, b600, b1200,
+           b1800, b2400, b4800, b9600, b19200, b38400,
+           b57600, b115200, b240400, b460800, b500000, b576000,
+           b921600, b1000000, b1152000, b1500000, b2000000, b2500000,
+           b3000000, b3500000, b4000000, maxbaud, crtscts,
+           (* character size *)
+           cs5, cs6, cs7, cs8, cstopb, cread, parenb, parodd, hupcl, clocal,
+           (* local flags *)
+           lisig, licanon, lxcase, lecho, lechoe, lechok, lechonl, lnoflsh,
+           ltopstop, lechoctl, lechoprt, lechoke, lflusho, lpendin, liexten) ;
+
+
+(*
+   InitTermios - new data structure.
+*)
+
+@findex InitTermios
+PROCEDURE InitTermios () : TERMIOS ;
+
+
+(*
+   KillTermios - delete data structure.
+*)
+
+@findex KillTermios
+PROCEDURE KillTermios (t: TERMIOS) : TERMIOS ;
+
+
+(*
+   cfgetospeed - return output baud rate.
+*)
+
+@findex cfgetospeed
+PROCEDURE cfgetospeed (t: TERMIOS) : INTEGER ;
+
+
+(*
+   cfgetispeed - return input baud rate.
+*)
+
+@findex cfgetispeed
+PROCEDURE cfgetispeed (t: TERMIOS) : INTEGER ;
+
+
+(*
+   cfsetospeed - set output baud rate.
+*)
+
+@findex cfsetospeed
+PROCEDURE cfsetospeed (t: TERMIOS; b: CARDINAL) : INTEGER ;
+
+
+(*
+   cfsetispeed - set input baud rate.
+*)
+
+@findex cfsetispeed
+PROCEDURE cfsetispeed (t: TERMIOS; b: CARDINAL) : INTEGER ;
+
+
+(*
+   cfsetspeed - set input and output baud rate.
+*)
+
+@findex cfsetspeed
+PROCEDURE cfsetspeed (t: TERMIOS; b: CARDINAL) : INTEGER ;
+
+
+(*
+   tcgetattr - get state of, fd, into, t.
+*)
+
+@findex tcgetattr
+PROCEDURE tcgetattr (fd: INTEGER; t: TERMIOS) : INTEGER ;
+
+
+(*
+   The following three functions return the different option values.
+*)
+
+@findex tcsnow
+PROCEDURE tcsnow () : INTEGER ;   (* alter fd now *)
+@findex tcsdrain
+PROCEDURE tcsdrain () : INTEGER ; (* alter when all output has been sent *)
+@findex tcsflush
+PROCEDURE tcsflush () : INTEGER ; (* like drain, except discard any pending input *)
+
+
+(*
+   tcsetattr - set state of, fd, to, t, using option.
+*)
+
+@findex tcsetattr
+PROCEDURE tcsetattr (fd: INTEGER; option: INTEGER; t: TERMIOS) : INTEGER ;
+
+
+(*
+   cfmakeraw - sets, t, to raw mode.
+*)
+
+@findex cfmakeraw
+PROCEDURE cfmakeraw (t: TERMIOS) ;
+
+
+(*
+   tcsendbreak - send zero bits for duration.
+*)
+
+@findex tcsendbreak
+PROCEDURE tcsendbreak (fd: INTEGER; duration: INTEGER) : INTEGER ;
+
+
+(*
+   tcdrain - waits for pending output to be written on, fd.
+*)
+
+@findex tcdrain
+PROCEDURE tcdrain (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflushi - flush input.
+*)
+
+@findex tcflushi
+PROCEDURE tcflushi (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflusho - flush output.
+*)
+
+@findex tcflusho
+PROCEDURE tcflusho (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflushio - flush input and output.
+*)
+
+@findex tcflushio
+PROCEDURE tcflushio (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflowoni - restart input on, fd.
+*)
+
+@findex tcflowoni
+PROCEDURE tcflowoni (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflowoffi - stop input on, fd.
+*)
+
+@findex tcflowoffi
+PROCEDURE tcflowoffi (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflowono - restart output on, fd.
+*)
+
+@findex tcflowono
+PROCEDURE tcflowono (fd: INTEGER) : INTEGER ;
+
+
+(*
+   tcflowoffo - stop output on, fd.
+*)
+
+@findex tcflowoffo
+PROCEDURE tcflowoffo (fd: INTEGER) : INTEGER ;
+
+
+(*
+   GetFlag - sets a flag value from, t, in, b, and returns TRUE
+             if, t, supports, f.
+*)
+
+@findex GetFlag
+PROCEDURE GetFlag (t: TERMIOS; f: Flag; VAR b: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   SetFlag - sets a flag value in, t, to, b, and returns TRUE if
+             this flag value is supported.
+*)
+
+@findex SetFlag
+PROCEDURE SetFlag (t: TERMIOS; f: Flag; b: BOOLEAN) : BOOLEAN ;
+
+
+(*
+   GetChar - sets a CHAR, ch, value from, t, and returns TRUE if
+             this value is supported.
+*)
+
+@findex GetChar
+PROCEDURE GetChar (t: TERMIOS; c: ControlChar; VAR ch: CHAR) : BOOLEAN ;
+
+
+(*
+   SetChar - sets a CHAR value in, t, and returns TRUE if, c,
+             is supported.
+*)
+
+@findex SetChar
+PROCEDURE SetChar (t: TERMIOS; c: ControlChar; ch: CHAR) : BOOLEAN ;
+
+
+END termios.
+@end example
+@page
+
+@node gm2-libs/wrapc, , gm2-libs/termios, Base libraries
+@subsection gm2-libs/wrapc
+
+@example
+DEFINITION MODULE wrapc ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT QUALIFIED strtime, filesize, fileinode,
+                 getrand, getusername, filemtime,
+                 getnameuidgid, signbit, signbitf, signbitl,
+		 isfinite, isfinitel, isfinitef ;
+
+
+(*
+   strtime - returns the C string for the equivalent C asctime
+             function.
+*)
+
+@findex strtime
+PROCEDURE strtime () : ADDRESS ;
+
+
+(*
+   filesize - assigns the size of a file, f, into low, high and
+              returns zero if successful.
+*)
+
+@findex filesize
+PROCEDURE filesize (f: INTEGER; VAR low, high: CARDINAL) : INTEGER ;
+
+
+(*
+   fileinode - return the inode associated with file, f.
+*)
+
+@findex fileinode
+PROCEDURE fileinode (f: INTEGER; VAR low, high: CARDINAL) : INTEGER ;
+
+
+(*
+   filemtime - returns the mtime of a file, f.
+*)
+
+@findex filemtime
+PROCEDURE filemtime (f: INTEGER) : INTEGER ;
+
+
+(*
+   getrand - returns a random number between 0..n-1
+*)
+
+@findex getrand
+PROCEDURE getrand (n: INTEGER) : INTEGER ;
+
+
+(*
+   getusername - returns a C string describing the current user.
+*)
+
+@findex getusername
+PROCEDURE getusername () : ADDRESS ;
+
+
+(*
+   getnameuidgid - fills in the, uid, and, gid, which represents
+                   user, name.
+*)
+
+@findex getnameuidgid
+PROCEDURE getnameuidgid (name: ADDRESS; VAR uid, gid: INTEGER) ;
+
+
+(*
+   in C these procedure functions are really macros, so we provide
+   real C functions and let gm2 call these if the builtins
+   are unavailable.
+*)
+
+@findex signbit
+PROCEDURE signbit (r: REAL) : INTEGER ;
+@findex signbitf
+PROCEDURE signbitf (s: SHORTREAL) : INTEGER ;
+@findex signbitl
+PROCEDURE signbitl (l: LONGREAL) : INTEGER ;
+
+
+(*
+   isfinite - provide non builtin alternative to the gcc builtin isfinite.
+              Returns 1 if x is finite and 0 if it is not.
+*)
+
+@findex isfinite
+PROCEDURE isfinite (x: REAL) : INTEGER ;
+
+
+(*
+   isfinitef - provide non builtin alternative to the gcc builtin isfinite.
+               Returns 1 if x is finite and 0 if it is not.
+*)
+
+@findex isfinitef
+PROCEDURE isfinitef (x: SHORTREAL) : INTEGER ;
+
+
+(*
+   isfinitel - provide non builtin alternative to the gcc builtin isfinite.
+               Returns 1 if x is finite and 0 if it is not.
+*)
+
+@findex isfinitel
+PROCEDURE isfinitel (x: LONGREAL) : INTEGER ;
+
+
+END wrapc.
+@end example
+@page
+
+
+@c ------------------------------------------------------------
+@node PIM and Logitech 3.0 Compatible, PIM coroutine support, Base libraries, Libraries
+@section PIM and Logitech 3.0 Compatible
+
+@c README.texi describes the additional PIM libraries.
+@c Copyright @copyright{} 2000-2020 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+These modules are provided to enable legacy Modula-2 applications to
+build with GNU Modula-2. It is advised that these module should not
+be used for new projects, maybe the ISO libraries or the native
+compiler PIM libraries (FIO) should be used instead.
+
+Here is an outline of the module layering:
+
+@example
+
+InOut  RealInOut  LongIO CardinalIO
+    \     |       |      /
+           Terminal
+-----------------------------------
+              |
+           Termbase
+           /      \
+    Keyboard      Display
+
+@end example
+
+Above the line are user level PIM [234] and Logitech 3.0 compatible
+modules.  Below the line Logitech 3.0 advised that these modules
+should be considered part of the runtime system. The libraries do
+not provide all the features found in the Logitech libraries as
+a number of these features were MS-DOS related. Essentially the
+basic input/output, file system, string manipulation and conversion
+routines are provided. Access to DOSCALL, graphics, time and date
+are not as these were constrained by the limitations of MS-DOS.
+
+The following libraries are contained within the base GNU Modula-2
+libraries and are also Logitech-3.0 compatible: @xref{gm2-libs/ASCII},
+@xref{gm2-libs/Storage} and @xref{gm2-libs/MathLib0}.  These libraries
+are always available for any dialect of the language (although their
+implementation and behaviour might differ, for example Storage ISO and
+PIM).
+
+The following libraries are Logitech-3.0 compatible but fall outside
+the base GNU Modula-2 libraries.
+@menu
+* gm2-libs-pim/BitBlockOps::BitBlockOps.def
+* gm2-libs-pim/BitByteOps::BitByteOps.def
+* gm2-libs-pim/BitWordOps::BitWordOps.def
+* gm2-libs-pim/BlockOps::BlockOps.def
+* gm2-libs-pim/Break::Break.def
+* gm2-libs-pim/CardinalIO::CardinalIO.def
+* gm2-libs-pim/Conversions::Conversions.def
+* gm2-libs-pim/DebugPMD::DebugPMD.def
+* gm2-libs-pim/DebugTrace::DebugTrace.def
+* gm2-libs-pim/Delay::Delay.def
+* gm2-libs-pim/Display::Display.def
+* gm2-libs-pim/ErrorCode::ErrorCode.def
+* gm2-libs-pim/FileSystem::FileSystem.def
+* gm2-libs-pim/FloatingUtilities::FloatingUtilities.def
+* gm2-libs-pim/InOut::InOut.def
+* gm2-libs-pim/Keyboard::Keyboard.def
+* gm2-libs-pim/LongIO::LongIO.def
+* gm2-libs-pim/NumberConversion::NumberConversion.def
+* gm2-libs-pim/Random::Random.def
+* gm2-libs-pim/RealConversions::RealConversions.def
+* gm2-libs-pim/RealInOut::RealInOut.def
+* gm2-libs-pim/Strings::Strings.def
+* gm2-libs-pim/Termbase::Termbase.def
+* gm2-libs-pim/Terminal::Terminal.def
+* gm2-libs-pim/TimeDate::TimeDate.def
+@end menu
+
+@node gm2-libs-pim/BitBlockOps, gm2-libs-pim/BitByteOps, , PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/BitBlockOps
+
+@example
+DEFINITION MODULE BitBlockOps ;
+
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   BlockAnd - performs a bitwise AND on blocks
+              [dest..dest+size-1] := [dest..dest+size-1] AND
+                                     [src..src+size-1]
+*)
+
+@findex BlockAnd
+PROCEDURE BlockAnd (dest, src: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   BlockOr - performs a bitwise OR on blocks
+             [dest..dest+size-1] := [dest..dest+size-1] OR
+                                    [src..src+size-1]
+*)
+
+@findex BlockOr
+PROCEDURE BlockOr (dest, src: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   BlockXor - performs a bitwise XOR on blocks
+              [dest..dest+size-1] := [dest..dest+size-1] XOR
+                                     [src..src+size-1]
+*)
+
+@findex BlockXor
+PROCEDURE BlockXor (dest, src: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   BlockNot - performs a bitsize NOT on the block as defined
+              by:  [dest..dest+size-1]
+*)
+
+@findex BlockNot
+PROCEDURE BlockNot (dest: ADDRESS; size: CARDINAL) ;
+
+
+(*
+   BlockShr - performs a block shift right of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is shifted, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness SHIFT use
+              the SYSTEM.SHIFT procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+@findex BlockShr
+PROCEDURE BlockShr (dest: ADDRESS; size, count: CARDINAL) ;
+
+
+(*
+   BlockShl - performs a block shift left of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is shifted, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness SHIFT use
+              the SYSTEM.SHIFT procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+@findex BlockShl
+PROCEDURE BlockShl (dest: ADDRESS; size, count: CARDINAL) ;
+
+
+(*
+   BlockRor - performs a block rotate right of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is rotated, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness ROTATE use
+              the SYSTEM.ROTATE procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+@findex BlockRor
+PROCEDURE BlockRor (dest: ADDRESS; size, count: CARDINAL) ;
+
+
+(*
+   BlockRol - performs a block rotate left of, count, bits.
+              Where the block is defined as:
+              [dest..dest+size-1].
+              The block is considered to be an ARRAY OF BYTEs
+              which is rotated, bit at a time over each byte in
+              turn.  The left most byte is considered the byte
+              located at the lowest address.
+              If you require an endianness ROTATE use
+              the SYSTEM.ROTATE procedure and declare the
+              block as a POINTER TO set type.
+*)
+
+@findex BlockRol
+PROCEDURE BlockRol (dest: ADDRESS; size, count: CARDINAL) ;
+
+
+END BitBlockOps.
+@end example
+@page
+
+@node gm2-libs-pim/BitByteOps, gm2-libs-pim/BitWordOps, gm2-libs-pim/BitBlockOps, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/BitByteOps
+
+@example
+DEFINITION MODULE BitByteOps ;
+
+FROM SYSTEM IMPORT BYTE ;
+
+
+(*
+   GetBits - returns the bits firstBit..lastBit from source.
+             Bit 0 of byte maps onto the firstBit of source.
+*)
+
+@findex GetBits
+PROCEDURE GetBits (source: BYTE; firstBit, lastBit: CARDINAL) : BYTE ;
+
+
+(*
+   SetBits - sets bits in, byte, starting at, firstBit, and ending at,
+             lastBit, with, pattern.  The bit zero of, pattern, will
+             be placed into, byte, at position, firstBit.
+*)
+
+@findex SetBits
+PROCEDURE SetBits (VAR byte: BYTE; firstBit, lastBit: CARDINAL;
+                   pattern: BYTE) ;
+
+
+(*
+   ByteAnd - returns a bitwise (left AND right)
+*)
+
+@findex ByteAnd
+PROCEDURE ByteAnd (left, right: BYTE) : BYTE ;
+
+
+(*
+   ByteOr - returns a bitwise (left OR right)
+*)
+
+@findex ByteOr
+PROCEDURE ByteOr (left, right: BYTE) : BYTE ;
+
+
+(*
+   ByteXor - returns a bitwise (left XOR right)
+*)
+
+@findex ByteXor
+PROCEDURE ByteXor (left, right: BYTE) : BYTE ;
+
+
+(*
+   ByteNot - returns a byte with all bits inverted.
+*)
+
+@findex ByteNot
+PROCEDURE ByteNot (byte: BYTE) : BYTE ;
+
+
+(*
+   ByteShr - returns a, byte, which has been shifted, count
+             bits to the right.
+*)
+
+@findex ByteShr
+PROCEDURE ByteShr (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   ByteShl - returns a, byte, which has been shifted, count
+             bits to the left.
+*)
+
+@findex ByteShl
+PROCEDURE ByteShl (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   ByteSar - shift byte arthemetic right.  Preserves the top
+             end bit and as the value is shifted right.
+*)
+
+@findex ByteSar
+PROCEDURE ByteSar (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   ByteRor - returns a, byte, which has been rotated, count
+             bits to the right.
+*)
+
+@findex ByteRor
+PROCEDURE ByteRor (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   ByteRol - returns a, byte, which has been rotated, count
+             bits to the left.
+*)
+
+@findex ByteRol
+PROCEDURE ByteRol (byte: BYTE; count: CARDINAL) : BYTE ;
+
+
+(*
+   HighNibble - returns the top nibble only from, byte.
+                The top nibble of, byte, is extracted and
+                returned in the bottom nibble of the return
+                value.
+*)
+
+@findex HighNibble
+PROCEDURE HighNibble (byte: BYTE) : BYTE ;
+
+
+(*
+   LowNibble - returns the low nibble only from, byte.
+               The top nibble is replaced by zeros.
+*)
+
+@findex LowNibble
+PROCEDURE LowNibble (byte: BYTE) : BYTE ;
+
+
+(*
+   Swap - swaps the low and high nibbles in the, byte.
+*)
+
+@findex Swap
+PROCEDURE Swap (byte: BYTE) : BYTE ;
+
+
+END BitByteOps.
+@end example
+@page
+
+@node gm2-libs-pim/BitWordOps, gm2-libs-pim/BlockOps, gm2-libs-pim/BitByteOps, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/BitWordOps
+
+@example
+DEFINITION MODULE BitWordOps ;
+
+FROM SYSTEM IMPORT WORD ;
+
+
+(*
+   GetBits - returns the bits firstBit..lastBit from source.
+             Bit 0 of word maps onto the firstBit of source.
+*)
+
+@findex GetBits
+PROCEDURE GetBits (source: WORD; firstBit, lastBit: CARDINAL) : WORD ;
+
+
+(*
+   SetBits - sets bits in, word, starting at, firstBit, and ending at,
+             lastBit, with, pattern.  The bit zero of, pattern, will
+             be placed into, word, at position, firstBit.
+*)
+
+@findex SetBits
+PROCEDURE SetBits (VAR word: WORD; firstBit, lastBit: CARDINAL;
+                   pattern: WORD) ;
+
+
+(*
+   WordAnd - returns a bitwise (left AND right)
+*)
+
+@findex WordAnd
+PROCEDURE WordAnd (left, right: WORD) : WORD ;
+
+
+(*
+   WordOr - returns a bitwise (left OR right)
+*)
+
+@findex WordOr
+PROCEDURE WordOr (left, right: WORD) : WORD ;
+
+
+(*
+   WordXor - returns a bitwise (left XOR right)
+*)
+
+@findex WordXor
+PROCEDURE WordXor (left, right: WORD) : WORD ;
+
+
+(*
+   WordNot - returns a word with all bits inverted.
+*)
+
+@findex WordNot
+PROCEDURE WordNot (word: WORD) : WORD ;
+
+
+(*
+   WordShr - returns a, word, which has been shifted, count
+             bits to the right.
+*)
+
+@findex WordShr
+PROCEDURE WordShr (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   WordShl - returns a, word, which has been shifted, count
+             bits to the left.
+*)
+
+@findex WordShl
+PROCEDURE WordShl (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   WordSar - shift word arthemetic right.  Preserves the top
+             end bit and as the value is shifted right.
+*)
+
+@findex WordSar
+PROCEDURE WordSar (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   WordRor - returns a, word, which has been rotated, count
+             bits to the right.
+*)
+
+@findex WordRor
+PROCEDURE WordRor (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   WordRol - returns a, word, which has been rotated, count
+             bits to the left.
+*)
+
+@findex WordRol
+PROCEDURE WordRol (word: WORD; count: CARDINAL) : WORD ;
+
+
+(*
+   HighByte - returns the top byte only from, word.
+              The byte is returned in the bottom byte
+              in the return value.
+*)
+
+@findex HighByte
+PROCEDURE HighByte (word: WORD) : WORD ;
+
+
+(*
+   LowByte - returns the low byte only from, word.
+             The byte is returned in the bottom byte
+             in the return value.
+*)
+
+@findex LowByte
+PROCEDURE LowByte (word: WORD) : WORD ;
+
+
+(*
+   Swap - byte flips the contents of word.
+*)
+
+@findex Swap
+PROCEDURE Swap (word: WORD) : WORD ;
+
+
+END BitWordOps.
+@end example
+@page
+
+@node gm2-libs-pim/BlockOps, gm2-libs-pim/Break, gm2-libs-pim/BitWordOps, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/BlockOps
+
+@example
+DEFINITION MODULE BlockOps ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(*
+   MoveBlockForward - moves, n, bytes from, src, to, dest.
+                      Starts copying from src and keep copying
+                      until, n, bytes have been copied.
+*)
+
+@findex BlockMoveForward
+PROCEDURE BlockMoveForward (dest, src: ADDRESS; n: CARDINAL) ;
+
+
+(*
+   MoveBlockBackward - moves, n, bytes from, src, to, dest.
+                       Starts copying from src+n and keeps copying
+                       until, n, bytes have been copied.
+                       The last datum to be copied will be the byte
+                       at address, src.
+*)
+
+@findex BlockMoveBackward
+PROCEDURE BlockMoveBackward (dest, src: ADDRESS; n: CARDINAL) ;
+
+
+(*
+   BlockClear - fills, block..block+n-1, with zero's.
+*)
+
+@findex BlockClear
+PROCEDURE BlockClear (block: ADDRESS; n: CARDINAL) ;
+
+
+(*
+   BlockSet - fills, n, bytes starting at, block, with a pattern
+              defined at address pattern..pattern+patternSize-1.
+*)
+
+@findex BlockSet
+PROCEDURE BlockSet (block: ADDRESS; n: CARDINAL;
+                    pattern: ADDRESS; patternSize: CARDINAL) ;
+
+
+(*
+   BlockEqual - returns TRUE if the blocks defined, a..a+n-1, and,
+                b..b+n-1 contain the same bytes.
+*)
+
+@findex BlockEqual
+PROCEDURE BlockEqual (a, b: ADDRESS; n: CARDINAL) : BOOLEAN ;
+
+
+(*
+   BlockPosition - searches for a pattern as defined by
+                   pattern..patternSize-1 in the block,
+                   block..block+blockSize-1.  It returns
+                   the offset from block indicating the
+                   first occurence of, pattern.
+                   MAX(CARDINAL) is returned if no match
+                   is detected.
+*)
+
+@findex BlockPosition
+PROCEDURE BlockPosition (block: ADDRESS; blockSize: CARDINAL;
+                         pattern: ADDRESS; patternSize: CARDINAL) : CARDINAL ;
+
+
+END BlockOps.
+@end example
+@page
+
+@node gm2-libs-pim/Break, gm2-libs-pim/CardinalIO, gm2-libs-pim/BlockOps, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Break
+
+@example
+DEFINITION MODULE Break ;
+
+
+EXPORT QUALIFIED EnableBreak, DisableBreak, InstallBreak, UnInstallBreak ;
+
+
+(*
+   EnableBreak - enable the current break handler.
+*)
+
+@findex EnableBreak
+PROCEDURE EnableBreak ;
+
+
+(*
+   DisableBreak - disable the current break handler (and all
+                  installed handlers).
+*)
+
+@findex DisableBreak
+PROCEDURE DisableBreak ;
+
+
+(*
+   InstallBreak - installs a procedure, p, to be invoked when
+                  a ctrl-c is caught. Any number of these
+                  procedures may be stacked. Only the top
+                  procedure is run when ctrl-c is caught.
+*)
+
+@findex InstallBreak
+PROCEDURE InstallBreak (p: PROC) ;
+
+
+(*
+   UnInstallBreak - pops the break handler stack.
+*)
+
+@findex UnInstallBreak
+PROCEDURE UnInstallBreak ;
+
+
+END Break.
+@end example
+@page
+
+@node gm2-libs-pim/CardinalIO, gm2-libs-pim/Conversions, gm2-libs-pim/Break, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/CardinalIO
+
+@example
+DEFINITION MODULE CardinalIO ;
+
+EXPORT QUALIFIED Done,
+                 ReadCardinal, WriteCardinal, ReadHex, WriteHex,
+                 ReadLongCardinal, WriteLongCardinal, ReadLongHex,
+                 WriteLongHex,
+                 ReadShortCardinal, WriteShortCardinal, ReadShortHex,
+                 WriteShortHex ;
+
+
+VAR
+@findex Done (var)
+   Done: BOOLEAN ;
+
+
+(*
+   ReadCardinal - read an unsigned decimal number from the terminal.
+                  The read continues until a space, newline, esc or
+                  end of file is reached.
+*)
+
+@findex ReadCardinal
+PROCEDURE ReadCardinal (VAR c: CARDINAL) ;
+
+
+(*
+   WriteCardinal - writes the value, c, to the terminal and ensures
+                   that at least, n, characters are written. The number
+                   will be padded out by preceeding spaces if necessary.
+*)
+
+@findex WriteCardinal
+PROCEDURE WriteCardinal (c: CARDINAL; n: CARDINAL) ;
+
+
+(*
+   ReadHex - reads in an unsigned hexadecimal number from the terminal.
+             The read continues until a space, newline, esc or
+             end of file is reached.
+*)
+
+@findex ReadHex
+PROCEDURE ReadHex (VAR c: CARDINAL) ;
+
+
+(*
+   WriteHex - writes out a CARDINAL, c, in hexadecimal format padding
+              with, n, characters (leading with '0')
+*)
+
+@findex WriteHex
+PROCEDURE WriteHex (c: CARDINAL; n: CARDINAL) ;
+
+
+(*
+   ReadLongCardinal - read an unsigned decimal number from the terminal.
+                      The read continues until a space, newline, esc or
+                      end of file is reached.
+*)
+
+@findex ReadLongCardinal
+PROCEDURE ReadLongCardinal (VAR c: LONGCARD) ;
+
+
+(*
+   WriteLongCardinal - writes the value, c, to the terminal and ensures
+                       that at least, n, characters are written. The number
+                       will be padded out by preceeding spaces if necessary.
+*)
+
+@findex WriteLongCardinal
+PROCEDURE WriteLongCardinal (c: LONGCARD; n: CARDINAL) ;
+
+
+(*
+   ReadLongHex - reads in an unsigned hexadecimal number from the terminal.
+                 The read continues until a space, newline, esc or
+                 end of file is reached.
+*)
+
+@findex ReadLongHex
+PROCEDURE ReadLongHex (VAR c: LONGCARD) ;
+
+
+(*
+   WriteLongHex - writes out a LONGCARD, c, in hexadecimal format padding
+                  with, n, characters (leading with '0')
+*)
+
+@findex WriteLongHex
+PROCEDURE WriteLongHex (c: LONGCARD; n: CARDINAL) ;
+
+
+(*
+   WriteShortCardinal - writes the value, c, to the terminal and ensures
+                       that at least, n, characters are written. The number
+                       will be padded out by preceeding spaces if necessary.
+*)
+
+@findex WriteShortCardinal
+PROCEDURE WriteShortCardinal (c: SHORTCARD; n: CARDINAL) ;
+
+
+(*
+   ReadShortCardinal - read an unsigned decimal number from the terminal.
+                       The read continues until a space, newline, esc or
+                       end of file is reached.
+*)
+
+@findex ReadShortCardinal
+PROCEDURE ReadShortCardinal (VAR c: SHORTCARD) ;
+
+
+(*
+   ReadShortHex - reads in an unsigned hexadecimal number from the terminal.
+                 The read continues until a space, newline, esc or
+                 end of file is reached.
+*)
+
+@findex ReadShortHex
+PROCEDURE ReadShortHex (VAR c: SHORTCARD) ;
+
+
+(*
+   WriteShortHex - writes out a SHORTCARD, c, in hexadecimal format padding
+                  with, n, characters (leading with '0')
+*)
+
+@findex WriteShortHex
+PROCEDURE WriteShortHex (c: SHORTCARD; n: CARDINAL) ;
+
+
+END CardinalIO.
+@end example
+@page
+
+@node gm2-libs-pim/Conversions, gm2-libs-pim/DebugPMD, gm2-libs-pim/CardinalIO, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Conversions
+
+@example
+DEFINITION MODULE Conversions ;
+
+EXPORT QUALIFIED ConvertOctal, ConvertHex, ConvertCardinal,
+                 ConvertInteger, ConvertLongInt, ConvertShortInt ;
+
+(*
+   ConvertOctal - converts a CARDINAL, num, into an octal/hex/decimal
+                  string and right justifies the string. It adds
+                  spaces rather than '0' to pad out the string
+                  to len characters.
+
+                  If the length of str is < num then the number is
+                  truncated on the right.
+*)
+
+@findex ConvertOctal
+PROCEDURE ConvertOctal    (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+@findex ConvertHex
+PROCEDURE ConvertHex      (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+@findex ConvertCardinal
+PROCEDURE ConvertCardinal (num, len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+
+(*
+   The INTEGER counterparts will add a '-' if, num, is <0
+*)
+
+@findex ConvertInteger
+PROCEDURE ConvertInteger  (num: INTEGER; len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+@findex ConvertLongInt
+PROCEDURE ConvertLongInt  (num: LONGINT; len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+@findex ConvertShortInt
+PROCEDURE ConvertShortInt (num: SHORTINT; len: CARDINAL; VAR str: ARRAY OF CHAR) ;
+
+
+END Conversions.
+@end example
+@page
+
+@node gm2-libs-pim/DebugPMD, gm2-libs-pim/DebugTrace, gm2-libs-pim/Conversions, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/DebugPMD
+
+@example
+DEFINITION MODULE DebugPMD ;
+
+END DebugPMD.
+@end example
+@page
+
+@node gm2-libs-pim/DebugTrace, gm2-libs-pim/Delay, gm2-libs-pim/DebugPMD, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/DebugTrace
+
+@example
+DEFINITION MODULE DebugTrace ;
+
+END DebugTrace.
+@end example
+@page
+
+@node gm2-libs-pim/Delay, gm2-libs-pim/Display, gm2-libs-pim/DebugTrace, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Delay
+
+@example
+DEFINITION MODULE Delay ;
+
+EXPORT QUALIFIED Delay ;
+
+
+(*
+   milliSec - delays the program by approximately, milliSec, milliseconds.
+*)
+
+@findex Delay
+PROCEDURE Delay (milliSec: INTEGER) ;
+
+
+END Delay.
+@end example
+@page
+
+@node gm2-libs-pim/Display, gm2-libs-pim/ErrorCode, gm2-libs-pim/Delay, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Display
+
+@example
+DEFINITION MODULE Display ;
+
+EXPORT QUALIFIED Write ;
+
+
+(*
+   Write - display a character to the stdout.
+           ASCII.EOL moves to the beginning of the next line.
+           ASCII.del erases the character to the left of the cursor.
+*)
+
+@findex Write
+PROCEDURE Write (ch: CHAR) ;
+
+
+END Display.
+@end example
+@page
+
+@node gm2-libs-pim/ErrorCode, gm2-libs-pim/FileSystem, gm2-libs-pim/Display, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/ErrorCode
+
+@example
+DEFINITION MODULE ErrorCode ;
+
+EXPORT QUALIFIED SetErrorCode, GetErrorCode, ExitToOS ;
+
+
+(*
+   SetErrorCode - sets the exit value which will be used if
+                  the application terminates normally.
+*)
+
+@findex SetErrorCode
+PROCEDURE SetErrorCode (value: INTEGER) ;
+
+
+(*
+   GetErrorCode - returns the current value to be used upon
+                  application termination.
+*)
+
+@findex GetErrorCode
+PROCEDURE GetErrorCode (VAR value: INTEGER) ;
+
+
+(*
+   ExitToOS - terminate the application and exit returning
+              the last value set by SetErrorCode to the OS.
+*)
+
+@findex ExitToOS
+PROCEDURE ExitToOS ;
+
+
+END ErrorCode.
+@end example
+@page
+
+@node gm2-libs-pim/FileSystem, gm2-libs-pim/FloatingUtilities, gm2-libs-pim/ErrorCode, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/FileSystem
+
+@example
+DEFINITION MODULE FileSystem ;
+
+(*  Use this module sparingly, FIO or the ISO file modules have a
+    much cleaner interface.  *)
+
+FROM SYSTEM IMPORT WORD, BYTE, ADDRESS ;
+IMPORT FIO ;
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED File, Response, Flag, FlagSet,
+
+                 Create, Close, Lookup, Rename, Delete,
+                 SetRead, SetWrite, SetModify, SetOpen,
+                 Doio, SetPos, GetPos, Length, Reset,
+
+                 ReadWord, ReadChar, ReadByte, ReadNBytes,
+                 WriteWord, WriteChar, WriteByte, WriteNBytes ;
+
+TYPE
+@findex File (type)
+   File = RECORD
+             res     : Response ;
+             flags   : FlagSet ;
+             eof     : BOOLEAN ;
+             lastWord: WORD ;
+             lastByte: BYTE ;
+             fio     : FIO.File ;
+             highpos,
+             lowpos  : CARDINAL ;
+             name    : String ;
+@findex END (type)
+          END ;
+
+@findex Flag (type)
+   Flag = (
+           read,        (* read access mode *)
+           write,       (* write access mode *)
+           modify,
+           truncate,    (* truncate file when closed *)
+           again,       (* reread the last character *)
+           temporary,   (* file is temporary *)
+           opened       (* file has been opened *)
+          );
+
+@findex FlagSet (type)
+   FlagSet = SET OF Flag;
+
+@findex Response (type)
+   Response = (done, notdone, notsupported, callerror,
+               unknownfile, paramerror, toomanyfiles,
+@findex userdeverror) (type)
+               userdeverror) ;
+
+@findex Command (type)
+   Command = (create, close, lookup, rename, delete,
+              setread, setwrite, setmodify, setopen,
+              doio, setpos, getpos, length) ;
+
+
+(*
+   Create - creates a temporary file. To make the file perminant
+            the file must be renamed.
+*)
+
+@findex Create
+PROCEDURE Create (VAR f: File) ;
+
+
+(*
+   Close - closes an open file.
+*)
+
+@findex Close
+PROCEDURE Close (f: File) ;
+
+
+(*
+   Lookup - looks for a file, filename. If the file is found
+            then, f, is opened. If it is not found and, newFile,
+            is TRUE then a new file is created and attached to, f.
+            If, newFile, is FALSE and no file was found then f.res
+            is set to notdone.
+*)
+
+@findex Lookup
+PROCEDURE Lookup (VAR f: File; filename: ARRAY OF CHAR; newFile: BOOLEAN) ;
+
+
+(*
+   Rename - rename a file and change a temporary file to a permanent
+            file. f.res is set appropriately.
+*)
+
+@findex Rename
+PROCEDURE Rename (VAR f: File; newname: ARRAY OF CHAR) ;
+
+
+(*
+   Delete - deletes a file, name, and sets the f.res field.
+            f.res is set appropriately.
+*)
+
+@findex Delete
+PROCEDURE Delete (name: ARRAY OF CHAR; VAR f: File) ;
+
+
+(*
+   ReadWord - reads a WORD, w, from file, f.
+              f.res is set appropriately.
+*)
+
+@findex ReadWord
+PROCEDURE ReadWord (VAR f: File; VAR w: WORD) ;
+
+
+(*
+   WriteWord - writes one word to a file, f.
+               f.res is set appropriately.
+*)
+
+@findex WriteWord
+PROCEDURE WriteWord (VAR f: File; w: WORD) ;
+
+
+(*
+   ReadChar - reads one character from a file, f.
+*)
+
+@findex ReadChar
+PROCEDURE ReadChar (VAR f: File; VAR ch: CHAR) ;
+
+
+(*
+   WriteChar - writes a character, ch, to a file, f.
+               f.res is set appropriately.
+*)
+
+@findex WriteChar
+PROCEDURE WriteChar (VAR f: File; ch: CHAR) ;
+
+
+(*
+   ReadByte - reads a BYTE, b, from file, f.
+              f.res is set appropriately.
+*)
+
+@findex ReadByte
+PROCEDURE ReadByte (VAR f: File; VAR b: BYTE) ;
+
+
+(*
+   WriteByte - writes one BYTE, b, to a file, f.
+               f.res is set appropriately.
+*)
+
+@findex WriteByte
+PROCEDURE WriteByte (VAR f: File; b: BYTE) ;
+
+
+(*
+   ReadNBytes - reads a sequence of bytes from a file, f.
+*)
+
+@findex ReadNBytes
+PROCEDURE ReadNBytes (VAR f: File; a: ADDRESS; amount: CARDINAL;
+                      VAR actuallyRead: CARDINAL) ;
+
+
+(*
+   WriteNBytes - writes a sequence of bytes to file, f.
+*)
+
+@findex WriteNBytes
+PROCEDURE WriteNBytes (VAR f: File; a: ADDRESS; amount: CARDINAL;
+                       VAR actuallyWritten: CARDINAL) ;
+
+
+(*
+   Again - returns the last character read to the internal buffer
+           so that it can be read again.
+*)
+
+@findex Again
+PROCEDURE Again (VAR f: File) ;
+
+
+(*
+   SetRead - puts the file, f, into the read state.
+             The file position is unchanged.
+*)
+
+@findex SetRead
+PROCEDURE SetRead (VAR f: File) ;
+
+
+(*
+   SetWrite - puts the file, f, into the write state.
+              The file position is unchanged.
+*)
+
+@findex SetWrite
+PROCEDURE SetWrite (VAR f: File) ;
+
+
+(*
+   SetModify - puts the file, f, into the modify state.
+               The file position is unchanged but the file can be
+               read and written.
+*)
+
+@findex SetModify
+PROCEDURE SetModify (VAR f: File) ;
+
+
+(*
+   SetOpen - places a file, f, into the open state. The file may
+             have been in the read/write/modify state before and
+             in which case the previous buffer contents are flushed
+             and the file state is reset to open. The position is
+             unaltered.
+*)
+
+@findex SetOpen
+PROCEDURE SetOpen (VAR f: File) ;
+
+
+(*
+   Reset - places a file, f, into the open state and reset the
+           position to the start of the file.
+*)
+
+@findex Reset
+PROCEDURE Reset (VAR f: File) ;
+
+
+(*
+   SetPos - lseek to a position within a file.
+*)
+
+@findex SetPos
+PROCEDURE SetPos (VAR f: File; high, low: CARDINAL) ;
+
+
+(*
+   GetPos - return the position within a file.
+*)
+
+@findex GetPos
+PROCEDURE GetPos (VAR f: File; VAR high, low: CARDINAL) ;
+
+
+(*
+   Length - returns the length of file, in, high, and, low.
+*)
+
+@findex Length
+PROCEDURE Length (VAR f: File; VAR high, low: CARDINAL) ;
+
+
+(*
+   Doio - effectively flushes a file in write mode, rereads the
+          current buffer from disk if in read mode and writes
+          and rereads the buffer if in modify mode.
+*)
+
+@findex Doio
+PROCEDURE Doio (VAR f: File) ;
+
+
+(*
+   FileNameChar - checks to see whether the character, ch, is
+                  legal in a filename. nul is returned if the
+                  character was illegal.
+*)
+
+@findex FileNameChar
+PROCEDURE FileNameChar (ch: CHAR) ;
+
+
+END FileSystem.
+@end example
+@page
+
+@node gm2-libs-pim/FloatingUtilities, gm2-libs-pim/InOut, gm2-libs-pim/FileSystem, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/FloatingUtilities
+
+@example
+DEFINITION MODULE FloatingUtilities ;
+
+EXPORT QUALIFIED Frac, Round, Float, Trunc,
+                 Fracl, Roundl, Floatl, Truncl ;
+
+
+(*
+   Frac - returns the fractional component of, r.
+*)
+
+@findex Frac
+PROCEDURE Frac (r: REAL) : REAL ;
+
+
+(*
+   Int - returns the integer part of r. It rounds the value towards zero.
+*)
+
+@findex Int
+PROCEDURE Int (r: REAL) : INTEGER ;
+
+
+(*
+   Round - returns the number rounded to the nearest integer.
+*)
+
+@findex Round
+PROCEDURE Round (r: REAL) : INTEGER ;
+
+
+(*
+   Float - returns a REAL value corresponding to, i.
+*)
+
+@findex Float
+PROCEDURE Float (i: INTEGER) : REAL ;
+
+
+(*
+   Trunc - round to the nearest integer not larger in absolute
+           value.
+*)
+
+@findex Trunc
+PROCEDURE Trunc (r: REAL) : INTEGER ;
+
+
+(*
+   Fracl - returns the fractional component of, r.
+*)
+
+@findex Fracl
+PROCEDURE Fracl (r: LONGREAL) : LONGREAL ;
+
+
+(*
+   Intl - returns the integer part of r. It rounds the value towards zero.
+*)
+
+@findex Intl
+PROCEDURE Intl (r: LONGREAL) : LONGINT ;
+
+
+(*
+   Roundl - returns the number rounded to the nearest integer.
+*)
+
+@findex Roundl
+PROCEDURE Roundl (r: LONGREAL) : LONGINT ;
+
+
+(*
+   Floatl - returns a REAL value corresponding to, i.
+*)
+
+@findex Floatl
+PROCEDURE Floatl (i: INTEGER) : LONGREAL ;
+
+
+(*
+   Truncl - round to the nearest integer not larger in absolute
+            value.
+*)
+
+@findex Truncl
+PROCEDURE Truncl (r: LONGREAL) : LONGINT ;
+
+
+END FloatingUtilities.
+@end example
+@page
+
+@node gm2-libs-pim/InOut, gm2-libs-pim/Keyboard, gm2-libs-pim/FloatingUtilities, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/InOut
+
+@example
+DEFINITION MODULE InOut ;
+
+IMPORT ASCII ;
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED EOL, Done, termCH, OpenInput, OpenOutput,
+                 CloseInput, CloseOutput,
+                 Read, ReadString, ReadInt, ReadCard,
+                 Write, WriteLn, WriteString, WriteInt, WriteCard,
+                 WriteOct, WriteHex,
+                 ReadS, WriteS ;
+
+CONST
+@findex EOL (const)
+   EOL = ASCII.EOL ;
+
+VAR
+@findex Done (var)
+   Done  : BOOLEAN ;
+@findex termCH (var)
+   termCH: CHAR ;
+
+
+(*
+   OpenInput - reads a string from stdin as the filename for reading.
+               If the filename ends with `.' then it appends the defext
+               extension. The global variable Done is set if all
+               was successful.
+*)
+
+@findex OpenInput
+PROCEDURE OpenInput (defext: ARRAY OF CHAR) ;
+
+
+(*
+   CloseInput - closes an opened input file and returns input back to
+                StdIn.
+*)
+
+@findex CloseInput
+PROCEDURE CloseInput ;
+
+
+(*
+   OpenOutput - reads a string from stdin as the filename for writing.
+                If the filename ends with `.' then it appends the defext
+                extension. The global variable Done is set if all
+                was successful.
+*)
+
+@findex OpenOutput
+PROCEDURE OpenOutput (defext: ARRAY OF CHAR) ;
+
+
+(*
+   CloseOutput - closes an opened output file and returns output back to
+                 StdOut.
+*)
+
+@findex CloseOutput
+PROCEDURE CloseOutput ;
+
+
+(*
+   Read - reads a single character from the current input file.
+          Done is set to FALSE if end of file is reached or an
+          error occurs.
+*)
+
+@findex Read
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   ReadString - reads a sequence of characters. Leading white space
+                is ignored and the string is terminated with a character
+                <= ' '
+*)
+
+@findex ReadString
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+
+
+(*
+   WriteString - writes a string to the output file.
+*)
+
+@findex WriteString
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+
+
+(*
+   Write - writes out a single character, ch, to the current output file.
+*)
+
+@findex Write
+PROCEDURE Write (ch: CHAR) ;
+
+
+(*
+   WriteLn - writes a newline to the output file.
+*)
+
+@findex WriteLn
+PROCEDURE WriteLn ;
+
+
+(*
+   ReadInt - reads a string and converts it into an INTEGER, x.
+             Done is set if an INTEGER is read.
+*)
+
+@findex ReadInt
+PROCEDURE ReadInt (VAR x: INTEGER) ;
+
+
+(*
+   ReadInt - reads a string and converts it into an INTEGER, x.
+             Done is set if an INTEGER is read.
+*)
+
+@findex ReadCard
+PROCEDURE ReadCard (VAR x: CARDINAL) ;
+
+
+(*
+   WriteCard - writes the CARDINAL, x, to the output file. It ensures
+               that the number occupies, n, characters. Leading spaces
+               are added if required.
+*)
+
+@findex WriteCard
+PROCEDURE WriteCard (x, n: CARDINAL) ;
+
+
+(*
+   WriteInt - writes the INTEGER, x, to the output file. It ensures
+              that the number occupies, n, characters. Leading spaces
+              are added if required.
+*)
+
+@findex WriteInt
+PROCEDURE WriteInt (x: INTEGER; n: CARDINAL) ;
+
+
+(*
+   WriteOct - writes the CARDINAL, x, to the output file in octal.
+              It ensures that the number occupies, n, characters.
+              Leading spaces are added if required.
+*)
+
+@findex WriteOct
+PROCEDURE WriteOct (x, n: CARDINAL) ;
+
+
+(*
+   WriteHex - writes the CARDINAL, x, to the output file in hexadecimal.
+              It ensures that the number occupies, n, characters.
+              Leading spaces are added if required.
+*)
+
+@findex WriteHex
+PROCEDURE WriteHex (x, n: CARDINAL) ;
+
+
+(*
+   ReadS - returns a string which has is a sequence of characters.
+           Leading white space is ignored and string is terminated
+           with a character <= ' '.
+*)
+
+@findex ReadS
+PROCEDURE ReadS () : String ;
+
+
+(*
+   WriteS - writes a String to the output device.
+            It returns the string, s.
+*)
+
+@findex WriteS
+PROCEDURE WriteS (s: String) : String ;
+
+
+END InOut.
+@end example
+@page
+
+@node gm2-libs-pim/Keyboard, gm2-libs-pim/LongIO, gm2-libs-pim/InOut, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Keyboard
+
+@example
+DEFINITION MODULE Keyboard ;
+
+EXPORT QUALIFIED Read, KeyPressed ;
+
+
+(*
+   Read - reads a character from StdIn. If necessary it will wait
+          for a key to become present on StdIn.
+*)
+
+@findex Read
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   KeyPressed - returns TRUE if a character can be read from StdIn
+                without blocking the caller.
+*)
+
+@findex KeyPressed
+PROCEDURE KeyPressed () : BOOLEAN ;
+
+
+END Keyboard.
+@end example
+@page
+
+@node gm2-libs-pim/LongIO, gm2-libs-pim/NumberConversion, gm2-libs-pim/Keyboard, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/LongIO
+
+@example
+DEFINITION MODULE LongIO ;
+
+EXPORT QUALIFIED Done, ReadLongInt, WriteLongInt ;
+
+VAR
+@findex Done (var)
+   Done: BOOLEAN ;
+
+@findex ReadLongInt
+PROCEDURE ReadLongInt (VAR i: LONGINT) ;
+@findex WriteLongInt
+PROCEDURE WriteLongInt (i: LONGINT; n: CARDINAL) ;
+
+
+END LongIO.
+@end example
+@page
+
+@node gm2-libs-pim/NumberConversion, gm2-libs-pim/Random, gm2-libs-pim/LongIO, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/NumberConversion
+
+@example
+DEFINITION MODULE NumberConversion ;
+
+(* --fixme-- finish this.  *)
+
+END NumberConversion.
+@end example
+@page
+
+@node gm2-libs-pim/Random, gm2-libs-pim/RealConversions, gm2-libs-pim/NumberConversion, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Random
+
+@example
+DEFINITION MODULE Random ;
+
+FROM SYSTEM IMPORT BYTE ;
+EXPORT QUALIFIED Randomize, RandomInit, RandomBytes, RandomCard, RandomInt, RandomReal, RandomLongReal ;
+
+
+(*
+   Randomize - initialize the random number generator with a seed
+               based on the microseconds.
+*)
+
+@findex Randomize
+PROCEDURE Randomize ;
+
+
+(*
+   RandomInit - initialize the random number generator with value, seed.
+*)
+
+@findex RandomInit
+PROCEDURE RandomInit (seed: CARDINAL) ;
+
+
+(*
+   RandomBytes - fills in an array with random values.
+*)
+
+@findex RandomBytes
+PROCEDURE RandomBytes (VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   RandomInt - return an INTEGER in the range 0..bound-1
+*)
+
+@findex RandomInt
+PROCEDURE RandomInt (bound: INTEGER) : INTEGER ;
+
+
+(*
+   RandomCard - return a CARDINAL in the range 0..bound-1
+*)
+
+@findex RandomCard
+PROCEDURE RandomCard (bound: CARDINAL) : CARDINAL ;
+
+
+(*
+   RandomReal - return a REAL number in the range 0.0..1.0
+*)
+
+@findex RandomReal
+PROCEDURE RandomReal () : REAL ;
+
+
+(*
+   RandomLongReal - return a LONGREAL number in the range 0.0..1.0
+*)
+
+@findex RandomLongReal
+PROCEDURE RandomLongReal () : LONGREAL ;
+
+
+END Random.
+@end example
+@page
+
+@node gm2-libs-pim/RealConversions, gm2-libs-pim/RealInOut, gm2-libs-pim/Random, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/RealConversions
+
+@example
+DEFINITION MODULE RealConversions ;
+
+EXPORT QUALIFIED SetNoOfExponentDigits,
+                 RealToString, StringToReal,
+                 LongRealToString, StringToLongReal ;
+
+
+(*
+   SetNoOfExponentDigits - sets the number of exponent digits to be
+                           used during future calls of LongRealToString
+                           and RealToString providing that the width
+                           is sufficient.
+                           If this value is set to 0 (the default) then
+                           the number digits used is the minimum necessary.
+*)
+
+@findex SetNoOfExponentDigits
+PROCEDURE SetNoOfExponentDigits (places: CARDINAL) ;
+
+
+(*
+   RealToString - converts a real, r, into a right justified string, str.
+                  The number of digits to the right of the decimal point
+                  is given in, digits.  The value, width, represents the
+                  maximum number of characters to be used in the string,
+                  str.
+
+                  If digits is negative then exponent notation is used
+                  whereas if digits is positive then fixed point notation
+                  is used.
+
+                  If, r, is less than 0.0 then a '-' preceeds the value,
+                  str.  However, if, r, is >= 0.0 a '+' is not added.
+
+                  If the conversion of, r, to a string requires more
+                  than, width, characters then the string, str, is set
+                  to a nul string and, ok is assigned FALSE.
+
+                  For fixed point notation the minimum width required is
+                  ABS(width)+8
+
+                  For exponent notation the minimum width required is
+                  ABS(digits)+2+log10(magnitude).
+
+                  if r is a NaN then the string 'nan' is returned formatted and
+                  ok will be FALSE.
+*)
+
+@findex RealToString
+PROCEDURE RealToString (r: REAL; digits, width: INTEGER;
+                        VAR str: ARRAY OF CHAR; VAR ok: BOOLEAN) ;
+
+
+(*
+   LongRealToString - converts a real, r, into a right justified string, str.
+                      The number of digits to the right of the decimal point
+                      is given in, digits. The value, width, represents the
+                      maximum number of characters to be used in the string,
+                      str.
+
+                      If digits is negative then exponent notation is used
+                      whereas if digits is positive then fixed point notation
+                      is used.
+
+                      If, r, is less than 0.0 then a '-' preceeds the value,
+                      str. However, if, r, is >= 0.0 a '+' is not added.
+
+                      If the conversion of, r, to a string requires more
+                      than, width, characters then the string, str, is set
+                      to a nul string and, ok is assigned FALSE.
+
+                      For fixed point notation the minimum width required is
+                      ABS(width)+8
+
+                      For exponent notation the minimum width required is
+                      ABS(digits)+2+log10(magnitude).
+
+                      Examples:
+                      RealToString(100.0, 10, 10, a, ok)       ->  '100.000000'
+                      RealToString(100.0, -5, 12, a, ok)       ->  '  1.00000E+2'
+
+                      RealToString(123.456789, 10, 10, a, ok)  ->  '123.456789'
+                      RealToString(123.456789, -5, 13, a, ok)  ->  '    1.23456E+2'
+
+                      RealToString(123.456789, -2, 15, a, ok)  ->  '          1.23E+2'
+
+                      if r is a NaN then the string 'nan' is returned formatted and
+                      ok will be FALSE.
+*)
+
+@findex LongRealToString
+PROCEDURE LongRealToString (r: LONGREAL; digits, width: INTEGER;
+                            VAR str: ARRAY OF CHAR; VAR ok: BOOLEAN) ;
+
+
+(*
+   StringToReal - converts, str, into a REAL, r. The parameter, ok, is
+                  set to TRUE if the conversion was successful.
+*)
+
+@findex StringToReal
+PROCEDURE StringToReal (str: ARRAY OF CHAR; VAR r: REAL; VAR ok: BOOLEAN) ;
+
+
+(*
+   StringToLongReal - converts, str, into a LONGREAL, r. The parameter, ok, is
+                      set to TRUE if the conversion was successful.
+*)
+
+@findex StringToLongReal
+PROCEDURE StringToLongReal (str: ARRAY OF CHAR; VAR r: LONGREAL; VAR ok: BOOLEAN) ;
+
+
+END RealConversions.
+@end example
+@page
+
+@node gm2-libs-pim/RealInOut, gm2-libs-pim/Strings, gm2-libs-pim/RealConversions, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/RealInOut
+
+@example
+DEFINITION MODULE RealInOut ;
+
+EXPORT QUALIFIED SetNoOfDecimalPlaces,
+                 ReadReal, WriteReal, WriteRealOct,
+                 ReadLongReal, WriteLongReal, WriteLongRealOct,
+                 ReadShortReal, WriteShortReal, WriteShortRealOct,
+                 Done ;
+
+CONST
+@findex DefaultDecimalPlaces (const)
+   DefaultDecimalPlaces = 6 ;
+
+VAR
+@findex Done (var)
+   Done: BOOLEAN ;
+
+
+(*
+   SetNoOfDecimalPlaces - number of decimal places WriteReal and
+                          WriteLongReal should emit.  This procedure
+                          can be used to override the default
+                          DefaultDecimalPlaces constant.
+*)
+
+@findex SetNoOfDecimalPlaces
+PROCEDURE SetNoOfDecimalPlaces (places: CARDINAL) ;
+
+
+(*
+   ReadReal - reads a real number, legal syntaxes include:
+              100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+@findex ReadReal
+PROCEDURE ReadReal (VAR x: REAL) ;
+
+
+(*
+   WriteReal - writes a real to the terminal. The real number
+               is right justified and, n, is the minimum field
+               width.
+*)
+
+@findex WriteReal
+PROCEDURE WriteReal (x: REAL; n: CARDINAL) ;
+
+
+(*
+   WriteRealOct - writes the real to terminal in octal words.
+*)
+
+@findex WriteRealOct
+PROCEDURE WriteRealOct (x: REAL) ;
+
+
+(*
+   ReadLongReal - reads a LONGREAL number, legal syntaxes include:
+                  100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+@findex ReadLongReal
+PROCEDURE ReadLongReal (VAR x: LONGREAL) ;
+
+
+(*
+   WriteLongReal - writes a LONGREAL to the terminal. The real number
+                   is right justified and, n, is the minimum field
+                   width.
+*)
+
+@findex WriteLongReal
+PROCEDURE WriteLongReal (x: LONGREAL; n: CARDINAL) ;
+
+
+(*
+   WriteLongRealOct - writes the LONGREAL to terminal in octal words.
+*)
+
+@findex WriteLongRealOct
+PROCEDURE WriteLongRealOct (x: LONGREAL) ;
+
+
+(*
+   ReadShortReal - reads a SHORTREAL number, legal syntaxes include:
+                   100, 100.0, 100e0, 100E0, 100E-1, E2, +1E+2, 1e+2
+*)
+
+@findex ReadShortReal
+PROCEDURE ReadShortReal (VAR x: SHORTREAL) ;
+
+
+(*
+   WriteShortReal - writes a SHORTREAL to the terminal. The real number
+                    is right justified and, n, is the minimum field
+                    width.
+*)
+
+@findex WriteShortReal
+PROCEDURE WriteShortReal (x: SHORTREAL; n: CARDINAL) ;
+
+
+(*
+   WriteShortRealOct - writes the SHORTREAL to terminal in octal words.
+*)
+
+@findex WriteShortRealOct
+PROCEDURE WriteShortRealOct (x: SHORTREAL) ;
+
+
+END RealInOut.
+@end example
+@page
+
+@node gm2-libs-pim/Strings, gm2-libs-pim/Termbase, gm2-libs-pim/RealInOut, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Strings
+
+@example
+DEFINITION MODULE Strings ;
+
+EXPORT QUALIFIED Assign, Insert, Delete, Pos, Copy, ConCat, Length,
+                 CompareStr ;
+
+(*
+   Assign - dest := source.
+*)
+
+@findex Assign
+PROCEDURE Assign (VAR dest: ARRAY OF CHAR; source: ARRAY OF CHAR) ;
+
+
+(*
+   Insert - insert the string, substr, into str at position, index.
+            substr, is added to the end of, str, if, index >= length(str)
+*)
+
+@findex Insert
+PROCEDURE Insert (substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR;
+                  index: CARDINAL) ;
+
+
+(*
+   Delete - delete len characters from, str, starting at, index.
+*)
+
+@findex Delete
+PROCEDURE Delete (VAR str: ARRAY OF CHAR; index: CARDINAL; length: CARDINAL) ;
+
+
+(*
+   Pos - return the first position of, substr, in, str.
+*)
+
+@findex Pos
+PROCEDURE Pos (substr, str: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   Copy - copy at most, length, characters in, substr, to, str,
+          starting at position, index.
+*)
+
+@findex Copy
+PROCEDURE Copy (str: ARRAY OF CHAR;
+                index, length: CARDINAL; VAR result: ARRAY OF CHAR) ;
+
+(*
+   ConCat - concatenates two strings, s1, and, s2
+            and places the result into, dest.
+*)
+
+@findex ConCat
+PROCEDURE ConCat (s1, s2: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR) ;
+
+
+(*
+   Length - return the length of string, s.
+*)
+
+@findex Length
+PROCEDURE Length (s: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   CompareStr - compare two strings, left, and, right.
+*)
+
+@findex CompareStr
+PROCEDURE CompareStr (left, right: ARRAY OF CHAR) : INTEGER ;
+
+
+END Strings.
+@end example
+@page
+
+@node gm2-libs-pim/Termbase, gm2-libs-pim/Terminal, gm2-libs-pim/Strings, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Termbase
+
+@example
+DEFINITION MODULE Termbase ;
+
+(*
+   Initially the read routines from Keyboard and the
+   write routine from Display is assigned to the Read,
+   KeyPressed and Write procedures.
+*)
+
+EXPORT QUALIFIED ReadProcedure, StatusProcedure, WriteProcedure,
+                 AssignRead, AssignWrite, UnAssignRead, UnAssignWrite,
+                 Read, KeyPressed, Write ;
+
+TYPE
+@findex ReadProcedure (type)
+   ReadProcedure = PROCEDURE (VAR CHAR) ;
+@findex WriteProcedure (type)
+   WriteProcedure = PROCEDURE (CHAR) ;
+@findex StatusProcedure (type)
+   StatusProcedure = PROCEDURE () : BOOLEAN ;
+
+
+(*
+   AssignRead - assigns a read procedure and status procedure for terminal
+                input. Done is set to TRUE if successful. Subsequent
+                Read and KeyPressed calls are mapped onto the user supplied
+                procedures. The previous read and status procedures are
+                uncovered and reused after UnAssignRead is called.
+*)
+
+@findex AssignRead
+PROCEDURE AssignRead (rp: ReadProcedure; sp: StatusProcedure;
+                      VAR Done: BOOLEAN) ;
+
+
+(*
+   UnAssignRead - undo the last call to AssignRead and set Done to TRUE
+                  on success.
+*)
+
+@findex UnAssignRead
+PROCEDURE UnAssignRead (VAR Done: BOOLEAN) ;
+
+
+(*
+   Read - reads a single character using the currently active read
+          procedure.
+*)
+
+@findex Read
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   KeyPressed - returns TRUE if a character is available to be read.
+*)
+
+@findex KeyPressed
+PROCEDURE KeyPressed () : BOOLEAN ;
+
+
+(*
+   AssignWrite - assigns a write procedure for terminal output.
+                 Done is set to TRUE if successful. Subsequent
+                 Write calls are mapped onto the user supplied
+                 procedure. The previous write procedure is
+                 uncovered and reused after UnAssignWrite is called.
+*)
+
+@findex AssignWrite
+PROCEDURE AssignWrite (wp: WriteProcedure; VAR Done: BOOLEAN) ;
+
+
+(*
+   UnAssignWrite - undo the last call to AssignWrite and set Done to TRUE
+                   on success.
+*)
+
+@findex UnAssignWrite
+PROCEDURE UnAssignWrite (VAR Done: BOOLEAN) ;
+
+
+(*
+   Write - writes a single character using the currently active write
+           procedure.
+*)
+
+@findex Write
+PROCEDURE Write (VAR ch: CHAR) ;
+
+
+END Termbase.
+@end example
+@page
+
+@node gm2-libs-pim/Terminal, gm2-libs-pim/TimeDate, gm2-libs-pim/Termbase, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/Terminal
+
+@example
+DEFINITION MODULE Terminal ;
+
+(*
+   It provides simple terminal input output
+   routines which all utilize the TermBase module.
+*)
+
+EXPORT QUALIFIED Read, KeyPressed, ReadAgain, ReadString, Write,
+                 WriteString, WriteLn ;
+
+
+(*
+   Read - reads a single character.
+*)
+
+@findex Read
+PROCEDURE Read (VAR ch: CHAR) ;
+
+
+(*
+   KeyPressed - returns TRUE if a character can be read without blocking
+                the caller.
+*)
+
+@findex KeyPressed
+PROCEDURE KeyPressed () : BOOLEAN ;
+
+
+(*
+   ReadString - reads a sequence of characters.
+                Tabs are expanded into 8 spaces and <cr> or <lf> terminates
+                the string.
+*)
+
+@findex ReadString
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+
+
+(*
+   ReadAgain - makes the last character readable again.
+*)
+
+@findex ReadAgain
+PROCEDURE ReadAgain ;
+
+
+(*
+   Write - writes a single character to the Termbase module.
+*)
+
+@findex Write
+PROCEDURE Write (ch: CHAR) ;
+
+
+(*
+   WriteString - writes out a string which is terminated by a <nul>
+                 character or the end of string HIGH(s).
+*)
+
+@findex WriteString
+PROCEDURE WriteString (s: ARRAY OF CHAR) ;
+
+
+(*
+   WriteLn - writes a lf character.
+*)
+
+@findex WriteLn
+PROCEDURE WriteLn ;
+
+
+END Terminal.
+@end example
+@page
+
+@node gm2-libs-pim/TimeDate, , gm2-libs-pim/Terminal, PIM and Logitech 3.0 Compatible
+@subsection gm2-libs-pim/TimeDate
+
+@example
+DEFINITION MODULE TimeDate ;
+
+(*
+   Legacy compatibility - you are advised to use cleaner
+   designed modules based on 'man 3 strtime'
+   and friends for new projects as the day value here is ugly.
+   [it was mapped onto MSDOS pre 2000].
+*)
+
+EXPORT QUALIFIED Time, GetTime, SetTime, CompareTime, TimeToZero,
+                 TimeToString ;
+
+TYPE
+(*
+   day holds:  bits 0..4 = day of month (1..31)
+                    5..8 = month of year (1..12)
+                    9..  = year - 1900
+   minute holds:    hours * 60 + minutes
+   millisec holds:  seconds * 1000 + millisec
+                    which is reset to 0 every minute
+*)
+
+   Time = RECORD
+             day, minute, millisec: CARDINAL ;
+          END ;
+
+
+(*
+   GetTime - returns the current date and time.
+*)
+
+@findex GetTime
+PROCEDURE GetTime (VAR curTime: Time) ;
+
+
+(*
+   SetTime - does nothing, but provides compatibility with
+             the Logitech-3.0 library.
+*)
+
+@findex SetTime
+PROCEDURE SetTime (curTime: Time) ;
+
+
+(*
+   CompareTime - compare two dates and time which returns:
+
+                 -1  if t1 < t2
+                  0  if t1 = t2
+                  1  if t1 > t2
+*)
+
+@findex CompareTime
+PROCEDURE CompareTime (t1, t2: Time) : INTEGER ;
+
+
+(*
+   TimeToZero - initializes, t, to zero.
+*)
+
+@findex TimeToZero
+PROCEDURE TimeToZero (VAR t: Time) ;
+
+
+(*
+   TimeToString - convert time, t, to a string.
+                  The string, s, should be at least 19 characters
+                  long and the returned string will be
+
+                  yyyy-mm-dd hh:mm:ss
+*)
+
+@findex TimeToString
+PROCEDURE TimeToString (t: Time; VAR s: ARRAY OF CHAR) ;
+
+
+END TimeDate.
+@end example
+@page
+
+
+@c ------------------------------------------------------------
+@node PIM coroutine support, M2 ISO Libraries, PIM and Logitech 3.0 Compatible, Libraries
+@section PIM coroutine support
+
+@c README.texi describes the PIM coroutine libraries.
+@c Copyright @copyright{} 2000-2022 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+This directory contains a PIM @code{SYSTEM} containing the
+@code{PROCESS} primitives built on top of @code{gthread}s.
+@menu
+* gm2-libs-coroutines/Debug::Debug.def
+* gm2-libs-coroutines/Executive::Executive.def
+* gm2-libs-coroutines/KeyBoardLEDs::KeyBoardLEDs.def
+* gm2-libs-coroutines/SYSTEM::SYSTEM.def
+* gm2-libs-coroutines/TimerHandler::TimerHandler.def
+@end menu
+
+@node gm2-libs-coroutines/Debug, gm2-libs-coroutines/Executive, , PIM coroutine support
+@subsection gm2-libs-coroutines/Debug
+
+@example
+DEFINITION MODULE Debug ;
+
+(*
+    Description: provides some simple debugging routines.
+*)
+
+EXPORT QUALIFIED Halt, DebugString, PushOutput ;
+
+TYPE
+@findex WriteP (type)
+   WriteP = PROCEDURE (CHAR) ;
+
+
+(*
+   Halt - writes a message in the format:
+          Module:Line:Message
+
+          It then terminates by calling HALT.
+*)
+
+@findex Halt
+PROCEDURE Halt (File    : ARRAY OF CHAR;
+                LineNo  : CARDINAL;
+                Function,
+                Message : ARRAY OF CHAR) ;
+
+
+(*
+   DebugString - writes a string to the debugging device (Scn.Write).
+                 It interprets \n as carriage return, linefeed.
+*)
+
+@findex DebugString
+PROCEDURE DebugString (a: ARRAY OF CHAR) ;
+
+
+(*
+   PushOutput - pushes the output procedure, p, which is used Debug.
+*)
+
+@findex PushOutput
+PROCEDURE PushOutput (p: WriteP) ;
+
+
+(*
+   PopOutput - pops the current output procedure from the stack.
+*)
+
+@findex PopOutput
+PROCEDURE PopOutput ;
+
+
+END Debug.
+@end example
+@page
+
+@node gm2-libs-coroutines/Executive, gm2-libs-coroutines/KeyBoardLEDs, gm2-libs-coroutines/Debug, PIM coroutine support
+@subsection gm2-libs-coroutines/Executive
+
+@example
+DEFINITION MODULE Executive ;
+
+EXPORT QUALIFIED SEMAPHORE, DESCRIPTOR,
+                 InitProcess, KillProcess, Resume, Suspend, InitSemaphore,
+                 Wait, Signal, WaitForIO, Ps, GetCurrentProcess,
+                 RotateRunQueue, ProcessName, DebugProcess ;
+
+TYPE
+@findex SEMAPHORE (type)
+   SEMAPHORE ;         (* defines Dijkstra's semaphores *)
+@findex DESCRIPTOR (type)
+   DESCRIPTOR ;        (* handle onto a process         *)
+
+
+(*
+   InitProcess - initializes a process which is held in the suspended
+                 state. When the process is resumed it will start executing
+                 procedure, p. The process has a maximum stack size of,
+                 StackSize, bytes and its textual name is, Name.
+                 The StackSize should be at least 5000 bytes.
+*)
+
+@findex InitProcess
+PROCEDURE InitProcess (p: PROC; StackSize: CARDINAL;
+                       Name: ARRAY OF CHAR) : DESCRIPTOR ;
+
+
+(*
+   KillProcess - kills the current process. Notice that if InitProcess
+                 is called again, it might reuse the DESCRIPTOR of the
+                 killed process. It is the responsibility of the caller
+                 to ensure all other processes understand this process
+                 is different.
+*)
+
+@findex KillProcess
+PROCEDURE KillProcess ;
+
+
+(*
+   Resume - resumes a suspended process. If all is successful then the process, p,
+            is returned. If it fails then NIL is returned.
+*)
+
+@findex Resume
+PROCEDURE Resume (d: DESCRIPTOR) : DESCRIPTOR ;
+
+
+(*
+   Suspend - suspend the calling process.
+             The process can only continue running if another process
+             Resumes it.
+*)
+
+@findex Suspend
+PROCEDURE Suspend ;
+
+
+(*
+   InitSemaphore - creates a semaphore whose initial value is, v, and
+                   whose name is, Name.
+*)
+
+@findex InitSemaphore
+PROCEDURE InitSemaphore (v: CARDINAL; Name: ARRAY OF CHAR) : SEMAPHORE ;
+
+
+(*
+   Wait - performs dijkstra's P operation on a semaphore.
+          A process which calls this procedure will
+          wait until the value of the semaphore is > 0
+          and then it will decrement this value.
+*)
+
+@findex Wait
+PROCEDURE Wait (s: SEMAPHORE) ;
+
+
+(*
+   Signal - performs dijkstra's V operation on a semaphore.
+            A process which calls the procedure will increment
+            the semaphores value.
+*)
+
+@findex Signal
+PROCEDURE Signal (s: SEMAPHORE) ;
+
+
+(*
+   WaitForIO - waits for an interrupt to occur on vector, VectorNo.
+*)
+
+@findex WaitForIO
+PROCEDURE WaitForIO (VectorNo: CARDINAL) ;
+
+
+(*
+   Ps - displays a process list together with process status.
+*)
+
+@findex Ps
+PROCEDURE Ps ;
+
+
+(*
+   GetCurrentProcess - returns the descriptor of the current running
+                       process.
+*)
+
+@findex GetCurrentProcess
+PROCEDURE GetCurrentProcess () : DESCRIPTOR ;
+
+
+(*
+   RotateRunQueue - rotates the process run queue.
+                    It does not call the scheduler.
+*)
+
+@findex RotateRunQueue
+PROCEDURE RotateRunQueue ;
+
+
+(*
+   ProcessName - displays the name of process, d, through
+                 DebugString.
+*)
+
+@findex ProcessName
+PROCEDURE ProcessName (d: DESCRIPTOR) ;
+
+
+(*
+   DebugProcess - gdb debug handle to enable users to debug deadlocked
+                  semaphore processes.
+*)
+
+@findex DebugProcess
+PROCEDURE DebugProcess (d: DESCRIPTOR) ;
+
+
+END Executive.
+@end example
+@page
+
+@node gm2-libs-coroutines/KeyBoardLEDs, gm2-libs-coroutines/SYSTEM, gm2-libs-coroutines/Executive, PIM coroutine support
+@subsection gm2-libs-coroutines/KeyBoardLEDs
+
+@example
+DEFINITION MODULE KeyBoardLEDs ;
+
+
+EXPORT QUALIFIED SwitchLeds,
+                 SwitchScroll, SwitchNum, SwitchCaps ;
+
+
+(*
+   SwitchLeds - switch the keyboard LEDs to the state defined
+                by the BOOLEAN variables. TRUE = ON.
+*)
+
+@findex SwitchLeds
+PROCEDURE SwitchLeds (NumLock, CapsLock, ScrollLock: BOOLEAN) ;
+
+
+(*
+   SwitchScroll - switchs the scroll LED on or off.
+*)
+
+@findex SwitchScroll
+PROCEDURE SwitchScroll (Scroll: BOOLEAN) ;
+
+
+(*
+   SwitchNum - switches the Num LED on or off.
+*)
+
+@findex SwitchNum
+PROCEDURE SwitchNum (Num: BOOLEAN) ;
+
+
+(*
+   SwitchCaps - switches the Caps LED on or off.
+*)
+
+@findex SwitchCaps
+PROCEDURE SwitchCaps (Caps: BOOLEAN) ;
+
+
+END KeyBoardLEDs.
+@end example
+@page
+
+@node gm2-libs-coroutines/SYSTEM, gm2-libs-coroutines/TimerHandler, gm2-libs-coroutines/KeyBoardLEDs, PIM coroutine support
+@subsection gm2-libs-coroutines/SYSTEM
+
+@example
+DEFINITION MODULE SYSTEM ;
+
+(* This module is designed to be used on a native operating system
+   rather than an embedded system as it implements the coroutine
+   primitives TRANSFER, IOTRANSFER and
+   NEWPROCESS through the GNU Pthread library.  *)
+
+FROM COROUTINES IMPORT PROTECTION ;
+
+EXPORT QUALIFIED (* the following are built into the compiler: *)
+                 ADDRESS, WORD, BYTE, CSIZE_T, CSSIZE_T, (* 
+                 Target specific data types. *)
+                 ADR, TSIZE, ROTATE, SHIFT, THROW, TBITSIZE,
+                 (* SIZE is exported depending upon -fpim2 and
+                    -fpedantic.  *)
+                 (* The rest are implemented in SYSTEM.mod.  *)
+                 PROCESS, TRANSFER, NEWPROCESS, IOTRANSFER,
+                 LISTEN,
+                 ListenLoop, TurnInterrupts,
+                 (* Internal GM2 compiler functions.  *)
+                 ShiftVal, ShiftLeft, ShiftRight,
+                 RotateVal, RotateLeft, RotateRight ;
+
+
+TYPE
+@findex PROCESS (type)
+   PROCESS  = RECORD
+                 context: INTEGER ;
+@findex END (type)
+              END ;
+
+(* Note that the full list of system and sized datatypes include:
+   LOC, WORD, BYTE, ADDRESS,
+
+   (and the non language standard target types)
+
+   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+   WORD16, WORD32, WORD64, BITSET8, BITSET16,
+   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
+   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.
+
+   Also note that the non-standard data types will
+   move into another module in the future.  *)
+
+(* The following types are supported on this target:
+   (* Target specific data types.  *)
+*)
+
+
+(*
+   TRANSFER - save the current volatile environment into, p1.
+              Restore the volatile environment from, p2.
+*)
+
+@findex TRANSFER
+PROCEDURE TRANSFER (VAR p1: PROCESS; p2: PROCESS) ;
+
+
+(*
+   NEWPROCESS - p is a parameterless procedure, a, is the origin of
+                the workspace used for the process stack and containing
+                the volatile environment of the process.  StackSize, is
+                the maximum size of the stack in bytes which can be used
+                by this process.  new, is the new process.
+*)
+
+@findex NEWPROCESS
+PROCEDURE NEWPROCESS (p: PROC; a: ADDRESS; StackSize: CARDINAL; VAR new: PROCESS) ;
+
+
+(*
+   IOTRANSFER - saves the current volatile environment into, First,
+                and restores volatile environment, Second.
+                When an interrupt, InterruptNo, is encountered then
+                the reverse takes place.  (The then current volatile
+                environment is shelved onto Second and First is resumed).
+
+                NOTE: that upon interrupt the Second might not be the
+                      same process as that before the original call to
+                      IOTRANSFER.
+*)
+
+@findex IOTRANSFER
+PROCEDURE IOTRANSFER (VAR First, Second: PROCESS; InterruptNo: CARDINAL) ;
+
+
+(*
+   LISTEN - briefly listen for any interrupts.
+*)
+
+@findex LISTEN
+PROCEDURE LISTEN ;
+
+
+(*
+   ListenLoop - should be called instead of users writing:
+
+                LOOP
+                   LISTEN
+                END
+
+                It performs the same function but yields
+                control back to the underlying operating system
+                via a call to pth_select.
+                It also checks for deadlock.
+                This function returns when an interrupt occurs ie
+                a file descriptor becomes ready or a time event
+                expires.  See the module RTint.
+*)
+
+@findex ListenLoop
+PROCEDURE ListenLoop ;
+
+
+(*
+   TurnInterrupts - switches processor interrupts to the protection
+                    level, to.  It returns the old value.
+*)
+
+@findex TurnInterrupts
+PROCEDURE TurnInterrupts (to: PROTECTION) : PROTECTION ;
+
+
+(*
+   all the functions below are declared internally to gm2
+   ====================================================
+
+@findex ADR
+PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
+  (* Returns the address of variable v. *)
+
+@findex SIZE
+PROCEDURE SIZE (v: <type>) : ZType;
+  (* Returns the number of BYTES used to store a v of
+     any specified <type>.  Only available if -fpim2 is used.
+  *)
+
+@findex TSIZE
+PROCEDURE TSIZE (<type>) : CARDINAL;
+  (* Returns the number of BYTES used to store a value of the
+     specified <type>.
+  *)
+
+@findex ROTATE
+PROCEDURE ROTATE (val: <a set type>;
+                  num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by rotating up or down
+     (left or right) by the absolute value of num.  The direction is
+     down if the sign of num is negative, otherwise the direction is up.
+  *)
+
+@findex SHIFT
+PROCEDURE SHIFT (val: <a set type>;
+                 num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by shifting up or down
+     (left or right) by the absolute value of num, introducing
+     zeros as necessary.  The direction is down if the sign of
+     num is negative, otherwise the direction is up.
+  *)
+
+@findex THROW
+PROCEDURE THROW (i: INTEGER) ;
+  (*
+     THROW is a GNU extension and was not part of the PIM or ISO
+     standards.  It throws an exception which will be caught by the EXCEPT
+     block (assuming it exists).  This is a compiler builtin function which
+     interfaces to the GCC exception handling runtime system.
+     GCC uses the term throw, hence the naming distinction between
+     the GCC builtin and the Modula-2 runtime library procedure Raise.
+     The later library procedure Raise will call SYSTEM.THROW after
+     performing various housekeeping activities.
+  *)
+
+@findex TBITSIZE
+PROCEDURE TBITSIZE (<type>) : CARDINAL ;
+  (* Returns the minimum number of bits necessary to represent
+     <type>.  This procedure function is only useful for determining
+     the number of bits used for any type field within a packed RECORD.
+     It is not particularly useful elsewhere since <type> might be
+     optimized for speed, for example a BOOLEAN could occupy a WORD.
+  *)
+*)
+
+(* The following procedures are invoked by GNU Modula-2 to
+   shift non word sized set types.  They are not strictly part
+   of the core PIM Modula-2, however they are used
+   to implement the SHIFT procedure defined above,
+   which are in turn used by the Logitech compatible libraries.
+
+   Users will access these procedures by using the procedure
+   SHIFT above and GNU Modula-2 will map SHIFT onto one of
+   the following procedures.
+*)
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will
+              only call this routine for larger sets.
+*)
+
+@findex ShiftVal
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*)
+
+@findex ShiftLeft
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex ShiftRight
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM.  GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for
+               larger sets.
+*)
+
+@findex RotateVal
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known
+                at compile time.
+*)
+
+@findex RotateLeft
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*)
+
+@findex RotateRight
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+
+
+END SYSTEM.
+@end example
+@page
+
+@node gm2-libs-coroutines/TimerHandler, , gm2-libs-coroutines/SYSTEM, PIM coroutine support
+@subsection gm2-libs-coroutines/TimerHandler
+
+@example
+DEFINITION MODULE TimerHandler ;
+
+(* It also provides the Executive with a basic round robin scheduler.  *)
+
+EXPORT QUALIFIED TicksPerSecond, GetTicks,
+                 EVENT,
+                 Sleep, ArmEvent, WaitOn, Cancel, ReArmEvent ;
+
+
+CONST
+@findex TicksPerSecond (const)
+   TicksPerSecond =   25 ;  (* Number of ticks per second.  *)
+
+TYPE
+@findex EVENT (type)
+   EVENT ;
+
+
+(*
+   GetTicks - returns the number of ticks since boottime.
+*)
+
+@findex GetTicks
+PROCEDURE GetTicks () : CARDINAL ;
+
+
+(*
+   Sleep - suspends the current process for a time, t.
+           The time is measured in ticks.
+*)
+
+@findex Sleep
+PROCEDURE Sleep (t: CARDINAL) ;
+
+
+(*
+   ArmEvent - initializes an event, e, to occur at time, t.
+              The time, t, is measured in ticks.
+              The event is NOT placed onto the event queue.
+*)
+
+@findex ArmEvent
+PROCEDURE ArmEvent (t: CARDINAL) : EVENT ;
+
+
+(*
+   WaitOn - places event, e, onto the event queue and then the calling
+            process suspends. It is resumed up by either the event
+            expiring or the event, e, being cancelled.
+            TRUE is returned if the event was cancelled
+            FALSE is returned if the event expires.
+            The event, e, is always assigned to NIL when the function
+            finishes.
+*)
+
+@findex WaitOn
+PROCEDURE WaitOn (VAR e: EVENT) : BOOLEAN ;
+
+
+(*
+   Cancel - cancels the event, e, on the event queue and makes
+            the appropriate process runnable again.
+            TRUE is returned if the event was cancelled and
+            FALSE is returned is the event was not found or
+                  no process was waiting on this event.
+*)
+
+@findex Cancel
+PROCEDURE Cancel (e: EVENT) : BOOLEAN ;
+
+
+(*
+   ReArmEvent - removes an event, e, from the event queue. A new time
+                is given to this event and it is then re-inserted onto the
+                event queue in the correct place.
+                TRUE is returned if this occurred
+                FALSE is returned if the event was not found.
+*)
+
+@findex ReArmEvent
+PROCEDURE ReArmEvent (e: EVENT; t: CARDINAL) : BOOLEAN ;
+
+
+END TimerHandler.
+@end example
+@page
+
+
+@c ------------------------------------------------------------
+@node M2 ISO Libraries, , PIM coroutine support, Libraries
+@section M2 ISO Libraries
+
+@c README.texi describes the ISO libraries.
+@c Copyright @copyright{} 2000-2022 Free Software Foundation, Inc.
+@c
+@c This is part of the GM2 manual.
+@c For copying conditions, see the file gcc/doc/include/fdl.texi.
+
+This directory contains the ISO definition modules and some
+corresponding implementation modules.  The definition files:
+@file{ChanConsts.def}, @file{CharClass.def}, @file{ComplexMath.def},
+@file{ConvStringLong.def}, @file{ConvStringReal.def},
+@file{ConvTypes.def}, @file{COROUTINES.def}, @file{EXCEPTIONS.def},
+@file{GeneralUserExceptions.def}, @file{IOChan.def},
+@file{IOConsts.def}, @file{IOLink.def}, @file{IOLink.def},
+@file{IOResult.def}, @file{LongComplexMath.def}, @file{LongConv.def},
+@file{LongIO.def}, @file{LongMath.def}, @file{LongStr.def},
+@file{LowLong.def}, @file{LowReal.def}, @file{M2EXCEPTION.def},
+@file{Processes.def}, @file{ProgramArgs.def}, @file{RawIO.def},
+@file{RealConv.def}, @file{RealIO.def}, @file{RealMath.def},
+@file{RealStr.def}, @file{RndFile.def}, @file{Semaphores.def},
+@file{SeqFile.def}, @file{SIOResult.def}, @file{SLongIO.def},
+@file{SRawIO.def}, @file{SRealIO.def}, @file{StdChans.def},
+@file{STextIO.def}, @file{Storage.def}, @file{StreamFile.def},
+@file{Strings.def}, @file{SWholeIO.def}, @file{SysClock.def},
+@file{SYSTEM.def}, @file{TERMINATION.def}, @file{TextIO.def},
+@file{WholeConv.def}, @file{WholeIO.def} and @file{WholeStr.def}
+were defined by the International Standard
+Information technology - programming languages BS ISO/IEC
+10514-1:1996E Part 1: Modula-2, Base Language.
+
+The Copyright to the definition files @file{ChanConsts.def},
+@file{CharClass.def}, @file{ComplexMath.def},
+@file{ConvStringLong.def}, @file{ConvStringReal.def},
+@file{ConvTypes.def}, @file{COROUTINES.def}, @file{EXCEPTIONS.def},
+@file{GeneralUserExceptions.def}, @file{IOChan.def},
+@file{IOConsts.def}, @file{IOLink.def}, @file{IOLink.def},
+@file{IOResult.def}, @file{LongComplexMath.def}, @file{LongConv.def},
+@file{LongIO.def}, @file{LongMath.def}, @file{LongStr.def},
+@file{LowLong.def}, @file{LowReal.def}, @file{M2EXCEPTION.def},
+@file{Processes.def}, @file{ProgramArgs.def}, @file{RawIO.def},
+@file{RealConv.def}, @file{RealIO.def}, @file{RealMath.def},
+@file{RealStr.def}, @file{RndFile.def}, @file{Semaphores.def},
+@file{SeqFile.def}, @file{SIOResult.def}, @file{SLongIO.def},
+@file{SRawIO.def}, @file{SRealIO.def}, @file{StdChans.def},
+@file{STextIO.def}, @file{Storage.def}, @file{StreamFile.def},
+@file{Strings.def}, @file{SWholeIO.def}, @file{SysClock.def},
+@file{SYSTEM.def}, @file{TERMINATION.def}, @file{TextIO.def},
+@file{WholeConv.def}, @file{WholeIO.def} and @file{WholeStr.def}
+belong to ISO/IEC (International Organization for Standardization and
+International Electrotechnical Commission).  The licence allows them
+to be distributed with the compiler (as described on page
+707 of the Information technology - Programming languages Part 1:
+Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).
+
+All implementation modules and @file{ClientSocket.def},
+@file{LongWholeIO.def}, @file{M2RTS.def}, @file{MemStream.def},
+@file{pth.def}, @file{RandomNumber.def}, @file{RTdata.def},
+@file{RTentity.def}, @file{RTfio.def}, @file{RTio.def},
+@file{ShortComplexMath.def}, @file{ShortIO.def},
+@file{ShortWholeIO.def}, @file{SimpleCipher.def},
+@file{SLongWholeIO.def}, @file{SShortIO.def},
+@file{SShortWholeIO.def}, @file{StringChan.def} and
+@file{wraptime.def} are Copyright of the FSF and are held under the
+GPLv3 with runtime exceptions.
+
+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
+@url{http://www.gnu.org/licenses/}.
+
+Notice that GNU Modula-2 contains additional libraries for
+input/output of @code{SHORTREAL}, @code{SHORTCARD}, @code{SHORTINT},
+@code{LONGCARD}, @code{LONGINT} data types.  It also provides a
+@code{RandomNumber}, @code{SimpleCipher} and @code{ClientSocket}
+modules as well as low level modules which allow the IO libraries to
+coexist with their PIM counterparts.
+@menu
+* gm2-libs-iso/COROUTINES::COROUTINES.def
+* gm2-libs-iso/ChanConsts::ChanConsts.def
+* gm2-libs-iso/CharClass::CharClass.def
+* gm2-libs-iso/ClientSocket::ClientSocket.def
+* gm2-libs-iso/ComplexMath::ComplexMath.def
+* gm2-libs-iso/ConvStringLong::ConvStringLong.def
+* gm2-libs-iso/ConvStringReal::ConvStringReal.def
+* gm2-libs-iso/ConvTypes::ConvTypes.def
+* gm2-libs-iso/EXCEPTIONS::EXCEPTIONS.def
+* gm2-libs-iso/ErrnoCategory::ErrnoCategory.def
+* gm2-libs-iso/GeneralUserExceptions::GeneralUserExceptions.def
+* gm2-libs-iso/IOChan::IOChan.def
+* gm2-libs-iso/IOConsts::IOConsts.def
+* gm2-libs-iso/IOLink::IOLink.def
+* gm2-libs-iso/IOResult::IOResult.def
+* gm2-libs-iso/LongComplexMath::LongComplexMath.def
+* gm2-libs-iso/LongConv::LongConv.def
+* gm2-libs-iso/LongIO::LongIO.def
+* gm2-libs-iso/LongMath::LongMath.def
+* gm2-libs-iso/LongStr::LongStr.def
+* gm2-libs-iso/LongWholeIO::LongWholeIO.def
+* gm2-libs-iso/LowLong::LowLong.def
+* gm2-libs-iso/LowReal::LowReal.def
+* gm2-libs-iso/LowShort::LowShort.def
+* gm2-libs-iso/M2EXCEPTION::M2EXCEPTION.def
+* gm2-libs-iso/M2RTS::M2RTS.def
+* gm2-libs-iso/MemStream::MemStream.def
+* gm2-libs-iso/Preemptive::Preemptive.def
+* gm2-libs-iso/Processes::Processes.def
+* gm2-libs-iso/ProgramArgs::ProgramArgs.def
+* gm2-libs-iso/RTco::RTco.def
+* gm2-libs-iso/RTdata::RTdata.def
+* gm2-libs-iso/RTentity::RTentity.def
+* gm2-libs-iso/RTfio::RTfio.def
+* gm2-libs-iso/RTgen::RTgen.def
+* gm2-libs-iso/RTgenif::RTgenif.def
+* gm2-libs-iso/RTio::RTio.def
+* gm2-libs-iso/RandomNumber::RandomNumber.def
+* gm2-libs-iso/RawIO::RawIO.def
+* gm2-libs-iso/RealConv::RealConv.def
+* gm2-libs-iso/RealIO::RealIO.def
+* gm2-libs-iso/RealMath::RealMath.def
+* gm2-libs-iso/RealStr::RealStr.def
+* gm2-libs-iso/RndFile::RndFile.def
+* gm2-libs-iso/SIOResult::SIOResult.def
+* gm2-libs-iso/SLongIO::SLongIO.def
+* gm2-libs-iso/SLongWholeIO::SLongWholeIO.def
+* gm2-libs-iso/SRawIO::SRawIO.def
+* gm2-libs-iso/SRealIO::SRealIO.def
+* gm2-libs-iso/SShortIO::SShortIO.def
+* gm2-libs-iso/SShortWholeIO::SShortWholeIO.def
+* gm2-libs-iso/STextIO::STextIO.def
+* gm2-libs-iso/SWholeIO::SWholeIO.def
+* gm2-libs-iso/SYSTEM::SYSTEM.def
+* gm2-libs-iso/Semaphores::Semaphores.def
+* gm2-libs-iso/SeqFile::SeqFile.def
+* gm2-libs-iso/ShortComplexMath::ShortComplexMath.def
+* gm2-libs-iso/ShortIO::ShortIO.def
+* gm2-libs-iso/ShortWholeIO::ShortWholeIO.def
+* gm2-libs-iso/SimpleCipher::SimpleCipher.def
+* gm2-libs-iso/StdChans::StdChans.def
+* gm2-libs-iso/Storage::Storage.def
+* gm2-libs-iso/StreamFile::StreamFile.def
+* gm2-libs-iso/StringChan::StringChan.def
+* gm2-libs-iso/Strings::Strings.def
+* gm2-libs-iso/SysClock::SysClock.def
+* gm2-libs-iso/TERMINATION::TERMINATION.def
+* gm2-libs-iso/TermFile::TermFile.def
+* gm2-libs-iso/TextIO::TextIO.def
+* gm2-libs-iso/WholeConv::WholeConv.def
+* gm2-libs-iso/WholeIO::WholeIO.def
+* gm2-libs-iso/WholeStr::WholeStr.def
+* gm2-libs-iso/wrapsock::wrapsock.def
+* gm2-libs-iso/wraptime::wraptime.def
+@end menu
+
+@node gm2-libs-iso/COROUTINES, gm2-libs-iso/ChanConsts, , M2 ISO Libraries
+@subsection gm2-libs-iso/COROUTINES
+
+@example
+DEFINITION MODULE COROUTINES;
+
+(* Facilities for coroutines and the handling of interrupts *)
+
+IMPORT SYSTEM ;
+
+
+CONST
+@findex UnassignedPriority (const)
+  UnassignedPriority = 0 ;
+
+TYPE
+@findex COROUTINE (type)
+  COROUTINE ; (* Values of this type are created dynamically by NEWCOROUTINE
+                 and identify the coroutine in subsequent operations *)
+@findex INTERRUPTSOURCE (type)
+  INTERRUPTSOURCE = CARDINAL ;
+@findex PROTECTION (type)
+  PROTECTION = [UnassignedPriority..7] ;
+
+
+@findex NEWCOROUTINE
+PROCEDURE NEWCOROUTINE (procBody: PROC;
+                        workspace: SYSTEM.ADDRESS;
+                        size: CARDINAL;
+                        VAR cr: COROUTINE;
+                        [initProtection: PROTECTION = UnassignedPriority]);
+  (* Creates a new coroutine whose body is given by procBody, and
+     returns the identity of the coroutine in cr. workspace is a
+     pointer to the work space allocated to the coroutine; size
+     specifies the size of this workspace in terms of SYSTEM.LOC.
+
+     The optarg, initProtection, may contain a single parameter which
+     specifies the initial protection level of the coroutine.
+  *)
+
+@findex TRANSFER
+PROCEDURE TRANSFER (VAR from: COROUTINE; to: COROUTINE);
+  (* Returns the identity of the calling coroutine in from, and
+     transfers control to the coroutine specified by to.
+  *)
+
+@findex IOTRANSFER
+PROCEDURE IOTRANSFER (VAR from: COROUTINE; to: COROUTINE);
+  (* Returns the identity of the calling coroutine in from and
+     transfers control to the coroutine specified by to.  On
+     occurrence of an interrupt, associated with the caller, control
+     is transferred back to the caller, and the identity of the
+     interrupted coroutine is returned in from.  The calling coroutine
+     must be associated with a source of interrupts.
+  *)
+
+@findex ATTACH
+PROCEDURE ATTACH (source: INTERRUPTSOURCE);
+  (* Associates the specified source of interrupts with the calling
+     coroutine. *)
+
+@findex DETACH
+PROCEDURE DETACH (source: INTERRUPTSOURCE);
+  (* Dissociates the specified source of interrupts from the calling
+     coroutine. *)
+
+@findex IsATTACHED
+PROCEDURE IsATTACHED (source: INTERRUPTSOURCE): BOOLEAN;
+  (* Returns TRUE if and only if the specified source of interrupts is
+     currently associated with a coroutine; otherwise returns FALSE.
+  *)
+
+@findex HANDLER
+PROCEDURE HANDLER (source: INTERRUPTSOURCE): COROUTINE;
+  (* Returns the coroutine, if any, that is associated with the source
+     of interrupts. The result is undefined if IsATTACHED(source) =
+     FALSE.
+  *)
+
+@findex CURRENT
+PROCEDURE CURRENT (): COROUTINE;
+  (* Returns the identity of the calling coroutine. *)
+
+@findex LISTEN
+PROCEDURE LISTEN (p: PROTECTION);
+  (* Momentarily changes the protection of the calling coroutine to
+     p. *)
+
+@findex PROT
+PROCEDURE PROT (): PROTECTION;
+  (* Returns the protection of the calling coroutine. *)
+
+
+(*
+   TurnInterrupts - switches processor interrupts to the protection
+                    level, to.  It returns the old value.
+*)
+
+@findex TurnInterrupts
+PROCEDURE TurnInterrupts (to: PROTECTION) : PROTECTION ;
+
+
+(*
+   ListenLoop - should be called instead of users writing:
+
+                LOOP
+                   LISTEN
+                END
+
+                It performs the same function but yields
+                control back to the underlying operating system.
+                It also checks for deadlock.
+                Note that this function does return when an interrupt occurs.
+                (File descriptor becomes ready or time event expires).
+*)
+
+@findex ListenLoop
+PROCEDURE ListenLoop ;
+
+
+END COROUTINES.
+@end example
+@page
+
+@node gm2-libs-iso/ChanConsts, gm2-libs-iso/CharClass, gm2-libs-iso/COROUTINES, M2 ISO Libraries
+@subsection gm2-libs-iso/ChanConsts
+
+@example
+DEFINITION MODULE ChanConsts;
+
+  (* Common types and values for channel open requests and results *)
+
+TYPE
+@findex ChanFlags (type)
+  ChanFlags =        (* Request flags possibly given when a channel is opened *)
+  ( readFlag,        (* input operations are requested/available *)
+    writeFlag,       (* output operations are requested/available *)
+    oldFlag,         (* a file may/must/did exist before the channel is opened *)
+    textFlag,        (* text operations are requested/available *)
+    rawFlag,         (* raw operations are requested/available *)
+    interactiveFlag, (* interactive use is requested/applies *)
+    echoFlag         (* echoing by interactive device on removal of characters from input
+                        stream requested/applies *)
+  );
+
+@findex FlagSet (type)
+  FlagSet = SET OF ChanFlags;
+
+  (* Singleton values of FlagSet, to allow for example, read + write *)
+
+CONST
+@findex read (const)
+  read = FlagSet@{readFlag@};   (* input operations are requested/available *)
+@findex write (const)
+  write = FlagSet@{writeFlag@}; (* output operations are requested/available *)
+@findex old (const)
+  old = FlagSet@{oldFlag@};     (* a file may/must/did exist before the channel is opened *)
+@findex text (const)
+  text = FlagSet@{textFlag@};   (* text operations are requested/available *)
+@findex raw (const)
+  raw = FlagSet@{rawFlag@};     (* raw operations are requested/available *)
+@findex interactive (const)
+  interactive = FlagSet@{interactiveFlag@}; (* interactive use is requested/applies *)
+@findex echo (const)
+  echo = FlagSet@{echoFlag@};   (* echoing by interactive device on removal of characters from
+                                 input stream requested/applies *)
+
+TYPE
+@findex OpenResults (type)
+  OpenResults =        (* Possible results of open requests *)
+    (opened,           (* the open succeeded as requested *)
+     wrongNameFormat,  (* given name is in the wrong format for the implementation *)
+     wrongFlags,       (* given flags include a value that does not apply to the device *)
+     tooManyOpen,      (* this device cannot support any more open channels *)
+     outOfChans,       (* no more channels can be allocated *)
+     wrongPermissions, (* file or directory permissions do not allow request *)
+     noRoomOnDevice,   (* storage limits on the device prevent the open *)
+     noSuchFile,       (* a needed file does not exist *)
+     fileExists,       (* a file of the given name already exists when a new one is required *)
+     wrongFileType,    (* the file is of the wrong type to support the required operations *)
+     noTextOperations, (* text operations have been requested, but are not supported *)
+     noRawOperations,  (* raw operations have been requested, but are not supported *)
+     noMixedOperations,(* text and raw operations have been requested, but they
+                          are not supported in combination *)
+     alreadyOpen,      (* the source/destination is already open for operations not supported
+                          in combination with the requested operations *)
+     otherProblem      (* open failed for some other reason *)
+    );
+
+END ChanConsts.
+
+@end example
+@page
+
+@node gm2-libs-iso/CharClass, gm2-libs-iso/ClientSocket, gm2-libs-iso/ChanConsts, M2 ISO Libraries
+@subsection gm2-libs-iso/CharClass
+
+@example
+DEFINITION MODULE CharClass;
+
+  (* Classification of values of the type CHAR *)
+
+@findex IsNumeric
+PROCEDURE IsNumeric (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch is classified as a numeric character *)
+
+@findex IsLetter
+PROCEDURE IsLetter (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch is classified as a letter *)
+
+@findex IsUpper
+PROCEDURE IsUpper (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch is classified as an upper case letter *)
+
+@findex IsLower
+PROCEDURE IsLower (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch is classified as a lower case letter *)
+
+@findex IsControl
+PROCEDURE IsControl (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch represents a control function *)
+
+@findex IsWhiteSpace
+PROCEDURE IsWhiteSpace (ch: CHAR): BOOLEAN;
+  (* Returns TRUE if and only if ch represents a space character or a format effector *)
+
+END CharClass.
+
+@end example
+@page
+
+@node gm2-libs-iso/ClientSocket, gm2-libs-iso/ComplexMath, gm2-libs-iso/CharClass, M2 ISO Libraries
+@subsection gm2-libs-iso/ClientSocket
+
+@example
+DEFINITION MODULE ClientSocket ;
+
+FROM IOChan IMPORT ChanId ;
+FROM ChanConsts IMPORT FlagSet, OpenResults ;
+
+
+(*
+   OpenSocket - opens a TCP client connection to host:port.
+*)
+
+@findex OpenSocket
+PROCEDURE OpenSocket (VAR cid: ChanId;
+                      host: ARRAY OF CHAR; port: CARDINAL;
+                      f: FlagSet; VAR res: OpenResults) ;
+
+(*
+   Close - if the channel identified by cid is not open to
+           a socket stream, the exception wrongDevice is
+           raised; otherwise closes the channel, and assigns
+           the value identifying the invalid channel to cid.
+*)
+
+@findex Close
+PROCEDURE Close (VAR cid: ChanId) ;
+
+
+(*
+   IsSocket - tests if the channel identified by cid is open as
+              a client socket stream.
+*)
+
+@findex IsSocket
+PROCEDURE IsSocket (cid: ChanId) : BOOLEAN ;
+
+
+END ClientSocket.
+@end example
+@page
+
+@node gm2-libs-iso/ComplexMath, gm2-libs-iso/ConvStringLong, gm2-libs-iso/ClientSocket, M2 ISO Libraries
+@subsection gm2-libs-iso/ComplexMath
+
+@example
+DEFINITION MODULE ComplexMath;
+
+  (* Mathematical functions for the type COMPLEX *)
+
+CONST
+@findex i (const)
+  i =    CMPLX (0.0, 1.0);
+@findex one (const)
+  one =  CMPLX (1.0, 0.0);
+@findex zero (const)
+  zero = CMPLX (0.0, 0.0);
+
+@findex abs
+PROCEDURE __BUILTIN__ abs (z: COMPLEX): REAL;
+  (* Returns the length of z *)
+
+@findex arg
+PROCEDURE __BUILTIN__ arg (z: COMPLEX): REAL;
+  (* Returns the angle that z subtends to the positive real axis *)
+
+@findex conj
+PROCEDURE __BUILTIN__ conj (z: COMPLEX): COMPLEX;
+  (* Returns the complex conjugate of z *)
+
+@findex power
+PROCEDURE __BUILTIN__ power (base: COMPLEX; exponent: REAL): COMPLEX;
+  (* Returns the value of the number base raised to the power exponent *)
+
+@findex sqrt
+PROCEDURE __BUILTIN__ sqrt (z: COMPLEX): COMPLEX;
+  (* Returns the principal square root of z *)
+
+@findex exp
+PROCEDURE __BUILTIN__ exp (z: COMPLEX): COMPLEX;
+  (* Returns the complex exponential of z *)
+
+@findex ln
+PROCEDURE __BUILTIN__ ln (z: COMPLEX): COMPLEX;
+  (* Returns the principal value of the natural logarithm of z *)
+
+@findex sin
+PROCEDURE __BUILTIN__ sin (z: COMPLEX): COMPLEX;
+  (* Returns the sine of z *)
+
+@findex cos
+PROCEDURE __BUILTIN__ cos (z: COMPLEX): COMPLEX;
+  (* Returns the cosine of z *)
+
+@findex tan
+PROCEDURE __BUILTIN__ tan (z: COMPLEX): COMPLEX;
+  (* Returns the tangent of z *)
+
+@findex arcsin
+PROCEDURE __BUILTIN__ arcsin (z: COMPLEX): COMPLEX;
+  (* Returns the arcsine of z *)
+
+@findex arccos
+PROCEDURE __BUILTIN__ arccos (z: COMPLEX): COMPLEX;
+  (* Returns the arccosine of z *)
+
+@findex arctan
+PROCEDURE __BUILTIN__ arctan (z: COMPLEX): COMPLEX;
+  (* Returns the arctangent of z *)
+
+@findex polarToComplex
+PROCEDURE polarToComplex (abs, arg: REAL): COMPLEX;
+  (* Returns the complex number with the specified polar coordinates *)
+
+@findex scalarMult
+PROCEDURE scalarMult (scalar: REAL; z: COMPLEX): COMPLEX;
+  (* Returns the scalar product of scalar with z *)
+
+@findex IsCMathException
+PROCEDURE IsCMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in a
+     routine from this module; otherwise returns FALSE.
+  *)
+
+END ComplexMath.
+
+@end example
+@page
+
+@node gm2-libs-iso/ConvStringLong, gm2-libs-iso/ConvStringReal, gm2-libs-iso/ComplexMath, M2 ISO Libraries
+@subsection gm2-libs-iso/ConvStringLong
+
+@example
+DEFINITION MODULE ConvStringLong ;
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   RealToFloatString - converts a real with, sigFigs, into a string
+                       and returns the result as a string.
+*)
+
+@findex RealToFloatString
+PROCEDURE RealToFloatString (real: LONGREAL; sigFigs: CARDINAL) : String ;
+
+
+(*
+   RealToEngString - converts the value of real to floating-point
+                     string form, with sigFigs significant figures.
+                     The number is scaled with one to three digits
+                     in the whole number part and with an exponent
+                     that is a multiple of three.
+*)
+
+@findex RealToEngString
+PROCEDURE RealToEngString (real: LONGREAL; sigFigs: CARDINAL) : String ;
+
+
+(*
+   RealToFixedString - returns the number of characters in the fixed-point
+                       string representation of real rounded to the given
+                       place relative to the decimal point.
+*)
+
+@findex RealToFixedString
+PROCEDURE RealToFixedString (real: LONGREAL; place: INTEGER) : String ;
+
+
+END ConvStringLong.
+@end example
+@page
+
+@node gm2-libs-iso/ConvStringReal, gm2-libs-iso/ConvTypes, gm2-libs-iso/ConvStringLong, M2 ISO Libraries
+@subsection gm2-libs-iso/ConvStringReal
+
+@example
+DEFINITION MODULE ConvStringReal ;
+
+FROM DynamicStrings IMPORT String ;
+
+
+(*
+   RealToFloatString - converts a real with, sigFigs, into a string
+                       and returns the result as a string.
+*)
+
+@findex RealToFloatString
+PROCEDURE RealToFloatString (real: REAL; sigFigs: CARDINAL) : String ;
+
+
+(*
+   RealToEngString - converts the value of real to floating-point
+                     string form, with sigFigs significant figures.
+                     The number is scaled with one to three digits
+                     in the whole number part and with an exponent
+                     that is a multiple of three.
+*)
+
+@findex RealToEngString
+PROCEDURE RealToEngString (real: REAL; sigFigs: CARDINAL) : String ;
+
+
+(*
+   RealToFixedString - returns the number of characters in the fixed-point
+                       string representation of real rounded to the given
+                       place relative to the decimal point.
+*)
+
+@findex RealToFixedString
+PROCEDURE RealToFixedString (real: REAL; place: INTEGER) : String ;
+
+
+END ConvStringReal.
+@end example
+@page
+
+@node gm2-libs-iso/ConvTypes, gm2-libs-iso/EXCEPTIONS, gm2-libs-iso/ConvStringReal, M2 ISO Libraries
+@subsection gm2-libs-iso/ConvTypes
+
+@example
+DEFINITION MODULE ConvTypes;
+
+  (* Common types used in the string conversion modules *)
+
+TYPE
+@findex ConvResults (type)
+  ConvResults =     (* Values of this type are used to express the format of a string *)
+  (
+    strAllRight,    (* the string format is correct for the corresponding conversion *)
+    strOutOfRange,  (* the string is well-formed but the value cannot be represented *)
+    strWrongFormat, (* the string is in the wrong format for the conversion *)
+    strEmpty        (* the given string is empty *)
+  );
+
+@findex ScanClass (type)
+  ScanClass =  (* Values of this type are used to classify input to finite state scanners *)
+  (
+    padding,   (* a leading or padding character at this point in the scan - ignore it *)
+    valid,     (* a valid character at this point in the scan - accept it *)
+    invalid,   (* an invalid character at this point in the scan - reject it *)
+    terminator (* a terminating character at this point in the scan (not part of token) *)
+  );
+
+@findex ScanState (type)
+  ScanState =  (* The type of lexical scanning control procedures *)
+    PROCEDURE (CHAR, VAR ScanClass, VAR ScanState);
+
+END ConvTypes.
+
+@end example
+@page
+
+@node gm2-libs-iso/EXCEPTIONS, gm2-libs-iso/ErrnoCategory, gm2-libs-iso/ConvTypes, M2 ISO Libraries
+@subsection gm2-libs-iso/EXCEPTIONS
+
+@example
+DEFINITION MODULE EXCEPTIONS;
+
+(* Provides facilities for raising user exceptions
+   and for making enquiries concerning the current execution state.
+*)
+
+TYPE
+  ExceptionSource;   (* values of this type are used within library
+                        modules to identify the source of raised
+                        exceptions *)
+@findex ExceptionNumber (type)
+  ExceptionNumber = CARDINAL;
+
+@findex AllocateSource
+PROCEDURE AllocateSource(VAR newSource: ExceptionSource);
+  (* Allocates a unique value of type ExceptionSource *)
+
+@findex RAISE
+PROCEDURE RAISE (source: ExceptionSource;
+                 number: ExceptionNumber; message: ARRAY OF CHAR);
+  (* Associates the given values of source, number and message with
+     the current context and raises an exception.
+  *)
+
+@findex CurrentNumber
+PROCEDURE CurrentNumber (source: ExceptionSource): ExceptionNumber;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from source, returns
+     the corresponding number, and otherwise raises an exception.
+  *)
+
+@findex GetMessage
+PROCEDURE GetMessage (VAR text: ARRAY OF CHAR);
+  (* If the current coroutine is in the exceptional execution state,
+     returns the possibly truncated string associated with the
+     current context.  Otherwise, in normal execution state,
+     returns the empty string.
+  *)
+
+@findex IsCurrentSource
+PROCEDURE IsCurrentSource (source: ExceptionSource): BOOLEAN;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from source, returns
+     TRUE, and otherwise returns FALSE.
+  *)
+
+@findex IsExceptionalExecution
+PROCEDURE IsExceptionalExecution (): BOOLEAN;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception, returns TRUE, and
+     otherwise returns FALSE.
+  *)
+
+END EXCEPTIONS.
+@end example
+@page
+
+@node gm2-libs-iso/ErrnoCategory, gm2-libs-iso/GeneralUserExceptions, gm2-libs-iso/EXCEPTIONS, M2 ISO Libraries
+@subsection gm2-libs-iso/ErrnoCategory
+
+@example
+DEFINITION MODULE ErrnoCategory ;
+
+(*
+   provides an interface to errno (if the system
+   supports it) which determines whether the current
+   errno is a hard or soft error.  These distinctions
+   are needed by the ISO Modula-2 libraries.  Not all
+   errno values are tested, only those which could be
+   related to a device.
+*)
+
+IMPORT ChanConsts ;
+
+
+(*
+   IsErrnoHard - returns TRUE if the value of errno is associated with
+                 a hard device error.
+*)
+
+@findex IsErrnoHard
+PROCEDURE IsErrnoHard (e: INTEGER) : BOOLEAN ;
+
+
+(*
+   IsErrnoSoft - returns TRUE if the value of errno is associated with
+                 a soft device error.
+*)
+
+@findex IsErrnoSoft
+PROCEDURE IsErrnoSoft (e: INTEGER) : BOOLEAN ;
+
+
+(*
+   UnAvailable - returns TRUE if the value of errno indicates that
+                 the resource or device is unavailable for some
+                 reason.
+*)
+
+@findex UnAvailable
+PROCEDURE UnAvailable (e: INTEGER) : BOOLEAN ;
+
+
+(*
+   GetOpenResults - maps errno onto the ISO Modula-2 enumerated
+                    type, OpenResults.
+*)
+
+@findex GetOpenResults
+PROCEDURE GetOpenResults (e: INTEGER) : ChanConsts.OpenResults ;
+
+
+END ErrnoCategory.
+@end example
+@page
+
+@node gm2-libs-iso/GeneralUserExceptions, gm2-libs-iso/IOChan, gm2-libs-iso/ErrnoCategory, M2 ISO Libraries
+@subsection gm2-libs-iso/GeneralUserExceptions
+
+@example
+DEFINITION MODULE GeneralUserExceptions;
+
+(* Provides facilities for general user-defined exceptions *)
+
+TYPE
+@findex GeneralExceptions (type)
+  GeneralExceptions = (problem, disaster);
+
+@findex RaiseGeneralException
+PROCEDURE RaiseGeneralException (exception: GeneralExceptions;
+                                 text: ARRAY OF CHAR);
+  (* Raises exception using text as the associated message *)
+
+@findex IsGeneralException
+PROCEDURE IsGeneralException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception from
+     GeneralExceptions; otherwise returns FALSE.
+  *)
+
+@findex GeneralException
+PROCEDURE GeneralException(): GeneralExceptions;
+  (* If the current coroutine is in the exceptional execution
+     state because of the raising of an exception from
+     GeneralExceptions, returns the corresponding enumeration value,
+     and otherwise raises an exception.
+  *)
+
+END GeneralUserExceptions.
+@end example
+@page
+
+@node gm2-libs-iso/IOChan, gm2-libs-iso/IOConsts, gm2-libs-iso/GeneralUserExceptions, M2 ISO Libraries
+@subsection gm2-libs-iso/IOChan
+
+@example
+DEFINITION MODULE IOChan;
+
+  (* Types and procedures forming the interface to channels for
+     device-independent data transfer modules
+  *)
+
+IMPORT IOConsts, ChanConsts, SYSTEM;
+
+TYPE
+  ChanId; (* Values of this type are used to identify channels *)
+
+  (* There is one pre-defined value identifying an invalid channel
+     on which no data transfer operations are available.  It may
+     be used to initialize variables of type ChanId.
+  *)
+
+@findex InvalidChan
+PROCEDURE InvalidChan (): ChanId;
+  (* Returns the value identifying the invalid channel. *)
+
+  (* For each of the following operations, if the device supports
+     the operation on the channel, the behaviour of the procedure
+     conforms with the description below.  The full behaviour is
+     defined for each device module.  If the device does not
+     support the operation on the channel, the behaviour of the
+     procedure is to raise the exception notAvailable.
+  *)
+
+  (* Text operations - these perform any required translation between the
+     internal and external representation of text.
+  *)
+
+@findex Look
+PROCEDURE Look (cid: ChanId; VAR ch: CHAR; VAR res: IOConsts.ReadResults);
+  (* If there is a character as the next item in the input stream
+     cid, assigns its value to ch without removing it from the stream;
+     otherwise the value of ch is not defined.  res (and the stored
+     read result) are set to the value allRight, endOfLine, or endOfInput.
+  *)
+
+@findex Skip
+PROCEDURE Skip (cid: ChanId);
+  (* If the input stream cid has ended, the exception skipAtEnd
+     is raised; otherwise the next character or line mark in cid is
+     removed, and the stored read result is set to the value
+     allRight.
+  *)
+
+@findex SkipLook
+PROCEDURE SkipLook (cid: ChanId; VAR ch: CHAR; VAR res: IOConsts.ReadResults);
+  (* If the input stream cid has ended, the exception skipAtEnd is
+     raised; otherwise the next character or line mark in cid is
+     removed.  If there is a character as the next item in cid
+     stream, assigns its value to ch without removing it from the
+     stream.  Otherwise, the value of ch is not defined.  res
+     (and the stored read result) are set to the value allRight,
+     endOfLine, or endOfInput.
+  *)
+
+@findex WriteLn
+PROCEDURE WriteLn (cid: ChanId);
+  (* Writes a line mark over the channel cid. *)
+
+@findex TextRead
+PROCEDURE TextRead (cid: ChanId; to: SYSTEM.ADDRESS; maxChars: CARDINAL;
+                    VAR charsRead: CARDINAL);
+  (* Reads at most maxChars characters from the current line in cid,
+     and assigns corresponding values to successive components of
+     an ARRAY OF CHAR variable for which the address of the first
+     component is to. The number of characters read is assigned to charsRead.
+     The stored read result is set to allRight, endOfLine, or endOfInput.
+  *)
+
+@findex TextWrite
+PROCEDURE TextWrite (cid: ChanId; from: SYSTEM.ADDRESS;
+                     charsToWrite: CARDINAL);
+  (* Writes a number of characters given by the value of charsToWrite,
+     from successive components of an ARRAY OF CHAR variable for which
+     the address of the first component is from, to the channel cid.
+  *)
+
+  (* Direct raw operations  - these do not effect translation between
+     the internal and external representation of data
+  *)
+
+@findex RawRead
+PROCEDURE RawRead (cid: ChanId; to: SYSTEM.ADDRESS; maxLocs: CARDINAL;
+                   VAR locsRead: CARDINAL);
+  (* Reads at most maxLocs items from cid, and assigns corresponding
+     values to successive components of an ARRAY OF LOC variable for
+     which the address of the first component is to. The number of
+     characters read is assigned to charsRead. The stored read result
+     is set to the value allRight, or endOfInput.
+  *)
+
+@findex RawWrite
+PROCEDURE RawWrite (cid: ChanId; from: SYSTEM.ADDRESS; locsToWrite: CARDINAL);
+  (* Writes a number of items given by the value of charsToWrite,
+     from successive components of an ARRAY OF LOC variable for
+     which the address of the first component is from, to the channel cid.
+  *)
+
+  (* Common operations *)
+
+@findex GetName
+PROCEDURE GetName (cid: ChanId; VAR s: ARRAY OF CHAR);
+  (* Copies to s a name associated with the channel cid, possibly truncated
+     (depending on the capacity of s).
+  *)
+
+@findex Reset
+PROCEDURE Reset (cid: ChanId);
+  (* Resets the channel cid to a state defined by the device module. *)
+
+@findex Flush
+PROCEDURE Flush (cid: ChanId);
+  (* Flushes any data buffered by the device module out to the channel cid. *)
+
+  (* Access to read results *)
+
+@findex SetReadResult
+PROCEDURE SetReadResult (cid: ChanId; res: IOConsts.ReadResults);
+  (* Sets the read result value for the channel cid to the value res. *)
+
+@findex ReadResult
+PROCEDURE ReadResult (cid: ChanId): IOConsts.ReadResults;
+  (* Returns the stored read result value for the channel cid.
+     (This is initially the value notKnown).
+  *)
+
+  (* Users can discover which flags actually apply to a channel *)
+
+@findex CurrentFlags
+PROCEDURE CurrentFlags (cid: ChanId): ChanConsts.FlagSet;
+  (* Returns the set of flags that currently apply to the channel cid. *)
+
+  (* The following exceptions are defined for this module and its clients *)
+
+TYPE
+@findex ChanExceptions (type)
+  ChanExceptions =
+    (wrongDevice,      (* device specific operation on wrong device *)
+     notAvailable,     (* operation attempted that is not available on that
+                          channel *)
+     skipAtEnd,        (* attempt to skip data from a stream that has ended *)
+     softDeviceError,  (* device specific recoverable error *)
+     hardDeviceError,  (* device specific non-recoverable error *)
+     textParseError,   (* input data does not correspond to a character or
+                          line mark - optional detection *)
+     notAChannel       (* given value does not identify a channel -
+                          optional detection *)
+    );
+
+@findex IsChanException
+PROCEDURE IsChanException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception from
+     ChanExceptions; otherwise returns FALSE.
+  *)
+
+@findex ChanException
+PROCEDURE ChanException (): ChanExceptions;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of an exception from ChanExceptions,
+     returns the corresponding enumeration value, and otherwise
+     raises an exception.
+  *)
+
+  (* When a device procedure detects a device error, it raises the
+     exception softDeviceError or hardDeviceError.  If these
+     exceptions are handled, the following facilities may be
+     used to discover an implementation-defined error number for
+     the channel.
+  *)
+
+TYPE
+@findex DeviceErrNum (type)
+  DeviceErrNum = INTEGER;
+
+@findex DeviceError
+PROCEDURE DeviceError (cid: ChanId): DeviceErrNum;
+  (* If a device error exception has been raised for the channel cid,
+     returns the error number stored by the device module.
+  *)
+
+END IOChan.
+@end example
+@page
+
+@node gm2-libs-iso/IOConsts, gm2-libs-iso/IOLink, gm2-libs-iso/IOChan, M2 ISO Libraries
+@subsection gm2-libs-iso/IOConsts
+
+@example
+DEFINITION MODULE IOConsts;
+
+  (* Types and constants for input/output modules *)
+
+TYPE
+@findex ReadResults (type)
+  ReadResults =  (* This type is used to classify the result of an input operation *)
+  (
+    notKnown,    (* no read result is set *)
+    allRight,    (* data is as expected or as required *)
+    outOfRange,  (* data cannot be represented *)
+    wrongFormat, (* data not in expected format *)
+    endOfLine,   (* end of line seen before expected data *)
+    endOfInput   (* end of input seen before expected data *)
+  );
+
+END IOConsts.
+
+@end example
+@page
+
+@node gm2-libs-iso/IOLink, gm2-libs-iso/IOResult, gm2-libs-iso/IOConsts, M2 ISO Libraries
+@subsection gm2-libs-iso/IOLink
+
+@example
+DEFINITION MODULE IOLink;
+
+(* Types and procedures for the standard implementation of channels *)
+
+IMPORT IOChan, IOConsts, ChanConsts, SYSTEM;
+
+TYPE
+  DeviceId;
+    (* Values of this type are used to identify new device modules,
+       and are normally obtained by them during their initialization.
+    *)
+
+@findex AllocateDeviceId
+PROCEDURE AllocateDeviceId (VAR did: DeviceId);
+  (* Allocates a unique value of type DeviceId, and assigns this
+     value to did. *)
+
+@findex MakeChan
+PROCEDURE MakeChan (did: DeviceId; VAR cid: IOChan.ChanId);
+  (* Attempts to make a new channel for the device module identified
+     by did. If no more channels can be made, the identity of
+     the invalid channel is assigned to cid.  Otherwise, the identity
+     of a new channel is assigned to cid.
+  *)
+
+@findex UnMakeChan
+PROCEDURE UnMakeChan (did: DeviceId; VAR cid: IOChan.ChanId);
+  (* If the device module identified by did is not the module that
+     made the channel identified by cid, the exception wrongDevice is
+     raised; otherwise the channel is deallocated, and the value
+     identifying the invalid channel is assigned to cid.
+  *)
+
+TYPE
+@findex DeviceTablePtr (type)
+  DeviceTablePtr = POINTER TO DeviceTable;
+    (* Values of this type are used to refer to device tables *)
+
+TYPE
+@findex LookProc (type)
+  LookProc      = PROCEDURE (DeviceTablePtr, VAR CHAR, VAR IOConsts.ReadResults) ;
+@findex SkipProc (type)
+  SkipProc      = PROCEDURE (DeviceTablePtr) ;
+@findex SkipLookProc (type)
+  SkipLookProc  = PROCEDURE (DeviceTablePtr, VAR CHAR, VAR IOConsts.ReadResults) ;
+@findex WriteLnProc (type)
+  WriteLnProc   = PROCEDURE (DeviceTablePtr) ;
+@findex TextReadProc (type)
+  TextReadProc  = PROCEDURE (DeviceTablePtr, SYSTEM.ADDRESS, CARDINAL, VAR CARDINAL) ;
+@findex TextWriteProc (type)
+  TextWriteProc = PROCEDURE (DeviceTablePtr, SYSTEM.ADDRESS, CARDINAL) ;
+@findex RawReadProc (type)
+  RawReadProc   = PROCEDURE (DeviceTablePtr, SYSTEM.ADDRESS, CARDINAL, VAR CARDINAL) ;
+@findex RawWriteProc (type)
+  RawWriteProc  = PROCEDURE (DeviceTablePtr, SYSTEM.ADDRESS, CARDINAL) ;
+@findex GetNameProc (type)
+  GetNameProc   = PROCEDURE (DeviceTablePtr, VAR ARRAY OF CHAR) ;
+@findex ResetProc (type)
+  ResetProc     = PROCEDURE (DeviceTablePtr) ;
+@findex FlushProc (type)
+  FlushProc     = PROCEDURE (DeviceTablePtr) ;
+@findex FreeProc (type)
+  FreeProc      = PROCEDURE (DeviceTablePtr) ;
+     (* Carry out the operations involved in closing the corresponding
+        channel, including flushing buffers, but do not unmake the
+        channel.
+     *)
+
+
+TYPE
+@findex DeviceData (type)
+  DeviceData = SYSTEM.ADDRESS;
+
+@findex DeviceTable (type)
+  DeviceTable =
+    RECORD                         (* Initialized by MakeChan to: *)
+      cd: DeviceData;              (* the value NIL *)
+      did: DeviceId;               (* the value given in the call of MakeChan *)
+      cid: IOChan.ChanId;          (* the identity of the channel *)
+      result: IOConsts.ReadResults;(* the value notKnown *)
+      errNum: IOChan.DeviceErrNum; (* undefined *)
+      flags: ChanConsts.FlagSet;   (* ChanConsts.FlagSet@{@} *)
+      doLook: LookProc;            (* raise exception notAvailable *)
+      doSkip: SkipProc;            (* raise exception notAvailable *)
+      doSkipLook: SkipLookProc;    (* raise exception notAvailable *)
+      doLnWrite: WriteLnProc;      (* raise exception notAvailable *)
+      doTextRead: TextReadProc;    (* raise exception notAvailable *)
+      doTextWrite: TextWriteProc;  (* raise exception notAvailable *)
+      doRawRead: RawReadProc;      (* raise exception notAvailable *)
+      doRawWrite: RawWriteProc;    (* raise exception notAvailable *)
+      doGetName: GetNameProc;      (* return the empty string *)
+      doReset: ResetProc;          (* do nothing *)
+      doFlush: FlushProc;          (* do nothing *)
+      doFree: FreeProc;            (* do nothing *)
+    END;
+
+
+  (* The pointer to the device table for a channel is obtained using the
+     following procedure: *)
+
+(*
+   If the device module identified by did is not the module that made
+   the channel identified by cid, the exception wrongDevice is raised.
+*)
+
+@findex DeviceTablePtrValue
+PROCEDURE DeviceTablePtrValue (cid: IOChan.ChanId; did: DeviceId): DeviceTablePtr;
+
+
+(*
+   Tests if the device module identified by did is the module
+   that made the channel identified by cid.
+*)
+
+@findex IsDevice
+PROCEDURE IsDevice (cid: IOChan.ChanId; did: DeviceId) : BOOLEAN;
+
+
+TYPE
+@findex DevExceptionRange (type)
+  DevExceptionRange = IOChan.ChanExceptions;
+
+(*
+  ISO standard states defines
+
+  DevExceptionRange = [IOChan.notAvailable ..  IOChan.textParseError];
+
+  however this must be a bug as other modules need to raise
+  IOChan.wrongDevice exceptions.
+*)
+
+@findex RAISEdevException
+PROCEDURE RAISEdevException (cid: IOChan.ChanId; did: DeviceId;
+                             x: DevExceptionRange; s: ARRAY OF CHAR);
+
+  (* If the device module identified by did is not the module that made the channel
+     identified by cid, the exception wrongDevice is raised; otherwise the given exception
+     is raised, and the string value in s is included in the exception message.
+  *)
+
+@findex IsIOException
+PROCEDURE IsIOException () : BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising af an exception from ChanExceptions;
+     otherwise FALSE.
+  *)
+
+@findex IOException
+PROCEDURE IOException () : IOChan.ChanExceptions;
+  (* If the current coroutine is in the exceptional execution state because of the
+     raising af an exception from ChanExceptions, returns the corresponding
+     enumeration value, and otherwise raises an exception.
+  *)
+
+END IOLink.
+@end example
+@page
+
+@node gm2-libs-iso/IOResult, gm2-libs-iso/LongComplexMath, gm2-libs-iso/IOLink, M2 ISO Libraries
+@subsection gm2-libs-iso/IOResult
+
+@example
+DEFINITION MODULE IOResult;
+
+  (* Read results for specified channels *)
+
+IMPORT IOConsts, IOChan;
+
+TYPE
+@findex ReadResults (type)
+  ReadResults = IOConsts.ReadResults;
+
+  (*
+@findex ReadResults (type)
+    ReadResults =  (* This type is used to classify the result of an input operation *)
+    (
+      notKnown,    (* no read result is set *)
+      allRight,    (* data is as expected or as required *)
+      outOfRange,  (* data cannot be represented *)
+      wrongFormat, (* data not in expected format *)
+      endOfLine,   (* end of line seen before expected data *)
+      endOfInput   (* end of input seen before expected data *)
+    );
+  *)
+
+@findex ReadResult
+PROCEDURE ReadResult (cid: IOChan.ChanId): ReadResults;
+  (* Returns the result for the last read operation on the channel cid. *)
+
+END IOResult.
+
+@end example
+@page
+
+@node gm2-libs-iso/LongComplexMath, gm2-libs-iso/LongConv, gm2-libs-iso/IOResult, M2 ISO Libraries
+@subsection gm2-libs-iso/LongComplexMath
+
+@example
+DEFINITION MODULE LongComplexMath;
+
+  (* Mathematical functions for the type LONGCOMPLEX *)
+
+CONST
+@findex i (const)
+  i =    CMPLX (0.0, 1.0);
+@findex one (const)
+  one =  CMPLX (1.0, 0.0);
+@findex zero (const)
+  zero = CMPLX (0.0, 0.0);
+
+@findex abs
+PROCEDURE abs (z: LONGCOMPLEX): LONGREAL;
+  (* Returns the length of z *)
+
+@findex arg
+PROCEDURE arg (z: LONGCOMPLEX): LONGREAL;
+  (* Returns the angle that z subtends to the positive real axis *)
+
+@findex conj
+PROCEDURE conj (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the complex conjugate of z *)
+
+@findex power
+PROCEDURE power (base: LONGCOMPLEX; exponent: LONGREAL): LONGCOMPLEX;
+  (* Returns the value of the number base raised to the power exponent *)
+
+@findex sqrt
+PROCEDURE sqrt (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the principal square root of z *)
+
+@findex exp
+PROCEDURE exp (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the complex exponential of z *)
+
+@findex ln
+PROCEDURE ln (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the principal value of the natural logarithm of z *)
+
+@findex sin
+PROCEDURE sin (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the sine of z *)
+
+@findex cos
+PROCEDURE cos (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the cosine of z *)
+
+@findex tan
+PROCEDURE tan (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the tangent of z *)
+
+@findex arcsin
+PROCEDURE arcsin (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the arcsine of z *)
+
+@findex arccos
+PROCEDURE arccos (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the arccosine of z *)
+
+@findex arctan
+PROCEDURE arctan (z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the arctangent of z *)
+
+@findex polarToComplex
+PROCEDURE polarToComplex (abs, arg: LONGREAL): LONGCOMPLEX;
+  (* Returns the complex number with the specified polar coordinates *)
+
+@findex scalarMult
+PROCEDURE scalarMult (scalar: LONGREAL; z: LONGCOMPLEX): LONGCOMPLEX;
+  (* Returns the scalar product of scalar with z *)
+
+@findex IsCMathException
+PROCEDURE IsCMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END LongComplexMath.
+
+@end example
+@page
+
+@node gm2-libs-iso/LongConv, gm2-libs-iso/LongIO, gm2-libs-iso/LongComplexMath, M2 ISO Libraries
+@subsection gm2-libs-iso/LongConv
+
+@example
+DEFINITION MODULE LongConv;
+
+  (* Low-level LONGREAL/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+@findex ConvResults (type)
+  ConvResults = ConvTypes.ConvResults; (* strAllRight, strOutOfRange,
+                                          strWrongFormat, strEmpty *)
+
+@findex ScanReal
+PROCEDURE ScanReal (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState);
+  (* Represents the start state of a finite state scanner for real
+     numbers - assigns class of inputCh to chClass and a procedure
+     representing the next state to nextState.
+  *)
+
+@findex FormatReal
+PROCEDURE FormatReal (str: ARRAY OF CHAR): ConvResults;
+  (* Returns the format of the string value for conversion to LONGREAL. *)
+
+@findex ValueReal
+PROCEDURE ValueReal (str: ARRAY OF CHAR): LONGREAL;
+  (* Returns the value corresponding to the real number string value
+     str if str is well-formed; otherwise raises the LongConv exception.
+  *)
+
+@findex LengthFloatReal
+PROCEDURE LengthFloatReal (real: LONGREAL; sigFigs: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the floating-point string
+     representation of real with sigFigs significant figures.
+  *)
+
+@findex LengthEngReal
+PROCEDURE LengthEngReal (real: LONGREAL; sigFigs: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the floating-point engineering
+     string representation of real with sigFigs significant figures.
+  *)
+
+@findex LengthFixedReal
+PROCEDURE LengthFixedReal (real: LONGREAL; place: INTEGER): CARDINAL;
+  (* Returns the number of characters in the fixed-point string
+     representation of real rounded to the given place relative to the
+     decimal point.
+  *)
+
+@findex IsRConvException
+PROCEDURE IsRConvException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in a
+     routine from this module; otherwise returns FALSE.
+  *)
+
+END LongConv.
+
+@end example
+@page
+
+@node gm2-libs-iso/LongIO, gm2-libs-iso/LongMath, gm2-libs-iso/LongConv, M2 ISO Libraries
+@subsection gm2-libs-iso/LongIO
+
+@example
+DEFINITION MODULE LongIO;
+
+  (* Input and output of long real numbers in decimal text form
+     over specified channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, @{decimal digit@}, [".",
+       @{decimal digit@}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadReal
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: LONGREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed fixed or floating
+     point number.  The value of this number is assigned to real.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteFloat
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: LONGREAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to cid in floating-point text form,
+     with sigFigs significant figures, in a field of the given
+     minimum width.
+  *)
+
+@findex WriteEng
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: LONGREAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+@findex WriteFixed
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: LONGREAL;
+                      place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to cid in fixed-point text form,
+     rounded to the given place relative to the decimal point,
+     in a field of the given minimum width.
+  *)
+
+@findex WriteReal
+PROCEDURE WriteReal (cid: IOChan.ChanId; real: LONGREAL;
+                     width: CARDINAL);
+  (* Writes the value of real to cid, as WriteFixed if the
+     sign and magnitude can be shown in the given width, or
+     otherwise as WriteFloat.  The number of places or
+     significant digits depends on the given width.
+  *)
+
+END LongIO.
+
+@end example
+@page
+
+@node gm2-libs-iso/LongMath, gm2-libs-iso/LongStr, gm2-libs-iso/LongIO, M2 ISO Libraries
+@subsection gm2-libs-iso/LongMath
+
+@example
+DEFINITION MODULE LongMath;
+
+  (* Mathematical functions for the type LONGREAL *)
+
+CONST
+@findex pi (const)
+  pi   = 3.1415926535897932384626433832795028841972;
+@findex exp1 (const)
+  exp1 = 2.7182818284590452353602874713526624977572;
+
+@findex sqrt
+PROCEDURE __BUILTIN__ sqrt (x: LONGREAL): LONGREAL;
+  (* Returns the positive square root of x *)
+
+@findex exp
+PROCEDURE __BUILTIN__ exp (x: LONGREAL): LONGREAL;
+  (* Returns the exponential of x *)
+
+@findex ln
+PROCEDURE __BUILTIN__ ln (x: LONGREAL): LONGREAL;
+  (* Returns the natural logarithm of x *)
+
+  (* The angle in all trigonometric functions is measured in radians *)
+
+@findex sin
+PROCEDURE __BUILTIN__ sin (x: LONGREAL): LONGREAL;
+  (* Returns the sine of x *)
+
+@findex cos
+PROCEDURE __BUILTIN__ cos (x: LONGREAL): LONGREAL;
+  (* Returns the cosine of x *)
+
+@findex tan
+PROCEDURE tan (x: LONGREAL): LONGREAL;
+  (* Returns the tangent of x *)
+
+@findex arcsin
+PROCEDURE arcsin (x: LONGREAL): LONGREAL;
+  (* Returns the arcsine of x *)
+
+@findex arccos
+PROCEDURE arccos (x: LONGREAL): LONGREAL;
+  (* Returns the arccosine of x *)
+
+@findex arctan
+PROCEDURE arctan (x: LONGREAL): LONGREAL;
+  (* Returns the arctangent of x *)
+
+@findex power
+PROCEDURE power (base, exponent: LONGREAL): LONGREAL;
+  (* Returns the value of the number base raised to the power exponent *)
+
+@findex round
+PROCEDURE round (x: LONGREAL): INTEGER;
+  (* Returns the value of x rounded to the nearest integer *)
+
+@findex IsRMathException
+PROCEDURE IsRMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in a
+     routine from this module; otherwise returns FALSE.
+  *)
+
+END LongMath.
+
+@end example
+@page
+
+@node gm2-libs-iso/LongStr, gm2-libs-iso/LongWholeIO, gm2-libs-iso/LongMath, M2 ISO Libraries
+@subsection gm2-libs-iso/LongStr
+
+@example
+DEFINITION MODULE LongStr;
+
+  (* LONGREAL/string conversions *)
+
+IMPORT
+   ConvTypes;
+
+TYPE
+   (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+@findex ConvResults (type)
+   ConvResults = ConvTypes.ConvResults;
+
+(* the string form of a signed fixed-point real number is
+     ["+" | "-"], decimal digit, @{decimal digit@}, [".",
+     @{decimal digit@}]
+*)
+
+(* the string form of a signed floating-point real number is
+     signed fixed-point real number, "E", ["+" | "-"],
+     decimal digit, @{decimal digit@}
+*)
+
+@findex StrToReal
+PROCEDURE StrToReal (str: ARRAY OF CHAR; VAR real: LONGREAL;
+                     VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent characters
+     in str are in the format of a signed real number, assigns a
+     corresponding value to real.  Assigns a value indicating the
+     format of str to res.
+  *)
+
+@findex RealToFloat
+PROCEDURE RealToFloat (real: LONGREAL; sigFigs: CARDINAL;
+                       VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.
+  *)
+
+@findex RealToEng
+PROCEDURE RealToEng (real: LONGREAL; sigFigs: CARDINAL;
+                     VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str. The number is scaled with one to three digits
+     in the whole number part and with an exponent that is a
+     multiple of three.
+  *)
+
+@findex RealToFixed
+PROCEDURE RealToFixed (real: LONGREAL; place: INTEGER;
+                       VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to fixed-point string form, rounded
+     to the given place relative to the decimal point, and copies
+     the possibly truncated result to str.
+  *)
+
+@findex RealToStr
+PROCEDURE RealToStr (real: LONGREAL; VAR str: ARRAY OF CHAR);
+  (* Converts the value of real as RealToFixed if the sign and
+     magnitude can be shown within the capacity of str, or
+     otherwise as RealToFloat, and copies the possibly truncated
+     result to str. The number of places or significant digits
+     depend on the capacity of str.
+  *)
+
+END LongStr.
+
+@end example
+@page
+
+@node gm2-libs-iso/LongWholeIO, gm2-libs-iso/LowLong, gm2-libs-iso/LongStr, M2 ISO Libraries
+@subsection gm2-libs-iso/LongWholeIO
+
+@example
+DEFINITION MODULE LongWholeIO;
+
+  (* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, @{decimal digit@}
+
+     The text form of an unsigned whole number is
+       decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadInt
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: LONGINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+@findex WriteInt
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: LONGINT;
+                    width: CARDINAL);
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+
+@findex ReadCard
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: LONGCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+@findex WriteCard
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: LONGCARD;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+
+END LongWholeIO.
+@end example
+@page
+
+@node gm2-libs-iso/LowLong, gm2-libs-iso/LowReal, gm2-libs-iso/LongWholeIO, M2 ISO Libraries
+@subsection gm2-libs-iso/LowLong
+
+@example
+DEFINITION MODULE LowLong;
+
+  (* Access to underlying properties of the type LONGREAL *)
+
+CONST
+@findex radix (const)
+  radix      = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, radix> )) ;      (* ZType *)
+@findex places (const)
+  places     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, places> )) ;     (* ZType *)
+@findex expoMin (const)
+  expoMin    = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, expoMin> )) ;    (* ZType *)
+@findex expoMax (const)
+  expoMax    = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, expoMax> )) ;    (* ZType *)
+@findex large (const)
+  large      = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, large> )) ;      (* RType *)
+@findex small (const)
+  small      = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, small> )) ;      (* RType *)
+@findex IEC559 (const)
+  IEC559     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, IEC559> )) ;     (* BOOLEAN *)
+@findex LIA1 (const)
+  LIA1       = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, LIA1> )) ;       (* BOOLEAN *)
+@findex ISO (const)
+  ISO        = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, ISO> )) ;        (* BOOLEAN *)
+@findex IEEE (const)
+  IEEE       = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, IEEE> )) ;       (* BOOLEAN *)
+@findex rounds (const)
+  rounds     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, rounds> )) ;     (* BOOLEAN *)
+@findex gUnderflow (const)
+  gUnderflow = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, gUnderflow> )) ; (* BOOLEAN *)
+@findex exception (const)
+  exception  = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, exception> )) ;  (* BOOLEAN *)
+@findex extend (const)
+  extend     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, extend> )) ;     (* BOOLEAN *)
+@findex nModes (const)
+  nModes     = __ATTRIBUTE__ __BUILTIN__ (( <LONGREAL, nModes> )) ;     (* ZType *)
+
+TYPE
+@findex Modes (type)
+  Modes = PACKEDSET OF [0 .. nModes-1];
+
+@findex exponent
+PROCEDURE exponent (x: LONGREAL): INTEGER;
+  (* Returns the exponent value of x *)
+
+@findex fraction
+PROCEDURE fraction (x: LONGREAL): LONGREAL;
+  (* Returns the significand (or significant part) of x *)
+
+@findex sign
+PROCEDURE sign (x: LONGREAL): LONGREAL;
+  (* Returns the signum of x *)
+
+@findex succ
+PROCEDURE succ (x: LONGREAL): LONGREAL;
+  (* Returns the next value of the type LONGREAL greater than x *)
+
+@findex ulp
+PROCEDURE ulp (x: LONGREAL): LONGREAL;
+  (* Returns the value of a unit in the last place of x *)
+
+@findex pred
+PROCEDURE pred (x: LONGREAL): LONGREAL;
+  (* Returns the previous value of the type LONGREAL less than x *)
+
+@findex intpart
+PROCEDURE intpart (x: LONGREAL): LONGREAL;
+  (* Returns the integer part of x *)
+
+@findex fractpart
+PROCEDURE fractpart (x: LONGREAL): LONGREAL;
+  (* Returns the fractional part of x *)
+
+@findex scale
+PROCEDURE scale (x: LONGREAL; n: INTEGER): LONGREAL;
+  (* Returns the value of x * radix ** n *)
+
+@findex trunc
+PROCEDURE trunc (x: LONGREAL; n: INTEGER): LONGREAL;
+  (* Returns the value of the first n places of x *)
+
+@findex round
+PROCEDURE round (x: LONGREAL; n: INTEGER): LONGREAL;
+  (* Returns the value of x rounded to the first n places *)
+
+@findex synthesize
+PROCEDURE synthesize (expart: INTEGER; frapart: LONGREAL): LONGREAL;
+  (* Returns a value of the type LONGREAL constructed from the given expart and frapart *)
+
+@findex setMode
+PROCEDURE setMode (m: Modes);
+  (* Sets status flags appropriate to the underlying implementation of the type LONGREAL *)
+
+@findex currentMode
+PROCEDURE currentMode (): Modes;
+  (* Returns the current status flags in the form set by setMode *)
+
+@findex IsLowException
+PROCEDURE IsLowException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END LowLong.
+
+@end example
+@page
+
+@node gm2-libs-iso/LowReal, gm2-libs-iso/LowShort, gm2-libs-iso/LowLong, M2 ISO Libraries
+@subsection gm2-libs-iso/LowReal
+
+@example
+DEFINITION MODULE LowReal;
+
+  (* Access to underlying properties of the type REAL *)
+
+CONST
+@findex radix (const)
+  radix      = __ATTRIBUTE__ __BUILTIN__ (( <REAL, radix> )) ;      (* ZType *)
+@findex places (const)
+  places     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, places> )) ;     (* ZType *)
+@findex expoMin (const)
+  expoMin    = __ATTRIBUTE__ __BUILTIN__ (( <REAL, expoMin> )) ;    (* ZType *)
+@findex expoMax (const)
+  expoMax    = __ATTRIBUTE__ __BUILTIN__ (( <REAL, expoMax> )) ;    (* ZType *)
+@findex large (const)
+  large      = __ATTRIBUTE__ __BUILTIN__ (( <REAL, large> )) ;      (* RType *)
+@findex small (const)
+  small      = __ATTRIBUTE__ __BUILTIN__ (( <REAL, small> )) ;      (* RType *)
+@findex IEC559 (const)
+  IEC559     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, IEC559> )) ;     (* BOOLEAN *)
+@findex LIA1 (const)
+  LIA1       = __ATTRIBUTE__ __BUILTIN__ (( <REAL, LIA1> )) ;       (* BOOLEAN *)
+@findex ISO (const)
+  ISO        = __ATTRIBUTE__ __BUILTIN__ (( <REAL, ISO> )) ;        (* BOOLEAN *)
+@findex IEEE (const)
+  IEEE       = __ATTRIBUTE__ __BUILTIN__ (( <REAL, IEEE> )) ;       (* BOOLEAN *)
+@findex rounds (const)
+  rounds     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, rounds> )) ;     (* BOOLEAN *)
+@findex gUnderflow (const)
+  gUnderflow = __ATTRIBUTE__ __BUILTIN__ (( <REAL, gUnderflow> )) ; (* BOOLEAN *)
+@findex exception (const)
+  exception  = __ATTRIBUTE__ __BUILTIN__ (( <REAL, exception> )) ;  (* BOOLEAN *)
+@findex extend (const)
+  extend     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, extend> )) ;     (* BOOLEAN *)
+@findex nModes (const)
+  nModes     = __ATTRIBUTE__ __BUILTIN__ (( <REAL, nModes> )) ;     (* ZType *)
+
+TYPE
+@findex Modes (type)
+  Modes = PACKEDSET OF [0..nModes-1];
+
+@findex exponent
+PROCEDURE exponent (x: REAL): INTEGER;
+  (* Returns the exponent value of x *)
+
+@findex fraction
+PROCEDURE fraction (x: REAL): REAL;
+  (* Returns the significand (or significant part) of x *)
+
+@findex sign
+PROCEDURE sign (x: REAL): REAL;
+  (* Returns the signum of x *)
+
+@findex succ
+PROCEDURE succ (x: REAL): REAL;
+  (* Returns the next value of the type REAL greater than x *)
+
+@findex ulp
+PROCEDURE ulp (x: REAL): REAL;
+  (* Returns the value of a unit in the last place of x *)
+
+@findex pred
+PROCEDURE pred (x: REAL): REAL;
+  (* Returns the previous value of the type REAL less than x *)
+
+@findex intpart
+PROCEDURE intpart (x: REAL): REAL;
+  (* Returns the integer part of x *)
+
+@findex fractpart
+PROCEDURE fractpart (x: REAL): REAL;
+  (* Returns the fractional part of x *)
+
+@findex scale
+PROCEDURE scale (x: REAL; n: INTEGER): REAL;
+  (* Returns the value of x * radix ** n *)
+
+@findex trunc
+PROCEDURE trunc (x: REAL; n: INTEGER): REAL;
+  (* Returns the value of the first n places of x *)
+
+@findex round
+PROCEDURE round (x: REAL; n: INTEGER): REAL;
+  (* Returns the value of x rounded to the first n places *)
+
+@findex synthesize
+PROCEDURE synthesize (expart: INTEGER; frapart: REAL): REAL;
+  (* Returns a value of the type REAL constructed from the given expart and frapart *)
+
+@findex setMode
+PROCEDURE setMode (m: Modes);
+  (* Sets status flags appropriate to the underlying implementation of the type REAL *)
+
+@findex currentMode
+PROCEDURE currentMode (): Modes;
+  (* Returns the current status flags in the form set by setMode *)
+
+@findex IsLowException
+PROCEDURE IsLowException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END LowReal.
+
+@end example
+@page
+
+@node gm2-libs-iso/LowShort, gm2-libs-iso/M2EXCEPTION, gm2-libs-iso/LowReal, M2 ISO Libraries
+@subsection gm2-libs-iso/LowShort
+
+@example
+DEFINITION MODULE LowShort;
+
+  (* Access to underlying properties of the type SHORTREAL *)
+
+CONST
+@findex radix (const)
+  radix      = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, radix> )) ;      (* ZType *)
+@findex places (const)
+  places     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, places> )) ;     (* ZType *)
+@findex expoMin (const)
+  expoMin    = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, expoMin> )) ;    (* ZType *)
+@findex expoMax (const)
+  expoMax    = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, expoMax> )) ;    (* ZType *)
+@findex large (const)
+  large      = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, large> )) ;      (* RType *)
+@findex small (const)
+  small      = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, small> )) ;      (* RType *)
+@findex IEC559 (const)
+  IEC559     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, IEC559> )) ;     (* BOOLEAN *)
+@findex LIA1 (const)
+  LIA1       = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, LIA1> )) ;       (* BOOLEAN *)
+@findex ISO (const)
+  ISO        = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, ISO> )) ;        (* BOOLEAN *)
+@findex IEEE (const)
+  IEEE       = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, IEEE> )) ;       (* BOOLEAN *)
+@findex rounds (const)
+  rounds     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, rounds> )) ;     (* BOOLEAN *)
+@findex gUnderflow (const)
+  gUnderflow = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, gUnderflow> )) ; (* BOOLEAN *)
+@findex exception (const)
+  exception  = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, exception> )) ;  (* BOOLEAN *)
+@findex extend (const)
+  extend     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, extend> )) ;     (* BOOLEAN *)
+@findex nModes (const)
+  nModes     = __ATTRIBUTE__ __BUILTIN__ (( <SHORTREAL, nModes> )) ;     (* ZType *)
+
+TYPE
+@findex Modes (type)
+  Modes = PACKEDSET OF [0 .. nModes-1];
+
+@findex exponent
+PROCEDURE exponent (x: SHORTREAL): INTEGER;
+  (* Returns the exponent value of x *)
+
+@findex fraction
+PROCEDURE fraction (x: SHORTREAL): SHORTREAL;
+  (* Returns the significand (or significant part) of x *)
+
+@findex sign
+PROCEDURE sign (x: SHORTREAL): SHORTREAL;
+  (* Returns the signum of x *)
+
+@findex succ
+PROCEDURE succ (x: SHORTREAL): SHORTREAL;
+  (* Returns the next value of the type SHORTREAL greater than x *)
+
+@findex ulp
+PROCEDURE ulp (x: SHORTREAL): SHORTREAL;
+  (* Returns the value of a unit in the last place of x *)
+
+@findex pred
+PROCEDURE pred (x: SHORTREAL): SHORTREAL;
+  (* Returns the previous value of the type SHORTREAL less than x *)
+
+@findex intpart
+PROCEDURE intpart (x: SHORTREAL): SHORTREAL;
+  (* Returns the integer part of x *)
+
+@findex fractpart
+PROCEDURE fractpart (x: SHORTREAL): SHORTREAL;
+  (* Returns the fractional part of x *)
+
+@findex scale
+PROCEDURE scale (x: SHORTREAL; n: INTEGER): SHORTREAL;
+  (* Returns the value of x * radix ** n *)
+
+@findex trunc
+PROCEDURE trunc (x: SHORTREAL; n: INTEGER): SHORTREAL;
+  (* Returns the value of the first n places of x *)
+
+@findex round
+PROCEDURE round (x: SHORTREAL; n: INTEGER): SHORTREAL;
+  (* Returns the value of x rounded to the first n places *)
+
+@findex synthesize
+PROCEDURE synthesize (expart: INTEGER; frapart: SHORTREAL): SHORTREAL;
+  (* Returns a value of the type SHORTREAL constructed from the given expart and frapart *)
+
+@findex setMode
+PROCEDURE setMode (m: Modes);
+  (* Sets status flags appropriate to the underlying implementation of the type SHORTREAL *)
+
+@findex currentMode
+PROCEDURE currentMode (): Modes;
+  (* Returns the current status flags in the form set by setMode *)
+
+@findex IsLowException
+PROCEDURE IsLowException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END LowShort.
+@end example
+@page
+
+@node gm2-libs-iso/M2EXCEPTION, gm2-libs-iso/M2RTS, gm2-libs-iso/LowShort, M2 ISO Libraries
+@subsection gm2-libs-iso/M2EXCEPTION
+
+@example
+DEFINITION MODULE M2EXCEPTION;
+
+(* Provides facilities for identifying language exceptions *)
+
+TYPE
+@findex M2Exceptions (type)
+  M2Exceptions =
+    (indexException,     rangeException,         caseSelectException,  invalidLocation,
+     functionException,  wholeValueException,    wholeDivException,    realValueException,
+     realDivException,   complexValueException,  complexDivException,  protException,
+     sysException,       coException,            exException
+    );
+
+@findex M2Exception
+PROCEDURE M2Exception (): M2Exceptions;
+  (* If the current coroutine is in the exceptional execution state because of the raising
+     of a language exception, returns the corresponding enumeration value, and otherwise
+     raises an exception.
+  *)
+
+@findex IsM2Exception
+PROCEDURE IsM2Exception (): BOOLEAN;
+  (* If the current coroutine is in the exceptional execution state because of the raising
+     of a language exception, returns TRUE, and otherwise returns FALSE.
+  *)
+
+END M2EXCEPTION.
+@end example
+@page
+
+@node gm2-libs-iso/M2RTS, gm2-libs-iso/MemStream, gm2-libs-iso/M2EXCEPTION, M2 ISO Libraries
+@subsection gm2-libs-iso/M2RTS
+
+@example
+DEFINITION MODULE M2RTS ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+@findex ArgCVEnvP (type)
+   ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+@findex ConstructModules
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+                            argc: INTEGER; argv, envp: ADDRESS) ;
+
+@findex DeconstructModules
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+                              argc: INTEGER; argv, envp: ADDRESS) ;
+
+
+(*
+   RegisterModule - adds module name to the list of outstanding
+                    modules which need to have their dependencies
+                    explored to determine initialization order.
+*)
+
+@findex RegisterModule
+PROCEDURE RegisterModule (name: ADDRESS;
+                          init, fini:  ArgCVEnvP;
+                          dependencies: PROC) ;
+
+
+(*
+   RequestDependant - used to specify that modulename is dependant upon
+                      module dependantmodule.
+*)
+
+@findex RequestDependant
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+
+(*
+   ExecuteTerminationProcedures - calls each installed termination
+                                  procedure in reverse order.
+*)
+
+@findex ExecuteTerminationProcedures
+PROCEDURE ExecuteTerminationProcedures ;
+
+
+(*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE is the
+                                 procedure is installed.
+*)
+
+@findex InstallTerminationProcedure
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   ExecuteInitialProcedures - executes the initial procedures installed
+                              by InstallInitialProcedure.
+*)
+
+@findex ExecuteInitialProcedures
+PROCEDURE ExecuteInitialProcedures ;
+
+
+(*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the main
+                             program module.
+*)
+
+@findex InstallInitialProcedure
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+@findex HALT
+PROCEDURE HALT ([exitcode: INTEGER = -1]) ;
+
+
+(*
+   Halt - provides a more user friendly version of HALT, which takes
+          four parameters to aid debugging.
+*)
+
+@findex Halt
+PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+                function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
+
+
+(*
+   ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*)
+
+@findex ExitOnHalt
+PROCEDURE ExitOnHalt (e: INTEGER) ;
+
+
+(*
+   ErrorMessage - emits an error message to stderr and then calls exit (1).
+*)
+
+@findex ErrorMessage
+PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
+                        file: ARRAY OF CHAR;
+                        line: CARDINAL;
+                        function: ARRAY OF CHAR) ;
+
+
+(*
+   IsTerminating - Returns true if any coroutine has started program termination
+                   and false otherwise.
+*)
+
+@findex IsTerminating
+PROCEDURE IsTerminating () : BOOLEAN ;
+
+
+(*
+   HasHalted - Returns true if a call to HALT has been made and false
+               otherwise.
+*)
+
+@findex HasHalted
+PROCEDURE HasHalted () : BOOLEAN ;
+
+
+(*
+   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.
+*)
+
+@findex Length
+PROCEDURE Length (a: ARRAY OF CHAR) : CARDINAL ;
+
+
+(*
+   The following are the runtime exception handler routines.
+*)
+
+@findex AssignmentException
+PROCEDURE AssignmentException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ReturnException
+PROCEDURE ReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex IncException
+PROCEDURE IncException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex DecException
+PROCEDURE DecException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex InclException
+PROCEDURE InclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ExclException
+PROCEDURE ExclException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ShiftException
+PROCEDURE ShiftException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex RotateException
+PROCEDURE RotateException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex StaticArraySubscriptException
+PROCEDURE StaticArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex DynamicArraySubscriptException
+PROCEDURE DynamicArraySubscriptException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ForLoopBeginException
+PROCEDURE ForLoopBeginException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ForLoopToException
+PROCEDURE ForLoopToException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ForLoopEndException
+PROCEDURE ForLoopEndException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex PointerNilException
+PROCEDURE PointerNilException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex NoReturnException
+PROCEDURE NoReturnException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex CaseException
+PROCEDURE CaseException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeNonPosDivException
+PROCEDURE WholeNonPosDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeNonPosModException
+PROCEDURE WholeNonPosModException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeZeroDivException
+PROCEDURE WholeZeroDivException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeZeroRemException
+PROCEDURE WholeZeroRemException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex WholeValueException
+PROCEDURE WholeValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex RealValueException
+PROCEDURE RealValueException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex ParameterException
+PROCEDURE ParameterException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+@findex NoException
+PROCEDURE NoException (filename: ADDRESS; line, column: CARDINAL; scope, message: ADDRESS) ;
+
+
+END M2RTS.
+@end example
+@page
+
+@node gm2-libs-iso/MemStream, gm2-libs-iso/Preemptive, gm2-libs-iso/M2RTS, M2 ISO Libraries
+@subsection gm2-libs-iso/MemStream
+
+@example
+DEFINITION MODULE MemStream ;
+
+(*
+    Description: provides an ISO module which can write to a memory
+                 buffer or read from a memory buffer.
+*)
+
+FROM IOChan IMPORT ChanId ;
+FROM ChanConsts IMPORT FlagSet, OpenResults ;
+FROM SYSTEM IMPORT ADDRESS, LOC ;
+
+
+(*
+   Attempts to obtain and open a channel connected to a contigeous
+   buffer in memory.  The write flag is implied; without the raw
+   flag, text is implied.  If successful, assigns to cid the identity of
+   the opened channel, assigns the value opened to res.
+   If a channel cannot be opened as required,
+   the value of res indicates the reason, and cid identifies the
+   invalid channel.
+
+   The parameters, buffer, length and used maybe updated as
+   data is written.  The buffer maybe reallocated
+   and its address might alter, however the parameters will
+   always reflect the current active buffer.  When this
+   channel is closed the buffer is deallocated and
+   buffer will be set to NIL, length and used will be set to
+   zero.
+*)
+
+@findex OpenWrite
+PROCEDURE OpenWrite (VAR cid: ChanId; flags: FlagSet;
+                     VAR res: OpenResults;
+                     VAR buffer: ADDRESS;
+                     VAR length: CARDINAL;
+                     VAR used: CARDINAL;
+                     deallocOnClose: BOOLEAN) ;
+
+
+(*
+   Attempts to obtain and open a channel connected to a contigeous
+   buffer in memory.  The read and old flags are implied; without
+   the raw flag, text is implied.  If successful, assigns to cid the
+   identity of the opened channel, assigns the value opened to res, and
+   selects input mode, with the read position corresponding to the start
+   of the buffer.  If a channel cannot be opened as required, the value of
+   res indicates the reason, and cid identifies the invalid channel.
+*)
+
+@findex OpenRead
+PROCEDURE OpenRead (VAR cid: ChanId; flags: FlagSet;
+                    VAR res: OpenResults;
+                    buffer: ADDRESS; length: CARDINAL;
+                    deallocOnClose: BOOLEAN) ;
+
+
+(*
+   Close - if the channel identified by cid is not open to
+           a memory stream, the exception wrongDevice is
+           raised; otherwise closes the channel, and assigns
+           the value identifying the invalid channel to cid.
+*)
+
+@findex Close
+PROCEDURE Close (VAR cid: ChanId) ;
+
+
+(*
+   Rewrite - assigns the buffer index to zero.  Subsequent
+             writes will overwrite the previous buffer contents.
+*)
+
+@findex Rewrite
+PROCEDURE Rewrite (cid: ChanId) ;
+
+
+(*
+   Reread - assigns the buffer index to zero.  Subsequent
+            reads will read the previous buffer contents.
+*)
+
+@findex Reread
+PROCEDURE Reread (cid: ChanId) ;
+
+
+(*
+   IsMem - tests if the channel identified by cid is open as
+           a memory stream.
+*)
+
+@findex IsMem
+PROCEDURE IsMem (cid: ChanId) : BOOLEAN ;
+
+
+END MemStream.
+@end example
+@page
+
+@node gm2-libs-iso/Preemptive, gm2-libs-iso/Processes, gm2-libs-iso/MemStream, M2 ISO Libraries
+@subsection gm2-libs-iso/Preemptive
+
+@example
+DEFINITION MODULE Preemptive ;
+
+
+(*
+   initPreemptive - if microsecs > 0 then turn on preemptive scheduling.
+                    if microsecs = 0 then preemptive scheduling is turned off.
+*)
+
+@findex initPreemptive
+PROCEDURE initPreemptive (seconds, microsecs: CARDINAL) ;
+
+
+END Preemptive.
+@end example
+@page
+
+@node gm2-libs-iso/Processes, gm2-libs-iso/ProgramArgs, gm2-libs-iso/Preemptive, M2 ISO Libraries
+@subsection gm2-libs-iso/Processes
+
+@example
+DEFINITION MODULE Processes;
+
+  (* This module allows concurrent algorithms to be expressed using
+     processes. A process is a unit of a program that has the
+     potential to run in parallel with other processes.
+  *)
+
+IMPORT SYSTEM;
+
+TYPE
+  ProcessId;                      (* Used to identify processes *)
+@findex Parameter (type)
+  Parameter     = SYSTEM.ADDRESS; (* Used to pass data between processes *)
+@findex Body (type)
+  Body          = PROC;           (* Used as the type of a process body *)
+@findex Urgency (type)
+  Urgency       = INTEGER;        (* Used by the internal scheduler *)
+@findex Sources (type)
+  Sources       = CARDINAL;       (* Used to identify event sources *)
+@findex ProcessesExceptions (type)
+  ProcessesExceptions =           (* Exceptions raised by this module *)
+    (passiveProgram, processError);
+
+(* The following procedures create processes and switch control between
+   them. *)
+
+@findex Create
+PROCEDURE Create (procBody: Body; extraSpace: CARDINAL; procUrg: Urgency;
+                  procParams: Parameter; VAR procId: ProcessId);
+  (* Creates a new process with procBody as its body, and with urgency
+     and parameters given by procUrg and procParams.  At least as
+     much workspace (in units of SYSTEM.LOC) as is specified by
+     extraSpace is allocated to the process.
+     An identity for the new process is returned in procId.
+     The process is created in the passive state; it will not run
+     until activated.
+  *)
+
+@findex Start
+PROCEDURE Start (procBody: Body; extraSpace: CARDINAL; procUrg: Urgency;
+                 procParams: Parameter; VAR procId: ProcessId);
+  (* Creates a new process, with parameters as for Create.
+     The process is created in the ready state; it is eligible to
+     run immediately.
+  *)
+
+@findex StopMe
+PROCEDURE StopMe ();
+  (* Terminates the calling process.
+     The process must not be associated with a source of events.
+  *)
+
+@findex SuspendMe
+PROCEDURE SuspendMe ();
+  (* Causes the calling process to enter the passive state.  The
+     procedure only returns when the calling process is again
+     activated by another process.
+  *)
+
+@findex Activate
+PROCEDURE Activate (procId: ProcessId);
+  (* Causes the process identified by procId to enter the ready
+     state, and thus to become eligible to run again.
+  *)
+
+@findex SuspendMeAndActivate
+PROCEDURE SuspendMeAndActivate (procId: ProcessId);
+  (* Executes an atomic sequence of SuspendMe() and
+     Activate(procId). *)
+
+@findex Switch
+PROCEDURE Switch (procId: ProcessId; VAR info: Parameter);
+  (* Causes the calling process to enter the passive state; the
+     process identified by procId becomes the currently executing
+     process.  info is used to pass parameter information from the
+     calling to the activated process.  On return, info will
+     contain information from the process that chooses to switch
+     back to this one (or will be NIL if Activate or
+     SuspendMeAndActivate are used instead of Switch).
+  *)
+
+@findex Wait
+PROCEDURE Wait ();
+  (* Causes the calling process to enter the waiting state.
+     The procedure will return when the calling process is
+     activated by another process, or when one of its associated
+     eventSources has generated an event.
+  *)
+
+(* The following procedures allow the association of processes
+   with sources of external events.
+*)
+
+@findex Attach
+PROCEDURE Attach (eventSource: Sources);
+  (* Associates the specified eventSource with the calling
+     process. *)
+
+@findex Detach
+PROCEDURE Detach (eventSource: Sources);
+  (* Dissociates the specified eventSource from the program. *)
+
+@findex IsAttached
+PROCEDURE IsAttached (eventSource: Sources): BOOLEAN;
+  (* Returns TRUE if and only if the specified eventSource is
+     currently associated with one of the processes of the
+     program.
+  *)
+
+@findex Handler
+PROCEDURE Handler (eventSource: Sources): ProcessId;
+  (* Returns the identity of the process, if any, that is
+     associated with the specified eventSource.
+  *)
+
+(* The following procedures allow processes to obtain their
+   identity, parameters, and urgency.
+*)
+
+@findex Me
+PROCEDURE Me (): ProcessId;
+  (* Returns the identity of the calling process (as assigned
+     when the process was first created).
+  *)
+
+@findex MyParam
+PROCEDURE MyParam (): Parameter;
+  (* Returns the value specified as procParams when the calling
+     process was created. *)
+
+@findex UrgencyOf
+PROCEDURE UrgencyOf (procId: ProcessId): Urgency;
+  (* Returns the urgency established when the process identified
+     by procId was first created.
+  *)
+
+(* The following procedure provides facilities for exception
+   handlers. *)
+
+@findex ProcessesException
+PROCEDURE ProcessesException (): ProcessesExceptions;
+  (* If the current coroutine is in the exceptional execution state
+     because of the raising of a language exception, returns the
+     corresponding enumeration value, and otherwise raises an
+     exception.
+  *)
+
+@findex IsProcessesException
+PROCEDURE IsProcessesException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in
+     a routine from this module; otherwise returns FALSE.
+  *)
+
+(*
+   Reschedule - rotates the ready queue and transfers to the process
+                with the highest run priority.
+*)
+
+@findex Reschedule
+PROCEDURE Reschedule ;
+
+
+(*
+   displayProcesses -
+*)
+
+@findex displayProcesses
+PROCEDURE displayProcesses (message: ARRAY OF CHAR) ;
+
+
+END Processes.
+@end example
+@page
+
+@node gm2-libs-iso/ProgramArgs, gm2-libs-iso/RTco, gm2-libs-iso/Processes, M2 ISO Libraries
+@subsection gm2-libs-iso/ProgramArgs
+
+@example
+DEFINITION MODULE ProgramArgs;
+
+  (* Access to program arguments *)
+
+IMPORT IOChan;
+
+TYPE
+@findex ChanId (type)
+  ChanId = IOChan.ChanId;
+
+@findex ArgChan
+PROCEDURE ArgChan (): ChanId;
+  (* Returns a value that identifies a channel for reading
+     program arguments *)
+
+@findex IsArgPresent
+PROCEDURE IsArgPresent (): BOOLEAN;
+  (* Tests if there is a current argument to read from.  If not,
+     read <= IOChan.CurrentFlags() will be FALSE, and attempting
+     to read from the argument channel will raise the exception
+     notAvailable.
+  *)
+
+@findex NextArg
+PROCEDURE NextArg ();
+  (* If there is another argument, causes subsequent input from the
+     argument device to come from the start of the next argument.
+     Otherwise there is no argument to read from, and a call of
+     IsArgPresent will return FALSE.
+  *)
+
+END ProgramArgs.
+@end example
+@page
+
+@node gm2-libs-iso/RTco, gm2-libs-iso/RTdata, gm2-libs-iso/ProgramArgs, M2 ISO Libraries
+@subsection gm2-libs-iso/RTco
+
+@example
+DEFINITION MODULE RTco ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+(* init initializes the module and allows the application to lazily invoke threads.  *)
+
+@findex init
+PROCEDURE init () : INTEGER ;
+
+@findex initThread
+PROCEDURE initThread (p: PROC; stackSize: CARDINAL; interruptLevel: CARDINAL) : INTEGER ;
+
+@findex initSemaphore
+PROCEDURE initSemaphore (value: CARDINAL) : INTEGER ;
+
+@findex wait
+PROCEDURE wait (semaphore: INTEGER) ;
+
+@findex signal
+PROCEDURE signal (semaphore: INTEGER) ;
+
+@findex transfer
+PROCEDURE transfer (VAR p1: INTEGER; p2: INTEGER) ;
+
+@findex waitThread
+PROCEDURE waitThread (tid: INTEGER) ;
+
+@findex signalThread
+PROCEDURE signalThread (tid: INTEGER) ;
+
+@findex currentThread
+PROCEDURE currentThread () : INTEGER ;
+
+
+(* currentInterruptLevel returns the interrupt level of the current thread.  *)
+
+@findex currentInterruptLevel
+PROCEDURE currentInterruptLevel () : CARDINAL ;
+
+
+(* turninterrupts returns the old interrupt level and assigns the interrupt level
+   to newLevel.  *)
+
+@findex turnInterrupts
+PROCEDURE turnInterrupts (newLevel: CARDINAL) : CARDINAL ;
+
+
+(*
+   select access to the select system call which will be thread safe.
+   This is typically called from the idle process to wait for an interrupt.
+*)
+
+@findex select
+PROCEDURE select (p1: INTEGER;
+                  p2: ADDRESS;
+                  p3: ADDRESS;
+                  p4: ADDRESS;
+                  p5: ADDRESS) : INTEGER ;
+
+
+END RTco.
+@end example
+@page
+
+@node gm2-libs-iso/RTdata, gm2-libs-iso/RTentity, gm2-libs-iso/RTco, M2 ISO Libraries
+@subsection gm2-libs-iso/RTdata
+
+@example
+DEFINITION MODULE RTdata ;
+
+(*
+    Description: provides a mechanism whereby devices can store
+                 data attached to a device.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM IOLink IMPORT DeviceTablePtr ;
+
+TYPE
+@findex ModuleId (type)
+   ModuleId ;
+@findex FreeProcedure (type)
+   FreeProcedure = PROCEDURE (ADDRESS) ;
+
+
+(*
+   MakeModuleId - creates a unique module Id.
+*)
+
+@findex MakeModuleId
+PROCEDURE MakeModuleId (VAR m: ModuleId) ;
+
+
+(*
+   InitData - adds, datum, to the device, d.  The datum
+              is associated with ModuleID, m.
+*)
+
+@findex InitData
+PROCEDURE InitData (d: DeviceTablePtr; m: ModuleId;
+                    datum: ADDRESS; f: FreeProcedure) ;
+
+
+(*
+   GetData - returns the datum assocated with ModuleId, m.
+*)
+
+@findex GetData
+PROCEDURE GetData (d: DeviceTablePtr; m: ModuleId) : ADDRESS ;
+
+
+(*
+   KillData - destroys the datum associated with ModuleId, m,
+              in device, d.  It invokes the free procedure
+              given during InitData.
+*)
+
+@findex KillData
+PROCEDURE KillData (d: DeviceTablePtr; m: ModuleId) ;
+
+
+END RTdata.
+@end example
+@page
+
+@node gm2-libs-iso/RTentity, gm2-libs-iso/RTfio, gm2-libs-iso/RTdata, M2 ISO Libraries
+@subsection gm2-libs-iso/RTentity
+
+@example
+DEFINITION MODULE RTentity ;
+
+(*
+    Description: provides a set of routines for maintaining an
+                 efficient mechanism to group opaque (or pointer)
+                 data structures together.  Internally the
+                 entities are grouped together using a binary
+                 tree.  It does not use Storage - and instead
+                 uses malloc, free from libc as Storage uses the
+                 module to detect erroneous deallocations.
+*)
+
+IMPORT SYSTEM ;
+
+TYPE
+@findex Group (type)
+   Group ;
+
+
+@findex InitGroup
+PROCEDURE InitGroup () : Group ;
+@findex KillGroup
+PROCEDURE KillGroup (g: Group) : Group ;
+@findex GetKey
+PROCEDURE GetKey (g: Group; a: SYSTEM.ADDRESS) : CARDINAL ;
+@findex PutKey
+PROCEDURE PutKey (g: Group; a: SYSTEM.ADDRESS; key: CARDINAL) ;
+@findex DelKey
+PROCEDURE DelKey (g: Group; a: SYSTEM.ADDRESS) ;
+@findex IsIn
+PROCEDURE IsIn (g: Group; a: SYSTEM.ADDRESS) : BOOLEAN ;
+
+
+END RTentity.
+@end example
+@page
+
+@node gm2-libs-iso/RTfio, gm2-libs-iso/RTgen, gm2-libs-iso/RTentity, M2 ISO Libraries
+@subsection gm2-libs-iso/RTfio
+
+@example
+DEFINITION MODULE RTfio ;
+
+(*
+    Description: provides default FIO based methods for the RTgenif
+                 procedures.  These will be used by StreamFile,
+                 SeqFile, StdChans, TermFile and RndFile.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM IOLink IMPORT DeviceTablePtr;
+FROM RTgenif IMPORT GenDevIF ;
+
+
+(*
+   doreadchar - returns a CHAR from the file associated with, g.
+*)
+
+@findex doreadchar
+PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+
+
+(*
+   dounreadchar - pushes a CHAR back onto the file associated
+                  with, g.
+*)
+
+@findex dounreadchar
+PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+
+
+(*
+   dogeterrno - returns the errno relating to the generic device.
+*)
+
+@findex dogeterrno
+PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+
+
+(*
+   dorbytes - reads upto, max, bytes setting, actual, and
+              returning FALSE if an error (not due to eof)
+              occurred.
+*)
+
+@findex dorbytes
+PROCEDURE dorbytes (g: GenDevIF;
+                    d: DeviceTablePtr;
+                    to: ADDRESS;
+                    max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+
+(*
+   dowbytes - writes up to, nBytes.  It returns FALSE
+              if an error occurred and it sets actual
+              to the amount of data written.
+*)
+
+@findex dowbytes
+PROCEDURE dowbytes (g: GenDevIF;
+                    d: DeviceTablePtr;
+                    from: ADDRESS;
+                    nBytes: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+
+
+(*
+   dowriteln - attempt to write an end of line marker to the
+               file and returns TRUE if successful.
+*)
+
+@findex dowriteln
+PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   iseof - returns TRUE if end of file has been seen.
+*)
+
+@findex iseof
+PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   iseoln - returns TRUE if end of line has been seen.
+*)
+
+@findex iseoln
+PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   iserror - returns TRUE if an error was seen on the device.
+             Note that reaching EOF is not classified as an
+             error.
+*)
+
+@findex iserror
+PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+END RTfio.
+@end example
+@page
+
+@node gm2-libs-iso/RTgen, gm2-libs-iso/RTgenif, gm2-libs-iso/RTfio, M2 ISO Libraries
+@subsection gm2-libs-iso/RTgen
+
+@example
+DEFINITION MODULE RTgen ;
+
+(*
+    Description: provides a generic device interface between
+                 ISO channels and the underlying PIM style
+                 FIO procedure calls.
+*)
+
+FROM RTgenif IMPORT GenDevIF ;
+FROM IOLink IMPORT DeviceId, DeviceTablePtr;
+FROM IOConsts IMPORT ReadResults ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+@findex ChanDev (type)
+   ChanDev ;
+@findex DeviceType (type)
+   DeviceType = (seqfile, streamfile, programargs, stdchans, term, socket, rndfile) ;
+
+
+(*
+   InitChanDev - initialize and return a ChanDev.
+*)
+
+@findex InitChanDev
+PROCEDURE InitChanDev (t: DeviceType; d: DeviceId; g: GenDevIF) : ChanDev ;
+
+
+(*
+   KillChanDev - deallocates, g.
+*)
+
+@findex KillChanDev
+PROCEDURE KillChanDev (g: GenDevIF) : GenDevIF ;
+
+
+(*
+   RaiseEOFinLook - returns TRUE if the Look procedure
+                    should raise an exception if it
+                    sees end of file.
+*)
+
+@findex RaiseEOFinLook
+PROCEDURE RaiseEOFinLook (g: ChanDev) : BOOLEAN ;
+
+
+(*
+   RaiseEOFinSkip - returns TRUE if the Skip procedure
+                    should raise an exception if it
+                    sees end of file.
+*)
+
+@findex RaiseEOFinSkip
+PROCEDURE RaiseEOFinSkip (g: ChanDev) : BOOLEAN ;
+
+
+@findex doLook
+PROCEDURE doLook (g: ChanDev;
+                  d: DeviceTablePtr;
+                  VAR ch: CHAR;
+                  VAR r: ReadResults) ;
+
+@findex doSkip
+PROCEDURE doSkip (g: ChanDev;
+                  d: DeviceTablePtr) ;
+
+@findex doSkipLook
+PROCEDURE doSkipLook (g: ChanDev;
+                      d: DeviceTablePtr;
+                      VAR ch: CHAR;
+                      VAR r: ReadResults) ;
+
+@findex doWriteLn
+PROCEDURE doWriteLn (g: ChanDev;
+                     d: DeviceTablePtr) ;
+
+@findex doReadText
+PROCEDURE doReadText (g: ChanDev;
+                      d: DeviceTablePtr;
+                      to: ADDRESS;
+                      maxChars: CARDINAL;
+                      VAR charsRead: CARDINAL) ;
+
+@findex doWriteText
+PROCEDURE doWriteText (g: ChanDev;
+                       d: DeviceTablePtr;
+                       from: ADDRESS;
+                       charsToWrite: CARDINAL) ;
+
+@findex doReadLocs
+PROCEDURE doReadLocs (g: ChanDev;
+                      d: DeviceTablePtr;
+                      to: ADDRESS;
+                      maxLocs: CARDINAL;
+                      VAR locsRead: CARDINAL) ;
+
+@findex doWriteLocs
+PROCEDURE doWriteLocs (g: ChanDev;
+                       d: DeviceTablePtr;
+                       from: ADDRESS;
+                       locsToWrite: CARDINAL) ;
+
+(*
+   checkErrno - checks a number of errno conditions and raises
+                appropriate ISO exceptions if they occur.
+*)
+
+@findex checkErrno
+PROCEDURE checkErrno (g: ChanDev; d: DeviceTablePtr) ;
+
+
+END RTgen.
+@end example
+@page
+
+@node gm2-libs-iso/RTgenif, gm2-libs-iso/RTio, gm2-libs-iso/RTgen, M2 ISO Libraries
+@subsection gm2-libs-iso/RTgenif
+
+@example
+DEFINITION MODULE RTgenif ;
+
+(*
+    Description: provides a generic interface mechanism used
+                 by RTgen.  This is not an ISO module but rather
+                 a runtime support module.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM IOLink IMPORT DeviceId, DeviceTablePtr ;
+
+TYPE
+@findex GenDevIF (type)
+   GenDevIF ;
+@findex readchar (type)
+   readchar   = PROCEDURE (GenDevIF, DeviceTablePtr) : CHAR ;
+@findex unreadchar (type)
+   unreadchar = PROCEDURE (GenDevIF, DeviceTablePtr, CHAR) : CHAR ;
+@findex geterrno (type)
+   geterrno   = PROCEDURE (GenDevIF, DeviceTablePtr) : INTEGER ;
+@findex readbytes (type)
+   readbytes  = PROCEDURE (GenDevIF, DeviceTablePtr, ADDRESS, CARDINAL, VAR CARDINAL) : BOOLEAN ;
+@findex writebytes (type)
+   writebytes = PROCEDURE (GenDevIF, DeviceTablePtr, ADDRESS, CARDINAL, VAR CARDINAL) : BOOLEAN ;
+@findex writeln (type)
+   writeln    = PROCEDURE (GenDevIF, DeviceTablePtr) : BOOLEAN ;
+@findex iseof (type)
+   iseof      = PROCEDURE (GenDevIF, DeviceTablePtr) : BOOLEAN ;
+@findex iseoln (type)
+   iseoln     = PROCEDURE (GenDevIF, DeviceTablePtr) : BOOLEAN ;
+@findex iserror (type)
+   iserror    = PROCEDURE (GenDevIF, DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   InitGenDevIF - initializes a generic device.
+*)
+
+@findex InitGenDevIF
+PROCEDURE InitGenDevIF (d     : DeviceId;
+                        rc    : readchar;
+                        urc   : unreadchar;
+                        geterr: geterrno;
+                        rbytes: readbytes;
+                        wbytes: writebytes;
+                        wl    : writeln;
+                        eof   : iseof;
+                        eoln  : iseoln;
+                        iserr : iserror) : GenDevIF ;
+
+
+(*
+   getDID - returns the device id this generic interface.
+*)
+
+@findex getDID
+PROCEDURE getDID (g: GenDevIF) : DeviceId ;
+
+
+(*
+   doReadChar - returns the next character from the generic
+                device.
+*)
+
+@findex doReadChar
+PROCEDURE doReadChar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
+
+
+(*
+   doUnReadChar - pushes back a character to the generic device.
+*)
+
+@findex doUnReadChar
+PROCEDURE doUnReadChar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
+
+
+(*
+   doGetErrno - returns the errno relating to the generic device.
+*)
+
+@findex doGetErrno
+PROCEDURE doGetErrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
+
+
+(*
+   doRBytes - attempts to read, n, bytes from the generic device.
+              It set the actual amount read and returns a boolean
+              to determine whether an error occurred.
+*)
+
+@findex doRBytes
+PROCEDURE doRBytes (g: GenDevIF; d: DeviceTablePtr;
+                    to: ADDRESS; max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+
+
+(*
+   doWBytes - attempts to write, n, bytes to the generic device.
+              It sets the actual amount written and returns a
+              boolean to determine whether an error occurred.
+*)
+
+@findex doWBytes
+PROCEDURE doWBytes (g: GenDevIF; d: DeviceTablePtr;
+                    from: ADDRESS; max: CARDINAL;
+                    VAR actual: CARDINAL) : BOOLEAN ;
+
+
+(*
+   doWrLn - writes an end of line marker and returns
+            TRUE if successful.
+*)
+
+@findex doWrLn
+PROCEDURE doWrLn (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   isEOF - returns true if the end of file was reached.
+*)
+
+@findex isEOF
+PROCEDURE isEOF (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   isEOLN - returns true if the end of line was reached.
+*)
+
+@findex isEOLN
+PROCEDURE isEOLN (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   isError - returns true if an error was seen in the device.
+*)
+
+@findex isError
+PROCEDURE isError (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
+
+
+(*
+   KillGenDevIF - deallocates a generic device.
+*)
+
+@findex KillGenDevIF
+PROCEDURE KillGenDevIF (g: GenDevIF) : GenDevIF ;
+
+
+END RTgenif.
+@end example
+@page
+
+@node gm2-libs-iso/RTio, gm2-libs-iso/RandomNumber, gm2-libs-iso/RTgenif, M2 ISO Libraries
+@subsection gm2-libs-iso/RTio
+
+@example
+DEFINITION MODULE RTio ;
+
+(*
+    Description: provides low level routines for creating and destroying
+                 ChanIds.  This is necessary to allow multiple modules
+                 to create, ChanId values, where ChanId is an opaque
+                 type.
+*)
+
+IMPORT FIO, IOLink ;
+
+TYPE
+@findex ChanId (type)
+   ChanId ;
+
+
+(*
+   InitChanId - return a new ChanId.
+*)
+
+@findex InitChanId
+PROCEDURE InitChanId () : ChanId ;
+
+
+(*
+   KillChanId - deallocate a ChanId.
+*)
+
+@findex KillChanId
+PROCEDURE KillChanId (c: ChanId) : ChanId ;
+
+
+(*
+   NilChanId - return a NIL pointer.
+*)
+
+@findex NilChanId
+PROCEDURE NilChanId () : ChanId ;
+
+
+(*
+   GetDeviceId - returns the device id, from, c.
+*)
+
+@findex GetDeviceId
+PROCEDURE GetDeviceId (c: ChanId) : IOLink.DeviceId ;
+
+
+(*
+   SetDeviceId - sets the device id in, c.
+*)
+
+@findex SetDeviceId
+PROCEDURE SetDeviceId (c: ChanId; d: IOLink.DeviceId) ;
+
+
+(*
+   GetDevicePtr - returns the device table ptr, from, c.
+*)
+
+@findex GetDevicePtr
+PROCEDURE GetDevicePtr (c: ChanId) : IOLink.DeviceTablePtr ;
+
+
+(*
+   SetDevicePtr - sets the device table ptr in, c.
+*)
+
+@findex SetDevicePtr
+PROCEDURE SetDevicePtr (c: ChanId; p: IOLink.DeviceTablePtr) ;
+
+
+(*
+   GetFile - returns the file field from, c.
+*)
+
+@findex GetFile
+PROCEDURE GetFile (c: ChanId) : FIO.File ;
+
+
+(*
+   SetFile - sets the file field in, c.
+*)
+
+@findex SetFile
+PROCEDURE SetFile (c: ChanId; f: FIO.File) ;
+
+
+END RTio.
+@end example
+@page
+
+@node gm2-libs-iso/RandomNumber, gm2-libs-iso/RawIO, gm2-libs-iso/RTio, M2 ISO Libraries
+@subsection gm2-libs-iso/RandomNumber
+
+@example
+DEFINITION MODULE RandomNumber ;
+
+(*
+    Description: provides primitives for obtaining random numbers on
+                 pervasive data types.
+*)
+
+FROM SYSTEM IMPORT BYTE ;
+EXPORT QUALIFIED Randomize, RandomInit, RandomBytes,
+                 RandomCard, RandomShortCard, RandomLongCard,
+                 RandomInt, RandomShortInt, RandomLongInt,
+                 RandomReal, RandomLongReal, RandomShortReal ;
+
+
+(*
+   Randomize - initialize the random number generator with a seed
+               based on the microseconds.
+*)
+
+@findex Randomize
+PROCEDURE Randomize ;
+
+
+(*
+   RandomInit - initialize the random number generator with value, seed.
+*)
+
+@findex RandomInit
+PROCEDURE RandomInit (seed: CARDINAL) ;
+
+
+(*
+   RandomBytes - fills in an array with random values.
+*)
+
+@findex RandomBytes
+PROCEDURE RandomBytes (VAR a: ARRAY OF BYTE) ;
+
+
+(*
+   RandomInt - return an INTEGER in the range [low .. high].
+*)
+
+@findex RandomInt
+PROCEDURE RandomInt (low, high: INTEGER) : INTEGER ;
+
+
+(*
+   RandomShortInt - return an SHORTINT in the range [low..high].
+*)
+
+@findex RandomShortInt
+PROCEDURE RandomShortInt (low, high: SHORTINT) : SHORTINT ;
+
+
+(*
+   RandomLongInt - return an LONGINT in the range [low..high].
+*)
+
+@findex RandomLongInt
+PROCEDURE RandomLongInt (low, high: LONGINT) : LONGINT ;
+
+
+(*
+   RandomShortCard - return a SHORTCARD in the range [low..high].
+*)
+
+@findex RandomShortCard
+PROCEDURE RandomShortCard (low, high: CARDINAL) : CARDINAL ;
+
+
+(*
+   RandomCard - return a CARDINAL in the range [low..high].
+*)
+
+@findex RandomCard
+PROCEDURE RandomCard (low, high: CARDINAL) : CARDINAL ;
+
+
+(*
+   RandomLongCard - return an LONGCARD in the range [low..high].
+*)
+
+@findex RandomLongCard
+PROCEDURE RandomLongCard (low, high: LONGCARD) : LONGCARD ;
+
+
+(*
+   RandomReal - return a REAL number in the range 0.0..1.0
+*)
+
+@findex RandomReal
+PROCEDURE RandomReal () : REAL ;
+
+
+(*
+   RandomShortReal - return a SHORTREAL number in the range 0.0..1.0
+*)
+
+@findex RandomShortReal
+PROCEDURE RandomShortReal () : SHORTREAL ;
+
+
+(*
+   RandomLongReal - return a LONGREAL number in the range 0.0..1.0
+*)
+
+@findex RandomLongReal
+PROCEDURE RandomLongReal () : LONGREAL ;
+
+
+END RandomNumber.
+@end example
+@page
+
+@node gm2-libs-iso/RawIO, gm2-libs-iso/RealConv, gm2-libs-iso/RandomNumber, M2 ISO Libraries
+@subsection gm2-libs-iso/RawIO
+
+@example
+DEFINITION MODULE RawIO;
+
+  (* Reading and writing data over specified channels using raw
+     operations, that is, with no conversion or interpretation.
+     The read result is of the type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan, SYSTEM;
+
+@findex Read
+PROCEDURE Read (cid: IOChan.ChanId; VAR to: ARRAY OF SYSTEM.LOC);
+  (* Reads storage units from cid, and assigns them to
+     successive components of to. The read result is set
+     to the value allRight, wrongFormat, or endOfInput.
+  *)
+
+@findex Write
+PROCEDURE Write (cid: IOChan.ChanId; from: ARRAY OF SYSTEM.LOC);
+  (* Writes storage units to cid from successive components
+     of from. *)
+
+END RawIO.
+
+@end example
+@page
+
+@node gm2-libs-iso/RealConv, gm2-libs-iso/RealIO, gm2-libs-iso/RawIO, M2 ISO Libraries
+@subsection gm2-libs-iso/RealConv
+
+@example
+DEFINITION MODULE RealConv;
+
+  (* Low-level REAL/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+  (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+@findex ConvResults (type)
+  ConvResults = ConvTypes.ConvResults;
+
+@findex ScanReal
+PROCEDURE ScanReal (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState);
+  (* Represents the start state of a finite state scanner for real
+     numbers - assigns class of inputCh to chClass and a procedure
+     representing the next state to nextState.
+   *)
+
+@findex FormatReal
+PROCEDURE FormatReal (str: ARRAY OF CHAR): ConvResults;
+  (* Returns the format of the string value for conversion to REAL. *)
+
+@findex ValueReal
+PROCEDURE ValueReal (str: ARRAY OF CHAR): REAL;
+  (* Returns the value corresponding to the real number string value
+     str if str is well-formed; otherwise raises the RealConv
+     exception.
+  *)
+
+@findex LengthFloatReal
+PROCEDURE LengthFloatReal (real: REAL; sigFigs: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the floating-point string
+     representation of real with sigFigs significant figures.
+  *)
+
+@findex LengthEngReal
+PROCEDURE LengthEngReal (real: REAL; sigFigs: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the floating-point engineering
+     string representation of real with sigFigs significant figures.
+  *)
+
+@findex LengthFixedReal
+PROCEDURE LengthFixedReal (real: REAL; place: INTEGER): CARDINAL;
+  (* Returns the number of characters in the fixed-point string
+     representation of real rounded to the given place relative to the
+     decimal point.
+  *)
+
+@findex IsRConvException
+PROCEDURE IsRConvException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception in a
+     routine from this module; otherwise returns FALSE.
+  *)
+
+END RealConv.
+@end example
+@page
+
+@node gm2-libs-iso/RealIO, gm2-libs-iso/RealMath, gm2-libs-iso/RealConv, M2 ISO Libraries
+@subsection gm2-libs-iso/RealIO
+
+@example
+DEFINITION MODULE RealIO;
+
+  (* Input and output of real numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, @{decimal digit@},
+       [".", @{decimal digit@}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadReal
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: REAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed fixed or floating
+     point number.  The value of this number is assigned to real.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteFloat
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: REAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to cid in floating-point text form,
+     with sigFigs significant figures, in a field of the given
+     minimum width.
+  *)
+
+@findex WriteEng
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: REAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+@findex WriteFixed
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: REAL;
+                      place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to cid in fixed-point text form,
+     rounded to the given place relative to the decimal point,
+     in a field of the given minimum width.
+  *)
+
+@findex WriteReal
+PROCEDURE WriteReal (cid: IOChan.ChanId;
+                     real: REAL; width: CARDINAL);
+  (* Writes the value of real to cid, as WriteFixed if the sign
+     and magnitude can be shown in the given width, or otherwise
+     as WriteFloat.  The number of places or significant digits
+     depends on the given width.
+  *)
+
+END RealIO.
+@end example
+@page
+
+@node gm2-libs-iso/RealMath, gm2-libs-iso/RealStr, gm2-libs-iso/RealIO, M2 ISO Libraries
+@subsection gm2-libs-iso/RealMath
+
+@example
+DEFINITION MODULE RealMath;
+
+  (* Mathematical functions for the type REAL *)
+
+CONST
+@findex pi (const)
+  pi   = 3.1415926535897932384626433832795028841972;
+@findex exp1 (const)
+  exp1 = 2.7182818284590452353602874713526624977572;
+
+@findex sqrt
+PROCEDURE __BUILTIN__ sqrt (x: REAL): REAL;
+  (* Returns the positive square root of x *)
+
+@findex exp
+PROCEDURE __BUILTIN__ exp (x: REAL): REAL;
+  (* Returns the exponential of x *)
+
+@findex ln
+PROCEDURE __BUILTIN__ ln (x: REAL): REAL;
+  (* Returns the natural logarithm of x *)
+
+  (* The angle in all trigonometric functions is measured in radians *)
+
+@findex sin
+PROCEDURE __BUILTIN__ sin (x: REAL): REAL;
+  (* Returns the sine of x *)
+
+@findex cos
+PROCEDURE __BUILTIN__ cos (x: REAL): REAL;
+  (* Returns the cosine of x *)
+
+@findex tan
+PROCEDURE tan (x: REAL): REAL;
+  (* Returns the tangent of x *)
+
+@findex arcsin
+PROCEDURE arcsin (x: REAL): REAL;
+  (* Returns the arcsine of x *)
+
+@findex arccos
+PROCEDURE arccos (x: REAL): REAL;
+  (* Returns the arccosine of x *)
+
+@findex arctan
+PROCEDURE arctan (x: REAL): REAL;
+  (* Returns the arctangent of x *)
+
+@findex power
+PROCEDURE power (base, exponent: REAL) : REAL;
+  (* Returns the value of the number base raised to the power exponent *)
+
+@findex round
+PROCEDURE round (x: REAL) : INTEGER;
+  (* Returns the value of x rounded to the nearest integer *)
+
+@findex IsRMathException
+PROCEDURE IsRMathException () : BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END RealMath.
+
+@end example
+@page
+
+@node gm2-libs-iso/RealStr, gm2-libs-iso/RndFile, gm2-libs-iso/RealMath, M2 ISO Libraries
+@subsection gm2-libs-iso/RealStr
+
+@example
+DEFINITION MODULE RealStr;
+
+  (* REAL/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+  (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+@findex ConvResults (type)
+  ConvResults = ConvTypes.ConvResults;
+
+(* the string form of a signed fixed-point real number is
+     ["+" | "-"], decimal digit, @{decimal digit@}, [".",
+     @{decimal digit@}]
+*)
+
+(* the string form of a signed floating-point real number is
+     signed fixed-point real number, "E", ["+" | "-"],
+     decimal digit, @{decimal digit@}
+*)
+
+@findex StrToReal
+PROCEDURE StrToReal (str: ARRAY OF CHAR; VAR real: REAL;
+                     VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent characters
+     in str are in the format of a signed real number, assigns a
+     corresponding value to real.  Assigns a value indicating the
+     format of str to res.
+  *)
+
+@findex RealToFloat
+PROCEDURE RealToFloat (real: REAL; sigFigs: CARDINAL;
+                       VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.
+  *)
+
+@findex RealToEng
+PROCEDURE RealToEng (real: REAL; sigFigs: CARDINAL;
+                     VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to floating-point string form, with
+     sigFigs significant figures, and copies the possibly truncated
+     result to str.  The number is scaled with one to three digits
+     in the whole number part and with an exponent that is a multiple
+     of three.
+  *)
+
+@findex RealToFixed
+PROCEDURE RealToFixed (real: REAL; place: INTEGER;
+                       VAR str: ARRAY OF CHAR);
+  (* Converts the value of real to fixed-point string form, rounded
+     to the given place relative to the decimal point, and copies
+     the possibly truncated result to str.
+  *)
+
+@findex RealToStr
+PROCEDURE RealToStr (real: REAL; VAR str: ARRAY OF CHAR);
+  (* Converts the value of real as RealToFixed if the sign and
+     magnitude can be shown within the capacity of str, or
+     otherwise as RealToFloat, and copies the possibly truncated
+     result to str. The number of places or significant digits are
+     implementation-defined.
+  *)
+
+END RealStr.
+
+@end example
+@page
+
+@node gm2-libs-iso/RndFile, gm2-libs-iso/SIOResult, gm2-libs-iso/RealStr, M2 ISO Libraries
+@subsection gm2-libs-iso/RndFile
+
+@example
+DEFINITION MODULE RndFile;
+
+  (* Random access files *)
+
+IMPORT IOChan, ChanConsts, SYSTEM;
+
+TYPE
+@findex ChanId (type)
+   ChanId = IOChan.ChanId;
+@findex FlagSet (type)
+   FlagSet = ChanConsts.FlagSet;
+@findex OpenResults (type)
+   OpenResults = ChanConsts.OpenResults;
+
+   (* Accepted singleton values of FlagSet *)
+
+CONST
+   (* input operations are requested/available *)
+@findex read (const)
+   read = FlagSet@{ChanConsts.readFlag@};
+   (* output operations are requested/available *)
+@findex write (const)
+   write = FlagSet@{ChanConsts.writeFlag@};
+   (* a file may/must/did exist before the channel is opened *)
+@findex old (const)
+   old = FlagSet@{ChanConsts.oldFlag@};
+   (* text operations are requested/available *)
+@findex text (const)
+   text = FlagSet@{ChanConsts.textFlag@};
+   (* raw operations are requested/available *)
+@findex raw (const)
+   raw = FlagSet@{ChanConsts.rawFlag@};
+
+@findex OpenOld
+PROCEDURE OpenOld (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
+                   VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a stored random
+     access file of the given name.
+     The old flag is implied; without the write flag, read is implied;
+     without the text flag, raw is implied.
+     If successful, assigns to cid the identity of the opened channel,
+     assigns the value opened to res, and sets the read/write position
+     to the start of the file.
+     If a channel cannot be opened as required, the value of res indicates
+     the reason, and cid identifies the invalid channel.
+  *)
+
+@findex OpenClean
+PROCEDURE OpenClean (VAR cid: ChanId; name: ARRAY OF CHAR; flags: FlagSet;
+                     VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a stored random
+     access file of the given name.
+     The write flag is implied; without the text flag, raw is implied.
+     If successful, assigns to cid the identity of the opened channel,
+     assigns the value opened to res, and truncates the file to zero length.
+     If a channel cannot be opened as required, the value of res indicates
+     the reason, and cid identifies the invalid channel.
+  *)
+
+@findex IsRndFile
+PROCEDURE IsRndFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to a random access file. *)
+
+@findex IsRndFileException
+PROCEDURE IsRndFileException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution
+     state because of the raising of a RndFile exception; otherwise returns
+     FALSE.
+  *)
+
+CONST
+@findex FilePosSize (const)
+   FilePosSize = SIZE(LONGINT) ;
+   (* <implementation-defined whole number greater than zero>; *)
+
+TYPE
+@findex FilePos (type)
+   FilePos = LONGINT ;  (* ARRAY [1 .. FilePosSize] OF SYSTEM.LOC; *)
+
+@findex StartPos
+PROCEDURE StartPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position of
+     the start of the file.
+  *)
+
+@findex CurrentPos
+PROCEDURE CurrentPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position
+     of the current read/write position.
+  *)
+
+@findex EndPos
+PROCEDURE EndPos (cid: ChanId): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the first
+     position after which there have been no writes.
+  *)
+
+@findex NewPos
+PROCEDURE NewPos (cid: ChanId; chunks: INTEGER; chunkSize: CARDINAL;
+                  from: FilePos): FilePos;
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise returns the position
+     (chunks * chunkSize) relative to the position given by from, or
+     raises the exception posRange if the required position cannot be
+     represented as a value of type FilePos.
+  *)
+
+@findex SetPos
+PROCEDURE SetPos (cid: ChanId; pos: FilePos);
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise sets the read/write
+     position to the value given by pos.
+  *)
+
+@findex Close
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to a random access file,
+     the exception wrongDevice is raised; otherwise closes the channel,
+     and assigns the value identifying the invalid channel to cid.
+  *)
+
+END RndFile.
+@end example
+@page
+
+@node gm2-libs-iso/SIOResult, gm2-libs-iso/SLongIO, gm2-libs-iso/RndFile, M2 ISO Libraries
+@subsection gm2-libs-iso/SIOResult
+
+@example
+DEFINITION MODULE SIOResult;
+
+  (* Read results for the default input channel *)
+
+IMPORT IOConsts;
+
+TYPE
+@findex ReadResults (type)
+  ReadResults = IOConsts.ReadResults;
+
+  (*
+@findex ReadResults (type)
+    ReadResults =   (* This type is used to classify the result of an input operation *)
+    (
+      notKnown,     (* no read result is set *)
+      allRight,     (* data is as expected or as required *)
+      outOfRange,   (* data cannot be represented *)
+      wrongFormat,  (* data not in expected format *)
+      endOfLine,    (* end of line seen before expected data *)
+      endOfInput    (* end of input seen before expected data *)
+    );
+  *)
+
+@findex ReadResult
+PROCEDURE ReadResult (): ReadResults;
+  (* Returns the result for the last read operation on the default input channel. *)
+
+END SIOResult.
+
+@end example
+@page
+
+@node gm2-libs-iso/SLongIO, gm2-libs-iso/SLongWholeIO, gm2-libs-iso/SIOResult, M2 ISO Libraries
+@subsection gm2-libs-iso/SLongIO
+
+@example
+DEFINITION MODULE SLongIO;
+
+  (* Input and output of long real numbers in decimal text form
+     using default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, @{decimal digit@},
+       [".", @{decimal digit@}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadReal
+PROCEDURE ReadReal (VAR real: LONGREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteFloat
+PROCEDURE WriteFloat (real: LONGREAL; sigFigs: CARDINAL;
+                      width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+
+@findex WriteEng
+PROCEDURE WriteEng (real: LONGREAL; sigFigs: CARDINAL;
+                    width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+@findex WriteFixed
+PROCEDURE WriteFixed (real: LONGREAL; place: INTEGER;
+                      width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+
+@findex WriteReal
+PROCEDURE WriteReal (real: LONGREAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+
+END SLongIO.
+
+@end example
+@page
+
+@node gm2-libs-iso/SLongWholeIO, gm2-libs-iso/SRawIO, gm2-libs-iso/SLongIO, M2 ISO Libraries
+@subsection gm2-libs-iso/SLongWholeIO
+
+@example
+DEFINITION MODULE SLongWholeIO;
+
+  (* Input and output of whole numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, @{decimal digit@}
+
+     The text form of an unsigned whole number is
+       decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadInt
+PROCEDURE ReadInt (VAR int: LONGINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     whole number.  The value of this number is assigned
+     to int.  The read result is set to the value allRight,
+     outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteInt
+PROCEDURE WriteInt (int: LONGINT; width: CARDINAL);
+  (* Writes the value of int to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+
+@findex ReadCard
+PROCEDURE ReadCard (VAR card: LONGCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of an
+     unsigned whole number.  The value of this number is
+     assigned to card.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteCard
+PROCEDURE WriteCard (card: LONGCARD; width: CARDINAL);
+  (* Writes the value of card to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+
+END SLongWholeIO.
+@end example
+@page
+
+@node gm2-libs-iso/SRawIO, gm2-libs-iso/SRealIO, gm2-libs-iso/SLongWholeIO, M2 ISO Libraries
+@subsection gm2-libs-iso/SRawIO
+
+@example
+DEFINITION MODULE SRawIO;
+
+  (* Reading and writing data over default channels using raw operations, that is, with no
+     conversion or interpretation. The read result is of the type IOConsts.ReadResults.
+  *)
+
+IMPORT SYSTEM;
+
+@findex Read
+PROCEDURE Read (VAR to: ARRAY OF SYSTEM.LOC);
+  (* Reads storage units from the default input channel, and assigns them to successive
+     components of to.  The read result is set to the value allRight, wrongFormat, or
+     endOfInput.
+  *)
+
+@findex Write
+PROCEDURE Write (from: ARRAY OF SYSTEM.LOC);
+  (* Writes storage units to the default output channel from successive components of from.
+  *)
+
+END SRawIO.
+
+@end example
+@page
+
+@node gm2-libs-iso/SRealIO, gm2-libs-iso/SShortIO, gm2-libs-iso/SRawIO, M2 ISO Libraries
+@subsection gm2-libs-iso/SRealIO
+
+@example
+DEFINITION MODULE SRealIO;
+
+  (* Input and output of real numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, @{decimal digit@},
+       [".", @{decimal digit@}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadReal
+PROCEDURE ReadReal (VAR real: REAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteFloat
+PROCEDURE WriteFloat (real: REAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+
+@findex WriteEng
+PROCEDURE WriteEng (real: REAL; sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with one to
+     three digits in the whole number part, and with an exponent that
+     is a multiple of three.
+  *)
+
+@findex WriteFixed
+PROCEDURE WriteFixed (real: REAL; place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+
+@findex WriteReal
+PROCEDURE WriteReal (real: REAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+
+END SRealIO.
+
+@end example
+@page
+
+@node gm2-libs-iso/SShortIO, gm2-libs-iso/SShortWholeIO, gm2-libs-iso/SRealIO, M2 ISO Libraries
+@subsection gm2-libs-iso/SShortIO
+
+@example
+DEFINITION MODULE SShortIO;
+
+  (* Input and output of short real numbers in decimal text form
+     using default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, @{decimal digit@},
+       [".", @{decimal digit@}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadReal
+PROCEDURE ReadReal (VAR real: SHORTREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     fixed or floating point number. The value of this number
+     is assigned to real.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteFloat
+PROCEDURE WriteFloat (real: SHORTREAL; sigFigs: CARDINAL;
+                      width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     floating-point text form, with sigFigs significant figures,
+     in a field of the given minimum width.
+  *)
+
+@findex WriteEng
+PROCEDURE WriteEng (real: SHORTREAL; sigFigs: CARDINAL;
+                    width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+@findex WriteFixed
+PROCEDURE WriteFixed (real: SHORTREAL; place: INTEGER;
+                      width: CARDINAL);
+  (* Writes the value of real to the default output channel in
+     fixed-point text form, rounded to the given place relative
+     to the decimal point, in a field of the given minimum width.
+  *)
+
+@findex WriteReal
+PROCEDURE WriteReal (real: SHORTREAL; width: CARDINAL);
+  (* Writes the value of real to the default output channel, as
+     WriteFixed if the sign and magnitude can be shown in the
+     given width, or otherwise as WriteFloat. The number of
+     places or significant digits depends on the given width.
+  *)
+
+END SShortIO.
+
+@end example
+@page
+
+@node gm2-libs-iso/SShortWholeIO, gm2-libs-iso/STextIO, gm2-libs-iso/SShortIO, M2 ISO Libraries
+@subsection gm2-libs-iso/SShortWholeIO
+
+@example
+DEFINITION MODULE SShortWholeIO;
+
+  (* Input and output of whole numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, @{decimal digit@}
+
+     The text form of an unsigned whole number is
+       decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadInt
+PROCEDURE ReadInt (VAR int: SHORTINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     whole number.  The value of this number is assigned
+     to int.  The read result is set to the value allRight,
+     outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteInt
+PROCEDURE WriteInt (int: SHORTINT; width: CARDINAL);
+  (* Writes the value of int to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+
+@findex ReadCard
+PROCEDURE ReadCard (VAR card: SHORTCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of an
+     unsigned whole number.  The value of this number is
+     assigned to card.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteCard
+PROCEDURE WriteCard (card: SHORTCARD; width: CARDINAL);
+  (* Writes the value of card to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+
+END SShortWholeIO.
+@end example
+@page
+
+@node gm2-libs-iso/STextIO, gm2-libs-iso/SWholeIO, gm2-libs-iso/SShortWholeIO, M2 ISO Libraries
+@subsection gm2-libs-iso/STextIO
+
+@example
+DEFINITION MODULE STextIO;
+
+  (* Input and output of character and string types over default channels. The read result
+     is of the type IOConsts.ReadResults.
+  *)
+
+  (* The following procedures do not read past line marks *)
+
+@findex ReadChar
+PROCEDURE ReadChar (VAR ch: CHAR);
+  (* If possible, removes a character from the default input stream, and assigns the
+     corresponding value to ch.  The read result is set to allRight, endOfLine or
+     endOfInput.
+  *)
+
+@findex ReadRestLine
+PROCEDURE ReadRestLine (VAR s: ARRAY OF CHAR);
+  (* Removes any remaining characters from the default input stream before the next line
+     mark, copying to s as many as can be accommodated as a string value.  The read result
+     is set to the value allRight, outOfRange, endOfLine, or endOfInput.
+  *)
+
+@findex ReadString
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR);
+  (* Removes only those characters from the default input stream before the next line mark
+     that can be accommodated in s as a string value, and copies them to s. The read result
+     is set to the value allRight, endOfLine, or endOfInput.
+  *)
+
+@findex ReadToken
+PROCEDURE ReadToken (VAR s: ARRAY OF CHAR);
+  (* Skips leading spaces, and then removes characters from the default input stream before
+     the next space or line mark, copying to s as many as can be accommodated as a string
+     value.  The read result is set to the value allRight, outOfRange, endOfLine, or
+     endOfInput.
+  *)
+
+  (* The following procedure reads past the next line mark *)
+
+@findex SkipLine
+PROCEDURE SkipLine;
+  (* Removes successive items from the default input stream up to and including the next
+     line mark or until the end of input is reached. The read result is set to the value
+     allRight, or endOfInput.
+  *)
+
+
+  (* Output procedures *)
+
+@findex WriteChar
+PROCEDURE WriteChar (ch: CHAR);
+  (* Writes the value of ch to the default output stream. *)
+
+@findex WriteLn
+PROCEDURE WriteLn;
+  (* Writes a line mark to the default output stream. *)
+
+@findex WriteString
+PROCEDURE WriteString (s: ARRAY OF CHAR);
+  (* Writes the string value of s to the default output stream. *)
+
+END STextIO.
+@end example
+@page
+
+@node gm2-libs-iso/SWholeIO, gm2-libs-iso/SYSTEM, gm2-libs-iso/STextIO, M2 ISO Libraries
+@subsection gm2-libs-iso/SWholeIO
+
+@example
+DEFINITION MODULE SWholeIO;
+
+  (* Input and output of whole numbers in decimal text form over
+     default channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, @{decimal digit@}
+
+     The text form of an unsigned whole number is
+       decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadInt
+PROCEDURE ReadInt (VAR int: INTEGER);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of a signed
+     whole number.  The value of this number is assigned
+     to int.  The read result is set to the value allRight,
+     outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteInt
+PROCEDURE WriteInt (int: INTEGER; width: CARDINAL);
+  (* Writes the value of int to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+
+@findex ReadCard
+PROCEDURE ReadCard (VAR card: CARDINAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from the default input channel that form part of an
+     unsigned whole number.  The value of this number is
+     assigned to card.  The read result is set to the value
+     allRight, outOfRange, wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteCard
+PROCEDURE WriteCard (card: CARDINAL; width: CARDINAL);
+  (* Writes the value of card to the default output channel in
+     text form, in a field of the given minimum width.
+  *)
+
+END SWholeIO.
+@end example
+@page
+
+@node gm2-libs-iso/SYSTEM, gm2-libs-iso/Semaphores, gm2-libs-iso/SWholeIO, M2 ISO Libraries
+@subsection gm2-libs-iso/SYSTEM
+
+@example
+DEFINITION MODULE SYSTEM;
+
+  (* Gives access to system programming facilities that are probably
+     non portable. *)
+
+  (* The constants and types define underlying properties of storage *)
+
+EXPORT QUALIFIED BITSPERLOC, LOCSPERWORD,
+                 LOC, BYTE, WORD, ADDRESS, CSIZE_T, CSSIZE_T, (* 
+                 Target specific data types.  *)
+                 ADDADR, SUBADR, DIFADR, MAKEADR, ADR, ROTATE,
+                 SHIFT, CAST, TSIZE,
+
+                 (* Internal GM2 compiler functions *)
+                 ShiftVal, ShiftLeft, ShiftRight,
+                 RotateVal, RotateLeft, RotateRight,
+                 THROW, TBITSIZE ;
+
+CONST
+                  (* <implementation-defined constant> ; *)
+@findex BITSPERLOC (const)
+  BITSPERLOC    = __ATTRIBUTE__ __BUILTIN__ ((BITS_PER_UNIT)) ;
+                  (* <implementation-defined constant> ; *)
+@findex LOCSPERWORD (const)
+  LOCSPERWORD   = __ATTRIBUTE__ __BUILTIN__ ((UNITS_PER_WORD)) ;
+                  (* <implementation-defined constant> ; *)
+@findex LOCSPERBYTE (const)
+  LOCSPERBYTE = 8 DIV BITSPERLOC ;
+
+(* Note that the full list of system and sized datatypes include:
+   LOC, WORD, BYTE, ADDRESS,
+
+   (and the non language standard target types)
+
+   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+   WORD16, WORD32, WORD64, BITSET8, BITSET16,
+   BITSET32, REAL32, REAL64, REAL128, COMPLEX32,
+   COMPLEX64, COMPLEX128, CSIZE_T, CSSIZE_T.
+
+   Also note that the non-standard data types will
+   move into another module in the future.  *)
+
+(*
+   All the data types and procedures below are declared internally.
+   ===============================================================
+
+TYPE
+   (* Target specific data types.  *)
+
+TYPE
+  LOC; (* A system basic type. Values are the uninterpreted
+          contents of the smallest addressable unit of storage *)
+@findex ADDRESS (type)
+  ADDRESS = POINTER TO LOC;
+@findex WORD (type)
+  WORD = ARRAY [0 .. LOCSPERWORD-1] OF LOC;
+
+  (* BYTE and LOCSPERBYTE are provided if appropriate for machine *)
+
+TYPE
+@findex BYTE (type)
+  BYTE = ARRAY [0 .. LOCSPERBYTE-1] OF LOC;
+
+@findex ADDADR
+PROCEDURE ADDADR (addr: ADDRESS; offset: CARDINAL): ADDRESS;
+  (* Returns address given by (addr + offset), or may raise
+     an exception if this address is not valid.
+  *)
+
+@findex SUBADR
+PROCEDURE SUBADR (addr: ADDRESS; offset: CARDINAL): ADDRESS;
+  (* Returns address given by (addr - offset), or may raise an
+     exception if this address is not valid.
+  *)
+
+@findex DIFADR
+PROCEDURE DIFADR (addr1, addr2: ADDRESS): INTEGER;
+  (* Returns the difference between addresses (addr1 - addr2),
+     or may raise an exception if the arguments are invalid
+     or address space is non-contiguous.
+  *)
+
+@findex MAKEADR
+PROCEDURE MAKEADR (high: <some type>; ...): ADDRESS;
+  (* Returns an address constructed from a list of values whose
+     types are implementation-defined, or may raise an
+     exception if this address is not valid.
+
+     In GNU Modula-2, MAKEADR can take any number of arguments
+     which are mapped onto the type ADDRESS. The first parameter
+     maps onto the high address bits and subsequent parameters map
+     onto lower address bits. For example:
+
+     a := MAKEADR(BYTE(0FEH), BYTE(0DCH), BYTE(0BAH), BYTE(098H),
+                  BYTE(076H), BYTE(054H), BYTE(032H), BYTE(010H)) ;
+
+     then the value of, a, on a 64 bit machine is: 0FEDCBA9876543210H
+
+     The parameters do not have to be the same type, but constants
+     _must_ be typed.
+  *)
+
+@findex ADR
+PROCEDURE ADR (VAR v: <anytype>): ADDRESS;
+  (* Returns the address of variable v. *)
+
+@findex ROTATE
+PROCEDURE ROTATE (val: <a packedset type>;
+                  num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by rotating up/right
+     or down/right by the absolute value of num.  The direction is
+     down/right if the sign of num is negative, otherwise the direction
+     is up/left.
+  *)
+
+@findex SHIFT
+PROCEDURE SHIFT (val: <a packedset type>;
+                 num: INTEGER): <type of first parameter>;
+  (* Returns a bit sequence obtained from val by shifting up/left
+     or down/right by the absolute value of num, introducing
+     zeros as necessary.  The direction is down/right if the sign of
+     num is negative, otherwise the direction is up/left.
+  *)
+
+@findex CAST
+PROCEDURE CAST (<targettype>; val: <anytype>): <targettype>;
+  (* CAST is a type transfer function.  Given the expression
+     denoted by val, it returns a value of the type <targettype>.
+     An invalid value for the target value or a
+     physical address alignment problem may raise an exception.
+  *)
+
+@findex TSIZE
+PROCEDURE TSIZE (<type>; ... ): CARDINAL;
+  (* Returns the number of LOCS used to store a value of the
+     specified <type>.   The extra parameters, if present,
+     are used to distinguish variants in a variant record.
+  *)
+
+@findex THROW
+PROCEDURE THROW (i: INTEGER) ;
+  (*
+     THROW is a GNU extension and was not part of the PIM or ISO
+     standards.  It throws an exception which will be caught by the
+     EXCEPT block (assuming it exists).  This is a compiler builtin
+     function which interfaces to the GCC exception handling runtime
+     system.
+     GCC uses the term throw, hence the naming distinction between
+     the GCC builtin and the Modula-2 runtime library procedure Raise.
+     The later library procedure Raise will call SYSTEM.THROW after
+     performing various housekeeping activities.
+  *)
+
+@findex TBITSIZE
+PROCEDURE TBITSIZE (<type>) : CARDINAL ;
+  (* Returns the minimum number of bits necessary to represent
+     <type>.  This procedure function is only useful for determining
+     the number of bits used for any type field within a packed RECORD.
+     It is not particularly useful elsewhere since <type> might be
+     optimized for speed, for example a BOOLEAN could occupy a WORD.
+  *)
+*)
+
+
+(* The following procedures are invoked by GNU Modula-2 to
+   shift non word set types. They are not part of ISO Modula-2
+   but are used to implement the SHIFT procedure defined above. *)
+
+(*
+   ShiftVal - is a runtime procedure whose job is to implement
+              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
+              inline a SHIFT of a single WORD sized set and will only
+              call this routine for larger sets.
+*)
+
+@findex ShiftVal
+PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
+                    SetSizeInBits: CARDINAL;
+                    ShiftCount: INTEGER) ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+               This procedure might be called by the back end of
+               GNU Modula-2 depending whether amount is known at
+               compile time.
+*)
+
+@findex ShiftLeft
+PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+(*
+   ShiftRight - performs the shift left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex ShiftRight
+PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+
+
+(*
+   RotateVal - is a runtime procedure whose job is to implement
+               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
+               inline a ROTATE of a single WORD (or less)
+               sized set and will only call this routine for larger
+               sets.
+*)
+
+@findex RotateVal
+PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
+                     SetSizeInBits: CARDINAL;
+                     RotateCount: INTEGER) ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+                This procedure might be called by the back end of
+                GNU Modula-2 depending whether amount is known at
+                compile time.
+*)
+
+@findex RotateLeft
+PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
+                      SetSizeInBits: CARDINAL;
+                      RotateCount: CARDINAL) ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+                 This procedure might be called by the back end of
+                 GNU Modula-2 depending whether amount is known at
+                 compile time.
+*)
+
+@findex RotateRight
+PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
+                       SetSizeInBits: CARDINAL;
+                       RotateCount: CARDINAL) ;
+
+
+END SYSTEM.
+@end example
+@page
+
+@node gm2-libs-iso/Semaphores, gm2-libs-iso/SeqFile, gm2-libs-iso/SYSTEM, M2 ISO Libraries
+@subsection gm2-libs-iso/Semaphores
+
+@example
+DEFINITION MODULE Semaphores;
+
+  (* Provides mutual exclusion facilities for use by processes. *)
+
+TYPE
+  SEMAPHORE;
+
+@findex Create
+PROCEDURE Create (VAR s: SEMAPHORE; initialCount: CARDINAL );
+  (* Creates and returns s as the identity of a new semaphore that
+     has its associated count initialized to initialCount, and has
+     no processes yet waiting on it.
+  *)
+
+@findex Destroy
+PROCEDURE Destroy (VAR s: SEMAPHORE);
+  (* Recovers the resources used to implement the semaphore s,
+     provided that no process is waiting for s to become free.
+  *)
+
+@findex Claim
+PROCEDURE Claim (s: SEMAPHORE);
+  (* If the count associated with the semaphore s is non-zero,
+     decrements this count and allows the calling process to
+     continue; otherwise suspends the calling process until
+     s is released.
+  *)
+
+@findex Release
+PROCEDURE Release (s: SEMAPHORE);
+  (* If there are any processes waiting on the semaphore s,
+     allows one of them to enter the ready state; otherwise
+     increments the count associated with s.
+  *)
+
+@findex CondClaim
+PROCEDURE CondClaim (s: SEMAPHORE): BOOLEAN;
+  (* Returns FALSE if the call Claim(s) would cause the calling
+     process to be suspended; in this case the count associated
+     with s is not changed. Otherwise returns TRUE and the
+     associated count is decremented.
+  *)
+
+END Semaphores.
+
+@end example
+@page
+
+@node gm2-libs-iso/SeqFile, gm2-libs-iso/ShortComplexMath, gm2-libs-iso/Semaphores, M2 ISO Libraries
+@subsection gm2-libs-iso/SeqFile
+
+@example
+DEFINITION MODULE SeqFile;
+
+  (* Rewindable sequential files *)
+
+IMPORT IOChan, ChanConsts;
+
+TYPE
+@findex ChanId (type)
+  ChanId = IOChan.ChanId;
+@findex FlagSet (type)
+  FlagSet = ChanConsts.FlagSet;
+@findex OpenResults (type)
+  OpenResults = ChanConsts.OpenResults;
+
+  (* Accepted singleton values of FlagSet *)
+
+CONST
+  (* input operations are requested/available *)
+@findex read (const)
+  read = FlagSet@{ChanConsts.readFlag@};
+
+  (* output operations are requested/available *)
+@findex write (const)
+  write = FlagSet@{ChanConsts.writeFlag@};
+
+  (* a file may/must/did exist before the channel is opened *)
+@findex old (const)
+  old = FlagSet@{ChanConsts.oldFlag@};
+
+  (* text operations are requested/available *)
+@findex text (const)
+  text = FlagSet@{ChanConsts.textFlag@};
+
+  (* raw operations are requested/available *)
+@findex raw (const)
+  raw = FlagSet@{ChanConsts.rawFlag@};
+
+@findex OpenWrite
+PROCEDURE OpenWrite (VAR cid: ChanId; name: ARRAY OF CHAR;
+                     flags: FlagSet; VAR res: OpenResults);
+  (*
+     Attempts to obtain and open a channel connected to a stored
+     rewindable file of the given name.
+     The write flag is implied; without the raw flag, text is
+     implied.  If successful, assigns to cid the identity of
+     the opened channel, assigns the value opened to res, and
+     selects output mode, with the write position at the start
+     of the file (i.e. the file is of zero length).
+     If a channel cannot be opened as required, the value of
+     res indicates the reason, and cid identifies the invalid
+     channel.
+  *)
+
+@findex OpenAppend
+PROCEDURE OpenAppend (VAR cid: ChanId; name: ARRAY OF CHAR;
+                      flags: FlagSet; VAR res: OpenResults);
+  (*
+     Attempts to obtain and open a channel connected to a stored
+     rewindable file of the given name.  The write and old flags
+     are implied; without the raw flag, text is implied.  If
+     successful, assigns to cid the identity of the opened channel,
+     assigns the value opened to res, and selects output mode,
+     with the write position corresponding to the length of the
+     file.  If a channel cannot be opened as required, the value
+     of res indicates the reason, and cid identifies the invalid
+     channel.
+  *)
+
+@findex OpenRead
+PROCEDURE OpenRead (VAR cid: ChanId; name: ARRAY OF CHAR;
+                    flags: FlagSet; VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a stored
+     rewindable file of the given name.
+     The read and old flags are implied; without the raw flag,
+     text is implied.  If successful, assigns to cid the
+     identity of the opened channel, assigns the value opened to
+     res, and selects input mode, with the read position
+     corresponding to the start of the file.
+     If a channel cannot be opened as required, the value of
+     res indicates the reason, and cid identifies the invalid
+     channel.
+  *)
+
+@findex IsSeqFile
+PROCEDURE IsSeqFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to a
+     rewindable sequential file. *)
+
+@findex Reread
+PROCEDURE Reread (cid: ChanId);
+  (* If the channel identified by cid is not open to a rewindable
+     sequential file, the exception wrongDevice is raised;
+     otherwise attempts to set the read position to the
+     start of the file, and to select input mode.
+     If the operation cannot be performed (perhaps because of
+     insufficient permissions) neither input mode nor output
+     mode is selected.
+  *)
+
+@findex Rewrite
+PROCEDURE Rewrite (cid: ChanId);
+  (* If the channel identified by cid is not open to a
+     rewindable sequential file, the exception wrongDevice is
+     raised; otherwise, attempts to truncate the file to zero
+     length, and to select output mode.  If the operation
+     cannot be performed (perhaps because of insufficient
+     permissions) neither input mode nor output mode is selected.
+  *)
+
+@findex Close
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to a rewindable
+     sequential file, the exception wrongDevice is raised;
+     otherwise closes the channel, and assigns the value
+     identifying the invalid channel to cid.
+  *)
+
+END SeqFile.
+
+@end example
+@page
+
+@node gm2-libs-iso/ShortComplexMath, gm2-libs-iso/ShortIO, gm2-libs-iso/SeqFile, M2 ISO Libraries
+@subsection gm2-libs-iso/ShortComplexMath
+
+@example
+DEFINITION MODULE ShortComplexMath;
+
+  (* Mathematical functions for the type SHORTCOMPLEX *)
+
+CONST
+@findex i (const)
+  i =    CMPLX (0.0, 1.0);
+@findex one (const)
+  one =  CMPLX (1.0, 0.0);
+@findex zero (const)
+  zero = CMPLX (0.0, 0.0);
+
+@findex abs
+PROCEDURE abs (z: SHORTCOMPLEX): SHORTREAL;
+  (* Returns the length of z *)
+
+@findex arg
+PROCEDURE arg (z: SHORTCOMPLEX): SHORTREAL;
+  (* Returns the angle that z subtends to the positive real axis *)
+
+@findex conj
+PROCEDURE conj (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the complex conjugate of z *)
+
+@findex power
+PROCEDURE power (base: SHORTCOMPLEX; exponent: SHORTREAL): SHORTCOMPLEX;
+  (* Returns the value of the number base raised to the power exponent *)
+
+@findex sqrt
+PROCEDURE sqrt (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the principal square root of z *)
+
+@findex exp
+PROCEDURE exp (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the complex exponential of z *)
+
+@findex ln
+PROCEDURE ln (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the principal value of the natural logarithm of z *)
+
+@findex sin
+PROCEDURE sin (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the sine of z *)
+
+@findex cos
+PROCEDURE cos (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the cosine of z *)
+
+@findex tan
+PROCEDURE tan (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the tangent of z *)
+
+@findex arcsin
+PROCEDURE arcsin (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the arcsine of z *)
+
+@findex arccos
+PROCEDURE arccos (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the arccosine of z *)
+
+@findex arctan
+PROCEDURE arctan (z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the arctangent of z *)
+
+@findex polarToComplex
+PROCEDURE polarToComplex (abs, arg: SHORTREAL): SHORTCOMPLEX;
+  (* Returns the complex number with the specified polar coordinates *)
+
+@findex scalarMult
+PROCEDURE scalarMult (scalar: SHORTREAL; z: SHORTCOMPLEX): SHORTCOMPLEX;
+  (* Returns the scalar product of scalar with z *)
+
+@findex IsCMathException
+PROCEDURE IsCMathException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of an exception in a routine from this module; otherwise
+     returns FALSE.
+  *)
+
+END ShortComplexMath.
+
+@end example
+@page
+
+@node gm2-libs-iso/ShortIO, gm2-libs-iso/ShortWholeIO, gm2-libs-iso/ShortComplexMath, M2 ISO Libraries
+@subsection gm2-libs-iso/ShortIO
+
+@example
+DEFINITION MODULE ShortIO;
+
+  (* Input and output of short real numbers in decimal text form
+     over specified channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed fixed-point real number is
+       ["+" | "-"], decimal digit, @{decimal digit@}, [".",
+       @{decimal digit@}]
+
+     The text form of a signed floating-point real number is
+       signed fixed-point real number,
+       "E", ["+" | "-"], decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadReal
+PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: SHORTREAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed fixed or floating
+     point number.  The value of this number is assigned to real.
+     The read result is set to the value allRight, outOfRange,
+     wrongFormat, endOfLine, or endOfInput.
+  *)
+
+@findex WriteFloat
+PROCEDURE WriteFloat (cid: IOChan.ChanId; real: SHORTREAL;
+                      sigFigs: CARDINAL; width: CARDINAL);
+  (* Writes the value of real to cid in floating-point text form,
+     with sigFigs significant figures, in a field of the given
+     minimum width.
+  *)
+
+@findex WriteEng
+PROCEDURE WriteEng (cid: IOChan.ChanId; real: SHORTREAL;
+                    sigFigs: CARDINAL; width: CARDINAL);
+  (* As for WriteFloat, except that the number is scaled with
+     one to three digits in the whole number part, and with an
+     exponent that is a multiple of three.
+  *)
+
+@findex WriteFixed
+PROCEDURE WriteFixed (cid: IOChan.ChanId; real: SHORTREAL;
+                      place: INTEGER; width: CARDINAL);
+  (* Writes the value of real to cid in fixed-point text form,
+     rounded to the given place relative to the decimal point,
+     in a field of the given minimum width.
+  *)
+
+@findex WriteReal
+PROCEDURE WriteReal (cid: IOChan.ChanId; real: SHORTREAL;
+                     width: CARDINAL);
+  (* Writes the value of real to cid, as WriteFixed if the
+     sign and magnitude can be shown in the given width, or
+     otherwise as WriteFloat.  The number of places or
+     significant digits depends on the given width.
+  *)
+
+END ShortIO.
+@end example
+@page
+
+@node gm2-libs-iso/ShortWholeIO, gm2-libs-iso/SimpleCipher, gm2-libs-iso/ShortIO, M2 ISO Libraries
+@subsection gm2-libs-iso/ShortWholeIO
+
+@example
+DEFINITION MODULE ShortWholeIO;
+
+  (* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, @{decimal digit@}
+
+     The text form of an unsigned whole number is
+       decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadInt
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: SHORTINT);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+@findex WriteInt
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: SHORTINT;
+                    width: CARDINAL);
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+
+@findex ReadCard
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: SHORTCARD);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+@findex WriteCard
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: SHORTCARD;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+
+END ShortWholeIO.
+@end example
+@page
+
+@node gm2-libs-iso/SimpleCipher, gm2-libs-iso/StdChans, gm2-libs-iso/ShortWholeIO, M2 ISO Libraries
+@subsection gm2-libs-iso/SimpleCipher
+
+@example
+DEFINITION MODULE SimpleCipher ;
+
+(*
+    Description: provides a simple Caesar cipher layer which
+                 can be attached to any channel device.  This,
+                 pedagogical, module is designed to show how
+                 it is possible to add further layers underneath
+                 the channel devices.
+*)
+
+FROM IOChan IMPORT ChanId ;
+
+
+(*
+   InsertCipherLayer - inserts a caesar cipher below channel, cid.
+                       The encryption, key, is specified.
+*)
+
+@findex InsertCipherLayer
+PROCEDURE InsertCipherLayer (cid: ChanId; key: INTEGER) ;
+
+
+(*
+   RemoveCipherLayer - removes a Caesar cipher below channel, cid.
+*)
+
+@findex RemoveCipherLayer
+PROCEDURE RemoveCipherLayer (cid: ChanId) ;
+
+
+END SimpleCipher.
+@end example
+@page
+
+@node gm2-libs-iso/StdChans, gm2-libs-iso/Storage, gm2-libs-iso/SimpleCipher, M2 ISO Libraries
+@subsection gm2-libs-iso/StdChans
+
+@example
+DEFINITION MODULE StdChans;
+
+  (* Access to standard and default channels *)
+
+IMPORT IOChan;
+
+TYPE
+@findex ChanId (type)
+  ChanId = IOChan.ChanId;
+    (* Values of this type are used to identify channels *)
+
+  (* The following functions return the standard channel values.
+     These channels cannot be closed.
+  *)
+
+@findex StdInChan
+PROCEDURE StdInChan (): ChanId;
+  (* Returns the identity of the implementation-defined standard source for
+program
+     input.
+  *)
+
+@findex StdOutChan
+PROCEDURE StdOutChan (): ChanId;
+  (* Returns the identity of the implementation-defined standard source for program
+     output.
+  *)
+
+@findex StdErrChan
+PROCEDURE StdErrChan (): ChanId;
+  (* Returns the identity of the implementation-defined standard destination for program
+     error messages.
+  *)
+
+@findex NullChan
+PROCEDURE NullChan (): ChanId;
+  (* Returns the identity of a channel open to the null device. *)
+
+  (* The following functions return the default channel values *)
+
+@findex InChan
+PROCEDURE InChan (): ChanId;
+  (* Returns the identity of the current default input channel. *)
+
+@findex OutChan
+PROCEDURE OutChan (): ChanId;
+  (* Returns the identity of the current default output channel. *)
+
+@findex ErrChan
+PROCEDURE ErrChan (): ChanId;
+  (* Returns the identity of the current default error message channel. *)
+
+  (* The following procedures allow for redirection of the default channels *)
+
+@findex SetInChan
+PROCEDURE SetInChan (cid: ChanId);
+  (* Sets the current default input channel to that identified by cid. *)
+
+@findex SetOutChan
+PROCEDURE SetOutChan (cid: ChanId);
+  (* Sets the current default output channel to that identified by cid. *)
+
+@findex SetErrChan
+PROCEDURE SetErrChan (cid: ChanId);
+  (* Sets the current default error channel to that identified by cid. *)
+
+END StdChans.
+@end example
+@page
+
+@node gm2-libs-iso/Storage, gm2-libs-iso/StreamFile, gm2-libs-iso/StdChans, M2 ISO Libraries
+@subsection gm2-libs-iso/Storage
+
+@example
+DEFINITION MODULE Storage;
+
+  (* Facilities for dynamically allocating and deallocating storage *)
+
+IMPORT SYSTEM;
+
+@findex ALLOCATE
+PROCEDURE ALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL);
+  (* Allocates storage for a variable of size amount and assigns
+     the address of this variable to addr. If there is insufficient
+     unallocated storage to do this, the value NIL is assigned to addr.
+  *)
+
+@findex DEALLOCATE
+PROCEDURE DEALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL);
+  (* Deallocates amount locations allocated by ALLOCATE for
+     the storage of the variable addressed by addr and assigns
+     the value NIL to addr.
+  *)
+
+@findex REALLOCATE
+PROCEDURE REALLOCATE (VAR addr: SYSTEM.ADDRESS; amount: CARDINAL);
+  (* Attempts to reallocate, amount of storage.  Effectively it
+     calls ALLOCATE, copies the amount of data pointed to by
+     addr into the new space and DEALLOCATES the addr.
+     This procedure is a GNU extension.
+  *)
+
+TYPE
+@findex StorageExceptions (type)
+  StorageExceptions = (
+    nilDeallocation,             (* first argument to DEALLOCATE is NIL *)
+    pointerToUnallocatedStorage, (* storage to deallocate not allocated by ALLOCATE *)
+    wrongStorageToUnallocate     (* amount to deallocate is not amount allocated *)
+  );
+
+@findex IsStorageException
+PROCEDURE IsStorageException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional
+     execution state because of the raising of an exception from
+     StorageExceptions; otherwise returns FALSE.
+  *)
+
+@findex StorageException
+PROCEDURE StorageException (): StorageExceptions;
+  (* If the current coroutine is in the exceptional execution
+     state because of the raising of an exception from
+     StorageExceptions, returns the corresponding
+     enumeration value, and otherwise raises an exception.
+  *)
+
+END Storage.
+@end example
+@page
+
+@node gm2-libs-iso/StreamFile, gm2-libs-iso/StringChan, gm2-libs-iso/Storage, M2 ISO Libraries
+@subsection gm2-libs-iso/StreamFile
+
+@example
+DEFINITION MODULE StreamFile;
+
+  (* Independent sequential data streams *)
+
+IMPORT IOChan, ChanConsts;
+
+TYPE
+@findex ChanId (type)
+  ChanId = IOChan.ChanId;
+@findex FlagSet (type)
+  FlagSet = ChanConsts.FlagSet;
+@findex OpenResults (type)
+  OpenResults = ChanConsts.OpenResults;
+
+  (* Accepted singleton values of FlagSet *)
+
+CONST
+@findex read (const)
+  read = FlagSet@{ChanConsts.readFlag@};   (* input operations are requested/available *)
+@findex write (const)
+  write = FlagSet@{ChanConsts.writeFlag@}; (* output operations are requested/available *)
+@findex old (const)
+  old = FlagSet@{ChanConsts.oldFlag@};     (* a file may/must/did exist before the channel is
+                                            opened *)
+@findex text (const)
+  text = FlagSet@{ChanConsts.textFlag@};   (* text operations are requested/available *)
+@findex raw (const)
+  raw = FlagSet@{ChanConsts.rawFlag@};     (* raw operations are requested/available *)
+
+
+@findex Open
+PROCEDURE Open (VAR cid: ChanId; name: ARRAY OF CHAR;
+                flags: FlagSet; VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to a
+     sequential stream of the given name.
+     The read flag implies old; without the raw flag, text is
+     implied.  If successful, assigns to cid the identity of
+     the opened channel, and assigns the value opened to res.
+     If a channel cannot be opened as required, the value of
+     res indicates the reason, and cid identifies the invalid
+     channel.
+  *)
+
+@findex IsStreamFile
+PROCEDURE IsStreamFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to a sequential stream. *)
+
+@findex Close
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to a sequential stream, the exception
+     wrongDevice is raised; otherwise closes the channel, and assigns the value identifying
+     the invalid channel to cid.
+  *)
+
+END StreamFile.
+
+@end example
+@page
+
+@node gm2-libs-iso/StringChan, gm2-libs-iso/Strings, gm2-libs-iso/StreamFile, M2 ISO Libraries
+@subsection gm2-libs-iso/StringChan
+
+@example
+DEFINITION MODULE StringChan ;
+
+(*
+    Description: provides a set of Channel and String
+                 input and output procedures.
+*)
+
+FROM DynamicStrings IMPORT String ;
+IMPORT IOChan;
+
+
+(*
+   writeString - writes a string, s, to ChanId, cid.
+                 The string, s, is not destroyed.
+*)
+
+@findex writeString
+PROCEDURE writeString (cid: IOChan.ChanId; s: String) ;
+
+
+(*
+   writeFieldWidth - writes a string, s, to ChanId, cid.
+                     The string, s, is not destroyed and it
+                     is prefixed by spaces so that at least,
+                     width, characters are written.  If the
+                     string, s, is longer than width then
+                     no spaces are prefixed to the output
+                     and the entire string is written.
+*)
+
+@findex writeFieldWidth
+PROCEDURE writeFieldWidth (cid: IOChan.ChanId;
+                           s: String; width: CARDINAL) ;
+
+
+END StringChan.
+@end example
+@page
+
+@node gm2-libs-iso/Strings, gm2-libs-iso/SysClock, gm2-libs-iso/StringChan, M2 ISO Libraries
+@subsection gm2-libs-iso/Strings
+
+@example
+DEFINITION MODULE Strings;
+
+  (* Facilities for manipulating strings *)
+
+TYPE
+@findex String1 (type)
+  String1 = ARRAY [0..0] OF CHAR;
+    (* String1 is provided for constructing a value of a single-character string type from a
+       single character value in order to pass CHAR values to ARRAY OF CHAR parameters.
+    *)
+
+@findex Length
+PROCEDURE Length (stringVal: ARRAY OF CHAR): CARDINAL;
+  (* Returns the length of stringVal (the same value as would be returned by the
+     pervasive function LENGTH).
+  *)
+
+
+(* The following seven procedures construct a string value, and attempt to assign it to a
+   variable parameter.  They all have the property that if the length of the constructed string
+   value exceeds the capacity of the variable parameter, a truncated value is assigned, while
+   if the length of the constructed string value is less than the capacity of the variable
+   parameter, a string terminator is appended before assignment is performed.
+*)
+
+@findex Assign
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Copies source to destination *)
+
+@findex Extract
+PROCEDURE Extract (source: ARRAY OF CHAR; startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  (* Copies at most numberToExtract characters from source to destination, starting at position
+     startIndex in source.
+  *)
+
+@findex Delete
+PROCEDURE Delete (VAR stringVar: ARRAY OF CHAR; startIndex, numberToDelete:
+CARDINAL);
+  (* Deletes at most numberToDelete characters from stringVar, starting at position
+     startIndex.
+  *)
+
+@findex Insert
+PROCEDURE Insert (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                  VAR destination: ARRAY OF CHAR);
+  (* Inserts source into destination at position startIndex *)
+
+@findex Replace
+PROCEDURE Replace (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  (* Copies source into destination, starting at position startIndex. Copying stops when
+     all of source has been copied, or when the last character of the string value in
+     destination has been replaced.
+  *)
+
+@findex Append
+PROCEDURE Append (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Appends source to destination. *)
+
+@findex Concat
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Concatenates source2 onto source1 and copies the result into destination. *)
+
+(* The following predicates provide for pre-testing of the operation-completion
+   conditions for the procedures above.
+*)
+
+@findex CanAssignAll
+PROCEDURE CanAssignAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if a number of characters, indicated by sourceLength, will fit into
+     destination; otherwise returns FALSE.
+  *)
+
+@findex CanExtractAll
+PROCEDURE CanExtractAll (sourceLength, startIndex, numberToExtract: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there are numberToExtract characters starting at startIndex and
+     within the sourceLength of some string, and if the capacity of destination is
+     sufficient to hold numberToExtract characters; otherwise returns FALSE.
+  *)
+
+@findex CanDeleteAll
+PROCEDURE CanDeleteAll (stringLength, startIndex, numberToDelete: CARDINAL): BOOLEAN;
+  (* Returns TRUE if there are numberToDelete characters starting at startIndex and
+     within the stringLength of some string; otherwise returns FALSE.
+  *)
+
+@findex CanInsertAll
+PROCEDURE CanInsertAll (sourceLength, startIndex: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is room for the insertion of sourceLength characters from
+     some string into destination starting at startIndex; otherwise returns FALSE.
+  *)
+
+@findex CanReplaceAll
+PROCEDURE CanReplaceAll (sourceLength, startIndex: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is room for the replacement of sourceLength characters in
+     destination starting at startIndex; otherwise returns FALSE.
+  *)
+
+@findex CanAppendAll
+PROCEDURE CanAppendAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination to append a string of
+     length sourceLength to the string in destination; otherwise returns FALSE.
+  *)
+
+@findex CanConcatAll
+PROCEDURE CanConcatAll (source1Length, source2Length: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination for a two strings of
+     lengths source1Length and source2Length; otherwise returns FALSE.
+  *)
+
+(* The following type and procedures provide for the comparison of string values, and for the
+   location of substrings within strings.
+*)
+
+TYPE
+@findex CompareResults (type)
+  CompareResults = (less, equal, greater);
+
+@findex Compare
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): CompareResults;
+  (* Returns less, equal, or greater, according as stringVal1 is lexically less than,
+     equal to, or greater than stringVal2.
+  *)
+
+@findex Equal
+PROCEDURE Equal (stringVal1, stringVal2: ARRAY OF CHAR): BOOLEAN;
+  (* Returns Strings.Compare(stringVal1, stringVal2) = Strings.equal *)
+
+@findex FindNext
+PROCEDURE FindNext (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks forward for next occurrence of pattern in stringToSearch, starting the search at
+     position startIndex. If startIndex < LENGTH(stringToSearch) and pattern is found,
+     patternFound is returned as TRUE, and posOfPattern contains the start position in
+     stringToSearch of pattern. Otherwise patternFound is returned as FALSE, and posOfPattern
+     is unchanged.
+  *)
+
+@findex FindPrev
+PROCEDURE FindPrev (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks backward for the previous occurrence of pattern in stringToSearch and returns the
+     position of the first character of the pattern if found. The search for the pattern
+     begins at startIndex. If pattern is found, patternFound is returned as TRUE, and
+     posOfPattern contains the start position in stringToSearch of pattern in the range
+     [0..startIndex]. Otherwise patternFound is returned as FALSE, and posOfPattern is unchanged.
+  *)
+
+@findex FindDiff
+PROCEDURE FindDiff (stringVal1, stringVal2: ARRAY OF CHAR;
+                    VAR differenceFound: BOOLEAN; VAR posOfDifference: CARDINAL);
+  (* Compares the string values in stringVal1 and stringVal2 for differences. If they
+     are equal, differenceFound is returned as FALSE, and TRUE otherwise. If
+     differenceFound is TRUE, posOfDifference is set to the position of the first
+     difference; otherwise posOfDifference is unchanged.
+  *)
+
+@findex Capitalize
+PROCEDURE Capitalize (VAR stringVar: ARRAY OF CHAR);
+  (* Applies the function CAP to each character of the string value in stringVar. *)
+
+
+END Strings.
+
+@end example
+@page
+
+@node gm2-libs-iso/SysClock, gm2-libs-iso/TERMINATION, gm2-libs-iso/Strings, M2 ISO Libraries
+@subsection gm2-libs-iso/SysClock
+
+@example
+DEFINITION MODULE SysClock;
+
+(* Facilities for accessing a system clock that records the date
+   and time of day *)
+
+CONST
+@findex maxSecondParts (const)
+  maxSecondParts = 1000000 ;
+
+TYPE
+@findex Month (type)
+  Month    = [1 .. 12];
+@findex Day (type)
+  Day      = [1 .. 31];
+@findex Hour (type)
+  Hour     = [0 .. 23];
+@findex Min (type)
+  Min      = [0 .. 59];
+@findex Sec (type)
+  Sec      = [0 .. 59];
+@findex Fraction (type)
+  Fraction = [0 .. maxSecondParts];
+@findex UTCDiff (type)
+  UTCDiff  = [-780 .. 720];
+@findex DateTime (type)
+  DateTime =
+    RECORD
+      year:      CARDINAL;
+      month:     Month;
+      day:       Day;
+      hour:      Hour;
+      minute:    Min;
+      second:    Sec;
+      fractions: Fraction;      (* parts of a second *)
+      zone:      UTCDiff;       (* Time zone differential
+                                   factor which is the number
+                                   of minutes to add to local
+                                   time to obtain UTC. *)
+      summerTimeFlag: BOOLEAN;  (* Interpretation of flag
+                                   depends on local usage. *)
+    END;
+
+@findex CanGetClock
+PROCEDURE CanGetClock(): BOOLEAN;
+(* Tests if the clock can be read *)
+
+@findex CanSetClock
+PROCEDURE CanSetClock(): BOOLEAN;
+(* Tests if the clock can be set *)
+
+@findex IsValidDateTime
+PROCEDURE IsValidDateTime(userData: DateTime): BOOLEAN;
+(* Tests if the value of userData is a valid *)
+
+@findex GetClock
+PROCEDURE GetClock(VAR userData: DateTime);
+(* Assigns local date and time of the day to userData *)
+
+@findex SetClock
+PROCEDURE SetClock(userData: DateTime);
+(* Sets the system time clock to the given local date and
+   time *)
+
+END SysClock.
+@end example
+@page
+
+@node gm2-libs-iso/TERMINATION, gm2-libs-iso/TermFile, gm2-libs-iso/SysClock, M2 ISO Libraries
+@subsection gm2-libs-iso/TERMINATION
+
+@example
+DEFINITION MODULE TERMINATION;
+
+(* Provides facilities for enquiries concerning the occurrence of termination events. *)
+
+@findex IsTerminating
+PROCEDURE IsTerminating (): BOOLEAN ;
+  (* Returns true if any coroutine has started  program termination and false otherwise. *)
+
+@findex HasHalted
+PROCEDURE HasHalted (): BOOLEAN ;
+  (* Returns true if a call to HALT has been made and false otherwise. *)
+
+END TERMINATION.
+@end example
+@page
+
+@node gm2-libs-iso/TermFile, gm2-libs-iso/TextIO, gm2-libs-iso/TERMINATION, M2 ISO Libraries
+@subsection gm2-libs-iso/TermFile
+
+@example
+DEFINITION MODULE TermFile;
+
+  (* Access to the terminal device *)
+
+  (* Channels opened by this module are connected to a single
+     terminal device; typed characters are distributed between
+     channels according to the sequence of read requests.
+  *)
+
+IMPORT IOChan, ChanConsts;
+
+TYPE
+@findex ChanId (type)
+  ChanId = IOChan.ChanId;
+@findex FlagSet (type)
+  FlagSet = ChanConsts.FlagSet;
+@findex OpenResults (type)
+  OpenResults = ChanConsts.OpenResults;
+
+  (* Accepted singleton values of FlagSet *)
+
+CONST
+@findex read (const)
+  read = FlagSet@{ChanConsts.readFlag@};
+  (* input operations are requested/available *)
+@findex write (const)
+  write = FlagSet@{ChanConsts.writeFlag@};
+  (* output operations are requested/available *)
+@findex text (const)
+  text = FlagSet@{ChanConsts.textFlag@};
+  (* text operations are requested/available *)
+@findex raw (const)
+  raw = FlagSet@{ChanConsts.rawFlag@};
+  (* raw operations are requested/available *)
+@findex echo (const)
+  echo = FlagSet@{ChanConsts.echoFlag@};
+  (* echoing by interactive device on reading of
+     characters from input stream requested/applies
+  *)
+
+@findex Open
+PROCEDURE Open (VAR cid: ChanId; flagset: FlagSet; VAR res: OpenResults);
+  (* Attempts to obtain and open a channel connected to
+     the terminal.  Without the raw flag, text is implied.
+     Without the echo flag, line mode is requested,
+     otherwise single character mode is requested.
+     If successful, assigns to cid the identity of
+     the opened channel, and assigns the value opened to res.
+     If a channel cannot be opened as required, the value of
+     res indicates the reason, and cid identifies the
+     invalid channel.
+  *)
+
+@findex IsTermFile
+PROCEDURE IsTermFile (cid: ChanId): BOOLEAN;
+  (* Tests if the channel identified by cid is open to
+     the terminal. *)
+
+@findex Close
+PROCEDURE Close (VAR cid: ChanId);
+  (* If the channel identified by cid is not open to the terminal,
+     the exception wrongDevice is raised; otherwise closes the
+     channel and assigns the value identifying the invalid channel
+     to cid.
+  *)
+
+END TermFile.
+
+@end example
+@page
+
+@node gm2-libs-iso/TextIO, gm2-libs-iso/WholeConv, gm2-libs-iso/TermFile, M2 ISO Libraries
+@subsection gm2-libs-iso/TextIO
+
+@example
+DEFINITION MODULE TextIO;
+
+  (* Input and output of character and string types over
+     specified channels.  The read result is of the type
+     IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The following procedures do not read past line marks *)
+
+@findex ReadChar
+PROCEDURE ReadChar (cid: IOChan.ChanId; VAR ch: CHAR);
+  (* If possible, removes a character from the input stream
+     cid and assigns the corresponding value to ch.  The
+     read result is set to the value allRight, endOfLine, or
+     endOfInput.
+  *)
+
+@findex ReadRestLine
+PROCEDURE ReadRestLine (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Removes any remaining characters from the input stream
+     cid before the next line mark,  copying to s as many as
+     can be accommodated as a string value.  The read result is
+     set to the value allRight, outOfRange, endOfLine, or
+     endOfInput.
+  *)
+
+@findex ReadString
+PROCEDURE ReadString (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Removes only those characters from the input stream cid
+     before the next line mark that can be accommodated in s
+     as a string value, and copies them to s.  The read result
+     is set to the value allRight, endOfLine, or endOfInput.
+  *)
+
+@findex ReadToken
+PROCEDURE ReadToken (cid: IOChan.ChanId; VAR s: ARRAY OF CHAR);
+  (* Skips leading spaces, and then removes characters from
+     the input stream cid before the next space or line mark,
+     copying to s as many as can be accommodated as a string
+     value.  The read result is set to the value allRight,
+     outOfRange, endOfLine, or endOfInput.
+  *)
+
+  (* The following procedure reads past the next line mark *)
+
+@findex SkipLine
+PROCEDURE SkipLine (cid: IOChan.ChanId);
+  (* Removes successive items from the input stream cid up
+     to and including the next line mark, or until the end
+     of input is reached.  The read result is set to the
+     value allRight, or endOfInput.
+  *)
+
+  (* Output procedures *)
+
+@findex WriteChar
+PROCEDURE WriteChar (cid: IOChan.ChanId; ch: CHAR);
+  (* Writes the value of ch to the output stream cid. *)
+
+@findex WriteLn
+PROCEDURE WriteLn (cid: IOChan.ChanId);
+  (* Writes a line mark to the output stream cid. *)
+
+@findex WriteString
+PROCEDURE WriteString (cid: IOChan.ChanId; s: ARRAY OF CHAR);
+  (* Writes the string value in s to the output stream cid. *)
+
+END TextIO.
+
+@end example
+@page
+
+@node gm2-libs-iso/WholeConv, gm2-libs-iso/WholeIO, gm2-libs-iso/TextIO, M2 ISO Libraries
+@subsection gm2-libs-iso/WholeConv
+
+@example
+DEFINITION MODULE WholeConv;
+
+  (* Low-level whole-number/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+@findex ConvResults (type)
+  ConvResults = ConvTypes.ConvResults;
+        (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+
+@findex ScanInt
+PROCEDURE ScanInt (inputCh: CHAR;
+                   VAR chClass: ConvTypes.ScanClass;
+                   VAR nextState: ConvTypes.ScanState) ;
+  (* Represents the start state of a finite state scanner for signed
+     whole numbers - assigns class of inputCh to chClass and a
+     procedure representing the next state to nextState.
+  *)
+
+@findex FormatInt
+PROCEDURE FormatInt (str: ARRAY OF CHAR): ConvResults;
+  (* Returns the format of the string value for conversion to INTEGER. *)
+
+@findex ValueInt
+PROCEDURE ValueInt (str: ARRAY OF CHAR): INTEGER;
+  (* Returns the value corresponding to the signed whole number string
+     value str if str is well-formed; otherwise raises the WholeConv
+     exception.
+   *)
+
+@findex LengthInt
+PROCEDURE LengthInt (int: INTEGER): CARDINAL;
+  (* Returns the number of characters in the string representation of
+     int.
+   *)
+
+@findex ScanCard
+PROCEDURE ScanCard (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState);
+  (* Represents the start state of a finite state scanner for unsigned
+     whole numbers - assigns class of inputCh to chClass and a procedure
+     representing the next state to nextState.
+   *)
+
+@findex FormatCard
+PROCEDURE FormatCard (str: ARRAY OF CHAR): ConvResults;
+  (* Returns the format of the string value for conversion to CARDINAL.
+   *)
+
+@findex ValueCard
+PROCEDURE ValueCard (str: ARRAY OF CHAR): CARDINAL;
+  (* Returns the value corresponding to the unsigned whole number string
+     value str if str is well-formed; otherwise raises the WholeConv
+     exception.
+   *)
+
+@findex LengthCard
+PROCEDURE LengthCard (card: CARDINAL): CARDINAL;
+  (* Returns the number of characters in the string representation of
+     card.
+   *)
+
+@findex IsWholeConvException
+PROCEDURE IsWholeConvException (): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution
+     state because of the raising of an exception in a routine from this
+     module; otherwise returns FALSE.
+  *)
+
+END WholeConv.
+@end example
+@page
+
+@node gm2-libs-iso/WholeIO, gm2-libs-iso/WholeStr, gm2-libs-iso/WholeConv, M2 ISO Libraries
+@subsection gm2-libs-iso/WholeIO
+
+@example
+DEFINITION MODULE WholeIO;
+
+  (* Input and output of whole numbers in decimal text form
+     over specified channels.  The read result is of the
+     type IOConsts.ReadResults.
+  *)
+
+IMPORT IOChan;
+
+  (* The text form of a signed whole number is
+       ["+" | "-"], decimal digit, @{decimal digit@}
+
+     The text form of an unsigned whole number is
+       decimal digit, @{decimal digit@}
+  *)
+
+@findex ReadInt
+PROCEDURE ReadInt (cid: IOChan.ChanId; VAR int: INTEGER);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of a signed whole number.  The
+     value of this number is assigned to int.  The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+@findex WriteInt
+PROCEDURE WriteInt (cid: IOChan.ChanId; int: INTEGER;
+                    width: CARDINAL);
+  (* Writes the value of int to cid in text form, in a field of
+     the given minimum width. *)
+
+@findex ReadCard
+PROCEDURE ReadCard (cid: IOChan.ChanId; VAR card: CARDINAL);
+  (* Skips leading spaces, and removes any remaining characters
+     from cid that form part of an unsigned whole number.  The
+     value of this number is assigned to card. The read result
+     is set to the value allRight, outOfRange, wrongFormat,
+     endOfLine, or endOfInput.
+  *)
+
+@findex WriteCard
+PROCEDURE WriteCard (cid: IOChan.ChanId; card: CARDINAL;
+                     width: CARDINAL);
+  (* Writes the value of card to cid in text form, in a field
+     of the given minimum width. *)
+
+END WholeIO.
+@end example
+@page
+
+@node gm2-libs-iso/WholeStr, gm2-libs-iso/wrapsock, gm2-libs-iso/WholeIO, M2 ISO Libraries
+@subsection gm2-libs-iso/WholeStr
+
+@example
+DEFINITION MODULE WholeStr;
+
+  (* Whole-number/string conversions *)
+
+IMPORT
+  ConvTypes;
+
+TYPE
+@findex ConvResults (type)
+  ConvResults = ConvTypes.ConvResults;
+  (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
+
+(* the string form of a signed whole number is
+     ["+" | "-"], decimal digit, @{decimal digit@}
+*)
+
+@findex StrToInt
+PROCEDURE StrToInt (str: ARRAY OF CHAR; VAR int: INTEGER;
+                    VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent
+     characters in str are in the format of a signed whole
+     number, assigns a corresponding value to int. Assigns
+     a value indicating the format of str to res.
+  *)
+
+@findex IntToStr
+PROCEDURE IntToStr (int: INTEGER; VAR str: ARRAY OF CHAR);
+  (* Converts the value of int to string form and copies the
+     possibly truncated result to str. *)
+
+(* the string form of an unsigned whole number is
+     decimal digit, @{decimal digit@}
+*)
+
+@findex StrToCard
+PROCEDURE StrToCard (str: ARRAY OF CHAR;
+                     VAR card: CARDINAL;
+                     VAR res: ConvResults);
+  (* Ignores any leading spaces in str. If the subsequent
+     characters in str are in the format of an unsigned
+     whole number, assigns a corresponding value to card.
+     Assigns a value indicating the format of str to res.
+  *)
+
+@findex CardToStr
+PROCEDURE CardToStr (card: CARDINAL; VAR str: ARRAY OF CHAR);
+  (* Converts the value of card to string form and copies the
+     possibly truncated result to str. *)
+
+END WholeStr.
+@end example
+@page
+
+@node gm2-libs-iso/wrapsock, gm2-libs-iso/wraptime, gm2-libs-iso/WholeStr, M2 ISO Libraries
+@subsection gm2-libs-iso/wrapsock
+
+@example
+DEFINITION MODULE wrapsock ;
+
+(*
+    Description: provides a set of wrappers to some client side
+                 tcp socket primatives.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM ChanConsts IMPORT OpenResults ;
+
+
+TYPE
+@findex clientInfo (type)
+   clientInfo = ADDRESS ;
+
+
+(*
+   clientOpen - returns an ISO Modula-2 OpenResult.
+                It attempts to connect to:  hostname:portNo.
+                If successful then the data structure, c,
+                will have its fields initialized.
+*)
+
+@findex clientOpen
+PROCEDURE clientOpen (c: clientInfo;
+                      hostname: ADDRESS;
+                      length: CARDINAL;
+                      portNo: CARDINAL) : OpenResults ;
+
+
+(*
+   clientOpenIP - returns an ISO Modula-2 OpenResult.
+                  It attempts to connect to:  ipaddress:portNo.
+                  If successful then the data structure, c,
+                  will have its fields initialized.
+*)
+
+@findex clientOpenIP
+PROCEDURE clientOpenIP (c: clientInfo;
+                        ip: CARDINAL;
+                        portNo: CARDINAL) : OpenResults ;
+
+
+(*
+   getClientPortNo - returns the portNo from structure, c.
+*)
+
+@findex getClientPortNo
+PROCEDURE getClientPortNo (c: clientInfo) : CARDINAL ;
+
+
+(*
+   getClientHostname - fills in the hostname of the server
+                       the to which the client is connecting.
+*)
+
+@findex getClientHostname
+PROCEDURE getClientHostname (c: clientInfo;
+                             hostname: ADDRESS; high: CARDINAL) ;
+
+
+(*
+   getClientSocketFd - returns the sockFd from structure, c.
+*)
+
+@findex getClientSocketFd
+PROCEDURE getClientSocketFd (c: clientInfo) : INTEGER ;
+
+
+(*
+   getClientIP - returns the sockFd from structure, s.
+*)
+
+@findex getClientIP
+PROCEDURE getClientIP (c: clientInfo) : CARDINAL ;
+
+
+(*
+   getPushBackChar - returns TRUE if a pushed back character
+                     is available.
+*)
+
+@findex getPushBackChar
+PROCEDURE getPushBackChar (c: clientInfo; VAR ch: CHAR) : BOOLEAN ;
+
+
+(*
+   setPushBackChar - returns TRUE if it is able to push back a
+                     character.
+*)
+
+@findex setPushBackChar
+PROCEDURE setPushBackChar (c: clientInfo; ch: CHAR) : BOOLEAN ;
+
+
+(*
+   getSizeOfClientInfo - returns the sizeof (opaque data type).
+*)
+
+@findex getSizeOfClientInfo
+PROCEDURE getSizeOfClientInfo () : CARDINAL ;
+
+
+END wrapsock.
+@end example
+@page
+
+@node gm2-libs-iso/wraptime, , gm2-libs-iso/wrapsock, M2 ISO Libraries
+@subsection gm2-libs-iso/wraptime
+
+@example
+DEFINITION MODULE wraptime ;
+
+(*
+    Description: provides an interface to various time related
+                 entities on the underlying host operating system.
+                 It provides access to the glibc/libc functions:
+                 gettimeofday, settimeofday and localtime_r.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+@findex timeval (type)
+   timeval  = ADDRESS ;
+@findex timezone (type)
+   timezone = ADDRESS ;
+@findex tm (type)
+   tm       = ADDRESS ;
+
+
+(*
+   InitTimeval - returns a newly created opaque type.
+*)
+
+@findex InitTimeval
+PROCEDURE InitTimeval () : timeval ;
+
+
+(*
+   KillTimeval - deallocates the memory associated with an
+                 opaque type.
+*)
+
+@findex KillTimeval
+PROCEDURE KillTimeval (tv: timeval) : timeval ;
+
+
+(*
+   InitTimezone - returns a newly created opaque type.
+*)
+
+@findex InitTimezone
+PROCEDURE InitTimezone () : timezone ;
+
+
+(*
+   KillTimezone - deallocates the memory associated with an
+                  opaque type.
+*)
+
+@findex KillTimezone
+PROCEDURE KillTimezone (tv: timezone) : timezone ;
+
+
+(*
+   InitTM - returns a newly created opaque type.
+*)
+
+@findex InitTM
+PROCEDURE InitTM () : tm ;
+
+
+(*
+   KillTM - deallocates the memory associated with an
+            opaque type.
+*)
+
+@findex KillTM
+PROCEDURE KillTM (tv: tm) : tm ;
+
+
+(*
+   gettimeofday - calls gettimeofday(2) with the same parameters, tv,
+                  and, tz.  It returns 0 on success.
+*)
+
+@findex gettimeofday
+PROCEDURE gettimeofday (tv: timeval; tz: timezone) : INTEGER ;
+
+
+(*
+   settimeofday - calls settimeofday(2) with the same parameters, tv,
+                  and, tz.  It returns 0 on success.
+*)
+
+@findex settimeofday
+PROCEDURE settimeofday (tv: timeval; tz: timezone) : INTEGER ;
+
+
+(*
+   GetFractions - returns the tv_usec field inside the timeval structure
+                  as a CARDINAL.
+*)
+
+@findex GetFractions
+PROCEDURE GetFractions (tv: timeval) : CARDINAL ;
+
+
+(*
+   localtime_r - returns the tm parameter, m, after it has been assigned with
+                 appropriate contents determined by, tv.  Notice that
+                 this procedure function expects, timeval, as its first
+                 parameter and not a time_t (as expected by the posix
+                 equivalent).  This avoids having to expose a time_t
+                 system dependant definition.
+*)
+
+@findex localtime_r
+PROCEDURE localtime_r (tv: timeval; m: tm) : tm ;
+
+
+(*
+   GetYear - returns the year from the structure, m.
+*)
+
+@findex GetYear
+PROCEDURE GetYear (m: tm) : CARDINAL ;
+
+
+(*
+   GetMonth - returns the month from the structure, m.
+*)
+
+@findex GetMonth
+PROCEDURE GetMonth (m: tm) : CARDINAL ;
+
+
+(*
+   GetDay - returns the day of the month from the structure, m.
+*)
+
+@findex GetDay
+PROCEDURE GetDay (m: tm) : CARDINAL ;
+
+
+(*
+   GetHour - returns the hour of the day from the structure, m.
+*)
+
+@findex GetHour
+PROCEDURE GetHour (m: tm) : CARDINAL ;
+
+
+(*
+   GetMinute - returns the minute within the hour from the structure, m.
+*)
+
+@findex GetMinute
+PROCEDURE GetMinute (m: tm) : CARDINAL ;
+
+
+(*
+   GetSecond - returns the seconds in the minute from the structure, m.
+               The return value will always be in the range 0..59.
+               A leap minute of value 60 will be truncated to 59.
+*)
+
+@findex GetSecond
+PROCEDURE GetSecond (m: tm) : CARDINAL ;
+
+
+(*
+   GetSummerTime - returns a boolean indicating whether summer time is
+                   set.
+*)
+
+@findex GetSummerTime
+PROCEDURE GetSummerTime (tz: timezone) : BOOLEAN ;
+
+
+(*
+   GetDST - returns the number of minutes west of GMT.
+*)
+
+@findex GetDST
+PROCEDURE GetDST (tz: timezone) : INTEGER ;
+
+
+(*
+   SetTimeval - sets the fields in timeval, tv, with:
+                second, minute, hour, day, month, year, fractions.
+*)
+
+@findex SetTimeval
+PROCEDURE SetTimeval (tv: timeval;
+                      second, minute, hour, day,
+                      month, year, yday, wday, isdst: CARDINAL) ;
+
+
+(*
+   SetTimezone - set the timezone field inside timeval, tv.
+*)
+
+@findex SetTimezone
+PROCEDURE SetTimezone (tv: timeval;
+                       zone: CARDINAL; minuteswest: INTEGER) ;
+
+
+END wraptime.
+@end example
+@page
+
+
+@c ------------------------------------------------------------
diff --git a/gcc/m2/target-independent/readme.txt b/gcc/m2/target-independent/readme.txt
new file mode 100644
index 00000000000..ca1789fd723
--- /dev/null
+++ b/gcc/m2/target-independent/readme.txt
@@ -0,0 +1,3 @@
+This directory contains the target independent copies of the
+documentation which will be used if Python3 is unavailable during the
+build.
diff --git a/gcc/m2/tools-src/README b/gcc/m2/tools-src/README
new file mode 100644
index 00000000000..e2e0dce3824
--- /dev/null
+++ b/gcc/m2/tools-src/README
@@ -0,0 +1,3 @@
+This directory contains miscellaneous scripts and programs (mklink.c)
+to allow for bootstrap linking and creating library documentation from
+sources.
\ No newline at end of file
diff --git a/gcc/m2/tools-src/boilerplate.py b/gcc/m2/tools-src/boilerplate.py
new file mode 100644
index 00000000000..99596529b4e
--- /dev/null
+++ b/gcc/m2/tools-src/boilerplate.py
@@ -0,0 +1,548 @@
+#!/usr/bin/env python3
+#
+# boilerplate.py utility to rewrite the boilerplate with new dates.
+#
+# Copyright (C) 2018-2022 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/>.
+#
+
+import argparse
+import datetime
+import os
+import sys
+
+
+error_count = 0
+seen_files = []
+output_name = None
+
+ISO_COPYRIGHT = 'Copyright ISO/IEC'
+COPYRIGHT = 'Copyright (C)'
+GNU_PUBLIC_LICENSE = 'GNU General Public License'
+GNU_LESSER_GENERAL = 'GNU Lesser General'
+GCC_RUNTIME_LIB_EXC = 'GCC Runtime Library Exception'
+VERSION_2_1 = 'version 2.1'
+VERSION_2 = 'version 2'
+VERSION_3 = 'version 3'
+Licenses = {VERSION_2_1: 'v2.1', VERSION_2: 'v2', VERSION_3: 'v3'}
+CONTRIBUTED_BY = 'ontributed by'
+
+
+def printf(fmt, *args):
+    # printf - keeps C programmers happy :-)
+    print(str(fmt) % args, end=' ')
+
+
+def error(fmt, *args):
+    # error - issue an error message.
+    global error_count
+
+    print(str(fmt) % args, end=' ')
+    error_count += 1
+
+
+def halt_on_error():
+    if error_count > 0:
+        os.sys.exit(1)
+
+
+def basename(f):
+    b = f.split('/')
+    return b[-1]
+
+
+def analyse_comment(text, f):
+    # analyse_comment determine the license from the top comment.
+    start_date, end_date = None, None
+    contribution, summary, lic = None, None, None
+    if text.find(ISO_COPYRIGHT) > 0:
+        lic = 'BSISO'
+        now = datetime.datetime.now()
+        for d in range(1984, now.year+1):
+            if text.find(str(d)) > 0:
+                if start_date is None:
+                    start_date = str(d)
+                end_date = str(d)
+        return start_date, end_date, '', '', lic
+    elif text.find(COPYRIGHT) > 0:
+        if text.find(GNU_PUBLIC_LICENSE) > 0:
+            lic = 'GPL'
+        elif text.find(GNU_LESSER_GENERAL) > 0:
+            lic = 'LGPL'
+        for license_ in Licenses.keys():
+            if text.find(license_) > 0:
+                lic += Licenses[license_]
+        if text.find(GCC_RUNTIME_LIB_EXC) > 0:
+            lic += 'x'
+        now = datetime.datetime.now()
+        for d in range(1984, now.year+1):
+            if text.find(str(d)) > 0:
+                if start_date is None:
+                    start_date = str(d)
+                end_date = str(d)
+        if text.find(CONTRIBUTED_BY) > 0:
+            i = text.find(CONTRIBUTED_BY)
+            i += len(CONTRIBUTED_BY)
+            j = text.index('. ', i)
+            contribution = text[i:j]
+    if text.find(basename(f)) > 0:
+        i = text.find(basename(f))
+        j = text.find('. ', i)
+        if j < 0:
+            error("summary of the file does not finish with a '.'")
+            summary = text[i:]
+        else:
+            summary = text[i:j]
+    return start_date, end_date, contribution, summary, lic
+
+
+def analyse_header_without_terminator(f, start):
+    text = ''
+    for count, l in enumerate(open(f).readlines()):
+        parts = l.split(start)
+        if len(parts) > 1:
+            line = start.join(parts[1:])
+            line = line.strip()
+            text += ' '
+            text += line
+        elif (l.rstrip() != '') and (len(parts[0]) > 0):
+            return analyse_comment(text, f), count
+    return [None, None, None, None, None], 0
+
+
+def analyse_header_with_terminator(f, start, end):
+    inComment = False
+    text = ''
+    for count, line in enumerate(open(f).readlines()):
+        while line != '':
+            line = line.strip()
+            if inComment:
+                text += ' '
+                pos = line.find(end)
+                if pos >= 0:
+                    text += line[:pos]
+                    line = line[pos:]
+                    inComment = False
+                else:
+                    text += line
+                    line = ''
+            else:
+                pos = line.find(start)
+                if (pos >= 0) and (len(line) > len(start)):
+                    before = line[:pos].strip()
+                    if before != '':
+                        return analyse_comment(text, f), count
+                    line = line[pos + len(start):]
+                    inComment = True
+                elif (line != '') and (line == end):
+                    line = ''
+                else:
+                    return analyse_comment(text, f), count
+    return [None, None, None, None, None], 0
+
+
+def analyse_header(f, start, end):
+    # analyse_header -
+    if end is None:
+        return analyse_header_without_terminator(f, start)
+    else:
+        return analyse_header_with_terminator(f, start, end)
+
+
+def add_stop(sentence):
+    # add_stop - add a full stop to a sentance.
+    if sentence is None:
+        return None
+    sentence = sentence.rstrip()
+    if (len(sentence) > 0) and (sentence[-1] != '.'):
+        return sentence + '.'
+    return sentence
+
+
+GPLv3 = """
+%s
+
+Copyright (C) %s Free Software Foundation, Inc.
+Contributed by %s
+
+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/>.
+"""
+
+GPLv3x = """
+%s
+
+Copyright (C) %s Free Software Foundation, Inc.
+Contributed by %s
+
+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/>.
+"""
+
+LGPLv3 = """
+%s
+
+Copyright (C) %s Free Software Foundation, Inc.
+Contributed by %s
+
+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 Lesser General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, 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
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public License
+along with GNU Modula-2.  If not, see <https://www.gnu.org/licenses/>.
+"""
+
+BSISO = """
+Library module defined by the International Standard
+   Information technology - programming languages
+   BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
+
+   Copyright ISO/IEC (International Organization for Standardization
+   and International Electrotechnical Commission) %s.
+
+   It may be freely copied for the purpose of implementation (see page
+   707 of the Information technology - Programming languages Part 1:
+   Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).
+"""
+
+templates = {}
+templates['GPLv3'] = GPLv3
+templates['GPLv3x'] = GPLv3x
+templates['LGPLv3'] = LGPLv3
+templates['LGPLv2.1'] = LGPLv3
+templates['BSISO'] = BSISO
+
+
+def write_template(fo, magic, start, end, dates, contribution, summary, lic):
+    if lic in templates:
+        if lic == 'BSISO':
+            # non gpl but freely distributed for the implementation of a
+            # compiler
+            text = templates[lic] % (dates)
+            text = text.rstrip()
+        else:
+            summary = summary.lstrip()
+            contribution = contribution.lstrip()
+            summary = add_stop(summary)
+            contribution = add_stop(contribution)
+            if magic is not None:
+                fo.write(magic)
+                fo.write('\n')
+            text = templates[lic] % (summary, dates, contribution)
+            text = text.rstrip()
+        if end is None:
+            text = text.split('\n')
+            for line in text:
+                fo.write(start)
+                fo.write(' ')
+                fo.write(line)
+                fo.write('\n')
+        else:
+            text = text.lstrip()
+            fo.write(start)
+            fo.write(' ')
+            fo.write(text)
+            fo.write('  ')
+            fo.write(end)
+            fo.write('\n')
+        # add a blank comment line for a script for eye candy.
+        if start == '#' and end is None:
+            fo.write(start)
+            fo.write('\n')
+    else:
+        error('no template found for: %s\n', lic)
+        os.sys.exit(1)
+    return fo
+
+
+def write_boiler_plate(fo, magic, start, end,
+                       start_date, end_date, contribution, summary, gpl):
+    if start_date == end_date:
+        dates = start_date
+    else:
+        dates = '%s-%s' % (start_date, end_date)
+    return write_template(fo, magic, start, end,
+                          dates, contribution, summary, gpl)
+
+
+def rewrite_file(f, magic, start, end, start_date, end_date,
+                 contribution, summary, gpl, lines):
+    text = ''.join(open(f).readlines()[lines:])
+    if output_name == '-':
+        fo = sys.stdout
+    else:
+        fo = open(f, 'w')
+    fo = write_boiler_plate(fo, magic, start, end,
+                            start_date, end_date, contribution, summary, gpl)
+    fo.write(text)
+    fo.flush()
+    if output_name != '-':
+        fo.close()
+
+
+def handle_header(f, magic, start, end):
+    # handle_header keep reading lines of file, f, looking for start, end
+    # sequences and comments inside.  The comments are checked for:
+    # date, contribution, summary
+    global error_count
+
+    error_count = 0
+    [start_date, end_date,
+     contribution, summary, lic], lines = analyse_header(f, start, end)
+    if lic is None:
+        error('%s:1:no GPL found at the top of the file\n', f)
+    else:
+        if args.verbose:
+            printf('copyright: %s\n', lic)
+            if (start_date is not None) and (end_date is not None):
+                if start_date == end_date:
+                    printf('dates = %s\n', start_date)
+                else:
+                    printf('dates = %s-%s\n', start_date, end_date)
+            if summary is not None:
+                printf('summary: %s\n', summary)
+            if contribution is not None:
+                printf('contribution: %s\n', contribution)
+        if start_date is None:
+            error('%s:1:no date found in the GPL at the top of the file\n', f)
+        if args.contribution is None:
+            if contribution == '':
+                error('%s:1:no contribution found in the ' +
+                      'GPL at the top of the file\n', f)
+            else:
+                contribution = args.contribution
+        if summary is None:
+            if args.summary == '':
+                error('%s:1:no single line summary found in the ' +
+                      'GPL at the top of the file\n', f)
+            else:
+                summary = args.summary
+    if error_count == 0:
+        now = datetime.datetime.now()
+        if args.no:
+            print(f, 'suppressing change as requested: %s-%s %s'
+                  % (start_date, end_date, lic))
+        else:
+            if lic == 'BSISO':
+                # don't change the BS ISO license!
+                pass
+            elif args.extensions:
+                lic = 'GPLv3x'
+            elif args.gpl3:
+                lic = 'GPLv3'
+            rewrite_file(f, magic, start, end, start_date,
+                         str(now.year), contribution, summary, lic, lines)
+    else:
+        printf('too many errors, no modifications will occur\n')
+
+
+def bash_tidy(f):
+    # bash_tidy tidy up dates using '#' comment
+    handle_header(f, '#!/bin/bash', '#', None)
+
+
+def python_tidy(f):
+    # python_tidy tidy up dates using '#' comment
+    handle_header(f, '#!/usr/bin/env python3', '#', None)
+
+
+def bnf_tidy(f):
+    # bnf_tidy tidy up dates using '--' comment
+    handle_header(f, None, '--', None)
+
+
+def c_tidy(f):
+    # c_tidy tidy up dates using '/* */' comments
+    handle_header(f, None, '/*', '*/')
+
+
+def m2_tidy(f):
+    # m2_tidy tidy up dates using '(* *)' comments
+    handle_header(f, None, '(*', '*)')
+
+
+def in_tidy(f):
+    # in_tidy tidy up dates using '#' as a comment and check
+    # the first line for magic number.
+    first = open(f).readlines()[0]
+    if (len(first) > 0) and (first[:2] == '#!'):
+        # magic number found, use this
+        handle_header(f, first, '#', None)
+    else:
+        handle_header(f, None, '#', None)
+
+
+def do_visit(args, dirname, names):
+    # do_visit helper function to call func on every extension file.
+    global output_name
+    func, extension = args
+    for f in names:
+        if len(f) > len(extension) and f[-len(extension):] == extension:
+            output_name = f
+            func(os.path.join(dirname, f))
+
+
+def visit_dir(startDir, ext, func):
+    # visit_dir call func for each file in startDir which has ext.
+    global output_name, seen_files
+    for dirName, subdirList, fileList in os.walk(startDir):
+        for fname in fileList:
+            if (len(fname) > len(ext)) and (fname[-len(ext):] == ext):
+                fullpath = os.path.join(dirName, fname)
+                output_name = fullpath
+                if not (fullpath in seen_files):
+                    seen_files += [fullpath]
+                    func(fullpath)
+            # Remove the first entry in the list of sub-directories
+            # if there are any sub-directories present
+        if len(subdirList) > 0:
+            del subdirList[0]
+
+
+def find_files():
+    # find_files for each file extension call the appropriate tidy routine.
+    visit_dir(args.recursive, '.h.in', c_tidy)
+    visit_dir(args.recursive, '.in', in_tidy)
+    visit_dir(args.recursive, '.sh', in_tidy)
+    visit_dir(args.recursive, '.py', python_tidy)
+    visit_dir(args.recursive, '.c', c_tidy)
+    visit_dir(args.recursive, '.h', c_tidy)
+    visit_dir(args.recursive, '.cc', c_tidy)
+    visit_dir(args.recursive, '.def', m2_tidy)
+    visit_dir(args.recursive, '.mod', m2_tidy)
+    visit_dir(args.recursive, '.bnf', bnf_tidy)
+
+
+def handle_arguments():
+    # handle_arguments create and return the args object.
+    parser = argparse.ArgumentParser()
+    parser.add_argument('-c', '--contribution',
+                        help='set the contribution string ' +
+                        'at the top of the file.',
+                        default='', action='store')
+    parser.add_argument('-d', '--debug', help='turn on internal debugging.',
+                        default=False, action='store_true')
+    parser.add_argument('-f', '--force',
+                        help='force a check to insist that the ' +
+                        'contribution, summary and GPL exist.',
+                        default=False, action='store_true')
+    parser.add_argument('-g', '--gplv3', help='change to GPLv3',
+                        default=False, action='store_true')
+    parser.add_argument('-o', '--outputfile', help='set the output file',
+                        default='-', action='store')
+    parser.add_argument('-r', '--recursive',
+                        help='recusively scan directory for known file ' +
+                        'extensions (.def, .mod, .c, .h, .py, .in, .sh).',
+                        default='.', action='store')
+    parser.add_argument('-s', '--summary',
+                        help='set the summary line for the file.',
+                        default=None, action='store')
+    parser.add_argument('-u', '--update', help='update all dates.',
+                        default=False, action='store_true')
+    parser.add_argument('-v', '--verbose',
+                        help='display copyright, ' +
+                        'date and contribution messages',
+                        action='store_true')
+    parser.add_argument('-x', '--extensions',
+                        help='change to GPLv3 with GCC runtime extensions.',
+                        default=False, action='store_true')
+    parser.add_argument('-N', '--no',
+                        help='do not modify any file.',
+                        action='store_true')
+    args = parser.parse_args()
+    return args
+
+
+def has_ext(name, ext):
+    # has_ext return True if, name, ends with, ext.
+    if len(name) > len(ext):
+        return name[-len(ext):] == ext
+    return False
+
+
+def single_file(name):
+    # single_file scan the single file for a GPL boilerplate which
+    # has a GPL, contribution field and a summary heading.
+    if has_ext(name, '.def') or has_ext(name, '.mod'):
+        m2_tidy(name)
+    elif has_ext(name, '.h') or has_ext(name, '.c') or has_ext(name, '.cc'):
+        c_tidy(name)
+    elif has_ext(name, '.in'):
+        in_tidy(name)
+    elif has_ext(name, '.sh'):
+        in_tidy(name)  # uses magic number for actual sh/bash
+    elif has_ext(name, '.py'):
+        python_tidy(name)
+
+
+def main():
+    # main - handle_arguments and then find source files.
+    global args, output_name
+    args = handle_arguments()
+    output_name = args.outputfile
+    if args.recursive:
+        find_files()
+    elif args.inputfile is None:
+        print('an input file must be specified on the command line')
+    else:
+        single_file(args.inputfile)
+    halt_on_error()
+
+
+main()
diff --git a/gcc/m2/tools-src/buildpg b/gcc/m2/tools-src/buildpg
new file mode 100644
index 00000000000..dce5d4c6bd3
--- /dev/null
+++ b/gcc/m2/tools-src/buildpg
@@ -0,0 +1,289 @@
+#!/bin/sh
+
+# Copyright (C) 2000-2022 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 GNU Modula-2; see the file COPYING.  If not, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+#
+
+# builds the pg.bnf from ppg.mod
+# usage buildpg ppg.mod destination [-e]
+#    -e   build without error recovery
+#
+PPGSRC=$1
+PPGDST=$2
+
+includeNonErrorChecking () {
+   sed -e "1,/StartNonErrorChecking/d" < $PPGSRC |\
+   sed -e "1,/EndNonErrorChecking/!d"
+}
+
+includeErrorChecking () {
+   sed -e "1,/StartErrorChecking/d" < $PPGSRC |\
+   sed -e "1,/EndErrorChecking/!d"
+}
+
+
+echo "% module" $PPGDST "begin"
+sed -e "1,/% declaration/!d" < $PPGSRC | sed -e "s/ppg/${PPGDST}/g"
+
+echo "% declaration" $PPGDST "begin"
+
+sed -e "1,/% declaration/d" < $PPGSRC | sed -e "1,/% rules/!d" | sed -e "s/ppg/${PPGDST}/g"
+
+if [ "$3" = "-e" ] ; then
+   includeNonErrorChecking
+   echo "% module" $PPGDST "end"
+   sed -e "1,/% module pg end/d" < $PPGSRC | sed -e "s/ppg/${PPGDST}/g"
+else
+   includeErrorChecking
+   echo "% module" $PPGDST "end"
+   sed -e "1,/% module pg end/d" < $PPGSRC | sed -e "s/ppg/${PPGDST}/g" |\
+   sed -e "s/WasNoError := Main() ;/Main({eoftok}) ;/"
+fi
+
+echo "% rules"
+
+cat << EOFEOF  | sed -e "s/ppg/${PPGDST}/g"
+error       'WarnError' 'WarnString'
+tokenfunc   'GetCurrentTokenType()'
+
+token   'identifier'  identtok      -- internal token
+token   'literal'     literaltok
+token   '%'           codetok
+token   ':='          lbecomestok
+token   '=:'          rbecomestok
+token   '|'           bartok
+token   '['           lsparatok
+token   ']'           rsparatok
+token   '{'           lcparatok   -- left  curly para
+token   '}'           rcparatok   -- right curly para
+token   '('           lparatok
+token   ')'           rparatok
+token   "error"       errortok
+token   "tokenfunc"   tfunctok
+token   "symfunc"     symfunctok
+token   '"'           dquotetok
+token   "'"           squotetok
+token   "module"      moduletok
+token   "begin"       begintok
+token   "rules"       rulestok
+token   "end"         endtok
+token   '<'           lesstok
+token   '>'           gretok
+token   "token"       tokentok
+token   "special"     specialtok
+token   "first"       firsttok
+token   "follow"      followtok
+token   "BNF"         BNFtok
+token   "FNB"         FNBtok
+token   "declaration" declarationtok
+token   "epsilon"     epsilontok
+token   ''            eoftok      -- internal token
+
+special Ident          first { < identtok > }   follow { }
+special Modula2Code    first { }                follow { '%' }
+special StartModName   first { < identtok > }   follow { }
+special EndModName     first { < identtok > }   follow { }
+special DoDeclaration  first { < identtok > }   follow { }
+special CollectLiteral first { < literaltok > } follow { }
+special CollectTok     first { < identtok > }   follow { }
+special DefineToken    first { < identtok > }   follow { }
+
+BNF
+
+Rules      := "%" "rules" { Defs } ExtBNF =:
+
+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 % ]
+              =:
+
+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 ")" =:
+
+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 ; %
+              "=:" =:
+
+Defs       := "special" Special | "token" Token | "error" ErrorProcedures |
+              "tokenfunc" TokenProcedure | "symfunc" SymProcedure =:
+ExtBNF     := "BNF" { Production } "FNB" =:
+Main       := Header Decls Footer Rules =:
+Header     := "%" "module" StartModName =:
+Decls      := "%" "declaration" DoDeclaration =:
+Footer     := "%" "module" EndModName =:
+
+First      := "first"  "{" { LitOrTokenOrIdent
+                             % WITH CurrentSetDesc^ DO
+                                  next := TailProduction^.first ;
+                               END ;
+                               TailProduction^.first := CurrentSetDesc
+                             %
+                           } "}" =:
+Follow     := "follow" "{" { LitOrTokenOrIdent
+                             % WITH CurrentSetDesc^ DO
+                                  next := TailProduction^.followinfo^.follow ;
+                               END ;
+                               TailProduction^.followinfo^.follow := CurrentSetDesc
+                             %
+                           } "}" =:
+LitOrTokenOrIdent := Literal % CurrentSetDesc := NewSetDesc() ;
+                               WITH CurrentSetDesc^ DO
+                                  type   := litel ;
+                                  string := LastLiteral ;
+                               END ;
+                              % |
+                     '<' CollectTok '>' |
+                     Ident % CurrentSetDesc := NewSetDesc() ;
+                             WITH CurrentSetDesc^ DO
+                                type   := idel ;
+                                ident  := CurrentIdent ;
+                             END ;
+                           % =:
+
+Literal    := '"' CollectLiteral '"' |
+              "'" CollectLiteral "'" =:
+
+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() ; % =:
+
+CollectLiteral := % LastLiteral := GetCurrentToken() ;
+                    AdvanceToken ; % =:
+
+DefineToken := %  AddEntry(Aliases, LastLiteral, GetCurrentToken()) ;
+                  AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ;
+                  AddEntry(Values, GetCurrentToken(), LargestValue) ;
+                  AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ;
+                  INC(LargestValue) ;
+                  AdvanceToken ; % =:
+
+Token      := Literal DefineToken =:
+
+ErrorProcedures  := Literal % ErrorProcArray := LastLiteral %
+                    Literal % ErrorProcString := LastLiteral % =:
+TokenProcedure := Literal % TokenTypeProc := LastLiteral % =:
+SymProcedure   := Literal % SymIsProc := LastLiteral % =:
+
+Production := Statement =:
+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 % } =:
+
+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 ; % }
+           =:
+
+FNB
+
+EOFEOF
diff --git a/gcc/m2/tools-src/calcpath b/gcc/m2/tools-src/calcpath
new file mode 100755
index 00000000000..e0817704f64
--- /dev/null
+++ b/gcc/m2/tools-src/calcpath
@@ -0,0 +1,51 @@
+#!/bin/sh
+
+# calcpath return a path which is $1/$2/$3 when $2 is relative and $2/$3 if absolute.
+
+# Copyright (C) 2021-2022 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 gm2; see the file COPYING.  If not, write to the Free Software
+# Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+
+Usage () {
+   echo "Usage: calcpath pathcomponent1 pathcomponent2 subdir"
+   echo -n "  if pathcomponent1 is relative then pathcomponent1/pathcomponet2/subdir is"
+   echo " returned"
+   echo "  otherwise pathcomponet2/subdir is returned"
+   echo "  the path is checked for legality in subdir."
+}
+
+
+if [ $# -eq 3 ]; then
+   if [ "$(echo $2 | cut -b 1)" = "." ] ; then
+       # relative path
+       the_path=$1/$2/$3
+   else
+       the_path=$2/$3
+   fi
+   cd $3
+   if realpath ${the_path} > /dev/null ; then
+       echo ${the_path}
+   else
+       echo "calcpath: error ${the_path} is not a valid path in subdirectory $3" 1>&2
+       exit 1
+   fi
+else
+   Usage
+   exit 1
+fi
diff --git a/gcc/m2/tools-src/def2doc.py b/gcc/m2/tools-src/def2doc.py
new file mode 100644
index 00000000000..d1637eef387
--- /dev/null
+++ b/gcc/m2/tools-src/def2doc.py
@@ -0,0 +1,539 @@
+#!/usr/bin/env python3
+
+# def2doc.py creates texi library documentation for all exported procedures.
+# Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+# Copyright (C) 2000-2022 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 GNU Modula-2; see the file COPYING.  If not, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+#
+
+import argparse
+import os
+import sys
+
+Base_Libs = ['gm2-libs', 'Base libraries', 'Basic M2F compatible libraries']
+
+PIM_Log_Desc = 'PIM and Logitech 3.0 compatible libraries'
+PIM_Log = ['gm2-libs-pim', 'PIM and Logitech 3.0 Compatible', PIM_Log_Desc]
+PIM_Cor_Desc = 'PIM compatible process support'
+PIM_Cor = ['gm2-libs-coroutines', 'PIM coroutine support', PIM_Cor_Desc]
+ISO_Libs = ['gm2-libs-iso', 'M2 ISO Libraries', 'ISO defined libraries']
+
+library_classifications = [Base_Libs, PIM_Log, PIM_Cor, ISO_Libs]
+
+# state_states
+state_none, state_var, state_type, state_const = range(4)
+# block states
+block_none, block_code, block_text, block_index = range(4)
+
+
+class state:
+    def __init__(self):
+        self._state_state = state_none
+        self._block = block_none
+
+    def get_state(self):
+        return self._state_state
+
+    def set_state(self, value):
+        self._state_state = value
+
+    def is_const(self):
+        return self._state_state == state_const
+
+    def is_type(self):
+        return self._state_state == state_type
+
+    def is_var(self):
+        return self._state_state == state_var
+
+    def get_block(self):
+        return self._block
+
+    def _change_block(self, new_block):
+        if self._block != new_block:
+            self._block = new_block
+            self._emit_block_desc()
+
+    def _emit_block_desc(self):
+        if self._block == block_code:
+            output.write('.. code-block:: modula2\n')
+        elif self._block == block_index:
+            output.write('.. index::\n')
+
+    def to_code(self):
+        self._change_block(block_code)
+
+    def to_index(self):
+        self._change_block(block_index)
+
+
+def init_state():
+    global state_obj
+    state_obj = state()
+
+
+def emit_node(name, nxt, previous, up):
+    if args.texinfo:
+        output.write('@node ' + name + ', ' + nxt + ', ')
+        output.write(previous + ', ' + up + '\n')
+    elif args.sphinx:
+        output.write('@c @node ' + name + ', ' + nxt + ', ')
+        output.write(previous + ', ' + up + '\n')
+
+
+def emit_section(name):
+    if args.texinfo:
+        output.write('@section ' + name + '\n')
+    elif args.sphinx:
+        output.write(name + '\n')
+        output.write('=' * len(name) + '\n')
+
+
+def emit_sub_section(name):
+    if args.texinfo:
+        output.write('@subsection ' + name + '\n')
+    elif args.sphinx:
+        output.write(name + '\n')
+        output.write('-' * len(name) + '\n')
+
+
+def display_library_class():
+    # display_library_class displays a node for a library directory and invokes
+    # a routine to summarize each module.
+    global args
+    previous = ''
+    nxt = library_classifications[1][1]
+    i = 0
+    lib = library_classifications[i]
+    while True:
+        emit_node(lib[1], nxt, previous, args.up)
+        emit_section(lib[1])
+        output.write('\n')
+        display_modules(lib[1], lib[0], args.builddir, args.sourcedir)
+        output.write('\n')
+        output.write('@c ' + '-' * 60 + '\n')
+        previous = lib[1]
+        i += 1
+        if i == len(library_classifications):
+            break
+        lib = library_classifications[i]
+        if i+1 == len(library_classifications):
+            nxt = ''
+        else:
+            nxt = library_classifications[i+1][1]
+
+
+def display_menu():
+    # display_menu displays the top level menu for library documentation.
+    output.write('@menu\n')
+    for lib in library_classifications:
+        output.write('* ' + lib[1] + '::' + lib[2] + '\n')
+    output.write('@end menu\n')
+    output.write('\n')
+    output.write('@c ' + '=' * 60 + '\n')
+    output.write('\n')
+
+
+def remote_initial_comments(file, line):
+    # remote_initial_comments removes any (* *) at the top
+    # of the definition module.
+    while (line.find('*)') == -1):
+        line = file.readline()
+
+
+def removeable_field(line):
+    # removeable_field - returns True if a comment field should be removed
+    # from the definition module.
+    field_list = ['Author', 'Last edit', 'LastEdit', 'Last update',
+                  'Date', 'Title', 'Revision']
+    for field in field_list:
+        if (line.find(field) != -1) and (line.find(':') != -1):
+            return True
+    ignore_list = ['System', 'SYSTEM']
+    for ignore_field in ignore_list:
+        if line.find(ignore_field) != -1:
+            if line.find(':') != -1:
+                if line.find('Description:') == -1:
+                    return True
+    return False
+
+
+def remove_fields(file, line):
+    # remove_fields removes Author/Date/Last edit/SYSTEM/Revision
+    # fields from a comment within the start of a definition module.
+    while (line.find('*)') == -1):
+        if not removeable_field(line):
+            line = line.rstrip().replace('{', '@{').replace('}', '@}')
+            output.write(line + '\n')
+        line = file.readline()
+    output.write(line.rstrip() + '\n')
+
+
+def emit_index(entry, tag):
+    global state_obj
+    if args.texinfo:
+        if tag == '':
+            output.write('@findex ' + entry.rstrip() + '\n')
+        else:
+            output.write('@findex ' + entry.rstrip() + ' ' + tag + '\n')
+    elif args.sphinx:
+        if tag == '':
+            state_obj.to_index()
+            output.write(' ' * 3 + entry.rstrip() + '\n')
+        else:
+            state_obj.to_index()
+            output.write(' ' * 3 + 'pair: ' + entry.rstrip() + '; ' + tag + '\n')
+
+
+def check_index(line):
+    # check_index - create an index entry for a PROCEDURE, TYPE, CONST or VAR.
+    global state_obj
+
+    words = line.split()
+    procedure = ''
+    if (len(words) > 1) and (words[0] == 'PROCEDURE'):
+        state_obj.set_state(state_none)
+        if (words[1] == '__BUILTIN__') and (len(words) > 2):
+            procedure = words[2]
+        else:
+            procedure = words[1]
+    if (len(line) > 1) and (line[0:2] == '(*'):
+        state_obj.set_state(state_none)
+    elif line == 'VAR':
+        state_obj.set_state(state_var)
+        return
+    elif line == 'TYPE':
+        state_obj.set_state(state_type)
+        return
+    elif line == 'CONST':
+        state_obj.set_state(state_const)
+    if state_obj.is_var():
+        words = line.split(',')
+        for word in words:
+            word = word.lstrip()
+            if word != '':
+                if word.find(':') == -1:
+                    emit_index(word, '(var)')
+                elif len(word) > 0:
+                    var = word.split(':')
+                    if len(var) > 0:
+                        emit_index(var[0], '(var)')
+    if state_obj.is_type():
+        words = line.lstrip()
+        if words.find('=') != -1:
+            word = words.split('=')
+            if (len(word[0]) > 0) and (word[0][0] != '_'):
+                emit_index(word[0].rstrip(), '(type)')
+        else:
+            word = words.split()
+            if (len(word) > 1) and (word[1] == ';'):
+                # hidden type
+                if (len(word[0]) > 0) and (word[0][0] != '_'):
+                    emit_index(word[0].rstrip(), '(type)')
+    if state_obj.is_const():
+        words = line.split(';')
+        for word in words:
+            word = word.lstrip()
+            if word != '':
+                if word.find('=') != -1:
+                    var = word.split('=')
+                    if len(var) > 0:
+                        emit_index(var[0], '(const)')
+    if procedure != '':
+        name = procedure.split('(')
+        if name[0] != '':
+            proc = name[0]
+            if proc[-1] == ';':
+                proc = proc[:-1]
+            if proc != '':
+                emit_index(proc, '')
+
+def demangle_system_datatype(line, indent):
+    # The spaces in front align in the export qualified list.
+    indent += len ('EXPORT QUALIFIED ')
+    line = line.replace('@SYSTEM_DATATYPES@',
+                        '\n' + indent * ' ' + 'Target specific data types.')
+    line = line.replace('@SYSTEM_TYPES@',
+                        '(* Target specific data types.  *)')
+    return line
+
+
+def emit_texinfo_content(f, line):
+    global state_obj
+    output.write(line.rstrip() + '\n')
+    line = f.readline()
+    if len(line.rstrip()) == 0:
+        output.write('\n')
+        line = f.readline()
+        if (line.find('(*') != -1):
+            remove_fields(f, line)
+        else:
+            output.write(line.rstrip() + '\n')
+    else:
+        output.write(line.rstrip() + '\n')
+    line = f.readline()
+    while line:
+        line = line.rstrip()
+        check_index(line)
+        line = line.replace('{', '@{').replace('}', '@}')
+        line = demangle_system_datatype(line, 0)
+        output.write(line + '\n')
+        line = f.readline()
+    return f
+
+
+def emit_sphinx_content(f, line):
+    global state_obj
+    state_obj.to_code()
+    indentation = 4
+    indent = ' ' * indentation
+    output.write(indent + line.rstrip() + '\n')
+    line = f.readline()
+    if len(line.rstrip()) == 0:
+        output.write('\n')
+        line = f.readline()
+        if (line.find('(*') != -1):
+            remove_fields(f, line)
+        else:
+            output.write(indent + line.rstrip() + '\n')
+    else:
+        output.write(indent + line.rstrip() + '\n')
+    line = f.readline()
+    while line:
+        line = line.rstrip()
+        check_index(line)
+        state_obj.to_code()
+        line = demangle_system_datatype(line, indentation)
+        output.write(indent + line + '\n')
+        line = f.readline()
+    return f
+
+
+def emit_example_content(f, line):
+    if args.texinfo:
+        return emit_texinfo_content(f, line)
+    elif args.sphinx:
+        return emit_sphinx_content(f, line)
+
+
+def emit_example_begin():
+    if args.texinfo:
+        output.write('@example\n')
+
+
+def emit_example_end():
+    if args.texinfo:
+        output.write('@end example\n')
+
+
+def emit_page(need_page):
+    if need_page and args.texinfo:
+        output.write('@page\n')
+
+
+def parse_definition(dir_, source, build, file, need_page):
+    # parse_definition reads a definition module and creates
+    # indices for procedures, constants, variables and types.
+    output.write('\n')
+    with open(find_file(dir_, build, source, file), 'r') as f:
+        init_state()
+        line = f.readline()
+        while (line.find('(*') != -1):
+            remote_initial_comments(f, line)
+            line = f.readline()
+        while (line.find('DEFINITION') == -1):
+            line = f.readline()
+        emit_example_begin()
+        f = emit_example_content(f, line)
+        emit_example_end()
+        emit_page(need_page)
+
+
+def parse_modules(up, dir_, build, source, list_of_modules):
+    previous = ''
+    i = 0
+    if len(list_of_modules) > 1:
+        nxt = dir_ + '/' + list_of_modules[1][:-4]
+    else:
+        nxt = ''
+    while i < len(list_of_modules):
+        emit_node(dir_ + '/' + list_of_modules[i][:-4], nxt, previous, up)
+        emit_sub_section(dir_ + '/' + list_of_modules[i][:-4])
+        parse_definition(dir_, source, build, list_of_modules[i], True)
+        output.write('\n')
+        previous = dir_ + '/' + list_of_modules[i][:-4]
+        i = i + 1
+        if i+1 < len(list_of_modules):
+            nxt = dir_ + '/' + list_of_modules[i+1][:-4]
+        else:
+            nxt = ''
+
+
+def do_cat(name):
+    # do_cat displays the contents of file, name, to stdout
+    with open(name, 'r') as file:
+        line = file.readline()
+        while line:
+            output.write(line.rstrip() + '\n')
+            line = file.readline()
+
+
+def module_menu(dir_, build, source):
+    # module_menu generates a simple menu for all definition modules
+    # in dir
+    output.write('@menu\n')
+    list_of_files = []
+    if os.path.exists(os.path.join(source, dir_)):
+        list_of_files += os.listdir(os.path.join(source, dir_))
+    if os.path.exists(os.path.join(source, dir_)):
+        list_of_files += os.listdir(os.path.join(build, dir_))
+    list_of_files = list(dict.fromkeys(list_of_files).keys())
+    list_of_files.sort()
+    for file in list_of_files:
+        if found_file(dir_, build, source, file):
+            if (len(file) > 4) and (file[-4:] == '.def'):
+                output.write('* ' + dir_ + '/' + file[:-4] + '::' + file + '\n')
+    output.write('@end menu\n')
+    output.write('\n')
+
+
+def check_directory(dir_, build, source):
+    # check_directory - returns True if dir exists in either build or source.
+    if os.path.isdir(build) and os.path.exists(os.path.join(build, dir_)):
+        return True
+    elif os.path.isdir(source) and os.path.exists(os.path.join(source, dir_)):
+        return True
+    else:
+        return False
+
+
+def found_file(dir_, build, source, file):
+    # found_file return True if file is found in build/dir/file or
+    # source/dir/file.
+    name = os.path.join(os.path.join(build, dir_), file)
+    if os.path.exists(name):
+        return True
+    name = os.path.join(os.path.join(source, dir_), file)
+    if os.path.exists(name):
+        return True
+    return False
+
+
+def find_file(dir_, build, source, file):
+    # find_file return the path to file searching in build/dir/file
+    # first then source/dir/file.
+    name1 = os.path.join(os.path.join(build, dir_), file)
+    if os.path.exists(name1):
+        return name1
+    name2 = os.path.join(os.path.join(source, dir_), file)
+    if os.path.exists(name2):
+        return name2
+    sys.stderr.write('file cannot be found in either ' + name1)
+    sys.stderr.write(' or ' + name2 + '\n')
+    os.sys.exit(1)
+
+
+def display_modules(up, dir_, build, source):
+    # display_modules walks though the files in dir and parses
+    # definition modules and includes README.texi
+    if check_directory(dir_, build, source):
+        if args.texinfo:
+            ext = '.texi'
+        elif args.sphinx:
+            ext = '.rst'
+        else:
+            ext = ''
+        if found_file(dir_, build, source, 'README' + ext):
+            do_cat(find_file(dir_, build, source, 'README' + ext))
+        module_menu(dir_, build, source)
+        list_of_files = []
+        if os.path.exists(os.path.join(source, dir_)):
+            list_of_files += os.listdir(os.path.join(source, dir_))
+        if os.path.exists(os.path.join(source, dir_)):
+            list_of_files += os.listdir(os.path.join(build, dir_))
+        list_of_files = list(dict.fromkeys(list_of_files).keys())
+        list_of_files.sort()
+        list_of_modules = []
+        for file in list_of_files:
+            if found_file(dir_, build, source, file):
+                if (len(file) > 4) and (file[-4:] == '.def'):
+                    list_of_modules += [file]
+        list_of_modules.sort()
+        parse_modules(up, dir_, build, source, list_of_modules)
+    else:
+        line = 'directory ' + dir_ + ' not found in either '
+        line += build + ' or ' + source
+        sys.stderr.write(line + '\n')
+
+
+def display_copyright():
+    output.write('@c Copyright (C) 2000-2022 Free Software Foundation, Inc.\n')
+    output.write('@c This file is part of GNU Modula-2.\n')
+    output.write("""
+@c Permission is granted to copy, distribute and/or modify this document
+@c under the terms of the GNU Free Documentation License, Version 1.2 or
+@c any later version published by the Free Software Foundation.
+""")
+
+
+def collect_args():
+    parser = argparse.ArgumentParser()
+    parser.add_argument('-v', '--verbose', help='generate progress messages',
+                        action='store_true')
+    parser.add_argument('-b', '--builddir', help='set the build directory',
+                        default='.', action='store')
+    parser.add_argument('-f', '--inputfile', help='set the input file',
+                        default=None, action='store')
+    parser.add_argument('-o', '--outputfile', help='set the output file',
+                        default=None, action='store')
+    parser.add_argument('-s', '--sourcedir', help='set the source directory',
+                        default='.', action='store')
+    parser.add_argument('-t', '--texinfo',
+                        help='generate texinfo documentation',
+                        default=False, action='store_true')
+    parser.add_argument('-u', '--up', help='set the up node',
+                        default='', action='store')
+    parser.add_argument('-x', '--sphinx', help='generate sphinx documentation',
+                        default=False, action='store_true')
+    args = parser.parse_args()
+    return args
+
+
+def handle_file():
+    if args.inputfile is None:
+        display_copyright()
+        display_menu()
+        display_library_class()
+    else:
+        parse_definition('.', args.sourcedir, args.builddir,
+                         args.inputfile, False)
+
+
+def main():
+    global args, output
+    args = collect_args()
+    if args.outputfile is None:
+        output = sys.stdout
+        handle_file()
+    else:
+        with open(args.outputfile, 'w') as output:
+            handle_file()
+
+
+main()
diff --git a/gcc/m2/tools-src/makeSystem b/gcc/m2/tools-src/makeSystem
new file mode 100644
index 00000000000..4ff8603d1ed
--- /dev/null
+++ b/gcc/m2/tools-src/makeSystem
@@ -0,0 +1,108 @@
+#!/bin/sh
+
+# makeSystem creates a target SYSTEM.def using the appropriate dialect template.
+
+# Copyright (C) 2008-2022 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 gm2; see the file COPYING.  If not, write to the Free Software
+# Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+
+Usage () {
+   echo "Usage: makesystem dialectflag SYSTEM.def SYSTEM.mod librarypath compiler"
+}
+
+if [ $# -lt 6 ] ; then
+   Usage
+   exit 1
+fi
+
+DIALECT=$1
+SYSTEMDEF=$2
+SYSTEMMOD=$3
+LIBRARY=$4
+COMPILER=$5
+OUTPUTFILE=$6
+
+if [ "$COMPILER" = "" ] ; then
+    echo "parameter 5 of makeSystem is incorrect, GM2_FOR_TARGET was unset"
+    exit 1
+fi
+
+if [ "$DIALECT" != "-fiso" -a "$DIALECT" != "-fpim" ] ; then
+   Usage
+   echo "dialect must be -fiso or -fpim"
+   exit 1
+fi
+
+displayExportedTypes () {
+   n=1
+   c=0
+   for i in ${types} ; do
+      if [ $n -eq 1 ] ; then
+          n=0
+          echo -n "                 " >> ${OUTPUTFILE}
+      fi
+      echo -n "$i, " >> ${OUTPUTFILE}
+      if [ $c -eq 4 ] ; then
+          echo " " >> ${OUTPUTFILE}
+          n=1
+          c=0
+      fi
+      c=`expr $c + 1`
+   done
+   echo " " >> ${OUTPUTFILE}
+}
+
+displayBuiltinTypes () {
+   for i in ${types} ; do
+      echo "   $i ; " >> ${OUTPUTFILE}
+   done
+}
+
+displayStart () {
+   sed -e "1,/@SYSTEM_DATATYPES@/!d" < ${SYSTEMDEF} | \
+   sed -e "/@SYSTEM_DATATYPES@/d" >> ${OUTPUTFILE}
+}
+
+displayMiddle () {
+   sed -e "1,/@SYSTEM_DATATYPES@/d" < ${SYSTEMDEF} | \
+   sed -e "1,/@SYSTEM_TYPES@/!d" | \
+   sed -e "/@SYSTEM_TYPES@/d" >> ${OUTPUTFILE}
+}
+
+displayEnd () {
+   sed -e "1,/@SYSTEM_TYPES@/d" < ${SYSTEMDEF} >> ${OUTPUTFILE}
+}
+
+MINIMAL="-fno-scaffold-main -fno-scaffold-dynamic -fno-scaffold-static -fno-m2-plugin"
+
+rm -f ${OUTPUTFILE}
+if ${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} \
+	       -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null 2>&1 > /dev/null ; then
+    types=`${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} -fno-m2-plugin -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null | cut -f5 -d' '`
+    touch ${OUTPUTFILE}
+    displayStart
+    displayExportedTypes
+    displayMiddle
+    displayBuiltinTypes
+    displayEnd
+else
+    ${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} \
+		-c -fdump-system-exports ${SYSTEMMOD} -o /dev/null
+    exit $?
+fi
diff --git a/gcc/m2/tools-src/mklink.c b/gcc/m2/tools-src/mklink.c
new file mode 100644
index 00000000000..fb95fd43369
--- /dev/null
+++ b/gcc/m2/tools-src/mklink.c
@@ -0,0 +1,807 @@
+/* mklink.c creates startup code and the link command line.
+
+Copyright (C) 2000-2022 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"
+
+#define MAX_FILE_NAME 8192
+#define MAXSTACK 4096
+#define STDIN 0
+#define STDOUT 1
+#define ENDOFILE ((char)-1)
+#define ERROR(X) \
+  (fprintf (stderr, "%s:%d error %s\n", __FILE__, __LINE__, X) \
+   && (fflush (stderr)))
+#define DEBUG(X) \
+  ((Debug) && (fprintf (stderr, "%s\n", X) && (fflush (stderr))))
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+typedef struct functlist
+{
+  char *functname;
+  struct functlist *next;
+} functList;
+
+/* Prototypes.  */
+
+static void ParseFileLinkCommand (void);
+static void ParseFileStartup (void);
+static void ParseFile (char *Name);
+static void ParseComments (void);
+static void CopyUntilEof (void);
+static void CopyUntilEol (void);
+static int IsSym (char *s);
+static int SymIs (char *s);
+static int FindString (char *String);
+static void GetNL (void);
+static char GetChar (void);
+static void ResetBuffer (void);
+static int GetSingleChar (char *ch);
+static int InRange (int Element, unsigned int Min, unsigned int Max);
+static char PutChar (char ch);
+static int IsSpace (char ch);
+static void SkipSpaces (void);
+static void SkipText (void);
+static void SilentSkipSpaces (void);
+static void SilentSkipText (void);
+static void PushBack (char *s);
+static int IsDigit (char ch);
+static void GetName (char *Name);
+static void OpenOutputFile (void);
+static void CloseFile (void);
+static void FindSource (char *Name);
+static void CopyUntilEolInto (char *Buffer);
+static void FindObject (char *Name);
+static int IsExists (char *Name);
+
+/* Global variables.  */
+
+static char *NameOfFile = NULL;
+static const char *NameOfMain = "main";
+static int StackPtr = 0;
+static char Stack[MAXSTACK];
+static int CurrentFile = STDIN;
+static int OutputFile;
+static int LinkCommandLine = FALSE;
+static int ProfilePCommand = FALSE;
+static int ProfilePGCommand = FALSE;
+static int ExitNeeded = TRUE;
+static char *libraries = NULL;
+static char *args = NULL;
+static functList *head = NULL;
+static functList *tail = NULL;
+static int langC = FALSE; /* FALSE = C++, TRUE = C.  */
+
+/* addLibrary - adds libname to the list of libraries to be linked.  */
+
+static void
+addLibrary (char *libname)
+{
+  if (libraries == NULL)
+    libraries = strdup (libname);
+  else
+    {
+      char *old = libraries;
+      char *newlib
+          = (char *)malloc (strlen (libname) + strlen (libraries) + 1 + 1);
+      strcpy (newlib, libraries);
+      strcat (newlib, " ");
+      strcat (newlib, libname);
+      libraries = newlib;
+      free (old);
+    }
+}
+
+/* addGccArg - adds arg to the list of gcc arguments.  */
+
+static void
+addGccArg (char *arg)
+{
+  if (args == NULL)
+    args = strdup (arg);
+  else
+    {
+      char *old = args;
+      char *newarg = (char *)malloc (strlen (old) + strlen (arg) + 1 + 1);
+      strcpy (newarg, old);
+      strcat (newarg, " ");
+      strcat (newarg, arg);
+      args = newarg;
+      free (old);
+    }
+}
+
+int
+main (int argc, char *argv[])
+{
+  int i;
+
+  if (argc >= 3)
+    {
+      if (strcmp (argv[1], "-l") == 0)
+	LinkCommandLine = TRUE;
+      else if (strcmp (argv[1], "-s") == 0)
+	LinkCommandLine = FALSE;
+      else
+        {
+          fprintf (stderr, "Usage: mklink (-l|-s) [--langc|--langc++] [--pg|-p] "
+                           "[--lib library] [--main name] [--exit] --name "
+                           "filename <modulelistfile>\n");
+          fprintf (stderr, "       must supply -l or -s option\n");
+          exit (1);
+        }
+      ProfilePCommand = FALSE;
+      ProfilePGCommand = FALSE;
+      i = 2;
+      while (i < argc - 1)
+        {
+          if (strcmp (argv[i], "--langc++") == 0)
+	    langC = FALSE;
+          else if (strcmp (argv[i], "--langc") == 0)
+	    langC = TRUE;
+          else if (strncmp (argv[i], "-f", 2) == 0)
+	    addGccArg (argv[i]);
+          else if (strcmp (argv[i], "--pg") == 0)
+	    ProfilePGCommand = TRUE;
+          else if (strcmp (argv[i], "-p") == 0)
+	    ProfilePCommand = TRUE;
+          else if (strcmp (argv[i], "--exit") == 0)
+	    ExitNeeded = FALSE;
+          else if (strcmp (argv[i], "--lib") == 0)
+            {
+              i++;
+              addLibrary (argv[i]);
+            }
+          else if (strcmp (argv[i], "--main") == 0)
+            {
+              i++;
+              NameOfMain = argv[i];
+            }
+          else if (strcmp (argv[i], "--name") == 0)
+            {
+              i++;
+              NameOfFile = argv[i];
+            }
+          i++;
+        }
+      ParseFile (argv[i]);
+    }
+  else
+    {
+      fprintf (stderr, "Usage: mklink (-l|-s) [--gcc|--g++] [--pg|-p] [--lib "
+                       "library] [--main name] [--exit] --name filename "
+                       "<modulelistfile>\n");
+      exit (1);
+    }
+  if (NameOfFile == NULL)
+    {
+      fprintf (stderr, "mklink must have a --name argument\n");
+      fprintf (stderr, "Usage: mklink (-l|-s) [--gcc|--g++] [--pg|-p] [--lib "
+                       "library] [--main name] [--exit] --name filename "
+                       "<modulelistfile>\n");
+      exit (1);
+    }
+  exit (0);
+}
+
+/* ParseFile - parses the input file and generates the output file.  */
+
+static void
+ParseFile (char *Name)
+{
+  FindSource (Name);
+  OpenOutputFile ();
+  if (LinkCommandLine)
+    ParseFileLinkCommand ();
+  else
+    ParseFileStartup ();
+  CloseFile ();
+}
+
+/* ParseFileLinkCommand - generates the link command.  */
+
+static void
+ParseFileLinkCommand (void)
+{
+  char name[MAX_FILE_NAME];
+  char *s = NULL;
+  char *l = NULL;
+  char *c = NULL;
+
+  s = getenv ("CC");
+  if (s == NULL)
+    {
+      if (langC)
+        printf ("gcc -g ");
+      else
+        printf ("g++ -g ");
+    }
+  else
+    printf ("%s -g ", s);
+
+  if (args != NULL)
+    printf ("%s ", args);
+
+  l = getenv ("LDFLAGS");
+  if (l != NULL)
+    printf ("%s ", l);
+
+  c = getenv ("CFLAGS");
+  if (c != NULL)
+    printf ("%s ", c);
+
+  if (ProfilePGCommand)
+    printf (" -pg");
+  else if (ProfilePCommand)
+    printf (" -p");
+
+  while (PutChar (GetChar ()) != (char)EOF)
+    {
+      CopyUntilEolInto (name);
+      if ((strlen (name) > 0) && (name[0] != '#'))
+        FindObject (name);
+    }
+  printf (" %s\n", libraries);
+}
+
+/* FindObject - searches the M2PATH variable to find the object file.
+   If it finds the object file it prints it to stdout otherwise it
+   writes an error on stderr.  */
+
+static void
+FindObject (char *Name)
+{
+  char m2search[4096];
+  char m2path[4096];
+  char name[4096];
+  char exist[4096];
+  int s, p;
+
+  if (getenv ("M2PATH") == NULL)
+    strcpy (m2path, ".");
+  else
+    strcpy (m2path, getenv ("M2PATH"));
+
+  snprintf (name, sizeof (name), "%s.o", Name);
+  p = 0;
+  while (m2path[p] != (char)0)
+    {
+      s = 0;
+      while ((m2path[p] != (char)0) && (m2path[p] != ' '))
+        {
+          m2search[s] = m2path[p];
+          s++;
+          p++;
+        }
+      if (m2path[p] == ' ')
+	p++;
+      m2search[s] = (char)0;
+      snprintf (exist, sizeof (exist), "%s/%s", m2search, name);
+      if (IsExists (exist))
+        {
+          printf (" %s", exist);
+          return;
+        }
+    }
+  fprintf (stderr, "cannot find %s\n", name);
+}
+
+/* IsExists - returns true if a file, Name, exists.  It returns false
+   otherwise.  */
+
+static int
+IsExists (char *Name)
+{
+  struct stat buf;
+
+  return (stat (Name, &buf) == 0);
+}
+
+/* add_function - adds a name to the list of functions, in order.  */
+
+void
+add_function (char *name)
+{
+  functList *p = (functList *)malloc (sizeof (functList));
+  p->functname = (char *)malloc (strlen (name) + 1);
+  strcpy (p->functname, name);
+
+  if (head == NULL)
+    {
+      head = p;
+      tail = p;
+      p->next = NULL;
+    }
+  else
+    {
+      tail->next = p;
+      tail = p;
+      tail->next = NULL;
+    }
+}
+
+static void
+GenerateInitCalls (functList *p)
+{
+  while (p != NULL)
+    {
+      printf ("   _M2_%s_init (argc, argv, envp);\n", p->functname);
+      p = p->next;
+    }
+}
+
+static void
+GenerateFinishCalls (functList *p)
+{
+  if (p->next != NULL)
+    GenerateFinishCalls (p->next);
+  printf ("   _M2_%s_finish (argc, argv, envp);\n", p->functname);
+}
+
+static void
+GeneratePrototypes (functList *p)
+{
+  while (p != NULL)
+    {
+      if (langC)
+        {
+          printf ("extern void _M2_%s_init (int argc, char *argv[], char *envp[]);\n",
+                  p->functname);
+          printf ("extern void _M2_%s_finish (int argc, char *argv[], char *envp[]);\n",
+                  p->functname);
+        }
+      else
+        {
+          printf ("extern \"C\" void _M2_%s_init (int argc, char *argv[], char *envp[]);\n",
+                  p->functname);
+          printf ("extern \"C\" void _M2_%s_finish (int argc, char *argv[], char *envp[]);\n",
+                  p->functname);
+        }
+      p = p->next;
+    }
+}
+
+/* ParseFileStartup - generates the startup code.  */
+
+static void
+ParseFileStartup (void)
+{
+  char name[MAX_FILE_NAME];
+  functList *p;
+
+  while (PutChar (GetChar ()) != (char)EOF)
+    {
+      CopyUntilEolInto (name);
+      if ((strlen (name) > 0) && (strcmp (name, "mod_init") != 0)
+          && (name[0] != '#'))
+	add_function (name);
+    }
+  GeneratePrototypes (head);
+  printf ("extern");
+  if (!langC)
+    printf (" \"C\"");
+  printf (" void _exit(int);\n");
+
+  printf ("\n\nint %s(int argc, char *argv[], char *envp[])\n", NameOfMain);
+  printf ("{\n");
+  GenerateInitCalls (head);
+  GenerateFinishCalls (head);
+  if (ExitNeeded)
+    printf ("   _exit(0);\n");
+  printf ("   return(0);\n");
+  printf ("}\n");
+}
+
+/* OpenOutputFile - shut down stdout and open the new mod_init.c */
+
+static void
+OpenOutputFile (void)
+{
+  if (strcmp (NameOfFile, "-") != 0)
+    {
+      if (close (STDOUT) != 0)
+        {
+          ERROR ("Unable to close stdout");
+          exit (1);
+        }
+      OutputFile = creat (NameOfFile, 0666);
+      if (OutputFile != STDOUT)
+        {
+          ERROR ("Expected that the file descriptor should be 1");
+        }
+    }
+}
+
+/* CloseFile - flush and close the file.  */
+
+static void
+CloseFile (void)
+{
+#if 0
+  fflush(stdout);
+  if (close(STDOUT) != 0) {
+    ERROR("Unable to close our output file"); exit(1);
+  }
+#endif
+}
+
+/* CopyUntilEof - copies from the current input marker until ENDOFILE
+   is reached.  */
+
+static void
+CopyUntilEof (void)
+{
+  char ch;
+
+  while ((ch = GetChar ()) != ENDOFILE)
+    putchar (ch);
+}
+
+/* CopyUntilEol - copies from the current input marker until '\n' is
+   reached.  */
+
+static void
+CopyUntilEol (void)
+{
+  char ch;
+
+  while (((ch = GetChar ()) != '\n') && (ch != (char)EOF))
+    putchar (ch);
+  if (ch == '\n')
+    putchar (ch);
+}
+
+/* CopyUntilEolInto - copies from the current input marker until '\n'
+   is reached into a Buffer.  */
+
+static void
+CopyUntilEolInto (char *Buffer)
+{
+  char ch;
+  int i = 0;
+
+  while (((ch = GetChar ()) != '\n') && (ch != (char)EOF))
+    {
+      Buffer[i] = ch;
+      i++;
+    }
+  if ((ch == '\n') || (ch == (char)EOF))
+    Buffer[i] = (char)0;
+}
+
+/* IsSym - returns true if string, s, was found in the input stream.
+   The input stream is uneffected.  */
+
+static int
+IsSym (char *s)
+{
+  int i = 0;
+
+  while ((s[i] != (char)0) && (s[i] == PutChar (GetChar ())))
+    {
+      GetChar ();
+      i++;
+    }
+  if (s[i] == (char)0)
+    {
+      PushBack (s);
+      /* found s in input string.  */
+      return (TRUE);
+    }
+  else
+    {
+      /* push back the characters we have scanned.  */
+      if (i > 0)
+        {
+          do
+            {
+              i--;
+              PutChar (s[i]);
+            }
+          while (i > 0);
+        }
+      return (FALSE);
+    }
+}
+
+/* SymIs - returns true if string, s, was found in the input stream.
+   The token s is consumed from the input stream.  */
+
+static int
+SymIs (char *s)
+{
+  int i = 0;
+
+  while ((s[i] != (char)0) && (s[i] == PutChar (GetChar ())))
+    {
+      GetChar ();
+      i++;
+    }
+  if (s[i] == (char)0)
+    {
+      /* found s in input string.  */
+      return (TRUE);
+    }
+  else
+    {
+      /* push back the characters we have scanned.  */
+      if (i > 0)
+        {
+          do
+            {
+              i--;
+              PutChar (s[i]);
+            }
+          while (i > 0);
+        }
+      return (FALSE);
+    }
+}
+
+/* FindString - keeps on reading input until a string, String, is
+   matched.  If end of file is reached then FALSE is returned, otherwise
+   TRUE is returned.  */
+
+static int
+FindString (char *String)
+{
+  int StringIndex = 0;
+  int Found = FALSE;
+  int eof = FALSE;
+  char ch;
+
+  while ((!Found) && (!eof))
+    {
+      if (String[StringIndex] == (char)0)
+	/* must have found string.  */
+	Found = TRUE;
+      else
+        {
+          ch = GetChar ();
+          eof = (ch == ENDOFILE);
+          if (ch == String[StringIndex])
+	    StringIndex++;
+          else
+	    StringIndex = 0;
+        }
+    }
+  return (Found);
+}
+
+/* GetNL - keeps on reading input from until a new line is found.  */
+
+static void
+GetNL (void)
+{
+  char ch;
+
+  while ((ch = GetChar ()) != '\n')
+    putchar (ch);
+  putchar ('\n');
+}
+
+/* GetChar - returns the current character in input.  */
+
+static char
+GetChar (void)
+{
+  char ch;
+
+  if (StackPtr > 0)
+    {
+      StackPtr--;
+      return (Stack[StackPtr]);
+    }
+  else
+    {
+      if (GetSingleChar (&ch))
+	return (ch);
+      else
+	return (ENDOFILE);
+    }
+}
+
+#define MAXBUF 0x1000
+static int Pointer = 0;
+static int AmountRead = 0;
+static char Buffer[MAXBUF];
+
+/* ResetBuffer - resets the buffer information to an initial state.  */
+
+static void
+ResetBuffer (void)
+{
+  StackPtr = 0;
+  Pointer = 0;
+  AmountRead = 0;
+}
+
+/* GetSingleChar - gets a single character from input.  TRUE is
+   returned upon success.  */
+
+static int
+GetSingleChar (char *ch)
+{
+  if (Pointer == AmountRead)
+    {
+      AmountRead = read (CurrentFile, &Buffer, MAXBUF);
+      if (AmountRead < 0)
+	AmountRead = 0;
+      Pointer = 0;
+    }
+  if (Pointer == AmountRead)
+    {
+      *ch = ENDOFILE;
+      return (FALSE);
+    }
+  else
+    {
+      *ch = Buffer[Pointer];
+      Pointer++;
+      return (TRUE);
+    }
+}
+
+/* InRange - returns true if Element is within the range Min..Max.  */
+
+static int
+InRange (int Element, unsigned int Min, unsigned int Max)
+{
+  return ((Element >= Min) && (Element <= Max));
+}
+
+/* PutChar - pushes a character back onto input.  This character is
+   also returned.  */
+
+static char
+PutChar (char ch)
+{
+  if (StackPtr < MAXSTACK)
+    {
+      Stack[StackPtr] = ch;
+      StackPtr++;
+    }
+  else
+    {
+      ERROR ("Stack overflow in PutChar");
+    }
+  return (ch);
+}
+
+/* IsSpace - returns true if character, ch, is a space.  */
+
+static int
+IsSpace (char ch)
+{
+  return ((ch == ' ') || (ch == '\t'));
+}
+
+/* SkipSpaces - eats up spaces in input.  */
+
+static void
+SkipSpaces (void)
+{
+  while (IsSpace (PutChar (GetChar ())))
+    putchar (GetChar ());
+}
+
+/* SilentSkipSpaces - eats up spaces in input.  */
+
+static void
+SilentSkipSpaces (void)
+{
+  char ch;
+
+  while (IsSpace (PutChar (GetChar ())))
+    ch = GetChar (); /* throw away character.  */
+}
+
+/* SkipText - skips ascii text, it does not skip white spaces.  */
+
+static void
+SkipText (void)
+{
+  while (!IsSpace (PutChar (GetChar ())))
+    putchar (GetChar ());
+}
+
+/* SilentSkipText - skips ascii text, it does not skip white spaces.  */
+
+static void
+SilentSkipText (void)
+{
+  char ch;
+
+  while (!IsSpace (PutChar (GetChar ())))
+    ch = GetChar (); /* throw away character.  */
+}
+
+/* PushBack - pushes a string, backwards onto the input stack.  */
+
+static void
+PushBack (char *s)
+{
+  int i;
+
+  i = strlen (s);
+  while (i > 0)
+    {
+      i--;
+      PutChar (s[i]);
+    }
+}
+
+/* IsDigit - returns true if a character, ch, is a decimal digit.  */
+
+static int
+IsDigit (char ch)
+{
+  return (((ch >= '0') && (ch <= '9')));
+}
+
+/* GetName - returns the next name found.  */
+
+static void
+GetName (char *Name)
+{
+  int i;
+  char ch;
+
+  SkipSpaces ();
+  ch = GetChar ();
+  i = 0;
+  while (!IsSpace (ch))
+    {
+      Name[i] = ch;
+      i++;
+      ch = GetChar ();
+    }
+  Name[i] = '\0';
+}
+
+/* FindSource - open source file on StdIn.  */
+
+static void
+FindSource (char *Name)
+{
+  if (close (STDIN) != 0)
+    {
+      ERROR ("close on STDIN failed");
+    }
+  CurrentFile = open (Name, O_RDONLY);
+  if (CurrentFile < 0)
+    {
+      perror ("failed to open file");
+      exit (1);
+    }
+  if (CurrentFile != STDIN)
+    {
+      ERROR ("Expecting file descriptor value of 1");
+    }
+}
diff --git a/gcc/m2/tools-src/tidydates.py b/gcc/m2/tools-src/tidydates.py
new file mode 100644
index 00000000000..c244066cd40
--- /dev/null
+++ b/gcc/m2/tools-src/tidydates.py
@@ -0,0 +1,166 @@
+#!/usr/bin/env python3
+
+# utility to tidy dates and detect lack of copyright.
+
+# Copyright (C) 2016-2022 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 GNU Modula-2; see the file COPYING.  If not, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+
+import os
+import pathlib
+import shutil
+import sys
+
+max_line_length = 60
+
+COPYRIGHT = 'Copyright (C)'
+
+
+def visit_dir(directory, ext, func):
+    # visit_dir - call func for each file below, dir, matching extension, ext.
+    list_of_files = os.listdir(directory)
+    list_of_files.sort()
+    for filename in list_of_files:
+        path = pathlib.PurePath(filename)
+        full = os.path.join(directory, filename)
+        if path.is_file(full):
+            if path.suffix == ext:
+                func(full)
+        elif path.is_dir(full):
+            visit_dir(full, ext, func)
+
+
+def is_year(year):
+    # is_year - returns True if, year, is legal.
+    if len(year) == 5:
+        year = year[:-1]
+    for c in year:
+        if not c.isdigit():
+            return False
+    return True
+
+
+def handle_copyright(outfile, lines, n, leader1, leader2):
+    # handle_copyright look for Copyright in the comment.
+    global max_line_length
+    i = lines[n]
+    c = i.find(COPYRIGHT)+len(COPYRIGHT)
+    outfile.write(i[:c])
+    d = i[c:].split()
+    start = c
+    seen_date = True
+    years = []
+    while seen_date:
+        if d == []:
+            n += 1
+            i = lines[n]
+            d = i[2:].split()
+        else:
+            e = d[0]
+            punctuation = ''
+            if len(d) == 1:
+                d = []
+            else:
+                d = d[1:]
+            if c > max_line_length:
+                outfile.write('\n')
+                outfile.write(leader1)
+                outfile.write(leader2)
+                outfile.write(' '*(start-2))
+                c = start
+            if is_year(e):
+                if (e[-1] == '.') or (e[-1] == ','):
+                    punctuation = e[-1]
+                    e = e[:-1]
+                else:
+                    punctuation = ''
+            else:
+                seen_date = False
+            if seen_date:
+                if not (e in years):
+                    c += len(e) + len(punctuation)
+                    outfile.write(' ')
+                    outfile.write(e)
+                    outfile.write(punctuation)
+                    years += [e]
+            else:
+                if start < c:
+                    outfile.write('\n')
+                    outfile.write(leader1)
+                    outfile.write(leader2)
+                    outfile.write(' '*(start-2))
+
+                outfile.write(' ')
+                outfile.write(e)
+                outfile.write(punctuation)
+                for w in d:
+                    outfile.write(' ')
+                    outfile.write(w)
+    outfile.write('\n')
+    return outfile, n+1
+
+
+def handle_header(filename, leader1, leader2):
+    # handle_header reads in the header of a file and inserts
+    # a line break around the Copyright dates.
+    print('------------------------------')
+    lines = open(filename).readlines()
+    if len(lines) > 20:
+        with open('tmptidy', 'w') as outfile:
+            n = 0
+            for i in lines:
+                if i.find('Copyright (C)') >= 0:
+                    outfile, n = handle_copyright(outfile, lines,
+                                                  n, leader1, leader2)
+                    outfile.writelines(lines[n:])
+                    outfile.close()
+                    print('-> mv tmptidy', filename)
+                    shutil.move('tmptidy', filename)
+                    return
+                else:
+                    outfile.write(lines[n])
+                    n += 1
+        sys.stdout.write('%s:1:1 needs a Copyright notice..\n' % filename)
+
+
+def bash_tidy(filename):
+    # bash_tidy - tidy up dates using '#' comment
+    handle_header(filename, '#', ' ')
+
+
+def c_tidy(filename):
+    # c_tidy - tidy up dates using '/* */' comments
+    handle_header(filename, ' ', '*')
+
+
+def m2_tidy(filename):
+    # m2_tidy - tidy up dates using '(* *)' comments
+    handle_header(filename, ' ', ' ')
+
+
+def main():
+    # main - for each file extension call the appropriate tidy routine.
+    visit_dir('.', '.in', bash_tidy)
+    visit_dir('.', '.py', bash_tidy)
+    visit_dir('.', '.c', c_tidy)
+    visit_dir('.', '.h', c_tidy)
+    visit_dir('.', '.def', m2_tidy)
+    visit_dir('.', '.mod', m2_tidy)
+
+
+main()
diff --git a/gcc/m2/version.c b/gcc/m2/version.c
new file mode 100644
index 00000000000..205635c667f
--- /dev/null
+++ b/gcc/m2/version.c
@@ -0,0 +1 @@
+#define version_string  "1.9.5"
diff --git a/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/c.c b/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/c.c
new file mode 100644
index 00000000000..15dfe182b33
--- /dev/null
+++ b/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/c.c
@@ -0,0 +1,30 @@
+/* c.c trivial C module which implements strlen.
+
+Copyright (C) 2009-2020 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/>.  */
+
+
+int funcString (char *s)
+{
+  int i = 0;
+
+  while (s[i] != (char)0)
+    i++;
+  return i;
+}
diff --git a/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/c.def b/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/c.def
new file mode 100644
index 00000000000..ca6f94e20d8
--- /dev/null
+++ b/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/c.def
@@ -0,0 +1,28 @@
+(* c.def trivial test module which defines a C function.
+
+Copyright (C) 2009-2020 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/>.  *)
+
+DEFINITION MODULE FOR "C" c ;
+
+EXPORT UNQUALIFIED funcString ;
+
+PROCEDURE funcString (s: ARRAY OF CHAR) : INTEGER ;
+
+END c.
diff --git a/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/calling-c-datatypes-unbounded-run-pass.exp b/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/calling-c-datatypes-unbounded-run-pass.exp
new file mode 100644
index 00000000000..ba2231e5f62
--- /dev/null
+++ b/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/calling-c-datatypes-unbounded-run-pass.exp
@@ -0,0 +1,43 @@
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/calling-c/datatypes/unbounded/run/pass"
+gm2_link_obj "c.o"
+
+set output [target_compile $srcdir/$subdir/c.c c.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/m.mod b/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/m.mod
new file mode 100644
index 00000000000..45be253692d
--- /dev/null
+++ b/gcc/testsuite/gm2/calling-c/datatypes/unbounded/run/pass/m.mod
@@ -0,0 +1,42 @@
+(* trivial test module which calls a C module.
+
+Copyright (C) 2009-2020 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/>.  *)
+
+MODULE m ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM c IMPORT funcString ;
+
+PROCEDURE farrayofchar (a: ARRAY OF CHAR) ;
+BEGIN
+   IF funcString('hello')#5
+   THEN
+      HALT(1)
+   END ;
+   IF funcString(a)#5
+   THEN
+      HALT(2)
+   END
+END farrayofchar ;
+
+
+BEGIN
+   farrayofchar ('hello')
+END m.
diff --git a/gcc/testsuite/gm2/case/pass/case-pass.exp b/gcc/testsuite/gm2/case/pass/case-pass.exp
new file mode 100644
index 00000000000..a35ea4ba62a
--- /dev/null
+++ b/gcc/testsuite/gm2/case/pass/case-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim ${srcdir}/gm2/case/pass;
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/case/pass/testcase1.mod b/gcc/testsuite/gm2/case/pass/testcase1.mod
new file mode 100644
index 00000000000..3a631e53bfe
--- /dev/null
+++ b/gcc/testsuite/gm2/case/pass/testcase1.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001-2020 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 2, 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. *)
+
+MODULE testcase1 ;
+
+
+PROCEDURE do ;
+BEGIN
+END do ;
+
+PROCEDURE foo (ch: CHAR) ;
+BEGIN
+   CASE ch OF
+
+   '0'     :  do |
+   '1'     :  do |
+   '2'..'9':  do
+
+   ELSE
+      do
+   END
+END foo ;
+
+BEGIN
+   foo('1')
+END testcase1.
diff --git a/gcc/testsuite/gm2/case/pass/testcase2.mod b/gcc/testsuite/gm2/case/pass/testcase2.mod
new file mode 100644
index 00000000000..dd9fc7d9963
--- /dev/null
+++ b/gcc/testsuite/gm2/case/pass/testcase2.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001-2020 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 2, 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. *)
+
+MODULE testcase2 ;
+
+
+(*
+   do -
+*)
+
+PROCEDURE do ;
+BEGIN
+END do ;
+
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   CASE c OF
+
+   0   : do |
+   1   : do |
+   2..9: do
+
+   ELSE
+      do
+   END
+END testcase2.
diff --git a/gcc/testsuite/gm2/case/pass/testcase3.mod b/gcc/testsuite/gm2/case/pass/testcase3.mod
new file mode 100644
index 00000000000..820c56447f7
--- /dev/null
+++ b/gcc/testsuite/gm2/case/pass/testcase3.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001-2020 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 2, 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. *)
+
+MODULE testcase3 ;
+
+
+PROCEDURE do ;
+BEGIN
+END do ;
+
+VAR
+   a, b, c: CARDINAL ;
+BEGIN
+   IF (a>=b) AND (a<=c)
+   THEN
+      do
+   END
+END testcase3.
diff --git a/gcc/testsuite/gm2/case/pass/testcase4.mod b/gcc/testsuite/gm2/case/pass/testcase4.mod
new file mode 100644
index 00000000000..42a7f1a18d9
--- /dev/null
+++ b/gcc/testsuite/gm2/case/pass/testcase4.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001-2020 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 2, 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. *)
+
+MODULE testcase4 ;
+
+
+PROCEDURE do ;
+BEGIN
+END do ;
+
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   CASE c OF
+
+   2..9: do |
+   0   : do |
+   1   : do
+
+   ELSE
+      do
+   END
+END testcase4.
diff --git a/gcc/testsuite/gm2/complex/fail/var1.mod b/gcc/testsuite/gm2/complex/fail/var1.mod
new file mode 100644
index 00000000000..34f292bf622
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/fail/var1.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var1 ;
+
+
+VAR
+   p   : REAL;
+   q   : LONGREAL ;
+   c   : COMPLEX;
+BEGIN
+   p := 5.0 ;
+   q := 6.0 ;
+   c := CMPLX(p, q)
+END var1.
diff --git a/gcc/testsuite/gm2/complex/pass/arith.mod b/gcc/testsuite/gm2/complex/pass/arith.mod
new file mode 100644
index 00000000000..5ddf6c423ae
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/arith.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+
+VAR
+   a, b: COMPLEX ;
+BEGIN
+   a := i ;
+   b := a*one
+END arith.
diff --git a/gcc/testsuite/gm2/complex/pass/arith2.mod b/gcc/testsuite/gm2/complex/pass/arith2.mod
new file mode 100644
index 00000000000..2bb8a14b771
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/arith2.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith2 ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+
+PROCEDURE getOne () : COMPLEX ;
+BEGIN
+   RETURN one
+END getOne ;
+
+VAR
+   a, b: COMPLEX ;
+BEGIN
+   a := i ;
+   b := a*getOne()
+END arith2.
diff --git a/gcc/testsuite/gm2/complex/pass/arith3.mod b/gcc/testsuite/gm2/complex/pass/arith3.mod
new file mode 100644
index 00000000000..564487a8bcd
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/arith3.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith3 ;
+
+FROM M2RTS IMPORT Halt ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      Halt(__FILE__, l, __FUNCTION__, 'failed')
+   END
+END Assert ;
+
+PROCEDURE getOne () : COMPLEX ;
+BEGIN
+   RETURN one
+END getOne ;
+
+VAR
+   a, b: COMPLEX ;
+BEGIN
+   a := i ;
+   b := a*getOne() ;
+   Assert(i*i=-one, __LINE__)
+END arith3.
diff --git a/gcc/testsuite/gm2/complex/pass/arith4.mod b/gcc/testsuite/gm2/complex/pass/arith4.mod
new file mode 100644
index 00000000000..cf3338e26a3
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/arith4.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith4 ;
+
+VAR
+   z: COMPLEX ;
+BEGIN
+   z := CMPLX (2.0, 3.0)
+END arith4.
diff --git a/gcc/testsuite/gm2/complex/pass/arith5.mod b/gcc/testsuite/gm2/complex/pass/arith5.mod
new file mode 100644
index 00000000000..17ac8aa88e1
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/arith5.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith5 ;
+
+VAR
+   z: COMPLEX ;
+   c: COMPLEX ;
+BEGIN
+   c := CMPLX (1.0, 0.0) ;
+   z := CMPLX (2.0, 3.0) * c
+END arith5.
diff --git a/gcc/testsuite/gm2/complex/pass/arith6.mod b/gcc/testsuite/gm2/complex/pass/arith6.mod
new file mode 100644
index 00000000000..74ce68faf2d
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/arith6.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith6 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   z: COMPLEX ;
+BEGIN
+   z := CMPLX (0.0, -1.0) ;
+   IF z*z#-CMPLX(1.0, 0.0)
+   THEN
+      exit(1)
+   END
+END arith6.
diff --git a/gcc/testsuite/gm2/complex/pass/complex-pass.exp b/gcc/testsuite/gm2/complex/pass/complex-pass.exp
new file mode 100644
index 00000000000..95b612e6a23
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/complex-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_iso
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/complex/pass/consts.mod b/gcc/testsuite/gm2/complex/pass/consts.mod
new file mode 100644
index 00000000000..4ee53e55cc7
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/consts.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE consts ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+
+BEGIN
+END consts.
diff --git a/gcc/testsuite/gm2/complex/pass/consts2.mod b/gcc/testsuite/gm2/complex/pass/consts2.mod
new file mode 100644
index 00000000000..b15859cea06
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/consts2.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE consts2 ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+
+VAR
+   a: COMPLEX ;
+BEGIN
+   a := i ;
+   a := one ;
+   a := zero
+END consts2.
diff --git a/gcc/testsuite/gm2/complex/pass/consts3.mod b/gcc/testsuite/gm2/complex/pass/consts3.mod
new file mode 100644
index 00000000000..4afe9174104
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/consts3.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE consts3 ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+
+VAR
+   a: COMPLEX ;
+BEGIN
+   a := i ;
+   IF a=i
+   THEN
+      
+   END
+END consts3.
diff --git a/gcc/testsuite/gm2/complex/pass/tinycabs.mod b/gcc/testsuite/gm2/complex/pass/tinycabs.mod
new file mode 100644
index 00000000000..1fa92855494
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/tinycabs.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2020 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 2, 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. *)
+
+MODULE tinycabs ;
+
+FROM libc IMPORT printf ;
+
+PROCEDURE cabs (z: COMPLEX) : REAL ;
+BEGIN
+   RETURN ABS (RE (z)) + ABS (IM (z))
+END cabs ;
+
+VAR
+   r: REAL ;
+   z: COMPLEX ;
+BEGIN
+   z := CMPLX (1.0, 2.0) ;
+   r := cabs (z) ;
+   printf ("abs value is %g\n", r)
+END tinycabs.
diff --git a/gcc/testsuite/gm2/complex/pass/var1.mod b/gcc/testsuite/gm2/complex/pass/var1.mod
new file mode 100644
index 00000000000..7df4c34bccc
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/var1.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var1 ;
+
+
+VAR
+   p, q: REAL;
+   c   : COMPLEX;
+BEGIN
+   p := 5.0 ;
+   q := 6.0 ;
+   c := CMPLX(p, q)
+END var1.
diff --git a/gcc/testsuite/gm2/complex/pass/var2.mod b/gcc/testsuite/gm2/complex/pass/var2.mod
new file mode 100644
index 00000000000..0f2ec9aec47
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/var2.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var2 ;
+
+
+VAR
+   p, q: LONGREAL;
+   c   : LONGCOMPLEX;
+BEGIN
+   p := 5.0 ;
+   q := 6.0 ;
+   c := CMPLX(p, q)
+END var2.
diff --git a/gcc/testsuite/gm2/complex/pass/var3.mod b/gcc/testsuite/gm2/complex/pass/var3.mod
new file mode 100644
index 00000000000..8275b0c1547
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/var3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var3 ;
+
+
+VAR
+   p, q: SHORTREAL;
+   c   : SHORTCOMPLEX;
+BEGIN
+   p := 5.0 ;
+   q := 6.0 ;
+   c := CMPLX(p, q)
+END var3.
diff --git a/gcc/testsuite/gm2/complex/pass/var4.mod b/gcc/testsuite/gm2/complex/pass/var4.mod
new file mode 100644
index 00000000000..e166c46f2a3
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/var4.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var4 ;
+
+FROM SYSTEM IMPORT COMPLEX32, REAL32 ;
+
+VAR
+   p, q: REAL32 ;
+   c   : COMPLEX32 ;
+BEGIN
+   p := 5.0 ;
+   q := 6.0 ;
+   c := CMPLX(p, q)
+END var4.
diff --git a/gcc/testsuite/gm2/complex/pass/var5.mod b/gcc/testsuite/gm2/complex/pass/var5.mod
new file mode 100644
index 00000000000..fc598d5aeba
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/var5.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var5 ;
+
+
+VAR
+   p: REAL ;
+   c: COMPLEX ;
+BEGIN
+   p := 5.0 ;
+   c := CMPLX(p, 6.0)
+END var5.
diff --git a/gcc/testsuite/gm2/complex/pass/var6.mod b/gcc/testsuite/gm2/complex/pass/var6.mod
new file mode 100644
index 00000000000..de6efa43ca9
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/var6.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var6 ;
+
+
+VAR
+   p: LONGREAL ;
+   c: LONGCOMPLEX ;
+BEGIN
+   p := 5.0 ;
+   c := CMPLX(p, 6.0)
+END var6.
diff --git a/gcc/testsuite/gm2/complex/pass/var7.mod b/gcc/testsuite/gm2/complex/pass/var7.mod
new file mode 100644
index 00000000000..af061609fc2
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/var7.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var7 ;
+
+
+VAR
+   p: SHORTREAL ;
+   c: SHORTCOMPLEX ;
+BEGIN
+   p := 5.0 ;
+   c := CMPLX(p, 6.0)
+END var7.
diff --git a/gcc/testsuite/gm2/complex/pass/var8.mod b/gcc/testsuite/gm2/complex/pass/var8.mod
new file mode 100644
index 00000000000..3622ee7a51e
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/pass/var8.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE var8 ;
+
+FROM SYSTEM IMPORT COMPLEX32, REAL32 ;
+
+VAR
+   p: REAL32 ;
+   c: COMPLEX32 ;
+BEGIN
+   p := 5.0 ;
+   c := CMPLX(p, 6.0)
+END var8.
diff --git a/gcc/testsuite/gm2/complex/run/pass/arith3.mod b/gcc/testsuite/gm2/complex/run/pass/arith3.mod
new file mode 100644
index 00000000000..066eb66af7d
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/run/pass/arith3.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2009-2021 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 2, 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. *)
+
+MODULE arith3 ;
+
+FROM M2RTS IMPORT Halt ;
+FROM libc IMPORT printf ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      Halt(__FILE__, l, __FUNCTION__, 'failure')
+   END
+END Assert ;
+
+PROCEDURE getOne () : COMPLEX ;
+BEGIN
+   RETURN one
+END getOne ;
+
+VAR
+   a, b, c: COMPLEX ;
+BEGIN
+   printf ("main module starting\n");
+   printf ("a := i\n");   
+   a := i ;
+   printf ("b := a*getOne()\n");
+   b := a*getOne() ;
+   printf ("c := i*i\n");
+   c := i*i ;
+
+   printf ("Assert (c=-one)\n");
+   Assert(c=-one, __LINE__) ;
+
+   printf ("Assert (i*i=-one)\n");
+   Assert(i*i=-one, __LINE__) ;
+   printf ("main module finishing, all done\n");
+END arith3.
diff --git a/gcc/testsuite/gm2/complex/run/pass/arith4.mod b/gcc/testsuite/gm2/complex/run/pass/arith4.mod
new file mode 100644
index 00000000000..950674a2680
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/run/pass/arith4.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith4 ;
+
+FROM M2RTS IMPORT Halt ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      Halt(__FILE__, l, __FUNCTION__, 'failure')
+   END
+END Assert ;
+
+PROCEDURE getOne () : LONGCOMPLEX ;
+BEGIN
+   RETURN one
+END getOne ;
+
+VAR
+   a, b, c, d: LONGCOMPLEX ;
+BEGIN
+   a := i ;
+   b := a*getOne() ;
+   c := i*i ;
+   d := -one ;
+
+   Assert(c=-one, __LINE__) ;
+
+   Assert(c=d, __LINE__) ;
+
+   Assert(i*i=-one, __LINE__)
+END arith4.
diff --git a/gcc/testsuite/gm2/complex/run/pass/arith5.mod b/gcc/testsuite/gm2/complex/run/pass/arith5.mod
new file mode 100644
index 00000000000..c7a7955b592
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/run/pass/arith5.mod
@@ -0,0 +1,67 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith5 ;
+
+FROM libc IMPORT printf ;
+FROM M2RTS IMPORT Halt ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+   two  = CMPLX (2.0, 0.0) ;
+   zero = CMPLX (0.0, 0.0) ;
+   three= CMPLX (3.0, 0.0) ;
+   foo  = CMPLX (4.0, 1.0) ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      Halt(__FILE__, l, __FUNCTION__, 'failure')
+   END
+END Assert ;
+
+PROCEDURE getOne () : LONGCOMPLEX ;
+BEGIN
+   RETURN one
+END getOne ;
+
+VAR
+   a, b, c, d: LONGCOMPLEX ;
+BEGIN
+   a := i ;
+   b := a*getOne() ;
+   c := i*i ;
+   d := -one ;
+
+   Assert(c=-one, __LINE__) ;
+
+   Assert(c=d, __LINE__) ;
+
+   printf("RE(foo) = %Lg\n", RE(foo)) ;
+   printf("IM(foo) = %Lg\n", IM(foo)) ;
+
+   printf("RE(i*i) = %Lg\n", RE(i*i)) ;
+   printf("IM(i*i) = %Lg\n", IM(i*i)) ;
+
+   printf("RE(-one) = %Lg\n", RE(-one)) ;
+   printf("IM(-one) = %Lg\n", IM(-one)) ;
+
+   Assert(i*i=-one, __LINE__)
+END arith5.
diff --git a/gcc/testsuite/gm2/complex/run/pass/arith6.mod b/gcc/testsuite/gm2/complex/run/pass/arith6.mod
new file mode 100644
index 00000000000..74ce68faf2d
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/run/pass/arith6.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith6 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   z: COMPLEX ;
+BEGIN
+   z := CMPLX (0.0, -1.0) ;
+   IF z*z#-CMPLX(1.0, 0.0)
+   THEN
+      exit(1)
+   END
+END arith6.
diff --git a/gcc/testsuite/gm2/complex/run/pass/arith7.mod b/gcc/testsuite/gm2/complex/run/pass/arith7.mod
new file mode 100644
index 00000000000..c99455a30f5
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/run/pass/arith7.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith7 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE Assert (b: BOOLEAN) ;
+BEGIN
+   INC(c) ;
+   IF NOT b
+   THEN
+      exit(c)
+   END
+END Assert ;
+
+
+CONST
+   one = CMPLX(1.0, 0.0) ;
+
+VAR
+   z: COMPLEX ;
+   c: CARDINAL ;
+BEGIN
+   c := 0 ;
+   z := CMPLX (0.0, -1.0) ;
+   Assert(z*z=-CMPLX(1.0, 0.0)) ;
+   Assert(z*z=-one)
+END arith7.
diff --git a/gcc/testsuite/gm2/complex/run/pass/arith8.mod b/gcc/testsuite/gm2/complex/run/pass/arith8.mod
new file mode 100644
index 00000000000..bf308d1e462
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/run/pass/arith8.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arith8 ;
+
+FROM libc IMPORT exit ;
+
+CONST
+   i    = CMPLX (0.0, 1.0) ;
+   one  = CMPLX (1.0, 0.0) ;
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      exit(1)
+   END
+END Assert ;
+
+BEGIN
+   Assert(i*i=-one, __LINE__)
+END arith8.
diff --git a/gcc/testsuite/gm2/complex/run/pass/complex-run-pass.exp b/gcc/testsuite/gm2/complex/run/pass/complex-run-pass.exp
new file mode 100644
index 00000000000..081061c7148
--- /dev/null
+++ b/gcc/testsuite/gm2/complex/run/pass/complex-run-pass.exp
@@ -0,0 +1,41 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../gm2
+
+gm2_link_lib "m2iso m2pim"
+gm2_init_iso "${srcdir}/gm2/complex/run/pass"
+
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/coroutines/pim/run/pass/coroutines-pim-run-pass.exp b/gcc/testsuite/gm2/coroutines/pim/run/pass/coroutines-pim-run-pass.exp
new file mode 100644
index 00000000000..ec4bb0d7875
--- /dev/null
+++ b/gcc/testsuite/gm2/coroutines/pim/run/pass/coroutines-pim-run-pass.exp
@@ -0,0 +1,39 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2010-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../gm2
+
+gm2_init_cor
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/coroutines/pim/run/pass/testiotransfer.mod b/gcc/testsuite/gm2/coroutines/pim/run/pass/testiotransfer.mod
new file mode 100644
index 00000000000..4829afeb367
--- /dev/null
+++ b/gcc/testsuite/gm2/coroutines/pim/run/pass/testiotransfer.mod
@@ -0,0 +1,88 @@
+(* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library 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
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *)
+
+MODULE testiotransfer ;
+
+
+FROM SYSTEM IMPORT ADDRESS, PROCESS, TRANSFER, NEWPROCESS,
+                   BYTE, LISTEN, IOTRANSFER, ListenLoop ;
+
+FROM COROUTINES IMPORT PROTECTION ;
+FROM RTint IMPORT InitTimeVector, ReArmTimeVector ;
+FROM Storage IMPORT ALLOCATE ;
+FROM libc IMPORT printf, exit ;
+
+CONST
+   Debugging = FALSE ;
+
+
+PROCEDURE Timer ;
+CONST
+   MaxCount = 1000 ;
+VAR
+   v: CARDINAL ;
+   c: CARDINAL ;
+BEGIN
+   printf ('clock starting\n') ;
+   v := InitTimeVector (500, 0, MAX (PROTECTION)) ;
+   c := 0 ;
+   LOOP
+      INC (c) ;
+      IF Debugging
+      THEN
+         printf ('about to call IOTRANSFER: %d\n', c)
+      END ;
+      IOTRANSFER (p2, p1, v) ;
+      IF Debugging
+      THEN
+         printf ('back from IOTRANSFER: %d\n', c)
+      END ;
+      ReArmTimeVector (v, 500, 0) ;
+      IF Debugging
+      THEN
+         printf ('ReArmed timer: %d\n', c)
+      END ;
+      IF c = MaxCount
+      THEN
+         printf ("%d IOTRANSFERs successfully completed\nexit 0\n", c) ;
+         exit (0)
+      END
+   END
+END Timer ;
+
+
+CONST
+   MaxStack = 16 * 1024 * 1024 ;
+
+VAR
+   s1, s2 : ADDRESS ;
+   p1, p2 : PROCESS ;
+BEGIN
+   (* exit (1) ; *)   (* disable test for now.  *)
+   ALLOCATE (s1, MaxStack) ;
+   ALLOCATE (s2, MaxStack) ;
+   NEWPROCESS (Timer, s2, MaxStack, p2) ;
+   printf ('now to TRANSFER...\n') ;
+   TRANSFER (p1, p2) ;
+   printf ('now to LISTEN\n') ;
+   ListenLoop
+(*
+   LOOP
+      LISTEN
+   END
+*)
+END testiotransfer.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/coroutines/pim/run/pass/testtransfer.mod b/gcc/testsuite/gm2/coroutines/pim/run/pass/testtransfer.mod
new file mode 100644
index 00000000000..c5007fa7b52
--- /dev/null
+++ b/gcc/testsuite/gm2/coroutines/pim/run/pass/testtransfer.mod
@@ -0,0 +1,87 @@
+(* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library 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
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *)
+
+MODULE testtransfer ;
+
+FROM SYSTEM IMPORT ADDRESS, PROCESS, NEWPROCESS, TRANSFER ;
+FROM Storage IMPORT ALLOCATE ;
+FROM libc IMPORT printf, exit ;
+
+
+CONST
+   MaxStack  = 16 * 1024 * 1024 ;
+   Debugging = FALSE ;
+   MaxCount  = 1000 ;
+
+
+PROCEDURE p1 ;
+BEGIN
+   LOOP
+      IF Debugging
+      THEN
+         printf('hello world process 1\n')
+      END ;
+      TRANSFER(P1, P2) ;
+      IF Debugging
+      THEN
+         printf('after TRANSFER in process 2\n')
+      END
+   END
+END p1 ;
+
+
+PROCEDURE p2 ;
+BEGIN
+   LOOP
+      IF Debugging
+      THEN
+         printf('hello world process 2  (%d)\n', count)
+      END ;
+      TRANSFER(P2, P1) ;
+      IF Debugging
+      THEN
+         printf('after TRANSFER in process 2\n')
+      END ;
+      INC(count) ;
+      IF count=MaxCount
+      THEN
+         printf('completed %d TRANSFERs successfully\n', count) ;
+         exit(0)
+      END
+   END
+END p2 ;
+
+
+VAR
+   MainP, P1, P2: PROCESS ;
+   S1, S2, S3   : ADDRESS ;
+   count        : CARDINAL ;
+BEGIN
+   printf ("inside testtransfer\n");
+   count := 0 ;
+   ALLOCATE(S1, MaxStack) ;
+   ALLOCATE(S2, MaxStack) ;
+   ALLOCATE(S3, MaxStack) ;
+   printf ("before newprocess 1\n");
+   NEWPROCESS(p1, S1, MaxStack, P1) ;
+   printf ("before newprocess 2\n");
+   NEWPROCESS(p2, S2, MaxStack, P2) ;
+   printf ("before TRANSFER\n");
+   TRANSFER(MainP, P1) ;
+   printf ("program finishing - which should not occur here!\n");
+   exit (1)
+END testtransfer.
diff --git a/gcc/testsuite/gm2/cpp/fail/another.h b/gcc/testsuite/gm2/cpp/fail/another.h
new file mode 100644
index 00000000000..90d0b4d34f2
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/fail/another.h
@@ -0,0 +1,21 @@
+/* Copyright (C) 2005, 2006 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 2, 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 "bother.h"
+
+and another error
+
diff --git a/gcc/testsuite/gm2/cpp/fail/fail1.mod b/gcc/testsuite/gm2/cpp/fail/fail1.mod
new file mode 100644
index 00000000000..b5b40bf66af
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/fail/fail1.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE fail1 ;
+
+#include "another.h"
+
+(* test to see that the compiler handles errors correctly when we have invoked the preprocessor *)
+
+BEGIN
+
+END fail1.
diff --git a/gcc/testsuite/gm2/cpp/longcard2.mod b/gcc/testsuite/gm2/cpp/longcard2.mod
new file mode 100644
index 00000000000..539906974e8
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/longcard2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE longcard2 ;
+
+FROM SYSTEM IMPORT TSIZE ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+
+#define SIZETYPE(X,Y)  WriteString('the size of ') ; WriteString(Y) ; WriteString(' is ') ; WriteCard(TSIZE(X), 0) ; WriteLn
+
+BEGIN
+   SIZETYPE(LONGCARD, "LONGCARD") ;
+   SIZETYPE(LONGINT,  "LONGINT")
+END longcard2.
diff --git a/gcc/testsuite/gm2/cpp/longstrimp.mod b/gcc/testsuite/gm2/cpp/longstrimp.mod
new file mode 100644
index 00000000000..3d8076ef22f
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/longstrimp.mod
@@ -0,0 +1,21 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE longstrimp;
+
+FROM LongStr IMPORT ConvResults;
+
+END longstrimp.
diff --git a/gcc/testsuite/gm2/cpp/pass/arrayhuge.mod b/gcc/testsuite/gm2/cpp/pass/arrayhuge.mod
new file mode 100644
index 00000000000..5837e7eccfb
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/pass/arrayhuge.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+                 2011, 2012, 2013, 2014, 2015, 2016, 2017
+   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 2, 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. *)
+
+MODULE arrayhuge ;
+
+#if defined(__LP64__)
+VAR
+   a: ARRAY [MAX(CARDINAL)-4..MAX(CARDINAL)] OF CHAR ;
+BEGIN
+   a[MAX(CARDINAL)-1] := 'a'
+#else
+BEGIN
+#endif
+END arrayhuge.
diff --git a/gcc/testsuite/gm2/cpp/pass/arrayhuge2.mod b/gcc/testsuite/gm2/cpp/pass/arrayhuge2.mod
new file mode 100644
index 00000000000..27573a29949
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/pass/arrayhuge2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+                 2011, 2012, 2013, 2014, 2015, 2016, 2017
+   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 2, 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. *)
+
+MODULE arrayhuge2 ;
+
+
+VAR
+   a: ARRAY [MAX(CARDINAL)-4..MAX(CARDINAL)] OF CHAR ;
+BEGIN
+   a[MAX(CARDINAL)-1] := 'a'
+
+
+
+END arrayhuge2.
diff --git a/gcc/testsuite/gm2/cpp/pass/cpp-pass.exp b/gcc/testsuite/gm2/cpp/pass/cpp-pass.exp
new file mode 100644
index 00000000000..74f95a40458
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/pass/cpp-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/pim/pass" -fcpp
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/cpp/pass/cpp.mod b/gcc/testsuite/gm2/cpp/pass/cpp.mod
new file mode 100644
index 00000000000..0830380f584
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/pass/cpp.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE cpp ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT exit, printf ;
+
+PROCEDURE InternalError (a, file: ARRAY OF CHAR;
+                         line: CARDINAL) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   r := printf("%s:%d:internal error, %s\n",
+               ADR(file), line, ADR(a)) ;
+   exit(1)
+END InternalError ;
+
+#define ERROR(X)  InternalError(X, __FILE__, __LINE__)
+
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := 1 ;
+   j := 1 ;
+   IF i#j
+   THEN
+      ERROR('trivial assignment failed')
+   END ;
+   i := 2 DIV 2 ;
+   IF i#j
+   THEN
+      ERROR('trivial division failed')
+   END ;
+   ERROR('ignore this error just checking cpp')
+END cpp.
diff --git a/gcc/testsuite/gm2/cpp/pass/cpph.mod b/gcc/testsuite/gm2/cpp/pass/cpph.mod
new file mode 100644
index 00000000000..bd71ff21876
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/pass/cpph.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE cpph ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT exit, printf ;
+
+PROCEDURE InternalError (a, file: ARRAY OF CHAR;
+                         line: CARDINAL) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   r := printf("%s:%d:internal error, %s\n",
+               ADR(file), line, ADR(a)) ;
+   exit(1)
+END InternalError ;
+
+
+
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := 1 ;
+   j := 1 ;
+   IF i#j
+   THEN
+      InternalError('trivial assignment failed', "cpp.mod", 25)
+   END ;
+   i := 2 DIV 2 ;
+   IF i#j
+   THEN
+      InternalError('trivial division failed', "cpp.mod", 30)
+   END ;
+   InternalError('ignore this error just checking cpp', "cpp.mod", 32)
+END cpph.
diff --git a/gcc/testsuite/gm2/cpp/pass/subaddr.mod b/gcc/testsuite/gm2/cpp/pass/subaddr.mod
new file mode 100644
index 00000000000..61befaf31e6
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/pass/subaddr.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE subaddr;
+
+FROM SYSTEM IMPORT ADDRESS;
+
+VAR
+   x, y: ADDRESS;
+#if defined(__x86_64) || (defined(__alpha__) && defined(__arch64__)) || defined(__LP64__)
+   i   : LONGCARD ;
+#else
+   i   : CARDINAL;
+#endif
+BEGIN
+#if defined(__x86_64) || (defined(__alpha__) && defined(__arch64__)) || defined(__LP64__)
+   i := LONGCARD(x - y)
+#else
+   i := CARDINAL(x - y)
+#endif
+END subaddr.
diff --git a/gcc/testsuite/gm2/cpp/pass/testcpp.mod b/gcc/testsuite/gm2/cpp/pass/testcpp.mod
new file mode 100644
index 00000000000..efaccc034e8
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/pass/testcpp.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcpp ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+(*
+   let`s make this as hard as we can..
+   ' foo bar 
+   ` hmm
+   now what happens here /* is this seen or not ? /* and this */
+*)
+
+BEGIN
+   WriteString('this is my important string /* which in enclosed by a */ C style comment') ; WriteLn ;
+   WriteString('"') ;
+   WriteString('/* I wonder how is copes with "?') ; WriteLn
+END testcpp.
diff --git a/gcc/testsuite/gm2/cpp/pass/testcpp2.mod b/gcc/testsuite/gm2/cpp/pass/testcpp2.mod
new file mode 100644
index 00000000000..e145f2f74ee
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/pass/testcpp2.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcpp2 ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StdIO IMPORT Write ;
+
+
+CONST
+#if defined(SMALL)
+   MaxFileLength = 14 ;
+#else
+   MaxFileLength = 1024 ;
+#endif
+
+(*
+   let`s make this as hard as we can..   (* *) (* *)
+   ' foo bar '
+   ` hmm
+   now what happens here /* is this seen or not ? /* and this */
+   //  do we see this? \
+*)
+
+BEGIN
+   WriteString('the constant value after is: ') ;
+   WriteCard(MaxFileLength, 0) ;
+   WriteLn ;
+   Write('\') ;
+   WriteLn
+END testcpp2.
diff --git a/gcc/testsuite/gm2/cpp/setchar2.mod b/gcc/testsuite/gm2/cpp/setchar2.mod
new file mode 100644
index 00000000000..071d9478fac
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/setchar2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar2 ;
+
+TYPE
+   smallchar = SET OF ['A'..'Z'] ;
+
+VAR
+   s : smallchar ;
+   ch: CHAR ;
+BEGIN
+#if 1
+   s := smallchar {} ;
+   s := smallchar {'B', 'D', 'G'} ;
+   s := smallchar {'H', 'I'} ;
+#endif
+   s := smallchar {'A', 'Z'} ;
+#if 1
+   s := s + smallchar {'H', 'I'} ;
+   s := smallchar {'H', 'I'} ;
+#endif
+END setchar2.
diff --git a/gcc/testsuite/gm2/cpp/setchar6.mod b/gcc/testsuite/gm2/cpp/setchar6.mod
new file mode 100644
index 00000000000..294b7d9b96d
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/setchar6.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar6 ;
+
+TYPE
+   smallchar = SET OF ['A'..'Z'] ;
+
+VAR
+   s : smallchar ;
+   ch: CHAR ;
+BEGIN
+#if 1
+   s := {} ;
+   s := smallchar {'B', 'D', 'G'} ;
+   s := smallchar {'H', 'I'} ;
+#endif
+   s := smallchar {'A', 'Z'} ;
+#if 1
+   s := s + smallchar {'H', 'I'} ;
+   s := smallchar {'H', 'I'} ;
+#endif
+END setchar6.
diff --git a/gcc/testsuite/gm2/cse/fail/cse-fail.exp b/gcc/testsuite/gm2/cse/fail/cse-fail.exp
new file mode 100644
index 00000000000..8f56fb15cfa
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/fail/cse-fail.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/cse/fail"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/cse/fail/testcse38.mod b/gcc/testsuite/gm2/cse/fail/testcse38.mod
new file mode 100644
index 00000000000..a6aa15ef03e
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/fail/testcse38.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcse38 ;
+
+VAR
+   a, b: ARRAY [0..10] OF CHAR ;
+   i   : CARDINAL ;
+BEGIN
+   FOR i := 0 TO 10 DO
+      a[i] := 1 ;
+      a[i] := a[i] + VAL(CHAR, 1) ;
+   END
+END testcse38.
diff --git a/gcc/testsuite/gm2/cse/pass/cse-pass.exp b/gcc/testsuite/gm2/cse/pass/cse-pass.exp
new file mode 100644
index 00000000000..522ccf8915b
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/cse-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/cse/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/cse/pass/m2t.c b/gcc/testsuite/gm2/cse/pass/m2t.c
new file mode 100644
index 00000000000..4dfe2e84745
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/m2t.c
@@ -0,0 +1,113 @@
+
+
+typedef char char11[11];
+
+struct STRING {
+  char11  contents;
+  int     high;
+};
+
+extern void StrIO_WriteLn (void);
+static int StrLen (struct STRING a) __attribute__ ((always_inline));
+static void foo (void) __attribute__ ((always_inline));
+
+
+/*
+ *  Function foo (foo)
+ */
+
+static void
+foo (void)
+{
+  struct STRING t;
+  char11 b;
+  void * _T30;
+  void * _T32;
+  void * _T33;
+  void * _T34;
+  void * _T36;
+  unsigned int _T37;
+  unsigned int D_432;
+  unsigned int * indirect_3;
+  char11   * _T33_2;
+  char11 * * indirect_1;
+
+  __builtin_memcpy (&b, "hello", 6);
+  _T30 = &t;
+  _T32 = _T30;
+  _T33 = &b;
+  indirect_1 = (char11 * *) _T32;
+  _T33_2 = (char11 *) _T33;
+  *indirect_1 = _T33_2;
+  _T34 = &t;
+  _T36 = _T34 + 8;
+  indirect_3 = (unsigned int *) _T36;
+  *indirect_3 = 5;
+  D_432 = StrLen (t);
+  _T37 = D_432;
+  if (_T37 != 5)
+    goto L61;
+  else
+    goto L0;
+
+ L0: ;
+  StrIO_WriteLn ();
+
+ L61: ;
+  return;
+
+}
+
+
+/*
+ * Function StrLen
+ */
+
+static int
+StrLen (struct STRING a)
+{
+  void * _T18;
+  void * _T20;
+  char11 * _T21;
+  void * _T23;
+  void * _T24;
+  void * _T25;
+  int _T27;
+  int _T28;
+  char * _T29;
+  unsigned int D_417;
+  void * D_416;
+  void * D_415;
+  long int D_414;
+  char11 * * indirect_0;
+
+  _T18 = &a;
+  _T20 = _T18;
+  indirect_0 = (char11 * *) _T20;
+  _T21 = *indirect_0;
+  _T24 = _T21;
+  _T23 = _T24;
+  _T27 = 4;
+  _T28 = _T27;
+  D_414 = (long int) _T28;
+  D_415 = (void *) D_414;
+  D_416 = (void *)((unsigned long) D_415 + (unsigned long) _T23);
+  _T29 = (char *) D_416;
+  *_T29 = 97;
+  D_417 = 5;
+  return D_417;
+}
+
+
+/*
+ * Function _M2_testcse49_init (_M2_testcse49_init)
+ */
+
+void
+_M2_testcse49_init (void)
+{
+  foo ();
+  return;
+}
+
+
diff --git a/gcc/testsuite/gm2/cse/pass/testb.mod b/gcc/testsuite/gm2/cse/pass/testb.mod
new file mode 100644
index 00000000000..1d934659588
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testb.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testb ;
+
+FROM testbuiltin IMPORT sin ;
+
+BEGIN
+END testb.
diff --git a/gcc/testsuite/gm2/cse/pass/testbuiltin.def b/gcc/testsuite/gm2/cse/pass/testbuiltin.def
new file mode 100644
index 00000000000..fad0e47354f
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testbuiltin.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE testbuiltin ;
+
+PROCEDURE __BUILTIN__ sin (x: REAL) : REAL ;
+
+END testbuiltin.
diff --git a/gcc/testsuite/gm2/cse/pass/testbuiltin.mod b/gcc/testsuite/gm2/cse/pass/testbuiltin.mod
new file mode 100644
index 00000000000..132bf2f089c
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testbuiltin.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE testbuiltin ;
+
+IMPORT cbuiltin ;
+
+PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_sin)) sin (x: REAL) : REAL ;
+BEGIN
+   RETURN cbuiltin.sin (x)
+END sin ;
+
+END testbuiltin.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse.def b/gcc/testsuite/gm2/cse/pass/testcse.def
new file mode 100644
index 00000000000..c72cfb56b3f
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse.def
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+DEFINITION MODULE testcse ;
+
+(*
+    Title      : testcse
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Tue Mar 26 23:52:58 1996
+    Last edit  : Tue Mar 26 23:52:58 1996
+    Description: 
+*)
+
+EXPORT QUALIFIED stop ;
+
+PROCEDURE stop ;
+
+END testcse.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse.mod b/gcc/testsuite/gm2/cse/pass/testcse.mod
new file mode 100644
index 00000000000..474fe857092
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE testcse ;
+
+PROCEDURE stop ;
+BEGIN
+   a := 4
+END stop ;
+
+VAR
+   a, b, c, d: CARDINAL ;
+BEGIN
+   a := b + 1 + b + 1 ;  (* works *)
+   LOOP END
+END testcse.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse10.mod b/gcc/testsuite/gm2/cse/pass/testcse10.mod
new file mode 100644
index 00000000000..cc9a1fbae43
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse10.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse10 ;
+
+
+VAR
+   i: CARDINAL ;
+   j: CARDINAL ;
+   a: POINTER TO CARDINAL ;
+BEGIN
+   i := a^ ;
+   i := i + 1
+END testcse10.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse11.mod b/gcc/testsuite/gm2/cse/pass/testcse11.mod
new file mode 100644
index 00000000000..c28790ae0ea
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse11.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcse11 ;
+
+
+TYPE
+   String = POINTER TO ARRAY [0..20] OF CHAR ;
+
+
+(*
+   foo - 
+*)
+
+PROCEDURE foo (VAR a: String) ;
+BEGIN
+   a^ := 'hello'
+END foo ;
+
+
+VAR
+   a: String ;
+BEGIN
+   foo(a)
+END testcse11.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse12.mod b/gcc/testsuite/gm2/cse/pass/testcse12.mod
new file mode 100644
index 00000000000..eeb4ef5bc74
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse12.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse12 ;
+
+CONST
+   Maxfiles      = 20 ;
+   MaxNameSize   = 80 ;
+
+TYPE
+   File = INTEGER ;
+
+   (* File is the index into files array *)
+
+   FileType = ( none, reading, writing, random );
+   FCB       = RECORD
+                  type     : FileType;
+                  name     : ARRAY [0..MaxNameSize] OF CHAR;
+                  filedes  : INTEGER;		(* file descriptor *)
+               END ;
+   FileArray = ARRAY [-1..Maxfiles] OF FCB;
+
+PROCEDURE GetUnixFileDescriptor (f: File) : INTEGER ;
+BEGIN
+   RETURN( files[f].filedes )
+END GetUnixFileDescriptor ;
+
+
+VAR
+   f    : File ;
+   files: FileArray;
+BEGIN
+   IF GetUnixFileDescriptor(f)=1
+   THEN
+   END
+END testcse12.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse13.mod b/gcc/testsuite/gm2/cse/pass/testcse13.mod
new file mode 100644
index 00000000000..f9cb417737b
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse13.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse13 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   p, q: POINTER TO CHAR ;
+
+PROCEDURE foo ;
+VAR
+   a, b, c: CHAR ;
+BEGIN
+   IF a=0C
+   THEN
+   END ;
+   q^ := 1C ;
+   p := ADR(a) ;
+(*   a := b ; *)
+   p^ := c ;
+(*
+
+   p^ := b ;
+   q := ADR(a) ;
+   p^ := c ;
+*)
+   LOOP END
+END foo ;
+
+BEGIN
+   foo ;
+   p^ := 3C
+END testcse13.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse14.mod b/gcc/testsuite/gm2/cse/pass/testcse14.mod
new file mode 100644
index 00000000000..797a7f775ab
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse14.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse14 ;
+
+
+PROCEDURE Power10 (r: REAL; power: CARDINAL) : REAL;
+VAR 
+   i: CARDINAL;
+BEGIN
+   i := 0 ;
+   WHILE i<power DO
+      r := r * 10.0 ;
+      INC(i)
+   END ;
+   RETURN( r )
+END Power10 ;
+
+
+BEGIN
+   IF Power10(1.0, 1)=2.0
+   THEN
+   END
+END testcse14.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse15.mod b/gcc/testsuite/gm2/cse/pass/testcse15.mod
new file mode 100644
index 00000000000..d4e430f9672
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse15.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse15 ;
+
+TYPE
+   Response = (done, notdone) ;
+   IO = (read, write) ;
+
+   File = RECORD
+             res   : Response ;
+             Opened: BOOLEAN ;
+             io    : IO ;
+          END ;
+
+PROCEDURE Close (VAR f: File) ;
+BEGIN
+   WITH f DO
+      IF io=read
+      THEN
+         IF Opened
+         THEN
+            res := done
+         ELSE
+            res := notdone
+         END
+      END
+   END
+END Close ;
+
+
+VAR
+   f: File ;
+BEGIN
+   Close(f)
+END testcse15.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse16.mod b/gcc/testsuite/gm2/cse/pass/testcse16.mod
new file mode 100644
index 00000000000..9e867894a65
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse16.mod
@@ -0,0 +1,80 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse16 ;
+
+CONST
+   MaxScopes  =  20 ; (* Maximum number of scopes at any one time.           *)
+   NulSym     =   0 ;
+
+TYPE
+   CallFrame = RECORD
+                  Main  : CARDINAL ;  (* Main scope for insertions        *)
+                  Search: CARDINAL ;  (* Search scope for symbol searches *)
+                  Start : CARDINAL ;  (* ScopePtr value before StartScope *)
+                                      (* was called.                      *)
+               END ;
+
+VAR
+   ScopeCallFrame: ARRAY [1..MaxScopes] OF CallFrame ;
+   ScopePtr      : CARDINAL ;
+
+
+PROCEDURE foo (Sym: CARDINAL) ;
+BEGIN
+   INC(ScopePtr) ;
+   WITH ScopeCallFrame[ScopePtr] DO
+      Main := ScopeCallFrame[ScopePtr-1].Main ;
+(*
+      Start := ScopeCallFrame[ScopePtr-1].Start ;
+      Search := Sym
+*)
+   END
+END foo ;
+
+
+PROCEDURE IsAlreadyDeclaredSym (Name: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH ScopeCallFrame[ScopePtr] DO
+      RETURN( GetLocalSym(ScopeCallFrame[ScopePtr].Main, Name)#NulSym )
+   END
+END IsAlreadyDeclaredSym ;
+
+
+PROCEDURE GetLocalSym (Sym: CARDINAL; Name: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( 0 )
+END GetLocalSym ;
+
+
+BEGIN
+   ScopePtr := 1 ;
+   WITH ScopeCallFrame[ScopePtr] DO
+      Main := 1 ;
+      Start := 1 ;
+      Search := 1
+   END ;
+   foo(1000) ;
+   IF ScopeCallFrame[ScopePtr].Main#ScopeCallFrame[ScopePtr-1].Main
+   THEN
+      HALT
+   END ;
+(*
+   IF IsAlreadyDeclaredSym(1234)
+   THEN
+   END
+*)
+END testcse16.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse17.mod b/gcc/testsuite/gm2/cse/pass/testcse17.mod
new file mode 100644
index 00000000000..0526e3052e0
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse17.mod
@@ -0,0 +1,55 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse17 ;
+
+
+TYPE
+   r = RECORD
+          a, b, c: CARDINAL ;
+          array  : ARRAY [0..10] OF CARDINAL ;
+       END ;
+
+
+PROCEDURE testcase (i: CARDINAL) : CARDINAL ;
+BEGIN
+   WITH t[i] DO
+      CASE i OF
+
+      1:  a := i ; b := i ; c := i |
+      2:  a := i ; b := i ; c := i |
+      3:  a := i ; b := i ; c := i |
+      4:  a := i ; b := i ; c := i |
+      5:  a := i ; b := i ; c := i
+
+      END ;
+      RETURN( t[i].a )
+   END
+END testcase ;
+
+
+
+VAR
+   t: ARRAY [1..10] OF r ;
+   i: CARDINAL ;
+BEGIN
+   FOR i := 1 TO 5 DO
+      IF testcase(i)#i
+      THEN
+         HALT
+      END
+   END
+END testcse17.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse18.mod b/gcc/testsuite/gm2/cse/pass/testcse18.mod
new file mode 100644
index 00000000000..8ddcf8691b6
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse18.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse18 ;
+
+CONST
+   NulSym = 0 ;
+
+PROCEDURE GetScopeSym (n: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( 1 )
+END GetScopeSym ;
+
+
+PROCEDURE GetSym (Name: CARDINAL) : CARDINAL ;
+VAR
+   Sym        : CARDINAL ;
+   OldScopePtr: CARDINAL ;
+BEGIN
+   Sym := GetScopeSym(Name) ;
+   IF Sym=NulSym
+   THEN
+      (* Check default base types for symbol *)
+      OldScopePtr := ScopePtr ;  (* Save ScopePtr *)
+      ScopePtr := BaseScopePtr ; (* Alter ScopePtr to point to top of BaseModule *)
+      Sym := GetScopeSym(Name) ; (* Search BaseModule for Name *)
+      ScopePtr := OldScopePtr    (* Restored ScopePtr *)
+   END ;
+   RETURN( Sym )
+END GetSym ;
+
+
+VAR
+   sym,
+   BaseScopePtr,
+   OldScopePtr,
+   ScopePtr,
+   Sym         : CARDINAL ;
+BEGIN
+   sym := GetSym(123)
+END testcse18.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse19.mod b/gcc/testsuite/gm2/cse/pass/testcse19.mod
new file mode 100644
index 00000000000..1cbbeef91fb
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse19.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse19 ;
+
+PROCEDURE foo ; BEGIN END foo ;
+
+VAR
+   a, b, c: CARDINAL ;
+BEGIN
+   a := b ;
+   b := c ;
+   foo ;
+   c := a + b
+END testcse19.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse2.mod b/gcc/testsuite/gm2/cse/pass/testcse2.mod
new file mode 100644
index 00000000000..5fb6c04e5f3
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcse2 ;
+
+
+VAR
+   i, j: CARDINAL ;
+   a: ARRAY [5..10] OF CARDINAL ;
+BEGIN
+   a[i] := 100 ; (* a[j] * a[j] ; *)
+   LOOP END
+END testcse2.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse20.mod b/gcc/testsuite/gm2/cse/pass/testcse20.mod
new file mode 100644
index 00000000000..43c62b945b1
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse20.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse20 ;
+
+
+(*
+   Swap - 
+*)
+
+PROCEDURE Swap ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := a ;
+   a := b ;
+   b := t
+END Swap ;
+
+
+VAR
+   a, b, t: CARDINAL ;
+BEGIN
+   a := 0 ;
+   b := 1 ;
+   t := 2 ;
+   Swap
+END testcse20.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse21.mod b/gcc/testsuite/gm2/cse/pass/testcse21.mod
new file mode 100644
index 00000000000..5810067bcb7
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse21.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse21 ;
+
+
+(*
+   Swap - 
+*)
+
+PROCEDURE Swap ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := a ;
+   a := b*a ;
+   b := t*a
+END Swap ;
+
+
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   a := 1 ;
+   b := 2 ;
+   Swap
+END testcse21.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse22.mod b/gcc/testsuite/gm2/cse/pass/testcse22.mod
new file mode 100644
index 00000000000..cc59ad7aa22
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse22.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse22 ;
+
+
+PROCEDURE func () : CARDINAL ;
+BEGIN
+   RETURN( global )
+END func ;
+
+
+VAR
+   global: CARDINAL ;
+BEGIN
+   global := func() ;
+   global := 1 ;
+   global := 2 ;
+END testcse22.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse23.mod b/gcc/testsuite/gm2/cse/pass/testcse23.mod
new file mode 100644
index 00000000000..7fc721bb95a
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse23.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse23 ;
+
+
+VAR
+   a, i: CARDINAL ;
+BEGIN
+   FOR i := 1 TO 5 DO
+      a := a * i
+   END
+END testcse23.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse24.mod b/gcc/testsuite/gm2/cse/pass/testcse24.mod
new file mode 100644
index 00000000000..b5eac399bec
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse24.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse24 ;
+
+TYPE
+   foo = RECORD
+            this: bar ;
+         END ;
+
+   bar = RECORD
+            that: REAL
+         END ;
+
+VAR
+   r,
+   clock : REAL ;
+   i     : CARDINAL ;
+   a     : ARRAY [1..5] OF foo ;
+   t     : POINTER TO foo ;
+BEGIN
+   clock := a[i].this.that ;
+   r := t^.this.that * clock ;
+   IF clock=1.0
+   THEN
+      clock := 2.0
+   END
+END testcse24.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse25.mod b/gcc/testsuite/gm2/cse/pass/testcse25.mod
new file mode 100644
index 00000000000..653534a94ae
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse25.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse25 ;
+
+
+
+VAR
+   a, b, c, d, e: CARDINAL ;
+BEGIN
+   a := b + c ;
+   b := a - d ;
+   c := b + c ;
+   d := a - b ;
+   IF a=e
+   THEN
+      a := 100 ;
+      b := 100 ;
+      c := 100 ;
+      d := 100 
+   END
+END testcse25.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse26.mod b/gcc/testsuite/gm2/cse/pass/testcse26.mod
new file mode 100644
index 00000000000..16636d3a3ab
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse26.mod
@@ -0,0 +1,73 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse26 ;
+
+FROM NumberIO IMPORT StrToBin, BinToStr ;
+
+CONST
+   MaxBitsetSize = 32 ;
+   nul           =  0C ;
+
+
+PROCEDURE PopInt () : INTEGER ;
+BEGIN
+   RETURN( 1 )
+END PopInt ;
+
+
+PROCEDURE PushInt (i: INTEGER) ;
+BEGIN
+END PushInt ;
+
+PROCEDURE PushCard (i: CARDINAL) ;
+BEGIN
+END PushCard ;
+
+PROCEDURE PopCard () : CARDINAL ;
+BEGIN
+   RETURN( i )
+END PopCard ;
+
+PROCEDURE WriteError (a: ARRAY OF CHAR) ;
+BEGIN
+END WriteError ;
+
+
+VAR
+   i: CARDINAL ;
+
+PROCEDURE Bit ;
+VAR
+   c       : CARDINAL ;
+   Op1, Op2: CARDINAL ;
+BEGIN
+   (* in correct bitset range *)
+   c := 0 ;
+   FOR i := Op1 TO Op2 DO
+      PushCard(i) ;
+      Bit ;
+      INC(c, PopCard())
+   END ;
+   INC(c) ;
+   Op1 := c ;
+   i := i + c ;
+END Bit ;
+
+
+BEGIN
+   Bit
+END testcse26.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse27.mod b/gcc/testsuite/gm2/cse/pass/testcse27.mod
new file mode 100644
index 00000000000..9bd1764bea8
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse27.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse27 ;
+
+
+PROCEDURE FindNextLineInBuffer (VAR OffsetIntoBuffer: CARDINAL;
+                                VAR OffsetIntoSource: CARDINAL) ;
+BEGIN
+END FindNextLineInBuffer ;
+
+
+PROCEDURE StartOfIndexInBuffer () : CARDINAL ;
+BEGIN
+   RETURN( 1 )
+END StartOfIndexInBuffer ;
+
+
+PROCEDURE WriteBuffer ;
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   a := StartOfIndexInBuffer() ;
+   b := BufferOffset ;
+   FindNextLineInBuffer(a, b)
+END WriteBuffer ;
+
+
+VAR
+   BufferOffset: CARDINAL ;
+BEGIN
+   WriteBuffer
+END testcse27.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse28.mod b/gcc/testsuite/gm2/cse/pass/testcse28.mod
new file mode 100644
index 00000000000..21ea9b61ddf
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse28.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse28 ;
+
+
+FROM StrLib IMPORT StrLen ;
+
+
+(*
+   foo - 
+*)
+
+PROCEDURE foo () : CARDINAL ;
+VAR
+   n, r: CARDINAL ;
+BEGIN
+   n := 0 ;
+   r := StrLen('abcd') ;
+   INC(n) ;
+   RETURN( n )
+END foo ;
+
+
+
+BEGIN
+   IF foo()=1
+   THEN
+   END
+END testcse28.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse29.mod b/gcc/testsuite/gm2/cse/pass/testcse29.mod
new file mode 100644
index 00000000000..fa2d4f9ee70
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse29.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse29 ;
+
+CONST
+   MaxNoOfRooms = 10 ;
+
+VAR
+   NoOfBoxes,
+   NoOfCorridors: CARDINAL ;
+   NoOfRooms, i : CARDINAL ;
+   Rooms        : ARRAY [0..10] OF RECORD
+                                      RoomNo: CARDINAL ;
+                                   END ;
+
+PROCEDURE foo ;
+BEGIN
+   NoOfRooms := NoOfBoxes ;
+   NoOfCorridors := NoOfCorridorBoxes ;
+   (* Now set all other rooms to void *)
+   i := NoOfRooms+1 ;
+   WHILE i<=MaxNoOfRooms DO
+      Rooms[i].RoomNo := 0 ;
+      INC(i)
+   END
+END foo ;
+
+
+VAR
+   NoOfCorridorBoxes: CARDINAL ;
+BEGIN
+   NoOfCorridorBoxes := 10 ;
+   foo ;
+   NoOfRooms := NoOfBoxes ;
+   NoOfCorridors := NoOfCorridorBoxes ;
+END testcse29.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse3.mod b/gcc/testsuite/gm2/cse/pass/testcse3.mod
new file mode 100644
index 00000000000..600d83a760f
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse3.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse3 ;
+
+
+PROCEDURE foo (VAR a: ARRAY OF CHAR) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := i + 1 ;
+   a[i] := 0C
+END foo ;
+
+
+VAR
+   b: ARRAY [0..4] OF CHAR ;
+BEGIN
+   foo(b)
+END testcse3.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse31.mod b/gcc/testsuite/gm2/cse/pass/testcse31.mod
new file mode 100644
index 00000000000..bdf6cd02914
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse31.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse31 ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   DESCRIPTOR= POINTER TO Descriptor ;    (* handle onto a process         *)
+   Descriptor= RECORD
+                  Volatiles  : ADDRESS ;  (* process volatile environment  *)
+               END ;
+
+PROCEDURE TRANSFER (p1, p2: ADDRESS) ;
+BEGIN
+END TRANSFER ;
+
+PROCEDURE Reschedule ; (* (VAR From, Highest: DESCRIPTOR) ; *)
+VAR From, Highest: DESCRIPTOR ;
+BEGIN
+   Highest := NIL ;
+   IF From#CurrentProcess
+   THEN
+      From := CurrentProcess ;
+      CurrentProcess := Highest ;
+      TRANSFER(From^.Volatiles, Highest^.Volatiles)
+   END
+END Reschedule ;
+
+
+VAR
+   CurrentProcess: DESCRIPTOR ;
+BEGIN
+   Reschedule ; (* (CurrentProcess, CurrentProcess) ; *)
+   CurrentProcess := NIL
+END testcse31.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse32.mod b/gcc/testsuite/gm2/cse/pass/testcse32.mod
new file mode 100644
index 00000000000..ff06987c1e1
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse32.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse32 ;
+
+FROM MathLib0 IMPORT pi, sin, cos, tan ;
+
+VAR
+   t, u, v, p: REAL ;
+BEGIN
+   t := sin(pi/2.0) / cos(pi/2.0) ;
+   u := tan(pi/2.0) / cos(pi/2.0)
+END testcse32.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse33.mod b/gcc/testsuite/gm2/cse/pass/testcse33.mod
new file mode 100644
index 00000000000..8f0835c329a
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse33.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse33 ;
+
+
+CONST
+   MaxBoxes =  500 ;
+   MaxX     =  120 ;  (* 38 ; *)
+   MaxY     =   80 ;  (* 24 ; *)
+
+TYPE
+   Box    = RECORD
+               x1, y1,
+               x2, y2   : CARDINAL ;
+               RoomOfBox: CARDINAL ;
+            END ;
+
+VAR
+   Boxes    : ARRAY [0..MaxBoxes] OF Box ;
+   NoOfBoxes: CARDINAL ;
+
+
+PROCEDURE Init ;
+BEGIN
+   NoOfBoxes := 0 ;
+   (* Initialize box 0 the edge of the map *)
+   WITH Boxes[0] DO
+      x1 := 1 ;
+      x2 := MaxX ;
+      y1 := 1 ;
+      y2 := MaxY
+   END
+END Init ;
+
+BEGIN
+   Init
+END testcse33.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse34.mod b/gcc/testsuite/gm2/cse/pass/testcse34.mod
new file mode 100644
index 00000000000..f97b3bad565
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse34.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse34 ;
+
+FROM MathLib0 IMPORT pi, sin, cos, tan ;
+
+VAR
+   t, u, v, p: REAL ;
+BEGIN
+   t := sin(2.0) / cos(2.0) * 2.0 ;
+   u := tan(2.0) / cos(2.0)
+END testcse34.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse35.mod b/gcc/testsuite/gm2/cse/pass/testcse35.mod
new file mode 100644
index 00000000000..bcb46a9c03d
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse35.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse35 ;
+
+FROM SYSTEM IMPORT BYTE ;
+
+VAR
+   c   : CARDINAL ;
+   b, d: BYTE ;
+
+BEGIN
+   b := BYTE(0) ;
+   c := 0 ;
+   d := VAL(BYTE, 0)
+END testcse35.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse36.mod b/gcc/testsuite/gm2/cse/pass/testcse36.mod
new file mode 100644
index 00000000000..398146f78a0
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse36.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse36 ;
+
+
+VAR
+   c, b: CARDINAL ;
+BEGIN
+   c := (1 + b) + (b + 1)
+END testcse36.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse37.mod b/gcc/testsuite/gm2/cse/pass/testcse37.mod
new file mode 100644
index 00000000000..1a789077530
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse37.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse37 ;
+
+PROCEDURE Read (VAR x: REAL) ;
+VAR
+   t: REAL ;
+BEGIN
+   t := 1.0 ;
+   x := t ;
+   x := 2.0
+END Read ;
+
+
+VAR
+   y: REAL ;
+BEGIN
+   Read(y)
+END testcse37.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse39.mod b/gcc/testsuite/gm2/cse/pass/testcse39.mod
new file mode 100644
index 00000000000..08b33b886b2
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse39.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse39 ;
+
+
+TYPE
+   Ptr    = POINTER TO String ;
+   String = ARRAY [0..10] OF CHAR ;
+
+
+PROCEDURE Read (VAR a, b: Ptr) ;
+BEGIN
+   a^[0] := b^[0]
+END Read ;
+
+
+VAR
+   p, q: POINTER TO CHAR ;
+   c, d: CHAR ;
+   a, b: Ptr ;
+   i   : CARDINAL ;
+BEGIN
+   a := b ;
+   b^[i] := b^[3] ;
+   c := d ;
+   Read(a, b) ;
+END testcse39.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse4.c b/gcc/testsuite/gm2/cse/pass/testcse4.c
new file mode 100644
index 00000000000..308a9602e35
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse4.c
@@ -0,0 +1,48 @@
+void *alloca (unsigned int);
+void memcpy(void *, void *, unsigned int);
+void write (int, void *, int);
+
+#define nul  (char)0
+struct m2string {
+  char *contents;
+  int HIGH;
+};
+
+struct m2string at_start = { "hello", 5 };
+
+static int StrLen (struct m2string a)
+{
+  int high, len;
+  char *copy;  
+  char **T25;
+
+  copy = alloca(a.HIGH+1);
+  memcpy(a.contents, copy, a.HIGH+1);
+  a.contents = copy;
+#if 0
+  len = 0;
+  high = a.HIGH;
+#endif
+  
+  T25 = (char **)&a;
+#if 0
+  /* (a.contents[len] != nul) */
+  while ((len <= high) && ((*T24)[len] != nul))
+    len++;
+
+  return len;
+#endif
+  (*T25)[0] = 'a';
+  return 0;
+}
+
+void init (void)
+{
+  struct m2string b;
+
+  b.contents = "hello";
+  b.HIGH = 4;
+  if (StrLen(b) == 5)
+    write(1, "works\n", 6);
+}
+
diff --git a/gcc/testsuite/gm2/cse/pass/testcse4.mod b/gcc/testsuite/gm2/cse/pass/testcse4.mod
new file mode 100644
index 00000000000..3074637cb3f
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse4.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcse4 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+CONST
+   nul = 0C ;
+
+PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   High,
+   Len : CARDINAL ;
+BEGIN
+   Len := 0 ;
+   High := HIGH( a ) ;
+   WHILE (Len<=High) AND (a[Len]#nul) DO
+      INC( Len ) ;
+   END ;
+   RETURN( Len )
+END StrLen ;
+
+BEGIN
+   IF StrLen('works')=5
+   THEN
+      WriteString('works')
+   END ;
+   WriteLn
+END testcse4.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse40.mod b/gcc/testsuite/gm2/cse/pass/testcse40.mod
new file mode 100644
index 00000000000..d75ed562980
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse40.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse40 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ; WriteLn
+END testcse40.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse41.mod b/gcc/testsuite/gm2/cse/pass/testcse41.mod
new file mode 100644
index 00000000000..8f4dc11a62a
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse41.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse41 ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+(*
+   tests function value.
+*)
+
+PROCEDURE myfunc () : ADDRESS ;
+BEGIN
+   RETURN( NIL )
+END myfunc ;
+
+VAR
+   v: POINTER TO RECORD
+                    a, b: CARDINAL ;
+                 END ;
+   z, x: ADDRESS ;
+BEGIN
+   v := myfunc() ;
+   x := v ;
+   WITH v^ DO
+      a := 2
+   END ;
+   z := v
+END testcse41.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse42.mod b/gcc/testsuite/gm2/cse/pass/testcse42.mod
new file mode 100644
index 00000000000..233da8c2db2
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse42.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse42 ;
+
+
+VAR
+   a: ARRAY [2..8] OF CARDINAL ;
+   c: CARDINAL ;
+BEGIN
+   c := 8 ;
+   a[4] := c
+END testcse42.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse43.mod b/gcc/testsuite/gm2/cse/pass/testcse43.mod
new file mode 100644
index 00000000000..34219a86774
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse43.mod
@@ -0,0 +1,95 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcse43 ;
+
+
+CONST
+   MaxSyms  = 100 ;
+   MaxAlias = 100 ;
+
+TYPE
+   AliasList = POINTER TO AList ;
+
+   (*
+      AList has two main components: List and Syms.
+
+            List is contains the alias through its pairing of indices in
+                 the To and From fields.
+
+            Syms contains the actual symbols that the List indices reference
+                 together with their mode.
+   *)
+
+   SymIndex  = [0..MaxSyms] ;
+
+   Alias     = RECORD
+                  From, To: SymIndex ;    (* index into syms, showing the alias        *)
+               END ;
+
+   Symbol    = RECORD
+                  addr    : CARDINAL ;
+                  Id      : CARDINAL ;    (* symbol value from SymbolTable.mod         *)
+                  Dirty   : BOOLEAN ;     (* have we written to this symbol yet?       *)
+                  Count   : CARDINAL ;    (* number of times used (read and write)     *)
+               END ;
+
+   AList     = RECORD
+                  List    : ARRAY [1..MaxAlias] OF Alias ;
+                  AliasPtr: CARDINAL ;    (* points to the top of the List array       *)
+                  Syms    : ARRAY [1..MaxSyms] OF Symbol ;
+                  SymPtr  : SymIndex ;    (* points to the top of the Syms array       *)
+                  Next    : AliasList ;   (* used to store old lists on the free queue *)
+               END ;
+
+
+PROCEDURE New () : AliasList ;
+BEGIN
+   RETURN( NIL )
+END New ;
+
+
+PROCEDURE DuplicateAlias (a: AliasList) : AliasList ;
+VAR
+   b: AliasList ;
+   i: CARDINAL ;
+   j: CARDINAL ;
+BEGIN
+   b := New() ;
+   (* it may well be faster simply to perform b^ := a^ ?? *)
+   i := a^.AliasPtr ;
+   b^.AliasPtr := i ;
+   WHILE i>0 DO
+      b^.List[i] := a^.List[i] ;
+      DEC(i)
+   END ;
+   j := a^.SymPtr ;
+   b^.SymPtr := j ;
+   WHILE j>0 DO
+      b^.Syms[j] := a^.Syms[j] ;
+      DEC(j)
+   END ;
+   RETURN( b )
+END DuplicateAlias ;
+
+
+VAR
+   a, b: AliasList ;
+   j, i: CARDINAL ;
+BEGIN
+   b := DuplicateAlias(a)
+END testcse43.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse44.mod b/gcc/testsuite/gm2/cse/pass/testcse44.mod
new file mode 100644
index 00000000000..6a73d0fef43
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse44.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse44 ;
+
+
+PROCEDURE foo () : BOOLEAN ;
+BEGIN
+   RETURN( TRUE )
+END foo ;
+
+
+VAR
+   a, b, c, d: CARDINAL ;
+BEGIN
+   a := 1 + b + 1 ;
+   c := a + b ;
+   d := a ;
+   WHILE foo() DO
+      INC(a, b)
+   END
+END testcse44.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse45.mod b/gcc/testsuite/gm2/cse/pass/testcse45.mod
new file mode 100644
index 00000000000..6d5fdbd57e5
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse45.mod
@@ -0,0 +1,62 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse45 ;
+
+
+TYPE
+
+   Where = RECORD
+              Declared,
+              FirstUsed: CARDINAL ;
+           END ;
+
+   SymUndefined = RECORD
+                     Name      : CARDINAL ;   (* Index into name array, name *)
+                                              (* of record.                  *)
+                     At        : Where ;      (* Where was sym declared/used *)
+                  END ;
+
+
+VAR
+   myvar: SymUndefined ;
+
+
+PROCEDURE InitWhereDeclared (VAR at: Where) ;
+BEGIN
+   WITH at DO
+      Declared :=  1 ;
+      FirstUsed := 2
+   END
+END InitWhereDeclared ;
+
+
+(*
+   MakeUnbounded - makes an unbounded array Symbol.
+                   No name is required.
+*)
+
+PROCEDURE MakeUnbounded ;
+BEGIN
+   WITH myvar DO
+      InitWhereDeclared(At) (* Declared here               *)
+   END
+END MakeUnbounded ;
+
+
+BEGIN
+   MakeUnbounded
+END testcse45.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse46.mod b/gcc/testsuite/gm2/cse/pass/testcse46.mod
new file mode 100644
index 00000000000..05b73397c9b
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse46.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse46 ;
+
+
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   j := 10 ;
+   i := j+i ;
+   i := 10
+END testcse46.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse47.mod b/gcc/testsuite/gm2/cse/pass/testcse47.mod
new file mode 100644
index 00000000000..d158b0816d9
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse47.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE testcse47 ;
+
+FROM StrIO IMPORT WriteString ;
+
+BEGIN
+   WriteString('hello world\n')
+END testcse47.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse48.mod b/gcc/testsuite/gm2/cse/pass/testcse48.mod
new file mode 100644
index 00000000000..452785fcf39
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse48.mod
@@ -0,0 +1,52 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE testcse48 ;
+
+FROM StrIO IMPORT WriteLn ;
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   string = ARRAY [0..10] OF CHAR ;
+   STRING = RECORD
+               c: POINTER TO string ;
+               h: CARDINAL ;
+            END ;
+
+PROCEDURE StrLen (a: STRING) : CARDINAL ;
+VAR
+   b: string ;
+BEGIN
+   b := a.c^ ;
+   a.c := ADR(b) ;
+   a.c^[4] := 'a' ;
+   RETURN 5
+END StrLen ;
+
+VAR
+   l: CARDINAL ;
+   t: STRING ;
+   b: string ;
+BEGIN
+   b := 'hello' ;
+   t.c := ADR(b) ;
+   t.h := 5 ;
+   IF StrLen(t)=5
+   THEN
+      WriteLn
+   END
+END testcse48.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse49.mod b/gcc/testsuite/gm2/cse/pass/testcse49.mod
new file mode 100644
index 00000000000..6fa21fa4858
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse49.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE testcse49 ;
+
+FROM StrIO IMPORT WriteLn ;
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+
+TYPE
+   string = ARRAY [0..10] OF CHAR ;
+   STRING = RECORD
+               c: POINTER TO string ;
+               h: CARDINAL ;
+            END ;
+
+PROCEDURE StrLen (a: STRING) : CARDINAL ;
+BEGIN
+   a.c^[4] := 'a' ;
+   RETURN 5
+END StrLen ;
+
+
+PROCEDURE foo ;
+VAR
+   t: STRING ;
+   b: string ;
+BEGIN
+   b := 'hello' ;
+   t.c := ADR(b) ;
+   t.h := 5 ;
+   IF StrLen(t)=5
+   THEN
+      WriteLn
+   END
+END foo ;
+
+BEGIN
+   foo
+END testcse49.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse5.c b/gcc/testsuite/gm2/cse/pass/testcse5.c
new file mode 100644
index 00000000000..afea91bf336
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse5.c
@@ -0,0 +1,56 @@
+#include <stdlib.h>
+#include <string.h>
+
+#define nul  (char)0
+struct m2string {
+  char *contents;
+  int HIGH;
+};
+
+typedef struct m2string STRING;
+static inline int inline StrLen (STRING a) __attribute__ ((always_inline));
+
+static STRING b;
+
+void init (void)
+{
+  b.contents = "hello";
+  b.HIGH = 4;
+
+  if (StrLen(b) == 5)
+    write(1, "works\n", 6);
+}
+
+static inline int StrLen (STRING a)
+{
+  int **T20;
+  char *T24;
+#if 0
+  char *copy;  
+  int high, len;
+
+  copy = alloca(a.HIGH+1);
+  memcpy(a.contents, copy, a.HIGH+1);
+  a.contents = copy;
+
+  len = 0;
+  high = a.HIGH;
+  T25 = (char **)&a;
+  **T25 = 'a';
+#endif
+
+#if 0
+  /* (a.contents[len] != nul) */
+  while ((len <= high) && ((*T24)[len] != nul))
+    len++;
+
+  return len;
+#endif
+  (*(char **)&a)[0] = 'a';
+
+  T20 = &a;
+  T24 = *T20;
+  *T24 = 'a';
+  return 5;
+}
+
diff --git a/gcc/testsuite/gm2/cse/pass/testcse5.mod b/gcc/testsuite/gm2/cse/pass/testcse5.mod
new file mode 100644
index 00000000000..5457fdbf2cf
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse5.mod
@@ -0,0 +1,94 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcse5 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrLen, StrCopy ;
+
+CONST
+   nul = 0C ;
+
+
+PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   i,
+   Higha,
+   Highb: CARDINAL ;
+   Equal: BOOLEAN ;
+BEGIN
+   Higha := StrLen( a ) ;
+   Highb := StrLen( b ) ;
+   IF Higha=Highb
+   THEN
+      Equal := TRUE ;
+      i := 0 ;
+      WHILE Equal AND (i<Higha) DO
+         Equal := (a[i]=b[i]) ;
+         INC( i )
+      END
+   ELSE
+      Equal := FALSE
+   END ;
+   RETURN( Equal )
+END StrEqual ;
+
+(*
+PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   High,
+   Len : CARDINAL ;
+BEGIN
+   Len := 0 ;
+   High := HIGH( a ) ;
+   WHILE (Len<=High) AND (a[Len]#nul) DO
+      INC( Len ) ;
+   END ;
+   RETURN( Len )
+END StrLen ;
+
+
+PROCEDURE StrCopy (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+VAR
+   Higha,
+   Highb,
+   n    : CARDINAL ;
+BEGIN
+   n := 0 ;
+   Higha := StrLen( a ) ;
+   Highb := HIGH( b ) ;
+   WHILE (n<Higha) AND (n<=Highb) DO
+      b[n] := a[n] ;
+      INC( n )
+   END ;
+   IF n<=Highb
+   THEN
+      b[n] := nul
+   END
+END StrCopy ;
+*)
+
+VAR
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   StrCopy('hello', a) ;
+   IF StrEqual(a, 'hello')
+   THEN
+      WriteString('works')
+   END ;
+   WriteLn
+END testcse5.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse50.def b/gcc/testsuite/gm2/cse/pass/testcse50.def
new file mode 100644
index 00000000000..101353abf2e
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse50.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+DEFINITION MODULE testcse50 ;
+
+PROCEDURE GetEnvironment (Env: ARRAY OF CHAR; VAR a: ARRAY OF CHAR) : BOOLEAN ;
+
+END testcse50.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse50.mod b/gcc/testsuite/gm2/cse/pass/testcse50.mod
new file mode 100644
index 00000000000..feb805a98da
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse50.mod
@@ -0,0 +1,37 @@
+IMPLEMENTATION MODULE testcse50 ;
+
+
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT getenv ;
+FROM ASCII IMPORT nul ;
+FROM StrLib IMPORT StrCopy ;
+
+
+PROCEDURE GetEnvironment (Env: ARRAY OF CHAR; VAR a: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   High,
+   i   : CARDINAL ;
+   Addr: POINTER TO CHAR ;
+BEGIN
+   i := 0 ;
+   High := HIGH(a) ;
+   Addr := getenv(ADR(Env)) ;
+   WHILE (i<High) AND (Addr#NIL) AND (Addr^#nul) DO
+      a[i] := Addr^ ;
+      INC(Addr) ;
+      INC(i)
+   END ;
+   IF i<High
+   THEN
+      a[i] := nul
+   END ;
+   RETURN( Addr#NIL )
+END GetEnvironment ;
+
+VAR
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF GetEnvironment('foobar', a)
+   THEN
+   END
+END testcse50.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse51.mod b/gcc/testsuite/gm2/cse/pass/testcse51.mod
new file mode 100644
index 00000000000..d9a1f85c7b2
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse51.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library 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
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA *)
+
+MODULE testcse51 ;
+
+FROM NumberIO IMPORT WriteCard ;
+
+VAR
+   MapDist: ARRAY [0..10], [0..10] OF CARDINAL ;
+
+BEGIN
+   MapDist[2,2] := 2 ;
+   WriteCard(MapDist[0,0], 4)
+END testcse51.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse52.def b/gcc/testsuite/gm2/cse/pass/testcse52.def
new file mode 100644
index 00000000000..f1e9506d337
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse52.def
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001 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 2, 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+DEFINITION MODULE testcse52 ;
+
+TYPE
+   string = ARRAY [0..10] OF CHAR ;
+   STRING = RECORD
+               c: POINTER TO string ;
+               h: CARDINAL ;
+            END ;
+
+PROCEDURE init (a: STRING) ;
+
+
+END testcse52.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse52.mod b/gcc/testsuite/gm2/cse/pass/testcse52.mod
new file mode 100644
index 00000000000..827a82454bb
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse52.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001 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 2, 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+IMPLEMENTATION MODULE testcse52 ;
+
+PROCEDURE init (a: STRING) ;
+BEGIN
+   a.c^[0] := 'g' (* currently fails *)
+(* passes
+   t := ADR(a) ;
+   t^^ := 'g'
+*)
+END init ;
+
+END testcse52.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse53.def b/gcc/testsuite/gm2/cse/pass/testcse53.def
new file mode 100644
index 00000000000..6a275e2ee9c
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse53.def
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001 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 2, 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+DEFINITION MODULE testcse53 ;
+
+TYPE
+   string = ARRAY [0..10] OF CHAR ;
+   STRING = RECORD
+               c: POINTER TO string ;
+               h: CARDINAL ;
+            END ;
+
+PROCEDURE init (a: STRING) ;
+
+
+END testcse53.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse53.mod b/gcc/testsuite/gm2/cse/pass/testcse53.mod
new file mode 100644
index 00000000000..aee3170ed5e
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse53.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001 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 2, 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+IMPLEMENTATION MODULE testcse53 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+PROCEDURE init (a: STRING) ;
+VAR
+   t: POINTER TO POINTER TO CHAR ;
+BEGIN
+   t := ADR(a) ;
+   t^^ := 'g'
+END init ;
+
+END testcse53.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse6.c b/gcc/testsuite/gm2/cse/pass/testcse6.c
new file mode 100644
index 00000000000..4693cc9f155
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse6.c
@@ -0,0 +1,14 @@
+
+struct m2string {
+  char *contents;
+  int HIGH;
+};
+
+typedef struct m2string STRING;
+
+void init (STRING a)
+{
+  **((char **)&a) = 'g';
+}
+
+
diff --git a/gcc/testsuite/gm2/cse/pass/testcse6.mod b/gcc/testsuite/gm2/cse/pass/testcse6.mod
new file mode 100644
index 00000000000..d874bc8285b
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse6.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse6 ;
+
+
+(*
+PROCEDURE foo ;
+BEGIN
+   a := b + c + d + e + f + g + h
+END foo ;
+*)
+
+VAR
+   a, b, c, d, e, f, g, h: CARDINAL ;
+BEGIN
+   d := c ;
+   b := c ;
+   e := c ;
+   f := c ;
+   g := c ;
+   h := c ;
+   a := b + c ;
+   IF a=0
+   THEN
+      c := 5
+   END ;
+   a := a + 1
+END testcse6.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse7.c b/gcc/testsuite/gm2/cse/pass/testcse7.c
new file mode 100644
index 00000000000..e7d204b2a8b
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse7.c
@@ -0,0 +1,21 @@
+
+struct m2string {
+  char *contents;
+  int HIGH;
+};
+
+typedef struct m2string STRING;
+static inline void inline foo (STRING a) __attribute__ ((always_inline));
+
+
+static void foo (STRING f)
+{
+  **((char **)&f) = 'g';
+}
+
+void init (STRING a)
+{
+  foo(a);
+}
+
+
diff --git a/gcc/testsuite/gm2/cse/pass/testcse7.mod b/gcc/testsuite/gm2/cse/pass/testcse7.mod
new file mode 100644
index 00000000000..93b782d0cb9
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse7.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse7 ;
+
+
+TYPE
+   Where = RECORD
+              Declared : CARDINAL ;
+              FirstUsed: CARDINAL ;
+           END ;
+
+
+(*
+   foo - 
+*)
+
+PROCEDURE foo () : CARDINAL ;
+BEGIN
+   RETURN( 1 )
+END foo ;
+
+
+PROCEDURE InitWhereDeclared (VAR at: Where) : CARDINAL ;
+BEGIN
+   WITH at DO
+      Declared := foo() ;
+      FirstUsed := Declared   (* we assign this field to something legal *)
+   END ;
+   RETURN( foo() )
+END InitWhereDeclared ;
+
+
+VAR
+   a: Where ;
+BEGIN
+   IF InitWhereDeclared(a)=1
+   THEN
+   END
+END testcse7.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse8.c b/gcc/testsuite/gm2/cse/pass/testcse8.c
new file mode 100644
index 00000000000..d6f61edb741
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse8.c
@@ -0,0 +1,30 @@
+
+struct m2string {
+  char *contents;
+  int HIGH;
+};
+
+typedef struct m2string STRING;
+static inline void inline StrLen (STRING a) __attribute__ ((always_inline));
+static inline void inline foo (void) __attribute__ ((always_inline));
+
+static void StrLen (STRING f)
+{
+  **((char **)&f) = 'g';
+}
+
+static void foo (void)
+{
+  STRING a;
+
+  a.contents = "hello";
+  a.HIGH = 6;
+  StrLen(a);
+}
+
+void init (void)
+{
+  foo();
+}
+
+
diff --git a/gcc/testsuite/gm2/cse/pass/testcse8.mod b/gcc/testsuite/gm2/cse/pass/testcse8.mod
new file mode 100644
index 00000000000..553d152b40e
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse8.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcse8 ;
+
+PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ;
+BEGIN
+   RETURN( 1 )
+END StrLen ;
+
+PROCEDURE Space (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( TRUE )
+END Space ;
+
+PROCEDURE GetNextArg (CmdLine: ARRAY OF CHAR; VAR CmdIndex: CARDINAL;
+                      VAR Arg: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   ArgIndex: CARDINAL ;  (* Index into Arg *)
+   HighA,
+   HighC: CARDINAL ;
+BEGIN
+   HighA := HIGH(Arg) ;
+   HighC := StrLen(CmdLine) ;
+   ArgIndex := 0 ;
+   (* Skip spaces *)
+   WHILE (CmdIndex<HighC) AND Space(CmdLine[CmdIndex]) DO
+      INC(CmdIndex)
+   END ;
+   RETURN( TRUE )
+END GetNextArg ;
+
+
+VAR
+   a   : ARRAY [0..20] OF CHAR ;
+   i, j: CARDINAL ;
+BEGIN
+   IF GetNextArg(a, i, a)
+   THEN
+   END
+END testcse8.
diff --git a/gcc/testsuite/gm2/cse/pass/testcse9.c b/gcc/testsuite/gm2/cse/pass/testcse9.c
new file mode 100644
index 00000000000..363eeb8e13c
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testcse9.c
@@ -0,0 +1,7 @@
+typedef void (*procedure) (char *);
+
+void
+ReadConv_ReadReal (procedure p, char *ch)
+{
+  (*p)(ch);
+}
diff --git a/gcc/testsuite/gm2/cse/pass/testsize.mod b/gcc/testsuite/gm2/cse/pass/testsize.mod
new file mode 100644
index 00000000000..f6717b4ddc6
--- /dev/null
+++ b/gcc/testsuite/gm2/cse/pass/testsize.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testsize ;
+
+FROM SYSTEM IMPORT SIZE, BYTE ;
+
+VAR
+   a: ARRAY [0..1] OF BYTE ;
+   i: CARDINAL ;
+BEGIN
+   i := SIZE(a) DIV 2
+END testsize.
diff --git a/gcc/testsuite/gm2/dynamic/pass/add.mod b/gcc/testsuite/gm2/dynamic/pass/add.mod
new file mode 100644
index 00000000000..02aefe6b601
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/add.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE add ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 2
+END add.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/dynamic/pass/dynamic-pass.exp b/gcc/testsuite/gm2/dynamic/pass/dynamic-pass.exp
new file mode 100644
index 00000000000..f90aa190bb1
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/dynamic-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/dynamic/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/dynamic/pass/prog21.mod b/gcc/testsuite/gm2/dynamic/pass/prog21.mod
new file mode 100644
index 00000000000..9dea76878a0
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/prog21.mod
@@ -0,0 +1,199 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE prog21;
+
+(* Referral exercise from 1995 *)
+
+(* Author - Stuart F Lewis March 1997 *)
+
+(* Reads student sports race data from a file *)
+(* stores in an array*)
+ (* displays the results *)
+
+(* MODEL SOLUTION FOR prog21 for course.swd *)
+
+FROM StrIO IMPORT WriteLn,WriteString,ReadString;
+FROM StrLib IMPORT StrEqual, StrLess, StrConCat;
+FROM StdIO IMPORT Read, Write;
+FROM NumberIO IMPORT WriteInt, ReadCard,WriteCard;
+FROM ASCII IMPORT eof;
+
+CONST
+   MaxPeople = 20;
+   EndOfRaceMark = 'qqqqqqqqqq';
+
+TYPE
+   Rec = RECORD
+            strdata : ARRAY[0..9] OF CHAR;
+         END;
+
+   name_type = ARRAY[0..9] OF CHAR;
+   OnePerson = RECORD
+                  name : name_type;
+                  score : CARDINAL;
+               END;
+
+   All = ARRAY[1..MaxPeople] OF OnePerson;
+
+VAR
+   draw,position,Npeople,count : CARDINAL;
+   Results : All;
+
+PROCEDURE continue;
+VAR
+   ch : CHAR;
+BEGIN
+   WriteLn;
+   WriteString("press ENTER to continue > ");
+   Read(ch);
+END continue;
+
+(* main program procedures start here *)
+
+PROCEDURE Initialise;
+BEGIN
+   Npeople := 0;
+   FOR count :=1 TO MaxPeople DO
+      WITH Results[count] DO
+         name := '          ';
+         score := 0;
+      END;(*with*)
+   END;(*for*)
+END Initialise;
+
+PROCEDURE SearchFor(temp : name_type;in : All ;
+                    VAR Index : CARDINAL) : BOOLEAN ;
+BEGIN
+   FOR count :=1 TO Npeople DO
+      WITH in[count] DO
+         IF StrEqual(name,temp)
+         THEN
+            Index := count;
+            RETURN TRUE;
+         END;(*if*)
+      END;(*with*)
+   END;(*for*)
+   RETURN FALSE;
+END SearchFor;
+
+PROCEDURE Add(temp : name_type;VAR in : All ; VAR Index : CARDINAL) ;
+BEGIN
+   Npeople := Npeople +1;
+   WITH in[Npeople] DO
+      name := temp;
+   END;(*with*)
+   Index := Npeople;
+END Add;
+
+PROCEDURE ReadStr10(VAR temp : name_type) ;
+BEGIN
+   temp := '          ';
+   ReadString(temp);
+   StrConCat(temp,'         ',temp);
+   WriteString(temp);
+   WriteString('****');
+   WriteLn;
+END ReadStr10;
+
+
+PROCEDURE InputData;
+VAR
+  race,temp : name_type;
+  Index,points : CARDINAL;
+BEGIN
+   ReadStr10(race);
+   WHILE NOT StrEqual(race,EndOfRaceMark) DO
+      ReadStr10(temp); (*blank line*)
+      ReadStr10(temp); (*first person in a race*)
+      points := 3; (*first place*)
+      WHILE StrEqual(temp,EndOfRaceMark) DO
+            IF NOT SearchFor(temp,Results,Index) THEN
+                   Add(temp,Results,Index);
+            END;(*if*)
+            IF points > 0 THEN
+               Results[Index].score := Results[Index].score + points;
+               points := points - 1;
+            END;(*if*)
+            ReadStr10(temp);
+      END;(*while same race*)
+      (* ReadStr10(temp); blank line*)
+      ReadStr10(race);
+   END;(*while races*)
+   WriteString(race);
+END InputData;
+
+PROCEDURE OutputResults;
+BEGIN
+   position := 1;
+   draw := 0;
+   FOR count :=1 TO Npeople DO
+      WITH Results[count] DO
+         WriteString(name);
+         WriteCard(score,6);
+         WriteCard(position,4);
+         IF score > Results[count + 1].score
+         THEN
+            position := position + 1 + draw;
+            IF draw > 0
+            THEN
+               draw := 0;
+               WriteString("=");
+            END;(*if*)
+         END;(*if*)
+         IF (score = Results[count + 1].score)
+         THEN
+            draw := draw + 1;
+            WriteString("=");
+         END;(*if*)
+         WriteLn;
+      END;(*with*)
+   END;(*for*)
+END OutputResults;
+
+PROCEDURE Less(first,second : CARDINAL) : BOOLEAN;
+BEGIN
+   (*compares score first then name to maintain order *)
+   (* comparison is back to front because we want descending order*)
+   IF Results[first].score > Results[second].score
+   THEN RETURN TRUE
+   ELSE
+      IF (Results[first].score = Results[second].score)
+           AND (StrLess(Results[first].name,Results[second].name))
+      THEN RETURN TRUE
+      ELSE RETURN FALSE
+      END;(*IF*)
+END;(*IF*)
+END Less;
+
+PROCEDURE Swap(first,second : CARDINAL);
+VAR
+   temp : OnePerson;
+BEGIN
+   temp := Results[first];
+   Results[first] := Results[second];
+   Results[second] := temp;
+END Swap;
+
+
+BEGIN (*main program*)
+   Initialise;
+   InputData;
+   WriteLn;
+   (*HSort(Npeople,Less,Swap);*)
+   OutputResults;
+END prog21.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testarray.mod b/gcc/testsuite/gm2/dynamic/pass/testarray.mod
new file mode 100644
index 00000000000..ea978ce5c6b
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testarray.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testarray ;
+
+
+PROCEDURE bufreadchar (Id: CARDINAL) : INTEGER ;
+VAR 
+   object: CHAR;  
+BEGIN
+   WITH files[ Id ] DO
+      object := buf[bufindex];
+      INC(bufindex);
+      RETURN( ORD(object) ) ;
+   END
+END bufreadchar ;
+
+
+VAR
+   files: ARRAY [0..10] OF RECORD
+                              count,
+                              bufindex: CARDINAL ;
+                              buf     : ARRAY [0..5] OF CHAR ;
+                           END ;
+   i: INTEGER ;
+BEGIN
+   i := bufreadchar(1)
+END testarray.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testarray2.mod b/gcc/testsuite/gm2/dynamic/pass/testarray2.mod
new file mode 100644
index 00000000000..c4b5b03087a
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testarray2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testarray2 ;
+
+
+VAR
+   a   : ARRAY [0..10] OF CARDINAL ;
+   z, i: CARDINAL ;
+BEGIN
+   z := a[i] ;
+   INC(i) ;
+   z := z + a[i]
+END testarray2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testarray3.mod b/gcc/testsuite/gm2/dynamic/pass/testarray3.mod
new file mode 100644
index 00000000000..5afdb78685d
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testarray3.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testarray3 ;
+
+
+VAR
+   a, b, i: CARDINAL ;
+BEGIN
+   a := i ;
+   INC(i) ;
+   b := i ;
+   b := b + a
+END testarray3.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testarray4.mod b/gcc/testsuite/gm2/dynamic/pass/testarray4.mod
new file mode 100644
index 00000000000..7c5074062fc
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testarray4.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testarray4 ;
+
+
+PROCEDURE foo () : CARDINAL ;
+VAR
+   t,
+   i: INTEGER ;
+BEGIN
+   t := a[i] ;
+   INC(i, i*3) ;
+   RETURN( t )
+END foo ;
+
+
+VAR
+   a: ARRAY [-10..10] OF INTEGER ;
+   i: CARDINAL ;
+BEGIN
+   i := foo()
+END testarray4.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testarray6.mod b/gcc/testsuite/gm2/dynamic/pass/testarray6.mod
new file mode 100644
index 00000000000..69013c8bc95
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testarray6.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testarray6 ;
+
+
+VAR
+   x: CARDINAL ;
+   a: ARRAY [0..10] OF CARDINAL ;
+   i: CARDINAL ;
+BEGIN
+   x := 10*x + (ORD(a[i])-ORD('0'))
+END testarray6.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec.mod b/gcc/testsuite/gm2/dynamic/pass/testbec.mod
new file mode 100644
index 00000000000..0f37faa99a2
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec ;
+
+
+FROM SYSTEM IMPORT ADR ;
+
+
+(*
+PROCEDURE foo ;
+BEGIN
+   a := 1 ;
+   p^ := 1 ;
+   b := 1 ;
+   c := 1
+END foo ;
+*)
+
+
+VAR
+   p            : POINTER TO CARDINAL ;
+   a, b, c, d, e: CARDINAL ;
+   r            : ARRAY [0..10] OF CARDINAL ;
+BEGIN
+   (* foo ; *)
+   a := b + c - (d + e) - (a + b) ; (* works *)
+   LOOP END
+END testbec.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec10.mod b/gcc/testsuite/gm2/dynamic/pass/testbec10.mod
new file mode 100644
index 00000000000..b75a4afa5dd
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec10.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec10 ;
+
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+
+TYPE
+   foo = RECORD
+            a, b: CARDINAL ;
+            z, f: CARDINAL ;
+            x, y: CARDINAL ;
+            ch  : CHAR ;
+         END ;
+
+VAR
+   q: POINTER TO foo ;
+   p: POINTER TO CARDINAL ;
+   c: CARDINAL ;
+   r: foo ;
+   a: ADDRESS ;
+BEGIN
+   c := p^ + 4 + c ;
+   q := ADR(p) + a ;
+   r := q^ ;
+END testbec10.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec11.mod b/gcc/testsuite/gm2/dynamic/pass/testbec11.mod
new file mode 100644
index 00000000000..34efbbd76d5
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec11.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec11 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   foo = RECORD
+            a, b: CARDINAL ;
+            z, f: CARDINAL ;
+            x, y: CARDINAL ;
+            ch  : CHAR ;
+         END ;
+
+
+PROCEDURE bar ;
+VAR
+   a: CARDINAL ;
+BEGIN
+   p := ADR(a)
+END bar ;
+
+
+VAR
+   q: POINTER TO foo ;
+   p: POINTER TO CARDINAL ;
+   c: CARDINAL ;
+   r: foo ;
+BEGIN
+   bar ;
+   p := ADR(c) ;
+END testbec11.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec12.mod b/gcc/testsuite/gm2/dynamic/pass/testbec12.mod
new file mode 100644
index 00000000000..74f27bb409b
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec12.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec12 ;
+
+
+VAR
+   a, b, c: CARDINAL ;
+BEGIN
+   a := b DIV c
+END testbec12.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec13.mod b/gcc/testsuite/gm2/dynamic/pass/testbec13.mod
new file mode 100644
index 00000000000..c3b7359fa8f
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec13.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec13 ;
+
+
+VAR
+   a, b, c, d, e, f: CARDINAL ;
+BEGIN
+   a := b DIV ((c + d + e) DIV f)
+END testbec13.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec14.mod b/gcc/testsuite/gm2/dynamic/pass/testbec14.mod
new file mode 100644
index 00000000000..39cbfe1817a
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec14.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec14 ;
+
+
+VAR
+   a, b, c, d, e, f: CARDINAL ;
+BEGIN
+   a := b DIV ((c + d + e) MOD f)
+END testbec14.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec15.mod b/gcc/testsuite/gm2/dynamic/pass/testbec15.mod
new file mode 100644
index 00000000000..2d9368d41bc
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec15.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec15 ;
+
+
+VAR
+   a, b, c, d, e, f, g, h: CARDINAL ;
+BEGIN
+   a := (b DIV ((c + d + e) MOD f)) DIV (g MOD h)
+END testbec15.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec16.mod b/gcc/testsuite/gm2/dynamic/pass/testbec16.mod
new file mode 100644
index 00000000000..72c4f70da76
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec16.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec16 ;
+
+
+VAR
+   a, b, c, d, e, f, g, h, i, j, k: CARDINAL ;
+BEGIN
+   a := (b DIV ((c + d + e) MOD f)) DIV ((i + j + k) MOD (g + h))
+END testbec16.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec17.mod b/gcc/testsuite/gm2/dynamic/pass/testbec17.mod
new file mode 100644
index 00000000000..5ef704bd782
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec17.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec17 ;
+
+
+VAR
+   a, b, c, d, e, f, g, h, i, j, k: CARDINAL ;
+BEGIN
+   a := (b DIV ((c + d + e) MOD f)) * ((i + j + k) MOD (g + h))
+END testbec17.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec18.mod b/gcc/testsuite/gm2/dynamic/pass/testbec18.mod
new file mode 100644
index 00000000000..5197c025727
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec18.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec18 ;
+
+
+VAR
+   a, b, c, d, e, f, g, h, i, j, k: CARDINAL ;
+BEGIN
+   a := b * (c + d) ;
+END testbec18.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec19.mod b/gcc/testsuite/gm2/dynamic/pass/testbec19.mod
new file mode 100644
index 00000000000..ed5fa091484
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec19.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec19 ;
+
+
+VAR
+   a, b, c, d, e, f, g, h, i, j, k, l: CARDINAL ;
+BEGIN
+   a := (b DIV ((c + d + e) MOD f)) * ((i + j + k) MOD (g + h)) * (l * 2)
+END testbec19.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec2.mod b/gcc/testsuite/gm2/dynamic/pass/testbec2.mod
new file mode 100644
index 00000000000..98fa0e635c7
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec2.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec2 ;
+
+
+
+VAR
+   a, b, c, d: CARDINAL ;
+BEGIN
+   INC(a) ;
+   LOOP END
+END testbec2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec20.mod b/gcc/testsuite/gm2/dynamic/pass/testbec20.mod
new file mode 100644
index 00000000000..8eb253bfc77
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec20.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec20 ;
+
+
+VAR
+   a, b, c: CARDINAL ;
+BEGIN
+   a := b * 2
+END testbec20.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec21.mod b/gcc/testsuite/gm2/dynamic/pass/testbec21.mod
new file mode 100644
index 00000000000..307fe2dbf49
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec21.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec21 ;
+
+
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   a := b * 2
+END testbec21.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec22.mod b/gcc/testsuite/gm2/dynamic/pass/testbec22.mod
new file mode 100644
index 00000000000..703830b5ba5
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec22.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec22 ;
+
+
+
+VAR
+   i, j      : INTEGER ;
+   a, b, c, d: CARDINAL ;
+BEGIN
+   a := b * 8 ;
+   c := d DIV 8 ;
+   d := a MOD 256 ;
+   i := j MOD 4
+END testbec22.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec23.mod b/gcc/testsuite/gm2/dynamic/pass/testbec23.mod
new file mode 100644
index 00000000000..83daa600285
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec23.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec23 ;
+
+
+TYPE
+   foo = RECORD
+            a, b: CARDINAL ;
+         END ;
+
+VAR
+   p   : POINTER TO foo ;
+   x, y: foo ;
+BEGIN
+   x := p^
+END testbec23.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec24.mod b/gcc/testsuite/gm2/dynamic/pass/testbec24.mod
new file mode 100644
index 00000000000..7e7f639fd22
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec24.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec24 ;
+
+
+TYPE
+   foo = RECORD
+            a, b: CARDINAL ;
+         END ;
+
+VAR
+   p   : POINTER TO foo ;
+   x, y: foo ;
+BEGIN
+   p^ := x
+END testbec24.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec25.mod b/gcc/testsuite/gm2/dynamic/pass/testbec25.mod
new file mode 100644
index 00000000000..c2647d34021
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec25.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec25 ;
+
+
+
+VAR
+   p, q: POINTER TO CARDINAL ;
+   x, y: CARDINAL ;
+BEGIN
+   p^ := x ;
+   y  := q^
+END testbec25.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec26.mod b/gcc/testsuite/gm2/dynamic/pass/testbec26.mod
new file mode 100644
index 00000000000..c2577d62fe3
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec26.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec26 ;
+
+
+
+VAR
+   p, q: POINTER TO CARDINAL ;
+   y   : CARDINAL ;
+BEGIN
+   y  := q^ + p^
+END testbec26.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec27.mod b/gcc/testsuite/gm2/dynamic/pass/testbec27.mod
new file mode 100644
index 00000000000..a51f6f6d9b2
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec27.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec27 ;
+
+VAR
+   a, b, c, d, e, f, g, h, i, j, k, l, m, n, o: CARDINAL ;
+BEGIN
+(*
+   a := ((b DIV c) DIV ((d DIV e) DIV f)) DIV ((g DIV h) DIV ((i DIV j) DIV k)) ;
+*)
+   a := b MOD c MOD d MOD e MOD f MOD g MOD h MOD i MOD j MOD k MOD l MOD m ;
+(*
+   a := (b MOD c) DIV (e MOD f)
+*)
+END testbec27.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec28.mod b/gcc/testsuite/gm2/dynamic/pass/testbec28.mod
new file mode 100644
index 00000000000..8e216f66ad3
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec28.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec28 ;
+
+
+VAR
+   a, b: ARRAY [0..100] OF CARDINAL ;
+BEGIN
+   a := b
+END testbec28.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec29.mod b/gcc/testsuite/gm2/dynamic/pass/testbec29.mod
new file mode 100644
index 00000000000..a2b205b2f94
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec29.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testbec29 ;
+
+
+TYPE
+   t = ARRAY [0..100] OF CHAR ;
+VAR
+   p   : POINTER TO t ;
+   a   : t ;
+BEGIN
+   p^ := a ;
+   p^ := 'abcdefghijkl'
+END testbec29.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec3.mod b/gcc/testsuite/gm2/dynamic/pass/testbec3.mod
new file mode 100644
index 00000000000..bf869b686e6
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec3.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec3 ;
+
+
+VAR
+   a, b, c, d: CARDINAL ;
+BEGIN
+   a := a + b + 1 -c ;
+   LOOP END
+END testbec3.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec30.mod b/gcc/testsuite/gm2/dynamic/pass/testbec30.mod
new file mode 100644
index 00000000000..de9874bac42
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec30.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testbec30 ;
+
+
+VAR
+   a, b: ARRAY [0..100] OF CHAR ;
+BEGIN
+   a := 'hello world'
+END testbec30.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec31.mod b/gcc/testsuite/gm2/dynamic/pass/testbec31.mod
new file mode 100644
index 00000000000..9b51c3b5e48
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec31.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec31 ;
+
+
+TYPE
+   foo = RECORD
+            a, b, c: CARDINAL ;
+         END ;
+
+VAR
+   x, y, z: foo ;
+BEGIN
+   x := y
+END testbec31.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec32.mod b/gcc/testsuite/gm2/dynamic/pass/testbec32.mod
new file mode 100644
index 00000000000..84fb3406049
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec32.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec32 ;
+
+
+TYPE
+   foo = RECORD
+            a, b, c: CARDINAL ;
+         END ;
+
+PROCEDURE bar ;
+VAR
+   x, y, z: foo ;
+BEGIN
+   x := y
+END bar ;
+
+
+BEGIN
+   bar
+END testbec32.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec33.mod b/gcc/testsuite/gm2/dynamic/pass/testbec33.mod
new file mode 100644
index 00000000000..ba624a8c299
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec33.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec33 ;
+
+
+(* works *)
+
+TYPE
+   foo = RECORD
+            a, b, c: CARDINAL ;
+         END ;
+
+PROCEDURE bar ;
+VAR
+   x: foo ;
+   y: POINTER TO foo ;
+BEGIN
+   x := y^
+END bar ;
+
+
+BEGIN
+   bar
+END testbec33.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec34.mod b/gcc/testsuite/gm2/dynamic/pass/testbec34.mod
new file mode 100644
index 00000000000..bd4fbbf11e2
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec34.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec34 ;
+
+
+(* works *)
+TYPE
+   foo = RECORD
+            a, b, c: CARDINAL ;
+         END ;
+
+
+VAR
+   x: foo ;
+   y: POINTER TO foo ;
+BEGIN
+   x := y^
+END testbec34.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec35.mod b/gcc/testsuite/gm2/dynamic/pass/testbec35.mod
new file mode 100644
index 00000000000..e3eacff8b65
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec35.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec35 ;
+
+(* works *)
+TYPE
+   foo = RECORD
+            a, b, c: CARDINAL ;
+         END ;
+
+
+VAR
+   x: POINTER TO foo ;
+   y: foo ;
+BEGIN
+   x^ := y
+END testbec35.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec36.mod b/gcc/testsuite/gm2/dynamic/pass/testbec36.mod
new file mode 100644
index 00000000000..9ddc04914dc
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec36.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec36 ;
+
+
+(* works *)
+
+TYPE
+   foo = RECORD
+            a, b, c: CARDINAL ;
+         END ;
+
+PROCEDURE bar ;
+VAR
+   x: POINTER TO foo ;
+   y: foo ;
+BEGIN
+   x^ := y
+END bar ;
+
+
+BEGIN
+   bar
+END testbec36.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec37.mod b/gcc/testsuite/gm2/dynamic/pass/testbec37.mod
new file mode 100644
index 00000000000..d8da01edfba
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec37.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec37 ;
+
+
+TYPE
+   foo = RECORD
+            a, b: CARDINAL ;
+         END ;
+
+PROCEDURE bar ;
+VAR
+   i, j: CARDINAL ;
+   t   : foo ;
+BEGIN
+   t := Sources[i] ;
+   Sources[i] := Sources[j] ;
+   Sources[j] := t
+END bar ;
+
+
+VAR
+   Sources: ARRAY [0..10] OF foo ;
+BEGIN
+   bar
+END testbec37.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec38.mod b/gcc/testsuite/gm2/dynamic/pass/testbec38.mod
new file mode 100644
index 00000000000..fbc63202b5e
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec38.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec38 ;
+
+
+PROCEDURE kill (VAR i: CARDINAL) ;
+BEGIN
+   
+END kill ;
+
+
+PROCEDURE test ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := j ;
+   kill(i)
+END test ;
+
+
+BEGIN
+   test
+END testbec38.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec39.mod b/gcc/testsuite/gm2/dynamic/pass/testbec39.mod
new file mode 100644
index 00000000000..c24cc449b7c
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec39.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec39 ;
+
+VAR
+   a, b, c, d: CARDINAL ;
+BEGIN
+   a := 1 ;
+   b := 2 ;
+   c := 3 ;
+   d := a + 4
+END testbec39.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec4.mod b/gcc/testsuite/gm2/dynamic/pass/testbec4.mod
new file mode 100644
index 00000000000..619b230ac26
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec4.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec4 ;
+
+
+PROCEDURE foo ;
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := 'a' ;
+   WHILE ch='a' DO
+      ch := 'b'
+   END
+END foo ;
+
+
+BEGIN
+   foo
+END testbec4.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec40.mod b/gcc/testsuite/gm2/dynamic/pass/testbec40.mod
new file mode 100644
index 00000000000..b08cef0829e
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec40.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec40 ;
+
+
+VAR
+   a, b, c, d, e, f, g, h, i: CARDINAL ;
+BEGIN
+   a := b + c ;
+   d := e + f ;
+(*   g := h + i *)
+   g := a + d
+END testbec40.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec41.mod b/gcc/testsuite/gm2/dynamic/pass/testbec41.mod
new file mode 100644
index 00000000000..0e092aae206
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec41.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec41 ;
+
+
+VAR
+   a, b, c: CARDINAL ;
+BEGIN
+   a := b + 5 ;
+   c := a + 3
+END testbec41.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec42.mod b/gcc/testsuite/gm2/dynamic/pass/testbec42.mod
new file mode 100644
index 00000000000..3e87573f61b
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec42.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec42 ;
+
+
+VAR
+   e, f, g, h, i,
+   a, b, c, d   : CARDINAL ;
+BEGIN
+   a := b + c + d ;
+   e := f + g + h ;
+   i := a + e
+END testbec42.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec43.mod b/gcc/testsuite/gm2/dynamic/pass/testbec43.mod
new file mode 100644
index 00000000000..8a0b78f6745
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec43.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec43 ;
+
+
+VAR
+   a, b, c, d, e, f, g: CARDINAL ;
+BEGIN
+   g := ((a + b) + (c + d)) + (e + g)
+END testbec43.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec44.mod b/gcc/testsuite/gm2/dynamic/pass/testbec44.mod
new file mode 100644
index 00000000000..81a29e5965c
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec44.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec44 ;
+
+
+CONST
+   MaxCount = 100 * 1000 * 1000 ;
+
+VAR
+   e, f, g, h, i, j,
+   a, b, c, d   : CARDINAL ;
+BEGIN
+   FOR j := 0 TO MaxCount DO
+      a := b + c + d ;
+      e := f + g + h ;
+      i := a + e
+   END
+END testbec44.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec45.mod b/gcc/testsuite/gm2/dynamic/pass/testbec45.mod
new file mode 100644
index 00000000000..39b86a90e42
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec45.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec45 ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ;
+   WriteLn
+END testbec45.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec5.mod b/gcc/testsuite/gm2/dynamic/pass/testbec5.mod
new file mode 100644
index 00000000000..34f9c075567
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec5.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec5 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+
+PROCEDURE foo ;
+VAR
+   ch: CHAR ;
+   a : ADDRESS ;
+BEGIN
+   a := ADR(ch) ;
+   ch := 'a' ;
+   WHILE ch='a' DO
+      a := ADR(ch) ;
+      ch := 'b'
+   END ;
+   a := ADR(ch)
+END foo ;
+
+
+BEGIN
+   foo
+END testbec5.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec6.mod b/gcc/testsuite/gm2/dynamic/pass/testbec6.mod
new file mode 100644
index 00000000000..0bc8697db09
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec6.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec6 ;
+
+
+PROCEDURE foo (a, b, c: CARDINAL) : CARDINAL ;
+BEGIN
+   g := foo(a, b, c) ;
+   RETURN( a+b+c )
+END foo ;
+
+
+VAR
+   a, b, c, d: CARDINAL ;
+   g: CARDINAL ;
+BEGIN
+   g := foo(a, b, c)
+END testbec6.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec7.mod b/gcc/testsuite/gm2/dynamic/pass/testbec7.mod
new file mode 100644
index 00000000000..dd5ac8cfdc6
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec7.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec7 ;
+
+
+PROCEDURE foo (i: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( i )
+END foo ;
+
+
+PROCEDURE bar ;
+VAR
+   a: ARRAY [0..10] OF CARDINAL ;
+   i: CARDINAL ;
+BEGIN
+   IF foo(1)=foo(2)
+   THEN
+      bar
+   END ;
+   FOR i := 0 TO 10 DO
+      a[i] := foo(i)
+   END
+END bar ;
+
+BEGIN
+   bar
+END testbec7.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec8.mod b/gcc/testsuite/gm2/dynamic/pass/testbec8.mod
new file mode 100644
index 00000000000..d552d5083ba
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec8.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec8 ;
+
+
+PROCEDURE bar ;
+VAR
+   i, j, k: CARDINAL ;
+BEGIN
+   i := j DIV 10 ;
+   k := j MOD 10
+END bar ;
+
+
+BEGIN
+   bar
+END testbec8.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testbec9.mod b/gcc/testsuite/gm2/dynamic/pass/testbec9.mod
new file mode 100644
index 00000000000..8f9713f555f
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testbec9.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testbec9 ;
+
+
+VAR
+   a, b, t: CARDINAL ;
+BEGIN
+   t := a ;
+   a := b ;
+   b := t
+END testbec9.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testdavid.mod b/gcc/testsuite/gm2/dynamic/pass/testdavid.mod
new file mode 100644
index 00000000000..be0d514e91b
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testdavid.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testdavid ;
+
+VAR
+   i, j, k, l, m: CARDINAL ;
+BEGIN
+   j := 5 ;
+   k := 6 ;
+   i := j+(k*j)+k-j ;   (* 5+(6*5)+6-5   =    36 *)
+   l := j*i-k+(j*i) ;   (* 5*36-6+(5*36) =   354 *)
+   m := j+k+i*l-m ;     (* 5+6+36*354    = 12755 *)
+   i := l+m
+END testdavid.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testdiv.mod b/gcc/testsuite/gm2/dynamic/pass/testdiv.mod
new file mode 100644
index 00000000000..58fc2207999
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testdiv.mod
@@ -0,0 +1,104 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testdiv ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrLen ;
+
+
+CONST
+   ClockFreq = 20 ;
+
+TYPE
+   ProcType   = (User, System) ;
+ 
+   ProcStatus = (Runnable, WaitOnSem, WaitOnIO, Suspended, Killed, Sleeping) ;
+ 
+   PtrToProcDes      = POINTER TO ProcessDescriptor ;
+   ProcessDescriptor = RECORD
+                          RightPtr      : PtrToProcDes ;
+                          LeftPtr       : PtrToProcDes ;
+                          RightRunPtr   : PtrToProcDes ;
+                          LeftRunPtr    : PtrToProcDes ;
+                          RightOwner    : PtrToProcDes ;
+                          LeftOwner     : PtrToProcDes ;
+                          Father        : PtrToProcDes ;
+                          Sons          : PtrToProcDes ;
+                          PPriority     : CARDINAL ;  (* 0..MaxPriority *)
+                          PQuanta       : CARDINAL ;
+                          PMemorySize   : CARDINAL ;
+                          PMemoryStart  : ADDRESS ;
+                          PHeapSize     : CARDINAL ;
+                          PHeapStart    : ADDRESS ;
+                          PFreeMem      : ADDRESS ;
+                          TimeSecs      : CARDINAL ;
+                          PName         : ARRAY [0..15] OF CHAR ;
+                          Process       : ADDRESS ;
+                          PType         : ProcType ;
+                          PCurrentStatus: ProcStatus ;
+                          PNextStatus   : ProcStatus ;
+                       END ;
+
+
+PROCEDURE WriteProcess (p: PtrToProcDes) ;
+VAR
+   i : CARDINAL ;
+BEGIN
+(*
+   WriteString( p^.PName ) ;
+   i := HIGH( p^.PName )-StrLen( p^.PName ) ;
+   WHILE i>0 DO
+       WriteString(' ') ;
+       DEC( i )
+   END ;
+*)
+   WITH p^ DO
+(*
+      WriteCard( PMemorySize DIV 1024, 6 ) ;
+      WriteString('k   (') ;
+      IF PMemorySize#0
+      THEN
+         WriteCard( (PMemorySize -
+                     (CARDINAL(Process) - CARDINAL(PMemoryStart))) * 100
+                    DIV PMemorySize, 3)
+      ELSE
+         WriteString('  0')
+      END ;
+      WriteString('%)  Pri') ;
+      WriteCard( PPriority, 2 ) ;
+      WriteCard( PQuanta, 3 ) ;
+      WriteString('  ') ;
+      WriteString('  ') ;
+      WriteString('  ') ;
+*)
+      WriteCard( (TimeSecs DIV ClockFreq) DIV (60*60), 2 ) ;      (* Hours   *)
+      WriteString(':') ;
+      WriteCard( ((TimeSecs DIV ClockFreq) DIV 60) MOD 60, 2) ;   (* Minutes *)
+      WriteString(':') ;
+      WriteCard( (TimeSecs DIV ClockFreq) MOD 60, 2)              (* Seconds *)
+   END
+END WriteProcess ;
+
+
+VAR
+   TimeSecs: CARDINAL ;
+   p       : PtrToProcDes ;
+BEGIN
+   WriteProcess(p)
+END testdiv.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testexp.mod b/gcc/testsuite/gm2/dynamic/pass/testexp.mod
new file mode 100644
index 00000000000..5faf7e1dced
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testexp.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testexp ;
+
+
+PROCEDURE Halt (a: ARRAY OF CHAR; file: ARRAY OF CHAR; line: CARDINAL) ;
+BEGIN
+END Halt ;
+
+
+BEGIN
+   Halt('my test', __FILE__, __LINE__)
+END testexp.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testfor.mod b/gcc/testsuite/gm2/dynamic/pass/testfor.mod
new file mode 100644
index 00000000000..b0b10dccfec
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testfor.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfor ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+CONST
+   Max = 100 ;
+
+
+(*
+   Try - 
+*)
+
+PROCEDURE Try ;
+VAR
+   y,
+   x,
+   d,
+   i: CARDINAL ;
+   a: ARRAY [0..Max] OF CARDINAL ;
+BEGIN
+   FOR i := 0 TO Max DO
+      d := d + a[i] ;
+      y := 0 ;
+      WriteString('it works') ;
+      WHILE y<i DO
+         INC(y)
+      END ;
+      x := d + i
+   END
+END Try ;
+
+
+BEGIN
+   Try
+END testfor.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testfor2.mod b/gcc/testsuite/gm2/dynamic/pass/testfor2.mod
new file mode 100644
index 00000000000..05006d279d0
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testfor2.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfor2 ;
+
+
+VAR
+   i, a, b, c: CARDINAL ;
+BEGIN
+   FOR i := 1 TO 20 DO c := a + i ; b := a + i
+   END ;
+   i := b + c                                            
+END testfor2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testfunc.mod b/gcc/testsuite/gm2/dynamic/pass/testfunc.mod
new file mode 100644
index 00000000000..dfb34203b20
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testfunc.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfunc ;
+
+
+PROCEDURE foo () : CARDINAL ;
+BEGIN
+   RETURN( 10 )
+END foo ;
+
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   IF a*foo()>CARDINAL(b)
+   THEN
+   END
+END testfunc.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testfunc2.mod b/gcc/testsuite/gm2/dynamic/pass/testfunc2.mod
new file mode 100644
index 00000000000..6a6f5efe259
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testfunc2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfunc2 ;
+
+
+PROCEDURE Alpha (a: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( a+1 )
+END Alpha ;
+
+
+PROCEDURE Beta (a: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( a+2 )
+END Beta ;
+
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 1 ;
+   c := Beta(Alpha(c))
+END testfunc2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testfunc3.mod b/gcc/testsuite/gm2/dynamic/pass/testfunc3.mod
new file mode 100644
index 00000000000..8f3dd7b9f62
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testfunc3.mod
@@ -0,0 +1,81 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfunc3 ;
+
+
+
+PROCEDURE WriteLn ;
+BEGIN
+END WriteLn ;
+
+PROCEDURE StartOfIndexInBuffer () : CARDINAL ;
+BEGIN
+   RETURN( 0 )
+END StartOfIndexInBuffer ;
+
+PROCEDURE FindNextLineInBuffer (a, b: CARDINAL) ;
+BEGIN
+END FindNextLineInBuffer ;
+
+PROCEDURE DisplayUpToToken (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( a )
+END DisplayUpToToken ;
+
+PROCEDURE WriteNChars (ch: CHAR; a: CARDINAL) ;
+BEGIN
+END WriteNChars ;
+
+PROCEDURE DisplayRestOfBuffer (a, b: CARDINAL) ;
+BEGIN
+END DisplayRestOfBuffer ;
+
+
+VAR
+   BufferOffset,
+   TokenLength,
+   Indent      : CARDINAL ;
+
+
+(*
+   WriteBuffer - writes the buffer with the CurrentSymbol underlined.
+*)
+
+PROCEDURE WriteBuffer ;
+VAR
+   OffsetIntoSource,
+   OffsetIntoBuffer,
+   Indent          : CARDINAL ;
+BEGIN
+   OffsetIntoBuffer := StartOfIndexInBuffer() ;
+   OffsetIntoSource := BufferOffset ;
+   FindNextLineInBuffer(OffsetIntoBuffer, OffsetIntoSource) ;
+
+   (* Found end of first line, now display BufferSource *)
+
+   Indent := DisplayUpToToken(OffsetIntoBuffer, OffsetIntoSource) ;
+   WriteNChars(' ', Indent) ;
+   WriteNChars('^', TokenLength) ;
+   WriteLn ;
+   DisplayRestOfBuffer(OffsetIntoBuffer, OffsetIntoSource) ;
+   WriteLn
+END WriteBuffer ;
+
+
+BEGIN
+   WriteBuffer
+END testfunc3.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testfunc4.mod b/gcc/testsuite/gm2/dynamic/pass/testfunc4.mod
new file mode 100644
index 00000000000..3283b3a4a47
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testfunc4.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfunc4 ;
+
+
+PROCEDURE test (a, b, c: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( a+b+c )
+END test ;
+
+
+VAR
+   answer, i: CARDINAL ;
+BEGIN
+   answer := test(10+i, 20+i, 30+i)
+END testfunc4.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testfunc5.mod b/gcc/testsuite/gm2/dynamic/pass/testfunc5.mod
new file mode 100644
index 00000000000..bf6c83b45d3
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testfunc5.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfunc5 ;
+
+
+TYPE
+   Instruction = (mov) ;
+   Register    = (RegECX) ;
+
+VAR
+   WordSize: CARDINAL ;
+
+
+PROCEDURE MaxDatum () : CARDINAL ;
+BEGIN
+   RETURN( WordSize )
+END MaxDatum ;
+
+
+PROCEDURE InstRegInt (inst: Instruction; s: CARDINAL; reg: Register;
+                      int: INTEGER) ;
+BEGIN
+END InstRegInt ;
+
+
+PROCEDURE BlockMove (Size: CARDINAL) ;
+BEGIN
+   IF Size>WordSize
+   THEN
+      InstRegInt(mov, MaxDatum(), RegECX, INTEGER(Size DIV WordSize))
+   END
+END BlockMove ;
+
+
+BEGIN
+   BlockMove(4)
+END testfunc5.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/dynamic/pass/testfunc6.mod b/gcc/testsuite/gm2/dynamic/pass/testfunc6.mod
new file mode 100644
index 00000000000..b805ff92048
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testfunc6.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfunc6 ;
+
+
+PROCEDURE pop () : CARDINAL ;
+BEGIN
+   RETURN( 0 )
+END pop ;
+
+
+PROCEDURE memcopy ;
+VAR
+   a: CARDINAL ;
+BEGIN
+   a := pop()
+END memcopy ;
+
+
+BEGIN
+   memcopy
+END testfunc6.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testif.mod b/gcc/testsuite/gm2/dynamic/pass/testif.mod
new file mode 100644
index 00000000000..8036861547f
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testif.mod
@@ -0,0 +1,61 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testif ;
+
+
+
+PROCEDURE ReadToken (VAR CurrentToken, TokenType, TokenIndex, CurSymLine: CARDINAL) ;
+BEGIN
+END ReadToken ;
+
+
+PROCEDURE ProcessDate ; BEGIN END ProcessDate ;
+
+CONST
+   ReservedToken = 0 ;
+
+VAR
+   FoundEofToken: BOOLEAN ;
+   TokenNumber,
+   DateTok,
+   FileTok,
+   LineTok,
+   CurrentToken,
+   TokenType,
+   TokenIndex,
+   CurSymLine   : CARDINAL ;
+BEGIN
+   IF NOT FoundEofToken
+   THEN
+      ReadToken(CurrentToken, TokenType, TokenIndex, CurSymLine) ;
+      INC(TokenNumber) ;
+    (* ; WriteString('TokenIndex => ') ; Write(BufferSource[TokenIndex MOD MaxBuffer]) ; WriteLn ; *)
+      IF TokenType=ReservedToken
+      THEN
+         IF CurrentToken=DateTok
+         THEN
+            ProcessDate
+         ELSIF CurrentToken=FileTok
+         THEN
+            ProcessDate
+         ELSIF CurrentToken=LineTok
+         THEN
+            ProcessDate
+         END
+      END
+   END
+END testif.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testit.mod b/gcc/testsuite/gm2/dynamic/pass/testit.mod
new file mode 100644
index 00000000000..03e331b6f02
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testit.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testit ;
+
+
+
+BEGIN
+
+END testit.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testloop.mod b/gcc/testsuite/gm2/dynamic/pass/testloop.mod
new file mode 100644
index 00000000000..275f8f43672
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testloop.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testloop ;
+
+
+BEGIN
+   LOOP
+   END
+END testloop.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testloop2.mod b/gcc/testsuite/gm2/dynamic/pass/testloop2.mod
new file mode 100644
index 00000000000..8c6259f7d8c
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testloop2.mod
@@ -0,0 +1,56 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testloop2 ;
+
+
+FROM SYSTEM IMPORT ADR ;
+
+PROCEDURE foo ;
+VAR
+   p: POINTER TO CARDINAL ;
+BEGIN
+   i := 1 ;
+   p := ADR(i) ;
+   WHILE i#0 DO
+      IF TRUE
+      THEN
+         dec(i)
+      END ;
+      IF i>0
+      THEN
+      ELSE
+      END ;
+      WHILE i=0 DO
+      END ;
+      REPEAT
+      UNTIL i=0
+   END
+END foo ;
+
+PROCEDURE dec (VAR i: CARDINAL) ;
+BEGIN
+END dec ;
+
+PROCEDURE bar ;
+BEGIN
+END bar ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   foo
+END testloop2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testloop3.mod b/gcc/testsuite/gm2/dynamic/pass/testloop3.mod
new file mode 100644
index 00000000000..d32616865db
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testloop3.mod
@@ -0,0 +1,55 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testloop3 ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+TYPE
+   PtrToNode = POINTER TO RECORD
+                             Next: PtrToNode ;
+                             Sym : CARDINAL ;
+                          END ;
+
+VAR
+   RemoveList: PtrToNode ;
+
+
+(*
+   FindNextUsedQuad - returns TRUE if node, q, is on a list defined by, p.
+*)
+
+PROCEDURE IsItemOnList (p, q: PtrToNode) : BOOLEAN ;
+BEGIN
+   WHILE p#NIL DO
+      IF p=q
+      THEN
+         WriteString('found item') ; WriteLn
+      ELSE
+         p := p^.Next
+      END
+   END ;
+   RETURN( FALSE )
+END IsItemOnList ;
+
+
+BEGIN
+   RemoveList := NIL ;
+   IF IsItemOnList(RemoveList, RemoveList)
+   THEN
+   END
+END testloop3.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testloop4.mod b/gcc/testsuite/gm2/dynamic/pass/testloop4.mod
new file mode 100644
index 00000000000..5b63abfb90b
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testloop4.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testloop4 ;
+
+
+PROCEDURE IsUsed (i: CARDINAL) : BOOLEAN ;
+BEGIN
+   WHILE ListUsed[i] DO
+      INC(i)
+   END ;
+   RETURN( FALSE )
+END IsUsed ;
+
+
+VAR
+   ListUsed: ARRAY [0..20] OF BOOLEAN ;
+BEGIN
+   ListUsed[0] := TRUE ;
+   IF IsUsed(10)
+   THEN
+   END
+END testloop4.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testloop5.mod b/gcc/testsuite/gm2/dynamic/pass/testloop5.mod
new file mode 100644
index 00000000000..71fa027caee
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testloop5.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testloop5 ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+TYPE
+   PtrToNode = POINTER TO CARDINAL ;
+
+VAR
+   RemoveList: PtrToNode ;
+
+
+(*
+   FindNextUsedQuad - returns TRUE if node, q, is on a list defined by, p.
+*)
+
+PROCEDURE IsItemOnList (p: PtrToNode) : BOOLEAN ;
+BEGIN
+   WHILE p^#0 DO
+   END ;
+   RETURN( FALSE )
+END IsItemOnList ;
+
+
+BEGIN
+   RemoveList := NIL ;
+   IF IsItemOnList(RemoveList)
+   THEN
+   END
+END testloop5.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testmin.mod b/gcc/testsuite/gm2/dynamic/pass/testmin.mod
new file mode 100644
index 00000000000..b88aded8402
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testmin.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   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 2, 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. *)
+
+MODULE testmin ;
+
+
+FROM SYSTEM IMPORT TSIZE ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard, WriteInt ;
+
+TYPE
+   barfoo      = CARDINAL ;
+   foobar      = barfoo ;
+   ColourCodes = (black, brown, red, orange) ;
+
+VAR
+   i: INTEGER ;
+   b: BOOLEAN ;
+   c: CARDINAL ;
+   s: BITSET ;
+   t: ColourCodes ;
+BEGIN
+   WriteString('INTEGER  ') ; WriteCard(TSIZE(INTEGER), 8) ; WriteLn ;
+   WriteString('INTEGER  ') ; WriteInt(MAX(INTEGER), 12) ; WriteInt(MIN(INTEGER), 12) ; WriteLn ;
+   WriteString('CARDINAL ') ; WriteCard(MAX(CARDINAL), 12) ; WriteCard(MIN(CARDINAL), 12) ; WriteLn ;
+   WriteString('BOOLEAN  ') ; WriteCard(VAL(CARDINAL, MAX(BOOLEAN)), 12) ; WriteCard(VAL(CARDINAL, MIN(BOOLEAN)), 12) ; WriteLn ;
+   WriteString('BITSET   ') ; WriteCard(MAX(BITSET), 12) ; WriteCard(MIN(BITSET), 12) ; WriteLn ;
+   FOR t := MIN(ColourCodes) TO MAX(ColourCodes) DO
+
+   END
+END testmin.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testnum4.mod b/gcc/testsuite/gm2/dynamic/pass/testnum4.mod
new file mode 100644
index 00000000000..59b5545554f
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testnum4.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testnum4 ;
+
+FROM NumberIO IMPORT WriteHex ;
+FROM StrIO IMPORT WriteLn ;
+
+
+BEGIN
+   WriteHex(1234H, 8) ; WriteLn
+END testnum4.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testord.mod b/gcc/testsuite/gm2/dynamic/pass/testord.mod
new file mode 100644
index 00000000000..4879b27305b
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testord.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testord ;
+
+FROM StdIO IMPORT Write ;
+
+PROCEDURE foo ;
+BEGIN
+   i := 2
+END foo ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   foo ;
+   Write(CHR(i+ORD('0')))
+END testord.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testparam.mod b/gcc/testsuite/gm2/dynamic/pass/testparam.mod
new file mode 100644
index 00000000000..dc8a3896a64
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testparam.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testparam ;
+
+
+PROCEDURE p (a, b, c, d: CARDINAL) ;
+BEGIN
+   
+END p ;
+
+
+
+BEGIN
+   p(1, 2, 3, 2)
+END testparam.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testparam2.mod b/gcc/testsuite/gm2/dynamic/pass/testparam2.mod
new file mode 100644
index 00000000000..f40ef94cb7f
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testparam2.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testparam2 ;
+
+
+TYPE
+   RegisterList = RECORD
+                     state     : (free, used, etc) ;
+                     Reg       : CARDINAL ;
+                     CleanAlias: CARDINAL ;
+                     DirtyAlias: CARDINAL ;
+                  END ;
+
+PROCEDURE DuplicateList (i: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( i )
+END DuplicateList ;
+
+
+PROCEDURE GetRegisterAssociate (reg: CARDINAL; VAR clean, dirty: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := InitRegisterPtr ;
+   WHILE i>0 DO
+      IF ListOfRegisters[i-1].Reg=reg
+      THEN
+         clean := DuplicateList(ListOfRegisters[i-1].CleanAlias) ;
+         dirty := DuplicateList(ListOfRegisters[i-1].DirtyAlias) ;
+         RETURN
+      ELSE
+         DEC(i)
+      END
+   END
+END GetRegisterAssociate ;
+
+
+VAR
+   c, d: CARDINAL ;
+   ListOfRegisters: ARRAY [0..10] OF RegisterList ;
+   InitRegisterPtr: CARDINAL ;
+BEGIN
+   GetRegisterAssociate(1, c, d)
+END testparam2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testproc.mod b/gcc/testsuite/gm2/dynamic/pass/testproc.mod
new file mode 100644
index 00000000000..483ec9e441c
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testproc.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testproc ;
+
+
+VAR
+   p: PROC ;
+BEGIN
+   p
+END testproc.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testproc2.c b/gcc/testsuite/gm2/dynamic/pass/testproc2.c
new file mode 100644
index 00000000000..18927e842c0
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testproc2.c
@@ -0,0 +1,21 @@
+
+int testproc2_x;
+
+void _M2_init (void)
+{
+  testproc2_x = 1;
+}
+
+int bar (void)
+{
+  int t, t1;
+  int c1;
+
+  t = testproc2_x;
+  t1 = t + 1;
+  testproc2_x = t1;
+  c1 = testproc2_x;
+  return c1;
+}
+
+
diff --git a/gcc/testsuite/gm2/dynamic/pass/testproc2.def b/gcc/testsuite/gm2/dynamic/pass/testproc2.def
new file mode 100644
index 00000000000..aa511e59ae8
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testproc2.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+DEFINITION MODULE testproc2 ;
+
+PROCEDURE bar () : CARDINAL ;
+
+VAR
+   x: CARDINAL ;
+
+END testproc2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testproc2.mod b/gcc/testsuite/gm2/dynamic/pass/testproc2.mod
new file mode 100644
index 00000000000..a853491ee8c
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testproc2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2007 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 2, 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. *)
+
+IMPLEMENTATION MODULE testproc2 ;
+
+PROCEDURE bar () : CARDINAL ;
+VAR
+   c1: CARDINAL ;
+BEGIN
+   INC(x) ;
+   c1 := x ;  (* xxxxxx *)
+   RETURN c1
+END bar ;
+
+
+BEGIN
+   x := 1
+END testproc2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testscn.mod b/gcc/testsuite/gm2/dynamic/pass/testscn.mod
new file mode 100644
index 00000000000..914181b1c18
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testscn.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testscn ;
+
+
+CONST
+   Width     = 80 ;
+   Height    = 25 ;
+
+TYPE
+   DisplayUnit = RECORD
+                    char  : CHAR ;
+                    attrib: CHAR ;
+                 END ;
+
+   Line        = ARRAY [0..Width-1] OF DisplayUnit ;
+   Screen      = ARRAY [0..Height-1] OF Line ;
+
+VAR
+   screen    : POINTER TO Screen ;
+
+
+PROCEDURE ScrollUp ;
+VAR
+   j: CARDINAL ;
+BEGIN
+   FOR j := 0 TO Height-2 DO
+      screen^[j] := screen^[j+1]
+   END
+END ScrollUp ;
+
+
+BEGIN
+   ScrollUp
+END testscn.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testset.mod b/gcc/testsuite/gm2/dynamic/pass/testset.mod
new file mode 100644
index 00000000000..f699fb8fd9b
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testset.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testset ;
+
+FROM NumberIO IMPORT WriteHex ;
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   b: BITSET ;
+   j, i: CARDINAL ;
+BEGIN
+   FOR i := 0 TO 16 DO
+      b := {} ;
+      INCL(b, i) ;
+      WriteHex(CARDINAL(b), 4) ; WriteLn
+   END
+END testset.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testset2.mod b/gcc/testsuite/gm2/dynamic/pass/testset2.mod
new file mode 100644
index 00000000000..fcaddfed55b
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testset2.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testset2 ;
+
+FROM NumberIO IMPORT WriteHex ;
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   b,
+   j, i: CARDINAL ;
+BEGIN
+   FOR i := 0 TO 16 DO
+      j := (i+j) + 4*i ;
+      WriteHex(CARDINAL(j), 4) ; WriteLn
+   END
+END testset2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testset3.mod b/gcc/testsuite/gm2/dynamic/pass/testset3.mod
new file mode 100644
index 00000000000..99a0618715a
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testset3.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testset3 ;
+
+VAR
+   i, j: BITSET ;
+BEGIN
+   EXCL(i, 4)
+END testset3.
diff --git a/gcc/testsuite/gm2/dynamic/pass/teststr.c b/gcc/testsuite/gm2/dynamic/pass/teststr.c
new file mode 100644
index 00000000000..7ea383ab82e
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/teststr.c
@@ -0,0 +1,12 @@
+extern void StrLib_StrCopy(char *b, unsigned int length, char *a, unsigned int);
+
+static char a[50];
+
+void foo (char *b, unsigned int length)
+{
+  char Copy[length+1];
+
+  strcpy(Copy, b);
+  StrLib_StrCopy(b, length, a, 50);
+}
+
diff --git a/gcc/testsuite/gm2/dynamic/pass/teststr.mod b/gcc/testsuite/gm2/dynamic/pass/teststr.mod
new file mode 100644
index 00000000000..da19b2f7ef4
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/teststr.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE teststr ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrCopy, StrConCat, StrLen, StrEqual ;
+FROM NumberIO IMPORT WriteCard ;
+
+PROCEDURE foo (b: ARRAY OF CHAR) ;
+BEGIN
+   StrCopy(b, a)
+END foo ;
+
+VAR
+   a: ARRAY [0..50] OF CHAR ;
+BEGIN
+   foo('hello') ;
+   WriteString('hello world') ; WriteLn ;
+   StrCopy('hello gaius', a) ; WriteString(a) ; WriteLn ;
+   StrCopy('2', a) ; WriteString(a) ; WriteLn ;
+   StrConCat('1', a, a) ; WriteString(a) ; WriteLn ;
+   StrConCat(a, a, a) ; WriteString(a) ; WriteLn ;
+(*   WriteString('length of a = ') ; WriteCard(StrLen(a), 10) ; WriteLn ; *)
+   IF StrEqual(a, '1212')
+   THEN
+      WriteString('yes')
+   ELSE
+      WriteString('no')
+   END ;
+   StrConCat(a, a, a) ; WriteString(a) ; WriteLn ;
+   IF StrEqual(a, '1212')
+   THEN
+      WriteString('yes')
+   ELSE
+      WriteString('no')
+   END ;
+   WriteLn ;
+END teststr.
diff --git a/gcc/testsuite/gm2/dynamic/pass/teststr2.mod b/gcc/testsuite/gm2/dynamic/pass/teststr2.mod
new file mode 100644
index 00000000000..58ee8ea6dc8
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/teststr2.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE teststr2 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrCopy, StrConCat ;
+
+CONST
+   MaxIterations = 100000 ;
+
+VAR
+   i: CARDINAL ;
+   a: ARRAY [0..1000] OF CHAR ;
+BEGIN
+   WriteString('timing strcopy...') ; WriteLn ;
+   FOR i := 1 TO MaxIterations DO
+      StrCopy('abcdefghijklmnopqrstuwvxyz', a) ;
+      StrConCat(a, a, a)
+   END ;
+   WriteString('done') ; WriteLn
+END teststr2.
diff --git a/gcc/testsuite/gm2/dynamic/pass/teststring.mod b/gcc/testsuite/gm2/dynamic/pass/teststring.mod
new file mode 100644
index 00000000000..625cc0d7165
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/teststring.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE teststring ;
+
+FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
+
+TYPE
+   MINE = ARRAY [0..40] OF CHAR ;
+
+PROCEDURE foo (VAR a: MINE) ;
+BEGIN
+   a := "hello world" ;
+   LOOP
+      WriteString('> ') ;
+      ReadString(a) ; WriteLn ;
+      WriteString('String was: ') ; WriteString(a) ; WriteLn
+   END
+END foo ;
+
+VAR
+   b: MINE ;
+BEGIN
+   foo(b) ;
+   b := "and again"
+END teststring.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testunbounded.mod b/gcc/testsuite/gm2/dynamic/pass/testunbounded.mod
new file mode 100644
index 00000000000..44125a52fb7
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testunbounded.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testunbounded ;
+
+FROM StrIO IMPORT WriteString ;
+
+
+TYPE
+   DESCRIPTOR = POINTER TO RECORD
+                              a, b, c, d, e: CARDINAL ;
+                              RunName: ARRAY [0..15] OF CHAR ;
+                           END ;
+
+
+PROCEDURE DisplayProcess (p: DESCRIPTOR) ;
+VAR
+   a: ARRAY [0..4] OF CHAR ;
+   db: ARRAY [0..50] OF CHAR ;
+BEGIN
+   WITH p^ DO
+      WriteString(RunName)
+   END
+END DisplayProcess ;
+
+
+VAR
+   p: DESCRIPTOR ;
+BEGIN
+   DisplayProcess(p)
+END testunbounded.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testwith.mod b/gcc/testsuite/gm2/dynamic/pass/testwith.mod
new file mode 100644
index 00000000000..1d9a8647046
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testwith.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testwith ;
+
+
+TYPE
+   List = POINTER TO RECORD
+                        bar: CARDINAL ;
+                     END ;
+
+
+PROCEDURE foo (l: List) ;
+BEGIN
+   WITH l^ DO
+      INC(bar)
+   END
+END foo ;
+
+
+VAR
+   l: List ;
+BEGIN
+   foo(l)
+END testwith.
diff --git a/gcc/testsuite/gm2/dynamic/pass/testzero.mod b/gcc/testsuite/gm2/dynamic/pass/testzero.mod
new file mode 100644
index 00000000000..6f2403baca7
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/testzero.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testzero ;
+
+
+
+VAR
+   a, b, c: CARDINAL ;
+BEGIN
+   a := 0 ;
+   b := 0 ;
+   c := 0
+END testzero.
diff --git a/gcc/testsuite/gm2/dynamic/pass/wc.mod b/gcc/testsuite/gm2/dynamic/pass/wc.mod
new file mode 100644
index 00000000000..f32d0c95637
--- /dev/null
+++ b/gcc/testsuite/gm2/dynamic/pass/wc.mod
@@ -0,0 +1,59 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE wc ;
+
+
+FROM StdIO IMPORT Read ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+FROM ASCII IMPORT cr ;
+
+CONST
+   Max = 1000 ;
+
+VAR
+   a    : ARRAY [0..Max] OF CHAR ;
+   words,
+   word : CARDINAL ;
+   chars: CARDINAL ;
+   ch   : CHAR ;
+BEGIN
+   word := 0 ;
+   words := 0 ;
+   chars := 0 ;
+   Read(ch) ;
+   WHILE ch#cr DO
+      INC(chars) ;
+      a[chars] := ch ;
+      IF ch#' '
+      THEN
+         IF word=0
+         THEN
+            word := 1 ;
+            INC(words)
+         END
+      ELSE
+         word := 0
+      END ;
+      Read(ch)
+   END ;
+   WriteLn ;
+   WriteCard(words, 4) ;
+   WriteLn ;
+   WriteCard(chars, 4) ;
+   WriteLn
+END wc.
diff --git a/gcc/testsuite/gm2/embedded/pass/embedded-pass.exp b/gcc/testsuite/gm2/embedded/pass/embedded-pass.exp
new file mode 100644
index 00000000000..e21d9e2d629
--- /dev/null
+++ b/gcc/testsuite/gm2/embedded/pass/embedded-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/pim/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/embedded/pass/varataddress.mod b/gcc/testsuite/gm2/embedded/pass/varataddress.mod
new file mode 100644
index 00000000000..fef65a9724c
--- /dev/null
+++ b/gcc/testsuite/gm2/embedded/pass/varataddress.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE varataddress ;
+
+VAR
+   GPIORegisters[20200000H]: BITSET ;
+
+BEGIN
+END varataddress.
diff --git a/gcc/testsuite/gm2/embedded/pass/varataddress1.mod b/gcc/testsuite/gm2/embedded/pass/varataddress1.mod
new file mode 100644
index 00000000000..da0b0208b99
--- /dev/null
+++ b/gcc/testsuite/gm2/embedded/pass/varataddress1.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2013 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. *)
+
+MODULE varataddress1 ;
+
+FROM SYSTEM IMPORT WORD ;
+
+VAR
+   GPIORegisters[20200000H]: WORD ;
+
+BEGIN
+END varataddress1.
diff --git a/gcc/testsuite/gm2/embedded/pass/varataddress2.mod b/gcc/testsuite/gm2/embedded/pass/varataddress2.mod
new file mode 100644
index 00000000000..0b79c64f24a
--- /dev/null
+++ b/gcc/testsuite/gm2/embedded/pass/varataddress2.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2013 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. *)
+
+MODULE varataddress2 ;
+
+TYPE
+   registers = ARRAY [0..3] OF BITSET ;
+
+VAR
+   GPIORegisters[20200000H]: registers;
+
+BEGIN
+END varataddress2.
diff --git a/gcc/testsuite/gm2/embedded/pass/varataddress3.mod b/gcc/testsuite/gm2/embedded/pass/varataddress3.mod
new file mode 100644
index 00000000000..e47cc020482
--- /dev/null
+++ b/gcc/testsuite/gm2/embedded/pass/varataddress3.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2013 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. *)
+
+MODULE varataddress2 ;
+
+TYPE
+   registers = ARRAY [0..3] OF BITSET ;
+
+VAR
+   GPIORegisters[20200000H]: registers;
+
+BEGIN
+   INCL(GPIORegisters[0], 0) ;
+   INCL(GPIORegisters[1], 1) ;
+   INCL(GPIORegisters[2], 2) ;
+   INCL(GPIORegisters[3], 3)
+END varataddress2.
diff --git a/gcc/testsuite/gm2/errors/fail/array1.mod b/gcc/testsuite/gm2/errors/fail/array1.mod
new file mode 100644
index 00000000000..274011be953
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/array1.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE array1 ;
+
+VAR
+   a: ARRAY [FALSE..TRUE] OF CARDINAL ;
+   i, j: CARDINAL ;
+BEGIN
+   a[i=j] := j
+END array1.
diff --git a/gcc/testsuite/gm2/errors/fail/badexpr.mod b/gcc/testsuite/gm2/errors/fail/badexpr.mod
new file mode 100644
index 00000000000..3e5d3ce9106
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badexpr.mod
@@ -0,0 +1,13 @@
+MODULE badexpr ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+VAR
+    i: CARDINAL;
+    a: ADDRESS ;
+BEGIN
+    a := NIL;
+    WHILE i < a DO
+        INC (i)
+    END;
+END badexpr.
diff --git a/gcc/testsuite/gm2/errors/fail/badfor.mod b/gcc/testsuite/gm2/errors/fail/badfor.mod
new file mode 100644
index 00000000000..544274dcf75
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badfor.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2019  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 2, 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. *)
+
+MODULE badfor ;
+
+
+TYPE
+   rec = RECORD
+            x, y: CARDINAL ;
+         END ;
+
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   FOR i := 1 TO rec DO
+
+   END
+END badfor.
diff --git a/gcc/testsuite/gm2/errors/fail/badhigh.mod b/gcc/testsuite/gm2/errors/fail/badhigh.mod
new file mode 100644
index 00000000000..44ba128bc05
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badhigh.mod
@@ -0,0 +1,9 @@
+MODULE badhigh;
+VAR
+    i, high : CARDINAL;
+BEGIN
+    high := 10;
+    WHILE i < HIGH DO
+        INC(i);
+    END;
+END badhigh.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/badshift.mod b/gcc/testsuite/gm2/errors/fail/badshift.mod
new file mode 100644
index 00000000000..7c38ebfca12
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badshift.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2020 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/>.  *)
+
+MODULE badshift ;
+
+(* bad expression containing a legal shift.  *)
+
+FROM SYSTEM IMPORT ADR, ADDRESS, SHIFT ;
+
+VAR
+   s: SET OF [0..15] ;
+   c: CHAR ;
+BEGIN
+   (* should generate a subexpression error with the call to SHIFT.  *)
+   s := SHIFT (s, 1) + c
+END badshift.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/badsubexpradr.mod b/gcc/testsuite/gm2/errors/fail/badsubexpradr.mod
new file mode 100644
index 00000000000..61c5d82214d
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badsubexpradr.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2020 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/>.  *)
+
+MODULE badsubexpradr ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+
+VAR
+   a: ADDRESS ;
+   c: CHAR ;
+BEGIN
+   (* should generate a subexpression error with the call to ADR.  *)
+   a := ADR (c) + c ;
+END badsubexpradr.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/binaryconst.mod b/gcc/testsuite/gm2/errors/fail/binaryconst.mod
new file mode 100644
index 00000000000..d499246a113
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/binaryconst.mod
@@ -0,0 +1,7 @@
+MODULE binaryconst ;
+
+VAR
+   r: REAL ;
+BEGIN
+   r := 1.2 + 1
+END binaryconst.
diff --git a/gcc/testsuite/gm2/errors/fail/binarygeneric.mod b/gcc/testsuite/gm2/errors/fail/binarygeneric.mod
new file mode 100644
index 00000000000..5bafe85b4cf
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/binarygeneric.mod
@@ -0,0 +1,11 @@
+MODULE binarygeneric ;
+
+FROM SYSTEM IMPORT WORD ;
+
+VAR
+   a, b, c: WORD ;
+BEGIN
+   b := 1 ;
+   c := 2 ;
+   a := b + c
+END binarygeneric.
diff --git a/gcc/testsuite/gm2/errors/fail/binarygenericconst.mod b/gcc/testsuite/gm2/errors/fail/binarygenericconst.mod
new file mode 100644
index 00000000000..47085c4ee22
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/binarygenericconst.mod
@@ -0,0 +1,10 @@
+MODULE binarygenericconst ;
+
+FROM SYSTEM IMPORT WORD ;
+
+VAR
+   a, b: WORD ;
+BEGIN
+   b := 1 ;
+   a := 1 + b
+END binarygenericconst.
diff --git a/gcc/testsuite/gm2/errors/fail/end.mod b/gcc/testsuite/gm2/errors/fail/end.mod
new file mode 100644
index 00000000000..1607936b5ac
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/end.mod
@@ -0,0 +1,20 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE end ;
+
+BEGIN
+end.
diff --git a/gcc/testsuite/gm2/errors/fail/errors-fail.exp b/gcc/testsuite/gm2/errors/fail/errors-fail.exp
new file mode 100644
index 00000000000..5f578b92cf3
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/errors-fail.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/errors/fail" -Wpedantic -Wstudents -Wunused-variable
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/errors/fail/mismatched.mod b/gcc/testsuite/gm2/errors/fail/mismatched.mod
new file mode 100644
index 00000000000..e0efb3646b3
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/mismatched.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2019  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 2, 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. *)
+
+MODULE mismatched ;
+
+
+BEGIN
+
+END mismat.
diff --git a/gcc/testsuite/gm2/errors/fail/mismatchedproc.mod b/gcc/testsuite/gm2/errors/fail/mismatchedproc.mod
new file mode 100644
index 00000000000..1326325a201
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/mismatchedproc.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2019  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 2, 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. *)
+
+MODULE mismatchedproc ;
+
+PROCEDURE foo ;
+BEGIN
+
+END bar ;
+
+
+BEGIN
+
+END mismatchedproc.
diff --git a/gcc/testsuite/gm2/errors/fail/nestedproc4.mod b/gcc/testsuite/gm2/errors/fail/nestedproc4.mod
new file mode 100644
index 00000000000..25ea76076b4
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/nestedproc4.mod
@@ -0,0 +1,78 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc4 ;
+
+FROM StdIO IMPORT Write ;
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   s: ARRAY [0..10] OF CHAR ;
+
+PROCEDURE a ;
+
+PROCEDURE b ;
+VAR
+   p: PROC ;
+
+PROCEDURE c ;
+VAR
+   s: ARRAY [0..10] OF CHAR ;
+
+PROCEDURE d ;
+
+PROCEDURE e ;
+BEGIN
+   s[4] := 'a' ;
+   b2
+END e ;
+
+BEGIN
+   e
+END d ;
+
+BEGIN
+   d
+END c ;
+
+BEGIN
+   foo(b) ;
+   p := b ;
+   c
+END b ;
+
+PROCEDURE b2 ;
+BEGIN
+   s[4] := 'g' ;
+END b2 ;
+
+
+BEGIN
+   s := 'abcdgfghi' ;
+   b ;
+   Write(s[4]) ; WriteLn
+   (* output should be 'g' *)
+END a ;
+
+
+PROCEDURE foo (p: PROC) ;
+BEGIN
+END foo ;
+
+
+BEGIN
+   a
+END nestedproc4.
diff --git a/gcc/testsuite/gm2/errors/fail/nomodule.mod b/gcc/testsuite/gm2/errors/fail/nomodule.mod
new file mode 100644
index 00000000000..d62e9723404
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/nomodule.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE nomodule ;
+
+FROM none IMPORT foobar ;
+
+BEGIN
+
+END nomodule.
diff --git a/gcc/testsuite/gm2/errors/fail/proctype.mod b/gcc/testsuite/gm2/errors/fail/proctype.mod
new file mode 100644
index 00000000000..56d72fadd72
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/proctype.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE proctype ;
+
+
+PROCEDURE count (c: INTEGER; ch: CHAR) ;
+BEGIN
+END count ;
+
+TYPE
+   proc = PROCEDURE (INTEGER, CARDINAL) ;
+
+VAR
+   p: proc ;
+BEGIN
+   p := count
+END proctype.
diff --git a/gcc/testsuite/gm2/errors/fail/prog110.mod b/gcc/testsuite/gm2/errors/fail/prog110.mod
new file mode 100644
index 00000000000..6fcbf831eb3
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/prog110.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE prog110;
+
+FROM StrIO IMPORT WriteString, WriteLn;
+FROM NumberIO IMPORT ReadInt, WriteInt;
+
+VAR
+    n : INTEGER ;      (* Number to divide *)
+    d : INTEGER ;      (* Divisor *)
+    result : INTEGER;  (* Result from divide *)
+    r : INTEGER ;      (* Remainder *)
+    c : CHAR ;         (* Answer from user to continue y/n *)
+
+BEGIN
+   c := "Y";          (* set this to Y so it does the loop the first
+time *)
+   
+   WHILE c = "y" OR c = "Y" DO
+      WriteString "Input Number to divide (n)";
+      ReadInt (n);
+      WriteString "Input Number to divide by n";
+      ReadInt (d);
+      
+      R := 0;
+      result := N DIV D;
+
+   END
+END prog110.
diff --git a/gcc/testsuite/gm2/errors/fail/prog111.mod b/gcc/testsuite/gm2/errors/fail/prog111.mod
new file mode 100644
index 00000000000..3efb1685b4c
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/prog111.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE prog111 ;
+
+
+VAR
+   n: INTEGER ;
+BEGIN
+   n := n(1)
+END prog111.
diff --git a/gcc/testsuite/gm2/errors/fail/prog113.mod b/gcc/testsuite/gm2/errors/fail/prog113.mod
new file mode 100644
index 00000000000..4dda4cf1d4a
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/prog113.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE prog113 ;
+
+FROM FIO IMPORT ReadString, File ;
+
+VAR
+   f: File ;
+   a: ARRAY [0..100] OF CHAR ;
+BEGIN
+   FIO.ReadString(f, a)
+END prog113.
diff --git a/gcc/testsuite/gm2/errors/fail/prog114.mod b/gcc/testsuite/gm2/errors/fail/prog114.mod
new file mode 100644
index 00000000000..5988801d376
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/prog114.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE prog114 ;
+
+
+PROCEDURE test (a: ARRAY OF CHAR;) ;
+BEGIN
+END test ;
+
+
+BEGIN
+
+END prog114.
diff --git a/gcc/testsuite/gm2/errors/fail/testaddress.mod b/gcc/testsuite/gm2/errors/fail/testaddress.mod
new file mode 100644
index 00000000000..7a26d8617f4
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testaddress.mod
@@ -0,0 +1,10 @@
+MODULE testaddress ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+VAR
+   a: ADDRESS ;
+   c: CARDINAL ;
+BEGIN
+   c := a + 'z'
+END testaddress.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/testarray.mod b/gcc/testsuite/gm2/errors/fail/testarray.mod
new file mode 100644
index 00000000000..34ee08adc77
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testarray.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testarray ;
+
+
+VAR
+   a: (* ARRAY *) [0..10] OF CHAR ;
+BEGIN
+
+END testarray.
diff --git a/gcc/testsuite/gm2/errors/fail/testbit.mod b/gcc/testsuite/gm2/errors/fail/testbit.mod
new file mode 100644
index 00000000000..56c0128f503
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testbit.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testbit ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+VAR
+   c   : CARDINAL ;
+   a, b: BITSET ;
+BEGIN
+   IF c IN c
+   THEN
+      WriteString('hmm') ; WriteLn
+   END
+END testbit.
diff --git a/gcc/testsuite/gm2/errors/fail/testbit2.mod b/gcc/testsuite/gm2/errors/fail/testbit2.mod
new file mode 100644
index 00000000000..d851b0990cc
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testbit2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testbit2 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+VAR
+   c   : CARDINAL ;
+   a, b: BITSET ;
+BEGIN
+   IF b IN b
+   THEN
+      WriteString('hmm') ; WriteLn
+   END
+END testbit2.
diff --git a/gcc/testsuite/gm2/errors/fail/testcase.mod b/gcc/testsuite/gm2/errors/fail/testcase.mod
new file mode 100644
index 00000000000..337fa66b61a
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testcase.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcase ;
+
+
+TYPE
+   bar = CARDINAL ;
+
+var
+   a: CARDINAL ;
+BEGIN
+   a := 1
+END testcase.
diff --git a/gcc/testsuite/gm2/errors/fail/testcomment.mod b/gcc/testsuite/gm2/errors/fail/testcomment.mod
new file mode 100644
index 00000000000..aa0a774ffd3
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testcomment.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcomment ;
+
+(*
+FROM NumberIO IMPORT WriteCard ;
+
+
+
+BEGIN
+
+END testcomment.
diff --git a/gcc/testsuite/gm2/errors/fail/testcomment2.mod b/gcc/testsuite/gm2/errors/fail/testcomment2.mod
new file mode 100644
index 00000000000..29406153f47
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testcomment2.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcomment2 ;
+
+
+FROM NumberIO (* IMPORT WriteCard ;
+
+
+BEGIN
+
+END testcomment2.
diff --git a/gcc/testsuite/gm2/errors/fail/testcomment3.mod b/gcc/testsuite/gm2/errors/fail/testcomment3.mod
new file mode 100644
index 00000000000..f064606db57
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testcomment3.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testcomment3 ;
+
+
+
+(*--*)*)
+
+BEGIN
+END testcomment3.
diff --git a/gcc/testsuite/gm2/errors/fail/testconst.mod b/gcc/testsuite/gm2/errors/fail/testconst.mod
new file mode 100644
index 00000000000..5d89c23a3d0
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testconst.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testconst ;
+
+
+
+BEGIN
+   MAX:=10;
+END testconst.
diff --git a/gcc/testsuite/gm2/errors/fail/testdyn.mod b/gcc/testsuite/gm2/errors/fail/testdyn.mod
new file mode 100644
index 00000000000..f9e3e805600
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testdyn.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testdyn ;
+
+
+FROM StrLib IMPORT StrEqual ;
+
+TYPE
+   Results = ARRAY [0..9] OF CHAR ;
+   Double  = ARRAY [0..4] OF Results ;
+VAR
+   Value   : ARRAY [0..9] OF CHAR ;
+BEGIN
+   IF StrEqual(Double[1], Value)
+   THEN
+   END
+END testdyn.
diff --git a/gcc/testsuite/gm2/errors/fail/testdyn2.mod b/gcc/testsuite/gm2/errors/fail/testdyn2.mod
new file mode 100644
index 00000000000..c6e47c6d41e
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testdyn2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testdyn2 ;
+
+
+TYPE
+   Results = ARRAY [0..9] OF CHAR ;
+   Double  = ARRAY [0..4] OF Results ;
+VAR
+   Value   : ARRAY [0..9] OF CHAR ;
+BEGIN
+   Double[1] := Value
+END testdyn2.
diff --git a/gcc/testsuite/gm2/errors/fail/testdyn3.mod b/gcc/testsuite/gm2/errors/fail/testdyn3.mod
new file mode 100644
index 00000000000..653a299c615
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testdyn3.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testdyn3 ;
+
+
+TYPE
+   Results = ARRAY [0..9] OF CHAR ;
+   Double  = ARRAY [0..4] OF Results ;
+VAR
+   Value   : ARRAY [0..9] OF CHAR ;
+BEGIN
+   Value := Double[1]
+END testdyn3.
diff --git a/gcc/testsuite/gm2/errors/fail/testexp.mod b/gcc/testsuite/gm2/errors/fail/testexp.mod
new file mode 100644
index 00000000000..7d41b18f5ef
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testexp.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testexp ;
+
+
+VAR
+   a, b, c, d: BOOLEAN ;
+BEGIN
+   IF a=b AND c=d
+   THEN
+   END
+END testexp.
diff --git a/gcc/testsuite/gm2/errors/fail/testfio.mod b/gcc/testsuite/gm2/errors/fail/testfio.mod
new file mode 100644
index 00000000000..fabf93ecb95
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testfio.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testfio ;
+
+FROM Args IMPORT GetArg ;
+FROM StdIO IMPORT Write ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM FIO IMPORT Exists, OpenToRead, Close, File, IsNoError, EOF, ReadChar ;
+
+VAR
+   i: INTEGER ;
+   f: File ;
+   c: CARDINAL ;
+   a: ARRAY [0..20] OF CHAR ;
+BEGIN
+   WriteString('testfio starting') ; WriteLn ;
+   c := 1 ;
+   WHILE GetArg(a, c) DO
+      WriteString('File: ') ; WriteString(a) ;
+      IF Exists(a)
+      THEN
+         WriteString(' exists') ; WriteLn ;
+         f := OpenToRead(a) ;
+         WHILE NOT EOF(i) DO
+            Write(ReadChar(f))
+         END ;
+         Close(f)
+      ELSE
+         WriteString(' not found: ') ; WriteString(a) ; WriteLn
+      END ;
+      INC(c)
+   END
+END testfio.
diff --git a/gcc/testsuite/gm2/errors/fail/testimport.mod b/gcc/testsuite/gm2/errors/fail/testimport.mod
new file mode 100644
index 00000000000..755364fcc87
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testimport.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testimport ;
+
+FROM testimport2 IMPORT foo, bar ;
+FROM testimport2 IMPORT bar ;
+
+BEGIN
+   foo ;
+   bar
+END testimport.
diff --git a/gcc/testsuite/gm2/errors/fail/testimport2.def b/gcc/testsuite/gm2/errors/fail/testimport2.def
new file mode 100644
index 00000000000..50e5170f316
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testimport2.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+DEFINITION MODULE testimport2 ;
+
+PROCEDURE foo ;
+PROCEDURE bar ;
+
+END testimport2.
diff --git a/gcc/testsuite/gm2/errors/fail/testimport2.mod b/gcc/testsuite/gm2/errors/fail/testimport2.mod
new file mode 100644
index 00000000000..5b0e7b5daf1
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testimport2.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE testimport2 ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+
+PROCEDURE bar ;
+BEGIN
+END bar ;
+
+VAR
+   bar: CARDINAL ;
+
+END testimport2.
diff --git a/gcc/testsuite/gm2/errors/fail/testinit.mod b/gcc/testsuite/gm2/errors/fail/testinit.mod
new file mode 100644
index 00000000000..d0d9bb02ec0
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testinit.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testinit ;
+
+
+PROCEDURE ToThePower (i, n: CARDINAL) : CARDINAL ;
+BEGIN
+   IF n=0
+   THEN
+      RETURN( 1 )
+   ELSE
+      WHILE n>1 DO
+         i := i * i ;
+         DEC(n)
+      END ;
+      RETURN( i )
+   END
+END ToThePower ;
+
+
+PROCEDURE foo ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   n := ToThePower(n, 2)
+END foo ;
+
+BEGIN
+   foo
+END testinit.
diff --git a/gcc/testsuite/gm2/errors/fail/testmodule.mod b/gcc/testsuite/gm2/errors/fail/testmodule.mod
new file mode 100644
index 00000000000..8785cc35341
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testmodule.mod
@@ -0,0 +1,7 @@
+MODULE testmodule ;
+
+IMPORT Storage ;
+
+BEGIN
+   Storage (1)
+END testmodule.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/testnil.mod b/gcc/testsuite/gm2/errors/fail/testnil.mod
new file mode 100644
index 00000000000..aeb3c2a4b4d
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testnil.mod
@@ -0,0 +1,7 @@
+MODULE testnil ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := NIL
+END testnil.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/testnil2.mod b/gcc/testsuite/gm2/errors/fail/testnil2.mod
new file mode 100644
index 00000000000..6e3682e4765
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testnil2.mod
@@ -0,0 +1,7 @@
+MODULE testnil2 ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   NIL (c)
+END testnil2.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/testparam.mod b/gcc/testsuite/gm2/errors/fail/testparam.mod
new file mode 100644
index 00000000000..238334f35ba
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testparam.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testparam ;
+
+
+FROM FIO IMPORT IsNoError, Close, EOF ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   IF EOF(i)
+   THEN
+   END
+END testparam.
diff --git a/gcc/testsuite/gm2/errors/fail/testproc.mod b/gcc/testsuite/gm2/errors/fail/testproc.mod
new file mode 100644
index 00000000000..1c00287b68b
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testproc.mod
@@ -0,0 +1,9 @@
+MODULE testproc ;
+
+
+VAR
+   p: PROC ;
+   c: CARDINAL ;
+BEGIN
+   c := p + 'z'
+END testproc.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/testproc2.mod b/gcc/testsuite/gm2/errors/fail/testproc2.mod
new file mode 100644
index 00000000000..5a2621f19de
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testproc2.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testproc2 ;
+
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+
+
+PROCEDURE ToThePower (i, n: CARDINAL) : CARDINAL ;
+BEGIN
+   IF n=0
+   THEN
+      RETURN( 1 )
+   ELSE
+      WHILE n>1 DO
+         i := i*i ;
+         DEC(n)
+      END ;
+      RETURN( n )
+   END
+END ToThePower ;
+
+
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   a := ToThePower(b, a) ;
+   WriteCard('a', 12) ; WriteLn
+END testproc2.
diff --git a/gcc/testsuite/gm2/errors/fail/testsize.mod b/gcc/testsuite/gm2/errors/fail/testsize.mod
new file mode 100644
index 00000000000..5e0294c567d
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testsize.mod
@@ -0,0 +1,9 @@
+MODULE testsize ;
+
+FROM SYSTEM IMPORT SIZE ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := SIZE (1)
+END testsize.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/errors/fail/teststring.mod b/gcc/testsuite/gm2/errors/fail/teststring.mod
new file mode 100644
index 00000000000..24624c7696b
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/teststring.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE teststring ;
+
+VAR
+   str: ARRAY [0..40] OF CHAR ;
+BEGIN
+   str := "Delete record containing a particular surname"
+END teststring.
diff --git a/gcc/testsuite/gm2/errors/fail/testsub3.mod b/gcc/testsuite/gm2/errors/fail/testsub3.mod
new file mode 100644
index 00000000000..76f7525bea0
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testsub3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testsub3 ;
+
+TYPE
+   LIndex = CARDINAL ;
+   RIndex = CARDINAL ;
+
+VAR
+   i: LIndex ;
+   j: RIndex ;
+BEGIN
+   i := i + j + TRUE
+END testsub3.
diff --git a/gcc/testsuite/gm2/errors/fail/testsub4.mod b/gcc/testsuite/gm2/errors/fail/testsub4.mod
new file mode 100644
index 00000000000..88bef33481f
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testsub4.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testsub4 ;
+
+
+VAR
+   j: CARDINAL ;
+   i: BOOLEAN ;
+BEGIN
+   i := i + j
+END testsub4.
diff --git a/gcc/testsuite/gm2/errors/fail/testtype.mod b/gcc/testsuite/gm2/errors/fail/testtype.mod
new file mode 100644
index 00000000000..65b71a45198
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testtype.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testtype ;
+
+
+TYPE
+   T = CARDINAL ;
+
+VAR
+   v: T ;
+
+
+PROCEDURE foo (a: v) ;
+BEGIN
+END foo ;
+
+
+VAR
+   b: v ;
+BEGIN
+
+END testtype.
diff --git a/gcc/testsuite/gm2/errors/fail/testvar.mod b/gcc/testsuite/gm2/errors/fail/testvar.mod
new file mode 100644
index 00000000000..af1122591e0
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testvar.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testvar ;
+
+
+PROCEDURE foo ;
+   i := 6
+END foo ;
+
+
+BEGIN
+   foo
+END testvar.
diff --git a/gcc/testsuite/gm2/errors/fail/testwith.mod b/gcc/testsuite/gm2/errors/fail/testwith.mod
new file mode 100644
index 00000000000..87b546cbaec
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testwith.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testwith ;
+
+
+VAR
+   w: RECORD
+         a,
+         b: CARDINAL ;
+      END ;
+
+BEGIN
+   WITH x DO
+      a := 0
+   END
+END testwith.
diff --git a/gcc/testsuite/gm2/errors/fail/testwrite.mod b/gcc/testsuite/gm2/errors/fail/testwrite.mod
new file mode 100644
index 00000000000..8198660c84b
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/testwrite.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testwrite ;
+
+IMPORT StrIO ;
+IMPORT FIO ;
+
+
+VAR
+   which: RECORD
+             filehandle: FILE ;
+             Surname   : ARRAY [0..20] OF CHAR ;
+          END ;
+
+
+PROCEDURE do ;
+BEGIN
+   WITH which DO
+      StrIO.WriteString(filehandle,Surname)
+   END
+END do ;
+
+
+BEGIN
+   do
+END testwrite.
diff --git a/gcc/testsuite/gm2/errors/fail/type.mod b/gcc/testsuite/gm2/errors/fail/type.mod
new file mode 100644
index 00000000000..bf7adb16c03
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/type.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE type ;
+
+FROM FIO IMPORT EOF, OpenToRead ;
+IMPORT FIO ;
+
+VAR
+   f: File ;
+BEGIN
+   f := OpenToRead('nothing') ;
+   IF EOF(f)
+   THEN
+   END
+END type.
diff --git a/gcc/testsuite/gm2/errors/fail/unarygeneric.mod b/gcc/testsuite/gm2/errors/fail/unarygeneric.mod
new file mode 100644
index 00000000000..bd485ef29ef
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/unarygeneric.mod
@@ -0,0 +1,10 @@
+MODULE unarygeneric ;
+
+FROM SYSTEM IMPORT WORD ;
+
+VAR
+   a, b: WORD ;
+BEGIN
+   b := 1 ;
+   a := -b
+END unarygeneric.
diff --git a/gcc/testsuite/gm2/errors/mustfail b/gcc/testsuite/gm2/errors/mustfail
new file mode 100644
index 00000000000..8b137891791
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/mustfail
@@ -0,0 +1 @@
+
diff --git a/gcc/testsuite/gm2/errors/options b/gcc/testsuite/gm2/errors/options
new file mode 100644
index 00000000000..78c69642fef
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/options
@@ -0,0 +1 @@
+-pedantic -O -students
diff --git a/gcc/testsuite/gm2/errors/testchar.mod b/gcc/testsuite/gm2/errors/testchar.mod
new file mode 100644
index 00000000000..376cfade186
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/testchar.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE testchar ;
+
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := '0'
+END testchar.
diff --git a/gcc/testsuite/gm2/errors/testsub2.mod b/gcc/testsuite/gm2/errors/testsub2.mod
new file mode 100644
index 00000000000..fb1a1ac898c
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/testsub2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testsub2 ;
+
+TYPE
+   Index = CARDINAL ;
+
+VAR
+   i: Index ;
+BEGIN
+   DEC(i)
+END testsub2.
diff --git a/gcc/testsuite/gm2/examples/callingC/pass/examples-callingC-pass.exp b/gcc/testsuite/gm2/examples/callingC/pass/examples-callingC-pass.exp
new file mode 100644
index 00000000000..4c9ea5bf188
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/pass/examples-callingC-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "$srcdir/$subdir"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/examples/callingC/pass/hello.mod b/gcc/testsuite/gm2/examples/callingC/pass/hello.mod
new file mode 100644
index 00000000000..314e08b668c
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/pass/hello.mod
@@ -0,0 +1,28 @@
+(* hello.mod simple program call C printf.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+MODULE hello ;
+
+FROM libprintf IMPORT printf ;
+
+BEGIN
+   printf ("hello %s", "world\n")
+END hello.
diff --git a/gcc/testsuite/gm2/examples/callingC/pass/libprintf.def b/gcc/testsuite/gm2/examples/callingC/pass/libprintf.def
new file mode 100644
index 00000000000..326c5b048d9
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/pass/libprintf.def
@@ -0,0 +1,35 @@
+(* libprintf.def provides simple example of access to printf.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" libprintf ;
+
+
+EXPORT UNQUALIFIED printf ;
+
+PROCEDURE printf (a: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+
+
+END libprintf.
diff --git a/gcc/testsuite/gm2/examples/callingC/run/pass/c.c b/gcc/testsuite/gm2/examples/callingC/run/pass/c.c
new file mode 100644
index 00000000000..3a9959559f7
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/run/pass/c.c
@@ -0,0 +1,7 @@
+#include <string.h>
+
+int bar (char *file, char *mode)
+{
+  return strcmp(file, mode);
+}
+
diff --git a/gcc/testsuite/gm2/examples/callingC/run/pass/c.def b/gcc/testsuite/gm2/examples/callingC/run/pass/c.def
new file mode 100644
index 00000000000..828ed3a7eb5
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/run/pass/c.def
@@ -0,0 +1,33 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+DEFINITION MODULE FOR "C" c ;
+
+(*
+    Title      : c
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu Nov 26 19:58:36 2009
+    Revision   : $Version$ 
+    Description: tiny example of C definition module.
+*)
+
+EXPORT UNQUALIFIED bar ;
+
+PROCEDURE bar (a, b: ARRAY OF CHAR) : BOOLEAN ;
+
+END c.
diff --git a/gcc/testsuite/gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp b/gcc/testsuite/gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp
new file mode 100644
index 00000000000..04afa7c2621
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp
@@ -0,0 +1,43 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_iso "$srcdir/$subdir"
+gm2_link_obj "c.o"
+
+set output [target_compile $srcdir/$subdir/c.c c.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2_target_compile $srcdir/$subdir/m.mod m.o object "-g"
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/examples/callingC/run/pass/hello.mod b/gcc/testsuite/gm2/examples/callingC/run/pass/hello.mod
new file mode 100644
index 00000000000..314e08b668c
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/run/pass/hello.mod
@@ -0,0 +1,28 @@
+(* hello.mod simple program call C printf.
+
+Copyright (C) 2005-2021 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/>.  *)
+
+MODULE hello ;
+
+FROM libprintf IMPORT printf ;
+
+BEGIN
+   printf ("hello %s", "world\n")
+END hello.
diff --git a/gcc/testsuite/gm2/examples/callingC/run/pass/libprintf.def b/gcc/testsuite/gm2/examples/callingC/run/pass/libprintf.def
new file mode 100644
index 00000000000..326c5b048d9
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/run/pass/libprintf.def
@@ -0,0 +1,35 @@
+(* libprintf.def provides simple example of access to printf.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" libprintf ;
+
+
+EXPORT UNQUALIFIED printf ;
+
+PROCEDURE printf (a: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+
+
+END libprintf.
diff --git a/gcc/testsuite/gm2/examples/callingC/run/pass/m.mod b/gcc/testsuite/gm2/examples/callingC/run/pass/m.mod
new file mode 100644
index 00000000000..6107ef3260a
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/callingC/run/pass/m.mod
@@ -0,0 +1,19 @@
+MODULE m ;
+
+IMPORT c ;
+FROM SYSTEM IMPORT THROW, ADDRESS ;
+
+PROCEDURE foo (file : ARRAY OF CHAR) : ADDRESS ;
+BEGIN
+   IF c.bar(file, 'rb')
+   THEN
+   END ;
+   RETURN NIL ;
+END foo ;
+
+
+VAR
+   s: ADDRESS ;
+BEGIN
+   s := foo('test.bmp')
+END m.
diff --git a/gcc/testsuite/gm2/examples/cpp/pass/examples-cpp-pass.exp b/gcc/testsuite/gm2/examples/cpp/pass/examples-cpp-pass.exp
new file mode 100644
index 00000000000..e94c49df381
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/cpp/pass/examples-cpp-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "$srcdir/$subdir/" -fcpp
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/examples/cpp/pass/hello.mod b/gcc/testsuite/gm2/examples/cpp/pass/hello.mod
new file mode 100644
index 00000000000..786d1dedf34
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/cpp/pass/hello.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+                 2010
+                 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. *)
+
+MODULE hello ;
+
+#define HELLO "Hello world"
+#define TRUE (1==1)
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+BEGIN
+#if defined(TRUE)
+   WriteString(HELLO) ; WriteLn
+#else
+#  error "cpp was not called"
+#endif
+END hello.
diff --git a/gcc/testsuite/gm2/examples/cppDef/pass/a.def b/gcc/testsuite/gm2/examples/cppDef/pass/a.def
new file mode 100644
index 00000000000..ac33f7b7cab
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/cppDef/pass/a.def
@@ -0,0 +1,38 @@
+(* a.def trivial example using CPP in a definition module.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE a ;
+
+EXPORT QUALIFIED constValue ;
+
+CONST
+#if defined(VALUE)
+   constValue = VALUE ;
+#else
+   constValue = -1 ;
+#endif
+
+END a.
diff --git a/gcc/testsuite/gm2/examples/cppDef/pass/a.mod b/gcc/testsuite/gm2/examples/cppDef/pass/a.mod
new file mode 100644
index 00000000000..00487e3e216
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/cppDef/pass/a.mod
@@ -0,0 +1,29 @@
+(* a.mod dummy module for the trivial example.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+IMPLEMENTATION MODULE a ;
+
+END a.
diff --git a/gcc/testsuite/gm2/examples/cppDef/pass/b.mod b/gcc/testsuite/gm2/examples/cppDef/pass/b.mod
new file mode 100644
index 00000000000..4bdf54c21ee
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/cppDef/pass/b.mod
@@ -0,0 +1,29 @@
+(* b.mod tiny test main module accessing the CPP based definition module.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+MODULE b ;
+
+FROM a IMPORT constValue ;
+FROM libprintf IMPORT printf ;
+
+BEGIN
+   printf ('value of constValue = %d\n', constValue)
+END b.
diff --git a/gcc/testsuite/gm2/examples/cppDef/pass/examples-cppDef-pass.exp b/gcc/testsuite/gm2/examples/cppDef/pass/examples-cppDef-pass.exp
new file mode 100644
index 00000000000..5c10b5454db
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/cppDef/pass/examples-cppDef-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "$srcdir/$subdir/" -DVALUE=999 -fcpp
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/examples/cppDef/pass/libprintf.def b/gcc/testsuite/gm2/examples/cppDef/pass/libprintf.def
new file mode 100644
index 00000000000..326c5b048d9
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/cppDef/pass/libprintf.def
@@ -0,0 +1,35 @@
+(* libprintf.def provides simple example of access to printf.
+
+Copyright (C) 2001-2021 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/>.  *)
+
+DEFINITION MODULE FOR "C" libprintf ;
+
+
+EXPORT UNQUALIFIED printf ;
+
+PROCEDURE printf (a: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+
+
+END libprintf.
diff --git a/gcc/testsuite/gm2/examples/hello/pass/examples-hello-pass.exp b/gcc/testsuite/gm2/examples/hello/pass/examples-hello-pass.exp
new file mode 100644
index 00000000000..cdabece797e
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/hello/pass/examples-hello-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "$srcdir/$subdir"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/examples/hello/pass/hello.mod b/gcc/testsuite/gm2/examples/hello/pass/hello.mod
new file mode 100644
index 00000000000..644251bf821
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/hello/pass/hello.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+                 2010
+                 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. *)
+
+MODULE hello ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ; WriteLn
+END hello.
diff --git a/gcc/testsuite/gm2/examples/map/pass/AdvMap.def b/gcc/testsuite/gm2/examples/map/pass/AdvMap.def
new file mode 100644
index 00000000000..92788d429cc
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/AdvMap.def
@@ -0,0 +1,107 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE AdvMap ;
+
+
+EXPORT QUALIFIED Rooms, Line, DoorStatus, Door, Room, Treasure,
+                 ActualNoOfRooms, MaxNoOfTreasures, MaxNoOfRooms,
+                 NoOfRoomsToHidePlayers, NoOfRoomsToSpring,
+                 NoOfRoomsToHideCoal, NoOfRoomsToHideGrenade,
+                 ReadAdvMap, Adjacent, IncPosition,
+                 FileName, MaxLengthOfFileName ;
+
+
+CONST
+   MaxNoOfRooms           = 350 ;  (* An upper limit *)
+   WallsPerRoom           =   8 ;  (* An upper limit *)
+   DoorsPerRoom           =   6 ;  (* An upper limit *)
+   MaxNoOfTreasures       =  15 ;  (* An upper limit *)
+   MaxLengthOfFileName    =  11 ;
+   NoOfRoomsToHidePlayers =  50 ;
+   NoOfRoomsToSpring      =  50 ;
+   NoOfRoomsToHideCoal    =  50 ;
+   NoOfRoomsToHideGrenade =  50 ;
+
+
+TYPE
+
+   Line         = RECORD
+                     X1 : CARDINAL ;
+                     Y1 : CARDINAL ;
+                     X2 : CARDINAL ;
+                     Y2 : CARDINAL
+                  END ;
+
+   DoorStatus   = (Open, Closed, Secret) ;
+
+   Door         = RECORD
+                     Position    : Line ;
+                     StateOfDoor : DoorStatus ;
+                     LeadsTo     : CARDINAL
+                  END ;
+
+   TreasureInfo = RECORD
+                     Xpos         : CARDINAL ;
+                     Ypos         : CARDINAL ;
+                     Rm           : CARDINAL ;
+                     Tweight      : CARDINAL ;
+                     TreasureName : ARRAY [0..12] OF CHAR
+                  END ;
+
+   Room         = RECORD
+                     RoomNo      : CARDINAL ;
+                     NoOfWalls   : CARDINAL ;
+                     NoOfDoors   : CARDINAL ;
+                     Walls       : ARRAY [1..WallsPerRoom] OF Line ;
+                     Doors       : ARRAY [1..DoorsPerRoom] OF Door ;
+                     Treasures   : BITSET ;
+                  END ;
+
+
+
+VAR
+   ActualNoOfRooms : CARDINAL ;
+   Treasure        : ARRAY [1..MaxNoOfTreasures] OF TreasureInfo ;
+   Rooms           : ARRAY [1..MaxNoOfRooms] OF Room ;
+
+   FileName        : ARRAY [0..MaxLengthOfFileName] OF CHAR ;
+
+
+(*
+   ReadAdvMap - read map, Name, into memory.
+                TRUE is returned if the operation was successful.
+*)
+
+PROCEDURE ReadAdvMap (Name: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   Adjacent - tests to see if two rooms are Adjacent to each other.
+*)
+
+PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IncPosition - increments the position of x, y by the direction that are facing.
+*)
+
+PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
+
+
+END AdvMap.
diff --git a/gcc/testsuite/gm2/examples/map/pass/AdvMap.mod b/gcc/testsuite/gm2/examples/map/pass/AdvMap.mod
new file mode 100644
index 00000000000..cfe3518655a
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/AdvMap.mod
@@ -0,0 +1,420 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+
+IMPLEMENTATION MODULE AdvMap ;
+
+IMPORT StdIO ;
+
+FROM Scan IMPORT WriteError, GetNextSymbol, OpenSource, CloseSource ;
+FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrLib IMPORT StrEqual, StrLen, StrCopy ;
+FROM ASCII IMPORT cr, lf, nul, EOL ;
+
+
+VAR
+   CurrentRoom          : CARDINAL ;
+   CurrentSymbol        : ARRAY [0..20] OF CHAR ;
+   FatelError           : BOOLEAN ;
+
+
+(* IncPosition increments the x,y coordinates according  *)
+(* the Direction sent.                                   *)
+
+PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
+BEGIN
+   IF (Dir=0) AND (y>0)
+   THEN
+      DEC(y)
+   ELSIF Dir=3
+   THEN
+      INC(x)
+   ELSIF Dir=2
+   THEN
+      INC(y)
+   ELSIF x>0
+   THEN
+      DEC(x)
+   END
+END IncPosition ;
+ 
+
+
+(* Adjacent tests whether two rooms R1 & R2 are adjacent *)
+(* Assume that access to map has been granted.           *)
+
+PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
+VAR
+   i, r1, r2 : CARDINAL ;
+   ok: BOOLEAN ;
+BEGIN
+   WITH Rooms[R1] DO
+      i := NoOfDoors ;
+      ok := FALSE ;
+      WHILE (i>0) AND (NOT ok) DO
+         IF Doors[i].LeadsTo=R2
+         THEN
+            ok := TRUE
+         ELSE
+            DEC(i)
+         END
+      END
+   END ;
+   RETURN( ok )
+END Adjacent ;
+
+
+(* The following procedures test and read the syntax marking out the  *)
+(* map of the adventure game. Displaying syntactic errors if occurred *)
+
+(*
+   ReadAdvMap - read map, Name, into memory.
+                TRUE is returned if the operation was successful.
+*)
+
+PROCEDURE ReadAdvMap (Name: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   Success := OpenSource(Name) ;
+   IF Success
+   THEN
+      GetNextSymbol(CurrentSymbol) ;
+      WHILE (NOT StrEqual( CurrentSymbol, 'END.' )) AND (NOT FatelError) DO
+         ReadRoom ;
+         GetNextSymbol(CurrentSymbol)
+      END ;
+      CloseSource ;
+      Success := NOT FatelError
+   ELSE
+      WriteString('cannot open: ') ; WriteString(Name) ; WriteLn
+   END ;
+   RETURN( Success )
+END ReadAdvMap ;
+
+
+PROCEDURE ReadRoom ;
+BEGIN
+   IF NOT FatelError
+   THEN
+      IF NOT StrEqual( CurrentSymbol, 'ROOM' )
+      THEN
+         WriteError('ROOM --- Expected') ;
+         FatelError := TRUE
+      ELSE
+         GetNextSymbol(CurrentSymbol) ;
+         ReadRoomNo ;
+         IF (CurrentRoom<1) OR (CurrentRoom>MaxNoOfRooms)
+         THEN
+            WriteError('Out Of Range Error - Room No.') ;
+            FatelError := TRUE ;
+            WriteString('Non Recoverable Error') ;
+            WriteLn
+         ELSE
+            WITH Rooms[CurrentRoom] DO
+               Treasures := {} ;
+               NoOfWalls := 0 ;
+               NoOfDoors := 0 ;
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+
+            WHILE (NOT StrEqual( CurrentSymbol, 'END' )) AND
+                  (NOT FatelError) DO
+               IF StrEqual( CurrentSymbol, 'WALL' )
+               THEN
+                  ReadWall
+               ELSIF StrEqual( CurrentSymbol, 'DOOR' )
+               THEN
+                  ReadDoor
+               ELSIF StrEqual( CurrentSymbol, 'TREASURE' )
+               THEN
+                  ReadTreasure
+               ELSE
+                  WriteError('WALL, DOOR, TREASURE, END --- Expected') ;
+                  FatelError := TRUE ;
+                  GetNextSymbol(CurrentSymbol)
+               END
+            END
+         END
+      END
+   END
+END ReadRoom ;
+
+
+PROCEDURE ReadWall ;
+VAR
+   x1, y1,
+   x2, y2: CARDINAL ;
+BEGIN
+   IF NOT FatelError
+   THEN
+      GetNextSymbol(CurrentSymbol) ;
+      WITH Rooms[CurrentRoom] DO
+         REPEAT
+            INC( NoOfWalls ) ;
+            IF NoOfWalls>WallsPerRoom
+            THEN
+               WriteError('Out Of Range Error - Too Many Walls') ;
+               FatelError := TRUE ;
+               WriteString('Non Recoverable Error') ;
+               WriteLn
+            ELSE
+               ReadCard( x1 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( y1 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( x2 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( y2 ) ;
+
+               IF (x1#x2) AND (y1#y2)
+               THEN
+                  WriteError('Diagonal Wall --- Not Allowed') ;
+                  FatelError := TRUE
+               END ;
+                  
+               (* Always have the lowest value of x in x1 OR y in y1 *)
+
+               IF (x1<x2) OR (y1<y2)
+               THEN
+                  Walls[NoOfWalls].X1 := x1 ;
+                  Walls[NoOfWalls].Y1 := y1 ;
+                  Walls[NoOfWalls].X2 := x2 ;
+                  Walls[NoOfWalls].Y2 := y2
+               ELSE
+                  Walls[NoOfWalls].X1 := x2 ;
+                  Walls[NoOfWalls].Y1 := y2 ;
+                  Walls[NoOfWalls].X2 := x1 ;
+                  Walls[NoOfWalls].Y2 := y1
+               END
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+         UNTIL StrEqual( CurrentSymbol, 'WALL' ) OR
+               StrEqual( CurrentSymbol, 'DOOR' ) OR
+               StrEqual( CurrentSymbol, 'TREASURE' ) OR
+               StrEqual( CurrentSymbol, 'END' ) OR
+               FatelError ;
+      END ;
+   END
+END ReadWall ;
+
+
+PROCEDURE ReadDoor ;
+VAR
+   x1, y1,
+   x2, y2: CARDINAL ;
+BEGIN
+   IF NOT FatelError
+   THEN
+      GetNextSymbol(CurrentSymbol) ;
+      WITH Rooms[CurrentRoom] DO
+         REPEAT
+            INC( NoOfDoors ) ;
+            IF NoOfDoors>DoorsPerRoom
+            THEN
+               WriteError('Out Of Range Error - Too Many Doors') ;
+               FatelError := TRUE ;
+               WriteString('Non Recoverable Error') ;
+               WriteLn
+            ELSE
+               ReadCard( x1 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( y1 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( x2 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( y2 ) ;
+
+               IF (x1#x2) AND (y1#y2)
+               THEN
+                  WriteError('Diagonal Door --- Not Allowed') ;
+                  FatelError := TRUE
+               END ;
+
+               (* Always have the lowest value of x in x1 OR y in y1 *)
+
+               IF (x1<x2) OR (y1<y2)
+               THEN
+                  Doors[NoOfDoors].Position.X1 := x1 ;
+                  Doors[NoOfDoors].Position.Y1 := y1 ;
+                  Doors[NoOfDoors].Position.X2 := x2 ;
+                  Doors[NoOfDoors].Position.Y2 := y2
+               ELSE
+                  Doors[NoOfDoors].Position.X1 := x2 ;
+                  Doors[NoOfDoors].Position.Y1 := y2 ;
+                  Doors[NoOfDoors].Position.X2 := x1 ;
+                  Doors[NoOfDoors].Position.Y2 := y1
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               IF NOT StrEqual( CurrentSymbol, 'STATUS' )
+               THEN
+                  WriteError('STATUS --- Expected') ;
+                  FatelError := TRUE
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               IF StrEqual( CurrentSymbol, 'CLOSED' )
+               THEN
+                  Doors[NoOfDoors].StateOfDoor := Closed
+               ELSIF StrEqual( CurrentSymbol, 'SECRET' )
+               THEN
+                  Doors[NoOfDoors].StateOfDoor := Secret
+               ELSIF StrEqual( CurrentSymbol, 'OPEN' )
+               THEN
+                  Doors[NoOfDoors].StateOfDoor := Open
+               ELSE
+                  WriteError('Illegal Door Status')
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               IF NOT StrEqual( CurrentSymbol, 'LEADS' )
+               THEN
+                  WriteError('LEADS --- Expected') ;
+                  FatelError := TRUE
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               IF NOT StrEqual( CurrentSymbol, 'TO' )
+               THEN
+                  WriteError('TO --- Expected') ;
+                  FatelError := TRUE
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( x1 ) ;
+               IF x1>MaxNoOfRooms
+               THEN
+                  WriteError('Out Of Range Error - Room No.') ;
+                  FatelError := TRUE
+               ELSE
+                  Doors[NoOfDoors].LeadsTo := x1
+               END
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+         UNTIL StrEqual( CurrentSymbol, 'DOOR' ) OR
+               StrEqual( CurrentSymbol, 'WALL' ) OR
+               StrEqual( CurrentSymbol, 'TREASURE' ) OR
+               StrEqual( CurrentSymbol, 'END' ) OR
+               FatelError ;
+      END
+   END
+END ReadDoor ;
+
+
+PROCEDURE ReadTreasure ;
+VAR
+   x, y, TreasureNo: CARDINAL ;
+BEGIN
+   IF NOT FatelError
+   THEN
+      GetNextSymbol(CurrentSymbol) ;
+      REPEAT
+         WITH Rooms[CurrentRoom] DO
+            IF NOT StrEqual( CurrentSymbol, 'AT' )
+            THEN
+               WriteError('AT --- Expected') ;
+               FatelError := TRUE
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+            ReadCard( x ) ;
+            GetNextSymbol(CurrentSymbol) ;
+            ReadCard( y ) ;
+            GetNextSymbol(CurrentSymbol) ;
+            IF NOT StrEqual( CurrentSymbol, 'IS' )
+            THEN
+               WriteError('IS --- Expected') ;
+               FatelError := TRUE
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+            ReadCard( TreasureNo ) ;
+
+            IF (TreasureNo<=MaxNoOfTreasures) AND (TreasureNo>0)
+            THEN
+               (* Tell Room about treasures *)
+
+               INCL( Treasures, TreasureNo ) ;
+
+               (* Tell Treasures about Treasures! and Room *)
+
+               Treasure[TreasureNo].Xpos := x ;
+               Treasure[TreasureNo].Ypos := y ;
+               Treasure[TreasureNo].Rm := CurrentRoom ;
+            ELSE
+               WriteError('Out Of Range Error - Treasure No.') ;
+               FatelError := TRUE
+            END
+         END ;
+         GetNextSymbol(CurrentSymbol) ;
+      UNTIL StrEqual( CurrentSymbol, 'WALL' ) OR
+            StrEqual( CurrentSymbol, 'DOOR' ) OR
+            StrEqual( CurrentSymbol, 'TREASURE' ) OR
+            StrEqual( CurrentSymbol, 'END' ) OR
+            FatelError ;
+   END
+END ReadTreasure ;
+
+
+PROCEDURE ReadRoomNo ;
+BEGIN
+   IF NOT FatelError
+   THEN
+      ReadCard( CurrentRoom ) ;
+      IF (CurrentRoom>0) AND (CurrentRoom<=MaxNoOfRooms)
+      THEN
+         IF CurrentRoom>ActualNoOfRooms
+         THEN
+            ActualNoOfRooms := CurrentRoom
+         END
+      END
+   END
+END ReadRoomNo ;
+
+
+PROCEDURE ReadCard (VAR c: CARDINAL) ;
+VAR
+   i    : CARDINAL ;
+   High : CARDINAL ;
+   ch   : CHAR ;
+BEGIN
+   IF NOT FatelError
+   THEN
+      i := 0 ;
+      c := 0 ;
+      High := HIGH(CurrentSymbol) ;
+      REPEAT
+         ch := CurrentSymbol[i] ;
+         IF (ch>='0') AND (ch<='9')
+         THEN
+            c := c*10+ORD(ch)-ORD('0')
+         ELSIF ch#nul
+         THEN
+            WriteError('Cardinal Number Expected') ;
+            FatelError := TRUE
+         END ;
+         INC( i ) ;
+      UNTIL (i>High) OR (ch=nul) ;
+   END
+END ReadCard ;
+
+
+PROCEDURE Init ;
+BEGIN
+   ActualNoOfRooms := 0 ;
+   FatelError := FALSE
+END Init ;
+
+
+BEGIN
+   Init
+END AdvMap.
diff --git a/gcc/testsuite/gm2/examples/map/pass/BoxMap.def b/gcc/testsuite/gm2/examples/map/pass/BoxMap.def
new file mode 100644
index 00000000000..0aa9ec56ff6
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/BoxMap.def
@@ -0,0 +1,83 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE BoxMap ;
+
+(*
+   Title      : BoxMap
+   Author     : Gaius Mulley
+   Date       : 18/7/88
+   LastEdit   : 18/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Generates a simple random map full of boxes.
+                Box corridors and box rooms.
+                All boxes are contained in the array Boxes and
+                1..NoOfCorridorBoxes are the corridor boxes and
+                NoOfCorridorBoxes..NoOfBoxes are the room boxes.
+*)
+
+EXPORT QUALIFIED MaxBoxes, MaxX, MaxY,
+                 MaxDoorLength, MinDoorLength,
+                 CorridorWidth, CorridorDoorLength,
+                 TotalCorridorLength, MinDistanceBetweenCorridors,
+                 MaxCorridorLength, MinCorridorLength,
+                 MaxRoomLength, MinRoomLength,
+                 MinDistanceBetweenRooms,
+                 Box,
+                 Boxes,
+                 NoOfBoxes, NoOfCorridorBoxes,
+                 CreateBoxMap ;
+
+CONST
+   MaxBoxes =  500 ;
+   MaxX     =  120 ;  (* 38 ; *)
+   MaxY     =   80 ;  (* 24 ; *)
+
+   MaxDoorLength               =   3 ;
+   MinDoorLength               =   2 ;
+   CorridorWidth               =   7 ;  (* 4 ; *)
+   CorridorDoorLength          =   CorridorWidth-2 ;
+   TotalCorridorLength         =   (MaxX*3+MaxY*3) DIV 2 ;
+   MinDistanceBetweenCorridors =   CorridorWidth ;
+   MaxCorridorLength           =  70 ;  (* 70 ; *)
+   MinCorridorLength           =  15 ;  (* 8 ; *)
+   MaxRoomLength               =  13 ;
+   MinRoomLength               =   6 ;  (* 4 ; *)
+   MinDistanceBetweenRooms     =   MinRoomLength-1 ;
+
+TYPE
+   Box    = RECORD
+               x1, y1,
+               x2, y2   : CARDINAL ;
+               RoomOfBox: CARDINAL ;
+            END ;
+
+VAR
+                      (* Box 0 is the boarder of the map.             *)
+   Boxes            : ARRAY [0..MaxBoxes] OF Box ;
+   NoOfCorridorBoxes: CARDINAL ;
+   NoOfBoxes        : CARDINAL ;
+
+
+(*
+   CreateBoxMap - builds a map with central corridors and ajoining rooms.
+*)
+
+PROCEDURE CreateBoxMap ;
+
+
+END BoxMap.
diff --git a/gcc/testsuite/gm2/examples/map/pass/BoxMap.mod b/gcc/testsuite/gm2/examples/map/pass/BoxMap.mod
new file mode 100644
index 00000000000..b07a6a3d940
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/BoxMap.mod
@@ -0,0 +1,1760 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+IMPLEMENTATION MODULE BoxMap ;
+
+(*
+   Title      : MakeMap
+   Author     : Gaius Mulley
+   Date       : 18/7/88
+   LastEdit   : 18/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Generates a simple random box map for Dungeon
+*)
+
+IMPORT Break ;
+FROM StdIO IMPORT Write, Read ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard, ReadCard ;
+FROM Assertion IMPORT Assert ;
+FROM Geometry IMPORT IsSubLine, IsSubRange, IsIntersectingRange,
+                     IntersectionLength, IsPointOnLine, Abs, Min, Max ;
+FROM MakeBoxes IMPORT InitBoxes, KillBoxes,
+                      AddBoxes, GetAndDeleteRandomBox ;
+FROM StoreCoords IMPORT InitCoords, KillCoords,
+                        GetAndDeleteRandomCoord, AddCoord, CoordsExist ;
+FROM Chance IMPORT InitRandom, KillRandom,
+                   GetAndDeleteRandom, AddRandom,
+                   GetRand ;
+
+CONST
+   MaxCard  = 65535 ;
+
+   MaxStack =   500 ;
+
+TYPE
+   Square = RECORD
+               Contents    : (Empty, Secret, Door, Wall, Treasure) ;
+               RoomOfSquare: CARDINAL ;
+            END ;
+
+   Map      = ARRAY [1..MaxX], [1..MaxY] OF Square ;
+
+   StackEntity = RECORD
+                    PerimeterIndex  : CARDINAL ;  (* Untried Coords   *)
+                    BoxIndex        : CARDINAL ;  (* Untried boxes    *)
+                    OrientationIndex: CARDINAL ;  (* Untried orient's *)
+                 END ;
+
+VAR
+   CurrentMap       : Map ;
+   Stack            : ARRAY [1..MaxStack] OF StackEntity ;
+   StackPtr         : CARDINAL ;
+
+
+(*
+   InitializeMap - Initializes CurrentMap.
+                   CurrentMap has its boarder set to a Wall and middle
+                   is set to Empty.
+*)
+
+PROCEDURE InitializeMap ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   FOR i := 1 TO MaxX DO
+      FOR j := 1 TO MaxY DO
+         WITH CurrentMap[i, j] DO
+            Contents := Empty ;
+            RoomOfSquare := 0
+         END
+      END
+   END
+END InitializeMap ;
+
+
+(*
+   Init - Initialize the module and start the generation of a map.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   NoOfBoxes := 0 ;
+   (* Initialize box 0 the edge of the map *)
+   WITH Boxes[0] DO
+      x1 := 1 ;
+      x2 := MaxX ;
+      y1 := 1 ;
+      y2 := MaxY
+   END ;
+   StackPtr := 0
+END Init ;
+
+
+(*
+   CreateBoxMap - builds a map with central corridors and ajoining rooms.
+*)
+
+PROCEDURE CreateBoxMap ;
+BEGIN
+   Init ;
+   CorridorMap ;
+   RoomMap
+END CreateBoxMap ;
+
+
+(*
+   CorridorMap - makes a map based arround central corridors.
+*)
+
+PROCEDURE CorridorMap ;
+BEGIN
+   CreateCorridors ;
+   NoOfCorridorBoxes := NoOfBoxes
+END CorridorMap ;
+
+
+(*
+   CleanUpStack - cleans up the temporary stack where alternative rooms were
+                  stored but are no longer needed.
+*)
+
+PROCEDURE CleanUpStack ;
+BEGIN
+   WHILE StackPtr>0 DO
+      WITH Stack[StackPtr] DO
+         KillBoxes(BoxIndex) ;
+         KillCoords(PerimeterIndex) ;
+         KillRandom(OrientationIndex)
+      END ;
+      DEC(StackPtr)
+   END
+END CleanUpStack ;
+
+
+(*
+   RoomMap - creates the rooms on the map which fill in space left by the
+             corridors.
+*)
+
+PROCEDURE RoomMap ;
+BEGIN
+   WriteString('Starting Room building') ; WriteLn ;
+   CreateRooms
+END RoomMap ;
+
+
+(*
+   CreateCorridors - creates a length of corridor on the map.
+*)
+
+PROCEDURE CreateCorridors ;
+VAR
+   Length,
+   LengthLeft: CARDINAL ;
+BEGIN
+   LengthLeft := TotalCorridorLength ;
+   InitBoxCorridor ;  (* Place new Box on the stack *)
+   REPEAT
+      IF MakeCorridor()
+      THEN
+         WITH Boxes[NoOfBoxes] DO
+            Length := Max(Abs(x1, x2), Abs(y1, y2))
+         END ;
+         IF LengthLeft>Length
+         THEN
+            DEC(LengthLeft, Length) ;
+            InitBoxCorridor   (* Place new corridors on the stack *)
+         ELSE
+            LengthLeft := 0   (* All done *)
+         END
+      ELSE
+         IF StackPtr>0
+         THEN
+            (* Retract last corridor and try another *)
+            WriteString('Backtracking') ; WriteLn ;
+            WriteString('HALTing - quicker than backtracking') ; WriteLn ;
+            HALT ;
+            WITH Boxes[NoOfBoxes] DO
+               INC(LengthLeft, Max(Abs(x1, x2), Abs(y1, y2)))
+            END ;
+            KillBox ;
+            UnMakeBox
+         ELSE
+            WriteString('Run out of ideas! MaxCorridorLength too large!') ;
+            WriteLn ;
+            LengthLeft := 0    (* Fail safe exit *)
+         END
+      END
+   UNTIL LengthLeft=0
+END CreateCorridors ;
+
+
+(*
+   CreateRooms - places rooms inbetween the corridors on the map.
+*)
+
+PROCEDURE CreateRooms ;
+VAR
+   Finished: BOOLEAN ;
+BEGIN
+   InitBoxRoom ;
+   Finished := FALSE ;
+   REPEAT
+      IF MakeRoom()
+      THEN
+         InitBoxRoom ;
+         Finished := NOT CoordsExist(Stack[StackPtr].PerimeterIndex)
+      ELSE
+         Finished := TRUE ;
+(*
+         IF StackPtr>0
+         THEN
+            (* Retract last room and try another *)
+            WriteString('Backtracking room') ; WriteLn ;
+            KillBox ;
+            UnMakeBox
+         ELSE
+            WriteString('Run out of ideas! Trying to create rooms!') ;
+            WriteLn ;
+         END
+*)
+      END
+   UNTIL Finished ;
+END CreateRooms ;
+
+
+(*
+   MakeCorridor - returns true if a corridor was legally placed
+                  onto the map.
+*)
+
+PROCEDURE MakeCorridor () : BOOLEAN ;
+VAR
+   Success   : BOOLEAN ;
+   x, y      : CARDINAL ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      (*
+         Perimeter has been previously pushed.
+         We now try to place a piece of corridor
+         on a selected perimeter coordinate.
+      *)
+      Success := FALSE ;
+      REPEAT
+         GetAndDeleteRandomCoord(PerimeterIndex, x, y) ;
+         x := Min(x, MaxX) ;
+         y := Min(y, MaxY) ;
+         IF x#0  (* x=0 means no more coordinates to fetch *)
+         THEN
+            Success := PutCorridorOntoMap(x, y)
+         END
+      UNTIL Success OR (x=0)    (* x=0 and y=0 means no coordinates left *)
+                                (* when x=0  y is also 0.                *)
+   END ;
+   RETURN( Success )
+END MakeCorridor ;
+
+
+(*
+   MakeRoom - returns true if a room was legally placed
+              onto the map.
+*)
+
+PROCEDURE MakeRoom () : BOOLEAN ;
+VAR
+   Success   : BOOLEAN ;
+   x, y      : CARDINAL ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      (*
+         Perimeter has been previously pushed.
+         We now try to place a piece of corridor
+         on a selected perimeter coordinate.
+      *)
+      Success := FALSE ;
+      REPEAT
+         GetAndDeleteRandomCoord(PerimeterIndex, x, y) ;
+         IF x#0  (* x=0 means no more coordinates to fetch *)
+         THEN
+            Success := PutRoomOntoMap(x, y)
+         END
+      UNTIL Success OR (x=0)    (* x=0 and y=0 means no coordinates left *)
+                                (* when x=0  y is also 0.                *)
+   END ;
+   RETURN( Success )
+END MakeRoom ;
+
+
+(*
+   UnMakeBox - deletes the last box placed in the Box list.
+*)
+
+PROCEDURE UnMakeBox ;
+BEGIN
+(*
+   IF NoOfCorridorBoxes>0
+   THEN
+      FindSpaceNextToRoom
+   END ;
+*)
+   DEC(NoOfBoxes)
+END UnMakeBox ;
+
+
+(*
+   KillSurroundingBoxes - finds a pocket of space on the map and deletes
+                          all neighbouring boxes.
+*)
+
+(*
+PROCEDURE KillSurroundingBoxes ;
+VAR
+   x, y,
+   i, j,
+   Swap, b: CARDINAL ;
+BEGIN
+   GetFreeSpace(x, y) ;
+   i := x ;
+   j := y ;
+   Swap := NoOfBoxes ;
+   REPEAT
+      b := 1 ;
+      WHILE b<=Swap DO
+         IF IsPointOnBox(b, i, j)
+         THEN
+            SwapBox(b, Swap) ;
+            DEC(Swap)
+         END ;
+         INC(b)
+      END ;
+      WalkClockWise(i, j)
+   UNTIL (x=i) AND (y=j) ;
+   RenewBoxes(Swap, Swap)
+END KillSurroundingBoxes ;
+*)
+
+
+(*
+   SwapBox - swaps two boxes, i and j, arround on the stack.
+*)
+
+PROCEDURE SwapBox (i, j: CARDINAL) ;
+VAR
+   s: StackEntity ;
+   b: Box ;
+BEGIN
+   b := Boxes[i] ;
+   Boxes[i] := Boxes[j] ;
+   Boxes[j] := b ;
+   s := Stack[i] ;
+   Stack[i] := Stack[j] ;
+   Stack[j] := s
+END SwapBox ;
+
+
+(*
+   FindSpaceNextToRoom - finds a pocket of space on the map and places
+                         a room near this onto the top of the box stack.
+*)
+
+PROCEDURE FindSpaceNextToRoom ;
+VAR
+   t: Box ;
+   x, y, b, d,
+   Nearest,
+   Distance  : CARDINAL ;
+BEGIN
+   GetSpaceCoord(x, y) ;
+   Nearest := 1 ;
+   Distance := DistanceAppartPoint(1, x, y) ;
+   b := NoOfBoxes-1 ;
+   WHILE b>1 DO
+      d := DistanceAppartPoint(b, x, y) ;
+      IF d<Distance
+      THEN
+         Distance := d ;
+         Nearest := b
+      END ;
+      DEC(b)
+   END ;
+   SwapBox(Nearest, NoOfBoxes)
+END FindSpaceNextToRoom ;
+
+
+(*
+   GetSpaceCoord - Sets x and y to a coordinate which has no room on it.
+*)
+
+PROCEDURE GetSpaceCoord (VAR x, y: CARDINAL) ;
+VAR
+   Space: BOOLEAN ;
+BEGIN
+   Space := FALSE ;
+   x := 1 ;
+   WHILE (NOT Space) AND (x<=MaxX) DO
+      y := 1 ;
+      WHILE (NOT Space) AND (y<=MaxY) DO
+         IF NOT IsSpace(x, y)
+         THEN
+            INC(y)
+         ELSE
+            Space := TRUE
+         END
+      END ;
+      IF NOT Space
+      THEN
+         INC(x)
+      END
+   END
+END GetSpaceCoord ;
+
+
+(*
+   Reschedule - reorders boxes on the stack, all boxes that touch the
+                top box are placed n-1 n-2 etc on the stack,
+                efficient recursive backtracking!
+*)
+
+PROCEDURE Reschedule (Lowest: CARDINAL) ;
+VAR
+   b,
+   Swap: CARDINAL ;
+   t   : Box ;
+BEGIN
+   Swap := NoOfBoxes-1 ;
+   b := Lowest+1 ;
+   WITH Boxes[NoOfBoxes] DO
+      WHILE Swap>b DO
+         IF IsTouchingBox(b, x1, y1, x2, y2)
+         THEN
+            SwapBox(b, Swap) ;
+            INC(b)
+         END ;
+         DEC(Swap)
+      END
+   END
+END Reschedule ;
+
+
+(*
+   InitBoxCorridor - initializes a new corridor on the Stack,
+                     the perimeter of the map is also pushed.
+*)
+
+PROCEDURE InitBoxCorridor ;
+BEGIN
+   INC(StackPtr) ;
+   WITH Stack[StackPtr] DO
+      PerimeterIndex := InitCoords() ;
+      PushPerimeterOfBoxes(PerimeterIndex, FALSE) ;
+      OrientationIndex := 0 ;
+      BoxIndex := 0
+   END
+END InitBoxCorridor ;
+
+
+(*
+   InitBoxRoom - initializes a new corridor on the Stack,
+                 the perimeter of the map is also pushed.
+*)
+
+PROCEDURE InitBoxRoom ;
+BEGIN
+   (*
+      This is a really nasty kludge - because of memory space limitations
+      the StoreCoords module is pushed for space when creating large size
+      maps.
+      The kludge to get arround this is to kill all perimeter coordinates of the
+      previous box. This can be done since we never invoke backtracking
+      when creating boxrooms - but we may when we come up with a suitable
+      reliable algorithm, however, until then we can take advantage of
+      no backtracking and delete all perimeter coords of the last box.
+   *)
+   IF StackPtr>1
+   THEN
+      (* Ok delete perimeter coord *)
+      KillCoords(Stack[StackPtr].PerimeterIndex) ;
+      KillBoxes(Stack[StackPtr].BoxIndex)
+   END ;
+   (* All done - kludge over *)
+   INC(StackPtr) ;
+   WITH Stack[StackPtr] DO
+      PerimeterIndex := InitCoords() ;
+      PushPerimeterOfBoxes(PerimeterIndex, TRUE) ;
+      OrientationIndex := 0 ;
+      BoxIndex := 0
+   END
+END InitBoxRoom ;
+
+
+(*
+   KillBox - pops the last Box from the stack.
+*)
+
+PROCEDURE KillBox ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      KillCoords(PerimeterIndex)
+   END ;
+   DEC(StackPtr)
+END KillBox ;
+
+
+(*
+   PutCorridorOntoMap - returns true if it has placed a corridor
+                        onto a map.
+                        Otherwise no corridor has been placed onto
+                        this map.
+*)
+
+PROCEDURE PutCorridorOntoMap (x, y: CARDINAL) : BOOLEAN ;
+VAR
+   LenX,
+   LenY    : CARDINAL ;
+   Success : BOOLEAN ;
+BEGIN
+   CheckInitBoxCorridorIndex ;
+   WITH Stack[StackPtr] DO
+      Success := FALSE ;
+      REPEAT
+         IF GetBox(LenX, LenY)
+         THEN
+            Success := PlaceCorridorBox(x, y, LenX-1, LenY-1)
+         END
+      UNTIL Success OR (LenX=0) ;
+   END ;
+   CheckKillBoxIndex(LenX=0) ;
+   RETURN( Success )
+END PutCorridorOntoMap ;
+
+
+(*
+   PutRoomOntoMap - returns true if it has placed a room
+                    onto a map.
+                    Otherwise no room has been placed onto
+                    this map.
+*)
+
+PROCEDURE PutRoomOntoMap (x, y: CARDINAL) : BOOLEAN ;
+VAR
+   LenX,
+   LenY    : CARDINAL ;
+   Success : BOOLEAN ;
+BEGIN
+   CheckInitBoxRoomIndex ;
+   WITH Stack[StackPtr] DO
+      Success := FALSE ;
+      REPEAT
+         IF GetBox(LenX, LenY)
+         THEN
+            Success := PlaceRoomBox(x, y, LenX-1, LenY-1)
+         END
+      UNTIL Success OR (LenX=0) ;
+   END ;
+   CheckKillBoxIndex(LenX=0) ;
+   RETURN( Success )
+END PutRoomOntoMap ;
+
+
+(*
+   GetBox - returns true if a box can be returned.
+            It chooses one box from the box index,
+            from the stack.
+            The lengths of the Box are returned
+            in LengthX and LengthY.
+*)
+
+PROCEDURE GetBox (VAR LengthX, LengthY: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      GetAndDeleteRandomBox(BoxIndex, LengthX, LengthY)
+   END ;
+   RETURN(LengthX#0)        (* LengthX#0 means found legal size box *)
+END GetBox ;
+
+
+(*
+   CheckInitBoxCorridorIndex - checks to see whether the current
+                               stacked box needs
+                               a list of legal corridor sizes stacked.
+*)
+
+PROCEDURE CheckInitBoxCorridorIndex ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      IF BoxIndex=0
+      THEN
+         (* Without stacked box list of legal sized corridors *)
+         BoxIndex := InitBoxes() ;
+         AddBoxes(BoxIndex, MinCorridorLength, CorridorWidth,
+                            MaxCorridorLength, CorridorWidth) ;
+         AddBoxes(BoxIndex, CorridorWidth, MinCorridorLength,
+                            CorridorWidth, MaxCorridorLength)
+      END
+   END
+END CheckInitBoxCorridorIndex ;
+
+
+(*
+   CheckInitBoxRoomIndex - checks to see whether the current stack box
+                           needs a list of legal corridor sizes stacked.
+*)
+
+PROCEDURE CheckInitBoxRoomIndex ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      IF BoxIndex=0
+      THEN
+         (* Without stacked box list of legal sized rooms *)
+         BoxIndex := InitBoxes() ;
+         AddBoxes(BoxIndex, MinRoomLength, MinRoomLength,
+                            MaxRoomLength, MaxRoomLength)
+      END
+   END
+END CheckInitBoxRoomIndex ;
+
+
+(*
+   CheckKillBoxIndex - if NeedToKill is set then the list of boxes
+                       on the stack is killed.
+                       Ideally this procedure should be a macro.
+*)
+
+PROCEDURE CheckKillBoxIndex (NeedToKill: BOOLEAN) ;
+BEGIN
+   IF NeedToKill
+   THEN
+      WITH Stack[StackPtr] DO
+         KillBoxes(BoxIndex) ;
+         BoxIndex := 0
+      END
+   END
+END CheckKillBoxIndex ;
+
+
+(*
+   PlaceCorridorBox - returns true if a box can make a corridor at
+                      position x, y.
+                      All 4 orientations are tried.
+
+
+                              2  1
+                              4  3
+
+                      Ie  1:  (x, y) (x+LenX, y+LenY)
+                          2:  (x, y) (x-LenX, y+LenY)
+                          3:  (x, y) (x+LenX, y-LenY)
+                          4:  (x, y) (x-LenX, y-LenY)
+*)
+
+PROCEDURE PlaceCorridorBox (x, y: CARDINAL; LenX, LenY: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+   i      : CARDINAL ;
+BEGIN
+   CheckInitOrientationIndex ;
+   WITH Stack[StackPtr] DO
+      Success := FALSE ;
+      REPEAT
+         i := GetAndDeleteRandom(OrientationIndex) ;
+         CASE i OF
+
+         1:  Success := AttemptToPlaceCorridor(x, y, x+LenX, y+LenY) |
+
+         2:  IF x>LenX
+             THEN
+                Success := AttemptToPlaceCorridor(x-LenX, y, x, y+LenY)
+             END |
+
+         3:  IF y>LenY
+             THEN
+                Success := AttemptToPlaceCorridor(x, y-LenY, x+LenX, y)
+             END |
+
+         4:  IF (x>LenX) AND (y>LenY)
+             THEN
+                Success := AttemptToPlaceCorridor(x-LenX, y-LenY, x, y)
+             END
+
+         ELSE
+         END
+      UNTIL Success OR (i=0) ;
+   END ;
+   CheckKillOrientationIndex(i=0) ;
+   RETURN( Success )
+END PlaceCorridorBox ;
+
+
+(*
+   PlaceRoomBox - returns true if a box can make a corridor at
+                  position x, y.
+                  All 4 orientations are tried.
+
+
+                          2  1
+                          4  3
+
+                  Ie  1:  (x, y) (x+LenX, y+LenY)
+                      2:  (x, y) (x-LenX, y+LenY)
+                      3:  (x, y) (x+LenX, y-LenY)
+                      4:  (x, y) (x-LenX, y-LenY)
+*)
+
+PROCEDURE PlaceRoomBox (x, y: CARDINAL; LenX, LenY: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+   i      : CARDINAL ;
+BEGIN
+   CheckInitOrientationIndex ;
+   WITH Stack[StackPtr] DO
+      Success := FALSE ;
+      REPEAT
+         i := GetAndDeleteRandom(OrientationIndex) ;
+         CASE i OF
+
+         1:  Success := AttemptToPlaceRoom(x, y, x+LenX, y+LenY) |
+
+         2:  IF x>LenX
+             THEN
+                Success := AttemptToPlaceRoom(x-LenX, y, x, y+LenY)
+             END |
+
+         3:  IF y>LenY
+             THEN
+                Success := AttemptToPlaceRoom(x, y-LenY, x+LenX, y)
+             END |
+
+         4:  IF (x>LenX) AND (y>LenY)
+             THEN
+                Success := AttemptToPlaceRoom(x-LenX, y-LenY, x, y)
+             END
+
+         ELSE
+         END
+      UNTIL Success OR (i=0) ;
+   END ;
+   CheckKillOrientationIndex(i=0) ;
+   RETURN( Success )
+END PlaceRoomBox ;
+
+
+(*
+   CheckInitOrientationIndex - checks to see whether the current stacked
+                               entity needs a new orientation index to also
+                               be stacked.
+*)
+
+PROCEDURE CheckInitOrientationIndex ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      IF OrientationIndex=0
+      THEN
+         OrientationIndex := InitRandom() ;
+         AddRandom(OrientationIndex, 4)
+      END
+   END
+END CheckInitOrientationIndex ;
+
+
+(*
+   CheckKillOrientationIndex - checks to see whether the current stacked
+                               entities orientation index needs to be
+                               deleted.
+                               This procedure ideally should be a macro..
+*)
+
+PROCEDURE CheckKillOrientationIndex (NeedToKill: BOOLEAN) ;
+BEGIN
+   IF NeedToKill
+   THEN
+      WITH Stack[StackPtr] DO
+         KillRandom(OrientationIndex) ;
+         OrientationIndex := 0
+      END
+   END
+END CheckKillOrientationIndex ;
+
+
+(*
+   PushPerimeterOfBoxes - pushes all the current perimeter of the box map onto
+                          the perimeter stack.
+*)
+
+PROCEDURE PushPerimeterOfBoxes (CoordIndex: CARDINAL; NoOpt: BOOLEAN) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF NoOfBoxes=0
+   THEN
+      (* Perimeter is center square in map *)
+      AddCoord(CoordIndex, MaxX DIV 2, MaxY DIV 2)
+   ELSE
+      i := 1 ;
+      WHILE i<=NoOfBoxes DO
+         PushPerimeterOfWalls(CoordIndex, i, NoOpt) ;
+         INC(i)
+      END
+   END
+END PushPerimeterOfBoxes ;
+
+
+(*
+   PushPerimeterOfWalls - pushes all coordinates of a box wall which are
+                          external to the group of boxes.
+                          Ie any wall which does is not shared by an
+                          adjacent box MUST be external.
+                          NoOpt determines whether optimization should be
+                          applied to the restricting of perimeter coords.
+                          Optimiztion tests for the minimum size of a room
+                          to any wall, if this fails the coord is not added
+                          to the perimeter list.
+                          However this should not be used when pushing the
+                          room perimeter since optimization is too restrictive.
+                          (Corridor restrictions etc).
+*)
+
+PROCEDURE PushPerimeterOfWalls (CoordIndex: CARDINAL; b: CARDINAL;
+                                NoOpt: BOOLEAN) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      FOR i := x1 TO x2 DO
+         IF IsExternalHorizWallPerimeter(b, i, y1) AND
+            (NoOpt OR IsEnoughSpacePointToBox(i, y1))
+         THEN
+            AddCoord(CoordIndex, i, y1)
+         END ;
+         IF IsExternalHorizWallPerimeter(b, i, y2) AND
+            (NoOpt OR IsEnoughSpacePointToBox(i, y2))
+         THEN
+            AddCoord(CoordIndex, i, y2)
+         END
+      END ;
+      FOR j := y1 TO y2 DO
+         IF IsExternalVertWallPerimeter(b, x1, j) AND
+            (NoOpt OR IsEnoughSpacePointToBox(x1, j))
+         THEN
+            AddCoord(CoordIndex, x1, j)
+         END ;
+         IF IsExternalVertWallPerimeter(b, x2, j) AND
+            (NoOpt OR IsEnoughSpacePointToBox(x2, j))
+         THEN
+            AddCoord(CoordIndex, x2, j)
+         END
+      END
+   END
+END PushPerimeterOfWalls ;
+
+
+(*
+   IsExternalHorizWallPerimeter - returns true if coordinates,
+                                  x and y are not on any Horiz
+                                  wall of any box except b.
+                                  This routine allows point z, y to be
+                                  on a Vertical wall, but NOT on another
+                                  Horizontal wall.
+*)
+
+PROCEDURE IsExternalHorizWallPerimeter (b: CARDINAL;
+                                        x, y: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   Found := FALSE ;
+   IF NOT IsCornerPerimeter(b, x, y)
+   THEN
+      i := 0 ;
+      WHILE (i<=NoOfBoxes) AND (NOT Found) DO
+         IF i#b
+         THEN
+            WITH Boxes[i] DO
+               IF IsPointOnLine(x, y, x1, y1, x2, y1)
+               THEN
+                  Found := TRUE
+               ELSIF IsPointOnLine(x, y, x1, y2, x2, y2)
+               THEN
+                  Found := TRUE
+               END
+            END
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END IsExternalHorizWallPerimeter ;
+
+
+(*
+   IsExternalVertWallPerimeter - returns true if coordinates,
+                                 x and y are not on any Vertical
+                                 wall of any box except b.
+                                 This routine allows point z, y to be
+                                 on a Horizontal wall, but NOT on another
+                                 Vertical wall.
+*)
+
+PROCEDURE IsExternalVertWallPerimeter (b: CARDINAL;
+                                       x, y: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   Found := FALSE ;
+   IF NOT IsCornerPerimeter(b, x, y)
+   THEN
+      i := 0 ;
+      WHILE (i<=NoOfBoxes) AND (NOT Found) DO
+         IF i#b
+         THEN
+            WITH Boxes[i] DO
+               IF IsPointOnLine(x, y, x1, y1, x1, y2)
+               THEN
+                  Found := TRUE
+               ELSIF IsPointOnLine(x, y, x2, y1, x2, y2)
+               THEN
+                  Found := TRUE
+               END
+            END
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END IsExternalVertWallPerimeter ;
+
+
+(*
+   AttemptToPlaceCorridor - attempts to place a corridor x1, y1  x2, y2
+                            onto the map.
+                            If it succeeds it returns true
+                            otherwise false
+*)
+
+PROCEDURE AttemptToPlaceCorridor (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   IF IsCorridorSatisfied(x1, y1, x2, y2)
+   THEN
+      AddBox(x1, y1, x2, y2) ;
+      Success := TRUE
+   ELSE
+      Success := FALSE
+   END ;
+   RETURN( Success )
+END AttemptToPlaceCorridor ;
+
+
+(*
+   AttemptToPlaceRoom - attempts to place a room x1, y1  x2, y2
+                        onto the map.
+                        If it succeeds it returns true
+                        otherwise false
+*)
+
+PROCEDURE AttemptToPlaceRoom (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   IF IsRoomSatisfied(x1, y1, x2, y2)
+   THEN
+      AddBox(x1, y1, x2, y2) ;
+      Success := TRUE
+   ELSE
+      Success := FALSE
+   END ;
+   RETURN( Success )
+END AttemptToPlaceRoom ;
+
+
+(*
+   IsCorridorSatisfied - returns true if a Corridor x1, y1  x2, y2
+                         may be placed onto the map without
+                         contraveining the various rules.
+*)
+
+PROCEDURE IsCorridorSatisfied (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   (* Put(x1, y1, x2, y2) ; *)
+   IF (x2>MaxX) OR (y2>MaxY)
+   THEN
+      (* WriteString('Failed SIZE') ; WriteLn *)
+      Success := FALSE
+   ELSIF NOT DistanceAppartEdge(x1, y1, x2, y2)
+   THEN
+      Success := FALSE
+   ELSIF IsOverLappingBox(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed OVERLAP') ; *)
+      Success := FALSE
+   ELSIF NOT IsCorridorJoin(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed CORRIDOR JOIN') ; *)
+      Success := FALSE
+   ELSIF NOT IsEnoughSpaceBetweenCorridors(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed SPACE') ; *)
+      Success := FALSE
+   ELSE
+      Success := TRUE
+   END ;
+   RETURN( Success )
+END IsCorridorSatisfied ;
+
+
+(*
+   IsRoomSatisfied - returns true if a box x1, y1  x2, y2
+                     may be placed onto the map without
+                     contraveining the various rules.
+*)
+
+PROCEDURE IsRoomSatisfied (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   (* Put(x1, y1, x2, y2) ; *)
+   IF (x2>MaxX) OR (y2>MaxY)
+   THEN
+      (* WriteString('Failed SIZE') ; WriteLn ; *)
+      Success := FALSE
+   ELSIF IsOverLappingBox(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed OVERLAP') ; *)
+      Success := FALSE
+   ELSIF NOT DistanceAppartEdge(x1, y1, x2, y2)
+   THEN
+      Success := FALSE
+   ELSIF NOT IsBoxRoomLegal(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed Legal') ; *)
+      Success := FALSE
+   ELSIF NOT IsRoomJoin(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed ROOM JOIN') ; *)
+      Success := FALSE
+   ELSIF NOT IsEnoughSpaceBetweenRooms(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed SPACE') ; *)
+      Success := FALSE
+   ELSE
+      Success := TRUE
+      (* ; WriteString('SUCCESS') ; *)
+   END ;
+   RETURN( Success )
+END IsRoomSatisfied ;
+
+
+(*
+   IsEnoughSpacePointToBox - returns true if there is enough space
+                             between a point, x, y and all the boxes.
+                             This routine is called before perimeter
+                             coordinates are pushed, therefore coordinates
+                             pushed are not doomed to failure due to lack
+                             of space.
+                             This routine consists of a reduced
+                             IsEnoughSpaceBetweenBoxes procedure.
+*)
+
+PROCEDURE IsEnoughSpacePointToBox (x, y: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   i       : CARDINAL ;
+   Distance: CARDINAL ;
+BEGIN
+   ok := TRUE ;
+   i := 0 ;  (* 0 = Perimeter of map *)
+   WHILE ok AND (i<=NoOfBoxes) DO
+      Distance := DistanceAppartPoint(i, x, y) ;
+      IF Distance#0
+      THEN
+         ok := (Distance>=MinDistanceBetweenRooms)
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsEnoughSpacePointToBox ;
+
+
+(*
+   IsEnoughSpaceBetweenCorridors - returns true if there is enough
+                                   space between box x1, y1  x2, y2
+                                   and the other boxes.
+                                   Also tests for right angle connection.
+*)
+
+PROCEDURE IsEnoughSpaceBetweenCorridors (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   i       : CARDINAL ;
+   Distance: CARDINAL ;
+BEGIN
+   ok := TRUE ;
+   i := 1 ;
+   WHILE ok AND (i<=NoOfBoxes) DO
+      IF IsTouchingBox(i, x1, y1, x2, y2)
+      THEN
+         (* Check for a box that is not at right angles to new box. *)
+         (* We are only allowed to touch a box at right angles.     *)
+         IF NOT IsDifferentOrientationBox(i, x1, y1, x2, y2)
+         THEN
+            (* touching a box which is not at right angles *)
+            ok := FALSE
+         END
+      ELSIF FreeSpace(i, x1, y1, x2, y2)
+      THEN
+         Distance := DistanceAppartBox(i, x1, y1, x2, y2) ;
+(*
+      Distance := Min(
+                       DistanceAppartBox(i, x1, y1, x2, y2),
+                       DistanceAppartDiagonal(i, x1, y1, x2, y2)
+                     ) ;
+*)
+         IF Distance=0
+         THEN
+         ELSE
+            ok := (Distance>=MinDistanceBetweenCorridors)
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsEnoughSpaceBetweenCorridors ;
+
+
+(*
+   IsBoxRoomLegal - returns true if a box x1, y1, x2, y2 does not
+                    have a wall which is next to but not sharing
+                    another wall.
+*)
+
+PROCEDURE IsBoxRoomLegal (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   i       : CARDINAL ;
+   Distance: CARDINAL ;
+   CoveredN,
+   CoveredS,
+   CoveredE,
+   CoveredW: BOOLEAN ;
+BEGIN
+   CoveredN := IsFullyCovered(x1, y2, x2, y2) ;
+   CoveredS := IsFullyCovered(x1, y1, x2, y1) ;
+   CoveredE := IsFullyCovered(x2, y1, x2, y2) ;
+   CoveredW := IsFullyCovered(x1, y1, x1, y2) ;
+   ok := TRUE ;
+   i := 1 ;
+   WHILE ok AND (i<=NoOfBoxes) DO
+      IF NOT IsTouchingBox(i, x1, y1, x2, y2)
+      THEN
+         IF (x1>1) AND (NOT CoveredW)
+         THEN
+            ok := NOT IsTouchingBox(i, x1-1, y1, x2, y2)
+         END ;
+         IF ok AND (y1>1) AND (NOT CoveredS)
+         THEN
+            ok := NOT IsTouchingBox(i, x1, y1-1, x2, y2)
+         END ;
+         IF ok AND (x2<MaxX) AND (NOT CoveredE)
+         THEN
+            ok := NOT IsTouchingBox(i, x1, y1, x2+1, y2)
+         END ;
+         IF ok AND (y2<MaxY) AND (NOT CoveredN)
+         THEN
+            ok := NOT IsTouchingBox(i, x1, y1, x2, y2+1)
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsBoxRoomLegal ;
+
+
+(*
+   IsFullyCovered - returns true if every point on the line
+                    x1, y1, x2, y2 is covered. The line must
+                    either be horizontal or vertical.
+*)
+
+PROCEDURE IsFullyCovered (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   i      : CARDINAL ;
+   Covered: BOOLEAN ;
+BEGIN
+   Covered := TRUE ;
+   IF x1=x2
+   THEN
+      (* Vertical *)
+      i := y1 ;
+      WHILE Covered AND (i<=y2) DO
+         Covered := IsSpace(x1, i) ;
+         INC(i)
+      END
+   ELSIF y1=y2
+   THEN
+      (* Horizontal *)
+      i := x1 ;
+      WHILE Covered AND (i<=x2) DO
+         Covered := IsSpace(i, y1) ;
+         INC(i)
+      END
+   END ;
+   RETURN( Covered )
+END IsFullyCovered ;
+
+
+(*
+   IsEnoughSpaceBetweenRooms - returns true if there is enough
+                               space between box x1, y1  x2, y2
+                               and the other boxes.
+*)
+
+PROCEDURE IsEnoughSpaceBetweenRooms (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   i       : CARDINAL ;
+   Distance: CARDINAL ;
+BEGIN
+   ok := TRUE ;
+   i := 1 ;
+   WHILE ok AND (i<=NoOfBoxes) DO
+      IF NOT IsTouchingBox(i, x1, y1, x2, y2)
+      THEN
+         (* Dont test the walls of the box for contraveining the space rule *)
+(*
+         IF (x1+1<x2-1) AND (y1+1<y2-1) AND FreeSpace(i, x1+1, y1+1, x2-1, y2-1)
+         THEN
+            Distance := DistanceAppartDiagonal(i, x1+1, y1+1, x2-1, y2-1) ;
+*)
+         IF FreeSpace(i, x1, y1, x2, y2)
+         THEN
+(*
+            Distance := DistanceAppartDiagonal(i, x1, y1, x2, y2) ;
+*)
+            Distance := Max( DistanceAppartDiagonal(i, x1, y1, x2, y2),
+                             DistanceAppartBox(i, x1, y1, x2, y2) ) ;
+            (* WriteString('Dist') ; WriteCard(Distance, 6) ; WriteLn ; *)
+            IF Distance=0
+            THEN
+               (* touching a box *)
+            ELSE
+               Assert(NOT IsTouchingBox(i, x1, y1, x2, y2)) ;
+               ok := (Distance>=MinDistanceBetweenRooms)
+            END
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsEnoughSpaceBetweenRooms ;
+
+
+(*
+   FreeSpace - returns true if there exists free space between box
+               X1, Y1, X2, Y2 and box b.
+               Should not be called if box b touches X1, Y1, X2, Y2.
+*)
+
+PROCEDURE FreeSpace (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+VAR
+   Free  : BOOLEAN ;
+   xs, xe,
+   ys, ye,
+   i, j  : CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      IF Abs(X1, x2)<Abs(X2, x1)
+      THEN
+         xs := Min(X1, x2) ;
+         xe := Max(X1, x2)
+      ELSE
+         xs := Min(X2, x1) ;
+         xe := Max(X2, x1)
+      END ;
+      IF Abs(Y1, y2)<Abs(Y2, y1)
+      THEN
+         ys := Min(Y1, y2) ;
+         ye := Max(Y1, y2)
+      ELSE
+         ys := Min(Y2, y1) ;
+         ye := Max(Y2, y1)
+      END ;
+      Free := FALSE ;
+      i := xs ;
+      WHILE (NOT Free) AND (i<=xe) DO
+         j := ys ;
+         WHILE (NOT Free) AND (j<=ye) DO
+            Free := IsSpace(i, j) ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   END ;
+   (* IF Free THEN WriteString('FREE') END ; *)
+   RETURN( Free )
+END FreeSpace ;
+
+
+(*
+   IsSpace - returns true if point x, y is not in any box.
+             A wall is counted as in the box.
+*)
+
+PROCEDURE IsSpace (x, y: CARDINAL) : BOOLEAN ;
+VAR
+   b    : CARDINAL ;
+   InBox: BOOLEAN ;
+BEGIN
+   InBox := FALSE ;
+   b := 1 ;   (* Not zero of course !! *)
+   WHILE (NOT InBox) AND (b<=NoOfBoxes) DO
+      WITH Boxes[b] DO
+         InBox := IsSubRange(x1, x2, x) AND IsSubRange(y1, y2, y)
+      END ;
+      INC(b)
+   END ;
+   RETURN( NOT InBox )
+END IsSpace ;
+
+
+(*
+   DistanceAppartEdge - returns true if the box, x1, y1, x2, y2, is a
+                        required distance away from the edge of the
+                        map.
+                        Cannot use room zero for this test as we are inside
+                        it and may touch one wall but be too near another!
+*)
+
+PROCEDURE DistanceAppartEdge (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   Distance: CARDINAL ;
+BEGIN
+    ok := TRUE ;
+    Distance := Abs(x1, 1) ;
+    IF (Distance>0) AND ok
+    THEN
+       ok := (Distance>=MinDistanceBetweenRooms)
+    END ;
+    Distance := Abs(x2, MaxX) ;
+    IF (Distance>0) AND ok
+    THEN
+       ok := (Distance>=MinDistanceBetweenRooms)
+    END ;
+    Distance := Abs(y1, 1) ;
+    IF (Distance>0) AND ok
+    THEN
+       ok := (Distance>=MinDistanceBetweenRooms)
+    END ;
+    Distance := Abs(y2, MaxY) ;
+    IF (Distance>0) AND ok
+    THEN
+       ok := (Distance>=MinDistanceBetweenRooms)
+    END ;
+    RETURN( ok )
+END DistanceAppartEdge ;
+
+
+(*
+   DistanceAppartPoint - returns the distance appart between box, b,
+                         and point X, Y.
+*)
+
+PROCEDURE DistanceAppartPoint (b: CARDINAL; X, Y: CARDINAL) : CARDINAL ;
+VAR
+   Xmin,
+   Ymin: CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      IF IsSubRange(x1, x2, X)
+      THEN
+         Ymin := Min( Abs(y1, Y), Abs(y2, Y) )
+      ELSE
+         Ymin := MaxCard
+      END ;
+      IF IsSubRange(y1, y2, Y)
+      THEN
+         Xmin := Min( Abs(x1, X), Abs(x2, X) )
+      ELSE
+         Xmin := MaxCard
+      END
+   END ;
+   RETURN( Min(Xmin, Ymin) )
+END DistanceAppartPoint ;
+
+
+(*
+   DistanceAppartBox - returns the distance appart between box, b,
+                       and box X1, Y1, X2, Y2
+*)
+
+PROCEDURE DistanceAppartBox (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : CARDINAL ;
+VAR
+   Xmin,
+   Ymin: CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      IF IsIntersectingRange(x1, x2, X1, X2)
+      THEN
+         Ymin := Min(
+                      Min( Abs(y1, Y1), Abs(y2, Y2) ),
+                      Min( Abs(y1, Y2), Abs(Y1, y2) )
+                    )
+      ELSE
+         Ymin := MaxCard
+      END ;
+      IF IsIntersectingRange(y1, y2, Y1, Y2)
+      THEN
+         Xmin := Min(
+                      Min( Abs(x1, X1), Abs(x2, X2) ),
+                      Min( Abs(x1, X2), Abs(X1, x2) )
+                    )
+      ELSE
+         Xmin := MaxCard
+      END
+   END ;
+   RETURN( Min(Xmin, Ymin) )
+END DistanceAppartBox ;
+
+
+(*
+   DistanceAppartDiagonal - returns the diagonal
+                            distance appart between X1, Y1, X2, Y2
+                            and box b.
+*)
+
+PROCEDURE DistanceAppartDiagonal (b: CARDINAL;
+                                  X1, Y1, X2, Y2: CARDINAL) : CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      RETURN(
+              Min(
+                   Min( Abs(x1, X2), Abs(x2, X1) ),
+                   Min( Abs(y1, Y2), Abs(y2, Y1) )
+                 )
+            )
+   END
+END DistanceAppartDiagonal ;
+
+
+(*
+   IsCorridorJoin - returns true if a box corridor x1, y1  x2, y2
+                    joins another corridor at right angles without
+                    cutting off the potential corridor door.
+
+                    A corridor is thought of as
+
+                    ##########################
+                    |                        |
+                    |                        |
+                    ##########################
+
+                    and may only be placed together in a way such that
+                    they meet  -|  or  -  etc
+                                       |
+
+                    False is returned if this box corridor does not
+                    correctly form a T junction with another.
+*)
+
+PROCEDURE IsCorridorJoin (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok,
+   DoorFound: BOOLEAN ;
+   b        : CARDINAL ;
+BEGIN
+   ok := TRUE ;
+   IF NoOfBoxes=0
+   THEN
+      DoorFound := TRUE
+   ELSE
+      DoorFound := FALSE ;
+      b := 1 ;
+      WHILE ok AND (b<=NoOfBoxes) DO
+         (* WriteString('Box') ; WriteCard(b, 2) ; *)
+         IF IsTouchingBox(b, x1, y1, x2, y2)
+         THEN
+            (* WriteString('TouchingBox') ; *)
+            IF IsDifferentOrientationBox(b, x1, y1, x2, y2)
+            THEN
+               (* WriteString('Different Orientation') ; *)
+               IF NOT DoorFound
+               THEN
+                  DoorFound := IsCorridorWallJoinBox(b, x1, y1, x2, y2)
+               END
+               (* ; IF ok THEN WriteString('WallJoin') END ; *)
+            ELSE
+               ok := FALSE  (* Dont allow parallel corridors to touch *)
+            END
+         END ;
+         INC(b)
+      END
+   END ;
+   RETURN( ok AND DoorFound )
+END IsCorridorJoin ;
+
+
+(*
+   IsRoomJoin - returns true if a box room x1, y1  x2, y2
+                joins another room with enough space for a door.
+*)
+
+PROCEDURE IsRoomJoin (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   DoorFound: BOOLEAN ;
+   b        : CARDINAL ;
+BEGIN
+   IF NoOfBoxes=0
+   THEN
+      DoorFound := TRUE
+   ELSE
+      DoorFound := FALSE ;
+      b := 1 ;
+      WHILE (NOT DoorFound) AND (b<=NoOfBoxes) DO
+         (* WriteString('Box') ; WriteCard(b, 2) ; *)
+         IF IsTouchingBox(b, x1, y1, x2, y2)
+         THEN
+            IF NOT DoorFound
+            THEN
+               DoorFound := IsRoomWallJoinBox(b, x1, y1, x2, y2)
+            END
+         END ;
+         INC(b)
+      END
+   END ;
+   RETURN( DoorFound )
+END IsRoomJoin ;
+
+
+(*
+   IsCorridorWallJoinBox - returns true if box, b, and box X1, Y1  X2, Y2
+                           form a correct join ie covering the potential
+                           door.
+*)
+
+PROCEDURE IsCorridorWallJoinBox (b: CARDINAL;
+                                 X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   WITH Boxes[b] DO
+      Success := (((X1=x1) OR (X1=x2) OR (X2=x1) OR (X2=x2))
+                              AND IsSubLine(Y1, Y2, y1, y2)) OR
+                 (((Y1=y1) OR (Y1=y2) OR (Y2=y1) OR (Y2=y2))
+                              AND IsSubLine(X1, X2, x1, x2)) ;
+      RETURN( Success )
+   END
+END IsCorridorWallJoinBox ;
+
+
+(*
+   IsRoomWallJoinBox - returns true if box, b, and box X1, Y1  X2, Y2
+                       form a correct join ie covering the potential
+                       door.
+*)
+
+PROCEDURE IsRoomWallJoinBox (b: CARDINAL;
+                             X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+VAR
+   DoorWidth: CARDINAL ;
+BEGIN
+   DoorWidth := 0 ;
+   WITH Boxes[b] DO
+      IF (X1=x2) OR (x1=X2)
+      THEN
+         DoorWidth := IntersectionLength(Y1, Y2, y1, y2) ;
+         IF (IsSubRange(Y1, Y2, y1) OR IsSubRange(y1, y2, Y1)) AND (DoorWidth>1)
+         THEN
+            DEC(DoorWidth)
+         END ;
+         IF (IsSubRange(Y1, Y2, y2) OR IsSubRange(y1, y2, Y2)) AND (DoorWidth>1)
+         THEN
+            DEC(DoorWidth)
+         END
+      ELSIF (Y1=y2) OR (y1=Y2)
+      THEN
+         DoorWidth := IntersectionLength(X1, X2, x1, x2) ;
+         IF (IsSubRange(X1, X2, x1) OR IsSubRange(x1, x2, X1)) AND (DoorWidth>1)
+         THEN
+            DEC(DoorWidth)
+         END ;
+         IF (IsSubRange(X1, X2, x2) OR IsSubRange(x1, x2, X2)) AND (DoorWidth>1)
+         THEN
+            DEC(DoorWidth)
+         END
+      END ;
+      RETURN( DoorWidth>=MinDoorLength )
+   END
+END IsRoomWallJoinBox ;
+
+
+(*
+   IsDifferentOrientationBox - returns true if box b has a different
+                               orientation to box X1, Y1  X2, Y2.
+*)
+
+PROCEDURE IsDifferentOrientationBox (b: CARDINAL;
+                                     X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Boxes[b] DO
+      IF Abs(X1, X2) = Abs(Y1, Y2)
+      THEN
+         RETURN( TRUE )                        (* Square X1, Y1, X2, Y2 *)
+      ELSIF Abs(X1, X2) > Abs(Y1, Y2)
+      THEN
+         RETURN( Abs(x1, x2) <= Abs(y1, y2) )
+      ELSE
+         RETURN( Abs(x1, x2) >= Abs(y1, y2) )
+      END
+   END
+END IsDifferentOrientationBox ;
+
+
+(*
+   IsTouchingBox - returns true if a box X1, Y1  X2, Y2 touches box b
+                   or if it intersects with this box.
+*)
+
+PROCEDURE IsTouchingBox (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Boxes[b] DO
+      RETURN( NOT ((X2<x1) OR (X1>x2) OR (Y2<y1) OR (Y1>y2)) )
+   END
+END IsTouchingBox ;
+
+
+(*
+   IsCornerPerimeter - returns true if box, b, has a corner x, y which
+                       is a perimeter.
+*)
+
+PROCEDURE IsCornerPerimeter (b: CARDINAL; x, y: CARDINAL) : BOOLEAN ;
+VAR
+   Perimeter: BOOLEAN ;
+   i, j     : CARDINAL ;
+BEGIN
+   IF IsCorner(b, x, y)
+   THEN
+      Perimeter := FALSE ;
+      i := x-1 ;
+      j := y-1 ;
+      WHILE (NOT Perimeter) AND (i<=x+1) DO
+         j := y-1 ;
+         WHILE (NOT Perimeter) AND (j<=y+1) DO
+            IF IsSubRange(1, MaxX, i) AND IsSubRange(1, MaxY, j)
+            THEN
+               Perimeter := IsSpace(i, j)
+            END ;
+            INC(j, 2)
+         END ;
+         INC(i, 2)
+      END ;
+      RETURN( Perimeter )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsCornerPerimeter ;
+
+
+(*
+   IsCorner - returns true if box, b, has a corner x, y.
+*)
+
+PROCEDURE IsCorner (b: CARDINAL; x, y: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Boxes[b] DO
+      RETURN( ((x1=x) OR (x2=x)) AND ((y1=y) OR (y2=y)) )
+   END
+END IsCorner ;
+
+
+(*
+   IsOverLappingBox - returns true if box X1, Y1  X2, Y2 overlaps
+                      with another box NOT including edges touching.
+*)
+
+PROCEDURE IsOverLappingBox (X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+VAR
+   b    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   Found := FALSE ;
+   b := 1 ;
+   WHILE (NOT Found) AND (b<=NoOfBoxes) DO
+      WITH Boxes[b] DO
+         Found := IsIntersection(x1, y1, x2, y2, X1, Y1, X2, Y2)
+      END ;
+      INC(b)
+   END ;
+   RETURN( Found )
+END IsOverLappingBox ;
+
+
+(*
+   IsIntersection - returns true if two boxes x1, y1  x2, y2 intersects
+                    with X1, Y1  X2, Y2. Wall touching is allowed.
+*)
+
+PROCEDURE IsIntersection (x1, y1, x2, y2,
+                          X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( NOT ( (x2<=X1) OR (x1>=X2) OR (y2<=Y1) OR (y1>=Y2) ) )
+END IsIntersection ;
+
+
+(*
+   AddBox - adds a box to the list of boxes and
+            adds a box to the Map.
+*)
+
+PROCEDURE AddBox (X1, Y1, X2, Y2: CARDINAL) ;
+BEGIN
+   IF NoOfBoxes=MaxBoxes
+   THEN
+      WriteString('Too many boxes in Module MakeMap') ; WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfBoxes) ;
+      WITH Boxes[NoOfBoxes] DO
+         x1 := X1 ;
+         y1 := Y1 ;
+         x2 := X2 ;
+         y2 := Y2
+      END
+   END
+END AddBox ;
+
+
+(*
+   GetCh - waits for a character to be pressed.
+*)
+
+PROCEDURE GetCh ;
+VAR
+   ch: CHAR ;
+BEGIN
+   Read(ch)
+END GetCh ;
+
+
+BEGIN
+   Init
+END BoxMap.
diff --git a/gcc/testsuite/gm2/examples/map/pass/Chance.def b/gcc/testsuite/gm2/examples/map/pass/Chance.def
new file mode 100644
index 00000000000..afa69a40988
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/Chance.def
@@ -0,0 +1,72 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE Chance ;
+
+(*
+   Title      : Chance
+   Author     : Gaius Mulley
+   Date       : 19/7/88
+   LastEdit   : 19/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Provides a set of utilities for random numbers.
+*)
+
+EXPORT QUALIFIED InitRandom, KillRandom,
+                 GetAndDeleteRandom, AddRandom, GetRand ;
+
+(*
+   InitRandom - Initializes a potential list of random numbers.
+                An index to this potential random number list is returned.
+*)
+
+PROCEDURE InitRandom () : CARDINAL ;
+
+
+(*
+   KillRandom - Kills a complete list of random numbers.
+*)
+
+PROCEDURE KillRandom (RandomListIndex: CARDINAL) ;
+
+
+(*
+   GetAndDeleteRandom - Returns a random number from the
+                        list and then it is deleted.
+                        Numbers 1..n will be returned if they exist,
+                        if 0 is returned then the list is empty.
+*)
+
+PROCEDURE GetAndDeleteRandom (RandomListIndex: CARDINAL) : CARDINAL ;
+
+
+(*
+   AddRandom - places a list of numbers 1..n into the specified list.
+*)
+
+PROCEDURE AddRandom (RandomListIndex: CARDINAL; n: CARDINAL) ;
+
+
+(*
+   GetRand - returns a number between 0..n-1.
+             This routine is independant from the above routines.
+*)
+
+PROCEDURE GetRand (n: CARDINAL) : CARDINAL ;
+
+
+END Chance.
diff --git a/gcc/testsuite/gm2/examples/map/pass/Chance.mod b/gcc/testsuite/gm2/examples/map/pass/Chance.mod
new file mode 100644
index 00000000000..900f6e102e0
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/Chance.mod
@@ -0,0 +1,206 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+IMPLEMENTATION MODULE Chance ;
+
+
+FROM Args IMPORT GetArg ;
+FROM NumberIO IMPORT StrToCard ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+(* FROM Random IMPORT RandomCard ; *)
+
+
+CONST
+   MaxCard   = 65535 ;
+   MaxRandom =  8000 ;
+   MaxIndex  =   500 ;
+
+TYPE
+   Index  = RECORD
+               Start,               (* Start of the Random list *)
+               End  : CARDINAL ;    (* End of the Random list   *)
+            END ;
+
+VAR
+   RandomIndex: ARRAY [0..MaxIndex] OF Index ;
+   Random     : ARRAY [1..MaxRandom] OF CARDINAL ;
+   NoOfRandom : CARDINAL ;   (* Number of random numbers in array Coords *)
+   NoOfIndices: CARDINAL ;   (* Number of indices in RandomIndex         *)
+
+
+(*
+   InitRandom - Initializes a potential list of random numbers.
+                An index to this potential random number list is returned.
+*)
+
+PROCEDURE InitRandom () : CARDINAL ;
+BEGIN
+   IF NoOfIndices=MaxIndex
+   THEN
+      WriteString('Too many random list indices in Module Chance') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfIndices) ;
+      WITH RandomIndex[NoOfIndices] DO
+         Start := NoOfRandom+1 ;
+         End := 0
+      END ;
+      Add(NoOfIndices, 0) ;     (* Dummy random no. that we keep *)
+      RETURN(NoOfIndices)       (* for the life of this list.    *)
+   END
+END InitRandom ;
+
+
+(*
+   KillRandom - Kills a complete list of random numbers.
+*)
+
+PROCEDURE KillRandom (RandomListIndex: CARDINAL) ;
+BEGIN
+   IF NoOfIndices>0
+   THEN
+      (* Destroy index to Random list *)
+      WITH RandomIndex[RandomListIndex] DO
+         Start := 0 ;
+         End := 0
+      END ;
+      (*
+         If killed last Random index list see if we can garbage collect
+         previously killed middle indices.
+      *)
+      IF NoOfIndices=RandomListIndex
+      THEN
+         REPEAT
+            DEC(NoOfIndices)
+         UNTIL (NoOfIndices=0) OR (RandomIndex[NoOfIndices].Start#0)
+      END ;
+      NoOfRandom := RandomIndex[NoOfIndices].End
+   ELSE
+      WriteString('All Random lists have been killed - Module Chance') ;
+      WriteLn ;
+      HALT
+   END
+END KillRandom ;
+
+
+(*
+   AddRandom - places a list of numbers 1..n into the specified list.
+*)
+
+PROCEDURE AddRandom (RandomListIndex: CARDINAL; n: CARDINAL) ;
+BEGIN
+   WHILE n>0 DO
+      Add(RandomListIndex, n) ;
+      DEC(n)
+   END
+END AddRandom ;
+
+
+PROCEDURE Add (RandomListIndex: CARDINAL; i: CARDINAL) ;
+BEGIN
+   IF NoOfRandom=MaxRandom
+   THEN
+      WriteString('Too many random numbers in a list in Module Chance') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfRandom) ;
+      Random[NoOfRandom] := i ;
+      WITH RandomIndex[RandomListIndex] DO
+         End := NoOfRandom
+      END
+   END
+END Add ;
+
+
+(*
+   GetAndDeleteRandom - Returns a random number from the
+                        list and then it is deleted.
+*)
+
+PROCEDURE GetAndDeleteRandom (RandomListIndex: CARDINAL) : CARDINAL ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH RandomIndex[RandomListIndex] DO
+      i := Start+GetRand(End-Start+1) ;  (* +1 for GetRand *)
+      j := i ;
+      REPEAT
+         IF Random[j]=0
+         THEN
+            INC(j) ;
+            IF j>End
+            THEN
+               j := Start
+            END
+         END
+      UNTIL (j=i) OR (Random[j]#0) ;
+      i := Random[j] ;
+      Random[j] := 0        (* Now delete this box *)
+   END ;
+   RETURN( i )
+END GetAndDeleteRandom ;
+
+
+(*
+   GetRand - returns a number between 0..n-1.
+             This routine is independant of the above routines.
+*)
+
+VAR
+   RandomSeed: CARDINAL ;
+   Num       : ARRAY [0..9] OF CHAR ;
+
+PROCEDURE GetRand (n: CARDINAL) : CARDINAL ;
+BEGIN
+   (* $R- *)
+   RandomSeed := (RandomSeed*257 + 0ABCDH) MOD MaxCard ;
+   (* $R= *)
+   RETURN( RandomSeed MOD n )
+(*
+   IF n<2
+   THEN
+      RETURN( 0 )  (* return 0  if n=0  or n=1 *)
+   ELSE
+      RETURN( RandomCard(n) )
+   END
+*)
+END GetRand ;
+
+
+PROCEDURE Init ;
+BEGIN
+   NoOfRandom := 0 ;
+   NoOfIndices := 0 ;
+   WITH RandomIndex[NoOfIndices] DO
+      End := 0
+   END
+END Init ;
+
+
+BEGIN
+   Init
+   ; IF GetArg(Num, 1)
+   THEN
+      StrToCard(Num, RandomSeed)
+   ELSE
+      RandomSeed := 3
+   END
+END Chance.
diff --git a/gcc/testsuite/gm2/examples/map/pass/Find.def b/gcc/testsuite/gm2/examples/map/pass/Find.def
new file mode 100644
index 00000000000..a506a747318
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/Find.def
@@ -0,0 +1,52 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE Find ;
+
+(*
+   Title      : WriteMap
+   Author     : Gaius Mulley
+   Date       : Sat Dec  7 16:04:47 gmt 1991
+   LastEdit   : Sat Dec  7 16:04:47 gmt 1991
+   System     : LOGITECH MODULA-2/86
+   Description: Works out an optimum route from a start position
+      	        to a finish position.
+*)
+
+EXPORT QUALIFIED FindOptimumRoute ;
+
+
+(*
+   FindOptimumRoute - finds the optimum route between two points,
+                      x1, y1, x2, y2. The directions are returned
+                      in a string, Commands. A boolean is returned
+                      if any commands were entered.
+*)
+
+PROCEDURE FindOptimumRoute (x1, y1, x2, y2: INTEGER;
+      	       	     	    VAR Commands: ARRAY OF CHAR) : BOOLEAN ;
+
+(*
+   IsOptimumRoutePossible - returns true if we can use the optimum
+                            route procedure to work out how to get
+      	       	     	    to position, x2, y2 from x1, y1.
+*)
+
+PROCEDURE IsOptimumRoutePossible (x1, y1, x2, y2: INTEGER) : BOOLEAN ;
+
+
+END Find.
diff --git a/gcc/testsuite/gm2/examples/map/pass/Find.mod b/gcc/testsuite/gm2/examples/map/pass/Find.mod
new file mode 100644
index 00000000000..704d786dec7
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/Find.mod
@@ -0,0 +1,309 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+IMPLEMENTATION MODULE Find ;
+
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+CONST
+   MaxX     =         10 ;
+   MaxY     =         20 ;
+   Infinity =      10000 ;
+   Wall     = Infinity   ;
+   Door     = Infinity-1 ;
+
+VAR
+   MapDist: ARRAY [0..MaxX], [0..MaxY] OF CARDINAL ;
+   Xoffset,
+   Yoffset: CARDINAL ;
+
+(*
+   FindOptimumRoute - finds the optimum route between two points,
+                      x1, y1, x2, y2. The directions are returned
+                      in a string, Commands. A boolean is returned
+                      if any commands were entered.
+*)
+
+PROCEDURE FindOptimumRoute (x1, y1, x2, y2: INTEGER;
+      	       	     	    VAR Commands: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   IF IsOptimumRoutePossible(x1, y1, x2, y2)
+   THEN
+      InitMapDist(x1, y1, x2, y2) ;
+      RETURN( CalculateOptimumRoute(x1, y1, x2, y2, Commands) )
+   ELSE
+      RETURN( FALSE )
+   END
+END FindOptimumRoute ;
+
+
+(*
+   IsOptimumRoutePossible - returns true if we can use the optimum
+                            route procedure to work out how to get
+      	       	     	    to position, x2, y2 from x1, y1.
+*)
+
+PROCEDURE IsOptimumRoutePossible (x1, y1, x2, y2: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN( (Abs(x1, x2) <= MaxX) AND (Abs(y1, y2) <= MaxY) )
+END IsOptimumRoutePossible ;
+
+
+(*
+   Min - returns the minimum of two cardinals.
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a>b
+   THEN
+      RETURN( b )
+   ELSE
+      RETURN( a )
+   END
+END Min ;
+
+
+(*
+   Abs - returns the absolute difference between two INTEGERs.
+*)
+
+PROCEDURE Abs (a, b: INTEGER) : INTEGER ;
+BEGIN
+   IF a>b
+   THEN
+      RETURN( a-b )
+   ELSE
+      RETURN( b-a )
+   END
+END Abs ;
+
+
+(*
+   CalculateOptimumRoute - calculates the optimum route between
+      	       	     	   two points and putting the route into
+      	       	     	   the string Commands. TRUE is returned
+                           if any commands are placed into Commands.
+*)
+
+PROCEDURE CalculateOptimumRoute (x1, y1, x2, y2: INTEGER;
+      	       	     	      	 VAR Commands: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   Distance: CARDINAL ;
+BEGIN
+   Distance := ScanBackwards(x1, y1, x2, y2, 0) ;
+   RETURN( FALSE )
+END CalculateOptimumRoute ;
+
+
+(*
+   ScanBackwards - fills in the DistMap with the distance values
+      	       	   from x2, y2 to x1, y1.
+*)
+
+PROCEDURE ScanBackwards (x1, y1, x2, y2: INTEGER;
+      	       	     	 Distance: CARDINAL) : CARDINAL ;
+VAR
+   ShortDist: CARDINAL ;
+BEGIN
+   IF ((MapDist[x2, y2]=0) OR (Distance < MapDist[x2, y2]))
+   THEN
+      ShortDist := Infinity ;
+      MapDist[x2, y2] := Distance ;
+      ShortDist := MoveVector(x1, y1, x2, y2,  0,  1, Distance) ;
+      ShortDist := MoveVector(x1, y1, x2, y2,  1,  0, Distance) ;
+      ShortDist := MoveVector(x1, y1, x2, y2,  0, -1, Distance) ;
+      ShortDist := MoveVector(x1, y1, x2, y2, -1,  0, Distance) ;
+      RETURN( ShortDist )
+   ELSE
+      RETURN( MapDist[x2, y2]+Distance )
+   END
+END ScanBackwards ;
+
+
+(*
+   MoveVector - returns a CARDINAL value indicating the distance between
+      	        x2, y2 and x1, y1. It moves one step from x2, y2 along
+      	        vector xv, yv. If this vector hits upon a door then
+      	        we increment the vector - we dont increment the
+      	        distance as one goes through a door using 1 unit
+      	        of distance (actually covering 2 units of space).
+*)
+
+PROCEDURE MoveVector (x1, y1, x2, y2: INTEGER ;
+      	       	      xv, yv  : INTEGER ;
+      	       	      Distance: CARDINAL) : CARDINAL ;
+VAR
+   ShortDist: CARDINAL ;
+BEGIN
+   IF IsDoor(x2+xv, y2+yv)
+   THEN
+      xv := 2*xv ;
+      yv := 2*yv
+   END ;
+   INC(Distance) ;
+   y2 := y2+yv ;
+   x2 := x2+xv ;
+   IF CheckSquare(x2, y2)
+   THEN
+      ShortDist := ScanBackwards(x1, y1, x2, y2, Distance)
+   ELSE
+      ShortDist := Infinity
+   END ;
+   RETURN( ShortDist )
+END MoveVector ;
+
+
+(*
+   CheckSquare - checks to see whether square, x, y, is free.
+      	       	 If this square is free then true is returned.
+*)
+
+PROCEDURE CheckSquare (x, y: INTEGER) : BOOLEAN ;
+BEGIN
+   IF InRange(x, y) AND (MapDist[x, y] # Wall)
+   THEN
+      RETURN( TRUE )
+   END ;
+   RETURN( FALSE )
+END CheckSquare ;
+
+
+(*
+   IsDoor - returns true if point, x, y, is legal and is
+      	    on a door.
+*)
+
+PROCEDURE IsDoor (x, y: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN( InRange(x, y) AND (MapDist[x, y] = Door) )
+END IsDoor ;
+
+
+(*
+   InRange - returns a boolean result determining whether, x, y,
+      	     is a legal index for the MapDist array.
+*)
+
+PROCEDURE InRange (x, y: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN( (x <= MaxX) AND (y <= MaxY) AND
+      	   (x >= 0)    AND (y >= 0) )
+END InRange ;
+
+
+(*
+   InitMapDist - initializes the MapDist matrix.
+*)
+
+PROCEDURE InitMapDist (x1, y1, x2, y2: INTEGER) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   FOR i := 0 TO MaxX DO
+      FOR j := 0 TO MaxY DO
+      	 MapDist[i, j] := 0  (* Empty *)
+      END
+   END ;
+   (*
+      Work out the Xoffset and Yoffset. We require that
+      our x1, y1 and x2, y2 are as central as possible.
+   *)
+   Xoffset := (MaxX DIV 2) - (Abs(x1, x2) DIV 2) ;
+   Yoffset := (MaxY DIV 2) - (Abs(y1, y2) DIV 2) ;
+   OverlayAdvMap
+END InitMapDist ;
+
+
+PROCEDURE OverlayAdvMap ;
+VAR
+   r, w, d: CARDINAL ;
+BEGIN
+END OverlayAdvMap ;
+
+
+(*
+   DisplayMap - display the contents of the DistMap.
+*)
+
+PROCEDURE DisplayMap ;
+VAR
+   x, y: CARDINAL ;
+BEGIN
+   WriteString('------------------------------------------------------') ;
+   WriteLn ;
+   FOR y := 0 TO MaxY DO
+      FOR x := 0 TO MaxX DO
+      	 IF MapDist[x, y] = Wall
+      	 THEN
+      	    WriteString('######')
+      	 ELSIF MapDist[x, y] = Door
+      	 THEN
+      	    WriteString('      ')
+      	 ELSE
+      	    WriteCard(MapDist[x, y], 3) ; WriteString('   ')
+      	 END
+      END ;
+      WriteLn
+   END
+END DisplayMap ;
+
+
+(*
+   TestDistance - tests to see whether the ScanBackwards procedure
+      	       	  works.
+*)
+
+PROCEDURE TestDistance ;
+VAR
+   MyDist: CARDINAL ;
+   x, y  : CARDINAL ;
+BEGIN
+   InitMapDist(0, 0, MaxX, MaxY) ;
+   FOR y := 0 TO MaxY DO
+      MapDist[4, y] := Wall
+   END ;
+   MapDist[4, 3] := Door ;
+
+   FOR y := 0 TO MaxY DO
+      MapDist[7, y] := Wall
+   END ;
+   MapDist[7, 7] := Door ;
+
+   FOR x := 0 TO MaxX DO
+      MapDist[x, 2] := Wall
+   END ;
+   MapDist[2, 2] := Door ;
+   DisplayMap ;
+   WriteString('Creating distance map between points 0,0 and MaxX, MaxY') ;
+   WriteLn ;
+   MyDist := ScanBackwards(0, 0, MaxX, MaxY, 1) ;
+
+   WriteString('Distance is') ;
+
+   WriteCard(MapDist[0,0], 6) ;
+   WriteLn ;
+   DisplayMap
+END TestDistance ;
+
+
+BEGIN
+   TestDistance
+END Find.
diff --git a/gcc/testsuite/gm2/examples/map/pass/Geometry.def b/gcc/testsuite/gm2/examples/map/pass/Geometry.def
new file mode 100644
index 00000000000..3000480ca9b
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/Geometry.def
@@ -0,0 +1,100 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE Geometry ;
+
+(*
+   Title      : Geometry
+   Author     : Gaius Mulley
+   Date       : 20/8/88
+   LastEdit   : 20/8/88
+   System     : LOGITECH MODULA-2/86
+   Description: Defines some commonly used geometrical functions.
+*)
+
+EXPORT QUALIFIED IsSubLine, IsSubRange, IsIntersectingRange,
+                 IntersectionLength, IsPointOnLine,
+                 Abs, Min, Max, Swap ;
+
+
+(*
+   IsSubLine - returns true if the range i1..i2 or j1..j2 are ranges
+               of each other.
+*)
+
+PROCEDURE IsSubLine (i1, i2, j1, j2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSubRange - returns true if i lies inbetween High and Low.
+*)
+
+PROCEDURE IsSubRange (Low, High, i: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsIntersectingRange - returns true if the ranges i1..i2  j1..j2
+                         overlap.
+*)
+
+PROCEDURE IsIntersectingRange (i1, i2, j1, j2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IntersectionLength - returns the intersection length
+                        of the overlapping ranges i1..i2  j1..j2.
+*)
+
+PROCEDURE IntersectionLength (i1, i2, j1, j2: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsPointOnLine - returns true if point x, y is on line (x1, y1) , (x2, y2)
+*)
+
+PROCEDURE IsPointOnLine (x, y: CARDINAL; x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Max - returns the largest cardinal number from i and j.
+*)
+
+PROCEDURE Max (i, j: CARDINAL) : CARDINAL ;
+
+
+(*
+   Min - returns the smallest cardinal number from i and j.
+*)
+
+PROCEDURE Min (i, j: CARDINAL) : CARDINAL ;
+
+
+(*
+   Abs - returns the difference between i and j.
+*)
+
+PROCEDURE Abs (i, j: CARDINAL) : CARDINAL ;
+
+
+(*
+   Swap - swaps two cardinal numbers i and j.
+*)
+
+PROCEDURE Swap (VAR i, j: CARDINAL) ;
+
+
+END Geometry.
diff --git a/gcc/testsuite/gm2/examples/map/pass/Geometry.mod b/gcc/testsuite/gm2/examples/map/pass/Geometry.mod
new file mode 100644
index 00000000000..64f4cd51534
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/Geometry.mod
@@ -0,0 +1,154 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+IMPLEMENTATION MODULE Geometry ;
+
+
+FROM Assertion IMPORT Assert ;
+
+
+(*
+   IsSubLine - returns true if the range i1..i2 or j1..j2 are ranges
+               of each other.
+*)
+
+PROCEDURE IsSubLine (i1, i2, j1, j2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( ((i1<=j1) AND (i2>=j2)) OR ((j1<=i1) AND (j2>=i2)) )
+END IsSubLine ;
+
+
+(*
+   IsIntersectingRange - returns true if the ranges i1..i2  j1..j2
+                         overlap.
+*)
+
+PROCEDURE IsIntersectingRange (i1, i2, j1, j2: CARDINAL) : BOOLEAN ;
+BEGIN
+   (* Easier to prove NOT outside limits!! *)
+   RETURN( NOT ((i1>j2) OR (i2<j1)) )
+END IsIntersectingRange ;
+
+
+(*
+   IntersectionLength - returns the intersection length
+                        of the overlapping ranges i1..i2  j1..j2.
+*)
+
+PROCEDURE IntersectionLength (i1, i2, j1, j2: CARDINAL) : CARDINAL ;
+BEGIN
+   IF IsSubRange(i1, i2, j1)
+   THEN
+      RETURN( Abs(j1, Min(i2, j2)) )
+   ELSIF IsSubRange(i1, i2, j2)
+   THEN
+      RETURN( Abs(Max(i1, j1), j2) )
+   ELSE
+      RETURN( 0 )
+   END
+END IntersectionLength ;
+
+
+(*
+   IsPointOnLine - returns true if point x, y is on line (x1, y1) , (x2, y2)
+*)
+
+PROCEDURE IsPointOnLine (x, y: CARDINAL; x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF (x1=x2) AND (x=x1)
+   THEN
+      RETURN( IsSubRange(y1, y2, y) )
+   ELSIF (y1=y2) AND (y=y1)
+   THEN
+      RETURN( IsSubRange(x1, x2, x) )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsPointOnLine ;
+
+
+(*
+   IsSubRange - returns true if i lies inbetween High and Low.
+*)
+
+PROCEDURE IsSubRange (Low, High, i: CARDINAL) : BOOLEAN ;
+BEGIN
+   Assert(High>=Low) ;
+   RETURN( (i>=Low) AND (i<=High) )
+END IsSubRange ;
+
+
+(*
+   Max - returns the largest cardinal number from i and j.
+*)
+
+PROCEDURE Max (i, j: CARDINAL) : CARDINAL ;
+BEGIN
+   IF i>j
+   THEN
+      RETURN( i )
+   ELSE
+      RETURN( j )
+   END
+END Max ;
+
+
+(*
+   Min - returns the smallest cardinal number from i and j.
+*)
+
+PROCEDURE Min (i, j: CARDINAL) : CARDINAL ;
+BEGIN
+   IF i<j
+   THEN
+      RETURN( i )
+   ELSE
+      RETURN( j )
+   END
+END Min ;
+
+
+(*
+   Abs - returns the difference between i and j.
+*)
+
+PROCEDURE Abs (i, j: CARDINAL) : CARDINAL ;
+BEGIN
+   IF i>j
+   THEN
+      RETURN( i-j )
+   ELSE
+      RETURN( j-i )
+   END
+END Abs ;
+
+
+(*
+   Swap - swaps two cardinal numbers i and j.
+*)
+
+PROCEDURE Swap (VAR i, j: CARDINAL) ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := i ;
+   i := j ;
+   j := t
+END Swap ;
+
+
+END Geometry.
diff --git a/gcc/testsuite/gm2/examples/map/pass/MakeBoxes.def b/gcc/testsuite/gm2/examples/map/pass/MakeBoxes.def
new file mode 100644
index 00000000000..6841be8da1c
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/MakeBoxes.def
@@ -0,0 +1,67 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE MakeBoxes ;
+
+(*
+   Title      : MakeBoxes
+   Author     : Gaius Mulley
+   Date       : 15/7/88
+   LastEdit   : 15/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Provides a list of all possible box sizes.
+                Any number of unique boxes may be requested and deleted.
+*)
+
+EXPORT QUALIFIED InitBoxes, KillBoxes,
+                 AddBoxes, GetAndDeleteRandomBox ;
+
+
+(*
+   InitBoxes - Initializes a list of boxes.
+               An index to this box list is returned.
+*)
+
+PROCEDURE InitBoxes () : CARDINAL ;
+
+
+(*
+   KillBoxes - Kills a complete box list.
+*)
+
+PROCEDURE KillBoxes (BoxListIndex: CARDINAL) ;
+
+
+(*
+   AddBoxes - Adds a list of boxes MinX..MaxX, MinY..MaxY
+              to a box list BoxListIndex.
+*)
+
+PROCEDURE AddBoxes (BoxListIndex: CARDINAL;
+                    MinX, MinY, MaxX, MaxY: CARDINAL) ;
+
+
+(*
+   GetAndDeleteRandomBox - Returns a random box from the box list and
+                           this box is then deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomBox (BoxListIndex: CARDINAL;
+                                 VAR SizeX, SizeY: CARDINAL) ;
+
+
+END MakeBoxes.
diff --git a/gcc/testsuite/gm2/examples/map/pass/MakeBoxes.mod b/gcc/testsuite/gm2/examples/map/pass/MakeBoxes.mod
new file mode 100644
index 00000000000..bead8883ac4
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/MakeBoxes.mod
@@ -0,0 +1,238 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+IMPLEMENTATION MODULE MakeBoxes ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+FROM Chance IMPORT GetRand ;
+
+
+CONST
+   MaxBox   = 15000 ;
+   MaxIndex =   500 ;
+
+TYPE
+   Box    = RECORD
+               LengthX,
+               LengthY: CARDINAL ;
+            END ;
+
+   Index  = RECORD
+               Start,               (* Start of the Box list *)
+               End  : CARDINAL ;    (* End of the Box list   *)
+            END ;
+
+VAR
+   BoxIndex   : ARRAY [0..MaxIndex] OF Index ;
+   Boxes      : ARRAY [1..MaxBox] OF Box ;
+   NoOfBoxes  : CARDINAL ;   (* Number of boxes in array Boxes *)
+   NoOfIndices: CARDINAL ;   (* Number of indices in BoxIndex  *)
+
+
+(*
+   InitBoxes - Initializes a list of boxes.
+               An index to this box list is returned.
+*)
+
+PROCEDURE InitBoxes () : CARDINAL ;
+BEGIN
+   IF NoOfIndices=MaxIndex
+   THEN
+      WriteString('Too many box list indices in Module MakeBoxes') ;
+      WriteLn ;
+      WriteString('Increase MaxIndex') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfIndices) ;
+      WITH BoxIndex[NoOfIndices] DO
+         Start := NoOfBoxes+1 ;
+         End := NoOfBoxes
+      END ;
+      RETURN(NoOfIndices)
+   END
+END InitBoxes ;
+
+
+(*
+   AddBoxes - Adds a list of boxes MinX..MaxX, MinY..MaxY
+              to a box list BoxListIndex.
+*)
+
+PROCEDURE AddBoxes (BoxListIndex: CARDINAL;
+                    MinX, MinY, MaxX, MaxY: CARDINAL) ;
+BEGIN
+   WITH BoxIndex[BoxListIndex] DO
+      Expand(BoxListIndex, MinX, MinY, MaxX, MaxY) ;
+      End := NoOfBoxes
+   END
+END AddBoxes ;
+
+
+(*
+   Expand - expands the box limitations MinX..MaxX, MinY..MaxY for all
+            possibilities of boxes.
+*)
+
+PROCEDURE Expand (BoxListIndex: CARDINAL;
+                  MinX, MinY, MaxX, MaxY: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := MinX ;
+   WHILE i<=MaxX DO
+      j := MinY ;
+      WHILE j<=MaxY DO
+         AddBox(BoxListIndex, i, j) ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END Expand ;
+
+
+(*
+   AddBox - adds a box of Width, Height to a list of boxes specified by
+            BoxListIndex.
+*)
+
+PROCEDURE AddBox (BoxListIndex: CARDINAL;
+                  Width, Height: CARDINAL) ;
+BEGIN
+   IF NoOfBoxes=MaxBox
+   THEN
+      WriteString('Too many boxes in a list in Module MakeBoxes') ;
+      WriteLn ;
+      WriteString('Increase MaxBox') ;
+      WriteLn ;
+      HALT
+   ELSIF UniqueBox(BoxListIndex, Width, Height)
+   THEN
+      INC(NoOfBoxes) ;
+      WITH Boxes[NoOfBoxes] DO
+         LengthX := Width ;
+         LengthY := Height
+      END
+   END
+END AddBox ;
+
+
+(*
+   UniqueBox - returns true if a box Width, Height is unique in the
+               box list BoxListIndex.
+*)
+
+PROCEDURE UniqueBox (BoxListIndex: CARDINAL;
+                     Width, Height: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   WITH BoxIndex[BoxListIndex] DO
+      i := Start ;
+      Found := FALSE ;
+      WHILE (NOT Found) AND (i<=End) DO
+         WITH Boxes[i] DO
+            Found := (LengthX=Width) AND (LengthY=Height)
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END UniqueBox ;
+
+
+(*
+   KillBoxes - Kills a complete box list.
+*)
+
+PROCEDURE KillBoxes (BoxListIndex: CARDINAL) ;
+BEGIN
+   IF NoOfIndices>0
+   THEN
+      (* Destroy index to box list *)
+      WITH BoxIndex[BoxListIndex] DO
+         Start := 0 ;
+         End := 0
+      END ;
+      (*
+         If killed last box list see if we can garbage collect
+         previously killed middle indices.
+      *)
+      IF NoOfIndices=BoxListIndex
+      THEN
+         REPEAT
+            DEC(NoOfIndices)
+         UNTIL (NoOfIndices=0) OR (BoxIndex[NoOfIndices].Start#0)
+      END ;
+      NoOfBoxes := BoxIndex[NoOfIndices].End
+   ELSE
+      WriteString('All boxes have been killed - Module MakeBoxes') ;
+      WriteLn ;
+      HALT
+   END
+END KillBoxes ;
+
+
+(*
+   GetAndDeleteRandomBox - Returns a random box from the box list and
+                           this box is then deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomBox (BoxListIndex: CARDINAL;
+                                 VAR SizeX, SizeY: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH BoxIndex[BoxListIndex] DO
+      i := Start+GetRand(End-Start+1) ;  (* +1 for GetRand *)
+      j := i ;
+      REPEAT
+         IF Boxes[j].LengthX=0
+         THEN
+            INC(j) ;
+            IF j>End
+            THEN
+               j := Start
+            END
+         END
+      UNTIL (j=i) OR (Boxes[j].LengthX#0) ;
+      WITH Boxes[j] DO
+         SizeX := LengthX ;
+         SizeY := LengthY ;
+         LengthX := 0 ;      (* Now delete this box *)
+         LengthY := 0
+      END
+   END
+END GetAndDeleteRandomBox ;
+
+
+PROCEDURE Init ;
+BEGIN
+   NoOfBoxes := 0 ;
+   NoOfIndices := 0 ;
+   WITH BoxIndex[NoOfIndices] DO
+      End := 0
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END MakeBoxes.
diff --git a/gcc/testsuite/gm2/examples/map/pass/Map.mod b/gcc/testsuite/gm2/examples/map/pass/Map.mod
new file mode 100644
index 00000000000..cc4457721a2
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/Map.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+MODULE Map ;
+
+FROM RoomMap IMPORT CreateRoomMap ;
+FROM WriteMap IMPORT WriteMapText ;
+
+BEGIN
+   CreateRoomMap ;
+   WriteMapText
+END Map.
diff --git a/gcc/testsuite/gm2/examples/map/pass/RoomMap.def b/gcc/testsuite/gm2/examples/map/pass/RoomMap.def
new file mode 100644
index 00000000000..b02ba45f716
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/RoomMap.def
@@ -0,0 +1,92 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE RoomMap ;
+
+(*
+   Title      : RoomMap
+   Author     : Gaius Mulley
+   Date       : 20/8/88
+   LastEdit   : 20/8/88
+   System     : LOGITECH MODULA-2/86
+   Description: Generates rooms from a list of boxes.
+*)
+
+EXPORT QUALIFIED MaxNoOfRooms,
+                 MaxNoOfTreasures,
+                 Rooms,
+                 NoOfRooms,
+                 DoorStatus,
+                 Treasure, TreasureInfo, Door, Line,
+                 CreateRoomMap ;
+
+CONST
+   MaxNoOfRooms           = 350 ;  (* An upper limit *)
+   WallsPerRoom           =   8 ;  (* An upper limit *)
+   DoorsPerRoom           =   6 ;  (* An upper limit *)
+   MaxNoOfTreasures       =  15 ;  (* An upper limit *)
+
+TYPE
+   Line         = RECORD
+                     X1 : CARDINAL ;
+                     Y1 : CARDINAL ;
+                     X2 : CARDINAL ;
+                     Y2 : CARDINAL
+                  END ;
+
+   DoorStatus   = (Open, Closed, Secret) ;
+
+   Door         = RECORD
+                     Position    : Line ;
+                     StateOfDoor : DoorStatus ;
+                     LeadsTo     : CARDINAL
+                  END ;
+
+   TreasureInfo = RECORD
+                     Xpos         : CARDINAL ;
+                     Ypos         : CARDINAL ;
+                     Rm           : CARDINAL ;
+                     Tweight      : CARDINAL ;
+                     TreasureName : ARRAY [0..12] OF CHAR
+                  END ;
+
+   Room         = RECORD
+                     RoomNo      : CARDINAL ;
+                     NoOfWalls   : CARDINAL ;
+                     NoOfDoors   : CARDINAL ;
+                     Walls       : ARRAY [1..WallsPerRoom] OF Line ;
+                     Doors       : ARRAY [1..DoorsPerRoom] OF Door ;
+                     (* Treasures   : BITSET ; *)
+                  END ;
+
+
+
+VAR
+   NoOfRooms       : CARDINAL ;
+   Treasure        : ARRAY [1..MaxNoOfTreasures] OF TreasureInfo ;
+   Rooms           : ARRAY [1..MaxNoOfRooms] OF Room ;
+
+
+(*
+   CreateRoomMap - creates rooms from a list of boxes in BoxMap.
+*)
+
+PROCEDURE CreateRoomMap ;
+
+
+
+END RoomMap.
diff --git a/gcc/testsuite/gm2/examples/map/pass/RoomMap.mod b/gcc/testsuite/gm2/examples/map/pass/RoomMap.mod
new file mode 100644
index 00000000000..a75e85297b1
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/RoomMap.mod
@@ -0,0 +1,1470 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+IMPLEMENTATION MODULE RoomMap ;
+
+
+IMPORT Break ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn, WriteString ;
+FROM Assertion IMPORT Assert ;
+
+FROM Geometry IMPORT IsSubLine, IsSubRange, Swap, IntersectionLength,
+                     Abs, Max, Min, IsPointOnLine, IsIntersectingRange ;
+
+FROM Chance IMPORT GetRand, InitRandom, KillRandom, GetAndDeleteRandom,
+                   AddRandom ;
+
+FROM StoreCoords IMPORT InitCoords, KillCoords, GetAndDeleteRandomCoord,
+                        AddCoord ;
+
+FROM BoxMap IMPORT MaxX, MaxY,
+                   Boxes, NoOfBoxes, NoOfCorridorBoxes, CreateBoxMap,
+                   MinDoorLength, MaxDoorLength ;
+
+CONST
+   MaxLineStack = 20 ;
+   CorridorDoorLength = 2 ;
+
+VAR
+   NoOfCorridors: CARDINAL ;
+   NoOfLines    : CARDINAL ;
+   Lines        : ARRAY [1..MaxLineStack] OF Line ;
+
+
+(*
+   CreateRoomMap - copy boxes into rooms and amalgamate boxes into rooms.
+*)
+
+PROCEDURE CreateRoomMap ;
+BEGIN
+   (* WriteString('Creating Boxes') ; WriteLn ; *)
+   CreateBoxMap ;
+   (* WriteString('Creating Rooms') ; WriteLn ; *)
+   InitRooms ;
+   CreateCorridors ;
+   CreateRooms ;
+END CreateRoomMap ;
+
+
+(*
+   InitRooms - copies the box array from Module BoxMap into the Room array.
+*)
+
+PROCEDURE InitRooms ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=NoOfBoxes DO
+      WITH Rooms[i] DO
+         RoomNo := i ;
+         NoOfDoors := 0 ;
+         NoOfWalls := 4 ;
+         (* Treasures := {} ; *)
+         Walls[1].X1 := Boxes[i].x1 ;   (* Lower y=c *)
+         Walls[1].Y1 := Boxes[i].y1 ;
+         Walls[1].X2 := Boxes[i].x2 ;
+         Walls[1].Y2 := Boxes[i].y1 ;
+
+         Walls[2].X1 := Boxes[i].x2 ;   (* Right x=c *)
+         Walls[2].Y1 := Boxes[i].y1 ;
+         Walls[2].X2 := Boxes[i].x2 ;
+         Walls[2].Y2 := Boxes[i].y2 ;
+
+         Walls[3].X1 := Boxes[i].x1 ;   (* Top y=c   *)
+         Walls[3].Y1 := Boxes[i].y2 ;
+         Walls[3].X2 := Boxes[i].x2 ;
+         Walls[3].Y2 := Boxes[i].y2 ;
+
+         Walls[4].X1 := Boxes[i].x1 ;   (* Left x=c  *)
+         Walls[4].Y1 := Boxes[i].y1 ;
+         Walls[4].X2 := Boxes[i].x1 ;
+         Walls[4].Y2 := Boxes[i].y2
+      END ;
+      INC(i)
+   END ;
+   NoOfRooms := NoOfBoxes ;
+   NoOfCorridors := NoOfCorridorBoxes ;
+   (* Now set all other rooms to void *)
+   i := NoOfRooms+1 ;
+   WHILE i<=MaxNoOfRooms DO
+      Rooms[i].RoomNo := 0 ;
+      INC(i)
+   END
+  ; WriteString('Corridors') ; WriteCard(NoOfCorridors, 4) ; WriteLn ;
+  ; WriteString('Rooms    ') ; WriteCard(NoOfRooms, 4) ; WriteLn ;
+END InitRooms ;
+
+
+(*
+   CreateCorridors - creates corridors from the corridor boxes.
+*)
+
+PROCEDURE CreateCorridors ;
+BEGIN
+   AmalgamateCorridors ;
+   CreateCorridorDoors
+END CreateCorridors ;
+
+
+(*
+   CreateRooms - creates rooms from the room boxes.
+*)
+
+PROCEDURE CreateRooms ;
+BEGIN
+   AmalgamateRooms ;
+   WriteString('Creating RoomDoors') ; WriteLn ;
+   CreateMinRoomDoors ;
+   CreateRoomDoors
+END CreateRooms ;
+
+
+(*
+   CreateCorridorDoors - places corridors doors along the corridors.
+*)
+
+PROCEDURE CreateCorridorDoors ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=NoOfCorridors DO
+      j := 1 ;
+      WHILE j<=NoOfCorridors DO
+         IF (i#j) AND RoomExists(i) AND RoomExists(j)
+         THEN
+            MakeCorridorDoors(i, j)
+         END ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END CreateCorridorDoors ;
+
+
+(*
+   CreateMinRoomDoors - create minimum doors arround map. Thus allowing
+                        an entrance into every room.
+*)
+
+PROCEDURE CreateMinRoomDoors ;
+VAR
+   Done: BOOLEAN ;
+   i   : CARDINAL ;
+BEGIN
+   REPEAT
+      Done := FALSE ;
+      i := 1 ;
+      WHILE (NOT Done) AND (i<=NoOfRooms) DO
+         IF RoomExists(i)
+         THEN
+            IF Rooms[i].NoOfDoors=0
+            THEN
+               IF MakeDoorInRoomToSafty(i)
+               THEN
+               END ;
+               Done := (Rooms[i].NoOfDoors#0)
+            END
+         END ;
+         INC(i)
+      END
+   UNTIL NOT Done ;
+   (* Now remove all rooms that have no doors *)
+   WriteString('Number of rooms') ; WriteCard(NoOfRooms, 4) ; WriteLn ;
+   i := 1 ;
+   WHILE i<=NoOfRooms DO
+      IF RoomExists(i) AND (Rooms[i].NoOfDoors=0)
+      THEN
+         RemoveRoom(i) ;
+         WriteString('Removing room') ; WriteCard(i, 4) ; WriteLn ;
+      END ;
+      INC(i)
+   END
+END CreateMinRoomDoors ;
+
+
+(*
+   CreateRoomDoors - places room doors in rooms.
+*)
+
+PROCEDURE CreateRoomDoors ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   i := NoOfCorridors+1 ;
+   WHILE i<=NoOfRooms DO
+      IF RoomExists(i)
+      THEN
+         n := GetRand(DoorsPerRoom-1 DIV 2)+1 ;
+         WHILE (Rooms[i].NoOfDoors<DoorsPerRoom) AND (n>0) DO
+            IF MakeDoorInRoom(i)
+            THEN
+            END ;
+            DEC(n)
+         END
+      END ;
+      INC(i)
+   END
+END CreateRoomDoors ;
+
+
+(*
+   MakeCorridorDoors - checks for corridor doors thoughout the corridor rooms.
+*)
+
+PROCEDURE MakeCorridorDoors (r1, r2: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=Rooms[r1].NoOfWalls DO
+      j := 1 ;
+      WHILE j<=Rooms[r2].NoOfWalls DO
+         IF IsIntersection( Rooms[r1].Walls[i].X1, Rooms[r1].Walls[i].Y1,
+                            Rooms[r1].Walls[i].X2, Rooms[r1].Walls[i].Y2,
+                            Rooms[r2].Walls[j].X1, Rooms[r2].Walls[j].Y1,
+                            Rooms[r2].Walls[j].X2, Rooms[r2].Walls[j].Y2 )
+         THEN
+            CheckForCorridorDoor(r1, i, r2, j)
+         END ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END MakeCorridorDoors ;
+
+
+(*
+   MakeDoorInRoomToSafty - true is returned if a door is made in room r
+                           to a room which already has a door.
+                           Thus room, r, is reachable by the whole map.
+*)
+
+PROCEDURE MakeDoorInRoomToSafty (r: CARDINAL) : BOOLEAN ;
+VAR
+   RoomList,
+   Neighbour: CARDINAL ;
+   Done     : BOOLEAN ;
+BEGIN
+   Done := FALSE ;
+   RoomList := InitRandom() ;
+   AddRandom(RoomList, NoOfRooms) ;  (* 1..NoOfRooms *)
+   Neighbour := GetAndDeleteRandom(RoomList) ;
+   WHILE (Neighbour#0) AND (NOT Done) DO
+      IF RoomExists(Neighbour) AND (r#Neighbour) AND
+         IsTouching(r, Neighbour) AND (Rooms[Neighbour].NoOfDoors#0)
+      THEN
+         Done := MakeDoorBetweenRooms(r, Neighbour)
+      END ;
+      Neighbour := GetAndDeleteRandom(RoomList)
+   END ;
+   KillRandom(RoomList) ;
+   RETURN( Done )
+END MakeDoorInRoomToSafty ;
+
+
+(*
+   MakeDoorInRoom - true is returned if a door is made in room r.
+*)
+
+PROCEDURE MakeDoorInRoom (r: CARDINAL) : BOOLEAN ;
+VAR
+   RoomList,
+   Neighbour: CARDINAL ;
+   Done     : BOOLEAN ;
+BEGIN
+   Done := FALSE ;
+   RoomList := InitRandom() ;
+   AddRandom(RoomList, NoOfRooms) ;  (* 1..NoOfRooms *)
+   Neighbour := GetAndDeleteRandom(RoomList) ;
+   WHILE (Neighbour#0) AND (NOT Done) DO
+      IF RoomExists(Neighbour) AND (r#Neighbour) AND IsTouching(r, Neighbour)
+      THEN
+         Done := MakeDoorBetweenRooms(r, Neighbour)
+      END ;
+      Neighbour := GetAndDeleteRandom(RoomList)
+   END ;
+   KillRandom(RoomList) ;
+   RETURN( Done )
+END MakeDoorInRoom ;
+
+
+(*
+   MakeDoorBetweenRooms - returns true if it makes a door between
+                          rooms r1 and r2.
+*)
+
+PROCEDURE MakeDoorBetweenRooms (r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   CoordList: CARDINAL ;
+   Success  : BOOLEAN ;
+BEGIN
+   Success := FALSE ;
+   CoordList := InitCoords() ;
+   PushPossibleDoorCoords(CoordList, r1, r2) ;
+   Success := ChooseDoor(CoordList, r1, r2) ;
+   KillCoords(CoordList) ;
+   RETURN( Success )
+END MakeDoorBetweenRooms ;
+
+
+(*
+   PushPossibleDoorCoords - pushes the possible door coordinates on the
+                            coordinate stack CoordList.
+                            The door links rooms r1 and r2 together.
+*)
+
+PROCEDURE PushPossibleDoorCoords (CoordList: CARDINAL; r1, r2: CARDINAL) ;
+VAR
+   i, j     : CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=Rooms[r1].NoOfWalls DO
+      j := 1 ;
+      WHILE j<=Rooms[r2].NoOfWalls DO
+         IF IsIntersection( Rooms[r1].Walls[i].X1, Rooms[r1].Walls[i].Y1,
+                            Rooms[r1].Walls[i].X2, Rooms[r1].Walls[i].Y2,
+                            Rooms[r2].Walls[j].X1, Rooms[r2].Walls[j].Y1,
+                            Rooms[r2].Walls[j].X2, Rooms[r2].Walls[j].Y2 )
+         THEN
+            IF PossibleDoorLength(r1, i, r2, j)>=MinDoorLength
+            THEN
+               PushPossibleDoorCoordsOnWall(CoordList, r1, i, r2, j)
+            END
+         END ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END PushPossibleDoorCoords ;
+
+
+(*
+   PushPossibleDoorCoordsOnWall - pushes the coordinates which can take a door
+                                  between rooms r1 and r2 on walls w1 and w2
+                                  onto the coordinate stack CoordList.
+*)
+
+PROCEDURE PushPossibleDoorCoordsOnWall (CoordList: CARDINAL ;
+                                        r1, w1, r2, w2: CARDINAL) ;
+VAR
+   s, e,
+   x1, y1, x2, y2,
+   x3, y3, x4, y4: CARDINAL ;
+BEGIN
+   WriteString('Pushing walls') ; WriteCard(w1, 4) ; WriteCard(w2, 4) ; WriteLn ;
+   WITH Rooms[r1].Walls[w1] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Rooms[r2].Walls[w2] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      Assert(x1=x3) ; Assert(x2=x4) ;
+      IF IsSubRange(y1, y2, y3)
+      THEN
+         s := y3
+      ELSE
+         Assert(IsSubRange(y3, y4, y1)) ;
+         s := y1
+      END ;
+      e := Min(y2, y4) ;
+      INC(s) ;
+      DEC(e) ;
+      WHILE s<=e DO
+         IF IsDoorAllowed(r1, r2, x1, s, x1, e) AND
+            IsDoorAllowed(r2, r1, x1, s, x1, e)
+         THEN
+            AddCoord(CoordList, x1, s)
+          ; WriteString('Point') ; WriteCard(x1, 4) ; WriteCard(s, 4) ; WriteLn
+         END ;
+         INC(s)
+      END
+   ELSE
+      Assert(IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)) ;
+      Assert(y1=y3) ; Assert(y2=y4) ;
+      IF IsSubRange(x1, x2, x3)
+      THEN
+         s := x3
+      ELSE
+         Assert(IsSubRange(x3, x4, x1)) ;
+         s := x1
+      END ;
+      e := Min(x2, x4) ;
+      INC(s) ;
+      DEC(e) ;
+      WHILE s<=e DO
+         IF IsDoorAllowed(r1, r2, s, y1, e, y1) AND
+            IsDoorAllowed(r2, r1, s, y1, e, y1)
+         THEN
+            AddCoord(CoordList, s, y1)
+          ; WriteString('Point') ; WriteCard(s, 4) ; WriteCard(y1, 4) ; WriteLn
+         END ;
+         INC(s)
+      END
+   END
+END PushPossibleDoorCoordsOnWall ;
+
+
+(*
+   ChooseDoor - chooses a door from the CoordList which connects rooms
+                r1 and r2.
+*)
+
+PROCEDURE ChooseDoor (CoordList: CARDINAL; r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   x, y  : CARDINAL ;
+   w1, w2: CARDINAL ;
+   ok    : BOOLEAN ;
+BEGIN
+   GetAndDeleteRandomCoord(CoordList, x, y) ;
+   ok := (x#0) AND (y#0) ;
+   IF ok
+   THEN
+      w1 := FindWall(r1, x, y) ;
+      w2 := FindWall(r2, x, y) ;
+      MakeRoomDoor(r1, w1, r2, w2, x, y)
+   END ;
+   RETURN( ok )
+END ChooseDoor ;
+
+
+(*
+   FindWall - returns the wall number of a room r1 which has the point x, y
+              on it. A corner point will return a wall of zero.
+*)
+
+PROCEDURE FindWall (r: CARDINAL; x, y: CARDINAL) : CARDINAL ;
+VAR
+   Found: BOOLEAN ;
+   i    : CARDINAL ;
+BEGIN
+   i := 1 ;
+   Found := FALSE ;
+   WITH Rooms[r] DO
+      WHILE (i<=NoOfWalls) AND (NOT Found) DO
+         WITH Walls[i] DO
+            IF ((x=X1) AND (y=Y1)) OR ((x=X2) AND (y=Y2))
+            THEN
+               (* Corner has been found *)
+               Found := TRUE ;
+               i := 0
+            ELSIF IsPointOnLine(x, y, X1, Y1, X2, Y2)
+            THEN
+               Found := TRUE
+            ELSE
+               INC(i)
+            END
+         END
+      END
+   END ;
+   IF Found
+   THEN
+      RETURN( i )
+   ELSE
+      RETURN( 0 )
+   END
+END FindWall ;
+
+
+(*
+   MakeRoomDoor - makes a door between rooms r1 and r2 on walls w1 and w2
+                  at position x, y.
+*)
+
+PROCEDURE MakeRoomDoor (r1: CARDINAL; w1: CARDINAL; r2: CARDINAL; w2: CARDINAL;
+                        x, y: CARDINAL) ;
+VAR
+   l, h, List,
+   x1, y1, x2, y2,
+   x3, y3, x4, y4: CARDINAL ;
+   Done          : BOOLEAN ;
+BEGIN
+   WriteString('Making walls') ; WriteCard(w1, 4) ; WriteCard(w2, 4) ; WriteLn ;
+   WITH Rooms[r1].Walls[w1] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Rooms[r2].Walls[w2] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      Assert(x1=x3) ; Assert(x2=x4) ;
+      Done := FALSE ;
+      List := InitRandom() ;
+      AddRandom(List, MaxDoorLength) ;
+      REPEAT
+         l := GetAndDeleteRandom(List) ;
+         IF l>=MinDoorLength
+         THEN
+            h := Min(y+l-1, Min(y2, y4)-1) ;
+            Done := IsDoorAllowed(r1, r2, x, y, x, h) AND
+                    IsDoorAllowed(r2, r1, x, y, x, h)
+         END
+      UNTIL (l=0) OR Done ;
+      KillRandom(List) ;
+      Assert(l#0) ;
+      FixRoomDoor(r2, r1, x, y, x, h)
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)
+   THEN
+      Assert(y1=y3) ; Assert(y2=y4) ;
+      Done := FALSE ;
+      List := InitRandom() ;
+      AddRandom(List, MaxDoorLength) ;
+      REPEAT
+         l := GetAndDeleteRandom(List) ;
+         IF l>=MinDoorLength
+         THEN
+            h := Min(x+l-1, Min(x2, x4)-1) ;
+            Done := IsDoorAllowed(r1, r2, x, y, h, y) AND
+                    IsDoorAllowed(r2, r1, x, y, h, y)
+         END
+      UNTIL (l=0) OR Done ;
+      KillRandom(List) ;
+      Assert(l#0) ;
+      FixRoomDoor(r2, r1, x, y, h, y)
+   ELSE
+      HALT
+   END
+END MakeRoomDoor ;
+
+
+(*
+   IsDoorAllowed - checks whether a door can be built in r1 leading to r2
+                   the coordinates of the door are x1, y1, x2, y2.
+*)
+
+PROCEDURE IsDoorAllowed (r1, r2: CARDINAL; x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok  : BOOLEAN ;
+   i, w: CARDINAL ;
+BEGIN
+   ok := (NOT DoorsClash(r1, x1, y1, x2, y2)) AND
+         (Rooms[r1].NoOfDoors<DoorsPerRoom) AND
+         (Max(Abs(x1, x2)+1, Abs(y1, y2)+1)>=MinDoorLength) ;
+   IF ok
+   THEN
+      w := FindWall(r1, x1, y1) ;
+      IF IsVertical(x1, y1, x2, y2)
+      THEN
+         i := y1 ;
+         WHILE (i<=y2) AND ok DO
+            ok := (w=FindWall(r1, x1, i)) ;
+            INC(i)
+         END
+      ELSIF IsHorizontal(x1, y1, x2, y2)
+      THEN
+         i := x1 ;
+         WHILE (i<=x2) AND ok DO
+            ok := (w=FindWall(r1, i, y1)) ;
+            INC(i)
+         END
+      END
+   END ;
+   RETURN( ok )
+END IsDoorAllowed ;
+
+
+(*
+   FixRoomDoor - places a door between rooms r1 and r2 with coordinates
+                 x1, y1, x2, y2.
+*)
+
+PROCEDURE FixRoomDoor (r1, r2: CARDINAL; x1, y1, x2, y2: CARDINAL) ;
+BEGIN
+   IF IsConnectionSecret(r1, r2)
+   THEN
+      AddDoor(r1, r2, x1, y1, x2, y2, Secret) ;
+      AddDoor(r2, r1, x1, y1, x2, y2, Secret)
+   ELSIF (NOT Adjacent(r1, r2)) AND (GetRand(100)>49)
+   THEN
+      AddDoor(r1, r2, x1, y1, x2, y2, Secret) ;
+      AddDoor(r2, r1, x1, y1, x2, y2, Secret)
+   ELSE
+      AddDoor(r1, r2, x1, y1, x2, y2, Closed) ;
+      AddDoor(r2, r1, x1, y1, x2, y2, Closed)
+   END
+END FixRoomDoor ;
+
+
+(*
+   IsConnectionSecret - returns true if the rooms, r1 and r2, are
+                        connected via a secret door.
+*)
+
+PROCEDURE IsConnectionSecret (r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WITH Rooms[r1] DO
+      WHILE i<=NoOfDoors DO
+         WITH Doors[i] DO
+            IF (LeadsTo=r1) AND (StateOfDoor=Secret)
+            THEN
+               RETURN( TRUE )
+            ELSE
+               INC(i)
+            END
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END IsConnectionSecret ;
+
+
+(*
+   CheckForCorridorDoor - checks whether a door can be built on walls
+                          w1 and w2 of rooms r1 and r2.
+*)
+
+PROCEDURE CheckForCorridorDoor (r1: CARDINAL; w1: CARDINAL;
+                                r2: CARDINAL; w2: CARDINAL) ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := PossibleDoorLength(r1, w1, r2, w2) ;
+   (* WriteString('Intersection length') ; WriteCard(l, 4) ; WriteLn ; *)
+   IF l>=CorridorDoorLength
+   THEN
+      BuildCorridorDoor(r1, w1, r2, w2)
+   END
+END CheckForCorridorDoor ;
+
+
+(*
+   BuildCorridorDoor - will build a door on walls w1 and w2.
+                       BuildCorridorDoor works out the coordinates
+                       for the corridor doors.
+*)
+
+PROCEDURE BuildCorridorDoor (r1: CARDINAL; w1: CARDINAL;
+                             r2: CARDINAL; w2: CARDINAL) ;
+VAR
+   x1, y1, x2, y2,
+   x3, y3, x4, y4: CARDINAL ;
+BEGIN
+   WITH Rooms[r1].Walls[w1] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Rooms[r2].Walls[w2] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      Assert(x1=x3) ; Assert(x2=x4) ;
+      IF Abs(y1, y2)<Abs(y3, y4)
+      THEN
+         AttemptBuildCorridorDoor(r1, r2, x1, y1+1, x2, y2-1)
+      ELSE
+         AttemptBuildCorridorDoor(r1, r2, x1, y3+1, x2, y4-1)
+      END
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)
+   THEN
+      Assert(y1=y3) ; Assert(y2=y4) ;
+      IF Abs(x1, x2)<Abs(x3, x4)
+      THEN
+         AttemptBuildCorridorDoor(r1, r2, x1+1, y1, x2-1, y2)
+      ELSE
+         AttemptBuildCorridorDoor(r1, r2, x3+1, y1, x4-1, y4)
+      END
+   END
+END BuildCorridorDoor ;
+
+
+(*
+   AttemptBuildCorridorDoor - attempts to make a corridor door
+                              between rooms r1 and r2 with
+                              coordinates x1, y1, x2, y2.
+*)
+
+PROCEDURE AttemptBuildCorridorDoor (r1, r2: CARDINAL ;
+                                    x1, y1, x2, y2: CARDINAL) ;
+BEGIN
+   IF IsDoorAllowed(r1, r2, x1, y1, x2, y2) AND
+      IsDoorAllowed(r2, r1, x1, y1, x2, y2)
+   THEN
+      IF IsConnectionSecret(r1, r2)
+      THEN
+         AddDoor(r1, r2, x1, y1, x2, y2, Secret) ;
+         AddDoor(r2, r1, x1, y1, x2, y2, Secret)
+      ELSIF (NOT Adjacent(r1, r2)) AND (GetRand(100)>65)
+      THEN
+         AddDoor(r1, r2, x1, y1, x2, y2, Secret) ;
+         AddDoor(r2, r1, x1, y1, x2, y2, Secret)
+      ELSE
+         AddDoor(r1, r2, x1, y1, x2, y2, Open) ;
+         AddDoor(r2, r1, x1, y1, x2, y2, Open)
+      END
+   ELSE
+      WriteString('Not allowing corridor door!') ; WriteLn
+   END
+END AttemptBuildCorridorDoor ;
+
+
+(*
+   DoorsClash - returns true if there does exist a door which clashes with
+                x1, y1, x2, y2 in room r1.
+*)
+
+PROCEDURE DoorsClash (r: CARDINAL; x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Clash: BOOLEAN ;
+   i    : CARDINAL ;
+BEGIN
+   IF IsVertical(x1, y1, x2, y2)
+   THEN
+      INC(y2) ;
+      IF y1>1
+      THEN
+         DEC(y1)
+      END
+   ELSE
+      INC(x2) ;
+      IF x1>1
+      THEN
+         DEC(x1)
+      END
+   END ;
+   Clash := FALSE ;
+   WITH Rooms[r] DO
+      i := 1 ;
+      WHILE (i<=NoOfDoors) AND (NOT Clash) DO
+         WITH Doors[i].Position DO
+            IF IsIntersection(x1, y1, x2, y2, X1, Y1, X2, Y2)
+            THEN
+               Clash := TRUE
+            END
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( Clash )
+END DoorsClash ;
+
+
+(*
+   AddDoor - adds a door in room r1 that leads to a door in r2.
+             The coordinates of the door are x1, y1, x2, y2 and the
+             door type is in Status.
+*)
+
+PROCEDURE AddDoor (r1, r2: CARDINAL;
+                   x1, y1, x2, y2: CARDINAL; Status: DoorStatus) ;
+BEGIN
+  ; Assert(IsTouching(r1, r2))
+  ; Assert(IsDoorAllowed(r1, r2, x1, y1, x2, y2)) ;
+  ; Assert(r1#r2) ;
+  ; Assert(RoomExists(r1) AND RoomExists(r2)) ;
+   WITH Rooms[r1] DO
+      Assert(NoOfDoors<DoorsPerRoom) ;
+      INC(NoOfDoors) ;
+      WITH Doors[NoOfDoors] DO
+         Position.X1 := x1 ;
+         Position.Y1 := y1 ;
+         Position.X2 := x2 ;
+         Position.Y2 := y2 ;
+         StateOfDoor := Status ;
+         LeadsTo := r2
+      END
+   END
+END AddDoor ;
+
+
+(*
+   PossibleDoorLength - returns the possible door length between rooms
+                        r1 and r2 on wall w1 and w2.
+*)
+
+PROCEDURE PossibleDoorLength (r1: CARDINAL; w1: CARDINAL;
+                              r2: CARDINAL; w2: CARDINAL) : CARDINAL ;
+VAR
+   l,
+   x1, x2, x3, x4,
+   y1, y2, y3, y4: CARDINAL ;
+BEGIN
+   WITH Rooms[r1].Walls[w1] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Rooms[r2].Walls[w2] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      l := IntersectionLength(y1, y2, y3, y4)+1 ;
+      IF (IsSubRange(y1, y2, y3) OR IsSubRange(y3, y4, y1)) AND (l>0)
+      THEN
+         DEC(l)
+      END ;
+      IF (IsSubRange(y1, y2, y4) OR IsSubRange(y3, y4, y2)) AND (l>0)
+      THEN
+         DEC(l)
+      END
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)
+   THEN
+      l := IntersectionLength(x1, x2, x3, x4)+1 ;
+      IF (IsSubRange(x1, x2, x3) OR IsSubRange(x3, x4, x1)) AND (l>0)
+      THEN
+         DEC(l)
+      END ;
+      IF (IsSubRange(x1, x2, x4) OR IsSubRange(x3, x4, x2)) AND (l>0)
+      THEN
+         DEC(l)
+      END
+   ELSE
+      l := 0
+   END ;
+   RETURN( l )
+END PossibleDoorLength ;
+
+
+(*
+   AmalgamateCorridors - joins corridors together.
+*)
+
+PROCEDURE AmalgamateCorridors ;
+VAR
+   i, j: CARDINAL ;
+   Done: BOOLEAN ;
+BEGIN
+   REPEAT
+      Done := FALSE ;
+      i := 1 ;
+      WHILE (NOT Done) AND (i<=NoOfCorridors) DO
+         j := 1 ;
+         WHILE (NOT Done) AND (j<=NoOfCorridors) DO
+            IF (i#j) AND RoomExists(i) AND RoomExists(j)
+            THEN
+               IF Amalgamate(i, j)
+               THEN
+                  Done := TRUE
+               END
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   UNTIL NOT Done
+END AmalgamateCorridors ;
+
+
+(*
+   AmalgamateRooms - joins rooms together.
+*)
+
+PROCEDURE AmalgamateRooms ;
+VAR
+   i, j: CARDINAL ;
+   Done: BOOLEAN ;
+BEGIN
+   REPEAT
+      Done := FALSE ;
+      i := NoOfCorridors+1 ;
+      WHILE (NOT Done) AND (i<=NoOfRooms) DO
+         j := NoOfCorridors+1 ;
+         WHILE (NOT Done) AND (j<=NoOfRooms) DO
+            IF (i#j) AND RoomExists(i) AND RoomExists(j)
+            THEN
+               IF Amalgamate(i, j)
+               THEN
+                  Done := TRUE
+               END
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   UNTIL NOT Done
+END AmalgamateRooms ;
+
+
+(*
+   Amalgamate - returns true if it can join two rooms r1 and r2 together.
+*)
+
+PROCEDURE Amalgamate (r1, r2: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsTouching(r1, r2)
+   THEN
+      NoOfLines := 0 ;
+      CopyWallsToLines(r1) ;
+      CopyWallsToLines(r2) ;
+      RemoveRoom(r1) ;
+      RemoveRoom(r2) ;
+      IF CompactLines() AND IsLineRoomSatisfied()
+      THEN
+         CopyLinesToWalls(r1) ;
+         InsertRoom(r1) ;
+         RETURN( TRUE )
+      ELSE
+         InsertRoom(r1) ;
+         InsertRoom(r2) ;
+         RETURN( FALSE )
+      END
+   ELSE
+      RETURN( FALSE )
+   END
+END Amalgamate ;
+
+
+(*
+   CompactLines - returns true if the lines in the line buffer are
+                  reduced by forming a bigger room.
+*)
+
+PROCEDURE CompactLines () : BOOLEAN ;
+VAR
+   Done,
+   Compacted: BOOLEAN ;
+   i, j     : CARDINAL ;
+BEGIN
+   Compacted := FALSE ;
+   REPEAT
+      Done := FALSE ;
+      i := 1 ;
+      WHILE (i<=NoOfLines) AND (NOT Done) DO
+         j := 1 ;
+         WHILE (j<=NoOfLines) AND (NOT Done) DO
+            IF (i#j) AND (NOT IsNulLine(i)) AND (NOT IsNulLine(j))
+            THEN
+               IF IsIntersectionLine(i, j)
+               THEN
+                  DeleteIntersectionLine(i, j) ;
+                  LinkUpLines ;
+                  Done := TRUE ;
+                  Compacted := TRUE
+               END
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   UNTIL NOT Done ;
+   RETURN( Compacted )
+END CompactLines ;
+
+
+(*
+   LinkUpLines - attempts to join lines that naturally run in to each other.
+*)
+
+PROCEDURE LinkUpLines ;
+VAR
+   Joined: BOOLEAN ;
+   i, j  : CARDINAL ;
+BEGIN
+   Joined := FALSE ;
+   i := 1 ;
+   WHILE (i<=NoOfLines) AND (NOT Joined) DO
+      j := 1 ;
+      WHILE (j<=NoOfLines) AND (NOT Joined) DO
+         Joined := JoinedLines(i, j) ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END LinkUpLines ;
+
+
+(*
+   JoinedLines - returns true if it can join lines i and j.
+*)
+
+PROCEDURE JoinedLines (i, j: CARDINAL) : BOOLEAN ;
+VAR
+   Joined        : BOOLEAN ;
+   x1, x2, x3, x4,
+   y1, y2, y3, y4: CARDINAL ;
+BEGIN
+   WITH Lines[i] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Lines[j] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   Joined := FALSE ;
+   (* X1 <= X2  - always *)
+   WITH Lines[i] DO
+      IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4) AND (x1=x3)
+      THEN
+         IF y4=y1
+         THEN
+            AddLine(x3, y3, x2, y2) ;
+            DeleteLine(i) ;
+            DeleteLine(j) ;
+            Joined := TRUE
+         ELSIF y2=y3
+         THEN
+            AddLine(x1, y1, x4, y4) ;
+            DeleteLine(i) ;
+            DeleteLine(j) ;
+            Joined := TRUE
+         END
+      ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4) AND
+            (y1=y3)
+      THEN
+         IF x4=x1
+         THEN
+            AddLine(x3, y3, x2, y2) ;
+            DeleteLine(i) ;
+            DeleteLine(j) ;
+            Joined := TRUE
+         ELSIF x2=x3
+         THEN
+            AddLine(x1, y1, x4, y4) ;
+            DeleteLine(i) ;
+            DeleteLine(j) ;
+            Joined := TRUE
+         END
+      END
+   END ;
+   RETURN( Joined )
+END JoinedLines ;
+
+
+(*
+   IsIntersectionLine - returns true if lines i and j intersect.
+*)
+
+PROCEDURE IsIntersectionLine (i, j: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+            IsIntersection(
+               Lines[i].X1, Lines[i].Y1, Lines[i].X2, Lines[i].Y2,
+               Lines[j].X1, Lines[j].Y1, Lines[j].X2, Lines[j].Y2)
+            )
+END IsIntersectionLine ;
+
+
+(*
+   DeleteIntersectionLine - joins two lines together, i and j, and
+                            removes the intersection.
+*)
+
+PROCEDURE DeleteIntersectionLine (i, j: CARDINAL) ;
+VAR
+   x1, x2, x3, x4,
+   y1, y2, y3, y4: CARDINAL ;
+BEGIN
+   WITH Lines[i] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Lines[j] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      DeleteLine(i) ;
+      DeleteLine(j) ;
+      SubtractIntersection(y1, y2, y3, y4) ;
+      AddLine(x1, y1, x2, y2) ;
+      AddLine(x3, y3, x4, y4)
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)
+   THEN
+      DeleteLine(i) ;
+      DeleteLine(j) ;
+      SubtractIntersection(x1, x2, x3, x4) ;
+      AddLine(x1, y1, x2, y2) ;
+      AddLine(x3, y3, x4, y4)
+   END
+END DeleteIntersectionLine ;
+
+
+(*
+   SubtractIntersection - deletes the intersecting entities of the range
+                          i1..i2  j1..j2.
+*)
+
+PROCEDURE SubtractIntersection (VAR i1, i2, j1, j2: CARDINAL) ;
+VAR
+   k1, k2,
+   l1, l2: CARDINAL ;
+BEGIN
+   Assert(i1<=i2) ;
+   Assert(j1<=j2) ;
+   IF IsSubRange(i1, i2, j1)
+   THEN
+      k1 := i1 ;
+      k2 := j1
+   ELSIF IsSubRange(j1, j2, i1)
+   THEN
+      k1 := j1 ;
+      k2 := i1
+   END ;
+   IF IsSubRange(i1, i2, j2)
+   THEN
+      l1 := j2 ;
+      l2 := i2
+   ELSIF IsSubRange(j1, j2, i2)
+   THEN
+      l1 := i2 ;
+      l2 := j2
+   END ;
+   i1 := k1 ;
+   i2 := k2 ;
+   j1 := l1 ;
+   j2 := l2
+END SubtractIntersection ;
+
+
+(*
+   AddLine - adds a line to the lines buffer.
+*)
+
+PROCEDURE AddLine (x1, y1, x2, y2: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF (x1>x2) OR (y1>y2)
+   THEN
+      Swap(x1, x2) ;
+      Swap(y1, y2)
+   ELSIF (x1#x2) OR (y1#y2)
+   THEN
+      (* Do not store points *)
+      IF NOT InsertLine(x1, y1, x2, y2)
+      THEN
+         INC(NoOfLines) ;
+         WITH Lines[NoOfLines] DO
+            X1 := x1 ;
+            Y1 := y1 ;
+            X2 := x2 ;
+            Y2 := y2
+         END
+      END
+    (* ; DisplayLines *)
+   END
+END AddLine ;
+
+
+(*
+   InsertLine - attempts to insert a line in a free slot,
+                true is returned if successfull.
+*)
+
+PROCEDURE InsertLine (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+   i      : CARDINAL ;
+BEGIN
+   i := 1 ;
+   Success := FALSE ;
+   WHILE (NOT Success) AND (i<=NoOfLines) DO
+      IF IsNulLine(i)
+      THEN
+         WITH Lines[i] DO
+            X1 := x1 ;
+            Y1 := y1 ;
+            X2 := x2 ;
+            Y2 := y2
+         END ;
+         Success := TRUE
+      ELSE
+         INC(i)
+      END
+   END ;
+   RETURN( Success )
+END InsertLine ;
+
+
+(*
+   DeleteLine - deletes a line from the lines buffer.
+*)
+
+PROCEDURE DeleteLine (l: CARDINAL) ;
+BEGIN
+   WITH Lines[l] DO
+      X1 := 0 ;
+      Y1 := 0 ;
+      X2 := 0 ;
+      Y2 := 0
+   END
+ (* ; DisplayLines *)
+END DeleteLine ;
+
+
+PROCEDURE DisplayLines ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WriteString('Lines') ; WriteLn ;
+   i := 1 ;
+   WHILE i<=NoOfLines DO
+      WITH Lines[i] DO
+         WriteCard(X1, 4) ; WriteCard(Y1, 4) ;
+         WriteCard(X2, 4) ; WriteCard(Y2, 4) ; WriteLn
+      END ;
+      INC(i)
+   END
+END DisplayLines ;
+
+
+(*
+   IsNulLine - returns true if line l is a nul line.
+*)
+
+PROCEDURE IsNulLine (l: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Lines[l] DO
+      RETURN( (X1=0) AND (Y1=0) AND (X2=0) AND (Y2=0) )
+   END
+END IsNulLine ;
+
+
+(*
+   RemoveRoom - removes a room, r, from the room list.
+*)
+
+PROCEDURE RemoveRoom (r: CARDINAL) ;
+BEGIN
+   Rooms[r].RoomNo := 0   (* No longer exists *)
+END RemoveRoom ;
+
+
+(*
+   InsertRoom - inserts a room, r, back into the room list.
+*)
+
+PROCEDURE InsertRoom (r: CARDINAL) ;
+BEGIN
+   Rooms[r].RoomNo := r
+END InsertRoom ;
+
+
+(*
+   RoomExist - returns true if a room, r, exists.
+*)
+
+PROCEDURE RoomExists (r: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( Rooms[r].RoomNo#0 )
+END RoomExists ;
+
+
+(*
+   IsLineRoomSatisfied - returns true if the line room meets the requirements
+                         of a room.
+*)
+
+PROCEDURE IsLineRoomSatisfied () : BOOLEAN ;
+VAR
+   Count, i: CARDINAL ;
+BEGIN
+   Count := 0 ;
+   i := 1 ;
+   WHILE i<=NoOfLines DO
+      IF NOT IsNulLine(i)
+      THEN
+         INC(Count)
+      END ;
+      INC(i)
+   END ;
+   RETURN( Count<=WallsPerRoom )
+   (* Must also check for a door into another room *)
+END IsLineRoomSatisfied ;
+
+
+(*
+   CopyWallsToLines - copies walls from room r into the lines buffer.
+*)
+
+PROCEDURE CopyWallsToLines (r: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WITH Rooms[r] DO
+      WHILE i<=NoOfWalls DO
+         INC(NoOfLines) ;
+         WITH Lines[NoOfLines] DO
+            X1 := Walls[i].X1 ;
+            Y1 := Walls[i].Y1 ;
+            X2 := Walls[i].X2 ;
+            Y2 := Walls[i].Y2
+         END ;
+         INC(i)
+      END
+   END
+END CopyWallsToLines ;
+
+
+(*
+   CopyLinesToWalls - copies the lines buffer into the walls of room r.
+*)
+
+PROCEDURE CopyLinesToWalls (r: CARDINAL) ;
+BEGIN
+   WITH Rooms[r] DO
+      NoOfWalls := 0 ;
+      WHILE NoOfLines>0 DO
+         IF NOT IsNulLine(NoOfLines)
+         THEN
+            INC(NoOfWalls) ;
+            WITH Lines[NoOfLines] DO
+               Walls[NoOfWalls].X1 := X1 ;
+               Walls[NoOfWalls].Y1 := Y1 ;
+               Walls[NoOfWalls].X2 := X2 ;
+               Walls[NoOfWalls].Y2 := Y2
+            END
+         END ;
+         DEC(NoOfLines)
+      END
+   END
+END CopyLinesToWalls ;
+
+
+(*
+   IsTouching - returns true if room r1 and r2 touch each other.
+*)
+
+PROCEDURE IsTouching (r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   i, j: CARDINAL ;
+   ok  : BOOLEAN ;
+BEGIN
+   ok := FALSE ;
+   i := 1 ;
+   WHILE (NOT ok) AND (i<=Rooms[r1].NoOfWalls) DO
+      j := 1 ;
+      WHILE (NOT ok) AND (j<=Rooms[r2].NoOfWalls) DO
+         ok := IsIntersection(Rooms[r1].Walls[i].X1, Rooms[r1].Walls[i].Y1,
+                              Rooms[r1].Walls[i].X2, Rooms[r1].Walls[i].Y2,
+                              Rooms[r2].Walls[j].X1, Rooms[r2].Walls[j].Y1,
+                              Rooms[r2].Walls[j].X2, Rooms[r2].Walls[j].Y2) ;
+         INC(j)
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsTouching ;
+
+
+(*
+   IsIntersection - returns true if the line x1, y1, x2, y2 touches
+                    line X1, Y1, X2, Y2.
+                    This routine does not consider perpendicular
+                    intersections.
+*)
+
+PROCEDURE IsIntersection (x1, y1, x2, y2, X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   Assert(x1#0) ;
+   Assert(X1#0) ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(X1, Y1, X2, Y2) AND
+      (x1=X1)
+   THEN
+      RETURN( IsIntersectingRange(y1, y2, Y1, Y2) )
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(X1, Y1, X2, Y2) AND
+         (y1=Y1)
+   THEN
+      RETURN( IsIntersectingRange(x1, x2, X1, X2) )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsIntersection ;
+
+
+(*
+   IsVertical - returns true if line x1, y1, x2, y2 is vertical.
+*)
+
+PROCEDURE IsVertical (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (x1=x2) AND (y1#y2) )
+END IsVertical ;
+
+
+(*
+   IsHorizontal - returns true if line x1, y1, x2, y2 is horizontal.
+*)
+
+PROCEDURE IsHorizontal (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (y1=y2) AND (x1#x2) )
+END IsHorizontal ;
+
+
+(*
+   Adjacent - tests whether two rooms r1 & r2 are adjacent.
+*)
+
+PROCEDURE Adjacent (r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WITH Rooms[r1] DO
+      i := NoOfDoors ;
+      WHILE i>0 DO
+         IF Doors[i].LeadsTo=r2
+         THEN
+            RETURN( TRUE )
+         ELSE
+            DEC(i)
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END Adjacent ;
+
+
+PROCEDURE Stop ;
+BEGIN
+   HALT
+END Stop ;
+
+
+END RoomMap.
diff --git a/gcc/testsuite/gm2/examples/map/pass/Semantic.mod b/gcc/testsuite/gm2/examples/map/pass/Semantic.mod
new file mode 100644
index 00000000000..16cef47c818
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/Semantic.mod
@@ -0,0 +1,389 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+MODULE Semantic ;
+
+
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT exit, system ;
+FROM StrLib IMPORT StrCopy, StrConCat ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM Args IMPORT GetArg ;
+FROM libc IMPORT system ;
+(*
+FROM FIO IMPORT File, OpenToWrite, Close, Exists, ReportError, WriteShort,
+                WriteChar, IsNoError ;
+*)
+FROM FIO IMPORT File, OpenToWrite, Close, Exists, WriteChar, IsNoError ;
+
+FROM AdvMap IMPORT ReadAdvMap, Rooms, DoorStatus, ActualNoOfRooms,
+                   MaxNoOfTreasures, Treasure ;
+
+CONST
+   MaxFileName = 4096 ;
+
+VAR
+   ErrorInRoom: BOOLEAN ;
+
+
+PROCEDURE GetOppositeDoor (r, x1, y1, x2, y2: CARDINAL ;
+                           VAR doorno: CARDINAL ; VAR ok: BOOLEAN) ;
+VAR
+   xok, yok: BOOLEAN ;
+BEGIN
+   ok := FALSE ;
+   doorno := 1 ;
+   WITH Rooms[r] DO
+      WHILE (NOT ok) AND (doorno<=NoOfDoors) DO
+         xok :=  (x1=Doors[doorno].Position.X1) AND
+                 (x2=Doors[doorno].Position.X2) ;
+         yok :=  (y1=Doors[doorno].Position.Y1) AND
+                 (y2=Doors[doorno].Position.Y2) ;
+         IF xok AND yok
+         THEN
+            ok := TRUE
+         ELSE
+            INC( doorno )
+         END
+      END
+   END
+END GetOppositeDoor ;
+
+
+PROCEDURE GetWallOnDoor (r, x1, y1, x2, y2: CARDINAL ;
+                         VAR ok: BOOLEAN) ;
+VAR
+   wallno: CARDINAL ;
+BEGIN
+   ok := FALSE ;
+   wallno := 1 ;
+   WITH Rooms[r] DO
+      WHILE (NOT ok) AND (wallno<=NoOfWalls) DO
+         WITH Walls[wallno] DO
+            IF (Walls[wallno].X1=x1) AND (Walls[wallno].X2=x2)
+            THEN
+               IF (Walls[wallno].Y1<=y1) AND (Walls[wallno].Y2>=y2)
+               THEN
+                  ok := TRUE
+               END
+            END ;
+            IF (Walls[wallno].Y1=y1) AND (Walls[wallno].Y2=y2)
+            THEN
+               IF (Walls[wallno].X1<=x1) AND (Walls[wallno].X2>=x2)
+               THEN
+                  ok := TRUE
+               END
+            END ;
+            INC( wallno )
+         END
+      END
+   END
+END GetWallOnDoor ;
+
+
+PROCEDURE HorizWallOnDoor (r, x1, y1: CARDINAL ;
+                           VAR ok: BOOLEAN) ;
+VAR
+   wallno: CARDINAL ;
+BEGIN
+   ok := FALSE ;
+   wallno := 1 ;
+   WITH Rooms[r] DO
+      WHILE (NOT ok) AND (wallno<=NoOfWalls) DO
+         WITH Walls[wallno] DO
+            IF (Walls[wallno].X1=Walls[wallno].X2) AND (x1=Walls[wallno].X1)
+            THEN
+               IF (Walls[wallno].Y1<=y1) AND (Walls[wallno].Y2>=y1)
+               THEN
+                  ok := TRUE
+               END
+            END
+         END ;
+         INC( wallno )
+      END
+   END
+END HorizWallOnDoor ;
+
+
+PROCEDURE VertWallOnDoor (r, x1, y1: CARDINAL ;
+                          VAR ok: BOOLEAN) ;
+VAR
+   wallno: CARDINAL ;
+BEGIN
+   ok := FALSE ;
+   wallno := 1 ;
+   WITH Rooms[r] DO
+      WHILE (NOT ok) AND (wallno<=NoOfWalls) DO
+         WITH Walls[wallno] DO
+            IF (Walls[wallno].Y1=Walls[wallno].Y2) AND (y1=Walls[wallno].Y1)
+            THEN
+               IF (Walls[wallno].X1<=x1) AND (Walls[wallno].X2>=x1)
+               THEN
+                  ok := TRUE
+               END
+            END
+         END ;
+         INC( wallno )
+      END
+   END
+END VertWallOnDoor ;
+
+
+(*
+   AnalyzeSemantic - 
+*)
+
+PROCEDURE AnalyzeSemantic ;
+VAR
+   room: CARDINAL ;
+BEGIN
+   FOR room := 1 TO ActualNoOfRooms DO
+      AnalyzeRoom(room)
+   END
+END AnalyzeSemantic ;
+
+
+(*
+   AnalyzeRoom - 
+*)
+
+PROCEDURE AnalyzeRoom (room: CARDINAL) ;
+VAR
+   door: CARDINAL ;
+BEGIN
+   WITH Rooms[room] DO
+      IF NoOfDoors#0
+      THEN
+         FOR door := 1 TO NoOfDoors DO
+            AnalyzeDoor(room, door)
+         END
+      END
+   END
+END AnalyzeRoom ;
+
+
+(*
+   AnalyzeDoor - 
+*)
+
+PROCEDURE AnalyzeDoor (room, door: CARDINAL) ;
+VAR
+   OtherDoor,
+   i        : CARDINAL ;
+   ok       : BOOLEAN ;
+BEGIN
+   WITH Rooms[room] DO
+      WITH Doors[door] DO
+         IF LeadsTo#0
+         THEN
+            GetOppositeDoor( LeadsTo, Position.X1, Position.Y1,
+                             Position.X2, Position.Y2 ,OtherDoor, ok ) ;
+            IF ok
+            THEN
+               IF StateOfDoor#Rooms[LeadsTo].Doors[OtherDoor].StateOfDoor
+               THEN
+                  WriteString('Inconsistant Door STATUS in room') ;
+                  WriteCard( room, 6 ) ; WriteString('Door NO.') ;
+                  WriteCard( door, 6 ) ; WriteLn ;
+                  ErrorInRoom := TRUE
+               END
+            ELSE
+               WriteString('Inconsistant Door LEADSTO in room') ;
+               WriteCard( room, 6 ) ; WriteString('  Door NO.') ;
+               WriteCard( door, 6 ) ; WriteString('  - OR -') ;WriteLn ;
+               WriteString('Inconsistant Door COORDS in room') ;
+               WriteCard( room, 6 ) ; WriteString('  Door NO.') ;
+               WriteCard( door, 6 ) ; WriteLn ;
+               ErrorInRoom := TRUE
+            END ;
+            GetWallOnDoor( room, Position.X1, Position.Y1,
+                           Position.X2, Position.Y2, ok ) ;
+            IF NOT ok
+            THEN
+               WriteString('Door NOT ON WALL in room') ;
+               WriteCard( room, 6 ) ; WriteString('  Door NO.') ;
+               WriteCard( door, 6 ) ; WriteLn ;
+               ErrorInRoom := TRUE
+            END ;
+            IF Position.X1=Position.X2
+            THEN
+               i := Position.Y1 ;
+               REPEAT
+                  VertWallOnDoor( LeadsTo, Position.X1, i, ok ) ;
+                  INC( i ) ;
+               UNTIL ok OR (i>Position.Y2)
+            ELSE
+               i := Position.X1 ;
+               REPEAT
+                  HorizWallOnDoor( LeadsTo, i, Position.Y1, ok ) ;
+                  INC( i )
+               UNTIL ok OR (i>Position.X2)
+            END ;
+            IF ok
+            THEN
+               WriteString('Adjacent Room CONFLICT with DOOR in ROOM') ;
+               WriteCard( room, 6 ) ; WriteString('  Door NO.') ;
+               WriteCard( door, 6 ) ; WriteLn ;
+               WriteString('Adjacent Room is') ; WriteCard( LeadsTo, 6 ) ;
+               WriteLn ;
+               ErrorInRoom := TRUE
+            END
+         END
+      END
+   END
+END AnalyzeDoor ;
+
+
+(*
+(*
+   CrunchRooms - 
+*)
+
+PROCEDURE CrunchRooms (f: File) ;
+VAR
+   room: CARDINAL ;
+BEGIN
+   WriteShort(f, ActualNoOfRooms) ;
+   FOR room := 1 TO ActualNoOfRooms DO
+      CrunchRoom(f, room)
+   END
+END CrunchRooms ;
+
+
+(*
+   CrunchRoom - 
+*)
+
+PROCEDURE CrunchRoom (f: File; room: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WITH Rooms[room] DO
+      WriteShort(f, NoOfWalls) ;
+      FOR i := 1 TO NoOfWalls DO
+         CrunchWall(f, room, i)
+      END ;
+      WriteShort(f, NoOfDoors) ;
+      FOR i := 1 TO NoOfDoors DO
+         CrunchDoor(f, room, i)
+      END
+   END
+END CrunchRoom ;
+
+
+(*
+   CrunchDoor - 
+*)
+
+PROCEDURE CrunchDoor (f: File; room: CARDINAL; doorno: CARDINAL) ;
+BEGIN
+   WITH Rooms[room].Doors[doorno] DO
+      WriteShort(f, Position.X1) ;
+      WriteShort(f, Position.Y1) ;
+      WriteShort(f, Position.X2) ;
+      WriteShort(f, Position.Y2) ;
+      WriteShort(f, LeadsTo) ;
+      WriteChar(f, VAL(CHAR, StateOfDoor))
+   END
+END CrunchDoor ;
+
+
+(*
+   CrunchWall - 
+*)
+
+PROCEDURE CrunchWall (f: File; room: CARDINAL; wallno: CARDINAL) ;
+BEGIN
+   WITH Rooms[room].Walls[wallno] DO
+      WriteShort(f, X1) ;
+      WriteShort(f, Y1) ;
+      WriteShort(f, X2) ;
+      WriteShort(f, Y2)
+   END
+END CrunchWall ;
+
+
+(*
+   CrunchTreasures - 
+*)
+
+PROCEDURE CrunchTreasures (f: File) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   FOR i := 1 TO MaxNoOfTreasures DO
+      WITH Treasure[i] DO
+         WriteShort(f, Xpos) ;
+         WriteShort(f, Ypos) ;
+         WriteShort(f, Rm)
+      END
+   END
+END CrunchTreasures ;
+
+
+(*
+   CrunchMap - 
+*)
+
+PROCEDURE CrunchMap (a: ARRAY OF CHAR) ;
+VAR
+   f: File ;
+   c: ARRAY [0..MaxFileName] OF CHAR ;
+BEGIN
+   StrConCat(a, '.bin', a) ;
+   IF Exists(a)
+   THEN
+      StrCopy('/bin/rm -f ', c) ;
+      StrConCat(c, a, c) ;
+      IF system(ADR(c))#0
+      THEN
+         WriteString('failed to ') ; WriteString(c) ; WriteLn ;
+         exit(1)
+      END
+   END ;
+   f := OpenToWrite(a) ;
+   IF IsNoError(f)
+   THEN
+      CrunchRooms(f) ;
+      CrunchTreasures(f) ;
+      Close(f)
+   ELSE
+      WriteString('error when opening ') ; WriteString(a) ;
+      WriteString(' for writing: ') ; ReportError(f) ; WriteLn
+   END
+END CrunchMap ;
+*)
+
+VAR
+   FileName: ARRAY [0..MaxFileName] OF CHAR ;
+BEGIN
+   IF GetArg(FileName, 1)
+   THEN
+      IF ReadAdvMap(FileName)
+      THEN
+         ErrorInRoom := FALSE ;
+         AnalyzeSemantic ;
+(*
+         IF NOT ErrorInRoom
+         THEN
+            CrunchMap(FileName)
+         END
+*)
+      END
+   END
+END Semantic.
diff --git a/gcc/testsuite/gm2/examples/map/pass/StoreCoord.def b/gcc/testsuite/gm2/examples/map/pass/StoreCoord.def
new file mode 100644
index 00000000000..e50406c4e5e
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/StoreCoord.def
@@ -0,0 +1,72 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE StoreCoords ;
+
+(*
+   Title      : StoreCoords
+   Author     : Gaius Mulley
+   Date       : 15/7/88
+   LastEdit   : 15/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Provides a list of unique coordinates.
+                These coordinates maybe randomly requested.
+*)
+
+EXPORT QUALIFIED InitCoords, KillCoords,
+                 GetAndDeleteRandomCoord, AddCoord, CoordsExist ;
+
+(*
+   InitCoords - Initializes a potential list of coordinates.
+                An index to this potential coordinate list is returned.
+*)
+
+PROCEDURE InitCoords () : CARDINAL ;
+
+
+(*
+   KillCoords - Kills a complete coordinate list.
+*)
+
+PROCEDURE KillCoords (CoordListIndex: CARDINAL) ;
+
+
+(*
+   GetAndDeleteRandomCoord - Returns a random coordinate from the coordinate
+                             list and then it is deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomCoord (CoordListIndex: CARDINAL;
+                                   VAR x, y: CARDINAL) ;
+
+
+(*
+   AddCoord - places a coordinate into the specified list.
+*)
+
+PROCEDURE AddCoord (CoordListIndex: CARDINAL; x, y: CARDINAL) ;
+
+
+(*
+   CoordsExist - returns true if a coordinate exists
+                 within the CoordListIndex.
+*)
+
+PROCEDURE CoordsExist (CoordListIndex: CARDINAL) : BOOLEAN ;
+
+
+END StoreCoords.
diff --git a/gcc/testsuite/gm2/examples/map/pass/StoreCoord.mod b/gcc/testsuite/gm2/examples/map/pass/StoreCoord.mod
new file mode 100644
index 00000000000..787467c56de
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/StoreCoord.mod
@@ -0,0 +1,231 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+
+IMPLEMENTATION MODULE StoreCoords ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM Chance IMPORT GetRand ;
+
+
+CONST
+   MaxCoord = 15000 ;
+   MaxIndex =   500 ;
+
+TYPE
+   Coord  = RECORD
+               X,
+               Y: CARDINAL ;
+            END ;
+
+   Index  = RECORD
+               Start,               (* Start of the Coord list *)
+               End  : CARDINAL ;    (* End of the Coord list   *)
+            END ;
+
+VAR
+   CoordIndex : ARRAY [0..MaxIndex] OF Index ;
+   Coords     : ARRAY [1..MaxCoord] OF Coord ;
+   NoOfCoords : CARDINAL ;   (* Number of coordinates in array Coords *)
+   NoOfIndices: CARDINAL ;   (* Number of indices in CoordIndex       *)
+
+
+(*
+   InitCoords - Initializes a potential list of coordinates.
+                An index to this potential coordinate list is returned.
+*)
+
+PROCEDURE InitCoords () : CARDINAL ;
+BEGIN
+   IF NoOfIndices=MaxIndex
+   THEN
+      WriteString('Too many coordinate list indices in Module StoreCoords') ;
+      WriteLn ;
+      WriteString('Increase MaxIndex') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfIndices) ;
+      WITH CoordIndex[NoOfIndices] DO
+         Start := NoOfCoords+1 ;
+         End := 0
+      END ;
+      AddCoord(NoOfIndices, 0, 0) ;  (* Dummy coordinate that we keep *)
+      RETURN(NoOfIndices)            (* for the life of this list.    *)
+   END
+END InitCoords ;
+
+
+(*
+   KillCoords - Kills a complete coordinate list.
+*)
+
+PROCEDURE KillCoords (CoordListIndex: CARDINAL) ;
+BEGIN
+   IF NoOfIndices>0
+   THEN
+      (* Destroy index to Coord list *)
+      WITH CoordIndex[CoordListIndex] DO
+         WriteString('No of coords') ; WriteCard(End-Start+1, 4) ; WriteLn ;
+         Start := 0 ;
+         End := 0
+      END ;
+      (*
+         If killed last Coord list see if we can garbage collect
+         previously killed middle indices.
+      *)
+      IF NoOfIndices=CoordListIndex
+      THEN
+         REPEAT
+            DEC(NoOfIndices)
+         UNTIL (NoOfIndices=0) OR (CoordIndex[NoOfIndices].Start#0)
+      END ;
+      NoOfCoords := CoordIndex[NoOfIndices].End
+   ELSE
+      WriteString('All Coordinate lists have been killed - Module StoreCoords') ;
+      WriteLn ;
+      HALT
+   END
+END KillCoords ;
+
+
+
+(*
+   AddCoord - places a coordinate into the specified list.
+*)
+
+PROCEDURE AddCoord (CoordListIndex: CARDINAL; x, y: CARDINAL) ;
+BEGIN
+   IF NoOfCoords=MaxCoord
+   THEN
+      WriteString('Too many coordinates in a list in Module StoreCoords') ;
+      WriteLn ;
+      WriteString('Increase MaxCoord') ;
+      WriteLn ;
+      HALT
+   ELSIF UniqueCoord(CoordListIndex, x, y)
+   THEN
+      INC(NoOfCoords) ;
+      WITH Coords[NoOfCoords] DO
+         X := x ;
+         Y := y
+      END ;
+      WITH CoordIndex[CoordListIndex] DO
+         End := NoOfCoords
+      END
+   END
+END AddCoord ;
+
+
+(*
+   UniqueCoord - returns true if x and y are unique in the coord list.
+*)
+
+PROCEDURE UniqueCoord (CoordListIndex: CARDINAL;
+                       x, y: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   WITH CoordIndex[CoordListIndex] DO
+      i := Start ;
+      Found := FALSE ;
+      WHILE (NOT Found) AND (i<=End) DO
+         WITH Coords[i] DO
+            Found := (X=x) AND (Y=y)
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END UniqueCoord ;
+
+
+(*
+   GetAndDeleteRandomCoord - Returns a random coordinate from the coordinate
+                             list and then it is deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomCoord (CoordListIndex: CARDINAL;
+                                   VAR x, y: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH CoordIndex[CoordListIndex] DO
+      i := Start+GetRand(End-Start+1) ;  (* +1 for GetRand *)
+      j := i ;
+      REPEAT
+         IF Coords[j].X=0
+         THEN
+            INC(j) ;
+            IF j>End
+            THEN
+               j := Start
+            END
+         END
+      UNTIL (j=i) OR (Coords[j].X#0) ;
+      WITH Coords[j] DO
+         x := X ;
+         y := Y ;
+         X := 0 ;      (* Now delete this box *)
+         Y := 0
+      END
+   END
+END GetAndDeleteRandomCoord ;
+
+
+(*
+   CoordsExist - returns true if a coordinate exists
+                 within the CoordListIndex.
+*)
+
+PROCEDURE CoordsExist (CoordListIndex: CARDINAL) : BOOLEAN ;
+VAR
+   i : CARDINAL ;
+   ok: BOOLEAN ;
+BEGIN
+   ok := FALSE ;
+   WITH CoordIndex[CoordListIndex] DO
+      IF End>0
+      THEN
+         (* Was at least one coordinate *)
+         i := Start ;
+         WHILE (NOT ok) AND (i<=End) DO
+            ok := (Coords[i].X#0) ;   (* #0 means coordinate still exists *)
+            INC(i)
+         END
+      END
+   END ;
+   RETURN( ok )
+END CoordsExist ;
+
+
+PROCEDURE Init ;
+BEGIN
+   NoOfCoords := 0 ;
+   NoOfIndices := 0 ;
+   WITH CoordIndex[NoOfIndices] DO
+      End := 0
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END StoreCoords.
diff --git a/gcc/testsuite/gm2/examples/map/pass/StoreCoords.def b/gcc/testsuite/gm2/examples/map/pass/StoreCoords.def
new file mode 100644
index 00000000000..e50406c4e5e
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/StoreCoords.def
@@ -0,0 +1,72 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE StoreCoords ;
+
+(*
+   Title      : StoreCoords
+   Author     : Gaius Mulley
+   Date       : 15/7/88
+   LastEdit   : 15/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Provides a list of unique coordinates.
+                These coordinates maybe randomly requested.
+*)
+
+EXPORT QUALIFIED InitCoords, KillCoords,
+                 GetAndDeleteRandomCoord, AddCoord, CoordsExist ;
+
+(*
+   InitCoords - Initializes a potential list of coordinates.
+                An index to this potential coordinate list is returned.
+*)
+
+PROCEDURE InitCoords () : CARDINAL ;
+
+
+(*
+   KillCoords - Kills a complete coordinate list.
+*)
+
+PROCEDURE KillCoords (CoordListIndex: CARDINAL) ;
+
+
+(*
+   GetAndDeleteRandomCoord - Returns a random coordinate from the coordinate
+                             list and then it is deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomCoord (CoordListIndex: CARDINAL;
+                                   VAR x, y: CARDINAL) ;
+
+
+(*
+   AddCoord - places a coordinate into the specified list.
+*)
+
+PROCEDURE AddCoord (CoordListIndex: CARDINAL; x, y: CARDINAL) ;
+
+
+(*
+   CoordsExist - returns true if a coordinate exists
+                 within the CoordListIndex.
+*)
+
+PROCEDURE CoordsExist (CoordListIndex: CARDINAL) : BOOLEAN ;
+
+
+END StoreCoords.
diff --git a/gcc/testsuite/gm2/examples/map/pass/StoreCoords.mod b/gcc/testsuite/gm2/examples/map/pass/StoreCoords.mod
new file mode 100644
index 00000000000..c6acbce6f1e
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/StoreCoords.mod
@@ -0,0 +1,230 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+IMPLEMENTATION MODULE StoreCoords ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM Chance IMPORT GetRand ;
+
+
+CONST
+   MaxCoord = 15000 ;
+   MaxIndex =   500 ;
+
+TYPE
+   Coord  = RECORD
+               X,
+               Y: CARDINAL ;
+            END ;
+
+   Index  = RECORD
+               Start,               (* Start of the Coord list *)
+               End  : CARDINAL ;    (* End of the Coord list   *)
+            END ;
+
+VAR
+   CoordIndex : ARRAY [0..MaxIndex] OF Index ;
+   Coords     : ARRAY [1..MaxCoord] OF Coord ;
+   NoOfCoords : CARDINAL ;   (* Number of coordinates in array Coords *)
+   NoOfIndices: CARDINAL ;   (* Number of indices in CoordIndex       *)
+
+
+(*
+   InitCoords - Initializes a potential list of coordinates.
+                An index to this potential coordinate list is returned.
+*)
+
+PROCEDURE InitCoords () : CARDINAL ;
+BEGIN
+   IF NoOfIndices=MaxIndex
+   THEN
+      WriteString('Too many coordinate list indices in Module StoreCoords') ;
+      WriteLn ;
+      WriteString('Increase MaxIndex') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfIndices) ;
+      WITH CoordIndex[NoOfIndices] DO
+         Start := NoOfCoords+1 ;
+         End := 0
+      END ;
+      AddCoord(NoOfIndices, 0, 0) ;  (* Dummy coordinate that we keep *)
+      RETURN(NoOfIndices)            (* for the life of this list.    *)
+   END
+END InitCoords ;
+
+
+(*
+   KillCoords - Kills a complete coordinate list.
+*)
+
+PROCEDURE KillCoords (CoordListIndex: CARDINAL) ;
+BEGIN
+   IF NoOfIndices>0
+   THEN
+      (* Destroy index to Coord list *)
+      WITH CoordIndex[CoordListIndex] DO
+         WriteString('No of coords') ; WriteCard(End-Start+1, 4) ; WriteLn ;
+         Start := 0 ;
+         End := 0
+      END ;
+      (*
+         If killed last Coord list see if we can garbage collect
+         previously killed middle indices.
+      *)
+      IF NoOfIndices=CoordListIndex
+      THEN
+         REPEAT
+            DEC(NoOfIndices)
+         UNTIL (NoOfIndices=0) OR (CoordIndex[NoOfIndices].Start#0)
+      END ;
+      NoOfCoords := CoordIndex[NoOfIndices].End
+   ELSE
+      WriteString('All Coordinate lists have been killed - Module StoreCoords') ;
+      WriteLn ;
+      HALT
+   END
+END KillCoords ;
+
+
+
+(*
+   AddCoord - places a coordinate into the specified list.
+*)
+
+PROCEDURE AddCoord (CoordListIndex: CARDINAL; x, y: CARDINAL) ;
+BEGIN
+   IF NoOfCoords=MaxCoord
+   THEN
+      WriteString('too many coordinates in a list in Module StoreCoords') ;
+      WriteLn ;
+      WriteString('increase MaxCoord') ;
+      WriteLn ;
+      HALT
+   ELSIF UniqueCoord(CoordListIndex, x, y)
+   THEN
+      INC(NoOfCoords) ;
+      WITH Coords[NoOfCoords] DO
+         X := x ;
+         Y := y
+      END ;
+      WITH CoordIndex[CoordListIndex] DO
+         End := NoOfCoords
+      END
+   END
+END AddCoord ;
+
+
+(*
+   UniqueCoord - returns true if x and y are unique in the coord list.
+*)
+
+PROCEDURE UniqueCoord (CoordListIndex: CARDINAL;
+                       x, y: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   WITH CoordIndex[CoordListIndex] DO
+      i := Start ;
+      Found := FALSE ;
+      WHILE (NOT Found) AND (i<=End) DO
+         WITH Coords[i] DO
+            Found := (X=x) AND (Y=y)
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END UniqueCoord ;
+
+
+(*
+   GetAndDeleteRandomCoord - Returns a random coordinate from the coordinate
+                             list and then it is deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomCoord (CoordListIndex: CARDINAL;
+                                   VAR x, y: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH CoordIndex[CoordListIndex] DO
+      i := Start+GetRand(End-Start+1) ;  (* +1 for GetRand *)
+      j := i ;
+      REPEAT
+         IF Coords[j].X=0
+         THEN
+            INC(j) ;
+            IF j>End
+            THEN
+               j := Start
+            END
+         END
+      UNTIL (j=i) OR (Coords[j].X#0) ;
+      WITH Coords[j] DO
+         x := X ;
+         y := Y ;
+         X := 0 ;      (* Now delete this box *)
+         Y := 0
+      END
+   END
+END GetAndDeleteRandomCoord ;
+
+
+(*
+   CoordsExist - returns true if a coordinate exists
+                 within the CoordListIndex.
+*)
+
+PROCEDURE CoordsExist (CoordListIndex: CARDINAL) : BOOLEAN ;
+VAR
+   i : CARDINAL ;
+   ok: BOOLEAN ;
+BEGIN
+   ok := FALSE ;
+   WITH CoordIndex[CoordListIndex] DO
+      IF End>0
+      THEN
+         (* Was at least one coordinate *)
+         i := Start ;
+         WHILE (NOT ok) AND (i<=End) DO
+            ok := (Coords[i].X#0) ;   (* #0 means coordinate still exists *)
+            INC(i)
+         END
+      END
+   END ;
+   RETURN( ok )
+END CoordsExist ;
+
+
+PROCEDURE Init ;
+BEGIN
+   NoOfCoords := 0 ;
+   NoOfIndices := 0 ;
+   WITH CoordIndex[NoOfIndices] DO
+      End := 0
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END StoreCoords.
diff --git a/gcc/testsuite/gm2/examples/map/pass/WriteMap.def b/gcc/testsuite/gm2/examples/map/pass/WriteMap.def
new file mode 100644
index 00000000000..a74931696cd
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/WriteMap.def
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+DEFINITION MODULE WriteMap ;
+
+(*
+   Title      : WriteMap
+   Author     : Gaius Mulley
+   Date       : 22/8/88
+   LastEdit   : 22/8/88
+   System     : LOGITECH MODULA-2/86
+   Description: Writes an ASCII description of the map.
+*)
+
+EXPORT QUALIFIED WriteMapText ;
+
+
+(*
+   WriteMapText - writes out the map in textual form.
+*)
+
+PROCEDURE WriteMapText ;
+
+
+END WriteMap.
diff --git a/gcc/testsuite/gm2/examples/map/pass/WriteMap.mod b/gcc/testsuite/gm2/examples/map/pass/WriteMap.mod
new file mode 100644
index 00000000000..ccaff46879d
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/WriteMap.mod
@@ -0,0 +1,132 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+IMPLEMENTATION MODULE WriteMap ;
+
+
+
+IMPORT Break ;
+
+FROM StrIO IMPORT WriteLn, WriteString ;
+
+FROM NumberIO IMPORT WriteCard ;
+
+FROM RoomMap IMPORT NoOfRooms, Rooms, DoorStatus ;
+
+
+(*
+   WriteMapText - writes out the map in textual form.
+*)
+
+PROCEDURE WriteMapText ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   MakeRoomNumbers ;
+   FOR i := 1 TO NoOfRooms DO
+      IF RoomExists(i)
+      THEN
+         WriteRoom(i)
+      END
+   END ;
+   WriteString('END.') ; WriteLn
+END WriteMapText ;
+
+
+(*
+   MakeRoomNumbers - makes room numbers for the rooms that exist.
+*)
+
+PROCEDURE MakeRoomNumbers ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   j := 1 ;
+   FOR i := 1 TO NoOfRooms DO
+      IF RoomExists(i)
+      THEN
+         Rooms[i].RoomNo := j ;
+         INC(j)
+      END
+   END
+END MakeRoomNumbers ;
+
+
+(*
+   WriteRoom - writes out the room coordinates.
+*)
+
+PROCEDURE WriteRoom (r: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WITH Rooms[r] DO
+      WriteString('ROOM') ; WriteCard(RoomNo, 4) ; WriteLn ;
+      WriteString('WALL') ; WriteLn ;
+      FOR i := 1 TO NoOfWalls DO
+         WITH Walls[i] DO
+            WriteCard(X1, 8) ; WriteCard(Y1, 4) ;
+            WriteCard(X2, 4) ; WriteCard(Y2, 4) ; WriteLn
+         END
+      END ;
+      FOR i := 1 TO NoOfDoors DO
+         WriteString('DOOR') ;
+         WITH Doors[i] DO
+            WITH Position DO
+               WriteCard(X1, 4) ; WriteCard(Y1, 4) ;
+               WriteCard(X2, 4) ; WriteCard(Y2, 4)
+            END ;
+            WriteString('  STATUS ') ;
+            WriteStatus(StateOfDoor) ;
+            WriteString(' LEADS TO') ;
+            WriteCard(Rooms[LeadsTo].RoomNo, 4) ; WriteLn
+         END
+      END ;
+      WriteString('END') ; WriteLn
+   END
+END WriteRoom ;
+
+
+(*
+   WriteStatus - writes the status of a door.
+*)
+
+PROCEDURE WriteStatus (s: DoorStatus) ;
+BEGIN
+   CASE s OF
+
+   Open   : WriteString('OPEN  ') |
+   Closed : WriteString('CLOSED') |
+   Secret : WriteString('SECRET')
+
+   ELSE
+      HALT
+   END
+END WriteStatus ;
+
+
+(*
+   RoomExists - returns true if a room exists.
+*)
+
+PROCEDURE RoomExists (r: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( Rooms[r].RoomNo#0 )
+END RoomExists ;
+
+
+END WriteMap.
diff --git a/gcc/testsuite/gm2/examples/map/pass/examples-map-pass.exp b/gcc/testsuite/gm2/examples/map/pass/examples-map-pass.exp
new file mode 100644
index 00000000000..4c9ea5bf188
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/examples-map-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "$srcdir/$subdir"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/examples/map/pass/makemaps b/gcc/testsuite/gm2/examples/map/pass/makemaps
new file mode 100644
index 00000000000..980d9d257fc
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/makemaps
@@ -0,0 +1,8 @@
+#!/bin/sh
+
+for i in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ; do
+   echo $i
+   if [ ! -f m$i ] ; then
+      ./map $i | tee m$i
+   fi
+done
diff --git a/gcc/testsuite/gm2/examples/map/pass/testch2.mod b/gcc/testsuite/gm2/examples/map/pass/testch2.mod
new file mode 100644
index 00000000000..5331486ecf6
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/testch2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+MODULE testch2 ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM Chance IMPORT InitRandom, KillRandom, GetAndDeleteRandom, AddRandom ;
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   Index: CARDINAL ;
+   i,  j: CARDINAL ;
+BEGIN
+   FOR i := 1 TO 15 DO
+      Index := InitRandom() ;
+      AddRandom(Index, 5) ;
+      FOR j := 1 TO 6 DO
+         WriteCard(GetAndDeleteRandom(Index), 1)
+      END ;
+      WriteLn ;
+      KillRandom(Index)
+   END
+END testch2.
diff --git a/gcc/testsuite/gm2/examples/map/pass/testchan.mod b/gcc/testsuite/gm2/examples/map/pass/testchan.mod
new file mode 100644
index 00000000000..895415c46b5
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/testchan.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+MODULE testchance ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM Chance IMPORT GetRand ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   FOR i := 1 TO 100 DO
+      WriteCard(GetRand(2), 1) ;
+   END
+END testchance.
diff --git a/gcc/testsuite/gm2/examples/map/pass/testcoor.mod b/gcc/testsuite/gm2/examples/map/pass/testcoor.mod
new file mode 100644
index 00000000000..a15f2365507
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/testcoor.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 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. *)
+MODULE testcoords ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StoreCoords IMPORT InitCoords, KillCoords,
+                        AddCoord, GetAndDeleteRandomCoord ;
+
+VAR
+   Index: CARDINAL ;
+   i, j : CARDINAL ;
+   x, y : CARDINAL ;
+BEGIN
+   FOR i := 1 TO 10 DO
+      Index := InitCoords() ;
+      WriteString('Index:') ; WriteCard(Index, 4) ; WriteString('Coords') ;
+      FOR j := 1 TO 5 DO
+         AddCoord(Index, j, j)
+      END ;
+      FOR j := 1 TO 6 DO
+         GetAndDeleteRandomCoord(Index, x, y) ;
+         WriteCard(x, 4) ; WriteCard(y, 2)
+      END ;
+      WriteLn ;
+      KillCoords(Index)
+   END
+END testcoords.
diff --git a/gcc/testsuite/gm2/examples/map/pass/testmaps b/gcc/testsuite/gm2/examples/map/pass/testmaps
new file mode 100644
index 00000000000..b90f3ca8e60
--- /dev/null
+++ b/gcc/testsuite/gm2/examples/map/pass/testmaps
@@ -0,0 +1,25 @@
+#!/bin/sh
+
+for i in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 151 16 17 18 19 20 ; do
+   echo -n map $i
+   ./map $i > mapdir/n$i
+   if [ -f n$i ] ; then
+      ed n$i << EOFEOF >& /dev/null
+/ROOM
+i
+  
+.
+.-1
+1,.d
+w
+q
+EOFEOF
+      if diff mapdir/n$i mapdir/m$i >& /dev/null ; then
+         echo " passed"
+         rm -f mapdir/n$i
+      else
+         echo " failed"
+      fi
+   fi
+done
+
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/cpp.cpp b/gcc/testsuite/gm2/exceptions/run/pass/cpp.cpp
new file mode 100644
index 00000000000..bc0d5838db4
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/cpp.cpp
@@ -0,0 +1,11 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+extern "C" void cpp_mytry (void)
+{
+  throw (int)9;
+}
+
+extern "C" void _M2_cpp_ctor (void) {}
+extern "C" void _M2_cpp_init (void) {}
+extern "C" void _M2_cpp_finish (void) {}
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/cpp.def b/gcc/testsuite/gm2/exceptions/run/pass/cpp.def
new file mode 100644
index 00000000000..d292f652787
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/cpp.def
@@ -0,0 +1,31 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+DEFINITION MODULE cpp ;
+
+(*
+    Title      : cpp
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Sep  5 16:10:30 2008
+    Revision   : $Version$ 
+    Description: a simple wrapper for cpp
+*)
+
+PROCEDURE mytry ;
+
+END cpp.
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/exceptions-run-pass.exp b/gcc/testsuite/gm2/exceptions/run/pass/exceptions-run-pass.exp
new file mode 100644
index 00000000000..7b3d898c0a5
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/exceptions-run-pass.exp
@@ -0,0 +1,54 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib libgloss.exp
+load_lib prune.exp
+load_lib gm2-torture.exp
+
+
+set output [target_compile $srcdir/$subdir/cpp.cpp cpp.o object "-g"]
+set output [target_compile $srcdir/$subdir/mycpp.cpp mycpp.o object "-g"]
+
+#
+#  notice this uses PIM libraries with exceptions - this is a useful test.
+#  There are other exception tests which test exceptions with the ISO libraries.
+#
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/exceptions/run/pass"
+set output [gm2_target_compile $srcdir/$subdir/m2test.mod m2test.o object "-g"]
+
+gm2_link_obj "cpp.o mycpp.o m2test.o"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+    if { $testcase ne "$srcdir/$subdir/m2test.mod" } {
+	gm2-torture-execute $testcase "" "pass"
+    }
+}
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/libexcept.mod b/gcc/testsuite/gm2/exceptions/run/pass/libexcept.mod
new file mode 100644
index 00000000000..a2c1b803f79
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/libexcept.mod
@@ -0,0 +1,63 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE libexcept ;
+
+
+FROM libc IMPORT exit, write, exit, printf ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR, THROW ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+FROM RTExceptions IMPORT IsInExceptionState ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e, r: INTEGER ;
+BEGIN
+   Assert(NOT IsInExceptionState(), __LINE__, __COLUMN__, "should not be in the exception state") ;
+   THROW(1) ;
+   exit(1)
+EXCEPT
+   Assert(IsInExceptionState(), __LINE__, __COLUMN__, "should be in the exception state") ;
+   r := printf("correctly in exception handler, about to exit with code %d\n", e) ;
+   exit(e)
+END libexcept.
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/m2test.def b/gcc/testsuite/gm2/exceptions/run/pass/m2test.def
new file mode 100644
index 00000000000..2d31f2ba2b8
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/m2test.def
@@ -0,0 +1,31 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+DEFINITION MODULE m2test ;
+
+(*
+    Title      : m2test
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Sep  5 20:13:28 2008
+    Revision   : $Version$ 
+    Description: provides an interface to try.
+*)
+
+PROCEDURE try ;
+
+END m2test.
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/m2test.mod b/gcc/testsuite/gm2/exceptions/run/pass/m2test.mod
new file mode 100644
index 00000000000..be46b4ded2b
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/m2test.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+IMPLEMENTATION MODULE m2test ;
+
+FROM SYSTEM IMPORT THROW ;
+IMPORT mycpp ;
+
+PROCEDURE try ;
+BEGIN
+   THROW (1)
+END try ;
+
+END m2test.
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/mycpp.cpp b/gcc/testsuite/gm2/exceptions/run/pass/mycpp.cpp
new file mode 100644
index 00000000000..30178908803
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/mycpp.cpp
@@ -0,0 +1,53 @@
+/* Copyright (C) 2008 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 2, 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 <stdio.h>
+#include <stdlib.h>
+
+extern "C" void mycpp_test (void);
+extern "C" void m2test_try (void);
+
+void mycpp_test (void)
+{
+  int r;
+
+  try {
+    printf("start of main c++ program\n");
+    m2test_try() ;
+    printf("ending (should not get here)\n");
+    exit(1);
+  }
+  catch (int i) {
+    printf("c++ caught exception correctly\n");
+    exit(0);
+  }
+  printf("c++ should not get here\n");
+  exit(1);
+}
+
+extern "C" void _M2_mycpp_init (void)
+{
+  mycpp_test();
+}
+
+extern "C" void _M2_mycpp_finish (void)
+{
+}
+
+extern "C" void _M2_mycpp_ctor (void)
+{
+}
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/mycpp.def b/gcc/testsuite/gm2/exceptions/run/pass/mycpp.def
new file mode 100644
index 00000000000..f2af694875a
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/mycpp.def
@@ -0,0 +1,31 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+DEFINITION MODULE mycpp ;
+
+(*
+    Title      : mycpp
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Sep  5 20:19:26 2008
+    Revision   : $Version$ 
+    Description: provides an interface to mycpp_test.
+*)
+
+PROCEDURE test ;
+
+END mycpp.
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/mym2.mod b/gcc/testsuite/gm2/exceptions/run/pass/mym2.mod
new file mode 100644
index 00000000000..c3bd059beeb
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/mym2.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE mym2 ;
+
+FROM cpp IMPORT mytry ;
+FROM libc IMPORT printf, exit ;
+
+PROCEDURE test ;
+VAR
+   r: INTEGER ;
+BEGIN
+   r := printf("start of main Modula-2 program\n") ;
+   mytry ;
+   r := printf("ending (should not get here)\n") ;
+   exit(1);
+EXCEPT
+   r := printf("Modula-2 caught exception correctly\n") ;
+   exit(0);
+END test ;
+
+BEGIN
+   test
+END mym2.
diff --git a/gcc/testsuite/gm2/exceptions/run/pass/mym2a.mod b/gcc/testsuite/gm2/exceptions/run/pass/mym2a.mod
new file mode 100644
index 00000000000..d63f6cb63c4
--- /dev/null
+++ b/gcc/testsuite/gm2/exceptions/run/pass/mym2a.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE mym2a ;
+
+FROM cpp IMPORT mytry ;
+FROM libc IMPORT printf, exit ;
+
+
+VAR
+   r: INTEGER ;
+BEGIN
+   r := printf("start of main Modula-2 program\n") ;
+   mytry ;
+   r := printf("ending (should not get here)\n") ;
+   exit(1);
+EXCEPT
+   r := printf("Modula-2 caught exception correctly\n") ;
+   exit(0);
+END mym2a.
diff --git a/gcc/testsuite/gm2/extensions/pass/align.mod b/gcc/testsuite/gm2/extensions/pass/align.mod
new file mode 100644
index 00000000000..5f922967b93
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/align.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE align ;
+
+TYPE
+   foo = INTEGER <* bytealignment(1024) *> ;
+
+VAR
+   z  : INTEGER ;
+   bar: foo ;
+BEGIN
+
+END align.
diff --git a/gcc/testsuite/gm2/extensions/pass/align2.mod b/gcc/testsuite/gm2/extensions/pass/align2.mod
new file mode 100644
index 00000000000..ddfdee0352d
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/align2.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE align2 ;
+
+VAR
+   x  : CHAR ;
+   z  : ARRAY [0..255] OF INTEGER <* bytealignment(1024) *> ;
+BEGIN
+
+END align2.
diff --git a/gcc/testsuite/gm2/extensions/pass/card16p.mod b/gcc/testsuite/gm2/extensions/pass/card16p.mod
new file mode 100644
index 00000000000..7f352a8cadd
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/card16p.mod
@@ -0,0 +1,101 @@
+MODULE card16p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+   i, j: CARDINAL16;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(CARDINAL16) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(CARDINAL16) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END card16p.
diff --git a/gcc/testsuite/gm2/extensions/pass/card32p.mod b/gcc/testsuite/gm2/extensions/pass/card32p.mod
new file mode 100644
index 00000000000..84eb4471ced
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/card32p.mod
@@ -0,0 +1,110 @@
+MODULE card32p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+
+   c32: CARDINAL32 ;
+   i32: INTEGER32 ;
+   w32: WORD32 ;
+   i, j: CARDINAL32;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   i32 := i ;
+   Assert(i32=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER32") ;
+   c32 := i ;
+   Assert(c32=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL32") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(CARDINAL32) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(CARDINAL32) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END card32p.
diff --git a/gcc/testsuite/gm2/extensions/pass/card64p.mod b/gcc/testsuite/gm2/extensions/pass/card64p.mod
new file mode 100644
index 00000000000..ededa1518c1
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/card64p.mod
@@ -0,0 +1,119 @@
+MODULE card64p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+
+   c32: CARDINAL32 ;
+   i32: INTEGER32 ;
+   w32: WORD32 ;
+
+   c64: CARDINAL64 ;
+   i64: INTEGER64 ;
+   w64: WORD64 ;
+   i, j: CARDINAL64;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   i32 := i ;
+   Assert(i32=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER32") ;
+   c32 := i ;
+   Assert(c32=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL32") ;
+
+   i64 := i ;
+   Assert(i64=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER64") ;
+   c64 := i ;
+   Assert(c64=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL64") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(CARDINAL64) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(CARDINAL64) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END card64p.
diff --git a/gcc/testsuite/gm2/extensions/pass/card8p.mod b/gcc/testsuite/gm2/extensions/pass/card8p.mod
new file mode 100644
index 00000000000..103ae8ca375
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/card8p.mod
@@ -0,0 +1,92 @@
+MODULE card8p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+   i, j: CARDINAL8;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(CARDINAL8) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(CARDINAL8) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END card8p.
diff --git a/gcc/testsuite/gm2/extensions/pass/co.def b/gcc/testsuite/gm2/extensions/pass/co.def
new file mode 100644
index 00000000000..7aa6cf72b7a
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/co.def
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE co ;
+
+IMPORT SYSTEM ;
+EXPORT QUALIFIED NEWCOROUTINE, COROUTINE ;
+
+TYPE
+   PROTECTION = SYSTEM.ADDRESS ;
+   COROUTINE = SYSTEM.ADDRESS ;
+
+PROCEDURE NEWCOROUTINE (procBody: PROC; workspace: SYSTEM.ADDRESS;
+                        size: CARDINAL; VAR cr: COROUTINE;
+                        [initProtection: PROTECTION = NIL]);
+
+END co.
diff --git a/gcc/testsuite/gm2/extensions/pass/co.mod b/gcc/testsuite/gm2/extensions/pass/co.mod
new file mode 100644
index 00000000000..1a008df82a2
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/co.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE co ;
+
+PROCEDURE NEWCOROUTINE (procBody: PROC; workspace: SYSTEM.ADDRESS;
+                        size: CARDINAL; VAR cr: COROUTINE;
+                        [initProtection: PROTECTION]);
+BEGIN
+  
+END NEWCOROUTINE ;
+
+END co.
diff --git a/gcc/testsuite/gm2/extensions/pass/extensions-pass.exp b/gcc/testsuite/gm2/extensions/pass/extensions-pass.exp
new file mode 100644
index 00000000000..21ceee21148
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/extensions-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/extensions/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/extensions/pass/frame.mod b/gcc/testsuite/gm2/extensions/pass/frame.mod
new file mode 100644
index 00000000000..124b8847c11
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/frame.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE frame ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Builtins IMPORT frame_address ;
+
+PROCEDURE foo ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   a := frame_address (0)
+END foo ;
+
+BEGIN
+   foo
+END frame.
diff --git a/gcc/testsuite/gm2/extensions/pass/hello.mod b/gcc/testsuite/gm2/extensions/pass/hello.mod
new file mode 100644
index 00000000000..e6a3dab7224
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/hello.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE hello ;
+
+FROM libc IMPORT write ;
+FROM SYSTEM IMPORT ADR ;
+FROM StrLib IMPORT StrCopy ;
+
+VAR
+   i: INTEGER ;
+   buf: ARRAY [0..12] OF CHAR ;
+BEGIN
+   StrCopy("hello world", buf) ;
+   i := write(1, ADR(buf), 11)
+END hello.
diff --git a/gcc/testsuite/gm2/extensions/pass/int16p.mod b/gcc/testsuite/gm2/extensions/pass/int16p.mod
new file mode 100644
index 00000000000..0f7249fafa5
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/int16p.mod
@@ -0,0 +1,101 @@
+MODULE int16p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+   i, j: INTEGER16;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(INTEGER16) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(INTEGER16) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END int16p.
diff --git a/gcc/testsuite/gm2/extensions/pass/int32p.mod b/gcc/testsuite/gm2/extensions/pass/int32p.mod
new file mode 100644
index 00000000000..4eab85dfeff
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/int32p.mod
@@ -0,0 +1,110 @@
+MODULE int32p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+
+   c32: CARDINAL32 ;
+   i32: INTEGER32 ;
+   w32: WORD32 ;
+   i, j: INTEGER32;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   i32 := i ;
+   Assert(i32=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER32") ;
+   c32 := i ;
+   Assert(c32=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL32") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(INTEGER32) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(INTEGER32) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END int32p.
diff --git a/gcc/testsuite/gm2/extensions/pass/int64p.mod b/gcc/testsuite/gm2/extensions/pass/int64p.mod
new file mode 100644
index 00000000000..4ad29717041
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/int64p.mod
@@ -0,0 +1,119 @@
+MODULE int64p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+
+   c32: CARDINAL32 ;
+   i32: INTEGER32 ;
+   w32: WORD32 ;
+
+   c64: CARDINAL64 ;
+   i64: INTEGER64 ;
+   w64: WORD64 ;
+   i, j: INTEGER64;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   i32 := i ;
+   Assert(i32=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER32") ;
+   c32 := i ;
+   Assert(c32=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL32") ;
+
+   i64 := i ;
+   Assert(i64=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER64") ;
+   c64 := i ;
+   Assert(c64=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL64") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(INTEGER64) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(INTEGER64) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END int64p.
diff --git a/gcc/testsuite/gm2/extensions/pass/int8p.mod b/gcc/testsuite/gm2/extensions/pass/int8p.mod
new file mode 100644
index 00000000000..9e3959e5ebb
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/int8p.mod
@@ -0,0 +1,92 @@
+MODULE int8p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+   i, j: INTEGER8;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(INTEGER8) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(INTEGER8) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END int8p.
diff --git a/gcc/testsuite/gm2/extensions/pass/intsize8.mod b/gcc/testsuite/gm2/extensions/pass/intsize8.mod
new file mode 100644
index 00000000000..25a41e546bf
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/intsize8.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE intsize8 ;
+
+FROM SYSTEM IMPORT INTEGER8 ;
+
+VAR
+   i, j: INTEGER8 ;
+BEGIN
+   i := 123 ;
+   j := 20 ;
+   INC(i, 4) ;
+   DEC(i, j)
+END intsize8.
diff --git a/gcc/testsuite/gm2/extensions/pass/jmp.mod b/gcc/testsuite/gm2/extensions/pass/jmp.mod
new file mode 100644
index 00000000000..b54fbe0864d
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/jmp.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE jmp ;
+
+FROM Builtins IMPORT setjmp, longjmp ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   env: ARRAY [0..10] OF CARDINAL ;
+BEGIN
+   IF setjmp(ADR(env))=0
+   THEN
+   END
+END jmp.
diff --git a/gcc/testsuite/gm2/extensions/pass/libc.def b/gcc/testsuite/gm2/extensions/pass/libc.def
new file mode 100644
index 00000000000..a1a0eb67d3d
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/libc.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+DEFINITION MODULE libc ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT UNQUALIFIED write, exit ;
+
+PROCEDURE write (fd: INTEGER; a: ADDRESS; bytes: CARDINAL) : INTEGER ;
+PROCEDURE exit (e: INTEGER) ;
+
+END libc.
diff --git a/gcc/testsuite/gm2/extensions/pass/optparam.mod b/gcc/testsuite/gm2/extensions/pass/optparam.mod
new file mode 100644
index 00000000000..1b9e7d6bbb1
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/optparam.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE optparam ;
+
+PROCEDURE test (a: CARDINAL; [b: CARDINAL = 2]) ;
+BEGIN
+   
+END test ;
+
+BEGIN
+   test(1)
+END optparam.
diff --git a/gcc/testsuite/gm2/extensions/pass/optparam2.mod b/gcc/testsuite/gm2/extensions/pass/optparam2.mod
new file mode 100644
index 00000000000..73d8518496f
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/optparam2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE optparam2 ;
+
+
+PROCEDURE bar ;
+BEGIN
+END bar ;
+
+PROCEDURE foo ([i: INTEGER = -1]) ;
+BEGIN
+   
+END foo ;
+
+BEGIN
+   foo()
+END optparam2.
diff --git a/gcc/testsuite/gm2/extensions/pass/return.mod b/gcc/testsuite/gm2/extensions/pass/return.mod
new file mode 100644
index 00000000000..e5e244492ea
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/return.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE return ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Builtins IMPORT return_address ;
+
+PROCEDURE foo ;
+VAR
+   a: ADDRESS ;
+BEGIN
+   a := return_address (0)
+END foo ;
+
+BEGIN
+   foo
+END return.
diff --git a/gcc/testsuite/gm2/extensions/pass/set8.mod b/gcc/testsuite/gm2/extensions/pass/set8.mod
new file mode 100644
index 00000000000..746c5afaf31
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/set8.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE set8 ;
+
+FROM SYSTEM IMPORT BITSET8 ;
+
+VAR
+   s8: BITSET8 ;
+BEGIN
+   s8 := BITSET8{}
+END set8.
diff --git a/gcc/testsuite/gm2/extensions/pass/set8a.mod b/gcc/testsuite/gm2/extensions/pass/set8a.mod
new file mode 100644
index 00000000000..3e7d31bd05a
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/set8a.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE set8a ;
+
+FROM libc IMPORT exit ;
+FROM SYSTEM IMPORT BITSET8 ;
+
+VAR
+   s: BITSET8 ;
+BEGIN
+   s := BITSET8{} ;
+   INCL(s, 3) ;
+   IF s#BITSET8{3}
+   THEN
+      exit(1)
+   END
+END set8a.
diff --git a/gcc/testsuite/gm2/extensions/pass/set8b.mod b/gcc/testsuite/gm2/extensions/pass/set8b.mod
new file mode 100644
index 00000000000..5863cee5861
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/set8b.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE set8b ;
+
+FROM SYSTEM IMPORT BITSET8, BYTE ;
+FROM libc IMPORT exit ;
+
+VAR
+   b: BYTE ;
+   s: BITSET8 ;
+BEGIN
+   b := 127 ;
+   s := b ;
+   IF s#BITSET8{0,1,2,3,4,5,6}
+   THEN
+      exit(1)
+   END
+END set8b.
diff --git a/gcc/testsuite/gm2/extensions/pass/testco.mod b/gcc/testsuite/gm2/extensions/pass/testco.mod
new file mode 100644
index 00000000000..9cc179d4bcd
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/pass/testco.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testco ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM co IMPORT NEWCOROUTINE, COROUTINE ;
+
+PROCEDURE test ;
+BEGIN
+   LOOP END
+END test ;
+
+VAR
+   c: COROUTINE ;
+BEGIN
+   NEWCOROUTINE(test, NIL, 20000, c) ;
+   (* this makes no sense to run, but it is legal *)
+END testco.
diff --git a/gcc/testsuite/gm2/extensions/run/fail/extensions-run-fail.exp b/gcc/testsuite/gm2/extensions/run/fail/extensions-run-fail.exp
new file mode 100644
index 00000000000..ede8efb40a7
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/fail/extensions-run-fail.exp
@@ -0,0 +1,39 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/extensions/run/fail" -fsoft-check-all -fno-m2-plugin
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "fail"
+}
diff --git a/gcc/testsuite/gm2/extensions/run/fail/intsize8.mod b/gcc/testsuite/gm2/extensions/run/fail/intsize8.mod
new file mode 100644
index 00000000000..37722fea6e6
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/fail/intsize8.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE intsize8 ;
+
+FROM SYSTEM IMPORT INTEGER8 ;
+
+VAR
+   i, j: INTEGER8 ;
+BEGIN
+   i := 123 ;
+   j := 20 ;
+   INC(i, 5)
+END intsize8.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/align3.mod b/gcc/testsuite/gm2/extensions/run/pass/align3.mod
new file mode 100644
index 00000000000..2fb285257d0
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/align3.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE align3 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+
+VAR
+   x  : CHAR ;
+   z  : ARRAY [0..255] OF INTEGER <* bytealignment(1024) *> ;
+BEGIN
+   IF ADR(z) MOD 1024 = ADDRESS (0)
+   THEN
+      IF ADR(z[1]) MOD 1024 # ADDRESS (0)
+      THEN
+         exit(0)
+      ELSE
+         exit(2)
+      END
+   ELSE
+      exit(1)
+   END
+END align3.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/align4.mod b/gcc/testsuite/gm2/extensions/run/pass/align4.mod
new file mode 100644
index 00000000000..56fbaaff895
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/align4.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE align4 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+
+VAR
+   x  : CHAR ;
+   z  : POINTER TO INTEGER <* bytealignment(1024) *> ;
+BEGIN
+   IF ADR(z) MOD 1024 = ADDRESS (0)
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END align4.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/align5.mod b/gcc/testsuite/gm2/extensions/run/pass/align5.mod
new file mode 100644
index 00000000000..a02a1e4efdc
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/align5.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE align5 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+
+TYPE
+   rec = RECORD
+            x: CHAR ;
+            y: CHAR <* bytealignment(1024) *> ;
+         END ;
+VAR
+   r: rec ;
+BEGIN
+   IF ADR(r.y) MOD 1024 = ADDRESS (0)
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END align5.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/align6.mod b/gcc/testsuite/gm2/extensions/run/pass/align6.mod
new file mode 100644
index 00000000000..4fa4223cb66
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/align6.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE align6 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+
+VAR
+   x: CHAR ;
+   y: CHAR  <* bytealignment(1024) *> ;
+BEGIN
+   IF ADR(y) MOD 1024 = ADDRESS(0)
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END align6.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/align7.mod b/gcc/testsuite/gm2/extensions/run/pass/align7.mod
new file mode 100644
index 00000000000..8aec3d09e4e
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/align7.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE align7 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+
+TYPE
+   foo = ARRAY [0..255] OF INTEGER <* bytealignment(1024) *> ;
+
+VAR
+   x  : CHAR ;
+   z  : foo ;
+BEGIN
+   IF ADR(z) MOD 1024 = ADDRESS(0)
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END align7.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/callingc.mod b/gcc/testsuite/gm2/extensions/run/pass/callingc.mod
new file mode 100644
index 00000000000..8f9f35e8e67
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/callingc.mod
@@ -0,0 +1,21 @@
+MODULE callingc ;
+
+FROM libc IMPORT printf, exit ;
+FROM StrLib IMPORT StrLen ;
+
+VAR
+   a: ARRAY [0..1] OF CHAR ;
+BEGIN
+   printf ("\n") ;
+   IF StrLen ("\n") # 2
+   THEN
+      printf ("yes the conversion of the string into printf has corrupted the literal version as well!\n") ;
+      exit (1)
+   END ;
+   a := "\n" ;
+   IF StrLen (a) # 2
+   THEN
+      printf ("yes the conversion of the string into printf has corrupted the array version as well!\n") ;
+      exit (2)
+   END
+END callingc.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/card16p.mod b/gcc/testsuite/gm2/extensions/run/pass/card16p.mod
new file mode 100644
index 00000000000..e679bfd5600
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/card16p.mod
@@ -0,0 +1,101 @@
+MODULE card16p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+   i, j: CARDINAL16;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(CARDINAL16) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i16 := 0 ;
+   j := 1 ;
+   DEC(i16) ;
+   Assert(i16=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i16, j) ;
+   Assert(i16=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i16) ;
+   Assert(i16=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i16, j) ;
+   Assert(i16=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(CARDINAL16) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END card16p.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/card32p.mod b/gcc/testsuite/gm2/extensions/run/pass/card32p.mod
new file mode 100644
index 00000000000..fd1e18f97f7
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/card32p.mod
@@ -0,0 +1,110 @@
+MODULE card32p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+
+   c32: CARDINAL32 ;
+   i32: INTEGER32 ;
+   w32: WORD32 ;
+   i, j: CARDINAL32;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   i32 := i ;
+   Assert(i32=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER32") ;
+   c32 := i ;
+   Assert(c32=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL32") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(CARDINAL32) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i32 := 0 ;
+   j := 1 ;
+   DEC(i32) ;
+   Assert(i32=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i32, j) ;
+   Assert(i32=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i32) ;
+   Assert(i32=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i32, j) ;
+   Assert(i32=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(CARDINAL32) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END card32p.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/card64p.mod b/gcc/testsuite/gm2/extensions/run/pass/card64p.mod
new file mode 100644
index 00000000000..5c4d81363a2
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/card64p.mod
@@ -0,0 +1,119 @@
+MODULE card64p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+
+   c32: CARDINAL32 ;
+   i32: INTEGER32 ;
+   w32: WORD32 ;
+
+   c64: CARDINAL64 ;
+   i64: INTEGER64 ;
+   w64: WORD64 ;
+   i, j: CARDINAL64;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   i32 := i ;
+   Assert(i32=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER32") ;
+   c32 := i ;
+   Assert(c32=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL32") ;
+
+   i64 := i ;
+   Assert(i64=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER64") ;
+   c64 := i ;
+   Assert(c64=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL64") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(CARDINAL64) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i64 := 0 ;
+   j := 1 ;
+   DEC(i64) ;
+   Assert(i64=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i64, j) ;
+   Assert(i64=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i64) ;
+   Assert(i64=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i64, j) ;
+   Assert(i64=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(CARDINAL64) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END card64p.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/card8p.mod b/gcc/testsuite/gm2/extensions/run/pass/card8p.mod
new file mode 100644
index 00000000000..2366a49dec4
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/card8p.mod
@@ -0,0 +1,92 @@
+MODULE card8p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+   i, j: CARDINAL8;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(CARDINAL8) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i8 := 0 ;
+   j := 1 ;
+   DEC(i8) ;
+   Assert(i8=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i8, j) ;
+   Assert(i8=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i8) ;
+   Assert(i8=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i8, j) ;
+   Assert(i8=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(CARDINAL8) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END card8p.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/column.mod b/gcc/testsuite/gm2/extensions/run/pass/column.mod
new file mode 100644
index 00000000000..ba82fd7b774
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/column.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE column ;
+
+FROM libc IMPORT exit ;
+
+BEGIN
+   IF __COLUMN__#7
+   THEN
+      exit(1)
+   END ;
+   IF TRUE
+   THEN
+      IF __COLUMN__#10
+      THEN
+         exit(2)
+      END
+   END ;
+   IF
+   __COLUMN__#4
+   THEN
+      exit(3)
+   END
+END column.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/cvararg.c b/gcc/testsuite/gm2/extensions/run/pass/cvararg.c
new file mode 100644
index 00000000000..404c7d7ed7d
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/cvararg.c
@@ -0,0 +1,60 @@
+#include <stdio.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <string.h>
+
+
+int func (int code, ...)
+{
+  va_list argsPtr;
+  int i, v;
+
+  va_start(argsPtr, code);
+  for (i=1; i<=code; i++) {
+    v = va_arg(argsPtr, int);
+    printf("%d parameter is %d\n", i, v);
+    if (i != v)
+      exit(1);
+  }
+  va_end(argsPtr);
+  return 1;
+}
+
+
+int funcptr (int code, ...)
+{
+  va_list argsPtr;
+  int l, v;
+  char *p;
+
+  va_start(argsPtr, code);
+  switch (code) {
+
+  case 1:   
+    p = va_arg(argsPtr, char *);
+    l = va_arg(argsPtr, int);
+    printf("parameter is %s and length %d\n", p, l);
+    if (strlen(p) != l)
+      exit(1);
+    break;
+  }
+  va_end(argsPtr);
+  return 1;
+}
+
+
+int funcptrint (char *p, ...)
+{
+  va_list argsPtr;
+  int l, v;
+
+  va_start(argsPtr, p);
+
+  l = va_arg(argsPtr, int);
+  printf("parameter is %s and length %d\n", p, l);
+  if (strlen(p) != l)
+    exit(1);
+
+  va_end(argsPtr);
+  return 1;
+}
diff --git a/gcc/testsuite/gm2/extensions/run/pass/cvararg.def b/gcc/testsuite/gm2/extensions/run/pass/cvararg.def
new file mode 100644
index 00000000000..7bd582fe5f5
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/cvararg.def
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+DEFINITION MODULE FOR "C" cvararg ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+EXPORT UNQUALIFIED func, funcptr, funcptrint ;
+
+PROCEDURE func (c: INTEGER; ...) : INTEGER ;
+PROCEDURE funcptr (c: INTEGER; ...) : INTEGER ;
+PROCEDURE funcptrint (p: ADDRESS; ...) : INTEGER ;
+
+END cvararg.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/extensions-run-pass.exp b/gcc/testsuite/gm2/extensions/run/pass/extensions-run-pass.exp
new file mode 100644
index 00000000000..24e8f3ea45f
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/extensions-run-pass.exp
@@ -0,0 +1,42 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/extensions/run/pass" -fsoft-check-all
+gm2_link_obj "cvararg.o"
+
+set output [target_compile $srcdir/$subdir/cvararg.c cvararg.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/extensions/run/pass/int16p.mod b/gcc/testsuite/gm2/extensions/run/pass/int16p.mod
new file mode 100644
index 00000000000..0f7249fafa5
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/int16p.mod
@@ -0,0 +1,101 @@
+MODULE int16p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+   i, j: INTEGER16;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(INTEGER16) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(INTEGER16) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END int16p.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/int32p.mod b/gcc/testsuite/gm2/extensions/run/pass/int32p.mod
new file mode 100644
index 00000000000..4eab85dfeff
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/int32p.mod
@@ -0,0 +1,110 @@
+MODULE int32p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+
+   c32: CARDINAL32 ;
+   i32: INTEGER32 ;
+   w32: WORD32 ;
+   i, j: INTEGER32;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   i32 := i ;
+   Assert(i32=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER32") ;
+   c32 := i ;
+   Assert(c32=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL32") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(INTEGER32) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(INTEGER32) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END int32p.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/int64p.mod b/gcc/testsuite/gm2/extensions/run/pass/int64p.mod
new file mode 100644
index 00000000000..4ad29717041
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/int64p.mod
@@ -0,0 +1,119 @@
+MODULE int64p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+
+   c16: CARDINAL16 ;
+   i16: INTEGER16 ;
+   w16: WORD16 ;
+
+   c32: CARDINAL32 ;
+   i32: INTEGER32 ;
+   w32: WORD32 ;
+
+   c64: CARDINAL64 ;
+   i64: INTEGER64 ;
+   w64: WORD64 ;
+   i, j: INTEGER64;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   i16 := i ;
+   Assert(i16=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER16") ;
+   c16 := i ;
+   Assert(c16=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL16") ;
+
+   i32 := i ;
+   Assert(i32=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER32") ;
+   c32 := i ;
+   Assert(c32=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL32") ;
+
+   i64 := i ;
+   Assert(i64=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER64") ;
+   c64 := i ;
+   Assert(c64=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL64") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(INTEGER64) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(INTEGER64) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END int64p.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/int8field.mod b/gcc/testsuite/gm2/extensions/run/pass/int8field.mod
new file mode 100644
index 00000000000..904e2e300f4
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/int8field.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE int8field ;
+
+IMPORT SYSTEM ;
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+
+PROCEDURE assert (a, b: CARDINAL) ;
+BEGIN
+   WriteCard(a, 1) ; WriteLn ;
+   IF a#b
+   THEN
+      exit(1)
+   END
+END assert ;
+
+TYPE
+   Version = RECORD
+                major : SYSTEM.CARDINAL8;
+                minor : SYSTEM.CARDINAL8;
+                path  : SYSTEM.CARDINAL8;
+             END ;
+
+VAR
+   v: Version ;
+BEGIN
+   v.major := 1 ;
+   v.minor := 2 ;
+   v.path  := 3 ;
+   assert(v.major, 1) ;
+   assert(v.minor, 2) ;
+   assert(v.path, 3)
+END int8field.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/int8p.mod b/gcc/testsuite/gm2/extensions/run/pass/int8p.mod
new file mode 100644
index 00000000000..9e3959e5ebb
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/int8p.mod
@@ -0,0 +1,92 @@
+MODULE int8p ; 
+
+
+FROM libc IMPORT exit, write ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR,
+                   INTEGER8, INTEGER16, INTEGER32, INTEGER64,
+                   CARDINAL8, CARDINAL16, CARDINAL32, CARDINAL64,
+                   BYTE, WORD16, WORD32, WORD64 ;
+FROM M2RTS IMPORT Length ;
+FROM NumberIO IMPORT CardToStr ;
+
+   
+PROCEDURE Assert (c: BOOLEAN; line: CARDINAL; column: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   IF NOT c
+   THEN
+      r := write(2, ADR(__FILE__), Length(__FILE__)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(line, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      CardToStr(column, 0, a) ;
+      r := write(2, ADR(a), Length(a)) ;
+      r := write(2, ADR(": "), Length(":")) ;
+      r := write(2, ADR(message), Length(message)) ;
+      a[0] := nl ;
+      a[1] := nul ;
+      r := write(2, ADR(a), Length(a)) ;
+      e := 1
+   END
+END Assert ;
+
+VAR
+   e  : INTEGER ;
+   z: (zero, one, two) ;
+
+   c8 : CARDINAL8 ;
+   w8 : BYTE ;
+   i8 : INTEGER8 ;
+   i, j: INTEGER8;
+BEGIN
+   e := 0 ;
+
+   i := 0 ;
+   INC(i) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   i8 := i ;
+   Assert(i8=1, __LINE__, __COLUMN__, "assignment failed to propagate via INTEGER8") ;
+   c8 := i ;
+   Assert(c8=1, __LINE__, __COLUMN__, "assignment failed to propagate via CARDINAL8") ;
+
+   DEC(i) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   j := 1 ;
+   INC(i, j) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   INC(i, one) ;
+   Assert(i=1, __LINE__, __COLUMN__, "INC failed to generate value of 1") ;
+   DEC(i, one) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MAX(INTEGER8) ;
+   j := i ;
+   DEC(i) ;
+   Assert(i=j-1, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-1") ;
+   DEC(i, 1) ;
+   Assert(i=j-2, __LINE__, __COLUMN__, "DEC failed to generate value of MAX(dataType)-2") ;
+
+   i := 0 ;
+   j := 1 ;
+   DEC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   DEC(i, j) ;
+   Assert(i=-2, __LINE__, __COLUMN__, "DEC failed to generate value of -2") ;
+   INC(i) ;
+   Assert(i=-1, __LINE__, __COLUMN__, "DEC failed to generate value of -1") ;
+   INC(i, j) ;
+   Assert(i=0, __LINE__, __COLUMN__, "DEC failed to generate value of 0") ;
+   i := MIN(INTEGER8) ;
+   j := i ;
+   INC(i) ;
+   Assert(i=j+1, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+1") ;
+   INC(i, 1) ;
+   Assert(i=j+2, __LINE__, __COLUMN__, "DEC failed to generate value of MIN(dataType)+2") ;
+   exit(e) ;
+END int8p.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/packedrecord.mod b/gcc/testsuite/gm2/extensions/run/pass/packedrecord.mod
new file mode 100644
index 00000000000..6aecbe9df84
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/packedrecord.mod
@@ -0,0 +1,56 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE packedrecord ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT SIZE, BYTE ;
+
+
+TYPE
+   Colour     = (white, black) ;
+   HeapOpcode = (move, take, begin, end, add, del) ;
+   PieceNo    = [0..15] ;
+
+   Instruction = RECORD
+                    <* bytealignment(0) *>
+                    o: HeapOpcode ;  (* 3 bits *)
+                    c: Colour ;      (* 1 bit  *)
+                    n: PieceNo ;     (* 4 bits *)
+                 END ;
+
+(*
+   assert - 
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf ("assert failed\n");
+      exit (1)
+   END
+END assert ;
+
+
+VAR
+   i: Instruction ;
+BEGIN
+   printf ("size of 'i' is %d byte(s)\n", SIZE (i)) ;
+   assert (SIZE (i) = SIZE (BYTE))
+END packedrecord.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/packedrecord2.mod b/gcc/testsuite/gm2/extensions/run/pass/packedrecord2.mod
new file mode 100644
index 00000000000..9d1c2b1b2eb
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/packedrecord2.mod
@@ -0,0 +1,57 @@
+(* Copyright (C) 2015, 2016, 2017
+   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. *)
+
+MODULE packedrecord2 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT SIZE, BYTE ;
+
+
+TYPE
+   Colour     = (white, black) ;
+   HeapOpcode = (move, take, begin, end, add, del) ;
+   PieceNo    = [0..15] ;
+
+   Instruction = RECORD
+                    <* bytealignment(0) *>
+                    o: [move..del] ;     (* 3 bits *)
+                    c: [white..black] ;  (* 1 bit *)
+                    n: PieceNo ;         (* 4 bits *)
+                 END ;
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf ("assert failed\n");
+      exit (1)
+   END
+END assert ;
+
+
+VAR
+   i: Instruction ;
+BEGIN
+   printf ("size of 'i' is %d byte(s)\n", SIZE (i)) ;
+   assert (SIZE (i) = SIZE (BYTE))
+END packedrecord2.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/real32.mod b/gcc/testsuite/gm2/extensions/run/pass/real32.mod
new file mode 100644
index 00000000000..0b347b5b95f
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/real32.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE real32 ;
+
+FROM SYSTEM IMPORT REAL32 ;
+FROM libc IMPORT exit ;
+FROM StringConvert IMPORT LongrealToString ;
+FROM DynamicStrings IMPORT String, EqualArray, Slice ;
+
+VAR
+   lr : LONGREAL ;
+   r32: REAL32 ;
+   s  : String ;
+BEGIN
+   r32 := 3.1415927 ;
+   lr := r32 ;
+   s := LongrealToString(lr, 9, 8) ;
+   IF NOT EqualArray(Slice(s, 0, 9), '3.1415927')
+   THEN
+      exit(1)
+   END
+END real32.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/real32a.mod b/gcc/testsuite/gm2/extensions/run/pass/real32a.mod
new file mode 100644
index 00000000000..8cbd29263e8
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/real32a.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE real32a ;
+
+FROM SYSTEM IMPORT REAL32 ;
+FROM libc IMPORT exit ;
+
+VAR
+   lv,
+   lr : LONGREAL ;
+   r32: REAL32 ;
+BEGIN
+   r32 := 3.1415927 ;
+   lr := r32 ;
+   lv := VAL(LONGREAL, r32) ;
+   IF lr#lv
+   THEN
+      exit(1)
+   END
+END real32a.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/record.mod b/gcc/testsuite/gm2/extensions/run/pass/record.mod
new file mode 100644
index 00000000000..7412075709b
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/record.mod
@@ -0,0 +1,25 @@
+MODULE record ;
+
+FROM SYSTEM IMPORT CARDINAL16;
+FROM libc IMPORT exit ;
+
+TYPE
+  InOut = RECORD
+             in  : CARDINAL16;
+             in2 : CARDINAL16; (* remove this and it works?! *)
+             out : CARDINAL;
+          END ;
+
+VAR
+   io : InOut;
+BEGIN
+   io.in:=1718;
+   io.in2:=198; (* or set in2 to 0 and it works *)
+
+   io.out:=io.in;
+   io.in2:=io.in;
+   IF io.in2 # io.in
+   THEN
+      exit(1)
+   END
+END record.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/testopen.mod b/gcc/testsuite/gm2/extensions/run/pass/testopen.mod
new file mode 100644
index 00000000000..a36d2e0eae1
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/testopen.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testopen ;
+
+FROM libc IMPORT open ;
+FROM SYSTEM IMPORT ADR ;
+
+PROCEDURE foo ;
+VAR
+   fd: INTEGER ;
+BEGIN
+   fd := open(ADR("/dev/tty"), 0)
+END foo ;
+
+BEGIN
+   foo
+END testopen.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/vararg.mod b/gcc/testsuite/gm2/extensions/run/pass/vararg.mod
new file mode 100644
index 00000000000..bbc9856c1bc
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/vararg.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE vararg ;
+
+FROM cvararg IMPORT func ;
+
+BEGIN
+   IF func(1, INTEGER(1))=1
+   THEN
+   END ;
+   IF func(2, INTEGER(1), INTEGER(2))=1
+   THEN
+   END ;
+   IF func(3, INTEGER(1), INTEGER(2), INTEGER(3))=1
+   THEN
+   END ;
+   IF func(4, INTEGER(1), INTEGER(2), INTEGER(3), INTEGER(4))=1
+   THEN
+   END ;
+   IF func(5, INTEGER(1), INTEGER(2), INTEGER(3), INTEGER(4), INTEGER(5))=1
+   THEN
+   END
+END vararg.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/vararg2.mod b/gcc/testsuite/gm2/extensions/run/pass/vararg2.mod
new file mode 100644
index 00000000000..e26ed096fb8
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/vararg2.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE vararg2 ;
+
+FROM cvararg IMPORT funcptr ;
+FROM SYSTEM IMPORT ADR ;
+
+BEGIN
+   IF funcptr(1, ADR("hello world"), 11)=1
+   THEN
+   END ;
+   IF funcptr(1, ADR("hello"), 5)=1
+   THEN
+   END ;
+   IF funcptr(1, ADR("/etc/passwd"), 11)=1
+   THEN
+   END
+END vararg2.
diff --git a/gcc/testsuite/gm2/extensions/run/pass/vararg3.mod b/gcc/testsuite/gm2/extensions/run/pass/vararg3.mod
new file mode 100644
index 00000000000..14ba9515f7b
--- /dev/null
+++ b/gcc/testsuite/gm2/extensions/run/pass/vararg3.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE vararg3 ;
+
+FROM cvararg IMPORT funcptrint ;
+FROM SYSTEM IMPORT ADR ;
+
+BEGIN
+   IF funcptrint(ADR("hello world"), INTEGER(11))=1
+   THEN
+   END
+END vararg3.
diff --git a/gcc/testsuite/gm2/fpu/pass/five.mod b/gcc/testsuite/gm2/fpu/pass/five.mod
new file mode 100644
index 00000000000..ee6a25e687d
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/five.mod
@@ -0,0 +1,28 @@
+(* five.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE five ;
+
+VAR
+   a: REAL ;
+BEGIN
+   a := -1.5
+END five.
diff --git a/gcc/testsuite/gm2/fpu/pass/fp.def b/gcc/testsuite/gm2/fpu/pass/fp.def
new file mode 100644
index 00000000000..af423e5ae7c
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/fp.def
@@ -0,0 +1,29 @@
+(* fp.def basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+DEFINITION MODULE fp ;
+
+EXPORT QUALIFIED pi ;
+
+CONST
+   pi = 3.1416 ;
+
+END fp.
diff --git a/gcc/testsuite/gm2/fpu/pass/fp.mod b/gcc/testsuite/gm2/fpu/pass/fp.mod
new file mode 100644
index 00000000000..3f1e2cbf252
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/fp.mod
@@ -0,0 +1,24 @@
+(* fp.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+IMPLEMENTATION MODULE fp ;
+
+END fp.
diff --git a/gcc/testsuite/gm2/fpu/pass/fpu-pass.exp b/gcc/testsuite/gm2/fpu/pass/fpu-pass.exp
new file mode 100644
index 00000000000..811492234f9
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/fpu-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_log "${srcdir}/gm2/fpu/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/fpu/pass/one.mod b/gcc/testsuite/gm2/fpu/pass/one.mod
new file mode 100644
index 00000000000..087366828bd
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/one.mod
@@ -0,0 +1,28 @@
+(* one.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE one ;
+
+VAR
+   r: REAL ;
+BEGIN
+   r := 1.0
+END one.
diff --git a/gcc/testsuite/gm2/fpu/pass/r1.mod b/gcc/testsuite/gm2/fpu/pass/r1.mod
new file mode 100644
index 00000000000..5994934fb92
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/r1.mod
@@ -0,0 +1,30 @@
+(* r1.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE r1 ;
+
+VAR
+   l: LONGINT ;
+   r: LONGREAL ;
+BEGIN
+   l := 1000000000 ;
+   r := VAL (LONGREAL, l)
+END r1.
diff --git a/gcc/testsuite/gm2/fpu/pass/realconst.mod b/gcc/testsuite/gm2/fpu/pass/realconst.mod
new file mode 100644
index 00000000000..407dc05fc56
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/realconst.mod
@@ -0,0 +1,49 @@
+(* realconst.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE realconst ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM MathLib0 IMPORT pi ;
+FROM FpuIO IMPORT WriteReal, ReadReal ;
+
+VAR
+   Degrees, Radians: REAL ;
+
+
+PROCEDURE ConvertAngle (angle:REAL): REAL ;
+VAR
+   ConversionFactor: REAL ;
+BEGIN
+   ConversionFactor:= pi / 180.0 ;
+   WriteString ('Conversion factor ') ;
+   WriteReal (ConversionFactor, 20, 15 ) ;
+   WriteLn ;
+   RETURN ConversionFactor * angle
+END ConvertAngle;
+
+BEGIN
+   WriteString ("Enter an angle in degrees:  ") ;
+   ReadReal (Degrees) ; WriteLn ;
+   Radians := ConvertAngle (Degrees) ;
+   WriteString ("The angle in radians is:  ") ;
+   WriteReal (Radians, 20, 5) ; WriteLn ;
+END realconst.
diff --git a/gcc/testsuite/gm2/fpu/pass/testfp.mod b/gcc/testsuite/gm2/fpu/pass/testfp.mod
new file mode 100644
index 00000000000..7c4cc68252a
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/testfp.mod
@@ -0,0 +1,35 @@
+(* testfp.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE testfp ;
+
+FROM Builtins IMPORT atan2, sin ;
+FROM FpuIO IMPORT WriteLongReal ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+VAR
+   x: LONGREAL ;
+BEGIN
+   x := atan2 (0.4, 1.0) ;
+   WriteLongReal (x, 20, 10) ; WriteLn ;
+   x := sin (0.4) ;
+   WriteLongReal (x, 20, 10) ; WriteLn
+END testfp.
diff --git a/gcc/testsuite/gm2/fpu/pass/testfp2.mod b/gcc/testsuite/gm2/fpu/pass/testfp2.mod
new file mode 100644
index 00000000000..bd7d6a1c3fe
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/testfp2.mod
@@ -0,0 +1,42 @@
+(* testfp2.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE testfp2 ;
+
+IMPORT fp ;
+
+
+PROCEDURE foo (x: REAL) : REAL ;
+BEGIN
+   WHILE x>fp.pi DO
+      x := x - 2.0*fp.pi
+   END ;
+   WHILE x>fp.pi DO
+      x := x + 2.0*fp.pi
+   END ;
+   RETURN( x )
+END foo ;
+
+VAR
+   y: REAL ;
+BEGIN
+   y := foo(7.0)
+END testfp2.
diff --git a/gcc/testsuite/gm2/fpu/pass/testfpu1.mod b/gcc/testsuite/gm2/fpu/pass/testfpu1.mod
new file mode 100644
index 00000000000..0e1ae88e040
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/testfpu1.mod
@@ -0,0 +1,32 @@
+(* testfpu1.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE testfpu1 ;
+
+FROM MathLib0 IMPORT pi ;
+FROM FpuIO IMPORT WriteReal, WriteLongReal ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+BEGIN
+   WriteString('the LONGREAL value of pi = ') ; WriteLongReal(pi, 70, 68) ; WriteLn ;
+   WriteString('the REAL     value of pi = ') ; WriteReal(pi, 70, 68) ; WriteLn
+END testfpu1.
diff --git a/gcc/testsuite/gm2/fpu/pass/testfpu2.mod b/gcc/testsuite/gm2/fpu/pass/testfpu2.mod
new file mode 100644
index 00000000000..0c8f774d5aa
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/testfpu2.mod
@@ -0,0 +1,28 @@
+(* testfpu2.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE testfpu2 ;
+
+VAR
+   r: REAL ;
+BEGIN
+   r := 2.3
+END testfpu2.
diff --git a/gcc/testsuite/gm2/fpu/pass/testfpu3.mod b/gcc/testsuite/gm2/fpu/pass/testfpu3.mod
new file mode 100644
index 00000000000..cda9ddc96ce
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/testfpu3.mod
@@ -0,0 +1,46 @@
+(* testfpu3.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE testfpu3 ;
+
+TYPE
+   Stack = RECORD
+              Left, Right: REAL ;
+           END ;
+
+VAR
+   Stacked: ARRAY [0..10] OF Stack ;
+   i      : CARDINAL ;
+BEGIN
+   FOR i := 0 TO 10 DO
+      WITH Stacked[i] DO
+         Left  := FLOAT(i) ;
+         Right := 10.0
+      END
+   END ;
+   FOR i := 0 TO 10 DO
+      WITH Stacked[i] DO
+         Left := Right * Left
+      END
+   END ;
+   LOOP
+   END
+END testfpu3.
diff --git a/gcc/testsuite/gm2/fpu/pass/testsin.mod b/gcc/testsuite/gm2/fpu/pass/testsin.mod
new file mode 100644
index 00000000000..1341c9ca820
--- /dev/null
+++ b/gcc/testsuite/gm2/fpu/pass/testsin.mod
@@ -0,0 +1,39 @@
+(* testsin.mod basic floating point test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE testsin ;
+
+FROM MathLib0 IMPORT pi, sin, cos ;
+FROM FpuIO IMPORT WriteReal, WriteLongReal ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+VAR
+   c,
+   b,
+   a: LONGREAL ;
+BEGIN
+   c := pi ;
+   a := sin(pi/3.0) ;
+   b := cos(pi/3.0) ;
+   WriteLongReal(a, 70, 68) ; WriteLn ;
+   WriteLongReal(b, 70, 68) ; WriteLn ;
+END testsin.
diff --git a/gcc/testsuite/gm2/imports/run/pass/c.def b/gcc/testsuite/gm2/imports/run/pass/c.def
new file mode 100644
index 00000000000..b060d76f324
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/c.def
@@ -0,0 +1,35 @@
+(* Copyright (C) 2011 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. *)
+
+DEFINITION MODULE c ;
+
+(*
+    Title      : c
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Aug 29 10:35:38 2014
+    Revision   : $Version$ 
+    Description: 
+*)
+
+EXPORT QUALIFIED z ;
+
+CONST
+   z = 1 ;
+
+END c.
diff --git a/gcc/testsuite/gm2/imports/run/pass/c.mod b/gcc/testsuite/gm2/imports/run/pass/c.mod
new file mode 100644
index 00000000000..3b423ffc3cd
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/c.mod
@@ -0,0 +1,21 @@
+(* Copyright (C) 2011 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. *)
+
+IMPLEMENTATION MODULE c ;
+
+END c.
diff --git a/gcc/testsuite/gm2/imports/run/pass/imports-run-pass.exp b/gcc/testsuite/gm2/imports/run/pass/imports-run-pass.exp
new file mode 100644
index 00000000000..f47d4fa82d9
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/imports-run-pass.exp
@@ -0,0 +1,44 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/imports/run/pass"
+gm2_link_obj "c.o"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    set output [gm2_target_compile ${srcdir}/${subdir}/c.mod c.o object "-g -I${gccpath}/libgm2/libpim:${gm2src}/gm2-libs:${srcdir}/${subdir} -fpim"]
+
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    if { $testcase ne "$srcdir/$subdir/c.mod" } {
+	gm2-torture-execute $testcase "" "pass"
+    }
+}
diff --git a/gcc/testsuite/gm2/imports/run/pass/innermods.mod b/gcc/testsuite/gm2/imports/run/pass/innermods.mod
new file mode 100644
index 00000000000..614afc6e3c6
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/innermods.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2014 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. *)
+
+MODULE innermods ;
+
+  MODULE a ;
+  EXPORT x ;
+
+  PROCEDURE x ;
+  BEGIN
+  END x ;
+
+  END a ;
+
+  MODULE b ;
+
+  FROM a IMPORT x ;
+  EXPORT y ;
+
+  PROCEDURE y ;
+  BEGIN
+     x
+  END y ;
+  
+  END b;
+
+BEGIN
+   y
+END innermods.
diff --git a/gcc/testsuite/gm2/imports/run/pass/innermods2.mod b/gcc/testsuite/gm2/imports/run/pass/innermods2.mod
new file mode 100644
index 00000000000..69174c89ac1
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/innermods2.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2014 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. *)
+
+MODULE innermods2 ;
+
+  MODULE a ;
+  EXPORT x ;
+
+  PROCEDURE x ;
+  BEGIN
+  END x ;
+
+  END a ;
+
+  MODULE b ;
+
+  FROM a IMPORT x ;
+  FROM c IMPORT z ;
+  EXPORT y ;
+
+  PROCEDURE y ;
+  BEGIN
+     x
+  END y ;
+  
+  END b;
+
+BEGIN
+   y
+END innermods2.
diff --git a/gcc/testsuite/gm2/imports/run/pass/innermods3.mod b/gcc/testsuite/gm2/imports/run/pass/innermods3.mod
new file mode 100644
index 00000000000..f926dc4dacf
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/innermods3.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2014 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. *)
+
+MODULE innermods3 ;
+
+  MODULE a ;
+  EXPORT x ;
+
+  PROCEDURE x ;
+  BEGIN
+  END x ;
+
+  END a ;
+
+  MODULE b ;
+
+  IMPORT x ;
+  EXPORT y ;
+
+    MODULE d ;
+
+    FROM c IMPORT z ;
+
+    END d ;
+
+  PROCEDURE y ;
+  BEGIN
+     x
+  END y ;
+  
+  END b;
+
+BEGIN
+   y
+END innermods3.
diff --git a/gcc/testsuite/gm2/imports/run/pass/innermods4.mod b/gcc/testsuite/gm2/imports/run/pass/innermods4.mod
new file mode 100644
index 00000000000..4032141297e
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/innermods4.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2014 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. *)
+
+MODULE innermods4 ;
+
+  MODULE b ;
+
+  FROM a IMPORT x ;
+  EXPORT y ;
+
+  PROCEDURE y ;
+  BEGIN
+     x
+  END y ;
+  
+  END b;
+
+  MODULE a ;
+  EXPORT x ;
+
+  PROCEDURE x ;
+  BEGIN
+  END x ;
+
+  END a ;
+
+BEGIN
+   y
+END innermods4.
diff --git a/gcc/testsuite/gm2/imports/run/pass/innermods5.def b/gcc/testsuite/gm2/imports/run/pass/innermods5.def
new file mode 100644
index 00000000000..35094c71c0e
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/innermods5.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2011 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. *)
+
+DEFINITION MODULE innermods5 ;
+
+EXPORT QUALIFIED sin ;
+
+PROCEDURE sin (x: REAL) : REAL ;
+
+END innermods5.
diff --git a/gcc/testsuite/gm2/imports/run/pass/innermods5.mod b/gcc/testsuite/gm2/imports/run/pass/innermods5.mod
new file mode 100644
index 00000000000..a070c8c69c5
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/innermods5.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2014 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. *)
+
+IMPLEMENTATION MODULE innermods5 ;
+
+   MODULE inner ;
+
+   EXPORT sin ;
+
+   PROCEDURE sin (x: REAL) : REAL ;
+   BEGIN
+      RETURN 1.0
+   END sin ;
+   
+   END inner ;
+
+END innermods5.
diff --git a/gcc/testsuite/gm2/imports/run/pass/innermods6.mod b/gcc/testsuite/gm2/imports/run/pass/innermods6.mod
new file mode 100644
index 00000000000..057bf879452
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/innermods6.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE innermods6 ;
+
+  PROCEDURE proc ;
+
+    MODULE inner ;
+    BEGIN
+    END inner ;
+
+  BEGIN
+  END proc ;
+
+BEGIN
+
+END innermods6.
diff --git a/gcc/testsuite/gm2/integer/div.mod b/gcc/testsuite/gm2/integer/div.mod
new file mode 100644
index 00000000000..11610c48a43
--- /dev/null
+++ b/gcc/testsuite/gm2/integer/div.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE div ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   x, y: INTEGER ;
+BEGIN
+   x := -3 ;
+   y :=  2 ;
+   IF x DIV y#-1
+   THEN
+      exit(1)
+   END ;
+   IF -3 DIV 2#-1
+   THEN
+      exit(2)
+   END
+END div.
diff --git a/gcc/testsuite/gm2/integer/expr.mod b/gcc/testsuite/gm2/integer/expr.mod
new file mode 100644
index 00000000000..c685d69cbc1
--- /dev/null
+++ b/gcc/testsuite/gm2/integer/expr.mod
@@ -0,0 +1,88 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE expr ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i, j: INTEGER ;
+BEGIN
+   IF 6 DIV 2#3
+   THEN
+      exit(1)
+   END ;
+   IF 6 MOD 2#0
+   THEN
+      exit(2)
+   END ;
+   IF 1 DIV 3#0
+   THEN
+      exit(3)
+   END ;
+   IF 1 MOD 3#1
+   THEN
+      exit(4)
+   END ;
+   IF -3 DIV 2#-1
+   THEN
+      exit(5)
+   END ;
+   IF 3 DIV (-2)#-1    (* we must surround the -2 in parenthenesis as `DIV' `-' is illegal *)
+   THEN
+      exit(6)
+   END ;
+
+   (* and the same for variables *)
+
+   i := 6 ;
+   j := 2 ;
+   IF i DIV j#3
+   THEN
+      exit(7)
+   END ;
+   i := 6 ;
+   j := 2 ;
+   IF i MOD j#0
+   THEN
+      exit(8)
+   END ;
+   i := 1 ;
+   j := 3 ;
+   IF i DIV j#0
+   THEN
+      exit(9)
+   END ;
+   i := 1 ;
+   j := 3 ;
+   IF i MOD j#1
+   THEN
+      exit(10)
+   END ;
+   i := -3 ;
+   j := 2 ;
+   IF i DIV j#-1
+   THEN
+      exit(11)
+   END ;
+ 
+   i := 3 ;
+   j := -2 ;
+   IF i DIV j#-1
+   THEN
+      exit(12)
+   END ;
+END expr. 
diff --git a/gcc/testsuite/gm2/integer/mod.mod b/gcc/testsuite/gm2/integer/mod.mod
new file mode 100644
index 00000000000..50c1ff0f3aa
--- /dev/null
+++ b/gcc/testsuite/gm2/integer/mod.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE mod ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   x, y: INTEGER ;
+BEGIN
+   x := -2 ;
+   y :=  4 ;
+   IF x MOD y#-2
+   THEN
+      exit(1)
+   END ;
+   IF -2 MOD 4#-2
+   THEN
+      exit(2)
+   END
+END mod.
diff --git a/gcc/testsuite/gm2/integer/mod2.mod b/gcc/testsuite/gm2/integer/mod2.mod
new file mode 100644
index 00000000000..0cfe2d9e565
--- /dev/null
+++ b/gcc/testsuite/gm2/integer/mod2.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE mod2 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   x, y: INTEGER ;
+BEGIN
+   x := -3213546 ;
+   y :=  12313654 ;
+   IF x MOD y#-3213546
+   THEN
+      exit(1)
+   END ;
+   IF -3213546 MOD 12313654#-3213546
+   THEN
+      exit(2)
+   END
+END mod2.
diff --git a/gcc/testsuite/gm2/integer/one.mod b/gcc/testsuite/gm2/integer/one.mod
new file mode 100644
index 00000000000..0f0b0487aee
--- /dev/null
+++ b/gcc/testsuite/gm2/integer/one.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE one ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   IF i#1
+   THEN
+      exit(1)
+   END
+END one.
diff --git a/gcc/testsuite/gm2/integer/options b/gcc/testsuite/gm2/integer/options
new file mode 100644
index 00000000000..1a6e90a1757
--- /dev/null
+++ b/gcc/testsuite/gm2/integer/options
@@ -0,0 +1 @@
+-g 
diff --git a/gcc/testsuite/gm2/integer/zero.mod b/gcc/testsuite/gm2/integer/zero.mod
new file mode 100644
index 00000000000..308f46ed195
--- /dev/null
+++ b/gcc/testsuite/gm2/integer/zero.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE zero ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   IF i#0
+   THEN
+      exit(1)
+   END
+END zero.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/Makefile b/gcc/testsuite/gm2/iso/analysis/fail/Makefile
new file mode 100644
index 00000000000..41364109830
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/Makefile
@@ -0,0 +1,9 @@
+
+all: force
+	@echo "this is a dummy Makefile which only has 'make clean' as a target"
+
+clean: force
+	$(RM) a.out *.cpp *.o *.s *~
+
+force:
+
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/arithoverflow.mod b/gcc/testsuite/gm2/iso/analysis/fail/arithoverflow.mod
new file mode 100644
index 00000000000..b81cbca3ece
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/arithoverflow.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE arithoverflow ;  (*!m2iso+gm2*)
+
+FROM SYSTEM IMPORT INTEGER8 ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   a, b, c: INTEGER8 ;
+BEGIN
+   a := 126 ;
+   b := 2 ;
+   c := a + b
+END test ;
+
+
+BEGIN
+   test
+END arithoverflow.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/arithoverflow2.mod b/gcc/testsuite/gm2/iso/analysis/fail/arithoverflow2.mod
new file mode 100644
index 00000000000..fdcdb43e4cc
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/arithoverflow2.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE arithoverflow2 ;  (*!m2iso+gm2*)
+
+FROM SYSTEM IMPORT CARDINAL8 ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   a, b, c: CARDINAL8 ;
+BEGIN
+   a := 254 ;
+   b := 2 ;
+   c := a + b
+END test ;
+
+
+BEGIN
+   test
+END arithoverflow2.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/arithsubcard.mod b/gcc/testsuite/gm2/iso/analysis/fail/arithsubcard.mod
new file mode 100644
index 00000000000..5279704e2b1
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/arithsubcard.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE arithsubcard ;  (*!m2iso+gm2*)
+
+FROM SYSTEM IMPORT CARDINAL8 ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   a, b, c: CARDINAL8 ;
+BEGIN
+   a := 254 ;
+   b := 255 ;
+   c := a - b
+END test ;
+
+
+BEGIN
+   test
+END arithsubcard.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/arrayrange.mod b/gcc/testsuite/gm2/iso/analysis/fail/arrayrange.mod
new file mode 100644
index 00000000000..66af7e3e02a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/arrayrange.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE arrayrange ;  (*!m2iso+gm2*)
+
+
+VAR
+   a: ARRAY [0..3] OF CARDINAL ;
+
+
+PROCEDURE access (b: ARRAY OF CARDINAL; s: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN b[s]
+END access ;
+
+
+BEGIN
+   IF access (a, 4) = 4
+   THEN
+   END
+END arrayrange.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/assignvalue.mod b/gcc/testsuite/gm2/iso/analysis/fail/assignvalue.mod
new file mode 100644
index 00000000000..a4e87b03a1d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/assignvalue.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE assignvalue ;  (*!m2iso+gm2*)
+
+
+PROCEDURE bad () : INTEGER ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := -1 ;
+   RETURN i
+END bad ;
+
+
+VAR
+   foo: CARDINAL ;
+BEGIN
+   (* plugin should detect this as an error, post optimization.  *)
+   foo := bad ()
+END assignvalue.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/callassignment.mod b/gcc/testsuite/gm2/iso/analysis/fail/callassignment.mod
new file mode 100644
index 00000000000..89984cee0ad
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/callassignment.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE callassignment ;  (*!m2iso+gm2*)
+
+
+PROCEDURE a (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END a ;
+
+
+PROCEDURE b (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END b ;
+
+
+PROCEDURE c (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END c ;
+
+
+VAR
+   y: CARDINAL ;
+BEGIN
+   y := c(b(a(2)))
+END callassignment.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/callassignment2.mod b/gcc/testsuite/gm2/iso/analysis/fail/callassignment2.mod
new file mode 100644
index 00000000000..f4de833c3d3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/callassignment2.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE callassignment2 ;  (*!m2iso+gm2*)
+
+FROM libc IMPORT printf ;
+
+
+PROCEDURE a (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END a ;
+
+
+PROCEDURE b (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END b ;
+
+
+PROCEDURE c (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END c ;
+
+
+VAR
+   y: CARDINAL ;
+BEGIN
+   printf ("can the plugin detect the range error after this call\n");
+   y := c(b(a(2)))
+END callassignment2.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/callassignment3.mod b/gcc/testsuite/gm2/iso/analysis/fail/callassignment3.mod
new file mode 100644
index 00000000000..804939550e0
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/callassignment3.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE callassignment3 ;  (*!m2iso+gm2*)
+
+FROM libc IMPORT printf ;
+
+
+PROCEDURE a (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END a ;
+
+
+PROCEDURE b (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END b ;
+
+
+PROCEDURE c (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END c ;
+
+
+VAR
+   y: CARDINAL ;
+BEGIN
+   printf ("can the plugin detect the range error after these calls?\n");
+   printf ("call 1\n");
+   printf ("call 2\n");
+   printf ("call 3\n");
+   printf ("call 4\n");
+   y := c(b(a(2)))
+END callassignment3.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/callassignment4.mod b/gcc/testsuite/gm2/iso/analysis/fail/callassignment4.mod
new file mode 100644
index 00000000000..4b6d800e427
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/callassignment4.mod
@@ -0,0 +1,61 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE callassignment4 ;  (*!m2iso+gm2*)
+
+FROM libc IMPORT printf ;
+
+
+PROCEDURE a (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END a ;
+
+
+PROCEDURE b (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END b ;
+
+
+PROCEDURE c (x: INTEGER) : INTEGER ;
+BEGIN
+   DEC (x) ;
+   RETURN x
+END c ;
+
+
+VAR
+   y: CARDINAL ;
+BEGIN
+   printf ("can the plugin detect the range error after these calls?\n");
+   printf ("call 1\n");
+   printf ("call 2\n");
+   printf ("call 3\n");
+   printf ("call 4\n");
+   y := 1 ;
+   IF y = 1
+   THEN
+
+   ELSE
+
+   END ;
+   y := c(b(a(2)))
+END callassignment4.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/caserange.mod b/gcc/testsuite/gm2/iso/analysis/fail/caserange.mod
new file mode 100644
index 00000000000..cf6c40ee4b8
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/caserange.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE caserange ;  (*!m2iso+gm2*)
+
+
+PROCEDURE selector (s: CARDINAL) ;
+BEGIN
+   CASE s OF
+
+   1,
+   2,
+   3: |
+
+   END
+END selector ;
+
+
+BEGIN
+   selector (4)
+END caserange.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/decvalue.mod b/gcc/testsuite/gm2/iso/analysis/fail/decvalue.mod
new file mode 100644
index 00000000000..84073c0e171
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/decvalue.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE decvalue ;  (*!m2iso+gm2*)
+
+
+TYPE
+   small = [-3..4] ;
+
+
+(*
+   decrement -
+*)
+
+PROCEDURE decrement (v: small) : small ;
+BEGIN
+   DEC (v) ;
+   RETURN v
+END decrement ;
+
+
+VAR
+   s: small ;
+BEGIN
+   s := decrement (-3)
+END decvalue.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/forloop.mod b/gcc/testsuite/gm2/iso/analysis/fail/forloop.mod
new file mode 100644
index 00000000000..57c1e22a680
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/forloop.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE forloop ;  (*!m2iso+gm2*)
+
+TYPE
+   small = [-4..3] ;
+
+VAR
+   i: small ;
+BEGIN
+   FOR i := 0 TO 5 DO
+
+   END
+END forloop.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/incvalue.mod b/gcc/testsuite/gm2/iso/analysis/fail/incvalue.mod
new file mode 100644
index 00000000000..0f609eb9d2e
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/incvalue.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE incvalue ;  (*!m2iso+gm2*)
+
+
+TYPE
+   small = [-3..4] ;
+
+
+(*
+   increment -
+*)
+
+PROCEDURE increment (v: small) : small ;
+BEGIN
+   INC (v) ;
+   RETURN v
+END increment ;
+
+
+VAR
+   s: small ;
+BEGIN
+   s := increment (4)
+END incvalue.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/iso-analysis-fail.exp b/gcc/testsuite/gm2/iso/analysis/fail/iso-analysis-fail.exp
new file mode 100644
index 00000000000..f461c6c06dd
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/iso-analysis-fail.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_iso ${srcdir}/gm2/iso/fail:${srcdir}/gm2/iso/pass "-fsoft-check-all -O2"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/noreturn.mod b/gcc/testsuite/gm2/iso/analysis/fail/noreturn.mod
new file mode 100644
index 00000000000..dff10cebdd8
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/noreturn.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE noreturn ;  (*!m2pim+gm2*)
+
+
+PROCEDURE bad () : CARDINAL ;
+BEGIN
+   (*
+      the compiler will find this error without any plugin
+    *)
+END bad ;
+
+VAR
+   foo: CARDINAL ;
+BEGIN
+   foo := bad ()
+END noreturn.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/returnvalue.mod b/gcc/testsuite/gm2/iso/analysis/fail/returnvalue.mod
new file mode 100644
index 00000000000..18436e9a0ac
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/returnvalue.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE returnvalue ;  (*!m2iso+gm2*)
+
+
+PROCEDURE bad () : CARDINAL ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := -1 ;
+   (* plugin should detect this as an error, post optimization.  *)
+   RETURN i
+END bad ;
+
+
+VAR
+   foo: CARDINAL ;
+BEGIN
+   foo := bad ()
+END returnvalue.
diff --git a/gcc/testsuite/gm2/iso/analysis/fail/staticarray.mod b/gcc/testsuite/gm2/iso/analysis/fail/staticarray.mod
new file mode 100644
index 00000000000..0b5950284bb
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/analysis/fail/staticarray.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE staticarray ;  (*!m2iso+gm2*)
+
+
+VAR
+   a: ARRAY [0..3] OF CARDINAL ;
+
+
+PROCEDURE access (s: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN a[s]
+END access ;
+
+
+BEGIN
+   IF access (4) = 4
+   THEN
+   END
+END staticarray.
diff --git a/gcc/testsuite/gm2/iso/check/fail/iso-check-fail.exp b/gcc/testsuite/gm2/iso/check/fail/iso-check-fail.exp
new file mode 100644
index 00000000000..a519f839f90
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/check/fail/iso-check-fail.exp
@@ -0,0 +1,58 @@
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+load_lib target-supports.exp
+
+global TESTING_IN_BUILD_TREE
+global ENABLE_PLUGIN
+
+# The plugin testcases currently only work when the build tree is available.
+# Also check whether the host supports plugins.
+if { ![info exists TESTING_IN_BUILD_TREE] || ![info exists ENABLE_PLUGIN] } {
+    return
+}
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+global TORTURE_OPTIONS
+
+set old_options $TORTURE_OPTIONS
+set TORTURE_OPTIONS [list \
+			 { -O2 -fsoft-check-all } \
+			 { -O2 -g -fsoft-check-all } \
+			 { -O3 -fsoft-check-all } \
+		         { -O3 -g -fsoft-check-all } ]
+
+gm2_init_iso ${srcdir}/gm2/iso/check/fail
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
+
+set TORTURE_OPTIONS $old_options
diff --git a/gcc/testsuite/gm2/iso/check/fail/modulusoverflow.mod b/gcc/testsuite/gm2/iso/check/fail/modulusoverflow.mod
new file mode 100644
index 00000000000..39dd13d044e
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/check/fail/modulusoverflow.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE modulusoverflow ;  (*!m2pim+gm2*)
+
+TYPE
+   tiny = [10..100] ;
+
+VAR
+   x, y, z: tiny ;
+BEGIN
+   x := 10 ;
+   y := 12 ;
+   z := y MOD x
+END modulusoverflow.
diff --git a/gcc/testsuite/gm2/iso/fail/badarray.mod b/gcc/testsuite/gm2/iso/fail/badarray.mod
new file mode 100644
index 00000000000..0b173b6be11
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badarray.mod
@@ -0,0 +1,7 @@
+MODULE badarray ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c[1] := 5
+END badarray.
diff --git a/gcc/testsuite/gm2/iso/fail/badarray2.mod b/gcc/testsuite/gm2/iso/fail/badarray2.mod
new file mode 100644
index 00000000000..23b863d7b40
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badarray2.mod
@@ -0,0 +1,8 @@
+MODULE badarray ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c[1] := 5 ;
+   c[1] := 6
+END badarray.
diff --git a/gcc/testsuite/gm2/iso/fail/badipv4.mod b/gcc/testsuite/gm2/iso/fail/badipv4.mod
new file mode 100644
index 00000000000..6b0896a29d3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badipv4.mod
@@ -0,0 +1,9 @@
+MODULE badipv4 ;
+
+TYPE
+  IPV4 = ARRAY [1..4] OF CHAR ;
+
+CONST
+  Loopback = IPV4 {127, 0, 0, 1} ;
+
+END badipv4.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/fail/bug10.mod b/gcc/testsuite/gm2/iso/fail/bug10.mod
new file mode 100644
index 00000000000..1779cd6efaf
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/bug10.mod
@@ -0,0 +1,12 @@
+MODULE bug10 ;
+
+(* Missing import; Using the element in an expression crashes the compiler. *)
+(* Using the element in an assignment is working. *)
+
+FROM ChanConsts IMPORT (*read, text,*) FlagSet;
+
+VAR flags:FlagSet;
+BEGIN
+    flags:=read+text;
+
+END bug10.
diff --git a/gcc/testsuite/gm2/iso/fail/bug8.mod b/gcc/testsuite/gm2/iso/fail/bug8.mod
new file mode 100644
index 00000000000..c8210b95943
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/bug8.mod
@@ -0,0 +1,17 @@
+MODULE bug8;
+
+(* Missing import; Using the element in an expression crashes the compiler. *)
+(* Using the element in an assignment is working. *)
+
+FROM ChanConsts IMPORT (*read, text,*) FlagSet;
+
+VAR flags:FlagSet;
+BEGIN
+    flags:=read; (* OK, no expression *)
+    flags:=read+text; (* gm2 -g  -fiso Bug8.mod
+Bug8.mod:10:5:*** fatal error ***
+../../gm2/gcc-versionno/gcc/gm2/gm2-compiler/SymbolTable.mod:6399:1:*** internal error *** illegal symbol
+cc1gm2: internal compiler error: Aborted
+*)
+
+END bug8.
diff --git a/gcc/testsuite/gm2/iso/fail/bug9.mod b/gcc/testsuite/gm2/iso/fail/bug9.mod
new file mode 100644
index 00000000000..0a4d4c51419
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/bug9.mod
@@ -0,0 +1,13 @@
+MODULE bug9 ;
+
+(* Missing import; Using the element in an expression crashes the compiler. *)
+(* Using the element in an assignment is working. *)
+
+FROM ChanConsts IMPORT (*read, text,*) FlagSet;
+
+VAR
+   flags: FlagSet;
+BEGIN
+   flags := read ;
+
+END bug9.
diff --git a/gcc/testsuite/gm2/iso/fail/case.mod b/gcc/testsuite/gm2/iso/fail/case.mod
new file mode 100644
index 00000000000..8193fd128f9
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/case.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE case ;
+
+FROM libc IMPORT printf ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 2 ;
+   CASE c OF
+
+   1:  printf("one") |
+   2:  printf("two") |
+   1:  printf("mistake")
+
+   ELSE
+   END
+END case.
diff --git a/gcc/testsuite/gm2/iso/fail/case2.mod b/gcc/testsuite/gm2/iso/fail/case2.mod
new file mode 100644
index 00000000000..401a017df46
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/case2.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE case2 ;
+
+FROM libc IMPORT printf ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 2 ;
+   CASE c OF
+
+   1:  printf("one") |
+   3:  printf("two") |
+   1..2:  printf("mistake")
+
+   ELSE
+   END
+END case2.
diff --git a/gcc/testsuite/gm2/iso/fail/case3.mod b/gcc/testsuite/gm2/iso/fail/case3.mod
new file mode 100644
index 00000000000..0e6bedb4ab4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/case3.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE case3 ;
+
+FROM libc IMPORT printf ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 2 ;
+   CASE c OF
+
+   1   :  printf("one") |
+   3   :  printf("two") |
+   4..6:  printf("four .. six") |
+   6..8:  printf("mistake")
+
+   ELSE
+   END
+END case3.
diff --git a/gcc/testsuite/gm2/iso/fail/const1.mod b/gcc/testsuite/gm2/iso/fail/const1.mod
new file mode 100644
index 00000000000..c3340af7be3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/const1.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE const1 ;
+
+
+CONST
+   foo = CMPLX(0.0,1.0/sqrt(2.0)) ;
+
+PROCEDURE sqrt (r: REAL) : REAL ;
+BEGIN
+   RETURN r
+END sqrt ;
+
+VAR    
+   z :COMPLEX;
+BEGIN
+   z := foo
+END const1.
diff --git a/gcc/testsuite/gm2/iso/fail/constarray.mod b/gcc/testsuite/gm2/iso/fail/constarray.mod
new file mode 100644
index 00000000000..71f0804a099
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constarray.mod
@@ -0,0 +1,11 @@
+MODULE constarray ;
+
+TYPE
+   VEC = ARRAY [0..2] OF REAL;
+
+CONST
+   VecConst = VEC {1.0, 2.0, 3.0};
+
+BEGIN
+   VecConst[1] := 1.0
+END constarray.
diff --git a/gcc/testsuite/gm2/iso/fail/constarray2.mod b/gcc/testsuite/gm2/iso/fail/constarray2.mod
new file mode 100644
index 00000000000..590cd57e617
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constarray2.mod
@@ -0,0 +1,11 @@
+MODULE constarray2 ;
+
+TYPE
+   VEC = ARRAY [0..2] OF REAL;
+
+CONST
+   VecConst = VEC {1.0, 2.0, 3.0};
+
+BEGIN
+   VecConst := VEC {2.0, 3.0, 4.0}
+END constarray2.
diff --git a/gcc/testsuite/gm2/iso/fail/constprocedure.mod b/gcc/testsuite/gm2/iso/fail/constprocedure.mod
new file mode 100644
index 00000000000..62607381f50
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constprocedure.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE constprocedure ;   (*!m2iso*)
+
+CONST
+   myfunc = CAP ;
+
+VAR
+   a: CHAR ;
+BEGIN
+   a := myfunc ('a')
+END constprocedure.
diff --git a/gcc/testsuite/gm2/iso/fail/constrecord.mod b/gcc/testsuite/gm2/iso/fail/constrecord.mod
new file mode 100644
index 00000000000..8019b3f2ce7
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constrecord.mod
@@ -0,0 +1,13 @@
+MODULE constrecord ;   (*!m2iso*)
+
+TYPE
+   VEC = RECORD
+            x, y, z: REAL ;
+         END ;
+
+CONST
+   VecConst = VEC {1.0, 2.0, 3.0} ;
+
+BEGIN
+   VecConst.y := 1.0
+END constrecord.
diff --git a/gcc/testsuite/gm2/iso/fail/constrecord2.mod b/gcc/testsuite/gm2/iso/fail/constrecord2.mod
new file mode 100644
index 00000000000..78b3f263b9b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constrecord2.mod
@@ -0,0 +1,13 @@
+MODULE constrecord2 ;   (*!m2iso*)
+
+TYPE
+   VEC = RECORD
+            x, y, z: REAL ;
+         END ;
+
+CONST
+   VecConst = VEC {1.0, 2.0, 3.0} ;
+
+BEGIN
+   VecConst := VEC {2.0, 3.0, 4.0}
+END constrecord2.
diff --git a/gcc/testsuite/gm2/iso/fail/constrecord3.mod b/gcc/testsuite/gm2/iso/fail/constrecord3.mod
new file mode 100644
index 00000000000..654c6ed2ae4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constrecord3.mod
@@ -0,0 +1,15 @@
+MODULE constrecord3 ;   (*!m2iso*)
+
+TYPE
+   VEC = RECORD
+            x, y, z: REAL ;
+         END ;
+
+CONST
+   VecConst = VEC {1.0, 2.0, 3.0} ;
+
+BEGIN
+   WITH VecConst DO
+      y := 1.0
+   END
+END constrecord3.
diff --git a/gcc/testsuite/gm2/iso/fail/constsubrange.mod b/gcc/testsuite/gm2/iso/fail/constsubrange.mod
new file mode 100644
index 00000000000..fc7bf05f985
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constsubrange.mod
@@ -0,0 +1,8 @@
+MODULE constsubrange ;
+
+VAR
+   a, b: [10..20] ;
+BEGIN
+   a := 10 ;
+   b := 1 ;
+END constsubrange.
diff --git a/gcc/testsuite/gm2/iso/fail/constsubrange2.mod b/gcc/testsuite/gm2/iso/fail/constsubrange2.mod
new file mode 100644
index 00000000000..0f2737bdecd
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constsubrange2.mod
@@ -0,0 +1,7 @@
+MODULE constsubrange2 ;
+
+VAR
+   a: [10..20] ;
+BEGIN
+   a := 8 + 1
+END constsubrange2.
diff --git a/gcc/testsuite/gm2/iso/fail/constsubrange3.mod b/gcc/testsuite/gm2/iso/fail/constsubrange3.mod
new file mode 100644
index 00000000000..9eda30867c9
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/constsubrange3.mod
@@ -0,0 +1,7 @@
+MODULE constsubrange3 ;
+
+VAR
+   a: [10..20] ;
+BEGIN
+   a := 8
+END constsubrange3.
diff --git a/gcc/testsuite/gm2/iso/fail/defa.def b/gcc/testsuite/gm2/iso/fail/defa.def
new file mode 100644
index 00000000000..36d7d733730
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/defa.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+DEFINITION MODULE defa ;
+
+IMPORT defb ;
+
+END defa.
diff --git a/gcc/testsuite/gm2/iso/fail/defa.mod b/gcc/testsuite/gm2/iso/fail/defa.mod
new file mode 100644
index 00000000000..bec7a9a7ff4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/defa.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+IMPLEMENTATION MODULE defa ;
+
+IMPORT defb ;
+
+VAR
+   x: INTEGER ;
+BEGIN
+   x := defb.defc.foo ;     (* purposeful failure *)
+END defa.
diff --git a/gcc/testsuite/gm2/iso/fail/defb.def b/gcc/testsuite/gm2/iso/fail/defb.def
new file mode 100644
index 00000000000..1835752f138
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/defb.def
@@ -0,0 +1,24 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+DEFINITION MODULE defb ;
+
+TYPE
+   bar = INTEGER ;
+
+END defb.
diff --git a/gcc/testsuite/gm2/iso/fail/defb.mod b/gcc/testsuite/gm2/iso/fail/defb.mod
new file mode 100644
index 00000000000..ad0f67aed8c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/defb.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+IMPLEMENTATION MODULE defb ;
+
+IMPORT defc ;
+
+CONST
+   y = defc.z ;   (* purposeful failure *)
+
+END defb.
diff --git a/gcc/testsuite/gm2/iso/fail/defc.def b/gcc/testsuite/gm2/iso/fail/defc.def
new file mode 100644
index 00000000000..3f89ff0cd10
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/defc.def
@@ -0,0 +1,24 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+DEFINITION MODULE defc ;
+
+CONST
+   foo = 5 ;
+
+END defc.
diff --git a/gcc/testsuite/gm2/iso/fail/defc.mod b/gcc/testsuite/gm2/iso/fail/defc.mod
new file mode 100644
index 00000000000..fcd30b91b87
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/defc.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+IMPLEMENTATION MODULE defc ;
+
+CONST
+   z = defb.bar ;  (* purposeful failure *)
+
+END defc.
diff --git a/gcc/testsuite/gm2/iso/fail/except.mod b/gcc/testsuite/gm2/iso/fail/except.mod
new file mode 100644
index 00000000000..237911efcdd
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/except.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE except ;
+
+FROM Storage IMPORT ALLOCATE ;
+FROM libc IMPORT printf ;
+
+PROCEDURE keepFlying ;
+VAR
+   t: INTEGER ;
+BEGIN
+   r := printf("keepFlying main body\n") ;
+   RETRY
+EXCEPT
+   r := printf("inside keepFlying exception routine\n") ;
+   IF ip=NIL
+   THEN
+      NEW(ip) ;
+      ip^ := 0 ;
+      RETRY
+   END
+END keepFlying ;
+
+VAR
+   r : INTEGER ;
+   ip: POINTER TO INTEGER ;
+BEGIN
+   ip := NIL ;
+   keepFlying ;
+   r := printf("all done\n")
+END except.
diff --git a/gcc/testsuite/gm2/iso/fail/except2.mod b/gcc/testsuite/gm2/iso/fail/except2.mod
new file mode 100644
index 00000000000..2ecb5908327
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/except2.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE except2 ;
+
+FROM Storage IMPORT ALLOCATE ;
+FROM libc IMPORT printf ;
+
+PROCEDURE keepFlying ;
+VAR
+   t: INTEGER ;
+BEGIN
+   r := printf("keepFlying main body\n") ;
+EXCEPT
+   r := printf("inside keepFlying exception routine\n") ;
+EXCEPT
+   r := printf("inside keepFlying exception routine\n") ;
+   IF ip=NIL
+   THEN
+      NEW(ip) ;
+      ip^ := 0 ;
+      RETRY
+   END
+END keepFlying ;
+
+VAR
+   r : INTEGER ;
+   ip: POINTER TO INTEGER ;
+BEGIN
+   ip := NIL ;
+   keepFlying ;
+   r := printf("all done\n")
+END except2.
diff --git a/gcc/testsuite/gm2/iso/fail/iso-fail.exp b/gcc/testsuite/gm2/iso/fail/iso-fail.exp
new file mode 100644
index 00000000000..b8982f3ca2d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/iso-fail.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_iso ${srcdir}/gm2/iso/fail:${srcdir}/gm2/iso/pass
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/iso/fail/isoa.def b/gcc/testsuite/gm2/iso/fail/isoa.def
new file mode 100644
index 00000000000..c49bd5a867c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/isoa.def
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE isoa;
+
+IMPORT isob;
+
+TYPE
+   i = isob.i ;
+
+END isoa.
diff --git a/gcc/testsuite/gm2/iso/fail/isoa.mod b/gcc/testsuite/gm2/iso/fail/isoa.mod
new file mode 100644
index 00000000000..eb866f9aa02
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/isoa.mod
@@ -0,0 +1,22 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE isoa ;
+
+FROM isob IMPORT i;
+
+END isoa.
diff --git a/gcc/testsuite/gm2/iso/fail/lengthsubexpr.mod b/gcc/testsuite/gm2/iso/fail/lengthsubexpr.mod
new file mode 100644
index 00000000000..9aabe7a3c54
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/lengthsubexpr.mod
@@ -0,0 +1,10 @@
+MODULE lengthsubexpr ;
+
+
+VAR
+   c: CARDINAL ;
+   a: CHAR ;
+BEGIN
+   a := 'a' ;
+   c := LENGTH ("Hello world") + a
+END lengthsubexpr.
diff --git a/gcc/testsuite/gm2/iso/fail/proc.mod b/gcc/testsuite/gm2/iso/fail/proc.mod
new file mode 100644
index 00000000000..a4ea95839fc
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/proc.mod
@@ -0,0 +1,55 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE proc ;
+
+IMPORT ConvTypes ;
+
+TYPE
+   type = ConvTypes.ScanState ;
+
+
+PROCEDURE ScanInt (inputCh: CARDINAL;   (* this first param should be a CHAR *)
+                   VAR chClass: ConvTypes.ScanClass;
+                   VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+END ScanInt ;
+
+PROCEDURE test ;
+BEGIN
+END test ;
+
+PROCEDURE foo () : type ;
+BEGIN
+   RETURN ScanInt
+END foo ;
+
+PROCEDURE bar () : PROC ;
+BEGIN
+   RETURN test
+END bar ;
+
+
+VAR
+   p : ConvTypes.ScanState ;
+   ch: CHAR ;
+   c : ConvTypes.ScanClass ;
+   n : ConvTypes.ScanState ;
+BEGIN
+   p := foo() ;
+   p(ch, c, n)
+END proc.
diff --git a/gcc/testsuite/gm2/iso/fail/realbitscast.mod b/gcc/testsuite/gm2/iso/fail/realbitscast.mod
new file mode 100644
index 00000000000..f845630ca46
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/realbitscast.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE realbitscast;
+
+FROM SYSTEM IMPORT WORD, CAST ;
+
+TYPE
+    BITS32 = SET OF [0..31];
+    BITS64 = SET OF [0..63];
+    BITS96 = SET OF [0..95] ;
+    REAL32 = SHORTREAL;
+    REAL64 = REAL;
+
+VAR
+    b32 : BITS32;
+    b64 : BITS64;
+    r32 : REAL32;
+    r64 : REAL64;
+    w   : WORD ;
+BEGIN
+   r32 := 1.0 ;
+   r64 := 1.0 ;
+   b32 := CAST (BITS32, r64) ;   (* error (r32), but the compiler should not crash!  *)
+   b64 := CAST (BITS64, r32) ;   (* error (r64), but the compiler should not crash!  *)
+END realbitscast.
diff --git a/gcc/testsuite/gm2/iso/fail/varient.mod b/gcc/testsuite/gm2/iso/fail/varient.mod
new file mode 100644
index 00000000000..b621f4cfa81
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/varient.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE varient ;
+
+TYPE
+   t1 =  RECORD
+            CASE atag: CARDINAL OF
+            0 : v1 : CHAR; |
+            1 : v2 : INTEGER;
+          | 2 : c3 : LONGINT;
+
+            (* should get an error here, as an ELSE is expected due to
+               an incomplete range. *)
+            END
+         END ;
+
+BEGIN
+END varient.
diff --git a/gcc/testsuite/gm2/iso/fail/varient2.mod b/gcc/testsuite/gm2/iso/fail/varient2.mod
new file mode 100644
index 00000000000..549f2995004
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/varient2.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE varient2 ;
+
+TYPE
+   t1 =  RECORD
+            CASE atag: CARDINAL OF
+            0 : v1 : CHAR; |
+            1 : v2 : INTEGER;
+          | 1 : c3 : LONGINT;  (* duplicate range *)
+
+            END
+         END ;
+
+BEGIN
+END varient2.
diff --git a/gcc/testsuite/gm2/iso/future/builtinlj.mod b/gcc/testsuite/gm2/iso/future/builtinlj.mod
new file mode 100644
index 00000000000..3bfc9aee0b3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/future/builtinlj.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE builtinlj ;
+
+FROM Builtins IMPORT longjmp, setjmp ;
+FROM SYSTEM IMPORT ADR, ADDRESS, WORD ;
+FROM libc IMPORT printf ;
+
+PROCEDURE func ;
+BEGIN
+   r := printf("call longjmp\n") ;
+   longjmp(ADR(env), 1)
+END func ;
+
+VAR
+   env: ARRAY [0..5] OF WORD ;
+   r  : INTEGER ;
+BEGIN
+   IF setjmp(ADR(env))=0
+   THEN
+      func
+   ELSE
+      r := printf("worked bye\n")
+   END
+END builtinlj.
diff --git a/gcc/testsuite/gm2/iso/pass/ChanConsts.def b/gcc/testsuite/gm2/iso/pass/ChanConsts.def
new file mode 100644
index 00000000000..0cbf184c034
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/ChanConsts.def
@@ -0,0 +1,69 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE ChanConsts;
+
+  (* Common types and values for channel open requests and results *)
+
+TYPE
+  ChanFlags =        (* Request flags possibly given when a channel is opened *)
+  ( readFlag,        (* input operations are requested/available *)
+    writeFlag,       (* output operations are requested/available *)
+    oldFlag,         (* a file may/must/did exist before the channel is opened *)
+    textFlag,        (* text operations are requested/available *)
+    rawFlag,         (* raw operations are requested/available *)
+    interactiveFlag, (* interactive use is requested/applies *)
+    echoFlag         (* echoing by interactive device on removal of characters from input
+                        stream requested/applies *)
+  );
+
+  FlagSet = SET OF ChanFlags;
+
+  (* Singleton values of FlagSet, to allow for example, read + write *)
+
+CONST
+  read = FlagSet{readFlag};   (* input operations are requested/available *)
+  write = FlagSet{writeFlag}; (* output operations are requested/available *)
+  old = FlagSet{oldFlag};     (* a file may/must/did exist before the channel is opened *)
+  text = FlagSet{textFlag};   (* text operations are requested/available *)
+  raw = FlagSet{rawFlag};     (* raw operations are requested/available *)
+  interactive = FlagSet{interactiveFlag}; (* interactive use is requested/applies *)
+  echo = FlagSet{echoFlag};   (* echoing by interactive device on removal of characters from
+                                 input stream requested/applies *)
+
+TYPE
+  OpenResults =        (* Possible results of open requests *)
+    (opened,           (* the open succeeded as requested *)
+     wrongNameFormat,  (* given name is in the wrong format for the implementation *)
+     wrongFlags,       (* given flags include a value that does not apply to the device *)
+     tooManyOpen,      (* this device cannot support any more open channels *)
+     outOfChans,       (* no more channels can be allocated *)
+     wrongPermissions, (* file or directory permissions do not allow request *)
+     noRoomOnDevice,   (* storage limits on the device prevent the open *)
+     noSuchFile,       (* a needed file does not exist *)
+     fileExists,       (* a file of the given name already exists when a new one is required *)
+     wrongFileType,    (* the file is of the wrong type to support the required operations *)
+      noTextOperations, (* text operations have been requested, but are not supported *)
+     noRawOperations,  (* raw operations have been requested, but are not supported *)
+     noMixedOperations,(* text and raw operations have been requested, but they
+                          are not supported in combination *)
+     alreadyOpen,      (* the source/destination is already open for operations not supported
+                          in combination with the requested operations *)
+     otherProblem      (* open failed for some other reason *)
+    );
+
+END ChanConsts.
+
diff --git a/gcc/testsuite/gm2/iso/pass/ChanConsts.mod b/gcc/testsuite/gm2/iso/pass/ChanConsts.mod
new file mode 100644
index 00000000000..31f682dc3c2
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/ChanConsts.mod
@@ -0,0 +1,20 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE ChanConsts ;
+
+END ChanConsts.
diff --git a/gcc/testsuite/gm2/iso/pass/ConvTypes.def b/gcc/testsuite/gm2/iso/pass/ConvTypes.def
new file mode 100644
index 00000000000..e313e4df5e3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/ConvTypes.def
@@ -0,0 +1,27 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE ConvTypes;
+
+TYPE
+  ConvResults =  (strAllRight, strOutOfRange, strWrongFormat, strEmpty);
+
+  ScanClass =  (padding, valid, invalid, terminator);
+
+  ScanState = PROCEDURE (CHAR, VAR ScanClass, VAR ScanState);
+
+END ConvTypes.
+
diff --git a/gcc/testsuite/gm2/iso/pass/ConvTypes.mod b/gcc/testsuite/gm2/iso/pass/ConvTypes.mod
new file mode 100644
index 00000000000..78857b61ee6
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/ConvTypes.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE ConvTypes ;
+
+PROCEDURE foo (ch: CHAR; VAR s: ScanClass; VAR p: ScanState) ;
+BEGIN
+END foo ;
+
+
+VAR
+   c: ScanClass ;
+   s: ScanState ;
+BEGIN
+   s := foo ;
+   s('a', c, s)
+END ConvTypes.
diff --git a/gcc/testsuite/gm2/iso/pass/addadr1.mod b/gcc/testsuite/gm2/iso/pass/addadr1.mod
new file mode 100644
index 00000000000..df4cde39c3d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/addadr1.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE addadr1;
+
+FROM SYSTEM IMPORT BYTE, ADDRESS, ADR, ADDADR, CAST;
+
+VAR pbyte : POINTER TO BYTE;
+    pchar : POINTER TO CHAR;
+    byte : BYTE;
+    ch : CHAR;
+
+    a : ADDRESS;
+
+BEGIN
+  pbyte := ADR(byte);
+  pchar := ADR(ch);
+
+  pbyte := ADDADR(pbyte,SIZE(BYTE));
+  pchar := ADDADR(pchar,SIZE(CHAR));
+
+  a := ADDADR(pchar,SIZE(CHAR));
+
+  a := ADDADR(CAST(ADDRESS,pchar),SIZE(CHAR));
+END addadr1.
+
diff --git a/gcc/testsuite/gm2/iso/pass/bits32c.mod b/gcc/testsuite/gm2/iso/pass/bits32c.mod
new file mode 100644
index 00000000000..d1c7fa584e5
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/bits32c.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE bits32c;
+
+FROM SYSTEM IMPORT CAST ;
+
+TYPE BITS32 = BITSET;
+
+VAR b : BITSET;
+    b32 : BITS32;
+
+PROCEDURE f1 (b : BITSET) : BITS32;
+  BEGIN
+    RETURN CAST(BITS32,b);
+  END f1;
+
+BEGIN
+  b := BITSET{};
+  b32 := CAST(BITS32,BITSET{3}) + f1(BITSET{3});
+END bits32c.
diff --git a/gcc/testsuite/gm2/iso/pass/callwraptime.mod b/gcc/testsuite/gm2/iso/pass/callwraptime.mod
new file mode 100644
index 00000000000..387a3e55e1e
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/callwraptime.mod
@@ -0,0 +1,11 @@
+MODULE callwraptime ;
+
+FROM wraptime IMPORT tm, InitTM, GetMonth ;
+
+VAR
+   m: tm ;
+   month: [1..12] ;
+BEGIN
+   m := InitTM () ;
+   month := GetMonth (m)
+END callwraptime.
diff --git a/gcc/testsuite/gm2/iso/pass/caseiso.mod b/gcc/testsuite/gm2/iso/pass/caseiso.mod
new file mode 100644
index 00000000000..24c3d54e3cc
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/caseiso.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE caseiso ;
+
+VAR r1 : RECORD
+            CASE :CARDINAL OF   (* case without tag field has this 
+                                   syntax by ISO *)
+            0 : v1 : CARDINAL;
+          | 1 : v2 : INTEGER;
+            ELSE
+            END
+         END ;
+
+VAR r2 : RECORD
+            CASE CARDINAL OF
+            | 0 : v1 : CARDINAL;       (* pipe is allowed before first 
+                                          record field by ISO *)
+            | 1 : v2 : INTEGER;
+            ELSE
+            END
+         END ;
+
+BEGIN
+END caseiso.
diff --git a/gcc/testsuite/gm2/iso/pass/caseiso2.mod b/gcc/testsuite/gm2/iso/pass/caseiso2.mod
new file mode 100644
index 00000000000..66e97d1a083
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/caseiso2.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE caseiso2 ;
+
+(* remember SIZE is a standard and pervasive function in ISO *)
+FROM libc IMPORT exit ;
+
+VAR
+   r1 : RECORD
+           CASE :CARDINAL OF   (* case without tag field has this 
+                                syntax by ISO *)
+             0 : v1 : CARDINAL;
+           | 1 : v2 : INTEGER;
+           ELSE
+           END
+        END;
+
+VAR
+   r2 : RECORD
+           CASE CARDINAL OF
+           | 0 : v1 : CARDINAL;       (* pipe is allowed before first 
+                                     record field by ISO *)
+           | 1 : v2 : INTEGER;
+           ELSE
+           END
+        END;
+
+VAR
+   r3: RECORD
+          v1: CARDINAL;
+       END ;
+BEGIN
+   r1.v2 := -1 ;
+   r2.v2 := -1 ;
+   IF SIZE(r1)#SIZE(r2)
+   THEN
+      exit(1)
+   END ;
+   IF SIZE(r1)#SIZE(r3)
+   THEN
+      exit(2)
+   END
+END caseiso2.
diff --git a/gcc/testsuite/gm2/iso/pass/cast.mod b/gcc/testsuite/gm2/iso/pass/cast.mod
new file mode 100644
index 00000000000..f7fe5a3e43f
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/cast.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE cast ;
+
+IMPORT SYSTEM ;
+
+TYPE
+   foo = RECORD
+            something: CARDINAL ;
+         END;
+   ptr = POINTER TO foo;
+
+VAR
+   a: SYSTEM.ADDRESS;
+   p: ptr ;
+BEGIN
+   p := SYSTEM.CAST(ptr, a)
+END cast.
diff --git a/gcc/testsuite/gm2/iso/pass/cast3.mod b/gcc/testsuite/gm2/iso/pass/cast3.mod
new file mode 100644
index 00000000000..4083c4b818f
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/cast3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE cast3 ;
+
+FROM SYSTEM IMPORT CAST, LOC;
+
+VAR
+   x :LOC ;
+   n :CARDINAL ;
+BEGIN
+   (*cast*)
+   n := 2 ;
+   x := CAST(LOC, n)
+END cast3.
diff --git a/gcc/testsuite/gm2/iso/pass/castiso.mod b/gcc/testsuite/gm2/iso/pass/castiso.mod
new file mode 100644
index 00000000000..00fe90f4466
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/castiso.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE castiso ;
+
+IMPORT SYSTEM ;
+
+TYPE
+   Foo = RECORD
+            x, y: CARDINAL;
+         END ;
+   pFoo = POINTER TO Foo;
+
+VAR
+   a   : SYSTEM.ADDRESS;
+   pfoo: pFoo;
+
+BEGIN
+  pfoo := SYSTEM.CAST(pFoo, a)
+END castiso.
diff --git a/gcc/testsuite/gm2/iso/pass/const1.mod b/gcc/testsuite/gm2/iso/pass/const1.mod
new file mode 100644
index 00000000000..020e91c445b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/const1.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE const1 ;
+
+FROM RealMath IMPORT sqrt ;
+
+CONST
+   foo = CMPLX (0.0,1.0/sqrt (2.0)) ;
+
+VAR
+   z :COMPLEX;
+BEGIN
+   z := foo
+END const1.
diff --git a/gcc/testsuite/gm2/iso/pass/constreal.mod b/gcc/testsuite/gm2/iso/pass/constreal.mod
new file mode 100644
index 00000000000..c7ccfba4bbe
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/constreal.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE constreal ;
+
+VAR
+   l: LONGREAL ;
+BEGIN
+   l := 1.E0
+END constreal.
diff --git a/gcc/testsuite/gm2/iso/pass/constructor1.mod b/gcc/testsuite/gm2/iso/pass/constructor1.mod
new file mode 100644
index 00000000000..4916fc9aa47
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/constructor1.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE constructor1 ;
+
+TYPE
+   position = RECORD
+                 x1, y1, x2, y2: CARDINAL ;
+              END ;
+
+CONST
+   first = position{1,1,10,10} ;
+
+BEGIN
+
+END constructor1.
diff --git a/gcc/testsuite/gm2/iso/pass/constructor2.mod b/gcc/testsuite/gm2/iso/pass/constructor2.mod
new file mode 100644
index 00000000000..3ecce4e7c38
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/constructor2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE constructor2 ;
+
+TYPE
+   colours = (red, green, blue) ;
+
+   position = RECORD
+                 x1, y1, x2, y2: CARDINAL ;
+              END ;
+
+   rec = RECORD
+            col: colours;
+            pos: position ;
+         END ;
+
+CONST
+   first = rec{red, position{1,1,10,10}} ;
+
+BEGIN
+
+END constructor2.
diff --git a/gcc/testsuite/gm2/iso/pass/constructor3.mod b/gcc/testsuite/gm2/iso/pass/constructor3.mod
new file mode 100644
index 00000000000..3b5e29fb348
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/constructor3.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE constructor3 ;
+
+TYPE
+   position = RECORD
+                 x1, y1, x2, y2: CARDINAL ;
+              END ;
+
+CONST
+   first = position{1,1,10,55} ;
+
+VAR
+   second: position ;
+BEGIN
+   second := first
+END constructor3.
diff --git a/gcc/testsuite/gm2/iso/pass/constructor4.mod b/gcc/testsuite/gm2/iso/pass/constructor4.mod
new file mode 100644
index 00000000000..4399b665227
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/constructor4.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE constructor4 ;
+
+TYPE
+   colours = (red, green, blue) ;
+
+   position = RECORD
+                 x1, y1, x2, y2: CARDINAL ;
+              END ;
+
+   rec = RECORD
+            col: colours;
+            pos: position ;
+         END ;
+
+CONST
+   first = rec{green, position{2,3,4,5}} ;
+
+VAR
+   second: rec ;
+BEGIN
+   second := first
+END constructor4.
diff --git a/gcc/testsuite/gm2/iso/pass/constructor5.mod b/gcc/testsuite/gm2/iso/pass/constructor5.mod
new file mode 100644
index 00000000000..9784f7dea9a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/constructor5.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE constructor5 ;
+
+VAR
+   second: rec ;
+
+CONST
+   first = rec{green, position{2,3,4,5}} ;
+
+TYPE
+   rec = RECORD
+            col: colours;
+            pos: position ;
+         END ;
+
+   colours = (red, green, blue) ;
+
+   position = RECORD
+                 x1, y1, x2, y2: CARDINAL ;
+              END ;
+
+BEGIN
+   second := first
+END constructor5.
diff --git a/gcc/testsuite/gm2/iso/pass/constructor6.mod b/gcc/testsuite/gm2/iso/pass/constructor6.mod
new file mode 100644
index 00000000000..0ace1acd244
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/constructor6.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE constructor6 ;
+
+CONST
+   first = array {1, 2, 3, 4 BY 3};
+
+TYPE
+   array = ARRAY [1..6] OF CARDINAL ;
+
+VAR
+   second: array ;
+BEGIN
+   second := first
+END constructor6.
diff --git a/gcc/testsuite/gm2/iso/pass/constsize4.mod b/gcc/testsuite/gm2/iso/pass/constsize4.mod
new file mode 100644
index 00000000000..e5e2661212f
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/constsize4.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE constsize4 ;
+
+FROM SYSTEM IMPORT BYTE ;
+
+VAR
+   my: ARRAY [0..SIZE(r)+LENGTH(foo)+1] OF BYTE ;
+
+TYPE
+   r = RECORD
+          a: CARDINAL ;
+          b: CHAR ;
+       END ;
+
+   
+CONST
+   foo = "hello world this is a test" ;
+
+BEGIN
+
+END constsize4.
diff --git a/gcc/testsuite/gm2/iso/pass/delim.mod b/gcc/testsuite/gm2/iso/pass/delim.mod
new file mode 100644
index 00000000000..bfb340b52ff
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/delim.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2018 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 2, 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. *)
+
+MODULE delim ;  (*!m2iso+gm2*)
+
+(* check to see if (* <* *) can be compiled (ignored).  *)
+
+BEGIN
+
+END delim.
diff --git a/gcc/testsuite/gm2/iso/pass/delim2.mod b/gcc/testsuite/gm2/iso/pass/delim2.mod
new file mode 100644
index 00000000000..bdeb1fe9eec
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/delim2.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2018 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 2, 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. *)
+
+MODULE delim2 ;  (*!m2iso+gm2*)
+
+(* check to see if comment strings containing delimiter tags can be compiled (ignored).  *)
+
+CONST
+   mystring = "<*" ;  (* is just a string.  *)
+
+BEGIN
+
+END delim2.
diff --git a/gcc/testsuite/gm2/iso/pass/enummodule.mod b/gcc/testsuite/gm2/iso/pass/enummodule.mod
new file mode 100644
index 00000000000..e14189ba8d6
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/enummodule.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE enummodule ;
+
+MODULE m1 ;
+EXPORT T1 ;
+TYPE T1 = (red, blue, green) ;
+END m1 ;
+
+MODULE m2 ;
+IMPORT T1 ;
+EXPORT T2 ;
+TYPE T2 = T1 ;
+END m2 ;
+
+CONST
+   colour = m2.red ;
+
+END enummodule.
diff --git a/gcc/testsuite/gm2/iso/pass/except1.mod b/gcc/testsuite/gm2/iso/pass/except1.mod
new file mode 100644
index 00000000000..e1fbb126659
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/except1.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE except1 ;
+
+PROCEDURE first ;
+
+   PROCEDURE foo ;
+   BEGIN
+   END foo ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF c=1
+   THEN
+      i := 2
+   ELSE
+      i := 1
+   END ;
+EXCEPT
+   c := 2 ;
+(*   RETRY *)
+END first ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 1 ;
+   first
+END except1.
diff --git a/gcc/testsuite/gm2/iso/pass/expproc.mod b/gcc/testsuite/gm2/iso/pass/expproc.mod
new file mode 100644
index 00000000000..354f74f34d6
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/expproc.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE expproc ;
+
+   MODULE foo ;
+   EXPORT bar ;
+      PROCEDURE bar ;
+      BEGIN
+      END bar ;
+   END foo ;
+
+VAR
+   p: PROC ;
+BEGIN
+   p := bar
+END expproc.
diff --git a/gcc/testsuite/gm2/iso/pass/expproc2.mod b/gcc/testsuite/gm2/iso/pass/expproc2.mod
new file mode 100644
index 00000000000..328a34848f0
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/expproc2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE expproc2 ;
+
+    MODULE foo ;
+    EXPORT bar ;
+
+    PROCEDURE bar (h: horrid) ;
+    BEGIN
+    END bar ;
+
+    TYPE
+       horrid = [two..three] ;
+    CONST
+       three = 1 + two ;
+       two   = 1 + 1 + 0 ;
+
+    END foo ;    
+
+BEGIN
+   bar(2)
+END expproc2.
diff --git a/gcc/testsuite/gm2/iso/pass/iso-pass.exp b/gcc/testsuite/gm2/iso/pass/iso-pass.exp
new file mode 100644
index 00000000000..9e5147cc26c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/iso-pass.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_iso ${srcdir}/gm2/iso/pass -fcpp;
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/iso/pass/isob.def b/gcc/testsuite/gm2/iso/pass/isob.def
new file mode 100644
index 00000000000..724f76e7667
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/isob.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE isob ;
+
+TYPE
+   i;
+
+END isob.
diff --git a/gcc/testsuite/gm2/iso/pass/isob.mod b/gcc/testsuite/gm2/iso/pass/isob.mod
new file mode 100644
index 00000000000..45ab7199d39
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/isob.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE isob ;
+
+IMPORT SYSTEM ;
+TYPE
+   i = SYSTEM.ADDRESS ;
+
+END isob.
diff --git a/gcc/testsuite/gm2/iso/pass/isobitset.mod b/gcc/testsuite/gm2/iso/pass/isobitset.mod
new file mode 100644
index 00000000000..3b7e9d88448
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/isobitset.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE isobitset ;
+
+(* BITSET is a standard type in ISO *)
+
+VAR
+   b: BITSET ;
+BEGIN
+   b := {}
+END isobitset.
diff --git a/gcc/testsuite/gm2/iso/pass/isobitset2.mod b/gcc/testsuite/gm2/iso/pass/isobitset2.mod
new file mode 100644
index 00000000000..29224e3e23c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/isobitset2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE isobitset2 ;
+
+
+VAR
+   b, c: BITSET ;
+BEGIN
+   b := {1, 2} + {5..6} ;
+   c := {3, 4} ;
+   b := b + c ;
+END isobitset2.
diff --git a/gcc/testsuite/gm2/iso/pass/longm.mod b/gcc/testsuite/gm2/iso/pass/longm.mod
new file mode 100644
index 00000000000..d866f926468
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/longm.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE longm ;
+
+
+FROM LongMath IMPORT pi, sin, cos ;
+FROM libc IMPORT printf ;
+
+
+VAR
+   r: LONGREAL ;
+BEGIN
+   r := sin(2.0*pi/12.0) ;
+   printf("value of sin(2.0*pi/12.0) = %llf\n", r) ;
+   r := cos(2.0*pi/6.0) ;
+   printf("value of cos(2.0*pi/6.0) = %llf\n", r)
+END longm.
diff --git a/gcc/testsuite/gm2/iso/pass/m.mod b/gcc/testsuite/gm2/iso/pass/m.mod
new file mode 100644
index 00000000000..ce2497001b3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/m.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE m ;
+
+   MODULE m1 ;
+   EXPORT t1 ;
+   TYPE
+      t1 = (red, green, blue) ;
+   END m1 ;
+
+   MODULE m2 ;
+   IMPORT t1 ;
+   EXPORT t2 ;
+   TYPE
+      t2 = t1 ;
+   END m2 ;
+
+CONST
+   shade = m2.blue ;
+
+VAR
+   r: t2 ;
+BEGIN
+   r := shade
+END m.
diff --git a/gcc/testsuite/gm2/iso/pass/proccast.mod b/gcc/testsuite/gm2/iso/pass/proccast.mod
new file mode 100644
index 00000000000..e43ade4acde
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/proccast.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE proccast ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR, CAST ;
+FROM libc IMPORT exit ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+
+PROCEDURE GetProcAdr (a: ADDRESS; name: ARRAY OF CHAR) : PROC ;
+VAR
+   p: PROC ;
+BEGIN
+   p := foo ;
+   RETURN( p )
+END GetProcAdr ;
+
+
+TYPE
+   INITPROC = PROCEDURE (INTEGER) ;
+VAR
+   initproc: INITPROC ;
+BEGIN
+   initproc := CAST(INITPROC, GetProcAdr(ADR(foo), 'testing')) ;
+   IF CAST(ADDRESS,initproc)=NIL
+   THEN
+      exit(1)
+   END
+END proccast.
diff --git a/gcc/testsuite/gm2/iso/pass/realbitscast.mod b/gcc/testsuite/gm2/iso/pass/realbitscast.mod
new file mode 100644
index 00000000000..4da57777cee
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/realbitscast.mod
@@ -0,0 +1,69 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE realbitscast;
+
+FROM SYSTEM IMPORT CAST, WORD ;
+
+#undef HAVE_REAL96
+
+#if defined(__sparc__)
+#   undef HAVE_REAL96
+#elif defined(__alpha__) && defined(__arch64__)
+#   define HAVE_REAL96
+#elif defined(__ppc__)
+#   undef HAVE_REAL96
+#elif defined(__ia64)
+#   undef HAVE_REAL69
+#elif defined(__APPLE__) && defined(__i386__)
+#   undef HAVE_REAL96
+#elif defined(__APPLE__)
+#   define HAVE_REAL96
+#endif
+
+
+TYPE
+    BITS32 = SET OF [0..31];
+    BITS64 = SET OF [0..63];
+    BITS96 = SET OF [0..95] ;
+    REAL32 = SHORTREAL;
+    REAL64 = REAL;
+
+#if defined(HAVE_REAL96)
+    REAL96 = LONGREAL ;
+    (* and on the x86_64 LONGREAL is 128 bits *)
+    (* this is also true for at least some alphas *)
+#endif
+
+VAR
+    b32 : BITS32;
+    b64 : BITS64;
+    r32 : REAL32;
+    r64 : REAL64;
+#if defined(HAVE_REAL96)
+    b96 : BITS96 ;
+    r96 : REAL96 ;
+#endif
+    w   : WORD ;
+BEGIN
+   r32 := 1.0 ;
+   b32 := CAST(BITS32, r32) ;
+   b64 := CAST(BITS64, r64) ;
+#if defined(HAVE_REAL96)
+   b96 := CAST(BITS96, r96)
+#endif
+END realbitscast.
diff --git a/gcc/testsuite/gm2/iso/pass/set12.mod b/gcc/testsuite/gm2/iso/pass/set12.mod
new file mode 100644
index 00000000000..1ba34d66258
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/set12.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE set12 ;
+
+TYPE
+   colour = (red, blue, green) ;
+   foo = SET OF colour ;
+
+VAR
+   s: foo ;
+BEGIN
+   s := foo{}
+END set12.
diff --git a/gcc/testsuite/gm2/iso/pass/stringchar.mod b/gcc/testsuite/gm2/iso/pass/stringchar.mod
new file mode 100644
index 00000000000..5a86f4a79fa
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/stringchar.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE stringchar ;
+
+FROM SYSTEM IMPORT TSIZE, CAST ;
+
+TYPE
+   MinStringType = ARRAY [0..0] OF CHAR ;
+VAR
+   C: CHAR;
+   S: MinStringType;
+   n: CARDINAL;
+BEGIN
+    C :="A" ;
+    C :='A' ;
+
+    S :="A" ;
+    S :='A' ;
+
+    S := CAST(MinStringType, C) ;
+    C := CAST(CHAR, S) ;
+
+    n := MAX(CARDINAL) ;
+    n := SIZE(S) ;
+    n := TSIZE(MinStringType)
+END stringchar.
diff --git a/gcc/testsuite/gm2/iso/pass/subassign.mod b/gcc/testsuite/gm2/iso/pass/subassign.mod
new file mode 100644
index 00000000000..6778702f3ce
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/subassign.mod
@@ -0,0 +1,8 @@
+MODULE subassign ;
+
+VAR
+   card : CARDINAL ;
+   month: [1..12] ;
+BEGIN
+   month := card
+END subassign.
diff --git a/gcc/testsuite/gm2/iso/pass/testaddindr.mod b/gcc/testsuite/gm2/iso/pass/testaddindr.mod
new file mode 100644
index 00000000000..968d274b079
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testaddindr.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testaddindr ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+
+PROCEDURE compare (a, b: ADDRESS) : BOOLEAN ;
+BEGIN
+   RETURN a^=b^;
+END compare ;
+
+VAR
+   ch  : CHAR ;
+   c, d: ADDRESS ;
+BEGIN
+   c := ADR(ch) ;
+   d := ADR(ch) ;
+   IF compare(c, d)
+   THEN
+   END
+END testaddindr.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv.def b/gcc/testsuite/gm2/iso/pass/testconv.def
new file mode 100644
index 00000000000..1854e25965a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv.def
@@ -0,0 +1,34 @@
+(* Copyright (C) 2015 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.  *)
+
+DEFINITION MODULE testconv ;  (*!m2pim*)
+
+(*
+    Title      : testconv
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Sat Feb  4 21:40:59 2017
+    Revision   : $Version$
+    Description: tiny test code
+*)
+
+FROM ConvTypes IMPORT ConvResults ;
+
+PROCEDURE FormatReal (str: ARRAY OF CHAR) : ConvResults ;
+
+END testconv.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv.mod b/gcc/testsuite/gm2/iso/pass/testconv.mod
new file mode 100644
index 00000000000..d3cae06adbb
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2015 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.  *)
+
+IMPLEMENTATION MODULE testconv ;   (*!m2pim*)
+
+FROM ConvTypes IMPORT ConvResults, ScanClass ;
+IMPORT ConvTypes ;
+
+
+PROCEDURE ScanReal (inputCh: CHAR; VAR chClass: ConvTypes.ScanClass;
+                    VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+
+END ScanReal ;
+
+
+PROCEDURE FormatReal (str: ARRAY OF CHAR) : ConvResults ;
+VAR
+   proc   : ConvTypes.ScanState ;
+   chClass: ConvTypes.ScanClass ;
+   i, h   : CARDINAL ;
+BEGIN
+   i := 1 ;
+   h := LENGTH(str) ;
+   ScanReal(str[0], chClass, proc) ;
+   WHILE (i<h) AND (chClass=padding) DO
+      proc(str[i], chClass, proc) ;
+      INC(i)
+   END ;
+   RETURN strAllRight
+END FormatReal ;
+
+
+END testconv.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv2.def b/gcc/testsuite/gm2/iso/pass/testconv2.def
new file mode 100644
index 00000000000..42503cdde63
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv2.def
@@ -0,0 +1,33 @@
+(* Copyright (C) 2017 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.  *)
+
+DEFINITION MODULE testconv2 ;  (*!m2pim*)
+
+(*
+    Title      : testconv2
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Feb 17 16:23:42 2017
+    Revision   : $Version$
+    Description:
+*)
+
+PROCEDURE FormatReal ;
+
+
+END testconv2.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv2.mod b/gcc/testsuite/gm2/iso/pass/testconv2.mod
new file mode 100644
index 00000000000..10658911a7d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv2.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2017 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.  *)
+
+IMPLEMENTATION MODULE testconv2 ;   (*!m2pim*)
+
+TYPE
+   myprocedure = PROCEDURE (VAR myprocedure) ;
+
+
+PROCEDURE s (VAR nextState: myprocedure) ;
+BEGIN
+
+END s ;
+
+
+PROCEDURE FormatReal ;
+VAR
+   proc: myprocedure ;
+   i   : CARDINAL ;
+BEGIN
+   i := 1 ;
+   s (proc) ;
+   WHILE i<10 DO
+      proc (proc) ;
+      INC (i)
+   END
+END FormatReal ;
+
+
+END testconv2.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv3.mod b/gcc/testsuite/gm2/iso/pass/testconv3.mod
new file mode 100644
index 00000000000..a0d13f4ddea
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv3.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE testconv3 ;   (*!m2iso*)
+
+TYPE
+   myprocedure = PROCEDURE (VAR CARDINAL) ;
+
+
+PROCEDURE s (VAR c: CARDINAL) ;
+BEGIN
+
+END s ;
+
+
+VAR
+   proc: myprocedure ;
+   i, h: CARDINAL ;
+BEGIN
+   i := 1 ;
+   proc := s ;
+   WHILE i<10 DO
+      proc (h) ;
+      INC (i)
+   END
+END testconv3.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv4.mod b/gcc/testsuite/gm2/iso/pass/testconv4.mod
new file mode 100644
index 00000000000..5d312ef7f78
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv4.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE testconv4 ;   (*!m2iso*)
+
+TYPE
+   myprocedure = PROCEDURE (VAR CARDINAL) ;
+
+
+PROCEDURE s (VAR c: CARDINAL) ;
+END s ;
+
+PROCEDURE a ;
+VAR
+   proc: myprocedure ;
+   i, h: CARDINAL ;
+BEGIN
+   i := 1 ;
+   proc := s ;
+   WHILE i<10 DO
+      proc (h) ;
+      INC (i)
+   END
+END a ;
+
+BEGIN
+   a
+END testconv4.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv5.mod b/gcc/testsuite/gm2/iso/pass/testconv5.mod
new file mode 100644
index 00000000000..646b1f880a0
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv5.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE testconv5 ;   (*!m2iso*)
+
+TYPE
+   month = [1..12] ;
+
+
+VAR
+   i: month ;
+BEGIN
+   IF i = 1
+   THEN
+   END
+END testconv5.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv6.mod b/gcc/testsuite/gm2/iso/pass/testconv6.mod
new file mode 100644
index 00000000000..e0831897a2c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv6.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE testconv6 ;   (*!m2iso*)
+
+TYPE
+   month = [1..12] ;
+
+   DateTime = RECORD
+                 m: month;
+              END ;
+
+
+VAR
+   d: DateTime ;
+   h: CARDINAL ;
+BEGIN
+   CASE d.m OF
+
+   1:  h := 12 |
+
+   ELSE
+   END
+END testconv6.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv7.mod b/gcc/testsuite/gm2/iso/pass/testconv7.mod
new file mode 100644
index 00000000000..13c490755e1
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv7.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE testconv7 ;   (*!m2iso*)
+
+TYPE
+  Month    = [1..12] ;
+  DateTime = RECORD
+                month: Month ;
+             END ;
+
+PROCEDURE IsValidDateTime (userData: DateTime) : BOOLEAN ;
+(* Tests if the value of userData is a valid *)
+BEGIN
+   WITH userData DO
+      CASE month OF
+
+      1:  RETURN FALSE |
+
+      ELSE
+      END
+   END ;
+   RETURN TRUE
+END IsValidDateTime ;
+
+
+VAR
+   u: DateTime ;
+BEGIN
+   IF IsValidDateTime (u)
+   THEN
+   END
+END testconv7.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv8.mod b/gcc/testsuite/gm2/iso/pass/testconv8.mod
new file mode 100644
index 00000000000..1cb7b53cbe1
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv8.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE testconv8 ;   (*!m2iso*)
+
+FROM libc IMPORT printf ;
+
+TYPE
+   day = [1..31] ;
+
+PROCEDURE test ;
+VAR
+   d1: day ;
+   c : CARDINAL ;
+   i : INTEGER ;
+BEGIN
+   IF -3+2 = i
+   THEN
+      printf ("something 1\n")
+   END ;
+   IF -3+2 = c
+   THEN
+      printf ("something 2\n")
+   END ;
+   IF -3+4 = d1
+   THEN
+      printf ("something 3\n")
+   END
+END test ;
+
+BEGIN
+   test
+END testconv8.
diff --git a/gcc/testsuite/gm2/iso/pass/testconv9.mod b/gcc/testsuite/gm2/iso/pass/testconv9.mod
new file mode 100644
index 00000000000..c681c3506a8
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testconv9.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE testconv9 ;   (*!m2iso*)
+
+FROM libc IMPORT printf ;
+
+CONST
+   foo = -1 ;
+   bar =  1 ;
+TYPE
+   day = [1..31] ;
+
+   rec = RECORD
+            d: day ;
+         END ;
+
+PROCEDURE test ;
+VAR
+   r, s: rec ;
+   c   : CARDINAL ;
+   i   : INTEGER ;
+BEGIN
+   IF -3+4 = r.d + s.d
+   THEN
+      printf ("something 3\n")
+   END
+END test ;
+
+
+BEGIN
+   test
+END testconv9.
diff --git a/gcc/testsuite/gm2/iso/pass/testiso.mod b/gcc/testsuite/gm2/iso/pass/testiso.mod
new file mode 100644
index 00000000000..4328b24c84d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testiso.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testiso ;
+
+FROM SYSTEM IMPORT WORD, BYTE, LOC, ADR ;
+
+VAR
+   b: BYTE ;
+   l: LOC ;
+   w: WORD ;
+   bi: BITSET ;
+   ch: CHAR ;
+   v : POINTER TO CARDINAL ;
+BEGIN
+   v := ADR(w) ;
+   v^ := 1234H
+END testiso.
diff --git a/gcc/testsuite/gm2/iso/pass/testiso2.mod b/gcc/testsuite/gm2/iso/pass/testiso2.mod
new file mode 100644
index 00000000000..b20a1fc218f
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testiso2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testiso2 ;
+
+FROM SYSTEM IMPORT WORD, BYTE, LOC, ADR ;
+
+VAR
+   b: BYTE ;
+   l: LOC ;
+   w: WORD ;
+   bi: BITSET ;
+   ch: CHAR ;
+   v : POINTER TO CARDINAL ;
+BEGIN
+   w := 1234H ;
+   b := BYTE(010H) ;
+   b := VAL(BYTE, 0FFH) ;
+   l := LOC(7FH) ;
+   ch := 'z' ;
+   bi := BITSET{1, 3, 5, 6, 31}
+END testiso2.
diff --git a/gcc/testsuite/gm2/iso/pass/testisosize.mod b/gcc/testsuite/gm2/iso/pass/testisosize.mod
new file mode 100644
index 00000000000..7e2d616a1ee
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testisosize.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testisosize ;
+
+VAR
+   b, a: CARDINAL ;
+BEGIN
+   a := SIZE(b)
+END testisosize.
diff --git a/gcc/testsuite/gm2/iso/pass/testlength.mod b/gcc/testsuite/gm2/iso/pass/testlength.mod
new file mode 100644
index 00000000000..d7b5d27895b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testlength.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testlength ;
+
+FROM libc IMPORT exit ;
+
+BEGIN
+   IF LENGTH('a')#1
+   THEN
+      exit(1)
+   END ;
+   IF LENGTH('hello')#5
+   THEN
+      exit(1)
+   END
+END testlength.
diff --git a/gcc/testsuite/gm2/iso/pass/testlength2.mod b/gcc/testsuite/gm2/iso/pass/testlength2.mod
new file mode 100644
index 00000000000..b8f3e2b0216
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testlength2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE testlength2 ;
+
+FROM libc IMPORT exit ;
+(* FROM Strings IMPORT Length ; *)
+
+PROCEDURE Length (a: ARRAY OF CHAR) : CARDINAL ;
+BEGIN
+   RETURN 12
+END Length ;
+
+VAR
+   a: ARRAY [0..20] OF CHAR ;
+   l: CARDINAL ;
+BEGIN
+   a := "hello world" ;
+   l := LENGTH(a) ;
+   IF l#12
+   THEN
+      exit(1)
+   END
+END testlength2.
diff --git a/gcc/testsuite/gm2/iso/pass/testlength3.mod b/gcc/testsuite/gm2/iso/pass/testlength3.mod
new file mode 100644
index 00000000000..4f39af526cd
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testlength3.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE testlength3 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   a: ARRAY [0..20] OF CHAR ;
+   l: CARDINAL ;
+BEGIN
+   a := "hello world" ;
+   l := LENGTH(a) ;
+   IF l=11
+   THEN
+      (* do nothing *)
+   ELSE
+      exit(1)
+   END ;
+   a := "world" ;
+   l := LENGTH(a) ;
+   IF l=5
+   THEN
+      (* do nothing *)
+   ELSE
+      exit(1)
+   END
+END testlength3.
diff --git a/gcc/testsuite/gm2/iso/pass/testlength4.mod b/gcc/testsuite/gm2/iso/pass/testlength4.mod
new file mode 100644
index 00000000000..74f4b5fe3fa
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testlength4.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE testlength4 ;
+
+FROM libc IMPORT exit ;
+
+CONST
+   X = '0123' ;
+   Y = '456789' ;
+   l = LENGTH(X+Y) ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := l
+END testlength4.
diff --git a/gcc/testsuite/gm2/iso/pass/testlength5.mod b/gcc/testsuite/gm2/iso/pass/testlength5.mod
new file mode 100644
index 00000000000..17190505a94
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testlength5.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testlength5 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE Length (a: ARRAY OF CHAR) : CARDINAL ;
+BEGIN
+   RETURN 15
+END Length ;
+
+VAR
+   a: ARRAY [0..20] OF CHAR ;
+BEGIN
+   a := 'hello' ;
+   IF LENGTH(a)=15
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END testlength5.
diff --git a/gcc/testsuite/gm2/iso/pass/unbounded.mod b/gcc/testsuite/gm2/iso/pass/unbounded.mod
new file mode 100644
index 00000000000..7f9b5ce92f3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/unbounded.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded ;
+
+
+PROCEDURE test (a: ARRAY OF ARRAY OF CHAR) ;
+BEGIN
+   
+END test ;
+
+
+VAR
+   b: ARRAY [0..4], [0..5] OF CHAR ;
+BEGIN
+   test(b)
+END unbounded.
diff --git a/gcc/testsuite/gm2/iso/pass/unbounded2.mod b/gcc/testsuite/gm2/iso/pass/unbounded2.mod
new file mode 100644
index 00000000000..eadbd90de21
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/unbounded2.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded2 ;
+
+
+PROCEDURE test (a: ARRAY OF ARRAY OF CHAR) ;
+BEGIN
+   a[1][2] := 'a'
+END test ;
+
+
+VAR
+   b: ARRAY [0..4], [0..5] OF CHAR ;
+BEGIN
+   test(b)
+END unbounded2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/adraddress.mod b/gcc/testsuite/gm2/iso/run/pass/adraddress.mod
new file mode 100644
index 00000000000..7e7ecf190ba
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/adraddress.mod
@@ -0,0 +1,42 @@
+MODULE adraddress;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+IMPORT STextIO;
+FROM libc IMPORT exit, printf ;
+
+
+PROCEDURE assert (b: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d:assert failed\n", ADR(f), l) ;
+      r := 1
+   END
+END assert ;
+
+
+TYPE
+   NamePtr = POINTER TO ARRAY [0..99] OF CHAR;
+   NamePtrPtr = POINTER TO NamePtr;
+
+VAR
+   strp  : ARRAY [0..9] OF ADDRESS;
+   name  : ARRAY [0..99] OF CHAR;
+   namep : NamePtr;
+   namepp: NamePtrPtr;
+   r     : INTEGER ;
+BEGIN
+   name := "test";
+   strp[0] := ADR(name);
+   namepp := ADR(strp[0]);
+   assert(strp[0]#namepp, __FILE__, __LINE__) ;
+   namep := namepp^;
+   assert(strp[0]=namep, __FILE__, __LINE__) ;
+   assert(ADR(name)=namep, __FILE__, __LINE__) ;
+
+   STextIO.WriteString(namep^); STextIO.WriteLn;
+   IF r#0
+   THEN
+      exit(r)
+   END
+END adraddress.
diff --git a/gcc/testsuite/gm2/iso/run/pass/adrunbounded3.mod b/gcc/testsuite/gm2/iso/run/pass/adrunbounded3.mod
new file mode 100644
index 00000000000..63c6a1df703
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/adrunbounded3.mod
@@ -0,0 +1,93 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE adrunbounded3 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+
+
+CONST
+   MaxDim = 3 ;
+
+TYPE
+   Vector = ARRAY [1..MaxDim] OF REAL;
+   Matrix = ARRAY [1..MaxDim] OF Vector;
+
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (b: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL; message: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf ("%s:%d: assert failed: %s\n", file, line, message) ;
+      exit (1)
+   END
+END assert ;
+
+
+(*
+   inner -
+*)
+
+PROCEDURE inner (VAR m: ARRAY OF REAL) ;
+VAR
+   b: ADDRESS ;
+BEGIN
+   b := ADR (m) ;
+   assert (a = b, __FILE__, __LINE__, "a = b")
+END inner ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test (VAR m: ARRAY OF ARRAY OF REAL) ;
+VAR
+   u0, u1, u2: ADDRESS ;
+   i         : CARDINAL ;
+BEGIN
+   u0 := ADR (m) ;
+   assert (a0 = u0, __FILE__, __LINE__, "a0 = u0") ;
+   u1 := ADR (m[0]) ;
+   assert (a0 = u1, __FILE__, __LINE__, "a0 = u1") ;
+   u2 := ADR (m[0][0]) ;
+   assert (a0 = u2, __FILE__, __LINE__, "a0 = u2") ;
+   FOR i := 0 TO MaxDim-1 DO
+      a := ADR (m[i]) ;
+      printf ("a = %p\n", a) ;
+      inner (m[i])
+   END
+END test ;
+
+
+VAR
+   m            : Matrix ;
+   a, a0, a1, a2: ADDRESS ;
+BEGIN
+   a0 := ADR (m) ;
+   a1 := ADR (m[1]) ;
+   a2 := ADR (m[1][1]) ;
+   assert (a0 = a1, __FILE__, __LINE__, "a0 = a1") ;
+   assert (a0 = a2, __FILE__, __LINE__, "a0 = a2") ;
+   test (m)
+END adrunbounded3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/baseimport.mod b/gcc/testsuite/gm2/iso/run/pass/baseimport.mod
new file mode 100644
index 00000000000..6568ac0def1
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/baseimport.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE baseimport ;
+
+IMPORT fileio ;
+
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+BEGIN
+   c := fileio.ORDL(i)
+END baseimport.
diff --git a/gcc/testsuite/gm2/iso/run/pass/compsize.mod b/gcc/testsuite/gm2/iso/run/pass/compsize.mod
new file mode 100644
index 00000000000..50dd8919990
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/compsize.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE compsize ;
+
+FROM SYSTEM IMPORT BITSET32, INTEGER16, COMPLEX64 ;
+
+VAR
+   b: BITSET32 ;
+   i: INTEGER16 ;
+   c: COMPLEX64 ;
+BEGIN
+
+END compsize.
diff --git a/gcc/testsuite/gm2/iso/run/pass/concurrentstore.mod b/gcc/testsuite/gm2/iso/run/pass/concurrentstore.mod
new file mode 100644
index 00000000000..459525153af
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/concurrentstore.mod
@@ -0,0 +1,162 @@
+(* concurrentstore.mod a concurrent test for ALLOCATE/DEALLOCATE.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE concurrentstore ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Processes IMPORT Create, Start, StopMe, SuspendMe, Activate, SuspendMeAndActivate, ProcessId, Me, Reschedule ;
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Preemptive IMPORT initPreemptive ;
+FROM Processes IMPORT Wait, Attach, Create, ProcessId, Urgency, Activate ;
+FROM RTint IMPORT InitTimeVector, ReArmTimeVector, IncludeVector, ExcludeVector ;
+FROM COROUTINES IMPORT TurnInterrupts, PROTECTION ;
+
+
+CONST
+   maxProcesses    = 5 ;
+   maxStorageItems = 10 ;
+   stackSpace      = 1 * 1024 * 1024 ;
+   maxTests        = 10 ;
+
+VAR
+   processes: ARRAY [1..maxProcesses] OF ProcessId ;
+   heap     : ARRAY [1..maxProcesses] OF ARRAY [1..maxStorageItems] OF ADDRESS ;
+
+
+(*
+   createThreads -
+*)
+
+PROCEDURE createThreads ;
+VAR
+   t: INTEGER ;
+BEGIN
+   FOR t := 1 TO maxProcesses DO
+      Create (stressAllocation, stackSpace, -1, NIL, processes[t])
+   END
+END createThreads ;
+
+
+(*
+   stressAllocation -
+*)
+
+PROCEDURE stressAllocation ;
+VAR
+   looping,
+   count,
+   a, tid : CARDINAL ;
+BEGIN
+   tid := Find (Me ()) ;
+   count := 0 ;
+   looping := 0 ;
+   LOOP
+      FOR a := 1 TO maxStorageItems DO
+         ALLOCATE (heap[tid][a], a)
+      END ;
+      FOR a := 1 TO maxStorageItems DO
+         DEALLOCATE (heap[tid][a], a)
+      END ;
+      INC (count) ;
+      (* Reschedule ; *)
+      IF count = maxTests
+      THEN
+         printf ("process %d completed %d allocate/deallocates\n",
+                 tid, count * maxTests) ;
+         count := 0 ;
+         INC (looping) ;
+         IF looping = 10
+         THEN
+            printf ("this thread is complete\n") ;
+            SuspendMe
+         END
+      END
+   END
+END stressAllocation ;
+
+
+(*
+   Find -
+*)
+
+PROCEDURE Find (id: ProcessId) : CARDINAL ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   FOR c := 1 TO maxProcesses DO
+      IF processes[c] = id
+      THEN
+         RETURN c
+      END
+   END ;
+   HALT
+END Find ;
+
+
+(*
+   timedWait -
+*)
+
+PROCEDURE timedWait ;
+VAR
+   old: PROTECTION ;
+   vec: CARDINAL ;
+BEGIN
+   printf ("timedWait for 5 seconds\n");
+   old := TurnInterrupts (MAX (PROTECTION)) ;
+   vec := InitTimeVector (5, 5, MAX (PROTECTION)) ;
+   Attach (vec) ;  (* attach vector to this process.  *)
+   IncludeVector (vec) ;
+   (* ReArmTimeVector (vec, 3, 3) ;  (* 10 seconds.  *) *)
+   printf ("main process is now going Wait for 5 seconds\n");
+   Wait ;
+   printf ("yes, 5 seconds has elapsed\n");
+END timedWait ;
+
+
+PROCEDURE parallelRun ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   printf ("initPreemptive\n") ;
+   initPreemptive (2, 0) ;
+   printf ("after initPreemptive\n") ;
+
+   FOR c := 1 TO maxProcesses DO
+      Activate (processes[c])
+   END ;
+   timedWait ;
+   printf ("all complete\n") ;
+END parallelRun ;
+
+
+BEGIN
+   printf ("starting concurrentstore test\n") ;
+   createThreads ;
+   printf ("running all threads\n") ;
+   parallelRun
+END concurrentstore.
diff --git a/gcc/testsuite/gm2/iso/run/pass/constprocedure.mod b/gcc/testsuite/gm2/iso/run/pass/constprocedure.mod
new file mode 100644
index 00000000000..60666b665e3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/constprocedure.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2018 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.  *)
+
+MODULE constprocedure ;   (*!m2iso*)
+
+CONST
+   myfunc = myCap ;
+
+
+PROCEDURE myCap (ch: CHAR) : CHAR ;
+BEGIN
+   RETURN CAP (ch)
+END myCap ;
+
+
+VAR
+   a: CHAR ;
+BEGIN
+   a := myfunc ('a')
+END constprocedure.
diff --git a/gcc/testsuite/gm2/iso/run/pass/constructor1.mod b/gcc/testsuite/gm2/iso/run/pass/constructor1.mod
new file mode 100644
index 00000000000..3bdba4d6bdd
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/constructor1.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE constructor1 ;
+
+FROM libc IMPORT exit ;
+
+
+VAR
+   f: position ;
+   s: tile ;
+
+TYPE
+   position = RECORD
+                 x1, y1, x2, y2: CARDINAL ;
+              END ;
+
+   tile = RECORD
+             c: colour ;
+             p: position ;
+          END ;
+
+   colour = (red, blue, green) ;
+
+CONST
+   first = position{1,2,3,4} ;
+   second = tile{blue, position{2,3,4,5}} ;
+
+BEGIN
+   f := first ;
+   IF (f.x1=1) AND (f.y1=2) AND (f.x2=3) AND (f.y2=4)
+   THEN
+      (* all ok *)
+   ELSE
+      exit(1)
+   END ;
+   s := second ;
+   IF (s.c=blue) AND (s.p.x1=2) AND (s.p.y1=3) AND (s.p.x2=4) AND (s.p.y2=5)
+   THEN
+      (* all ok *)
+   ELSE
+      exit(2)
+   END
+END constructor1.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/run/pass/constructor2.mod b/gcc/testsuite/gm2/iso/run/pass/constructor2.mod
new file mode 100644
index 00000000000..a4334c7cad9
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/constructor2.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE constructor2 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   Vector = ARRAY [0..2] OF REAL ;
+
+
+PROCEDURE ScalarMultiplication (Vector: ARRAY OF REAL; Scalar: REAL;
+                                VAR Result : ARRAY OF REAL) ;
+VAR
+   h: CARDINAL ;
+BEGIN
+   FOR h := 0 TO HIGH(Vector) DO
+      Result[h] := Vector[h] * Scalar
+   END
+END ScalarMultiplication ;
+
+
+VAR
+   a, r, s: Vector ;
+BEGIN
+   a := Vector {1.0, 2.0, 3.0} ;
+   ScalarMultiplication (a, 5.0, r) ;
+
+   ScalarMultiplication (Vector {1.0, 2.0, 3.0}, 5.0, s) ;
+   IF (r[0]=s[0]) AND (r[1]=s[1]) AND (r[2]=s[2])
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END constructor2.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/run/pass/conststrarray.mod b/gcc/testsuite/gm2/iso/run/pass/conststrarray.mod
new file mode 100644
index 00000000000..37a4bc4e67c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/conststrarray.mod
@@ -0,0 +1,59 @@
+(* conststrarray.mod provides a test to access a constant array.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE conststrarray ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT SIZE, ADR ;
+
+TYPE
+   array = ARRAY [0..26] OF CHAR ;
+
+CONST
+   str = array { "A", "B", "C", "D", "E", "F", "G", "H",
+                 "I", "J", "K", "L", "M", "N", "O", "P",
+                 "Q", "R", "S", "T", "U", "V", "W", "X",
+                 "Y", "Z" } ;
+
+PROCEDURE assert (b: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf ("%s:%d:assert failed\n", ADR (file), line) ;
+      r := 1
+   END
+END assert ;
+
+
+VAR
+   s: array ;
+   c: CARDINAL ;
+   r: INTEGER ;
+BEGIN
+   r := 0 ;
+   s := "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ;
+   FOR c := 0 TO 25 DO
+      printf ("c = %d, s[c] = %c, str[c] = %c, %c\n", c, s[c], str[c], CHR (ORD ('A')+c)) ;
+      assert (s[c] = CHR (ORD ('A')+c), __FILE__, __LINE__) ;
+      assert (s[c] = str[c], __FILE__, __LINE__)
+   END ;
+   exit (r)
+END conststrarray.
diff --git a/gcc/testsuite/gm2/iso/run/pass/contimer.mod b/gcc/testsuite/gm2/iso/run/pass/contimer.mod
new file mode 100644
index 00000000000..cc7e3035576
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/contimer.mod
@@ -0,0 +1,101 @@
+(* contimer.mod a basic thread test for round robin scheduling.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE contimer ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Processes IMPORT Create, Start, StopMe, SuspendMe, Activate, SuspendMeAndActivate, ProcessId, Me, Reschedule ;
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM Preemptive IMPORT initPreemptive ;
+FROM COROUTINES IMPORT LISTEN, PROTECTION ;
+
+CONST
+   maxProcesses    = 10 ;
+   stackSpace      = 1 * 1024 * 1024 ;
+
+VAR
+   processes: ARRAY [1..maxProcesses] OF ProcessId ;
+
+
+(*
+   createThreads -
+*)
+
+PROCEDURE createThreads ;
+VAR
+   t: INTEGER ;
+BEGIN
+   FOR t := 1 TO maxProcesses DO
+      Create (simpleProcess, stackSpace, -1, NIL, processes[t])
+   END
+END createThreads ;
+
+
+(*
+   simpleProcess -
+*)
+
+PROCEDURE simpleProcess ;
+VAR
+   count: CARDINAL ;
+BEGIN
+   count := 0 ;
+   LOOP
+      printf ("%x:  hello world\n", Me ()) ;
+      (* LISTEN (MIN (PROTECTION)) ; *)
+      Reschedule ;
+      INC (count) ;
+      IF count = 1000
+      THEN
+         printf ("all done - finishing\n");
+         exit (0)
+      END
+   END
+END simpleProcess ;
+
+
+PROCEDURE parallelRun ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   printf ("initPreemptive\n") ;
+   initPreemptive (1, 0) ;
+   printf ("after initPreemptive\n") ;
+   FOR c := 1 TO maxProcesses DO
+      Activate (processes[c])
+   END ;
+   printf ("all complete\n") ;
+   SuspendMe
+END parallelRun ;
+
+
+BEGIN
+   printf ("starting contimer test\n") ;
+   createThreads ;
+   printf ("running all threads\n") ;
+   parallelRun
+END contimer.
diff --git a/gcc/testsuite/gm2/iso/run/pass/except.c b/gcc/testsuite/gm2/iso/run/pass/except.c
new file mode 100644
index 00000000000..a33357dcb27
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except.c
@@ -0,0 +1,157 @@
+/*
+ * Copyright (C) 2008 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 2, 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 <setjmp.h>
+#include <malloc.h>
+#include <stdio.h>
+
+typedef enum jmpstatus {
+  jmp_normal,
+  jmp_retry,
+  jmp_exception,
+} jmp_status;
+
+struct setjmp_stack {
+  jmp_buf  env;
+  struct setjmp_stack *next;
+} *head = NULL;
+
+void pushsetjmp (void)
+{
+  struct setjmp_stack *p = (struct setjmp_stack *) malloc (sizeof (struct setjmp_stack));
+
+  p->next = head;
+  head = p;
+}
+
+void exception (void)
+{
+  printf("invoking exception handler\n");
+  longjmp (head->env, jmp_exception);
+}
+
+void retry (void)
+{
+  printf("retry\n");
+  longjmp (head->env, jmp_retry);
+}
+
+void popsetjmp (void)
+{
+  struct setjmp_stack *p = head;
+
+  head = head->next;
+  free (p);
+}
+
+
+static int *ip = NULL;
+
+void fly (void)
+{
+  printf("fly main body\n");
+  if (ip == NULL) {
+    printf("ip == NULL\n");
+    exception();
+  }
+  if ((*ip) == 0) {
+    printf("*ip == 0\n");
+    exception();
+  }
+  if ((4 / (*ip)) == 4)
+    printf("yes it worked\n");
+  else
+    printf("no it failed\n");
+}
+
+/*
+ *   a GNU C version of the Modula-2 example given in the ISO standard.
+ *   This is written to prove that the underlying runtime system
+ *   will work with the C interpretation.  Thus gm2 will produce
+ *   trees which follow the "template" setjmp/longjmp schema below
+ *   when compiling EXCEPT/TRY statements.
+ */
+
+void tryFlying (void)
+{
+  void tryFlying_m2_exception () {
+    printf("inside tryFlying exception routine\n");
+    if ((ip != NULL) && ((*ip) == 0)) {
+      (*ip) = 1;
+      retry();
+    }
+  }
+
+  int t;
+
+  pushsetjmp ();
+  do {
+    t = setjmp (head->env);
+  } while (t == jmp_retry);
+
+  if (t == jmp_exception) {
+    /* exception called */
+    tryFlying_m2_exception ();
+    /* exception has not been handled, invoke previous handler */
+    printf("exception not handled here\n");
+    popsetjmp();
+    exception();
+  }
+
+  printf("tryFlying main body\n");  
+  fly();
+  popsetjmp();
+}
+
+
+void keepFlying (void)
+{
+  void keepFlying_m2_exception () {
+    printf("inside keepFlying exception routine\n");
+    if (ip == NULL) {
+      ip = (int *)malloc (sizeof (int));
+      *ip = 0;
+      retry();
+    }
+  }
+  int t;
+
+  pushsetjmp ();
+  do {
+    t = setjmp (head->env);
+  } while (t == jmp_retry);
+  
+  if (t == jmp_exception) {
+    /* exception called */
+    keepFlying_m2_exception ();
+    /* exception has not been handled, invoke previous handler */
+    popsetjmp();
+    exception();
+  }
+  printf("keepFlying main body\n");
+  tryFlying();
+  popsetjmp();
+}
+
+
+main ()
+{
+  keepFlying();
+  printf("all done\n");
+}
diff --git a/gcc/testsuite/gm2/iso/run/pass/except2.mod b/gcc/testsuite/gm2/iso/run/pass/except2.mod
new file mode 100644
index 00000000000..94f7cefea9d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except2.mod
@@ -0,0 +1,78 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE except2 ;
+
+FROM libc IMPORT printf ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM SYSTEM IMPORT ADR, WORD ;
+
+
+PROCEDURE fly ;
+BEGIN
+   printf("fly main body\n") ;
+   IF 4 DIV ip^ = 4
+   THEN
+      printf("yes it worked\n")
+   ELSE
+      printf("no it failed\n")
+   END
+END fly ;
+
+(*
+ *   a GNU M2 version of the Modula-2 example given in the ISO standard.
+ *   This is a hand translation of the equivalent except.c file in this
+ *   directory which is written to prove that the underlying runtime system
+ *   will work with the GCC exception handling trees.
+ *)
+
+PROCEDURE tryFlying ;
+BEGIN
+   printf("tryFlying main body\n");  
+   fly ;
+EXCEPT
+   printf("inside tryFlying exception routine\n") ;
+   IF (ip#NIL) AND (ip^=0)
+   THEN
+      ip^ := 1 ;
+      RETRY
+   END
+END tryFlying ;
+
+
+PROCEDURE keepFlying ;
+BEGIN
+   printf("keepFlying main body\n") ;
+   tryFlying ;
+EXCEPT
+   printf("inside keepFlying exception routine\n") ;
+   IF ip=NIL
+   THEN
+      NEW(ip) ;
+      ip^ := 0 ;
+      RETRY
+   END
+END keepFlying ;
+
+
+VAR
+   ip: POINTER TO INTEGER ;
+BEGIN
+   ip := NIL ;
+   keepFlying ;
+   printf("all done\n")
+END except2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/except3.cpp b/gcc/testsuite/gm2/iso/run/pass/except3.cpp
new file mode 100644
index 00000000000..e6a895826ed
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except3.cpp
@@ -0,0 +1,88 @@
+/* Copyright (C) 2008 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 2, 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 <stdio.h>
+#include <stdlib.h>
+
+// a c++ example of Modula-2 exception handling
+
+static int *ip = NULL;
+
+void fly (void)
+{
+  printf("fly main body\n") ;
+  if (ip == NULL)
+    throw;
+  if (*ip == 0)
+    throw;
+  if (4 / (*ip) == 4)
+    printf("yes it worked\n");
+  else
+    printf("no it failed\n");
+}
+
+/*
+ *   a CPP version of the Modula-2 example given in the ISO standard.
+ *   This is a hand translation of the equivalent except2.mod file in this
+ *   directory which is written to prove that the underlying CPP
+ *   runtime system will support ISO Modula-2 exceptions and to reinforce
+ *   my understanding of how the GCC trees are constructed and what
+ *   state is held where..
+ */
+
+void tryFlying (void)
+{
+ again_tryFlying:
+  printf("tryFlying main body\n");  
+  try {
+    fly() ;
+  }
+  catch (...) {
+    printf("inside tryFlying exception routine\n") ;
+    if ((ip != NULL) && ((*ip) == 0)) {
+      *ip = 1;
+      // retry
+      goto again_tryFlying;
+    }
+    printf("did't handle exception here so we will call the next exception routine\n") ;
+    throw;  // unhandled therefore call previous exception handler
+  }
+}
+
+void keepFlying (void)
+{
+ again_keepFlying:
+  printf("keepFlying main body\n") ;
+  try {
+    tryFlying();
+  }
+  catch (...) {
+    printf("inside keepFlying exception routine\n");
+    if (ip == NULL) {
+      ip = (int *)malloc(sizeof(int));
+      *ip = 0;
+      goto again_keepFlying;
+    }
+    throw;  // unhandled therefore call previous exception handler
+  }
+}
+
+main ()
+{
+  keepFlying();
+  printf("all done\n");
+}
diff --git a/gcc/testsuite/gm2/iso/run/pass/except4.mod b/gcc/testsuite/gm2/iso/run/pass/except4.mod
new file mode 100644
index 00000000000..c49595540a5
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except4.mod
@@ -0,0 +1,68 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE except4 ;
+
+FROM libc IMPORT printf ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM SYSTEM IMPORT ADR, WORD ;
+
+
+PROCEDURE fly ;
+BEGIN
+   printf("fly main body\n") ;
+   IF 4 DIV ip^ = 4
+   THEN
+      printf("yes it worked\n")
+   ELSE
+      printf("no it failed\n")
+   END
+END fly ;
+
+(*
+ *   a GNU M2 version of the Modula-2 example given in the ISO standard.
+ *   This is a hand translation of the equivalent except.c file in this
+ *   directory which is written to prove that the underlying runtime system
+ *   will work with the GCC builtin longjmp/set interpretation.
+ *)
+
+PROCEDURE tryFlying ;
+BEGIN
+   printf("tryFlying main body\n");  
+   fly ;
+EXCEPT
+   printf("inside tryFlying exception routine\n") ;
+   IF ip=NIL
+   THEN
+      NEW(ip) ;
+      ip^ := 0 ;
+      RETRY
+   END ;
+   IF ip^=0
+   THEN
+      ip^ := 1 ;
+      RETRY
+   END
+END tryFlying ;
+
+VAR
+   ip: POINTER TO INTEGER ;
+BEGIN
+   ip := NIL ;
+   tryFlying ;
+   printf("all done\n")
+END except4.
diff --git a/gcc/testsuite/gm2/iso/run/pass/except5.cpp b/gcc/testsuite/gm2/iso/run/pass/except5.cpp
new file mode 100644
index 00000000000..2a2f95ab406
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except5.cpp
@@ -0,0 +1,63 @@
+/* Copyright (C) 2008 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 2, 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 <stdio.h>
+#include <stdlib.h>
+
+int *ip;
+
+void fly (void)
+{
+  if (ip == NULL)
+     throw 1;
+  if ((4 / (*ip)) == 4)
+    printf("yes it worked\n");
+}
+
+/*
+ *   a heavily reduced test case, to aid debugging the compiler..
+ */
+
+void tryFlying (void)
+{
+ again:
+  try {
+    fly();
+#if 0
+    goto fin;
+#endif
+  }
+  catch (...) {
+#if 1
+    if (ip == NULL) {
+#endif
+      ip = (int *)malloc(sizeof(unsigned int));
+      *ip = 1;
+      goto again;
+#if 1
+    }
+#endif
+  }
+ fin:;
+}
+
+main()
+{
+  ip = NULL;
+  tryFlying();
+  printf("all done\n");
+}
diff --git a/gcc/testsuite/gm2/iso/run/pass/except5.mod b/gcc/testsuite/gm2/iso/run/pass/except5.mod
new file mode 100644
index 00000000000..9f6a6ffae2f
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except5.mod
@@ -0,0 +1,65 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE except5 ;
+
+FROM libc IMPORT printf ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM SYSTEM IMPORT ADR, WORD, THROW ;
+
+
+PROCEDURE fly ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF ip=NIL
+   THEN
+      THROW(1)
+   END ;
+   IF 4 DIV ip^ = 4
+   THEN
+      r := printf("yes it worked\n")
+   END ;
+END fly ;
+
+(*
+ *   a heavily reduced test case, to aid debugging the compiler..
+ *)
+
+PROCEDURE tryFlying ;
+VAR
+   r: INTEGER ;
+BEGIN
+   fly
+   EXCEPT
+   IF ip=NIL
+   THEN
+      r := printf("inside Modula-2 exception handler\n");
+      NEW(ip) ;
+      ip^ := 1 ;
+      RETRY
+   END
+END tryFlying ;
+
+VAR
+   r : INTEGER ;
+   ip: POINTER TO INTEGER ;
+BEGIN
+   ip := NIL ;
+   tryFlying ;
+   r := printf("all done\n")
+END except5.
diff --git a/gcc/testsuite/gm2/iso/run/pass/except6.cpp b/gcc/testsuite/gm2/iso/run/pass/except6.cpp
new file mode 100644
index 00000000000..0785f266757
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except6.cpp
@@ -0,0 +1,64 @@
+/* Copyright (C) 2008 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 2, 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 <stdio.h>
+#include <stdlib.h>
+
+typedef unsigned int INTEGER;
+INTEGER *ip;
+
+void fly (void)
+{
+  if (ip == NULL)
+     throw (INTEGER) 1;
+  if ((4 / (*ip)) == 4)
+    printf("yes it worked\n");
+}
+
+/*
+ *   a heavily reduced test case, to aid debugging the compiler..
+ */
+
+void tryFlying (void)
+{
+ again:
+  try {
+    fly();
+#if 0
+    goto fin;
+#endif
+  }
+  catch (...) {
+#if 1
+    if (ip == NULL) {
+#endif
+      ip = (unsigned int *)malloc(sizeof(unsigned int));
+      *ip = 1;
+      goto again;
+#if 1
+    }
+#endif
+  }
+ fin:;
+}
+
+main()
+{
+  ip = NULL;
+  tryFlying();
+  printf("all done\n");
+}
diff --git a/gcc/testsuite/gm2/iso/run/pass/except7.mod b/gcc/testsuite/gm2/iso/run/pass/except7.mod
new file mode 100644
index 00000000000..af040d05b2e
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except7.mod
@@ -0,0 +1,88 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE except7 ;
+
+FROM libc IMPORT printf ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM SYSTEM IMPORT ADR, WORD, THROW ;
+
+
+PROCEDURE fly ;
+BEGIN
+   printf("fly main body\n") ;
+   IF ip=NIL
+   THEN
+      THROW(1)
+   END ;
+   IF ip^=0
+   THEN
+      THROW(2)
+   END ;
+   IF 4 DIV ip^ = 4
+   THEN
+      printf("yes it worked\n")
+   ELSE
+      printf("no it failed\n")
+   END
+END fly ;
+
+(*
+ *   a GNU M2 version of the Modula-2 example given in the ISO standard.
+ *   This is a hand translation of the equivalent except.c file in this
+ *   directory which is written to prove that the underlying runtime system
+ *   will work with the GCC builtin longjmp/set interpretation.
+ *)
+
+PROCEDURE tryFlying ;
+BEGIN
+   printf("tryFlying main body\n");  
+   fly ;
+EXCEPT
+   printf("inside tryFlying exception routine\n") ;
+   IF (ip#NIL) AND (ip^=0)
+   THEN
+      printf("set value\n") ;
+      ip^ := 1 ;
+      RETRY
+   END
+END tryFlying ;
+
+
+PROCEDURE keepFlying ;
+BEGIN
+   printf("keepFlying main body\n") ;
+   tryFlying ;
+EXCEPT
+   printf("inside keepFlying exception routine\n") ;
+   IF ip=NIL
+   THEN
+      printf("allocate memory\n") ;
+      NEW(ip) ;
+      ip^ := 0 ;
+      RETRY
+   END
+END keepFlying ;
+
+
+VAR
+   ip: POINTER TO INTEGER ;
+BEGIN
+   ip := NIL ;
+   keepFlying ;
+   printf("all done\n")
+END except7.
diff --git a/gcc/testsuite/gm2/iso/run/pass/except8.mod b/gcc/testsuite/gm2/iso/run/pass/except8.mod
new file mode 100644
index 00000000000..889c6f838d9
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/except8.mod
@@ -0,0 +1,77 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE except8 ;
+
+FROM libc IMPORT printf ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM SYSTEM IMPORT ADR, WORD, THROW ;
+
+
+PROCEDURE fly ;
+BEGIN
+   printf("fly main body\n") ;
+   IF 4 DIV ip^ = 4
+   THEN
+      printf("yes it worked\n")
+   ELSE
+      printf("no it failed\n")
+   END
+END fly ;
+
+(*
+ *   a GNU M2 version of the Modula-2 example given in the ISO standard.
+ *)
+
+PROCEDURE tryFlying ;
+BEGIN
+   printf("tryFlying main body\n");  
+   fly ;
+EXCEPT
+   printf("inside tryFlying exception routine\n") ;
+   IF (ip#NIL) AND (ip^=0)
+   THEN
+      printf("set value\n") ;
+      ip^ := 1 ;
+      RETRY
+   END
+END tryFlying ;
+
+
+PROCEDURE keepFlying ;
+BEGIN
+   printf("keepFlying main body\n") ;
+   tryFlying ;
+EXCEPT
+   printf("inside keepFlying exception routine\n") ;
+   IF ip=NIL
+   THEN
+      printf("allocate memory\n") ;
+      NEW(ip) ;
+      ip^ := 0 ;
+      RETRY
+   END
+END keepFlying ;
+
+
+VAR
+   ip: POINTER TO INTEGER ;
+BEGIN
+   ip := NIL ;
+   keepFlying ;
+   printf("all done\n")
+END except8.
diff --git a/gcc/testsuite/gm2/iso/run/pass/fileio.def b/gcc/testsuite/gm2/iso/run/pass/fileio.def
new file mode 100644
index 00000000000..9206cccafd0
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/fileio.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+DEFINITION MODULE fileio ;
+
+PROCEDURE ORDL (i: INTEGER) : CARDINAL ;
+
+END fileio.
diff --git a/gcc/testsuite/gm2/iso/run/pass/fileio.mod b/gcc/testsuite/gm2/iso/run/pass/fileio.mod
new file mode 100644
index 00000000000..ccd52a66686
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/fileio.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+IMPLEMENTATION MODULE fileio ;
+
+PROCEDURE ORDL (i: INTEGER) : CARDINAL ;
+BEGIN
+   RETURN i
+END ORDL ;
+
+END fileio.
diff --git a/gcc/testsuite/gm2/iso/run/pass/hello.mod b/gcc/testsuite/gm2/iso/run/pass/hello.mod
new file mode 100644
index 00000000000..db425e357ba
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/hello.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE hello ;
+
+FROM STextIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ; WriteLn
+END hello.
diff --git a/gcc/testsuite/gm2/iso/run/pass/int8field.mod b/gcc/testsuite/gm2/iso/run/pass/int8field.mod
new file mode 100644
index 00000000000..5c34165eafe
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/int8field.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE int8field ;
+
+IMPORT SYSTEM ;
+FROM libc IMPORT exit ;
+FROM STextIO IMPORT WriteString, WriteLn ;
+FROM SWholeIO IMPORT WriteCard ;
+
+PROCEDURE assert (a, b: CARDINAL) ;
+BEGIN
+   WriteCard(a, 1) ; WriteLn ;
+   IF a#b
+   THEN
+      exit(1)
+   END
+END assert ;
+
+TYPE
+   Version = RECORD
+                major : SYSTEM.CARDINAL8;
+                minor : SYSTEM.CARDINAL8;
+                path  : SYSTEM.CARDINAL8;
+             END ;
+
+VAR
+   v: Version ;
+BEGIN
+   v.major := 1 ;
+   v.minor := 2 ;
+   v.path  := 3 ;
+   WriteCard(v.major, 1) ; WriteLn ;
+   WriteCard(v.minor, 1) ; WriteLn ;
+   WriteCard(v.path, 1) ; WriteLn ;
+   assert(v.major, 1) ;
+   assert(v.minor, 2) ;
+   assert(v.path, 3)
+END int8field.
diff --git a/gcc/testsuite/gm2/iso/run/pass/iso-run-pass.exp b/gcc/testsuite/gm2/iso/run/pass/iso-run-pass.exp
new file mode 100644
index 00000000000..443c28d60fb
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/iso-run-pass.exp
@@ -0,0 +1,41 @@
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_link_lib "m2iso m2pim"
+gm2_init_iso "${srcdir}/gm2/iso/run/pass" -fsoft-check-all
+gm2_link_obj fileio.o
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    if { $testcase != "$srcdir/$subdir/fileio.mod" } {
+        gm2_target_compile $srcdir/$subdir/fileio.mod fileio.o object "-g"
+	gm2-torture-execute $testcase "" "pass"
+    }
+}
diff --git a/gcc/testsuite/gm2/iso/run/pass/long.mod b/gcc/testsuite/gm2/iso/run/pass/long.mod
new file mode 100644
index 00000000000..0bbd5be9079
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/long.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE long ;
+
+FROM SYSTEM IMPORT WORD, ADR ;
+FROM Builtins IMPORT setjmp ;
+FROM libc IMPORT printf, exit ;
+
+VAR
+   r: INTEGER ;
+   env: ARRAY [0..10] OF WORD ;
+BEGIN
+   r := setjmp(ADR(env)) ;
+   r := printf("hello world\n")
+END long.
diff --git a/gcc/testsuite/gm2/iso/run/pass/long2.mod b/gcc/testsuite/gm2/iso/run/pass/long2.mod
new file mode 100644
index 00000000000..0908da8abb4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/long2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE long2 ;
+
+FROM SYSTEM IMPORT WORD, ADR ;
+FROM Builtins IMPORT setjmp, longjmp ;
+FROM libc IMPORT printf ;
+
+VAR
+   r: INTEGER ;
+   env: ARRAY [0..10] OF WORD ;
+BEGIN
+   r := setjmp(ADR(env)) ;
+   IF r=0
+   THEN
+      r := printf("first\n") ;
+      longjmp(ADR(env), 1)
+   ELSE
+      r := printf("second\n")
+   END 
+END long2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/long3.mod b/gcc/testsuite/gm2/iso/run/pass/long3.mod
new file mode 100644
index 00000000000..9bf3ad2f413
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/long3.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE long3 ;
+
+FROM SYSTEM IMPORT WORD, ADR ;
+FROM Builtins IMPORT setjmp, longjmp ;
+FROM libc IMPORT printf ;
+
+VAR
+   r: INTEGER ;
+   env: ARRAY [0..10] OF WORD ;
+BEGIN
+   r := setjmp(ADR(env)) ;
+   IF r=0
+   THEN
+      r := printf("first\n") ;
+      longjmp(ADR(env), 1)
+   ELSE
+      r := printf("second\n")
+   END 
+END long3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/long4.c b/gcc/testsuite/gm2/iso/run/pass/long4.c
new file mode 100644
index 00000000000..8f4ad69a438
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/long4.c
@@ -0,0 +1,15 @@
+#include <stdlib.h>
+#include <unistd.h>
+#include <setjmp.h>
+
+
+void func (void)
+{
+  int r;
+  int env[100];
+  //  sigjmp_buf env;
+
+  r = __builtin_setjmp(env);
+  __builtin_exit (r);
+}
+
diff --git a/gcc/testsuite/gm2/iso/run/pass/long4.mod b/gcc/testsuite/gm2/iso/run/pass/long4.mod
new file mode 100644
index 00000000000..382c1ecebd7
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/long4.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE long4 ;
+
+FROM SYSTEM IMPORT WORD, ADR ;
+FROM Builtins IMPORT setjmp ;
+FROM libc IMPORT printf, exit ;
+
+PROCEDURE func ;
+VAR
+   r  : INTEGER ;
+   env: ARRAY [0..32] OF WORD ;
+BEGIN
+   r := setjmp(ADR(env)) ;
+   exit (0)
+END func ;
+
+BEGIN
+   func
+END long4.
diff --git a/gcc/testsuite/gm2/iso/run/pass/minmax.mod b/gcc/testsuite/gm2/iso/run/pass/minmax.mod
new file mode 100644
index 00000000000..ff13805c995
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/minmax.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE minmax ;
+
+
+TYPE
+   color = (red, blue, green) ;
+   colourset = SET OF color ;
+
+VAR
+   c1, c2: color ;
+   b1, b2: CARDINAL ;
+BEGIN
+   c1 := MIN(colourset) ;
+   c2 := MAX(colourset) ;
+(*
+   Assert(c1=red) ;
+   Assert(c2=green) ;
+*)
+   b1 := MIN(BITSET) ;
+   b2 := MAX(BITSET)
+END minmax.
diff --git a/gcc/testsuite/gm2/iso/run/pass/modulus.mod b/gcc/testsuite/gm2/iso/run/pass/modulus.mod
new file mode 100644
index 00000000000..b67e72dbda5
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/modulus.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2019 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.  *)
+
+MODULE modulus ;
+
+FROM libc IMPORT printf ;
+
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   FOR i := 0 TO 32 DO
+      printf ("i = %d\n", i) ;
+      j := i MOD 16 ;
+      IF i MOD 16 = 0
+      THEN
+         printf ("%d is divisible by 16\n", i)
+      ELSE
+         printf ("%d is not divisible by 16\n", i)
+      END
+   END
+END modulus.
diff --git a/gcc/testsuite/gm2/iso/run/pass/nestediso.mod b/gcc/testsuite/gm2/iso/run/pass/nestediso.mod
new file mode 100644
index 00000000000..de68b66fbc4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/nestediso.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE nestediso ;
+
+
+TYPE
+   StringType = ARRAY [0..79] OF CHAR ;
+   DateType   = RECORD
+                   y, m, d: CARDINAL ;
+                END ;
+   PersonType = RECORD
+                   name: StringType ;
+                   birth: DateType ;
+                END ;
+
+VAR
+   person: PersonType ;
+   date  : DateType ;
+   a, b, c: CARDINAL ;
+BEGIN
+   date := DateType{1623, 6, 19} ;
+   a := 1623 ;
+   b := 6 ;
+   c := 19 ;
+   date := DateType{a, b, c} ;
+   person := PersonType{StringType{"" BY 80}, DateType{0, 1, 2}} ;
+   person := PersonType{StringType{"" BY 80}, {0, 1, 2}} ;
+   person := PersonType{"", {0, 1, 2}} ;
+   person := PersonType{StringType{""}, {0, 1, 2}} ;
+   person := PersonType{"Blaise Pascal", date}
+END nestediso.
diff --git a/gcc/testsuite/gm2/iso/run/pass/nestedrecord.mod b/gcc/testsuite/gm2/iso/run/pass/nestedrecord.mod
new file mode 100644
index 00000000000..ad8423d357b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/nestedrecord.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE nestedrecord ;
+
+TYPE
+   NestedRecord = RECORD
+                     a : INTEGER ;
+                     b : INTEGER ;
+                  END;
+
+   TopRecord = RECORD
+                  r: NestedRecord ;
+                  c: INTEGER ;
+               END;
+
+VAR
+   topRecord: TopRecord;
+BEGIN
+   topRecord := TopRecord{ {1, 2}, 3 };
+END nestedrecord.
+
diff --git a/gcc/testsuite/gm2/iso/run/pass/onebyte.mod b/gcc/testsuite/gm2/iso/run/pass/onebyte.mod
new file mode 100644
index 00000000000..df2a2578335
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/onebyte.mod
@@ -0,0 +1,54 @@
+(* onebyte.mod provides a test for a packed byte.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE onebyte ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT SIZE, ADR, BYTE ;
+
+
+PROCEDURE assert (b: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d:assert failed\n", ADR (file), line) ;
+      r := 1
+   END
+END assert ;
+
+
+TYPE
+   color = (red, blue, green, yellow, cyan, purple, black) ;
+   smallInt = PACKEDSET OF [0..7] ;
+   smallEnum = PACKEDSET OF color ;
+
+VAR
+   r: INTEGER ;
+   si: smallInt ;
+   se: smallEnum ;
+BEGIN
+   r := 0 ;
+   assert (SIZE (smallInt) = SIZE (BYTE), __FILE__, __LINE__) ;
+   assert (SIZE (smallEnum) = SIZE (BYTE), __FILE__, __LINE__) ;
+   assert (SIZE (si) = SIZE (BYTE), __FILE__, __LINE__) ;
+   assert (SIZE (se) = SIZE (BYTE), __FILE__, __LINE__) ;
+   exit (r)
+END onebyte.
diff --git a/gcc/testsuite/gm2/iso/run/pass/onebyte2.mod b/gcc/testsuite/gm2/iso/run/pass/onebyte2.mod
new file mode 100644
index 00000000000..7e1705fc459
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/onebyte2.mod
@@ -0,0 +1,60 @@
+(* onebyte2.mod provides an include on a packed byte.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE onebyte2 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT SIZE, ADR, BYTE ;
+
+
+PROCEDURE assert (b: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d:assert failed\n", ADR (file), line) ;
+      r := 1
+   END
+END assert ;
+
+
+TYPE
+   color = (red, blue, green, yellow, cyan, purple, black) ;
+   smallInt = PACKEDSET OF [0..7] ;
+   smallEnum = PACKEDSET OF color ;
+
+VAR
+   r: INTEGER ;
+   si: smallInt ;
+   se: smallEnum ;
+BEGIN
+   r := 0 ;
+   assert (SIZE (smallInt) = SIZE (BYTE), __FILE__, __LINE__) ;
+   assert (SIZE (smallEnum) = SIZE (BYTE), __FILE__, __LINE__) ;
+   assert (SIZE (si) = SIZE (BYTE), __FILE__, __LINE__) ;
+   assert (SIZE (se) = SIZE (BYTE), __FILE__, __LINE__) ;
+   se := smallEnum {} ;
+   si := smallInt {} ;
+   INCL (si, 1) ;
+   INCL (se, purple) ;
+   assert (ORD (si) = 2, __FILE__, __LINE__) ;
+   assert (ORD (se) = 32, __FILE__, __LINE__) ;
+   exit (r)
+END onebyte2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/onebyte3.mod b/gcc/testsuite/gm2/iso/run/pass/onebyte3.mod
new file mode 100644
index 00000000000..484c9c6c570
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/onebyte3.mod
@@ -0,0 +1,66 @@
+(* onebyte3.mod stress bit changes on arrays of bytes.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE onebyte3 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT SIZE, ADR, BYTE ;
+
+
+PROCEDURE assert (b: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d:assert failed\n", ADR (file), line) ;
+      r := 1
+   END
+END assert ;
+
+
+TYPE
+   byte = PACKEDSET OF [0..7] ;
+   array = ARRAY [0..10] OF byte ;
+VAR
+   a      : array ;
+   r      : INTEGER ;
+   i, j, k: CARDINAL ;
+BEGIN
+   r := 0 ;
+   FOR i := 0 TO 10 DO
+      (* zap all bytes to zero.  *)
+      FOR k := 0 TO 10 DO
+         a[k] := byte {}
+      END ;
+      (* assign all bits to 1 in byte i.  *)
+      FOR j := 0 TO 7 DO
+         INCL (a[i], j)
+      END ;
+      assert (ORD (a[i]) = 255, __FILE__, __LINE__) ;
+      (* check all other bytes unaffected.  *)
+      FOR k := 0 TO 10 DO
+         IF k # i
+         THEN
+            assert (ORD (a[k]) = 0, __FILE__, __LINE__);
+         END
+      END
+   END ;
+   exit (r)
+END onebyte3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/packed.mod b/gcc/testsuite/gm2/iso/run/pass/packed.mod
new file mode 100644
index 00000000000..401a6998f71
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/packed.mod
@@ -0,0 +1,57 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE packed ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT CAST, SHIFT ;
+
+
+PROCEDURE Assert (b: BOOLEAN; file: ARRAY OF CHAR; line: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d: assert failed\n", file, line)
+   END
+END Assert ;
+
+
+(*
+   tests based on ISO standard, note 4 on Page 361 
+*)
+
+PROCEDURE test ;
+VAR
+   v: CARDINAL ;
+BEGIN
+   Assert(CAST(CARDINAL, BITSET{0}) = VAL(CARDINAL, 1), __FILE__, __LINE__) ;
+   v := MAX(CARDINAL)-1 ;
+   WHILE v>0 DO
+      Assert(CAST(CARDINAL, SHIFT(CAST(BITSET, v), -1)) = v DIV 2, __FILE__, __LINE__) ;
+      v := v DIV 2
+   END ;
+   v := MAX(CARDINAL) DIV 2 ;
+   WHILE v>0 DO
+      Assert(CAST(CARDINAL, SHIFT(CAST(BITSET, v), 1)) = v*2, __FILE__, __LINE__) ;
+      v := v DIV 2
+   END
+END test ;
+
+
+BEGIN
+   test
+END packed.
diff --git a/gcc/testsuite/gm2/iso/run/pass/proc.c b/gcc/testsuite/gm2/iso/run/pass/proc.c
new file mode 100644
index 00000000000..2321809d5f6
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/proc.c
@@ -0,0 +1,17 @@
+
+typedef  void (*p1)(void);
+typedef  void (*proc)(p1);
+
+void myfunc (p1 p)
+{
+}
+
+void test (void) {}
+
+main()
+{
+  proc foo;
+
+  foo = myfunc;
+  foo(test);
+}
diff --git a/gcc/testsuite/gm2/iso/run/pass/proc.mod b/gcc/testsuite/gm2/iso/run/pass/proc.mod
new file mode 100644
index 00000000000..e8476e76c2e
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/proc.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE proc ;
+
+PROCEDURE test2 (p: MyProcType) ;
+BEGIN
+END test2 ;
+
+PROCEDURE test3 (p: MyProcType) ;
+BEGIN
+END test3 ;
+
+TYPE
+   MyProcType = PROCEDURE (MyProcType) ;
+
+PROCEDURE bar ;
+VAR
+   h : POINTER TO CHAR ;
+   i : CARDINAL ;
+   j : MyProcType ;
+   k : MyProcType ;
+   l : CARDINAL ;
+BEGIN
+   i := 123 ;
+   j := test2 ;
+   k := test2 ;
+   l := 456
+(*   p2(test3) *)
+END bar ;
+
+BEGIN
+   bar
+END proc.
diff --git a/gcc/testsuite/gm2/iso/run/pass/proc2.mod b/gcc/testsuite/gm2/iso/run/pass/proc2.mod
new file mode 100644
index 00000000000..362fbf962be
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/proc2.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE proc2 ;
+
+IMPORT ConvTypes ;
+
+TYPE
+   type = ConvTypes.ScanState ;
+
+
+PROCEDURE ScanInt (inputCh: CHAR;
+                   VAR chClass: ConvTypes.ScanClass;
+                   VAR nextState: ConvTypes.ScanState) ;
+BEGIN
+END ScanInt ;
+
+PROCEDURE foo () : type ;
+BEGIN
+   (* should cause an error (type) *)
+   RETURN ScanInt
+END foo ;
+
+VAR
+   p : ConvTypes.ScanState ;
+   ch: CHAR ;
+   c : ConvTypes.ScanClass ;
+   n : ConvTypes.ScanState ;
+BEGIN
+   p := ScanInt ;
+   p(ch, c, n)
+END proc2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/returnrecord.mod b/gcc/testsuite/gm2/iso/run/pass/returnrecord.mod
new file mode 100644
index 00000000000..97217906238
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/returnrecord.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE returnrecord ;
+
+IMPORT SYSTEM ;
+FROM libc IMPORT exit ;
+
+TYPE
+   bar = RECORD
+            a, b, c: SYSTEM.CARDINAL8 ;
+         END ;
+
+PROCEDURE foo () : bar ;
+BEGIN
+   RETURN bar{1, 2, 3}
+END foo ;
+
+VAR
+   r: bar ;
+BEGIN
+   r := foo() ;
+   IF r.a#1
+   THEN
+      exit(1)
+   END ;
+   IF r.b#2
+   THEN
+      exit(2)
+   END ;
+   IF r.c#3
+   THEN
+      exit(3)
+   END
+END returnrecord.
diff --git a/gcc/testsuite/gm2/iso/run/pass/shift.mod b/gcc/testsuite/gm2/iso/run/pass/shift.mod
new file mode 100644
index 00000000000..be33714c344
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/shift.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE shift ;
+
+FROM libc IMPORT exit ;
+FROM SYSTEM IMPORT SHIFT ;
+
+VAR
+   b: BITSET ;
+   i: INTEGER ;
+BEGIN
+   b := BITSET{1, 2, 3} ;
+   b := SHIFT(b, 1) ;
+   IF b#BITSET{2, 3, 4}
+   THEN
+      exit(1)
+   END ;
+   b := BITSET{1, 2, 3} ;
+   b := SHIFT(b, -1) ;
+   IF b#BITSET{0, 1, 2}
+   THEN
+      exit(2)
+   END ;
+   i := -1 ;
+   b := BITSET{1, 2, 3} ;
+   b := SHIFT(b, i) ;
+   IF b#BITSET{0, 1, 2}
+   THEN
+      exit(3)
+   END
+END shift.
diff --git a/gcc/testsuite/gm2/iso/run/pass/shift2.mod b/gcc/testsuite/gm2/iso/run/pass/shift2.mod
new file mode 100644
index 00000000000..dc97723fc2b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/shift2.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE shift2 ;
+
+FROM libc IMPORT exit ;
+FROM SYSTEM IMPORT SHIFT ;
+
+TYPE
+   large = SET OF [0..1023] ;
+VAR
+   b: large ;
+BEGIN
+   b := large{1, 2, 3} ;
+   b := SHIFT(b, 1) ;
+   IF b#large{2, 3, 4}
+   THEN
+      exit(1)
+   END ;
+   b := large{1, 2, 3} ;
+   b := SHIFT(b, -1) ;
+   IF b#large{0, 1, 2}
+   THEN
+      exit(2)
+   END
+END shift2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/shift3.mod b/gcc/testsuite/gm2/iso/run/pass/shift3.mod
new file mode 100644
index 00000000000..6d6244069d0
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/shift3.mod
@@ -0,0 +1,65 @@
+(* Copyright (C) 2004, 2005, 2006 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 2, 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. *)
+
+MODULE shift3 ;
+
+FROM libc IMPORT exit ;
+FROM SYSTEM IMPORT SHIFT ;
+
+PROCEDURE Check (a, b: large) ;
+BEGIN
+   IF a#b
+   THEN
+      exit(1)
+   END
+END Check ;
+
+
+PROCEDURE DoIt (s: large; v: INTEGER; r: large) ;
+BEGIN
+   s := SHIFT(s, v) ;
+   IF s#r
+   THEN
+      exit(2)
+   END
+END DoIt ;
+
+
+TYPE
+   large = SET OF [0..1023] ;
+VAR
+   b: large ;
+   i: INTEGER ;
+BEGIN
+   b := large{1, 2, 3} ;
+   b := SHIFT(b, 1) ;
+   Check(b, large{2, 3, 4}) ;
+   b := large{1, 2, 3} ;
+   b := SHIFT(b, -1) ;
+   Check(b, large{0, 1, 2}) ;
+   i := 1 ;
+   b := large{1, 2, 3} ;
+   DoIt(b, i, large{2, 3, 4}) ;
+   i := -1 ;
+   b := large{3, 4, 5} ;
+   DoIt(b, i, large{2, 3, 4})
+END shift3.
+(*
+ * Local variables:
+ *  compile-command: "gm2 -Wiso -c -g -I. shift3.mod"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/iso/run/pass/shift4.mod b/gcc/testsuite/gm2/iso/run/pass/shift4.mod
new file mode 100644
index 00000000000..26b2d53d904
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/shift4.mod
@@ -0,0 +1,76 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE shift4 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT SHIFT, BITSPERLOC ;
+
+TYPE
+   large = SET OF [0..1023] ;
+VAR
+   r   : INTEGER ;
+   i   : INTEGER ;
+   b, c: large ;
+BEGIN
+   r := 0 ;
+   b := large{1, 2, 3, 1022} ;
+   b := SHIFT(b, 1) ;
+   IF b#large{2, 3, 4, 1023}
+   THEN
+      exit(1)
+   END ;
+   b := large{1, 2, 3, 1023} ;
+   b := SHIFT(b, -1) ;
+   IF b#large{0, 1, 2, 1022}
+   THEN
+      exit(2)
+   END ;
+   b := large{1+SIZE(BITSET)*BITSPERLOC} ;
+   b := SHIFT(b, -1) ;
+   IF b#large{SIZE(BITSET)*BITSPERLOC}
+   THEN
+      exit(3)
+   END ;
+   b := SHIFT(b, -1) ;
+   IF b#large{SIZE(BITSET)*BITSPERLOC-1}
+   THEN
+      exit(4)
+   END ;
+   FOR i := 0 TO MAX(large) DO
+      b := large{0} ;
+      b := SHIFT(b, i) ;
+      c := large{i} ;
+      IF b#c
+      THEN
+         printf("failed shift left in loop on iteration %d\n", i) ;
+         r := 5
+      END
+   END ;
+   FOR i := 0 TO MAX(large) DO
+      b := large{i} ;
+      b := SHIFT(b, -i) ;
+      c := large{0} ;
+      IF b#c
+      THEN
+         printf("failed shift right in loop on iteration %d\n", i) ;
+         r := 6
+      END
+   END ;
+   printf("all done\n") ;
+   exit(r)
+END shift4.
diff --git a/gcc/testsuite/gm2/iso/run/pass/simple b/gcc/testsuite/gm2/iso/run/pass/simple
new file mode 100644
index 00000000000..6fd88fadfc5
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/simple
@@ -0,0 +1,39 @@
+#!/bin/sh
+
+# Copyright (C) 2005 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 2, 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.
+
+
+function runit () {
+   ./a.out 
+    code=$?
+    if [ $code != 0 ] ; then
+       echo $1 failed with $code
+    fi
+}
+
+gm2 -I. -Wiso -g $1 -c shift.mod
+gm2 -I. -Wiso -g $1 -c shift2.mod
+gm2 -I. -Wiso -g $1 -c -Wcpp testsystem.mod
+gm2 -I. -Wiso -g $1 -c ../../../../../gm2/gm2-iso/SYSTEM.mod
+
+gm2 -I. -Wiso -g $1 shift.mod
+runit shift.mod
+gm2 -I. -Wiso -g $1 shift2.mod
+runit shift2.mod
+gm2 -I. -Wiso -g $1 testsystem.mod
+runit testsystem.mod
diff --git a/gcc/testsuite/gm2/iso/run/pass/simplelarge.mod b/gcc/testsuite/gm2/iso/run/pass/simplelarge.mod
new file mode 100644
index 00000000000..7ca337b46b6
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/simplelarge.mod
@@ -0,0 +1,121 @@
+(* Copyright (C) 2014 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 2, 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. *)
+
+MODULE simplelarge ;
+
+FROM STextIO IMPORT WriteString, WriteLn, WriteChar, ReadToken, SkipLine ;
+FROM SWholeIO IMPORT WriteCard, WriteInt ;
+FROM WholeStr IMPORT StrToCard, ConvResults ;
+FROM SYSTEM IMPORT CARDINAL8 ;
+FROM libc IMPORT printf ;
+
+CONST
+   BoardX         =              16 ;
+   BoardY         =              16 ;
+   BoardSize      = BoardX * BoardY ;
+
+TYPE
+   Squares = [0..BoardSize-1] ;
+   SoS     = SET OF Squares ;
+   Colour  = (Blue, Red, Green, White) ;
+
+VAR
+   homeBase: ARRAY [MIN(Colour)..MAX(Colour)] OF SoS ;
+
+
+PROCEDURE dumpSet (c: Colour) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   printf ("inside dumpSet (%d)\n", ORD(c)) ;
+   printf ("      :  0 2 4 6 8 a c e \n") ;
+   FOR n := MIN(Squares) TO MAX(Squares) DO
+      IF n MOD 16 = 0
+      THEN
+         printf ("\nrow %2d:  ", n DIV 16)
+      END ;
+      IF n IN homeBase[c]
+      THEN
+         printf ("1")
+      ELSE
+         printf ("0")
+      END
+   END ;
+   printf ("\n")
+END dumpSet ;
+
+
+(*
+   assert - 
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      WriteString('assert failed') ; WriteLn ;
+      HALT
+   END
+END assert ;
+
+
+BEGIN
+   homeBase[Red] := SoS {} ;
+   dumpSet(Red) ;
+   homeBase[Blue] := SoS {0, 1, 2, 3,
+                          16, 17, 18, 19,
+                          32, 33, 34,
+                          48, 49} ;
+
+   dumpSet(Blue) ;
+
+   assert (0 IN homeBase[Blue]) ;
+   assert (1 IN homeBase[Blue]) ;
+   assert (2 IN homeBase[Blue]) ;
+   assert (3 IN homeBase[Blue]) ;
+
+(*
+   homeBase[Red] := SoS {255-0, 255-1, 255-2, 255-3,
+                         255-16, 255-17, 255-18, 255-19,
+                         255-32, 255-33, 255-34,
+                         255-48, 255-49} ;
+*)
+
+   homeBase[Blue] := homeBase[Blue] + SoS {4, 20, 35, 50, 65, 64} ;
+   dumpSet(Blue) ;
+   dumpSet(Red) ;
+   assert (homeBase[Red] = SoS {}) ;
+
+(*
+   homeBase[Red] := homeBase[Red] + SoS {255-4, 255-20, 255-35, 255-50, 255-65, 255-64} ;
+*)
+
+   assert (0 IN homeBase[Blue]) ;
+   assert (1 IN homeBase[Blue]) ;
+   assert (2 IN homeBase[Blue]) ;
+   assert (3 IN homeBase[Blue]) ;
+   assert (4 IN homeBase[Blue]) ;
+   assert (NOT (5 IN homeBase[Blue])) ;
+   assert (NOT (6 IN homeBase[Blue])) ;
+
+   assert (homeBase[Red] = SoS {})
+END simplelarge.
+(*
+ * Local variables:
+ *  compile-command: "gm2 -g -fiso simplelarge.mod"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/iso/run/pass/strcons.mod b/gcc/testsuite/gm2/iso/run/pass/strcons.mod
new file mode 100644
index 00000000000..6fe57c2530b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/strcons.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE strcons ;
+
+
+TYPE
+   NameType = ARRAY [0..24] OF CHAR ;
+   DateType = RECORD
+                 year, month, day: CARDINAL ;
+              END ;
+   PersonType = RECORD
+                   name: NameType ;
+                   DateOfBirth: DateType ;
+                END ;
+VAR
+   year, month, day: CARDINAL ;
+   date            : DateType ;
+   person          : PersonType ;
+BEGIN
+   date := DateType{year, month, day} ;
+   date := DateType{1623, 6, 19} ;
+   person := PersonType{"Blaise Pascal", date} ;
+END strcons.
diff --git a/gcc/testsuite/gm2/iso/run/pass/strcons2.mod b/gcc/testsuite/gm2/iso/run/pass/strcons2.mod
new file mode 100644
index 00000000000..f2f30c78207
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/strcons2.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE strcons2 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   DateType = RECORD
+                 year, month, day: CARDINAL ;
+              END ;
+
+
+PROCEDURE foo (VAR d: DateType; year, month, day: CARDINAL) ;
+BEGIN
+   d := DateType{year, month, day}
+END foo ;
+
+
+VAR
+   date: DateType ;
+BEGIN
+   foo(date, 1623, 6, 19) ;
+   IF (date.year#1623) OR (date.month#6) OR (date.day#19)
+   THEN
+      exit(1)
+   END
+END strcons2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/t.cpp b/gcc/testsuite/gm2/iso/run/pass/t.cpp
new file mode 100644
index 00000000000..92a93849726
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/t.cpp
@@ -0,0 +1,19 @@
+extern "C" void *malloc (int);
+extern "C" void _M2_except5_init (void);
+extern "C" int printf (const char *, ...);
+extern "C" void Storage_ALLOCATE (void **p, unsigned int s);
+
+void Storage_ALLOCATE (void **p, unsigned int s)
+{
+   (*p) = malloc (s);
+}
+
+main()
+{
+   try {
+     _M2_except5_init ();
+   }
+   catch (...) {
+      printf("caught in C++ main\n");
+   }
+}
diff --git a/gcc/testsuite/gm2/iso/run/pass/t1.cpp b/gcc/testsuite/gm2/iso/run/pass/t1.cpp
new file mode 100644
index 00000000000..f8c2deb4e72
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/t1.cpp
@@ -0,0 +1,14 @@
+extern "C" void *malloc (int);
+extern "C" void _M2_except5_init (void);
+extern "C" int printf (const char *, ...);
+extern "C" void Storage_ALLOCATE (void **p, unsigned int s);
+
+void Storage_ALLOCATE (void **p, unsigned int s)
+{
+   (*p) = malloc (s);
+}
+
+main()
+{
+   _M2_except5_init ();
+}
diff --git a/gcc/testsuite/gm2/iso/run/pass/testLength.mod b/gcc/testsuite/gm2/iso/run/pass/testLength.mod
new file mode 100644
index 00000000000..248066339aa
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/testLength.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE testLength ;   (*!m2iso*)
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn, WriteString ;
+FROM M2RTS IMPORT Length ;
+
+VAR
+   s: ARRAY [0..50] OF CHAR ;
+BEGIN
+   s := "What?";
+
+   WriteString("LENGTH(s) reports ") ;
+   WriteCard(LENGTH(s), 4) ; WriteLn ;
+
+   WriteString("Length(s) reports ") ;
+   WriteCard(Length(s), 4) ; WriteLn ;
+END testLength.
diff --git a/gcc/testsuite/gm2/iso/run/pass/testarray.mod b/gcc/testsuite/gm2/iso/run/pass/testarray.mod
new file mode 100644
index 00000000000..bacfe817f44
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/testarray.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testarray ;
+
+TYPE
+   ArrayType = ARRAY [0..15] OF INTEGER ;
+
+CONST
+   MyConst = ArrayType{0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15};
+
+VAR
+   a: ArrayType ;
+BEGIN
+   a := MyConst
+END testarray.
diff --git a/gcc/testsuite/gm2/iso/run/pass/testgeneric.mod b/gcc/testsuite/gm2/iso/run/pass/testgeneric.mod
new file mode 100644
index 00000000000..f00afbd3204
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/testgeneric.mod
@@ -0,0 +1,60 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE testgeneric ;
+
+FROM SYSTEM IMPORT WORD32, ADR ;
+FROM libc IMPORT printf, exit ;
+
+
+VAR
+   test: CARDINAL ;
+   code: INTEGER ;
+
+PROCEDURE assert (b: BOOLEAN; a: ARRAY OF CHAR) ;
+BEGIN
+   INC (test) ;
+   IF NOT b
+   THEN
+      printf ("failed test %d which was %a\n", ADR(a)) ;
+      code := 1
+   END
+END assert ;
+
+
+VAR
+   w: WORD32 ;
+   c: CARDINAL ;
+   i: INTEGER ;
+BEGIN
+   code := 0 ;
+   test := 0 ;
+   c := 1 ;
+   IF SIZE(w)=SIZE(c)
+   THEN
+      w := c ;
+      i := w ;
+      assert (CARDINAL(i) = c, "copying data through WORD32")
+   END ;
+
+   w := 1 ;
+   i := w ;
+   assert (i=1, "assigning const into a WORD32") ;
+   
+   exit (code)
+END testgeneric.
diff --git a/gcc/testsuite/gm2/iso/run/pass/testlarge.mod b/gcc/testsuite/gm2/iso/run/pass/testlarge.mod
new file mode 100644
index 00000000000..a91dda1d57e
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/testlarge.mod
@@ -0,0 +1,292 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE testlarge ;
+
+FROM STextIO IMPORT WriteString, WriteLn, WriteChar, ReadToken, SkipLine ;
+FROM SWholeIO IMPORT WriteCard, WriteInt ;
+FROM Strings IMPORT Length ;
+FROM Selective IMPORT Timeval, GetTimeOfDay, GetTime, InitTime, KillTime ;
+FROM WholeStr IMPORT StrToCard, ConvResults ;
+FROM SYSTEM IMPORT CARDINAL8 ;
+
+CONST
+   TwoPlayer      =            TRUE ;
+   FourPlayer     =           FALSE ;
+   BoardX         =              16 ;
+   BoardY         =              16 ;
+   BoardSize      = BoardX * BoardY ;
+   Pieces         =              19 ;   (* total pieces per player on the board  *)
+   PieceHeap      =            4000 ;   (* maximum moves we will examine per ply *)
+   MaxScore       =          100000 ;
+   MinScore       =         -100000 ;
+   WinScore       =        MaxScore ;
+   LooseScore     =       -WinScore ;
+   Debugging      =           FALSE ;
+   Thinking       =              10 ;   (* how many seconds can the program think? *)
+   slowEvaluation =           FALSE ;
+   HomeWeight     =          BoardX ;
+
+TYPE
+   Squares = [0..BoardSize-1] ;
+   SoS     = SET OF Squares ;
+   Colour  = (Blue, Red, Green, White) ;
+
+   Board = RECORD
+              used  : SoS ;   (* is the square used at all? *)
+              colour: ARRAY [0..1] OF SoS ;   (* if so which colour occupies the square? *)
+              pieces: ARRAY [MIN(Colour)..MAX(Colour)] OF ARRAY [1..Pieces] OF CARDINAL8 ;
+              home  : ARRAY [MIN(Colour)..MAX(Colour)] OF CARDINAL ;
+           END ;
+
+
+VAR
+   homeBase: ARRAY [MIN(Colour)..MAX(Colour)] OF SoS ;
+
+
+(*
+   +-----------------------------------------------------------------+
+   | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 |
+   |                                                                 |
+   | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 |
+   |                                                                 |
+   | 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 |
+   |                                                                 |
+   | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 |
+   |                                                                 |
+   | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 |
+   |                                                                 |
+   | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 |
+   |                                                                 |
+   | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 |
+   |                                                                 |
+   | 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 |
+   |                                                                 |
+   | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
+   |                                                                 |
+   |  96  97  98  99 100 101 102 103 104 105 106 107 108 109 110 111 |
+   |                                                                 |
+   |  80  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95 |
+   |                                                                 |
+   |  64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79 |
+   |---------                                                        |
+   |  48  49 \50  51  52  53  54  55  56  57  58  59  60  61  62  63 |
+   |           \                                                     |
+   |  32  33  34 \35  36  37  38  39  40  41  42  43  44  45  46  47 |
+   |               \                                                 |
+   |  16  17  18  19| 20  21  22  23  24  25  26  27  28  29  30  31 |
+   |                |                                                |
+   |   0   1   2   3|  4   5   6   7   8   9  10  11  12  13  14  15 |
+   +-----------------------------------------------------------------+
+*)
+
+
+(*
+   stop - 
+*)
+
+PROCEDURE stop ;
+BEGIN
+END stop ;
+
+
+(*
+   Min - 
+*)
+
+PROCEDURE Min (a, b: INTEGER) : INTEGER ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+(*
+   assert - 
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      WriteString('assert failed') ; WriteLn ;
+      HALT
+   END
+END assert ;
+
+
+(*
+   isUsed - return whether a square, p, is in use on board, b.
+*)
+
+PROCEDURE isUsed (VAR b: Board; p: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN p IN b.used
+END isUsed ;
+   
+
+(*
+   isColour - return TRUE if a square, p, is used and contains a
+              piece of colour, c.
+*)
+
+PROCEDURE isColour (VAR b: Board; p: CARDINAL; c: Colour) : BOOLEAN ;
+BEGIN
+   WITH b DO
+      IF p IN used
+      THEN
+         CASE c OF
+
+         Blue:  RETURN (NOT (p IN colour[0])) AND (NOT (p IN colour[1])) |
+         Red :  RETURN (p IN colour[0]) AND (NOT (p IN colour[1])) |
+         Green: RETURN (NOT (p IN colour[0])) AND (p IN colour[1]) |
+         White: RETURN (p IN colour[0]) AND (p IN colour[1])
+
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END isColour ;
+
+
+(*
+   addPiece - adds a piece, pos, of colour, c, to the board, b.
+*)
+
+PROCEDURE addPiece (VAR b: Board; pos: CARDINAL; c: Colour; piece: CARDINAL) ;
+BEGIN
+   WITH b DO
+      INCL(used, pos) ;
+      CASE c OF
+
+      Blue:  EXCL(colour[0], pos) ;
+             EXCL(colour[1], pos) |
+      Red :  INCL(colour[0], pos) ;
+             EXCL(colour[1], pos) |
+      Green: EXCL(colour[0], pos) ;
+             INCL(colour[1], pos) |
+      White: INCL(colour[0], pos) ;
+             INCL(colour[1], pos)
+
+      END ;
+      pieces[c][piece] := pos ;
+      IF pos IN homeBase[c]
+      THEN
+         stop ;
+         INC(home[c])
+      END
+   END
+END addPiece ;
+
+
+(*
+   initBoard - 
+*)
+
+PROCEDURE initBoard (VAR b: Board) ;
+BEGIN
+   b.used := SoS {} ;
+   b.colour[0] := SoS {} ;
+   b.colour[1] := SoS {} ;
+   b.home[Blue] := 0 ;
+   b.home[Red] := 0 ;
+   b.home[Green] := 0 ;
+   b.home[White] := 0 ;
+   IF TwoPlayer OR FourPlayer
+   THEN
+      (* red *)
+      addPiece(b,  0, Red, 1) ;
+      addPiece(b,  1, Red, 2) ;
+      addPiece(b,  2, Red, 3) ;
+      addPiece(b,  3, Red, 4) ;
+      addPiece(b, 16, Red, 5) ;
+      addPiece(b, 17, Red, 6) ;
+      addPiece(b, 18, Red, 7) ;
+      addPiece(b, 19, Red, 8) ;
+      addPiece(b, 32, Red, 9) ;
+      addPiece(b, 33, Red, 10) ;
+      addPiece(b, 34, Red, 11) ;
+      addPiece(b, 48, Red, 12) ;
+      addPiece(b, 49, Red, 13) ;
+
+      homeBase[Blue] := SoS{0, 1, 2, 3,
+                            16, 17, 18, 19,
+                            32, 33, 34,
+                            48, 49} ;
+
+      (* blue *)
+      addPiece(b, 255-0, Blue, 1) ;
+      addPiece(b, 255-1, Blue, 2) ;
+      addPiece(b, 255-2, Blue, 3) ;
+      addPiece(b, 255-3, Blue, 4) ;
+      addPiece(b, 255-16, Blue, 5) ;
+      addPiece(b, 255-17, Blue, 6) ;
+      addPiece(b, 255-18, Blue, 7) ;
+      addPiece(b, 255-19, Blue, 8) ;
+      addPiece(b, 255-32, Blue, 9) ;
+      addPiece(b, 255-33, Blue, 10) ;
+      addPiece(b, 255-34, Blue, 11) ;
+      addPiece(b, 255-48, Blue, 12) ;
+      addPiece(b, 255-49, Blue, 13) ;
+
+      homeBase[Red] := SoS{255-0, 255-1, 255-2, 255-3,
+                           255-16, 255-17, 255-18, 255-19,
+                           255-32, 255-33, 255-34,
+                           255-48, 255-49}
+   END ;
+   IF TwoPlayer
+   THEN
+      (* red *)
+      addPiece(b,  4, Red, 14) ;
+      addPiece(b, 20, Red, 15) ;
+      addPiece(b, 35, Red, 16) ;
+      addPiece(b, 50, Red, 17) ;
+      addPiece(b, 65, Red, 18) ;
+      addPiece(b, 64, Red, 19) ;
+      homeBase[Blue] := homeBase[Blue] + SoS{4, 20, 35, 50, 65, 64} ;
+
+      (* blue *)
+      addPiece(b, 255-4, Blue, 14) ;
+      addPiece(b, 255-20, Blue, 15) ;
+      addPiece(b, 255-35, Blue, 16) ;
+      addPiece(b, 255-50, Blue, 17) ;
+      addPiece(b, 255-65, Blue, 18) ;
+      addPiece(b, 255-64, Blue, 19) ;
+
+      homeBase[Red] := homeBase[Red] + SoS{255-4, 255-20, 255-35, 255-50, 255-65, 255-64}
+   END ;
+   assert(b.home[Blue] = 0) ;
+   assert(b.home[Red] = 0) ;
+   assert(b.home[Green] = 0) ;
+   assert(b.home[White] = 0)
+END initBoard ;
+
+
+VAR
+   b: Board ;
+BEGIN
+   initBoard(b)
+END testlarge.
+(*
+ * Local variables:
+ *  compile-command: "gm2 -g -fiso testlarge.mod"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/iso/run/pass/testsystem.mod b/gcc/testsuite/gm2/iso/run/pass/testsystem.mod
new file mode 100644
index 00000000000..c22f25be0c6
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/testsystem.mod
@@ -0,0 +1,180 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testsystem ;
+
+FROM SYSTEM IMPORT BITSPERLOC, LOCSPERWORD,
+                   LOC, BYTE, WORD, ADDRESS,
+                   ADDADR, SUBADR, DIFADR, MAKEADR, ADR, ROTATE,
+                   SHIFT, TSIZE ;
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM FIO IMPORT Close, StdOut ;
+
+
+PROCEDURE FindFirstElement (start: CARDINAL; s: LargeSet) : CARDINAL ;
+BEGIN
+   WHILE NOT (start IN s) DO
+      INC(start)
+   END ;
+   RETURN( start )
+END FindFirstElement ;
+
+
+PROCEDURE FindLastElement (start: CARDINAL; s: LargeSet) : CARDINAL ;
+BEGIN
+   WHILE (start+1<1024) AND ((start+1) IN s) DO
+      INC(start)
+   END ;
+   RETURN( start )
+END FindLastElement ;
+
+
+PROCEDURE debug (s: LargeSet) ;
+VAR
+   lo, hi: CARDINAL ;
+BEGIN
+   IF s=LargeSet{}
+   THEN
+      WriteString('{}')
+   ELSE
+      WriteString('{') ;
+      lo := FindFirstElement(0, s) ;
+      hi := FindLastElement(lo, s) ;
+      WHILE hi<1024 DO
+         IF hi=lo
+         THEN
+            WriteCard(lo, 0)
+         ELSE
+            WriteCard(lo, 0) ; WriteString('..') ; WriteCard(hi, 0)
+         END ;
+         lo := FindFirstElement(hi+1, s) ;
+         hi := FindLastElement(lo, s) ;
+         IF hi<1024
+         THEN
+            WriteString(', ')
+         END
+      END ;
+      WriteString('}')
+   END ;
+   WriteLn
+END debug ;
+
+
+(*
+ *   purpose of testsystem is to check that all ISO SYSTEM functions are
+ *   implemented, compile and run.
+ *)
+
+TYPE
+   LargeSet = SET OF [0..1023] ;
+   SmallSet = SET OF [0..3] ;
+
+VAR
+   a1, a2: ADDRESS ;
+   b1, b2: BYTE ;
+   s1, s2: BITSET ;
+   s3, s4: LargeSet ;
+   c1, c2: CARDINAL ;
+   w     : WORD ;
+   l     : LOC ;
+   array : ARRAY [0..TSIZE(ADDRESS)-1] OF LOC ;
+   s5, s6: SmallSet ;
+BEGIN
+   a1 := ADR(array) ;
+   a2 := ADDADR(a1, TSIZE(LOC)) ;
+   IF SUBADR(a2, TSIZE(LOC))#a1
+   THEN
+      Close(StdOut) ;
+      exit(1)
+   END ;
+   IF DIFADR(a2, a1) # INTEGER (TSIZE (LOC))
+   THEN
+      Close(StdOut) ;
+      exit(2)
+   END ;
+   a1 := MAKEADR (ADDRESS (0)) ;
+   IF a1#NIL
+   THEN
+      Close(StdOut) ;
+      exit(3)
+   END ;
+
+(*
+#if defined(__x86_64)
+   a1 := MAKEADR(BYTE(0ABH), BYTE(0CDH)) ;
+   a1 := MAKEADR(BYTE(0FEH), BYTE(0DCH), BYTE(0BAH), BYTE(098H),
+                 BYTE(076H), BYTE(054H), BYTE(032H), BYTE(010H)) ;
+
+   a1 := MAKEADR(CARDINAL(123456789), CARDINAL(987654321)) ;
+#endif
+*)
+   s3 := LargeSet{0, 1, 31, 32, 33, 63, 64, 65, 127, 128, 129} ;
+   debug(s3) ;
+   s4 := SHIFT(s3, -1) ;
+   debug(s4) ;
+   IF s4#LargeSet{0, 30, 31, 32, 62, 63, 64, 126, 127, 128}
+   THEN
+      Close(StdOut) ;
+      exit(4)
+   END ;
+   s4 := SHIFT(s4, 1) ;
+   debug(s4) ;
+   IF s4#LargeSet{1, 31, 32, 33, 63, 64, 65, 127, 128, 129}
+   THEN
+      Close(StdOut) ;
+      exit(5)
+   END ;
+   s5 := SmallSet{0, 1} ;
+   s6 := ROTATE(s5, 1) ;
+   IF s6#SmallSet{1, 2}
+   THEN
+      Close(StdOut) ;
+      exit(6)
+   END ;
+   s5 := SmallSet{0, 1} ;
+   s6 := ROTATE(s5, -1) ;
+   IF s6#SmallSet{0, 3}
+   THEN
+      Close(StdOut) ;
+      exit(7)
+   END ;
+   s3 := LargeSet{0, 1, 31, 32, 33, 63, 64, 65, 127, 128, 129} ;
+   debug(s3) ;
+   s4 := ROTATE(s3, -1) ;
+   debug(s4) ;
+   IF s4#LargeSet{1023, 0, 30, 31, 32, 62, 63, 64, 126, 127, 128}
+   THEN
+      Close(StdOut) ;
+      exit(8)
+   END ;
+   s3 := LargeSet{1, 31, 32, 33, 63, 64, 65, 127, 128, 129, 255, 1023} ;
+   debug(s3) ;
+   s4 := ROTATE(s3, 1) ;
+   debug(s4) ;
+   IF s4#LargeSet{0, 2, 32, 33, 34, 64, 65, 66, 128, 129, 130, 256}
+   THEN
+      Close(StdOut) ;
+      exit(9)
+   END
+END testsystem.
+(*
+ * Local variables:
+ *  compile-command: "gm2 -Wcpp -Wiso -c -g -I. testsystem.mod"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/iso/run/pass/tinyconst.mod b/gcc/testsuite/gm2/iso/run/pass/tinyconst.mod
new file mode 100644
index 00000000000..42875480e08
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tinyconst.mod
@@ -0,0 +1,48 @@
+(* tinyconst.mod minimal array access test.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE tinyconst ;
+
+FROM libc IMPORT printf, exit ;
+
+TYPE
+   array = ARRAY [0..25] OF CHAR ;
+
+CONST
+   str = array { "A", "B", "C", "D", "E", "F", "G", "H",
+                 "I", "J", "K", "L", "M", "N", "O", "P",
+                 "Q", "R", "S", "T", "U", "V", "W", "X",
+                 "Y", "Z" } ;
+
+VAR
+   z: CHAR ;
+   r: INTEGER ;
+BEGIN
+   z := str[25] ;
+   printf ("z should be z = %c\n", z) ;
+   IF z = 'Z'
+   THEN
+      r := 0
+   ELSE
+      r := 1
+   END ;
+   exit (r)
+END tinyconst.
diff --git a/gcc/testsuite/gm2/iso/run/pass/tinyconst2.mod b/gcc/testsuite/gm2/iso/run/pass/tinyconst2.mod
new file mode 100644
index 00000000000..9cf65220087
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tinyconst2.mod
@@ -0,0 +1,50 @@
+(* tinyconst2.mod minimal array access test.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE tinyconst2 ;
+
+FROM libc IMPORT printf, exit ;
+
+TYPE
+   array = ARRAY [0..25] OF CHAR ;
+
+CONST
+   str = array { "A", "B", "C", "D", "E", "F", "G", "H",
+                 "I", "J", "K", "L", "M", "N", "O", "P",
+                 "Q", "R", "S", "T", "U", "V", "W", "X",
+                 "Y", "Z" } ;
+
+VAR
+   z: CHAR ;
+   s: array ;
+   r: INTEGER ;
+BEGIN
+   s := str ;
+   z := s[25] ;
+   printf ("z should be z = %c\n", z) ;
+   IF z = 'Z'
+   THEN
+      r := 0
+   ELSE
+      r := 1
+   END ;
+   exit (r)
+END tinyconst2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/tinyconst3.mod b/gcc/testsuite/gm2/iso/run/pass/tinyconst3.mod
new file mode 100644
index 00000000000..901a0eb3772
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tinyconst3.mod
@@ -0,0 +1,47 @@
+(* tinyconst3.mod minimal array access test.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE tinyconst3 ;
+
+FROM libc IMPORT printf, exit ;
+
+TYPE
+   array = ARRAY [0..25] OF CHAR ;
+
+CONST
+   str = array { "ABCDEFGHIJKLMNOPQRSTUVWXYZ" } ;
+
+VAR
+   z: CHAR ;
+   s: array ;
+   r: INTEGER ;
+BEGIN
+   s := str ;
+   z := s[25] ;
+   printf ("z should be z = %c\n", z) ;
+   IF z = 'Z'
+   THEN
+      r := 0
+   ELSE
+      r := 1
+   END ;
+   exit (r)
+END tinyconst3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/tinyconst4.mod b/gcc/testsuite/gm2/iso/run/pass/tinyconst4.mod
new file mode 100644
index 00000000000..cfcbcca0e48
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tinyconst4.mod
@@ -0,0 +1,46 @@
+(* tinyconst4.mod minimal array access test.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE tinyconst4 ;
+
+FROM libc IMPORT printf, exit ;
+
+TYPE
+   array = ARRAY [0..25] OF CHAR ;
+
+CONST
+   str = array { "ABCDEFGHIJKLMNOPQRSTUVWXYZ" } ;
+
+VAR
+   z: CHAR ;
+   s: array ;
+   r: INTEGER ;
+BEGIN
+   z := str[25] ;
+   printf ("z should be z = %c\n", z) ;
+   IF z = 'Z'
+   THEN
+      r := 0
+   ELSE
+      r := 1
+   END ;
+   exit (r)
+END tinyconst4.
diff --git a/gcc/testsuite/gm2/iso/run/pass/tinyconst5.mod b/gcc/testsuite/gm2/iso/run/pass/tinyconst5.mod
new file mode 100644
index 00000000000..6e98f3d1240
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tinyconst5.mod
@@ -0,0 +1,47 @@
+(* tinyconst5.mod minimal array access test.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE tinyconst5 ;
+
+FROM libc IMPORT printf, exit ;
+
+TYPE
+   array = ARRAY [0..25] OF CHAR ;
+
+CONST
+   str = array { "ABCDEF", "GHIJKL", "MNOPQR", "STUVWX", "YZ" } ;
+
+VAR
+   z: CHAR ;
+   s: array ;
+   r: INTEGER ;
+BEGIN
+   s := str ;
+   z := str[25] ;
+   printf ("z should be z = %c\n", z) ;
+   IF z = 'Z'
+   THEN
+      r := 0
+   ELSE
+      r := 1
+   END ;
+   exit (r)
+END tinyconst5.
diff --git a/gcc/testsuite/gm2/iso/run/pass/tinytimer.mod b/gcc/testsuite/gm2/iso/run/pass/tinytimer.mod
new file mode 100644
index 00000000000..6d43cc9e364
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tinytimer.mod
@@ -0,0 +1,38 @@
+(* tinytimer.mod a trivial timer test.
+
+Copyright (C) 2020 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/>.  *)
+
+MODULE tinytimer ;
+
+FROM Preemptive IMPORT initPreemptive ;
+FROM libc IMPORT printf ;
+
+CONST
+   stackSpace = 1 * 1024 * 1024 ;
+
+BEGIN
+   printf ("starting concurrentstore test\n") ;
+   initPreemptive (0, 10000)
+END tinytimer.
diff --git a/gcc/testsuite/gm2/iso/run/pass/trivialmodulus.mod b/gcc/testsuite/gm2/iso/run/pass/trivialmodulus.mod
new file mode 100644
index 00000000000..f612309fdc2
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/trivialmodulus.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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.  *)
+
+MODULE trivialmodulus ;
+
+FROM libc IMPORT printf ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF 0 MOD 16 = 0
+   THEN
+      printf ("modulus succeeded\n")
+   ELSE
+      printf ("modulus failed\n")
+   END
+END trivialmodulus.
diff --git a/gcc/testsuite/gm2/iso/run/pass/tsize.mod b/gcc/testsuite/gm2/iso/run/pass/tsize.mod
new file mode 100644
index 00000000000..996afc46f9b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tsize.mod
@@ -0,0 +1,60 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE tsize ;
+
+FROM libc IMPORT exit ;
+FROM SYSTEM IMPORT TSIZE ;
+
+TYPE
+   t1 =  RECORD
+            CASE tag: CARDINAL OF
+          ||| 0 : v1 : CHAR;
+          | 1 : v2 : INTEGER;
+            ELSE
+            END
+         END ;
+
+   t2 =  RECORD
+            CASE atag: CARDINAL OF
+          ||| 0 : v1 : CARDINAL;
+          | 1 : v2 : CHAR;
+            ELSE
+            END
+         END ;
+
+
+BEGIN
+   (* incorrect test code commented out
+   IF TSIZE(t1, 0)#SIZE(CHAR)
+   THEN
+      exit(1)
+   END ;
+   IF TSIZE(t1, 1)#SIZE(INTEGER)
+   THEN
+      exit(1)
+   END ;
+   IF TSIZE(t2, 0)#SIZE(CARDINAL)
+   THEN
+      exit(1)
+   END ;
+   IF TSIZE(t2, 1)#SIZE(CHAR)
+   THEN
+      exit(1)
+   END
+   *)
+END tsize.
diff --git a/gcc/testsuite/gm2/iso/run/pass/tsize2.mod b/gcc/testsuite/gm2/iso/run/pass/tsize2.mod
new file mode 100644
index 00000000000..eaf8a250e29
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tsize2.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE tsize2 ;
+
+FROM libc IMPORT exit ;
+FROM SYSTEM IMPORT TSIZE ;
+
+TYPE
+   t1 =  RECORD
+            CASE atag: CARDINAL OF
+          |||||||||||||||||| 0 : v1 : CHAR;
+          | 1 : v2 : INTEGER;
+          ||2 : c3 : LONGINT;
+            ELSE
+            END
+         END ;
+
+
+BEGIN
+(* incorrect test code commented out
+   IF TSIZE(t1, 0)#SIZE(CHAR)
+   THEN
+      exit(1)
+   END ;
+   IF TSIZE(t1, 1)#SIZE(INTEGER)
+   THEN
+      exit(1)
+   END ;
+   IF TSIZE(t1, 2)#SIZE(LONGINT)
+   THEN
+      exit(1)
+   END ;
+   IF TSIZE(t1, 0, 1, 2)#SIZE(LONGINT)
+   THEN
+      exit(1)
+   END
+*)
+END tsize2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/tstLength.mod b/gcc/testsuite/gm2/iso/run/pass/tstLength.mod
new file mode 100644
index 00000000000..0445e47f5ec
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/tstLength.mod
@@ -0,0 +1,22 @@
+MODULE tstLength;
+
+FROM M2RTS IMPORT Length ;
+FROM StrIO IMPORT WriteLn, WriteString ;
+FROM NumberIO IMPORT WriteCard ;
+FROM libc IMPORT exit ;
+
+VAR
+   s: ARRAY [1..5] OF CHAR;
+BEGIN
+   s := "What?";
+
+   WriteString("LENGTH(s) reports ");
+   WriteCard(LENGTH(s), 4); WriteLn;
+
+   WriteString("Length(s) reports ");
+   WriteCard(Length(s), 4); WriteLn;
+   IF LENGTH(s)#Length(s)
+   THEN
+      exit(1)
+   END
+END tstLength.
diff --git a/gcc/testsuite/gm2/iso/run/pass/unbounded.mod b/gcc/testsuite/gm2/iso/run/pass/unbounded.mod
new file mode 100644
index 00000000000..6dd3f0d50cb
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/unbounded.mod
@@ -0,0 +1,69 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+
+PROCEDURE Assert (b: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf ("%s:%d:failure\n", ADR (f), l) ;
+      exit (1)
+   END
+END Assert ;
+
+
+PROCEDURE test (VAR a: ARRAY OF ARRAY OF CHAR) ;
+VAR
+   m, n: CARDINAL ;
+BEGIN
+   m := HIGH (a) ;
+   n := HIGH (a[0]) ;
+   printf ("m = %d, n = %d\n", m, n);
+   a[1, 2] := 'a' ;
+   a[2, 1] := 'c'
+END test ;
+
+
+VAR
+   b   : ARRAY [0..4], [0..5] OF CHAR ;
+   i, j: CARDINAL ;
+BEGIN
+   FOR i := 0 TO 4 DO
+      FOR j := 0 TO 5 DO
+         b[i, j] := 'z'
+      END
+   END ;
+   test (b) ;
+   FOR i := 0 TO 4 DO
+      FOR j := 0 TO 5 DO
+         IF (i = 1) AND (j = 2)
+         THEN
+            Assert (b[1, 2] = 'a', __FILE__, __LINE__)
+         ELSIF (i = 2) AND (j = 1)
+         THEN
+            Assert (b[2, 1] = 'c', __FILE__, __LINE__)
+         ELSE
+            Assert (b[i, j] = 'z', __FILE__, __LINE__)
+         END
+      END
+   END
+END unbounded.
diff --git a/gcc/testsuite/gm2/iso/run/pass/unbounded2.mod b/gcc/testsuite/gm2/iso/run/pass/unbounded2.mod
new file mode 100644
index 00000000000..47af1b3ae33
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/unbounded2.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded2 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+PROCEDURE Assert (b: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d:failure\n", ADR(f), l) ;
+      exit(1)
+   END
+END Assert ;
+
+
+PROCEDURE test (VAR a: ARRAY OF ARRAY OF CHAR) ;
+BEGIN
+   printf('HIGH(a) = %d\n', HIGH(a)) ;
+   printf('HIGH(a[0]) = %d\n', HIGH(a[0])) ;
+   a[0, 1] := 'a' ;
+   a[1, 0] := 'c'
+END test ;
+
+
+VAR
+   b: ARRAY [0..4], [0..5] OF CHAR ;
+   c: ARRAY BOOLEAN OF ARRAY BOOLEAN OF CHAR ;
+BEGIN
+   test(b) ;
+   Assert(b[0, 1]='a', __FILE__, __LINE__) ;
+   Assert(b[1, 0]='c', __FILE__, __LINE__) ;
+   test(c)
+END unbounded2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/unbounded3.mod b/gcc/testsuite/gm2/iso/run/pass/unbounded3.mod
new file mode 100644
index 00000000000..dcf53b71c9a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/unbounded3.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded3 ;
+
+FROM libc IMPORT exit, printf ;
+
+VAR
+   z: CARDINAL ;
+
+PROCEDURE testSize (a: ARRAY OF ARRAY OF ARRAY OF CHAR; s1, s2, s3: CARDINAL) ;
+BEGIN
+   IF s1#SIZE(a)
+   THEN
+      printf("SIZE(a) = %d\n", SIZE(a)) ;
+      exit(1)
+   ELSIF s2#SIZE(a[0])
+   THEN
+      z := SIZE(a[0]) ;
+      printf("SIZE(a[0]) = %d\n", SIZE(a[0])) ;
+      exit(2)
+   ELSIF s3#SIZE(a[0][0])
+   THEN
+      printf("SIZE(a[0][0]) = %d\n", SIZE(a[0][0])) ;
+      exit(3)
+   ELSIF s3#SIZE(a[0,0])
+   THEN
+      printf("SIZE(a[0,0]) = %d\n", SIZE(a[0,0])) ;
+      exit(4)
+   END
+END testSize ;
+
+VAR
+   b: ARRAY [0..4] OF ARRAY [0..5] OF ARRAY [0..1] OF CHAR ;
+BEGIN
+   testSize(b, 60, 12, 2)
+END unbounded3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/unbounded4.mod b/gcc/testsuite/gm2/iso/run/pass/unbounded4.mod
new file mode 100644
index 00000000000..c9a6e6b7073
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/unbounded4.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded4 ;
+
+FROM libc IMPORT printf ;
+
+PROCEDURE assign (VAR p: ARRAY OF ARRAY OF REAL;
+                  q: ARRAY OF ARRAY OF REAL) ;
+VAR
+   i, j, hi, hj: CARDINAL ;
+BEGIN
+   hi := HIGH(p) ;
+   hj := HIGH(p[0]) ;
+   FOR i := 0 TO hi DO
+      FOR j := 0 TO hj DO
+         printf("assigning p[%d,%d]\n", i, j);
+         p[i][j] := q[i,j]
+      END
+   END
+END assign ;
+
+
+VAR
+   a, b: ARRAY [1..3] OF ARRAY [1..3] OF REAL ;
+BEGIN
+   assign(b, a)
+END unbounded4.
diff --git a/gcc/testsuite/gm2/iso/run/pass/unbounded5.mod b/gcc/testsuite/gm2/iso/run/pass/unbounded5.mod
new file mode 100644
index 00000000000..167b2b402d4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/unbounded5.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded5 ;
+
+FROM libc IMPORT exit, printf ;
+
+PROCEDURE assign (VAR a: arrayType) ;
+BEGIN
+   a := arrayType{1, 2, 3, 4, 5, 6, 7, 8, 9}
+END assign ;
+
+TYPE
+   arrayType = ARRAY [1..9] OF CARDINAL ;
+
+VAR
+   a: arrayType ;
+BEGIN
+   assign(a) ;
+   IF (a[1]#1) AND (a[2]#2) AND (a[3]#3)
+   THEN
+      printf("assignment failed\n") ;
+      exit(1)
+   END ;
+   IF (a[4]#4) AND (a[5]#5) AND (a[6]#6)
+   THEN
+      printf("assignment failed\n") ;
+      exit(2)
+   END ;
+   IF (a[7]#7) AND (a[8]#8) AND (a[9]#9)
+   THEN
+      printf("assignment failed\n") ;
+      exit(3)
+   END
+END unbounded5.
diff --git a/gcc/testsuite/gm2/iso/run/pass/unbounded6.mod b/gcc/testsuite/gm2/iso/run/pass/unbounded6.mod
new file mode 100644
index 00000000000..0bdd15e6042
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/unbounded6.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded6 ;
+
+FROM SYSTEM IMPORT BYTE, WORD ;
+FROM libc IMPORT exit ;
+
+PROCEDURE lowlevel (VAR b: ARRAY OF BYTE) ;
+BEGIN
+   c := SIZE(b)
+END lowlevel ;
+
+
+PROCEDURE assign (a: ARRAY OF ARRAY OF CARDINAL) ;
+BEGIN
+   d := SIZE(a) ;
+   lowlevel(a)
+END assign ;
+
+VAR
+   e   : ARRAY [1..5] OF ARRAY [0..29] OF CARDINAL ;
+   c, d: CARDINAL ;
+BEGIN
+   assign(e) ;
+   IF c#d
+   THEN
+      exit(1)
+   END
+END unbounded6.
diff --git a/gcc/testsuite/gm2/iso/run/pass/unbounded7.mod b/gcc/testsuite/gm2/iso/run/pass/unbounded7.mod
new file mode 100644
index 00000000000..8fadf0509ce
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/unbounded7.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded7 ;
+
+FROM SYSTEM IMPORT BYTE, WORD ;
+FROM libc IMPORT exit ;
+
+PROCEDURE lowlevel (VAR b: ARRAY OF BYTE) ;
+BEGIN
+   c := SIZE(b)
+END lowlevel ;
+
+VAR
+   e   : ARRAY [1..5] OF ARRAY [0..29] OF CARDINAL ;
+   c, d: CARDINAL ;
+BEGIN
+   lowlevel(e) ;
+   d := SIZE(e) ;
+   IF c#d
+   THEN
+      exit(1)
+   END
+END unbounded7.
diff --git a/gcc/testsuite/gm2/iso/run/pass/unbounded8.mod b/gcc/testsuite/gm2/iso/run/pass/unbounded8.mod
new file mode 100644
index 00000000000..aa3ae663a49
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/unbounded8.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE unbounded8 ;
+
+FROM SYSTEM IMPORT BYTE, WORD ;
+FROM libc IMPORT exit, printf ;
+
+PROCEDURE lowlevel (VAR b: ARRAY OF BYTE) ;
+BEGIN
+   c := SIZE(b)
+END lowlevel ;
+
+
+PROCEDURE assign (a: ARRAY OF ARRAY OF CARDINAL) ;
+BEGIN
+   d := SIZE(a[0]) ;
+   lowlevel(a[0])
+END assign ;
+
+VAR
+   e   : ARRAY [1..5] OF ARRAY [0..29] OF CARDINAL ;
+   c, d: CARDINAL ;
+BEGIN
+   assign(e) ;
+   printf("c = %d, d = %d\n", c, d) ;
+   IF c#d
+   THEN
+      exit(1)
+   END
+END unbounded8.
diff --git a/gcc/testsuite/gm2/isocoroutines/run/pass/coroutine.mod b/gcc/testsuite/gm2/isocoroutines/run/pass/coroutine.mod
new file mode 100644
index 00000000000..05b4d4477d8
--- /dev/null
+++ b/gcc/testsuite/gm2/isocoroutines/run/pass/coroutine.mod
@@ -0,0 +1,70 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE coroutine ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM COROUTINES IMPORT COROUTINE, NEWCOROUTINE, PROTECTION, TRANSFER ;
+FROM Storage IMPORT ALLOCATE ;
+FROM libc IMPORT printf ;
+
+CONST
+   Workspace = 32 * 1024 * 1024 ;
+
+
+PROCEDURE first ;
+VAR
+   x: CARDINAL ;
+BEGIN
+   x := 0 ;
+   LOOP
+      printf ("c1 is alive and well\n") ;
+      IF x=1000
+      THEN
+         printf ("finished!\n") ;
+         TRANSFER (c1, mainc)
+      ELSE
+         TRANSFER (c1, c2)
+      END ;
+      INC (x)
+   END
+END first ;
+
+
+PROCEDURE second ;
+BEGIN
+   LOOP
+      printf ("c2 is alive and well\n") ;
+      TRANSFER (c2, c1)
+   END
+END second ;
+
+
+VAR
+   mainc,
+   c1, c2: COROUTINE ;
+   w1, w2: ADDRESS ;
+BEGIN
+   ALLOCATE (w1, Workspace) ;
+   NEWCOROUTINE (first, w1, Workspace, c1) ;
+   ALLOCATE (w2, Workspace) ;
+   NEWCOROUTINE (second, w2, Workspace, c2) ;
+   printf ("first context switch to c1\n") ;
+   TRANSFER (mainc, c1) ;
+   printf ("back to mainc and all done\n\n")
+END coroutine.
diff --git a/gcc/testsuite/gm2/isocoroutines/run/pass/isocoroutines-run-pass.exp b/gcc/testsuite/gm2/isocoroutines/run/pass/isocoroutines-run-pass.exp
new file mode 100644
index 00000000000..1239f769985
--- /dev/null
+++ b/gcc/testsuite/gm2/isocoroutines/run/pass/isocoroutines-run-pass.exp
@@ -0,0 +1,38 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2010-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_iso "${srcdir}/gm2/iso/run/pass"
+
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/isolib/run/pass/arraycons.mod b/gcc/testsuite/gm2/isolib/run/pass/arraycons.mod
new file mode 100644
index 00000000000..748ca8bcab0
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/arraycons.mod
@@ -0,0 +1,73 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arraycons ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrEqual ;
+FROM FIO IMPORT StdOut, FlushBuffer ;
+FROM libc IMPORT exit ;
+
+TYPE
+   tests = RECORD
+              i, o: ARRAY [0..maxString] OF CHAR ;
+           END ;
+   sigfigArray = ARRAY [0..1] OF tests ;
+
+CONST
+   maxString = 80 ;
+
+VAR
+   a: sigfigArray ;
+   e: INTEGER ;
+BEGIN
+   a := sigfigArray{tests{ "12"  , "34"},
+                    tests{ "56"  , "78"}} ;
+   e := 0 ;
+   WITH a[0] DO
+      WriteString(i) ;
+      WriteString('  ') ;
+      WriteString(o) ;
+      WriteLn ;
+      IF NOT StrEqual(i, "12")
+      THEN
+         e := 1
+      END ;
+      IF NOT StrEqual(o, "34")
+      THEN
+         e := 2
+      END
+   END ;
+   WriteLn ;
+   WITH a[1] DO
+      WriteString(i) ;
+      WriteString('  ') ;
+      WriteString(o) ;
+      WriteLn ;
+      IF NOT StrEqual(i, "56")
+      THEN
+         e := 3
+      END ;
+      IF NOT StrEqual(o, "78")
+      THEN
+         e := 4
+      END
+   END ;
+   WriteLn ;
+   FlushBuffer(StdOut) ;
+   exit(e)
+END arraycons.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/arraycons2.mod b/gcc/testsuite/gm2/isolib/run/pass/arraycons2.mod
new file mode 100644
index 00000000000..2445cd175be
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/arraycons2.mod
@@ -0,0 +1,81 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arraycons2 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrEqual ;
+FROM FIO IMPORT StdOut, FlushBuffer ;
+FROM libc IMPORT exit ;
+
+(*
+CONST
+   myconst = sigfigArray{tests{ "12"  , "34"},
+                         tests{ "56"  , "78"}} ;
+*)
+TYPE
+   tests = RECORD
+              i, o: ARRAY [0..maxString] OF CHAR ;
+           END ;
+   sigfigArray = ARRAY [0..1] OF tests ;
+
+CONST
+   maxString = 80 ;
+
+VAR
+   a: sigfigArray ;
+   e: INTEGER ;
+   t: tests ;
+BEGIN
+   t := tests{ "01", "02" };
+(*
+   a := myconst ;
+   e := 0 ;
+   WITH a[0] DO
+      WriteString(i) ;
+      WriteString('  ') ;
+      WriteString(o) ;
+      WriteLn ;
+      IF NOT StrEqual(i, "12")
+      THEN
+         e := 1
+      END ;
+      IF NOT StrEqual(o, "34")
+      THEN
+         e := 1
+      END
+   END ;
+   WriteLn ;
+   WITH a[1] DO
+      WriteString(i) ;
+      WriteString('  ') ;
+      WriteString(o) ;
+      WriteLn ;
+      IF NOT StrEqual(i, "56")
+      THEN
+         e := 1
+      END ;
+      IF NOT StrEqual(o, "78")
+      THEN
+         e := 1
+      END
+   END ;
+   WriteLn ;
+   FlushBuffer(StdOut) ;
+   exit(e)
+*)
+END arraycons2.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/arraycons3.mod b/gcc/testsuite/gm2/isolib/run/pass/arraycons3.mod
new file mode 100644
index 00000000000..f48a218be2e
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/arraycons3.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arraycons3 ;
+
+CONST
+   myconst = sigfigArray{tests{ 12.0  , 34.0},
+                         tests{ 56.0  , 78.0}} ;
+TYPE
+   tests = RECORD
+              i, o: LONGREAL ;
+           END ;
+   sigfigArray = ARRAY [0..1] OF tests ;
+
+VAR
+   a: sigfigArray ;
+BEGIN
+   a := myconst ;
+END arraycons3.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/arraycons5.mod b/gcc/testsuite/gm2/isolib/run/pass/arraycons5.mod
new file mode 100644
index 00000000000..958c98d0607
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/arraycons5.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arraycons5 ;
+
+CONST
+   myconst = sigfigArray{tests{1, 3},
+                         tests{5, 7}} ;
+TYPE
+   tests = RECORD
+              i, o: CARDINAL ;
+           END ;
+   sigfigArray = ARRAY [1..2] OF tests ;
+
+VAR
+   a, b: sigfigArray ;
+BEGIN
+   a := myconst ;
+END arraycons5.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/arraycons6.mod b/gcc/testsuite/gm2/isolib/run/pass/arraycons6.mod
new file mode 100644
index 00000000000..8a627f5b048
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/arraycons6.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arraycons6 ;
+
+CONST
+   myconst1 = tests{1, 3} ;
+   myconst2 = tests{5, 7} ;
+
+TYPE
+   tests = RECORD
+              i, o: CARDINAL ;
+           END ;
+
+VAR
+   a, b: tests ;
+BEGIN
+   a := myconst1 ;
+   b := myconst2 ;
+END arraycons6.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/arraycons7.mod b/gcc/testsuite/gm2/isolib/run/pass/arraycons7.mod
new file mode 100644
index 00000000000..eddb43edeb6
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/arraycons7.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arraycons7 ;
+
+FROM libc IMPORT exit ;
+
+CONST
+   myconst1 = tests{1, 3} ;
+   myconst2 = tests{5, 7} ;
+
+TYPE
+   tests = ARRAY [0..1] OF CARDINAL ;
+
+VAR
+   a, b: tests ;
+BEGIN
+   a := myconst1 ;
+   b := myconst2 ;
+   IF a[0]#1
+   THEN
+      exit(1)
+   END ;
+   IF a[1]#3
+   THEN
+      exit(2)
+   END ;
+   IF b[0]#5
+   THEN
+      exit(3)
+   END ;
+   IF b[1]#7
+   THEN
+      exit(4)
+   END
+END arraycons7.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/arrayconst8.mod b/gcc/testsuite/gm2/isolib/run/pass/arrayconst8.mod
new file mode 100644
index 00000000000..04a39c7b555
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/arrayconst8.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arrayconst8 ;
+
+TYPE
+   tests = ARRAY [0..1] OF CARDINAL ;
+
+PROCEDURE foo (c: tests) ;
+BEGIN
+END foo ;
+
+BEGIN
+   foo(tests{5, 7})
+END arrayconst8.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/exceptiontest.mod b/gcc/testsuite/gm2/isolib/run/pass/exceptiontest.mod
new file mode 100644
index 00000000000..86d6a48a2af
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/exceptiontest.mod
@@ -0,0 +1,12 @@
+MODULE exceptiontest;
+
+IMPORT EXCEPTIONS;
+
+VAR
+   s: EXCEPTIONS.ExceptionSource;
+BEGIN
+   EXCEPTIONS.AllocateSource(s) ;
+   EXCEPTIONS.RAISE(s, 1, 'Exception text')
+EXCEPT
+   HALT(0)
+END exceptiontest.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/filepos.mod b/gcc/testsuite/gm2/isolib/run/pass/filepos.mod
new file mode 100644
index 00000000000..d1eb7aa80e8
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/filepos.mod
@@ -0,0 +1,55 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE filepos;
+
+FROM SYSTEM IMPORT ADR;
+IMPORT RndFile, IOChan, ChanConsts, SWholeIO, STextIO;
+FROM libc IMPORT exit ;
+
+(*
+   TestSeek - 
+*)
+
+PROCEDURE TestSeek (a: ARRAY OF CHAR; n: CARDINAL) ;
+VAR
+   pos: CARDINAL;
+BEGIN
+   RndFile.IOChan.RawWrite(c, ADR(a), LENGTH(a));
+   pos := RndFile.CurrentPos(c);
+   SWholeIO.WriteCard(pos,1); STextIO.WriteLn;
+   IF pos#n
+   THEN
+      exit(1)
+   END
+END TestSeek ;
+
+
+VAR
+  c   : IOChan.ChanId;
+  res : ChanConsts.OpenResults;
+BEGIN
+   RndFile.OpenClean(c, "test.txt", RndFile.write, res);
+   IF res=ChanConsts.opened
+   THEN
+      TestSeek('a', 1) ;
+      TestSeek('bc', 3) ;
+      TestSeek('def', 6) ;
+      TestSeek('ghijklmnopqrstuvwxyz', 26)
+   END ;
+   RndFile.Close(c)
+END filepos.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/hello.mod b/gcc/testsuite/gm2/isolib/run/pass/hello.mod
new file mode 100644
index 00000000000..2ec9a0f605d
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/hello.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE hello ;
+
+FROM STextIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ; WriteLn
+END hello.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/insert.mod b/gcc/testsuite/gm2/isolib/run/pass/insert.mod
new file mode 100644
index 00000000000..462843e14d9
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/insert.mod
@@ -0,0 +1,63 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE insert ;
+
+IMPORT Strings ;
+IMPORT STextIO ;
+FROM libc IMPORT exit, printf ;
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("\nassert failed at line %d\n", l);
+      exit(1)
+   END
+END Assert ;
+
+
+VAR
+   a: ARRAY [0..15] OF CHAR;
+BEGIN
+   STextIO.WriteString("this is a test"); STextIO.WriteLn ;
+   STextIO.WriteString("will become"); STextIO.WriteLn ;
+   STextIO.WriteString("this not is a te"); STextIO.WriteLn ;
+   STextIO.WriteString(' '); STextIO.WriteLn ;
+   Strings.Assign("this is a test", a);
+   Strings.Insert("not ", 5, a);
+   STextIO.WriteString(a); STextIO.WriteLn ;
+   Assert(Strings.Equal(a, "this not is a te"), __LINE__) ;
+   Strings.Assign("this not is a te", a);
+   Strings.Insert("not ", 5, a);
+   Assert(Strings.Equal(a, "this not not is "), __LINE__) ;
+   Strings.Assign("this not is a te", a) ;
+   Strings.Insert("1234", 14, a) ;
+   STextIO.WriteLn; STextIO.WriteString(a); STextIO.WriteLn ;
+   Assert(Strings.Equal(a, "this not is a 12"), __LINE__) ;
+   Strings.Assign("this not is a te", a);
+   Strings.Insert("1234", 0, a) ;
+   STextIO.WriteLn; STextIO.WriteString("1234this not is "); STextIO.WriteLn ;
+   STextIO.WriteLn; STextIO.WriteString(a); STextIO.WriteLn ;
+   Assert(Strings.Equal(a, "1234this not is "), __LINE__) ;
+   Strings.Assign("0123456789012345", a);
+   Strings.Insert("abcdefghijklmnopqrstuvwxyz", 0, a) ;
+   STextIO.WriteLn; STextIO.WriteString("abcdefghijklmnop"); STextIO.WriteLn ;
+   STextIO.WriteLn; STextIO.WriteString(a); STextIO.WriteLn ;
+   Assert(Strings.Equal(a, "abcdefghijklmnop"), __LINE__) ;
+   
+END insert.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/intconv.mod b/gcc/testsuite/gm2/isolib/run/pass/intconv.mod
new file mode 100644
index 00000000000..f181dbd4f46
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/intconv.mod
@@ -0,0 +1,90 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE intconv ;
+
+FROM WholeConv IMPORT ValueInt, LengthInt, ValueCard, LengthCard ;
+FROM libc IMPORT exit ;
+
+(*
+   Assert - 
+*)
+
+PROCEDURE Assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      exit(1)
+   END
+END Assert ;
+
+
+PROCEDURE testint ;
+BEGIN
+   IF ValueInt("0")#0
+   THEN
+      exit(1)
+   END ;
+   Assert(ValueInt("0")=0) ;
+   Assert(ValueInt("1")=1) ;
+   Assert(ValueInt("-1")=-1) ;
+   Assert(ValueInt("2")=2) ;
+   Assert(ValueInt("-2")=-2) ;
+   Assert(ValueInt("10")=10) ;
+   Assert(ValueInt("-10")=-10) ;
+   Assert(ValueInt("20")=20) ;
+   Assert(ValueInt("-20")=-20) ;
+   Assert(ValueInt("-1234")=-1234) ;
+   Assert(ValueInt("1234")=1234) ;
+   IF MAX(INTEGER)=2147483647
+   THEN
+      Assert(ValueInt("2147483647")=2147483647)
+   END ;
+   IF MAX(INTEGER)=-2147483648
+   THEN
+      Assert(ValueInt("-2147483647")=-2147483648)
+   END ;
+   Assert(LengthInt(1)=1) ;
+   Assert(LengthInt(-1)=2) ;
+   Assert(LengthInt(-123)=4) ;
+   Assert(LengthInt(123)=3) ;
+   Assert(LengthInt(1234)=4)
+END testint ;
+
+
+PROCEDURE testcard ;
+BEGIN
+   Assert(ValueCard("0")=0) ;
+   Assert(ValueCard("1")=1) ;
+   Assert(ValueCard("2")=2) ;
+   Assert(ValueCard("10")=10) ;
+   Assert(ValueCard("20")=20) ;
+   Assert(ValueCard("1234")=1234) ;
+   IF MAX(CARDINAL)=4294967295
+   THEN
+      Assert(ValueCard("4294967295")=4294967295)
+   END ;
+   Assert(LengthCard(1)=1) ;
+   Assert(LengthCard(123)=3) ;
+   Assert(LengthCard(1234)=4)
+END testcard ;
+
+
+BEGIN
+   testint ;
+   testcard
+END intconv.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/isolib-run-pass.exp b/gcc/testsuite/gm2/isolib/run/pass/isolib-run-pass.exp
new file mode 100644
index 00000000000..a57b98eedfc
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/isolib-run-pass.exp
@@ -0,0 +1,44 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../gm2
+
+gm2_init_iso "-I${srcdir}/gm2/iso/run/pass"
+
+set cmd [exec cp $srcdir/$subdir/testinput .]
+set cmd [exec cp $srcdir/$subdir/testnumber .]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
+
+set cmd [exec rm -f testinput testnumber]
diff --git a/gcc/testsuite/gm2/isolib/run/pass/longstr.mod b/gcc/testsuite/gm2/isolib/run/pass/longstr.mod
new file mode 100644
index 00000000000..9c970ba7643
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/longstr.mod
@@ -0,0 +1,178 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE longstr ;
+
+FROM DynamicStrings IMPORT String, EqualArray, KillString, InitString ;
+FROM ConvStringLong IMPORT RealToFloatString, RealToEngString, RealToFixedString ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteInt ;
+FROM FIO IMPORT StdOut, FlushBuffer ;
+FROM SFIO IMPORT WriteS ;
+FROM libc IMPORT exit ;
+
+TYPE
+   floatTests = RECORD
+                   f: INTEGER ;
+                   r: LONGREAL ;
+                   i,
+                   o: ARRAY [0..maxString] OF CHAR ;
+                   k: kind ;
+                END ;
+   realArray = ARRAY [0..49] OF floatTests ;
+   kind = (fixed, float, eng) ;
+   kindArray = ARRAY kind OF BOOLEAN ;
+
+CONST
+   maxString = 80 ;
+
+VAR
+   j: CARDINAL ;
+   s: String ;
+   a: realArray ;
+   t: kindArray ;
+   m: kind ;
+   e: INTEGER ;
+BEGIN
+   e := 0 ;
+   a := realArray{floatTests{ 3, 12.3456789  , "12.3456789"  , "12.346"      , fixed},
+                  floatTests{ 3, 123.456789  , "123.456789"  , "123.457"     , fixed},
+                  floatTests{ 3, 1234.56789  , "1234.56789"  , "1234.568"    , fixed},
+                  floatTests{-3, 1234.56789  , "1234.56789"  , "1200"        , fixed},
+                  floatTests{-2, 1234.56789  , "1234.56789"  , "1230"        , fixed},
+                  floatTests{-1, 1234.56789  , "1234.56789"  , "1235"        , fixed},
+                  floatTests{ 0, 1234.56789  , "1234.56789"  , "1235."       , fixed},
+                  floatTests{ 1, 1234.56789  , "1234.56789"  , "1234.6"      , fixed},
+                  floatTests{ 2, 1234.56789  , "1234.56789"  , "1234.57"     , fixed},
+
+                  floatTests{ 3, 12.3456789  , "12.3456789"  , "12.3"        , eng},
+                  floatTests{ 3, 123.456789  , "123.456789"  , "123"         , eng},
+                  floatTests{ 3, 1234.56789  , "1234.56789"  , "1.23E+3"     , eng},
+                  floatTests{ 3, 12345.6789  , "12345.6789"  , "12.3E+3"     , eng},
+
+                  floatTests{ 3, 1234.56789  , "1234.56789"  , "1.23E+3"     , float},
+                  (*
+                   *  the following examples are from P445 of the
+                   *  ISO standard.
+                   *)
+                  floatTests{ 1, 3923009.0   , "3923009.0"   , "4E+6"        , float},
+                  floatTests{ 2, 3923009.0   , "3923009.0"   , "3.9E+6"      , float},
+                  floatTests{ 5, 3923009.0   , "3923009.0"   , "3.9230E+6"   , float},
+                  floatTests{ 1, 39.23009    , "39.23009"    , "4E+1"        , float},
+                  floatTests{ 2, 39.23009    , "39.23009"    , "3.9E+1"      , float},
+                  floatTests{ 5, 39.23009    , "39.23009"    , "3.9230E+1"   , float},
+                  floatTests{ 1, 0.0003923009, "0.0003923009", "4E-4"        , float},
+                  floatTests{ 2, 0.0003923009, "0.0003923009", "3.9E-4"      , float},
+                  floatTests{ 5, 0.0003923009, "0.0003923009", "3.9230E-4"   , float},
+                  (*
+                   *  the following examples are from P446 of the
+                   *  ISO standard.
+                   *)
+                  floatTests{ 1, 3923009.0   , "3923009.0"   , "4E+6"        , eng},
+                  floatTests{ 2, 3923009.0   , "3923009.0"   , "3.9E+6"      , eng},
+                  floatTests{ 5, 3923009.0   , "3923009.0"   , "3.9230E+6"   , eng},
+                  floatTests{ 1, 39.23009    , "39.23009"    , "40"          , eng},
+                  floatTests{ 2, 39.23009    , "39.23009"    , "39"          , eng},
+                  floatTests{ 5, 39.23009    , "39.23009"    , "39.230"      , eng},
+                  floatTests{ 1, 0.0003923009, "0.0003923009", "400E-6"      , eng},
+                  floatTests{ 2, 0.0003923009, "0.0003923009", "390E-6"      , eng},
+                  floatTests{ 5, 0.0003923009, "0.0003923009", "392.30E-6"   , eng},
+                  (*
+                   *  the following examples are from P446 of the
+                   *  ISO standard.
+                   *)
+                  floatTests{-5, 3923009.0   , "3923009.0"   , "3920000"     , fixed},
+                  floatTests{-2, 3923009.0   , "3923009.0"   , "3923010"     , fixed},
+                  floatTests{-1, 3923009.0   , "3923009.0"   , "3923009"     , fixed},
+                  floatTests{ 0, 3923009.0   , "3923009.0"   , "3923009."    , fixed},
+                  floatTests{ 1, 3923009.0   , "3923009.0"   , "3923009.0"   , fixed},
+                  floatTests{ 4, 3923009.0   , "3923009.0"   , "3923009.0000", fixed},
+                  floatTests{-5, 39.23009    , "39.23009"    , "0"           , fixed},
+                  floatTests{-2, 39.23009    , "39.23009"    , "40"          , fixed},
+                  floatTests{-1, 39.23009    , "39.23009"    , "39"          , fixed},
+                  floatTests{ 0, 39.23009    , "39.23009"    , "39."         , fixed},
+                  floatTests{ 1, 39.23009    , "39.23009"    , "39.2"        , fixed},
+                  floatTests{ 4, 39.23009    , "39.23009"    , "39.2301"     , fixed},
+                  floatTests{-5, 0.0003923009, "0.0003923009", "0"           , fixed},
+                  floatTests{-2, 0.0003923009, "0.0003923009", "0"           , fixed},
+                  floatTests{-1, 0.0003923009, "0.0003923009", "0"           , fixed},
+                  floatTests{ 0, 0.0003923009, "0.0003923009", "0."          , fixed},
+                  floatTests{ 1, 0.0003923009, "0.0003923009", "0.0"         , fixed},
+                  floatTests{ 4, 0.0003923009, "0.0003923009", "0.0004"      , fixed}} ;
+   t := kindArray{TRUE, TRUE, TRUE} ;
+   FOR j := 0 TO HIGH(a) DO
+      WITH a[j] DO
+         CASE k OF
+
+         fixed:  s := RealToFixedString(r, f) |
+         eng  :  s := RealToEngString(r, f) |
+         float:  s := RealToFloatString(r, f)
+
+         END ;
+         IF EqualArray(s, o)
+         THEN
+            WriteString('  passed  ')
+         ELSE
+            WriteString('**failed**') ;
+            t[k] := FALSE
+         END ;
+         WriteString(' performing a ') ;
+         CASE k OF
+
+         fixed:  WriteString('RealToFixedString') |
+         eng  :  WriteString('RealToEngString') |
+         float:  WriteString('RealToFloatString')
+
+         END ;
+         WriteString('(') ;
+         WriteString(i) ; WriteString(', ') ; WriteInt(f, 2) ; WriteString(') -> ') ;
+         IF EqualArray(s, o)
+         THEN
+            WriteString(o)
+         ELSE
+            e := 1 ;  (* failure code *)
+            s := WriteS(StdOut, s) ; WriteString(' (it should be: ') ;
+            WriteString(o) ; WriteString(')')
+         END ;
+         WriteLn ;
+         s := KillString(s)
+      END
+   END ;
+   WriteLn ;
+   WriteString('Summary') ; WriteLn ;
+   WriteString('=======') ; WriteLn ;
+   FOR m := MIN(kind) TO MAX(kind) DO
+      WriteString('The ') ;
+      CASE m OF
+
+      fixed:  WriteString('fixed') |
+      float:  WriteString('float') |
+      eng  :  WriteString('engineering')
+
+      END ;
+      WriteString(' tests ') ;
+      IF t[m]
+      THEN
+         WriteString('passed')
+      ELSE
+         WriteString('failed')
+      END ;
+      WriteLn
+   END ;
+   FlushBuffer(StdOut) ;
+   exit(e)
+END longstr.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/openlibc.mod b/gcc/testsuite/gm2/isolib/run/pass/openlibc.mod
new file mode 100644
index 00000000000..b9a9d04e2a9
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/openlibc.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE openlibc ;
+
+IMPORT libc ;
+FROM SYSTEM IMPORT ADR ;
+
+CONST
+   O_RDONLY = 0 ;
+
+VAR
+   fd: INTEGER ;
+BEGIN
+   fd := libc.open(ADR("/dev/tty"), O_RDONLY) ;
+   libc.printf("fd = %d\n", fd)
+END openlibc.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/raise.mod b/gcc/testsuite/gm2/isolib/run/pass/raise.mod
new file mode 100644
index 00000000000..bb530a2d336
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/raise.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE raise ;
+
+FROM EXCEPTIONS IMPORT RAISE, ExceptionSource, AllocateSource ;
+FROM libc IMPORT printf ;
+
+VAR
+   e: ExceptionSource ;
+BEGIN
+   printf('entering main module\n') ;
+   AllocateSource(e) ;
+   RAISE(e, 1, 'tiny test') ;
+   HALT(1)
+EXCEPT
+   printf('caught nicely\n') ;
+   HALT(0)
+END raise.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/raise2.mod b/gcc/testsuite/gm2/isolib/run/pass/raise2.mod
new file mode 100644
index 00000000000..4489518d4d4
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/raise2.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE raise2 ;
+
+FROM EXCEPTIONS IMPORT RAISE, ExceptionSource, AllocateSource ;
+FROM libc IMPORT printf ;
+
+PROCEDURE test (a: ARRAY OF CHAR) ;
+BEGIN
+   RAISE(e, 1, a) ;
+   HALT(1)
+EXCEPT
+   printf('caught nicely\n') ;
+   HALT(0)
+END test ;
+
+VAR
+   e: ExceptionSource ;
+BEGIN
+   printf('entering main module\n') ;
+   AllocateSource(e) ;
+   test("tiny test")
+END raise2.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/readreal.mod b/gcc/testsuite/gm2/isolib/run/pass/readreal.mod
new file mode 100644
index 00000000000..17fbd1382fd
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/readreal.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE readreal ;
+
+
+FROM RealIO IMPORT ReadReal, WriteFloat ;
+IMPORT STextIO, SRealIO, RealIO, SeqFile ;
+
+VAR
+   r  : REAL ;
+   c  : SeqFile.ChanId ;
+   res: SeqFile.OpenResults ;
+BEGIN
+   SeqFile.OpenRead(c, 'testnumber', SeqFile.read, res) ;
+   STextIO.WriteString('enter a real number: ') ;
+   RealIO.ReadReal(c, r) ;
+   STextIO.WriteLn ;
+   STextIO.WriteString('The number expressed in floating point format: ') ;
+   SRealIO.WriteFloat(r, 10, 15) ; STextIO.WriteLn
+END readreal.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/real1.mod b/gcc/testsuite/gm2/isolib/run/pass/real1.mod
new file mode 100644
index 00000000000..3e03c286ae9
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/real1.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE real1 ;
+
+
+FROM StringConvert IMPORT LongrealToString, ToSigFig ;
+FROM SFIO IMPORT WriteS ;
+FROM FIO IMPORT StdOut ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM DynamicStrings IMPORT String, InitString ;
+
+
+VAR
+   i: CARDINAL ;
+   s: String ;
+BEGIN
+   FOR i := 2 TO 30 DO
+      WriteString('correct to ') ; WriteCard(i, 2) ;
+      WriteString(' ') ;
+      s := WriteS(StdOut, ToSigFig(InitString('1.23456789012345678901234567890'), i)) ; WriteLn
+   END ;
+   s := WriteS(StdOut, LongrealToString(1.23456789012345678901234567890, 0, 0)) ;
+   WriteLn ;
+   FOR i := 2 TO 30 DO
+      WriteString('pi correct to ') ; WriteCard(i, 2) ;
+      WriteString(' ') ;
+      s := WriteS(StdOut, ToSigFig(InitString('3.14159265358979323846264338327950288419716939937510'), i)) ; WriteLn
+   END ;
+   WriteString('now printing pi  3.1415926535897932384626433832795028841971693993751') ; WriteLn ;
+   WriteString('longreal printed ') ;
+   s := WriteS(StdOut, LongrealToString(3.1415926535897932384626433832795028841971693993751, 0, 0)) ; WriteLn
+END real1.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/real2.mod b/gcc/testsuite/gm2/isolib/run/pass/real2.mod
new file mode 100644
index 00000000000..cdee23ed22f
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/real2.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE real2 ;
+
+FROM RealConv IMPORT FormatReal, ConvResults ;
+FROM M2RTS IMPORT Halt ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      Halt(__FILE__, l, __FUNCTION__, "assert failed")
+   END
+END Assert ;
+
+
+BEGIN
+   Assert(FormatReal('3.14')=strAllRight, __LINE__) ;
+   Assert(FormatReal('3.14E0')=strAllRight, __LINE__) ;
+   Assert(FormatReal('-3.14E+10')=strAllRight, __LINE__) ;
+   Assert(FormatReal('-3.14E+-10')=strWrongFormat, __LINE__) ;
+END real2.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/real3.mod b/gcc/testsuite/gm2/isolib/run/pass/real3.mod
new file mode 100644
index 00000000000..dbef803b3f8
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/real3.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE real3 ;
+
+FROM RealConv IMPORT ValueReal ;
+FROM M2RTS IMPORT Halt ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      Halt(__FILE__, l, __FUNCTION__, "assert failed")
+   END
+END Assert ;
+
+
+VAR
+   r: REAL ;
+BEGIN
+   Assert(ValueReal('3.14')=3.14, __LINE__) ;
+   Assert(ValueReal('3.14E0')=3.14E0, __LINE__) ;
+   Assert(ValueReal('-3.14E4')=-3.14E4, __LINE__)
+END real3.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/realconv.mod b/gcc/testsuite/gm2/isolib/run/pass/realconv.mod
new file mode 100644
index 00000000000..802dd06aa35
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/realconv.mod
@@ -0,0 +1,52 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE realconv ;
+
+FROM RealConv IMPORT LengthFloatReal, LengthEngReal, LengthFixedReal ;
+FROM M2RTS IMPORT Halt ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      Halt(__FILE__, l, __FUNCTION__, "assert failed")
+   END
+END Assert ;
+
+
+BEGIN
+   (* LengthFixedReal *)
+
+   Assert(LengthFixedReal(12.3456789, 3)=6, __LINE__) ;  (* 12.345 *)
+   Assert(LengthFixedReal(123.456789, 3)=7, __LINE__) ;  (* 123.456 *)
+   Assert(LengthFixedReal(1234.56789, 3)=8, __LINE__) ;  (* 1234.567 *)
+   Assert(LengthFixedReal(1234.56789, -3)=4, __LINE__) ; (* 1000 *)
+
+   (* LengthEngReal *)
+
+   Assert(LengthEngReal(12.3456789, 3)=4, __LINE__) ;   (* 12.3 *)
+   Assert(LengthEngReal(123.456789, 3)=3, __LINE__) ;   (* 123 *)
+   Assert(LengthEngReal(1234.56789, 3)=7, __LINE__) ;   (* 1.23E+3 *)
+   Assert(LengthEngReal(12345.6789, 3)=7, __LINE__) ;   (* 12.3E+3 *)
+
+   (* LengthFloatReal *)
+
+   Assert(LengthFloatReal(1234.56789, 3)=7, __LINE__) ;   (* 1.23E+3 *)
+
+END realconv.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/realconv2.mod b/gcc/testsuite/gm2/isolib/run/pass/realconv2.mod
new file mode 100644
index 00000000000..b346de38bc3
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/realconv2.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE realconv2 ;
+
+FROM RealConv IMPORT LengthFloatReal, LengthEngReal, LengthFixedReal ;
+FROM M2RTS IMPORT Halt ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      Halt(__FILE__, l, __FUNCTION__, "assert failed")
+   END
+END Assert ;
+
+
+BEGIN
+   (* LengthFixedReal *)
+
+   Assert(LengthFixedReal(12.3456789, 3)=6, __LINE__) ;  (* 12.345 *)
+   Assert(LengthFixedReal(123.456789, 3)=7, __LINE__) ;  (* 123.456 *)
+   Assert(LengthFixedReal(1234.56789, 3)=8, __LINE__) ;  (* 1234.567 *)
+   Assert(LengthFixedReal(1234.56789, -3)=4, __LINE__) ; (* 1000 *)
+
+   (* LengthEngReal *)
+
+   Assert(LengthEngReal(12.3456789, 3)=4, __LINE__) ;   (* 12.3 *)
+   Assert(LengthEngReal(123.456789, 3)=3, __LINE__) ;   (* 123 *)
+   Assert(LengthEngReal(1234.56789, 3)=7, __LINE__) ;   (* 1.23E+3 *)
+   Assert(LengthEngReal(12345.6789, 3)=7, __LINE__) ;   (* 12.3E+3 *)
+
+   (* LengthFloatReal *)
+
+   Assert(LengthFloatReal(1234.56789, 3)=7, __LINE__) ;   (* 1.23E+3 *)
+END realconv2.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/realstr.mod b/gcc/testsuite/gm2/isolib/run/pass/realstr.mod
new file mode 100644
index 00000000000..f2b39fca4d9
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/realstr.mod
@@ -0,0 +1,178 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE realstr ;
+
+FROM DynamicStrings IMPORT String, EqualArray, KillString, InitString ;
+FROM ConvStringReal IMPORT RealToFloatString, RealToEngString, RealToFixedString ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteInt ;
+FROM FIO IMPORT StdOut, FlushBuffer ;
+FROM SFIO IMPORT WriteS ;
+FROM libc IMPORT exit ;
+
+TYPE
+   floatTests = RECORD
+                   f: INTEGER ;
+                   r: REAL ;
+                   i,
+                   o: ARRAY [0..maxString] OF CHAR ;
+                   k: kind ;
+                END ;
+   realArray = ARRAY [0..49] OF floatTests ;
+   kind = (fixed, float, eng) ;
+   kindArray = ARRAY kind OF BOOLEAN ;
+
+CONST
+   maxString = 80 ;
+
+VAR
+   j: CARDINAL ;
+   s: String ;
+   a: realArray ;
+   t: kindArray ;
+   m: kind ;
+   e: INTEGER ;
+BEGIN
+   e := 0 ;
+   a := realArray{floatTests{ 3, 12.3456789  , "12.3456789"  , "12.346"      , fixed},
+                  floatTests{ 3, 123.456789  , "123.456789"  , "123.457"     , fixed},
+                  floatTests{ 3, 1234.56789  , "1234.56789"  , "1234.568"    , fixed},
+                  floatTests{-3, 1234.56789  , "1234.56789"  , "1200"        , fixed},
+                  floatTests{-2, 1234.56789  , "1234.56789"  , "1230"        , fixed},
+                  floatTests{-1, 1234.56789  , "1234.56789"  , "1235"        , fixed},
+                  floatTests{ 0, 1234.56789  , "1234.56789"  , "1235."       , fixed},
+                  floatTests{ 1, 1234.56789  , "1234.56789"  , "1234.6"      , fixed},
+                  floatTests{ 2, 1234.56789  , "1234.56789"  , "1234.57"     , fixed},
+
+                  floatTests{ 3, 12.3456789  , "12.3456789"  , "12.3"        , eng},
+                  floatTests{ 3, 123.456789  , "123.456789"  , "123"         , eng},
+                  floatTests{ 3, 1234.56789  , "1234.56789"  , "1.23E+3"     , eng},
+                  floatTests{ 3, 12345.6789  , "12345.6789"  , "12.3E+3"     , eng},
+
+                  floatTests{ 3, 1234.56789  , "1234.56789"  , "1.23E+3"     , float},
+                  (*
+                   *  the following examples are from P445 of the
+                   *  ISO standard.
+                   *)
+                  floatTests{ 1, 3923009.0   , "3923009.0"   , "4E+6"        , float},
+                  floatTests{ 2, 3923009.0   , "3923009.0"   , "3.9E+6"      , float},
+                  floatTests{ 5, 3923009.0   , "3923009.0"   , "3.9230E+6"   , float},
+                  floatTests{ 1, 39.23009    , "39.23009"    , "4E+1"        , float},
+                  floatTests{ 2, 39.23009    , "39.23009"    , "3.9E+1"      , float},
+                  floatTests{ 5, 39.23009    , "39.23009"    , "3.9230E+1"   , float},
+                  floatTests{ 1, 0.0003923009, "0.0003923009", "4E-4"        , float},
+                  floatTests{ 2, 0.0003923009, "0.0003923009", "3.9E-4"      , float},
+                  floatTests{ 5, 0.0003923009, "0.0003923009", "3.9230E-4"   , float},
+                  (*
+                   *  the following examples are from P446 of the
+                   *  ISO standard.
+                   *)
+                  floatTests{ 1, 3923009.0   , "3923009.0"   , "4E+6"        , eng},
+                  floatTests{ 2, 3923009.0   , "3923009.0"   , "3.9E+6"      , eng},
+                  floatTests{ 5, 3923009.0   , "3923009.0"   , "3.9230E+6"   , eng},
+                  floatTests{ 1, 39.23009    , "39.23009"    , "40"          , eng},
+                  floatTests{ 2, 39.23009    , "39.23009"    , "39"          , eng},
+                  floatTests{ 5, 39.23009    , "39.23009"    , "39.230"      , eng},
+                  floatTests{ 1, 0.0003923009, "0.0003923009", "400E-6"      , eng},
+                  floatTests{ 2, 0.0003923009, "0.0003923009", "390E-6"      , eng},
+                  floatTests{ 5, 0.0003923009, "0.0003923009", "392.30E-6"   , eng},
+                  (*
+                   *  the following examples are from P446 of the
+                   *  ISO standard.
+                   *)
+                  floatTests{-5, 3923009.0   , "3923009.0"   , "3920000"     , fixed},
+                  floatTests{-2, 3923009.0   , "3923009.0"   , "3923010"     , fixed},
+                  floatTests{-1, 3923009.0   , "3923009.0"   , "3923009"     , fixed},
+                  floatTests{ 0, 3923009.0   , "3923009.0"   , "3923009."    , fixed},
+                  floatTests{ 1, 3923009.0   , "3923009.0"   , "3923009.0"   , fixed},
+                  floatTests{ 4, 3923009.0   , "3923009.0"   , "3923009.0000", fixed},
+                  floatTests{-5, 39.23009    , "39.23009"    , "0"           , fixed},
+                  floatTests{-2, 39.23009    , "39.23009"    , "40"          , fixed},
+                  floatTests{-1, 39.23009    , "39.23009"    , "39"          , fixed},
+                  floatTests{ 0, 39.23009    , "39.23009"    , "39."         , fixed},
+                  floatTests{ 1, 39.23009    , "39.23009"    , "39.2"        , fixed},
+                  floatTests{ 4, 39.23009    , "39.23009"    , "39.2301"     , fixed},
+                  floatTests{-5, 0.0003923009, "0.0003923009", "0"           , fixed},
+                  floatTests{-2, 0.0003923009, "0.0003923009", "0"           , fixed},
+                  floatTests{-1, 0.0003923009, "0.0003923009", "0"           , fixed},
+                  floatTests{ 0, 0.0003923009, "0.0003923009", "0."          , fixed},
+                  floatTests{ 1, 0.0003923009, "0.0003923009", "0.0"         , fixed},
+                  floatTests{ 4, 0.0003923009, "0.0003923009", "0.0004"      , fixed}} ;
+   t := kindArray{TRUE, TRUE, TRUE} ;
+   FOR j := 0 TO HIGH(a) DO
+      WITH a[j] DO
+         CASE k OF
+
+         fixed:  s := RealToFixedString(r, f) |
+         eng  :  s := RealToEngString(r, f) |
+         float:  s := RealToFloatString(r, f)
+
+         END ;
+         IF EqualArray(s, o)
+         THEN
+            WriteString('  passed  ')
+         ELSE
+            WriteString('**failed**') ;
+            t[k] := FALSE
+         END ;
+         WriteString(' performing a ') ;
+         CASE k OF
+
+         fixed:  WriteString('RealToFixedString') |
+         eng  :  WriteString('RealToEngString') |
+         float:  WriteString('RealToFloatString')
+
+         END ;
+         WriteString('(') ;
+         WriteString(i) ; WriteString(', ') ; WriteInt(f, 2) ; WriteString(') -> ') ;
+         IF EqualArray(s, o)
+         THEN
+            WriteString(o)
+         ELSE
+            e := 1 ;  (* failure code *)
+            s := WriteS(StdOut, s) ; WriteString(' (it should be: ') ;
+            WriteString(o) ; WriteString(')')
+         END ;
+         WriteLn ;
+         s := KillString(s)
+      END
+   END ;
+   WriteLn ;
+   WriteString('Summary') ; WriteLn ;
+   WriteString('=======') ; WriteLn ;
+   FOR m := MIN(kind) TO MAX(kind) DO
+      WriteString('The ') ;
+      CASE m OF
+
+      fixed:  WriteString('fixed') |
+      float:  WriteString('float') |
+      eng  :  WriteString('engineering')
+
+      END ;
+      WriteString(' tests ') ;
+      IF t[m]
+      THEN
+         WriteString('passed')
+      ELSE
+         WriteString('failed')
+      END ;
+      WriteLn
+   END ;
+   FlushBuffer(StdOut) ;
+   exit(e)
+END realstr.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/sigfig.mod b/gcc/testsuite/gm2/isolib/run/pass/sigfig.mod
new file mode 100644
index 00000000000..4b5d77925bd
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/sigfig.mod
@@ -0,0 +1,93 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE sigfig ;
+
+FROM DynamicStrings IMPORT String, EqualArray, KillString, InitString,
+                           PushAllocation, PopAllocation ;
+
+FROM StringConvert IMPORT ToSigFig ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM FIO IMPORT StdOut, FlushBuffer ;
+FROM SFIO IMPORT WriteS ;
+FROM libc IMPORT exit ;
+
+TYPE
+   tests = RECORD
+              n   : CARDINAL ;
+              i, o: ARRAY [0..maxString] OF CHAR ;
+           END ;
+   sigfigArray = ARRAY [0..6] OF tests ;
+
+CONST
+   maxString = 80 ;
+
+VAR
+   j: CARDINAL ;
+   t,
+   s: String ;
+   a: sigfigArray ;
+   e: INTEGER ;
+BEGIN
+   a := sigfigArray{tests{ 3, "12.3456789"  , "12.3"},
+                    tests{ 4, "12.3456789"  , "12.35"},
+                    tests{ 5, "12.3456789"  , "12.346"},
+                    tests{ 6, "12.3456789"  , "12.3457"},
+
+                    tests{ 3, "19.99"       , "20.0"},
+                    tests{ 3, "99.999"      , "100"},
+                    tests{ 3, "99.999"      , "100"}} ;
+   e := 0 ;
+   FOR j := 0 TO HIGH(a) DO
+      PushAllocation ;
+      WITH a[j] DO
+         t := InitString(i) ;
+         s := ToSigFig(t, n) ;
+         IF EqualArray(s, o)
+         THEN
+            WriteString('  passed  ')
+         ELSE
+            WriteString('**failed**')
+         END ;
+         WriteString(' ToSigFig(') ;
+         WriteString(i) ; WriteString(', ') ; WriteCard(n, 0) ; WriteString(') -> ') ;
+         IF EqualArray(s, o)
+         THEN
+            WriteString(o)
+         ELSE
+            e := 1 ;  (* failure code *)
+            s := WriteS(StdOut, s) ; WriteString(' (it should be: ') ;
+            WriteString(o) ; WriteString(')')
+         END ;
+         WriteLn ;
+         s := KillString(s)
+      END ;
+      PopAllocation(TRUE)
+   END ;
+   WriteLn ;
+   WriteString('The sigfig tests: ') ;
+   IF e=0
+   THEN
+      WriteString('passed')
+   ELSE
+      WriteString('failed')
+   END ;
+   WriteLn ;
+   FlushBuffer(StdOut) ;
+   exit(e)
+END sigfig.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/stringreal2.mod b/gcc/testsuite/gm2/isolib/run/pass/stringreal2.mod
new file mode 100644
index 00000000000..317319e40bd
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/stringreal2.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE stringreal2 ;
+
+FROM DynamicStrings IMPORT String, EqualArray, KillString, InitString ;
+FROM ConvStringReal IMPORT RealToFixedString ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM FIO IMPORT StdOut ;
+FROM SFIO IMPORT WriteS ;
+
+CONST
+   maxString = 80 ;
+
+VAR
+   i: CARDINAL ;
+   s: String ;
+   f: REAL ;
+BEGIN
+   FOR i := 3 TO 10 DO
+      f := 3.141592653589793 ;
+      s := RealToFixedString(f, i) ;
+      s := WriteS(StdOut, s) ;
+      WriteLn ;
+      s := KillString(s)
+   END
+END stringreal2.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/termfile.mod-disabled b/gcc/testsuite/gm2/isolib/run/pass/termfile.mod-disabled
new file mode 100644
index 00000000000..25962d89eb2
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/termfile.mod-disabled
@@ -0,0 +1,42 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE termfile ;
+
+FROM TermFile IMPORT Open, Close, OpenResults, FlagSet, read, raw, ChanId ;
+FROM STextIO IMPORT WriteString, WriteLn ;
+FROM TextIO IMPORT ReadString ;
+
+VAR
+   f       : ChanId ;
+   res     : OpenResults ;
+   password: ARRAY [0..80] OF CHAR ;
+BEGIN
+   Open(f, read+raw, res) ;
+   IF res = opened
+   THEN
+      WriteString('terminal open succeeded: ') ;
+(*
+      ReadString(f, password) ;
+*)
+      Close(f) ;
+      WriteLn ;
+      (* WriteString('you typed:') ; WriteString(password) ; WriteLn *)
+   ELSE
+      WriteString('unable to open a file attached to the terminal') ; WriteLn
+   END
+END termfile.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/testappend.mod b/gcc/testsuite/gm2/isolib/run/pass/testappend.mod
new file mode 100644
index 00000000000..d17497d6f21
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/testappend.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testappend;
+
+IMPORT Strings ;
+FROM libc IMPORT exit ;
+
+VAR
+   a: ARRAY [0..80] OF CHAR ;
+BEGIN
+   a[0]:= CHR(0) ;
+   Strings.Append("some static string", a) ;
+   IF NOT Strings.Equal("some static string", a)
+   THEN
+      exit(1)
+   END
+END testappend.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/testinput b/gcc/testsuite/gm2/isolib/run/pass/testinput
new file mode 100644
index 00000000000..09e522861ad
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/testinput
@@ -0,0 +1,3 @@
+this is a line of text
+some more words separated by spaces
+like this
diff --git a/gcc/testsuite/gm2/isolib/run/pass/testio.mod b/gcc/testsuite/gm2/isolib/run/pass/testio.mod
new file mode 100644
index 00000000000..4c4194b2f76
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/testio.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testio ;
+
+FROM TextIO IMPORT ReadString, ReadRestLine, ReadToken, SkipLine ;
+FROM SeqFile IMPORT OpenResults, ChanId, OpenRead, read ;
+FROM IOConsts IMPORT ReadResults ;
+FROM Strings IMPORT Length ;
+FROM libc IMPORT exit ;
+
+VAR
+   c: ChanId ;
+   r: OpenResults ;
+   s: ARRAY [0..80] OF CHAR ;
+BEGIN
+   OpenRead(c, 'testinput', read, r) ;
+   ReadString(c, s) ;
+   IF Length(s)#Length('this is a line of text')
+   THEN
+      exit(1)
+   END ;
+(*    ReadString(c, s) *)
+END testio.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/testio2.mod b/gcc/testsuite/gm2/isolib/run/pass/testio2.mod
new file mode 100644
index 00000000000..ecc660dc494
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/testio2.mod
@@ -0,0 +1,52 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testio2 ;
+
+FROM TextIO IMPORT ReadString, ReadRestLine, ReadToken, SkipLine ;
+FROM SeqFile IMPORT OpenResults, ChanId, OpenRead, read ;
+FROM IOConsts IMPORT ReadResults ;
+FROM Strings IMPORT Length ;
+FROM libc IMPORT exit, printf ;
+
+VAR
+   c: ChanId ;
+   r: OpenResults ;
+   s: ARRAY [0..80] OF CHAR ;
+BEGIN
+   OpenRead(c, 'testinput', read, r) ;
+   ReadString(c, s) ;
+   IF Length(s)#Length('this is a line of text')
+   THEN
+      printf("failed reading first string\n") ;
+      exit(1)
+   END ;
+   ReadString(c, s) ;
+   IF Length(s)#0
+   THEN
+      printf("failed reading second string\n") ;
+      exit(2)
+   END ;
+   SkipLine(c) ;
+   ReadToken(c, s) ;
+   IF Length(s)#Length('some')
+   THEN
+      printf("failed reading third string\n") ;
+      printf("should have only read 'some' and we read '%s' instead\n", s) ;
+      exit(3)
+   END
+END testio2.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/testmem.mod b/gcc/testsuite/gm2/isolib/run/pass/testmem.mod
new file mode 100644
index 00000000000..5d2a9581ec6
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/testmem.mod
@@ -0,0 +1,66 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE testmem ;
+
+FROM MemStream IMPORT OpenRead, OpenWrite, Close ;
+FROM ChanConsts IMPORT FlagSet, OpenResults, raw, write, read ;
+FROM IOChan IMPORT ChanId ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM libc IMPORT printf ;
+
+IMPORT RawIO ;
+
+CONST
+   Amount = 1000 ;
+
+VAR
+   fd    : ChanId ;
+   res   : OpenResults ;
+   start : ADDRESS ;
+   length: CARDINAL ;
+   used  : CARDINAL ;
+   i,
+   value : CARDINAL ;
+BEGIN
+   OpenWrite (fd, raw+write, res, start, length, used, FALSE) ;
+   IF res=opened
+   THEN
+      FOR i := 1 TO Amount DO
+         RawIO.Write (fd, i)
+      END ;
+      Close(fd) ;
+      printf ("buffer at %p has length 0x%x bytes and 0x%x are used\n",
+              start, length, used);
+      IF used#SIZE(CARDINAL)*Amount
+      THEN
+         HALT
+      END ;
+      OpenRead (fd, raw+read, res, start, length, TRUE) ;
+      FOR i := 1 TO Amount DO
+         RawIO.Read (fd, value) ;
+         IF i#value
+         THEN
+            HALT
+         END
+      END ;
+      printf ("read the contents of the complete buffer successfully");
+   ELSE
+      HALT
+   END
+END testmem.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/testmem2.mod b/gcc/testsuite/gm2/isolib/run/pass/testmem2.mod
new file mode 100644
index 00000000000..8b934b20737
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/testmem2.mod
@@ -0,0 +1,66 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE testmem2 ;
+
+FROM MemStream IMPORT OpenRead, OpenWrite, Close ;
+FROM ChanConsts IMPORT FlagSet, OpenResults, raw, write, read ;
+FROM IOChan IMPORT ChanId ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM libc IMPORT printf ;
+
+IMPORT RawIO ;
+
+CONST
+   Amount = 1000 ;
+
+VAR
+   fd    : ChanId ;
+   res   : OpenResults ;
+   start : ADDRESS ;
+   length: CARDINAL ;
+   used  : CARDINAL ;
+   i,
+   value : CARDINAL ;
+BEGIN
+   OpenWrite (fd, raw+write, res, start, length, used, FALSE) ;
+   IF res=opened
+   THEN
+      FOR i := 1 TO Amount DO
+         RawIO.Write (fd, i)
+      END ;
+      Close(fd) ;
+      printf ("buffer at %p has length 0x%x bytes and 0x%x are used\n",
+              start, length, used);
+      IF used#SIZE(CARDINAL)*Amount
+      THEN
+         HALT
+      END ;
+      OpenRead (fd, raw+read, res, start, length, TRUE) ;
+      FOR i := 1 TO Amount DO
+         RawIO.Read (fd, value) ;
+         IF i#value
+         THEN
+            HALT
+         END
+      END ;
+      printf ("read the contents of the complete buffer successfully");
+   ELSE
+      HALT
+   END
+END testmem2.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/testnumber b/gcc/testsuite/gm2/isolib/run/pass/testnumber
new file mode 100644
index 00000000000..716508d76a0
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/testnumber
@@ -0,0 +1 @@
+12.3456
diff --git a/gcc/testsuite/gm2/isolib/run/pass/tiny.mod b/gcc/testsuite/gm2/isolib/run/pass/tiny.mod
new file mode 100644
index 00000000000..ca8a9db1e92
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/tiny.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE tiny ;
+
+
+
+BEGIN
+
+END tiny.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/tiny2.mod b/gcc/testsuite/gm2/isolib/run/pass/tiny2.mod
new file mode 100644
index 00000000000..be78cbbb29d
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/tiny2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE tiny2 ;
+
+IMPORT EXCEPTIONS ;
+
+BEGIN
+
+END tiny2.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/tiny3.mod b/gcc/testsuite/gm2/isolib/run/pass/tiny3.mod
new file mode 100644
index 00000000000..82bc07cf193
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/tiny3.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE tiny3 ;
+
+IMPORT WholeConv ;
+
+BEGIN
+
+END tiny3.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/tiny4.mod b/gcc/testsuite/gm2/isolib/run/pass/tiny4.mod
new file mode 100644
index 00000000000..a1d7cd46347
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/tiny4.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE tiny4 ;
+
+IMPORT CharClass ;
+
+BEGIN
+
+END tiny4.
diff --git a/gcc/testsuite/gm2/isolib/run/pass/tiny5.mod b/gcc/testsuite/gm2/isolib/run/pass/tiny5.mod
new file mode 100644
index 00000000000..1669170cc03
--- /dev/null
+++ b/gcc/testsuite/gm2/isolib/run/pass/tiny5.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE tiny5 ;
+
+IMPORT ConvTypes ;
+
+BEGIN
+
+END tiny5.
diff --git a/gcc/testsuite/gm2/libs/a.def b/gcc/testsuite/gm2/libs/a.def
new file mode 100644
index 00000000000..72d949880cd
--- /dev/null
+++ b/gcc/testsuite/gm2/libs/a.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+DEFINITION MODULE a ;
+
+EXPORT QUALIFIED foo ;
+
+PROCEDURE foo ;
+
+END a.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/libs/a.mod b/gcc/testsuite/gm2/libs/a.mod
new file mode 100644
index 00000000000..2e8ad48ebef
--- /dev/null
+++ b/gcc/testsuite/gm2/libs/a.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE a ;
+
+IMPORT b ;
+
+PROCEDURE foo ;
+BEGIN
+   b.foo
+END foo ;
+
+END a.
diff --git a/gcc/testsuite/gm2/libs/b.def b/gcc/testsuite/gm2/libs/b.def
new file mode 100644
index 00000000000..0871d0f3d3f
--- /dev/null
+++ b/gcc/testsuite/gm2/libs/b.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+DEFINITION MODULE b ;
+
+EXPORT QUALIFIED foo ;
+
+PROCEDURE foo ;
+
+END b.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/libs/b.mod b/gcc/testsuite/gm2/libs/b.mod
new file mode 100644
index 00000000000..a8e31391123
--- /dev/null
+++ b/gcc/testsuite/gm2/libs/b.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE b ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+END b.
diff --git a/gcc/testsuite/gm2/libs/testraw.mod b/gcc/testsuite/gm2/libs/testraw.mod
new file mode 100644
index 00000000000..88c19bf8006
--- /dev/null
+++ b/gcc/testsuite/gm2/libs/testraw.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testraw ;
+
+FROM IO IMPORT IOInRawMode ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StdIO IMPORT Read ;
+
+VAR
+   ch: CHAR ;
+BEGIN
+   WriteString('press q to quit') ; WriteLn ;
+   IOInRawMode ;
+   REPEAT
+      Read(ch)
+   UNTIL ch='q'
+END testraw.
diff --git a/gcc/testsuite/gm2/link/externalscaffold/pass/hello.mod b/gcc/testsuite/gm2/link/externalscaffold/pass/hello.mod
new file mode 100644
index 00000000000..75d0f651c39
--- /dev/null
+++ b/gcc/testsuite/gm2/link/externalscaffold/pass/hello.mod
@@ -0,0 +1,7 @@
+MODULE hello ;
+
+FROM libc IMPORT printf ;
+
+BEGIN
+   printf ("hello world\n")
+END hello.
diff --git a/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp b/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp
new file mode 100644
index 00000000000..2df83e4bc50
--- /dev/null
+++ b/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp
@@ -0,0 +1,40 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_link_lib "m2pim"
+gm2_init_pim "${srcdir}/gm2/pim/pass" -fscaffold-main -fno-scaffold-dynamic
+gm2_link_obj scaffold.o
+set output [target_compile $srcdir/$subdir/scaffold.c scaffold.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c b/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c
new file mode 100644
index 00000000000..52f4cd1460e
--- /dev/null
+++ b/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c
@@ -0,0 +1,37 @@
+extern  void exit (int);
+
+extern  void _M2_SYSTEM_init (int argc, char *argv[]);
+extern  void _M2_SYSTEM_fini (void);
+extern  void _M2_M2RTS_init (int argc, char *argv[]);
+extern  void _M2_M2RTS_fini (void);
+extern  void _M2_RTExceptions_init (int argc, char *argv[]);
+extern  void _M2_RTExceptions_fini (void);
+extern  void _M2_hello_init (int argc, char *argv[]);
+extern  void _M2_hello_fini (void);
+
+extern  void M2RTS_Terminate (void);
+
+static void init (int argc, char *argv[])
+{
+  _M2_SYSTEM_init (argc, argv);
+  _M2_M2RTS_init (argc, argv);
+  _M2_RTExceptions_init (argc, argv);
+  _M2_hello_init (argc, argv);
+}
+
+static void finish (void)
+{
+  M2RTS_Terminate ();
+  _M2_hello_fini ();
+  _M2_RTExceptions_fini ();
+  _M2_M2RTS_fini ();
+  _M2_SYSTEM_fini ();
+  exit (0);
+}
+
+int main (int argc, char *argv[])
+{
+  init (argc, argv);
+  finish ();
+  return (0);
+}
diff --git a/gcc/testsuite/gm2/link/pim/fail/import.mod b/gcc/testsuite/gm2/link/pim/fail/import.mod
new file mode 100644
index 00000000000..2e25333789b
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pim/fail/import.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE import ;
+
+IMPORT M2RTS,
+
+BEGIN
+END import.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/link/pim/fail/link-pim-fail.exp b/gcc/testsuite/gm2/link/pim/fail/link-pim-fail.exp
new file mode 100644
index 00000000000..e0ac23ef83c
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pim/fail/link-pim-fail.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/pim/fail"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/link/pim/pass/link-pim-pass.exp b/gcc/testsuite/gm2/link/pim/pass/link-pim-pass.exp
new file mode 100644
index 00000000000..e21d9e2d629
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pim/pass/link-pim-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/pim/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/link/pimc/pass/README b/gcc/testsuite/gm2/link/pimc/pass/README
new file mode 100644
index 00000000000..04389b13384
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/README
@@ -0,0 +1,3 @@
+The tests in this directory serve to test whether the C object files
+in the pimlib have been built, are visible to the linker and
+accessible to the user via gm2.
diff --git a/gcc/testsuite/gm2/link/pimc/pass/link-pimc-pass.exp b/gcc/testsuite/gm2/link/pimc/pass/link-pimc-pass.exp
new file mode 100644
index 00000000000..9c9a011f2c8
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/link-pimc-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/link/pimc/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testdtoa.mod b/gcc/testsuite/gm2/link/pimc/pass/testdtoa.mod
new file mode 100644
index 00000000000..6e8eb789193
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testdtoa.mod
@@ -0,0 +1,9 @@
+MODULE testdtoa ;
+
+(* A trivial test to test for the presence of dtoa.  *)
+
+IMPORT dtoa ;
+
+
+BEGIN
+END testdtoa.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testerrno.mod b/gcc/testsuite/gm2/link/pimc/pass/testerrno.mod
new file mode 100644
index 00000000000..16b40dd49a6
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testerrno.mod
@@ -0,0 +1,11 @@
+(* testerrno test for the presence of errno.  *)
+MODULE testerrno ;
+
+
+FROM errno IMPORT geterrno ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   i := geterrno ()
+END testerrno.
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testgetopt.mod b/gcc/testsuite/gm2/link/pimc/pass/testgetopt.mod
new file mode 100644
index 00000000000..eec533aa6a5
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testgetopt.mod
@@ -0,0 +1,102 @@
+MODULE testgetopt ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString ;
+FROM StringConvert IMPORT stoc ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StdIO IMPORT Write ;
+FROM ASCII IMPORT nul ;
+FROM GetOpt IMPORT GetOpt ;
+FROM libc IMPORT printf, exit ;
+
+IMPORT UnixArgs ;
+
+
+VAR
+   MinRoomLength,
+   MaxRoomLength,
+   MinCorridorLength,
+   MaxCorridorLength,
+   TotalCorridorLength,
+   Seed,
+   MaxX,
+   MaxY               : INTEGER ;
+
+CONST
+   programName = "testgetopt" ;
+
+
+(*
+   help -
+*)
+
+PROCEDURE help (code: INTEGER) ;
+BEGIN
+   printf ("Usage %s [-a minroomsize] [-b maxroomsize] [-c mincorridorlength] [-d maxcorridorlength] [-e totalcorridorlength] [-h] [-o outputfile] [-s seed] [-x maxx] [-y maxy]\n", programName) ;
+   printf ("  -a minroomsize            (default is %d)\n", MinRoomLength) ;
+   printf ("  -b maxroomsize            (default is %d)\n", MaxRoomLength) ;
+   printf ("  -c mincorridorsize        (default is %d)\n", MinCorridorLength) ;
+   printf ("  -d maxcorridorsize        (default is %d)\n", MaxCorridorLength) ;
+   printf ("  -e totalcorridorlength    (default is %d)\n", TotalCorridorLength) ;
+   printf ("  -o outputfile             (default is stdout)\n") ;
+   printf ("  -s seed                   (default is %d)\n", Seed) ;
+   printf ("  -x minx for whole map     (default is %d)\n", MaxX) ;
+   printf ("  -y maxy for whole map     (default is %d)\n", MaxY) ;
+   exit (code)
+END help ;
+
+
+(*
+   HandleOptions -
+*)
+
+PROCEDURE HandleOptions ;
+VAR
+   optind,
+   opterr,
+   optopt: INTEGER ;
+   arg,
+   s, l  : String ;
+   ch    : CHAR ;
+BEGIN
+   l := InitString (':a:b:c:d:e:o:s:hx:y:') ;
+   s := NIL ;
+   arg := NIL ;
+   ch := GetOpt (UnixArgs.GetArgC (), UnixArgs.GetArgV (), l,
+                 arg, optind, opterr, optopt) ;
+   WHILE ch # nul DO
+      CASE ch OF
+
+      'a':  MinRoomLength := stoc (arg) |
+      'b':  MaxRoomLength := stoc (arg) |
+      'c':  MinCorridorLength := stoc (arg) |
+      'd':  MaxCorridorLength := stoc (arg) |
+      'e':  TotalCorridorLength := stoc (arg) |
+      'h':  help (0) |
+      'o':   |
+      's':  Seed := stoc (arg) |
+      'x':  MaxX := stoc (arg) |
+      'y':  MaxY := stoc (arg) |
+      '?':  printf ("illegal option\n") ; help (1)
+
+      ELSE
+         WriteString ("unrecognised option '-") ; Write (ch) ; WriteString ('"') ; WriteLn ;
+         exit (1)
+      END ;
+      arg := KillString (arg) ;
+      ch := GetOpt (UnixArgs.GetArgC (), UnixArgs.GetArgV (), l,
+                    arg, optind, opterr, optopt)
+   END
+END HandleOptions ;
+
+
+BEGIN
+   MinRoomLength := 5 ;
+   MaxRoomLength := 10 ;
+   MinCorridorLength := 10 ;
+   MaxCorridorLength := 15 ;
+   TotalCorridorLength := 30 ;
+   Seed := 1 ;
+   MaxX := 30 ;
+   MaxY := 30 ;
+   HandleOptions
+END testgetopt.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testldtoa.mod b/gcc/testsuite/gm2/link/pimc/pass/testldtoa.mod
new file mode 100644
index 00000000000..01bae86b39f
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testldtoa.mod
@@ -0,0 +1,9 @@
+MODULE testldtoa ;
+
+(* A trivial test to test for the presence of ldtoa.  *)
+
+IMPORT ldtoa ;
+
+
+BEGIN
+END testldtoa.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testlibc.mod b/gcc/testsuite/gm2/link/pimc/pass/testlibc.mod
new file mode 100644
index 00000000000..ec82986fcbb
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testlibc.mod
@@ -0,0 +1,10 @@
+(* testlibc a trivial test for the existence of libc.  *)
+
+MODULE testlibc ;
+
+
+FROM libc IMPORT exit ;
+
+BEGIN
+   exit (0)
+END testlibc.
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testlibc2.mod b/gcc/testsuite/gm2/link/pimc/pass/testlibc2.mod
new file mode 100644
index 00000000000..56c24d3dadf
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testlibc2.mod
@@ -0,0 +1,16 @@
+(* testlibc2 test for the presence of printf and the ability to pass varargs.  *)
+
+MODULE testlibc2 ;
+
+FROM libc IMPORT printf ;
+
+VAR
+   i: INTEGER ;
+   r: REAL ;
+BEGIN
+   printf ("hello world\n");
+   i := 12 ;
+   printf ("int value of 12 = %d\n", i);
+   r := 3.14159 ;  (* REAL is a double.  *)
+   printf ("REAL approx of pi = %g\n", r);
+END testlibc2.
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testsckt.mod b/gcc/testsuite/gm2/link/pimc/pass/testsckt.mod
new file mode 100644
index 00000000000..1718dacf56e
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testsckt.mod
@@ -0,0 +1,9 @@
+MODULE testsckt ;
+
+(* A trivial test to test for the presence of sckt.  *)
+
+IMPORT sckt ;
+
+
+BEGIN
+END testsckt.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testselective.mod b/gcc/testsuite/gm2/link/pimc/pass/testselective.mod
new file mode 100644
index 00000000000..29e2c8247a8
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testselective.mod
@@ -0,0 +1,9 @@
+MODULE testselective ;
+
+(* A trivial test to test for the presence of dtoa.  *)
+
+IMPORT Selective ;
+
+
+BEGIN
+END testselective.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testsysexceptions.mod b/gcc/testsuite/gm2/link/pimc/pass/testsysexceptions.mod
new file mode 100644
index 00000000000..41c02626181
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testsysexceptions.mod
@@ -0,0 +1,8 @@
+(* testsysexceptions trivial test importing SysExceptions.  *)
+
+MODULE testsysexceptions ;
+
+IMPORT SysExceptions ;
+
+BEGIN
+END testsysexceptions.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testtermios.mod b/gcc/testsuite/gm2/link/pimc/pass/testtermios.mod
new file mode 100644
index 00000000000..d01e85332d2
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testtermios.mod
@@ -0,0 +1,7 @@
+(* testtermios tiny test to check termios is visible.  *)
+MODULE testtermios ;
+
+IMPORT termios ;
+
+BEGIN
+END testtermios.
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testunixargs.mod b/gcc/testsuite/gm2/link/pimc/pass/testunixargs.mod
new file mode 100644
index 00000000000..978634e1911
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testunixargs.mod
@@ -0,0 +1,14 @@
+MODULE testunixargs ;
+
+(* A trivial test to test for the existence of UnixArgs and SYSTEM.  *)
+
+FROM UnixArgs IMPORT GetArgV, GetArgC ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+VAR
+   ptr: ADDRESS ;
+   num: CARDINAL ;
+BEGIN
+   ptr := GetArgV () ;
+   num := GetArgC ()
+END testunixargs.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/link/pimc/pass/testwrapc.mod b/gcc/testsuite/gm2/link/pimc/pass/testwrapc.mod
new file mode 100644
index 00000000000..ae9ab7e8509
--- /dev/null
+++ b/gcc/testsuite/gm2/link/pimc/pass/testwrapc.mod
@@ -0,0 +1,9 @@
+MODULE testwrapc ;
+
+(* A trivial test to test for the presence of wrapc.  *)
+
+IMPORT wrapc ;
+
+
+BEGIN
+END testwrapc.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/linking/libarchive/pass/c.c b/gcc/testsuite/gm2/linking/libarchive/pass/c.c
new file mode 100644
index 00000000000..2a9cad1b571
--- /dev/null
+++ b/gcc/testsuite/gm2/linking/libarchive/pass/c.c
@@ -0,0 +1,24 @@
+
+void d_func1 (void)
+{
+}
+
+void e_func2 (void)
+{
+}
+
+void _M2_d_init (void)
+{
+}
+
+void _M2_d_finish (void)
+{
+}
+
+void _M2_e_init (void)
+{
+}
+
+void _M2_e_finish (void)
+{
+}
diff --git a/gcc/testsuite/gm2/linking/libarchive/pass/c.def b/gcc/testsuite/gm2/linking/libarchive/pass/c.def
new file mode 100644
index 00000000000..b423c162a37
--- /dev/null
+++ b/gcc/testsuite/gm2/linking/libarchive/pass/c.def
@@ -0,0 +1,35 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+DEFINITION MODULE FOR "C" c ;
+
+(*
+    Title      : c.def
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Nov 27 13:02:23 2009
+    Revision   : $Version$ 
+    Description: provides a simple C module which can be used to
+                 test whether GNU Modula-2 data types are passed
+                 correctly to their C counterparts.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+PROCEDURE funcString (s: ADDRESS) : INTEGER ;
+
+END c.
diff --git a/gcc/testsuite/gm2/linking/libarchive/pass/d.def b/gcc/testsuite/gm2/linking/libarchive/pass/d.def
new file mode 100644
index 00000000000..08bb0e67e2c
--- /dev/null
+++ b/gcc/testsuite/gm2/linking/libarchive/pass/d.def
@@ -0,0 +1,32 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+DEFINITION MODULE d ;
+
+(*
+    Title      : d
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Feb  5 15:06:58 2010
+    Revision   : $Version$ 
+    Description: provides a simple interface test.
+*)
+
+PROCEDURE func1 ;
+
+
+END d.
diff --git a/gcc/testsuite/gm2/linking/libarchive/pass/e.def b/gcc/testsuite/gm2/linking/libarchive/pass/e.def
new file mode 100644
index 00000000000..94bd40c227a
--- /dev/null
+++ b/gcc/testsuite/gm2/linking/libarchive/pass/e.def
@@ -0,0 +1,49 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+(* Copyright (C) 2009 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 2, 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. *)
+
+DEFINITION MODULE e ;
+
+(*
+    Title      : e
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Feb  5 15:08:56 2010
+    Revision   : $Version$ 
+    Description: provides an interface to func2.
+*)
+
+PROCEDURE func2 ;
+
+
+END e.
diff --git a/gcc/testsuite/gm2/linking/libarchive/pass/linking-libarchive-pass.exp b/gcc/testsuite/gm2/linking/libarchive/pass/linking-libarchive-pass.exp
new file mode 100644
index 00000000000..2ca30e84fb0
--- /dev/null
+++ b/gcc/testsuite/gm2/linking/libarchive/pass/linking-libarchive-pass.exp
@@ -0,0 +1,45 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../gm2
+
+gm2_init_iso "${srcdir}/gm2/linking/libarchive/pass"
+
+gm2_link_obj "c.o m.o"
+set output [target_compile $srcdir/$subdir/c.c c.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    if { $testcase ne "$srcdir/$subdir/m.mod" } {
+	gm2_target_compile $srcdir/$subdir/m.mod m.o object "-g"
+	gm2-torture-execute $testcase "" "pass"
+    }
+}
diff --git a/gcc/testsuite/gm2/linking/libarchive/pass/m.mod b/gcc/testsuite/gm2/linking/libarchive/pass/m.mod
new file mode 100644
index 00000000000..ed7b058aa29
--- /dev/null
+++ b/gcc/testsuite/gm2/linking/libarchive/pass/m.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE m ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM d IMPORT func1 ;
+FROM e IMPORT func2 ;
+
+
+BEGIN
+   func1 ;
+   func2
+END m.
diff --git a/gcc/testsuite/gm2/linking/verbose/pass/hello.mod b/gcc/testsuite/gm2/linking/verbose/pass/hello.mod
new file mode 100644
index 00000000000..e8fa9ef7aef
--- /dev/null
+++ b/gcc/testsuite/gm2/linking/verbose/pass/hello.mod
@@ -0,0 +1,7 @@
+MODULE hello ;
+
+FROM libc IMPORT printf ;
+
+BEGIN
+   printf("hello world\n")
+END hello.
diff --git a/gcc/testsuite/gm2/linking/verbose/pass/linking-verbose-pass.exp b/gcc/testsuite/gm2/linking/verbose/pass/linking-verbose-pass.exp
new file mode 100644
index 00000000000..dcf9947ebdf
--- /dev/null
+++ b/gcc/testsuite/gm2/linking/verbose/pass/linking-verbose-pass.exp
@@ -0,0 +1,42 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../gm2
+
+gm2_init_pim "${srcdir}/gm2/linking/verbose/pass"
+
+set output [exec rm -f a.out]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+    gm2_target_compile $srcdir/$subdir/hello.mod a.out executable "-v"
+}
+
+set output [exec rm -f a.out]
diff --git a/gcc/testsuite/gm2/pim/fail/TestLong3.mod b/gcc/testsuite/gm2/pim/fail/TestLong3.mod
new file mode 100644
index 00000000000..8d22fedbb58
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/TestLong3.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2017 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 2, 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. *)
+
+MODULE TestLong3 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   l: LONGCARD ;
+BEGIN
+   l := MAX(LONGINT)+1 ;
+END TestLong3.
diff --git a/gcc/testsuite/gm2/pim/fail/TestLong6.mod b/gcc/testsuite/gm2/pim/fail/TestLong6.mod
new file mode 100644
index 00000000000..89eaf4bb9de
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/TestLong6.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE TestLong6 ;
+
+FROM SYSTEM IMPORT TSIZE ;
+FROM StrIO IMPORT WriteLn, WriteString;
+FROM FpuIO IMPORT WriteLongInt;
+FROM NumberIO IMPORT WriteCard ;
+FROM M2RTS IMPORT ExitOnHalt ;
+
+VAR
+  LongIntegerVariable : LONGINT;
+
+BEGIN
+   (* this should cause an overflow warning or error *)
+   LongIntegerVariable := MAX(LONGINT) + MAX(LONGINT)
+END TestLong6.
diff --git a/gcc/testsuite/gm2/pim/fail/a.def b/gcc/testsuite/gm2/pim/fail/a.def
new file mode 100644
index 00000000000..4a74cdc3109
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/a.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE a ;
+
+TYPE
+   o ;
+
+END a.
diff --git a/gcc/testsuite/gm2/pim/fail/assignbounds.mod b/gcc/testsuite/gm2/pim/fail/assignbounds.mod
new file mode 100644
index 00000000000..3b628b4c0d7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/assignbounds.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE assignbounds ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := -1
+END assignbounds.
diff --git a/gcc/testsuite/gm2/pim/fail/assignsubrange.mod b/gcc/testsuite/gm2/pim/fail/assignsubrange.mod
new file mode 100644
index 00000000000..5d14dd7cc65
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/assignsubrange.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE assignsubrange ;
+
+TYPE
+   foo = [10..20] ;
+
+VAR
+   c: foo ;
+BEGIN
+   c := 9
+END assignsubrange.
diff --git a/gcc/testsuite/gm2/pim/fail/assignsubrange2.mod b/gcc/testsuite/gm2/pim/fail/assignsubrange2.mod
new file mode 100644
index 00000000000..dcbd00097d1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/assignsubrange2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE assignsubrange2 ;
+
+TYPE
+   foo = [10..20] ;
+
+VAR
+   c: foo ;
+BEGIN
+   c := 10-1
+END assignsubrange2.
diff --git a/gcc/testsuite/gm2/pim/fail/b.def b/gcc/testsuite/gm2/pim/fail/b.def
new file mode 100644
index 00000000000..5cdc9d9e738
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/b.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE b ;
+
+TYPE
+   p ;
+
+END b.
diff --git a/gcc/testsuite/gm2/pim/fail/bad.def b/gcc/testsuite/gm2/pim/fail/bad.def
new file mode 100644
index 00000000000..7044ed4ead9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/bad.def
@@ -0,0 +1,21 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE bad ;
+
+EXPORT foo ;
+
+END bad.
diff --git a/gcc/testsuite/gm2/pim/fail/badconst.mod b/gcc/testsuite/gm2/pim/fail/badconst.mod
new file mode 100644
index 00000000000..3f2b5952fd7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badconst.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE badconst ;
+
+VAR
+   c : CARDINAL;
+   i : INTEGER;
+BEGIN
+   c := MIN(INTEGER) ;
+   i := MAX(CARDINAL)
+END badconst.
diff --git a/gcc/testsuite/gm2/pim/fail/badfunc.mod b/gcc/testsuite/gm2/pim/fail/badfunc.mod
new file mode 100644
index 00000000000..d7492610cbf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badfunc.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE badfunc ;
+
+(* user has forgotten to import vga_white *)
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := vga_white()
+END badfunc.
diff --git a/gcc/testsuite/gm2/pim/fail/badparam.mod b/gcc/testsuite/gm2/pim/fail/badparam.mod
new file mode 100644
index 00000000000..75ee0f4f674
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badparam.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE badparam ;
+
+TYPE
+   range1 = [low..nrBits] ;
+   range2 = [low+1..nrBits+1] ;
+
+PROCEDURE func (b: myset1) ;
+BEGIN
+   
+END func ;
+
+TYPE
+   myset1 = SET OF range1 ;
+   myset2 = SET OF range2 ;
+
+CONST
+   nrBits = 64-foo ;
+   low    = nrBits-nrBits ;
+   foo    = 32 ;
+
+BEGIN
+   func(myset2{})   (* should result in an error at this position *)
+END badparam.
diff --git a/gcc/testsuite/gm2/pim/fail/badparam2.mod b/gcc/testsuite/gm2/pim/fail/badparam2.mod
new file mode 100644
index 00000000000..fd2f23beebb
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badparam2.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE badparam2 ;
+
+PROCEDURE foo (i: INTEGER; c: myset1) : BOOLEAN ;
+BEGIN
+   RETURN( FALSE )
+END foo ;
+
+TYPE
+   proc = PROCEDURE (INTEGER, myset2) : BOOLEAN ;
+   myset1 = SET OF [low..high] ;
+   myset2 = SET OF [low+1..high-1] ;
+
+CONST
+   high = low + 10 ;
+   low  = 2 ;
+
+PROCEDURE func (pa: proc) ;
+BEGIN
+END func ;
+
+
+VAR
+   p: proc ;
+BEGIN
+   func(foo) ;
+   (* func(p) ;  (* ok *) *)
+END badparam2.
diff --git a/gcc/testsuite/gm2/pim/fail/badtype.mod b/gcc/testsuite/gm2/pim/fail/badtype.mod
new file mode 100644
index 00000000000..ab2c816e909
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badtype.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE badtype ;
+
+VAR
+   r : REAL;
+BEGIN
+   r := 5
+END badtype.
diff --git a/gcc/testsuite/gm2/pim/fail/badtypes.mod b/gcc/testsuite/gm2/pim/fail/badtypes.mod
new file mode 100644
index 00000000000..38be856da11
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badtypes.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE badtypes ;
+
+
+VAR
+   a: LONGCARD ;
+BEGIN
+   a := 1 ;
+   IF 2.2E0 * a=2
+   THEN
+   END
+END badtypes.
diff --git a/gcc/testsuite/gm2/pim/fail/bits.mod b/gcc/testsuite/gm2/pim/fail/bits.mod
new file mode 100644
index 00000000000..95b582182d6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/bits.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE bits ;
+
+TYPE
+   enum = (red, green, blue) ;
+   set  = SET OF enum ;
+VAR
+   s: set ;
+BEGIN
+   s := set{} ;
+   INCL(s, 1)
+END bits.
diff --git a/gcc/testsuite/gm2/pim/fail/bits2.mod b/gcc/testsuite/gm2/pim/fail/bits2.mod
new file mode 100644
index 00000000000..05da1429b8a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/bits2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE bits2 ;
+
+
+TYPE
+   enum = (red, green, blue) ;
+   set  = SET OF enum ;
+VAR
+   s: set ;
+BEGIN
+   s := set{} ;
+   EXCL(s, 1)
+END bits2.
diff --git a/gcc/testsuite/gm2/pim/fail/bits3.mod b/gcc/testsuite/gm2/pim/fail/bits3.mod
new file mode 100644
index 00000000000..406285846da
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/bits3.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE bits3 ;
+
+VAR
+   s: BITSET ;
+BEGIN
+   s := {} ;
+   INCL(s, FALSE)
+END bits3.
diff --git a/gcc/testsuite/gm2/pim/fail/bits4.mod b/gcc/testsuite/gm2/pim/fail/bits4.mod
new file mode 100644
index 00000000000..ca324b13fa7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/bits4.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE bits4 ;
+
+TYPE
+   enum = (red, blue, green) ;
+
+VAR
+   s: BITSET ;
+BEGIN
+   s := {} ;
+   INCL(s, red)
+END bits4.
diff --git a/gcc/testsuite/gm2/pim/fail/cardword.mod b/gcc/testsuite/gm2/pim/fail/cardword.mod
new file mode 100644
index 00000000000..228c95cd785
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/cardword.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE cardword ;
+
+FROM SYSTEM IMPORT WORD ;
+
+VAR
+   a, c: CARDINAL ;
+   w: WORD ;
+BEGIN
+   a := c+w
+END cardword.
diff --git a/gcc/testsuite/gm2/pim/fail/constbec.mod b/gcc/testsuite/gm2/pim/fail/constbec.mod
new file mode 100644
index 00000000000..f99c97dc5e8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/constbec.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE constbec ;
+
+
+CONST
+   b = 10 ;
+
+VAR
+   a: CARDINAL ;
+BEGIN
+   b := a
+END constbec.
diff --git a/gcc/testsuite/gm2/pim/fail/constsize3.mod b/gcc/testsuite/gm2/pim/fail/constsize3.mod
new file mode 100644
index 00000000000..4b67c310c74
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/constsize3.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE constsize3 ;
+
+(* test should fail with cyclic dependancy error *)
+
+FROM SYSTEM IMPORT SIZE ;
+
+CONST
+   foo = SIZE(bar) ;
+
+TYPE
+   mumble = ARRAY [0..foo] OF CHAR ;
+   bar = ARRAY [0..SIZE(mumble)] OF CARDINAL ;
+
+VAR
+   b: bar ;
+   x: CARDINAL ;
+BEGIN
+   x := foo
+END constsize3.
diff --git a/gcc/testsuite/gm2/pim/fail/constvar.mod b/gcc/testsuite/gm2/pim/fail/constvar.mod
new file mode 100644
index 00000000000..2ee4c5e6518
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/constvar.mod
@@ -0,0 +1,9 @@
+MODULE constvar ;
+
+VAR
+   a: CARDINAL ;
+
+CONST
+   b = a ;
+
+END constvar.
diff --git a/gcc/testsuite/gm2/pim/fail/convert5.mod b/gcc/testsuite/gm2/pim/fail/convert5.mod
new file mode 100644
index 00000000000..4e99c82291b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/convert5.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE convert5 ;
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+PROCEDURE foo (c: CARDINAL) : INTEGER ;
+BEGIN
+(*   RETURN( -VAL(INTEGER, VAL(CARDINAL, MAX(INTEGER))+1) ) *)
+   RETURN( -VAL(INTEGER, VAL(CARDINAL, 2147483647)+1) )
+END foo ;
+
+BEGIN
+   IF foo(2)=2
+   THEN
+   END
+END convert5.
diff --git a/gcc/testsuite/gm2/pim/fail/dupconst.mod b/gcc/testsuite/gm2/pim/fail/dupconst.mod
new file mode 100644
index 00000000000..8f23b3a8bcd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/dupconst.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE dupconst ;
+
+CONST
+   foo = 1024 ;
+   foo =  512 ;
+
+BEGIN
+
+END dupconst.
diff --git a/gcc/testsuite/gm2/pim/fail/dupenum.mod b/gcc/testsuite/gm2/pim/fail/dupenum.mod
new file mode 100644
index 00000000000..df4ecd1bcb1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/dupenum.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE dupenum ;
+
+
+TYPE
+   foo = (black, blue, green, red) ;
+   bar = (black, white) ;
+
+BEGIN
+
+END dupenum.
diff --git a/gcc/testsuite/gm2/pim/fail/dupfield.mod b/gcc/testsuite/gm2/pim/fail/dupfield.mod
new file mode 100644
index 00000000000..167994cdc96
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/dupfield.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE dupfield ;
+
+
+TYPE
+   t = RECORD
+          f: CARDINAL ;
+          f: INTEGER ;
+       END ;
+
+VAR
+   i: t ;
+BEGIN
+   i.f := 0
+END dupfield.
diff --git a/gcc/testsuite/gm2/pim/fail/duptype.mod b/gcc/testsuite/gm2/pim/fail/duptype.mod
new file mode 100644
index 00000000000..df258db1208
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/duptype.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE duptype ;
+
+
+TYPE
+   t = CARDINAL ;
+   t = RECORD
+          i, j: CARDINAL ;
+       END ;
+BEGIN
+
+END duptype.
diff --git a/gcc/testsuite/gm2/pim/fail/dupvar.mod b/gcc/testsuite/gm2/pim/fail/dupvar.mod
new file mode 100644
index 00000000000..ed535e513d6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/dupvar.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE dupvar ;
+
+
+VAR
+   x: CARDINAL ;
+   x: INTEGER ;
+BEGIN
+   x := 0
+END dupvar.
diff --git a/gcc/testsuite/gm2/pim/fail/expression.mod b/gcc/testsuite/gm2/pim/fail/expression.mod
new file mode 100644
index 00000000000..79adff7960e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/expression.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2020 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 2, 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. *)
+
+MODULE expression ;
+
+VAR
+   k   : CHAR ;
+   i, j: CARDINAL ;
+BEGIN
+   i := j + k
+END expression.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/fail/expression2.mod b/gcc/testsuite/gm2/pim/fail/expression2.mod
new file mode 100644
index 00000000000..e7079848fdc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/expression2.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2020 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 2, 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. *)
+
+MODULE expression2 ;
+
+VAR
+   i   : CHAR ;
+   j, k: CARDINAL ;
+BEGIN
+   i := j + k
+END expression2.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/fail/expression3.mod b/gcc/testsuite/gm2/pim/fail/expression3.mod
new file mode 100644
index 00000000000..f83478dc0da
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/expression3.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2020 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 2, 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. *)
+
+MODULE expression3 ;
+
+VAR
+   r   : REAL ;
+   j, k: CARDINAL ;
+BEGIN
+   r := 3.14 ;
+   k := (j + k) + r ;
+   (* another line.  *)
+END expression3.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/fail/func.mod b/gcc/testsuite/gm2/pim/fail/func.mod
new file mode 100644
index 00000000000..43a91979373
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/func.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2020 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 2, 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. *)
+
+MODULE func ;
+
+PROCEDURE test (c: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN c
+END test ;
+
+VAR
+   r: REAL ;
+   c: CARDINAL ;
+   i: INTEGER ;
+BEGIN
+   c := 12 ;
+   (* r := test (1 + 2) ; *)
+   c := test (1 + 2) + r ;
+(*   c := test (VAL (REAL, c)) *)
+END func.
diff --git a/gcc/testsuite/gm2/pim/fail/good.def b/gcc/testsuite/gm2/pim/fail/good.def
new file mode 100644
index 00000000000..548aa4931f7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/good.def
@@ -0,0 +1,19 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE good ;
+
+END good.
diff --git a/gcc/testsuite/gm2/pim/fail/good.mod b/gcc/testsuite/gm2/pim/fail/good.mod
new file mode 100644
index 00000000000..92300c5cc42
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/good.mod
@@ -0,0 +1,21 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE good ;
+
+FROM bad IMPORT foo ;
+
+END good.
diff --git a/gcc/testsuite/gm2/pim/fail/import.mod b/gcc/testsuite/gm2/pim/fail/import.mod
new file mode 100644
index 00000000000..804ce6390e4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/import.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE import ;
+
+IMPORT Strings ;
+
+VAR
+   s: Strings.String ;
+BEGIN
+   foobar(s) ;
+   s := Strings.InitString('')
+END import.
diff --git a/gcc/testsuite/gm2/pim/fail/inserttok.def b/gcc/testsuite/gm2/pim/fail/inserttok.def
new file mode 100644
index 00000000000..df5e70ea27c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/inserttok.def
@@ -0,0 +1,19 @@
+DEFINITION MODULE inserttok ;
+
+(* Just filling the token buffer up *)
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR
+VAR VAR VAR VAR VAR VAR VAR VAR VAR
+
+(* Intentional misspelled VAR keyword *)
+PROCEDURE whatever (VAT s: ARRAY OF CHAR) : CARDINAL;
+
+END inserttok.
diff --git a/gcc/testsuite/gm2/pim/fail/inserttok.mod b/gcc/testsuite/gm2/pim/fail/inserttok.mod
new file mode 100644
index 00000000000..08c2a68a0dc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/inserttok.mod
@@ -0,0 +1,5 @@
+IMPLEMENTATION MODULE inserttok ;
+
+(* Hit this problem in a definition module *)
+
+END inserttok.
diff --git a/gcc/testsuite/gm2/pim/fail/integer.mod b/gcc/testsuite/gm2/pim/fail/integer.mod
new file mode 100644
index 00000000000..e2d371ed902
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/integer.mod
@@ -0,0 +1,271 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE integer ;
+
+(*
+    Title      : integer
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri May 18 17:05:36 2012
+    Revision   : $Version$
+    Description: simple test module to test the principles of catching signed and unsigned
+                 integer arithmetic overflow.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM libc IMPORT printf ;
+FROM DynamicStrings IMPORT String, InitString, string, KillString, InitString ;
+
+CONST
+   Verbose = TRUE ;
+   SizeOfIntAndLongSame = TRUE ;
+
+
+PROCEDURE ssub (i, j: INTEGER) ;
+BEGIN
+   IF ((j>0) AND (i < MIN(INTEGER)+j)) OR
+      ((j<0) AND (i > MAX(INTEGER)+j))
+   THEN
+      expecting(overflow, 'signed subtraction')
+   ELSE
+      expecting(none, 'signed subtraction')
+   END
+END ssub ;
+
+
+PROCEDURE sadd (i, j: INTEGER) ;
+BEGIN
+   IF ((j = MAX(INTEGER) AND (i > 0))) OR
+      ((i = MAX(INTEGER) AND (j > 0))) OR
+
+      ((j>0) AND (i > MAX(INTEGER)-j)) OR
+      ((j<0) AND (i < MIN(INTEGER)-j))
+   THEN
+      expecting(overflow, 'signed addition')
+   ELSE
+      expecting(none, 'signed addition')
+   END
+END sadd ;
+
+
+(*
+   smallMult -
+*)
+
+PROCEDURE smallMult (i, j: INTEGER) ;
+BEGIN
+   IF i>0
+   THEN
+      IF j>0
+      THEN
+         IF i>maxInt DIV j
+         THEN
+            expecting(overflow, 'signed mult')
+         ELSE
+            expecting(none, 'signed mult')
+         END
+      ELSE
+         IF j<minInt DIV i
+         THEN
+            expecting(overflow, 'signed mult')
+         ELSE
+            expecting(none, 'signed mult')
+         END
+      END
+   ELSE
+      IF j>0
+      THEN
+         IF i<minInt DIV j
+         THEN
+            expecting(overflow, 'signed mult')
+         ELSE
+            expecting(none, 'signed mult')
+         END
+      ELSE
+         IF (i#0) AND (j<maxInt DIV i)
+         THEN
+            expecting(overflow, 'signed mult')
+         ELSE
+            expecting(none, 'signed mult')
+         END
+      END
+   END
+END smallMult ;
+
+
+(*
+   smult -
+*)
+
+PROCEDURE smult (i, j: INTEGER) ;
+VAR
+   li, lj, lt: LONGINT ;
+BEGIN
+   IF SizeOfIntAndLongSame OR (SIZE(LONGINT)=SIZE(INTEGER))
+   THEN
+      smallMult(i, j)
+   ELSE
+      li := i ;
+      lj := j ;
+      lt := li * lj ;
+      IF (lt<VAL(LONGINT, minInt)) OR (lt>VAL(LONGINT, maxInt))
+      THEN
+         expecting(overflow, 'signed multiply')
+      ELSE
+         expecting(none, 'signed multiply')
+      END
+   END
+END smult ;
+
+
+(*
+   sneg -
+*)
+
+PROCEDURE sneg (i: INTEGER) ;
+BEGIN
+   IF i=minInt
+   THEN
+      expecting(overflow, 'signed negate')
+   ELSE
+      expecting(none, 'signed negate')
+   END
+END sneg ;
+
+
+(*
+   passed -
+*)
+
+PROCEDURE expecting (e: error; a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+   t: ADDRESS ;
+BEGIN
+   WITH test[testNo] DO
+      IF expected#e
+      THEN
+         s := InitString(a) ;
+         t := string(s) ;
+         printf("test %s (%d) has failed\n", t, testNo) ;
+         s := KillString(s)
+      ELSIF Verbose
+      THEN
+         s := InitString(a) ;
+         t := string(s) ;
+         printf("test %s (%d) has passed\n", t, testNo) ;
+         s := KillString(s)
+      END
+   END
+END expecting ;
+
+
+(*
+   doTest -
+*)
+
+PROCEDURE doTest ;
+BEGIN
+   WITH test[testNo] DO
+      CASE op OF
+
+      iadd :  sadd(l, r) |
+      isub :  ssub(l, r) |
+      ineg :  sneg(l) |
+      imult:  smult(l, r) |
+      idiv :  |
+      imod :  |
+
+      END
+   END
+END doTest ;
+
+
+(*
+   doTests -
+*)
+
+PROCEDURE doTests ;
+BEGIN
+   testNo := 0 ;
+   WHILE testNo<=maxTest DO
+      doTest ;
+      INC(testNo)
+   END
+END doTests ;
+
+
+CONST
+   maxTest = 25 ;
+   maxInt = MAX(INTEGER) ;
+   minInt = MIN(INTEGER) ;
+
+TYPE
+   opcode = (iadd, isub, ineg, imult, idiv, imod) ;
+   error  = (overflow, underflow, none) ;
+
+   case = RECORD
+             l, r    : INTEGER ;
+             op      : opcode ;
+             expected: error ;
+          END ;
+   cases = ARRAY [0..maxTest] OF case ;
+
+VAR
+   test  : cases ;
+   testNo: CARDINAL ;
+
+BEGIN
+   test := cases{{minInt, 0, ineg, overflow},
+                 (* 1 *)
+                 {maxInt, 0, ineg, none},
+                 {minInt DIV 2, minInt DIV 2, iadd, none},
+                 {minInt DIV 2, minInt DIV 2-1, iadd, overflow},
+                 {maxInt DIV 2, maxInt DIV 2, iadd, none},
+                 (* 4 *)
+                 {maxInt DIV 2, maxInt DIV 2+1, iadd, none},
+                 {maxInt DIV 2+1, maxInt DIV 2+1, iadd, overflow},
+                 {maxInt, 1, iadd, overflow},
+                 {maxInt, 0, iadd, none},
+                 (* 8 *)
+                 {minInt, -1, iadd, overflow},
+                 {minInt, 0, iadd, none},
+                 {-1, maxInt, isub, none},
+                 {-2, maxInt, isub, overflow},
+                 (* 12 *)
+                 {minInt, 1, isub, overflow},
+                 {minInt, 0, isub, none},
+                 {maxInt, -2, isub, overflow},
+                 {maxInt, minInt, isub, overflow},
+                 (* 16 *)
+                 {0, maxInt, isub, none},
+                 {0, minInt, isub, overflow},
+                 {-1, maxInt, isub, none},
+                 {-2, maxInt, isub, overflow},
+                 (* 20 *)
+                 {maxInt, 2, imult, overflow},
+                 {maxInt DIV 2, 2, imult, none},
+                 {minInt DIV 2, 2, imult, none},
+                 {minInt DIV 2-1, 2, imult, overflow},
+		 (* 24 *)
+                 {maxInt DIV 3, 3, imult, none},
+                 {minInt DIV 3, 3, imult, none}
+           } ;
+   doTests
+END integer.
diff --git a/gcc/testsuite/gm2/pim/fail/keyword.mod b/gcc/testsuite/gm2/pim/fail/keyword.mod
new file mode 100644
index 00000000000..68d5df78388
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/keyword.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE keyword ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   FOR i DO   (* missing keyword.  *)
+   END
+END keyword.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/fail/longtypes2.mod b/gcc/testsuite/gm2/pim/fail/longtypes2.mod
new file mode 100644
index 00000000000..f19231dccd4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/longtypes2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes2 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE foo (VAR l: LONGREAL) ;
+BEGIN
+   IF l#315.0
+   THEN
+      exit(1)
+   END
+END foo ;
+
+
+VAR
+   r: REAL ;
+BEGIN
+   r := 315.0 ;
+   foo(r)
+END longtypes2.
diff --git a/gcc/testsuite/gm2/pim/fail/longtypes3.mod b/gcc/testsuite/gm2/pim/fail/longtypes3.mod
new file mode 100644
index 00000000000..a99fe5104a7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/longtypes3.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes3 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE foo (VAR l: LONGCARD) ;
+BEGIN
+   IF l#3*256*256*256+5
+   THEN
+      exit(1)
+   END
+END foo ;
+
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 3*256*256*256+5 ;
+   foo(c)
+END longtypes3.
diff --git a/gcc/testsuite/gm2/pim/fail/multisetf.mod b/gcc/testsuite/gm2/pim/fail/multisetf.mod
new file mode 100644
index 00000000000..3faef795493
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/multisetf.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE multisetf ;
+
+TYPE
+   small = SET OF [0..31] ;
+   large = RECORD
+              e: ARRAY [0..7] OF small
+           END ;
+
+VAR
+   l: large ;
+   s: small ;
+BEGIN
+   s := {1, 3, 5, 7, 9} ;
+   l.e[0] := s ;
+   l.e[1] := s ;
+   l.e[2] := {0, 2, 4} ;
+   l.e[3] := s ;
+   l.e[4] := s ;
+   l.e[5] := {6, 8, 10} ;
+   l.e[6] := s ;
+   l.e[7] := s
+END multisetf.
diff --git a/gcc/testsuite/gm2/pim/fail/nested3.mod b/gcc/testsuite/gm2/pim/fail/nested3.mod
new file mode 100644
index 00000000000..18bb1e6bae4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/nested3.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nested3 ;
+
+
+PROCEDURE proc1 (val: INTEGER) ;
+BEGIN
+END proc1 ;
+
+
+PROCEDURE proc2 ;
+
+   MODULE mod1;
+   EXPORT val ;
+   VAR
+       val: REAL ;
+   BEGIN
+   END mod1 ;
+
+BEGIN
+   val := 1.5
+END proc2 ;
+
+
+BEGIN
+   val := 9.9   (* should cause undefined symbol error *)
+END nested3.
+
diff --git a/gcc/testsuite/gm2/pim/fail/opaque.mod b/gcc/testsuite/gm2/pim/fail/opaque.mod
new file mode 100644
index 00000000000..8f0d45e5594
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/opaque.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE opaque ;
+
+FROM a IMPORT o ;
+FROM b IMPORT p ;
+
+VAR
+   x: o ;
+   y: p ;
+BEGIN
+   IF x=y
+   THEN
+   END
+END opaque.
diff --git a/gcc/testsuite/gm2/pim/fail/opaque2.mod b/gcc/testsuite/gm2/pim/fail/opaque2.mod
new file mode 100644
index 00000000000..3feb278b9c9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/opaque2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE opaque2 ;
+
+FROM a IMPORT o ;
+FROM b IMPORT p ;
+
+PROCEDURE foo (c: p) ;
+BEGIN
+END foo ;
+
+
+VAR
+   x: o ;
+BEGIN
+   foo(x)
+END opaque2.
diff --git a/gcc/testsuite/gm2/pim/fail/opasfail.mod b/gcc/testsuite/gm2/pim/fail/opasfail.mod
new file mode 100644
index 00000000000..83c1fb4639b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/opasfail.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE opasfail ;
+
+FROM opaquetype IMPORT foo, bar ;
+
+VAR
+   f: foo ;
+   b: bar ;
+BEGIN
+   f := b
+END opasfail.
diff --git a/gcc/testsuite/gm2/pim/fail/opcpfail.mod b/gcc/testsuite/gm2/pim/fail/opcpfail.mod
new file mode 100644
index 00000000000..2fe7cb4e09f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/opcpfail.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE opcpfail ;
+
+FROM opaquetype IMPORT foo, bar ;
+
+VAR
+   f: foo ;
+   b: bar ;
+BEGIN
+   IF f=b
+   THEN
+   END
+END opcpfail.
diff --git a/gcc/testsuite/gm2/pim/fail/pim-fail.exp b/gcc/testsuite/gm2/pim/fail/pim-fail.exp
new file mode 100644
index 00000000000..955f8be8c7b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/pim-fail.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/pim/fail:${srcdir}/gm2/pim/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/pim/fail/procmod.mod b/gcc/testsuite/gm2/pim/fail/procmod.mod
new file mode 100644
index 00000000000..47398df229c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/procmod.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod ;
+
+   PROCEDURE foo ;
+      MODULE bar ;
+      EXPORT nothing ;
+      BEGIN
+      END bar ;
+   BEGIN
+   END foo ;
+
+BEGIN
+   foo
+END procmod.
diff --git a/gcc/testsuite/gm2/pim/fail/rotate.mod b/gcc/testsuite/gm2/pim/fail/rotate.mod
new file mode 100644
index 00000000000..39bea274fb4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/rotate.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE rotate ;
+
+FROM SYSTEM IMPORT ROTATE ;
+
+TYPE
+   foo = SET OF [5..7] ;
+VAR
+   b: foo ;
+BEGIN
+   b := foo{6} ;
+   b := ROTATE(b, 4)
+END rotate.
diff --git a/gcc/testsuite/gm2/pim/fail/rotate2.mod b/gcc/testsuite/gm2/pim/fail/rotate2.mod
new file mode 100644
index 00000000000..121915582b2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/rotate2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE rotate2 ;
+
+FROM SYSTEM IMPORT ROTATE ;
+
+TYPE
+   foo = SET OF [5..7] ;
+VAR
+   b: foo ;
+BEGIN
+   b := foo{6} ;
+   b := ROTATE(b, -4)
+END rotate2.
diff --git a/gcc/testsuite/gm2/pim/fail/setbec.mod b/gcc/testsuite/gm2/pim/fail/setbec.mod
new file mode 100644
index 00000000000..2395a70f328
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/setbec.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE setbec ;
+
+TYPE
+   SmallSet = SET OF [0..16] ;
+
+VAR
+   s: SmallSet ;
+   b: BITSET ;
+BEGIN
+   s := SmallSet{1, 3, 5, 7};
+   b := s
+END setbec.
diff --git a/gcc/testsuite/gm2/pim/fail/setequiv.mod b/gcc/testsuite/gm2/pim/fail/setequiv.mod
new file mode 100644
index 00000000000..e2382c2418a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/setequiv.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE setequiv ;
+
+TYPE
+   Enum = (A, B, C, D);
+   Typ = [B..D];
+
+VAR
+   typ : Typ;
+   styp: SET OF Typ;
+BEGIN
+   IF typ = A
+   THEN
+      typ := B
+   END ;
+   IF A IN styp  (* should cause a failure *)
+   THEN
+      typ := B
+   END
+END setequiv.
diff --git a/gcc/testsuite/gm2/pim/fail/setsnulf.mod b/gcc/testsuite/gm2/pim/fail/setsnulf.mod
new file mode 100644
index 00000000000..65f8948c908
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/setsnulf.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setsnulf ;
+
+
+TYPE
+   LargeSet = SET OF [0..255] ;
+   SmallSet = SET OF [0..127] ;
+
+VAR
+   l: LargeSet ;
+   s: SmallSet ;
+BEGIN
+   l := {} ;
+   s := {} ;
+   IF l={}
+   THEN
+   
+   END ;
+   IF s={}
+   THEN
+      
+   END
+END setsnulf.
diff --git a/gcc/testsuite/gm2/pim/fail/settype.mod b/gcc/testsuite/gm2/pim/fail/settype.mod
new file mode 100644
index 00000000000..695534a9790
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/settype.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE settype ;
+
+
+TYPE
+   foo = SET OF colour ;
+   colour = (red, green, blue) ;
+
+VAR
+   s: foo ;
+BEGIN
+   s := {1, 2}
+END settype.
diff --git a/gcc/testsuite/gm2/pim/fail/shift.mod b/gcc/testsuite/gm2/pim/fail/shift.mod
new file mode 100644
index 00000000000..79d60559827
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/shift.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE shift ;
+
+FROM SYSTEM IMPORT SHIFT ;
+
+TYPE
+   foo = SET OF [5..7] ;
+VAR
+   b: foo ;
+BEGIN
+   b := foo{6} ;
+   b := SHIFT(b, 4)
+END shift.
diff --git a/gcc/testsuite/gm2/pim/fail/shift2.mod b/gcc/testsuite/gm2/pim/fail/shift2.mod
new file mode 100644
index 00000000000..986d988462f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/shift2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE shift2 ;
+
+FROM SYSTEM IMPORT SHIFT ;
+
+TYPE
+   foo = SET OF [5..7] ;
+VAR
+   b: foo ;
+BEGIN
+   b := foo{6} ;
+   b := SHIFT(b, -4)
+END shift2.
diff --git a/gcc/testsuite/gm2/pim/fail/subrange7.mod b/gcc/testsuite/gm2/pim/fail/subrange7.mod
new file mode 100644
index 00000000000..b32491144c1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/subrange7.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE subrange7 ;
+
+CONST
+   low = ind0(50);
+   high = ind0(100);
+TYPE
+   ind = [low..high];
+   ind0 = [60..100];
+
+VAR
+   a : ARRAY [10..100] OF INTEGER;
+   b : ARRAY ind OF INTEGER;
+
+BEGIN
+END subrange7.
diff --git a/gcc/testsuite/gm2/pim/fail/unary.mod b/gcc/testsuite/gm2/pim/fail/unary.mod
new file mode 100644
index 00000000000..9986abf6e39
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/unary.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2020 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 2, 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. *)
+
+MODULE unary ;
+
+VAR
+   c: CHAR ;
+   i: CARDINAL ;
+BEGIN
+   i := - c
+END unary.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/fail/undeclared.mod b/gcc/testsuite/gm2/pim/fail/undeclared.mod
new file mode 100644
index 00000000000..86762df665f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/undeclared.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE undeclared ;  (*!m2pim+gm2*)
+
+
+BEGIN
+   foo := 1
+END undeclared.
diff --git a/gcc/testsuite/gm2/pim/fail/val.mod b/gcc/testsuite/gm2/pim/fail/val.mod
new file mode 100644
index 00000000000..78ed629b10d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/val.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2020 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 2, 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. *)
+
+MODULE val ;
+
+VAR
+   r: REAL ;
+   c: CARDINAL ;
+   i: INTEGER ;
+BEGIN
+   c := 12 ;
+   r := VAL (INTEGER, c)
+END val.
diff --git a/gcc/testsuite/gm2/pim/fail/val2.mod b/gcc/testsuite/gm2/pim/fail/val2.mod
new file mode 100644
index 00000000000..752b76f673b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/val2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2020 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 2, 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. *)
+
+MODULE val2 ;
+
+PROCEDURE test (c: CARDINAL) ;
+BEGIN
+END test ;
+
+VAR
+   r: REAL ;
+   c: CARDINAL ;
+   i: INTEGER ;
+BEGIN
+   c := 12 ;
+   test (1 + 2) ;
+   test (VAL (REAL, c))
+END val2.
diff --git a/gcc/testsuite/gm2/pim/fail/wordconst.mod b/gcc/testsuite/gm2/pim/fail/wordconst.mod
new file mode 100644
index 00000000000..57d153ca7d5
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/wordconst.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE wordconst ;
+
+FROM SYSTEM IMPORT WORD, BYTE ;
+
+CONST
+   word = WORD(012H) ;
+
+VAR
+   b: BYTE ;
+BEGIN
+   b := word
+END wordconst.
diff --git a/gcc/testsuite/gm2/pim/no-options/run/pass/integer.mod b/gcc/testsuite/gm2/pim/no-options/run/pass/integer.mod
new file mode 100644
index 00000000000..212b542fd16
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/no-options/run/pass/integer.mod
@@ -0,0 +1,274 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE integer ;
+
+(*
+    Title      : integer
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri May 18 17:05:36 2012
+    Revision   : $Version$
+    Description: simple test module to test the principles of catching signed and unsigned
+                 integer arithmetic overflow.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM libc IMPORT printf ;
+FROM DynamicStrings IMPORT String, InitString, string, KillString, InitString ;
+
+CONST
+   Verbose = TRUE ;
+   SizeOfIntAndLongSame = TRUE ;
+
+
+PROCEDURE ssub (i, j: INTEGER) ;
+BEGIN
+   IF ((j>0) AND (i < MIN(INTEGER)+j)) OR
+      ((j<0) AND (i > MAX(INTEGER)+j))
+   THEN
+      expecting(overflow, 'signed subtraction')
+   ELSE
+      expecting(none, 'signed subtraction')
+   END
+END ssub ;
+
+
+PROCEDURE sadd (i, j: INTEGER) ;
+BEGIN
+   printf ("i = %d,  j = %d   MIN(INTEGER) = %d\n",
+           i, j, MIN(INTEGER));
+   printf ("MIN(INTEGER) = %d,  -j = %d\n", MIN(INTEGER), -j);
+   IF ((j = MIN(INTEGER)) AND (i < 0)) OR
+      ((i = MIN(INTEGER)) AND (j < 0)) OR
+
+      ((j>0) AND (i > MAX(INTEGER)-j)) OR
+      ((j<0) AND (i < MIN(INTEGER)-j))
+   THEN
+      expecting(overflow, 'signed addition')
+   ELSE
+      expecting(none, 'signed addition')
+   END
+END sadd ;
+
+
+(*
+   smallMult -
+*)
+
+PROCEDURE smallMult (i, j: INTEGER) ;
+BEGIN
+   IF i>0
+   THEN
+      IF j>0
+      THEN
+         IF i>maxInt DIV j
+         THEN
+            expecting(overflow, 'signed mult')
+         ELSE
+            expecting(none, 'signed mult')
+         END
+      ELSE
+         IF j<minInt DIV i
+         THEN
+            expecting(overflow, 'signed mult')
+         ELSE
+            expecting(none, 'signed mult')
+         END
+      END
+   ELSE
+      IF j>0
+      THEN
+         IF i<minInt DIV j
+         THEN
+            expecting(overflow, 'signed mult')
+         ELSE
+            expecting(none, 'signed mult')
+         END
+      ELSE
+         IF (i#0) AND (j<maxInt DIV i)
+         THEN
+            expecting(overflow, 'signed mult')
+         ELSE
+            expecting(none, 'signed mult')
+         END
+      END
+   END
+END smallMult ;
+
+
+(*
+   smult -
+*)
+
+PROCEDURE smult (i, j: INTEGER) ;
+VAR
+   li, lj, lt: LONGINT ;
+BEGIN
+   IF SizeOfIntAndLongSame OR (SIZE(LONGINT)=SIZE(INTEGER))
+   THEN
+      smallMult(i, j)
+   ELSE
+      li := i ;
+      lj := j ;
+      lt := li * lj ;
+      IF (lt<VAL(LONGINT, minInt)) OR (lt>VAL(LONGINT, maxInt))
+      THEN
+         expecting(overflow, 'signed multiply')
+      ELSE
+         expecting(none, 'signed multiply')
+      END
+   END
+END smult ;
+
+
+(*
+   sneg -
+*)
+
+PROCEDURE sneg (i: INTEGER) ;
+BEGIN
+   IF i=minInt
+   THEN
+      expecting(overflow, 'signed negate')
+   ELSE
+      expecting(none, 'signed negate')
+   END
+END sneg ;
+
+
+(*
+   passed -
+*)
+
+PROCEDURE expecting (e: error; a: ARRAY OF CHAR) ;
+VAR
+   s: String ;
+   t: ADDRESS ;
+BEGIN
+   WITH test[testNo] DO
+      IF expected#e
+      THEN
+         s := InitString(a) ;
+         t := string(s) ;
+         printf("test %s (%d) has failed\n", t, testNo) ;
+         s := KillString(s)
+      ELSIF Verbose
+      THEN
+         s := InitString(a) ;
+         t := string(s) ;
+         printf("test %s (%d) has passed\n", t, testNo) ;
+         s := KillString(s)
+      END
+   END
+END expecting ;
+
+
+(*
+   doTest -
+*)
+
+PROCEDURE doTest ;
+BEGIN
+   WITH test[testNo] DO
+      CASE op OF
+
+      iadd :  sadd(l, r) |
+      isub :  ssub(l, r) |
+      ineg :  sneg(l) |
+      imult:  smult(l, r) |
+      idiv :  |
+      imod :  |
+
+      END
+   END
+END doTest ;
+
+
+(*
+   doTests -
+*)
+
+PROCEDURE doTests ;
+BEGIN
+   testNo := 0 ;
+   WHILE testNo<=maxTest DO
+      doTest ;
+      INC(testNo)
+   END
+END doTests ;
+
+
+CONST
+   maxTest = 25 ;
+   maxInt = MAX(INTEGER) ;
+   minInt = MIN(INTEGER) ;
+
+TYPE
+   opcode = (iadd, isub, ineg, imult, idiv, imod) ;
+   error  = (overflow, underflow, none) ;
+
+   case = RECORD
+             l, r    : INTEGER ;
+             op      : opcode ;
+             expected: error ;
+          END ;
+   cases = ARRAY [0..maxTest] OF case ;
+
+VAR
+   test  : cases ;
+   testNo: CARDINAL ;
+
+BEGIN
+   test := cases{{minInt, 0, ineg, overflow},
+                 (* 1 *)
+                 {maxInt, 0, ineg, none},
+                 {minInt DIV 2, minInt DIV 2, iadd, none},
+                 {minInt DIV 2, minInt DIV 2-1, iadd, overflow},
+                 {maxInt DIV 2, maxInt DIV 2, iadd, none},
+                 (* 4 *)
+                 {maxInt DIV 2, maxInt DIV 2+1, iadd, none},
+                 {maxInt DIV 2+1, maxInt DIV 2+1, iadd, overflow},
+                 {maxInt, 1, iadd, overflow},
+                 {maxInt, 0, iadd, none},
+                 (* 8 *)
+                 {minInt, -1, iadd, overflow},
+                 {minInt, 0, iadd, none},
+                 {-1, maxInt, isub, none},
+                 {-2, maxInt, isub, overflow},
+                 (* 12 *)
+                 {minInt, 1, isub, overflow},
+                 {minInt, 0, isub, none},
+                 {maxInt, -2, isub, overflow},
+                 {maxInt, minInt, isub, overflow},
+                 (* 16 *)
+                 {0, maxInt, isub, none},
+                 {0, minInt, isub, overflow},
+                 {-1, maxInt, isub, none},
+                 {-2, maxInt, isub, overflow},
+                 (* 20 *)
+                 {maxInt, 2, imult, overflow},
+                 {maxInt DIV 2, 2, imult, none},
+                 {minInt DIV 2, 2, imult, none},
+                 {minInt DIV 2-1, 2, imult, overflow},
+		 (* 24 *)
+                 {maxInt DIV 3, 3, imult, none},
+                 {minInt DIV 3, 3, imult, none}
+           } ;
+   doTests
+END integer.
diff --git a/gcc/testsuite/gm2/pim/no-options/run/pass/pim-no-options-run-pass.exp b/gcc/testsuite/gm2/pim/no-options/run/pass/pim-no-options-run-pass.exp
new file mode 100644
index 00000000000..31cb0ed738e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/no-options/run/pass/pim-no-options-run-pass.exp
@@ -0,0 +1,38 @@
+# Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/pim/no-options/run/pass/" -g
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/pim/options/bounds/fail/IdentifierBug.mod b/gcc/testsuite/gm2/pim/options/bounds/fail/IdentifierBug.mod
new file mode 100644
index 00000000000..790425799b4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/options/bounds/fail/IdentifierBug.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE IdentifierBug;
+
+VAR
+   c: INTEGER;
+BEGIN
+   C := 1
+END IdentifierBug.
diff --git a/gcc/testsuite/gm2/pim/options/bounds/fail/pim-options-bounds-fail.exp b/gcc/testsuite/gm2/pim/options/bounds/fail/pim-options-bounds-fail.exp
new file mode 100644
index 00000000000..5b5243696cf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/options/bounds/fail/pim-options-bounds-fail.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/../gm2/pim/pass" -frange
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/pim/options/optimize/run/pass/addition.def b/gcc/testsuite/gm2/pim/options/optimize/run/pass/addition.def
new file mode 100644
index 00000000000..eb57c600971
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/options/optimize/run/pass/addition.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006, 2007, 2008 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 2, 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. *)
+
+DEFINITION MODULE addition ;
+
+EXPORT QUALIFIED add ;
+PROCEDURE add (x, y: CARDINAL) : CARDINAL ;
+
+END addition.
diff --git a/gcc/testsuite/gm2/pim/options/optimize/run/pass/addition.mod b/gcc/testsuite/gm2/pim/options/optimize/run/pass/addition.mod
new file mode 100644
index 00000000000..04048ab2851
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/options/optimize/run/pass/addition.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005, 2006, 2007, 2008 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 2, 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. *)
+
+IMPLEMENTATION MODULE addition ;
+
+PROCEDURE add (x, y: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN x+y
+END add ;
+
+END addition.
diff --git a/gcc/testsuite/gm2/pim/options/optimize/run/pass/concat.mod b/gcc/testsuite/gm2/pim/options/optimize/run/pass/concat.mod
new file mode 100644
index 00000000000..10d619580fc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/options/optimize/run/pass/concat.mod
@@ -0,0 +1,57 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE concat ;
+
+FROM StrLib IMPORT StrConCat, StrLen, StrEqual ;
+FROM NumberIO IMPORT CardToStr ;
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+PROCEDURE foo ;
+VAR
+   line: ARRAY [0..79] OF CHAR ;
+BEGIN
+   CardToStr(10000, 6, line) ;
+   Assert(StrEqual(line, ' 10000'), __FILE__, __LINE__, 'StrEqual of CardToStr') ;
+   StrConCat(' ', line, line) ;
+   Assert(StrLen(line)=7, __FILE__, __LINE__, 'StrLen of StrConCat') ;
+   Assert(StrEqual(line, '  10000'), __FILE__, __LINE__, 'StrEqual')
+END foo ;
+
+
+BEGIN
+   foo
+END concat.
diff --git a/gcc/testsuite/gm2/pim/options/optimize/run/pass/pim-options-optimize-run-pass.exp b/gcc/testsuite/gm2/pim/options/optimize/run/pass/pim-options-optimize-run-pass.exp
new file mode 100644
index 00000000000..1a4ad54ed50
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/options/optimize/run/pass/pim-options-optimize-run-pass.exp
@@ -0,0 +1,56 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/pim/options/optimize/run/pass/"
+
+set copy_gm2_link_path ${gm2_link_path};
+set copy_gm2_link_objects ${gm2_link_objects};
+set gm2_link_objects "";
+set gm2_link_path "";
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    global gm2_link_objects;
+    global gm2_link_path;
+
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    if { $testcase ne "$srcdir/$subdir/addition.mod" } {
+	set output [exec rm -f addition.o];
+	set gm2_link_objects "";
+	set gm2_link_path "";
+	set output [gm2_target_compile $srcdir/$subdir/addition.mod addition.o object "-g"]
+	set gm2_link_path ${copy_gm2_link_path};
+	# set gm2_link_objects
+	gm2_link_obj "addition.o"
+	gm2-torture-execute $testcase "" "pass"
+    }
+}
diff --git a/gcc/testsuite/gm2/pim/options/optimize/run/pass/testadd.mod b/gcc/testsuite/gm2/pim/options/optimize/run/pass/testadd.mod
new file mode 100644
index 00000000000..48d1084cbc2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/options/optimize/run/pass/testadd.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2005, 2006, 2007, 2008 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 2, 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. *)
+
+MODULE testadd ;
+
+FROM addition IMPORT add ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+BEGIN
+   res := 0 ;
+   Assert(add(1, 2)=3, __FILE__, __LINE__, "3") ;
+   Assert(add(2, 1)=3, __FILE__, __LINE__, "3") ;
+   Assert(add(0, 1)=1, __FILE__, __LINE__, "1") ;
+   Assert(add(0, 0)=0, __FILE__, __LINE__, "0") ;
+   Assert(add(1024, 1024)=2048, __FILE__, __LINE__, "2048") ;
+   Assert(add(10000, 20000)=30000, __FILE__, __LINE__, "30000") ;
+   exit(res)
+END testadd.
diff --git a/gcc/testsuite/gm2/pim/pass/ABSBug.mod b/gcc/testsuite/gm2/pim/pass/ABSBug.mod
new file mode 100644
index 00000000000..3283a474653
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/ABSBug.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE ABSBug;
+
+CONST
+   Neg = -4096;
+
+VAR
+   a : CARDINAL;
+BEGIN
+  a := ABS(Neg)
+END ABSBug.
diff --git a/gcc/testsuite/gm2/pim/pass/TestLong4.mod b/gcc/testsuite/gm2/pim/pass/TestLong4.mod
new file mode 100644
index 00000000000..514deb94841
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/TestLong4.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE TestLong4 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   l: LONGCARD ;
+BEGIN
+   (* test for assignment of MAX(LONGINT)+1 *)
+   l := 9223372036854775808
+END TestLong4.
diff --git a/gcc/testsuite/gm2/pim/pass/TestLong7.mod b/gcc/testsuite/gm2/pim/pass/TestLong7.mod
new file mode 100644
index 00000000000..d73b9d3a76d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/TestLong7.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE TestLong7 ;
+
+VAR
+   LongIntegerVariable: LONGINT ;
+BEGIN
+   LongIntegerVariable := 4294967295 + 4294967295
+END TestLong7.
diff --git a/gcc/testsuite/gm2/pim/pass/TestLong8.mod b/gcc/testsuite/gm2/pim/pass/TestLong8.mod
new file mode 100644
index 00000000000..81b5bc1b617
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/TestLong8.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE TestLong8 ;
+
+VAR
+   LongIntegerVariable: LONGINT ;
+BEGIN
+   LongIntegerVariable := MAX(CARDINAL) + MAX(CARDINAL)
+END TestLong8.
diff --git a/gcc/testsuite/gm2/pim/pass/TestLong9.mod b/gcc/testsuite/gm2/pim/pass/TestLong9.mod
new file mode 100644
index 00000000000..ac6a054064c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/TestLong9.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2017 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 2, 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. *)
+
+MODULE TestLong9 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   l: LONGCARD ;
+BEGIN
+   l := MAX(LONGCARD) ;
+END TestLong9.
diff --git a/gcc/testsuite/gm2/pim/pass/another.mod b/gcc/testsuite/gm2/pim/pass/another.mod
new file mode 100644
index 00000000000..e249ded5608
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/another.mod
@@ -0,0 +1,37 @@
+MODULE another ;
+
+TYPE
+   MYSHORTREAL = REAL;
+   
+TYPE
+   PROCA = PROCEDURE (VAR ARRAY OF REAL);
+   PROCB = PROCEDURE (VAR ARRAY OF MYSHORTREAL);
+
+VAR
+   pa: PROCA; pb: PROCB;
+   x: ARRAY [0..1] OF REAL;
+   y: ARRAY [0..1] OF MYSHORTREAL;
+   
+PROCEDURE ProcA(VAR z: ARRAY OF REAL);
+BEGIN
+END ProcA ;
+
+PROCEDURE ProcB(VAR z: ARRAY OF MYSHORTREAL);
+BEGIN
+END ProcB ;
+
+BEGIN
+   x := y;
+   pa := ProcA;
+   pb := ProcB;
+   pa(x);
+   pa(y);
+   pb(x);
+   pb(y);
+   pa := ProcB;
+   pb := ProcA;
+   pa(x);
+   pa(y);
+   pb(x);
+   pb(y)
+END another.
diff --git a/gcc/testsuite/gm2/pim/pass/aochar.mod b/gcc/testsuite/gm2/pim/pass/aochar.mod
new file mode 100644
index 00000000000..67547b123ab
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/aochar.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE aochar ;
+
+FROM SYSTEM IMPORT BYTE ;
+
+PROCEDURE foo (VAR a: ARRAY OF BYTE) ;
+BEGIN
+END foo ;
+
+VAR
+   b: BYTE ;
+   ch: CHAR ;
+BEGIN
+   foo(b)
+END aochar.
diff --git a/gcc/testsuite/gm2/pim/pass/array.mod b/gcc/testsuite/gm2/pim/pass/array.mod
new file mode 100644
index 00000000000..e155b49a3b2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/array.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE array ;
+
+CONST
+   lower = 10 ;
+   upper = 20 ;
+
+TYPE
+   subrange = [lower..upper] ;
+
+VAR
+   a: ARRAY subrange OF CARDINAL ;
+   i: subrange ;
+BEGIN
+   a[i] := 12
+END array.
diff --git a/gcc/testsuite/gm2/pim/pass/array2.mod b/gcc/testsuite/gm2/pim/pass/array2.mod
new file mode 100644
index 00000000000..02415c8815a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/array2.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE array2;
+
+TYPE
+   ctype = INTEGER [-1 .. 24];
+   btype = ctype;
+
+VAR
+   bvar : ARRAY btype OF INTEGER;
+BEGIN
+   bvar[0] := 0;
+END array2.
diff --git a/gcc/testsuite/gm2/pim/pass/array3.mod b/gcc/testsuite/gm2/pim/pass/array3.mod
new file mode 100644
index 00000000000..1f784152e19
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/array3.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE array3;
+
+TYPE
+   ctype = INTEGER [-1 .. 24];
+
+VAR
+   bvar: ARRAY ctype OF INTEGER;
+BEGIN
+   bvar[0] := 0;
+END array3.
diff --git a/gcc/testsuite/gm2/pim/pass/array4.mod b/gcc/testsuite/gm2/pim/pass/array4.mod
new file mode 100644
index 00000000000..327ba088ccf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/array4.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE array4 ;
+
+VAR
+   s: ARRAY [1..5] OF CARDINAL ;
+BEGIN
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+   s[1] := 1 ;
+END array4.
+
diff --git a/gcc/testsuite/gm2/pim/pass/array5.mod b/gcc/testsuite/gm2/pim/pass/array5.mod
new file mode 100644
index 00000000000..8e2f99dc876
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/array5.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE array5 ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+VAR
+   s: POINTER TO ARRAY [1..5] OF CARDINAL ;
+BEGIN
+   NEW(s) ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1 ;
+   s^[1] := 1
+END array5.
diff --git a/gcc/testsuite/gm2/pim/pass/array6.mod b/gcc/testsuite/gm2/pim/pass/array6.mod
new file mode 100644
index 00000000000..f9cfd7336df
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/array6.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE array6 ;
+
+
+VAR
+   a: ARRAY [1..5] OF (one, two, three) ;
+BEGIN
+   a[1] := two
+END array6.
diff --git a/gcc/testsuite/gm2/pim/pass/arraybool.mod b/gcc/testsuite/gm2/pim/pass/arraybool.mod
new file mode 100644
index 00000000000..39df22a9c24
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraybool.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arraybool ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i, j, l, k: CARDINAL ;
+   and       : ARRAY [FALSE..TRUE], [FALSE..TRUE] OF BOOLEAN ;
+BEGIN
+   i := 3 ;
+   j := 3 ;
+   l := 10 ;
+   k := 10 ;
+   and[FALSE, FALSE] := FALSE ;
+   and[FALSE, TRUE] := FALSE ;
+   and[TRUE, FALSE] := FALSE ;
+   and[TRUE, TRUE] := TRUE ;
+   IF and[i=j, k=l]
+   THEN
+      exit(0)
+   END ;
+   exit(1)
+END arraybool.
diff --git a/gcc/testsuite/gm2/pim/pass/arraychar.mod b/gcc/testsuite/gm2/pim/pass/arraychar.mod
new file mode 100644
index 00000000000..e1b4e51baf4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraychar.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arraychar ;
+
+
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := ""
+END arraychar.
diff --git a/gcc/testsuite/gm2/pim/pass/arraychar2.mod b/gcc/testsuite/gm2/pim/pass/arraychar2.mod
new file mode 100644
index 00000000000..1975bf21852
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraychar2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arraychar2 ;
+
+PROCEDURE foo (a: ARRAY OF CHAR) ;
+BEGIN
+   a[0] := ""
+END foo ;
+
+BEGIN
+   foo('fred')
+END arraychar2.
diff --git a/gcc/testsuite/gm2/pim/pass/arraychar3.mod b/gcc/testsuite/gm2/pim/pass/arraychar3.mod
new file mode 100644
index 00000000000..ff8a74392de
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraychar3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arraychar3 ;
+
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := 'a' ;
+   IF ch=""
+   THEN
+      HALT
+   END
+END arraychar3.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayconst1.mod b/gcc/testsuite/gm2/pim/pass/arrayconst1.mod
new file mode 100644
index 00000000000..8d671c962e9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayconst1.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE arrayconst1 ;
+
+
+TYPE
+   array = ARRAY [0..4] OF CHAR ;
+
+CONST
+   my = array {'h', 'e', 'l', 'l', 'o'} ;
+
+VAR
+   a: array ;
+BEGIN
+   a := my
+END arrayconst1.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayconst2.mod b/gcc/testsuite/gm2/pim/pass/arrayconst2.mod
new file mode 100644
index 00000000000..6611bb1ab88
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayconst2.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE arrayconst2 ;
+
+
+TYPE
+   array = ARRAY [50..54] OF CHAR ;
+
+CONST
+   my = array {'h', 'e', 'l', 'l', 'o'} ;
+
+VAR
+   a: array ;
+BEGIN
+   a := my
+END arrayconst2.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayconst3.mod b/gcc/testsuite/gm2/pim/pass/arrayconst3.mod
new file mode 100644
index 00000000000..9a883eb3aa3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayconst3.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE arrayconst3 ;
+
+
+TYPE
+   array = ARRAY [0..4] OF INTEGER ;
+
+CONST
+   my = array {0, 1, 2, 3, 4};
+
+VAR
+   a: array ;
+BEGIN
+   a := my
+END arrayconst3.
diff --git a/gcc/testsuite/gm2/pim/pass/arraydecl.mod b/gcc/testsuite/gm2/pim/pass/arraydecl.mod
new file mode 100644
index 00000000000..e41451d91e8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraydecl.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE arraydecl ;
+
+
+VAR
+   my: ARRAY [0..10+1] OF INTEGER ;
+BEGIN
+
+END arraydecl.
diff --git a/gcc/testsuite/gm2/pim/pass/arraydim.mod b/gcc/testsuite/gm2/pim/pass/arraydim.mod
new file mode 100644
index 00000000000..df7d19097dc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraydim.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arraydim ;
+
+
+VAR
+   DisplayList: ARRAY [0..1] OF ARRAY [1..10] OF CARDINAL ;
+BEGIN
+
+END arraydim.
diff --git a/gcc/testsuite/gm2/pim/pass/arraydyn.mod b/gcc/testsuite/gm2/pim/pass/arraydyn.mod
new file mode 100644
index 00000000000..8e1ec5a83c1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraydyn.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arraydyn ;
+
+CONST
+   nul = 0C ;
+
+PROCEDURE strequal (a, b: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   i,
+   higha, highb: CARDINAL ;
+BEGIN
+   higha := HIGH(a) ;
+   highb := HIGH(b) ;
+   IF higha=highb
+   THEN
+      i := 0 ;
+      WHILE i<=higha DO
+(*
+         IF a[i]#b[i]
+         THEN
+            RETURN( FALSE )
+         ELSE
+            INC(i)
+         END
+*)
+         IF a[i]=0C
+         THEN
+            RETURN( FALSE )
+         END ;
+         INC(i)
+      END ;
+      RETURN( TRUE )
+   END ;
+   RETURN( FALSE )
+END strequal ;
+
+
+BEGIN
+   IF strequal('Hello world', 'Hello world')
+   THEN
+   END
+END arraydyn.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayeqiv.mod b/gcc/testsuite/gm2/pim/pass/arrayeqiv.mod
new file mode 100644
index 00000000000..0cfe8a59e4d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayeqiv.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2006 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 2, 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. *)
+
+MODULE arrayeqiv ;
+
+(*
+    Title      : arrayeqiv
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon Dec  4 09:52:23 2006
+    Revision   : $Version$ 
+    Description: tests array equivalence
+*)
+
+TYPE
+   arrayType1 = ARRAY [0..2] OF CARDINAL;
+   arrayType2 = arrayType1 ;
+VAR
+   ar1, ar2: arrayType2 ;
+BEGIN
+   ar1[1]:= ar2[2]
+END arrayeqiv.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayfio.mod b/gcc/testsuite/gm2/pim/pass/arrayfio.mod
new file mode 100644
index 00000000000..508a29d4a9f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayfio.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE arrayfio ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+   FileRec = POINTER TO RECORD
+                           state: (successful, not) ;
+                        END ;
+
+TYPE
+   File = CARDINAL ;
+
+CONST
+   MaxNoOfFiles = 10 ;
+
+VAR
+   FileInfo: ARRAY [0..MaxNoOfFiles] OF FileRec ;
+
+
+PROCEDURE IsNoError (f: File) : BOOLEAN ;
+BEGIN
+   RETURN( (f<MaxNoOfFiles) AND (FileInfo[f]#NIL) AND (FileInfo[f]^.state=successful) )
+END IsNoError ;
+
+
+BEGIN
+   NEW(FileInfo[0]) ;
+   FileInfo[0]^.state := successful ;
+   IF IsNoError(0)
+   THEN
+   END
+END arrayfio.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayhuge.mod b/gcc/testsuite/gm2/pim/pass/arrayhuge.mod
new file mode 100644
index 00000000000..1a924cca525
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayhuge.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+   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 2, 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. *)
+
+MODULE arrayhuge ;
+
+VAR
+   a: ARRAY [MAX(CARDINAL)-4..MAX(CARDINAL)] OF CHAR ;
+   i: CARDINAL ;
+BEGIN
+   a[MAX(CARDINAL)-1] := 'd' ;
+(*
+   a[MAX(CARDINAL)-4] := 'a' ;
+   FOR i := MAX(CARDINAL)-4 TO MAX(CARDINAL) DO
+      a[i] := 'z'
+   END
+*)
+END arrayhuge.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayhuge2.mod b/gcc/testsuite/gm2/pim/pass/arrayhuge2.mod
new file mode 100644
index 00000000000..57f986a166d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayhuge2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arrayhuge2 ;
+
+VAR
+   a: ARRAY [MAX(CARDINAL)-4..MAX(CARDINAL)] OF CHAR ;
+BEGIN
+   a[MAX(CARDINAL)-1] := 'a'
+END arrayhuge2.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayindex.mod b/gcc/testsuite/gm2/pim/pass/arrayindex.mod
new file mode 100644
index 00000000000..f893289a94c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayindex.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE arrayindex ;
+
+
+
+VAR
+   a: ARRAY [50..70] OF CARDINAL ;
+BEGIN
+   a[50] := 123 ;
+   a[55] := 456 ;
+   a[70] := 789 ;
+END arrayindex.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayindirect.mod b/gcc/testsuite/gm2/pim/pass/arrayindirect.mod
new file mode 100644
index 00000000000..bcad09b812b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayindirect.mod
@@ -0,0 +1,80 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE arrayindirect ;
+
+FROM SYSTEM IMPORT ADR, TSIZE, SIZE, WORD, ADDRESS ;
+
+CONST
+   UNIXREADONLY        =       0 ;
+   CreatePermissions   =     666B;
+   MaxNoOfFiles        =     100 ;
+   MaxBufferLength     = 1024*16 ;
+   MaxErrorString      = 1024* 8 ;
+
+TYPE
+   FileUsage         = (unused, openedforread, openedforwrite, openedforrandom) ;
+   FileStatus        = (successful, outofmemory, toomanyfilesopen, failed, connectionfailure) ;
+
+   NameInfo          = RECORD
+                          address: ADDRESS ;
+                          size   : CARDINAL ;
+                       END ;
+
+   Buffer            = POINTER TO buf ;
+   buf               =            RECORD
+                                     position: CARDINAL ;  (* where are we through this buffer *)
+                                     address : ADDRESS ;   (* dynamic buffer address           *)
+                                     filled  : CARDINAL ;  (* length of the buffer filled      *)
+                                     size    : CARDINAL ;  (* maximum space in this buffer     *)
+                                     left    : CARDINAL ;  (* number of bytes left to read     *)
+                                     contents: POINTER TO ARRAY [0..MaxBufferLength] OF CHAR ;
+                                  END ;
+
+   FileDescriptors   = POINTER TO fds ;
+   fds               =            RECORD
+                                     unixfd: INTEGER ;
+                                     name  : NameInfo ;
+                                     state : FileStatus ;
+                                     usage : FileUsage ;
+                                     buffer: Buffer ;
+                                  END ;
+   File = CARDINAL ;
+
+VAR
+   FileInfo: ARRAY [0..MaxNoOfFiles] OF FileDescriptors ;
+
+
+(*
+   GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*)
+
+PROCEDURE GetUnixFileDescriptor (f: File) : INTEGER ;
+BEGIN
+   IF (f<MaxNoOfFiles) AND (FileInfo[f]#NIL)
+   THEN
+      RETURN( FileInfo[f]^.unixfd )
+   ELSE
+      HALT
+   END
+END GetUnixFileDescriptor ;
+
+BEGIN
+   IF GetUnixFileDescriptor(File(1))=0
+   THEN
+      HALT
+   END
+END arrayindirect.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/pass/arrayinproc.mod b/gcc/testsuite/gm2/pim/pass/arrayinproc.mod
new file mode 100644
index 00000000000..d486d7dc496
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayinproc.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arrayinproc ;
+
+
+PROCEDURE myproc1 ;
+VAR
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+END myproc1 ;
+
+
+PROCEDURE myproc2 ;
+VAR
+   a: ARRAY [0..8] OF CHAR ;
+BEGIN
+END myproc2 ;
+
+
+VAR
+   a: ARRAY [0..9] OF CHAR ;
+BEGIN
+   myproc1 ;
+   myproc2
+END arrayinproc.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayint.mod b/gcc/testsuite/gm2/pim/pass/arrayint.mod
new file mode 100644
index 00000000000..9d3aecbefec
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayint.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arrayint ;
+
+
+(*
+   sum - 
+*)
+
+PROCEDURE sum (x: ARRAY OF INTEGER) : INTEGER ;
+VAR
+   i: CARDINAL ;
+   s: INTEGER ;
+BEGIN
+   s := 0 ;
+   FOR i := 0 TO HIGH(x) DO
+      INC(s, x[i])
+   END ;
+   RETURN s
+END sum ;
+
+VAR
+   a: ARRAY [0..10] OF INTEGER ;
+   c: INTEGER ;
+BEGIN
+   a[0] := 0 ;
+   a[1] := 1 ;
+   a[2] := 2 ;
+   a[3] := 3 ;
+   a[4] := 4 ;
+   a[5] := 5 ;
+   a[6] := 6 ;
+   a[7] := 7 ;
+   a[8] := 8 ;
+   a[9] := 9 ;
+   a[10] := 10 ;
+   c := sum(a)
+END arrayint.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayofbyte.mod b/gcc/testsuite/gm2/pim/pass/arrayofbyte.mod
new file mode 100644
index 00000000000..f73e86a79af
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayofbyte.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arrayofbyte ;
+
+FROM SYSTEM IMPORT BYTE, ADDRESS ;
+
+PROCEDURE foo (f: ARRAY OF BYTE) ;
+BEGIN
+END foo ;
+
+PROCEDURE bar (b: ARRAY OF BYTE) ;
+BEGIN
+   foo(b)
+END bar ;
+
+VAR
+   a: ADDRESS ;
+BEGIN
+   bar(a)
+END arrayofbyte.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayofcard.mod b/gcc/testsuite/gm2/pim/pass/arrayofcard.mod
new file mode 100644
index 00000000000..0d43844e5be
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayofcard.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE arrayofcard ;   (*!m2pim*)
+
+
+(*
+   bar -
+*)
+
+PROCEDURE bar (b: ARRAY OF CARDINAL) ;
+BEGIN
+END bar ;
+
+
+(*
+   foo -
+*)
+
+PROCEDURE foo (a: ARRAY OF CARDINAL) ;
+BEGIN
+   bar (a)
+END foo ;
+
+
+BEGIN
+END arrayofcard.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayptr.mod b/gcc/testsuite/gm2/pim/pass/arrayptr.mod
new file mode 100644
index 00000000000..2c71ef5ff1b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayptr.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arrayptr ;
+
+TYPE
+   a = ARRAY [0..2] OF p ;
+   p = POINTER TO RECORD
+                     v: CARDINAL ;
+                     f: a ;
+                  END ;
+VAR
+   i: a ;
+BEGIN
+   i[0]^.v := 123
+END arrayptr.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayptr2.mod b/gcc/testsuite/gm2/pim/pass/arrayptr2.mod
new file mode 100644
index 00000000000..87c6e2bf38e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayptr2.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arrayptr2 ;
+
+TYPE
+   a = ARRAY [0..2] OF POINTER TO r ;
+   r = RECORD
+          v: CARDINAL ;
+          f: a ;
+       END ;
+
+VAR
+   i: a ;
+BEGIN
+   i[0]^.v := 123
+END arrayptr2.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayptr3.mod b/gcc/testsuite/gm2/pim/pass/arrayptr3.mod
new file mode 100644
index 00000000000..d9549a34de2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayptr3.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arrayptr3 ;
+
+TYPE
+   p = POINTER TO ARRAY [0..2] OF p ;
+
+VAR
+   i: p ;
+BEGIN
+   i^[1] := NIL ;
+END arrayptr3.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayptr4.mod b/gcc/testsuite/gm2/pim/pass/arrayptr4.mod
new file mode 100644
index 00000000000..3cf29018583
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayptr4.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arrayptr4 ;
+
+TYPE
+   a = ARRAY [0..2] OF POINTER TO a ;
+
+VAR
+   i: a ;
+BEGIN
+   i[1] := NIL ;
+END arrayptr4.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayptr5.mod b/gcc/testsuite/gm2/pim/pass/arrayptr5.mod
new file mode 100644
index 00000000000..fc0b566842c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayptr5.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arrayptr5 ;
+
+TYPE
+   a = ARRAY [0..2] OF POINTER TO a ;
+
+VAR
+   i: a ;
+BEGIN
+   i[1] := NIL ;
+END arrayptr5.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayptr6.mod b/gcc/testsuite/gm2/pim/pass/arrayptr6.mod
new file mode 100644
index 00000000000..d01b5b52241
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayptr6.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE arrayptr6 ;
+
+TYPE
+   p = q ;
+   q = POINTER TO ARRAY [0..2] OF p ;
+
+VAR
+   i: p ;
+BEGIN
+END arrayptr6.
diff --git a/gcc/testsuite/gm2/pim/pass/arrayrecord.mod b/gcc/testsuite/gm2/pim/pass/arrayrecord.mod
new file mode 100644
index 00000000000..668b07bd821
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arrayrecord.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE arrayrecord ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+
+TYPE
+   record = RECORD
+               A, B, C: CARDINAL ;
+            END ;
+
+VAR
+   a, b, c: ADDRESS ;
+   array  : ARRAY [0..9] OF record ;
+   i      : CARDINAL ;
+BEGIN
+   i := 2 ;
+(*
+   a := ADR(array[i].A) ;
+   b := ADR(array[i].B) ;
+*)
+   c := ADR(array[i].C)
+END arrayrecord.
diff --git a/gcc/testsuite/gm2/pim/pass/arraytiny.c b/gcc/testsuite/gm2/pim/pass/arraytiny.c
new file mode 100644
index 00000000000..b263f11cd80
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraytiny.c
@@ -0,0 +1,24 @@
+/* Copyright (C) 2008 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 2, 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. */
+
+
+main()
+{
+   int a[4];
+
+   a[1] = 99;
+}
diff --git a/gcc/testsuite/gm2/pim/pass/arraytiny.mod b/gcc/testsuite/gm2/pim/pass/arraytiny.mod
new file mode 100644
index 00000000000..d99a99df36e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraytiny.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE arraytiny ;
+
+
+VAR
+   a: ARRAY [0..3] OF CARDINAL ;
+BEGIN
+   a[1] := 99
+END arraytiny.
diff --git a/gcc/testsuite/gm2/pim/pass/arraytype.mod b/gcc/testsuite/gm2/pim/pass/arraytype.mod
new file mode 100644
index 00000000000..35192f41dc6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraytype.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE arraytype ;
+
+VAR
+   b: ARRAY BOOLEAN OF ARRAY BOOLEAN OF BITSET ;
+BEGIN
+   b[FALSE, FALSE] := {0,1}
+END arraytype.
diff --git a/gcc/testsuite/gm2/pim/pass/arraytype2.mod b/gcc/testsuite/gm2/pim/pass/arraytype2.mod
new file mode 100644
index 00000000000..e89e07a8ac7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraytype2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE arraytype2 ;
+
+
+PROCEDURE foo ;
+VAR
+   b: ARRAY BOOLEAN OF ARRAY BOOLEAN OF BITSET ;
+BEGIN
+   b[FALSE, FALSE] := {0,1}
+END foo ;
+
+BEGIN
+   foo
+END arraytype2.
diff --git a/gcc/testsuite/gm2/pim/pass/arraytype3.mod b/gcc/testsuite/gm2/pim/pass/arraytype3.mod
new file mode 100644
index 00000000000..c917465a12d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraytype3.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE arraytype3 ;
+
+FROM mydef IMPORT BIT32 ;
+
+PROCEDURE foo ;
+VAR
+   b: ARRAY BOOLEAN OF ARRAY BOOLEAN OF BIT32 ;
+   PROCEDURE inner ;
+   BEGIN
+   
+   END inner ;
+
+BEGIN
+   b[FALSE, FALSE] := {0,1}
+END foo ;
+
+BEGIN
+   foo
+END arraytype3.
diff --git a/gcc/testsuite/gm2/pim/pass/arraytype4.mod b/gcc/testsuite/gm2/pim/pass/arraytype4.mod
new file mode 100644
index 00000000000..8ec85c407e4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/arraytype4.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE arraytype4 ;
+
+
+VAR
+   a: ARRAY BOOLEAN OF ARRAY BOOLEAN OF ARRAY CHAR OF BOOLEAN ;
+BEGIN
+   a[FALSE, TRUE, 'a'] := FALSE
+END arraytype4.
diff --git a/gcc/testsuite/gm2/pim/pass/assignment.mod b/gcc/testsuite/gm2/pim/pass/assignment.mod
new file mode 100644
index 00000000000..ef8dff090fe
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/assignment.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE assignment ;
+
+VAR
+   str: ARRAY [0..2] OF ARRAY [0..20] OF CHAR ;
+BEGIN
+   str[0] := 'hello world'
+END assignment.
diff --git a/gcc/testsuite/gm2/pim/pass/assignment2.mod b/gcc/testsuite/gm2/pim/pass/assignment2.mod
new file mode 100644
index 00000000000..8022287d1be
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/assignment2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE assignment2 ;
+
+VAR
+   str: ARRAY [0..2],[0..20] OF CHAR ;
+BEGIN
+   str[0] := 'hello world'
+END assignment2.
diff --git a/gcc/testsuite/gm2/pim/pass/assignment3.mod b/gcc/testsuite/gm2/pim/pass/assignment3.mod
new file mode 100644
index 00000000000..0d5f3a4292c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/assignment3.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE assignment3 ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 123
+END assignment3.
diff --git a/gcc/testsuite/gm2/pim/pass/assignment4.mod b/gcc/testsuite/gm2/pim/pass/assignment4.mod
new file mode 100644
index 00000000000..78c76d2fa09
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/assignment4.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE assignment4 ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   i := 123
+END assignment4.
diff --git a/gcc/testsuite/gm2/pim/pass/badpointer.mod b/gcc/testsuite/gm2/pim/pass/badpointer.mod
new file mode 100644
index 00000000000..0245baab2f6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/badpointer.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE badpointer ;
+
+TYPE
+   foo = POINTER TO CARDINAL ;
+
+CONST
+   bar = foo(NIL) ;
+
+VAR
+   c  : CARDINAL ;
+BEGIN
+   bar^ := c
+END badpointer.
diff --git a/gcc/testsuite/gm2/pim/pass/bits32.def b/gcc/testsuite/gm2/pim/pass/bits32.def
new file mode 100644
index 00000000000..e4360c607a7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bits32.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE bits32;
+
+TYPE BITSET32 = BITSET;
+     BITS32 = BITSET32;
+
+END bits32.
+
+
diff --git a/gcc/testsuite/gm2/pim/pass/bits32.mod b/gcc/testsuite/gm2/pim/pass/bits32.mod
new file mode 100644
index 00000000000..f558205f3c9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bits32.mod
@@ -0,0 +1,19 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE bits32 ;
+
+END bits32.
diff --git a/gcc/testsuite/gm2/pim/pass/bits32i.mod b/gcc/testsuite/gm2/pim/pass/bits32i.mod
new file mode 100644
index 00000000000..4f70248c4cb
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bits32i.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE bits32i;
+
+FROM bits32 IMPORT BITS32;
+
+VAR
+   b32: BITS32;
+BEGIN
+   b32 := BITS32{}
+END bits32i.
diff --git a/gcc/testsuite/gm2/pim/pass/bitset.mod b/gcc/testsuite/gm2/pim/pass/bitset.mod
new file mode 100644
index 00000000000..ccc2841c182
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bitset.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE bitset ;
+
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   b: BITSET ;
+   p: POINTER TO CARDINAL ;
+BEGIN
+   p := ADR(b) ;
+   p^ := 0 ;
+   p^ := 3 ;
+   p^ := 9 ;
+   p^ := 11 ;
+   p^ := 14
+END bitset.
diff --git a/gcc/testsuite/gm2/pim/pass/bitset2.mod b/gcc/testsuite/gm2/pim/pass/bitset2.mod
new file mode 100644
index 00000000000..5b5eb13c4ef
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bitset2.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE bitset2 ;
+
+
+TYPE
+   x = BITSET ;
+BEGIN
+
+END bitset2.
diff --git a/gcc/testsuite/gm2/pim/pass/bitset3.mod b/gcc/testsuite/gm2/pim/pass/bitset3.mod
new file mode 100644
index 00000000000..3b850bb68b5
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bitset3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE bitset3 ;
+
+TYPE BITS32 = BITSET;
+
+VAR
+   b: BITSET;
+   b32: BITS32;
+BEGIN
+   b := BITSET{};
+   b32 := BITS32{};
+END bitset3.
diff --git a/gcc/testsuite/gm2/pim/pass/bitset4.mod b/gcc/testsuite/gm2/pim/pass/bitset4.mod
new file mode 100644
index 00000000000..bac0eba46fc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bitset4.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE bitset4 ;
+
+PROCEDURE WarnError (a: ARRAY OF CHAR) ;
+BEGIN
+END WarnError ;
+
+PROCEDURE DescribeError (stop: BITSET) ;
+BEGIN
+   WarnError('syntax error')
+END DescribeError ;
+
+BEGIN
+   DescribeError({})
+END bitset4.
diff --git a/gcc/testsuite/gm2/pim/pass/bitset5.mod b/gcc/testsuite/gm2/pim/pass/bitset5.mod
new file mode 100644
index 00000000000..1fd937ce0ee
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bitset5.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE bitset5 ;
+
+VAR
+   b: BITSET ;
+BEGIN
+   b := {1,2} ;
+   CASE b OF
+
+   {}   :  |
+   {1,2}:
+
+   END
+END bitset5.
diff --git a/gcc/testsuite/gm2/pim/pass/bitsetfunc.mod b/gcc/testsuite/gm2/pim/pass/bitsetfunc.mod
new file mode 100644
index 00000000000..bc69e5a4884
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bitsetfunc.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE bitsetfunc ;
+
+PROCEDURE foo (b: BITSET) ;
+BEGIN
+END foo ;
+
+BEGIN
+END bitsetfunc.
diff --git a/gcc/testsuite/gm2/pim/pass/block.mod b/gcc/testsuite/gm2/pim/pass/block.mod
new file mode 100644
index 00000000000..cf2ed70b0a6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/block.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE block ;
+
+
+TYPE
+   blk = RECORD
+            a, b, c, d, e: CARDINAL ;
+            f, g, h, i, j: CHAR ;
+            k            : ARRAY [0..2] OF LONGREAL ;
+         END ;
+
+
+(*
+   first - 
+*)
+
+PROCEDURE first (b: blk) ;
+VAR
+   c: blk ;
+BEGIN
+   h := b
+END first ;
+
+
+VAR
+   g: blk ;
+   h: blk ;
+BEGIN
+   first(g)
+END block.
diff --git a/gcc/testsuite/gm2/pim/pass/blockindirect.mod b/gcc/testsuite/gm2/pim/pass/blockindirect.mod
new file mode 100644
index 00000000000..eec8d2e30b1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/blockindirect.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE blockindirect ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   blk = RECORD
+            a, b, c, d, e: CARDINAL ;
+            f, g, h, i, j: CHAR ;
+            k            : ARRAY [0..2] OF LONGREAL ;
+         END ;
+
+
+(*
+   first - 
+*)
+
+PROCEDURE first (VAR b: blk) ;
+VAR
+   c: blk ;
+   p: POINTER TO blk ;
+BEGIN
+   h := b ;
+   b := g ;
+   p := ADR(b) ;
+   p^ := h
+END first ;
+
+
+VAR
+   g: blk ;
+   h: blk ;
+BEGIN
+   first(g)
+END blockindirect.
diff --git a/gcc/testsuite/gm2/pim/pass/builtin.def b/gcc/testsuite/gm2/pim/pass/builtin.def
new file mode 100644
index 00000000000..617e4c36d30
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/builtin.def
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE builtin ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+PROCEDURE __BUILTIN__ alloca (i: CARDINAL) : ADDRESS ;
+PROCEDURE __BUILTIN__ memcopy (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+PROCEDURE __BUILTIN__ sinf (x: SHORTREAL) : SHORTREAL ;
+PROCEDURE __BUILTIN__ sinl (x: LONGREAL) : LONGREAL ;
+PROCEDURE __BUILTIN__ memset (s: ADDRESS; c: INTEGER; n: CARDINAL) : ADDRESS ;
+
+END builtin.
diff --git a/gcc/testsuite/gm2/pim/pass/builtin.mod b/gcc/testsuite/gm2/pim/pass/builtin.mod
new file mode 100644
index 00000000000..24835d1d8d0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/builtin.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE builtin ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_alloca)) alloca (i: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN NIL
+END alloca ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_memcpy)) memcopy (dest, src: ADDRESS; n: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN dest
+END memcopy ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sinf)) sinf (x: SHORTREAL) : SHORTREAL ;
+BEGIN
+   RETURN 0.0
+END sinf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_sinl)) sinl (x: LONGREAL) : LONGREAL ;
+BEGIN
+   RETURN 0.0
+END sinl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_memset)) memset (s: ADDRESS; c: INTEGER; n: CARDINAL) : ADDRESS ;
+BEGIN
+   RETURN s
+END memset ;
+
+END builtin.
diff --git a/gcc/testsuite/gm2/pim/pass/builtin2.mod b/gcc/testsuite/gm2/pim/pass/builtin2.mod
new file mode 100644
index 00000000000..d3d57b2ec9e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/builtin2.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE builtin2 ;
+
+
+PROCEDURE foo (a, b, c: ARRAY OF CHAR) ;
+BEGIN
+END foo ;
+
+
+BEGIN
+   foo('a', 'b', 'c')
+END builtin2.
diff --git a/gcc/testsuite/gm2/pim/pass/builtinconst.mod b/gcc/testsuite/gm2/pim/pass/builtinconst.mod
new file mode 100644
index 00000000000..a99c2dd20d0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/builtinconst.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE builtinconst ;
+
+CONST
+   maxcard = MAX(CARDINAL) ;
+VAR
+   c : CARDINAL ;
+BEGIN
+   c := maxcard
+END builtinconst.
diff --git a/gcc/testsuite/gm2/pim/pass/bytearray.mod b/gcc/testsuite/gm2/pim/pass/bytearray.mod
new file mode 100644
index 00000000000..640c194a3f3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/bytearray.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE bytearray ;
+
+FROM SYSTEM IMPORT BYTE ;
+
+PROCEDURE bytes (b: ARRAY OF BYTE) ;
+BEGIN
+   
+END bytes ;
+
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+   ch: CHAR ;
+BEGIN
+   bytes (i) ;
+   bytes (c) ;
+   bytes (ch) ;
+   bytes ("hello world")
+END bytearray.
diff --git a/gcc/testsuite/gm2/pim/pass/card.mod b/gcc/testsuite/gm2/pim/pass/card.mod
new file mode 100644
index 00000000000..7815536884e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/card.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE card ;
+
+
+VAR
+   x,
+   c: CARDINAL ;
+BEGIN
+   c := 10 ;
+   x := 0 ;
+   WHILE c>0 DO
+      x := x+1 ;
+      DEC(c)
+   END ;
+END card.
diff --git a/gcc/testsuite/gm2/pim/pass/card2.mod b/gcc/testsuite/gm2/pim/pass/card2.mod
new file mode 100644
index 00000000000..bcee887bf51
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/card2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE card2 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+   INC(c)   
+END foo ;
+
+VAR
+   s: SHORTCARD ;
+BEGIN
+   foo(s)
+END card2.
diff --git a/gcc/testsuite/gm2/pim/pass/char.mod b/gcc/testsuite/gm2/pim/pass/char.mod
new file mode 100644
index 00000000000..b8615c0ac25
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/char.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE char ;
+
+VAR
+   s: CHAR ;
+BEGIN
+   s := 'a' ;
+   s := 'z' ;
+   s := 'z' ;
+   s := 'z' ;
+   s := 'z' ;
+   s := 'z' ;
+   s := 'z' ;
+   s := 'z' ;
+   s := 'z' ;
+   s := '!'
+END char.
diff --git a/gcc/testsuite/gm2/pim/pass/char2.mod b/gcc/testsuite/gm2/pim/pass/char2.mod
new file mode 100644
index 00000000000..bff27c0ef6c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/char2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE char2 ;
+
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := 'a' ;
+   ch := 'z'
+END char2.
diff --git a/gcc/testsuite/gm2/pim/pass/charproc.mod b/gcc/testsuite/gm2/pim/pass/charproc.mod
new file mode 100644
index 00000000000..68aa085d549
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/charproc.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE charproc ;
+
+PROCEDURE write (ch: CHAR) ;
+VAR
+   ch2: CHAR ;
+BEGIN
+   ch2 := ch ;
+   ch2 := 'z'
+END write ;
+
+BEGIN
+   write('a')
+END charproc.
diff --git a/gcc/testsuite/gm2/pim/pass/charset.mod b/gcc/testsuite/gm2/pim/pass/charset.mod
new file mode 100644
index 00000000000..bc1bd35c3fd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/charset.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE charset ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   set = SET OF CHAR ;
+
+VAR
+   s: set ;
+   p: POINTER TO ARRAY [0..7] OF INTEGER ;
+BEGIN
+   p := ADR(s) ;
+   p^[0] := 3 ;
+   p^[1] := 7 ;
+   p^[2] := -1 ;
+   p^[3] := -1 ;
+   p^[4] := -1 ;
+   p^[5] := -1 ;
+   p^[6] := -1 ;
+   p^[7] := -1 ;
+   p^[7] := -1
+END charset.
diff --git a/gcc/testsuite/gm2/pim/pass/charset2.mod b/gcc/testsuite/gm2/pim/pass/charset2.mod
new file mode 100644
index 00000000000..8b8cf9a1153
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/charset2.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE charset2 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   set = SET OF ['A'..'z'] ;
+
+VAR
+   s: set ;
+   p: POINTER TO ARRAY [0..2] OF INTEGER ;
+BEGIN
+   p := ADR(s) ;
+   p^[0] := 3 ;
+   p^[1] := 7 ;
+   p^[2] := -1 ;
+   p^[2] := -1
+END charset2.
diff --git a/gcc/testsuite/gm2/pim/pass/charset3.mod b/gcc/testsuite/gm2/pim/pass/charset3.mod
new file mode 100644
index 00000000000..2d5712d8fcd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/charset3.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE charset3 ;   (*!m2pim*)
+
+TYPE
+   soc = SET OF CHAR ;
+
+VAR
+   s: soc ;
+BEGIN
+   s := soc {} ;
+   INCL (s, 'a')
+END charset3.
diff --git a/gcc/testsuite/gm2/pim/pass/checkparm.def b/gcc/testsuite/gm2/pim/pass/checkparm.def
new file mode 100644
index 00000000000..02f4c8cee63
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/checkparm.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+DEFINITION MODULE checkparm ;
+
+PROCEDURE foo (a, b, c: CARDINAL; d, e: CHAR) ;
+
+END checkparm.
diff --git a/gcc/testsuite/gm2/pim/pass/checkparm.mod b/gcc/testsuite/gm2/pim/pass/checkparm.mod
new file mode 100644
index 00000000000..3c53d0ffc89
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/checkparm.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+IMPLEMENTATION MODULE checkparm ;
+
+PROCEDURE foo (c, a, b: CARDINAL; e, d: CHAR) ;
+BEGIN
+END foo ;
+
+END checkparm.
diff --git a/gcc/testsuite/gm2/pim/pass/colour.mod b/gcc/testsuite/gm2/pim/pass/colour.mod
new file mode 100644
index 00000000000..be4375e5088
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/colour.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE colour ;
+
+   PROCEDURE make (VAR c: colours) ;
+   BEGIN
+      c := yellow
+   END make ;
+
+   MODULE inner ;
+   EXPORT colours ;
+
+      MODULE two ;
+      END two ;
+
+   TYPE
+      colours = (red, blue, yellow, white) ;
+   END inner ;
+
+VAR
+   g: colours ;
+BEGIN
+   make(g)
+END colour.
diff --git a/gcc/testsuite/gm2/pim/pass/comment1.mod b/gcc/testsuite/gm2/pim/pass/comment1.mod
new file mode 100644
index 00000000000..105c972f047
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/comment1.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE comment1 ;
+
+(*
+(*
+           Ptr
+*)
+*)
+
+
+BEGIN
+END comment1.
diff --git a/gcc/testsuite/gm2/pim/pass/complexarray.mod b/gcc/testsuite/gm2/pim/pass/complexarray.mod
new file mode 100644
index 00000000000..bbfc766e033
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/complexarray.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE complexarray ;
+
+
+VAR
+   statemachine: ARRAY [0.. 4-1] OF ARRAY [0.. 4-1] OF  PROCEDURE (INTEGER, INTEGER) : INTEGER ;
+BEGIN
+
+END complexarray.
diff --git a/gcc/testsuite/gm2/pim/pass/complextypes.mod b/gcc/testsuite/gm2/pim/pass/complextypes.mod
new file mode 100644
index 00000000000..9b65add0362
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/complextypes.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE complextypes ;
+
+
+TYPE
+   List = POINTER TO RECORD
+                        items: ARRAY sub OF RECORD
+                                               defined: BOOLEAN ;
+                                               next   : List ;
+                                            END ;
+                     END ;
+
+   sub = [3..9] ;
+
+VAR
+   l: List ;
+BEGIN
+END complextypes.
diff --git a/gcc/testsuite/gm2/pim/pass/constcast.mod b/gcc/testsuite/gm2/pim/pass/constcast.mod
new file mode 100644
index 00000000000..835f5f507c2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/constcast.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE constcast ;
+
+CONST
+   r = VAL(REAL, MAX(INTEGER)) ;
+
+BEGIN
+END constcast.
diff --git a/gcc/testsuite/gm2/pim/pass/constmax.mod b/gcc/testsuite/gm2/pim/pass/constmax.mod
new file mode 100644
index 00000000000..75e6ad714aa
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/constmax.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE constmax ;
+
+CONST
+   value = MAX(INTEGER) ;
+
+BEGIN
+
+END constmax.
diff --git a/gcc/testsuite/gm2/pim/pass/constset.mod b/gcc/testsuite/gm2/pim/pass/constset.mod
new file mode 100644
index 00000000000..47178b6dd51
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/constset.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE constset ;
+
+CONST
+    PTH_UNTIL_OCCURRED = BITSET {11} ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := VAL(CARDINAL, PTH_UNTIL_OCCURRED) ;
+   IF c=1
+   THEN
+   END
+END constset.
diff --git a/gcc/testsuite/gm2/pim/pass/constset2.mod b/gcc/testsuite/gm2/pim/pass/constset2.mod
new file mode 100644
index 00000000000..8c8b5a63b25
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/constset2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE constset2 ;
+
+FROM defset IMPORT PTH_UNTIL_OCCURRED ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := VAL(CARDINAL, PTH_UNTIL_OCCURRED) ;
+   IF c=1
+   THEN
+   END
+END constset2.
diff --git a/gcc/testsuite/gm2/pim/pass/constset3.mod b/gcc/testsuite/gm2/pim/pass/constset3.mod
new file mode 100644
index 00000000000..c2d21c25b3e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/constset3.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE constset3 ;
+
+FROM defset IMPORT PTH_UNTIL_OCCURRED ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := VAL(CARDINAL, PTH_UNTIL_OCCURRED+PTH_UNTIL_OCCURRED) ;
+   IF c=1
+   THEN
+   END
+END constset3.
diff --git a/gcc/testsuite/gm2/pim/pass/constsize.mod b/gcc/testsuite/gm2/pim/pass/constsize.mod
new file mode 100644
index 00000000000..e71c41d6a75
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/constsize.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE constsize ;
+
+FROM SYSTEM IMPORT SIZE, BYTE ;
+
+CONST
+   foo = SIZE(CARDINAL)-1 ;
+
+VAR
+   a: ARRAY [0..foo] OF BYTE ;
+BEGIN
+   
+END constsize.
diff --git a/gcc/testsuite/gm2/pim/pass/constsize2.mod b/gcc/testsuite/gm2/pim/pass/constsize2.mod
new file mode 100644
index 00000000000..0d67ad672e3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/constsize2.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE constsize2 ;
+
+FROM SYSTEM IMPORT SIZE ;
+
+CONST
+   foo = SIZE(bar) ;
+
+TYPE
+   bar = ARRAY [0..4] OF CARDINAL ;
+
+VAR
+   b: bar ;
+   x: CARDINAL ;
+BEGIN
+   x := foo
+END constsize2.
diff --git a/gcc/testsuite/gm2/pim/pass/convert.mod b/gcc/testsuite/gm2/pim/pass/convert.mod
new file mode 100644
index 00000000000..8a694677eef
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/convert.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE convert ;
+
+PROCEDURE one ;
+   PROCEDURE Convert (VAR y: CHAR) ;
+   BEGIN
+      y := 'b'
+   END Convert ;
+BEGIN
+
+END one ;
+
+
+PROCEDURE two ;
+   PROCEDURE Convert (VAR x: INTEGER) ;
+   BEGIN
+      x := 1
+   END Convert ;
+BEGIN
+
+END two ;
+
+
+BEGIN
+END convert.
+
+
diff --git a/gcc/testsuite/gm2/pim/pass/convert2.mod b/gcc/testsuite/gm2/pim/pass/convert2.mod
new file mode 100644
index 00000000000..4d0c5ef99b1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/convert2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE convert2 ;
+
+VAR
+   a: ARRAY [ORD('A')..ORD('Z')] OF CHAR ;
+BEGIN
+   a[ORD('A')] := 'A'
+END convert2.
diff --git a/gcc/testsuite/gm2/pim/pass/convert3.mod b/gcc/testsuite/gm2/pim/pass/convert3.mod
new file mode 100644
index 00000000000..29a318cd878
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/convert3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE convert3 ;
+
+CONST
+   Num = ORD('A') ;
+   ch = CHR(Num+1) ;
+
+VAR
+   t: CHAR ;
+BEGIN
+   t := ch
+END convert3.
diff --git a/gcc/testsuite/gm2/pim/pass/convert4.mod b/gcc/testsuite/gm2/pim/pass/convert4.mod
new file mode 100644
index 00000000000..d4e6f5df846
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/convert4.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE convert4 ;
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+PROCEDURE foo (c: CARDINAL) : INTEGER ;
+BEGIN
+   RETURN( -VAL(INTEGER, Min(VAL(CARDINAL, MAX(INTEGER))+1, c)) )
+END foo ;
+
+BEGIN
+   IF foo(2)=2
+   THEN
+   END
+END convert4.
diff --git a/gcc/testsuite/gm2/pim/pass/danglingelse.mod b/gcc/testsuite/gm2/pim/pass/danglingelse.mod
new file mode 100644
index 00000000000..d3795811778
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/danglingelse.mod
@@ -0,0 +1,114 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE danglingelse ;  (*!m2pim*)
+
+VAR
+   result: CARDINAL ;
+
+
+PROCEDURE Open (first, second, third: BOOLEAN) ;
+BEGIN
+   IF third
+   THEN
+      result := 1
+   END ;
+   IF second
+   THEN
+      IF first
+      THEN
+         IF third
+         THEN
+            result := 2
+         END
+      ELSE
+         result := 3
+      END
+   ELSE
+      IF first
+      THEN
+         IF third
+         THEN
+            result := 4
+         END
+      ELSE
+         result := 5
+      END
+   END ;
+   IF (NOT second) AND first
+   THEN
+      result := 6 ;
+      IF third
+      THEN
+         result := 7
+      ELSE
+         result := 8 ;
+         result := 9 ;
+      END
+   ELSE
+      result := 10 ;
+      IF second
+      THEN
+         IF first
+         THEN
+            IF third
+            THEN
+               result := 11
+            END ;
+            IF first
+            THEN
+               (* nothing *)
+            ELSE
+               result := 12 ;
+               result := 13
+            END
+         ELSE
+            IF third
+            THEN
+               result := 14
+            END
+         END
+      ELSE
+         IF first
+         THEN
+            IF third
+            THEN
+               result := 15
+            END ;
+            IF second
+            THEN
+               (* nothing *)
+            ELSE
+               result := 16 ;
+               result := 17
+            END
+         ELSE
+            IF third
+            THEN
+               result := 18
+            END
+         END
+      END ;
+      result := 19 ;
+      result := 20
+   END
+END Open ;
+
+
+BEGIN
+   Open (TRUE, TRUE, TRUE)
+END danglingelse.
diff --git a/gcc/testsuite/gm2/pim/pass/debug b/gcc/testsuite/gm2/pim/pass/debug
new file mode 100644
index 00000000000..ab82fa88ddf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/debug
@@ -0,0 +1,42 @@
+#!/bin/sh
+
+# Copyright (C) 2005 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 2, 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.
+
+if [ "$1" = "" ] ; then
+   echo "debug modulename"
+   exit 1
+fi
+if [ "$2" = "" ] ; then
+   G=""
+else
+   G=$2
+fi
+if ! gm2 -g $G -c $1.mod ; then
+   echo "compilation failed"
+   exit 1
+fi
+if ! gm2 -g $G $1.mod ; then
+   echo "link failed"
+   exit 1
+fi
+cat << EOFEOF > .gdbinit
+break _M2_$1_init
+run
+EOFEOF
+emacs .gdbinit
+
diff --git a/gcc/testsuite/gm2/pim/pass/defset.def b/gcc/testsuite/gm2/pim/pass/defset.def
new file mode 100644
index 00000000000..def70f0b8d3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/defset.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE defset ;
+
+CONST
+    PTH_UNTIL_OCCURRED = BITSET {11} ;
+
+END defset.
diff --git a/gcc/testsuite/gm2/pim/pass/defset.mod b/gcc/testsuite/gm2/pim/pass/defset.mod
new file mode 100644
index 00000000000..d17390975df
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/defset.mod
@@ -0,0 +1,20 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE defset ;
+
+END defset.
diff --git a/gcc/testsuite/gm2/pim/pass/deftype.mod b/gcc/testsuite/gm2/pim/pass/deftype.mod
new file mode 100644
index 00000000000..ce0bb0911fc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/deftype.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE deftype ;
+
+TYPE tL = RECORD m :INTEGER END;
+
+TYPE tT = tL;
+
+PROCEDURE T (t: tT) : INTEGER ;
+BEGIN
+   RETURN t.m
+END T ;
+
+BEGIN
+END deftype .
diff --git a/gcc/testsuite/gm2/pim/pass/divaddr.mod b/gcc/testsuite/gm2/pim/pass/divaddr.mod
new file mode 100644
index 00000000000..57f26910793
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/divaddr.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE divaddr ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+VAR
+   a, b, c: ADDRESS ;
+BEGIN
+   a := b DIV c
+END divaddr.
diff --git a/gcc/testsuite/gm2/pim/pass/enum.mod b/gcc/testsuite/gm2/pim/pass/enum.mod
new file mode 100644
index 00000000000..22870852e9e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/enum.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE enum ;
+
+TYPE
+   color = (red, yellow, blue, purple) ;
+
+VAR
+   c: color ;
+BEGIN
+   c := yellow
+END enum.
diff --git a/gcc/testsuite/gm2/pim/pass/enum2.mod b/gcc/testsuite/gm2/pim/pass/enum2.mod
new file mode 100644
index 00000000000..c3c9ff7e15c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/enum2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE enum2 ;
+
+TYPE
+   Components = (yearC, monthC, dayC, hourC, minuteC, secondC) ;
+VAR
+   c: Components ;
+BEGIN
+   c := yearC ;
+   INC(c)
+END enum2.
diff --git a/gcc/testsuite/gm2/pim/pass/enum3.mod b/gcc/testsuite/gm2/pim/pass/enum3.mod
new file mode 100644
index 00000000000..57997cb04f7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/enum3.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE enum3 ;
+
+TYPE
+   Enum = (a, b, c, d) ;
+   Type = [a..d] ;
+
+VAR
+   v: Type ;
+BEGIN
+   IF v=a
+   THEN
+      v := b
+   END
+END enum3.
diff --git a/gcc/testsuite/gm2/pim/pass/file.mod b/gcc/testsuite/gm2/pim/pass/file.mod
new file mode 100644
index 00000000000..35472cc8e1e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/file.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE file ;
+
+(*
+PROCEDURE foo (a: ARRAY OF CHAR) ;
+BEGIN
+END foo ;
+*)
+
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := __LINE__ ;
+(*   foo(__FILE__) *)
+END file.
diff --git a/gcc/testsuite/gm2/pim/pass/filesystem.mod b/gcc/testsuite/gm2/pim/pass/filesystem.mod
new file mode 100644
index 00000000000..5579ff4390d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/filesystem.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE filesystem ;
+
+FROM DynamicStrings IMPORT String ;
+
+TYPE
+   File = CARDINAL ;
+
+(*
+   delete - deletes file, name. It also kills the string, name.
+*)
+
+PROCEDURE delete (VAR name: String; VAR f: File) ;
+BEGIN
+END delete ;
+
+VAR
+   n: String ;
+   f: File ;
+BEGIN
+   delete(n, f)
+END filesystem.
diff --git a/gcc/testsuite/gm2/pim/pass/foo.mod b/gcc/testsuite/gm2/pim/pass/foo.mod
new file mode 100644
index 00000000000..5db7643447c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/foo.mod
@@ -0,0 +1,97 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE foo ;
+
+
+TYPE
+   proc = PROCEDURE (CHAR) ;
+
+   rec = RECORD
+            a, b: CARDINAL ;
+         END ;
+
+   colours = (red, blue, yellow) ;
+
+   varrec= RECORD
+              CASE type:colours OF
+
+              red : x: CARDINAL |
+              blue: y: CHAR
+
+              ELSE
+              END
+           END ;
+
+VAR
+   myp : POINTER TO rec ;
+   this: rec ;
+   that: RECORD
+            c, d: CARDINAL ;
+            e   : rec ;
+         END ;
+
+   other: varrec ;
+
+   inline: RECORD
+             CASE type:colours OF
+
+             red : x: CARDINAL |
+             blue: y: CHAR
+
+             ELSE
+             END
+          END ;
+   array: ARRAY [1..10] OF CHAR ;
+   large: ARRAY [1..100], [1..200] OF rec ;
+   it   : proc ;
+   another,
+   card   : CARDINAL ;
+
+(*
+TYPE
+
+   sub     = [1..10] ;
+   bar = CARDINAL ;
+VAR
+   z      : bar ;
+*)
+   i, j, k: INTEGER ;
+(*
+   c      : colours ;
+   b      : BOOLEAN ;
+*)
+
+(* *)
+PROCEDURE dummy (q: CARDINAL) ;
+VAR
+   t: CARDINAL ;
+   a: CHAR ;
+BEGIN
+   t := 123 ;
+   (* another := *) dummy(t) ;
+(*   RETURN( t ) *)
+END dummy ;
+
+
+BEGIN
+   card := 12 ;
+   (* myproc('a', card) ; *)
+   (*  *)
+   (* another := *) dummy(card);
+   i := 100
+   (* i := j+k *)
+END foo.
diff --git a/gcc/testsuite/gm2/pim/pass/foo2.mod b/gcc/testsuite/gm2/pim/pass/foo2.mod
new file mode 100644
index 00000000000..182d39ff0e6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/foo2.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE foo2 ;
+
+
+PROCEDURE foobar (param, more: CHAR) : CARDINAL ;
+VAR
+(*
+   seven, eight,
+   five, six,
+   isit, now,
+*)
+   working: CARDINAL;
+   then,
+   now : CHAR ;
+BEGIN
+   working := 1 ;
+   IF param='a'
+   THEN
+      RETURN( 0 )
+   ELSE
+      RETURN( 1 )
+   END
+END foobar ;
+
+VAR
+   i1    : CARDINAL ;
+   global: CHAR ;
+   c1    : CHAR ;
+   a     : ARRAY [1..200] OF CHAR ;
+BEGIN
+   i1 := foobar(global, c1)
+END foo2.
diff --git a/gcc/testsuite/gm2/pim/pass/for1.mod b/gcc/testsuite/gm2/pim/pass/for1.mod
new file mode 100644
index 00000000000..77b512a2ce2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/for1.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE for1 ;
+
+
+VAR
+   a, b,
+   i   : CARDINAL ;
+BEGIN
+   FOR i := 1 TO 10 DO
+      a := a + 1 ;
+      b := b + 1
+   END
+END for1.
diff --git a/gcc/testsuite/gm2/pim/pass/function.mod b/gcc/testsuite/gm2/pim/pass/function.mod
new file mode 100644
index 00000000000..0dd70ecd595
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/function.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE function ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE foo ;
+BEGIN
+   WriteString('currently in ') ; WriteString(__FUNCTION__) ; WriteLn
+END foo ;
+
+BEGIN
+   WriteString('currently in ') ; WriteString(__FUNCTION__) ; WriteLn ;
+   foo
+END function.
diff --git a/gcc/testsuite/gm2/pim/pass/function2.mod b/gcc/testsuite/gm2/pim/pass/function2.mod
new file mode 100644
index 00000000000..4cde1489fa3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/function2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE function2 ;
+
+PROCEDURE foo () : CARDINAL ;
+BEGIN
+   RETURN 123
+END foo ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := foo()
+END function2.
diff --git a/gcc/testsuite/gm2/pim/pass/gcd.def b/gcc/testsuite/gm2/pim/pass/gcd.def
new file mode 100644
index 00000000000..b52f3c82ad2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/gcd.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+DEFINITION MODULE gcd ;
+
+EXPORT QUALIFIED GreatestCommonDivisor ;
+
+PROCEDURE GreatestCommonDivisor (x, y: CARDINAL) : CARDINAL ;
+
+END gcd.
diff --git a/gcc/testsuite/gm2/pim/pass/gcd.mod b/gcc/testsuite/gm2/pim/pass/gcd.mod
new file mode 100644
index 00000000000..e60e60da2f9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/gcd.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE gcd ;
+
+
+FROM StrIO IMPORT WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+
+
+PROCEDURE GreatestCommonDivisor (x, y: CARDINAL) : CARDINAL ;
+VAR
+   u, v: CARDINAL ;
+BEGIN
+   u := x ;
+   v := y ;
+   WHILE x#y DO
+      IF x>y
+      THEN
+         DEC(x, y) ;
+         INC(u, v)
+      ELSE
+         DEC(y, x) ;
+         INC(v, u)
+      END
+   END ;
+   RETURN( u+v )
+END GreatestCommonDivisor ;
+
+
+VAR
+   d1, d2,
+   answer: CARDINAL ;
+BEGIN
+(*
+   d1 := 24 ;
+   d2 := 60 ;
+*)
+   answer := GreatestCommonDivisor(24, 60) ;
+   WriteCard(answer, 6) ; WriteLn
+END gcd.
diff --git a/gcc/testsuite/gm2/pim/pass/getconst.mod b/gcc/testsuite/gm2/pim/pass/getconst.mod
new file mode 100644
index 00000000000..e78db63110b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/getconst.mod
@@ -0,0 +1,79 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE getconst ;
+
+CONST
+   LongReal = 1 ;
+   Integer  = 2 ;
+   Char     = 3 ;
+
+
+PROCEDURE GetSymName (s: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN s
+END GetSymName ;
+
+PROCEDURE LengthKey (s: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN s
+END LengthKey ;
+
+PROCEDURE GetKey (s: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+END GetKey ;
+
+
+(*
+   GetConstLitType - returns the type of the constant, Sym.
+                     All constants have type NulSym except CHAR constants
+                     ie 00C 012C etc and floating point constants which have type LONGREAL.
+*)
+
+PROCEDURE GetConstLitType (Sym: CARDINAL) : CARDINAL ;
+CONST
+   Max = 4096 ;
+VAR
+   a   : ARRAY [0..Max] OF CHAR ;
+   i,
+   High: CARDINAL ;
+BEGIN
+   GetKey(GetSymName(Sym), a) ;
+   High := LengthKey(GetSymName(Sym)) ;
+   IF a[High-1]='C'
+   THEN
+      RETURN( Char )
+   ELSE
+      i := 0 ;
+      WHILE i<High DO
+         IF (a[i]='.') OR (a[i]='+')
+         THEN
+            RETURN( LongReal )
+         ELSE
+            INC(i)
+         END
+      END ;
+      RETURN( Integer )
+   END
+END GetConstLitType ;
+
+
+BEGIN
+   IF GetConstLitType(2)=2
+   THEN
+   END
+END getconst.
diff --git a/gcc/testsuite/gm2/pim/pass/hello.mod b/gcc/testsuite/gm2/pim/pass/hello.mod
new file mode 100644
index 00000000000..3b268bbcc94
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/hello.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE hello ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ; WriteLn
+END hello.
diff --git a/gcc/testsuite/gm2/pim/pass/impa.mod b/gcc/testsuite/gm2/pim/pass/impa.mod
new file mode 100644
index 00000000000..07e07b689b6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impa.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impa ;
+
+FROM impb IMPORT C ;
+
+BEGIN
+END impa.
diff --git a/gcc/testsuite/gm2/pim/pass/impb.def b/gcc/testsuite/gm2/pim/pass/impb.def
new file mode 100644
index 00000000000..fde4a12472a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impb.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE impb ;
+
+IMPORT impc ;
+
+TYPE
+   C = impc.C ;
+
+END impb.
diff --git a/gcc/testsuite/gm2/pim/pass/impb.mod b/gcc/testsuite/gm2/pim/pass/impb.mod
new file mode 100644
index 00000000000..c1ac62d1418
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impb.mod
@@ -0,0 +1,20 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE impb ;
+
+END impb.
diff --git a/gcc/testsuite/gm2/pim/pass/impc.def b/gcc/testsuite/gm2/pim/pass/impc.def
new file mode 100644
index 00000000000..3ed42b45c8d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impc.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE impc ;
+
+(* EXPORT QUALIFIED C ; *)
+
+TYPE
+   C = (red, blue, green) ;
+
+END impc.
diff --git a/gcc/testsuite/gm2/pim/pass/impc.mod b/gcc/testsuite/gm2/pim/pass/impc.mod
new file mode 100644
index 00000000000..ce6ca094200
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impc.mod
@@ -0,0 +1,20 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE impc ;
+
+END impc.
diff --git a/gcc/testsuite/gm2/pim/pass/impd.mod b/gcc/testsuite/gm2/pim/pass/impd.mod
new file mode 100644
index 00000000000..f53937aa22b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impd.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impd ;
+
+FROM impb IMPORT C ;
+
+CONST
+   start = MIN(C) ;
+   end   = MAX(C) ;
+
+VAR
+   a: ARRAY [start..end] OF CARDINAL ;
+BEGIN
+
+END impd.
diff --git a/gcc/testsuite/gm2/pim/pass/impe.mod b/gcc/testsuite/gm2/pim/pass/impe.mod
new file mode 100644
index 00000000000..54ca54f9869
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impe.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impe ;
+
+IMPORT impb ;
+
+CONST
+   start = MIN(impb.C) ;
+   end   = MAX(impb.C) ;
+
+VAR
+   a: ARRAY [start..end] OF CARDINAL ;
+BEGIN
+
+END impe.
diff --git a/gcc/testsuite/gm2/pim/pass/impf.mod b/gcc/testsuite/gm2/pim/pass/impf.mod
new file mode 100644
index 00000000000..71df5791ae7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impf.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impf ;
+
+IMPORT impb ;
+
+CONST
+   start = impb.red ;
+   end   = impb.green ;
+
+VAR
+   a: ARRAY [start..end] OF CARDINAL ;
+BEGIN
+
+END impf.
diff --git a/gcc/testsuite/gm2/pim/pass/impg.mod b/gcc/testsuite/gm2/pim/pass/impg.mod
new file mode 100644
index 00000000000..d2da1db6084
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impg.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impg ;
+
+IMPORT impc ;
+
+CONST
+   start = impc.red ;
+   end   = impc.green ;
+
+VAR
+   a: ARRAY [start..end] OF CARDINAL ;
+BEGIN
+
+END impg.
diff --git a/gcc/testsuite/gm2/pim/pass/imph.mod b/gcc/testsuite/gm2/pim/pass/imph.mod
new file mode 100644
index 00000000000..1bb965fac6e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/imph.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE imph ;
+
+FROM impb IMPORT C ;
+
+VAR
+   a: C ;
+BEGIN
+   a := red
+END imph.
diff --git a/gcc/testsuite/gm2/pim/pass/impi.mod b/gcc/testsuite/gm2/pim/pass/impi.mod
new file mode 100644
index 00000000000..a1fbf36599e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impi.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impi ;
+
+FROM impb IMPORT C ;
+
+VAR
+   a: ARRAY [red..green] OF CARDINAL ;
+BEGIN
+
+END impi.
diff --git a/gcc/testsuite/gm2/pim/pass/impj.mod b/gcc/testsuite/gm2/pim/pass/impj.mod
new file mode 100644
index 00000000000..f73b2e73789
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impj.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impj ;
+
+FROM impb IMPORT C ;
+
+VAR
+   a: C ;
+BEGIN
+   a := red
+END impj.
diff --git a/gcc/testsuite/gm2/pim/pass/impk.mod b/gcc/testsuite/gm2/pim/pass/impk.mod
new file mode 100644
index 00000000000..947fd89ff4b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impk.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impk ;
+
+IMPORT impb ;
+
+(* should pass *)
+VAR
+   a: ARRAY [impb.red..impb.green] OF CARDINAL ;
+BEGIN
+
+END impk.
diff --git a/gcc/testsuite/gm2/pim/pass/impl.mod b/gcc/testsuite/gm2/pim/pass/impl.mod
new file mode 100644
index 00000000000..76bdbca80af
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impl.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impl ;
+
+IMPORT impb ;
+
+VAR
+   a: impb.C ;
+BEGIN
+   a := impb.red
+END impl.
diff --git a/gcc/testsuite/gm2/pim/pass/impm.mod b/gcc/testsuite/gm2/pim/pass/impm.mod
new file mode 100644
index 00000000000..7e0cf58bd6e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impm.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impm ;
+
+FROM impc IMPORT red ;
+
+BEGIN
+
+END impm.
diff --git a/gcc/testsuite/gm2/pim/pass/impn.def b/gcc/testsuite/gm2/pim/pass/impn.def
new file mode 100644
index 00000000000..5bbbb5e22f4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impn.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE impn ;
+
+EXPORT QUALIFIED red ;
+
+TYPE
+   C = (red, blue, green) ;
+
+END impn.
diff --git a/gcc/testsuite/gm2/pim/pass/impn.mod b/gcc/testsuite/gm2/pim/pass/impn.mod
new file mode 100644
index 00000000000..d285feb0a7c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impn.mod
@@ -0,0 +1,20 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE impn ;
+
+END impn.
diff --git a/gcc/testsuite/gm2/pim/pass/impo.mod b/gcc/testsuite/gm2/pim/pass/impo.mod
new file mode 100644
index 00000000000..2328e0814e2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impo.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE impo ;
+
+FROM impn IMPORT red ;
+
+BEGIN
+
+END impo.
diff --git a/gcc/testsuite/gm2/pim/pass/imports.mod b/gcc/testsuite/gm2/pim/pass/imports.mod
new file mode 100644
index 00000000000..20e1f1daf28
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/imports.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE imports ;
+
+MODULE a ;
+EXPORT e1 ;
+TYPE
+e1 = (cyan, yellow, magenta) ;
+END a ;
+
+MODULE b ;
+IMPORT e1 ;
+EXPORT e2 ;
+TYPE
+   e2 = e1 ;
+END b ;
+
+CONST
+   colour = b.yellow ;
+
+END imports.
diff --git a/gcc/testsuite/gm2/pim/pass/impp.def b/gcc/testsuite/gm2/pim/pass/impp.def
new file mode 100644
index 00000000000..83bb47ee58f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impp.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE impp ;
+
+IMPORT impc;
+
+TYPE
+   C = impc.C ;
+
+END impp.
diff --git a/gcc/testsuite/gm2/pim/pass/impp.mod b/gcc/testsuite/gm2/pim/pass/impp.mod
new file mode 100644
index 00000000000..73fb8f1ccd7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impp.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE impp ;
+
+VAR
+   t: C ;
+BEGIN
+   t := red
+END impp.
diff --git a/gcc/testsuite/gm2/pim/pass/impq.def b/gcc/testsuite/gm2/pim/pass/impq.def
new file mode 100644
index 00000000000..1a05120360b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impq.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE impq;
+
+IMPORT impc;
+TYPE
+   C = impc.C;
+
+END impq.
diff --git a/gcc/testsuite/gm2/pim/pass/impq.mod b/gcc/testsuite/gm2/pim/pass/impq.mod
new file mode 100644
index 00000000000..b42b58eee73
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/impq.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE impq;
+
+IMPORT impc;
+
+VAR
+   a: C ;
+   b: impc.C ;
+BEGIN
+   a := impc.red ;
+   b := red ;
+   a := b ;
+   b := a
+END impq.
diff --git a/gcc/testsuite/gm2/pim/pass/incompsets.mod b/gcc/testsuite/gm2/pim/pass/incompsets.mod
new file mode 100644
index 00000000000..a73c33d09a3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/incompsets.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE incompsets ;
+
+
+TYPE
+   LargeSet = SET OF [0..255] ;
+   SmallSet = SET OF [0..127] ;
+
+VAR
+   l: LargeSet ;
+   s: SmallSet ;
+BEGIN
+   IF l=LargeSet{}
+   THEN
+
+   END ;
+   IF s=SmallSet{}
+   THEN
+
+   END
+END incompsets.
diff --git a/gcc/testsuite/gm2/pim/pass/index.mod b/gcc/testsuite/gm2/pim/pass/index.mod
new file mode 100644
index 00000000000..7f8555d6822
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/index.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE index;
+
+TYPE
+   A = ARRAY [0..1] OF CHAR ;
+VAR
+   a :ARRAY [0..1] OF A ;
+
+BEGIN 
+   a[0,0] := 'A'  (* Reported as error by GM2 of 2005-06-03 *)
+END index.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/pass/index2.mod b/gcc/testsuite/gm2/pim/pass/index2.mod
new file mode 100644
index 00000000000..c8326b85e42
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/index2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE index2 ;
+
+VAR
+   a :ARRAY [0..1] OF ARRAY [0..1] OF CHAR ;
+
+BEGIN 
+   a[0,0] := 'A'
+END index2.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/pass/indirect.mod b/gcc/testsuite/gm2/pim/pass/indirect.mod
new file mode 100644
index 00000000000..2ab9337d36d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/indirect.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE indirect ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   MYBYTE = [0..255] ;
+   ptr = POINTER TO ADDRESS ;
+
+VAR
+   f: ARRAY [0..255] OF ptr ;
+
+PROCEDURE first (p: ptr) ;
+VAR
+   t: ptr ;
+   i: CARDINAL ;
+BEGIN
+   t := f[i]^ ;
+   IF p^ = NIL
+   THEN
+      HALT
+   END
+END first ;
+
+
+VAR
+   q: ptr ;
+BEGIN
+   first(q)
+END indirect.
diff --git a/gcc/testsuite/gm2/pim/pass/inner.mod b/gcc/testsuite/gm2/pim/pass/inner.mod
new file mode 100644
index 00000000000..64290e7366b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/inner.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE inner ;
+
+   MODULE nested ;
+
+   EXPORT VisibleToInnerAndNested ;
+
+   VAR
+      InsideNested           : CARDINAL ;
+      VisibleToInnerAndNested: CARDINAL ;
+   BEGIN
+      VisibleToInnerAndNested := 123
+   END nested ;
+
+VAR
+   GlobalToBoth: CARDINAL ;
+BEGIN
+   GlobalToBoth := 456 ;
+   IF VisibleToInnerAndNested=123
+   THEN
+      GlobalToBoth := 789
+   END
+END inner.
diff --git a/gcc/testsuite/gm2/pim/pass/inner2.mod b/gcc/testsuite/gm2/pim/pass/inner2.mod
new file mode 100644
index 00000000000..03b3599f368
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/inner2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE inner2 ;
+
+    MODULE second ;
+
+       MODULE third ;
+       BEGIN
+       END third ;
+
+    BEGIN
+    END second ;
+
+BEGIN
+END inner2.
diff --git a/gcc/testsuite/gm2/pim/pass/int.mod b/gcc/testsuite/gm2/pim/pass/int.mod
new file mode 100644
index 00000000000..09d3230bbbc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/int.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE int ;
+
+VAR
+   s: INTEGER ;
+BEGIN
+   s := 1 ;
+   s := 1 ;
+   s := 1 ;
+   s := 1 ;
+   s := 1 ;
+   s := 1 ;
+END int.
diff --git a/gcc/testsuite/gm2/pim/pass/largeset.mod b/gcc/testsuite/gm2/pim/pass/largeset.mod
new file mode 100644
index 00000000000..945c87b5896
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/largeset.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE largeset ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   token = (eoftok, plustok, minustok, timestok, dividetok, becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok, repeattok, returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, integertok, identtok, realtok, stringtok) ;
+   set = SET OF token ;
+
+VAR
+   s: set ;
+   p: POINTER TO ARRAY [0..2] OF INTEGER ;
+BEGIN
+   p := ADR(s) ;
+   p^[0] := 3 ;
+   p^[1] := 7 ;
+   p^[2] := -1 ;
+   p^[2] := -1
+END largeset.
diff --git a/gcc/testsuite/gm2/pim/pass/largeset1.mod b/gcc/testsuite/gm2/pim/pass/largeset1.mod
new file mode 100644
index 00000000000..edb3c55e3f4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/largeset1.mod
@@ -0,0 +1,75 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE largeset1 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+TYPE
+   LargeBitset = SET OF [0..127] ;
+
+
+(*
+   GetAddr - 
+*)
+
+PROCEDURE GetAddr (i: CARDINAL) : ADDRESS ;
+BEGIN
+   CASE i OF
+
+   0..31  : RETURN( ADR(b) ) |
+   32..63 : RETURN( ADR(b)+ADDRESS(4) ) |
+   64..95 : RETURN( ADR(b)+ADDRESS(8) ) |
+   96..127: RETURN( ADR(b)+ADDRESS(12) )
+
+   ELSE
+      HALT
+   END
+END GetAddr ;
+
+
+VAR
+   b: LargeBitset ;
+   p: POINTER TO CARDINAL ;
+   i, j: CARDINAL ;
+BEGIN
+   j := 1 ;
+   b := LargeBitset{} ;
+   FOR i := 0 TO MAX(LargeBitset) DO
+      WriteString('index = ') ; WriteCard(i, 3) ; WriteLn ;
+      INCL(b, i) ;
+      p := GetAddr(i) ;
+      IF p^#j
+      THEN
+         exit(1)
+      END ;
+      EXCL(b, i) ;
+      IF b#LargeBitset{}
+      THEN
+         exit(2)
+      END ;
+      IF i MOD 32 = 31
+      THEN
+         j := 1
+      ELSE
+         j := j*2
+      END
+   END
+END largeset1.
diff --git a/gcc/testsuite/gm2/pim/pass/largeset2.mod b/gcc/testsuite/gm2/pim/pass/largeset2.mod
new file mode 100644
index 00000000000..3a1cbed5d1c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/largeset2.mod
@@ -0,0 +1,93 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE largeset2 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+TYPE
+   LargeBitset = SET OF [0..127] ;
+
+
+PROCEDURE TestIn (i: CARDINAL) ;
+VAR
+   j: CARDINAL ;
+BEGIN
+   IF NOT (i IN b)
+   THEN
+      exit(3)
+   END ;
+   FOR j := 0 TO MAX(LargeBitset) DO
+      IF (i#j) AND (j IN b)
+      THEN
+         exit(4)
+      END
+   END
+END TestIn ;
+
+
+(*
+   GetAddr - 
+*)
+
+PROCEDURE GetAddr (i: CARDINAL) : ADDRESS ;
+BEGIN
+   CASE i OF
+
+   0..31  : RETURN( ADR(b) ) |
+   32..63 : RETURN( ADR(b)+ADDRESS(4) ) |
+   64..95 : RETURN( ADR(b)+ADDRESS(8) ) |
+   96..127: RETURN( ADR(b)+ADDRESS(12) )
+
+   ELSE
+      HALT
+   END
+END GetAddr ;
+
+
+VAR
+   b: LargeBitset ;
+   p: POINTER TO CARDINAL ;
+   i, j: CARDINAL ;
+BEGIN
+   j := 1 ;
+   b := LargeBitset{} ;
+   FOR i := 0 TO MAX(LargeBitset) DO
+      WriteString('index = ') ; WriteCard(i, 3) ; WriteLn ;
+      INCL(b, i) ;
+      p := GetAddr(i) ;
+      IF p^#j
+      THEN
+         exit(1)
+      END ;
+      TestIn(i) ;
+      EXCL(b, i) ;
+      IF b#LargeBitset{}
+      THEN
+         exit(2)
+      END ;
+      IF i MOD 32 = 31
+      THEN
+         j := 1
+      ELSE
+         j := j*2
+      END
+   END
+END largeset2.
diff --git a/gcc/testsuite/gm2/pim/pass/largeset3.mod b/gcc/testsuite/gm2/pim/pass/largeset3.mod
new file mode 100644
index 00000000000..07074ec7e19
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/largeset3.mod
@@ -0,0 +1,137 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE largeset3 ;
+
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+TYPE
+   LargeBitset = SET OF [0..127] ;
+
+
+VAR
+   b: LargeBitset ;
+   j: CARDINAL ;
+BEGIN
+   j := 1 ;
+   b := LargeBitset{} ;
+   WriteString('index = ') ; WriteCard(1, 2) ; WriteLn ;
+   INCL(b, 1) ;
+   IF NOT (1 IN b)
+   THEN
+      exit(3)
+   END ;
+   IF 1 IN b
+   THEN
+      INC(j)
+   ELSE
+      exit(4)
+   END ;
+
+   EXCL(b, 1) ;
+   IF b#LargeBitset{}
+   THEN
+      exit(2)
+   END ;
+
+   j := 20 ;
+   b := LargeBitset{} ;
+   WriteString('index = ') ; WriteCard(20, 2) ; WriteLn ;
+   INCL(b, 20) ;
+   IF NOT (20 IN b)
+   THEN
+      exit(3)
+   END ;
+   IF 20 IN b
+   THEN
+      INC(j)
+   ELSE
+      exit(4)
+   END ;
+
+   EXCL(b, 20) ;
+   IF b#LargeBitset{}
+   THEN
+      exit(2)
+   END ;
+
+   j := 40 ;
+   b := LargeBitset{} ;
+   WriteString('index = ') ; WriteCard(40, 2) ; WriteLn ;
+   INCL(b, 40) ;
+   IF NOT (40 IN b)
+   THEN
+      exit(3)
+   END ;
+   IF 40 IN b
+   THEN
+      INC(j)
+   ELSE
+      exit(4)
+   END ;
+
+   EXCL(b, 40) ;
+   IF b#LargeBitset{}
+   THEN
+      exit(2)
+   END ;
+
+   j := 60 ;
+   b := LargeBitset{} ;
+   WriteString('index = ') ; WriteCard(60, 2) ; WriteLn ;
+   INCL(b, 60) ;
+   IF NOT (60 IN b)
+   THEN
+      exit(3)
+   END ;
+   IF 60 IN b
+   THEN
+      INC(j)
+   ELSE
+      exit(4)
+   END ;
+
+   EXCL(b, 60) ;
+   IF b#LargeBitset{}
+   THEN
+      exit(2)
+   END ;
+
+   j := 100 ;
+   b := LargeBitset{} ;
+   WriteString('index = ') ; WriteCard(100, 3) ; WriteLn ;
+   INCL(b, 100) ;
+   IF NOT (100 IN b)
+   THEN
+      exit(3)
+   END ;
+   IF 100 IN b
+   THEN
+      INC(j)
+   ELSE
+      exit(4)
+   END ;
+
+   EXCL(b, 100) ;
+   IF b#LargeBitset{}
+   THEN
+      exit(2)
+   END
+
+END largeset3.
diff --git a/gcc/testsuite/gm2/pim/pass/largeset4.mod b/gcc/testsuite/gm2/pim/pass/largeset4.mod
new file mode 100644
index 00000000000..be1cb43b99f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/largeset4.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE largeset4 ;
+
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+TYPE
+   LargeBitset = SET OF [0..127] ;
+
+VAR
+   b: LargeBitset ;
+BEGIN
+   b := LargeBitset{} ;
+   INCL(b, 1)
+
+END largeset4.
diff --git a/gcc/testsuite/gm2/pim/pass/largeset5.mod b/gcc/testsuite/gm2/pim/pass/largeset5.mod
new file mode 100644
index 00000000000..454c5d42504
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/largeset5.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE largeset5 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   LargeBitset = SET OF [0..127] ;
+
+VAR
+   a, b, c, d: LargeBitset ;
+BEGIN
+   a := LargeBitset{1, 2, 3, 4, 5, 100, 101, 102, 103, 104} ;
+   b := LargeBitset{1, 2, 3, 4, 5,      101, 102, 103, 104} ;
+   c := LargeBitset{1, 2, 3, 4, 5, 100, 101, 102, 103, 104, 105} ;
+   d := LargeBitset{1, 2, 3, 4, 5, 100, 101, 102, 103, 104, 105} ;
+   IF a<b
+   THEN
+      exit(1)
+   END ;
+   IF b>c
+   THEN
+      exit(1)
+   END ;
+   IF d>=c
+   THEN
+      exit(0)
+   END ;
+   exit(1)
+END largeset5.
diff --git a/gcc/testsuite/gm2/pim/pass/largeset6.mod b/gcc/testsuite/gm2/pim/pass/largeset6.mod
new file mode 100644
index 00000000000..3f0a09b31c7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/largeset6.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE largeset6 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   LargeBitset = SET OF [0..127] ;
+
+VAR
+   a, neg: LargeBitset ;
+BEGIN
+   a := LargeBitset{1, 2, 3, 4, 5, 100, 101, 102, 103, 104} ;
+
+   neg := -a ;
+   IF 1 IN neg
+   THEN
+      exit(1)
+   END ;
+   exit(0)
+END largeset6.
diff --git a/gcc/testsuite/gm2/pim/pass/largeset7.mod b/gcc/testsuite/gm2/pim/pass/largeset7.mod
new file mode 100644
index 00000000000..dabc23ed653
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/largeset7.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE largeset7 ;
+
+TYPE
+   s1 = SET OF [0..10] ;
+   s2 = SET OF [11..20] ;
+   s3 = SET OF [22..30] ;
+
+   set = RECORD
+            w1: s1 ;
+            w2: s2 ;
+            w3: s3
+         END ;
+
+VAR
+   b: set ;
+BEGIN
+
+END largeset7.
diff --git a/gcc/testsuite/gm2/pim/pass/localmod.mod b/gcc/testsuite/gm2/pim/pass/localmod.mod
new file mode 100644
index 00000000000..e1cd6dd2dc1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/localmod.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE localmod ;
+
+
+   MODULE SinCos ;
+      EXPORT zsin ;
+      PROCEDURE zsin (x: REAL) : REAL ;
+      BEGIN
+         RETURN 1.0
+      END zsin ;
+
+      PROCEDURE foo ;
+      BEGIN
+      END foo ;
+
+   VAR
+      y: REAL ;
+   BEGIN
+      y := zsin(2.0)
+   END SinCos ;
+
+VAR
+   x: REAL ;
+BEGIN
+   x := zsin(1.0)
+END localmod.
diff --git a/gcc/testsuite/gm2/pim/pass/localproc.mod b/gcc/testsuite/gm2/pim/pass/localproc.mod
new file mode 100644
index 00000000000..11fa64e0284
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/localproc.mod
@@ -0,0 +1,67 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE localproc ;
+
+FROM M2RTS IMPORT HALT ;
+
+(* (outer (a, (b (c)))) *)
+PROCEDURE outer ;
+VAR
+   k, l: INTEGER ;
+   
+   PROCEDURE a (VAR x: INTEGER) ;
+   VAR
+      j: CARDINAL ;
+   BEGIN
+      j := 1 ;
+      k := x ;
+      x := j
+   END a ;
+
+   PROCEDURE b (VAR x: INTEGER) ;
+   VAR
+      j: CARDINAL ;
+
+      PROCEDURE c (x: INTEGER) ;
+      BEGIN
+         k := x
+      END c ;
+
+   BEGIN
+      j := 1 ;
+      k := x ;
+      x := j
+   END b ;
+
+BEGIN
+   k := 0 ;
+   l := 2 ;
+   a(l) ;
+   IF k#2
+   THEN
+      HALT
+   END ;
+   IF l#1
+   THEN
+      HALT
+   END
+END outer ;
+
+BEGIN
+   outer
+END localproc.
diff --git a/gcc/testsuite/gm2/pim/pass/localvar.mod b/gcc/testsuite/gm2/pim/pass/localvar.mod
new file mode 100644
index 00000000000..271f6a0956b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/localvar.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE localvar ;
+
+PROCEDURE test (d: CARDINAL) ;
+VAR
+   a, b, c: CARDINAL ;
+BEGIN
+   a := 1 ;
+   b := 2 ;
+   c := 3 ;
+END test ;
+
+BEGIN
+   test(4)
+END localvar.
diff --git a/gcc/testsuite/gm2/pim/pass/log b/gcc/testsuite/gm2/pim/pass/log
new file mode 100644
index 00000000000..6b79386afe5
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/log
@@ -0,0 +1,457 @@
+=====================================================
+Stabs setchar3
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file setchar3.mod, line 30.
+
+Breakpoint 1, _M2_setchar3_init () at setchar3.mod:30
+30	   ch := 'z' ;
+31	   s := smallchar{} ;
+$1 = {}
+type = SET ['A'..'Z']
+=====================================================
+Dwarf2 setchar3
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file setchar3.mod, line 30.
+
+Breakpoint 1, _M2_setchar3_init () at setchar3.mod:30
+30	   ch := 'z' ;
+31	   s := smallchar{} ;
+$1 = {}
+type = SET ['A'..'Z']
+=====================================================
+Stabs subrange15
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file subrange15.mod, line 8.
+
+Breakpoint 1, _M2_subrange15_init () at subrange15.mod:8
+8	   s := 20 ;
+9	   s := 21 ;
+$1 = 20
+type = [20..40]
+=====================================================
+Dwarf2 subrange15
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file subrange15.mod, line 8.
+
+Breakpoint 1, _M2_subrange15_init () at subrange15.mod:8
+8	   s := 20 ;
+9	   s := 21 ;
+$1 = 20
+type = [20..40]
+=====================================================
+Stabs subrange16
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file subrange16.mod, line 8.
+
+Breakpoint 1, _M2_subrange16_init () at subrange16.mod:8
+8	   s := 'A' ;
+9	   s := 'B' ;
+$1 = 65 'A'
+type = ['A'..'Z']
+=====================================================
+Dwarf2 subrange16
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file subrange16.mod, line 8.
+
+Breakpoint 1, _M2_subrange16_init () at subrange16.mod:8
+8	   s := 'A' ;
+9	   s := 'B' ;
+$1 = 65 'A'
+type = ['A'..'Z']
+=====================================================
+Stabs subrange17
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file subrange17.mod, line 9.
+
+Breakpoint 1, _M2_subrange17_init () at subrange17.mod:9
+9	   s := blue ;
+10	   s := red ;
+$1 = blue
+type = [blue..yellow]
+=====================================================
+Dwarf2 subrange17
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file subrange17.mod, line 9.
+
+Breakpoint 1, _M2_subrange17_init () at subrange17.mod:9
+9	   s := blue ;
+10	   s := red ;
+$1 = blue
+type = [blue..yellow]
+=====================================================
+Stabs array4
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file array4.mod, line 6.
+
+Breakpoint 1, _M2_array4_init () at array4.mod:6
+6	   s[1] := 1 ;
+7	   s[1] := 1 ;
+$1 = {1, 0, 0, 0, 0}
+type = ARRAY [1..5] OF <invalid type code 7>
+=====================================================
+Dwarf2 array4
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file array4.mod, line 6.
+
+Breakpoint 1, _M2_array4_init () at array4.mod:6
+6	   s[1] := 1 ;
+7	   s[1] := 1 ;
+$1 = {1, 0, 0, 0, 0}
+type = ARRAY [1..5] OF CARDINAL
+=====================================================
+Stabs array5
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file array5.mod, line 8.
+
+Breakpoint 1, _M2_array5_init () at array5.mod:8
+8	   NEW(s) ;
+9	   s^[1] := 1 ;
+$1 = 0x536280
+type = POINTER TO ARRAY [1..5] OF <invalid type code 7>
+=====================================================
+Dwarf2 array5
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file array5.mod, line 8.
+
+Breakpoint 1, _M2_array5_init () at array5.mod:8
+8	   NEW(s) ;
+9	   s^[1] := 1 ;
+$1 = 0x536280
+type = POINTER TO ARRAY [1..5] OF CARDINAL
+=====================================================
+Stabs char
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file char.mod, line 6.
+
+Breakpoint 1, _M2_char_init () at char.mod:6
+6	   s := 'a' ;
+7	   s := 'z' ;
+$1 = 97 'a'
+type = <invalid type code 18>
+=====================================================
+Dwarf2 char
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file char.mod, line 6.
+
+Breakpoint 1, _M2_char_init () at char.mod:6
+6	   s := 'a' ;
+7	   s := 'z' ;
+$1 = 97 'a'
+type = CHAR
+=====================================================
+Stabs int
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file int.mod, line 6.
+
+Breakpoint 1, _M2_int_init () at int.mod:6
+6	   s := 1 ;
+7	   s := 1 ;
+$1 = 1
+type = <invalid type code 7>
+=====================================================
+Dwarf2 int
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file int.mod, line 6.
+
+Breakpoint 1, _M2_int_init () at int.mod:6
+6	   s := 1 ;
+7	   s := 1 ;
+$1 = 1
+type = INTEGER
+=====================================================
+Stabs ptrarray
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file ptrarray.mod, line 27.
+
+Breakpoint 1, _M2_ptrarray_init () at ptrarray.mod:27
+27	   s := NIL ;
+31	END ptrarray.
+$1 = 0x0
+type = POINTER TO ARRAY [0..9] OF <invalid type code 18>
+=====================================================
+Dwarf2 ptrarray
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file ptrarray.mod, line 27.
+
+Breakpoint 1, _M2_ptrarray_init () at ptrarray.mod:27
+27	   s := NIL ;
+31	END ptrarray.
+$1 = 0x0
+type = POINTER TO ARRAY [0..9] OF CHAR
+=====================================================
+Stabs variant9
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x4212d8: file variant9.mod, line 19.
+
+Breakpoint 1, _M2_variant9_init () at variant9.mod:19
+19	   WITH s DO
+20	      Data := card;
+$1 = {Data = card, <error type>}
+type = RcdType = RECORD
+    Data : DataType;
+     : <unknown type>;
+END 
+=====================================================
+Dwarf2 variant9
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x4212d8: file variant9.mod, line 19.
+
+Breakpoint 1, _M2_variant9_init () at variant9.mod:19
+19	   WITH s DO
+20	      Data := card;
+$1 = {Data = card, {$$1 = {j = 0, k = 0}, $$2 = {st = 0 C}}}
+type = RcdType = RECORD
+    Data : DataType;
+     : ;
+END 
+=====================================================
+Stabs setenum
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file setenum.mod, line 30.
+
+Breakpoint 1, _M2_setenum_init () at setenum.mod:30
+30	   s := set{};
+31	   s := set{};
+$1 = {}
+type = set = SET OF enum
+=====================================================
+Dwarf2 setenum
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file setenum.mod, line 30.
+
+Breakpoint 1, _M2_setenum_init () at setenum.mod:30
+30	   s := set{};
+31	   s := set{};
+$1 = {}
+type = set = SET OF enum
+=====================================================
+Stabs record7
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file record7.mod, line 32.
+
+Breakpoint 1, _M2_record7_init () at record7.mod:32
+32	   s := NIL ;
+36	END record7.
+$1 = 0x0
+type = POINTER TO ARRAY [-2..2] OF foo = RECORD
+    f1 : CARDINAL;
+    f2 : CHAR;
+    f3 : ARRAY [-2..2] OF CARDINAL;
+END 
+=====================================================
+Dwarf2 record7
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file record7.mod, line 32.
+
+Breakpoint 1, _M2_record7_init () at record7.mod:32
+32	   s := NIL ;
+36	END record7.
+$1 = 0x0
+type = POINTER TO ARRAY [-2..2] OF foo = RECORD
+    f1 : CARDINAL;
+    f2 : CHAR;
+    f3 : ARRAY [-2..2] OF CARDINAL;
+END 
+=====================================================
+Stabs setchar4
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file setchar4.mod, line 29.
+
+Breakpoint 1, _M2_setchar4_init () at setchar4.mod:29
+29	   p := ADR(s) ;
+30	   p^[0] := -1 ;
+$1 = {}
+type = charset = SET OF [200C..177C]
+=====================================================
+Dwarf2 setchar4
+GNU gdb 6.3
+Copyright 2004 Free Software Foundation, Inc.
+GDB is free software, covered by the GNU General Public License, and you are
+welcome to change it and/or distribute copies of it under certain conditions.
+Type "show copying" to see the conditions.
+There is absolutely no warranty for GDB.  Type "show warranty" for details.
+This GDB was configured as "x86_64-unknown-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".
+
+Breakpoint 1 at 0x421298: file setchar4.mod, line 29.
+
+Breakpoint 1, _M2_setchar4_init () at setchar4.mod:29
+29	   p := ADR(s) ;
+30	   p^[0] := -1 ;
+$1 = {}
+type = charset = SET OF CHAR
+gdb is hashed (/home/gaius/opt/bin/gdb)
diff --git a/gcc/testsuite/gm2/pim/pass/longint.mod b/gcc/testsuite/gm2/pim/pass/longint.mod
new file mode 100644
index 00000000000..4b10b21c536
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longint.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE longint ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM FpuIO IMPORT WriteLongInt ;
+
+VAR
+   l: LONGINT ;
+BEGIN
+   l := 123; (* 456789012 ; *)
+   WriteString('value = ') ; WriteLongInt(l, 20) ; WriteLn
+END longint.
diff --git a/gcc/testsuite/gm2/pim/pass/longint2.mod b/gcc/testsuite/gm2/pim/pass/longint2.mod
new file mode 100644
index 00000000000..5b8f1fee359
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longint2.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE longint2 ;
+
+VAR
+   l: LONGINT ;
+BEGIN
+   IF l DIV 2=0
+   THEN
+   END
+END longint2.
diff --git a/gcc/testsuite/gm2/pim/pass/longmm.mod b/gcc/testsuite/gm2/pim/pass/longmm.mod
new file mode 100644
index 00000000000..aaf756e6a5e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longmm.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE longmm ;
+
+FROM FpuIO IMPORT WriteLongInt ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+CONST
+   MinLongInt = MIN(LONGINT) ;
+   MaxLongInt = MAX(LONGINT) ;
+   MinLongCard = MIN(LONGCARD) ;
+   MaxLongCard = MAX(LONGCARD) ;
+
+VAR
+   i: LONGINT ;
+BEGIN
+   WriteString('MinLongInt = ') ; WriteLongInt(MinLongInt, 20) ; WriteLn ;
+   WriteString('MaxLongInt = ') ; WriteLongInt(MaxLongInt, 20) ; WriteLn ;
+END longmm.
diff --git a/gcc/testsuite/gm2/pim/pass/longreal.mod b/gcc/testsuite/gm2/pim/pass/longreal.mod
new file mode 100644
index 00000000000..b8077772a72
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longreal.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE longreal ;
+
+
+PROCEDURE foo (a: LONGREAL) ;
+BEGIN
+END foo ;
+
+BEGIN
+   foo(1.0)
+END longreal.
diff --git a/gcc/testsuite/gm2/pim/pass/longtypes.mod b/gcc/testsuite/gm2/pim/pass/longtypes.mod
new file mode 100644
index 00000000000..a188dfa94e9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longtypes.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes ;
+
+
+VAR
+   r : REAL ;
+   lr: LONGREAL ;
+   c : CARDINAL ;
+   lc: LONGCARD ;
+   i : INTEGER ;
+   li: LONGINT ;
+BEGIN
+   r := 1.0 ;
+   lr := r ;
+   i := 1 ;
+   li := i ;
+   c := 1 ;
+   lc := c
+END longtypes.
diff --git a/gcc/testsuite/gm2/pim/pass/longtypes3.mod b/gcc/testsuite/gm2/pim/pass/longtypes3.mod
new file mode 100644
index 00000000000..d0565b71bba
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longtypes3.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes3 ;
+
+FROM FpuIO IMPORT WriteLongInt ;
+FROM StrIO IMPORT WriteLn ;
+
+BEGIN
+   WriteLongInt(100+200+300, 10) ; WriteLn
+END longtypes3.
diff --git a/gcc/testsuite/gm2/pim/pass/longtypes4.mod b/gcc/testsuite/gm2/pim/pass/longtypes4.mod
new file mode 100644
index 00000000000..48de4f5d453
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longtypes4.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes4 ;
+
+FROM FpuIO IMPORT WriteLongReal ;
+FROM StrIO IMPORT WriteLn ;
+
+BEGIN
+   WriteLongReal(100.0+200.0+300.0, 10, 3) ; WriteLn
+END longtypes4.
diff --git a/gcc/testsuite/gm2/pim/pass/longtypes5.mod b/gcc/testsuite/gm2/pim/pass/longtypes5.mod
new file mode 100644
index 00000000000..9f3f3e6e32c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longtypes5.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes5 ;
+
+FROM RealInOut IMPORT WriteReal ;
+FROM StrIO IMPORT WriteLn ;
+
+BEGIN
+   WriteReal(100.0+200.0+300.0, 10) ; WriteLn
+END longtypes5.
diff --git a/gcc/testsuite/gm2/pim/pass/longtypes6.mod b/gcc/testsuite/gm2/pim/pass/longtypes6.mod
new file mode 100644
index 00000000000..5302d2b1e1b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/longtypes6.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes6 ;
+
+FROM RealInOut IMPORT WriteReal ;
+FROM StrIO IMPORT WriteLn ;
+
+BEGIN
+   WriteReal(100.0+200.0+300.0, 10) ; WriteLn
+END longtypes6.
diff --git a/gcc/testsuite/gm2/pim/pass/loopexit.mod b/gcc/testsuite/gm2/pim/pass/loopexit.mod
new file mode 100644
index 00000000000..975c81a4b57
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/loopexit.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE loopexit;
+
+VAR a,b,c,d,e : BOOLEAN;
+    i : CARDINAL;
+BEGIN
+  LOOP
+    IF b THEN
+      EXIT;
+    ELSE
+      IF c THEN
+        EXIT;
+      ELSE
+        d := e;
+      END;
+    END;
+    EXIT;
+  END
+END loopexit.
diff --git a/gcc/testsuite/gm2/pim/pass/math.mod b/gcc/testsuite/gm2/pim/pass/math.mod
new file mode 100644
index 00000000000..4d131ce3559
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/math.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE math ;
+
+IMPORT Builtins ;
+
+PROCEDURE sin (x: REAL) : REAL ;
+BEGIN
+   RETURN Builtins.sin(x)
+END sin ;
+
+END math.
diff --git a/gcc/testsuite/gm2/pim/pass/maxlongint.mod b/gcc/testsuite/gm2/pim/pass/maxlongint.mod
new file mode 100644
index 00000000000..711253bbcbd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/maxlongint.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE maxlongint ;
+
+(*
+   LongMin - returns the smallest LONGCARD
+*)
+
+PROCEDURE LongMin (a, b: LONGCARD) : LONGCARD ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END LongMin ;
+
+
+VAR
+   c: LONGCARD ;
+   i: LONGINT ;
+BEGIN
+   i := -VAL(LONGINT, LongMin(VAL(LONGCARD, MAX(LONGINT))+1, c))
+END maxlongint.
diff --git a/gcc/testsuite/gm2/pim/pass/maxreal.mod b/gcc/testsuite/gm2/pim/pass/maxreal.mod
new file mode 100644
index 00000000000..6e812ad3e0d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/maxreal.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE maxreal ;
+
+CONST
+   foo = MAX(REAL) ;
+
+VAR
+   r: REAL ;
+BEGIN
+   r := foo
+END maxreal.
diff --git a/gcc/testsuite/gm2/pim/pass/maxreal2.mod b/gcc/testsuite/gm2/pim/pass/maxreal2.mod
new file mode 100644
index 00000000000..ac9d6e0ebba
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/maxreal2.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE maxreal2 ;
+
+VAR
+   lr: LONGREAL ;
+   r : REAL ;
+BEGIN
+   r  := MAX(REAL) ;
+   lr := VAL(LONGREAL, r) ;
+   lr := VAL(LONGREAL, MAX(REAL))
+END maxreal2.
diff --git a/gcc/testsuite/gm2/pim/pass/minmaxconst.mod b/gcc/testsuite/gm2/pim/pass/minmaxconst.mod
new file mode 100644
index 00000000000..e7d7059407d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/minmaxconst.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE minmaxconst;
+
+CONST
+    I = MIN(CARDINAL) ;
+    J = MAX(CARDINAL) ;
+
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   a := I ;
+   b := J
+END minmaxconst.
diff --git a/gcc/testsuite/gm2/pim/pass/minmaxconst2.mod b/gcc/testsuite/gm2/pim/pass/minmaxconst2.mod
new file mode 100644
index 00000000000..15d50050a69
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/minmaxconst2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE minmaxconst2 ;
+
+VAR
+   i: LONGINT ;
+   j: LONGCARD ;
+BEGIN
+   i := 0 ;
+   IF i=MIN(LONGINT)
+   THEN
+   END ;
+   j := 0 ;
+   IF j=MAX(LONGCARD)
+   THEN
+   END
+END minmaxconst2.
diff --git a/gcc/testsuite/gm2/pim/pass/modaddr.mod b/gcc/testsuite/gm2/pim/pass/modaddr.mod
new file mode 100644
index 00000000000..13ecc0ca5e4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/modaddr.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE modaddr ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+VAR
+   a, b, c: ADDRESS ;
+BEGIN
+   a := b MOD c
+END modaddr.
diff --git a/gcc/testsuite/gm2/pim/pass/multaddr.mod b/gcc/testsuite/gm2/pim/pass/multaddr.mod
new file mode 100644
index 00000000000..21eca1e1762
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/multaddr.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE multaddr ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+VAR
+   a, b, c: ADDRESS ;
+BEGIN
+   a := b * c
+END multaddr.
diff --git a/gcc/testsuite/gm2/pim/pass/multiple.mod b/gcc/testsuite/gm2/pim/pass/multiple.mod
new file mode 100644
index 00000000000..c319a29e6bd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/multiple.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE multiple ;
+
+
+FROM SYSTEM IMPORT ADR, ADDRESS, TSIZE, SIZE ;
+
+PROCEDURE one (VAR ch: CHAR) ;
+BEGIN
+END one ;
+
+
+PROCEDURE two (i: INTEGER) ;
+BEGIN
+END two ;
+
+PROCEDURE three (VAR c: CARDINAL) ;
+BEGIN
+END three ;
+
+VAR
+   a: CHAR ;
+   b: INTEGER ;
+   c: CARDINAL ;
+   d: ADDRESS ;
+   e: CARDINAL ;
+   f: RECORD
+         one, two, three, four, five: CARDINAL ;
+      END ;
+BEGIN
+   one(a) ;
+   two(b) ;
+   three(c) ;
+   d := ADR(c) ;
+   c := TSIZE(CARDINAL) ;
+   e := SIZE(e)
+END multiple.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/pass/multiset.mod b/gcc/testsuite/gm2/pim/pass/multiset.mod
new file mode 100644
index 00000000000..93839cdd3d4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/multiset.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE multiset ;
+
+TYPE
+   small = SET OF [0..31] ;
+   large = RECORD
+              e: ARRAY [0..7] OF small
+           END ;
+
+VAR
+   l: large ;
+   s: small ;
+BEGIN
+   s := small{1, 3, 5, 7, 9} ;
+   l.e[0] := s ;
+   l.e[1] := s ;
+   l.e[2] := small{0, 2, 4} ;
+   l.e[3] := s ;
+   l.e[4] := s ;
+   l.e[5] := small{6, 8, 10} ;
+   l.e[6] := s ;
+   l.e[7] := s
+END multiset.
diff --git a/gcc/testsuite/gm2/pim/pass/multtypes.mod b/gcc/testsuite/gm2/pim/pass/multtypes.mod
new file mode 100644
index 00000000000..d46eba8d8e9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/multtypes.mod
@@ -0,0 +1,68 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE multtypes ;
+
+
+CONST
+   MaxNoOfRooms           = 350 ;  (* An upper limit *)
+   WallsPerRoom           =   8 ;  (* An upper limit *)
+   DoorsPerRoom           =   6 ;  (* An upper limit *)
+   MaxNoOfTreasures       =  15 ;  (* An upper limit *)
+
+TYPE
+   Line         = RECORD
+                     X1 : CARDINAL ;
+                     Y1 : CARDINAL ;
+                     X2 : CARDINAL ;
+                     Y2 : CARDINAL
+                  END ;
+
+   DoorStatus   = (Open, Closed, Secret) ;
+
+   Door         = RECORD
+                     Position    : Line ;
+                     StateOfDoor : DoorStatus ;
+                     LeadsTo     : CARDINAL
+                  END ;
+
+   TreasureInfo = RECORD
+                     Xpos         : CARDINAL ;
+                     Ypos         : CARDINAL ;
+                     Rm           : CARDINAL ;
+                     Tweight      : CARDINAL ;
+                     TreasureName : ARRAY [0..12] OF CHAR
+                  END ;
+
+   Room         = RECORD
+                     RoomNo      : CARDINAL ;
+                     NoOfWalls   : CARDINAL ;
+                     NoOfDoors   : CARDINAL ;
+                     Walls       : ARRAY [1..WallsPerRoom] OF Line ;
+                     Doors       : ARRAY [1..DoorsPerRoom] OF Door ;
+                     (* Treasures   : BITSET ; *)
+                  END ;
+
+
+
+VAR
+   NoOfRooms       : CARDINAL ;
+   Treasure        : ARRAY [1..MaxNoOfTreasures] OF TreasureInfo ;
+   Rooms           : ARRAY [1..MaxNoOfRooms] OF Room ;
+
+BEGIN
+END multtypes.
diff --git a/gcc/testsuite/gm2/pim/pass/mydef.def b/gcc/testsuite/gm2/pim/pass/mydef.def
new file mode 100644
index 00000000000..e98683095a3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/mydef.def
@@ -0,0 +1,24 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+DEFINITION MODULE mydef ;
+
+TYPE
+   BIT32 = BITSET ;
+
+
+END mydef.
diff --git a/gcc/testsuite/gm2/pim/pass/negatives.def b/gcc/testsuite/gm2/pim/pass/negatives.def
new file mode 100644
index 00000000000..532f148deda
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/negatives.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2015 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.  *)
+
+DEFINITION MODULE negatives ;  (*!m2pim*)
+
+
+PROCEDURE CardToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+
+
+END negatives.
diff --git a/gcc/testsuite/gm2/pim/pass/negatives.mod b/gcc/testsuite/gm2/pim/pass/negatives.mod
new file mode 100644
index 00000000000..b9f2828b4d4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/negatives.mod
@@ -0,0 +1,61 @@
+(* Copyright (C) 2015 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.  *)
+
+IMPLEMENTATION MODULE negatives ;   (*!m2pim*)
+
+CONST
+   MaxDigits = 50 ;
+   nul = 0C ;
+
+
+PROCEDURE CardToStr (x, n: CARDINAL ; VAR a: ARRAY OF CHAR) ;
+VAR
+   i, j,
+   Higha : CARDINAL ;
+   buf   : ARRAY [1..MaxDigits] OF CARDINAL ;
+BEGIN
+   i := 0 ;
+   REPEAT
+      INC(i) ;
+      IF i>MaxDigits
+      THEN
+         HALT
+      END ;
+      buf[i] := x MOD 10 ;
+      x := x DIV 10 ;
+   UNTIL x=0 ;
+   j := 0 ;
+   Higha := HIGH(a) ;
+   WHILE (n>i) AND (j<=Higha) DO
+      a[j] := ' ' ;
+      INC(j) ;
+      DEC(n)
+   END ;
+   WHILE (i>0) AND (j<=Higha) DO
+      a[j] := CHR( buf[i] + ORD('0') ) ;
+      INC(j) ;
+      DEC(i)
+   END ;
+   IF j<=Higha
+   THEN
+      a[j] := nul
+   END
+END CardToStr ;
+
+
+END negatives.
diff --git a/gcc/testsuite/gm2/pim/pass/nested.mod b/gcc/testsuite/gm2/pim/pass/nested.mod
new file mode 100644
index 00000000000..8912ebd7456
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nested.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+                 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016
+   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 2, 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. *)
+
+MODULE nested ;
+
+
+PROCEDURE outer (o1, o2, o3: CARDINAL) : CARDINAL ;
+   PROCEDURE inner (i1, i2: CARDINAL) : CARDINAL ;
+   BEGIN
+      RETURN( i1+i2+o3 )
+   END inner ;
+
+BEGIN
+   RETURN( inner(o1, o2) )
+END outer ;
+
+VAR
+   g: CARDINAL ;
+BEGIN
+   g := outer(1, 2, 3)
+END nested.
diff --git a/gcc/testsuite/gm2/pim/pass/nested2.mod b/gcc/testsuite/gm2/pim/pass/nested2.mod
new file mode 100644
index 00000000000..fb2ff1e26a8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nested2.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nested2 ;
+
+PROCEDURE foo (a, b: CARDINAL) ;
+   CONST
+      add = 1 + 2 ;
+   TYPE
+      this = ARRAY [0..add] OF CHAR ;
+
+   PROCEDURE bar (x, y: this) ;
+   BEGIN
+   END bar ;
+BEGIN
+   a := add
+END foo ;
+
+BEGIN
+   foo(1, 2)
+END nested2.
diff --git a/gcc/testsuite/gm2/pim/pass/nested3.mod b/gcc/testsuite/gm2/pim/pass/nested3.mod
new file mode 100644
index 00000000000..c57a167a025
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nested3.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nested3 ;
+
+
+PROCEDURE proc1 (val: INTEGER) ;
+BEGIN
+END proc1 ;
+
+
+PROCEDURE proc2 ;
+
+   MODULE mod1;
+   EXPORT val ;
+   VAR
+       val: REAL ;
+   BEGIN
+   END mod1 ;
+
+BEGIN
+   val := 1.5
+END proc2 ;
+
+
+BEGIN
+   (* val := 9.9 *)
+END nested3.
+
diff --git a/gcc/testsuite/gm2/pim/pass/nested4.mod b/gcc/testsuite/gm2/pim/pass/nested4.mod
new file mode 100644
index 00000000000..475879b5975
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nested4.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nested4 ;
+
+
+PROCEDURE proc1 (val: INTEGER) ;
+BEGIN
+END proc1 ;
+
+
+PROCEDURE proc2 ;
+
+   MODULE mod2 ;
+   EXPORT val ;
+
+      MODULE mod1;
+      EXPORT val ;
+      VAR
+          val: REAL ;
+      BEGIN
+      END mod1 ;
+
+   BEGIN
+   END mod2 ;
+
+BEGIN
+   val := 1.5
+END proc2 ;
+
+
+BEGIN
+   (* val := 9.9 *)
+END nested4.
+
diff --git a/gcc/testsuite/gm2/pim/pass/nested5.mod b/gcc/testsuite/gm2/pim/pass/nested5.mod
new file mode 100644
index 00000000000..851ee174795
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nested5.mod
@@ -0,0 +1,52 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nested5 ;
+
+PROCEDURE proc1 (val: INTEGER) ;
+BEGIN
+END proc1 ;
+
+PROCEDURE proc2 ;
+
+   MODULE mod3 ;
+   IMPORT val ;
+   BEGIN
+      val := 1.8
+   END mod3 ;
+
+   MODULE mod2 ;
+   EXPORT val ;
+
+      MODULE mod1;
+      EXPORT val ;
+      VAR
+          val: REAL ;
+      BEGIN
+      END mod1 ;
+
+   BEGIN
+   END mod2 ;
+
+BEGIN
+   val := 1.5
+END proc2 ;
+
+
+BEGIN
+END nested5.
+
diff --git a/gcc/testsuite/gm2/pim/pass/nested6.mod b/gcc/testsuite/gm2/pim/pass/nested6.mod
new file mode 100644
index 00000000000..95615a727ef
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nested6.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nested6 ;
+
+   PROCEDURE proc1 ;
+      MODULE mod1 ;
+      FROM Storage IMPORT ALLOCATE ;
+      VAR
+         p: POINTER TO CARDINAL ;
+      BEGIN
+         NEW(p)
+      END mod1 ;
+   BEGIN
+   END proc1 ;
+
+BEGIN
+END nested6.
diff --git a/gcc/testsuite/gm2/pim/pass/nested7.mod b/gcc/testsuite/gm2/pim/pass/nested7.mod
new file mode 100644
index 00000000000..f663f4f3a8d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nested7.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE nested7 ;   (*!m2pim*)
+
+TYPE
+   soc = SET OF CHAR ;
+
+   PROCEDURE outer ;
+
+      MODULE inner ;
+      IMPORT soc ;
+      EXPORT ident, foo ;
+      VAR
+         ident: ARRAY [0..7] OF CHAR ;
+
+         PROCEDURE foo (VAR a: soc) ;
+         BEGIN
+         END foo ;
+      BEGIN
+         ident[0] := 'b'
+      END inner ;
+   BEGIN
+      foo (s) ;
+      ident[0] := 'a'
+   END outer ;
+
+VAR
+   s: soc ;
+BEGIN
+   outer
+END nested7.
diff --git a/gcc/testsuite/gm2/pim/pass/nestedfor.mod b/gcc/testsuite/gm2/pim/pass/nestedfor.mod
new file mode 100644
index 00000000000..bafc0d86a0a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nestedfor.mod
@@ -0,0 +1,71 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE nestedfor ;
+
+FROM SYSTEM IMPORT INTEGER32 ;
+
+VAR
+   a: ARRAY [1..9] OF INTEGER32 ;
+
+
+PROCEDURE one (q: INTEGER32) ;
+   PROCEDURE two (p: INTEGER32) ;
+   VAR
+      i: INTEGER32 ;
+   BEGIN
+      FOR i := 1 TO p-1 DO
+         INC(s, a[i])
+      END
+   END two ;
+VAR
+   j: INTEGER32 ;
+BEGIN
+   RETURN ;
+   FOR j := 1 TO q-1 DO
+      INC(s, a[j])
+   END ;
+   two(q)
+END one ;
+
+PROCEDURE three (q: INTEGER32) ;
+   PROCEDURE four (p: INTEGER32) ;
+   VAR
+      i: INTEGER32 ;
+   BEGIN
+      FOR i := 1 TO p-1 DO
+         INC(s, a[i])
+      END
+   END four ;
+VAR
+   j: INTEGER32 ;
+BEGIN
+   RETURN ;
+   FOR j := 1 TO q-1 DO
+      INC(s, a[j])
+   END ;
+   four(q)
+END three ;
+
+VAR
+   s: INTEGER32 ;
+BEGIN
+   s := 0 ;
+   one(1) ;
+   three(1)
+END nestedfor.
diff --git a/gcc/testsuite/gm2/pim/pass/nestedif.mod b/gcc/testsuite/gm2/pim/pass/nestedif.mod
new file mode 100644
index 00000000000..6616f6b4ff2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nestedif.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE nestedif ;
+
+PROCEDURE outer ;
+   PROCEDURE inner ;
+   VAR
+      x, y: CARDINAL ;
+   BEGIN
+      x := 1 ;
+      y := 2 ;
+      IF x=y
+      THEN
+         HALT
+      END
+   END inner ;
+
+BEGIN
+   inner
+END outer ;
+
+BEGIN
+   outer
+END nestedif.
diff --git a/gcc/testsuite/gm2/pim/pass/nestedset.mod b/gcc/testsuite/gm2/pim/pass/nestedset.mod
new file mode 100644
index 00000000000..c146d1e78c4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/nestedset.mod
@@ -0,0 +1,22 @@
+MODULE nestedset ;
+
+TYPE
+   someset = SET OF [0..15] ;
+
+PROCEDURE a (s : someset) ;
+BEGIN
+END a ;
+
+PROCEDURE b (s : someset) ;
+
+   PROCEDURE c ;
+   BEGIN
+      a(s);
+   END c ;
+
+BEGIN
+END b;
+
+BEGIN
+END nestedset.
+
diff --git a/gcc/testsuite/gm2/pim/pass/onezero.mod b/gcc/testsuite/gm2/pim/pass/onezero.mod
new file mode 100644
index 00000000000..799251a792e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/onezero.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE onezero ;
+
+FROM ASCII IMPORT cr ;
+
+PROCEDURE first (i: INTEGER) : INTEGER ;
+VAR
+   j: CARDINAL ;
+BEGIN
+   i := 1+1 ;
+   RETURN( i )
+END first ;
+
+
+BEGIN
+   IF first(0)#2
+   THEN
+      HALT
+   END
+END onezero.
diff --git a/gcc/testsuite/gm2/pim/pass/opaque.def b/gcc/testsuite/gm2/pim/pass/opaque.def
new file mode 100644
index 00000000000..01bc5cddc41
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/opaque.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE opaque ;
+
+EXPORT QUALIFIED String ;
+
+TYPE
+   String ;
+
+END opaque.
diff --git a/gcc/testsuite/gm2/pim/pass/opaque.mod b/gcc/testsuite/gm2/pim/pass/opaque.mod
new file mode 100644
index 00000000000..ac631367fd7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/opaque.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE opaque ;
+
+CONST
+   MaxBuf   = 127 ;
+
+TYPE
+   Contents = RECORD
+                 buf : ARRAY [0..MaxBuf-1] OF CHAR ;
+                 len : CARDINAL ;
+                 next: String ;
+              END ;
+
+   Descriptor = POINTER TO descriptor ;   (* forward declaration necessary for p2c *)
+
+   String = POINTER TO RECORD
+                          contents: Contents ;
+                          head    : Descriptor ;
+                       END ;
+
+   descriptor =            RECORD
+                              charStarUsed : BOOLEAN ;     (* can we garbage collect this? *)
+                              charStarSize : CARDINAL ;
+                              charStarValid: BOOLEAN ;
+                              state        : (inuse, marked, onlist, poisoned) ;
+                              garbage      : String ;      (* temporary strings to be destroyed
+                                                              once this string is killed *)
+                           END ;
+
+
+END opaque.
diff --git a/gcc/testsuite/gm2/pim/pass/opaque2.mod b/gcc/testsuite/gm2/pim/pass/opaque2.mod
new file mode 100644
index 00000000000..f8552f3cc47
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/opaque2.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE opaque2 ;
+
+
+FROM SYSTEM IMPORT ADDRESS ;
+FROM opaque IMPORT String ;
+
+
+PROCEDURE foo (a: ADDRESS) ;
+BEGIN
+   (* nothing *)
+END foo ;
+
+
+VAR
+   s: String ;
+   a: ADDRESS ;
+BEGIN
+   s := NIL ;
+   s := a ;
+   foo(a)
+END opaque2.
diff --git a/gcc/testsuite/gm2/pim/pass/opaquetype.def b/gcc/testsuite/gm2/pim/pass/opaquetype.def
new file mode 100644
index 00000000000..4048bec598e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/opaquetype.def
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE opaquetype ;
+
+(*
+    Title      : opaquetype
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu Oct 23 11:00:12 2003
+    Revision   : $Version$ 
+    Description: simple type compatability test for opaques.
+*)
+
+EXPORT QUALIFIED foo, bar;
+
+TYPE
+    foo ;
+    bar ;
+
+
+END opaquetype.
diff --git a/gcc/testsuite/gm2/pim/pass/opaquetype.mod b/gcc/testsuite/gm2/pim/pass/opaquetype.mod
new file mode 100644
index 00000000000..f2d51370623
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/opaquetype.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE opaquetype ;
+
+TYPE
+   foo = POINTER TO REAL ;
+   bar = POINTER TO INTEGER ;
+
+
+END opaquetype.
diff --git a/gcc/testsuite/gm2/pim/pass/param.mod b/gcc/testsuite/gm2/pim/pass/param.mod
new file mode 100644
index 00000000000..983a8b8e1e6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/param.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE param ;
+
+TYPE
+   record = RECORD
+               a, b, c, d: CHAR ;
+               e         : BITSET ;
+            END ;
+
+PROCEDURE foo (fd: CARDINAL; p: record) ;
+BEGIN
+END foo ;
+
+VAR
+   r: record ;
+BEGIN
+   foo(1, r)
+END param.
diff --git a/gcc/testsuite/gm2/pim/pass/param2.mod b/gcc/testsuite/gm2/pim/pass/param2.mod
new file mode 100644
index 00000000000..0cb3c912173
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/param2.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE param2 ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM Builtins IMPORT alloca, memcpy ;
+
+TYPE
+   ub = RECORD
+           a: ADDRESS ;
+           h: CARDINAL ;
+        END ;
+
+PROCEDURE func (u: ub) ;
+VAR
+   p: ADDRESS ;
+   l: CARDINAL ;
+BEGIN
+   p := alloca(u.h) ;
+   p := memcpy(u.a, p, u.h) ;
+   u.a := p
+END func ;
+
+BEGIN
+END param2.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/pass/param3.mod b/gcc/testsuite/gm2/pim/pass/param3.mod
new file mode 100644
index 00000000000..973d22546fb
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/param3.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE param3 ;   (*!m2pim*)
+
+TYPE
+   symbol = bar ;
+   bar    = ARRAY [0..20] OF CHAR ;
+
+PROCEDURE get (VAR foo: symbol) ;
+BEGIN
+   foo := "hello"
+END get ;
+
+VAR
+   i: symbol ;
+BEGIN
+   get (i)
+END param3.
diff --git a/gcc/testsuite/gm2/pim/pass/parambool.mod b/gcc/testsuite/gm2/pim/pass/parambool.mod
new file mode 100644
index 00000000000..3bbdb0d5ab4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/parambool.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE parambool ;
+
+FROM libc IMPORT exit ;
+
+(*
+   foo - 
+*)
+
+PROCEDURE foo (b: BOOLEAN; i: CARDINAL) ;
+BEGIN
+   IF b AND (i=4)
+   THEN
+      exit(0)
+   END
+END foo ;
+
+
+(*
+   bar - 
+*)
+
+PROCEDURE bar () : CARDINAL ;
+BEGIN
+   RETURN( 4 )
+END bar ;
+
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 3 ;
+   foo(i=3, bar()) ;
+   exit(1)
+END parambool.
diff --git a/gcc/testsuite/gm2/pim/pass/paramreal.mod b/gcc/testsuite/gm2/pim/pass/paramreal.mod
new file mode 100644
index 00000000000..a4b4ff20fae
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/paramreal.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE paramreal ;
+
+FROM StdIO IMPORT Write ;
+FROM StrIO IMPORT WriteLn ;
+
+PROCEDURE test (r: REAL; lr: LONGREAL; li: LONGINT) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   lr := 5.91 ;
+   li := 123456789 ;
+   r  := 3.1415927 ;
+   li := 1 ;
+   WHILE li*10>li DO
+      li := li*10 ;
+      Write('.')
+   END ;
+   WriteLn ;
+   i := 1 ;
+   WHILE i*10>i DO
+      i := i*10 ;
+      Write('.')
+   END ;
+   WriteLn
+END test ;
+
+VAR
+   r: REAL ;
+   lr: LONGREAL ;
+   li: LONGINT ;
+BEGIN
+   lr := 5.123456789 ;
+   li := 987654321 ;
+   r  := 0.123456789 ;
+   test(r, lr, li)
+END paramreal.
diff --git a/gcc/testsuite/gm2/pim/pass/pim-pass.exp b/gcc/testsuite/gm2/pim/pass/pim-pass.exp
new file mode 100644
index 00000000000..79e2c658b4f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/pim-pass.exp
@@ -0,0 +1,38 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_log "${srcdir}/gm2/pim/pass:${gm2src}/gm2-compiler:${gm2src}/gm2-gcc"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/pim/pass/pimimp.mod b/gcc/testsuite/gm2/pim/pass/pimimp.mod
new file mode 100644
index 00000000000..ae1ef015389
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/pimimp.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE pimimp ;
+
+   MODULE M1 ;
+   IMPORT a ;
+   EXPORT w, x ;
+   VAR
+      u, v, w: CARDINAL ;
+
+      MODULE M2 ;
+      IMPORT u ;
+      EXPORT x, y;
+      VAR
+         x, y, z: CARDINAL ;
+      BEGIN
+         x := 11 ;
+         y := 22 ;
+         z := 33 ;
+         u := 44
+      END M2 ;
+
+   BEGIN
+      a := 55 ;
+      u := 66 ;
+      v := 77 ;
+      w := 88 ;
+      x := 99 ;
+      y := 111
+   END M1 ;
+
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   a := 222 ;
+   b := 333 ;
+   w := 444 ;
+   x := 555
+END pimimp.
diff --git a/gcc/testsuite/gm2/pim/pass/pointer.mod b/gcc/testsuite/gm2/pim/pass/pointer.mod
new file mode 100644
index 00000000000..7cd460acd3a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/pointer.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE pointer ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS, TSIZE ;
+
+VAR
+   p: POINTER TO POINTER TO CHAR ;
+   a: ARRAY [0..2] OF POINTER TO CHAR ;
+BEGIN
+   p := ADR(a) ;
+   INC(p, TSIZE(ADDRESS))
+END pointer.
diff --git a/gcc/testsuite/gm2/pim/pass/procadr.mod b/gcc/testsuite/gm2/pim/pass/procadr.mod
new file mode 100644
index 00000000000..9efd3dea53f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procadr.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE procadr ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+
+VAR
+   a: ADDRESS ;
+BEGIN
+   a := ADR(foo) ;
+   IF a=VAL(ADDRESS, foo)
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END procadr.
diff --git a/gcc/testsuite/gm2/pim/pass/procconv.mod b/gcc/testsuite/gm2/pim/pass/procconv.mod
new file mode 100644
index 00000000000..085f6f058bc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procconv.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE procconv ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM libc IMPORT exit ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+
+PROCEDURE GetProcAdr (a: ADDRESS; name: ARRAY OF CHAR) : PROC ;
+VAR
+   p: PROC ;
+BEGIN
+   p := foo ;
+   RETURN( p )
+END GetProcAdr ;
+
+
+TYPE
+   INITPROC = PROCEDURE (INTEGER) ;
+VAR
+   initproc: INITPROC ;
+BEGIN
+   initproc := VAL(INITPROC, GetProcAdr(ADR(foo), 'testing')) ;
+   IF VAL(ADDRESS,initproc)=NIL
+   THEN
+      exit(1)
+   END
+END procconv.
diff --git a/gcc/testsuite/gm2/pim/pass/procconv2.mod b/gcc/testsuite/gm2/pim/pass/procconv2.mod
new file mode 100644
index 00000000000..384e1eb3970
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procconv2.mod
@@ -0,0 +1,47 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE procconv2 ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM libc IMPORT exit ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+
+PROCEDURE GetProcAdr (a: ADDRESS; name: ARRAY OF CHAR) : PROC ;
+VAR
+   p: PROC ;
+BEGIN
+   p := foo ;
+   RETURN( p )
+END GetProcAdr ;
+
+
+TYPE
+   INITPROC = PROCEDURE (INTEGER) ;
+VAR
+   initproc: INITPROC ;
+BEGIN
+   initproc := CONVERT(INITPROC, GetProcAdr(ADR(foo), 'testing')) ;
+   IF CONVERT(ADDRESS,initproc)=NIL
+   THEN
+      exit(1)
+   END
+END procconv2.
diff --git a/gcc/testsuite/gm2/pim/pass/procedure1.mod b/gcc/testsuite/gm2/pim/pass/procedure1.mod
new file mode 100644
index 00000000000..bef9029b6d4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procedure1.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE procedure1 ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+PROCEDURE Storage (VAR a: ADDRESS; size: CARDINAL) ;
+BEGIN
+   a := ADDRESS(123)
+END Storage ;
+
+VAR
+   a: ADDRESS ;
+BEGIN
+   a := ADDRESS(456) ;
+   Storage(a, 100)
+END procedure1.
diff --git a/gcc/testsuite/gm2/pim/pass/procedure2.mod b/gcc/testsuite/gm2/pim/pass/procedure2.mod
new file mode 100644
index 00000000000..d9bfeed0bdd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procedure2.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE procedure2 ;
+
+FROM libc IMPORT malloc, exit ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+PROCEDURE ALLOCATE (VAR a: ADDRESS; size: CARDINAL) ;
+BEGIN
+   a := malloc (size)
+END ALLOCATE ;
+
+
+VAR
+   p: POINTER TO CARDINAL ;
+   e: CARDINAL ;
+BEGIN
+(*
+   NEW(p) ;
+   IF p=NIL
+   THEN
+      e := 1
+   ELSE
+      e := 0
+   END ;
+   exit(e)
+*)
+END procedure2.
diff --git a/gcc/testsuite/gm2/pim/pass/procindirect.mod b/gcc/testsuite/gm2/pim/pass/procindirect.mod
new file mode 100644
index 00000000000..b5fc6f01d8f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procindirect.mod
@@ -0,0 +1,59 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE procindirect ;
+
+
+FROM libc IMPORT exit ;
+TYPE
+   sec = PROCEDURE (CARDINAL) : CHAR ;
+
+PROCEDURE first ;
+BEGIN
+END first ;
+
+PROCEDURE second (c: CARDINAL) : CHAR ;
+BEGIN
+   RETURN( 'a' )
+END second ;
+
+PROCEDURE fetch () : CARDINAL ;
+BEGIN
+   RETURN( 2 )
+END fetch ;
+
+VAR
+   f: PROC ;
+   s: sec ;
+   b: CARDINAL ;
+   array: ARRAY [1..10] OF sec ;
+   i: CARDINAL ;
+BEGIN
+   f := first ;
+   f ;
+   s := second ;
+   IF s(b)#'a'
+   THEN
+      exit(1)
+   END ;
+   i := fetch() ;
+   array[i] := second ;
+   i := fetch() ;
+   IF array[i](b)#'a'
+   THEN
+      exit(1)
+   END
+END procindirect.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod.mod b/gcc/testsuite/gm2/pim/pass/procmod.mod
new file mode 100644
index 00000000000..72424fda310
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE procmod ;
+
+FROM StdIO IMPORT Write ;
+
+PROCEDURE proc ;
+
+   MODULE mod ;
+   IMPORT Write ;
+   BEGIN
+      Write('b')
+   END mod ;
+
+BEGIN
+   Write('c')
+END proc ;
+
+BEGIN
+   Write('a') ;
+   proc
+END procmod.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod2.mod b/gcc/testsuite/gm2/pim/pass/procmod2.mod
new file mode 100644
index 00000000000..695d21e6710
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod2 ;
+
+PROCEDURE foo ;
+    MODULE bar ;
+    EXPORT max, min ;
+
+    CONST
+       max = 10+1 ;
+       min =  1 ;
+    END bar ;
+TYPE
+   subr = [min..max] ;
+VAR
+   s: subr ;
+BEGIN
+END foo ;
+
+BEGIN
+END procmod2.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod3.mod b/gcc/testsuite/gm2/pim/pass/procmod3.mod
new file mode 100644
index 00000000000..64740921b8a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod3.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod3 ;
+
+
+PROCEDURE bar ;
+VAR
+   variable: CARDINAL ;
+
+   PROCEDURE error ;
+   BEGIN
+   END error ;
+
+   MODULE foo ;
+   IMPORT error, variable ;
+
+(*
+   PROCEDURE try ;
+   BEGIN
+      variable := 99 ;
+      error
+   END try ;
+*)
+
+   VAR
+      x: INTEGER ;
+   BEGIN
+      x := 101 ;
+      variable := 99 ;
+      error
+   END foo ;
+
+
+BEGIN
+END bar ;
+
+BEGIN
+   bar
+END procmod3.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod31.mod b/gcc/testsuite/gm2/pim/pass/procmod31.mod
new file mode 100644
index 00000000000..769e77623a1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod31.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod31 ;
+
+
+PROCEDURE bar ;
+VAR
+   variable: CARDINAL ;
+
+   PROCEDURE error ;
+   BEGIN
+   END error ;
+
+   PROCEDURE try ;
+   BEGIN
+      variable := 99 ;
+      error
+   END try ;
+
+BEGIN
+END bar ;
+
+BEGIN
+   bar
+END procmod31.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod4.mod b/gcc/testsuite/gm2/pim/pass/procmod4.mod
new file mode 100644
index 00000000000..99e381929b1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod4.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod4 ;
+
+PROCEDURE b ;
+   MODULE d ; IMPORT c ; END d;
+   MODULE e ; IMPORT c ; END e;
+   PROCEDURE c ; BEGIN END c ;
+BEGIN
+END b ;
+
+PROCEDURE f ;
+   MODULE g ; IMPORT c ; END g;
+   PROCEDURE c ; BEGIN END c ;
+BEGIN
+END f ;
+
+BEGIN
+END procmod4.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod5.mod b/gcc/testsuite/gm2/pim/pass/procmod5.mod
new file mode 100644
index 00000000000..672f11f68ba
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod5.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod5 ;
+
+PROCEDURE a ;
+   PROCEDURE b ;
+       PROCEDURE c ;
+           MODULE d ; IMPORT e ; BEGIN e END d ;
+       END c;
+   END b ;
+   PROCEDURE e ; VAR e1: CARDINAL ; BEGIN e1 := 11 END e ;
+END a ;
+
+PROCEDURE e ; VAR e1: CARDINAL ; BEGIN e1 := 99 END e ;
+
+BEGIN
+   a
+END procmod5.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod6.def b/gcc/testsuite/gm2/pim/pass/procmod6.def
new file mode 100644
index 00000000000..0d8de9d408b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod6.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE procmod6 ;
+
+EXPORT QUALIFIED foo ;
+
+VAR
+   foo: CARDINAL ;
+
+END procmod6.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod6.mod b/gcc/testsuite/gm2/pim/pass/procmod6.mod
new file mode 100644
index 00000000000..078accdc78f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod6.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE procmod6 ;
+
+PROCEDURE bar ;
+   MODULE inner ;
+   IMPORT foo ;
+   BEGIN
+      foo := 11
+   END inner ;
+VAR
+   foo: CARDINAL ;
+BEGIN
+END bar ;
+
+BEGIN
+   foo := 99
+END procmod6.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod7.mod b/gcc/testsuite/gm2/pim/pass/procmod7.mod
new file mode 100644
index 00000000000..66c02549ab6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod7.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod7 ;
+
+
+PROCEDURE bar ;
+VAR
+   variable: CARDINAL ;
+
+   MODULE foo ;
+   IMPORT variable ;
+
+      PROCEDURE bar ;
+      BEGIN
+         variable := 99
+      END bar ;
+
+   END foo ;
+
+BEGIN
+END bar ;
+
+BEGIN
+   bar
+END procmod7.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod8.mod b/gcc/testsuite/gm2/pim/pass/procmod8.mod
new file mode 100644
index 00000000000..5ec75e0388e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod8.mod
@@ -0,0 +1,63 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod8 ;
+
+VAR
+   x: INTEGER ;
+
+PROCEDURE aaa ;
+   MODULE yyy ;
+   IMPORT x ;
+      PROCEDURE zzz ;
+      BEGIN
+         x := 111
+      END zzz ;
+   END yyy ;
+
+   MODULE qqq ;
+   IMPORT x ;
+      PROCEDURE rrr ;
+
+         PROCEDURE ttt ;
+         BEGIN
+            x := 222
+         END ttt ;
+
+      BEGIN
+         x := 333
+      END rrr ;
+   END qqq ;
+
+BEGIN
+END aaa ;
+
+
+PROCEDURE bbb ;
+   MODULE ccc ;
+   IMPORT x ;
+      PROCEDURE ddd ;
+      BEGIN
+         x := 444
+      END ddd ;
+   END ccc ;
+BEGIN
+END bbb ;
+
+
+BEGIN
+END procmod8.
diff --git a/gcc/testsuite/gm2/pim/pass/procmod9.mod b/gcc/testsuite/gm2/pim/pass/procmod9.mod
new file mode 100644
index 00000000000..ec6e5fc542d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/procmod9.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE procmod9 ;
+
+   PROCEDURE ParseFunction ;
+
+      MODULE Lex;
+	 EXPORT val ;
+
+	 VAR
+	    val: REAL;
+
+      BEGIN
+      END Lex;
+
+      PROCEDURE Expression ;
+	 PROCEDURE SimpleExpression ;
+	    PROCEDURE Term ;
+
+	       PROCEDURE Factor ;
+	       BEGIN
+                  IF val=0.0
+                  THEN
+                  END
+	       END Factor;
+
+	    BEGIN
+	    END Term;
+
+	 BEGIN
+	 END SimpleExpression;
+
+      BEGIN
+      END Expression;
+
+   BEGIN
+   END ParseFunction;
+
+END procmod9.
diff --git a/gcc/testsuite/gm2/pim/pass/proctype.mod b/gcc/testsuite/gm2/pim/pass/proctype.mod
new file mode 100644
index 00000000000..e2a1b8a55f7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/proctype.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE proctype ;
+
+TYPE
+   Proc = PROCEDURE (CARDINAL) ;
+
+VAR
+   p: Proc ;
+BEGIN
+
+END proctype.
diff --git a/gcc/testsuite/gm2/pim/pass/proctype2.def b/gcc/testsuite/gm2/pim/pass/proctype2.def
new file mode 100644
index 00000000000..5d1cd035ee3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/proctype2.def
@@ -0,0 +1,37 @@
+(* Copyright (C) 2015 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.  *)
+
+DEFINITION MODULE proctype2 ;
+
+(*
+    Title      : proctype2
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon May 16 23:34:41 2016
+    Revision   : $Version$
+    Description: simple proctype test.
+*)
+
+TYPE
+   foo = PROCEDURE (CARDINAL) : foo ;
+
+VAR
+   v: foo ;
+
+
+END proctype2.
diff --git a/gcc/testsuite/gm2/pim/pass/proctype3.mod b/gcc/testsuite/gm2/pim/pass/proctype3.mod
new file mode 100644
index 00000000000..f73970694f0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/proctype3.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2017 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 2, 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. *)
+
+MODULE proctype3 ;
+
+TYPE
+   Proc = PROCEDURE (Proc, CARDINAL) ;
+
+VAR
+   p: Proc ;
+BEGIN
+
+END proctype3.
diff --git a/gcc/testsuite/gm2/pim/pass/proctype4.mod b/gcc/testsuite/gm2/pim/pass/proctype4.mod
new file mode 100644
index 00000000000..cc610eb775f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/proctype4.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2017 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 2, 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. *)
+
+MODULE proctype4 ;
+
+TYPE
+   Proc1 = PROCEDURE (CARDINAL) ;
+   Proc2 = PROCEDURE (Proc2, CARDINAL) ;
+
+VAR
+   p1: Proc1 ;
+   p2: Proc2 ;
+BEGIN
+
+END proctype4.
diff --git a/gcc/testsuite/gm2/pim/pass/program.mod b/gcc/testsuite/gm2/pim/pass/program.mod
new file mode 100644
index 00000000000..fca32e4aa59
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/program.mod
@@ -0,0 +1,108 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE program ;
+
+
+TYPE
+   tokenset = (eoftok, plustok, minustok, timestok, dividetok,
+becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok,
+rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok,
+singlequotetok, equaltok, hashtok, lesstok, greatertok,
+lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok,
+colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok,
+casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok,
+endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok,
+importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok,
+pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok,
+repeattok, returntok, settok, thentok, totok, typetok, untiltok,
+vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok,
+datetok, linetok, filetok, attributetok, builtintok, integertok,
+identtok, realtok, stringtok) ;
+
+TYPE
+   SetOfStop0 = SET OF [eoftok..begintok] ;
+   SetOfStop1 = SET OF [bytok..thentok] ;
+   SetOfStop2 = SET OF [totok..stringtok] ;
+
+VAR
+   currenttoken: tokenset ;
+
+
+PROCEDURE ProgramModule (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   Expect(moduletok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+(*
+   PushAutoOn  ;
+   Ident(stopset0 + SetOfStop0{semicolontok, lsbratok}, stopset1, stopset2) ;
+   P3StartBuildProgModule  ;
+   PushAutoOff  ;
+   IF currenttoken=lsbratok
+   THEN
+      Priority(stopset0 + SetOfStop0{semicolontok}, stopset1, stopset2) ;
+   END ;
+   Expect(semicolontok, stopset0 + SetOfStop0{begintok}, stopset1 + SetOfStop1{importtok, fromtok, endtok, consttok, proceduretok, moduletok}, stopset2 + SetOfStop2{typetok, vartok}) ;
+   WHILE ((currenttoken>=bytok) AND (currenttoken<totok) AND (currenttoken IN SetOfStop1 {fromtok, importtok})) DO
+      Import(stopset0 + SetOfStop0{begintok}, stopset1 + SetOfStop1{endtok, fromtok, importtok, consttok, moduletok, proceduretok}, stopset2 + SetOfStop2{vartok, typetok}) ;
+   END (* while *) ;
+   StartBuildInit  ;
+   Block(stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+   PushAutoOn  ;
+   Ident(stopset0 + SetOfStop0{periodtok}, stopset1, stopset2) ;
+   EndBuildFile  ;
+   P3EndBuildProgModule  ;
+   Expect(periodtok, stopset0, stopset1, stopset2) ;
+   PopAuto ;
+   EndBuildInit ;
+   PopAuto
+*)
+END ProgramModule ;
+
+
+PROCEDURE PushAutoOn ; BEGIN END PushAutoOn ;
+PROCEDURE PushAutoOff ; BEGIN END PushAutoOff ;
+PROCEDURE PopAuto ; BEGIN END PopAuto ;
+PROCEDURE P3StartBuildProgModule ; BEGIN END P3StartBuildProgModule ;
+PROCEDURE P3EndBuildProgModule ; BEGIN END P3EndBuildProgModule ;
+PROCEDURE StartBuildInit ; BEGIN END StartBuildInit ;
+PROCEDURE EndBuildInit ; BEGIN END EndBuildInit ;
+PROCEDURE EndBuildFile ; BEGIN END EndBuildFile ;
+
+
+PROCEDURE Priority (s0: SetOfStop0; s1: SetOfStop1; s2: SetOfStop2) ;
+BEGIN
+END Priority ;
+
+PROCEDURE Import (s0: SetOfStop0; s1: SetOfStop1; s2: SetOfStop2) ;
+BEGIN
+END Import ;
+
+PROCEDURE Ident (s0: SetOfStop0; s1: SetOfStop1; s2: SetOfStop2) ;
+BEGIN
+END Ident ;
+
+PROCEDURE Expect (t: tokenset; s0: SetOfStop0; s1: SetOfStop1; s2: SetOfStop2) ;
+BEGIN
+END Expect ;
+
+PROCEDURE Block (s0: SetOfStop0; s1: SetOfStop1; s2: SetOfStop2) ;
+BEGIN
+END Block ;
+
+BEGIN
+   ProgramModule(SetOfStop0{}, SetOfStop1{}, SetOfStop2{})
+END program.
diff --git a/gcc/testsuite/gm2/pim/pass/program2.mod b/gcc/testsuite/gm2/pim/pass/program2.mod
new file mode 100644
index 00000000000..63345896c50
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/program2.mod
@@ -0,0 +1,284 @@
+(* it is advisable not to edit this file as it was automatically generated from the grammer file ../../gcc-3.3.1/gcc/gm2/bnf/m2.bnf *)
+
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE program2 ;
+
+FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ;
+FROM M2Error IMPORT WriteFormat0, WriteFormat1, ErrorStringAt ;
+FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto, DisplayStack ;
+FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok, BuiltinTok ;
+FROM NameKey IMPORT Name, NulName ;
+FROM StrLib IMPORT StrCopy, StrConCat, StrEqual ;
+FROM P2SymBuild IMPORT BuildString, BuildNumber ;
+FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatChar ;
+FROM M2Debug IMPORT Assert ;
+FROM M2Printf IMPORT printf0 ;
+
+
+(* imports for Pass1 *)
+FROM M2Quads IMPORT PushT, PopT,
+                    StartBuildInit,
+                    EndBuildInit,
+                    BuildProcedureStart,
+                    BuildProcedureEnd,
+                    BuildAssignment,
+                    BuildInline ;
+
+FROM P1SymBuild IMPORT P1StartBuildProgramModule,
+                       P1EndBuildProgramModule,
+                       P1StartBuildDefinitionModule,
+                       P1EndBuildDefinitionModule,
+                       P1StartBuildImplementationModule,
+                       P1EndBuildImplementationModule,
+                       StartBuildInnerModule,
+                       EndBuildInnerModule,
+
+                       BuildImportOuterModule,
+                       BuildImportInnerModule,
+                       BuildExportOuterModule,
+                       BuildExportInnerModule,
+                       CheckExplicitExported,
+
+                       BuildHiddenType,
+                       BuildNulName,
+
+                       StartBuildEnumeration, EndBuildEnumeration,
+
+                       BuildProcedureHeading,
+                       StartBuildProcedure,
+                       EndBuildProcedure ;
+
+FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm, PutGnuAsmInput,
+                        PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
+                        MakeRegInterface,
+                        PutRegInterface, GetRegInterface,
+                        GetSymName,
+                        NulSym ;
+
+CONST
+   Pass1     = TRUE ;
+
+VAR
+   LastIdent : Name ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+END ErrorString ;
+
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+END ErrorArray ;
+
+
+(*
+   expecting token set defined as an enumerated type
+   (eoftok, plustok, minustok, timestok, dividetok, becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok, repeattok, returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, attributetok, builtintok, integertok, identtok, realtok, stringtok) ;
+*)
+TYPE
+   SetOfStop0 = SET OF [eoftok..begintok] ;
+   SetOfStop1 = SET OF [bytok..thentok] ;
+   SetOfStop2 = SET OF [totok..stringtok] ;
+   
+
+(*
+   DescribeStop - issues a message explaining what tokens were expected
+*)
+
+PROCEDURE DescribeStop (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : String ;
+BEGIN
+   RETURN NIL
+END DescribeStop ;
+
+
+(*
+   DescribeError - issues a message explaining what tokens were expected
+*)
+
+PROCEDURE DescribeError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END DescribeError ;
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END SyntaxError ;
+
+
+(*
+   SyntaxCheck - 
+*)
+
+PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END SyntaxCheck ;
+
+
+(*
+   WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+BEGIN
+END WarnMissingToken ;
+
+
+(*
+   MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+BEGIN
+END MissingToken ;
+
+
+(*
+   CheckAndInsert - 
+*)
+
+PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   RETURN TRUE
+END CheckAndInsert ;
+
+
+(*
+   InStopSet 
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
+BEGIN
+   RETURN TRUE
+END InStopSet ;
+
+
+(*
+   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
+*)
+
+PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END PeepToken ;
+
+
+(*
+   Expect - 
+*)
+
+PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END Expect ;
+
+
+(*
+   CompilationUnit - returns TRUE if the input was correct enough to parse
+                     in future passes.
+*)
+
+PROCEDURE CompilationUnit () : BOOLEAN ;
+BEGIN
+   RETURN TRUE
+END CompilationUnit ;
+
+
+(*
+   Ident - error checking varient of Ident
+*)
+
+PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END Ident ;
+
+
+(*
+   PossiblyExportIdent - error checking varient of Ident which also checks to see if
+                         this ident should be explicitly exported.
+*)
+
+PROCEDURE PossiblyExportIdent (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END PossiblyExportIdent ;
+
+
+PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END string ;
+
+
+PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END Integer ;
+
+
+PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END Real ;
+
+
+PROCEDURE FileUnit (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   IF currenttoken=definitiontok
+   THEN
+   ELSIF ((currenttoken>=bytok) AND (currenttoken<totok) AND (currenttoken IN SetOfStop1 {implementationtok, moduletok}))
+   THEN
+      ImplementationOrProgramModule(stopset0, stopset1, stopset2)
+   ELSE
+   END ;
+END FileUnit ;
+
+
+PROCEDURE ProgramModule (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   WHILE ((currenttoken>=bytok) AND (currenttoken<totok) AND (currenttoken IN SetOfStop1 {fromtok, importtok})) DO
+      Import(stopset0 + SetOfStop0{begintok}, stopset1 + SetOfStop1{endtok, fromtok, importtok, consttok, moduletok, proceduretok}, stopset2 + SetOfStop2{vartok, typetok}) ;
+      BuildImportOuterModule(FALSE)  ;
+   END
+END ProgramModule ;
+
+PROCEDURE Import (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END Import ;
+
+PROCEDURE Block (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END Block ;
+
+PROCEDURE Priority (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END Priority ;
+
+PROCEDURE DefinitionModule (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END DefinitionModule ;
+
+PROCEDURE ImplementationOrProgramModule (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+END ImplementationOrProgramModule ;
+
+END program2.
diff --git a/gcc/testsuite/gm2/pim/pass/ptrarray.mod b/gcc/testsuite/gm2/pim/pass/ptrarray.mod
new file mode 100644
index 00000000000..80bac2b2dcc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/ptrarray.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE ptrarray ;
+
+
+TYPE
+   foo = ARRAY [0..9] OF CHAR ;
+
+VAR
+   s: POINTER TO foo ;
+BEGIN
+   s := NIL ;
+   IF s=NIL
+   THEN
+   END
+END ptrarray.
diff --git a/gcc/testsuite/gm2/pim/pass/ptrarray2.mod b/gcc/testsuite/gm2/pim/pass/ptrarray2.mod
new file mode 100644
index 00000000000..823a49e7f80
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/ptrarray2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE ptrarray2 ;
+
+VAR
+   p: POINTER TO ARRAY [0..9] OF CHAR ;
+BEGIN
+   p := NIL
+END ptrarray2.
diff --git a/gcc/testsuite/gm2/pim/pass/ptrarray3.mod b/gcc/testsuite/gm2/pim/pass/ptrarray3.mod
new file mode 100644
index 00000000000..0a3fd26f5f9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/ptrarray3.mod
@@ -0,0 +1,19 @@
+MODULE ptarray3 ;
+
+TYPE
+  point = ARRAY [0..2] OF REAL;
+
+PROCEDURE CalcPlane(VAR p : ARRAY OF point);
+BEGIN
+END CalcPlane;
+
+PROCEDURE Calling;
+VAR
+   pts: ARRAY [0..3] OF point;
+BEGIN
+  CalcPlane(pts);
+END Calling;
+
+BEGIN
+   Calling
+END ptarray3.
diff --git a/gcc/testsuite/gm2/pim/pass/ptrcard.mod b/gcc/testsuite/gm2/pim/pass/ptrcard.mod
new file mode 100644
index 00000000000..437372b0d2f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/ptrcard.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE ptrcard ;
+
+FROM SYSTEM IMPORT ADR ;
+TYPE
+   ptr = POINTER TO CARDINAL ;
+VAR
+   c: POINTER TO CARDINAL ;
+   p: ptr ;
+   i: CARDINAL ;
+BEGIN
+   c := ADR(i) ;
+   p := ADR(i) ;
+END ptrcard.
diff --git a/gcc/testsuite/gm2/pim/pass/quads.def b/gcc/testsuite/gm2/pim/pass/quads.def
new file mode 100644
index 00000000000..fcdec4924bf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/quads.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE quads ;
+
+EXPORT QUALIFIED head ;
+
+VAR
+   head: CARDINAL ;
+
+END quads.
diff --git a/gcc/testsuite/gm2/pim/pass/quads.mod b/gcc/testsuite/gm2/pim/pass/quads.mod
new file mode 100644
index 00000000000..6155a0ad384
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/quads.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE quads ;
+
+PROCEDURE foo (head: CARDINAL) ;
+BEGIN
+END foo ;
+
+END quads.
diff --git a/gcc/testsuite/gm2/pim/pass/real.mod b/gcc/testsuite/gm2/pim/pass/real.mod
new file mode 100644
index 00000000000..f67ffc3a403
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/real.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE real ;
+
+VAR
+   i: CARDINAL ;
+   r: REAL ;
+BEGIN
+   r := 1.0 ;
+   FOR i := 1 TO 10 DO
+      r := r*1.5
+   END
+END real.
diff --git a/gcc/testsuite/gm2/pim/pass/real2.mod b/gcc/testsuite/gm2/pim/pass/real2.mod
new file mode 100644
index 00000000000..7162d0b435e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/real2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE real2 ;
+
+
+VAR
+   s1, s2, s3: SHORTREAL ;
+BEGIN
+   s1 := 3.14159 ;
+   s2 := 2.0 ;
+   s3 := s1*s2
+END real2.
diff --git a/gcc/testsuite/gm2/pim/pass/real3.mod b/gcc/testsuite/gm2/pim/pass/real3.mod
new file mode 100644
index 00000000000..88f4f43cb75
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/real3.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE real3 ;
+
+
+CONST
+   mir = MIN(REAL) ;
+   mis = MIN(SHORTREAL) ;
+   mil = MIN(LONGREAL) ;
+
+   mar = MAX(REAL) ;
+   mas = MAX(SHORTREAL) ;
+   mal = MAX(LONGREAL) ;
+
+VAR
+   a, b, c, d, e, f: REAL ;
+BEGIN
+   a := mir ;
+   b := mis ;
+   c := mil ;
+   d := mar ;
+   e := mas ;
+   f := mal
+END real3.
diff --git a/gcc/testsuite/gm2/pim/pass/realconst.mod b/gcc/testsuite/gm2/pim/pass/realconst.mod
new file mode 100644
index 00000000000..627eb423f33
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/realconst.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE realconst ;
+
+
+CONST
+   pi = 3.1415927 ;
+
+BEGIN
+
+END realconst.
diff --git a/gcc/testsuite/gm2/pim/pass/realneg.mod b/gcc/testsuite/gm2/pim/pass/realneg.mod
new file mode 100644
index 00000000000..1296f9ba50f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/realneg.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE realneg ;
+
+FROM FpuIO IMPORT WriteReal ;
+FROM StrIO IMPORT WriteLn ;
+
+PROCEDURE foo (a: REAL) ;
+BEGIN
+   WriteReal(a, 20, 10) ; WriteLn
+END foo ;
+
+
+BEGIN
+   foo(-2.0)
+END realneg.
diff --git a/gcc/testsuite/gm2/pim/pass/realneg2.mod b/gcc/testsuite/gm2/pim/pass/realneg2.mod
new file mode 100644
index 00000000000..7dd2d99c92e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/realneg2.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE realneg2 ;
+
+FROM FpuIO IMPORT WriteReal ;
+FROM StrIO IMPORT WriteLn ;
+
+PROCEDURE foo (a: REAL) ;
+BEGIN
+   WriteReal(a, 20, 10) ; WriteLn
+END foo ;
+
+
+VAR
+   r: REAL ;
+BEGIN
+   r := -2.0 ;
+   foo(r)
+END realneg2.
diff --git a/gcc/testsuite/gm2/pim/pass/realone.mod b/gcc/testsuite/gm2/pim/pass/realone.mod
new file mode 100644
index 00000000000..c6f904e9471
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/realone.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE realone ;
+
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   r: REAL ;
+BEGIN
+   IF r=1.0
+   THEN
+      WriteLn
+   END
+END realone.
diff --git a/gcc/testsuite/gm2/pim/pass/realsize.mod b/gcc/testsuite/gm2/pim/pass/realsize.mod
new file mode 100644
index 00000000000..996569b38f0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/realsize.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE realsize ;
+
+FROM SYSTEM IMPORT TSIZE ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+
+BEGIN
+   WriteString('size of SHORTREAL is ') ; WriteCard(TSIZE(SHORTREAL), 4) ; WriteLn ;
+   WriteString('size of REAL is ') ; WriteCard(TSIZE(REAL), 4) ; WriteLn ;
+   WriteString('size of LONGREAL is ') ; WriteCard(TSIZE(LONGREAL), 4) ; WriteLn
+END realsize.
diff --git a/gcc/testsuite/gm2/pim/pass/record1.mod b/gcc/testsuite/gm2/pim/pass/record1.mod
new file mode 100644
index 00000000000..2103a0e1e77
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record1.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE record1 ;
+
+TYPE
+   rec = RECORD
+            a: CARDINAL ;
+            b: CHAR ;
+         END ;
+
+VAR
+   r: rec ;
+BEGIN
+   r.a := 1 ;
+   r.b := 'a' ;
+   r.b := 'a' ;
+   r.b := 'a' ;
+   r.b := 'a' ;
+   r.b := 'a' ;
+END record1.
diff --git a/gcc/testsuite/gm2/pim/pass/record10.mod b/gcc/testsuite/gm2/pim/pass/record10.mod
new file mode 100644
index 00000000000..f6df0b52ec1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record10.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE record10 ;
+
+
+TYPE
+   r = RECORD
+          i: INTEGER ;
+          c: CARDINAL ;
+          s: BITSET ;
+       END ;
+
+
+PROCEDURE foo (VAR v: r) ;
+BEGIN
+   WITH v DO
+      i := 0 ;
+      c := 0 ;
+      s := {}
+   END
+END foo ;
+
+
+VAR
+   v: r ;
+BEGIN
+   foo(v)
+END record10.
diff --git a/gcc/testsuite/gm2/pim/pass/record11.mod b/gcc/testsuite/gm2/pim/pass/record11.mod
new file mode 100644
index 00000000000..d3b3cd4895b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record11.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE record11 ;
+
+TYPE
+   r = RECORD
+          CASE b: BOOLEAN OF
+
+          TRUE : c: CARDINAL |
+	  FALSE: d: INTEGER
+
+          END
+       END ;
+
+VAR
+   v: r ;
+
+BEGIN
+END record11.
diff --git a/gcc/testsuite/gm2/pim/pass/record12.def b/gcc/testsuite/gm2/pim/pass/record12.def
new file mode 100644
index 00000000000..144992299c8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record12.def
@@ -0,0 +1,35 @@
+(* Copyright (C) 2015 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.  *)
+
+DEFINITION MODULE record12 ;
+
+
+TYPE
+   r = RECORD
+          CASE b: BOOLEAN OF
+
+          TRUE : c: CARDINAL |
+	  FALSE: d: INTEGER
+
+          END
+       END ;
+
+VAR
+   v: r ;
+
+END record12.
diff --git a/gcc/testsuite/gm2/pim/pass/record13.def b/gcc/testsuite/gm2/pim/pass/record13.def
new file mode 100644
index 00000000000..759f2355abf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record13.def
@@ -0,0 +1,36 @@
+(* Copyright (C) 2015 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.  *)
+
+DEFINITION MODULE record13 ;
+
+
+TYPE
+   r = RECORD
+          CASE b: BOOLEAN OF
+
+          TRUE : c: CARDINAL |
+	  FALSE: d: INTEGER ;
+	         e: REAL
+
+          END
+       END ;
+
+VAR
+   v: r ;
+
+END record13.
diff --git a/gcc/testsuite/gm2/pim/pass/record14.def b/gcc/testsuite/gm2/pim/pass/record14.def
new file mode 100644
index 00000000000..27ff0b588a6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record14.def
@@ -0,0 +1,40 @@
+(* Copyright (C) 2016 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.  *)
+
+DEFINITION MODULE record14 ;
+
+
+TYPE
+   r = RECORD
+          CASE b: BOOLEAN OF
+
+          TRUE : t: s |
+	  FALSE: d: INTEGER ;
+	         e: REAL ;
+
+          END
+       END ;
+
+    s = RECORD
+           d: INTEGER ;
+        END ;
+
+VAR
+   v: r ;
+
+END record14.
diff --git a/gcc/testsuite/gm2/pim/pass/record15.def b/gcc/testsuite/gm2/pim/pass/record15.def
new file mode 100644
index 00000000000..7bb11c6e9de
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record15.def
@@ -0,0 +1,41 @@
+(* Copyright (C) 2016 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.  *)
+
+DEFINITION MODULE record15 ;
+
+
+TYPE
+   r = POINTER TO RECORD
+                    CASE b: BOOLEAN OF
+
+                    TRUE : t: s |
+                    FALSE: d: INTEGER ;
+                           e: REAL ;
+
+                    END
+                 END ;
+
+    s = RECORD
+           d: INTEGER ;
+	   p: r ;
+        END ;
+
+VAR
+   v: r ;
+
+END record15.
diff --git a/gcc/testsuite/gm2/pim/pass/record16.def b/gcc/testsuite/gm2/pim/pass/record16.def
new file mode 100644
index 00000000000..02990fba9d9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record16.def
@@ -0,0 +1,34 @@
+(* Copyright (C) 2016 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.  *)
+
+DEFINITION MODULE record16 ;
+
+
+TYPE
+   r = POINTER TO RECORD
+                     t: s ;
+                  END ;
+
+   s = RECORD
+          p: r ;
+       END ;
+
+VAR
+   v: r ;
+
+END record16.
diff --git a/gcc/testsuite/gm2/pim/pass/record2.mod b/gcc/testsuite/gm2/pim/pass/record2.mod
new file mode 100644
index 00000000000..6e2cedf76ca
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record2.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE record2 ;
+
+
+TYPE
+   rec = RECORD
+            CASE a: CARDINAL OF
+
+            1: b: CHAR |
+            2: c: REAL
+
+            ELSE
+            END
+         END ;
+VAR
+   r: rec ;
+   p: POINTER TO rec ;
+BEGIN
+   r.a := 1 ;
+   r.b := 'c' ;
+   r.b := 'c' ;
+   r.b := 'c' ;
+   r.b := 'c' ;
+   r.b := 'c' ;
+END record2.
diff --git a/gcc/testsuite/gm2/pim/pass/record3.mod b/gcc/testsuite/gm2/pim/pass/record3.mod
new file mode 100644
index 00000000000..b02021f2c91
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record3.mod
@@ -0,0 +1,69 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE record3 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM SYSTEM IMPORT TSIZE, SIZE ;
+
+TYPE
+   QuadOperator = (BecomesOp, IndrXOp, XIndrOp, BaseOp, ElementSizeOp,
+                   AddrOp,
+                   SizeOp,
+                   OffsetOp,
+                   IfEquOp, IfLessEquOp, IfGreEquOp, IfGreOp, IfLessOp,
+                   IfNotEquOp, IfInOp, IfNotInOp,
+                   CallOp, ParamOp, OptParamOp, ReturnOp, ReturnValueOp, FunctValueOp,
+                   NewLocalVarOp, KillLocalVarOp, ProcedureScopeOp,
+                   DummyOp,
+                   GotoOp, EndOp, StartOp,
+                   NegateOp, AddOp, SubOp, DivOp, MultOp, ModOp,
+      	       	   LogicalOrOp, LogicalAndOp, LogicalXorOp, LogicalDiffOp,
+                   InclOp, ExclOp,
+                   UnboundedOp, HighOp,
+                   CoerceOp, ConvertOp,
+                   StartDefFileOp, StartModFileOp, EndFileOp,
+                   CodeOnOp, CodeOffOp,
+                   ProfileOnOp, ProfileOffOp,
+                   OptimizeOnOp, OptimizeOffOp,
+                   InlineOp, LineNumberOp,
+                   SubrangeLowOp, SubrangeHighOp,
+                   BuiltinConstOp, StandardFunctionOp) ;
+
+   QuadFrame = RECORD
+                  Operator           : QuadOperator ;
+                  Operand1           : CARDINAL ;
+                  Operand2           : CARDINAL ;
+                  Operand3           : CARDINAL ;
+                  Next               : CARDINAL ;
+                  LineNo             : CARDINAL ;
+                  TokenNo            : CARDINAL ;
+                  NoOfTimesReferenced: CARDINAL ;
+               END ;
+
+CONST
+   MaxQuad = 50000 ;
+
+VAR
+   Quads: ARRAY [1..MaxQuad] OF QuadFrame ;
+BEGIN
+   WriteString('SIZE(QuadFrame) = ') ; WriteCard(TSIZE(QuadFrame), 6) ;
+   WriteLn ;
+   WriteString('SIZE(QuadFrame) = ') ; WriteCard(SIZE(Quads), 6) ;
+   WriteLn
+END record3.
diff --git a/gcc/testsuite/gm2/pim/pass/record4.mod b/gcc/testsuite/gm2/pim/pass/record4.mod
new file mode 100644
index 00000000000..c5fcf17f589
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record4.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE record4 ;
+
+TYPE
+   rec = RECORD
+            i: INTEGER
+         END ;
+
+PROCEDURE Expression (r: rec): BOOLEAN;
+BEGIN
+  RETURN TRUE
+END Expression ;
+
+TYPE
+   newrec =  rec ;
+
+PROCEDURE Term (t: newrec) ;
+BEGIN
+   WHILE NOT Expression(t) DO
+   END
+END Term ;
+
+VAR
+   n: newrec ;
+BEGIN
+   Term(n)
+END record4.
diff --git a/gcc/testsuite/gm2/pim/pass/record5.mod b/gcc/testsuite/gm2/pim/pass/record5.mod
new file mode 100644
index 00000000000..98cc7817107
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record5.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE record5 ;
+
+FROM SYSTEM IMPORT TSIZE ;
+
+TYPE
+   this = RECORD
+             tag: CARDINAL ;
+             foo: CARDINAL ;
+          END ;
+
+VAR
+   hmm: this ;
+   j,c: CARDINAL ;
+BEGIN
+   hmm.foo := 99 ;
+   j := TSIZE(hmm) ;
+END record5.
diff --git a/gcc/testsuite/gm2/pim/pass/record6.mod b/gcc/testsuite/gm2/pim/pass/record6.mod
new file mode 100644
index 00000000000..00a20b9376a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record6.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE record6 ;
+
+
+TYPE
+   t2 = RECORD
+           z: CARDINAL ;
+        END ;
+   t1 = RECORD
+           y: t2 ;
+        END ;
+
+   r = RECORD
+          x: t1 ;
+       END ;
+
+VAR
+   v: r ;
+BEGIN
+   v.x.y.z := 99
+END record6.
diff --git a/gcc/testsuite/gm2/pim/pass/record7.mod b/gcc/testsuite/gm2/pim/pass/record7.mod
new file mode 100644
index 00000000000..77acc9a088c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record7.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE record7 ;
+
+TYPE
+   foo = RECORD
+            f1: CARDINAL ;
+            f2: CHAR ;
+            f3: myarray ;
+         END ;
+
+   myarray = ARRAY myrange OF CARDINAL ;
+   myrange = [-2..2] ;
+VAR
+   s: POINTER TO ARRAY myrange OF foo ;
+BEGIN
+   s := NIL ;
+   IF s=NIL
+   THEN
+   END
+END record7.
diff --git a/gcc/testsuite/gm2/pim/pass/record8.mod b/gcc/testsuite/gm2/pim/pass/record8.mod
new file mode 100644
index 00000000000..6eab8740ca6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record8.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE record8 ;
+
+
+TYPE
+   r = RECORD
+          c: CARDINAL ;
+          s: BITSET ;
+       END ;
+
+VAR
+   v: r ;
+BEGIN
+   WITH v DO
+      c := 0 ;
+      s := {}
+   END ;
+END record8.
diff --git a/gcc/testsuite/gm2/pim/pass/record9.mod b/gcc/testsuite/gm2/pim/pass/record9.mod
new file mode 100644
index 00000000000..c67a0c37d03
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/record9.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE record9 ;
+
+
+TYPE
+   r = RECORD
+          i: INTEGER ;
+          c: CARDINAL ;
+          s: BITSET ;
+       END ;
+
+VAR
+   v: r ;
+BEGIN
+   WITH v DO
+      i := 0 ;
+      c := 0 ;
+      s := {}
+   END ;
+END record9.
diff --git a/gcc/testsuite/gm2/pim/pass/recordarray.c b/gcc/testsuite/gm2/pim/pass/recordarray.c
new file mode 100644
index 00000000000..bef0faf395d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/recordarray.c
@@ -0,0 +1,19 @@
+
+typedef struct srecord {
+  int x;
+  int y;
+  int z;
+} record ;
+
+
+
+static record a[50];
+
+main()
+{
+  int i = 1;
+
+  a[i].x = 1;
+  a[i].y = 2;
+  a[i].z = 3;
+}
diff --git a/gcc/testsuite/gm2/pim/pass/recordarray.mod b/gcc/testsuite/gm2/pim/pass/recordarray.mod
new file mode 100644
index 00000000000..a0ddac171ed
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/recordarray.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE recordarray ;
+
+TYPE
+   record = RECORD
+               x, y, z: CARDINAL ;
+            END ;
+
+VAR
+   a: ARRAY [1..50] OF record ;
+   i: CARDINAL ;
+BEGIN
+(*
+   FOR i := 1 TO 10 DO
+*)
+   i := 1 ;
+      a[i].x := 1 ;
+      a[i].y := 2 ;
+      a[i].z := 3
+(*
+   END
+*)
+END recordarray.
diff --git a/gcc/testsuite/gm2/pim/pass/recordarray2.mod b/gcc/testsuite/gm2/pim/pass/recordarray2.mod
new file mode 100644
index 00000000000..0c7f5e9aac4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/recordarray2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE recordarray2 ;
+
+
+VAR
+   a   : ARRAY [0..5], [0..6] OF RECORD
+                                    x, y: INTEGER ;
+                                 END ;
+   i, j: CARDINAL ;
+BEGIN
+   i := 2 ;
+   j := 3 ;
+   a[i, j].y := 99
+END recordarray2.
diff --git a/gcc/testsuite/gm2/pim/pass/redef.mod b/gcc/testsuite/gm2/pim/pass/redef.mod
new file mode 100644
index 00000000000..7f0a0e2a200
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/redef.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE redef ;
+
+VAR
+   INTEGER: BOOLEAN ;
+BEGIN
+   INTEGER := TRUE
+END redef.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/pass/set10.mod b/gcc/testsuite/gm2/pim/pass/set10.mod
new file mode 100644
index 00000000000..7d08bb71962
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set10.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE set10 ;
+
+FROM set11 IMPORT foo ;
+
+BEGIN
+END set10.
diff --git a/gcc/testsuite/gm2/pim/pass/set11.def b/gcc/testsuite/gm2/pim/pass/set11.def
new file mode 100644
index 00000000000..882ad0d39fe
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set11.def
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE set11 ;
+
+EXPORT QUALIFIED status, setof ;
+
+TYPE
+   hidden ;
+   status = (foo, bar) ;
+   setof  = SET OF status ;
+
+END set11.
diff --git a/gcc/testsuite/gm2/pim/pass/set11.mod b/gcc/testsuite/gm2/pim/pass/set11.mod
new file mode 100644
index 00000000000..3cf733612ea
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set11.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE set11 ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   hidden = ADDRESS ;
+
+PROCEDURE Call (s: setof) ;
+BEGIN
+END Call ;
+
+BEGIN
+   Call(setof{foo})
+END set11.
diff --git a/gcc/testsuite/gm2/pim/pass/set12.mod b/gcc/testsuite/gm2/pim/pass/set12.mod
new file mode 100644
index 00000000000..9533973819d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set12.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE set12 ;
+
+TYPE
+   colour = (red, blue, green) ;
+   foo = SET OF colour ;
+
+VAR
+   s: BITSET ;
+   f: foo ;
+BEGIN
+   s := {} ; (* this is legal in PIM2 *)
+   f := foo{}
+END set12.
diff --git a/gcc/testsuite/gm2/pim/pass/set4.mod b/gcc/testsuite/gm2/pim/pass/set4.mod
new file mode 100644
index 00000000000..bb7127d9abc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set4.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE set4 ;
+
+
+TYPE
+   colour = (red, blue, green) ;
+   ColourSet = SET OF colour ;
+VAR
+   s: ColourSet ;
+BEGIN
+   s := ColourSet{red, green} ;
+   s := ColourSet{red, blue} ;
+   s := ColourSet{red, blue, green}
+END set4.
diff --git a/gcc/testsuite/gm2/pim/pass/set5.mod b/gcc/testsuite/gm2/pim/pass/set5.mod
new file mode 100644
index 00000000000..c897fc0b718
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set5.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE set5 ;
+
+
+TYPE
+   colour = (red, blue, green) ;
+   ColourSet = SET OF colour ;
+
+PROCEDURE first (c: ColourSet) ;
+BEGIN
+   IF red IN c
+   THEN
+
+   END   
+END first ;
+
+
+VAR
+   s: ColourSet ;
+BEGIN
+   s := ColourSet{red, green} ;
+   first(s) ;
+   s := ColourSet{red, blue} ;
+   s := ColourSet{red, blue, green}
+END set5.
diff --git a/gcc/testsuite/gm2/pim/pass/set6.mod b/gcc/testsuite/gm2/pim/pass/set6.mod
new file mode 100644
index 00000000000..b6b24fa3783
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set6.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE set6 ;
+
+
+TYPE
+   colour = (red, blue, green) ;
+   ColourSet = SET OF [red..green] ;
+
+PROCEDURE first (c: ColourSet) ;
+BEGIN
+   IF red IN c
+   THEN
+
+   END   
+END first ;
+
+
+VAR
+   s: ColourSet ;
+BEGIN
+   s := ColourSet{red, green} ;
+   first(s) ;
+   s := ColourSet{red, blue} ;
+   s := ColourSet{red, blue, green}
+END set6.
diff --git a/gcc/testsuite/gm2/pim/pass/set7.mod b/gcc/testsuite/gm2/pim/pass/set7.mod
new file mode 100644
index 00000000000..df598e7c7e1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set7.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE set7 ;
+
+
+TYPE
+   colours = (red, blue, yellow, orange, green) ;
+   myset   = SET OF colours ;
+
+VAR
+   s: myset ;
+BEGIN
+   s := myset{} ;
+   INCL(s, blue)
+END set7.
diff --git a/gcc/testsuite/gm2/pim/pass/set8.mod b/gcc/testsuite/gm2/pim/pass/set8.mod
new file mode 100644
index 00000000000..546c558da85
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set8.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE set8 ;
+
+TYPE
+   colours = (red, blue, yellow, orange, green,
+              a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z,
+              aa, ab, ac, ad, ae, af, ag, ah, ai, aj, ak, al, am, an, ao, ap, aq) ;
+   myset   = SET OF colours ;
+
+PROCEDURE func (f: myset) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+
+   i := 0 ;  (* gdb fodder *)
+   INC(i) ;
+
+END func ;
+
+VAR
+   my: myset ;
+BEGIN
+   func(myset{a, aq})
+END set8.
diff --git a/gcc/testsuite/gm2/pim/pass/set9.mod b/gcc/testsuite/gm2/pim/pass/set9.mod
new file mode 100644
index 00000000000..159ed3af04e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/set9.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE set9 ;
+
+TYPE
+   tokens = (eoftok, plustok, minustok, timestok, dividetok, becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok, repeattok, returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, integertok, identtok, realtok, stringtok) ;
+
+   SetOfStop0 = SET OF [eoftok..begintok] ;
+   SetOfStop1 = SET OF [bytok..thentok] ;
+   SetOfStop2 = SET OF [totok..stringtok] ;
+
+VAR
+   s0 : SetOfStop0 ;
+   s1 : SetOfStop1 ;
+   s2 : SetOfStop2 ;
+   t  : tokens ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   IF ORD(t)<32
+   THEN
+      INCL(s0, t)
+   ELSIF ORD(t)<64
+   THEN
+      INCL(s1, t)
+   ELSE
+      INCL(s2, t)
+   END
+END set9.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar.mod b/gcc/testsuite/gm2/pim/pass/setchar.mod
new file mode 100644
index 00000000000..a97035e2d76
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar ;
+
+TYPE
+   smallchar = SET OF ['A'..'Z'] ;
+
+VAR
+   ch: CHAR ;
+BEGIN
+   IF ch IN smallchar{'A' .. 'Z'}
+   THEN
+   END
+END setchar.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar10.mod b/gcc/testsuite/gm2/pim/pass/setchar10.mod
new file mode 100644
index 00000000000..0ba3369d4ca
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar10.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar10 ;
+
+FROM libc IMPORT exit ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StdIO IMPORT Write ;
+
+TYPE
+   setofchar = SET OF CHAR ;
+
+PROCEDURE test (ch: CHAR) ;
+BEGIN
+   IF ch IN setofchar{'a', 'b', 'd', 'e'}
+   THEN
+      WriteString('works as we have seen: ') ; Write(ch) ; WriteLn ;
+      RETURN
+   END ;
+   exit(1)
+END test ;
+
+
+BEGIN
+   test('a') ;
+   test('b') ;
+   test('d') ;
+   test('e') ;
+END setchar10.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar11.mod b/gcc/testsuite/gm2/pim/pass/setchar11.mod
new file mode 100644
index 00000000000..33153fa28c9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar11.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar11 ;
+
+TYPE
+   soc = SET OF ['a'..'z'] ;
+VAR
+   s: soc ;
+BEGIN
+   s := soc{} ;
+END setchar11.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar3.mod b/gcc/testsuite/gm2/pim/pass/setchar3.mod
new file mode 100644
index 00000000000..4aaec41bf84
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar3.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar3 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   smallchar = SET OF ['A'..'Z'] ;
+
+VAR
+   s : smallchar ;
+   ch: CHAR ;
+   p : POINTER TO CARDINAL ;
+BEGIN
+   ch := 'z' ;
+   s := smallchar{} ;
+   s := smallchar{'A'} ;
+   p := ADR(s) ;
+   p^ := 1 ;
+   p^ := 3 ;
+   p^ := 7 ;
+   p^ := 15 ;
+   p^ := 31 ;
+   p^ := 31
+END setchar3.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar4.mod b/gcc/testsuite/gm2/pim/pass/setchar4.mod
new file mode 100644
index 00000000000..300d1e33aab
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar4.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar4 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   charset = SET OF CHAR ;
+
+VAR
+   s: charset ;
+   p: POINTER TO ARRAY [0..7] OF INTEGER ;
+BEGIN
+   p := ADR(s) ;
+   p^[0] := -1 ;
+   p^[1] := -1 ;
+   p^[2] := -1 ;
+   p^[3] := -1 ;
+   p^[4] := -1 ;
+   p^[5] := -1 ;
+   p^[6] := 255 ;
+   p^[7] := -1 ;
+   p^[7] := -1 ;
+END setchar4.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar5.mod b/gcc/testsuite/gm2/pim/pass/setchar5.mod
new file mode 100644
index 00000000000..25017ec623c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar5.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar5 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+   charset = SET OF ['0'..'z'] ;
+
+VAR
+   s: charset ;
+   p: POINTER TO ARRAY [0..2] OF INTEGER ;
+BEGIN
+   p := ADR(s) ;
+   p^[0] := -1 ;
+   p^[1] := -1 ;
+   p^[2] := -1 ;
+   p^[2] := -1 ;
+END setchar5.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar7.mod b/gcc/testsuite/gm2/pim/pass/setchar7.mod
new file mode 100644
index 00000000000..bdcead06977
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar7.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar7 ;
+
+
+TYPE
+   setofchar = SET OF ['0'..'z'] ;
+
+VAR
+   s: setofchar ;
+BEGIN
+   s := setofchar {'3'..'8', 'g'..'q'} ;
+   s := setofchar {'3'..'8', 'g'..'q'} ;
+   s := setofchar {} ;
+   s := setofchar {'3'..'8', 'B'..'E', 'Y'..'Z', 'g'..'q'} ;
+   s := setofchar {'3'..'8', 'g'..'q'} ;
+END setchar7.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar8.mod b/gcc/testsuite/gm2/pim/pass/setchar8.mod
new file mode 100644
index 00000000000..f1ee698bd57
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar8.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar8 ;
+
+
+TYPE
+   setofchar = SET OF ['0'..'z'] ;
+
+VAR
+   s: setofchar ;
+BEGIN
+   s := setofchar {'3'..'8'} + setofchar { 'g'..'q'} ;
+   s := setofchar {} ;
+   s := setofchar {'3'..'8', 'B'..'E', 'Y'..'Z', 'g'..'q'} ;
+   s := setofchar {'3'..'8', 'g'..'q'} ;
+END setchar8.
diff --git a/gcc/testsuite/gm2/pim/pass/setchar9.mod b/gcc/testsuite/gm2/pim/pass/setchar9.mod
new file mode 100644
index 00000000000..9a84e95be70
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setchar9.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setchar9 ;
+
+
+TYPE
+   setofchar = SET OF CHAR ;
+
+VAR
+   s: setofchar ;
+BEGIN
+   s := setofchar {'3'..'8'} + setofchar { 'g'..'q'} ;
+   s := setofchar {} ;
+   s := setofchar {'3'..'8', 'B'..'E', 'Y'..'Z', 'g'..'q'} ;
+   s := setofchar {'3'..'8', 'g'..'q'} ;
+   s := setofchar {'3'..'8', 'a', 'c', 'b', 'd', 'f', 'e', 'q'} ;
+   s := setofchar {'3'..'8', 'a', 'c', 'b', 'd', 'f', 'e', 'q'} ;
+   s := setofchar {'2'..'3', '5'..'6', '4', '9'} ;
+   s := setofchar {'h', 'e', 'l', 'l', 'o', ' ', 'w', 'o', 'r', 'l', 'd'} ;
+END setchar9.
diff --git a/gcc/testsuite/gm2/pim/pass/setconst.mod b/gcc/testsuite/gm2/pim/pass/setconst.mod
new file mode 100644
index 00000000000..4f2cb495284
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setconst.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setconst ;
+
+PROCEDURE PresetLocaltime;
+TYPE CharSet = SET OF CHAR;
+CONST
+    Digits = CharSet{"0".."9"};
+    NumChars = CharSet{0C,"+","-"} + Digits;
+VAR
+   c1, c2: CharSet ;
+BEGIN
+   c1 := Digits ;
+   c2 := NumChars
+END PresetLocaltime ;
+
+BEGIN
+END setconst.
diff --git a/gcc/testsuite/gm2/pim/pass/setconst2.mod b/gcc/testsuite/gm2/pim/pass/setconst2.mod
new file mode 100644
index 00000000000..ac9ea0f74c0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setconst2.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setconst2 ;
+
+PROCEDURE PresetLocaltime;
+TYPE CharSet = SET OF CHAR;
+CONST
+    Digits = CharSet{"0".."9"};
+    NumChars = CharSet{0C,"+","-"} + Digits;
+VAR
+   c: CHAR ;
+BEGIN
+   c := '0' ;
+   IF c IN Digits
+   THEN
+   END ;
+(*
+   IF c IN NumChars
+   THEN
+   END
+*)
+END PresetLocaltime ;
+
+BEGIN
+END setconst2.
diff --git a/gcc/testsuite/gm2/pim/pass/setconst3.mod b/gcc/testsuite/gm2/pim/pass/setconst3.mod
new file mode 100644
index 00000000000..b4e7b01e008
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setconst3.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setconst3 ;
+
+VAR
+   mem: ARRAY [0..CARDINAL(addressLines)] OF CARDINAL ;
+
+TYPE
+   Lines = SET OF [0..16] ;
+
+CONST
+   addressLines = Lines{1, 4, 13} ;
+
+BEGIN
+END setconst3.
diff --git a/gcc/testsuite/gm2/pim/pass/setenum.mod b/gcc/testsuite/gm2/pim/pass/setenum.mod
new file mode 100644
index 00000000000..0440eeaeaf4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setenum.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setenum ;
+
+
+TYPE
+   enum = (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q,
+           r, ss, t, u, v, w, x, y, z, A, B, C, D, E, F, G, H,
+           I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y,
+           Z) ;
+   set = SET OF enum ;
+VAR
+   s: set ;
+BEGIN
+   s := set{};
+   s := set{};
+END setenum.
diff --git a/gcc/testsuite/gm2/pim/pass/setimp.mod b/gcc/testsuite/gm2/pim/pass/setimp.mod
new file mode 100644
index 00000000000..de75939a0a1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setimp.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setimp ;
+
+TYPE
+   CharSet = SET OF CHAR ;
+CONST
+   White = CharSet{' ', CHR(13)} ;
+
+   PROCEDURE foo ;
+      MODULE bar ;
+      IMPORT CharSet ;
+      VAR
+         variable: CharSet ;
+      BEGIN
+         variable := CharSet{}
+      END bar ;
+
+   BEGIN
+   END foo ;
+
+BEGIN
+   foo
+END setimp.
diff --git a/gcc/testsuite/gm2/pim/pass/setimp2.mod b/gcc/testsuite/gm2/pim/pass/setimp2.mod
new file mode 100644
index 00000000000..26f1d6af413
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setimp2.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setimp2 ;
+
+TYPE
+   CharSet = SET OF CHAR ;
+CONST
+   White = CharSet{' ', CHR(13)} ;
+
+   PROCEDURE foo ;
+      MODULE bar ;
+      IMPORT CharSet ;
+      VAR
+         variable: CharSet ;
+      BEGIN
+         variable := CharSet{}
+      END bar ;
+
+   BEGIN
+   END foo ;
+
+   PROCEDURE foo2 ;
+      MODULE bar ;
+      IMPORT CharSet ;
+      VAR
+         variable: CharSet ;
+      BEGIN
+         variable := CharSet{}
+      END bar ;
+
+   BEGIN
+   END foo2 ;
+
+BEGIN
+   foo
+END setimp2.
diff --git a/gcc/testsuite/gm2/pim/pass/setofchar.mod b/gcc/testsuite/gm2/pim/pass/setofchar.mod
new file mode 100644
index 00000000000..6b6585bd984
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setofchar.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setofchar ;
+
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   b: ARRAY [0..7] OF BITSET ;
+   p: POINTER TO CARDINAL ;
+BEGIN
+   p := ADR(b) ;
+   p^ := 0 ;
+   b[1] := b[0] ;
+   p^ := 3 ;
+   p^ := 9 ;
+   p^ := 11 ;
+   p^ := 14
+END setofchar.
diff --git a/gcc/testsuite/gm2/pim/pass/setoverflow.mod b/gcc/testsuite/gm2/pim/pass/setoverflow.mod
new file mode 100644
index 00000000000..ae8b0cda71f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setoverflow.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setoverflow ;
+
+CONST
+   WhiteSpace = CharSet{tab, ' '} ;
+   tab = 011C ;
+TYPE
+   CharSet = SET OF CHAR ;
+VAR
+   termchars: CharSet ;
+BEGIN
+   termchars := CharSet{MIN(CHAR)..MAX(CHAR)} - WhiteSpace
+END setoverflow.
diff --git a/gcc/testsuite/gm2/pim/pass/sets.mod b/gcc/testsuite/gm2/pim/pass/sets.mod
new file mode 100644
index 00000000000..c8d7a749f66
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/sets.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE sets ;
+
+TYPE
+   colours = (red, blue, yellow, orange, green) ;
+   myset   = SET OF colours ;
+
+PROCEDURE testing (first: myset) ;
+BEGIN
+END testing ;
+
+BEGIN
+   testing(myset{blue, green})
+END sets.
diff --git a/gcc/testsuite/gm2/pim/pass/sets2.mod b/gcc/testsuite/gm2/pim/pass/sets2.mod
new file mode 100644
index 00000000000..676439b01ce
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/sets2.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE sets2 ;
+
+
+TYPE
+   colours = (red, blue, yellow, orange, green) ;
+   myset   = SET OF colours ;
+
+PROCEDURE Add ;
+BEGIN
+END Add ;
+
+
+PROCEDURE testing (first: myset) ;
+BEGIN
+   IF red IN first
+   THEN
+      Add
+   END ;
+   IF ORD(token)<2
+   THEN
+      Add
+   END
+END testing ;
+
+VAR
+   token: colours ;
+BEGIN
+   testing(myset{blue, green})
+END sets2.
diff --git a/gcc/testsuite/gm2/pim/pass/sets3.mod b/gcc/testsuite/gm2/pim/pass/sets3.mod
new file mode 100644
index 00000000000..2bbd4abff1a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/sets3.mod
@@ -0,0 +1,172 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE sets3 ;
+
+FROM DynamicStrings IMPORT String, InitString, ConCat, Mark, ConCatChar ;
+FROM M2Printf IMPORT printf1, printf0 ;
+FROM M2LexBuf IMPORT GetToken ;
+(* FROM M2Reserved IMPORT toktype ; *)
+
+
+CONST
+   Debugging = TRUE ;
+
+
+TYPE
+   toktype = (eoftok, plustok, minustok, timestok, dividetok, becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok, repeattok, returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, integertok, identtok, realtok, stringtok) ;
+
+
+   SetOfStop0 = SET OF [eoftok..begintok] ;
+   SetOfStop1 = SET OF [bytok..thentok] ;
+   SetOfStop2 = SET OF [totok..stringtok] ;
+
+VAR
+   currenttoken: toktype ;
+
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+END ErrorString ;
+
+PROCEDURE DescribeError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+VAR
+   str: String ;
+BEGIN
+   str := InitString('') ;
+   CASE currenttoken OF
+   
+   stringtok: str := ConCat(InitString("syntax error, found `string'"), Mark(str)) |
+   realtok: str := ConCat(InitString("syntax error, found `real number'"), Mark(str)) |
+   identtok: str := ConCat(InitString("syntax error, found `identifier'"), Mark(str)) |
+   integertok: str := ConCat(InitString("syntax error, found `integer number'"), Mark(str)) |
+   filetok: str := ConCat(InitString("syntax error, found `__FILE__'"), Mark(str)) |
+   linetok: str := ConCat(InitString("syntax error, found `__LINE__'"), Mark(str)) |
+   datetok: str := ConCat(InitString("syntax error, found `__DATE__'"), Mark(str)) |
+   periodperiodperiodtok: str := ConCat(InitString("syntax error, found `...'"), Mark(str)) |
+   volatiletok: str := ConCat(InitString("syntax error, found `VOLATILE'"), Mark(str)) |
+   asmtok: str := ConCat(InitString("syntax error, found `ASM'"), Mark(str)) |
+   withtok: str := ConCat(InitString("syntax error, found `WITH'"), Mark(str)) |
+   whiletok: str := ConCat(InitString("syntax error, found `WHILE'"), Mark(str)) |
+   vartok: str := ConCat(InitString("syntax error, found `VAR'"), Mark(str)) |
+   untiltok: str := ConCat(InitString("syntax error, found `UNTIL'"), Mark(str)) |
+   typetok: str := ConCat(InitString("syntax error, found `TYPE'"), Mark(str)) |
+   totok: str := ConCat(InitString("syntax error, found `TO'"), Mark(str)) |
+   thentok: str := ConCat(InitString("syntax error, found `THEN'"), Mark(str)) |
+   settok: str := ConCat(InitString("syntax error, found `SET'"), Mark(str)) |
+   returntok: str := ConCat(InitString("syntax error, found `RETURN'"), Mark(str)) |
+   repeattok: str := ConCat(InitString("syntax error, found `REPEAT'"), Mark(str)) |
+   recordtok: str := ConCat(InitString("syntax error, found `RECORD'"), Mark(str)) |
+   unqualifiedtok: str := ConCat(InitString("syntax error, found `UNQUALIFIED'"), Mark(str)) |
+   qualifiedtok: str := ConCat(InitString("syntax error, found `QUALIFIED'"), Mark(str)) |
+   proceduretok: str := ConCat(InitString("syntax error, found `PROCEDURE'"), Mark(str)) |
+   pointertok: str := ConCat(InitString("syntax error, found `POINTER'"), Mark(str)) |
+   ortok: str := ConCat(InitString("syntax error, found `OR'"), Mark(str)) |
+   oftok: str := ConCat(InitString("syntax error, found `OF'"), Mark(str)) |
+   nottok: str := ConCat(InitString("syntax error, found `NOT'"), Mark(str)) |
+   moduletok: str := ConCat(InitString("syntax error, found `MODULE'"), Mark(str)) |
+   modtok: str := ConCat(InitString("syntax error, found `MOD'"), Mark(str)) |
+   looptok: str := ConCat(InitString("syntax error, found `LOOP'"), Mark(str)) |
+   intok: str := ConCat(InitString("syntax error, found `IN'"), Mark(str)) |
+   importtok: str := ConCat(InitString("syntax error, found `IMPORT'"), Mark(str)) |
+   implementationtok: str := ConCat(InitString("syntax error, found `IMPLEMENTATION'"), Mark(str)) |
+   iftok: str := ConCat(InitString("syntax error, found `IF'"), Mark(str)) |
+   fromtok: str := ConCat(InitString("syntax error, found `FROM'"), Mark(str)) |
+   fortok: str := ConCat(InitString("syntax error, found `FOR'"), Mark(str)) |
+   exporttok: str := ConCat(InitString("syntax error, found `EXPORT'"), Mark(str)) |
+   exittok: str := ConCat(InitString("syntax error, found `EXIT'"), Mark(str)) |
+   endtok: str := ConCat(InitString("syntax error, found `END'"), Mark(str)) |
+   elsiftok: str := ConCat(InitString("syntax error, found `ELSIF'"), Mark(str)) |
+   elsetok: str := ConCat(InitString("syntax error, found `ELSE'"), Mark(str)) |
+   dotok: str := ConCat(InitString("syntax error, found `DO'"), Mark(str)) |
+   divtok: str := ConCat(InitString("syntax error, found `DIV'"), Mark(str)) |
+   definitiontok: str := ConCat(InitString("syntax error, found `DEFINITION'"), Mark(str)) |
+   consttok: str := ConCat(InitString("syntax error, found `CONST'"), Mark(str)) |
+   casetok: str := ConCat(InitString("syntax error, found `CASE'"), Mark(str)) |
+   bytok: str := ConCat(InitString("syntax error, found `BY'"), Mark(str)) |
+   begintok: str := ConCat(InitString("syntax error, found `BEGIN'"), Mark(str)) |
+   arraytok: str := ConCat(InitString("syntax error, found `ARRAY'"), Mark(str)) |
+   andtok: str := ConCat(InitString("syntax error, found `AND'"), Mark(str)) |
+   colontok: str := ConCat(InitString("syntax error, found `:'"), Mark(str)) |
+   periodperiodtok: str := ConCat(InitString("syntax error, found `..'"), Mark(str)) |
+   greaterequaltok: str := ConCat(InitString("syntax error, found `>='"), Mark(str)) |
+   lessequaltok: str := ConCat(InitString("syntax error, found `<='"), Mark(str)) |
+   lessgreatertok: str := ConCat(InitString("syntax error, found `<>'"), Mark(str)) |
+   hashtok: str := ConCat(InitString("syntax error, found `#'"), Mark(str)) |
+   equaltok: str := ConCat(InitString("syntax error, found `='"), Mark(str)) |
+   uparrowtok: str := ConCat(InitString("syntax error, found `^'"), Mark(str)) |
+   semicolontok: str := ConCat(InitString("syntax error, found `;'"), Mark(str)) |
+   commatok: str := ConCat(InitString("syntax error, found `,'"), Mark(str)) |
+   periodtok: str := ConCat(InitString("syntax error, found `.'"), Mark(str)) |
+   ambersandtok: str := ConCat(InitString("syntax error, found `&'"), Mark(str)) |
+   dividetok: str := ConCat(InitString("syntax error, found `/'"), Mark(str)) |
+   timestok: str := ConCat(InitString("syntax error, found `*'"), Mark(str)) |
+   minustok: str := ConCat(InitString("syntax error, found `-'"), Mark(str)) |
+   plustok: str := ConCat(InitString("syntax error, found `+'"), Mark(str)) |
+   doublequotestok: str := ConCat(ConCatChar(ConCatChar(InitString("syntax error, found '"), '"'), "'"), Mark(str)) |
+   singlequotetok: str := ConCat(ConCatChar(ConCatChar(InitString('syntax error, found "'), "'"), '"'), Mark(str)) |
+   greatertok: str := ConCat(InitString("syntax error, found `>'"), Mark(str)) |
+   lesstok: str := ConCat(InitString("syntax error, found `<'"), Mark(str)) |
+   rparatok: str := ConCat(InitString("syntax error, found `)'"), Mark(str)) |
+   lparatok: str := ConCat(InitString("syntax error, found `('"), Mark(str)) |
+   rcbratok: str := ConCat(InitString("syntax error, found `}'"), Mark(str)) |
+   lcbratok: str := ConCat(InitString("syntax error, found `{'"), Mark(str)) |
+   rsbratok: str := ConCat(InitString("syntax error, found `]'"), Mark(str)) |
+   lsbratok: str := ConCat(InitString("syntax error, found `['"), Mark(str)) |
+   bartok: str := ConCat(InitString("syntax error, found `|'"), Mark(str)) |
+   becomestok: str := ConCat(InitString("syntax error, found `:='"), Mark(str)) |
+   eoftok: str := ConCat(InitString("syntax error, found `'"), Mark(str))
+   ELSE
+   END ;
+   ErrorString(str) ;
+END DescribeError ;
+
+
+(*
+   SyntaxError - after a syntax error we skip all tokens up until we reach
+                 a stop symbol.
+*)
+(*
+PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
+BEGIN
+   DescribeError(stopset0, stopset1, stopset2) ;
+   IF Debugging
+   THEN
+      printf0('\nskipping token *** ')
+   END ;
+   (*
+      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 NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
+              ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
+              ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
+   DO
+      GetToken
+   END ;
+   IF Debugging
+   THEN
+      printf0(' ***\n')
+   END
+END SyntaxError ;
+*)
+
+
+BEGIN
+END sets3.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/pim/pass/sets4.mod b/gcc/testsuite/gm2/pim/pass/sets4.mod
new file mode 100644
index 00000000000..bd9fa9f6d23
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/sets4.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE sets4 ;
+
+TYPE
+   s = SET OF (one, two) ;
+
+BEGIN
+END sets4.
diff --git a/gcc/testsuite/gm2/pim/pass/sets5.mod b/gcc/testsuite/gm2/pim/pass/sets5.mod
new file mode 100644
index 00000000000..4d259cd992e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/sets5.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2006 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 2, 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. *)
+
+MODULE sets5 ;
+
+TYPE
+   s = SET OF (one, two) ;
+
+VAR
+   t: s ;
+   q: SET OF (five, six, seven) ;
+BEGIN
+   t := s{one} ;
+   t := s{one} ;
+   t := s{one} ;
+   t := s{one} ;
+END sets5.
diff --git a/gcc/testsuite/gm2/pim/pass/sets6.mod b/gcc/testsuite/gm2/pim/pass/sets6.mod
new file mode 100644
index 00000000000..1ec14fe2161
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/sets6.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE sets6 ;
+
+
+TYPE
+   myset = SET OF [0..15] ;
+
+VAR
+   s: myset ;
+   c: CARDINAL ;
+BEGIN
+   c := 10 ;
+   s := myset{c}
+END sets6.
diff --git a/gcc/testsuite/gm2/pim/pass/setsnul.mod b/gcc/testsuite/gm2/pim/pass/setsnul.mod
new file mode 100644
index 00000000000..fb576c7ce69
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/setsnul.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE setsnul ;
+
+
+TYPE
+   LargeSet = SET OF [0..255] ;
+   SmallSet = SET OF [0..127] ;
+
+VAR
+   l: LargeSet ;
+   s: SmallSet ;
+BEGIN
+   l := LargeSet{} ;
+   s := SmallSet{} ;
+   IF l=LargeSet{}
+   THEN
+   
+   END ;
+   IF s=SmallSet{}
+   THEN
+      
+   END
+END setsnul.
diff --git a/gcc/testsuite/gm2/pim/pass/settest1.mod b/gcc/testsuite/gm2/pim/pass/settest1.mod
new file mode 100644
index 00000000000..00e45643fe4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/settest1.mod
@@ -0,0 +1,8 @@
+MODULE settest1 ;
+
+TYPE BigSet = SET OF [0..100000];
+                                                                                
+        
+BEGIN
+        (******)                                               
+END settest1.
diff --git a/gcc/testsuite/gm2/pim/pass/settest2.mod b/gcc/testsuite/gm2/pim/pass/settest2.mod
new file mode 100644
index 00000000000..e1db9cfd31a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/settest2.mod
@@ -0,0 +1,8 @@
+MODULE settest2 ;
+
+TYPE BigSet = SET OF [0..10000];
+                                                                                
+        
+BEGIN
+        (******)                                               
+END settest2.
diff --git a/gcc/testsuite/gm2/pim/pass/settest3.mod b/gcc/testsuite/gm2/pim/pass/settest3.mod
new file mode 100644
index 00000000000..879a311936d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/settest3.mod
@@ -0,0 +1,8 @@
+MODULE settest3 ;
+
+TYPE BigSet = SET OF CARDINAL;                                                                                
+        
+BEGIN
+        (******)                                               
+END settest3.
+
diff --git a/gcc/testsuite/gm2/pim/pass/simpleproc.mod b/gcc/testsuite/gm2/pim/pass/simpleproc.mod
new file mode 100644
index 00000000000..6b1123ed864
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/simpleproc.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE simpleproc ;
+
+CONST
+   foo = 10 ;
+(*
+VAR
+   MyGlobalVar: CARDINAL ;
+*)
+
+PROCEDURE a ;
+VAR
+   d: CARDINAL ;
+BEGIN
+   d := foo
+END a ;
+
+
+PROCEDURE b ;
+BEGIN
+END b ;
+
+PROCEDURE c ;
+BEGIN
+END c ;
+
+BEGIN
+(*   a ; *)
+(*   b *)
+END simpleproc.
diff --git a/gcc/testsuite/gm2/pim/pass/sizes.mod b/gcc/testsuite/gm2/pim/pass/sizes.mod
new file mode 100644
index 00000000000..3f2883628c7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/sizes.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE sizes ;
+
+FROM libc IMPORT printf ;
+FROM SYSTEM IMPORT SIZE ;
+
+VAR
+   r: INTEGER ;
+BEGIN
+   r := printf("the sizeof(INTEGER) is %d bytes\n", SIZE(INTEGER)) ;
+   r := printf("the sizeof(BOOLEAN) is %d bytes\n", SIZE(BOOLEAN)) ;
+END sizes.
diff --git a/gcc/testsuite/gm2/pim/pass/sizetype.mod b/gcc/testsuite/gm2/pim/pass/sizetype.mod
new file mode 100644
index 00000000000..fb8427f8d91
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/sizetype.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE sizetype ;
+
+FROM SYSTEM IMPORT SIZE;
+
+VAR
+   n: CARDINAL ;
+BEGIN
+   n := SIZE(INTEGER)
+END sizetype.
diff --git a/gcc/testsuite/gm2/pim/pass/smallset1.mod b/gcc/testsuite/gm2/pim/pass/smallset1.mod
new file mode 100644
index 00000000000..29a39c4a8a6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/smallset1.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE smallset1 ;
+
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+VAR
+   b: BITSET ;
+   i, j: CARDINAL ;
+BEGIN
+   j := 1 ;
+   b := {} ;
+   FOR i := 0 TO MAX(BITSET) DO
+      WriteString('index = ') ; WriteCard(i, 2) ; WriteLn ;
+      INCL(b, i) ;
+      IF VAL(CARDINAL, b)#j
+      THEN
+         exit(1)
+      END ;
+      EXCL(b, i) ;
+      IF b#{}
+      THEN
+         exit(2)
+      END ;
+      j := j*2
+   END
+END smallset1.
diff --git a/gcc/testsuite/gm2/pim/pass/smallset2.mod b/gcc/testsuite/gm2/pim/pass/smallset2.mod
new file mode 100644
index 00000000000..335f584102a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/smallset2.mod
@@ -0,0 +1,63 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE smallset2 ;
+
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+PROCEDURE TestIn (i: CARDINAL) ;
+VAR
+   j: CARDINAL ;
+BEGIN
+   IF NOT (i IN b)
+   THEN
+      exit(3)
+   END ;
+   FOR j := 0 TO MAX(BITSET) DO
+      IF (i#j) AND (j IN b)
+      THEN
+         exit(4)
+      END
+   END
+END TestIn ;
+
+
+VAR
+   b: BITSET ;
+   i, j: CARDINAL ;
+BEGIN
+   j := 1 ;
+   b := {} ;
+   FOR i := 0 TO MAX(BITSET) DO
+      WriteString('index = ') ; WriteCard(i, 2) ; WriteLn ;
+      INCL(b, i) ;
+      IF VAL(CARDINAL, b)#j
+      THEN
+         exit(1)
+      END ;
+      TestIn(i) ;
+      EXCL(b, i) ;
+      IF b#{}
+      THEN
+         exit(2)
+      END ;
+      j := j*2
+   END
+END smallset2.
diff --git a/gcc/testsuite/gm2/pim/pass/smallset3.mod b/gcc/testsuite/gm2/pim/pass/smallset3.mod
new file mode 100644
index 00000000000..b6e37c0c6e2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/smallset3.mod
@@ -0,0 +1,79 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE smallset3 ;
+
+FROM libc IMPORT exit ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+VAR
+   b: BITSET ;
+   j: CARDINAL ;
+BEGIN
+   j := 1 ;
+   b := {} ;
+   WriteString('index = ') ; WriteCard(1, 2) ; WriteLn ;
+   INCL(b, 1) ;
+   IF VAL(CARDINAL, b)#2
+   THEN
+      exit(1)
+   END ;
+   IF NOT (1 IN b)
+   THEN
+      exit(3)
+   END ;
+   IF 1 IN b
+   THEN
+      INC(j)
+   ELSE
+      exit(4)
+   END ;
+
+   EXCL(b, 1) ;
+   IF b#{}
+   THEN
+      exit(2)
+   END ;
+
+   j := 20 ;
+   b := {} ;
+   WriteString('index = ') ; WriteCard(20, 2) ; WriteLn ;
+   INCL(b, 20) ;
+   IF VAL(CARDINAL, b)#1048576
+   THEN
+      exit(1)
+   END ;
+   IF NOT (20 IN b)
+   THEN
+      exit(3)
+   END ;
+   IF 20 IN b
+   THEN
+      INC(j)
+   ELSE
+      exit(4)
+   END ;
+
+   EXCL(b, 20) ;
+   IF b#{}
+   THEN
+      exit(2)
+   END
+
+END smallset3.
diff --git a/gcc/testsuite/gm2/pim/pass/smallset4.mod b/gcc/testsuite/gm2/pim/pass/smallset4.mod
new file mode 100644
index 00000000000..ec5a8c10fa1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/smallset4.mod
@@ -0,0 +1,102 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE smallset4 ;
+
+
+FROM libc IMPORT exit ;
+
+TYPE
+   tokens = (eoftok, plustok, minustok, timestok, dividetok, becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok, repeattok, returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, integertok, identtok, realtok, stringtok) ;
+
+   SetOfStop0 = SET OF [eoftok..begintok] ;
+   SetOfStop1 = SET OF [bytok..thentok] ;
+   SetOfStop2 = SET OF [totok..stringtok] ;
+   
+VAR
+   s0: SetOfStop0 ;
+   s1: SetOfStop1 ;
+   s2: SetOfStop2 ;
+   i : tokens ;
+BEGIN
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   INCL(s0, plustok) ;
+   IF NOT (plustok IN s0)
+   THEN
+      exit(1)
+   END ;
+   INCL(s1, casetok) ;
+   IF NOT (casetok IN s1)
+   THEN
+      exit(1)
+   END ;
+   INCL(s2, realtok) ;
+   IF NOT (realtok IN s2)
+   THEN
+      exit(1)
+   END ;
+   EXCL(s0, plustok) ;
+   IF s0#SetOfStop0{}
+   THEN
+      exit(2)
+   END ;
+   EXCL(s1, casetok) ;
+   IF s1#SetOfStop1{}
+   THEN
+      exit(2)
+   END ;
+   EXCL(s2, realtok) ;
+   IF s2#SetOfStop2{}
+   THEN
+      exit(2)
+   END ;
+   FOR i := MIN(SetOfStop0) TO MAX(SetOfStop0) DO
+      INCL(s0, i) ;
+      IF i IN s0
+      THEN
+         EXCL(s0, i) ;
+         IF i IN s0
+         THEN
+            exit(3)
+         END
+      END
+   END ;
+   FOR i := MIN(SetOfStop1) TO MAX(SetOfStop1) DO
+      INCL(s1, i) ;
+      IF i IN s1
+      THEN
+         EXCL(s1, i) ;
+         IF i IN s1
+         THEN
+            exit(3)
+         END
+      END
+   END ;
+   FOR i := MIN(SetOfStop2) TO MAX(SetOfStop2) DO
+      INCL(s2, i) ;
+      IF i IN s2
+      THEN
+         EXCL(s2, i) ;
+         IF i IN s2
+         THEN
+            exit(3)
+         END
+      END
+   END
+END smallset4.
diff --git a/gcc/testsuite/gm2/pim/pass/smallset5.mod b/gcc/testsuite/gm2/pim/pass/smallset5.mod
new file mode 100644
index 00000000000..fafbef8b685
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/smallset5.mod
@@ -0,0 +1,49 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE smallset5 ;
+
+FROM libc IMPORT exit ;
+
+
+TYPE
+   tokens = (eoftok, plustok, minustok, timestok, dividetok, becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok, repeattok, returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, integertok, identtok, realtok, stringtok) ;
+
+   SetOfStop0 = SET OF [eoftok..begintok] ;
+   SetOfStop1 = SET OF [bytok..thentok] ;
+   SetOfStop2 = SET OF [totok..stringtok] ;
+   
+VAR
+   s0, s4: SetOfStop0 ;
+   s1: SetOfStop1 ;
+   s2: SetOfStop2 ;
+BEGIN
+   s0 := SetOfStop0{eoftok} ;
+   s0 := s0 + SetOfStop0{plustok} ;
+
+   IF s0#SetOfStop0{eoftok, plustok}
+   THEN
+      exit(1)
+   END ;
+
+   s4 := SetOfStop0{timestok, becomestok} ;
+   s0 := s0 + s4 ;
+   IF s0#SetOfStop0{eoftok, plustok, timestok, becomestok}
+   THEN
+      exit(2)
+   END
+END smallset5.
diff --git a/gcc/testsuite/gm2/pim/pass/smallset6.mod b/gcc/testsuite/gm2/pim/pass/smallset6.mod
new file mode 100644
index 00000000000..97f053c4e15
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/smallset6.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE smallset6 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   tokens = (eoftok, plustok, minustok, timestok, dividetok, becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok, repeattok, returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, integertok, identtok, realtok, stringtok) ;
+
+   SetOfStop0 = SET OF [eoftok..begintok] ;
+   SetOfStop1 = SET OF [bytok..thentok] ;
+   SetOfStop2 = SET OF [totok..stringtok] ;
+
+VAR
+   currenttoken: tokens ;
+BEGIN
+   currenttoken := proceduretok ;
+
+   WHILE ((currenttoken>=bytok) AND (currenttoken<totok) AND (currenttoken IN SetOfStop1 {proceduretok, consttok})) OR
+         ((currenttoken>=totok) AND (currenttoken IN SetOfStop2 {vartok, typetok})) DO
+      exit(0)
+   END (* while *) ;
+   exit(1)
+END smallset6.
diff --git a/gcc/testsuite/gm2/pim/pass/smallset7.mod b/gcc/testsuite/gm2/pim/pass/smallset7.mod
new file mode 100644
index 00000000000..5ec3c919dc2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/smallset7.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE smallset7 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   b: BITSET ;
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   IF i IN {1, 2, 3}
+   THEN
+      exit(0)
+   ELSE
+      exit(1)
+   END
+END smallset7.
diff --git a/gcc/testsuite/gm2/pim/pass/stabs.mod b/gcc/testsuite/gm2/pim/pass/stabs.mod
new file mode 100644
index 00000000000..735304693dc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/stabs.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE stabs ;
+
+
+TYPE
+   foo = POINTER TO INTEGER ;
+
+VAR
+   p: POINTER TO CARDINAL ;
+   q: foo ;
+BEGIN
+   q := NIL
+END stabs.
diff --git a/gcc/testsuite/gm2/pim/pass/stdio.mod b/gcc/testsuite/gm2/pim/pass/stdio.mod
new file mode 100644
index 00000000000..f121a8c864f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/stdio.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE stdio ;   (*!m2pim*)
+
+CONST
+   MaxStack = 40 ;
+
+TYPE
+   ProcWrite = PROCEDURE (CHAR) ;
+
+VAR
+   StackW   : ARRAY [0..MaxStack] OF ProcWrite ;
+   StackWPtr: CARDINAL ;
+
+
+PROCEDURE write (ch: CHAR) ;
+BEGIN
+
+END write ;
+
+
+PROCEDURE PushOutput (p: ProcWrite) ;
+BEGIN
+   IF StackWPtr=MaxStack
+   THEN
+      HALT
+   ELSE
+      INC(StackWPtr) ;
+      StackW[StackWPtr] := p
+   END
+END PushOutput ;
+
+
+BEGIN
+   StackWPtr := 0 ;
+   PushOutput(write)
+END stdio.
diff --git a/gcc/testsuite/gm2/pim/pass/str1.mod b/gcc/testsuite/gm2/pim/pass/str1.mod
new file mode 100644
index 00000000000..a7ae33e8848
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/str1.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE str1 ;
+
+
+FROM StrLib IMPORT StrCopy ;
+
+PROCEDURE hello2 (s: ARRAY OF CHAR) ;
+BEGIN
+END hello2 ;
+
+
+PROCEDURE hello (s: ARRAY OF CHAR) ;
+BEGIN
+   hello2(s)
+END hello ;
+
+
+VAR
+   a: ARRAY [0..15] OF CHAR ;
+BEGIN
+   (* StrCopy('hello world', a) ; *)
+   a := 'hello world' ;
+   hello(a)
+END str1.
diff --git a/gcc/testsuite/gm2/pim/pass/str2.mod b/gcc/testsuite/gm2/pim/pass/str2.mod
new file mode 100644
index 00000000000..6519fed25ee
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/str2.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE str2 ;
+
+
+PROCEDURE hello (s: ARRAY OF CHAR) ;
+VAR
+   j,
+   i: CARDINAL ;
+BEGIN
+   i := 2 ;
+   s[i] := 'a'
+END hello ;
+
+
+VAR
+   a: ARRAY [0..50] OF CHAR ;
+BEGIN
+   hello(a)
+END str2.
diff --git a/gcc/testsuite/gm2/pim/pass/str3.mod b/gcc/testsuite/gm2/pim/pass/str3.mod
new file mode 100644
index 00000000000..cf4af15bb4f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/str3.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE str3 ;
+
+FROM StdIO IMPORT Write ;
+
+PROCEDURE hello (s: ARRAY OF CHAR) ;
+VAR
+   i,
+   h: CARDINAL ;
+BEGIN
+   i := 0 ;
+   h := HIGH(s) ;
+   WHILE i<=h DO
+      Write(s[i]) ;
+      INC(i)
+   END
+END hello ;
+
+
+BEGIN
+   hello('hello world')
+END str3.
diff --git a/gcc/testsuite/gm2/pim/pass/str4.mod b/gcc/testsuite/gm2/pim/pass/str4.mod
new file mode 100644
index 00000000000..6eadfe389f8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/str4.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE str4 ;
+
+CONST
+   max = 79 ;
+
+VAR
+   a: ARRAY [0..max] OF CHAR ;
+BEGIN
+   a := 'hello world'
+END str4.
diff --git a/gcc/testsuite/gm2/pim/pass/str5.mod b/gcc/testsuite/gm2/pim/pass/str5.mod
new file mode 100644
index 00000000000..801046c0ac9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/str5.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE str5 ;
+
+
+PROCEDURE attempt (first: CARDINAL; second: ARRAY OF CHAR; third: CARDINAL) ;
+BEGIN
+   
+END attempt ;
+
+
+BEGIN
+   attempt(1, "the second", 3)
+END str5.
diff --git a/gcc/testsuite/gm2/pim/pass/stressset.mod b/gcc/testsuite/gm2/pim/pass/stressset.mod
new file mode 100644
index 00000000000..6a11e64e02a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/stressset.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE stressset ;
+
+TYPE
+   range = [low..nrBits] ;
+
+PROCEDURE func (b: myset) ;
+BEGIN
+   
+END func ;
+
+TYPE
+   myset = SET OF range ;
+
+CONST
+   nrBits = 64-foo ;
+   low    = nrBits-nrBits ;
+   foo    = 32 ;
+
+BEGIN
+   func(myset{})
+END stressset.
diff --git a/gcc/testsuite/gm2/pim/pass/stringassign.mod b/gcc/testsuite/gm2/pim/pass/stringassign.mod
new file mode 100644
index 00000000000..9e7fe7a8678
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/stringassign.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE stringassign ;
+
+
+TYPE
+   ErrorNumber = [0..10];
+   ErrorMessage = ARRAY [0..9] OF CHAR;
+VAR
+   message: ARRAY ErrorNumber OF ErrorMessage;
+BEGIN
+   message[0] := ""
+END stringassign.
diff --git a/gcc/testsuite/gm2/pim/pass/stringopaq.mod b/gcc/testsuite/gm2/pim/pass/stringopaq.mod
new file mode 100644
index 00000000000..e35ca3136a0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/stringopaq.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE stringopaq ;
+
+FROM DynamicStrings IMPORT String, InitString ;
+
+VAR
+   s: String ;
+BEGIN
+   s := InitString('')
+END stringopaq.
diff --git a/gcc/testsuite/gm2/pim/pass/strings.mod b/gcc/testsuite/gm2/pim/pass/strings.mod
new file mode 100644
index 00000000000..c17736efa41
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/strings.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE strings ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+
+VAR
+   a: ADDRESS ;
+   b: ARRAY [0..20] OF CHAR ;
+BEGIN
+   b := "hello world" ;
+   a := ADR(b)
+END strings.
diff --git a/gcc/testsuite/gm2/pim/pass/strparam.def b/gcc/testsuite/gm2/pim/pass/strparam.def
new file mode 100644
index 00000000000..b8518d1b38a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/strparam.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+DEFINITION MODULE strparam ;
+
+PROCEDURE toint (a: ARRAY OF CHAR; VAR x: INTEGER) ;
+
+END strparam.
diff --git a/gcc/testsuite/gm2/pim/pass/strparam.mod b/gcc/testsuite/gm2/pim/pass/strparam.mod
new file mode 100644
index 00000000000..6ac94a69e03
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/strparam.mod
@@ -0,0 +1,86 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+IMPLEMENTATION MODULE strparam ;
+
+(*
+FROM ASCII IMPORT nul ;
+FROM StrLib IMPORT StrLen, StrRemoveWhitePrefix ;
+*)
+
+
+PROCEDURE toint (a: ARRAY OF CHAR; VAR x: INTEGER) ;
+BEGIN
+   x := 0
+END toint ;
+
+(*
+VAR
+   i        : CARDINAL ;
+   ok,
+   Negative : BOOLEAN ;
+   higha    : CARDINAL ;
+BEGIN
+   StrRemoveWhitePrefix(a, a) ;
+   higha := StrLen(a) ;
+   i := 0 ;
+   Negative := FALSE ;
+   ok := TRUE ;
+   WHILE ok DO
+      IF i<higha
+      THEN
+         IF a[i]='-'
+         THEN
+            INC(i) ;
+            Negative := NOT Negative
+         ELSIF (a[i]<'0') OR (a[i]>'9')
+         THEN
+            INC(i)
+         ELSE
+            ok := FALSE
+         END
+      ELSE
+         ok := FALSE
+      END
+   END ;
+   x := 0 ;
+   IF i<higha
+   THEN
+      ok := TRUE ;
+      REPEAT
+         IF Negative
+         THEN
+            x := 10*x - INTEGER(ORD(a[i])-ORD('0'))
+         ELSE
+            x := 10*x + INTEGER(ORD(a[i])-ORD('0'))
+         END ;
+         IF i<higha
+         THEN
+            INC(i) ;
+            IF (a[i]<'0') OR (a[i]>'9')
+            THEN
+               ok := FALSE
+            END
+         ELSE
+            ok := FALSE
+         END
+      UNTIL NOT ok ;
+   END
+END toint ;
+*)
+
+END strparam.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange.mod b/gcc/testsuite/gm2/pim/pass/subrange.mod
new file mode 100644
index 00000000000..3f98af7d840
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE subrange ;
+
+
+VAR
+   t: [12..16] ;
+   s: ['a'..'z'] ;
+BEGIN
+   t := 12
+END subrange.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange10.mod b/gcc/testsuite/gm2/pim/pass/subrange10.mod
new file mode 100644
index 00000000000..60882d5bf37
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange10.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange10 ;
+
+CONST
+   beforeouter = 1000 + 1 ;
+
+PROCEDURE outer;
+CONST
+   beforeinner = 2000 + 1 ;
+
+   PROCEDURE inner;
+   TYPE
+      ind1 = [-200..200];
+   CONST
+      low = ind1(-200);
+   BEGIN
+   END inner;
+
+TYPE
+   ind0 = [-100..100];
+CONST
+   low = ind0(-100);
+   inouter = 3000 + 1;
+
+BEGIN
+END outer;
+
+BEGIN
+   outer
+END subrange10.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange11.mod b/gcc/testsuite/gm2/pim/pass/subrange11.mod
new file mode 100644
index 00000000000..c2420e57f24
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange11.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange11 ;
+
+PROCEDURE outer;
+
+CONST
+   beforeinner = 1000 + 1 ;
+
+   PROCEDURE inner;
+   TYPE
+      ind1 = [-200..200];
+   CONST
+      low = ind1(-200);
+   BEGIN
+   END inner;
+
+VAR
+   a: array ;
+TYPE
+   ind0 = [-100..100];
+   array = ARRAY [low..0] OF CHAR ;
+CONST
+   low = ind0(-100);
+
+
+BEGIN
+END outer;
+
+BEGIN
+   outer
+END subrange11.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange12.mod b/gcc/testsuite/gm2/pim/pass/subrange12.mod
new file mode 100644
index 00000000000..4ae1cbffaa0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange12.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange12 ;
+
+TYPE  ind0 = [-100..100];
+
+CONST low  = ind0(-100);
+CONST high = ind0(100);
+TYPE  ind  = [low..high];
+
+VAR a: ARRAY [0..100] OF CHAR ;
+VAR b: ARRAY ind OF CHAR ;
+
+BEGIN
+END subrange12.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange14.mod b/gcc/testsuite/gm2/pim/pass/subrange14.mod
new file mode 100644
index 00000000000..3d21b62dc91
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange14.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE subrange14 ;
+
+TYPE
+   range = [1..20] ;
+
+VAR
+   r: range ;
+BEGIN
+   r := 1 ;
+   DEC(r)
+END subrange14.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange15.mod b/gcc/testsuite/gm2/pim/pass/subrange15.mod
new file mode 100644
index 00000000000..28e08e6d42d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange15.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange15 ;
+
+TYPE
+   t = [20..40] ;
+VAR
+   s: t ;
+BEGIN
+   s := 20 ;
+   s := 21 ;
+   s := 21 ;
+   s := 21 ;
+   s := 21 ;
+   s := 39
+END subrange15.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange16.mod b/gcc/testsuite/gm2/pim/pass/subrange16.mod
new file mode 100644
index 00000000000..b35973ed5b0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange16.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange16 ;
+
+TYPE
+   t = ['A'..'Z'] ;
+VAR
+   s: t ;
+BEGIN
+   s := 'A' ;
+   s := 'B' ;
+   s := 'B' ;
+   s := 'B' ;
+   s := 'B' ;
+   s := 'B' ;
+   s := 'Z'
+END subrange16.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange17.mod b/gcc/testsuite/gm2/pim/pass/subrange17.mod
new file mode 100644
index 00000000000..0c9aba22657
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange17.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange17 ;
+
+TYPE
+   colour = (blue, red, yellow, green) ;
+   t = [blue..yellow] ;
+VAR
+   s: t ;
+BEGIN
+   s := blue ;
+   s := red ;
+   s := red ;
+   s := red ;
+   s := red ;
+   s := red ;
+   s := yellow
+END subrange17.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange2.mod b/gcc/testsuite/gm2/pim/pass/subrange2.mod
new file mode 100644
index 00000000000..e9d719ea16e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE subrange2 ;
+
+TYPE
+   foo = LONGCARD ;
+VAR
+   t: foo [12..16] ;
+   s: ['a'..'z'] ;
+BEGIN
+   t := 12
+END subrange2.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange3.mod b/gcc/testsuite/gm2/pim/pass/subrange3.mod
new file mode 100644
index 00000000000..7460c261970
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange3.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange3 ;
+
+PROCEDURE proc;
+TYPE
+   ind0 = [-100..100];
+CONST
+   low = ind0(-100);
+BEGIN
+END proc;
+
+BEGIN
+   proc
+END subrange3.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange4.mod b/gcc/testsuite/gm2/pim/pass/subrange4.mod
new file mode 100644
index 00000000000..b507dd21519
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange4.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange4 ;
+
+CONST
+   low = ind0(-100);
+   high = ind0(100);
+TYPE
+   ind = [low..high];
+   ind0 = [-100..100];
+
+VAR
+   a : ARRAY [0..100] OF INTEGER;
+   b : ARRAY ind OF INTEGER;
+
+BEGIN
+END subrange4.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange5.mod b/gcc/testsuite/gm2/pim/pass/subrange5.mod
new file mode 100644
index 00000000000..8f34874f358
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange5.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange5 ;
+
+VAR
+   a: ARRAY ['a'..'c'] OF INTEGER ;
+BEGIN
+   a['b'] := 3
+END subrange5.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange6.mod b/gcc/testsuite/gm2/pim/pass/subrange6.mod
new file mode 100644
index 00000000000..2c98624fe1d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange6.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE subrange6 ;
+
+
+TYPE
+   foo = [-1..1] ;
+VAR
+   bar: foo ;
+BEGIN
+
+END subrange6.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange7.mod b/gcc/testsuite/gm2/pim/pass/subrange7.mod
new file mode 100644
index 00000000000..5166667eb78
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange7.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE subrange7 ;
+
+CONST
+   low = ind0(61);
+   high = ind0(100);
+TYPE
+   ind = [low..high];
+   ind0 = [60..100];
+
+VAR
+   a : ARRAY [10..100] OF INTEGER;
+   b : ARRAY ind OF INTEGER;
+
+BEGIN
+END subrange7.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange8.mod b/gcc/testsuite/gm2/pim/pass/subrange8.mod
new file mode 100644
index 00000000000..ea84155c3e1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange8.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange8 ;
+
+TYPE
+   ind = [50..99];
+   ind0 = [60..100];
+
+VAR
+   a : ARRAY [10..100] OF INTEGER;
+   b : ARRAY ind OF INTEGER;
+
+BEGIN
+END subrange8.
diff --git a/gcc/testsuite/gm2/pim/pass/subrange9.mod b/gcc/testsuite/gm2/pim/pass/subrange9.mod
new file mode 100644
index 00000000000..53ecb44588f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/subrange9.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE subrange9 ;
+
+PROCEDURE outer;
+
+CONST
+   beforeinner = 1000 + 1 ;
+
+   PROCEDURE inner;
+   TYPE
+      ind1 = [-200..200];
+   CONST
+      low = ind1(-200);
+   BEGIN
+   END inner;
+
+TYPE
+   ind0 = [-100..100];
+CONST
+   low = ind0(-100);
+
+
+BEGIN
+END outer;
+
+BEGIN
+   outer
+END subrange9.
diff --git a/gcc/testsuite/gm2/pim/pass/test2recursive.mod b/gcc/testsuite/gm2/pim/pass/test2recursive.mod
new file mode 100644
index 00000000000..9596abe7fa5
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/test2recursive.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE test2recursive ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM testrecursive IMPORT test_type;
+
+VAR
+   r: test_type ;
+BEGIN
+  WriteString('hello world') ; WriteLn;
+END test2recursive.
+
diff --git a/gcc/testsuite/gm2/pim/pass/testabs.mod b/gcc/testsuite/gm2/pim/pass/testabs.mod
new file mode 100644
index 00000000000..82bf6228706
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testabs.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testabs ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: CARDINAL ;
+   j: INTEGER ;
+BEGIN
+   i := ABS(-1) ;
+   j := 35 ;
+   j := ABS(j) ;
+   j := -10 ;
+   j := ABS(j) ;
+   j := 21 ;
+   IF NOT ODD(j)
+   THEN
+      exit(1)
+   END
+END testabs.
diff --git a/gcc/testsuite/gm2/pim/pass/testbuiltin.mod b/gcc/testsuite/gm2/pim/pass/testbuiltin.mod
new file mode 100644
index 00000000000..3c41b35691d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testbuiltin.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testbuiltin ;
+
+FROM builtin IMPORT alloca, memcopy, sinl, sinf ;
+FROM SYSTEM IMPORT ADDRESS, ADR, SIZE ;
+
+CONST
+   pi = 3.14159 ;
+
+VAR
+   a, b: ADDRESS ;
+   x, y: ARRAY [0..1023] OF CHAR ;
+   l   : LONGREAL ;
+   r   : REAL ;
+BEGIN
+   a := alloca (1024) ;
+   b := alloca (1024) ;
+   a := memcopy (a, b, 16) ;
+   r := 3.14 ;
+   r := sinf(r) ;
+   l := 3.14 ;
+   l := sinl(l) ;
+END testbuiltin.
diff --git a/gcc/testsuite/gm2/pim/pass/testbuiltin2.mod b/gcc/testsuite/gm2/pim/pass/testbuiltin2.mod
new file mode 100644
index 00000000000..fa7920dc185
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testbuiltin2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testbuiltin2 ;
+
+FROM Builtins IMPORT alloca, memcpy, strlen ;
+FROM SYSTEM IMPORT ADDRESS, ADR, SIZE ;
+
+TYPE
+   foo = PROCEDURE (ADDRESS) : INTEGER ;
+
+VAR
+   x, y: CARDINAL ;
+   a, b: ADDRESS ;
+   s   : ARRAY [0..100] OF CHAR ;
+   p   : foo ;
+BEGIN
+   a := memcpy(ADR(x), ADR(y), SIZE(x)) ;
+   b := alloca(1023) ;
+   s := "hello world" ;
+   p := strlen ;
+   x := p(ADR(s))
+END testbuiltin2.
diff --git a/gcc/testsuite/gm2/pim/pass/testbuiltstr.mod b/gcc/testsuite/gm2/pim/pass/testbuiltstr.mod
new file mode 100644
index 00000000000..d9ecf37b723
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testbuiltstr.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testbuiltstr ;
+
+
+FROM builtin IMPORT memset ;
+FROM SYSTEM IMPORT ADR, SIZE, ADDRESS ;
+
+VAR
+   s: ARRAY [0..3] OF CHAR ;
+   p: ADDRESS ;
+BEGIN
+   p := memset(ADR(s), 0, SIZE(s))
+END testbuiltstr.
diff --git a/gcc/testsuite/gm2/pim/pass/testcap.mod b/gcc/testsuite/gm2/pim/pass/testcap.mod
new file mode 100644
index 00000000000..868194fb81e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcap.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcap ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   a, z, A, B,
+   ch        : CHAR ;
+BEGIN
+   ch := CAP('a') ;
+   z := 'z' ;
+   z := CAP(z) ;
+   A := 'A' ;
+   A := CAP(A) ;
+   B := CAP('B')
+END testcap.
diff --git a/gcc/testsuite/gm2/pim/pass/testcap2.mod b/gcc/testsuite/gm2/pim/pass/testcap2.mod
new file mode 100644
index 00000000000..9ac80f93c52
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcap2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcap2 ;
+
+FROM libc IMPORT exit ;
+
+CONST
+   A = CAP(VAL(CHAR, 65)) ;
+
+PROCEDURE nothing ;
+BEGIN
+END nothing ;
+
+VAR
+   c: CARDINAL ;
+   i: INTEGER ;
+   ch: CHAR ;
+BEGIN
+   ch := CAP(VAL(CHAR, ch)) ;
+   ch := CAP(A)
+END testcap2.
diff --git a/gcc/testsuite/gm2/pim/pass/testcard.mod b/gcc/testsuite/gm2/pim/pass/testcard.mod
new file mode 100644
index 00000000000..0bce6474c23
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcard.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcard ;
+
+
+CONST
+   MinInt = -2147483648 ;
+BEGIN
+
+END testcard.
diff --git a/gcc/testsuite/gm2/pim/pass/testcard2.mod b/gcc/testsuite/gm2/pim/pass/testcard2.mod
new file mode 100644
index 00000000000..611d37bbed0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcard2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcard2 ;
+
+
+TYPE
+   INTEGER32 = INTEGER ;
+   INT32 = INTEGER32 ;
+CONST
+   MinInt = VAL(INT32, -2147483648) ;
+
+BEGIN
+
+END testcard2.
diff --git a/gcc/testsuite/gm2/pim/pass/testcard3.mod b/gcc/testsuite/gm2/pim/pass/testcard3.mod
new file mode 100644
index 00000000000..3108c4fe721
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcard3.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcard3 ;
+
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 2147483648
+END testcard3.
diff --git a/gcc/testsuite/gm2/pim/pass/testcard4.mod b/gcc/testsuite/gm2/pim/pass/testcard4.mod
new file mode 100644
index 00000000000..d710ad87080
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcard4.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcard4 ;
+
+
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 214748364 ;
+   c := c*10+8 ;
+   IF c=0
+   THEN
+   END
+END testcard4.
diff --git a/gcc/testsuite/gm2/pim/pass/testcard5.mod b/gcc/testsuite/gm2/pim/pass/testcard5.mod
new file mode 100644
index 00000000000..50de68fdbc9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcard5.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcard5 ;
+
+
+VAR
+   c: LONGINT ;
+BEGIN
+   (* MAX(CARDINAL) + 1 for 32 bit machines *)
+   c := 4294967297
+END testcard5.
diff --git a/gcc/testsuite/gm2/pim/pass/testcase.mod b/gcc/testsuite/gm2/pim/pass/testcase.mod
new file mode 100644
index 00000000000..65d1ea9699a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcase.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcase ;
+
+
+VAR
+   b, i: CARDINAL ;
+BEGIN
+   FOR i := 0 TO 3 DO
+      CASE i OF
+
+      | 0: b := 10
+      | 1: b := 15
+      | 2: b := 20
+
+      ELSE
+         b := 25
+      END
+   END
+END testcase.
diff --git a/gcc/testsuite/gm2/pim/pass/testcase2.mod b/gcc/testsuite/gm2/pim/pass/testcase2.mod
new file mode 100644
index 00000000000..b6c588f562d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcase2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcase2 ;
+
+TYPE
+   foo = RECORD
+            CASE  x:CARDINAL OF
+              1 : a : CHAR ;
+            | 2 : b : INTEGER ;
+            ELSE
+            END;
+          END;
+
+BEGIN
+END testcase2.
diff --git a/gcc/testsuite/gm2/pim/pass/testcase3.mod b/gcc/testsuite/gm2/pim/pass/testcase3.mod
new file mode 100644
index 00000000000..f0b8c140b98
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcase3.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcase3 ;
+
+VAR
+   b, i: CARDINAL ;
+BEGIN
+   FOR i := 0 TO 3 DO
+      CASE i OF
+
+        0: b := 10 |
+        1: b := 15 |
+        2: b := 20
+      
+      ELSE
+         b := 25
+      END
+   END
+END testcase3.
diff --git a/gcc/testsuite/gm2/pim/pass/testcase4.mod b/gcc/testsuite/gm2/pim/pass/testcase4.mod
new file mode 100644
index 00000000000..efb6a58cea7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testcase4.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testcase4 ;
+
+TYPE
+   foo = RECORD
+            CASE :CARDINAL OF
+              1 : a : CHAR ;
+            | 2 : b : INTEGER ;
+            ELSE
+            END;
+          END;
+
+BEGIN
+END testcase4.
diff --git a/gcc/testsuite/gm2/pim/pass/testchar.mod b/gcc/testsuite/gm2/pim/pass/testchar.mod
new file mode 100644
index 00000000000..07d5d412c8c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testchar.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testchar ;
+
+
+TYPE
+   T1 = CHAR ;
+   T2 = CHAR ;
+
+VAR
+   t1: T1 ;
+   t2: T2 ;
+BEGIN
+   t2 := t1
+END testchar.
diff --git a/gcc/testsuite/gm2/pim/pass/testfloat.mod b/gcc/testsuite/gm2/pim/pass/testfloat.mod
new file mode 100644
index 00000000000..fd3510b0395
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testfloat.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testfloat ;
+
+PROCEDURE local ;
+VAR
+   f: REAL ;
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   f := 10.0 ;
+   WHILE f/10.0>=FLOAT(i) DO
+      INC(i)
+   END
+END local ;
+
+BEGIN
+   local
+END testfloat.
diff --git a/gcc/testsuite/gm2/pim/pass/testfloat2.mod b/gcc/testsuite/gm2/pim/pass/testfloat2.mod
new file mode 100644
index 00000000000..53fbc5c8033
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testfloat2.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testfloat2 ;
+
+(*
+   ToThePower10 - returns a LONGREAL containing the value of v * 10^power.
+*)
+
+PROCEDURE ToThePower10 (v: LONGREAL; power: CARDINAL) : LONGREAL;
+VAR 
+   i: CARDINAL;
+BEGIN
+   i := 0 ;
+   WHILE i<power DO
+      v := v * 10.0 ;
+      INC(i)
+   END ;
+   RETURN( VAL(LONGREAL, v) )
+END ToThePower10 ;
+
+VAR
+   x: LONGREAL ;
+   NonTruncedDigits: CARDINAL ;
+BEGIN
+   WHILE x/ToThePower10(1.0, NonTruncedDigits) >= VAL(LONGREAL, MAX(INTEGER) DIV 10) DO
+      INC(NonTruncedDigits)
+   END
+END testfloat2.
diff --git a/gcc/testsuite/gm2/pim/pass/testfloat3.mod b/gcc/testsuite/gm2/pim/pass/testfloat3.mod
new file mode 100644
index 00000000000..53827629a91
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testfloat3.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testfloat3 ;
+
+(*
+   ToThePower10 - returns a LONGREAL containing the value of v * 10^power.
+*)
+
+PROCEDURE ToThePower10 (v: LONGREAL; power: CARDINAL) : LONGREAL;
+VAR 
+   i: CARDINAL;
+BEGIN
+   i := 0 ;
+   WHILE i<power DO
+      v := v * 10.0 ;
+      INC(i)
+   END ;
+   RETURN( VAL(LONGREAL, v) )
+END ToThePower10 ;
+
+VAR
+   x: LONGREAL ;
+   NonTruncedDigits: CARDINAL ;
+BEGIN
+   WHILE x/ToThePower10(1.0, NonTruncedDigits) >= VAL(LONGREAL, 99999) DO
+      INC(NonTruncedDigits)
+   END
+END testfloat3.
diff --git a/gcc/testsuite/gm2/pim/pass/testfloat4.mod b/gcc/testsuite/gm2/pim/pass/testfloat4.mod
new file mode 100644
index 00000000000..ee7ece8f763
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testfloat4.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testfloat4 ;
+
+(*
+   ToThePower10 - returns a LONGREAL containing the value of v * 10^power.
+*)
+
+PROCEDURE ToThePower10 (v: LONGREAL; power: CARDINAL) : LONGREAL;
+VAR 
+   i: CARDINAL;
+BEGIN
+   i := 0 ;
+   WHILE i<power DO
+      v := v * 10.0 ;
+      INC(i)
+   END ;
+   RETURN( v )
+END ToThePower10 ;
+
+VAR
+   x: LONGREAL ;
+   NonTruncedDigits: CARDINAL ;
+   i               : CARDINAL ;
+BEGIN
+   i := 99999 ;
+   WHILE x/ToThePower10(1.0, NonTruncedDigits) >= LFLOAT(i) DO
+      INC(NonTruncedDigits)
+   END
+END testfloat4.
diff --git a/gcc/testsuite/gm2/pim/pass/testfor.mod b/gcc/testsuite/gm2/pim/pass/testfor.mod
new file mode 100644
index 00000000000..5bd2db4efe9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testfor.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testfor ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   FOR i := 1 TO 10 DO
+      WriteCard(i, 0) ; WriteLn
+   END
+END testfor.
diff --git a/gcc/testsuite/gm2/pim/pass/testimpvar.mod b/gcc/testsuite/gm2/pim/pass/testimpvar.mod
new file mode 100644
index 00000000000..a8c07279a33
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testimpvar.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE testimpvar ;
+
+FROM varin IMPORT var ;
+FROM StrIO IMPORT WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+
+BEGIN
+   WriteCard(var, 0) ; WriteLn
+END testimpvar.
diff --git a/gcc/testsuite/gm2/pim/pass/testlong3.mod b/gcc/testsuite/gm2/pim/pass/testlong3.mod
new file mode 100644
index 00000000000..c2001f3e463
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testlong3.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testlong3 ;
+
+VAR
+   l: LONGINT ;
+BEGIN
+   l := 12345678901234
+END testlong3.
diff --git a/gcc/testsuite/gm2/pim/pass/testmod.mod b/gcc/testsuite/gm2/pim/pass/testmod.mod
new file mode 100644
index 00000000000..4984dfbf093
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testmod.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testmod ;
+
+
+VAR
+   i, j: INTEGER ;
+BEGIN
+   j := -51 ;
+   i := j MOD 2 ;
+   j := -50 ;
+   i := j MOD 2
+END testmod.
diff --git a/gcc/testsuite/gm2/pim/pass/testmod2.mod b/gcc/testsuite/gm2/pim/pass/testmod2.mod
new file mode 100644
index 00000000000..f4aed235026
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testmod2.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testmod2 ;
+
+
+MODULE m1 ;
+
+EXPORT M1 ;
+TYPE
+   colour = (red, blue, green) ;
+   M1 = colour ;
+END m1 ;
+
+MODULE m2 ;
+
+IMPORT M1 ;
+EXPORT M2 ;
+
+TYPE
+   M2 = M1 ;
+END m2 ;
+
+TYPE
+   
+CONST
+   c = m2.red ;
+
+END testmod2.
diff --git a/gcc/testsuite/gm2/pim/pass/testodd.mod b/gcc/testsuite/gm2/pim/pass/testodd.mod
new file mode 100644
index 00000000000..05fa59b2b89
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testodd.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testodd ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+BEGIN
+   c := 5 ;
+   IF NOT ODD(c)
+   THEN
+      exit(1)
+   END ;
+   i := -5 ;
+   IF NOT ODD(i)
+   THEN
+      exit(1)
+   END
+END testodd.
diff --git a/gcc/testsuite/gm2/pim/pass/testopaque.mod b/gcc/testsuite/gm2/pim/pass/testopaque.mod
new file mode 100644
index 00000000000..ed6cf6751e3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testopaque.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testopaque ;
+
+FROM opaque IMPORT String ;
+
+
+CONST
+   MaxBuf = 127 - 1 ;
+
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := MaxBuf
+END testopaque.
diff --git a/gcc/testsuite/gm2/pim/pass/testopaque2.mod b/gcc/testsuite/gm2/pim/pass/testopaque2.mod
new file mode 100644
index 00000000000..faa91670ff4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testopaque2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testopaque2 ;
+
+
+FROM opaque IMPORT String ;
+
+VAR
+   o: String ;
+BEGIN
+   o := NIL
+END testopaque2.
diff --git a/gcc/testsuite/gm2/pim/pass/testopaque3.mod b/gcc/testsuite/gm2/pim/pass/testopaque3.mod
new file mode 100644
index 00000000000..3bdfad731c7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testopaque3.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testopaque3 ;
+
+FROM opaquetype IMPORT foo, bar ;
+
+VAR
+   f, g: foo ;
+   a, b: bar ;
+BEGIN
+   f := g;
+   IF a=b
+   THEN
+
+   END
+END testopaque3.
diff --git a/gcc/testsuite/gm2/pim/pass/testord.mod b/gcc/testsuite/gm2/pim/pass/testord.mod
new file mode 100644
index 00000000000..0a45b66708e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testord.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testord ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   c: CARDINAL ;
+   ch: CHAR ;
+BEGIN
+   c := ORD('a') ;
+   ch := 'a' ;
+   IF c#ORD(ch)
+   THEN
+      exit(1)
+   END
+END testord.
diff --git a/gcc/testsuite/gm2/pim/pass/testparam.mod b/gcc/testsuite/gm2/pim/pass/testparam.mod
new file mode 100644
index 00000000000..b20fbd262d2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testparam.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE testparam ;   (*!m2pim*)
+
+
+TYPE
+   myproc = PROCEDURE (VAR CARDINAL) ;
+   myproc2 = PROCEDURE (VAR CARDINAL) ;
+
+
+PROCEDURE foo (VAR p: myproc) ;
+BEGIN
+   p := f
+END foo ;
+
+
+PROCEDURE f (VAR c: CARDINAL) ;
+BEGIN
+END f ;
+
+
+VAR
+   q: myproc2 ;
+BEGIN
+   q := f ;
+   foo (q)
+END testparam.
diff --git a/gcc/testsuite/gm2/pim/pass/testparam2.mod b/gcc/testsuite/gm2/pim/pass/testparam2.mod
new file mode 100644
index 00000000000..e5a93489a93
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testparam2.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE testparam2 ;   (*!m2pim*)
+
+FROM SYSTEM IMPORT WORD ;
+
+
+PROCEDURE foo (VAR p: WORD) ;
+BEGIN
+   p := INTEGER (1)
+END foo ;
+
+
+
+VAR
+   f: INTEGER ;
+BEGIN
+   foo (f)
+END testparam2.
diff --git a/gcc/testsuite/gm2/pim/pass/testparam3.mod b/gcc/testsuite/gm2/pim/pass/testparam3.mod
new file mode 100644
index 00000000000..91294ee3213
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testparam3.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE testparam3 ;   (*!m2pim*)
+
+FROM SYSTEM IMPORT WORD ;
+
+
+PROCEDURE foo (VAR p: WORD) ;
+BEGIN
+   p := 1
+END foo ;
+
+
+
+VAR
+   f: SHORTREAL ;
+BEGIN
+   foo (f)
+END testparam3.
diff --git a/gcc/testsuite/gm2/pim/pass/testpimsize.mod b/gcc/testsuite/gm2/pim/pass/testpimsize.mod
new file mode 100644
index 00000000000..f60028ffde6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testpimsize.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testpimsize ;
+
+FROM SYSTEM IMPORT SIZE ;
+
+VAR
+   b, a: CARDINAL ;
+BEGIN
+   a := SIZE(b)
+END testpimsize.
diff --git a/gcc/testsuite/gm2/pim/pass/testrecursive.def b/gcc/testsuite/gm2/pim/pass/testrecursive.def
new file mode 100644
index 00000000000..95e6573305e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testrecursive.def
@@ -0,0 +1,21 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE testrecursive;
+TYPE
+  test_type   = CARDINAL;
+  Error_Proc  = PROCEDURE(ARRAY OF CHAR, ARRAY OF CHAR);
+END testrecursive.
diff --git a/gcc/testsuite/gm2/pim/pass/testrecursive.mod b/gcc/testsuite/gm2/pim/pass/testrecursive.mod
new file mode 100644
index 00000000000..fd3781890fd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testrecursive.mod
@@ -0,0 +1,22 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE testrecursive;
+VAR
+  xError_Procedure : Error_Proc;
+BEGIN
+  (* empty *)
+END testrecursive.
diff --git a/gcc/testsuite/gm2/pim/pass/testreturnstr.mod b/gcc/testsuite/gm2/pim/pass/testreturnstr.mod
new file mode 100644
index 00000000000..8846eaaaec7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testreturnstr.mod
@@ -0,0 +1,21 @@
+MODULE testreturnstr ;
+
+FROM InOut IMPORT WriteString, WriteLn ;
+
+TYPE
+   teststr = ARRAY [0..9] OF CHAR;
+
+PROCEDURE test() : teststr ;
+VAR
+   f: teststr ;
+BEGIN
+   f := "test" ;
+   RETURN( f )
+END test;
+
+BEGIN
+   WriteString('test = "') ;
+   WriteString(test()) ;
+   WriteString('"') ;
+   WriteLn
+END testreturnstr.
diff --git a/gcc/testsuite/gm2/pim/pass/testset.mod b/gcc/testsuite/gm2/pim/pass/testset.mod
new file mode 100644
index 00000000000..eb6c6664d39
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testset.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE testset ;
+
+CONST
+   shift = 0;
+   Tandem = { shift + 15 };
+
+VAR
+   b: BITSET ;
+BEGIN
+   b := Tandem
+END testset.
diff --git a/gcc/testsuite/gm2/pim/pass/testshort.mod b/gcc/testsuite/gm2/pim/pass/testshort.mod
new file mode 100644
index 00000000000..1b53ed3d7ac
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testshort.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testshort ;
+
+FROM M2RTS IMPORT Halt ;
+
+PROCEDURE promote (i: SHORTINT) ;
+BEGIN
+   IF i#-1
+   THEN
+      Halt(__FILE__, __LINE__, __FUNCTION__, 'promotion failed')
+   END
+END promote ;
+
+VAR
+   s: SHORTINT ;
+BEGIN
+   s := -1 ;
+   promote(s)
+END testshort.
diff --git a/gcc/testsuite/gm2/pim/pass/testsinf.mod b/gcc/testsuite/gm2/pim/pass/testsinf.mod
new file mode 100644
index 00000000000..2ce83bf7fcd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testsinf.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testsinf ;
+
+FROM builtin IMPORT sinf ;
+
+VAR
+   r: SHORTREAL ;
+BEGIN
+   r := 3.14 ;
+   r := sinf(r) ;
+END testsinf.
diff --git a/gcc/testsuite/gm2/pim/pass/testsinl.mod b/gcc/testsuite/gm2/pim/pass/testsinl.mod
new file mode 100644
index 00000000000..b7d7fa01b27
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testsinl.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testsinl ;
+
+FROM builtin IMPORT sinl ;
+
+VAR
+   r: LONGREAL ;
+BEGIN
+   r := 3.14 ;
+   r := sinl(r) ;
+END testsinl.
diff --git a/gcc/testsuite/gm2/pim/pass/testsize.mod b/gcc/testsuite/gm2/pim/pass/testsize.mod
new file mode 100644
index 00000000000..141a50fa7c1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testsize.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testsize ;
+
+FROM SYSTEM IMPORT SIZE, ADDRESS ;
+
+PROCEDURE func (size : CARDINAL) ;
+BEGIN
+
+END func ;
+
+
+VAR
+   n: CARDINAL ;
+   a: ADDRESS ;
+BEGIN
+   n := 5 ;
+   func (n*SIZE(REAL))
+END testsize.
diff --git a/gcc/testsuite/gm2/pim/pass/testvar.mod b/gcc/testsuite/gm2/pim/pass/testvar.mod
new file mode 100644
index 00000000000..d245bf6b460
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testvar.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testvar ;
+
+
+(*
+   readint - 
+*)
+
+PROCEDURE readint (VAR i: INTEGER) ;
+CONST
+   foo = 123 ;
+(*
+TYPE
+   bar = CARDINAL ;
+VAR
+   b: bar ;
+*)
+VAR
+   a, b, c: CARDINAL ;
+BEGIN
+   a := 789 ;
+   i := foo
+END readint ;
+
+
+CONST
+   foo = 456 ;
+(*
+TYPE
+   bar = CHAR ;
+*)
+
+VAR
+   i, j, k: INTEGER ;
+BEGIN
+   i := foo ;
+   readint(i)
+END testvar.
diff --git a/gcc/testsuite/gm2/pim/pass/testvarin.mod b/gcc/testsuite/gm2/pim/pass/testvarin.mod
new file mode 100644
index 00000000000..562c932e2f9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/testvarin.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE testvarin ;
+
+IMPORT varin;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+
+BEGIN
+  WriteCard(varin.var,0) ;
+  WriteLn
+END testvarin.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio.mod b/gcc/testsuite/gm2/pim/pass/timeio.mod
new file mode 100644
index 00000000000..cac1c7f9e44
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+TYPE
+   CharSet = SET OF CHAR;
+
+
+PROCEDURE CheckMonth (VAR charset: CharSet);
+BEGIN
+   INCL(charset, 'm')
+END CheckMonth;
+
+
+VAR
+   c: CharSet ;
+BEGIN
+   CheckMonth (c)
+END timeio.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio2.mod b/gcc/testsuite/gm2/pim/pass/timeio2.mod
new file mode 100644
index 00000000000..2dadefbaf07
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio2.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio2 ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+TYPE
+   CharSet = RECORD
+                 w: CHAR;
+             END ;
+
+
+PROCEDURE CheckMonth (VAR charset: CharSet);
+VAR
+   c: CharSet ;
+BEGIN
+   charset.w := charset.w - 'a'
+END CheckMonth;
+
+
+VAR
+   c: CharSet ;
+BEGIN
+   CheckMonth (c)
+END timeio2.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio3.mod b/gcc/testsuite/gm2/pim/pass/timeio3.mod
new file mode 100644
index 00000000000..f3f1e4d3d4b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio3.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio3 ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+TYPE
+   CharSet = SET OF CHAR;
+
+
+PROCEDURE CheckMonth (VAR charset: CharSet);
+BEGIN
+   charset := charset + CharSet {'m'}
+END CheckMonth;
+
+
+VAR
+   c: CharSet ;
+BEGIN
+   CheckMonth (c)
+END timeio3.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio4.mod b/gcc/testsuite/gm2/pim/pass/timeio4.mod
new file mode 100644
index 00000000000..4d38fa70eda
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio4.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio4 ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+TYPE
+   CharSet = SET OF CHAR;
+
+
+PROCEDURE CheckMonth (VAR charset: CharSet);
+VAR
+   c: CharSet ;
+BEGIN
+   charset := c + CharSet {'m'}
+END CheckMonth;
+
+
+VAR
+   c: CharSet ;
+BEGIN
+   CheckMonth (c)
+END timeio4.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio5.mod b/gcc/testsuite/gm2/pim/pass/timeio5.mod
new file mode 100644
index 00000000000..29635ee5769
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio5.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio5 ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+TYPE
+   CharSet = SET OF CHAR;
+
+
+PROCEDURE CheckMonth (VAR charset: CharSet);
+BEGIN
+   charset := charset + CharSet {'m'}
+END CheckMonth;
+
+
+VAR
+   c: CharSet ;
+BEGIN
+   CheckMonth (c)
+END timeio5.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio6.mod b/gcc/testsuite/gm2/pim/pass/timeio6.mod
new file mode 100644
index 00000000000..7c5f2a33f87
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio6.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio6 ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+TYPE
+   CharSet = POINTER TO RECORD
+                           w0: BITSET ;
+			   w1: BITSET ;
+                        END ;
+
+
+PROCEDURE CheckMonth (charset: CharSet);
+BEGIN
+   charset^.w1 := charset^.w1 + BITSET {2}
+END CheckMonth;
+
+
+VAR
+   c: CharSet ;
+BEGIN
+   CheckMonth (c)
+END timeio6.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio7.mod b/gcc/testsuite/gm2/pim/pass/timeio7.mod
new file mode 100644
index 00000000000..3e9a15bdecb
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio7.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio7 ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+
+
+PROCEDURE CheckMonth (VAR charset: BITSET);
+BEGIN
+   INCL (charset, 1)
+END CheckMonth;
+
+
+VAR
+   c: BITSET ;
+BEGIN
+   CheckMonth (c)
+END timeio7.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio8.mod b/gcc/testsuite/gm2/pim/pass/timeio8.mod
new file mode 100644
index 00000000000..a439269447c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio8.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio8 ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+
+TYPE
+   soc = RECORD
+            w0: BITSET ;
+	    w1: BITSET ;
+         END ;
+
+PROCEDURE CheckMonth (VAR charset: soc);
+BEGIN
+   INCL (charset.w0, 1)
+END CheckMonth;
+
+
+VAR
+   c: soc ;
+BEGIN
+   CheckMonth (c)
+END timeio8.
diff --git a/gcc/testsuite/gm2/pim/pass/timeio9.mod b/gcc/testsuite/gm2/pim/pass/timeio9.mod
new file mode 100644
index 00000000000..216c5811a0a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/timeio9.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE timeio9 ;   (*!m2pim*)
+
+(* tiny reduced version of the TimeIO.mod which failed to compile.  *)
+
+TYPE
+   soc = SET OF [0..63] ;
+
+
+PROCEDURE CheckMonth (VAR charset: soc);
+BEGIN
+   INCL (charset, 1)
+END CheckMonth;
+
+
+VAR
+   c: soc ;
+BEGIN
+   CheckMonth (c)
+END timeio9.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyalloc.mod b/gcc/testsuite/gm2/pim/pass/tinyalloc.mod
new file mode 100644
index 00000000000..c0f1185359a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyalloc.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyalloc ;   (*!m2pim*)
+
+FROM Storage IMPORT ALLOCATE ;
+
+VAR
+   p: POINTER TO CHAR ;
+BEGIN
+   ALLOCATE (p, 20)
+END tinyalloc.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyarray.mod b/gcc/testsuite/gm2/pim/pass/tinyarray.mod
new file mode 100644
index 00000000000..037b4df22df
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyarray.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyarray ;
+
+FROM tinysub IMPORT subrange ;
+
+VAR
+   a: ARRAY [MIN(subrange)..MAX(subrange)] OF INTEGER ;
+BEGIN
+
+END tinyarray.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyarray2.mod b/gcc/testsuite/gm2/pim/pass/tinyarray2.mod
new file mode 100644
index 00000000000..712a6e72287
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyarray2.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyarray2 ;
+
+
+CONST
+   MaxArgs   =  255 ;
+   MaxString = 4096 ;
+
+
+VAR
+   Source: POINTER TO ARRAY [0..MaxArgs] OF
+           POINTER TO ARRAY [0..MaxString] OF CHAR ;
+
+BEGIN
+
+END tinyarray2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyarray3.mod b/gcc/testsuite/gm2/pim/pass/tinyarray3.mod
new file mode 100644
index 00000000000..b6e950abdb4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyarray3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyarray3 ;   (*!m2pim*)
+
+TYPE
+   ar = POINTER TO ARRAY [0..10] OF ar ;
+
+VAR
+   a: ar ;
+BEGIN
+
+END tinyarray3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyarray4.mod b/gcc/testsuite/gm2/pim/pass/tinyarray4.mod
new file mode 100644
index 00000000000..a38e052cc60
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyarray4.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyarray4 ;   (*!m2pim*)
+
+VAR
+   a: ARRAY [1..2], [3..4] OF CHAR ;
+BEGIN
+   a[1,3] := 'a'
+END tinyarray4.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyarray5.mod b/gcc/testsuite/gm2/pim/pass/tinyarray5.mod
new file mode 100644
index 00000000000..e49779b7426
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyarray5.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyarray5 ;   (*!m2pim*)
+
+TYPE
+   colour = (red, blue, green) ;
+   myarray = ARRAY [1..2], [3..4] OF colour ;
+VAR
+   a: myarray ;
+BEGIN
+   a[1,3] := red
+END tinyarray5.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyarray6.mod b/gcc/testsuite/gm2/pim/pass/tinyarray6.mod
new file mode 100644
index 00000000000..732fe7526b5
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyarray6.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyarray6 ;   (*!m2pim*)
+
+TYPE
+   colour = (red, blue, green) ;
+   myarray = ARRAY [1..2] OF ARRAY [3..4] OF colour ;
+VAR
+   a: myarray ;
+BEGIN
+   a[1][3] := red
+END tinyarray6.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyassign.def b/gcc/testsuite/gm2/pim/pass/tinyassign.def
new file mode 100644
index 00000000000..6c488ce8dcf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyassign.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2015 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.  *)
+
+DEFINITION MODULE tinyassign ;
+
+
+END tinyassign.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyassign.mod b/gcc/testsuite/gm2/pim/pass/tinyassign.mod
new file mode 100644
index 00000000000..237f052df7c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyassign.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2015 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.  *)
+
+IMPLEMENTATION MODULE tinyassign ;
+
+PROCEDURE foo ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 42
+END foo ;
+
+END tinyassign.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyassign2.mod b/gcc/testsuite/gm2/pim/pass/tinyassign2.mod
new file mode 100644
index 00000000000..13211dc278f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyassign2.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyassign2 ;
+
+VAR
+   foo: INTEGER ;
+BEGIN
+   foo := 42
+END tinyassign2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyassign3.mod b/gcc/testsuite/gm2/pim/pass/tinyassign3.mod
new file mode 100644
index 00000000000..03352782266
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyassign3.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyassign3 ;
+
+
+PROCEDURE foo ;
+VAR
+   bar: INTEGER ;
+BEGIN
+   bar := 42
+END foo ;
+
+
+BEGIN
+   foo
+END tinyassign3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyassign4.mod b/gcc/testsuite/gm2/pim/pass/tinyassign4.mod
new file mode 100644
index 00000000000..907f4844d6d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyassign4.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyassign4 ;
+
+
+PROCEDURE foo ;
+VAR
+   x, y, z: INTEGER ;
+BEGIN
+   x := 42 ;
+   y := 12 ;
+   z := 6
+END foo ;
+
+
+BEGIN
+   foo
+END tinyassign4.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyassign5.mod b/gcc/testsuite/gm2/pim/pass/tinyassign5.mod
new file mode 100644
index 00000000000..75884a60b53
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyassign5.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyassign5 ;
+
+
+PROCEDURE foo ;
+END foo ;
+
+VAR
+   p: PROC ;
+BEGIN
+   p := foo
+END tinyassign5.
diff --git a/gcc/testsuite/gm2/pim/pass/tinybitset.mod b/gcc/testsuite/gm2/pim/pass/tinybitset.mod
new file mode 100644
index 00000000000..ad47b8605f4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinybitset.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinybitset ;
+
+VAR
+   b: BITSET ;
+BEGIN
+   b := BITSET {}
+END tinybitset.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyelse.mod b/gcc/testsuite/gm2/pim/pass/tinyelse.mod
new file mode 100644
index 00000000000..07e8c224ad0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyelse.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyelse ;  (*!m2pim*)
+
+(*  detects dangling else statement.  *)
+
+FROM libc IMPORT exit ;
+
+
+BEGIN
+   IF TRUE
+   THEN
+      IF FALSE
+      THEN
+      END
+   ELSE
+      exit (1)
+   END
+END tinyelse.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyenum.mod b/gcc/testsuite/gm2/pim/pass/tinyenum.mod
new file mode 100644
index 00000000000..9ef2b54977e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyenum.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyenum ;   (*!m2pim*)
+
+VAR
+   ModuleType : (None, Definition, Implementation, Program) ;
+
+BEGIN
+END tinyenum.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyfor.mod b/gcc/testsuite/gm2/pim/pass/tinyfor.mod
new file mode 100644
index 00000000000..26caeafea84
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyfor.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyfor ;
+
+
+VAR
+   s, c: CARDINAL ;
+BEGIN
+   s := 0 ;
+   FOR c := 1 TO 10 BY 1 DO
+      s := s + c
+   END
+END tinyfor.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyfor2.mod b/gcc/testsuite/gm2/pim/pass/tinyfor2.mod
new file mode 100644
index 00000000000..b8d34cabf0b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyfor2.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyfor2 ;
+
+
+VAR
+   s, c: CARDINAL ;
+BEGIN
+   s := 0 ;
+   FOR c := 1 TO 10 DO
+      s := s + c
+   END
+END tinyfor2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyfor3.mod b/gcc/testsuite/gm2/pim/pass/tinyfor3.mod
new file mode 100644
index 00000000000..199171fb786
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyfor3.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyfor3 ;
+
+
+VAR
+   s, c: CARDINAL ;
+BEGIN
+   s := 0 ;
+   FOR c := 1 TO 10 BY 1+2 DO
+      s := s + c
+   END
+END tinyfor3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyhalt.mod b/gcc/testsuite/gm2/pim/pass/tinyhalt.mod
new file mode 100644
index 00000000000..c8205299a72
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyhalt.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyhalt ;
+
+
+BEGIN
+   HALT
+END tinyhalt.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyhello.mod b/gcc/testsuite/gm2/pim/pass/tinyhello.mod
new file mode 100644
index 00000000000..1b00e600376
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyhello.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyhello ;
+
+FROM libc IMPORT printf ;
+
+BEGIN
+   printf ("hello world\n")
+END tinyhello.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyif.mod b/gcc/testsuite/gm2/pim/pass/tinyif.mod
new file mode 100644
index 00000000000..e73e6542ebc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyif.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyif ;
+
+
+VAR
+   x, y: INTEGER ;
+BEGIN
+   x := 42 ;
+   IF (x = 42) AND (x > 0)
+   THEN
+      y := 1
+   ELSE
+      y := 0
+   END
+END tinyif.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyif2.mod b/gcc/testsuite/gm2/pim/pass/tinyif2.mod
new file mode 100644
index 00000000000..4ecffe01dba
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyif2.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyif2 ;
+
+
+VAR
+   x, y: INTEGER ;
+BEGIN
+   x := 42 ;
+   IF x = 42
+   THEN
+      y := 1
+   ELSIF x = 2
+   THEN
+      y := 0
+   ELSE
+      y := -1
+   END
+END tinyif2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyif3.mod b/gcc/testsuite/gm2/pim/pass/tinyif3.mod
new file mode 100644
index 00000000000..da62e2d3641
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyif3.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyif3 ;
+
+
+VAR
+   x, y: INTEGER ;
+BEGIN
+   x := 42 ;
+   IF x = 42
+   THEN
+      y := 1
+   END ;
+   IF x = 2
+   THEN
+      y := 2
+   ELSE
+      y := 0
+   END
+END tinyif3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyif4.mod b/gcc/testsuite/gm2/pim/pass/tinyif4.mod
new file mode 100644
index 00000000000..f4c61c8f744
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyif4.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyif4 ;
+
+
+VAR
+   c, i, r: INTEGER ;
+BEGIN
+   r := 0 ;
+   c := 42 ;
+   i := 2 ;
+   IF c = 42
+   THEN
+      IF i = 2
+      THEN
+         r := 1
+      ELSE
+         r := 2
+      END
+   ELSE
+      r := 3
+   END
+END tinyif4.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyif5.mod b/gcc/testsuite/gm2/pim/pass/tinyif5.mod
new file mode 100644
index 00000000000..6dfe89a99a1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyif5.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyif5 ;
+
+
+VAR
+   c, i, r: INTEGER ;
+BEGIN
+   r := 0 ;
+   c := 42 ;
+   i := 2 ;
+   IF c = 42
+   THEN
+      IF i = 2
+      THEN
+         r := 1
+      END
+   ELSE
+      r := 2
+   END
+END tinyif5.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyif6.mod b/gcc/testsuite/gm2/pim/pass/tinyif6.mod
new file mode 100644
index 00000000000..9ce9e7a6541
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyif6.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyif6 ;   (*!m2pim*)
+
+FROM libc IMPORT exit ;
+
+CONST
+   foo = TRUE ;
+   bar = TRUE ;
+
+BEGIN
+   IF foo
+   THEN
+      IF bar
+      THEN
+         exit (0)
+      ELSE
+         exit (1)
+      END
+   END
+END tinyif6.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyif7.mod b/gcc/testsuite/gm2/pim/pass/tinyif7.mod
new file mode 100644
index 00000000000..0c7ed82a398
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyif7.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyif7 ;   (*!m2pim*)
+
+FROM libc IMPORT printf ;
+
+VAR
+   foo, bar, mumble: BOOLEAN ;
+BEGIN
+   IF foo
+   THEN
+      IF NOT bar
+      THEN
+         printf ("one\n") ;
+         printf ("two\n") ;
+      END
+   ELSIF mumble
+   THEN
+      printf ("three\n") ;
+      printf ("four\n")
+   END
+END tinyif7.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyif8.mod b/gcc/testsuite/gm2/pim/pass/tinyif8.mod
new file mode 100644
index 00000000000..bf90a8dfa47
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyif8.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyif8 ;   (*!m2pim*)
+
+FROM libc IMPORT printf ;
+
+VAR
+   foo, bar, mumble: BOOLEAN ;
+BEGIN
+   IF foo
+   THEN
+      IF bar
+      THEN
+         printf ("one\n") ;
+         printf ("two\n")
+      ELSIF foo
+      THEN
+         printf ("three\n")
+      END
+   ELSE
+      printf ("last\n")
+   END
+END tinyif8.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyimp.mod b/gcc/testsuite/gm2/pim/pass/tinyimp.mod
new file mode 100644
index 00000000000..0dfebd2270d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyimp.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE tinyimp ;
+
+TYPE
+  X = BITSET;
+BEGIN
+END tinyimp.
diff --git a/gcc/testsuite/gm2/pim/pass/tinylit.mod b/gcc/testsuite/gm2/pim/pass/tinylit.mod
new file mode 100644
index 00000000000..8c43ac56f78
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinylit.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinylit ;
+
+CONST
+   esc = '\' ;
+
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := esc
+END tinylit.
diff --git a/gcc/testsuite/gm2/pim/pass/tinylit2.mod b/gcc/testsuite/gm2/pim/pass/tinylit2.mod
new file mode 100644
index 00000000000..aebd1b619fc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinylit2.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinylit2 ;
+
+CONST
+   squote = "'" ;
+
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := squote
+END tinylit2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinymax.mod b/gcc/testsuite/gm2/pim/pass/tinymax.mod
new file mode 100644
index 00000000000..dc344778865
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinymax.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinymax ;   (*!m2pim*)
+
+CONST
+   mxb = MAX(BITSET) ;
+   mib = mxb+1 ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := mib
+END tinymax.
diff --git a/gcc/testsuite/gm2/pim/pass/tinymod.mod b/gcc/testsuite/gm2/pim/pass/tinymod.mod
new file mode 100644
index 00000000000..c7f7a4b1cc4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinymod.mod
@@ -0,0 +1,21 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE tinymod ;
+
+BEGIN
+END tinymod.
diff --git a/gcc/testsuite/gm2/pim/pass/tinynode.mod b/gcc/testsuite/gm2/pim/pass/tinynode.mod
new file mode 100644
index 00000000000..04b0181a4f6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinynode.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinynode ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+   node = POINTER TO RECORD
+                        value: INTEGER ;
+                        next : node ;
+                     END ;
+
+VAR
+   n: node ;
+BEGIN
+   NEW (n) ;
+   n^.next := NIL
+END tinynode.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyparam.mod b/gcc/testsuite/gm2/pim/pass/tinyparam.mod
new file mode 100644
index 00000000000..4175409c586
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyparam.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyparam ;
+
+FROM libc IMPORT write ;
+FROM SYSTEM IMPORT ADR ;
+
+
+(*
+   foo -
+*)
+
+PROCEDURE foo (a: ARRAY OF CHAR) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := write (1, ADR (a), 10)
+END foo ;
+
+
+BEGIN
+   foo ('hello world\na test\n')
+END tinyparam.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyparam2.mod b/gcc/testsuite/gm2/pim/pass/tinyparam2.mod
new file mode 100644
index 00000000000..3344476f12e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyparam2.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyparam2 ;
+
+FROM libc IMPORT write ;
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+
+
+(*
+   foo -
+*)
+
+PROCEDURE foo (a: ARRAY OF CHAR) ;
+VAR
+   i: INTEGER ;
+BEGIN
+   i := write (1, ADR (a), HIGH (a))
+END foo ;
+
+
+BEGIN
+   foo ('hello world\na test\n')
+END tinyparam2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyplus.mod b/gcc/testsuite/gm2/pim/pass/tinyplus.mod
new file mode 100644
index 00000000000..bbd34b9b009
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyplus.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyplus ;
+
+
+CONST
+   foo = "hello" ;
+
+
+PROCEDURE bar (a: ARRAY OF CHAR) ;
+BEGIN
+END bar ;
+
+
+BEGIN
+   bar (foo + "world")
+END tinyplus.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyproc.mod b/gcc/testsuite/gm2/pim/pass/tinyproc.mod
new file mode 100644
index 00000000000..ab11f5f403f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyproc.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyproc ;
+
+
+PROCEDURE func ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1
+END func ;
+
+
+BEGIN
+   func
+END tinyproc.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyproc2.mod b/gcc/testsuite/gm2/pim/pass/tinyproc2.mod
new file mode 100644
index 00000000000..af39df99a16
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyproc2.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyproc2 ;
+
+
+VAR
+   p: PROC ;
+BEGIN
+   p
+END tinyproc2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyproc3.mod b/gcc/testsuite/gm2/pim/pass/tinyproc3.mod
new file mode 100644
index 00000000000..b94f9d08f38
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyproc3.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyproc3 ;
+
+
+VAR
+   a: ARRAY [1..10] OF INTEGER ;
+BEGIN
+   a[1] := 42
+END tinyproc3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyproc4.mod b/gcc/testsuite/gm2/pim/pass/tinyproc4.mod
new file mode 100644
index 00000000000..2937facc468
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyproc4.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyproc4 ;
+
+
+VAR
+   a: ARRAY [1..10] OF PROC ;
+BEGIN
+   a[1]
+END tinyproc4.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyproc5.mod b/gcc/testsuite/gm2/pim/pass/tinyproc5.mod
new file mode 100644
index 00000000000..836050a1540
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyproc5.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyproc5 ;   (*!m2pim*)
+
+
+TYPE
+   myProc = PROCEDURE () : CARDINAL ;
+VAR
+   p: myProc ;
+BEGIN
+   IF p () = 0
+   THEN
+   END
+END tinyproc5.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyproc6.mod b/gcc/testsuite/gm2/pim/pass/tinyproc6.mod
new file mode 100644
index 00000000000..931726b212d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyproc6.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyproc6 ;   (*!m2pim*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+TYPE
+   ThreadProcess = PROCEDURE (ADDRESS) ;
+VAR
+   tp : ThreadProcess ;
+   p  : PROC ;
+BEGIN
+   tp := ThreadProcess (p)
+END tinyproc6.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyptr.mod b/gcc/testsuite/gm2/pim/pass/tinyptr.mod
new file mode 100644
index 00000000000..6234b6337f2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyptr.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinyptr ;   (*!m2pim*)
+
+TYPE
+   colour = (red, blue, green) ;
+   mytype = POINTER TO POINTER TO INTEGER ;
+VAR
+   a: mytype ;
+BEGIN
+   a^^ := 1
+END tinyptr.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyreal.mod b/gcc/testsuite/gm2/pim/pass/tinyreal.mod
new file mode 100644
index 00000000000..a65574b4f80
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyreal.mod
@@ -0,0 +1,12 @@
+MODULE tinyreal ;
+
+FROM InOut IMPORT WriteLn, WriteString ;
+FROM FpuIO IMPORT WriteReal, ReadReal ;
+
+VAR
+   time: REAL;
+BEGIN
+   WriteString('Input value ');
+   ReadReal(time) ;
+   WriteReal(time,7,5); WriteLn ;
+END tinyreal.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyrecord.mod b/gcc/testsuite/gm2/pim/pass/tinyrecord.mod
new file mode 100644
index 00000000000..5a4734c4f92
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyrecord.mod
@@ -0,0 +1,43 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyrecord ;   (*!m2pim*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+CONST
+   MaxBufferLength = 100 ;
+
+TYPE
+   Buffer = POINTER TO RECORD
+                          valid   : BOOLEAN ;   (* are the field valid?             *)
+                          bufstart: LONGINT ;   (* the position of buffer in file   *)
+                          position: CARDINAL ;  (* where are we through this buffer *)
+                          address : ADDRESS ;   (* dynamic buffer address           *)
+                          filled  : CARDINAL ;  (* length of the buffer filled      *)
+                          size    : CARDINAL ;  (* maximum space in this buffer     *)
+                          left    : CARDINAL ;  (* number of bytes left to read     *)
+                          contents: POINTER TO ARRAY [0..MaxBufferLength] OF CHAR ;
+                       END ;
+
+VAR
+   b: Buffer ;
+   a: ADDRESS ;
+BEGIN
+   b^.contents := a
+END tinyrecord.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyrepeat.mod b/gcc/testsuite/gm2/pim/pass/tinyrepeat.mod
new file mode 100644
index 00000000000..25f38b572fc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyrepeat.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyrepeat ;
+
+
+VAR
+   c, i: CARDINAL ;
+BEGIN
+   c := 0 ;
+   i := 0 ;
+   REPEAT
+      c := c + i ;
+      i := i + 1
+   UNTIL i=10
+END tinyrepeat.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyset6.mod b/gcc/testsuite/gm2/pim/pass/tinyset6.mod
new file mode 100644
index 00000000000..b4a96a4690b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyset6.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyset6 ;   (*!m2pim*)
+
+TYPE
+   myset = SET OF colour ;
+   colour = (red, green, blue) ;
+
+
+PROCEDURE foo (s: myset) ;
+BEGIN
+END foo ;
+
+
+VAR
+   m: myset ;
+BEGIN
+   foo (m + myset {red})
+END tinyset6.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyset7.mod b/gcc/testsuite/gm2/pim/pass/tinyset7.mod
new file mode 100644
index 00000000000..e5ae6663513
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyset7.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE tinyset7 ;   (*!m2pim*)
+
+TYPE
+   myset = SET OF colour ;
+   colour = (red, green, blue) ;
+
+CONST
+   foo = myset {red, green} ;
+
+VAR
+   m: myset ;
+BEGIN
+   m := foo
+END tinyset7.
diff --git a/gcc/testsuite/gm2/pim/pass/tinystate.mod b/gcc/testsuite/gm2/pim/pass/tinystate.mod
new file mode 100644
index 00000000000..65f1e90eac1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinystate.mod
@@ -0,0 +1,60 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinystate ;
+
+
+PROCEDURE exit (r: INTEGER) ;
+BEGIN
+END exit ;
+
+PROCEDURE abort ;
+BEGIN
+END abort ;
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+END ExecuteTerminationProcedures ;
+
+
+VAR
+   ExitValue,
+   exitcode : INTEGER ;
+   isHalting,
+   CallExit : BOOLEAN ;
+BEGIN
+   IF exitcode#-1
+   THEN
+      CallExit := TRUE ;
+      ExitValue := exitcode
+   END ;
+   IF isHalting
+   THEN
+      (* double HALT found *)
+      exit(-1)
+   ELSE
+      isHalting := TRUE ;
+      ExecuteTerminationProcedures ;
+   END ;
+   IF CallExit
+   THEN
+      exit(ExitValue)
+   ELSE
+      abort
+   END
+END tinystate.
diff --git a/gcc/testsuite/gm2/pim/pass/tinysub.def b/gcc/testsuite/gm2/pim/pass/tinysub.def
new file mode 100644
index 00000000000..52ae07c22b8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinysub.def
@@ -0,0 +1,37 @@
+(* Copyright (C) 2015 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.  *)
+
+DEFINITION MODULE tinysub ;
+
+(*
+    Title      : tinysub
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Jul 22 11:02:04 2016
+    Revision   : $Version$
+    Description: test code!
+*)
+
+CONST
+   init = 0 ;
+
+TYPE
+   subrange = [0..7] ;
+
+
+END tinysub.
diff --git a/gcc/testsuite/gm2/pim/pass/tinytest.mod b/gcc/testsuite/gm2/pim/pass/tinytest.mod
new file mode 100644
index 00000000000..ffc839de622
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinytest.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinytest ;   (*!m2pim*)
+
+PROCEDURE nop ;
+END nop ;
+
+END tinytest.
diff --git a/gcc/testsuite/gm2/pim/pass/tinytrue.mod b/gcc/testsuite/gm2/pim/pass/tinytrue.mod
new file mode 100644
index 00000000000..2c0a68ceda1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinytrue.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinytrue ;
+
+VAR
+   b: BOOLEAN ;
+BEGIN
+   b := TRUE
+END tinytrue.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvar.mod b/gcc/testsuite/gm2/pim/pass/tinyvar.mod
new file mode 100644
index 00000000000..484aadd7f11
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvar.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE tinyvar ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+END tinyvar.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvar2.mod b/gcc/testsuite/gm2/pim/pass/tinyvar2.mod
new file mode 100644
index 00000000000..727186cccac
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvar2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE tinyvar2 ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 99
+END tinyvar2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvar3.mod b/gcc/testsuite/gm2/pim/pass/tinyvar3.mod
new file mode 100644
index 00000000000..5caad088acb
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvar3.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE tinyvar3 ;
+
+VAR
+   new: CARDINAL ;
+BEGIN
+   new := 99
+END tinyvar3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvar4.mod b/gcc/testsuite/gm2/pim/pass/tinyvar4.mod
new file mode 100644
index 00000000000..4ee3565f98c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvar4.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE tinyvar4 ;
+
+PROCEDURE foo ;
+VAR
+   new: CARDINAL ;
+BEGIN
+   new := 99
+END foo ;
+
+BEGIN
+   foo
+END tinyvar4.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvar5.mod b/gcc/testsuite/gm2/pim/pass/tinyvar5.mod
new file mode 100644
index 00000000000..ada3ffad922
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvar5.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2016 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 2, 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.  *)
+
+MODULE tinyvar5 ;
+
+PROCEDURE true (delete: CARDINAL) ;
+VAR
+   new: CARDINAL ;
+BEGIN
+   new := delete
+END true ;
+
+BEGIN
+   true (99)
+END tinyvar5.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvarient.mod b/gcc/testsuite/gm2/pim/pass/tinyvarient.mod
new file mode 100644
index 00000000000..b8940e9601b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvarient.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyvarient ;   (*!m2pim*)
+
+
+TYPE
+   decl = POINTER TO RECORD
+                        CASE b: BOOLEAN OF
+
+                        TRUE:  c: CARDINAL |
+			FALSE: i: INTEGER
+
+                        END
+                     END ;
+
+VAR
+   d: decl ;
+BEGIN
+   d := NIL
+END tinyvarient.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvarient2.mod b/gcc/testsuite/gm2/pim/pass/tinyvarient2.mod
new file mode 100644
index 00000000000..dd5682cef12
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvarient2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyvarient2 ;   (*!m2pim*)
+
+
+TYPE
+   decl = POINTER TO RECORD
+                        CASE b: BOOLEAN OF
+
+                        TRUE:  c: CARDINAL |
+			FALSE: d: decl
+
+                        END
+                     END ;
+
+VAR
+   d: decl ;
+BEGIN
+   d := NIL
+END tinyvarient2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvarient3.def b/gcc/testsuite/gm2/pim/pass/tinyvarient3.def
new file mode 100644
index 00000000000..df4ad633496
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvarient3.def
@@ -0,0 +1,24 @@
+(* Copyright (C) 2015 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.  *)
+
+DEFINITION MODULE tinyvarient3 ;  (*!m2pim*)
+
+TYPE
+   decl ;
+
+END tinyvarient3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvarient3.mod b/gcc/testsuite/gm2/pim/pass/tinyvarient3.mod
new file mode 100644
index 00000000000..fa40a810a3e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvarient3.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2016 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.  *)
+
+IMPLEMENTATION MODULE tinyvarient3 ;   (*!m2pim*)
+
+
+TYPE
+   decl = POINTER TO RECORD
+                        CASE b: BOOLEAN OF
+
+                        TRUE:  c: CARDINAL |
+			FALSE: d: decl
+
+                        END
+                     END ;
+
+VAR
+   d: decl ;
+BEGIN
+   d := NIL
+END tinyvarient3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvarient4.mod b/gcc/testsuite/gm2/pim/pass/tinyvarient4.mod
new file mode 100644
index 00000000000..89e514d6497
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvarient4.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyvarient4 ;   (*!m2pim*)
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+   decl = POINTER TO RECORD
+                        a: CHAR ;
+                        CASE b: BOOLEAN OF
+
+                        TRUE:  c: CARDINAL |
+			FALSE: d: decl
+
+                        END ;
+			e: INTEGER ;
+                     END ;
+
+VAR
+   d: decl ;
+BEGIN
+   NEW (d) ;
+   d^.a := 'a' ;
+   d^.b := TRUE ;
+   d^.c := 1 ;
+   d^.d := d ;
+   d^.e := 2
+END tinyvarient4.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvarient5.mod b/gcc/testsuite/gm2/pim/pass/tinyvarient5.mod
new file mode 100644
index 00000000000..37e556728f8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvarient5.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyvarient5 ;   (*!m2pim*)
+
+
+TYPE
+   atoms = (id, lit, sub, opt, mult, m2) ;
+   FollowDesc = CARDINAL ;
+   IdentDesc = CARDINAL ;
+   CodeDesc = CARDINAL ;
+   Name = CARDINAL ;
+   ExpressionDesc = CARDINAL ;
+   FactorType = atoms ;
+
+   FactorDesc     = POINTER TO factordesc ;
+   factordesc = RECORD
+                   followinfo: FollowDesc ;
+                   next      : FactorDesc ;   (* chain of successive factors *)
+                   line      : CARDINAL ;
+                   pushed    : FactorDesc ;   (* chain of pushed code factors *)
+                   CASE type: FactorType OF
+
+                   id  : ident : IdentDesc |
+                   lit : string: Name |
+                   sub,
+                   opt,
+                   mult: expr  : ExpressionDesc |
+                   m2  : code  : CodeDesc ;
+
+                   END
+                END ;
+
+VAR
+   f: FactorDesc ;
+BEGIN
+   f^.expr := 1
+END tinyvarient5.
diff --git a/gcc/testsuite/gm2/pim/pass/tinyvarient6.mod b/gcc/testsuite/gm2/pim/pass/tinyvarient6.mod
new file mode 100644
index 00000000000..caeaae23cf2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinyvarient6.mod
@@ -0,0 +1,145 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinyvarient6 ;   (*!m2pim*)
+
+
+CONST
+   MaxCodeHunkLength = 4 ;
+
+TYPE
+   Name = CARDINAL ;
+
+   ElementType = (idel, tokel, litel) ;
+
+   m2condition = (m2none, m2if, m2elsif, m2while) ;
+
+   TraverseResult = (unknown, true, false) ;
+
+   ProductionDesc = POINTER TO productiondesc ;
+
+   IdentDesc      = POINTER TO identdesc ;   (* forward fodder for p2c *)
+   identdesc      =            RECORD
+                                  definition: ProductionDesc ;   (* where this idents production is defined *)
+                                  name      : Name ;
+                                  line      : CARDINAL ;
+                               END ;
+
+   SetDesc        = POINTER TO setdesc ;
+   setdesc        =            RECORD
+                                  next          : SetDesc ;
+                                  CASE type: ElementType OF
+
+                                  idel  : ident : IdentDesc |
+                                  tokel,
+                                  litel : string: Name
+
+                                  END
+                               END ;
+
+(* note that epsilon refers to whether we can satisfy this component part
+   of a sentance without consuming a token. Reachend indicates we can get
+   to the end of the sentance without consuming a token.
+
+   For expression, statement, productions, terms: the epsilon value should
+   equal the reachend value but for factors the two may differ.
+*)
+
+   FollowDesc     = POINTER TO followdesc ;
+   followdesc     =            RECORD
+                                  calcfollow  : BOOLEAN ;          (* have we solved the follow set yet? *)
+                                  follow      : SetDesc ;          (* the follow set *)
+                                  reachend    : TraverseResult ;   (* can we see the end of the sentance (due to multiple epsilons) *)
+                                  epsilon     : TraverseResult ;   (* potentially no token may be consumed within this component of the sentance *)
+                                  line        : CARDINAL ;
+                    END ;
+
+   TermDesc       = POINTER TO termdesc ;
+
+   ExpressionDesc = POINTER TO expressiondesc ;
+   expressiondesc =            RECORD
+                                  term      : TermDesc ;
+                                  followinfo: FollowDesc ;
+                                  line      : CARDINAL ;
+                               END ;
+
+   StatementDesc  = POINTER TO statementdesc ;
+   statementdesc  =            RECORD
+                                  ident      : IdentDesc ;
+                                  expr       : ExpressionDesc ;
+                                  followinfo : FollowDesc ;
+                                  line       : CARDINAL ;
+                               END ;
+
+   CodeHunk       = POINTER TO codehunk ;
+   codehunk       =            RECORD
+                                  codetext  : ARRAY [0..MaxCodeHunkLength] OF CHAR ;
+                                  next      : CodeHunk ;
+                               END ;
+
+   CodeDesc       = POINTER TO codedesc ;
+   codedesc       =            RECORD
+                                  code      : CodeHunk ;
+                                  indent    : CARDINAL ;         (* column of the first % *)
+                                  line      : CARDINAL ;
+                               END ;
+
+   FactorType     = (id, lit, sub, opt, mult, m2) ;
+
+   FactorDesc     = POINTER TO factordesc ;
+   factordesc     =            RECORD
+                                  followinfo: FollowDesc ;
+                                  next      : FactorDesc ;   (* chain of successive factors *)
+                                  line      : CARDINAL ;
+                                  pushed    : FactorDesc ;   (* chain of pushed code factors *)
+                                  CASE type: FactorType OF
+
+                                  id  : ident : IdentDesc |
+                                  lit : string: Name |
+                                  sub,
+                                  opt,
+                                  mult: expr  : ExpressionDesc |
+                                  m2  : code  : CodeDesc ;
+
+                                  END
+                               END ;
+
+   termdesc       =            RECORD
+                                  factor    : FactorDesc ;
+                                  next      : TermDesc ;  (* chain of alternative terms *)
+                                  followinfo: FollowDesc ;
+                                  line      : CARDINAL ;
+                               END ;
+
+   productiondesc =            RECORD
+                                  next        : ProductionDesc ;   (* the chain of productions *)
+                                  statement   : StatementDesc ;
+                                  first       : SetDesc ;          (* the first set *)
+                                  firstsolved : BOOLEAN ;
+                                  followinfo  : FollowDesc ;
+                                  line        : CARDINAL ;
+                                  description : Name ;
+                               END ;
+
+   DoProcedure    = PROCEDURE (ProductionDesc) ;
+
+VAR
+   f: FactorDesc ;
+BEGIN
+   f^.type := m2
+END tinyvarient6.
diff --git a/gcc/testsuite/gm2/pim/pass/tinywhile.mod b/gcc/testsuite/gm2/pim/pass/tinywhile.mod
new file mode 100644
index 00000000000..e97e639321b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinywhile.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinywhile ;
+
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 10 ;
+   WHILE i>0 DO
+      DEC (i)
+   END
+END tinywhile.
diff --git a/gcc/testsuite/gm2/pim/pass/tinywith.mod b/gcc/testsuite/gm2/pim/pass/tinywith.mod
new file mode 100644
index 00000000000..e7a77229841
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinywith.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE tinywith ;
+
+
+TYPE
+   foo = POINTER TO RECORD
+                       left, right: foo ;
+		       ch         : CHAR ;
+                    END ;
+VAR
+   p: foo ;
+BEGIN
+   WITH p^ DO
+      ch := 'a'
+   END
+END tinywith.
diff --git a/gcc/testsuite/gm2/pim/pass/tinywith2.mod b/gcc/testsuite/gm2/pim/pass/tinywith2.mod
new file mode 100644
index 00000000000..83d63e46edd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinywith2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinywith2 ;
+
+
+TYPE
+   foo = POINTER TO RECORD
+                       left, right: foo ;
+		       ch         : CHAR ;
+                    END ;
+
+PROCEDURE this (VAR p: foo) ;
+BEGIN
+   WITH p^ DO
+      ch := 'a'
+   END
+END this ;
+
+
+BEGIN
+END tinywith2.
diff --git a/gcc/testsuite/gm2/pim/pass/tinywith3.mod b/gcc/testsuite/gm2/pim/pass/tinywith3.mod
new file mode 100644
index 00000000000..1e377fc8cee
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinywith3.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinywith3 ;
+
+
+TYPE
+   foo = POINTER TO RECORD
+                       left, right: foo ;
+		       ch         : CHAR ;
+                    END ;
+
+PROCEDURE this (VAR p: foo) ;
+BEGIN
+   WITH p^ DO
+      ch := 'a' ;
+      left := NIL ;
+      right := left
+   END
+END this ;
+
+
+BEGIN
+END tinywith3.
diff --git a/gcc/testsuite/gm2/pim/pass/tinywith4.mod b/gcc/testsuite/gm2/pim/pass/tinywith4.mod
new file mode 100644
index 00000000000..a58e7e10e44
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinywith4.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinywith4 ;
+
+
+TYPE
+   foo = POINTER TO RECORD
+                       left, right: foo ;
+		       ch         : CHAR ;
+                    END ;
+VAR
+   p: foo ;
+BEGIN
+   WITH p^ DO
+      ch := 'a' ;
+      right := NIL ;
+      left := right
+   END
+END tinywith4.
diff --git a/gcc/testsuite/gm2/pim/pass/tinywith5.mod b/gcc/testsuite/gm2/pim/pass/tinywith5.mod
new file mode 100644
index 00000000000..e5bb7e87c6b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinywith5.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinywith5 ;
+
+
+TYPE
+   foo = RECORD
+            left, right: POINTER TO foo ;
+            ch         : CHAR ;
+         END ;
+
+VAR
+   p: foo ;
+BEGIN
+   WITH p DO
+      ch := 'a' ;
+      right := NIL ;
+      left := right
+   END
+END tinywith5.
diff --git a/gcc/testsuite/gm2/pim/pass/tinywith6.mod b/gcc/testsuite/gm2/pim/pass/tinywith6.mod
new file mode 100644
index 00000000000..7d7d0121d08
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/tinywith6.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2016 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.  *)
+
+MODULE tinywith6 ;
+
+
+TYPE
+   Buffer = POINTER TO RECORD
+                          ch: CHAR ;
+                       END ;
+
+   foo = POINTER TO RECORD
+                       left, right: foo ;
+                       buffer     : Buffer ;
+                    END ;
+
+VAR
+   p: foo ;
+BEGIN
+   WITH p^ DO
+      WITH buffer^ DO
+         ch := 'a' ;
+      END
+   END
+END tinywith6.
diff --git a/gcc/testsuite/gm2/pim/pass/trunc.mod b/gcc/testsuite/gm2/pim/pass/trunc.mod
new file mode 100644
index 00000000000..c0200377a78
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/trunc.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE trunc ;
+
+
+VAR
+   s: SHORTREAL ;
+   l: LONGREAL ;
+   r: REAL ;
+   c: CARDINAL ;
+BEGIN
+   c := TRUNC(s) ;
+   c := TRUNC(l) ;
+   c := TRUNC(r)
+END trunc.
diff --git a/gcc/testsuite/gm2/pim/pass/try b/gcc/testsuite/gm2/pim/pass/try
new file mode 100644
index 00000000000..3ba6d71c63f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/try
@@ -0,0 +1,74 @@
+#!/bin/sh
+
+# Copyright (C) 2005 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 2, 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.
+
+
+export PATH=$HOME/bin/bin:$PATH
+
+
+doStabs () {
+    echo "====================================================="
+    echo "Stabs $1"
+    gm2 -g -c -gstabs+ $1.mod
+    gm2 -g -gstabs+ -o a.stabs $1.mod
+    if ! gdb ./a.stabs ; then
+       echo "gdb crashed on $1.mod"
+    fi
+}
+
+
+doDwarf2 () {
+    echo "====================================================="
+    echo "Dwarf2 $1"
+    gm2 -g -c -gdwarf-2 $1.mod
+    gm2 -g -gdwarf-2 -o a.dwarf2 $1.mod
+    if ! gdb ./a.dwarf2 ; then
+       echo "gdb crashed on $1.mod"
+    fi
+}
+
+
+doTry () {
+   cat <<EOF > .gdbinit
+set lang modula-2
+break _M2_$1_init
+run
+next
+print s
+ptype s
+quit
+EOF
+   doStabs $1
+   doDwarf2 $1
+}
+
+doTry setchar3
+doTry subrange15
+doTry subrange16
+doTry subrange17
+doTry array4
+doTry array5
+doTry char
+doTry int
+doTry ptrarray
+doTry variant9
+doTry setenum
+doTry record7
+doTry setchar4
+
+type gdb
diff --git a/gcc/testsuite/gm2/pim/pass/typeequiv.mod b/gcc/testsuite/gm2/pim/pass/typeequiv.mod
new file mode 100644
index 00000000000..bb5af581e1d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/typeequiv.mod
@@ -0,0 +1,56 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE typeequiv ;
+
+
+FROM SYSTEM IMPORT ADDRESS;
+
+TYPE
+   functionType = PROCEDURE (ADDRESS, ADDRESS) : INTEGER ;
+   aliasedType = functionType ;
+   anotherFunc = PROCEDURE (ADDRESS, ADDRESS) : aliasedType;
+
+
+PROCEDURE realFunc (a, b: ADDRESS) : INTEGER ;
+BEGIN
+   IF a = b
+   THEN
+      RETURN 1
+   ELSE
+      RETURN 0
+   END
+END realFunc ;
+
+
+PROCEDURE realGet (a, b: ADDRESS) : aliasedType ;
+BEGIN
+   RETURN realFunc
+END realGet ;
+
+
+VAR
+   compare: functionType;
+   a, b   : ADDRESS ;
+BEGIN
+   compare := realGet (a, b);
+   IF compare(a, b) = 1
+   THEN
+      a := b;
+   END
+END typeequiv.
diff --git a/gcc/testsuite/gm2/pim/pass/typeequiv2.mod b/gcc/testsuite/gm2/pim/pass/typeequiv2.mod
new file mode 100644
index 00000000000..e0fb8c3df32
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/typeequiv2.mod
@@ -0,0 +1,52 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE typeequiv2 ;
+
+
+FROM SYSTEM IMPORT ADDRESS;
+
+TYPE
+   functionType = PROCEDURE (ADDRESS, ADDRESS) : INTEGER ;
+   aliasedType = functionType ;
+   anotherFunc = PROCEDURE (ADDRESS, ADDRESS) : aliasedType;
+
+
+PROCEDURE realFunc (a, b: ADDRESS) : INTEGER ;
+BEGIN
+   IF a = b
+   THEN
+      RETURN 1
+   ELSE
+      RETURN 0
+   END
+END realFunc ;
+
+
+PROCEDURE realGet (a, b: ADDRESS) : aliasedType ;
+BEGIN
+   RETURN realFunc
+END realGet ;
+
+
+VAR
+   compare: functionType;
+   a, b   : ADDRESS ;
+BEGIN
+   compare := realGet (a, b)
+END typeequiv2.
diff --git a/gcc/testsuite/gm2/pim/pass/typeequiv3.mod b/gcc/testsuite/gm2/pim/pass/typeequiv3.mod
new file mode 100644
index 00000000000..f453ca39c0b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/typeequiv3.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE typeequiv3 ;
+
+
+FROM SYSTEM IMPORT ADDRESS;
+
+TYPE
+   functionType = PROCEDURE (ADDRESS, ADDRESS) : INTEGER ;
+
+
+PROCEDURE realFunc (a, b: ADDRESS) : INTEGER ;
+BEGIN
+   IF a = b
+   THEN
+      RETURN 1
+   ELSE
+      RETURN 0
+   END
+END realFunc ;
+
+
+PROCEDURE realGet (a, b: ADDRESS) : functionType ;
+BEGIN
+   RETURN realFunc
+END realGet ;
+
+
+VAR
+   compare: functionType;
+   a, b   : ADDRESS ;
+BEGIN
+   compare := realGet (a, b)
+END typeequiv3.
diff --git a/gcc/testsuite/gm2/pim/pass/typeonly.def b/gcc/testsuite/gm2/pim/pass/typeonly.def
new file mode 100644
index 00000000000..6ca3f0b7513
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/typeonly.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE typeonly ;
+
+TYPE
+   results   = (ok, outOfRange, wrongFormat, empty);
+   scanClass = (padding, valid, invalid, terminator);
+   scanState = PROCEDURE (CHAR, VAR scanClass, VAR scanState);
+
+END typeonly.
diff --git a/gcc/testsuite/gm2/pim/pass/typeonly.mod b/gcc/testsuite/gm2/pim/pass/typeonly.mod
new file mode 100644
index 00000000000..acc3f27c7b7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/typeonly.mod
@@ -0,0 +1,20 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE typeonly ;
+
+END typeonly.
diff --git a/gcc/testsuite/gm2/pim/pass/typesize.mod b/gcc/testsuite/gm2/pim/pass/typesize.mod
new file mode 100644
index 00000000000..8481ae8f315
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/typesize.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE typesize ;
+
+
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+   ch: CHAR ;
+   r : REAL ;
+   lr: LONGREAL ;
+   li: LONGINT ;
+BEGIN
+
+END typesize.
diff --git a/gcc/testsuite/gm2/pim/pass/unbounded.mod b/gcc/testsuite/gm2/pim/pass/unbounded.mod
new file mode 100644
index 00000000000..bb0f82d09b8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/unbounded.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE unbounded ;
+
+PROCEDURE func (a: ARRAY OF CHAR) ;
+BEGIN
+END func ;
+
+BEGIN
+(*   func('hello world') *)
+END unbounded.
diff --git a/gcc/testsuite/gm2/pim/pass/unbounded2.mod b/gcc/testsuite/gm2/pim/pass/unbounded2.mod
new file mode 100644
index 00000000000..b55d85abd8b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/unbounded2.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE unbounded2 ;
+
+PROCEDURE func (a: ARRAY OF CHAR) ;
+BEGIN
+END func ;
+
+BEGIN
+   func('hello world')
+END unbounded2.
diff --git a/gcc/testsuite/gm2/pim/pass/unbounded3.mod b/gcc/testsuite/gm2/pim/pass/unbounded3.mod
new file mode 100644
index 00000000000..e55218438fa
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/unbounded3.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE unbounded3 ;
+
+PROCEDURE func1 (a: ARRAY OF CHAR) ;
+BEGIN
+   a[3] := 'a'
+END func1 ;
+
+BEGIN
+   func1('abcde')
+END unbounded3.
diff --git a/gcc/testsuite/gm2/pim/pass/v.def b/gcc/testsuite/gm2/pim/pass/v.def
new file mode 100644
index 00000000000..be022e34c2d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/v.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE FOR "C" v ;
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT UNQUALIFIED test ;
+
+PROCEDURE test (a: ADDRESS) ;
+END v.
diff --git a/gcc/testsuite/gm2/pim/pass/varaddress.mod b/gcc/testsuite/gm2/pim/pass/varaddress.mod
new file mode 100644
index 00000000000..e9a4e8e6227
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varaddress.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE varaddress ;
+
+VAR
+   var [1000H] : CARDINAL ;
+BEGIN
+(*
+   VAR
+   a           : ADDRESS ;
+   IF ADR(a)#1000H
+   THEN
+      HALT
+   END
+*)
+END varaddress.
diff --git a/gcc/testsuite/gm2/pim/pass/varaddress2.mod b/gcc/testsuite/gm2/pim/pass/varaddress2.mod
new file mode 100644
index 00000000000..bc7efbadc97
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varaddress2.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE varaddress2 ;
+
+VAR
+   var [1000H] : CARDINAL ;
+BEGIN
+   IF var=0
+   THEN
+   END
+END varaddress2.
diff --git a/gcc/testsuite/gm2/pim/pass/varaddress3.mod b/gcc/testsuite/gm2/pim/pass/varaddress3.mod
new file mode 100644
index 00000000000..77a8af6f1e1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varaddress3.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2006 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 2, 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. *)
+
+MODULE varaddress3 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+
+VAR
+   var [1000H] : CARDINAL ;
+BEGIN
+   IF ADR(var)#ADDRESS(1000H)
+   THEN
+      HALT
+   END ;
+   IF ADR(var)#ADDRESS(1000H)
+   THEN
+      HALT
+   END
+END varaddress3.
diff --git a/gcc/testsuite/gm2/pim/pass/varcard.mod b/gcc/testsuite/gm2/pim/pass/varcard.mod
new file mode 100644
index 00000000000..afc610cf361
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varcard.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varcard ;
+
+
+(*
+   test - 
+*)
+
+PROCEDURE test (VAR c: CARDINAL) ;
+BEGIN
+   c := 1
+END test ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   test(c)
+END varcard.
diff --git a/gcc/testsuite/gm2/pim/pass/variant9.mod b/gcc/testsuite/gm2/pim/pass/variant9.mod
new file mode 100644
index 00000000000..85bd156e32a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/variant9.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE variant9 ;
+
+FROM libc IMPORT exit, printf ;
+
+TYPE
+  DataType = (card, other);
+  RcdType = RECORD
+              CASE Data : DataType OF
+                card  :  j : CARDINAL;
+                         k : CARDINAL |
+                other : st : CHAR ;
+              END
+            END ;
+      
+VAR
+  s: RcdType;
+  r: INTEGER ;
+BEGIN
+   WITH s DO
+      Data := card;
+      j := 123;
+      k := 456;
+      r := printf('j = %d and k = %d\n', j, k)
+   END ;
+   IF (s.j#123) OR (s.k#456)
+   THEN
+      exit(1)
+   END
+END variant9.
diff --git a/gcc/testsuite/gm2/pim/pass/varient.mod b/gcc/testsuite/gm2/pim/pass/varient.mod
new file mode 100644
index 00000000000..8889b42c000
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varient.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE varient;
+
+FROM libc IMPORT exit, printf ;
+
+TYPE
+  DataType = (card, other);
+  RcdType = RECORD
+              CASE Data : DataType OF
+                card  :  j : CARDINAL;
+                         k : CARDINAL |
+                other : st : CHAR ;
+              END
+            END ;
+      
+VAR
+  R1 : RcdType;
+  r  : INTEGER ;
+BEGIN
+   WITH R1 DO
+      Data := card;
+      j := 123;
+      k := 456;
+      r := printf('j = %d and k = %d\n', j, k)
+   END ;
+   IF (R1.j#123) OR (R1.k#456)
+   THEN
+      exit(1)
+   END
+END varient.
diff --git a/gcc/testsuite/gm2/pim/pass/varient2.mod b/gcc/testsuite/gm2/pim/pass/varient2.mod
new file mode 100644
index 00000000000..07eec91b398
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varient2.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient2 ;
+
+TYPE
+   Structform = (sets, bigsets) ;
+   Structrec = RECORD
+                  CASE form: Structform OF
+                  | sets, bigsets: basep: CARDINAL;
+                                   CASE : Structform OF
+                                   |
+                                   bigsets: offset, low, high: CARDINAL; 
+                                   | sets: (* no further fields *)
+                                   END;
+                  END
+               END ;
+
+BEGIN
+END varient2.
diff --git a/gcc/testsuite/gm2/pim/pass/varient3.mod b/gcc/testsuite/gm2/pim/pass/varient3.mod
new file mode 100644
index 00000000000..f1ba05d8a5a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varient3.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient3 ;
+
+TYPE
+   Structform = (sets, bigsets) ;
+   Structrec = RECORD
+                  CASE form: Structform OF
+                  | sets, bigsets:
+                  basep: CARDINAL;
+                  CASE : Structform OF
+                  |
+                     bigsets: foo: CARDINAL ;
+                     offset, low, high: CARDINAL; 
+                  | sets: (* no further fields *)
+                  END;
+               END
+            END ;
+
+BEGIN
+END varient3.
diff --git a/gcc/testsuite/gm2/pim/pass/varient4.mod b/gcc/testsuite/gm2/pim/pass/varient4.mod
new file mode 100644
index 00000000000..c0f96e03daa
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varient4.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient4 ;
+
+TYPE
+   this = RECORD
+             CASE tag: CARDINAL OF
+             1: foo: CARDINAL ;
+                  CASE bar: BOOLEAN OF
+                  TRUE : bt: INTEGER |
+                  FALSE: bf: CARDINAL
+                  END |
+             2: an: SHORTREAL |
+             ELSE
+             END
+          END ;
+
+VAR
+   hmm: this ;
+   j  : CARDINAL ;
+BEGIN
+(*
+   hmm.foo := 99 ;
+   hmm.tag := 'a' ;
+   hmm.bar := TRUE ;
+*)
+   hmm.bt  := -1 ;
+   hmm.bf  := 2 ;
+   hmm.an  := 1.0 ;
+   j := SIZE(this)
+END varient4.
diff --git a/gcc/testsuite/gm2/pim/pass/varient5.mod b/gcc/testsuite/gm2/pim/pass/varient5.mod
new file mode 100644
index 00000000000..97bad837667
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varient5.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient5 ;
+
+TYPE
+   Structform = (sets) ;
+   Structrec = RECORD
+                  CASE form: Structform OF
+                  sets: basep: CARDINAL ;
+                        hmm: RECORD
+                           CASE foo: Structform OF
+                           sets: offset: CARDINAL ;
+                           END
+                        END
+                  END
+               END ;
+
+BEGIN
+END varient5.
diff --git a/gcc/testsuite/gm2/pim/pass/varient6.mod b/gcc/testsuite/gm2/pim/pass/varient6.mod
new file mode 100644
index 00000000000..0f142e387d6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varient6.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient6 ;
+
+TYPE
+   Structform = (sets) ;
+   Structrec = RECORD
+                  CASE form: Structform OF
+                  sets: basep: CARDINAL ;
+                        hmm: RECORD
+                           CASE foo: Structform OF
+                           sets: offset: CARDINAL ;
+                           END
+                        END
+                  END
+               END ;
+
+VAR
+   this: Structrec ;
+BEGIN
+   this.hmm.offset := 22
+END varient6.
diff --git a/gcc/testsuite/gm2/pim/pass/varient7.mod b/gcc/testsuite/gm2/pim/pass/varient7.mod
new file mode 100644
index 00000000000..84d83836cb7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varient7.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient7 ;
+
+TYPE
+   Structform = (sets) ;
+   Structrec = RECORD
+                  CASE form: Structform OF
+                  sets: basep: CARDINAL ;
+                        CASE foo: Structform OF
+                           sets: offset: CARDINAL ;
+                        END
+                  END
+               END ;
+
+VAR
+   this: Structrec ;
+BEGIN
+   this.offset := 22
+END varient7.
diff --git a/gcc/testsuite/gm2/pim/pass/varient8.mod b/gcc/testsuite/gm2/pim/pass/varient8.mod
new file mode 100644
index 00000000000..627e3ccc8a8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varient8.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient8 ;
+
+FROM v IMPORT test ;
+FROM SYSTEM IMPORT ADR, TSIZE ;
+
+TYPE
+   this = RECORD
+             CASE tag: CARDINAL OF
+             1: foo: CARDINAL |
+             2: an: INTEGER |
+             ELSE
+             END ;
+             bar: CARDINAL ;
+          END ;
+
+VAR
+   hmm: this ;
+   j,c: CARDINAL ;
+BEGIN
+   hmm.tag := 22 ;
+   hmm.an  := -1 ;
+   hmm.foo := 99 ;
+   hmm.bar := 77 ;
+   j := TSIZE(hmm) ;
+   c := TSIZE(CARDINAL) ;
+   test(ADR(hmm))
+END varient8.
diff --git a/gcc/testsuite/gm2/pim/pass/varin.def b/gcc/testsuite/gm2/pim/pass/varin.def
new file mode 100644
index 00000000000..52aae90dc76
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varin.def
@@ -0,0 +1,24 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE varin ;
+
+EXPORT QUALIFIED var ;
+
+VAR
+   var: INTEGER ;
+
+END varin.
diff --git a/gcc/testsuite/gm2/pim/pass/varin.mod b/gcc/testsuite/gm2/pim/pass/varin.mod
new file mode 100644
index 00000000000..abe00eb03bd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varin.mod
@@ -0,0 +1,22 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE varin ;
+
+
+BEGIN
+   var := 123
+END varin.
diff --git a/gcc/testsuite/gm2/pim/pass/varint.mod b/gcc/testsuite/gm2/pim/pass/varint.mod
new file mode 100644
index 00000000000..3f903f32216
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/varint.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varint ;
+
+
+PROCEDURE test (VAR x: INTEGER) ;
+BEGIN
+   x := 1
+END test ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   test(i)
+END varint.
diff --git a/gcc/testsuite/gm2/pim/pass/wincat.mod b/gcc/testsuite/gm2/pim/pass/wincat.mod
new file mode 100644
index 00000000000..b4916baf6b2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/wincat.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE wincat ;
+
+FROM FIO IMPORT File, OpenToRead, EOF, Close, ReadChar, WriteChar,
+                StdOut ;
+FROM Args IMPORT GetArg ;
+
+VAR
+   f: File ;
+   a: ARRAY [0..4096] OF CHAR ;
+BEGIN
+   IF GetArg(a, 1)
+   THEN
+      f := OpenToRead(a) ;
+      WHILE NOT EOF(f) DO
+         WriteChar(StdOut, ReadChar(f))
+      END ;
+      Close(f)
+   END
+END wincat.
diff --git a/gcc/testsuite/gm2/pim/pass/with.mod b/gcc/testsuite/gm2/pim/pass/with.mod
new file mode 100644
index 00000000000..74b93b1f466
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/with.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE with ;
+
+
+TYPE
+   r = RECORD
+          x, y: CARDINAL ;
+       END ;
+
+VAR
+   v: r ;
+   i, j: CARDINAL ;
+BEGIN
+   IF i=j
+   THEN
+      WITH v DO
+         x := i
+      END
+   END
+END with.
diff --git a/gcc/testsuite/gm2/pim/pass/wordconst.mod b/gcc/testsuite/gm2/pim/pass/wordconst.mod
new file mode 100644
index 00000000000..329a0cf4ec8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/wordconst.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE wordconst ;
+
+FROM SYSTEM IMPORT WORD ;
+
+CONST
+   word = WORD(012H) ;
+
+VAR
+   w: WORD ;
+BEGIN
+   w := word
+END wordconst.
diff --git a/gcc/testsuite/gm2/pim/run/fail/case.mod b/gcc/testsuite/gm2/pim/run/fail/case.mod
new file mode 100644
index 00000000000..4a8f9995f55
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/fail/case.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE case ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 3 ;
+   CASE i OF
+
+   1: |
+   2:
+
+   END
+END case.
+(*
+ *  options: "-fcase"
+ *)
diff --git a/gcc/testsuite/gm2/pim/run/fail/nil.mod b/gcc/testsuite/gm2/pim/run/fail/nil.mod
new file mode 100644
index 00000000000..049b4e20912
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/fail/nil.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nil ;
+
+VAR
+   p: POINTER TO CARDINAL ;
+BEGIN
+   p := NIL ;
+   p^ := 3
+END nil.
+(*
+ *  options: "-Wnil"
+ *)
diff --git a/gcc/testsuite/gm2/pim/run/fail/pim-run-fail.exp b/gcc/testsuite/gm2/pim/run/fail/pim-run-fail.exp
new file mode 100644
index 00000000000..652b5484210
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/fail/pim-run-fail.exp
@@ -0,0 +1,38 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}../gm2/pim/run/fail" -fsoft-check-all -fno-m2-plugin
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "fail"
+}
diff --git a/gcc/testsuite/gm2/pim/run/pass/Countdown.mod b/gcc/testsuite/gm2/pim/run/pass/Countdown.mod
new file mode 100644
index 00000000000..8f4066cb075
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/Countdown.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE Countdown;
+(*
+ * FOR loop marches down to the bottom of the earth.
+ *
+ * WARNING: CODE CARRIES NO WARRATY! USE AT OWN RISK!
+ *)
+IMPORT StrIO, NumberIO, libc ;
+
+VAR
+   x, n :CARDINAL;
+BEGIN
+   x := 0 ;
+   FOR n := 10 TO 0 BY -1 DO
+      NumberIO.WriteCard(n, 4); StrIO.WriteLn ;
+      INC(x) ;
+      IF x>20
+      THEN
+         StrIO.WriteString('FOR BY -1 test failed') ;
+         StrIO.WriteLn ;
+         libc.exit(1)
+      END
+   END (*FOR*)
+END Countdown.
diff --git a/gcc/testsuite/gm2/pim/run/pass/EndFor.def b/gcc/testsuite/gm2/pim/run/pass/EndFor.def
new file mode 100644
index 00000000000..11dfa65abc9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/EndFor.def
@@ -0,0 +1,28 @@
+(* Copyright (C) 2014 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. *)
+
+DEFINITION MODULE EndFor ;
+
+
+PROCEDURE CheckLongintInteger (des: LONGINT; inc: INTEGER) ;
+PROCEDURE CheckLongintLongint (des: LONGINT; inc: LONGINT) ;
+PROCEDURE CheckCardinalInteger (des: CARDINAL; inc: INTEGER) ;
+PROCEDURE CheckCardinalCardinal (des: CARDINAL; inc: CARDINAL) ;
+
+
+END EndFor.
diff --git a/gcc/testsuite/gm2/pim/run/pass/EndFor.mod b/gcc/testsuite/gm2/pim/run/pass/EndFor.mod
new file mode 100644
index 00000000000..1659f0f86ce
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/EndFor.mod
@@ -0,0 +1,185 @@
+(* Copyright (C) 2014 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. *)
+
+IMPLEMENTATION MODULE EndFor ;
+
+FROM libc IMPORT exit, printf ;
+
+
+PROCEDURE CheckLongintInteger (des: LONGINT; inc: INTEGER) ;
+VAR
+   lg        : LONGINT ;
+   room, desn: LONGINT ;
+BEGIN
+   lg := VAL(LONGINT, inc) ;
+   IF inc>=0
+   THEN
+      IF des>=0
+      THEN
+         room := MAX(LONGINT)-des ;
+         IF lg>room
+         THEN
+            printf("increment exceeds range at end of FOR loop\n") ;
+            exit (2)
+         END
+      ELSE
+         (* inc can never cause an overflow given its type *)
+      END
+   ELSE
+      (* inc < 0 *)
+      IF des>=0
+      THEN
+         (* inc can never cause an underflow given its type *)
+      ELSE
+         (* des < 0 *)
+         IF des=MIN(LONGINT)
+         THEN
+            printf("increment exceeds range at end of FOR loop\n") ;
+            exit (4)
+         ELSE
+            desn := -des;
+            room := MIN(LONGINT)+desn ;
+            lg := -lg ;
+            IF lg>room
+            THEN
+               printf("increment exceeds range at end of FOR loop\n") ;
+               exit (5)
+            END
+         END
+      END
+   END
+END CheckLongintInteger ;
+
+
+PROCEDURE CheckLongintLongint (des: LONGINT; inc: LONGINT) ;
+VAR
+   lg        : LONGINT ;
+   room, desn: LONGINT ;
+BEGIN
+   IF inc>=0
+   THEN
+      IF des>=0
+      THEN
+         lg := inc ;
+         room := MAX(LONGINT)-des ;
+         IF lg>room
+         THEN
+            printf("increment exceeds range at end of FOR loop\n") ;
+            exit (2)
+         END
+      ELSE
+         (* inc can never cause an overflow given its type *)
+      END
+   ELSE
+      (* inc < 0 *)
+      IF des>=0
+      THEN
+         (* inc can never cause an underflow given its type *)
+      ELSE
+         IF des=MIN(LONGINT)
+         THEN
+            printf("increment exceeds range at end of FOR loop\n") ;
+            exit (4)
+         ELSE
+            IF inc=MIN(LONGINT)
+            THEN
+               IF des=0
+               THEN
+                  printf("increment exceeds range at end of FOR loop\n") ;
+                  exit (5)
+               END
+            ELSE
+               (* des < 0 *)
+               desn := -des;
+               room := MIN(LONGINT)+desn ;
+               lg := -inc ;
+               IF lg>room
+               THEN
+                  printf("increment exceeds range at end of FOR loop\n") ;
+                  exit (6)
+               END
+            END
+         END
+      END
+   END
+END CheckLongintLongint ;
+
+
+PROCEDURE CheckCardinalInteger (des: CARDINAL; inc: INTEGER) ;
+VAR
+   room: CARDINAL ;
+   lg  : CARDINAL ;
+BEGIN
+   IF inc>=0
+   THEN
+      IF des>=0
+      THEN
+         lg := VAL(CARDINAL, inc) ;
+         room := MAX(CARDINAL)-des ;
+         IF lg>room
+         THEN
+            printf("increment exceeds range at end of FOR loop\n") ;
+            exit (2)
+         END
+      ELSE
+         (* inc can never cause an overflow given its type *)
+      END
+   ELSE
+      (* inc < 0 *)
+      IF des>VAL(CARDINAL, MAX(INTEGER))
+      THEN
+         (* inc can never cause an underflow given its range *)
+      ELSE
+         (* des <= MAX(INTEGER) *)
+         IF des = CARDINAL (MAX (INTEGER))
+         THEN
+            printf("increment exceeds range at end of FOR loop\n") ;
+            exit (4)
+         ELSE
+            IF inc=MIN(INTEGER)
+            THEN
+               IF des=0
+               THEN
+                  printf("increment exceeds range at end of FOR loop\n") ;
+                  exit (5)
+               END
+            ELSE
+               lg := VAL(CARDINAL, -inc) ;
+               IF lg>des
+               THEN
+                  printf("increment exceeds range at end of FOR loop\n") ;
+                  exit (5)
+               END
+            END
+         END
+      END
+   END
+END CheckCardinalInteger ;
+
+
+PROCEDURE CheckCardinalCardinal (des: CARDINAL; inc: CARDINAL) ;
+BEGIN
+   IF MAX(CARDINAL)-des<inc
+   THEN
+      printf("increment exceeds range at end of FOR loop\n") ;
+      exit (2)
+   END
+END CheckCardinalCardinal ;
+
+
+END EndFor.
diff --git a/gcc/testsuite/gm2/pim/run/pass/EnumTest.mod b/gcc/testsuite/gm2/pim/run/pass/EnumTest.mod
new file mode 100644
index 00000000000..196588149cf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/EnumTest.mod
@@ -0,0 +1,70 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE EnumTest ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+TYPE
+   enumType = (zero, one, two, three, four) ;
+   arrayType = ARRAY enumType OF BOOLEAN ;
+
+CONST
+   lastEnum = four ;
+
+VAR
+   e: enumType ;
+   i: CARDINAL ;
+   a: arrayType ;
+BEGIN
+   res := 0 ;
+   FOR e := zero TO lastEnum DO
+      a[e] := FALSE ;
+   END ;
+   FOR e := zero TO lastEnum DO
+      Assert(NOT a[e], __FILE__, __LINE__, 'testing array against FALSE')
+   END ;
+   FOR e := zero TO lastEnum DO
+      a[e] := TRUE ;
+   END ;
+   FOR e := zero TO lastEnum DO
+      Assert(a[e], __FILE__, __LINE__, 'testing array against TRUE')
+   END ;
+   i := 1 ;
+   FOR e := one TO lastEnum DO
+      Assert (ORD (e) = i, __FILE__, __LINE__, 'enum against a value') ;
+      INC (i)
+   END ;
+   exit(res)
+END EnumTest.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For1.mod b/gcc/testsuite/gm2/pim/run/pass/For1.mod
new file mode 100644
index 00000000000..f53c31316aa
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For1.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE For1 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i, c: CARDINAL ;
+BEGIN
+   c := 0 ;
+   FOR i := 1 TO 20 BY 2 DO
+      INC(c, i)
+   END ;
+   IF c#1+3+5+7+9+11+13+15+17+19
+   THEN
+      exit(1)
+   END
+END For1.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For10.mod b/gcc/testsuite/gm2/pim/run/pass/For10.mod
new file mode 100644
index 00000000000..3c30aa194df
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For10.mod
@@ -0,0 +1,65 @@
+(* Copyright (C) 2014 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. *)
+
+MODULE For10 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+(* FROM EndFor IMPORT CheckCardinalInteger ; *)
+
+CONST
+   Check = TRUE ;
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+VAR
+   c      : CARDINAL ;
+   n, i, j: CARDINAL ;
+BEGIN
+   res := 0 ;
+   n := 4 ;
+   c := 0 ; 
+   FOR i := 30000 TO 0 BY -10000 DO
+      j := i ;
+      Assert(c<5, __FILE__,  __LINE__, "for loop executed too many times") ;
+      INC(c) ;
+(*
+      IF i#0
+      THEN
+         CheckCardinalInteger(i, -10000)   (* we cannot test when i=0 *)
+      END
+*)
+   END ;
+   Assert(c=4, __FILE__,  __LINE__, "for loop executed too few times") ;
+   Assert(i=0, __FILE__,  __LINE__, "for loop index") ;
+   exit(res)
+END For10.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For11.mod b/gcc/testsuite/gm2/pim/run/pass/For11.mod
new file mode 100644
index 00000000000..6400e923d26
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For11.mod
@@ -0,0 +1,65 @@
+(* Copyright (C) 2014 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. *)
+
+MODULE For11 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+(* FROM EndFor IMPORT CheckCardinalInteger ; *)
+
+CONST
+   Check = TRUE ;
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+VAR
+   c      : CARDINAL ;
+   n, i, j: INTEGER ;
+BEGIN
+   res := 0 ;
+   n := 4 ;
+   c := 0 ; 
+   FOR i := 30000 TO 0 BY -10000 DO
+      j := i ;
+      Assert(c<5, __FILE__,  __LINE__, "for loop executed too many times") ;
+      INC(c) ;
+(*
+      IF i#0
+      THEN
+         CheckCardinalInteger(i, -10000)   (* we cannot test when i=0 *)
+      END
+*)
+   END ;
+   Assert(c=4, __FILE__,  __LINE__, "for loop executed too few times") ;
+   Assert(i=0, __FILE__,  __LINE__, "for loop index") ;
+   exit(res)
+END For11.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For12.mod b/gcc/testsuite/gm2/pim/run/pass/For12.mod
new file mode 100644
index 00000000000..44df3ce0b00
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For12.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE For12 ;
+
+FROM libc IMPORT exit, printf ;
+
+VAR
+   i, c: CARDINAL ;
+BEGIN
+   c := 0 ;
+   FOR i := 20 TO 2 BY -2 DO
+      printf ("c = %d, i = %d\n", c, i) ;
+      INC (c, i)
+   END ;
+   IF c#2+4+6+8+10+12+14+16+18+20
+   THEN
+      exit (1)
+   END
+END For12.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For2.mod b/gcc/testsuite/gm2/pim/run/pass/For2.mod
new file mode 100644
index 00000000000..ca391cc76b0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For2.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE For2 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i, c: CARDINAL ;
+BEGIN
+   c := 0 ;
+   FOR i := 19 TO 0 BY -2 DO
+      INC (c, i)
+   END ;
+   IF c#1+3+5+7+9+11+13+15+17+19
+   THEN
+      exit (1)
+   END
+END For2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For3.mod b/gcc/testsuite/gm2/pim/run/pass/For3.mod
new file mode 100644
index 00000000000..eb6dc177995
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For3.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE For3 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE arithp (a, n, d: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( a+(n-1)*d )
+END arithp ;
+
+PROCEDURE sumarithp (a, n, d: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( (n DIV 2) * (2*a+(n-1)*d) )
+END sumarithp ;
+
+
+VAR
+   c, i: CARDINAL ;
+BEGIN
+   c := 0 ;
+   FOR i := 3 TO 96 BY 4 DO
+      INC(c, i)
+   END ;
+   IF i#arithp(3, 1+(96-3) DIV 4, 4)
+   THEN
+      exit(1)
+   END ;
+   IF c#sumarithp(3, 1+(96-3) DIV 4, 4)
+   THEN
+      exit(2)
+   END
+END For3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For4.mod b/gcc/testsuite/gm2/pim/run/pass/For4.mod
new file mode 100644
index 00000000000..026b2b3eb4a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For4.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE For4 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE sumarithp (a, n, d: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( (n DIV 2) * (2*a+(n-1)*d) )
+END sumarithp ;
+
+PROCEDURE arithp (a, n, d: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN( a+(n-1)*d )
+END arithp ;
+
+PROCEDURE foo ;
+BEGIN
+   n := 1 ;
+   c := 0 ;
+   FOR i := 1 TO 100 BY 2 DO
+      INC(c, i) ;
+      IF n=24
+      THEN
+         RETURN
+      END ;
+      INC(n)
+   END
+END foo ;
+
+VAR
+   n, c, i: CARDINAL ;
+BEGIN
+   foo ;
+   IF c#sumarithp(1, 24, 2)
+   THEN
+      exit(1)
+   END
+END For4.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For5.mod b/gcc/testsuite/gm2/pim/run/pass/For5.mod
new file mode 100644
index 00000000000..89def4c1933
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For5.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE For5 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated %s\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+VAR
+   n,
+   i, j: INTEGER ;
+BEGIN
+   res := 0 ;
+   n := 2 ;
+   FOR i := n TO 1 BY -1 DO
+      j := i
+   END ;
+   Assert(j=1, __FILE__,  __LINE__, "for loop index") ;
+   exit(res)
+END For5.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For6.mod b/gcc/testsuite/gm2/pim/run/pass/For6.mod
new file mode 100644
index 00000000000..a1c997793dd
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For6.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE For6 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated %s\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+VAR
+   n, c,
+   i, j: INTEGER ;
+BEGIN
+   res := 0 ;
+   n := 4 ;
+   c := 1 ;
+   FOR i := n TO 0 BY -1 DO
+      j := i ;
+      Assert(c<6, __FILE__,  __LINE__, "for loop executed too many times") ;
+      INC(c)
+   END ;
+   Assert(c=6, __FILE__,  __LINE__, "for loop executed too few times") ;
+   Assert(j=0, __FILE__,  __LINE__, "for loop index") ;
+   exit(res)
+END For6.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For7.mod b/gcc/testsuite/gm2/pim/run/pass/For7.mod
new file mode 100644
index 00000000000..d422c49b3ea
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For7.mod
@@ -0,0 +1,60 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE For7 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+(* FROM EndFor IMPORT CheckLongintInteger ; *)
+
+CONST
+   PseudoCheck = FALSE ;
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion\n")
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+VAR
+   c      : INTEGER ;
+   n, i, j: LONGINT ;
+BEGIN
+   res := 0 ;
+   n := 4 ;
+   c := 0 ;
+   FOR i := -256 TO 256 BY 64 DO
+      printf("i = %d\n", i);
+      j := i ;
+      Assert(c<10, __FILE__,  __LINE__, "for loop executed too many times") ;
+      INC(c) ;
+      (* CheckLongintInteger(i, 64) *)
+   END ;
+   Assert(c=9, __FILE__,  __LINE__, "for loop executed too few times") ;
+   Assert(i=256, __FILE__,  __LINE__, "for loop index") ;
+   exit(res)
+END For7.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For8.mod b/gcc/testsuite/gm2/pim/run/pass/For8.mod
new file mode 100644
index 00000000000..883ee10a920
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For8.mod
@@ -0,0 +1,59 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE For8 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+(* FROM EndFor IMPORT CheckLongintLongint ; *)
+
+CONST
+   Check = TRUE ;
+
+VAR
+   res: INTEGER ;
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+VAR
+   c      : INTEGER ;
+   n, i, j: LONGINT ;
+BEGIN
+   res := 0 ;
+   n := 4 ;
+   c := 0 ;
+   FOR i := -256000000000 TO 256000000000 BY 64000000000 DO
+      j := i ;
+      Assert(c<10, __FILE__,  __LINE__, "for loop executed too many times") ;
+      INC(c) ;
+      (* CheckLongintLongint(i, 64000000000) *)
+   END ;
+   Assert(c=9, __FILE__,  __LINE__, "for loop executed too few times") ;
+   Assert(i=256000000000, __FILE__,  __LINE__, "for loop index") ;
+   exit(res)
+END For8.
diff --git a/gcc/testsuite/gm2/pim/run/pass/For9.mod b/gcc/testsuite/gm2/pim/run/pass/For9.mod
new file mode 100644
index 00000000000..c25f33e946d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/For9.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE For9 ;
+
+VAR
+   a : ARRAY CHAR OF CHAR ;
+   ch: CHAR ;
+BEGIN
+   FOR ch := MIN(CHAR) TO MAX(CHAR) DO
+      a[ch] := ' '
+   END
+END For9.
diff --git a/gcc/testsuite/gm2/pim/run/pass/FpuIOBug.mod b/gcc/testsuite/gm2/pim/run/pass/FpuIOBug.mod
new file mode 100644
index 00000000000..16154128d66
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/FpuIOBug.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE FpuIOBug;
+
+FROM StrIO IMPORT WriteLn;
+FROM FpuIO IMPORT WriteLongInt;
+
+VAR
+   i, j: LONGINT;
+BEGIN
+   i := MAX(LONGINT);
+   WriteLongInt(i,0);
+   WriteLn;
+   j := MIN(LONGINT);
+   WriteLongInt(j,0);
+   WriteLn;
+   j := MIN(LONGINT) + 1;
+   WriteLongInt(j,0);
+   WriteLn
+END FpuIOBug.
diff --git a/gcc/testsuite/gm2/pim/run/pass/MaxReal.mod b/gcc/testsuite/gm2/pim/run/pass/MaxReal.mod
new file mode 100644
index 00000000000..15f9c7b3c45
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/MaxReal.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE MaxReal ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   r: REAL ;
+BEGIN
+   r := MAX (REAL) ;
+   IF r=0.0
+   THEN
+      exit (1)
+   END
+END MaxReal.
diff --git a/gcc/testsuite/gm2/pim/run/pass/MaxReal2.mod b/gcc/testsuite/gm2/pim/run/pass/MaxReal2.mod
new file mode 100644
index 00000000000..2c7b37d45d9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/MaxReal2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE MaxReal2 ;
+
+FROM libc IMPORT exit, printf ;
+
+
+PROCEDURE check (r: REAL) ;
+BEGIN
+   printf ("value is real r = %g\n", r) ;
+   IF r=0.0
+   THEN
+      exit (1)
+   END
+END check ;
+
+
+BEGIN
+   check (MAX (REAL))
+END MaxReal2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/TestLong.mod b/gcc/testsuite/gm2/pim/run/pass/TestLong.mod
new file mode 100644
index 00000000000..cf59b0b50d7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/TestLong.mod
@@ -0,0 +1,52 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE TestLong;
+
+FROM StrIO IMPORT WriteString, WriteLn;
+FROM FpuIO IMPORT StrToLongInt, WriteLongInt, LongIntToStr;
+FROM StrLib IMPORT StrEqual ;
+FROM M2RTS IMPORT ExitOnHalt ;
+
+TYPE
+   String = ARRAY [0..255] OF CHAR;
+
+VAR
+   CorrectResult,
+   LongIntegerVariable : LONGINT;
+   SameResult,
+   St                  : String;
+
+BEGIN
+   LongIntegerVariable := 12345678901234;
+   WriteLongInt(LongIntegerVariable, 0);
+   WriteLn;
+   St := '12345678901234';
+   WriteString(St);
+   WriteLn;
+   LongIntToStr(LongIntegerVariable, 0, SameResult) ;
+   StrToLongInt(St, CorrectResult) ;
+   WriteLongInt(CorrectResult, 0);
+   WriteLn ;
+   IF NOT StrEqual(St, SameResult)
+   THEN
+      WriteString('test failed: correct value is: ') ; WriteString(St) ;
+      WriteString(' assignment produced ') ; WriteString(SameResult) ;
+      WriteLn ;
+      ExitOnHalt(1) ;
+      HALT
+   END
+END TestLong.
diff --git a/gcc/testsuite/gm2/pim/run/pass/TestLong2.mod b/gcc/testsuite/gm2/pim/run/pass/TestLong2.mod
new file mode 100644
index 00000000000..cdc27392496
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/TestLong2.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE TestLong2 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   l: LONGCARD ;
+BEGIN
+   (* test for assignment of MAX (LONGINT).  *)
+   l := 9223372036854775807 ;
+   IF l # 9223372036854775807
+   THEN
+      exit (1)
+   END
+END TestLong2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/TestLong4.mod b/gcc/testsuite/gm2/pim/run/pass/TestLong4.mod
new file mode 100644
index 00000000000..78c8fe4f9a2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/TestLong4.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE TestLong4 ;
+
+FROM StrIO IMPORT WriteLn, WriteString;
+FROM FpuIO IMPORT WriteLongInt;
+FROM M2RTS IMPORT ExitOnHalt ;
+
+VAR
+  LongIntegerVariable : LONGINT;
+
+BEGIN
+   LongIntegerVariable := -12345678901234;
+   WriteString('we should see the value -12345678901234 appear here: ') ;
+   WriteLongInt(LongIntegerVariable,0);
+   WriteLn ;
+   IF LongIntegerVariable=-12345678901234
+   THEN
+      WriteString(' correct result') ; WriteLn
+   ELSE
+      WriteString(' incorrect result') ; WriteLn ;
+      ExitOnHalt(1) ;
+      HALT
+   END 
+END TestLong4.
diff --git a/gcc/testsuite/gm2/pim/run/pass/TestLong5.mod b/gcc/testsuite/gm2/pim/run/pass/TestLong5.mod
new file mode 100644
index 00000000000..569636b41d8
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/TestLong5.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE TestLong5 ;
+
+FROM SYSTEM IMPORT TSIZE ;
+FROM StrIO IMPORT WriteLn, WriteString;
+FROM FpuIO IMPORT WriteLongInt;
+FROM NumberIO IMPORT WriteCard ;
+FROM M2RTS IMPORT ExitOnHalt ;
+
+VAR
+  LongIntegerVariable : LONGINT;
+
+BEGIN
+   WriteString('max cardinal is: ') ; WriteCard(MAX(CARDINAL), 8) ; WriteLn ;
+   LongIntegerVariable := LONGINT(MAX(CARDINAL)) + LONGINT(MAX(CARDINAL));
+   WriteString('we should see the value 8589934590 for 32 bit CARDINALs appear here: ') ;
+   WriteLongInt(LongIntegerVariable,0);
+   WriteLn ;
+   IF TSIZE(CARDINAL)=4
+   THEN
+      IF LongIntegerVariable=8589934590
+      THEN
+         WriteString(' correct result') ; WriteLn
+      ELSE
+         WriteString(' incorrect result') ; WriteLn ;
+         ExitOnHalt(1) ;
+         HALT
+      END
+   ELSE
+      WriteString(' ignoring test on non 32 bit INTEGER machines') ; WriteLn ;
+   END
+END TestLong5.
diff --git a/gcc/testsuite/gm2/pim/run/pass/addrarray.mod b/gcc/testsuite/gm2/pim/run/pass/addrarray.mod
new file mode 100644
index 00000000000..f11c1a41792
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/addrarray.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE addrarray ;
+
+FROM libc IMPORT printf ;
+FROM SYSTEM IMPORT ADR, SIZE ;
+
+TYPE
+   record = RECORD
+               x, y, z: CARDINAL ;
+            END ;
+
+VAR
+   a: ARRAY [0..1] OF record ;
+BEGIN
+   printf ("address of a[0] is 0x%p\n", ADR(a[0]));
+   printf ("address of a[1] is 0x%p\n", ADR(a[1]));
+
+   printf ("address of a[0].x is 0x%p\n", ADR(a[0].x));
+   printf ("address of a[1].x is 0x%p\n", ADR(a[1].x));
+
+   printf ("size of record = %d bytes\n", SIZE(record));
+END addrarray.
diff --git a/gcc/testsuite/gm2/pim/run/pass/arraychar.mod b/gcc/testsuite/gm2/pim/run/pass/arraychar.mod
new file mode 100644
index 00000000000..84d28941ca7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/arraychar.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE arraychar ;
+
+FROM StrLib IMPORT StrEqual ;
+FROM libc IMPORT exit ;
+
+
+TYPE
+   T = ARRAY [0..19] OF CHAR ;
+
+
+PROCEDURE myproc (p: T) ;
+BEGIN
+   INC (test);
+   IF NOT StrEqual (p, 'z')
+   THEN
+      exit (test)
+   END
+END myproc ;
+
+
+VAR
+   a   : T ;
+   test: INTEGER ;
+BEGIN
+   test := 0 ;
+   a := 'z' ;
+   myproc ('z')      
+END arraychar.
diff --git a/gcc/testsuite/gm2/pim/run/pass/arraychar2.mod b/gcc/testsuite/gm2/pim/run/pass/arraychar2.mod
new file mode 100644
index 00000000000..cd063716dd5
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/arraychar2.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2015 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. *)
+
+MODULE arraychar2 ;
+
+FROM StrLib IMPORT StrEqual ;
+FROM libc IMPORT exit, printf ;
+
+
+TYPE
+   T = ARRAY [0..19] OF CHAR ;
+
+
+PROCEDURE myproc (p: T) ;
+BEGIN
+   INC (test);
+   IF NOT StrEqual (p, 'z')
+   THEN
+      exit (test)
+   END ;
+   printf (p) ;
+   printf ("\n")
+END myproc ;
+
+
+VAR
+   a   : T ;
+   test: INTEGER ;
+BEGIN
+   test := 0 ;
+   a := 'z' ;
+   printf (a) ;
+   printf ("\n") ;
+   myproc ('z')      
+END arraychar2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/arrayrecord.mod b/gcc/testsuite/gm2/pim/run/pass/arrayrecord.mod
new file mode 100644
index 00000000000..c07ee79e505
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/arrayrecord.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE arrayrecord ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   record = RECORD
+               x, y, z: CARDINAL ;
+            END ;
+
+VAR
+   a: ARRAY [0..1] OF record ;
+BEGIN
+   a[0].x := 1 ;
+   a[0].y := 2 ;
+   a[0].z := 3 ;
+   a[1].x := 20 ;
+   a[1].y := 40 ;
+   a[1].z := 60 ;
+
+   IF a[0].x#1
+   THEN
+      exit(1)
+   END ;
+
+   IF a[0].z#3
+   THEN
+      exit(2)
+   END ;
+
+   IF a[1].x#20
+   THEN
+      exit(3)
+   END ;
+
+   IF a[1].z#60
+   THEN
+      exit(4)
+   END ;
+
+   exit(0)
+END arrayrecord.
diff --git a/gcc/testsuite/gm2/pim/run/pass/bitsettest.def b/gcc/testsuite/gm2/pim/run/pass/bitsettest.def
new file mode 100644
index 00000000000..874542273b1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/bitsettest.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+DEFINITION MODULE bitsettest;
+
+PROCEDURE xorbitset (x, y: BITSET; VAR z: BITSET);
+
+END bitsettest.
diff --git a/gcc/testsuite/gm2/pim/run/pass/bitsettest.mod b/gcc/testsuite/gm2/pim/run/pass/bitsettest.mod
new file mode 100644
index 00000000000..9a757417dc7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/bitsettest.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+IMPLEMENTATION MODULE bitsettest;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE xorbitset (x, y: BITSET; VAR z: BITSET) ;
+BEGIN
+    z := x / y
+END xorbitset ;
+
+VAR
+   a, b, c: BITSET ;
+BEGIN
+   a := {0, 2, 3} ;
+   b := {0, 4, 5} ;
+   xorbitset(a, b, c) ;
+   IF c#{2, 3, 4, 5}
+   THEN
+      exit(1)
+   END
+END bitsettest.
diff --git a/gcc/testsuite/gm2/pim/run/pass/bytearray.mod b/gcc/testsuite/gm2/pim/run/pass/bytearray.mod
new file mode 100644
index 00000000000..72cb0325f58
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/bytearray.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE bytearray ;
+
+FROM SYSTEM IMPORT BYTE ;
+FROM libc IMPORT printf, exit ;
+
+PROCEDURE bytes (b: ARRAY OF BYTE; s: CARDINAL) ;
+BEGIN
+   IF HIGH(b)#s-1
+   THEN
+      printf ("passing ARRAY OF BYTE failed, expected %d and received %d bytes\n", s, HIGH(b)) ;
+      exit (1)
+   END
+END bytes ;
+
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+   ch: CHAR ;
+BEGIN
+   bytes (i, SIZE(i)) ;
+   bytes (c, SIZE(c)) ;
+   bytes (ch, SIZE(ch)) ;
+   bytes ("hello world", 12)
+END bytearray.
diff --git a/gcc/testsuite/gm2/pim/run/pass/constdynstr.mod b/gcc/testsuite/gm2/pim/run/pass/constdynstr.mod
new file mode 100644
index 00000000000..ffad9d6c913
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/constdynstr.mod
@@ -0,0 +1,29 @@
+MODULE constdynstr ;
+
+FROM DynamicStrings IMPORT String, Length, InitString, KillString ;
+FROM libc IMPORT printf, exit ;
+
+VAR
+   r: INTEGER ;
+   s: String ;
+BEGIN
+   r := 0 ;
+   s := InitString ("\n") ;
+   IF Length (s) # 2
+   THEN
+      printf ("\\n string should be 2 characters long in Modula-2\n") ;
+      r := 1
+   END ;
+   s := KillString (s) ;
+   s := InitString ("\\n") ;
+   IF Length (s) # 3
+   THEN
+      printf ("\\\\n string should be 3 characters long in Modula-2\n") ;
+      r := 2
+   END ;
+   IF r = 0
+   THEN
+      printf ("very basic escaped DynamicStrings pass\n") ;
+   END ;
+   exit (r)
+END constdynstr.
diff --git a/gcc/testsuite/gm2/pim/run/pass/conststr.mod b/gcc/testsuite/gm2/pim/run/pass/conststr.mod
new file mode 100644
index 00000000000..b6f087b23fc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/conststr.mod
@@ -0,0 +1,25 @@
+MODULE conststr ;
+
+FROM StrLib IMPORT StrLen ;
+FROM libc IMPORT printf, exit ;
+
+VAR
+   r: INTEGER ;
+BEGIN
+   r := 0 ;
+   IF StrLen ("\n") # 2
+   THEN
+      printf ("\\n string should be 2 characters long in Modula-2\n") ;
+      r := 1
+   END ;
+   IF StrLen ("\\n") # 3
+   THEN
+      printf ("\\\\n string should be 3 characters long in Modula-2\n") ;
+      r := 2
+   END ;
+   IF r = 0
+   THEN
+      printf ("very basic escaped strings pass\n") ;
+   END ;
+   exit (r)
+END conststr.
diff --git a/gcc/testsuite/gm2/pim/run/pass/conststr2.mod b/gcc/testsuite/gm2/pim/run/pass/conststr2.mod
new file mode 100644
index 00000000000..f6d49205f96
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/conststr2.mod
@@ -0,0 +1,54 @@
+MODULE conststr2 ;
+
+FROM StrLib IMPORT StrLen ;
+FROM libc IMPORT printf, exit ;
+
+
+TYPE
+   opaque = POINTER TO CHAR ;
+
+
+(*
+   local -
+*)
+
+PROCEDURE local (p: opaque; a: ARRAY OF CHAR) ;
+BEGIN
+   IF StrLen (a) # 2
+   THEN
+      printf ("\\n string should be 2 characters long in Modula-2\n") ;
+      r := 1
+   END
+END local ;
+
+
+PROCEDURE func (p: opaque; a: ARRAY OF CHAR) : CARDINAL ;
+BEGIN
+   IF StrLen (a) # 2
+   THEN
+      printf ("\\n string should be 2 characters long in Modula-2\n") ;
+      r := 1
+   END ;
+   RETURN 2
+END func ;
+
+
+VAR
+   r: INTEGER ;
+   p: opaque ;
+BEGIN
+   p := NIL ;
+   r := 0 ;
+   local (p, "\n") ;
+   local (p, '\n') ;
+   IF func (p, "\n") # 2
+   THEN
+      printf ("string escape failed\n") ;
+      r := 1
+   END ;
+   IF r = 0
+   THEN
+      printf ("very basic escaped strings pass\n")
+   END ;
+   exit (r)
+END conststr2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/cycles.mod b/gcc/testsuite/gm2/pim/run/pass/cycles.mod
new file mode 100644
index 00000000000..ad5a8c690e7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/cycles.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE cycles ;
+
+
+FROM FpuIO IMPORT StrToLongReal, WriteLongReal ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM libc IMPORT exit ;
+
+
+CONST
+   DefaultClockFreq = 133.0 * 1000000.0 ;
+   MaxString        = 100 ;
+VAR
+   ClockFreq,
+   Period   : LONGREAL ;
+BEGIN
+   StrToLongReal('350', ClockFreq) ;
+   Period := 1.0/(ClockFreq * 1000000.0) ;
+   IF Period>1.0
+   THEN
+      WriteString('floating point code generator failed') ; WriteLn ;
+      exit(1)
+   ELSE
+      WriteString('simple fpu code generator test passed') ; WriteLn
+   END
+END cycles.
diff --git a/gcc/testsuite/gm2/pim/run/pass/dec.mod b/gcc/testsuite/gm2/pim/run/pass/dec.mod
new file mode 100644
index 00000000000..3971041c293
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/dec.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE dec ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE func (n: CARDINAL; i: INTEGER) ;
+BEGIN
+   DEC(n, i) ;
+   IF n#458752
+   THEN
+      exit(0)
+   END
+END func ;
+
+
+VAR
+   i: INTEGER ;
+   n: CARDINAL ;
+BEGIN
+   n := 524288 ;
+   i := 65536 ;
+   DEC(n, i) ;
+   IF n#458752
+   THEN
+      exit(0)
+   END ;
+   func(524288, 65536)
+END dec.
diff --git a/gcc/testsuite/gm2/pim/run/pass/enums.mod b/gcc/testsuite/gm2/pim/run/pass/enums.mod
new file mode 100644
index 00000000000..870b7840041
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/enums.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE enums ;
+
+TYPE
+   colour = (red, green, blue) ;
+
+VAR
+   c: colour ;
+BEGIN
+   c := green ;
+   INC(c) ;
+   c := green ;
+   DEC(c)
+END enums.
diff --git a/gcc/testsuite/gm2/pim/run/pass/incsubrange.def b/gcc/testsuite/gm2/pim/run/pass/incsubrange.def
new file mode 100644
index 00000000000..f8a5e638938
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/incsubrange.def
@@ -0,0 +1,9 @@
+DEFINITION MODULE incsubrange ;
+
+TYPE
+   Month = [1..12] ;
+
+PROCEDURE incMonth (VAR m: Month) ;
+PROCEDURE incMonth2 (VAR m: Month) ;
+
+END incsubrange.
diff --git a/gcc/testsuite/gm2/pim/run/pass/incsubrange.mod b/gcc/testsuite/gm2/pim/run/pass/incsubrange.mod
new file mode 100644
index 00000000000..4a12fbaa3e6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/incsubrange.mod
@@ -0,0 +1,26 @@
+IMPLEMENTATION MODULE incsubrange ;
+
+
+PROCEDURE incMonth (VAR m: Month) ;
+BEGIN
+   m := m + 1
+END incMonth ;
+
+
+PROCEDURE incMonth2 (VAR m: Month) ;
+BEGIN
+   m := getMonth () + 1
+END incMonth2 ;
+
+
+(*
+   getMonth -
+*)
+
+PROCEDURE getMonth () : CARDINAL ;
+BEGIN
+   RETURN 1
+END getMonth ;
+
+
+END incsubrange.
diff --git a/gcc/testsuite/gm2/pim/run/pass/index3.mod b/gcc/testsuite/gm2/pim/run/pass/index3.mod
new file mode 100644
index 00000000000..2acb0e3ca87
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/index3.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE index3 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   a: ARRAY [0..10], [-3..3], [10..20] OF CHAR ;
+BEGIN
+   a[5,-2,12] := 'a' ;
+   IF a[5][-2][12]#'a'
+   THEN
+      exit(1)
+   END ;
+   a[5,-2,12] := 'a' ;
+   IF a[5][-2,12]#'a'
+   THEN
+      exit(1)
+   END ;
+   IF a[5,-2][12]#'a'
+   THEN
+      exit(1)
+   END
+END index3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/int16.mod b/gcc/testsuite/gm2/pim/run/pass/int16.mod
new file mode 100644
index 00000000000..25f1fc0837d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/int16.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE int16 ;
+
+FROM SYSTEM IMPORT INTEGER16;
+
+VAR
+   i: INTEGER16;
+BEGIN
+  FOR i := MIN(INTEGER16) TO MAX(INTEGER16) DO
+  END
+END int16.
diff --git a/gcc/testsuite/gm2/pim/run/pass/int32.mod b/gcc/testsuite/gm2/pim/run/pass/int32.mod
new file mode 100644
index 00000000000..d4e515b23d7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/int32.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE int32 ;
+
+FROM SYSTEM IMPORT INTEGER32 ;
+
+PROCEDURE foo ;
+VAR
+   i: INTEGER32 ;
+   c: CARDINAL ;
+BEGIN
+   c := 0 ;
+   FOR i := MIN(INTEGER32) TO MAX(INTEGER32) DO
+      INC(c) ;
+      IF c=20
+      THEN
+         RETURN
+      END
+   END
+END foo ;
+
+BEGIN
+   foo
+END int32.
diff --git a/gcc/testsuite/gm2/pim/run/pass/int8.mod b/gcc/testsuite/gm2/pim/run/pass/int8.mod
new file mode 100644
index 00000000000..88818d557b6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/int8.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE int8 ;
+
+FROM SYSTEM IMPORT INTEGER8;
+
+VAR
+   i: INTEGER8;
+BEGIN
+  FOR i := MIN(INTEGER8) TO MAX(INTEGER8) DO
+  END
+END int8.
diff --git a/gcc/testsuite/gm2/pim/run/pass/line.mod b/gcc/testsuite/gm2/pim/run/pass/line.mod
new file mode 100644
index 00000000000..e3286d3e20d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/line.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+(* line 17 *)
+(* line 18 *)
+(* line 19
+
+   line 21 *)
+MODULE line ;
+(* line 23 *)
+
+(* line 25 *)
+BEGIN
+   IF __LINE__#27
+   THEN
+      HALT
+   END
+END line.
diff --git a/gcc/testsuite/gm2/pim/run/pass/long.mod b/gcc/testsuite/gm2/pim/run/pass/long.mod
new file mode 100644
index 00000000000..0f2718b3807
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/long.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE long ;
+
+
+VAR
+   l: LONGINT ;
+BEGIN
+   l := 12345678901234
+END long.
diff --git a/gcc/testsuite/gm2/pim/run/pass/longfor.mod b/gcc/testsuite/gm2/pim/run/pass/longfor.mod
new file mode 100644
index 00000000000..72b0eeb3586
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/longfor.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE longfor ;
+
+
+PROCEDURE foo ;
+VAR
+   i: LONGINT ;
+   c: CARDINAL ;
+BEGIN
+   c := 0 ;
+   FOR i := MIN(LONGINT) TO MAX(LONGINT) DO
+      INC(c) ;
+      IF c=20
+      THEN
+         RETURN
+      END
+   END
+END foo ;
+
+BEGIN
+   foo
+END longfor.
diff --git a/gcc/testsuite/gm2/pim/run/pass/longtypes10.mod b/gcc/testsuite/gm2/pim/run/pass/longtypes10.mod
new file mode 100644
index 00000000000..7af32815578
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/longtypes10.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes10 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE x (r: LONGCARD) : LONGCARD ;
+BEGIN
+   RETURN r
+END x ;
+
+VAR
+   y: LONGCARD ;
+BEGIN
+   y := 5 ;
+   IF x(y+1+1)#7
+   THEN
+      exit(1)
+   END ;
+   IF x(1+1+y)#7
+   THEN
+      exit(1)
+   END
+END longtypes10.
diff --git a/gcc/testsuite/gm2/pim/run/pass/longtypes7.mod b/gcc/testsuite/gm2/pim/run/pass/longtypes7.mod
new file mode 100644
index 00000000000..8409f0a381a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/longtypes7.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes7 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE lr (r: LONGREAL) ;
+BEGIN
+   IF r#600.0
+   THEN
+      exit(1)
+   END
+END lr ;
+
+PROCEDURE r (r: REAL) ;
+BEGIN
+   IF r#600.0
+   THEN
+      exit(1)
+   END
+END r ;
+
+BEGIN
+   lr(100.0+200.0+300.0) ;
+   r(100.0+200.0+300.0)
+END longtypes7.
diff --git a/gcc/testsuite/gm2/pim/run/pass/longtypes8.mod b/gcc/testsuite/gm2/pim/run/pass/longtypes8.mod
new file mode 100644
index 00000000000..09088d793db
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/longtypes8.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes8 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE x (r: REAL) : REAL ;
+BEGIN
+   RETURN r
+END x ;
+
+VAR
+   y: REAL ;
+BEGIN
+   y := 5.0 ;
+(*
+   IF y+1.0+1.0#7.0
+   THEN
+      exit(1)
+   END ;
+*)
+   IF x(y+1.0+1.0)#7.0
+   THEN
+      exit(1)
+   END ;
+   IF x(1.0+1.0+y)#7.0
+   THEN
+      exit(1)
+   END
+END longtypes8.
diff --git a/gcc/testsuite/gm2/pim/run/pass/longtypes9.mod b/gcc/testsuite/gm2/pim/run/pass/longtypes9.mod
new file mode 100644
index 00000000000..6e5c8265b2e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/longtypes9.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE longtypes9 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE x (r: CARDINAL) : CARDINAL ;
+BEGIN
+   RETURN r
+END x ;
+
+VAR
+   y: CARDINAL ;
+BEGIN
+   y := 5 ;
+   IF x(y+1+1)#7
+   THEN
+      exit(1)
+   END ;
+   IF x(1+1+y)#7
+   THEN
+      exit(1)
+   END
+END longtypes9.
diff --git a/gcc/testsuite/gm2/pim/run/pass/math.mod b/gcc/testsuite/gm2/pim/run/pass/math.mod
new file mode 100644
index 00000000000..8eab79d294e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/math.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE math ;
+
+IMPORT MathLib0, SMathLib0 ;
+FROM libc IMPORT printf, exit ;
+
+
+PROCEDURE Assert (b: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d: assert failed\n", f, l) ;
+      exit(1)
+   END
+END Assert ;
+
+
+VAR
+   r: REAL ;
+   s: SHORTREAL ;
+BEGIN
+   r := 2.3 ;
+   printf("value of entier (10.0 + r) = %d (should be 12)\n", MathLib0.entier (10.0 + r)) ;
+   Assert(MathLib0.entier (10.0 + r) = 12, __FILE__, __LINE__) ;
+   s := 5.9 ;
+   printf("value of SMathLib0.entier (10.0 + s) = %d (should be 15)\n", SMathLib0.entier (10.0 + s)) ;
+   Assert(SMathLib0.entier (10.0 + s) = 15, __FILE__, __LINE__) ;
+END math.
diff --git a/gcc/testsuite/gm2/pim/run/pass/math2.mod b/gcc/testsuite/gm2/pim/run/pass/math2.mod
new file mode 100644
index 00000000000..3dd270997af
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/math2.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE math2 ;
+
+IMPORT MathLib0, SMathLib0 ;
+FROM libc IMPORT printf, exit ;
+
+
+PROCEDURE Assert (b: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d: assert failed\n", f, l) ;
+      exit(1)
+   END
+END Assert ;
+
+
+VAR
+   r: REAL ;
+   s: SHORTREAL ;
+BEGIN
+   r := 2.3 ;
+   printf("value of entier (10.0 + r) = %d (should be 12)\n", MathLib0.entier (10.0 + r)) ;
+   Assert(MathLib0.entier (r + 10.0) = 12, __FILE__, __LINE__) ;
+   s := 5.9 ;
+   printf("value of SMathLib0.entier (10.0 + s) = %d (should be 15)\n", SMathLib0.entier (10.0 + s)) ;
+   Assert(SMathLib0.entier (s + 10.0) = 15, __FILE__, __LINE__) ;
+END math2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/mathconst.mod b/gcc/testsuite/gm2/pim/run/pass/mathconst.mod
new file mode 100644
index 00000000000..8b5c2ebb7c3
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/mathconst.mod
@@ -0,0 +1,56 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE mathconst ;
+
+FROM libc IMPORT printf, exit ;
+
+PROCEDURE func1 (r: REAL) ;
+BEGIN
+   printf("value passed into function was %g\n", r) ;
+   IF r#130.0
+   THEN
+      exit(1)
+   END
+END func1 ;
+
+PROCEDURE func2 (r: REAL) ;
+BEGIN
+   printf("value passed into function was %g\n", r) ;
+   IF r#7.0
+   THEN
+      exit(1)
+   END
+END func2 ;
+
+PROCEDURE func3 (r: REAL) ;
+BEGIN
+   printf("value passed into function was %g\n", r) ;
+   IF r#123.0
+   THEN
+      exit(1)
+   END
+END func3 ;
+
+VAR
+   x: REAL ;
+BEGIN
+   x := 123.0 ;
+   func1(7.0+x) ;
+   func2(7.0) ;
+   func3(x)
+END mathconst.
diff --git a/gcc/testsuite/gm2/pim/run/pass/minhello.mod b/gcc/testsuite/gm2/pim/run/pass/minhello.mod
new file mode 100644
index 00000000000..0a69716746f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/minhello.mod
@@ -0,0 +1,12 @@
+MODULE minhello ;
+
+(* This test is useful to test the linking to ensure that the
+   application module is called after all modules are initialized
+   even if the application module only imports from a definition
+   for "C".  *)
+
+FROM libc IMPORT printf ;
+
+BEGIN
+   printf ("hello world\n")
+END minhello.
diff --git a/gcc/testsuite/gm2/pim/run/pass/minimal.mod b/gcc/testsuite/gm2/pim/run/pass/minimal.mod
new file mode 100644
index 00000000000..d2f42ba53f9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/minimal.mod
@@ -0,0 +1,5 @@
+MODULE minimal ;
+
+BEGIN
+
+END minimal.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedproc.mod b/gcc/testsuite/gm2/pim/run/pass/nestedproc.mod
new file mode 100644
index 00000000000..4c34e014045
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedproc.mod
@@ -0,0 +1,56 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+VAR
+   j: CARDINAL ;
+
+
+PROCEDURE middle ;
+VAR
+   j: CARDINAL ;
+
+   PROCEDURE displayit ;
+   BEGIN
+      WriteCard(j, 0) ; WriteLn
+   END displayit ;
+
+   PROCEDURE inner ;
+   VAR
+      j: CARDINAL ;
+   BEGIN
+      j := 999
+   END inner ;
+
+BEGIN
+   j := 222 ;
+   inner ;
+   displayit
+END middle ;
+
+
+
+BEGIN
+   j := 111 ;
+   WriteString('the answers on the next two lines should be 111 and 222') ; WriteLn ;
+   WriteCard(j, 0) ; WriteLn ;
+   middle
+   (* should yield   222 *)
+END nestedproc.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedproc2.mod b/gcc/testsuite/gm2/pim/run/pass/nestedproc2.mod
new file mode 100644
index 00000000000..3671e07f52a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedproc2.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc2 ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   j: CARDINAL ;
+
+PROCEDURE ReadIt (VAR c: CARDINAL) ;
+BEGIN
+   c := 222
+END ReadIt ;
+
+
+PROCEDURE middle ;
+VAR
+   j: CARDINAL ;
+
+   PROCEDURE displayit ;
+   BEGIN
+      INC(j) ;
+      WriteCard(j, 0) ; WriteLn
+   END displayit ;
+
+   PROCEDURE inner ;
+   BEGIN
+      ReadIt(j)
+   END inner ;
+
+BEGIN
+   j := 999 ;
+   inner ;
+   displayit
+END middle ;
+
+
+
+BEGIN
+   j := 111 ;
+   middle
+   (* should yield   223 *)
+END nestedproc2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedproc3.mod b/gcc/testsuite/gm2/pim/run/pass/nestedproc3.mod
new file mode 100644
index 00000000000..898862f7525
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedproc3.mod
@@ -0,0 +1,67 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc3 ;
+
+FROM StdIO IMPORT Write ;
+FROM StrIO IMPORT WriteLn ;
+
+PROCEDURE a ;
+VAR
+   s: CHAR ;
+
+   PROCEDURE b ;
+
+      PROCEDURE c ;
+      VAR
+         s: CHAR ;
+
+         PROCEDURE d ;
+
+            PROCEDURE e ;
+            BEGIN
+               s := 'a' ;
+               b2
+            END e ;
+
+        BEGIN
+           e
+        END d ;
+
+     BEGIN
+        d
+     END c ;
+
+   BEGIN
+      c
+   END b ;
+
+   PROCEDURE b2 ;
+   BEGIN
+      s := 'g' ;
+   END b2 ;
+
+
+   BEGIN
+      s := 'z' ;
+      b ;
+      Write(s) ; WriteLn
+      (* output should be 'g' *)
+   END a ;
+
+BEGIN
+   a
+END nestedproc3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedproc4.mod b/gcc/testsuite/gm2/pim/run/pass/nestedproc4.mod
new file mode 100644
index 00000000000..49f9fe97d87
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedproc4.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE nestedproc4 ;
+
+FROM libc IMPORT exit ;
+
+PROCEDURE a (p: CARDINAL) : CARDINAL ;
+   PROCEDURE b (q: CARDINAL) : CARDINAL ;
+   BEGIN
+      RETURN q
+   END b ;
+BEGIN
+   RETURN b(p)
+END a ;
+
+BEGIN
+   exit(a(0))
+END nestedproc4.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedproc5.mod b/gcc/testsuite/gm2/pim/run/pass/nestedproc5.mod
new file mode 100644
index 00000000000..a8b9c98d1ab
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedproc5.mod
@@ -0,0 +1,62 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nestedproc5 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrCopy, StrLen ;
+
+PROCEDURE outer ;
+VAR
+   a: ARRAY [0..80] OF CHAR ;
+
+   PROCEDURE flip (i, j: CARDINAL) ;
+   VAR
+      t: CHAR ;
+   BEGIN
+      t := a[i] ;
+(*
+      a[i] := a[j] ;
+      a[j] := t
+*)
+   END flip ;
+
+   PROCEDURE inner ;
+   VAR
+      h, l, k: CARDINAL ;
+   BEGIN
+(*
+      h := HIGH(a) ;  (* test it.. *)
+      IF h#80
+      THEN
+         HALT
+      END ;
+      k := 0 ;
+      l := StrLen(a)-1 ;
+      flip(3, 8)
+*)
+   END inner ;
+BEGIN
+   StrCopy('0128456739', a) ;
+   inner ;
+   WriteString(a) ; WriteLn
+END outer ;
+
+
+BEGIN
+   outer
+END nestedproc5.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedproc6.mod b/gcc/testsuite/gm2/pim/run/pass/nestedproc6.mod
new file mode 100644
index 00000000000..084fe8acfd7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedproc6.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE nestedproc6 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   set = SET OF [0..1023] ;
+
+PROCEDURE a (p: set) : CARDINAL ;
+   PROCEDURE b () : CARDINAL ;
+      PROCEDURE c () : CARDINAL ;
+      BEGIN
+         IF 0 IN p
+         THEN
+            RETURN 0
+         ELSE
+            RETURN 1
+         END
+      END c ;
+   BEGIN
+      RETURN c()
+   END b ;
+BEGIN
+   RETURN b()
+END a ;
+
+BEGIN
+   exit(a(set{0}))
+END nestedproc6.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedproc7.mod b/gcc/testsuite/gm2/pim/run/pass/nestedproc7.mod
new file mode 100644
index 00000000000..65fbbc5b2bb
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedproc7.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE nestedproc7 ;   (*!m2pim*)
+
+PROCEDURE a ;
+   PROCEDURE b ;
+      PROCEDURE c ;
+      BEGIN
+      END c ;
+   BEGIN
+      c
+   END b ;
+BEGIN
+   b
+END a ;
+
+BEGIN
+   a
+END nestedproc7.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedwith.mod b/gcc/testsuite/gm2/pim/run/pass/nestedwith.mod
new file mode 100644
index 00000000000..fabd21a128f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedwith.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nestedwith ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   record = RECORD
+               x, y, z: CARDINAL ;
+            END ;
+
+VAR
+   a: ARRAY [0..1] OF record ;
+BEGIN
+   a[0].x := 10 ;
+   a[1].x := 20 ;
+   WITH a[0] DO
+      WITH a[1] DO
+         IF x#20
+         THEN
+            exit(1)
+         END
+      END
+   END ;
+   exit(0)
+END nestedwith.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedwith2.mod b/gcc/testsuite/gm2/pim/run/pass/nestedwith2.mod
new file mode 100644
index 00000000000..b872e045476
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedwith2.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nestedwith2 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   record = RECORD
+               x, y, z: CARDINAL ;
+            END ;
+
+VAR
+   a: ARRAY [0..1] OF record ;
+BEGIN
+   a[0].x := 1 ;
+   a[0].y := 2 ;
+   a[0].z := 3 ;
+   a[1].x := 20 ;
+   a[1].y := 40 ;
+   a[1].z := 60 ;
+   WITH a[0] DO
+      WITH a[1] DO
+         IF x#20
+         THEN
+            exit(1)
+         END
+      END
+   END ;
+   exit(0)
+END nestedwith2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nestedwith3.mod b/gcc/testsuite/gm2/pim/run/pass/nestedwith3.mod
new file mode 100644
index 00000000000..c8dec2c1a5a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nestedwith3.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE nestedwith3 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   record = RECORD
+               x, y, z: CARDINAL ;
+            END ;
+
+VAR
+   a: ARRAY [0..1] OF record ;
+BEGIN
+   a[0].x := 1 ;
+   a[0].y := 2 ;
+   a[0].z := 3 ;
+   a[1].x := 20 ;
+   a[1].y := 40 ;
+   a[1].z := 60 ;
+   WITH a[0] DO
+      WITH a[1] DO
+         IF x#20
+         THEN
+            exit(1)
+         END
+      END
+   END ;
+   exit(0)
+END nestedwith3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/nothing.mod b/gcc/testsuite/gm2/pim/run/pass/nothing.mod
new file mode 100644
index 00000000000..5e58cda07fc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/nothing.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nothing ;
+
+IMPORT ASCII ;
+IMPORT StdIO ;
+IMPORT StrIO ;
+IMPORT SYSTEM ;
+IMPORT NumberIO ;
+IMPORT FIO ;
+
+BEGIN
+END nothing.
diff --git a/gcc/testsuite/gm2/pim/run/pass/pim-run-pass.exp b/gcc/testsuite/gm2/pim/run/pass/pim-run-pass.exp
new file mode 100644
index 00000000000..578533d376d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/pim-run-pass.exp
@@ -0,0 +1,44 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/pim/run/pass"
+gm2_link_obj "sys.o"
+
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    set output [gm2_target_compile $srcdir/$subdir/sys.mod sys.o object "-g -I$srcdir/../m2/gm2-libs -I$srcdir/$subdir -I$srcdir/../m2/gm2-compiler -I../m2/gm2-libs -I../m2/gm2-compiler -fpim"]
+
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    if { $testcase != "$srcdir/$subdir/sys.mod" } {
+	gm2-torture-execute $testcase "" "pass"
+    }
+}
diff --git a/gcc/testsuite/gm2/pim/run/pass/prog31ex.mod b/gcc/testsuite/gm2/pim/run/pass/prog31ex.mod
new file mode 100644
index 00000000000..37b064909c6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/prog31ex.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE prog31ex;
+FROM StrIO IMPORT WriteLn,WriteString;
+FROM FpuIO IMPORT ReadReal, WriteReal;
+
+VAR
+   fahrenheit      : REAL;
+   celsius         : REAL;
+BEGIN
+   celsius := -10.0;
+   fahrenheit := 0.0;
+   WHILE celsius <= 100.0 DO
+      WriteReal(celsius,6,2);
+      fahrenheit := ((celsius * 9.0) / 5.0) + 32.0;
+      WriteString(" degrees Celsius goes to ") ;
+      WriteReal(fahrenheit,6,2);
+      WriteString(" degrees Fahrenheit");
+      WriteLn;
+      celsius := celsius + 5.0;
+   END
+END prog31ex.
diff --git a/gcc/testsuite/gm2/pim/run/pass/rts.mod b/gcc/testsuite/gm2/pim/run/pass/rts.mod
new file mode 100644
index 00000000000..befbbcd98c2
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/rts.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE rts;
+
+FROM FpuIO IMPORT ReadReal,WriteReal,StrToReal,RealToStr, ReadLongReal;
+IMPORT StrIO; (* WriteString,WriteLn,ReadString; *)
+
+VAR
+   s  : ARRAY[0..9] OF CHAR;
+   r  : REAL;
+   l  : LONGREAL ;
+   t,f: CARDINAL;
+   a,b: CARDINAL ;
+BEGIN
+   a := 123 ;
+   b := 45 ;
+   r := FLOAT(a) + (FLOAT(b) / 100.0) ;
+(*
+   l := FLOAT(a) + (FLOAT(b) / 100.0) ;
+   ReadReal(r);
+*)
+   t := 7;
+   f := 2;
+   RealToStr(r,t,f,s);
+   StrIO.WriteString(s);
+   StrIO.WriteLn;
+END rts.
diff --git a/gcc/testsuite/gm2/pim/run/pass/setcritical.mod b/gcc/testsuite/gm2/pim/run/pass/setcritical.mod
new file mode 100644
index 00000000000..4eb43db2e60
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/setcritical.mod
@@ -0,0 +1,129 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE setcritical ;
+
+FROM libc IMPORT printf, exit ;
+
+TYPE
+   tokenum = (eoftok, plustok, minustok, timestok, dividetok, becomestok, ambersandtok, periodtok, commatok, semicolontok, lparatok, rparatok, lsbratok, rsbratok, lcbratok, rcbratok, uparrowtok, singlequotetok, equaltok, hashtok, lesstok, greatertok, lessgreatertok, lessequaltok, greaterequaltok, periodperiodtok, colontok, doublequotestok, bartok, andtok, arraytok, begintok, bytok, casetok, consttok, definitiontok, divtok, dotok, elsetok, elsiftok, endtok, exittok, exporttok, fortok, fromtok, iftok, implementationtok, importtok, intok, looptok, modtok, moduletok, nottok, oftok, ortok, pointertok, proceduretok, qualifiedtok, unqualifiedtok, recordtok, remtok, repeattok, returntok, settok, thentok, totok, typetok, untiltok, vartok, whiletok, withtok, asmtok, volatiletok, periodperiodperiodtok, datetok, linetok, filetok, attributetok, builtintok, integertok, identtok, realtok, stringtok) ;
+
+   SetOfStop0 = SET OF [eoftok..begintok] ;
+   SetOfStop1 = SET OF [bytok..settok] ;
+   SetOfStop2 = SET OF [thentok..stringtok] ;
+
+VAR
+   e: INTEGER ;
+
+
+(*
+   Assert - 
+*)
+
+PROCEDURE Assert (b: BOOLEAN; c: CARDINAL) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF NOT b
+   THEN
+      r := printf("assert failed in sets, with bit %d\n", c) ;
+      e := 1
+   END
+END Assert ;
+
+PROCEDURE only0 (s: SetOfStop0; enumValue: tokenum) : BOOLEAN ;
+VAR
+   i: tokenum ;
+   c: CARDINAL ;
+BEGIN
+   (* just see if one bit has been set *)
+   i := eoftok ;
+   c := 0 ;
+   REPEAT
+      IF i IN s
+      THEN
+         INC(c)
+      END ;
+      INC(i)
+   UNTIL i>begintok ;
+   RETURN (c=1) AND (enumValue IN s)
+END only0 ;
+
+PROCEDURE only1 (s: SetOfStop1; enumValue: tokenum) : BOOLEAN ;
+VAR
+   i: tokenum ;
+   c: CARDINAL ;
+BEGIN
+   (* just see if one bit has been set *)
+   i := bytok ;
+   c := 0 ;
+   REPEAT
+      IF i IN s
+      THEN
+         INC(c)
+      END ;
+      INC(i)
+   UNTIL i>settok ;
+   RETURN (c=1) AND (enumValue IN s)
+END only1 ;
+
+PROCEDURE only2 (s: SetOfStop2; enumValue: tokenum) : BOOLEAN ;
+VAR
+   i: tokenum ;
+   c: CARDINAL ;
+BEGIN
+   (* just see if one bit has been set *)
+   i := thentok ;
+   c := 0 ;
+   FOR i := thentok TO stringtok DO
+      IF i IN s
+      THEN
+         INC(c)
+      END
+   END ;
+   RETURN (c=1) AND (enumValue IN s)
+END only2 ;
+
+VAR
+   i : tokenum ;
+   s0: SetOfStop0 ;
+   s1: SetOfStop1 ;
+   s2: SetOfStop2 ;
+BEGIN
+   e := 0 ;
+   s0 := SetOfStop0{} ;
+   s1 := SetOfStop1{} ;
+   s2 := SetOfStop2{} ;
+   FOR i := eoftok TO stringtok DO
+      IF ORD(i)<ORD(bytok)
+      THEN
+         INCL(s0, i) ;
+         Assert(only0(s0, i), ORD(i)) ;
+         EXCL(s0, i)
+      ELSIF ORD(i)<ORD(thentok)
+      THEN
+         INCL(s1, i) ;
+         Assert(only1(s1, i), ORD(i)) ;
+         EXCL(s1, i)
+      ELSE
+         INCL(s2, i) ;
+         Assert(only2(s2, i), ORD(i)) ;
+         EXCL(s2, i)
+      END
+   END ;
+   exit(e)
+END setcritical.
diff --git a/gcc/testsuite/gm2/pim/run/pass/setequiv.mod b/gcc/testsuite/gm2/pim/run/pass/setequiv.mod
new file mode 100644
index 00000000000..f12ffd0106f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/setequiv.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE setequiv ;
+
+TYPE
+   Enum = (A, B, C, D);
+   Typ = [B..D];
+
+VAR
+   typ : Typ;
+   styp: SET OF Typ;
+BEGIN
+   IF typ = A
+   THEN
+      typ := B
+   END ;
+   IF B IN styp
+   THEN
+      typ := B
+   END
+END setequiv.
diff --git a/gcc/testsuite/gm2/pim/run/pass/str6.mod b/gcc/testsuite/gm2/pim/run/pass/str6.mod
new file mode 100644
index 00000000000..f69ef84b173
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/str6.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE str6 ;
+ 
+FROM StrIO IMPORT WriteString, WriteLn;
+FROM StrLib IMPORT StrEqual ;
+FROM libc IMPORT exit ;
+ 
+TYPE
+   String = ARRAY [0..255] OF CHAR;
+ 
+VAR
+   Str : String;
+BEGIN
+   Str := 'abcdefghij';
+   WriteString(Str);
+   WriteLn;
+   Str := '1234';
+   WriteString(Str);
+   WriteLn ;
+   IF NOT StrEqual(Str, '1234')
+   THEN
+      HALT(1)
+   END
+END str6.
diff --git a/gcc/testsuite/gm2/pim/run/pass/stringaddr.mod b/gcc/testsuite/gm2/pim/run/pass/stringaddr.mod
new file mode 100644
index 00000000000..f11f61e7f3d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/stringaddr.mod
@@ -0,0 +1,14 @@
+MODULE stringaddr ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+
+PROCEDURE foo ;
+BEGIN
+   a := ADR("hello world")
+END foo ;
+
+VAR
+   a: ADDRESS ;
+BEGIN
+
+END stringaddr.
diff --git a/gcc/testsuite/gm2/pim/run/pass/stringaddr2.def b/gcc/testsuite/gm2/pim/run/pass/stringaddr2.def
new file mode 100644
index 00000000000..fa41a4380de
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/stringaddr2.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+DEFINITION MODULE stringaddr2 ;
+
+PROCEDURE foo ;
+
+END stringaddr2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/stringaddr2.mod b/gcc/testsuite/gm2/pim/run/pass/stringaddr2.mod
new file mode 100644
index 00000000000..d64d7aad8a7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/stringaddr2.mod
@@ -0,0 +1,14 @@
+IMPLEMENTATION MODULE stringaddr2 ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+
+PROCEDURE foo ;
+BEGIN
+   a := ADR("hello world")
+END foo ;
+
+VAR
+   a: ADDRESS ;
+BEGIN
+
+END stringaddr2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/stripped.mod b/gcc/testsuite/gm2/pim/run/pass/stripped.mod
new file mode 100644
index 00000000000..f7dcbc0731b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/stripped.mod
@@ -0,0 +1,22 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE stripped ;
+FROM StrIO IMPORT WriteLn,WriteString;
+FROM FpuIO IMPORT ReadReal, WriteReal;
+
+BEGIN
+END stripped .
diff --git a/gcc/testsuite/gm2/pim/run/pass/sys.def b/gcc/testsuite/gm2/pim/run/pass/sys.def
new file mode 100644
index 00000000000..33b8444e360
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/sys.def
@@ -0,0 +1,24 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+DEFINITION MODULE sys ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+PROCEDURE foo (a: ADDRESS) ;
+
+END sys.
diff --git a/gcc/testsuite/gm2/pim/run/pass/sys.mod b/gcc/testsuite/gm2/pim/run/pass/sys.mod
new file mode 100644
index 00000000000..5156d97adbb
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/sys.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+IMPLEMENTATION MODULE sys ;
+
+PROCEDURE foo (a: ADDRESS) ;
+VAR
+   i: CARDINAL ;
+   p: POINTER TO CHAR ;
+BEGIN
+   i := 0 ;
+   p := a ;
+   WHILE p^#0C DO
+      INC(i) ;
+      INC(p)
+   END ;
+   IF i#11
+   THEN
+      HALT
+   END
+END foo ;
+
+END sys.
diff --git a/gcc/testsuite/gm2/pim/run/pass/t.def b/gcc/testsuite/gm2/pim/run/pass/t.def
new file mode 100644
index 00000000000..921f5f61cdf
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/t.def
@@ -0,0 +1 @@
+(* Copyright (C) 2008 Free Software Foundation, Inc. *)
diff --git a/gcc/testsuite/gm2/pim/run/pass/testaddr.mod b/gcc/testsuite/gm2/pim/run/pass/testaddr.mod
new file mode 100644
index 00000000000..47b957c9c38
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testaddr.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testaddr ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+
+PROCEDURE foo (a: ADDRESS) ;
+VAR
+   i: CARDINAL ;
+   p: POINTER TO CHAR ;
+BEGIN
+   i := 0 ;
+   p := a ;
+   WHILE p^#0C DO
+      INC(i) ;
+      INC(p)
+   END ;
+   IF i#11
+   THEN
+      HALT
+   END
+END foo ;
+
+
+BEGIN
+   foo(ADR("hello world"))
+END testaddr.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testaddr2.mod b/gcc/testsuite/gm2/pim/run/pass/testaddr2.mod
new file mode 100644
index 00000000000..6fd2972ecac
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testaddr2.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testaddr2 ;
+
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+FROM sys IMPORT foo ;
+
+BEGIN
+   foo (ADR ("hello world"))
+END testaddr2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testaddr3.mod b/gcc/testsuite/gm2/pim/run/pass/testaddr3.mod
new file mode 100644
index 00000000000..b31d0a4b047
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testaddr3.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testaddr3 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT open ;
+
+VAR
+   fd: INTEGER ;
+BEGIN
+   fd := open(ADR(__FILE__), 0)
+END testaddr3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testarray.mod b/gcc/testsuite/gm2/pim/run/pass/testarray.mod
new file mode 100644
index 00000000000..ee91c943ea6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testarray.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testarray ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   a: ARRAY [1..100] OF CARDINAL ;
+   i: CARDINAL ;
+BEGIN
+   i := 50 ;
+   a[i] := 99 ;
+   IF a[i]#99
+   THEN
+      exit(1)
+   END
+END testarray.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testarray2.mod b/gcc/testsuite/gm2/pim/run/pass/testarray2.mod
new file mode 100644
index 00000000000..4205e0b04c0
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testarray2.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testarray2 ;
+
+FROM libc IMPORT exit ;
+TYPE
+   array = ARRAY [1..100] OF CARDINAL ;
+
+
+PROCEDURE foo (VAR a: array) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 50 ;
+   a[i] := 99 ;
+   IF a[i]#99
+   THEN
+      exit(2)
+   END
+END foo ;
+
+
+VAR
+   a: array ;
+   i: CARDINAL ;
+BEGIN
+   foo(a) ;
+   i := 50 ;
+   IF a[i]#99
+   THEN
+      exit(1)
+   END
+END testarray2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testarray3.mod b/gcc/testsuite/gm2/pim/run/pass/testarray3.mod
new file mode 100644
index 00000000000..657e4255f84
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testarray3.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testarray3 ;
+
+FROM libc IMPORT exit ;
+TYPE
+   array = ARRAY [1..100] OF CARDINAL ;
+
+
+PROCEDURE foo (VAR a: array; i: CARDINAL) ;
+BEGIN
+   a[i] := 99 ;
+   IF a[i]#99
+   THEN
+      exit(2)
+   END
+END foo ;
+
+
+VAR
+   a: array ;
+   i: CARDINAL ;
+BEGIN
+   foo(a, 50) ;
+   i := 50 ;
+   IF a[i]#99
+   THEN
+      exit(1)
+   END
+END testarray3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testarray4.mod b/gcc/testsuite/gm2/pim/run/pass/testarray4.mod
new file mode 100644
index 00000000000..b7f74733e96
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testarray4.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testarray4 ;
+
+FROM libc IMPORT exit ;
+TYPE
+   array = ARRAY [1..100] OF CARDINAL ;
+
+
+PROCEDURE foo (VAR a: array; VAR i: CARDINAL) ;
+BEGIN
+   a[i] := 99 ;
+   IF a[i]#99
+   THEN
+      exit(2)
+   END
+END foo ;
+
+
+VAR
+   a: array ;
+   i: CARDINAL ;
+BEGIN
+   i := 50 ;
+   foo(a, i) ;
+   IF a[i]#99
+   THEN
+      exit(1)
+   END
+END testarray4.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testarray5.mod b/gcc/testsuite/gm2/pim/run/pass/testarray5.mod
new file mode 100644
index 00000000000..d2295f0b4ed
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testarray5.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testarray5 ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   array = ARRAY [1..100] OF RECORD
+                                x, y: CARDINAL ;
+                             END ;
+
+
+PROCEDURE foo (VAR a: array; VAR i: CARDINAL) ;
+BEGIN
+   WITH a[i] DO
+      x := 98 ;
+      y := 99 ;
+   END ;
+   IF (a[i].x#98) OR (a[i].y#99)
+   THEN
+      exit(2)
+   END
+END foo ;
+
+
+VAR
+   a: array ;
+   i: CARDINAL ;
+BEGIN
+   i := 50 ;
+   foo(a, i) ;
+   IF (a[i].x#98) OR (a[i].y#99)
+   THEN
+      exit(1)
+   END
+END testarray5.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testavail.mod b/gcc/testsuite/gm2/pim/run/pass/testavail.mod
new file mode 100644
index 00000000000..0240d58ced4
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testavail.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testavail ;
+
+
+FROM Storage IMPORT Available ;
+FROM libc IMPORT exit ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+BEGIN
+   IF Available(100)
+   THEN
+      WriteString('works') ; WriteLn
+   ELSE
+      exit(1)
+   END
+END testavail.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testdiv.mod b/gcc/testsuite/gm2/pim/run/pass/testdiv.mod
new file mode 100644
index 00000000000..19ba2a3cd1b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testdiv.mod
@@ -0,0 +1,136 @@
+MODULE testdiv ;  (*!m2pim *)
+
+FROM libc IMPORT printf, exit ;
+
+
+CONST
+   min = -40 ;
+   max = 100 ;
+
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf ("logic failed\n");
+      exit (1)
+   END
+END assert ;
+
+
+(*
+   divtest -
+*)
+
+PROCEDURE divtest (a, b: INTEGER) : BOOLEAN ;
+BEGIN
+   (* firstly catch division by 0.  *)
+   IF b = 0
+   THEN
+      RETURN FALSE
+   END ;
+   IF max < 0
+   THEN
+      (* case 2 range is always negative.  *)
+      (* in which case a division will be illegal as result will be positive.  *)
+      RETURN FALSE
+   ELSIF min >= 0
+   THEN
+      (* case 1 both min / max are positive.  *)
+      IF a < b * min
+      THEN
+         (* underflow.  *)
+         RETURN FALSE
+      END ;
+      IF b > a DIV min
+      THEN
+         (* underflow.  *)
+         RETURN FALSE
+      END
+   ELSE
+      (* case 3 mixed range.  *)
+      IF (a >= 0) AND (b > 0)
+      THEN
+         (* both operands positive therefore cannot overflow.  *)
+         RETURN TRUE
+      ELSIF (a < 0) AND (b < 0)
+      THEN
+         (* both operands negative, check for overflow.  *)
+         RETURN b < a DIV min
+      ELSE
+         (* mixed range of operands - only need to test underflow.  *)
+         IF a < 0
+         THEN
+            assert (b >= 0) ;
+            (* can underflow if.  *)
+            RETURN b > a DIV max
+         ELSE
+            assert (a >= 0) ;
+            assert (b < 0) ;
+            (* b is < 0 and the result can underflow if.  *)
+            (* printf ("a = %d, b = %d, b * min = %d\n", a, b, b * min);  *)
+            RETURN a DIV b >= min
+         END
+      END
+   END ;
+   HALT
+END divtest ;
+
+
+(*
+   assertFailed -
+*)
+
+PROCEDURE assertFailed (a, b: INTEGER; message: ARRAY OF CHAR) ;
+BEGIN
+   printf ("assert failed ") ;
+   printf (message) ;
+   printf (" %d DIV %d = %d\n", a, b, a DIV b)
+END assertFailed ;
+
+
+(*
+   inRange -
+*)
+
+PROCEDURE inRange (v: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN (v >= min) AND (v <= max)
+END inRange ;
+
+
+PROCEDURE runTest ;
+VAR
+   a, b: INTEGER ;
+BEGIN
+   FOR a := min TO max DO
+      FOR b := min TO max DO
+         IF b # 0
+         THEN
+            IF divtest (a, b)
+            THEN
+               (* printf ("a = %d, b = %d, a DIV b = %d\n", a, b, a DIV b); *)
+               printf ("a = %d, b = %d\n", a, b);
+               IF NOT inRange (a DIV b)
+               THEN
+                  assertFailed (a, b, "divtest marked this as good") ;
+               END
+            ELSE
+               IF inRange (a DIV b)
+               THEN
+                  assertFailed (a, b, "divtest marked this as bad")
+               END
+            END
+         END
+      END
+   END
+END runTest ;
+
+
+BEGIN
+   runTest
+END testdiv.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testfpufunc.mod b/gcc/testsuite/gm2/pim/run/pass/testfpufunc.mod
new file mode 100644
index 00000000000..125ac3d802a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testfpufunc.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfpufunc ;
+
+
+PROCEDURE func () : REAL ;
+VAR
+   a: REAL ;
+BEGIN
+   a := 4.5 ;
+   RETURN( a )
+END func ;
+
+
+VAR
+   t: REAL ;
+   n: CARDINAL ;
+BEGIN
+   n := 0 ;
+   WHILE n<10000 DO
+      t := func() ;
+      INC(n)
+   END
+END testfpufunc.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testfpufunc2.mod b/gcc/testsuite/gm2/pim/run/pass/testfpufunc2.mod
new file mode 100644
index 00000000000..9c34a43262c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testfpufunc2.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfpufunc2 ;
+
+
+PROCEDURE func () : REAL ;
+VAR
+   t: RECORD
+         a: REAL ;
+      END ;
+BEGIN
+   t.a := 4.5 ;
+   WITH t DO
+      RETURN( a )
+   END
+END func ;
+
+
+VAR
+   t: REAL ;
+   n: CARDINAL ;
+BEGIN
+   n := 0 ;
+   WHILE n<10000 DO
+      t := func() ;
+      INC(n)
+   END
+END testfpufunc2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testlarge.mod b/gcc/testsuite/gm2/pim/run/pass/testlarge.mod
new file mode 100644
index 00000000000..4036da80e06
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testlarge.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2014 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. *)
+
+MODULE testlarge ;
+
+FROM libc IMPORT printf, exit ;
+
+CONST
+   cmax = MAX(LONGINT) ;
+
+VAR
+   i,
+   max: LONGINT ;
+BEGIN
+   max := MAX(LONGINT) ;
+   i := 64 ;
+   IF i<max
+   THEN
+      printf("good sanity!\n")
+   ELSE
+      exit(1)
+   END ;
+   IF i<cmax
+   THEN
+      printf("good sanity (2)!\n")
+   ELSE
+      exit(2)
+   END
+END testlarge.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testlarge2.mod b/gcc/testsuite/gm2/pim/run/pass/testlarge2.mod
new file mode 100644
index 00000000000..27a5684d612
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testlarge2.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2014 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. *)
+
+MODULE testlarge2 ;
+
+FROM libc IMPORT printf, exit ;
+
+CONST
+   cmax = MAX(LONGINT) ;
+
+VAR
+   i, d,
+   max : LONGINT ;
+BEGIN
+   max := MAX(LONGINT) ;
+   i := 64 ;
+   d := -256 ;
+   IF i<max
+   THEN
+      printf("good sanity!\n")
+   ELSE
+      exit(1)
+   END ;
+   IF d<cmax
+   THEN
+      printf("good sanity (2)!\n")
+   ELSE
+      exit(2)
+   END
+END testlarge2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testnextproc.mod b/gcc/testsuite/gm2/pim/run/pass/testnextproc.mod
new file mode 100644
index 00000000000..cfc824b0859
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testnextproc.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testnextproc ;
+
+
+(*
+   nested procedures are not implemented in the compiler yet.
+*)
+
+PROCEDURE foo ;
+   PROCEDURE bar ;
+   BEGIN
+   END bar ;
+BEGIN bar
+END foo ;
+
+BEGIN
+   foo
+END testnextproc.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testparam.mod b/gcc/testsuite/gm2/pim/run/pass/testparam.mod
new file mode 100644
index 00000000000..f7c98e31ca1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testparam.mod
@@ -0,0 +1,70 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testparam ;
+
+
+FROM SYSTEM IMPORT SIZE ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+
+TYPE
+   r = RECORD
+          b: CHAR ;
+          c: CARDINAL ;
+       END ;
+
+   typeArray = ARRAY [1..20] OF r ;
+
+
+PROCEDURE arrayUb (a: ARRAY OF r) ;
+BEGIN
+   IF HIGH(a)#19
+   THEN
+      HALT
+   END
+END arrayUb ;
+
+
+PROCEDURE array (a: typeArray) ;
+BEGIN
+   IF a[5].b#'g'
+   THEN
+      HALT
+   END
+END array ;
+
+
+PROCEDURE char (ch: CHAR) ;
+BEGIN
+   IF ch#'g'
+   THEN
+      HALT
+   END
+END char ;
+
+VAR
+   ch    : CHAR ;
+   global: typeArray ;
+BEGIN
+   global[5].b := 'g' ;
+   WriteCard(SIZE(global[5]), 6) ; WriteLn ;
+   ch := 'g' ;
+   char(ch) ;
+   char('g') ;
+   arrayUb(global) ;
+   array(global)
+END testparam.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testreturnstr.mod b/gcc/testsuite/gm2/pim/run/pass/testreturnstr.mod
new file mode 100644
index 00000000000..3ddf5bbacac
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testreturnstr.mod
@@ -0,0 +1,39 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testreturnstr ;
+
+FROM libc IMPORT exit ;
+FROM StrLib IMPORT StrEqual ;
+
+TYPE
+   str = ARRAY [0..50] OF CHAR ;
+
+PROCEDURE func () : str ;
+VAR
+   t: str ;
+BEGIN
+   t := "hello world" ;
+   RETURN t
+END func ;
+
+BEGIN
+   IF NOT StrEqual("hello world", func())
+   THEN
+      exit(1)
+   END
+END testreturnstr.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testreturnstr2.mod b/gcc/testsuite/gm2/pim/run/pass/testreturnstr2.mod
new file mode 100644
index 00000000000..e2b25c7b0e9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testreturnstr2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testreturnstr2 ;
+
+FROM libc IMPORT exit ;
+FROM StrLib IMPORT StrEqual ;
+
+TYPE
+   str = ARRAY [0..50] OF CHAR ;
+
+PROCEDURE func () : str ;
+BEGIN
+   RETURN "hello world" ;
+END func ;
+
+BEGIN
+   IF NOT StrEqual("hello world", func())
+   THEN
+      exit(1)
+   END
+END testreturnstr2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testreturnstr3.def b/gcc/testsuite/gm2/pim/run/pass/testreturnstr3.def
new file mode 100644
index 00000000000..3b02d0a5e61
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testreturnstr3.def
@@ -0,0 +1,35 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+DEFINITION MODULE testreturnstr3 ;
+
+(*
+    Title      : testreturnstr3
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Mon Oct 27 22:42:31 2008
+    Revision   : $Version$ 
+    Description: 
+*)
+
+TYPE
+   str = ARRAY [0..50] OF CHAR ;
+
+PROCEDURE func () : str ;
+
+
+END testreturnstr3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testreturnstr3.mod b/gcc/testsuite/gm2/pim/run/pass/testreturnstr3.mod
new file mode 100644
index 00000000000..7515027c085
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testreturnstr3.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+IMPLEMENTATION MODULE testreturnstr3 ;
+
+PROCEDURE func () : str ;
+BEGIN
+   RETURN "hello world" ;
+END func ;
+
+END testreturnstr3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testsize.mod b/gcc/testsuite/gm2/pim/run/pass/testsize.mod
new file mode 100644
index 00000000000..8eb9f6d40d6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testsize.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testsize ;
+
+FROM SYSTEM IMPORT SIZE ;
+
+VAR
+   p: POINTER TO CHAR ;
+   c: CARDINAL ;
+BEGIN
+   p := NIL ;
+   c := SIZE(p^)   (* should not sigsegv! *)
+END testsize.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testsize2.mod b/gcc/testsuite/gm2/pim/run/pass/testsize2.mod
new file mode 100644
index 00000000000..40034bad559
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testsize2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testsize2 ;
+
+FROM SYSTEM IMPORT SIZE ;
+
+TYPE
+   FRAGMENT = POINTER TO RECORD
+                            Left, Right: FRAGMENT ;
+                            Size       : CARDINAL ;
+                         END ;
+
+VAR
+   n: CARDINAL ;
+   f: FRAGMENT ;
+BEGIN
+   n := 0 ;
+   INC(n, SIZE(f^)) ;
+   f := NIL ;
+   IF f=f
+   THEN
+   END
+END testsize2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testsize3.mod b/gcc/testsuite/gm2/pim/run/pass/testsize3.mod
new file mode 100644
index 00000000000..166a42da0b7
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testsize3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testsize3 ;
+
+FROM SYSTEM IMPORT BYTE, SIZE ;
+
+VAR
+   i: INTEGER ;
+   p: CHAR ;
+   c: CARDINAL ;
+   b: BYTE ;
+BEGIN
+   c := (SIZE(i) + SIZE(p)) DIV SIZE(b)
+END testsize3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testsize4.mod b/gcc/testsuite/gm2/pim/run/pass/testsize4.mod
new file mode 100644
index 00000000000..5f9c8018e63
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testsize4.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2022 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 2, 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. *)
+
+MODULE testsize4 ;
+
+FROM SYSTEM IMPORT TSIZE ;
+FROM libc IMPORT printf ;
+
+TYPE
+   ptr = POINTER TO CARDINAL ;
+
+VAR
+   foo: ptr ;
+   bar: CARDINAL ;
+BEGIN
+   foo := NIL ;
+   (* should be able to dereference an initialized pointer using TSIZE.  *)
+   bar := TSIZE (foo^) ;
+   printf ("result of TSIZE (foo^) is %d\n", bar) ;
+   (* and SIZE.  *)
+   bar := SIZE (foo^) ;
+   printf ("result of SIZE (foo^) is %d\n", bar)
+END testsize4.
diff --git a/gcc/testsuite/gm2/pim/run/pass/testtbitsize.mod b/gcc/testsuite/gm2/pim/run/pass/testtbitsize.mod
new file mode 100644
index 00000000000..1e893c73abc
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testtbitsize.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2022 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 2, 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. *)
+
+MODULE testtbitsize ;
+
+FROM SYSTEM IMPORT TBITSIZE ;
+FROM libc IMPORT printf ;
+
+TYPE
+   ptr = POINTER TO CARDINAL ;
+
+VAR
+   foo: ptr ;
+   bar: CARDINAL ;
+BEGIN
+   foo := NIL ;
+   (* should be able to dereference an initialized pointer using TBITSIZE.  *)
+   bar := TBITSIZE (foo^) ;
+   printf ("result of TBITSIZE (foo^) is %d\n", bar)
+END testtbitsize.
diff --git a/gcc/testsuite/gm2/pim/run/pass/tinywith.mod b/gcc/testsuite/gm2/pim/run/pass/tinywith.mod
new file mode 100644
index 00000000000..84a5195ca30
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/tinywith.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE tinywith ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   record = RECORD
+               x, y, z: CARDINAL ;
+            END ;
+
+VAR
+   a: ARRAY [0..1] OF record ;
+BEGIN
+   a[0].x := 10 ;
+   IF a[0].x # 10
+   THEN
+      exit(1)
+   END ;
+   WITH a[0] DO
+      IF x # 10
+      THEN
+         exit(2)
+      END
+   END
+END tinywith.
diff --git a/gcc/testsuite/gm2/pim/run/pass/unbounded.mod b/gcc/testsuite/gm2/pim/run/pass/unbounded.mod
new file mode 100644
index 00000000000..641d053b482
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/unbounded.mod
@@ -0,0 +1,53 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE unbounded ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+FROM libc IMPORT exit ;
+
+PROCEDURE foo (f: ARRAY OF CHAR) ;
+BEGIN
+   f[2] := 'a'
+END foo ;
+
+PROCEDURE bar (b: ARRAY OF CHAR) ;
+TYPE
+   PtrToChar = POINTER TO CHAR ;
+VAR
+   a: PtrToChar ;
+BEGIN
+   a := ADR(b) ;
+   INC(a, VAL(PtrToChar, 2)) ;
+   a^ := 'a'
+END bar ;
+
+VAR
+   a: ARRAY [0..10] OF CHAR ;
+BEGIN
+   a := '01234567890' ;
+   foo(a) ;
+   IF a[2]='a'
+   THEN
+      exit(1)
+   END ;
+   bar(a) ;
+   IF a[2]='a'
+   THEN
+      exit(2)
+   END
+END unbounded.
diff --git a/gcc/testsuite/gm2/pim/run/pass/varaddress3.mod b/gcc/testsuite/gm2/pim/run/pass/varaddress3.mod
new file mode 100644
index 00000000000..77a8af6f1e1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/varaddress3.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2006 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 2, 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. *)
+
+MODULE varaddress3 ;
+
+FROM SYSTEM IMPORT ADR, ADDRESS ;
+
+VAR
+   var [1000H] : CARDINAL ;
+BEGIN
+   IF ADR(var)#ADDRESS(1000H)
+   THEN
+      HALT
+   END ;
+   IF ADR(var)#ADDRESS(1000H)
+   THEN
+      HALT
+   END
+END varaddress3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/varparam2.mod b/gcc/testsuite/gm2/pim/run/pass/varparam2.mod
new file mode 100644
index 00000000000..44f57a72a06
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/varparam2.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE varparam2 ;
+
+TYPE
+   TermIO = RECORD
+               foo: BITSET ;
+            END ;
+
+
+   PROCEDURE GetTermIO(fd: CARDINAL; VAR termio: TermIO) : BOOLEAN;
+   VAR
+      t: BITSET ;
+
+      PROCEDURE Convert(flag1, flag2: CHAR; VAR bs: BITSET);
+      BEGIN
+	 bs := BITSET( ORD(flag1)*100H + ORD(flag2) );
+      END Convert;
+
+   BEGIN
+      WITH termio DO 
+         t := foo
+      END;
+      RETURN TRUE
+   END GetTermIO;
+
+VAR
+   f: TermIO ;
+BEGIN
+   IF GetTermIO(0, f)
+   THEN
+   END
+END varparam2.
diff --git a/gcc/testsuite/gm2/pim/run/pass/varparam3.mod b/gcc/testsuite/gm2/pim/run/pass/varparam3.mod
new file mode 100644
index 00000000000..fdd47f3fbce
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/varparam3.mod
@@ -0,0 +1,68 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE varparam3 ;
+
+   TYPE
+      InputModes = BITSET;
+      OutputModes = BITSET;
+      ControlModes = BITSET;
+      LineModes = BITSET;
+      TermIO =
+	 RECORD
+	    inputmodes: InputModes;
+	    outputmodes: OutputModes;
+	    controlmodes: ControlModes;
+	    linemodes: LineModes;
+	    linedisc: CHAR;
+	 END;
+
+      CTermIO =
+	 RECORD
+	    iflag1, iflag2: CHAR;
+	    oflag1, oflag2: CHAR;
+	    cflag1, cflag2: CHAR;
+	    lflag1, lflag2: CHAR;
+	    line: CHAR;
+	    c1, c2, c3, c4, c5, c6, c7, c8: CHAR;
+	 END;
+
+   PROCEDURE GetTermIO(fd: CARDINAL; VAR termio: TermIO) : BOOLEAN;
+      VAR
+	 ctermio: CTermIO;
+
+      PROCEDURE Convert(flag1, flag2: CHAR; VAR bs: BITSET);
+      BEGIN
+	 bs := BITSET( ORD(flag1)*100H + ORD(flag2) );
+      END Convert;
+
+   BEGIN
+      WITH termio DO 
+         WITH ctermio DO
+	    Convert(iflag1, iflag2, inputmodes);
+	 END;
+      END;
+      RETURN TRUE
+   END GetTermIO;
+
+VAR
+   t: TermIO ;
+BEGIN
+   IF GetTermIO(0, t)
+   THEN
+   END
+END varparam3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/varparm.mod b/gcc/testsuite/gm2/pim/run/pass/varparm.mod
new file mode 100644
index 00000000000..c73e84d254e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/varparm.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE varparm ;
+
+TYPE
+   TermIO = RECORD
+               foo: BITSET ;
+            END ;
+
+
+   PROCEDURE GetTermIO(fd: CARDINAL; VAR termio: TermIO) : BOOLEAN;
+   VAR
+      t: BITSET ;
+   BEGIN
+      WITH termio DO 
+         t := foo
+      END;
+      RETURN TRUE
+   END GetTermIO;
+
+VAR
+   f: TermIO ;
+BEGIN
+   IF GetTermIO(0, f)
+   THEN
+   END
+END varparm.
diff --git a/gcc/testsuite/gm2/pim/run/pass/wr.mod b/gcc/testsuite/gm2/pim/run/pass/wr.mod
new file mode 100644
index 00000000000..b787cfa39c6
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/wr.mod
@@ -0,0 +1,26 @@
+MODULE wr;
+
+IMPORT FIO;
+
+FROM StrIO IMPORT WriteString, WriteLn, ReadString;
+FROM StrLib IMPORT StrEqual;
+FROM NumberIO IMPORT WriteInt,WriteCard;
+
+
+PROCEDURE Overall;
+VAR
+   in,out : CARDINAL;
+   fnum1 : FIO.File;
+BEGIN
+   fnum1 := FIO.OpenToWrite('results.dat');
+   FOR out :=1 TO 9 DO
+      FIO.WriteCardinal(fnum1,out);
+      FIO.WriteLine(fnum1);
+   END ; (* outer for *)
+   FIO.Close(fnum1)
+END Overall;
+
+
+BEGIN (*main program*)
+   Overall
+END wr.
diff --git a/gcc/testsuite/gm2/pimcoroutines/pass/imports.mod b/gcc/testsuite/gm2/pimcoroutines/pass/imports.mod
new file mode 100644
index 00000000000..b47f3ba62c0
--- /dev/null
+++ b/gcc/testsuite/gm2/pimcoroutines/pass/imports.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2013 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. *)
+
+MODULE imports ;
+
+FROM SYSTEM IMPORT CARDINAL32 ;
+
+VAR
+   c: CARDINAL32 ;
+BEGIN
+   c := 0
+END imports.
diff --git a/gcc/testsuite/gm2/pimcoroutines/pass/imports2.mod b/gcc/testsuite/gm2/pimcoroutines/pass/imports2.mod
new file mode 100644
index 00000000000..840710ee448
--- /dev/null
+++ b/gcc/testsuite/gm2/pimcoroutines/pass/imports2.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2013 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. *)
+
+MODULE imports2 ;
+
+FROM SYSTEM IMPORT TRANSFER, NEWPROCESS, IOTRANSFER, ADDRESS, ADR ;
+
+BEGIN
+
+END imports2.
diff --git a/gcc/testsuite/gm2/pimcoroutines/pass/pimcoroutines-pass.exp b/gcc/testsuite/gm2/pimcoroutines/pass/pimcoroutines-pass.exp
new file mode 100644
index 00000000000..04407fe5ba7
--- /dev/null
+++ b/gcc/testsuite/gm2/pimcoroutines/pass/pimcoroutines-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_cor "${srcdir}/gm2/pimcoroutines/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/pimcoroutines/run/pass/pimcoroutines-run-pass.exp b/gcc/testsuite/gm2/pimcoroutines/run/pass/pimcoroutines-run-pass.exp
new file mode 100644
index 00000000000..f04f8285fb0
--- /dev/null
+++ b/gcc/testsuite/gm2/pimcoroutines/run/pass/pimcoroutines-run-pass.exp
@@ -0,0 +1,43 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_cor "${srcdir}/gm2/pim/run/pass"
+
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    set output [gm2_target_compile $srcdir/gm2/pim/run/pass/sys.mod sys.o object "-I$srcdir/../m2/gm2-libs -I$srcdir/gm2/pim/run/pass -I$srcdir/../m2/gm2-compiler -I../m2/gm2-libs -I../m2/gm2-compiler -fpim"]
+
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    if { $testcase != "$srcdir/$subdir/sys.mod" } {
+	gm2-torture-execute $testcase "" "pass"
+    }
+}
diff --git a/gcc/testsuite/gm2/pimcoroutines/run/pass/testtime.mod b/gcc/testsuite/gm2/pimcoroutines/run/pass/testtime.mod
new file mode 100644
index 00000000000..fa43163b107
--- /dev/null
+++ b/gcc/testsuite/gm2/pimcoroutines/run/pass/testtime.mod
@@ -0,0 +1,116 @@
+(* Copyright (C) 2005-2020
+                 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library 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
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *)
+
+MODULE testtime ;
+
+
+FROM Debug IMPORT Halt ;
+FROM StdIO IMPORT PushOutput ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM TimerHandler IMPORT EVENT, TicksPerSecond, Sleep, ArmEvent,
+                         Cancel, WaitOn, ReArmEvent ;
+FROM SYSTEM IMPORT TurnInterrupts ;
+FROM COROUTINES IMPORT PROTECTION ;
+FROM Executive IMPORT DESCRIPTOR, InitProcess, Resume, Ps ;
+FROM SYSTEM IMPORT ADR ;
+FROM libc IMPORT write, printf ;
+
+
+(*
+   OneSecond -
+*)
+
+PROCEDURE OneSecond ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   OldInts := TurnInterrupts (MIN (PROTECTION)) ;
+   printf ("1 second process has come to life\n");
+   n := 0 ;
+   LOOP
+      Sleep (1*TicksPerSecond) ;
+      INC (n) ;
+      printf ("%d seconds\n", n);
+   END
+END OneSecond ;
+
+
+(*
+   FourSeconds -
+*)
+
+PROCEDURE FourSeconds ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   OldInts := TurnInterrupts (MIN (PROTECTION)) ;
+   printf ("4 seconds process has come to life\n");
+   n := 0 ;
+   LOOP
+      Sleep (4*TicksPerSecond) ;
+      INC (n) ;
+      printf ("4 second alarm (%d occurance)\n", n);
+   END
+END FourSeconds ;
+
+
+(*
+   SixSeconds -
+*)
+
+PROCEDURE SixSeconds ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   OldInts := TurnInterrupts (MAX (PROTECTION)) ;
+   printf ("6 seconds process has come to life\n");
+   n := 0 ;
+   LOOP
+      Timeout := ArmEvent (6*TicksPerSecond) ;
+      IF WaitOn (Timeout)
+      THEN
+         WriteString ('...someone cancelled it...')
+      ELSE
+         INC (n) ;
+         printf ("6 second alarm (%d occurance)\n", n)
+      END
+   END
+END SixSeconds ;
+
+
+CONST
+   StackSize = 0100000H ;
+
+VAR
+   p1, p4,
+   p6      : DESCRIPTOR ;
+   OldInts : PROTECTION ;
+   Timeout : EVENT ;
+BEGIN
+   OldInts := TurnInterrupts (MIN (PROTECTION)) ;
+   printf ("got to OS\n") ;
+
+   printf ("now to create three processes...\n") ;
+
+   p1 := Resume (InitProcess (OneSecond  , StackSize, '1')) ;
+   p4 := Resume (InitProcess (FourSeconds, StackSize, '4')) ;
+   p6 := Resume (InitProcess (SixSeconds , StackSize, '6')) ;
+
+   Sleep (20*TicksPerSecond) ;
+   printf ("successfully completed, finishing now.\n")
+END testtime.
diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod b/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod
new file mode 100644
index 00000000000..6259b56873e
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod
@@ -0,0 +1,1712 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+                 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library 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
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA *)
+
+IMPLEMENTATION MODULE FIO ;
+
+(*
+    Title      : FIO
+    Author     : Gaius Mulley
+    System     : UNIX (gm2)
+    Date       : Thu Sep  2 22:07:21 1999
+    Last edit  : Thu Sep  2 22:07:21 1999
+    Description: a complete reimplememtation of FIO.mod
+                 provides a simple buffered file input/output library.
+*)
+
+FROM SYSTEM IMPORT ADR, TSIZE, SIZE, WORD ;
+FROM ASCII IMPORT nl, nul, tab ;
+FROM StrLib IMPORT StrLen, StrConCat, StrCopy ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM NumberIO IMPORT CardToStr ;
+FROM libc IMPORT exit, open, creat, read, write, close, lseek, strncpy, memcpy ;
+FROM Indexing IMPORT Index, InitIndex, InBounds, HighIndice, PutIndice, GetIndice ;
+FROM M2RTS IMPORT InstallTerminationProcedure ;
+
+CONST
+   SEEK_SET            =       0 ;   (* relative from beginning of the file *)
+   SEEK_END            =       2 ;   (* relative to the end of the file     *)
+   UNIXREADONLY        =       0 ;
+   UNIXWRITEONLY       =       1 ;
+   CreatePermissions   =     666B;
+   MaxBufferLength     = 1024*16 ;
+   MaxErrorString      = 1024* 8 ;
+
+TYPE
+   FileUsage         = (unused, openedforread, openedforwrite, openedforrandom) ;
+   FileStatus        = (successful, outofmemory, toomanyfilesopen, failed, connectionfailure, endofline, endoffile) ;
+
+   NameInfo          = RECORD
+                          address: ADDRESS ;
+                          size   : CARDINAL ;
+                       END ;
+
+   Buffer            = POINTER TO buf ;
+   buf               =            RECORD
+                                     valid   : BOOLEAN ;   (* are the field valid?             *)
+                                     bufstart: LONGINT ;   (* the position of buffer in file   *)
+                                     position: CARDINAL ;  (* where are we through this buffer *)
+                                     address : ADDRESS ;   (* dynamic buffer address           *)
+                                     filled  : CARDINAL ;  (* length of the buffer filled      *)
+                                     size    : CARDINAL ;  (* maximum space in this buffer     *)
+                                     left    : CARDINAL ;  (* number of bytes left to read     *)
+                                     contents: POINTER TO ARRAY [0..MaxBufferLength] OF CHAR ;
+                                  END ;
+
+   FileDescriptor   = POINTER TO fds ;
+   fds               =            RECORD
+                                     unixfd: INTEGER ;
+                                     name  : NameInfo ;
+                                     state : FileStatus ;
+                                     usage : FileUsage ;
+                                     output: BOOLEAN ;     (* is this file going to write data *)
+                                     buffer: Buffer ;
+                                     abspos: LONGINT ;     (* absolute position into file.     *)
+                                  END ;                    (* reflects low level reads which   *)
+                                                           (* means this value will normally   *)
+                                                           (* be further through the file than *)
+                                                           (* bufstart above.                  *)
+   PtrToChar         = POINTER TO CHAR ;
+
+(* we only need forward directives for the p2c bootstrapping tool *)
+
+(* %%%FORWARD%%%
+PROCEDURE SetEndOfLine (f: File; ch: CHAR) ; FORWARD ;
+PROCEDURE FormatError (a: ARRAY OF CHAR) ; FORWARD ;
+PROCEDURE FormatError1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ; FORWARD ;
+PROCEDURE CheckAccess (f: File; use: FileUsage; towrite: BOOLEAN) ; FORWARD ;
+PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ; FORWARD ;
+PROCEDURE InitializeFile (f: File; fname: ADDRESS; flength: CARDINAL;
+                          fstate: FileStatus; use: FileUsage; towrite: BOOLEAN; buflength: CARDINAL) : File ; FORWARD ;
+PROCEDURE ConnectToUnix (f: File; towrite, newfile: BOOLEAN) ; FORWARD ;
+PROCEDURE SetState (f: File; s: FileStatus) ; FORWARD ;
+PROCEDURE PreInitialize (f: File; fname: ARRAY OF CHAR;
+                         state: FileStatus; use: FileUsage;
+                         towrite: BOOLEAN; osfd: INTEGER; bufsize: CARDINAL) ; FORWARD ;
+   %%%FORWARD%%% *)
+
+VAR
+   FileInfo: Index ;
+   Error   : File ;   (* not stderr, this is an unused file handle
+                         which only serves to hold status values
+                         when we cannot create a new file handle *)
+
+
+(*
+   GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*)
+
+PROCEDURE GetUnixFileDescriptor (f: File) : INTEGER ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         RETURN( fd^.unixfd )
+      END
+   END ;
+   FormatError1('file %d has not been opened or is out of range\n', f) ;
+   RETURN( -1 )
+END GetUnixFileDescriptor ;
+
+
+(*
+   WriteString - writes a string to file, f.
+*)
+
+PROCEDURE WriteString (f: File; a: ARRAY OF CHAR) ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := StrLen(a) ;
+   IF WriteNBytes(f, l, ADR(a))#l
+   THEN
+   END
+END WriteString ;
+
+
+(*
+   Max - returns the maximum of two values.
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a>b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Max ;
+
+
+(*
+   Min - returns the minimum of two values.
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+(*
+   GetNextFreeDescriptor - returns the index to the FileInfo array indicating
+                           the next free slot.
+*)
+
+PROCEDURE GetNextFreeDescriptor () : File ;
+VAR
+   f, h: File ;
+   fd  : FileDescriptor ;
+BEGIN
+   f := Error+1 ;
+   h := HighIndice(FileInfo) ;
+   LOOP
+      IF f<=h
+      THEN
+         fd := GetIndice(FileInfo, f) ;
+         IF fd=NIL
+         THEN
+            RETURN( f )
+         END
+      END ;
+      INC(f) ;
+      IF f>h
+      THEN
+         PutIndice(FileInfo, f, NIL) ;  (* create new slot *)
+         RETURN( f )
+      END
+   END
+END GetNextFreeDescriptor ;
+
+
+(*
+   IsNoError - returns a TRUE if no error has occured on file, f.
+*)
+
+PROCEDURE IsNoError (f: File) : BOOLEAN ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f=Error
+   THEN
+      RETURN( FALSE )
+   ELSE
+      fd := GetIndice(FileInfo, f) ;
+      RETURN( (fd#NIL) AND ((fd^.state=successful) OR (fd^.state=endoffile) OR (fd^.state=endofline)) )
+   END
+END IsNoError ;
+
+
+(*
+   IsActive - returns TRUE if the file, f, is still active.
+*)
+
+PROCEDURE IsActive (f: File) : BOOLEAN ;
+BEGIN
+   IF f=Error
+   THEN
+      RETURN( FALSE )
+   ELSE
+      RETURN( GetIndice(FileInfo, f)#NIL )
+   END
+END IsActive ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE openToRead (fname: ADDRESS; flength: CARDINAL) : File ;
+VAR
+   f: File ;
+BEGIN
+   f := GetNextFreeDescriptor() ;
+   IF f=Error
+   THEN
+      SetState(f, toomanyfilesopen)
+   ELSE
+      f := InitializeFile(f, fname, flength, successful, openedforread, FALSE, MaxBufferLength) ;
+      ConnectToUnix(f, FALSE, FALSE)
+   END ;
+   RETURN( f )
+END openToRead ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE openToWrite (fname: ADDRESS; flength: CARDINAL) : File ;
+VAR
+   f: File ;
+BEGIN
+   f := GetNextFreeDescriptor() ;
+   IF f=Error
+   THEN
+      SetState(f, toomanyfilesopen)
+   ELSE
+      f := InitializeFile(f, fname, flength, successful, openedforwrite, TRUE, MaxBufferLength) ;
+      ConnectToUnix(f, TRUE, TRUE)
+   END ;
+   RETURN( f )
+END openToWrite ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE openForRandom (fname: ADDRESS; flength: CARDINAL;
+                         towrite, newfile: BOOLEAN) : File ;
+VAR
+   f: File ;
+BEGIN
+   f := GetNextFreeDescriptor() ;
+   IF f=Error
+   THEN
+      SetState(f, toomanyfilesopen)
+   ELSE
+      f := InitializeFile(f, fname, flength, successful, openedforrandom, towrite, MaxBufferLength) ;
+      ConnectToUnix(f, towrite, newfile)
+   END ;
+   RETURN( f )
+END openForRandom ;
+
+
+(*
+   exists - returns TRUE if a file named, fname exists for reading.
+*)
+
+PROCEDURE exists (fname: ADDRESS; flength: CARDINAL) : BOOLEAN ;
+VAR
+   f: File ;
+BEGIN
+   f := openToRead(fname, flength) ;
+   IF IsNoError(f)
+   THEN
+      Close(f) ;
+      RETURN( TRUE )
+   ELSE
+      Close(f) ;
+      RETURN( FALSE )
+   END
+END exists ;
+
+
+(*
+   SetState - sets the field, state, of file, f, to, s.
+*)
+
+PROCEDURE SetState (f: File; s: FileStatus) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   fd := GetIndice(FileInfo, f) ;
+   fd^.state := s
+END SetState ;
+
+
+(*
+   InitializeFile - initialize a file descriptor
+*)
+
+PROCEDURE InitializeFile (f: File; fname: ADDRESS;
+                          flength: CARDINAL; fstate: FileStatus;
+                          use: FileUsage;
+                          towrite: BOOLEAN; buflength: CARDINAL) : File ;
+VAR
+   p : PtrToChar ;
+   fd: FileDescriptor ;
+BEGIN
+   NEW(fd) ;
+   IF fd=NIL
+   THEN
+      SetState(Error, outofmemory) ;
+      RETURN( Error )
+   ELSE
+      PutIndice(FileInfo, f, fd) ;
+      WITH fd^ DO
+         name.size := flength+1 ;  (* need to guarantee the nul for C *)
+         usage     := use ;
+         output    := towrite ;
+         ALLOCATE(name.address, name.size) ;
+         IF name.address=NIL
+         THEN
+            state := outofmemory ;
+            RETURN( f )
+         END ;
+         name.address := strncpy(name.address, fname, flength) ;
+         (* and assign nul to the last byte *)
+         p := name.address ;
+         INC(p, flength) ;
+         p^ := nul ;
+         abspos := 0 ;
+         (* now for the buffer *)
+         NEW(buffer) ;
+         IF buffer=NIL
+         THEN
+            SetState(Error, outofmemory) ;
+            RETURN( Error )
+         ELSE
+            WITH buffer^ DO
+               valid    := FALSE ;
+               bufstart := 0 ;
+               size     := buflength ;
+               position := 0 ;
+               filled   := 0 ;
+               IF size=0
+               THEN
+                  address := NIL
+               ELSE
+                  ALLOCATE(address, size) ;
+                  IF address=NIL
+                  THEN
+                     state := outofmemory ;
+                     RETURN( f )
+                  END
+               END ;
+               IF towrite
+               THEN
+                  left := size
+               ELSE
+                  left := 0
+               END ;
+               contents := address ;  (* provides easy access for reading characters *)
+            END ;
+            state := fstate
+         END
+      END
+   END ;
+   RETURN( f )
+END InitializeFile ;
+
+
+(*
+   ConnectToUnix - connects a FIO file to a UNIX file descriptor.
+*)
+
+PROCEDURE ConnectToUnix (f: File; towrite, newfile: BOOLEAN) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            IF towrite
+            THEN
+               IF newfile
+               THEN
+                  unixfd := creat(name.address, CreatePermissions)
+               ELSE
+                  unixfd := open(name.address, UNIXWRITEONLY, 0)
+               END
+            ELSE
+               unixfd := open(name.address, UNIXREADONLY, 0)
+            END ;
+            IF unixfd<0
+            THEN
+               state := connectionfailure
+            END
+         END
+      END
+   END
+END ConnectToUnix ;
+
+
+(*
+   The following functions are wrappers for the above.
+*)
+
+PROCEDURE Exists (fname: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( exists(ADR(fname), StrLen(fname)) )
+END Exists ;
+
+
+PROCEDURE OpenToRead (fname: ARRAY OF CHAR) : File ;
+BEGIN
+   RETURN( openToRead(ADR(fname), StrLen(fname)) )
+END OpenToRead ;
+
+
+PROCEDURE OpenToWrite (fname: ARRAY OF CHAR) : File ;
+BEGIN
+   RETURN( openToWrite(ADR(fname), StrLen(fname)) )
+END OpenToWrite ;
+
+
+PROCEDURE OpenForRandom (fname: ARRAY OF CHAR;
+                         towrite: BOOLEAN; newfile: BOOLEAN) : File ;
+BEGIN
+   RETURN( openForRandom(ADR(fname), StrLen(fname), towrite, newfile) )
+END OpenForRandom ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE Close (f: File) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      (*
+         we allow users to close files which have an error status
+      *)
+      IF fd#NIL
+      THEN
+         FlushBuffer(f) ;
+         WITH fd^ DO
+            IF unixfd>=0
+            THEN
+               IF close(unixfd)#0
+               THEN
+                  FormatError1('failed to close file (%s)\n', name.address) ;
+                  state := failed   (* --fixme-- too late to notify user (unless we return a BOOLEAN) *)
+               END
+            END ;
+            IF name.address#NIL
+            THEN
+               DEALLOCATE(name.address, name.size)
+            END ;
+            IF buffer#NIL
+            THEN
+               WITH buffer^ DO
+                  IF address#NIL
+                  THEN
+                     DEALLOCATE(address, size)
+                  END
+               END ;
+               DISPOSE(buffer) ;
+               buffer := NIL
+            END
+         END ;
+         DISPOSE(fd) ;
+         PutIndice(FileInfo, f, NIL)
+      END
+   END
+END Close ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ReadFromBuffer (f: File; a: ADDRESS; nBytes: CARDINAL) : INTEGER ;
+VAR 
+   t     : ADDRESS ;
+   result: INTEGER ;
+   total,
+   n     : CARDINAL ;
+   p     : POINTER TO BYTE ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      total := 0 ;   (* how many bytes have we read *)
+      fd := GetIndice(FileInfo, f) ;
+      WITH fd^ DO
+         (* extract from the buffer first *)
+         IF (buffer#NIL) AND (buffer^.valid)
+         THEN
+            WITH buffer^ DO
+               IF left>0
+               THEN
+                  IF nBytes=1
+                  THEN
+                     (* too expensive to call memcpy for 1 character *)
+                     p := a ;
+                     p^ := contents^[position] ;
+                     DEC(left) ;         (* remove consumed bytes               *)
+                     INC(position) ;     (* move onwards n bytes                *)
+                     nBytes := 0 ;       (* reduce the amount for future direct *)
+                                         (* read                                *)
+                     RETURN( 1 )
+                  ELSE
+                     n := Min(left, nBytes) ;
+                     t := address ;
+                     INC(t, position) ;
+                     p := memcpy(a, t, n) ;
+                     DEC(left, n) ;      (* remove consumed bytes               *)
+                     INC(position, n) ;  (* move onwards n bytes                *)
+                                         (* move onwards ready for direct reads *)
+                     INC(a, n) ;
+                     DEC(nBytes, n) ;    (* reduce the amount for future direct *)
+                                         (* read                                *)
+                     INC(total, n) ;
+                     RETURN( total )     (* much cleaner to return now,         *)
+                  END                    (* difficult to record an error if     *)
+               END                       (* the read below returns -1           *)
+            END
+         END ;
+         IF nBytes>0
+         THEN
+            (* still more to read *)
+            result := read(unixfd, a, INTEGER(nBytes)) ;
+            IF result>0
+            THEN
+               INC(total, result) ;
+               INC(abspos, result) ;
+               (* now disable the buffer as we read directly into, a. *)
+               IF buffer#NIL
+               THEN
+                  buffer^.valid := FALSE
+               END ;
+            ELSE
+               IF result=0
+               THEN
+                  (* eof reached *)
+                  state := endoffile
+               ELSE
+                  state := failed
+               END ;
+               (* indicate buffer is empty *)
+               IF buffer#NIL
+               THEN
+                  WITH buffer^ DO
+                     valid    := FALSE ;
+                     left     := 0 ;
+                     position := 0 ;
+                     IF address#NIL
+                     THEN
+                        contents^[position] := nul
+                     END
+                  END
+               END ;
+               RETURN( -1 )
+            END
+         END
+      END ;
+      RETURN( total )
+   ELSE
+      RETURN( -1 )
+   END
+END ReadFromBuffer ;
+
+
+(*
+   ReadNBytes - reads nBytes of a file into memory area, a, 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.
+*)
+
+PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL; a: ADDRESS) : CARDINAL ;
+VAR
+   n: INTEGER ;
+   p: POINTER TO CHAR ;
+BEGIN
+   IF f#Error
+   THEN
+      CheckAccess(f, openedforread, FALSE) ;
+      n := ReadFromBuffer(f, a, nBytes) ;
+      IF n<0
+      THEN
+         RETURN( 0 )
+      ELSE
+         p := a ;
+         INC(p, n) ;
+         SetEndOfLine(f, p^) ;
+         RETURN( n )
+      END
+   ELSE
+      RETURN( 0 )
+   END
+END ReadNBytes ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
+VAR 
+   t     : ADDRESS ;
+   result: INTEGER ;
+   total,
+   n     : INTEGER ;
+   p     : POINTER TO BYTE ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      total := 0 ;   (* how many bytes have we read *)
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            (* extract from the buffer first *)
+            IF buffer#NIL
+            THEN
+               WITH buffer^ DO
+                  WHILE nBytes>0 DO
+                     IF (left>0) AND valid
+                     THEN
+                        IF nBytes=1
+                        THEN
+                           (* too expensive to call memcpy for 1 character *)
+                           p := a ;
+                           p^ := contents^[position] ;
+                           DEC(left) ;         (* remove consumed byte                *)
+                           INC(position) ;     (* move onwards n byte                 *)
+                           INC(total) ;
+                           RETURN( total )
+                        ELSE
+                           n := Min(left, nBytes) ;
+                           t := address ;
+                           INC(t, position) ;
+                           p := memcpy(a, t, n) ;
+                           DEC(left, n) ;      (* remove consumed bytes               *)
+                           INC(position, n) ;  (* move onwards n bytes                *)
+                                               (* move onwards ready for direct reads *)
+                           INC(a, n) ;
+                           DEC(nBytes, n) ;    (* reduce the amount for future direct *)
+                                               (* read                                *)
+                           INC(total, n)
+                        END
+                     ELSE
+                        (* refill buffer *)
+                        n := read(unixfd, address, size) ;
+                        IF n>=0
+                        THEN
+                           valid    := TRUE ;
+                           position := 0 ;
+                           left     := n ;
+                           filled   := n ;
+                           bufstart := abspos ;
+                           INC(abspos, n) ;
+                           IF n=0
+                           THEN
+                              (* eof reached *)
+                              state := endoffile ;
+                              RETURN( -1 )
+                           END
+                        ELSE
+                           valid    := FALSE ;
+                           position := 0 ;
+                           left     := 0 ;
+                           filled   := 0 ;
+                           state    := failed ;
+                           RETURN( total )
+                        END
+                     END
+                  END
+               END ;
+               RETURN( total )
+            ELSE
+               RETURN( -1 )
+            END
+         END
+      END
+   ELSE
+      RETURN( -1 )
+   END
+END BufferedRead ;
+
+
+(*
+   HandleEscape - translates \n and \t into their respective ascii codes.
+*)
+
+PROCEDURE HandleEscape (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR;
+                        VAR i, j: CARDINAL; HighSrc, HighDest: CARDINAL) ;
+BEGIN
+   IF (i+1<HighSrc) AND (src[i]='\') AND (j<HighDest)
+   THEN
+      IF src[i+1]='n'
+      THEN
+         (* requires a newline *)
+         dest[j] := nl ;
+         INC(j) ;
+         INC(i, 2)
+      ELSIF src[i+1]='t'
+      THEN
+         (* requires a tab (yuck) tempted to fake this but I better not.. *)
+         dest[j] := tab ;
+         INC(j) ;
+         INC(i, 2)
+      ELSE
+         (* copy escaped character *)
+         INC(i) ;
+         dest[j] := src[i] ;
+         INC(j) ;
+         INC(i)
+      END
+   END
+END HandleEscape ;
+
+
+(*
+   Cast - casts a := b
+*)
+
+PROCEDURE Cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF HIGH(a)=HIGH(b)
+   THEN
+      FOR i := 0 TO HIGH(a) DO
+         a[i] := b[i]
+      END
+   ELSE
+      FormatError('cast failed')
+   END
+END Cast ;
+
+
+(*
+   StringFormat1 - converts string, src, into, dest, together with encapsulated
+                   entity, w. It only formats the first %s or %d with n.
+*)
+
+PROCEDURE StringFormat1 (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR;
+                         w: ARRAY OF BYTE) ;
+VAR
+   HighSrc,
+   HighDest,
+   c, i, j : CARDINAL ;
+   str     : ARRAY [0..MaxErrorString] OF CHAR ;
+   p       : POINTER TO CHAR ;
+BEGIN
+   HighSrc := StrLen(src) ;
+   HighDest := HIGH(dest) ;
+   i := 0 ;
+   j := 0 ;
+   WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) AND (src[i]#'%') DO
+      IF src[i]='\'
+      THEN
+         HandleEscape(dest, src, i, j, HighSrc, HighDest)
+      ELSE
+         dest[j] := src[i] ;
+         INC(i) ;
+         INC(j)
+      END
+   END ;
+
+   IF (i+1<HighSrc) AND (src[i]='%') AND (j<HighDest)
+   THEN
+      IF src[i+1]='s'
+      THEN
+         Cast(p, w) ;
+         WHILE (j<HighDest) AND (p^#nul) DO
+            dest[j] := p^ ;
+            INC(j) ;
+            INC(p)
+         END ;
+         IF j<HighDest
+         THEN
+            dest[j] := nul
+         END ;
+         j := StrLen(dest) ;
+         INC(i, 2)
+      ELSIF src[i+1]='d'
+      THEN
+         dest[j] := nul ;
+         Cast(c, w) ;
+         CardToStr(c, 0, str) ;
+         StrConCat(dest, str, dest) ;
+         j := StrLen(dest) ;
+         INC(i, 2)
+      ELSE
+         dest[j] := src[i] ;
+         INC(i) ;
+         INC(j)
+      END
+   END ;
+   (* and finish off copying src into dest *)
+   WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) DO
+      IF src[i]='\'
+      THEN
+         HandleEscape(dest, src, i, j, HighSrc, HighDest)
+      ELSE
+         dest[j] := src[i] ;
+         INC(i) ;
+         INC(j)
+      END
+   END ;
+   IF j<HighDest
+   THEN
+      dest[j] := nul
+   END ;
+END StringFormat1 ;
+
+
+(*
+   FormatError - provides a orthoganal counterpart to the procedure below.
+*)
+
+PROCEDURE FormatError (a: ARRAY OF CHAR) ;
+BEGIN
+   WriteString(StdErr, a)
+END FormatError ;
+
+
+(*
+   FormatError1 - fairly generic error procedure.
+*)
+
+PROCEDURE FormatError1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
+VAR
+   s: ARRAY [0..MaxErrorString] OF CHAR ;
+BEGIN
+   StringFormat1(s, a, w) ;
+   FormatError(s)
+END FormatError1 ;
+
+
+(*
+   FormatError2 - fairly generic error procedure.
+*)
+
+PROCEDURE FormatError2 (a: ARRAY OF CHAR;
+                        w1, w2: ARRAY OF BYTE) ;
+VAR
+   s: ARRAY [0..MaxErrorString] OF CHAR ;
+BEGIN
+   StringFormat1(s, a, w1) ;
+   FormatError1(s, w2)
+END FormatError2 ;
+
+
+(*
+   CheckAccess - checks to see whether a file, f, has been
+                 opened for read/write.
+*)
+
+PROCEDURE CheckAccess (f: File; use: FileUsage; towrite: BOOLEAN) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd=NIL
+      THEN
+         IF f#StdErr
+         THEN
+            FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n')
+         END ;
+         HALT
+      ELSE
+         WITH fd^ DO
+            IF (use=openedforwrite) AND (usage=openedforread)
+            THEN
+               FormatError1('this file (%s) has been opened for reading but is now being written\n',
+                            name.address) ;
+               HALT
+            ELSIF (use=openedforread) AND (usage=openedforwrite)
+            THEN
+               FormatError1('this file (%s) has been opened for writing but is now being read\n',
+                            name.address) ;
+               HALT
+            ELSIF state=connectionfailure
+            THEN
+               FormatError1('this file (%s) was not successfully opened\n',
+                            name.address) ;
+               HALT
+            ELSIF towrite#output
+            THEN
+               IF output
+               THEN
+                  FormatError1('this file (%s) was opened for writing but is now being read\n',
+                               name.address) ;
+                  HALT
+               ELSE
+                  FormatError1('this file (%s) was opened for reading but is now being written\n',
+                               name.address) ;
+                  HALT
+               END
+            END
+         END
+      END
+   ELSE
+      FormatError('this file has not been opened successfully\n') ;
+      HALT
+   END
+END CheckAccess ;
+
+
+(*
+   ReadChar - returns a character read from file, f.
+              Sensible to check with IsNoError or EOF after calling
+              this function.
+*)
+
+PROCEDURE ReadChar (f: File) : CHAR ;
+VAR
+   ch: CHAR ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF BufferedRead(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch))
+   THEN
+      SetEndOfLine(f, ch) ;
+      RETURN( ch )
+   ELSE
+      RETURN( nul )
+   END
+END ReadChar ;
+
+
+(*
+   SetEndOfLine - 
+*)
+
+PROCEDURE SetEndOfLine (f: File; ch: CHAR) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      WITH fd^ DO
+         IF ch=nl
+         THEN
+            state := endofline
+         END
+      END
+   END
+END SetEndOfLine ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE UnReadChar (f: File ; ch: CHAR) ;
+VAR
+   fd  : FileDescriptor ;
+   n   : CARDINAL ;
+   a, b: ADDRESS ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      WITH fd^ DO
+         IF (state=successful) OR (state=endoffile) OR (state=endofline)
+         THEN
+            IF (buffer#NIL) AND (buffer^.valid)
+            THEN
+               WITH buffer^ DO
+                  (* we assume that a ReadChar has occurred, we will check just in case. *)
+                  IF state=endoffile
+                  THEN
+                     position := MaxBufferLength ;
+                     left := 0 ;
+                     filled := 0 ;
+                     state := successful
+                  END ;
+                  IF position>0
+                  THEN
+                     DEC(position) ;
+                     INC(left) ;
+                     contents^[position] := ch ;
+                     SetEndOfLine(f, ch)
+                  ELSE
+                     (* position=0 *)
+                     (* if possible make room and store ch *)
+                     IF filled=size
+                     THEN
+                        FormatError1('performing too many UnReadChar calls on file (%d)\n', f)
+                     ELSE
+                        n := filled-position ;
+                        b := ADR(contents^[position]) ;
+                        a := ADR(contents^[position+1]) ;
+                        a := memcpy(a, b, n) ;
+                        INC(filled) ;
+                        contents^[position] := ch ;
+                        SetEndOfLine(f, ch)
+                     END
+                  END
+               END
+            END
+         ELSE
+            FormatError1('UnReadChar can only be called if the previous read was successful or end of file, error on file (%d)\n', f)
+         END
+      END
+   END
+END UnReadChar ;
+
+
+(*
+   ReadAny - reads HIGH(a) bytes into, a. All input
+             is fully buffered, unlike ReadNBytes and thus is more
+             suited to small reads.
+*)
+
+PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF BufferedRead(f, HIGH(a), ADR(a)) = INTEGER (HIGH(a))
+   THEN
+      SetEndOfLine(f, a[HIGH(a)])
+   END
+END ReadAny ;
+
+
+(*
+   EOF - tests to see whether a file, f, has reached end of file.
+*)
+
+PROCEDURE EOF (f: File) : BOOLEAN ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         RETURN( fd^.state=endoffile )
+      END
+   END ;
+   RETURN( TRUE )
+END EOF ;
+
+
+(*
+   EOLN - tests to see whether a file, f, is upon a newline.
+          It does NOT consume the newline.
+*)
+
+PROCEDURE EOLN (f: File) : BOOLEAN ;
+VAR
+   ch: CHAR ;
+   fd: FileDescriptor ;
+BEGIN
+   CheckAccess(f, 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
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         IF fd^.state=successful
+         THEN
+            ch := ReadChar(f) ;
+            IF fd^.state=successful
+            THEN
+               UnReadChar(f, ch)
+            END ;
+            RETURN( ch=nl )
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END EOLN ;
+
+
+(*
+   WasEOLN - tests to see whether a file, f, has just seen a newline.
+*)
+
+PROCEDURE WasEOLN (f: File) : BOOLEAN ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   IF f=Error
+   THEN
+      RETURN FALSE
+   ELSE
+      fd := GetIndice(FileInfo, f) ;
+      RETURN( (fd#NIL) AND (fd^.state=endofline) )
+   END
+END WasEOLN ;
+
+
+(*
+   WriteLine - writes out a linefeed to file, f.
+*)
+
+PROCEDURE WriteLine (f: File) ;
+BEGIN
+   WriteChar(f, nl)
+END WriteLine ;
+
+
+(*
+   WriteNBytes - writes nBytes of a file into memory area, a, 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.
+*)
+
+PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL; a: ADDRESS) : CARDINAL ;
+VAR
+   total: INTEGER ;
+   fd   : FileDescriptor ;
+BEGIN
+   CheckAccess(f, openedforwrite, TRUE) ;
+   FlushBuffer(f) ;
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            total := write(unixfd, a, INTEGER(nBytes)) ;
+            IF total<0
+            THEN
+               state := failed ;
+               RETURN( 0 )
+            ELSE
+               INC(abspos, CARDINAL(total)) ;
+               IF buffer#NIL
+               THEN
+                  buffer^.bufstart := abspos
+               END ;
+               RETURN( CARDINAL(total) )
+            END
+         END
+      END
+   END ;
+   RETURN( 0 )
+END WriteNBytes ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE BufferedWrite (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
+VAR 
+   t     : ADDRESS ;
+   result: INTEGER ;
+   total,
+   n     : INTEGER ;
+   p     : POINTER TO BYTE ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         total := 0 ;   (* how many bytes have we read *)
+         WITH fd^ DO
+            IF buffer#NIL
+            THEN
+               WITH buffer^ DO
+                  WHILE nBytes>0 DO
+                     (* place into the buffer first *)
+                     IF left>0
+                     THEN
+                        IF nBytes=1
+                        THEN
+                           (* too expensive to call memcpy for 1 character *)
+                           p := a ;
+                           contents^[position] := p^ ;
+                           DEC(left) ;         (* reduce space                        *)
+                           INC(position) ;     (* move onwards n byte                 *)
+                           INC(total) ;
+                           RETURN( total )
+                        ELSE
+                           n := Min(left, nBytes) ;
+                           t := address ;
+                           INC(t, position) ;
+                           p := memcpy(a, t, CARDINAL(n)) ;
+                           DEC(left, n) ;      (* remove consumed bytes               *)
+                           INC(position, n) ;  (* move onwards n bytes                *)
+                                               (* move ready for further writes       *)
+                           INC(a, n) ;
+                           DEC(nBytes, n) ;    (* reduce the amount for future writes *)
+                           INC(total, n)
+                        END
+                     ELSE
+                        FlushBuffer(f) ;
+                        IF state#successful
+                        THEN
+                           nBytes := 0
+                        END
+                     END
+                  END
+               END ;
+               RETURN( total )
+            END
+         END
+      END
+   END ;
+   RETURN( -1 )
+END BufferedWrite ;
+
+
+(*
+   FlushBuffer - flush contents of file, f.
+*)
+
+PROCEDURE FlushBuffer (f: File) ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            IF output AND (buffer#NIL)
+            THEN
+               WITH buffer^ DO
+                  IF (position=0) OR (write(unixfd, address, position)=VAL(INTEGER, position))
+                  THEN
+                     INC(abspos, position) ;
+                     bufstart := abspos ;
+                     position := 0 ;
+                     filled   := 0 ;
+                     left     := size
+                  ELSE
+                     state := failed
+                  END
+               END
+            END
+         END
+      END
+   END
+END FlushBuffer ;
+
+
+(*
+   WriteAny - writes HIGH(a) bytes onto, file, f. All output
+              is fully buffered, unlike WriteNBytes and thus is more
+              suited to small writes.
+*)
+
+PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
+BEGIN
+   CheckAccess(f, openedforwrite, TRUE) ;
+   IF BufferedWrite (f, HIGH(a), ADR(a)) = INTEGER (HIGH(a))
+   THEN
+   END
+END WriteAny ;
+
+
+(*
+   WriteChar - writes a single character to file, f.
+*)
+
+PROCEDURE WriteChar (f: File; ch: CHAR) ;
+BEGIN
+   CheckAccess(f, openedforwrite, TRUE) ;
+   IF BufferedWrite(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch))
+   THEN
+   END
+END WriteChar ;
+
+
+(*
+   WriteCardinal - writes a CARDINAL to file, f.
+                   It writes the binary image of the cardinal
+                   to file, f.
+*)
+
+PROCEDURE WriteCardinal (f: File; c: CARDINAL) ;
+BEGIN
+   WriteAny(f, c)
+END WriteCardinal ;
+
+
+(*
+   ReadCardinal - reads a CARDINAL from file, f.
+                  It reads a binary image of a CARDINAL
+                  from a file, f.
+*)
+
+PROCEDURE ReadCardinal (f: File) : CARDINAL ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   ReadAny(f, c) ;
+   RETURN( c )
+END ReadCardinal ;
+
+
+(*
+   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.
+*)
+
+PROCEDURE ReadString (f: File; VAR a: ARRAY OF CHAR) ;
+VAR
+   high,
+   i   : CARDINAL ;
+   ch  : CHAR ;
+BEGIN
+   CheckAccess(f, openedforread, FALSE) ;
+   high := HIGH(a) ;
+   i := 0 ;
+   REPEAT
+      ch := ReadChar(f) ;
+      IF i<=high
+      THEN
+         IF (ch=nl) OR (NOT IsNoError(f)) OR EOF(f)
+         THEN
+            a[i] := nul ;
+            INC(i)
+         ELSE
+            a[i] := ch ;
+            INC(i)
+         END
+      END
+   UNTIL (ch=nl) OR (i>high) OR (NOT IsNoError(f)) OR EOF(f)
+END ReadString ;
+
+
+(*
+   SetPositionFromBeginning - sets the position from the beginning of the file.
+*)
+
+PROCEDURE SetPositionFromBeginning (f: File; pos: LONGINT) ;
+VAR
+   offset: LONGINT ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            (* 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 (abspos#pos) OR TRUE
+            THEN
+               FlushBuffer(f) ;
+               IF buffer#NIL
+               THEN
+                  WITH buffer^ DO
+                     IF output
+                     THEN
+                        left := size
+                     ELSE
+                        left := 0
+                     END ;
+                     position := 0 ;
+                     filled   := 0
+                  END
+               END ;
+               offset := lseek(unixfd, pos, SEEK_SET) ;
+               IF (offset>=0) AND (pos=offset)
+               THEN
+                  abspos := pos
+               ELSE
+                  state  := failed ;
+                  abspos := 0
+               END ;
+               IF buffer#NIL
+               THEN
+                  buffer^.valid := FALSE ;
+                  buffer^.bufstart := abspos
+               END
+            END
+         END
+      END
+   END
+END SetPositionFromBeginning ;
+
+
+(*
+   SetPositionFromEnd - sets the position from the end of the file.
+*)
+
+PROCEDURE SetPositionFromEnd (f: File; pos: LONGINT) ;
+VAR
+   offset: LONGINT ;
+   fd    : FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            FlushBuffer(f) ;
+            IF buffer#NIL
+            THEN
+               WITH buffer^ DO
+                  IF output
+                  THEN
+                     left := size
+                  ELSE
+                     left := 0
+                  END ;
+                  position := 0 ;
+                  filled   := 0
+               END
+            END ;
+            offset := lseek(unixfd, pos, SEEK_END) ;
+            IF offset>=0
+            THEN
+               abspos := offset ;
+            ELSE
+               state  := failed ;
+               abspos := 0 ;
+               offset := 0
+            END ;
+            IF buffer#NIL
+            THEN
+               buffer^.valid := FALSE ;
+               buffer^.bufstart := offset
+            END
+         END
+      END
+   END
+END SetPositionFromEnd ;
+
+
+(*
+   FindPosition - returns the current absolute position in file, f.
+*)
+
+PROCEDURE FindPosition (f: File) : LONGINT ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd#NIL
+      THEN
+         WITH fd^ DO
+            IF (buffer=NIL) OR (NOT buffer^.valid)
+            THEN
+               RETURN( abspos )
+            ELSE
+               WITH buffer^ DO
+                  RETURN( bufstart+VAL(LONGINT, position) )
+               END
+            END
+         END
+      END
+   END ;
+   RETURN( 0 )
+END FindPosition ;
+
+
+(*
+   GetFileName - assigns, a, with the filename associated with, f.
+*)
+
+PROCEDURE GetFileName (f: File; VAR a: ARRAY OF CHAR) ;
+VAR
+   i : CARDINAL ;
+   p : POINTER TO CHAR ;
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd=NIL
+      THEN
+         FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ;
+         HALT
+      ELSE
+         WITH fd^.name DO
+            IF address=NIL
+            THEN
+               StrCopy('', a)
+            ELSE
+               p := address ;
+               i := 0 ;
+               WHILE (p^#nul) AND (i<=HIGH(a)) DO
+                  a[i] := p^ ;
+                  INC(p) ;
+                  INC(i)
+               END
+            END
+         END
+      END
+   END
+END GetFileName ;
+
+
+(*
+   getFileName - returns the address of the filename associated with, f.
+*)
+
+PROCEDURE getFileName (f: File) : ADDRESS ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd=NIL
+      THEN
+         FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ;
+         HALT
+      ELSE
+         RETURN fd^.name.address
+      END
+   END
+END getFileName ;
+
+
+(*
+   getFileNameLength - returns the number of characters associated with filename, f.
+*)
+
+PROCEDURE getFileNameLength (f: File) : CARDINAL ;
+VAR
+   fd: FileDescriptor ;
+BEGIN
+   IF f#Error
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF fd=NIL
+      THEN
+         FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ;
+         HALT
+      ELSE
+         RETURN fd^.name.size
+      END
+   END
+END getFileNameLength ;
+
+
+(*
+   PreInitialize - preinitialize the file descriptor.
+*)
+
+PROCEDURE PreInitialize (f: File; fname: ARRAY OF CHAR;
+                         state: FileStatus; use: FileUsage;
+                         towrite: BOOLEAN; osfd: INTEGER; bufsize: CARDINAL) ;
+VAR
+   fd, fe: FileDescriptor ;
+BEGIN
+   IF InitializeFile(f, ADR(fname), StrLen(fname), state, use, towrite, bufsize)=f
+   THEN
+      fd := GetIndice(FileInfo, f) ;
+      IF f=Error
+      THEN
+         fe := GetIndice(FileInfo, StdErr) ;
+         IF fe=NIL
+         THEN
+            HALT
+         ELSE
+            fd^.unixfd := fe^.unixfd    (* the error channel *)
+         END
+      ELSE
+         fd^.unixfd := osfd
+      END
+   ELSE
+      HALT
+   END
+END PreInitialize ;
+
+
+(*
+   FlushOutErr - called when the application calls M2RTS.Terminate (automatically
+                 placed in program modules by GM2.
+*)
+
+PROCEDURE FlushOutErr ;
+BEGIN
+   IF IsNoError(StdOut)
+   THEN
+      FlushBuffer(StdOut)
+   END ;
+   IF IsNoError(StdErr)
+   THEN
+      FlushBuffer(StdErr)
+   END
+END FlushOutErr ;
+
+
+(*
+   Init - initialize the modules, global variables.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   FileInfo := InitIndex(0) ;
+   Error := 0 ;
+   PreInitialize(Error       , 'error'   , toomanyfilesopen, unused        , FALSE, -1, 0) ;
+   StdIn := 1 ;
+   PreInitialize(StdIn       , '<stdin>' , successful      , openedforread , FALSE, 0, MaxBufferLength) ;
+   StdOut := 2 ;
+   PreInitialize(StdOut      , '<stdout>', successful      , openedforwrite,  TRUE, 1, MaxBufferLength) ;
+   StdErr := 3 ;
+   PreInitialize(StdErr      , '<stderr>', successful      , openedforwrite,  TRUE, 2, MaxBufferLength) ;
+   IF NOT InstallTerminationProcedure(FlushOutErr)
+   THEN
+      HALT
+   END
+END Init ;
+
+
+BEGIN
+   Init
+FINALLY
+   FlushOutErr
+END FIO.
diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod b/gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod
new file mode 100644
index 00000000000..47635694a34
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod
@@ -0,0 +1,217 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library 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
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA *)
+
+IMPLEMENTATION MODULE StrLib ;
+
+FROM ASCII IMPORT nul, tab ;
+
+(* %%%FORWARD%%%
+PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ; FORWARD ;
+PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ; FORWARD ;
+PROCEDURE StrCopy (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ; FORWARD ;
+PROCEDURE StrConCat (a: ARRAY OF CHAR ; b: ARRAY OF CHAR ; VAR c: ARRAY OF CHAR) ; FORWARD ;
+PROCEDURE IsSubString (a, b: ARRAY OF CHAR) : BOOLEAN ; FORWARD ;
+   %%%FORWARD%%% *)
+
+
+(*
+   StrConCat - combines a and b into c.
+*)
+
+PROCEDURE StrConCat (a: ARRAY OF CHAR; b: ARRAY OF CHAR; VAR c: ARRAY OF CHAR) ;
+VAR
+   Highb,
+   Highc,
+   i, j : CARDINAL ;
+BEGIN
+   Highb := StrLen(b) ;
+   Highc := HIGH(c) ;
+   StrCopy(a, c) ;
+   i := StrLen(c) ;
+   j := 0 ;
+   WHILE (j<Highb) AND (i<=Highc) DO
+      c[i] := b[j] ;
+      INC(i) ;
+      INC(j)
+   END ;
+   IF i<=Highc
+   THEN
+      c[i] := nul
+   END
+END StrConCat ;
+
+
+(*
+   StrLess - returns TRUE if string, a, alphabetically occurs before
+             string, b.
+*)
+
+PROCEDURE StrLess (a, b: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   Higha,
+   Highb,
+   i    : CARDINAL ;
+BEGIN
+   Higha := StrLen(a) ;
+   Highb := StrLen(b) ;
+   i := 0 ;
+   WHILE (i<Higha) AND (i<Highb) DO
+      IF a[i]<b[i]
+      THEN
+         RETURN( TRUE )
+      ELSIF a[i]>b[i]
+      THEN
+         RETURN( FALSE )
+      END ;
+      (* must be equal, move on to next character *)
+      INC(i)
+   END ;
+   RETURN( Higha<Highb )    (* substrings are equal so we go on length *)
+END StrLess ;
+
+
+PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   i,
+   Higha,
+   Highb: CARDINAL ;
+   Equal: BOOLEAN ;
+BEGIN
+   Higha := StrLen(a) ;
+   Highb := StrLen(b) ;
+   IF Higha=Highb
+   THEN
+      Equal := TRUE ;
+      i := 0 ;
+      WHILE Equal AND (i<Higha) DO
+         Equal := (a[i]=b[i]) ;
+         INC(i)
+      END ;
+      RETURN( Equal )
+   ELSE
+      RETURN( FALSE )
+   END
+END StrEqual ;
+
+
+PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ;
+VAR
+   High,
+   Len : CARDINAL ;
+BEGIN
+   Len := 0 ;
+   High := HIGH(a) ;
+   WHILE (Len<=High) AND (a[Len]#nul) DO
+      INC(Len)
+   END ;
+   RETURN( Len )
+END StrLen ;
+
+
+PROCEDURE StrCopy (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+VAR
+   Higha,
+   Highb,
+   n    : CARDINAL ;
+BEGIN
+   n := 0 ;
+   Higha := StrLen(a) ;
+   Highb := HIGH(b) ;
+   WHILE (n<Higha) AND (n<=Highb) DO
+      b[n] := a[n] ;
+      INC(n)
+   END ;
+   IF n<=Highb
+   THEN
+      b[n] := nul
+   END
+END StrCopy ;
+
+
+(*
+   IsSubString - returns true if b is a subcomponent of a.
+*)
+
+PROCEDURE IsSubString (a, b: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   i, j,
+   LengthA,
+   LengthB: CARDINAL ;
+BEGIN
+   LengthA := StrLen(a) ;
+   LengthB := StrLen(b) ;
+   i := 0 ;
+   IF LengthA>LengthB
+   THEN
+      WHILE i<=LengthA-LengthB DO
+      	 j := 0 ;
+      	 WHILE (j<LengthB) AND (a[i+j]=b[j]) DO
+      	    INC(j)
+      	 END ;
+      	 IF j=LengthB
+      	 THEN
+      	    RETURN( TRUE )
+      	 ELSE
+      	    INC(i)
+      	 END
+      END
+   END ;
+   RETURN( FALSE )
+END IsSubString ;
+
+
+(*
+   IsWhite - returns TRUE if, ch, is a space or a tab.
+*)
+
+PROCEDURE IsWhite (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN( (ch=' ') OR (ch=tab) )
+END IsWhite ;
+
+
+(*
+   StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+                          space infront of a.
+*)
+
+PROCEDURE StrRemoveWhitePrefix (a: ARRAY OF CHAR; VAR b: ARRAY OF CHAR) ;
+VAR
+   i, j,
+   higha, highb: CARDINAL ;
+BEGIN
+   i := 0 ;
+   j := 0 ;
+   higha := StrLen(a) ;
+   highb := HIGH(b) ;
+   WHILE (i<higha) AND IsWhite(a[i]) DO
+      INC(i)
+   END ;
+   WHILE (i<higha) AND (j<=highb) DO
+      b[j] := a[i] ;
+      INC(i) ;
+      INC(j)
+   END ;
+   IF j<=highb
+   THEN
+      b[j] := nul
+   END
+END StrRemoveWhitePrefix ;
+
+
+END StrLib.
diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp b/gcc/testsuite/gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp
new file mode 100644
index 00000000000..ba0d677b931
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp
@@ -0,0 +1,39 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/pimlib/base/run/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/testconvert.mod b/gcc/testsuite/gm2/pimlib/base/run/pass/testconvert.mod
new file mode 100644
index 00000000000..6e438f7efe0
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/base/run/pass/testconvert.mod
@@ -0,0 +1,57 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testconvert ;
+
+FROM SYSTEM IMPORT ADR ;
+FROM StringConvert IMPORT LongrealToString ;
+FROM DynamicStrings IMPORT String, EqualArray, string ;
+FROM libc IMPORT exit, printf ;
+
+PROCEDURE Assert (b: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL;
+                  message: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d:  assert failed:  %s\n", ADR(f), l, ADR(message)) ;
+      exit(1)
+   END
+END Assert ;
+
+
+VAR
+   s: String ;
+BEGIN
+   s := LongrealToString(-123.0, 8, 3) ;
+   printf("returned value '%s'\n", string(s)) ;
+   Assert(EqualArray(LongrealToString(-123.0, 8, 3), '-123.000'), __FILE__, __LINE__, '-123.000') ;
+   s := LongrealToString(1.0, 4, 2) ;
+   printf("returned value '%s'\n", string(s)) ;
+   Assert(EqualArray(LongrealToString(1.0, 4, 2), '1.00'), __FILE__, __LINE__, '1.00') ;
+   s := LongrealToString(1.0, 4, 3) ;
+   printf("returned value '%s'\n", string(s)) ;
+   Assert(EqualArray(LongrealToString(1.0, 4, 3), '1.00'), __FILE__, __LINE__, '1.00') ;
+   s := LongrealToString(1.0, 6, 3) ;
+   printf("returned value '%s'\n", string(s)) ;
+   Assert(EqualArray(LongrealToString(1.0, 6, 3), ' 1.000'), __FILE__, __LINE__, ' 1.000') ;
+   s := LongrealToString(123.0, 8, 3) ;
+   printf("returned value '%s'\n", string(s)) ;
+   Assert(EqualArray(LongrealToString(123.0, 8, 3), ' 123.000'), __FILE__, __LINE__, ' 123.000') ;
+   s := LongrealToString(-123.0, 6, 3) ;
+   printf("returned value '%s'\n", string(s)) ;
+   Assert(EqualArray(LongrealToString(-123.0, 6, 3), '-123.0'), __FILE__, __LINE__, '-123.0') ;
+END testconvert.
diff --git a/gcc/testsuite/gm2/pimlib/coroutines/pass/pimlib-coroutines-pass.exp b/gcc/testsuite/gm2/pimlib/coroutines/pass/pimlib-coroutines-pass.exp
new file mode 100644
index 00000000000..644dc4396b2
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/coroutines/pass/pimlib-coroutines-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_cor "${srcdir}/gm2/pimlib/coroutines/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/pimlib/coroutines/pass/priority.mod b/gcc/testsuite/gm2/pimlib/coroutines/pass/priority.mod
new file mode 100644
index 00000000000..5553c96a81d
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/coroutines/pass/priority.mod
@@ -0,0 +1,21 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE priority[7] ;
+
+BEGIN
+END priority.
diff --git a/gcc/testsuite/gm2/pimlib/coroutines/pass/priority2.mod b/gcc/testsuite/gm2/pimlib/coroutines/pass/priority2.mod
new file mode 100644
index 00000000000..85f21d32a01
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/coroutines/pass/priority2.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE priority2[7] ;
+
+PROCEDURE p1 ;
+BEGIN
+   p2
+END p1 ;
+
+MODULE inner[0] ;
+
+EXPORT p2 ;
+
+PROCEDURE p2 ;
+BEGIN
+END p2 ;
+
+BEGIN
+END inner ;
+
+BEGIN
+   p1
+END priority2.
diff --git a/gcc/testsuite/gm2/pimlib/coroutines/pass/priority3.def b/gcc/testsuite/gm2/pimlib/coroutines/pass/priority3.def
new file mode 100644
index 00000000000..e40967a5e1c
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/coroutines/pass/priority3.def
@@ -0,0 +1,22 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE priority3 ;
+
+PROCEDURE p1 ;
+
+END priority3.
diff --git a/gcc/testsuite/gm2/pimlib/coroutines/pass/priority3.mod b/gcc/testsuite/gm2/pimlib/coroutines/pass/priority3.mod
new file mode 100644
index 00000000000..2027f45be41
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/coroutines/pass/priority3.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE priority3[7] ;
+
+(* Procedures p3 and p4 do not need to call TurnInterrupts whereas
+   p1 and p2 will need to call TurnInterrupts
+*)
+
+PROCEDURE p1 ;
+BEGIN
+   p2
+END p1 ;
+
+MODULE inner[0] ;
+
+EXPORT p2 ;
+
+PROCEDURE p2 ;
+BEGIN
+END p2 ;
+
+PROCEDURE p3 ;
+BEGIN
+END p3 ;
+
+BEGIN
+END inner ;
+
+PROCEDURE p4 ;
+BEGIN
+END p4 ;
+
+BEGIN
+   p1
+END priority3.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/pass/LogitechLong.mod b/gcc/testsuite/gm2/pimlib/logitech/pass/LogitechLong.mod
new file mode 100644
index 00000000000..9ba50c8d382
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/pass/LogitechLong.mod
@@ -0,0 +1,40 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE LogitechLong;
+
+(***************************************************************************************)
+(*        NOTE: THIS IS TEST CODE AND MAY BE INCORRECT             *)
+(***************************************************************************************)
+
+FROM InOut IMPORT WriteLn;
+
+FROM LongIO IMPORT WriteLongInt;
+
+VAR
+  i,j : LONGINT;
+
+BEGIN
+  i := MAX(LONGINT);
+  WriteLongInt(i,0);
+  WriteLn;
+  j := MIN(LONGINT);
+  WriteLongInt(j,0);
+  WriteLn;
+  j := MIN(LONGINT) + 1;
+  WriteLongInt(j,0);
+  WriteLn
+END LogitechLong.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/pass/hello.mod b/gcc/testsuite/gm2/pimlib/logitech/pass/hello.mod
new file mode 100644
index 00000000000..f6766292c56
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/pass/hello.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE hello ;
+
+FROM InOut IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ; WriteLn
+END hello.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/pass/pimlib-logitech-pass.exp b/gcc/testsuite/gm2/pimlib/logitech/pass/pimlib-logitech-pass.exp
new file mode 100644
index 00000000000..0d5fcfd4e33
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/pass/pimlib-logitech-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_log "${srcdir}/gm2/pimlib/logitech/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/bbits.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/bbits.mod
new file mode 100644
index 00000000000..288d16bdfa1
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/bbits.mod
@@ -0,0 +1,94 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE bbits ;
+
+FROM BitBlockOps IMPORT BlockAnd, BlockOr, BlockXor, BlockNot, BlockShr ;
+FROM SYSTEM IMPORT ADDRESS, BYTE, WORD, SIZE, ADR, SHIFT ;
+FROM libc IMPORT exit, printf ;
+FROM StrLib IMPORT StrEqual ;
+
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+PROCEDURE clear (a: ADDRESS; n: CARDINAL) ;
+VAR
+   p: POINTER TO BYTE ;
+BEGIN
+   p := a ;
+   WHILE n>0 DO
+      p^ := BYTE(0) ;
+      INC(p) ;
+      DEC(n)
+   END
+END clear ;
+
+
+PROCEDURE byteTest ;
+VAR
+   byte: BYTE ;
+BEGIN
+   byte := VAL(BYTE, BITSET{0, 3, 5, 7}) ;
+   BlockShr(ADR(byte), SIZE(byte), 1) ;
+   Assert(byte=VAL(BYTE, BITSET{2, 4, 6}), __FILE__, __LINE__, 'BlockShr on BYTE') ;
+   BlockXor(ADR(byte), ADR(byte), SIZE(byte)) ;
+   Assert(byte=BYTE(0), __FILE__, __LINE__, 'BlockXor on BYTE')   
+END byteTest ;
+
+
+PROCEDURE bitsetTest ;
+VAR
+   bytes : POINTER TO ARRAY [0..SIZE(BITSET)-1] OF BYTE ;
+   bitset: BITSET ;
+BEGIN
+   bytes := ADR(bitset) ;
+   bytes^[0] := BYTE(0A3H) ;
+   bytes^[1] := BYTE(053H) ;
+   bytes^[2] := BYTE(031H) ;
+   bytes^[3] := BYTE(01AH) ;
+
+   BlockShr(ADR(bitset), SIZE(bitset), 1) ;
+
+   Assert(bytes^[0]=BYTE(051H), __FILE__, __LINE__, 'BlockShr on byte[0]') ;
+   Assert(bytes^[1]=BYTE(0A9H), __FILE__, __LINE__, 'BlockShr on byte[1]') ;
+   Assert(bytes^[2]=BYTE(098H), __FILE__, __LINE__, 'BlockShr on byte[2]') ;
+   Assert(bytes^[3]=BYTE(08DH), __FILE__, __LINE__, 'BlockShr on byte[3]') ;
+   BlockXor(ADR(bitset), ADR(bitset), SIZE(bitset)) ;
+   Assert(bitset=BITSET(0), __FILE__, __LINE__, 'BlockXor on BITSET')
+END bitsetTest ;
+
+
+VAR
+   res: INTEGER ;
+BEGIN
+   res := 0 ;
+   byteTest ;
+   bitsetTest ;
+   exit(res)
+END bbits.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/hello.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/hello.mod
new file mode 100644
index 00000000000..f6766292c56
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/hello.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE hello ;
+
+FROM InOut IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ; WriteLn
+END hello.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/helloinout.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/helloinout.mod
new file mode 100644
index 00000000000..df0482fcab7
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/helloinout.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE helloinout ;
+
+FROM InOut IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString('hello world') ; WriteLn
+END helloinout.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/intb.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/intb.mod
new file mode 100644
index 00000000000..db3bac4f736
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/intb.mod
@@ -0,0 +1,88 @@
+(* Copyright (C) 2005 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 2, 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. *)
+
+MODULE intb ;
+
+FROM BitBlockOps IMPORT BlockAnd, BlockOr, BlockXor, BlockNot, BlockShr ;
+FROM SYSTEM IMPORT ADDRESS, BYTE, WORD, SIZE, ADR, SHIFT ;
+FROM libc IMPORT exit, printf ;
+FROM StrLib IMPORT StrEqual ;
+
+TYPE
+   BYTESET = PACKEDSET OF [0..7] ;
+
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+PROCEDURE clear (a: ADDRESS; n: CARDINAL) ;
+VAR
+   p: POINTER TO BYTE ;
+BEGIN
+   p := a ;
+   WHILE n>0 DO
+      p^ := BYTE(0) ;
+      INC(p) ;
+      DEC(n)
+   END
+END clear ;
+
+
+PROCEDURE byteTest ;
+VAR
+   byte, lo: BYTE ;
+BEGIN
+   byte := VAL(BYTE, BYTESET {0, 3, 5, 7}) ;
+   lo := VAL(BYTE, SHIFT(VAL(BYTESET, byte), -1)) ;
+   Assert(lo=VAL(BYTE, BYTESET {2, 4, 6}), __FILE__, __LINE__, 'SHIFT on BYTE') ;
+   lo := VAL(BYTE, SHIFT(VAL(BYTESET, lo), 1)) ;
+   Assert(lo=VAL(BYTE, BYTESET {3, 5, 7}), __FILE__, __LINE__, 'SHIFT on BYTE') ;
+END byteTest ;
+
+
+PROCEDURE bitsetTest ;
+VAR
+   bitset, lo: BITSET ;
+BEGIN
+   bitset := BITSET{0, 3, 5, 7, 30, 31} ;
+   lo := SHIFT(bitset, -1) ;
+   Assert(lo=BITSET{2, 4, 6, 29, 30}, __FILE__, __LINE__, 'SHIFT on BITSET') ;
+   lo := SHIFT(lo, 1) ;
+   Assert(lo=BITSET{3, 5, 7, 30, 31}, __FILE__, __LINE__, 'SHIFT on BITSET') ;
+END bitsetTest ;
+
+
+VAR
+   res: INTEGER ;
+BEGIN
+   res := 0 ;
+   Assert (SIZE (BYTESET) = 1, __FILE__, __LINE__, 'set size should be a byte') ;
+   byteTest ;
+   bitsetTest ;
+   exit(res)
+END intb.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/pimlib-logitech-run-pass.exp b/gcc/testsuite/gm2/pimlib/logitech/run/pass/pimlib-logitech-run-pass.exp
new file mode 100644
index 00000000000..4136d9e0ca3
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/pimlib-logitech-run-pass.exp
@@ -0,0 +1,41 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2log m2pim m2iso"
+gm2_init_log
+
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/realconv.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/realconv.mod
new file mode 100644
index 00000000000..f50f882070f
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/realconv.mod
@@ -0,0 +1,85 @@
+(* Copyright (C) 2005, 2006, 2007, 2008  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 2, 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. *)
+
+MODULE realconv ;
+
+FROM RealConversions IMPORT RealToString, StringToReal ;
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+FROM StrLib IMPORT StrEqual ;
+
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+BEGIN
+   IF v
+   THEN
+      printf("successfully evaluated assertion (%s)\n", ADR(e))
+   ELSE
+      printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1 ;
+      exit(res)
+   END
+END Assert ;
+
+
+VAR
+   d  : REAL ;
+   l  : LONGREAL ;
+   res: INTEGER ;
+   a  : ARRAY [0..100] OF CHAR ;
+   ok : BOOLEAN ;
+BEGIN
+   res := 0 ;
+   RealToString(100.0, 10, 10, a, ok) ;
+   Assert(ok, __FILE__, __LINE__, 'testing ok return BOOLEAN') ;
+   printf("value returned is '%s'\n", ADR(a)) ;
+   Assert(StrEqual('100.000000', a), __FILE__, __LINE__, 'testing return value of "100.000000"') ;
+   RealToString(100.0, -5, 12, a, ok) ;
+   Assert(ok, __FILE__, __LINE__, 'testing ok return BOOLEAN') ;
+   printf("value returned is '%s'\n", ADR(a)) ;
+   Assert(StrEqual('  1.00000E+2', a), __FILE__, __LINE__, 'testing return value of "  1.00000E+2"') ;
+
+   RealToString(123.456789, 10, 10, a, ok) ;
+   Assert(ok, __FILE__, __LINE__, 'testing ok return BOOLEAN') ;
+   printf("value returned is '%s'\n", ADR(a)) ;
+   Assert(StrEqual('123.456789', a), __FILE__, __LINE__, 'testing return value of "123.456789"') ;
+   RealToString(123.456789, -5, 13, a, ok) ;
+   Assert(ok, __FILE__, __LINE__, 'testing ok return BOOLEAN') ;
+   printf("value returned is '%s'\n", ADR(a)) ;
+   Assert(StrEqual('   1.23456E+2', a), __FILE__, __LINE__, 'testing return value of "   1.23456E+2"') ;
+
+   RealToString(123.456789, -2, 15, a, ok) ;
+   Assert(ok, __FILE__, __LINE__, 'testing ok return BOOLEAN') ;
+   printf("value returned is '%s'\n", ADR(a)) ;
+   Assert(StrEqual('        1.23E+2', a), __FILE__, __LINE__, 'testing return value of "        1.23E+2"') ;
+
+   StringToReal('  1234567.89E-4', d, ok) ;
+   Assert(ok, __FILE__, __LINE__, 'testing ok return BOOLEAN') ;
+   printf('value returned is %f\n', d) ;
+
+   RealToString(3.14159268, -6, 13, a, ok) ;
+   Assert(ok, __FILE__, __LINE__, 'testing ok return BOOLEAN') ;
+   printf("value returned is '%s'\n", ADR(a)) ;
+   Assert(StrEqual('  3.141592E+0', a), __FILE__, __LINE__, 'testing return value of "  3.141592E+0"') ;
+
+   RealToString(12345.6789, 5, 20, a, ok) ;
+   Assert(ok, __FILE__, __LINE__, 'testing ok return BOOLEAN') ;
+   printf("value returned is '%s'\n", ADR(a)) ;
+   Assert(StrEqual('         12345.67890', a), __FILE__, __LINE__, 'testing return value of "         12345.67890"') ;
+
+   exit(res)
+END realconv.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput.mod
new file mode 100644
index 00000000000..5ac24d7df77
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput.mod
@@ -0,0 +1,65 @@
+(* Copyright (C) 2009-2020 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 2, 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. *)
+
+MODULE realinput ;
+
+FROM RealInOut IMPORT ReadLongReal ;
+FROM FIO IMPORT FlushBuffer, StdOut, StdIn ;
+FROM PushBackInput IMPORT PutString, PutCh, GetCh ;
+FROM ASCII IMPORT lf ;
+FROM Termbase IMPORT ReadProcedure, AssignRead ;
+FROM libc IMPORT exit, printf ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      FlushBuffer(StdOut) ;
+      printf("%s:%d:regression test failed during execution\n",
+              __FILE__, l) ;
+      exit(1)
+   END
+END Assert ;
+
+
+(*
+   MyRead -
+*)
+
+PROCEDURE MyRead (VAR ch: CHAR) ;
+BEGIN
+   ch := GetCh(StdIn)
+END MyRead ;
+
+
+PROCEDURE Status () : BOOLEAN ;
+BEGIN
+   RETURN( TRUE )
+END Status ;
+
+VAR
+   x : LONGREAL ;
+   ch: CHAR ;
+   ok: BOOLEAN ;
+BEGIN
+   AssignRead(MyRead, Status, ok) ;
+   ch := PutCh(lf) ;
+   PutString("0.0123") ;
+   ReadLongReal(x) ;
+   Assert(x=0.0123, __LINE__)
+END realinput.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput2.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput2.mod
new file mode 100644
index 00000000000..dad857af5a1
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput2.mod
@@ -0,0 +1,65 @@
+(* Copyright (C) 2009-2020 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 2, 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. *)
+
+MODULE realinput2 ;
+
+FROM RealInOut IMPORT ReadReal ;
+FROM FIO IMPORT FlushBuffer, StdOut, StdIn ;
+FROM PushBackInput IMPORT PutString, PutCh, GetCh ;
+FROM ASCII IMPORT lf ;
+FROM Termbase IMPORT ReadProcedure, AssignRead ;
+FROM libc IMPORT exit, printf ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      FlushBuffer(StdOut) ;
+      printf("%s:%d:regression test failed during execution\n",
+              __FILE__, l) ;
+      exit(1)
+   END
+END Assert ;
+
+
+(*
+   MyRead -
+*)
+
+PROCEDURE MyRead (VAR ch: CHAR) ;
+BEGIN
+   ch := GetCh(StdIn)
+END MyRead ;
+
+
+PROCEDURE Status () : BOOLEAN ;
+BEGIN
+   RETURN( TRUE )
+END Status ;
+
+VAR
+   x : REAL ;
+   ch: CHAR ;
+   ok: BOOLEAN ;
+BEGIN
+   AssignRead(MyRead, Status, ok) ;
+   ch := PutCh(lf) ;
+   PutString("0.0123") ;
+   ReadReal(x) ;
+   Assert(x=0.0123, __LINE__)
+END realinput2.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput3.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput3.mod
new file mode 100644
index 00000000000..b242c806bba
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/realinput3.mod
@@ -0,0 +1,65 @@
+(* Copyright (C) 2009-2020 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 2, 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. *)
+
+MODULE realinput3 ;
+
+FROM RealInOut IMPORT ReadReal ;
+FROM FIO IMPORT FlushBuffer, StdOut, StdIn ;
+FROM PushBackInput IMPORT PutString, PutCh, GetCh ;
+FROM ASCII IMPORT lf ;
+FROM Termbase IMPORT ReadProcedure, AssignRead ;
+FROM libc IMPORT exit, printf ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      FlushBuffer(StdOut) ;
+      printf("%s:%d:regression test failed during execution\n",
+              __FILE__, l) ;
+      exit(1)
+   END
+END Assert ;
+
+
+(*
+   MyRead -
+*)
+
+PROCEDURE MyRead (VAR ch: CHAR) ;
+BEGIN
+   ch := GetCh(StdIn)
+END MyRead ;
+
+
+PROCEDURE Status () : BOOLEAN ;
+BEGIN
+   RETURN( TRUE )
+END Status ;
+
+VAR
+   x : REAL ;
+   ch: CHAR ;
+   ok: BOOLEAN ;
+BEGIN
+   AssignRead(MyRead, Status, ok) ;
+   ch := PutCh(lf) ;
+   PutString(" 0.0123") ;
+   ReadReal(x) ;
+   Assert(x=0.0123, __LINE__)
+END realinput3.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/rename.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/rename.mod
new file mode 100644
index 00000000000..70038006714
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/rename.mod
@@ -0,0 +1,47 @@
+(* rename.mod a tiny test program to test the ability to rename a file.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE rename ;
+
+FROM FileSystem IMPORT File, Response, Lookup, Rename, Close, SetWrite ;
+IMPORT FIO ;
+
+VAR
+   f, s: File ;
+BEGIN
+   Lookup (f, "first.txt", TRUE) ;
+   IF f.res = done
+   THEN
+      SetWrite (f) ;
+      FIO.WriteString (f.fio, "hello world") ;
+      FIO.WriteLine (f.fio) ;
+      Close (f) ;
+      Lookup (f, "first.txt", FALSE) ;
+      Rename (f, 'second.txt') ;
+      Lookup (s, "second.txt", FALSE) ;
+      IF s.res = done
+      THEN
+         HALT (0)
+      END
+   ELSE
+      HALT
+   END
+END rename.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/timedate.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/timedate.mod
new file mode 100644
index 00000000000..b46d8e89a82
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/timedate.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2005, 2006, 2007, 2008 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 2, 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. *)
+
+MODULE timedate ;
+
+FROM TimeDate IMPORT Time, GetTime, TimeToString ;
+FROM InOut IMPORT WriteString, WriteLn ;
+FROM Strings IMPORT Length ;
+FROM libc IMPORT exit ;
+
+VAR
+   t: Time ;
+   s: ARRAY [0..30] OF CHAR ;
+BEGIN
+   GetTime(t) ;
+   TimeToString(t, s) ;
+   WriteString(s) ; WriteLn ;
+   IF Length(s)#19
+   THEN
+      exit(1)
+   END
+END timedate.
diff --git a/gcc/testsuite/gm2/pimlib/logitech/run/pass/writeoct.mod b/gcc/testsuite/gm2/pimlib/logitech/run/pass/writeoct.mod
new file mode 100644
index 00000000000..78cadfca4a5
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/logitech/run/pass/writeoct.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE writeoct ;
+
+IMPORT InOut ;
+
+BEGIN
+   InOut.WriteString('8 in base 8 is: ') ;
+   InOut.WriteOct(8, 3) ; InOut.WriteLn
+END writeoct.
diff --git a/gcc/testsuite/gm2/pimlib/pass/pimlib-pass.exp b/gcc/testsuite/gm2/pimlib/pass/pimlib-pass.exp
new file mode 100644
index 00000000000..3cd4d77fff4
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/pass/pimlib-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2004-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_log
+
+foreach testcase [lsort [glob -nocomplain $srcdir/../gm2/gm2-libs-pim/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/format.mod b/gcc/testsuite/gm2/pimlib/run/pass/format.mod
new file mode 100644
index 00000000000..92d2d74e260
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/format.mod
@@ -0,0 +1,98 @@
+(* Copyright (C) 2019 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.  *)
+
+MODULE format ;  (*!m2pim+gm2*)
+
+FROM DynamicStrings IMPORT String, ConCat, InitString, EqualArray, KillString, string ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2 ;
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADDRESS, ADR ;
+
+
+(*
+   checkDelete -
+*)
+
+PROCEDURE checkDelete (s: String; a: ARRAY OF CHAR) ;
+VAR
+   s1    : String ;
+   c1, c2: ADDRESS ;
+BEGIN
+   c2 := string (s) ;
+   s1 := InitString (a) ;
+   c1 := string (s1) ;
+   IF EqualArray (s, a)
+   THEN
+      printf ("string test passed, '%s' correcly seen '%s'\n", c1, c2)
+   ELSE
+      printf ("string test failed, expecting '%s' and seen '%s'\n", c1, c2) ;
+      r := 1 ;
+   END ;
+   s1 := KillString (s1) ;
+   s := KillString (s) ;
+END checkDelete ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   s   : String ;
+   i, j: INTEGER ;
+   ch  : CHAR ;
+BEGIN
+   s := Sprintf0 (InitString ("abc")) ;
+   checkDelete (s, "abc") ;
+   s := Sprintf0 (InitString ("%%")) ;
+   checkDelete (s, "%") ;
+   s := Sprintf0 (InitString ("%%%%")) ;
+   checkDelete (s, "%%") ;
+   s := Sprintf0 (InitString ("%z")) ;
+   checkDelete (s, "z") ;
+   i := 1 ;
+   s := Sprintf1 (InitString ("%d"), i) ;
+   checkDelete (s, "1") ;
+   i := 12 ;
+   s := Sprintf1 (InitString ("%d"), i) ;
+   checkDelete (s, "12") ;
+   i := 123 ;
+   s := Sprintf1 (InitString ("%d"), i) ;
+   checkDelete (s, "123") ;
+   i := 1 ;
+   j := 2 ;
+   s := Sprintf2 (InitString ("%d %d"), i, j) ;
+   checkDelete (s, "1 2") ;
+   s := Sprintf2 (InitString ("%% %d %d"), i, j) ;
+   checkDelete (s, "% 1 2") ;
+   ch := 'a' ;
+   s := Sprintf1 (InitString ("%c"), ch) ;
+   checkDelete (s, "a") ;
+   s := Sprintf2 (InitString ("%c%c"), ch, ch) ;
+   checkDelete (s, "aa")
+END test ;
+
+
+VAR
+   r: INTEGER ;
+BEGIN
+   r := 0 ;
+   test ;
+   exit (r)
+END format.
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/limittests.c b/gcc/testsuite/gm2/pimlib/run/pass/limittests.c
new file mode 100644
index 00000000000..92a79ae3416
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/limittests.c
@@ -0,0 +1,16 @@
+#include <math.h>
+#include <stdio.h>
+
+int main ()
+{
+  double a = 1.0/0.0;
+
+  if (! isfinite (a))
+    printf ("infinity detected\n");
+
+  a = 1.0/1.0;
+
+  if (isfinite (a))
+    printf ("number is now finite\n");
+  return 0;
+}
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/limittests.mod b/gcc/testsuite/gm2/pimlib/run/pass/limittests.mod
new file mode 100644
index 00000000000..92b78891bdb
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/limittests.mod
@@ -0,0 +1,68 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE limittests ;
+
+FROM Builtins IMPORT isfinite ;
+FROM FpuIO IMPORT WriteLongReal, LongRealToStr ;
+FROM StrLib IMPORT StrEqual ;
+FROM libc IMPORT exit, printf ;
+FROM StrIO IMPORT WriteLn ;
+FROM FIO IMPORT FlushBuffer, StdOut ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      FlushBuffer (StdOut) ;
+      printf ("%s:%d:regression test failed during execution\n",
+              __FILE__, l) ;
+      r := 1
+   END
+END Assert ;
+
+
+VAR
+   a: REAL;
+   r: INTEGER ;
+BEGIN
+   r := 0 ;
+   a := 1.0 / 0.0 ;
+   IF NOT isfinite (a)
+   THEN
+      printf ("detected infinite number\n")
+   ELSE
+      printf ("failed to detect infinite number\n") ;
+      r := 1
+   END ;
+   a := 1.0 / 1.0 ;
+   IF isfinite (a)
+   THEN
+      printf ("detected finite number\n")
+   ELSE
+      printf ("failed to detect finite number\n") ;
+      r := 2
+   END ;
+   IF r = 0
+   THEN
+      printf ("all tests passed\n")
+   END ;
+   exit (r)
+
+END limittests.
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/longreal.mod b/gcc/testsuite/gm2/pimlib/run/pass/longreal.mod
new file mode 100644
index 00000000000..8d8222c861d
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/longreal.mod
@@ -0,0 +1,54 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE longreal ;
+
+FROM StringConvert IMPORT LongrealToString ;
+FROM DynamicStrings IMPORT String, EqualArray, string ;
+FROM libc IMPORT exit, printf ;
+
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      printf("%s:%d:regression test failed during execution\n",
+              __FILE__, l) ;
+      exit(1)
+   END
+END Assert ;
+
+
+VAR
+   s: String ;
+   r: REAL ;
+   l: LONGREAL ;
+BEGIN
+   r := 0.0123 ;
+   s := LongrealToString(r, 8, 8) ;
+   Assert(EqualArray(s, '0.012300'), __LINE__) ;
+   printf("printf converting 0.0123 = %g\n", r);
+   printf("result should be 0.012300 = %s\n", string(s)) ;
+   l := 0.0123 ;
+   s := LongrealToString(l, 8, 8) ;
+   printf("result should be 0.012300 = %s\n", string(s)) ;
+   Assert(EqualArray(s, '0.012300'), __LINE__) ;
+   s := LongrealToString(0.0123, 8, 8) ;
+   Assert(EqualArray(s, '0.012300'), __LINE__) ;
+   printf("result should be 0.012300 = %s\n", string(s)) ;
+   Assert(EqualArray(s, '0.012300'), __LINE__) ;
+END longreal.
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/pimlib-run-pass.exp b/gcc/testsuite/gm2/pimlib/run/pass/pimlib-run-pass.exp
new file mode 100644
index 00000000000..d88caa2d3e6
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/pimlib-run-pass.exp
@@ -0,0 +1,41 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2pim m2log m2iso"
+gm2_init_log
+
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/test.c b/gcc/testsuite/gm2/pimlib/run/pass/test.c
new file mode 100644
index 00000000000..d050c863a7d
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/test.c
@@ -0,0 +1,16 @@
+#include <math.h>
+#include <stdio.h>
+
+extern double a;
+
+int main ()
+{
+  if (! isfinite (a))
+    printf ("infinity detected\n");
+
+  a = 1.0/1.0;
+
+  if (isfinite (a))
+    printf ("number is now finite\n");
+  return 0;
+}
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/testreal.mod b/gcc/testsuite/gm2/pimlib/run/pass/testreal.mod
new file mode 100644
index 00000000000..70026eec93f
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/testreal.mod
@@ -0,0 +1,50 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testreal ;
+
+FROM FpuIO IMPORT WriteLongReal, LongRealToStr ;
+FROM StrLib IMPORT StrEqual ;
+FROM libc IMPORT exit, printf ;
+FROM StrIO IMPORT WriteLn ;
+FROM FIO IMPORT FlushBuffer, StdOut ;
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      FlushBuffer(StdOut) ;
+      printf("%s:%d:regression test failed during execution\n",
+              __FILE__, l) ;
+      exit(1)
+   END
+END Assert ;
+
+VAR
+   a: LONGREAL;
+   s: ARRAY [0..20] OF CHAR ;
+BEGIN
+   a := 0.1 ;
+   WriteLongReal(a,15,11) ; WriteLn ;
+   LongRealToStr(a, 15, 11, s) ;
+   Assert(StrEqual(s, '  0.10000000000'), __LINE__) ;
+
+   a := 0.25 ;
+   WriteLongReal(a,15,11) ; WriteLn ;
+   LongRealToStr(a, 15, 11, s) ;
+   Assert(StrEqual(s, '  0.25000000000'), __LINE__)
+END testreal.
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/testreal2.mod b/gcc/testsuite/gm2/pimlib/run/pass/testreal2.mod
new file mode 100644
index 00000000000..42c558caef4
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/testreal2.mod
@@ -0,0 +1,93 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testreal2 ;
+
+FROM FpuIO IMPORT WriteLongReal, LongRealToStr ;
+FROM StrLib IMPORT StrEqual ;
+FROM libc IMPORT exit, printf ;
+FROM StrIO IMPORT WriteLn ;
+FROM FIO IMPORT FlushBuffer, StdOut ;
+
+PROCEDURE Assert (b: BOOLEAN; l: CARDINAL) ;
+BEGIN
+   IF NOT b
+   THEN
+      FlushBuffer(StdOut) ;
+      printf("%s:%d:regression test failed during execution\n",
+              __FILE__, l) ;
+      r := 1
+   END
+END Assert ;
+
+VAR
+   a: LONGREAL;
+   s: ARRAY [0..20] OF CHAR ;
+   r: INTEGER ;
+BEGIN
+   r := 0 ;
+
+   a := -0.01 ;
+   WriteLongReal(a, 5, 2) ; WriteLn ;
+   LongRealToStr(a, 5, 2, s) ;
+   Assert(StrEqual(s, '-0.01'), __LINE__) ;
+
+   a := 0.1 ;
+   WriteLongReal(a,15,11) ; WriteLn ;
+   LongRealToStr(a, 15, 11, s) ;
+   Assert(StrEqual(s, '  0.10000000000'), __LINE__) ;
+
+   a := 0.01 ;
+   WriteLongReal(a, 5, 2) ; WriteLn ;
+   LongRealToStr(a, 5, 2, s) ;
+   Assert(StrEqual(s, ' 0.01'), __LINE__) ;
+
+   a := 0.000000001 ;
+   WriteLongReal(a, 11, 9) ; WriteLn ;
+   LongRealToStr(a, 11, 9, s) ;
+   Assert(StrEqual(s, '0.000000001'), __LINE__) ;
+
+   a := 0.00000001 ;
+   WriteLongReal(a, 10, 8) ; WriteLn ;
+   LongRealToStr(a, 10, 8, s) ;
+   Assert(StrEqual(s, '0.00000001'), __LINE__) ;
+
+   a := 0.25 ;
+   WriteLongReal(a,15,11) ; WriteLn ;
+   LongRealToStr(a, 15, 11, s) ;
+   Assert(StrEqual(s, '  0.25000000000'), __LINE__) ;
+
+   a := 0.12 ;
+   WriteLongReal(a, 5, 2) ; WriteLn ;
+   LongRealToStr(a, 5, 2, s) ;
+   Assert(StrEqual(s, ' 0.12'), __LINE__) ;
+
+   a := 0.001 ;
+   WriteLongReal(a, 6, 3) ; WriteLn ;
+   LongRealToStr(a, 6, 3, s) ;
+   Assert(StrEqual(s, ' 0.001'), __LINE__) ;
+
+   a := 0.0001 ;
+   WriteLongReal(a, 7, 4) ; WriteLn ;
+   LongRealToStr(a, 7, 4, s) ;
+   Assert(StrEqual(s, ' 0.0001'), __LINE__) ;
+
+   a := 0.00001 ;
+   WriteLongReal(a, 8, 5) ; WriteLn ;
+   LongRealToStr(a, 8, 5, s) ;
+   Assert(StrEqual(s, ' 0.00001'), __LINE__) ;
+END testreal2.
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/testreal4.mod b/gcc/testsuite/gm2/pimlib/run/pass/testreal4.mod
new file mode 100644
index 00000000000..29c33867cb9
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/testreal4.mod
@@ -0,0 +1,64 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE testreal4 ;
+
+FROM InOut IMPORT WriteLn, WriteString ;
+FROM RealConversions IMPORT SetNoOfExponentDigits,
+                            LongRealToString ;
+FROM StrLib IMPORT StrEqual ;
+
+
+PROCEDURE Assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      WriteString('assertion failed') ; WriteLn ;
+      r := 1
+   END
+END Assert ;
+
+
+VAR
+   s: ARRAY [0..40] OF CHAR ;
+   ok: BOOLEAN ;
+   r : INTEGER ;
+BEGIN
+   r := 0 ;
+   SetNoOfExponentDigits(3) ;
+   LongRealToString(0.0123456789, -8, 15, s, ok) ;
+   Assert(StrEqual(s, '1.23456789E-002') AND ok) ;
+   IF ok
+   THEN
+      WriteString(s) ; WriteLn
+   END ;
+   IF NOT StrEqual(s, '1.23456789E-002')
+   THEN
+      WriteString('expecting 1.23456789E-002 and received ') ; WriteString(s) ; WriteLn
+   END ;
+   LongRealToString(1.23456789, -8, 15, s, ok) ;
+   Assert(StrEqual(s, '1.23456789E+000') AND ok) ;
+   IF ok
+   THEN
+      WriteString(s) ; WriteLn
+   END ;
+   IF NOT StrEqual(s, '1.23456789E+000')
+   THEN
+      WriteString('expecting 1.23456789E+000 and received ') ; WriteString(s) ; WriteLn
+   END ;
+   HALT(r)
+END testreal4.
diff --git a/gcc/testsuite/gm2/projects/README b/gcc/testsuite/gm2/projects/README
new file mode 100644
index 00000000000..bc6bbf6968a
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/README
@@ -0,0 +1,3 @@
+Tests under here provide confidence that basic linking works for small
+projects.  There are projects to link against the core pim, pim and iso
+libraries.
diff --git a/gcc/testsuite/gm2/projects/iso/run/pass/halma/halma.mod b/gcc/testsuite/gm2/projects/iso/run/pass/halma/halma.mod
new file mode 100644
index 00000000000..a56928f5602
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/run/pass/halma/halma.mod
@@ -0,0 +1,1952 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE halma ;
+
+FROM STextIO IMPORT WriteString, WriteLn, WriteChar, ReadToken, SkipLine ;
+FROM SWholeIO IMPORT WriteCard, WriteInt ;
+FROM Strings IMPORT Length ;
+FROM Selective IMPORT Timeval, GetTimeOfDay, GetTime, InitTime, KillTime ;
+FROM WholeStr IMPORT StrToCard, ConvResults ;
+FROM SYSTEM IMPORT CARDINAL8 ;
+
+CONST
+   TwoPlayer      =            TRUE ;
+   FourPlayer     =           FALSE ;
+   BoardX         =              16 ;
+   BoardY         =              16 ;
+   BoardSize      = BoardX * BoardY ;
+   Pieces         =              19 ;   (* total pieces per player on the board  *)
+   PieceHeap      =            4000 ;   (* maximum moves we will examine per ply *)
+   MaxScore       =          100000 ;
+   MinScore       =         -100000 ;
+   WinScore       =        MaxScore ;
+   LooseScore     =       -WinScore ;
+   Debugging      =           FALSE ;
+   Thinking       =              10 ;   (* how many seconds can the program think? *)
+   slowEvaluation =           FALSE ;
+   HomeWeight     =          BoardX ;
+
+TYPE
+   Squares = [0..BoardSize-1] ;
+   SoS     = SET OF Squares ;
+   Colour  = (Blue, Red, Green, White) ;
+
+   Board = RECORD
+              used  : SoS ;   (* is the square used at all? *)
+              colour: ARRAY [0..1] OF SoS ;   (* if so which colour occupies the square? *)
+              pieces: ARRAY [MIN(Colour)..MAX(Colour)] OF ARRAY [1..Pieces] OF CARDINAL8 ;
+              home  : ARRAY [MIN(Colour)..MAX(Colour)] OF CARDINAL ;
+           END ;
+
+   Moves = RECORD
+              pieceHead: ARRAY [0..Pieces] OF CARDINAL ;      (* pieceHead[0] is start of peg 1 moves in the heap *)
+              pieceList: ARRAY [0..PieceHeap] OF CARDINAL8 ;  (* pieceHead[1] is start of peg 2 moves in the heap *)
+           END ;
+
+   Reachable = RECORD
+                  no  : CARDINAL ;
+                  prev: CARDINAL ;
+                  dist: CARDINAL ;
+                  list: ARRAY Squares OF CARDINAL ;
+               END ;
+
+   Graph = RECORD
+              graph: ARRAY Squares OF Reachable ;
+           END ;
+
+VAR
+   count   : CARDINAL ;
+   homeBase: ARRAY [MIN(Colour)..MAX(Colour)] OF SoS ;
+
+
+(*
+   +-----------------------------------------------------------------+
+   | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 |
+   |                                                                 |
+   | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 |
+   |                                                                 |
+   | 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 |
+   |                                                                 |
+   | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 |
+   |                                                                 |
+   | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 |
+   |                                                                 |
+   | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 |
+   |                                                                 |
+   | 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 |
+   |                                                                 |
+   | 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 |
+   |                                                                 |
+   | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
+   |                                                                 |
+   |  96  97  98  99 100 101 102 103 104 105 106 107 108 109 110 111 |
+   |                                                                 |
+   |  80  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95 |
+   |                                                                 |
+   |  64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79 |
+   |---------                                                        |
+   |  48  49 \50  51  52  53  54  55  56  57  58  59  60  61  62  63 |
+   |           \                                                     |
+   |  32  33  34 \35  36  37  38  39  40  41  42  43  44  45  46  47 |
+   |               \                                                 |
+   |  16  17  18  19| 20  21  22  23  24  25  26  27  28  29  30  31 |
+   |                |                                                |
+   |   0   1   2   3|  4   5   6   7   8   9  10  11  12  13  14  15 |
+   +-----------------------------------------------------------------+
+*)
+
+
+(*
+   stop -
+*)
+
+PROCEDURE stop ;
+BEGIN
+END stop ;
+
+
+(*
+   Min -
+*)
+
+PROCEDURE Min (a, b: INTEGER) : INTEGER ;
+BEGIN
+   IF a<b
+   THEN
+      RETURN( a )
+   ELSE
+      RETURN( b )
+   END
+END Min ;
+
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      WriteString('assert failed') ; WriteLn ;
+      HALT
+   END
+END assert ;
+
+
+(*
+   initGraph - initialise, g, to empty.
+*)
+
+PROCEDURE initGraph (VAR g: Graph) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   FOR i := MIN(Squares) TO MAX(Squares) DO
+      g.graph[i].no   := 0 ;
+      g.graph[i].prev := MAX(Squares)+1 ;
+      g.graph[i].dist := MAX(Squares)+1
+   END
+END initGraph ;
+
+
+(*
+   isUsed - return whether a square, p, is in use on board, b.
+*)
+
+PROCEDURE isUsed (VAR b: Board; p: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN p IN b.used
+END isUsed ;
+
+
+(*
+   isColour - return TRUE if a square, p, is used and contains a
+              piece of colour, c.
+*)
+
+PROCEDURE isColour (VAR b: Board; p: CARDINAL; c: Colour) : BOOLEAN ;
+BEGIN
+   WITH b DO
+      IF p IN used
+      THEN
+         CASE c OF
+
+         Blue:  RETURN (NOT (p IN colour[0])) AND (NOT (p IN colour[1])) |
+         Red :  RETURN (p IN colour[0]) AND (NOT (p IN colour[1])) |
+         Green: RETURN (NOT (p IN colour[0])) AND (p IN colour[1]) |
+         White: RETURN (p IN colour[0]) AND (p IN colour[1])
+
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END isColour ;
+
+
+(*
+   dumpBase -
+*)
+
+PROCEDURE dumpBase (c: Colour) ;
+VAR
+   n, i: CARDINAL ;
+BEGIN
+   WriteString('dumpBase(c) where ORD(c)=') ; WriteCard(ORD(c), 3) ; WriteLn ;
+   n := 0 ;
+   FOR i := 0 TO MAX(Squares) DO
+      IF (n>0) AND ((n MOD 16) = 0)
+      THEN
+         WriteLn
+      END ;
+      IF i IN homeBase[c]
+      THEN
+         WriteChar('1')
+      ELSE
+         WriteChar('0')
+      END ;
+      INC(n)
+   END ;
+   WriteLn
+END dumpBase ;
+
+
+
+(*
+   addPiece - adds a piece, pos, of colour, c, to the board, b.
+*)
+
+PROCEDURE addPiece (VAR b: Board; pos: CARDINAL; c: Colour; piece: CARDINAL) ;
+BEGIN
+(*
+VAR
+   i: CARDINAL ;
+
+   IF pos IN homeBase[c]
+   THEN
+      WriteString('found ') ; WriteCard(pos, 3) ; WriteString(' in homeBase[c]') ;
+      WriteLn ;
+      dumpBase(c)
+   END ;
+*)
+
+   WITH b DO
+      INCL(used, pos) ;
+      CASE c OF
+
+      Blue:  EXCL(colour[0], pos) ;
+             EXCL(colour[1], pos) |
+      Red :  INCL(colour[0], pos) ;
+             EXCL(colour[1], pos) |
+      Green: EXCL(colour[0], pos) ;
+             INCL(colour[1], pos) |
+      White: INCL(colour[0], pos) ;
+             INCL(colour[1], pos)
+
+      END ;
+      pieces[c][piece] := pos ;
+      IF pos IN homeBase[c]
+      THEN
+         INC(home[c])
+      END
+   END
+END addPiece ;
+
+
+(*
+   subPiece - removes a piece at, pos, from the board, b.
+*)
+
+PROCEDURE subPiece (VAR b: Board; pos: CARDINAL; c: Colour) ;
+BEGIN
+   WITH b DO
+      EXCL(used, pos) ;
+      IF pos IN homeBase[c]
+      THEN
+         DEC(home[c])
+      END
+   END
+END subPiece ;
+
+
+(*
+   ifFreeAdd -
+*)
+
+PROCEDURE ifFreeAdd (condition: BOOLEAN; VAR b: Board; t: INTEGER; p: CARDINAL; c: Colour; VAR m: Moves) ;
+BEGIN
+   IF condition AND (NOT isUsed(b, t)) AND (NOT isRecorded(m, t, p))
+   THEN
+      recordMove(m, t, p)
+   END
+END ifFreeAdd ;
+
+
+(*
+   recordMove - adds tile, t, to piece, p, list of moves.
+*)
+
+PROCEDURE recordMove (VAR m: Moves; t: INTEGER; p: CARDINAL) ;
+BEGIN
+   WITH m DO
+      pieceList[pieceHead[p]] := t ;
+      INC(pieceHead[p])
+   END
+END recordMove ;
+
+
+(*
+   isRecorded - returns TRUE if tile, t, has been already entered as a
+                possible move for piece, p, on move list, m.
+*)
+
+PROCEDURE isRecorded (VAR m: Moves; t: INTEGER; p: CARDINAL) : BOOLEAN ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH m DO
+      j := pieceHead[p] ;
+      i := pieceHead[p-1]+1 ;
+      WHILE i<j DO
+         IF pieceList[i] = VAL (CARDINAL8, t)
+         THEN
+            RETURN( TRUE )
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( FALSE )
+END isRecorded ;
+
+
+(*
+   addSingle - adds a single move from a piece, testing all eight one square
+               moves.
+*)
+
+PROCEDURE addSingle (VAR b: Board; VAR m: Moves; c: Colour; p: CARDINAL) ;
+VAR
+   t   : INTEGER ;
+   x, y: INTEGER ;
+BEGIN
+   WITH b DO
+      t := VAL(INTEGER, pieces[c][p]) ;
+      x := t MOD BoardX ;
+      y := t DIV BoardX ;
+      (* vertical and horizontal *)
+
+      ifFreeAdd(x>0, b, t-1, p, c, m) ;                                  (* -1,  0 *)
+      ifFreeAdd(x<BoardX-1, b, t+1, p, c, m) ;                           (*  1,  0 *)
+      ifFreeAdd(y>0, b, t-BoardX, p, c, m) ;                             (*  0, -1 *)
+      ifFreeAdd(y<BoardY-1, b, t+BoardX, p, c, m) ;                      (*  0,  1 *)
+
+      (* diagonals *)
+      ifFreeAdd((x>0) AND (y>0), b, t-(BoardX+1), p, c, m) ;             (* -1, -1 *)
+      ifFreeAdd((x<BoardX-1) AND (y<BoardY-1), b, t+BoardX+1, p, c, m) ; (*  1,  1 *)
+
+      ifFreeAdd((x<BoardX-1) AND (y>0), b, t-(BoardX-1), p, c, m) ;      (*  1, -1 *)
+      ifFreeAdd((x>0) AND (y<BoardY-1), b, t+(BoardX-1), p, c, m)        (* -1,  1 *)
+   END
+END addSingle ;
+
+
+(*
+   addMultipleV -
+*)
+
+PROCEDURE addMultipleV (VAR b: Board; VAR m: Moves; c: Colour; p: CARDINAL; x, y, i, j: INTEGER) ;
+VAR
+   t   : CARDINAL ;
+   d, e: INTEGER ;
+BEGIN
+   d := 1 ;
+   IF i=0
+   THEN
+      IF j>0
+      THEN
+         e := (BoardY-y) DIV 2
+      ELSIF j<0
+      THEN
+         e := y DIV 2
+      END
+   ELSIF j=0
+   THEN
+      IF i>0
+      THEN
+         e := (BoardX-x) DIV 2
+      ELSIF i<0
+      THEN
+         e := x DIV 2
+      END
+   ELSE
+      IF (i=1) AND (j=1)
+      THEN
+         e := Min((BoardX-x) DIV 2, (BoardY-y) DIV 2)
+      ELSIF (i=-1) AND (j=1)
+      THEN
+         e := Min(x DIV 2, (BoardY-y) DIV 2)
+      ELSIF (i=-1) AND (j=-1)
+      THEN
+         e := Min(x DIV 2, y DIV 2)
+      ELSE
+         (* 1, -1 *)
+         e := Min((BoardX-x) DIV 2, y DIV 2)
+      END
+   END ;
+   LOOP
+      IF d>e
+      THEN
+         (* no point searching further as there is no room for the reflective jump *)
+         RETURN
+      END ;
+      x := x + i ;
+      y := y + j ;
+      IF (x<0) OR (y<0) OR (x>=BoardX) OR (y>=BoardY)
+      THEN
+         RETURN
+      END ;
+      t := VAL(CARDINAL, y)*BoardX+VAL(CARDINAL, x) ;
+      IF isUsed(b, t)
+      THEN
+         (* found pivot, keep looking for the destination *)
+         WHILE d>0 DO
+            x := x + i ;
+            y := y + j ;
+         (*
+            IF i>=0
+            THEN
+               INC(x, i)
+            ELSE
+               DEC(x, -i)
+            END ;
+            IF j>=0
+            THEN
+               INC(y, j)
+            ELSE
+               DEC(y, -j)
+            END ;
+         *)
+            IF (x<0) OR (y<0) OR (x>=BoardX) OR (y>=BoardY)
+            THEN
+               RETURN
+            END ;
+            t := VAL(CARDINAL, y)*BoardX+VAL(CARDINAL, x) ;
+            IF isUsed(b, t)
+            THEN
+               RETURN
+            END ;
+            DEC(d)
+         END ;
+         IF NOT isRecorded(m, t, p)
+         THEN
+            IF Debugging
+            THEN
+               WriteString('adding move ') ; WriteCard(t, 0) ; WriteLn
+            END ;
+            recordMove(m, t, p)
+         END ;
+         RETURN
+      END ;
+      INC(d)
+   END
+END addMultipleV ;
+
+
+(*
+   addMultiple - adds moves which involve jumping.  Current peg, p, is at at position
+                 indicated by, m.pieceList[low].
+*)
+
+PROCEDURE addMultiple (VAR b: Board; VAR m: Moves; c: Colour; p: CARDINAL; low: CARDINAL) ;
+VAR
+   t   : INTEGER ;
+   x, y: INTEGER ;
+BEGIN
+   WITH b DO
+      WHILE low<m.pieceHead[p] DO
+         t := VAL(INTEGER, m.pieceList[low]) ;
+         x := t MOD BoardX ;
+         y := t DIV BoardX ;
+         addMultipleV(b, m, c, p, x, y, -1,  0) ;
+         addMultipleV(b, m, c, p, x, y, -1,  1) ;
+         addMultipleV(b, m, c, p, x, y, -1, -1) ;
+
+         addMultipleV(b, m, c, p, x, y,  1,  0) ;
+         addMultipleV(b, m, c, p, x, y,  1,  1) ;
+         addMultipleV(b, m, c, p, x, y,  1, -1) ;
+
+         addMultipleV(b, m, c, p, x, y,  0,  1) ;
+         addMultipleV(b, m, c, p, x, y,  0, -1) ;
+         INC(low)
+      END
+   END
+END addMultiple ;
+
+
+(*
+   genMove - generate the moves for peg, p.
+*)
+
+PROCEDURE genMove (VAR b: Board; VAR m: Moves; c: Colour; p: CARDINAL) ;
+BEGIN
+   m.pieceHead[p] := m.pieceHead[p-1] ;
+   recordMove(m, b.pieces[c][p], p) ;
+   (* record the current position so we can ignore moving back to it *)
+   addMultiple(b, m, c, p, m.pieceHead[p]-1) ;
+   addSingle(b, m, c, p)
+END genMove ;
+
+
+(*
+   genMoves - generate the list of moves for colour, c, on board, b.
+              The board, b, is unaltered despite being passed by reference.
+*)
+
+PROCEDURE genMoves (VAR b: Board; VAR m: Moves; c: Colour) ;
+VAR
+   pos,
+   peg: CARDINAL ;
+BEGIN
+   m.pieceHead[0] := 0 ;
+   FOR peg := 1 TO Pieces DO
+      pos := b.pieces[c][peg] ;
+      subPiece(b, pos, c) ;     (* remove this peg while jumping (so we dont jump over ourself) *)
+      genMove(b, m, c, peg) ;
+      addPiece(b, pos, c, peg)  (* restore the peg *)
+   END
+END genMoves ;
+
+
+(*
+   addToGraph -
+*)
+
+PROCEDURE addToGraph (VAR g: Graph; from, to: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WITH g.graph[from] DO
+      i := 0 ;
+      WHILE i<no DO
+         IF list[i]=to
+         THEN
+            RETURN
+         ELSE
+            INC(i)
+         END
+      END ;
+      list[no] := to ;
+      INC(no)
+   END
+END addToGraph ;
+
+
+(*
+   ifFreeRecord -
+*)
+
+PROCEDURE ifFreeRecord (condition: BOOLEAN; VAR b: Board; t: INTEGER; p: CARDINAL;
+                        c: Colour; VAR m: Moves; from: CARDINAL; VAR g: Graph) ;
+BEGIN
+   IF condition AND (NOT isUsed(b, t)) AND (NOT isRecorded(m, t, p))
+   THEN
+      recordMove(m, t, p) ;
+      addToGraph(g, from, t)
+   END
+END ifFreeRecord ;
+
+
+(*
+   recordSingle - adds a single move from a piece, testing all eight one square
+                  moves.
+*)
+
+PROCEDURE recordSingle (VAR b: Board; VAR m: Moves; c: Colour;
+                        p: CARDINAL; from: CARDINAL; VAR g: Graph) ;
+VAR
+   t   : INTEGER ;
+   x, y: INTEGER ;
+BEGIN
+   WITH b DO
+      t := VAL(INTEGER, pieces[c][p]) ;
+      x := t MOD BoardX ;
+      y := t DIV BoardX ;
+      (* vertical and horizontal *)
+
+      ifFreeRecord(x>0, b, t-1, p, c, m, from, g) ;                                  (* -1,  0 *)
+      ifFreeRecord(x<BoardX-1, b, t+1, p, c, m, from, g) ;                           (*  1,  0 *)
+      ifFreeRecord(y>0, b, t-BoardX, p, c, m, from, g) ;                             (*  0, -1 *)
+      ifFreeRecord(y<BoardY-1, b, t+BoardX, p, c, m, from, g) ;                      (*  0,  1 *)
+
+      (* diagonals *)
+      ifFreeRecord((x>0) AND (y>0), b, t-(BoardX+1), p, c, m, from, g) ;             (* -1, -1 *)
+      ifFreeRecord((x<BoardX-1) AND (y<BoardY-1), b, t+BoardX+1, p, c, m, from, g) ; (*  1,  1 *)
+
+      ifFreeRecord((x<BoardX-1) AND (y>0), b, t-(BoardX-1), p, c, m, from, g) ;      (*  1, -1 *)
+      ifFreeRecord((x>0) AND (y<BoardY-1), b, t+(BoardX-1), p, c, m, from, g)        (* -1,  1 *)
+   END
+END recordSingle ;
+
+
+(*
+   recordMultipleV -
+*)
+
+PROCEDURE recordMultipleV (VAR b: Board; VAR m: Moves; c: Colour;
+                           p: CARDINAL; x, y, i, j: INTEGER;
+                           from: CARDINAL; VAR g: Graph) ;
+VAR
+   t   : CARDINAL ;
+   d, e: INTEGER ;
+BEGIN
+   d := 1 ;
+   IF i=0
+   THEN
+      IF j>0
+      THEN
+         e := (BoardY-y) DIV 2
+      ELSIF j<0
+      THEN
+         e := y DIV 2
+      END
+   ELSIF j=0
+   THEN
+      IF i>0
+      THEN
+         e := (BoardX-x) DIV 2
+      ELSIF i<0
+      THEN
+         e := x DIV 2
+      END
+   ELSE
+      IF (i=1) AND (j=1)
+      THEN
+         e := Min((BoardX-x) DIV 2, (BoardY-y) DIV 2)
+      ELSIF (i=-1) AND (j=1)
+      THEN
+         e := Min(x DIV 2, (BoardY-y) DIV 2)
+      ELSIF (i=-1) AND (j=-1)
+      THEN
+         e := Min(x DIV 2, y DIV 2)
+      ELSE
+         (* 1, -1 *)
+         e := Min((BoardX-x) DIV 2, y DIV 2)
+      END
+   END ;
+   LOOP
+      IF d>e
+      THEN
+         (* no point searching further as there is no room for the reflective jump *)
+         RETURN
+      END ;
+      x := x + i ;
+      y := y + j ;
+      IF (x<0) OR (y<0) OR (x>=BoardX) OR (y>=BoardY)
+      THEN
+         RETURN
+      END ;
+      t := VAL(CARDINAL, y)*BoardX+VAL(CARDINAL, x) ;
+      IF isUsed(b, t)
+      THEN
+         (* found pivot, keep looking for the destination *)
+         WHILE d>0 DO
+            x := x + i ;
+            y := y + j ;
+            IF (x<0) OR (y<0) OR (x>=BoardX) OR (y>=BoardY)
+            THEN
+               RETURN
+            END ;
+            t := VAL(CARDINAL, y)*BoardX+VAL(CARDINAL, x) ;
+            IF isUsed(b, t)
+            THEN
+               RETURN
+            END ;
+            DEC(d)
+         END ;
+         IF NOT isRecorded(m, t, p)
+         THEN
+            IF Debugging
+            THEN
+               WriteString('adding move ') ; WriteCard(t, 0) ; WriteLn
+            END ;
+            recordMove(m, t, p) ;
+            addToGraph(g, from, t) ;
+            addToGraph(g, t, from)
+         END ;
+         RETURN
+      END ;
+      INC(d)
+   END
+END recordMultipleV ;
+
+
+(*
+   recordMultiple - adds moves which involve jumping.  Current peg, p, is at at position
+                    indicated by, m.pieceList[low].
+*)
+
+PROCEDURE recordMultiple (VAR b: Board; VAR m: Moves; c: Colour;
+                          p: CARDINAL; low: CARDINAL; VAR g: Graph) ;
+VAR
+   from: INTEGER ;
+   x, y: INTEGER ;
+BEGIN
+   WITH b DO
+      WHILE low<m.pieceHead[p] DO
+         from := VAL(INTEGER, m.pieceList[low]) ;
+         x := from MOD BoardX ;
+         y := from DIV BoardX ;
+         recordMultipleV(b, m, c, p, x, y, -1,  0, from, g) ;
+         recordMultipleV(b, m, c, p, x, y, -1,  1, from, g) ;
+         recordMultipleV(b, m, c, p, x, y, -1, -1, from, g) ;
+
+         recordMultipleV(b, m, c, p, x, y,  1,  0, from, g) ;
+         recordMultipleV(b, m, c, p, x, y,  1,  1, from, g) ;
+         recordMultipleV(b, m, c, p, x, y,  1, -1, from, g) ;
+
+         recordMultipleV(b, m, c, p, x, y,  0,  1, from, g) ;
+         recordMultipleV(b, m, c, p, x, y,  0, -1, from, g) ;
+         INC(low)
+      END
+   END
+END recordMultiple ;
+
+
+(*
+   recMove - generate the moves for peg, p.
+*)
+
+PROCEDURE recMove (VAR b: Board; VAR m: Moves; c: Colour;
+                   p: CARDINAL; from: CARDINAL; VAR g: Graph) ;
+BEGIN
+   m.pieceHead[p-1] := 0 ;
+   m.pieceHead[p] := 0 ;
+   recordMove(m, from, p) ;
+   (* record the current position so we can ignore moving back to it *)
+   recordMultiple(b, m, c, p, m.pieceHead[p]-1, g) ;
+   recordSingle(b, m, c, p, from, g)
+END recMove ;
+
+
+(*
+   recMoves - generate the list of moves for colour, c, on board, b, and record each
+              move in r.
+              The board, b, is unaltered despite being passed by reference.
+*)
+
+PROCEDURE recMoves (VAR b: Board; VAR m: Moves; c: Colour;
+                    peg: CARDINAL; from: CARDINAL; VAR g: Graph) ;
+VAR
+   pos: CARDINAL ;
+BEGIN
+   pos := b.pieces[c][peg] ;
+   subPiece(b, pos, c) ;        (* remove this peg while jumping (so we dont jump over ourself) *)
+   initGraph(g) ;
+   recMove(b, m, c, peg, from, g) ;
+   addPiece(b, pos, c, peg)  (* restore the peg *)
+END recMoves ;
+
+
+(*
+   WriteColour - displays the colour, c.
+*)
+
+PROCEDURE WriteColour (c: Colour) ;
+BEGIN
+   CASE c OF
+
+   White:  WriteString('white') |
+   Blue :  WriteString('blue') |
+   Green:  WriteString('green') |
+   Red  :  WriteString('red')
+
+   END
+END WriteColour ;
+
+
+(*
+   getFirstPos -
+*)
+
+PROCEDURE getFirstPos (s: ARRAY OF CHAR; VAR b: Board; c: Colour) : CARDINAL ;
+VAR
+   from: CARDINAL ;
+   x   : CHAR ;
+   y   : CARDINAL ;
+   res : ConvResults ;
+BEGIN
+   IF Length(s)>0
+   THEN
+      x := CAP(s[0]) ;
+      IF x='?'
+      THEN
+         displayAllMoves(b, c)
+      ELSIF (x>='A') AND (x<='P')
+      THEN
+         from := ORD (x) - ORD ('A') ;
+         s[0] := '0' ;
+         IF Length(s)>0
+         THEN
+            StrToCard(s, y, res) ;
+            IF (res=strAllRight) AND ((y=0) OR (y>BoardY))
+            THEN
+               WriteString('Please enter a number between [1-16]') ; WriteLn
+            ELSE
+               from := from+(y-1)*BoardY ;
+               IF isUsed(b, from) AND isColour(b, from, c)
+               THEN
+                  RETURN from
+               ELSE
+                  WriteString('That position is occupied by your opponent') ; WriteLn
+               END
+            END
+         END
+      ELSE
+         WriteString('please enter a letter [A-P] followed by a number [1-16]') ; WriteLn
+      END
+   END ;
+   RETURN BoardSize
+END getFirstPos ;
+
+
+(*
+   getSecondPos -
+*)
+
+PROCEDURE getSecondPos (s: ARRAY OF CHAR; VAR b: Board; c: Colour; peg: CARDINAL) : CARDINAL ;
+VAR
+   from: CARDINAL ;
+   x   : CHAR ;
+   y   : CARDINAL ;
+   res : ConvResults ;
+BEGIN
+   IF Length(s)>0
+   THEN
+      x := CAP(s[0]) ;
+      IF x='?'
+      THEN
+         displayMovesPeg(b, c, peg) ;
+         displayBoardPeg(b, c, peg)
+      ELSIF (x>='A') AND (x<='P')
+      THEN
+         from := ORD (x) - ORD ('A') ;
+         s[0] := '0' ;
+         IF Length(s)>0
+         THEN
+            StrToCard(s, y, res) ;
+            IF (res=strAllRight) AND ((y=0) OR (y>BoardY))
+            THEN
+               WriteString('Please enter a number between [1-16]') ; WriteLn
+            ELSE
+               from := from+(y-1)*BoardY ;
+               IF NOT isUsed(b, from)
+               THEN
+                  RETURN from
+               ELSIF isColour(b, from, c)
+               THEN
+                  WriteString('That position is already occupied by another of your pegs') ; WriteLn
+               ELSE
+                  WriteString('That position is occupied by your opponent') ; WriteLn
+               END
+            END
+         END
+      ELSE
+         WriteString('please enter a letter [A-P] followed by a number [1-16]') ; WriteLn
+      END
+   END ;
+   RETURN BoardSize
+END getSecondPos ;
+
+
+(*
+   getPeg -
+*)
+
+PROCEDURE getPeg (VAR b: Board; c: Colour; from: CARDINAL) : CARDINAL ;
+VAR
+   p: CARDINAL ;
+BEGIN
+   FOR p := 1 TO Pieces DO
+      IF b.pieces[c][p] = VAL (CARDINAL8, from)
+      THEN
+         RETURN p
+      END
+   END ;
+   HALT ;
+   RETURN Pieces+1
+END getPeg ;
+
+
+(*
+   checkLegal -
+*)
+
+PROCEDURE checkLegal (VAR b: Board; col: Colour; from, to: CARDINAL; peg: CARDINAL) : BOOLEAN ;
+VAR
+   m   : Moves ;
+   i, j: CARDINAL ;
+BEGIN
+   IF (to=BoardSize) OR (from=BoardSize)
+   THEN
+      RETURN FALSE
+   END ;
+   genMoves(b, m, col) ;
+   IF VAL (CARDINAL8, from) # b.pieces[col][peg]
+   THEN
+      RETURN FALSE
+   END ;
+   i := m.pieceHead[peg-1]+1 ;  (* skip the initial move *)
+   j := m.pieceHead[peg] ;
+   WHILE i<j DO
+      IF VAL (CARDINAL8, to) = m.pieceList[i]
+      THEN
+         RETURN TRUE
+      END ;
+      INC(i)
+   END ;
+   RETURN FALSE
+END checkLegal ;
+
+
+(*
+   noOfMoves - returns the number of moves held in, m.
+*)
+
+PROCEDURE noOfMoves (VAR m: Moves) : CARDINAL ;
+VAR
+   n, p, i, j: CARDINAL ;
+BEGIN
+   n := 0 ;
+   FOR p := 1 TO Pieces DO
+      i := m.pieceHead[p-1]+1 ;  (* skip the initial move *)
+      j := m.pieceHead[p] ;
+      WHILE i<j DO
+         INC(n) ;
+         INC(i)
+      END
+   END ;
+   RETURN n
+END noOfMoves ;
+
+
+(*
+   askMove - returns a move entered.
+*)
+
+PROCEDURE askMove (VAR b: Board; c: Colour; VAR peg: CARDINAL) : CARDINAL ;
+VAR
+   s       : ARRAY [0..80] OF CHAR ;
+   y,
+   from, to: CARDINAL ;
+   res     : ConvResults ;
+BEGIN
+   LOOP
+      WriteString('Please enter your move, from, ') ;
+      WriteColour(c) ;
+      WriteString(' ') ;
+      ReadToken(s) ;
+      SkipLine ;
+      from := getFirstPos(s, b, c) ;
+      IF from=BoardSize
+      THEN
+         WriteString('please try again...') ; WriteLn
+      ELSE
+         WriteString('now please enter your move, to, ') ;
+         WriteColour(c) ;
+         WriteString(' ') ;
+         ReadToken(s) ;
+         SkipLine ;
+         peg := getPeg(b, c, from) ;
+         to := getSecondPos(s, b, c, peg) ;
+         IF checkLegal(b, c, from, to, peg)
+         THEN
+            WriteString('you are ') ;
+            showMove(b, c, peg, from, to) ;
+            RETURN to
+         END
+      END
+   END
+END askMove ;
+
+
+(*
+   opponent - returns the opponents colour.
+*)
+
+PROCEDURE opponent (col: Colour) : Colour ;
+BEGIN
+   IF col=Red
+   THEN
+      RETURN Blue
+   ELSE
+      RETURN Red
+   END
+END opponent ;
+
+
+(*
+   maximumScore - returns TRUE if the maximim score was found.
+*)
+
+PROCEDURE maximumScore (score: INTEGER) : BOOLEAN ;
+BEGIN
+   RETURN (score<=MinScore) OR (score>=MaxScore)
+END maximumScore ;
+
+
+(*
+   calcScoreForPos - returns the score for Colour, c, pos, on Board, b.
+*)
+
+PROCEDURE calcScoreForPos (VAR b: Board; c: Colour; pos: CARDINAL) : INTEGER ;
+VAR
+   home,
+   x, y: CARDINAL ;
+BEGIN
+   IF c=Red
+   THEN
+      pos := (BoardSize-1) - pos
+   ELSIF c=Blue
+   THEN
+      (* nothing to do *)
+   ELSE
+      HALT  (* not implemented yet *)
+   END ;
+   IF pos IN homeBase[c]
+   THEN
+      home := HomeWeight
+   ELSE
+      home := 0
+   END ;
+
+   (* our score is dependant upon how far this piece is away from the opposite corner *)
+   x := pos MOD BoardX ;
+   y := pos DIV BoardY ;
+   IF x>y
+   THEN
+      (* max squares from 0,0 *)
+      RETURN BoardX-x+home
+   ELSE
+      RETURN BoardY-y+home
+   END
+END calcScoreForPos ;
+
+
+(*
+   calcScoreFor - returns the score for Colour, c.
+*)
+
+PROCEDURE calcScoreFor (VAR b: Board; c: Colour) : INTEGER ;
+VAR
+   score: INTEGER ;
+   p    : CARDINAL ;
+BEGIN
+   score := 0 ;
+   FOR p := 1 TO Pieces DO
+      INC(score, calcScoreForPos(b, c, b.pieces[c][p]))
+   END ;
+   RETURN score
+END calcScoreFor ;
+
+
+(*
+   updateMove -
+*)
+
+PROCEDURE updateMove (VAR b: Board; col: Colour; peg: CARDINAL; topos: CARDINAL) ;
+VAR
+   frompos: CARDINAL ;
+BEGIN
+   frompos := b.pieces[col][peg] ;
+   subPiece(b, frompos, col) ;
+   addPiece(b, topos, col, peg)
+END updateMove ;
+
+
+(*
+   retractMove -
+*)
+
+PROCEDURE retractMove (VAR b: Board; col: Colour; peg: CARDINAL; topos: CARDINAL) ;
+BEGIN
+   updateMove(b, col, peg, topos)
+END retractMove ;
+
+
+(*
+   calcScore - make the move and update the score.
+*)
+
+PROCEDURE calcScore (VAR b: Board; score: INTEGER; peg: CARDINAL;
+                     topos: CARDINAL; col: Colour) : INTEGER ;
+VAR
+   i, j, k: INTEGER ;
+BEGIN
+   IF slowEvaluation
+   THEN
+      (* compute the score by examine each peg in turn *)
+      updateMove(b, col, peg, topos) ;
+
+      (* check whether one side has won *)
+      IF b.home[Blue]=Pieces
+      THEN
+         RETURN MaxScore
+      ELSIF b.home[Red]=Pieces
+      THEN
+         RETURN MinScore
+      END ;
+
+      RETURN calcScoreFor(b, Blue) - calcScoreFor(b, Red)
+   ELSE
+      i := calcScoreForPos(b, col, b.pieces[col][peg]) ;
+      updateMove(b, col, peg, topos) ;  (* move the peg *)
+
+      (* check whether one side has won *)
+      IF b.home[Blue]=Pieces
+      THEN
+         RETURN MaxScore
+      ELSIF b.home[Red]=Pieces
+      THEN
+         RETURN MinScore
+      END ;
+
+      j := calcScoreForPos(b, col, topos) ;
+      IF col=Red
+      THEN
+         score := score + i - j
+      ELSE
+         score := score - i + j
+      END ;
+      IF Debugging
+      THEN
+         k := calcScoreFor(b, Blue) - calcScoreFor(b, Red) ;
+         IF score#k
+         THEN
+            HALT
+         END
+      END ;
+      RETURN score
+   END
+END calcScore ;
+
+
+(*
+   alphaBeta - returns the score estimated should move, pos, be chosen.
+               The board, b, and score is in the state _before_ move pos
+               is made.
+*)
+
+PROCEDURE alphaBeta (peg: CARDINAL; frompos, topos: CARDINAL;
+                     VAR b: Board; col: Colour;
+                     depth: CARDINAL;
+                     alpha, beta, score: INTEGER) : INTEGER ;
+VAR
+   try     : INTEGER ;
+   i, j,
+   n, p    : CARDINAL ;
+   m       : Moves ;
+   from, to: CARDINAL ;
+   op      : Colour ;
+BEGIN
+   score := calcScore(b, score, peg, topos, col) ;   (* make move and update score *)
+   IF (depth=0) OR maximumScore(score)
+   THEN
+      retractMove(b, col, peg, frompos) ;
+      INC(count) ;
+      IF col=Red
+      THEN
+         RETURN score+VAL(INTEGER, depth)
+      ELSE
+         RETURN score-VAL(INTEGER, depth)
+      END
+   ELSE
+      op := opponent(col) ;
+      genMoves(b, m, op) ;
+      IF op=Blue
+      THEN
+         (* blue to move, move is possible, continue searching *)
+         FOR p := 1 TO Pieces DO
+            from := b.pieces[op][p] ;
+            i := m.pieceHead[p-1]+1 ;  (* skip the initial move *)
+            j := m.pieceHead[p] ;
+            WHILE i<j DO
+               to := m.pieceList[i] ;
+               try := alphaBeta(p, from, to,
+                                b, op, depth-1, alpha, beta, score) ;
+               IF try > alpha
+               THEN
+                  (* found a better move *)
+                  alpha := try
+               END ;
+               IF alpha >= beta
+               THEN
+                  retractMove(b, col, peg, frompos) ;
+                  RETURN alpha
+               END ;
+               INC(i)
+            END
+         END ;
+         retractMove(b, col, peg, frompos) ;
+         RETURN alpha
+      ELSE
+         (* red to move, move is possible, continue searching *)
+         FOR p := 1 TO Pieces DO
+            from := b.pieces[op][p] ;
+            i := m.pieceHead[p-1]+1 ;  (* skip the initial move *)
+            j := m.pieceHead[p] ;
+            WHILE i<j DO
+               to := m.pieceList[i] ;
+               try := alphaBeta(p, from, to,
+                                b, op, depth-1, alpha, beta, score) ;
+               IF try < beta
+               THEN
+                  (* found a better move *)
+                  beta := try
+               END ;
+               IF alpha >= beta
+               THEN
+                  (* no point searching further as Red would choose
+                   a different previous move *)
+                  retractMove(b, col, peg, frompos) ;
+                  RETURN beta
+               END ;
+               INC(i)
+            END
+         END ;
+         retractMove(b, col, peg, frompos) ;
+         RETURN beta   (* the best score for a move Blue has found *)
+      END
+   END
+END alphaBeta ;
+
+
+(*
+   makeMove - computer makes a move for colour, col.
+*)
+
+PROCEDURE makeMove (VAR b: Board; col: Colour; score: INTEGER; VAR peg: CARDINAL) : INTEGER ;
+VAR
+   no        : CARDINAL ;
+   p, from,
+   frompos,
+   topos, to : CARDINAL ;
+   start, end: Timeval ;
+   try,
+   r, best   : INTEGER ;
+   secS, usec,
+   secE, i, j: CARDINAL ;
+   m         : Moves ;
+   plies     : CARDINAL ;
+   outOfTime : BOOLEAN ;
+BEGIN
+   start := InitTime(0, 0) ;
+   end := InitTime(0, 0) ;
+
+   r := GetTimeOfDay(start) ;
+   best := MinScore-1 ;   (* worst than minimum score so we will choose a loosing move if forced *)
+
+   count := 0 ;
+   i := 0 ;
+   genMoves(b, m, col) ;
+   no := noOfMoves(m) ;
+   peg := Pieces+1 ;
+   outOfTime := FALSE ;
+   plies := 0 ;
+   frompos := BoardSize ;
+   topos := BoardSize ;
+   REPEAT
+      WriteString("I'm going to look ") ;
+      WriteCard(plies, 0) ; WriteString(' moves ahead') ; WriteLn ;
+
+      FOR p := 1 TO Pieces DO
+         from := b.pieces[col][p] ;
+         i := m.pieceHead[p-1]+1 ;  (* skip the initial move *)
+         j := m.pieceHead[p] ;
+         IF (no=1) AND (i<j)
+         THEN
+            (* only one move and this peg can move, therefore dont bother evaluating the move, just play it *)
+            to := m.pieceList[i] ;
+            frompos := from ;
+            best := 0 ;
+            topos := to ;
+            peg := p
+         ELSE
+            WHILE (i<j) AND (NOT outOfTime) DO
+               r := GetTimeOfDay(end) ;
+               GetTime(start, secS, usec) ;
+               GetTime(end, secE, usec) ;
+               outOfTime := (secE-secS > Thinking) ;
+
+               IF outOfTime
+               THEN
+                  WriteString('out of time...') ; WriteLn
+               ELSE
+                  to := m.pieceList[i] ;
+                  try := alphaBeta(p, from, to,
+                                   b, col, plies,
+                                   MinScore, MaxScore, score) ;
+                  IF try>best
+                  THEN
+                     best := try ;
+                     topos := to ;
+                     frompos := from ;
+                     peg := p
+                  END
+               END ;
+               INC(i)
+            END
+         END
+      END ;
+      IF (NOT outOfTime) AND (frompos<BoardSize) AND (topos<BoardSize)
+      THEN
+         WriteString('so far I think the best move is from') ;
+         writePosition(frompos) ;
+         WriteString(' to') ;
+         writePosition(topos) ;
+         WriteLn
+      END ;
+      INC(plies)
+   UNTIL (no<2) OR outOfTime ;
+
+   IF best >= WinScore
+   THEN
+      WriteString('I think I can force a win') ; WriteLn
+   END ;
+   IF best <= LooseScore
+   THEN
+      WriteString('You should be able to force a win') ; WriteLn
+   END ;
+
+   IF no=1
+   THEN
+      WriteString('I can only play one move, so there is little point wasting time') ; WriteLn
+   ELSIF no=0
+   THEN
+      WriteString('I cannot move, so there is little point wasting time') ; WriteLn
+   ELSE
+      WriteString('I took ') ; WriteCard(secE-secS, 0) ;
+      WriteString(' seconds and evaluated ') ;
+      WriteCard(count, 0) ; WriteString(' positions,') ; WriteLn ;
+   END ;
+
+   start := KillTime(start) ;
+   end := KillTime(end) ;
+   RETURN topos
+END makeMove ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   b  : Board ;
+   c  : Colour ;
+   s  : INTEGER ;
+   peg,
+   to : CARDINAL ;
+BEGIN
+   initBoard(b) ;
+   c := Red ;
+   s := 0 ;
+   displayBoard(b) ;
+   peg := getPeg(b, c, 4) ;
+   displayBoardPeg(b, c, peg) ;
+   to := 36 ;
+   s := calcScore(b, s, peg, to, c) ;
+
+
+
+   peg := 5 ;
+   c := opponent(c) ;
+   peg := getPeg(b, c, 12*BoardX+15) ;
+   to := 12*BoardX+13 ;
+   s := calcScore(b, s, peg, to, c) ;
+   displayBoardPeg(b, c, peg) ;
+
+
+
+   c := Red ;
+   displayBoard(b) ;
+   peg := getPeg(b, c, 36) ;
+   stop ;
+   displayBoardPeg(b, c, peg) ;
+   to := 4 ;
+   s := calcScore(b, s, peg, to, c) ;
+   displayBoardPeg(b, c, peg) ;
+
+END test ;
+
+
+(*
+   displayHow -
+*)
+
+PROCEDURE displayHow (from, to: CARDINAL; VAR rec: ARRAY OF CARDINAL; r: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   writePosition(from) ; WriteString(' can move to ') ; writePosition(to) ; WriteString(' by: ') ;
+   i := 0 ;
+   WHILE (i<r) AND (i<=HIGH(rec)) DO
+      writePosition(rec[i])
+   END ;
+   WriteLn
+END displayHow ;
+
+
+(*
+   addToList -
+*)
+
+PROCEDURE addToList (VAR choices: ARRAY OF CARDINAL; VAR n: CARDINAL; from: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE i<n DO
+      IF choices[i]=from
+      THEN
+         RETURN
+      END ;
+      INC(i)
+   END ;
+   choices[n] := from ;
+   INC(n)
+END addToList ;
+
+
+(*
+   subBest -
+*)
+
+PROCEDURE subBest (VAR choices: ARRAY OF CARDINAL; VAR n: CARDINAL; VAR g: Graph) : CARDINAL ;
+VAR
+   b: CARDINAL ;
+   i, j, k: CARDINAL ;
+BEGIN
+   k := choices[0] ;
+   b := g.graph[k].dist ;
+   i := 1 ;
+   WHILE i<n DO
+      IF g.graph[choices[i]].dist<b
+      THEN
+         k := choices[i] ;
+         b := g.graph[k].dist
+      END ;
+      INC(i)
+   END ;
+   (* remove, k, from, choices *)
+   i := 0 ;
+   j := 0 ;
+   WHILE i<n DO
+      IF i#j
+      THEN
+         choices[i] := choices[j] ;
+         INC(i) ;
+      ELSIF choices[i]#k
+      THEN
+         INC(i)
+      END ;
+      INC(j)
+   END ;
+   DEC(n) ;
+   RETURN k
+END subBest ;
+
+
+(*
+   dijkstra -
+*)
+
+PROCEDURE dijkstra (from, to: CARDINAL; VAR g: Graph) ;
+VAR
+   visited: SoS ;
+   choices: ARRAY Squares OF CARDINAL ;
+   alt,
+   n, i   : CARDINAL ;
+   u, v   : CARDINAL ;
+BEGIN
+   g.graph[from].dist := 0 ;
+   g.graph[from].prev := from ;
+   visited := SoS{from} ;
+   n := 0 ;
+   addToList(choices, n, from) ;
+   WHILE n#0 DO
+      u := subBest(choices, n, g) ;
+      IF u=to
+      THEN
+         RETURN
+      ELSE
+         WITH g.graph[u] DO
+            i := 0 ;
+            WHILE i<no DO
+               v := list[i] ;
+               IF NOT (v IN visited)
+               THEN
+                  INCL(visited, v) ;
+                  addToList(choices, n, v) ;
+                  alt := dist + 1 ;
+                  IF alt<g.graph[v].dist
+                  THEN
+                     g.graph[v].dist := alt ;
+                     g.graph[v].prev := u
+                  END
+               END ;
+               INC(i)
+            END
+         END
+      END
+   END
+END dijkstra ;
+
+
+(*
+   showRoute -
+*)
+
+PROCEDURE showRoute (from, to: CARDINAL; VAR g: Graph) ;
+BEGIN
+   IF from#to
+   THEN
+      showRoute(from, g.graph[to].prev, g)
+   END ;
+   IF from=to
+   THEN
+      WriteString(' from')
+   ELSE
+      WriteString(' to')
+   END ;
+   writePosition(to)
+END showRoute ;
+
+
+(*
+   showMove - show how, peg, can move, from, to, on board, b.
+*)
+
+PROCEDURE showMove (VAR b: Board;
+                    c: Colour; peg: CARDINAL; from, to: CARDINAL) ;
+VAR
+   m: Moves ;
+   g: Graph ;
+BEGIN
+   recMoves(b, m, c, peg, from, g) ;
+   dijkstra(from, to, g) ;
+   WriteString('moving peg') ;
+   showRoute(from, to, g) ;
+   WriteLn
+END showMove ;
+
+
+(*
+   play -
+*)
+
+PROCEDURE play ;
+VAR
+   b       : Board ;
+   c       : Colour ;
+   s       : INTEGER ;
+   peg,
+   to, from: CARDINAL ;
+BEGIN
+   initBoard(b) ;
+   c := Red ;
+   s := 0 ;
+   displayBoard(b) ;
+   RETURN ;   (* remove this line of code if you really want to play the game.  *)
+   LOOP
+      to := askMove(b, c, peg) ;
+      s := calcScore(b, s, peg, to, c) ;
+      displayBoard(b) ;
+      WriteString('Current score = ') ; WriteInt(s, 0) ; WriteLn ;
+      IF s<=MinScore
+      THEN
+         WriteString('Well done you win') ; WriteLn ;
+         RETURN
+      END ;
+      c := opponent(c) ;
+      to := makeMove(b, c, s, peg) ;
+      IF peg>Pieces
+      THEN
+         WriteString('I cannot move') ; WriteLn
+      ELSE
+         from := b.pieces[c][peg] ;
+         WriteString('I am ') ;
+         showMove(b, c, peg, from, to) ;
+         s := calcScore(b, s, peg, to, c) ;
+         displayBoard(b) ;
+         WriteString('Current score = ') ; WriteInt(s, 0) ; WriteLn ;
+         IF s>=MaxScore
+         THEN
+            WriteString('Good try, but I win') ; WriteLn ;
+            RETURN
+         END
+      END ;
+      c := opponent(c)
+   END
+END play ;
+
+
+(*
+   writePosition -
+*)
+
+PROCEDURE writePosition (x: CARDINAL) ;
+BEGIN
+   WriteChar(' ') ;
+   WriteChar(CHR(ORD('a')+x MOD BoardX)) ;
+   WriteCard(x DIV BoardX+1, 0)
+END writePosition ;
+
+
+(*
+   displayMovesForPeg -
+*)
+
+PROCEDURE displayMovesForPeg (VAR b: Board; m: Moves; c: Colour; peg: CARDINAL) ;
+VAR
+   p, i, j: CARDINAL ;
+BEGIN
+   WriteString('peg at') ;
+   writePosition(b.pieces[c][peg]) ;
+   IF m.pieceHead[peg-1]+1<m.pieceHead[peg]
+   THEN
+      WriteString(' can move to ') ;
+      i := m.pieceHead[peg-1]+1 ;  (* skip the initial move *)
+      j := m.pieceHead[peg] ;
+      WHILE i<j DO
+         writePosition(m.pieceList[i]) ;
+         WriteString(' ') ;
+         INC(i)
+      END ;
+      WriteLn
+   ELSE
+      WriteString(' cannot move') ; WriteLn
+   END
+END displayMovesForPeg ;
+
+
+(*
+   displayMoves -
+*)
+
+PROCEDURE displayMoves (VAR b: Board; m: Moves; c: Colour) ;
+VAR
+   p, i, j: CARDINAL ;
+BEGIN
+   WriteString('possible moves are ') ; WriteLn ;
+   FOR p := 1 TO Pieces DO
+      IF m.pieceHead[p-1]+1<m.pieceHead[p]
+      THEN
+         WriteString('piece at position ') ;
+         writePosition(b.pieces[c][p]) ;
+         WriteString(' can move to ') ;
+         i := m.pieceHead[p-1]+1 ;  (* skip the initial move *)
+         j := m.pieceHead[p] ;
+         WHILE i<j DO
+            writePosition(m.pieceList[i]) ;
+            WriteString(' ') ;
+            INC(i)
+         END ;
+         WriteLn
+      END
+   END
+END displayMoves ;
+
+
+(*
+   displayAllMoves -
+*)
+
+PROCEDURE displayAllMoves (VAR b: Board; c: Colour) ;
+VAR
+   m: Moves ;
+BEGIN
+   genMoves(b, m, c) ;
+   displayMoves(b, m, c)
+END displayAllMoves ;
+
+
+(*
+   displayMovesPeg -
+*)
+
+PROCEDURE displayMovesPeg (VAR b: Board; c: Colour; peg: CARDINAL) ;
+VAR
+   m: Moves ;
+BEGIN
+   genMoves(b, m, c) ;
+   displayMovesForPeg(b, m, c, peg)
+END displayMovesPeg ;
+
+
+(*
+   initBoard -
+*)
+
+PROCEDURE initBoard (VAR b: Board) ;
+BEGIN
+   b.used := SoS {} ;
+   b.colour[0] := SoS {} ;
+   b.colour[1] := SoS {} ;
+   b.home[Blue] := 0 ;
+   b.home[Red] := 0 ;
+   b.home[Green] := 0 ;
+   b.home[White] := 0 ;
+   IF TwoPlayer OR FourPlayer
+   THEN
+      homeBase[Blue] := SoS{0, 1, 2, 3,
+                            16, 17, 18, 19,
+                            32, 33, 34,
+                            48, 49} ;
+      IF Debugging
+      THEN
+         dumpBase(Blue) ;
+         dumpBase(Red)
+      END ;
+
+      homeBase[Red] := SoS{255-0, 255-1, 255-2, 255-3,
+                           255-16, 255-17, 255-18, 255-19,
+                           255-32, 255-33, 255-34,
+                           255-48, 255-49} ;
+      IF Debugging
+      THEN
+         dumpBase(Red) ;
+         dumpBase(Blue)
+      END ;
+
+      (* red *)
+      addPiece(b,  0, Red, 1) ;
+      addPiece(b,  1, Red, 2) ;
+      addPiece(b,  2, Red, 3) ;
+      addPiece(b,  3, Red, 4) ;
+      addPiece(b, 16, Red, 5) ;
+      addPiece(b, 17, Red, 6) ;
+      addPiece(b, 18, Red, 7) ;
+      addPiece(b, 19, Red, 8) ;
+      addPiece(b, 32, Red, 9) ;
+      addPiece(b, 33, Red, 10) ;
+      addPiece(b, 34, Red, 11) ;
+      addPiece(b, 48, Red, 12) ;
+      addPiece(b, 49, Red, 13) ;
+
+      (* blue *)
+      addPiece(b, 255-0, Blue, 1) ;
+      addPiece(b, 255-1, Blue, 2) ;
+      addPiece(b, 255-2, Blue, 3) ;
+      addPiece(b, 255-3, Blue, 4) ;
+      addPiece(b, 255-16, Blue, 5) ;
+      addPiece(b, 255-17, Blue, 6) ;
+      addPiece(b, 255-18, Blue, 7) ;
+      addPiece(b, 255-19, Blue, 8) ;
+      addPiece(b, 255-32, Blue, 9) ;
+      addPiece(b, 255-33, Blue, 10) ;
+      addPiece(b, 255-34, Blue, 11) ;
+      addPiece(b, 255-48, Blue, 12) ;
+      addPiece(b, 255-49, Blue, 13) ;
+
+   END ;
+   IF TwoPlayer
+   THEN
+      homeBase[Blue] := homeBase[Blue] + SoS{4, 20, 35, 50, 65, 64} ;
+      IF Debugging
+      THEN
+         dumpBase(Blue)
+      END ;
+      homeBase[Red] := homeBase[Red] + SoS{255-4, 255-20, 255-35, 255-50, 255-65, 255-64} ;
+      IF Debugging
+      THEN
+         dumpBase(Red)
+      END ;
+(*
+      INCL(homeBase[Blue], 4) ;
+      INCL(homeBase[Blue], 20) ;
+      INCL(homeBase[Blue], 35) ;
+      INCL(homeBase[Blue], 50) ;
+      INCL(homeBase[Blue], 65) ;
+      INCL(homeBase[Blue], 64) ;
+*)
+      IF Debugging
+      THEN
+         dumpBase(Blue)
+      END ;
+
+(*
+      INCL(homeBase[Red], 255-4) ;
+      INCL(homeBase[Red], 255-20) ;
+      INCL(homeBase[Red], 255-35) ;
+      INCL(homeBase[Red], 255-50) ;
+      INCL(homeBase[Red], 255-65) ;
+      INCL(homeBase[Red], 255-64) ;
+*)
+
+      IF Debugging
+      THEN
+         dumpBase(Red)
+      END ;
+
+      (* red *)
+      addPiece(b,  4, Red, 14) ;
+      addPiece(b, 20, Red, 15) ;
+      addPiece(b, 35, Red, 16) ;
+      addPiece(b, 50, Red, 17) ;
+      addPiece(b, 65, Red, 18) ;
+      addPiece(b, 64, Red, 19) ;
+
+      (* blue *)
+      addPiece(b, 255-4, Blue, 14) ;
+      addPiece(b, 255-20, Blue, 15) ;
+      addPiece(b, 255-35, Blue, 16) ;
+      addPiece(b, 255-50, Blue, 17) ;
+      addPiece(b, 255-65, Blue, 18) ;
+      addPiece(b, 255-64, Blue, 19) ;
+
+   END ;
+   assert(b.home[Blue] = 0) ;
+   assert(b.home[Red] = 0) ;
+   assert(b.home[Green] = 0) ;
+   assert(b.home[White] = 0)
+END initBoard ;
+
+
+(*
+   displayBoard - displays the board.
+*)
+
+PROCEDURE displayBoard (b: Board) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WriteString('     a  b  c  d  e  f  g  h  i  j  k  l  m  n  o  p') ; WriteLn ;
+   WriteString('   +------------------------------------------------+') ; WriteLn ;
+   FOR j := BoardY TO 1 BY -1 DO
+      WriteCard(j, 2) ;
+      WriteString(' |') ;
+      FOR i := 1 TO BoardX DO
+         WriteChar(' ') ;
+         IF isColour(b, (j-1)*BoardX+(i-1), Blue)
+         THEN
+            WriteChar('b')
+         ELSIF isColour(b, (j-1)*BoardX+(i-1), Red)
+         THEN
+            WriteChar('r')
+         ELSIF isColour(b, (j-1)*BoardX+(i-1), Green)
+         THEN
+            WriteChar('g')
+         ELSIF isColour(b, (j-1)*BoardX+(i-1), White)
+         THEN
+            WriteChar('w')
+         ELSE
+            WriteChar(' ')
+         END ;
+         WriteChar(' ')
+      END ;
+      WriteString('| ') ;
+      WriteCard(j, 2) ;
+      WriteLn
+   END ;
+   WriteString('   +------------------------------------------------+') ; WriteLn ;
+   WriteString('     a  b  c  d  e  f  g  h  i  j  k  l  m  n  o  p') ; WriteLn
+END displayBoard ;
+
+
+(*
+   emitSpecialIf -
+*)
+
+PROCEDURE emitSpecialIf (normal, special: CHAR; i, j, x, y: CARDINAL) ;
+BEGIN
+   IF (x=i) AND (y=j)
+   THEN
+      WriteChar(special)
+   ELSE
+      WriteChar(normal)
+   END
+END emitSpecialIf ;
+
+
+(*
+   displayBoardPeg - displays the board with all moves by peg illustrated.
+*)
+
+PROCEDURE displayBoardPeg (b: Board; c: Colour; peg: CARDINAL) ;
+VAR
+   x, y,
+   i, j: CARDINAL ;
+   m   : Moves ;
+BEGIN
+   genMoves(b, m, c) ;
+   x := b.pieces[c][peg] MOD BoardX+1 ;
+   y := b.pieces[c][peg] DIV BoardX+1 ;
+   WriteString('     a  b  c  d  e  f  g  h  i  j  k  l  m  n  o  p') ; WriteLn ;
+   WriteString('   +------------------------------------------------+') ; WriteLn ;
+   FOR j := BoardY TO 1 BY -1 DO
+      WriteCard(j, 2) ;
+      WriteString(' |') ;
+      FOR i := 1 TO BoardX DO
+         WriteChar(' ') ;
+         IF isColour(b, (j-1)*BoardX+(i-1), Blue)
+         THEN
+            emitSpecialIf('b', 'x', i, j, x, y)
+         ELSIF isColour(b, (j-1)*BoardX+(i-1), Red)
+         THEN
+            emitSpecialIf('r', 'x', i, j, x, y)
+         ELSIF isColour(b, (j-1)*BoardX+(i-1), Green)
+         THEN
+            emitSpecialIf('g', 'x', i, j, x, y)
+         ELSIF isColour(b, (j-1)*BoardX+(i-1), White)
+         THEN
+            emitSpecialIf('w', 'x', i, j, x, y)
+         ELSE
+            IF isRecorded(m, ((j-1)*BoardX)+(i-1), peg)
+            THEN
+               CASE c OF
+
+               Blue :  WriteChar('B') |
+               Red  :  WriteChar('R') |
+               Green:  WriteChar('G') |
+               White:  WriteChar('W')
+
+               END
+            ELSE
+               WriteChar(' ')
+            END
+         END ;
+         WriteChar(' ')
+      END ;
+      WriteString('| ') ;
+      WriteCard(j, 2) ;
+      WriteLn
+   END ;
+   WriteString('   +------------------------------------------------+') ; WriteLn ;
+   WriteString('     a  b  c  d  e  f  g  h  i  j  k  l  m  n  o  p') ; WriteLn
+END displayBoardPeg ;
+
+
+BEGIN
+   (* test *)
+   play
+END halma.
+(*
+ * Local variables:
+ *  compile-command: "gm2 -g -fiso halma.mod"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/iso/run/pass/halma/projects-iso-run-pass-halma.exp b/gcc/testsuite/gm2/projects/iso/run/pass/halma/projects-iso-run-pass-halma.exp
new file mode 100644
index 00000000000..304cd39d79d
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/run/pass/halma/projects-iso-run-pass-halma.exp
@@ -0,0 +1,40 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2iso m2pim"
+gm2_init_iso
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/projects/iso/run/pass/hello/hello.mod b/gcc/testsuite/gm2/projects/iso/run/pass/hello/hello.mod
new file mode 100644
index 00000000000..f08d248a61b
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/run/pass/hello/hello.mod
@@ -0,0 +1,7 @@
+MODULE hello ;
+
+FROM STextIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString ("hello world using the ISO libraries") ; WriteLn
+END hello.
diff --git a/gcc/testsuite/gm2/projects/iso/run/pass/hello/projects-iso-run-pass-hello.exp b/gcc/testsuite/gm2/projects/iso/run/pass/hello/projects-iso-run-pass-hello.exp
new file mode 100644
index 00000000000..304cd39d79d
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/iso/run/pass/hello/projects-iso-run-pass-hello.exp
@@ -0,0 +1,40 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2iso m2pim"
+gm2_init_iso
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/projects/log/run/pass/hello/hello.mod b/gcc/testsuite/gm2/projects/log/run/pass/hello/hello.mod
new file mode 100644
index 00000000000..53e301f9ddf
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/log/run/pass/hello/hello.mod
@@ -0,0 +1,7 @@
+MODULE hello ;
+
+FROM InOut IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString ("hello world from the pim compatible libraries") ; WriteLn
+END hello.
diff --git a/gcc/testsuite/gm2/projects/log/run/pass/hello/projects-log-run-pass-hello.exp b/gcc/testsuite/gm2/projects/log/run/pass/hello/projects-log-run-pass-hello.exp
new file mode 100644
index 00000000000..a9474fcb692
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/log/run/pass/hello/projects-log-run-pass-hello.exp
@@ -0,0 +1,40 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+# gm2_link_lib "m2log m2pim m2iso"
+gm2_init_log
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/hello/hello.mod b/gcc/testsuite/gm2/projects/pim/run/pass/hello/hello.mod
new file mode 100644
index 00000000000..554ab2aa95a
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/hello/hello.mod
@@ -0,0 +1,7 @@
+MODULE hello ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString ("hello world from the core pim libraries") ; WriteLn
+END hello.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/hello/projects-pim-run-pass-hello.exp b/gcc/testsuite/gm2/projects/pim/run/pass/hello/projects-pim-run-pass-hello.exp
new file mode 100644
index 00000000000..cd97496d61f
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/hello/projects-pim-run-pass-hello.exp
@@ -0,0 +1,40 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2pim m2log m2iso"
+gm2_init_pim
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/AdvMap.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/AdvMap.def
new file mode 100644
index 00000000000..1e7281f7cd6
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/AdvMap.def
@@ -0,0 +1,107 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+DEFINITION MODULE AdvMap ;
+
+
+EXPORT QUALIFIED Rooms, Line, DoorStatus, Door, Room, Treasure,
+                 ActualNoOfRooms, MaxNoOfTreasures, MaxNoOfRooms,
+                 NoOfRoomsToHidePlayers, NoOfRoomsToSpring,
+                 NoOfRoomsToHideCoal, NoOfRoomsToHideGrenade,
+                 ReadAdvMap, Adjacent, IncPosition,
+                 FileName, MaxLengthOfFileName ;
+
+
+CONST
+   MaxNoOfRooms           = 350 ;
+   MaxWallsPerRoom        =   8 ;
+   MaxDoorsPerRoom        =   6 ;
+   MaxNoOfTreasures       =  15 ;
+   MaxLengthOfFileName    =  11 ;
+   NoOfRoomsToHidePlayers =  50 ;
+   NoOfRoomsToSpring      =  50 ;
+   NoOfRoomsToHideCoal    =  50 ;
+   NoOfRoomsToHideGrenade =  50 ;
+
+
+TYPE
+
+   Line         = RECORD
+                     X1 : CARDINAL ;
+                     Y1 : CARDINAL ;
+                     X2 : CARDINAL ;
+                     Y2 : CARDINAL
+                  END ;
+
+   DoorStatus   = (Open, Closed, Secret) ;
+
+   Door         = RECORD
+                     Position    : Line ;
+                     StateOfDoor : DoorStatus ;
+                     LeadsTo     : CARDINAL
+                  END ;
+
+   TreasureInfo = RECORD
+                     Xpos         : CARDINAL ;
+                     Ypos         : CARDINAL ;
+                     Rm           : CARDINAL ;
+                     Tweight      : CARDINAL ;
+                     TreasureName : ARRAY [0..12] OF CHAR
+                  END ;
+
+   Room         = RECORD
+                     RoomNo      : CARDINAL ;
+                     NoOfWalls   : CARDINAL ;
+                     NoOfDoors   : CARDINAL ;
+                     Walls       : ARRAY [1..MaxWallsPerRoom] OF Line ;
+                     Doors       : ARRAY [1..MaxDoorsPerRoom] OF Door ;
+                     Treasures   : BITSET ;
+                  END ;
+
+
+VAR
+   ActualNoOfRooms : CARDINAL ;
+   Treasure        : ARRAY [1..MaxNoOfTreasures] OF TreasureInfo ;
+   Rooms           : ARRAY [1..MaxNoOfRooms] OF Room ;
+
+   FileName        : ARRAY [0..MaxLengthOfFileName] OF CHAR ;
+
+
+(*
+   ReadAdvMap - read map, Name, into memory.
+                TRUE is returned if the operation was successful.
+*)
+
+PROCEDURE ReadAdvMap (Name: ARRAY OF CHAR) : BOOLEAN ;
+
+
+(*
+   Adjacent - tests to see if two rooms are Adjacent to each other.
+*)
+
+PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IncPosition - increments the position of x, y by the direction that are facing.
+*)
+
+PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
+
+
+END AdvMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/AdvMap.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/AdvMap.mod
new file mode 100644
index 00000000000..92b78552f8e
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/AdvMap.mod
@@ -0,0 +1,420 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+IMPLEMENTATION MODULE AdvMap ;
+
+IMPORT StdIO ;
+
+FROM Scan IMPORT WriteError, GetNextSymbol, OpenSource, CloseSource ;
+FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrLib IMPORT StrEqual, StrLen, StrCopy ;
+FROM ASCII IMPORT cr, lf, nul, EOL ;
+
+
+VAR
+   CurrentRoom  : CARDINAL ;
+   CurrentSymbol: ARRAY [0..20] OF CHAR ;
+   FatalError   : BOOLEAN ;
+
+
+(* IncPosition increments the x,y coordinates according  *)
+(* the Direction sent.                                   *)
+
+PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
+BEGIN
+   IF (Dir=0) AND (y>0)
+   THEN
+      DEC(y)
+   ELSIF Dir=3
+   THEN
+      INC(x)
+   ELSIF Dir=2
+   THEN
+      INC(y)
+   ELSIF x>0
+   THEN
+      DEC(x)
+   END
+END IncPosition ;
+
+
+
+(* Adjacent tests whether two rooms R1 & R2 are adjacent *)
+(* Assume that access to map has been granted.           *)
+
+PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
+VAR
+   i, r1, r2 : CARDINAL ;
+   ok: BOOLEAN ;
+BEGIN
+   WITH Rooms[R1] DO
+      i := NoOfDoors ;
+      ok := FALSE ;
+      WHILE (i>0) AND (NOT ok) DO
+         IF Doors[i].LeadsTo=R2
+         THEN
+            ok := TRUE
+         ELSE
+            DEC(i)
+         END
+      END
+   END ;
+   RETURN( ok )
+END Adjacent ;
+
+
+(* The following procedures test and read the syntax marking out the  *)
+(* map of the adventure game. Displaying syntactic errors if occurred *)
+
+(*
+   ReadAdvMap - read map, Name, into memory.
+                TRUE is returned if the operation was successful.
+*)
+
+PROCEDURE ReadAdvMap (Name: ARRAY OF CHAR) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   Success := OpenSource(Name) ;
+   IF Success
+   THEN
+      GetNextSymbol(CurrentSymbol) ;
+      WHILE (NOT StrEqual( CurrentSymbol, 'END.' )) AND (NOT FatalError) DO
+         ReadRoom ;
+         GetNextSymbol(CurrentSymbol)
+      END ;
+      CloseSource ;
+      Success := NOT FatalError
+   ELSE
+      WriteString('cannot open: ') ; WriteString(Name) ; WriteLn
+   END ;
+   RETURN( Success )
+END ReadAdvMap ;
+
+
+PROCEDURE ReadRoom ;
+BEGIN
+   IF NOT FatalError
+   THEN
+      IF NOT StrEqual( CurrentSymbol, 'ROOM' )
+      THEN
+         WriteError('ROOM --- Expected') ;
+         FatalError := TRUE
+      ELSE
+         GetNextSymbol(CurrentSymbol) ;
+         ReadRoomNo ;
+         IF (CurrentRoom<1) OR (CurrentRoom>MaxNoOfRooms)
+         THEN
+            WriteError('Out Of Range Error - Room No.') ;
+            FatalError := TRUE ;
+            WriteString('Non Recoverable Error') ;
+            WriteLn
+         ELSE
+            WITH Rooms[CurrentRoom] DO
+               Treasures := {} ;
+               NoOfWalls := 0 ;
+               NoOfDoors := 0 ;
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+
+            WHILE (NOT StrEqual( CurrentSymbol, 'END' )) AND
+                  (NOT FatalError) DO
+               IF StrEqual( CurrentSymbol, 'WALL' )
+               THEN
+                  ReadWall
+               ELSIF StrEqual( CurrentSymbol, 'DOOR' )
+               THEN
+                  ReadDoor
+               ELSIF StrEqual( CurrentSymbol, 'TREASURE' )
+               THEN
+                  ReadTreasure
+               ELSE
+                  WriteError('WALL, DOOR, TREASURE, END --- Expected') ;
+                  FatalError := TRUE ;
+                  GetNextSymbol(CurrentSymbol)
+               END
+            END
+         END
+      END
+   END
+END ReadRoom ;
+
+
+PROCEDURE ReadWall ;
+VAR
+   x1, y1,
+   x2, y2: CARDINAL ;
+BEGIN
+   IF NOT FatalError
+   THEN
+      GetNextSymbol(CurrentSymbol) ;
+      WITH Rooms[CurrentRoom] DO
+         REPEAT
+            INC( NoOfWalls ) ;
+            IF NoOfWalls>MaxWallsPerRoom
+            THEN
+               WriteError('MaxWallsPerRoom needs to be increased') ;
+               FatalError := TRUE ;
+               WriteString('Non Recoverable Error') ;
+               WriteLn
+            ELSE
+               ReadCard( x1 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( y1 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( x2 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( y2 ) ;
+
+               IF (x1#x2) AND (y1#y2)
+               THEN
+                  WriteError('Diagonal Wall --- Not Allowed') ;
+                  FatalError := TRUE
+               END ;
+
+               (* Always have the lowest value of x in x1 OR y in y1 *)
+
+               IF (x1<x2) OR (y1<y2)
+               THEN
+                  Walls[NoOfWalls].X1 := x1 ;
+                  Walls[NoOfWalls].Y1 := y1 ;
+                  Walls[NoOfWalls].X2 := x2 ;
+                  Walls[NoOfWalls].Y2 := y2
+               ELSE
+                  Walls[NoOfWalls].X1 := x2 ;
+                  Walls[NoOfWalls].Y1 := y2 ;
+                  Walls[NoOfWalls].X2 := x1 ;
+                  Walls[NoOfWalls].Y2 := y1
+               END
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+         UNTIL StrEqual( CurrentSymbol, 'WALL' ) OR
+               StrEqual( CurrentSymbol, 'DOOR' ) OR
+               StrEqual( CurrentSymbol, 'TREASURE' ) OR
+               StrEqual( CurrentSymbol, 'END' ) OR
+               FatalError ;
+      END ;
+   END
+END ReadWall ;
+
+
+PROCEDURE ReadDoor ;
+VAR
+   x1, y1,
+   x2, y2: CARDINAL ;
+BEGIN
+   IF NOT FatalError
+   THEN
+      GetNextSymbol(CurrentSymbol) ;
+      WITH Rooms[CurrentRoom] DO
+         REPEAT
+            INC( NoOfDoors ) ;
+            IF NoOfDoors>MaxDoorsPerRoom
+            THEN
+               WriteError('Out Of Range Error - Too Many Doors') ;
+               FatalError := TRUE ;
+               WriteString('Non Recoverable Error') ;
+               WriteLn
+            ELSE
+               ReadCard( x1 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( y1 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( x2 ) ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( y2 ) ;
+
+               IF (x1#x2) AND (y1#y2)
+               THEN
+                  WriteError('Diagonal Door --- Not Allowed') ;
+                  FatalError := TRUE
+               END ;
+
+               (* Always have the lowest value of x in x1 OR y in y1 *)
+
+               IF (x1<x2) OR (y1<y2)
+               THEN
+                  Doors[NoOfDoors].Position.X1 := x1 ;
+                  Doors[NoOfDoors].Position.Y1 := y1 ;
+                  Doors[NoOfDoors].Position.X2 := x2 ;
+                  Doors[NoOfDoors].Position.Y2 := y2
+               ELSE
+                  Doors[NoOfDoors].Position.X1 := x2 ;
+                  Doors[NoOfDoors].Position.Y1 := y2 ;
+                  Doors[NoOfDoors].Position.X2 := x1 ;
+                  Doors[NoOfDoors].Position.Y2 := y1
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               IF NOT StrEqual( CurrentSymbol, 'STATUS' )
+               THEN
+                  WriteError('STATUS --- Expected') ;
+                  FatalError := TRUE
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               IF StrEqual( CurrentSymbol, 'CLOSED' )
+               THEN
+                  Doors[NoOfDoors].StateOfDoor := Closed
+               ELSIF StrEqual( CurrentSymbol, 'SECRET' )
+               THEN
+                  Doors[NoOfDoors].StateOfDoor := Secret
+               ELSIF StrEqual( CurrentSymbol, 'OPEN' )
+               THEN
+                  Doors[NoOfDoors].StateOfDoor := Open
+               ELSE
+                  WriteError('Illegal Door Status')
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               IF NOT StrEqual( CurrentSymbol, 'LEADS' )
+               THEN
+                  WriteError('LEADS --- Expected') ;
+                  FatalError := TRUE
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               IF NOT StrEqual( CurrentSymbol, 'TO' )
+               THEN
+                  WriteError('TO --- Expected') ;
+                  FatalError := TRUE
+               END ;
+               GetNextSymbol(CurrentSymbol) ;
+               ReadCard( x1 ) ;
+               IF x1>MaxNoOfRooms
+               THEN
+                  WriteError('Out Of Range Error - Room No.') ;
+                  FatalError := TRUE
+               ELSE
+                  Doors[NoOfDoors].LeadsTo := x1
+               END
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+         UNTIL StrEqual( CurrentSymbol, 'DOOR' ) OR
+               StrEqual( CurrentSymbol, 'WALL' ) OR
+               StrEqual( CurrentSymbol, 'TREASURE' ) OR
+               StrEqual( CurrentSymbol, 'END' ) OR
+               FatalError ;
+      END
+   END
+END ReadDoor ;
+
+
+PROCEDURE ReadTreasure ;
+VAR
+   x, y, TreasureNo: CARDINAL ;
+BEGIN
+   IF NOT FatalError
+   THEN
+      GetNextSymbol(CurrentSymbol) ;
+      REPEAT
+         WITH Rooms[CurrentRoom] DO
+            IF NOT StrEqual( CurrentSymbol, 'AT' )
+            THEN
+               WriteError('AT --- Expected') ;
+               FatalError := TRUE
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+            ReadCard( x ) ;
+            GetNextSymbol(CurrentSymbol) ;
+            ReadCard( y ) ;
+            GetNextSymbol(CurrentSymbol) ;
+            IF NOT StrEqual( CurrentSymbol, 'IS' )
+            THEN
+               WriteError('IS --- Expected') ;
+               FatalError := TRUE
+            END ;
+            GetNextSymbol(CurrentSymbol) ;
+            ReadCard( TreasureNo ) ;
+
+            IF (TreasureNo<=MaxNoOfTreasures) AND (TreasureNo>0)
+            THEN
+               (* Tell Room about treasures *)
+
+               INCL( Treasures, TreasureNo ) ;
+
+               (* Tell Treasures about Treasures! and Room *)
+
+               Treasure[TreasureNo].Xpos := x ;
+               Treasure[TreasureNo].Ypos := y ;
+               Treasure[TreasureNo].Rm := CurrentRoom ;
+            ELSE
+               WriteError('Out Of Range Error - Treasure No.') ;
+               FatalError := TRUE
+            END
+         END ;
+         GetNextSymbol(CurrentSymbol) ;
+      UNTIL StrEqual( CurrentSymbol, 'WALL' ) OR
+            StrEqual( CurrentSymbol, 'DOOR' ) OR
+            StrEqual( CurrentSymbol, 'TREASURE' ) OR
+            StrEqual( CurrentSymbol, 'END' ) OR
+            FatalError ;
+   END
+END ReadTreasure ;
+
+
+PROCEDURE ReadRoomNo ;
+BEGIN
+   IF NOT FatalError
+   THEN
+      ReadCard( CurrentRoom ) ;
+      IF (CurrentRoom>0) AND (CurrentRoom<=MaxNoOfRooms)
+      THEN
+         IF CurrentRoom>ActualNoOfRooms
+         THEN
+            ActualNoOfRooms := CurrentRoom
+         END
+      END
+   END
+END ReadRoomNo ;
+
+
+PROCEDURE ReadCard (VAR c: CARDINAL) ;
+VAR
+   i    : CARDINAL ;
+   High : CARDINAL ;
+   ch   : CHAR ;
+BEGIN
+   IF NOT FatalError
+   THEN
+      i := 0 ;
+      c := 0 ;
+      High := HIGH(CurrentSymbol) ;
+      REPEAT
+         ch := CurrentSymbol[i] ;
+         IF (ch>='0') AND (ch<='9')
+         THEN
+            c := c*10+ORD(ch)-ORD('0')
+         ELSIF ch#nul
+         THEN
+            WriteError('Cardinal Number Expected') ;
+            FatalError := TRUE
+         END ;
+         INC( i ) ;
+      UNTIL (i>High) OR (ch=nul) ;
+   END
+END ReadCard ;
+
+
+PROCEDURE Init ;
+BEGIN
+   ActualNoOfRooms := 0 ;
+   FatalError := FALSE
+END Init ;
+
+
+BEGIN
+   Init
+END AdvMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/BoxMap.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/BoxMap.def
new file mode 100644
index 00000000000..3ca431c2bcf
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/BoxMap.def
@@ -0,0 +1,81 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+DEFINITION MODULE BoxMap ;
+
+(*
+   Title      : BoxMap
+   Author     : Gaius Mulley
+   Date       : 18/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Generates a simple random map full of boxes.
+                Box corridors and box rooms.
+                All boxes are contained in the array Boxes and
+                1..NoOfCorridorBoxes are the corridor boxes and
+                NoOfCorridorBoxes..NoOfBoxes are the room boxes.
+*)
+
+EXPORT QUALIFIED MaxBoxes, MaxX, MaxY,
+                 MaxDoorLength, MinDoorLength,
+                 CorridorWidth, CorridorDoorLength,
+                 TotalCorridorLength, MinDistanceBetweenCorridors,
+                 MaxCorridorLength, MinCorridorLength,
+                 MaxRoomLength, MinRoomLength,
+                 Box,
+                 Boxes,
+                 NoOfBoxes, NoOfCorridorBoxes,
+                 CreateBoxMap ;
+
+CONST
+   MaxBoxes =  500 ;
+   MaxX     =  120 ;  (* 38 ; *)
+   MaxY     =   80 ;  (* 24 ; *)
+
+   MaxDoorLength               =   3 ;
+   MinDoorLength               =   2 ;
+   CorridorWidth               =   7 ;  (* 4 ; *)
+   CorridorDoorLength          =   CorridorWidth-2 ;
+   TotalCorridorLength         =   (MaxX*3+MaxY*3) DIV 2 ;
+   MinDistanceBetweenCorridors =   CorridorWidth ;
+   MaxCorridorLength           =  70 ;  (* 70 ; *)
+   MinCorridorLength           =  15 ;  (* 8 ; *)
+   MaxRoomLength               =  13 ;
+   MinRoomLength               =   6 ;  (* 4 ; *)
+
+
+TYPE
+   Box    = RECORD
+               x1, y1,
+               x2, y2   : CARDINAL ;
+               RoomOfBox: CARDINAL ;
+            END ;
+
+VAR
+                      (* Box 0 is the boarder of the map.             *)
+   Boxes            : ARRAY [0..MaxBoxes] OF Box ;
+   NoOfCorridorBoxes: CARDINAL ;
+   NoOfBoxes        : CARDINAL ;
+
+
+(*
+   CreateBoxMap - builds a map with central corridors and ajoining rooms.
+*)
+
+PROCEDURE CreateBoxMap ;
+
+
+END BoxMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/BoxMap.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/BoxMap.mod
new file mode 100644
index 00000000000..f60f365ef24
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/BoxMap.mod
@@ -0,0 +1,1784 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+IMPLEMENTATION MODULE BoxMap ;
+
+(*
+   Title      : MakeMap
+   Author     : Gaius Mulley
+   Date       : 18/7/88
+   LastEdit   : 18/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Generates a simple random box map for Dungeon
+*)
+
+FROM MapOptions IMPORT isVerbose ;
+FROM StdIO IMPORT Write, Read ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard, ReadCard ;
+FROM Assertion IMPORT Assert ;
+
+FROM Geometry IMPORT IsSubLine, IsSubRange, IsIntersectingRange,
+                     IntersectionLength, IsPointOnLine, Abs, Min, Max ;
+
+FROM MakeBoxes IMPORT InitBoxes, KillBoxes,
+                      AddBoxes, GetAndDeleteRandomBox ;
+
+FROM StoreCoords IMPORT InitCoords, KillCoords,
+                        GetAndDeleteRandomCoord, AddCoord, CoordsExist ;
+
+FROM Chance IMPORT InitRandom, KillRandom,
+                   GetAndDeleteRandom, AddRandom,
+                   GetRand ;
+
+FROM Options IMPORT userX, userY,
+                    userMinRoomLength, userMaxRoomLength,
+		    userMinCorridorLength, userMaxCorridorLength,
+		    userTotalCorridorLength ;
+
+
+CONST
+   MaxCard  = MAX(CARDINAL) ;
+   MaxStack =  5000 ;
+
+TYPE
+   Square = RECORD
+               Contents    : (Empty, Secret, Door, Wall, Treasure) ;
+               RoomOfSquare: CARDINAL ;
+            END ;
+
+   Map      = ARRAY [1..MaxX], [1..MaxY] OF Square ;
+
+   StackEntity = RECORD
+                    PerimeterIndex  : CARDINAL ;  (* Untried Coords   *)
+                    BoxIndex        : CARDINAL ;  (* Untried boxes    *)
+                    OrientationIndex: CARDINAL ;  (* Untried orient's *)
+                 END ;
+
+VAR
+   CurrentMap       : Map ;
+   Stack            : ARRAY [1..MaxStack] OF StackEntity ;
+   StackPtr         : CARDINAL ;
+
+
+(*
+   MinDistanceBetweenRooms - returns the minimum distance between two rooms.
+*)
+
+PROCEDURE MinDistanceBetweenRooms () : CARDINAL ;
+BEGIN
+   RETURN userMinRoomLength-1
+END MinDistanceBetweenRooms ;
+
+
+(*
+   InitializeMap - Initializes CurrentMap.
+                   CurrentMap has its boarder set to a Wall and middle
+                   is set to Empty.
+*)
+
+PROCEDURE InitializeMap ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   FOR i := 1 TO userX DO
+      FOR j := 1 TO userY DO
+         WITH CurrentMap[i, j] DO
+            Contents := Empty ;
+            RoomOfSquare := 0
+         END
+      END
+   END
+END InitializeMap ;
+
+
+(*
+   Init - Initialize the module and start the generation of a map.
+*)
+
+PROCEDURE Init ;
+BEGIN
+   NoOfBoxes := 0 ;
+   (* Initialize box 0 the edge of the map *)
+   WITH Boxes[0] DO
+      x1 := 1 ;
+      x2 := userX ;
+      y1 := 1 ;
+      y2 := userY
+   END ;
+   StackPtr := 0
+END Init ;
+
+
+(*
+   CreateBoxMap - builds a map with central corridors and ajoining rooms.
+*)
+
+PROCEDURE CreateBoxMap ;
+BEGIN
+   Init ;
+   CorridorMap ;
+   RoomMap
+END CreateBoxMap ;
+
+
+(*
+   CorridorMap - makes a map based arround central corridors.
+*)
+
+PROCEDURE CorridorMap ;
+BEGIN
+   CreateCorridors ;
+   NoOfCorridorBoxes := NoOfBoxes
+END CorridorMap ;
+
+
+(*
+   CleanUpStack - cleans up the temporary stack where alternative rooms were
+                  stored but are no longer needed.
+*)
+
+PROCEDURE CleanUpStack ;
+BEGIN
+   WHILE StackPtr>0 DO
+      WITH Stack[StackPtr] DO
+         KillBoxes(BoxIndex) ;
+         KillCoords(PerimeterIndex) ;
+         KillRandom(OrientationIndex)
+      END ;
+      DEC(StackPtr)
+   END
+END CleanUpStack ;
+
+
+(*
+   RoomMap - creates the rooms on the map which fill in space left by the
+             corridors.
+*)
+
+PROCEDURE RoomMap ;
+BEGIN
+   IF isVerbose ()
+   THEN
+      WriteString('Starting Room building') ; WriteLn
+   END ;
+   CreateRooms
+END RoomMap ;
+
+
+(*
+   CreateCorridors - creates a length of corridor on the map.
+*)
+
+PROCEDURE CreateCorridors ;
+VAR
+   Length,
+   LengthLeft: CARDINAL ;
+BEGIN
+   LengthLeft := userTotalCorridorLength ;
+   InitBoxCorridor ;  (* Place new Box on the stack *)
+   REPEAT
+      IF MakeCorridor()
+      THEN
+         WITH Boxes[NoOfBoxes] DO
+            Length := Max(Abs(x1, x2), Abs(y1, y2))
+         END ;
+         IF LengthLeft>Length
+         THEN
+            DEC(LengthLeft, Length) ;
+            InitBoxCorridor   (* Place new corridors on the stack *)
+         ELSE
+            LengthLeft := 0   (* All done *)
+         END
+      ELSE
+         IF StackPtr>0
+         THEN
+            (* Retract last corridor and try another *)
+            WriteString('backtracking, cannot place corridors onto an empty map') ; WriteLn ;
+            WriteString('halting - quicker than backtracking') ; WriteLn ;
+            HALT ;
+            WITH Boxes[NoOfBoxes] DO
+               INC(LengthLeft, Max(Abs(x1, x2), Abs(y1, y2)))
+            END ;
+            KillBox ;
+            UnMakeBox
+         ELSE
+            WriteString('run out of ideas! userMaxCorridorLength is too large!') ;
+            WriteLn ;
+            LengthLeft := 0    (* Fail safe exit *)
+         END
+      END
+   UNTIL LengthLeft=0
+END CreateCorridors ;
+
+
+(*
+   CreateRooms - places rooms inbetween the corridors on the map.
+*)
+
+PROCEDURE CreateRooms ;
+VAR
+   Finished: BOOLEAN ;
+BEGIN
+   InitBoxRoom ;
+   Finished := FALSE ;
+   REPEAT
+      IF MakeRoom()
+      THEN
+         InitBoxRoom ;
+         Finished := NOT CoordsExist(Stack[StackPtr].PerimeterIndex)
+      ELSE
+         Finished := TRUE ;
+(*
+         IF StackPtr>0
+         THEN
+            (* Retract last room and try another *)
+            WriteString('Backtracking room') ; WriteLn ;
+            KillBox ;
+            UnMakeBox
+         ELSE
+            WriteString('Run out of ideas! Trying to create rooms!') ;
+            WriteLn ;
+         END
+*)
+      END
+   UNTIL Finished ;
+END CreateRooms ;
+
+
+(*
+   MakeCorridor - returns true if a corridor was legally placed
+                  onto the map.
+*)
+
+PROCEDURE MakeCorridor () : BOOLEAN ;
+VAR
+   Success   : BOOLEAN ;
+   x, y      : CARDINAL ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      (*
+         Perimeter has been previously pushed.
+         We now try to place a piece of corridor
+         on a selected perimeter coordinate.
+      *)
+      Success := FALSE ;
+      REPEAT
+         GetAndDeleteRandomCoord(PerimeterIndex, x, y) ;
+         x := Min(x, userX) ;
+         y := Min(y, userY) ;
+         IF x#0  (* x=0 means no more coordinates to fetch *)
+         THEN
+            Success := PutCorridorOntoMap(x, y)
+         END
+      UNTIL Success OR (x=0)    (* x=0 and y=0 means no coordinates left *)
+                                (* when x=0  y is also 0.                *)
+   END ;
+   RETURN( Success )
+END MakeCorridor ;
+
+
+(*
+   MakeRoom - returns true if a room was legally placed
+              onto the map.
+*)
+
+PROCEDURE MakeRoom () : BOOLEAN ;
+VAR
+   Success   : BOOLEAN ;
+   x, y      : CARDINAL ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      (*
+         Perimeter has been previously pushed.
+         We now try to place a piece of corridor
+         on a selected perimeter coordinate.
+      *)
+      Success := FALSE ;
+      REPEAT
+         GetAndDeleteRandomCoord(PerimeterIndex, x, y) ;
+         IF x#0  (* x=0 means no more coordinates to fetch *)
+         THEN
+            Success := PutRoomOntoMap(x, y)
+         END
+      UNTIL Success OR (x=0)    (* x=0 and y=0 means no coordinates left *)
+                                (* when x=0  y is also 0.                *)
+   END ;
+   RETURN( Success )
+END MakeRoom ;
+
+
+(*
+   UnMakeBox - deletes the last box placed in the Box list.
+*)
+
+PROCEDURE UnMakeBox ;
+BEGIN
+(*
+   IF NoOfCorridorBoxes>0
+   THEN
+      FindSpaceNextToRoom
+   END ;
+*)
+   DEC(NoOfBoxes)
+END UnMakeBox ;
+
+
+(*
+   KillSurroundingBoxes - finds a pocket of space on the map and deletes
+                          all neighbouring boxes.
+*)
+
+(*
+PROCEDURE KillSurroundingBoxes ;
+VAR
+   x, y,
+   i, j,
+   Swap, b: CARDINAL ;
+BEGIN
+   GetFreeSpace(x, y) ;
+   i := x ;
+   j := y ;
+   Swap := NoOfBoxes ;
+   REPEAT
+      b := 1 ;
+      WHILE b<=Swap DO
+         IF IsPointOnBox(b, i, j)
+         THEN
+            SwapBox(b, Swap) ;
+            DEC(Swap)
+         END ;
+         INC(b)
+      END ;
+      WalkClockWise(i, j)
+   UNTIL (x=i) AND (y=j) ;
+   RenewBoxes(Swap, Swap)
+END KillSurroundingBoxes ;
+*)
+
+
+(*
+   SwapBox - swaps two boxes, i and j, arround on the stack.
+*)
+
+PROCEDURE SwapBox (i, j: CARDINAL) ;
+VAR
+   s: StackEntity ;
+   b: Box ;
+BEGIN
+   b := Boxes[i] ;
+   Boxes[i] := Boxes[j] ;
+   Boxes[j] := b ;
+   s := Stack[i] ;
+   Stack[i] := Stack[j] ;
+   Stack[j] := s
+END SwapBox ;
+
+
+(*
+   FindSpaceNextToRoom - finds a pocket of space on the map and places
+                         a room near this onto the top of the box stack.
+*)
+
+PROCEDURE FindSpaceNextToRoom ;
+VAR
+   t: Box ;
+   x, y, b, d,
+   Nearest,
+   Distance  : CARDINAL ;
+BEGIN
+   GetSpaceCoord(x, y) ;
+   Nearest := 1 ;
+   Distance := DistanceAppartPoint(1, x, y) ;
+   b := NoOfBoxes-1 ;
+   WHILE b>1 DO
+      d := DistanceAppartPoint(b, x, y) ;
+      IF d<Distance
+      THEN
+         Distance := d ;
+         Nearest := b
+      END ;
+      DEC(b)
+   END ;
+   SwapBox(Nearest, NoOfBoxes)
+END FindSpaceNextToRoom ;
+
+
+(*
+   GetSpaceCoord - Sets x and y to a coordinate which has no room on it.
+*)
+
+PROCEDURE GetSpaceCoord (VAR x, y: CARDINAL) ;
+VAR
+   Space: BOOLEAN ;
+BEGIN
+   Space := FALSE ;
+   x := 1 ;
+   WHILE (NOT Space) AND (x<=userX) DO
+      y := 1 ;
+      WHILE (NOT Space) AND (y<=userY) DO
+         IF NOT IsSpace(x, y)
+         THEN
+            INC(y)
+         ELSE
+            Space := TRUE
+         END
+      END ;
+      IF NOT Space
+      THEN
+         INC(x)
+      END
+   END
+END GetSpaceCoord ;
+
+
+(*
+   Reschedule - reorders boxes on the stack, all boxes that touch the
+                top box are placed n-1 n-2 etc on the stack,
+                efficient recursive backtracking!
+*)
+
+PROCEDURE Reschedule (Lowest: CARDINAL) ;
+VAR
+   b,
+   Swap: CARDINAL ;
+   t   : Box ;
+BEGIN
+   Swap := NoOfBoxes-1 ;
+   b := Lowest+1 ;
+   WITH Boxes[NoOfBoxes] DO
+      WHILE Swap>b DO
+         IF IsTouchingBox(b, x1, y1, x2, y2)
+         THEN
+            SwapBox(b, Swap) ;
+            INC(b)
+         END ;
+         DEC(Swap)
+      END
+   END
+END Reschedule ;
+
+
+(*
+   InitBoxCorridor - initializes a new corridor on the Stack,
+                     the perimeter of the map is also pushed.
+*)
+
+PROCEDURE InitBoxCorridor ;
+BEGIN
+   INC(StackPtr) ;
+   WITH Stack[StackPtr] DO
+      PerimeterIndex := InitCoords() ;
+      PushPerimeterOfBoxes(PerimeterIndex, FALSE) ;
+      OrientationIndex := 0 ;
+      BoxIndex := 0
+   END
+END InitBoxCorridor ;
+
+
+(*
+   InitBoxRoom - initializes a new corridor on the Stack,
+                 the perimeter of the map is also pushed.
+*)
+
+PROCEDURE InitBoxRoom ;
+BEGIN
+   (*
+      This is a really nasty kludge - because of memory space limitations
+      the StoreCoords module is pushed for space when creating large size
+      maps.
+      The kludge to get arround this is to kill all perimeter coordinates of the
+      previous box. This can be done since we never invoke backtracking
+      when creating boxrooms - but we may when we come up with a suitable
+      reliable algorithm, however, until then we can take advantage of
+      no backtracking and delete all perimeter coords of the last box.
+   *)
+   IF StackPtr>1
+   THEN
+      (* Ok delete perimeter coord *)
+      KillCoords(Stack[StackPtr].PerimeterIndex) ;
+      KillBoxes(Stack[StackPtr].BoxIndex)
+   END ;
+   (* All done - kludge over *)
+   INC(StackPtr) ;
+   WITH Stack[StackPtr] DO
+      PerimeterIndex := InitCoords() ;
+      PushPerimeterOfBoxes(PerimeterIndex, TRUE) ;
+      OrientationIndex := 0 ;
+      BoxIndex := 0
+   END
+END InitBoxRoom ;
+
+
+(*
+   KillBox - pops the last Box from the stack.
+*)
+
+PROCEDURE KillBox ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      KillCoords(PerimeterIndex)
+   END ;
+   DEC(StackPtr)
+END KillBox ;
+
+
+(*
+   PutCorridorOntoMap - returns true if it has placed a corridor
+                        onto a map.
+                        Otherwise no corridor has been placed onto
+                        this map.
+*)
+
+PROCEDURE PutCorridorOntoMap (x, y: CARDINAL) : BOOLEAN ;
+VAR
+   LenX,
+   LenY    : CARDINAL ;
+   Success : BOOLEAN ;
+BEGIN
+   CheckInitBoxCorridorIndex ;
+   WITH Stack[StackPtr] DO
+      Success := FALSE ;
+      REPEAT
+         IF GetBox(LenX, LenY)
+         THEN
+            Success := PlaceCorridorBox(x, y, LenX-1, LenY-1)
+         END
+      UNTIL Success OR (LenX=0) ;
+   END ;
+   CheckKillBoxIndex(LenX=0) ;
+   RETURN( Success )
+END PutCorridorOntoMap ;
+
+
+(*
+   PutRoomOntoMap - returns true if it has placed a room
+                    onto a map.
+                    Otherwise no room has been placed onto
+                    this map.
+*)
+
+PROCEDURE PutRoomOntoMap (x, y: CARDINAL) : BOOLEAN ;
+VAR
+   LenX,
+   LenY    : CARDINAL ;
+   Success : BOOLEAN ;
+BEGIN
+   CheckInitBoxRoomIndex ;
+   WITH Stack[StackPtr] DO
+      Success := FALSE ;
+      REPEAT
+         IF GetBox(LenX, LenY)
+         THEN
+            Success := PlaceRoomBox(x, y, LenX-1, LenY-1)
+         END
+      UNTIL Success OR (LenX=0) ;
+   END ;
+   CheckKillBoxIndex(LenX=0) ;
+   RETURN( Success )
+END PutRoomOntoMap ;
+
+
+(*
+   GetBox - returns true if a box can be returned.
+            It chooses one box from the box index,
+            from the stack.
+            The lengths of the Box are returned
+            in LengthX and LengthY.
+*)
+
+PROCEDURE GetBox (VAR LengthX, LengthY: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      GetAndDeleteRandomBox(BoxIndex, LengthX, LengthY)
+   END ;
+   RETURN(LengthX#0)        (* LengthX#0 means found legal size box *)
+END GetBox ;
+
+
+(*
+   CheckInitBoxCorridorIndex - checks to see whether the current
+                               stacked box needs
+                               a list of legal corridor sizes stacked.
+*)
+
+PROCEDURE CheckInitBoxCorridorIndex ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      IF BoxIndex=0
+      THEN
+         (* Without stacked box list of legal sized corridors *)
+         BoxIndex := InitBoxes() ;
+         AddBoxes(BoxIndex, userMinCorridorLength, CorridorWidth,
+                            userMaxCorridorLength, CorridorWidth) ;
+         AddBoxes(BoxIndex, CorridorWidth, userMinCorridorLength,
+                            CorridorWidth, userMaxCorridorLength)
+      END
+   END
+END CheckInitBoxCorridorIndex ;
+
+
+(*
+   CheckInitBoxRoomIndex - checks to see whether the current stack box
+                           needs a list of legal corridor sizes stacked.
+*)
+
+PROCEDURE CheckInitBoxRoomIndex ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      IF BoxIndex=0
+      THEN
+         (* Without stacked box list of legal sized rooms *)
+         BoxIndex := InitBoxes() ;
+         AddBoxes(BoxIndex,
+                  userMinRoomLength, userMinRoomLength,
+                  userMaxRoomLength, userMaxRoomLength)
+      END
+   END
+END CheckInitBoxRoomIndex ;
+
+
+(*
+   CheckKillBoxIndex - if NeedToKill is set then the list of boxes
+                       on the stack is killed.
+                       Ideally this procedure should be a macro.
+*)
+
+PROCEDURE CheckKillBoxIndex (NeedToKill: BOOLEAN) ;
+BEGIN
+   IF NeedToKill
+   THEN
+      WITH Stack[StackPtr] DO
+         KillBoxes(BoxIndex) ;
+         BoxIndex := 0
+      END
+   END
+END CheckKillBoxIndex ;
+
+
+(*
+   PlaceCorridorBox - returns true if a box can make a corridor at
+                      position x, y.
+                      All 4 orientations are tried.
+
+
+                              2  1
+                              4  3
+
+                      Ie  1:  (x, y) (x+LenX, y+LenY)
+                          2:  (x, y) (x-LenX, y+LenY)
+                          3:  (x, y) (x+LenX, y-LenY)
+                          4:  (x, y) (x-LenX, y-LenY)
+*)
+
+PROCEDURE PlaceCorridorBox (x, y: CARDINAL; LenX, LenY: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+   i      : CARDINAL ;
+BEGIN
+   CheckInitOrientationIndex ;
+   WITH Stack[StackPtr] DO
+      Success := FALSE ;
+      REPEAT
+         i := GetAndDeleteRandom(OrientationIndex) ;
+         CASE i OF
+
+         1:  Success := AttemptToPlaceCorridor(x, y, x+LenX, y+LenY) |
+
+         2:  IF x>LenX
+             THEN
+                Success := AttemptToPlaceCorridor(x-LenX, y, x, y+LenY)
+             END |
+
+         3:  IF y>LenY
+             THEN
+                Success := AttemptToPlaceCorridor(x, y-LenY, x+LenX, y)
+             END |
+
+         4:  IF (x>LenX) AND (y>LenY)
+             THEN
+                Success := AttemptToPlaceCorridor(x-LenX, y-LenY, x, y)
+             END
+
+         ELSE
+         END
+      UNTIL Success OR (i=0) ;
+   END ;
+   CheckKillOrientationIndex(i=0) ;
+   RETURN( Success )
+END PlaceCorridorBox ;
+
+
+(*
+   PlaceRoomBox - returns true if a box can make a corridor at
+                  position x, y.
+                  All 4 orientations are tried.
+
+
+                          2  1
+                          4  3
+
+                  Ie  1:  (x, y) (x+LenX, y+LenY)
+                      2:  (x, y) (x-LenX, y+LenY)
+                      3:  (x, y) (x+LenX, y-LenY)
+                      4:  (x, y) (x-LenX, y-LenY)
+*)
+
+PROCEDURE PlaceRoomBox (x, y: CARDINAL; LenX, LenY: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+   i      : CARDINAL ;
+BEGIN
+   CheckInitOrientationIndex ;
+   WITH Stack[StackPtr] DO
+      Success := FALSE ;
+      REPEAT
+         i := GetAndDeleteRandom(OrientationIndex) ;
+         CASE i OF
+
+         1:  Success := AttemptToPlaceRoom(x, y, x+LenX, y+LenY) |
+
+         2:  IF x>LenX
+             THEN
+                Success := AttemptToPlaceRoom(x-LenX, y, x, y+LenY)
+             END |
+
+         3:  IF y>LenY
+             THEN
+                Success := AttemptToPlaceRoom(x, y-LenY, x+LenX, y)
+             END |
+
+         4:  IF (x>LenX) AND (y>LenY)
+             THEN
+                Success := AttemptToPlaceRoom(x-LenX, y-LenY, x, y)
+             END
+
+         ELSE
+         END
+      UNTIL Success OR (i=0) ;
+   END ;
+   CheckKillOrientationIndex(i=0) ;
+   RETURN( Success )
+END PlaceRoomBox ;
+
+
+(*
+   CheckInitOrientationIndex - checks to see whether the current stacked
+                               entity needs a new orientation index to also
+                               be stacked.
+*)
+
+PROCEDURE CheckInitOrientationIndex ;
+BEGIN
+   WITH Stack[StackPtr] DO
+      IF OrientationIndex=0
+      THEN
+         OrientationIndex := InitRandom() ;
+         AddRandom(OrientationIndex, 4)
+      END
+   END
+END CheckInitOrientationIndex ;
+
+
+(*
+   CheckKillOrientationIndex - checks to see whether the current stacked
+                               entities orientation index needs to be
+                               deleted.
+                               This procedure ideally should be a macro..
+*)
+
+PROCEDURE CheckKillOrientationIndex (NeedToKill: BOOLEAN) ;
+BEGIN
+   IF NeedToKill
+   THEN
+      WITH Stack[StackPtr] DO
+         KillRandom(OrientationIndex) ;
+         OrientationIndex := 0
+      END
+   END
+END CheckKillOrientationIndex ;
+
+
+(*
+   PushPerimeterOfBoxes - pushes all the current perimeter of the box map onto
+                          the perimeter stack.
+*)
+
+PROCEDURE PushPerimeterOfBoxes (CoordIndex: CARDINAL; NoOpt: BOOLEAN) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF NoOfBoxes=0
+   THEN
+      (* Perimeter is center square in map *)
+      AddCoord(CoordIndex, userX DIV 2, userY DIV 2)
+   ELSE
+      i := 1 ;
+      WHILE i<=NoOfBoxes DO
+         PushPerimeterOfWalls(CoordIndex, i, NoOpt) ;
+         INC(i)
+      END
+   END
+END PushPerimeterOfBoxes ;
+
+
+(*
+   PushPerimeterOfWalls - pushes all coordinates of a box wall which are
+                          external to the group of boxes.
+                          Ie any wall which does is not shared by an
+                          adjacent box MUST be external.
+                          NoOpt determines whether optimization should be
+                          applied to the restricting of perimeter coords.
+                          Optimiztion tests for the minimum size of a room
+                          to any wall, if this fails the coord is not added
+                          to the perimeter list.
+                          However this should not be used when pushing the
+                          room perimeter since optimization is too restrictive.
+                          (Corridor restrictions etc).
+*)
+
+PROCEDURE PushPerimeterOfWalls (CoordIndex: CARDINAL; b: CARDINAL;
+                                NoOpt: BOOLEAN) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      FOR i := x1 TO x2 DO
+         IF IsExternalHorizWallPerimeter(b, i, y1) AND
+            (NoOpt OR IsEnoughSpacePointToBox(i, y1))
+         THEN
+            AddCoord(CoordIndex, i, y1)
+         END ;
+         IF IsExternalHorizWallPerimeter(b, i, y2) AND
+            (NoOpt OR IsEnoughSpacePointToBox(i, y2))
+         THEN
+            AddCoord(CoordIndex, i, y2)
+         END
+      END ;
+      FOR j := y1 TO y2 DO
+         IF IsExternalVertWallPerimeter(b, x1, j) AND
+            (NoOpt OR IsEnoughSpacePointToBox(x1, j))
+         THEN
+            AddCoord(CoordIndex, x1, j)
+         END ;
+         IF IsExternalVertWallPerimeter(b, x2, j) AND
+            (NoOpt OR IsEnoughSpacePointToBox(x2, j))
+         THEN
+            AddCoord(CoordIndex, x2, j)
+         END
+      END
+   END
+END PushPerimeterOfWalls ;
+
+
+(*
+   IsExternalHorizWallPerimeter - returns true if coordinates,
+                                  x and y are not on any Horiz
+                                  wall of any box except b.
+                                  This routine allows point z, y to be
+                                  on a Vertical wall, but NOT on another
+                                  Horizontal wall.
+*)
+
+PROCEDURE IsExternalHorizWallPerimeter (b: CARDINAL;
+                                        x, y: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   Found := FALSE ;
+   IF NOT IsCornerPerimeter(b, x, y)
+   THEN
+      i := 0 ;
+      WHILE (i<=NoOfBoxes) AND (NOT Found) DO
+         IF i#b
+         THEN
+            WITH Boxes[i] DO
+               IF IsPointOnLine(x, y, x1, y1, x2, y1)
+               THEN
+                  Found := TRUE
+               ELSIF IsPointOnLine(x, y, x1, y2, x2, y2)
+               THEN
+                  Found := TRUE
+               END
+            END
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END IsExternalHorizWallPerimeter ;
+
+
+(*
+   IsExternalVertWallPerimeter - returns true if coordinates,
+                                 x and y are not on any Vertical
+                                 wall of any box except b.
+                                 This routine allows point z, y to be
+                                 on a Horizontal wall, but NOT on another
+                                 Vertical wall.
+*)
+
+PROCEDURE IsExternalVertWallPerimeter (b: CARDINAL;
+                                       x, y: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   Found := FALSE ;
+   IF NOT IsCornerPerimeter(b, x, y)
+   THEN
+      i := 0 ;
+      WHILE (i<=NoOfBoxes) AND (NOT Found) DO
+         IF i#b
+         THEN
+            WITH Boxes[i] DO
+               IF IsPointOnLine(x, y, x1, y1, x1, y2)
+               THEN
+                  Found := TRUE
+               ELSIF IsPointOnLine(x, y, x2, y1, x2, y2)
+               THEN
+                  Found := TRUE
+               END
+            END
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END IsExternalVertWallPerimeter ;
+
+
+(*
+   AttemptToPlaceCorridor - attempts to place a corridor x1, y1  x2, y2
+                            onto the map.
+                            If it succeeds it returns true
+                            otherwise false
+*)
+
+PROCEDURE AttemptToPlaceCorridor (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   IF IsCorridorSatisfied(x1, y1, x2, y2)
+   THEN
+      AddBox(x1, y1, x2, y2) ;
+      Success := TRUE
+   ELSE
+      Success := FALSE
+   END ;
+   RETURN( Success )
+END AttemptToPlaceCorridor ;
+
+
+(*
+   AttemptToPlaceRoom - attempts to place a room x1, y1  x2, y2
+                        onto the map.
+                        If it succeeds it returns true
+                        otherwise false
+*)
+
+PROCEDURE AttemptToPlaceRoom (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   IF IsRoomSatisfied(x1, y1, x2, y2)
+   THEN
+      AddBox(x1, y1, x2, y2) ;
+      Success := TRUE
+   ELSE
+      Success := FALSE
+   END ;
+   RETURN( Success )
+END AttemptToPlaceRoom ;
+
+
+(*
+   IsCorridorSatisfied - returns true if a Corridor x1, y1  x2, y2
+                         may be placed onto the map without
+                         contraveining the various rules.
+*)
+
+PROCEDURE IsCorridorSatisfied (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   (* Put(x1, y1, x2, y2) ; *)
+   IF (x2>userX) OR (y2>userY)
+   THEN
+      (* WriteString('Failed SIZE') ; WriteLn *)
+      Success := FALSE
+   ELSIF NOT DistanceAppartEdge(x1, y1, x2, y2)
+   THEN
+      Success := FALSE
+   ELSIF IsOverLappingBox(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed OVERLAP') ; *)
+      Success := FALSE
+   ELSIF NOT IsCorridorJoin(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed CORRIDOR JOIN') ; *)
+      Success := FALSE
+   ELSIF NOT IsEnoughSpaceBetweenCorridors(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed SPACE') ; *)
+      Success := FALSE
+   ELSE
+      Success := TRUE
+   END ;
+   RETURN( Success )
+END IsCorridorSatisfied ;
+
+
+(*
+   IsRoomSatisfied - returns true if a box x1, y1  x2, y2
+                     may be placed onto the map without
+                     contraveining the various rules.
+*)
+
+PROCEDURE IsRoomSatisfied (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   (* Put(x1, y1, x2, y2) ; *)
+   IF (x2>userX) OR (y2>userY)
+   THEN
+      (* WriteString('Failed SIZE') ; WriteLn ; *)
+      Success := FALSE
+   ELSIF IsOverLappingBox(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed OVERLAP') ; *)
+      Success := FALSE
+   ELSIF NOT DistanceAppartEdge(x1, y1, x2, y2)
+   THEN
+      Success := FALSE
+   ELSIF NOT IsBoxRoomLegal(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed Legal') ; *)
+      Success := FALSE
+   ELSIF NOT IsRoomJoin(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed ROOM JOIN') ; *)
+      Success := FALSE
+   ELSIF NOT IsEnoughSpaceBetweenRooms(x1, y1, x2, y2)
+   THEN
+      (* WriteString('Failed SPACE') ; *)
+      Success := FALSE
+   ELSE
+      Success := TRUE
+      (* ; WriteString('SUCCESS') ; *)
+   END ;
+   RETURN( Success )
+END IsRoomSatisfied ;
+
+
+(*
+   IsEnoughSpacePointToBox - returns true if there is enough space
+                             between a point, x, y and all the boxes.
+                             This routine is called before perimeter
+                             coordinates are pushed, therefore coordinates
+                             pushed are not doomed to failure due to lack
+                             of space.
+                             This routine consists of a reduced
+                             IsEnoughSpaceBetweenBoxes procedure.
+*)
+
+PROCEDURE IsEnoughSpacePointToBox (x, y: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   i       : CARDINAL ;
+   Distance: CARDINAL ;
+BEGIN
+   ok := TRUE ;
+   i := 0 ;  (* 0 = Perimeter of map *)
+   WHILE ok AND (i<=NoOfBoxes) DO
+      Distance := DistanceAppartPoint(i, x, y) ;
+      IF Distance#0
+      THEN
+         ok := (Distance>=MinDistanceBetweenRooms())
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsEnoughSpacePointToBox ;
+
+
+(*
+   IsEnoughSpaceBetweenCorridors - returns true if there is enough
+                                   space between box x1, y1  x2, y2
+                                   and the other boxes.
+                                   Also tests for right angle connection.
+*)
+
+PROCEDURE IsEnoughSpaceBetweenCorridors (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   i       : CARDINAL ;
+   Distance: CARDINAL ;
+BEGIN
+   ok := TRUE ;
+   i := 1 ;
+   WHILE ok AND (i<=NoOfBoxes) DO
+      IF IsTouchingBox(i, x1, y1, x2, y2)
+      THEN
+         (* Check for a box that is not at right angles to new box. *)
+         (* We are only allowed to touch a box at right angles.     *)
+         IF NOT IsDifferentOrientationBox(i, x1, y1, x2, y2)
+         THEN
+            (* touching a box which is not at right angles *)
+            ok := FALSE
+         END
+      ELSIF FreeSpace(i, x1, y1, x2, y2)
+      THEN
+         Distance := DistanceAppartBox(i, x1, y1, x2, y2) ;
+(*
+      Distance := Min(
+                       DistanceAppartBox(i, x1, y1, x2, y2),
+                       DistanceAppartDiagonal(i, x1, y1, x2, y2)
+                     ) ;
+*)
+         IF Distance=0
+         THEN
+         ELSE
+            ok := (Distance>=MinDistanceBetweenCorridors)
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsEnoughSpaceBetweenCorridors ;
+
+
+(*
+   IsBoxRoomLegal - returns true if a box x1, y1, x2, y2 does not
+                    have a wall which is next to but not sharing
+                    another wall.
+*)
+
+PROCEDURE IsBoxRoomLegal (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   i       : CARDINAL ;
+   Distance: CARDINAL ;
+   CoveredN,
+   CoveredS,
+   CoveredE,
+   CoveredW: BOOLEAN ;
+BEGIN
+   CoveredN := IsFullyCovered(x1, y2, x2, y2) ;
+   CoveredS := IsFullyCovered(x1, y1, x2, y1) ;
+   CoveredE := IsFullyCovered(x2, y1, x2, y2) ;
+   CoveredW := IsFullyCovered(x1, y1, x1, y2) ;
+   ok := TRUE ;
+   i := 1 ;
+   WHILE ok AND (i<=NoOfBoxes) DO
+      IF NOT IsTouchingBox(i, x1, y1, x2, y2)
+      THEN
+         IF (x1>1) AND (NOT CoveredW)
+         THEN
+            ok := NOT IsTouchingBox(i, x1-1, y1, x2, y2)
+         END ;
+         IF ok AND (y1>1) AND (NOT CoveredS)
+         THEN
+            ok := NOT IsTouchingBox(i, x1, y1-1, x2, y2)
+         END ;
+         IF ok AND (x2<userX) AND (NOT CoveredE)
+         THEN
+            ok := NOT IsTouchingBox(i, x1, y1, x2+1, y2)
+         END ;
+         IF ok AND (y2<userY) AND (NOT CoveredN)
+         THEN
+            ok := NOT IsTouchingBox(i, x1, y1, x2, y2+1)
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsBoxRoomLegal ;
+
+
+(*
+   IsFullyCovered - returns true if every point on the line
+                    x1, y1, x2, y2 is covered. The line must
+                    either be horizontal or vertical.
+*)
+
+PROCEDURE IsFullyCovered (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   i      : CARDINAL ;
+   Covered: BOOLEAN ;
+BEGIN
+   Covered := TRUE ;
+   IF x1=x2
+   THEN
+      (* Vertical *)
+      i := y1 ;
+      WHILE Covered AND (i<=y2) DO
+         Covered := IsSpace(x1, i) ;
+         INC(i)
+      END
+   ELSIF y1=y2
+   THEN
+      (* Horizontal *)
+      i := x1 ;
+      WHILE Covered AND (i<=x2) DO
+         Covered := IsSpace(i, y1) ;
+         INC(i)
+      END
+   END ;
+   RETURN( Covered )
+END IsFullyCovered ;
+
+
+(*
+   IsEnoughSpaceBetweenRooms - returns true if there is enough
+                               space between box x1, y1  x2, y2
+                               and the other boxes.
+*)
+
+PROCEDURE IsEnoughSpaceBetweenRooms (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   i       : CARDINAL ;
+   Distance: CARDINAL ;
+BEGIN
+   ok := TRUE ;
+   i := 1 ;
+   WHILE ok AND (i<=NoOfBoxes) DO
+      IF NOT IsTouchingBox(i, x1, y1, x2, y2)
+      THEN
+         (* Dont test the walls of the box for contraveining the space rule *)
+(*
+         IF (x1+1<x2-1) AND (y1+1<y2-1) AND FreeSpace(i, x1+1, y1+1, x2-1, y2-1)
+         THEN
+            Distance := DistanceAppartDiagonal(i, x1+1, y1+1, x2-1, y2-1) ;
+*)
+         IF FreeSpace(i, x1, y1, x2, y2)
+         THEN
+(*
+            Distance := DistanceAppartDiagonal(i, x1, y1, x2, y2) ;
+*)
+            Distance := Max( DistanceAppartDiagonal(i, x1, y1, x2, y2),
+                             DistanceAppartBox(i, x1, y1, x2, y2) ) ;
+            (* WriteString('Dist') ; WriteCard(Distance, 6) ; WriteLn ; *)
+            IF Distance=0
+            THEN
+               (* touching a box *)
+            ELSE
+               Assert(NOT IsTouchingBox(i, x1, y1, x2, y2)) ;
+               ok := (Distance>=MinDistanceBetweenRooms())
+            END
+         END
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsEnoughSpaceBetweenRooms ;
+
+
+(*
+   FreeSpace - returns true if there exists free space between box
+               X1, Y1, X2, Y2 and box b.
+               Should not be called if box b touches X1, Y1, X2, Y2.
+*)
+
+PROCEDURE FreeSpace (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+VAR
+   Free  : BOOLEAN ;
+   xs, xe,
+   ys, ye,
+   i, j  : CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      IF Abs(X1, x2)<Abs(X2, x1)
+      THEN
+         xs := Min(X1, x2) ;
+         xe := Max(X1, x2)
+      ELSE
+         xs := Min(X2, x1) ;
+         xe := Max(X2, x1)
+      END ;
+      IF Abs(Y1, y2)<Abs(Y2, y1)
+      THEN
+         ys := Min(Y1, y2) ;
+         ye := Max(Y1, y2)
+      ELSE
+         ys := Min(Y2, y1) ;
+         ye := Max(Y2, y1)
+      END ;
+      Free := FALSE ;
+      i := xs ;
+      WHILE (NOT Free) AND (i<=xe) DO
+         j := ys ;
+         WHILE (NOT Free) AND (j<=ye) DO
+            Free := IsSpace(i, j) ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   END ;
+   (* IF Free THEN WriteString('FREE') END ; *)
+   RETURN( Free )
+END FreeSpace ;
+
+
+(*
+   IsSpace - returns true if point x, y is not in any box.
+             A wall is counted as in the box.
+*)
+
+PROCEDURE IsSpace (x, y: CARDINAL) : BOOLEAN ;
+VAR
+   b    : CARDINAL ;
+   InBox: BOOLEAN ;
+BEGIN
+   InBox := FALSE ;
+   b := 1 ;   (* Not zero of course !! *)
+   WHILE (NOT InBox) AND (b<=NoOfBoxes) DO
+      WITH Boxes[b] DO
+         InBox := IsSubRange(x1, x2, x) AND IsSubRange(y1, y2, y)
+      END ;
+      INC(b)
+   END ;
+   RETURN( NOT InBox )
+END IsSpace ;
+
+
+(*
+   DistanceAppartEdge - returns true if the box, x1, y1, x2, y2, is a
+                        required distance away from the edge of the
+                        map.
+                        Cannot use room zero for this test as we are inside
+                        it and may touch one wall but be too near another!
+*)
+
+PROCEDURE DistanceAppartEdge (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok      : BOOLEAN ;
+   Distance: CARDINAL ;
+BEGIN
+    ok := TRUE ;
+    Distance := Abs(x1, 1) ;
+    IF (Distance>0) AND ok
+    THEN
+       ok := (Distance>=MinDistanceBetweenRooms())
+    END ;
+    Distance := Abs(x2, userX) ;
+    IF (Distance>0) AND ok
+    THEN
+       ok := (Distance>=MinDistanceBetweenRooms())
+    END ;
+    Distance := Abs(y1, 1) ;
+    IF (Distance>0) AND ok
+    THEN
+       ok := (Distance>=MinDistanceBetweenRooms())
+    END ;
+    Distance := Abs(y2, userY) ;
+    IF (Distance>0) AND ok
+    THEN
+       ok := (Distance>=MinDistanceBetweenRooms())
+    END ;
+    RETURN( ok )
+END DistanceAppartEdge ;
+
+
+(*
+   DistanceAppartPoint - returns the distance appart between box, b,
+                         and point X, Y.
+*)
+
+PROCEDURE DistanceAppartPoint (b: CARDINAL; X, Y: CARDINAL) : CARDINAL ;
+VAR
+   Xmin,
+   Ymin: CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      IF IsSubRange(x1, x2, X)
+      THEN
+         Ymin := Min( Abs(y1, Y), Abs(y2, Y) )
+      ELSE
+         Ymin := MaxCard
+      END ;
+      IF IsSubRange(y1, y2, Y)
+      THEN
+         Xmin := Min( Abs(x1, X), Abs(x2, X) )
+      ELSE
+         Xmin := MaxCard
+      END
+   END ;
+   RETURN( Min(Xmin, Ymin) )
+END DistanceAppartPoint ;
+
+
+(*
+   DistanceAppartBox - returns the distance appart between box, b,
+                       and box X1, Y1, X2, Y2
+*)
+
+PROCEDURE DistanceAppartBox (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : CARDINAL ;
+VAR
+   Xmin,
+   Ymin: CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      IF IsIntersectingRange(x1, x2, X1, X2)
+      THEN
+         Ymin := Min(
+                      Min( Abs(y1, Y1), Abs(y2, Y2) ),
+                      Min( Abs(y1, Y2), Abs(Y1, y2) )
+                    )
+      ELSE
+         Ymin := MaxCard
+      END ;
+      IF IsIntersectingRange(y1, y2, Y1, Y2)
+      THEN
+         Xmin := Min(
+                      Min( Abs(x1, X1), Abs(x2, X2) ),
+                      Min( Abs(x1, X2), Abs(X1, x2) )
+                    )
+      ELSE
+         Xmin := MaxCard
+      END
+   END ;
+   RETURN( Min(Xmin, Ymin) )
+END DistanceAppartBox ;
+
+
+(*
+   DistanceAppartDiagonal - returns the diagonal
+                            distance appart between X1, Y1, X2, Y2
+                            and box b.
+*)
+
+PROCEDURE DistanceAppartDiagonal (b: CARDINAL;
+                                  X1, Y1, X2, Y2: CARDINAL) : CARDINAL ;
+BEGIN
+   WITH Boxes[b] DO
+      RETURN(
+              Min(
+                   Min( Abs(x1, X2), Abs(x2, X1) ),
+                   Min( Abs(y1, Y2), Abs(y2, Y1) )
+                 )
+            )
+   END
+END DistanceAppartDiagonal ;
+
+
+(*
+   IsCorridorJoin - returns true if a box corridor x1, y1  x2, y2
+                    joins another corridor at right angles without
+                    cutting off the potential corridor door.
+
+                    A corridor is thought of as
+
+                    ##########################
+                    |                        |
+                    |                        |
+                    ##########################
+
+                    and may only be placed together in a way such that
+                    they meet  -|  or  -  etc
+                                       |
+
+                    False is returned if this box corridor does not
+                    correctly form a T junction with another.
+*)
+
+PROCEDURE IsCorridorJoin (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok,
+   DoorFound: BOOLEAN ;
+   b        : CARDINAL ;
+BEGIN
+   ok := TRUE ;
+   IF NoOfBoxes=0
+   THEN
+      DoorFound := TRUE
+   ELSE
+      DoorFound := FALSE ;
+      b := 1 ;
+      WHILE ok AND (b<=NoOfBoxes) DO
+         (* WriteString('Box') ; WriteCard(b, 2) ; *)
+         IF IsTouchingBox(b, x1, y1, x2, y2)
+         THEN
+            (* WriteString('TouchingBox') ; *)
+            IF IsDifferentOrientationBox(b, x1, y1, x2, y2)
+            THEN
+               (* WriteString('Different Orientation') ; *)
+               IF NOT DoorFound
+               THEN
+                  DoorFound := IsCorridorWallJoinBox(b, x1, y1, x2, y2)
+               END
+               (* ; IF ok THEN WriteString('WallJoin') END ; *)
+            ELSE
+               ok := FALSE  (* Dont allow parallel corridors to touch *)
+            END
+         END ;
+         INC(b)
+      END
+   END ;
+   RETURN( ok AND DoorFound )
+END IsCorridorJoin ;
+
+
+(*
+   IsRoomJoin - returns true if a box room x1, y1  x2, y2
+                joins another room with enough space for a door.
+*)
+
+PROCEDURE IsRoomJoin (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   DoorFound: BOOLEAN ;
+   b        : CARDINAL ;
+BEGIN
+   IF NoOfBoxes=0
+   THEN
+      DoorFound := TRUE
+   ELSE
+      DoorFound := FALSE ;
+      b := 1 ;
+      WHILE (NOT DoorFound) AND (b<=NoOfBoxes) DO
+         (* WriteString('Box') ; WriteCard(b, 2) ; *)
+         IF IsTouchingBox(b, x1, y1, x2, y2)
+         THEN
+            IF NOT DoorFound
+            THEN
+               DoorFound := IsRoomWallJoinBox(b, x1, y1, x2, y2)
+            END
+         END ;
+         INC(b)
+      END
+   END ;
+   RETURN( DoorFound )
+END IsRoomJoin ;
+
+
+(*
+   IsCorridorWallJoinBox - returns true if box, b, and box X1, Y1  X2, Y2
+                           form a correct join ie covering the potential
+                           door.
+*)
+
+PROCEDURE IsCorridorWallJoinBox (b: CARDINAL;
+                                 X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+BEGIN
+   WITH Boxes[b] DO
+      Success := (((X1=x1) OR (X1=x2) OR (X2=x1) OR (X2=x2))
+                              AND IsSubLine(Y1, Y2, y1, y2)) OR
+                 (((Y1=y1) OR (Y1=y2) OR (Y2=y1) OR (Y2=y2))
+                              AND IsSubLine(X1, X2, x1, x2)) ;
+      RETURN( Success )
+   END
+END IsCorridorWallJoinBox ;
+
+
+(*
+   IsRoomWallJoinBox - returns true if box, b, and box X1, Y1  X2, Y2
+                       form a correct join ie covering the potential
+                       door.
+*)
+
+PROCEDURE IsRoomWallJoinBox (b: CARDINAL;
+                             X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+VAR
+   DoorWidth: CARDINAL ;
+BEGIN
+   DoorWidth := 0 ;
+   WITH Boxes[b] DO
+      IF (X1=x2) OR (x1=X2)
+      THEN
+         DoorWidth := IntersectionLength(Y1, Y2, y1, y2) ;
+         IF (IsSubRange(Y1, Y2, y1) OR IsSubRange(y1, y2, Y1)) AND (DoorWidth>1)
+         THEN
+            DEC(DoorWidth)
+         END ;
+         IF (IsSubRange(Y1, Y2, y2) OR IsSubRange(y1, y2, Y2)) AND (DoorWidth>1)
+         THEN
+            DEC(DoorWidth)
+         END
+      ELSIF (Y1=y2) OR (y1=Y2)
+      THEN
+         DoorWidth := IntersectionLength(X1, X2, x1, x2) ;
+         IF (IsSubRange(X1, X2, x1) OR IsSubRange(x1, x2, X1)) AND (DoorWidth>1)
+         THEN
+            DEC(DoorWidth)
+         END ;
+         IF (IsSubRange(X1, X2, x2) OR IsSubRange(x1, x2, X2)) AND (DoorWidth>1)
+         THEN
+            DEC(DoorWidth)
+         END
+      END ;
+      RETURN( DoorWidth>=MinDoorLength )
+   END
+END IsRoomWallJoinBox ;
+
+
+(*
+   IsDifferentOrientationBox - returns true if box b has a different
+                               orientation to box X1, Y1  X2, Y2.
+*)
+
+PROCEDURE IsDifferentOrientationBox (b: CARDINAL;
+                                     X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Boxes[b] DO
+      IF Abs(X1, X2) = Abs(Y1, Y2)
+      THEN
+         RETURN( TRUE )                        (* Square X1, Y1, X2, Y2 *)
+      ELSIF Abs(X1, X2) > Abs(Y1, Y2)
+      THEN
+         RETURN( Abs(x1, x2) <= Abs(y1, y2) )
+      ELSE
+         RETURN( Abs(x1, x2) >= Abs(y1, y2) )
+      END
+   END
+END IsDifferentOrientationBox ;
+
+
+(*
+   IsTouchingBox - returns true if a box X1, Y1  X2, Y2 touches box b
+                   or if it intersects with this box.
+*)
+
+PROCEDURE IsTouchingBox (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Boxes[b] DO
+      RETURN( NOT ((X2<x1) OR (X1>x2) OR (Y2<y1) OR (Y1>y2)) )
+   END
+END IsTouchingBox ;
+
+
+(*
+   IsCornerPerimeter - returns true if box, b, has a corner x, y which
+                       is a perimeter.
+*)
+
+PROCEDURE IsCornerPerimeter (b: CARDINAL; x, y: CARDINAL) : BOOLEAN ;
+VAR
+   Perimeter: BOOLEAN ;
+   i, j     : CARDINAL ;
+BEGIN
+   IF IsCorner(b, x, y)
+   THEN
+      Perimeter := FALSE ;
+      i := x-1 ;
+      j := y-1 ;
+      WHILE (NOT Perimeter) AND (i<=x+1) DO
+         j := y-1 ;
+         WHILE (NOT Perimeter) AND (j<=y+1) DO
+            IF IsSubRange(1, userX, i) AND IsSubRange(1, userY, j)
+            THEN
+               Perimeter := IsSpace(i, j)
+            END ;
+            INC(j, 2)
+         END ;
+         INC(i, 2)
+      END ;
+      RETURN( Perimeter )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsCornerPerimeter ;
+
+
+(*
+   IsCorner - returns true if box, b, has a corner x, y.
+*)
+
+PROCEDURE IsCorner (b: CARDINAL; x, y: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Boxes[b] DO
+      RETURN( ((x1=x) OR (x2=x)) AND ((y1=y) OR (y2=y)) )
+   END
+END IsCorner ;
+
+
+(*
+   IsOverLappingBox - returns true if box X1, Y1  X2, Y2 overlaps
+                      with another box NOT including edges touching.
+*)
+
+PROCEDURE IsOverLappingBox (X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+VAR
+   b    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   Found := FALSE ;
+   b := 1 ;
+   WHILE (NOT Found) AND (b<=NoOfBoxes) DO
+      WITH Boxes[b] DO
+         Found := IsIntersection(x1, y1, x2, y2, X1, Y1, X2, Y2)
+      END ;
+      INC(b)
+   END ;
+   RETURN( Found )
+END IsOverLappingBox ;
+
+
+(*
+   IsIntersection - returns true if two boxes x1, y1  x2, y2 intersects
+                    with X1, Y1  X2, Y2. Wall touching is allowed.
+*)
+
+PROCEDURE IsIntersection (x1, y1, x2, y2,
+                          X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( NOT ( (x2<=X1) OR (x1>=X2) OR (y2<=Y1) OR (y1>=Y2) ) )
+END IsIntersection ;
+
+
+(*
+   AddBox - adds a box to the list of boxes and
+            adds a box to the Map.
+*)
+
+PROCEDURE AddBox (X1, Y1, X2, Y2: CARDINAL) ;
+BEGIN
+   IF NoOfBoxes=MaxBoxes
+   THEN
+      WriteString('Too many boxes in Module MakeMap') ; WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfBoxes) ;
+      WITH Boxes[NoOfBoxes] DO
+         x1 := X1 ;
+         y1 := Y1 ;
+         x2 := X2 ;
+         y2 := Y2
+      END
+   END
+END AddBox ;
+
+
+(*
+   GetCh - waits for a character to be pressed.
+*)
+
+PROCEDURE GetCh ;
+VAR
+   ch: CHAR ;
+BEGIN
+   Read(ch)
+END GetCh ;
+
+
+BEGIN
+   Init
+END BoxMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/Chance.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/Chance.def
new file mode 100644
index 00000000000..59808b75981
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/Chance.def
@@ -0,0 +1,87 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+DEFINITION MODULE Chance ;
+
+(*
+   Title      : Chance
+   Author     : Gaius Mulley
+   Date       : 19/7/88
+   LastEdit   : 19/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Provides a set of utilities for random numbers.
+*)
+
+EXPORT QUALIFIED InitRandom, KillRandom,
+                 GetAndDeleteRandom, AddRandom, GetRand, GetSeed, SetSeed ;
+
+(*
+   InitRandom - Initializes a potential list of random numbers.
+                An index to this potential random number list is returned.
+*)
+
+PROCEDURE InitRandom () : CARDINAL ;
+
+
+(*
+   KillRandom - Kills a complete list of random numbers.
+*)
+
+PROCEDURE KillRandom (RandomListIndex: CARDINAL) ;
+
+
+(*
+   GetAndDeleteRandom - Returns a random number from the
+                        list and then it is deleted.
+                        Numbers 1..n will be returned if they exist,
+                        if 0 is returned then the list is empty.
+*)
+
+PROCEDURE GetAndDeleteRandom (RandomListIndex: CARDINAL) : CARDINAL ;
+
+
+(*
+   AddRandom - places a list of numbers 1..n into the specified list.
+*)
+
+PROCEDURE AddRandom (RandomListIndex: CARDINAL; n: CARDINAL) ;
+
+
+(*
+   GetRand - returns a number between 0..n-1.
+             This routine is independant from the above routines.
+*)
+
+PROCEDURE GetRand (n: CARDINAL) : CARDINAL ;
+
+
+(*
+   SetSeed - use, n, as the seed to pseudo random numbers.
+*)
+
+PROCEDURE SetSeed (n: CARDINAL) ;
+
+
+(*
+   GetSeed - return the seed used to create pseudo random numbers.
+*)
+
+PROCEDURE GetSeed () : CARDINAL ;
+
+
+END Chance.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/Chance.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/Chance.mod
new file mode 100644
index 00000000000..91c69d432bf
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/Chance.mod
@@ -0,0 +1,222 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
+                 2014, 2015, 2016, 2017
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+IMPLEMENTATION MODULE Chance ;
+
+
+FROM NumberIO IMPORT StrToCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+(* FROM Random IMPORT RandomCard ; *)
+
+
+CONST
+   MaxRand   = 65535 ;
+   MaxRandom =  8000 ;
+   MaxIndex  =   500 ;
+
+TYPE
+   Index  = RECORD
+               Start,               (* Start of the Random list *)
+               End  : CARDINAL ;    (* End of the Random list   *)
+            END ;
+
+VAR
+   RandomIndex: ARRAY [0..MaxIndex] OF Index ;
+   Random     : ARRAY [1..MaxRandom] OF CARDINAL ;
+   NoOfRandom : CARDINAL ;   (* Number of random numbers in array Coords *)
+   NoOfIndices: CARDINAL ;   (* Number of indices in RandomIndex         *)
+
+
+(*
+   InitRandom - Initializes a potential list of random numbers.
+                An index to this potential random number list is returned.
+*)
+
+PROCEDURE InitRandom () : CARDINAL ;
+BEGIN
+   IF NoOfIndices=MaxIndex
+   THEN
+      WriteString('Too many random list indices in Module Chance') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfIndices) ;
+      WITH RandomIndex[NoOfIndices] DO
+         Start := NoOfRandom+1 ;
+         End := 0
+      END ;
+      Add(NoOfIndices, 0) ;     (* Dummy random no. that we keep *)
+      RETURN(NoOfIndices)       (* for the life of this list.    *)
+   END
+END InitRandom ;
+
+
+(*
+   KillRandom - Kills a complete list of random numbers.
+*)
+
+PROCEDURE KillRandom (RandomListIndex: CARDINAL) ;
+BEGIN
+   IF NoOfIndices>0
+   THEN
+      (* Destroy index to Random list *)
+      WITH RandomIndex[RandomListIndex] DO
+         Start := 0 ;
+         End := 0
+      END ;
+      (*
+         If killed last Random index list see if we can garbage collect
+         previously killed middle indices.
+      *)
+      IF NoOfIndices=RandomListIndex
+      THEN
+         REPEAT
+            DEC(NoOfIndices)
+         UNTIL (NoOfIndices=0) OR (RandomIndex[NoOfIndices].Start#0)
+      END ;
+      NoOfRandom := RandomIndex[NoOfIndices].End
+   ELSE
+      WriteString('all Random lists have been killed - non balanced calls to InitRandom/KillRandom in module Chance') ;
+      WriteLn ;
+      HALT
+   END
+END KillRandom ;
+
+
+(*
+   AddRandom - places a list of numbers 1..n into the specified list.
+*)
+
+PROCEDURE AddRandom (RandomListIndex: CARDINAL; n: CARDINAL) ;
+BEGIN
+   WHILE n>0 DO
+      Add(RandomListIndex, n) ;
+      DEC(n)
+   END
+END AddRandom ;
+
+
+PROCEDURE Add (RandomListIndex: CARDINAL; i: CARDINAL) ;
+BEGIN
+   IF NoOfRandom=MaxRandom
+   THEN
+      WriteString('Too many random numbers in a list in Module Chance') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfRandom) ;
+      Random[NoOfRandom] := i ;
+      WITH RandomIndex[RandomListIndex] DO
+         End := NoOfRandom
+      END
+   END
+END Add ;
+
+
+(*
+   GetAndDeleteRandom - Returns a random number from the
+                        list and then it is deleted.
+*)
+
+PROCEDURE GetAndDeleteRandom (RandomListIndex: CARDINAL) : CARDINAL ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH RandomIndex[RandomListIndex] DO
+      i := Start+GetRand(End-Start+1) ;  (* +1 for GetRand *)
+      j := i ;
+      REPEAT
+         IF Random[j]=0
+         THEN
+            INC(j) ;
+            IF j>End
+            THEN
+               j := Start
+            END
+         END
+      UNTIL (j=i) OR (Random[j]#0) ;
+      i := Random[j] ;
+      Random[j] := 0        (* Now delete this box *)
+   END ;
+   RETURN( i )
+END GetAndDeleteRandom ;
+
+
+(*
+   GetRand - returns a number between 0..n-1.
+             This routine is independant of the above routines.
+*)
+
+VAR
+   RandomSeed: CARDINAL ;
+   Num       : ARRAY [0..9] OF CHAR ;
+
+PROCEDURE GetRand (n: CARDINAL) : CARDINAL ;
+BEGIN
+   (* $R- *)
+   RandomSeed := (RandomSeed*257 + 0ABCDH) MOD MaxRand ;
+   (* $R= *)
+   RETURN( RandomSeed MOD n )
+(*
+   IF n<2
+   THEN
+      RETURN( 0 )  (* return 0  if n=0  or n=1 *)
+   ELSE
+      RETURN( RandomCard(n) )
+   END
+*)
+END GetRand ;
+
+
+(*
+   SetSeed - use, n, as the seed to pseudo random numbers.
+*)
+
+PROCEDURE SetSeed (n: CARDINAL) ;
+BEGIN
+   RandomSeed := n
+END SetSeed ;
+
+
+(*
+   GetSeed - return the seed used to create pseudo random numbers.
+*)
+
+PROCEDURE GetSeed () : CARDINAL ;
+BEGIN
+   RETURN RandomSeed
+END GetSeed ;
+
+
+
+PROCEDURE Init ;
+BEGIN
+   NoOfRandom := 0 ;
+   NoOfIndices := 0 ;
+   WITH RandomIndex[NoOfIndices] DO
+      End := 0
+   END ;
+   RandomSeed := 3
+END Init ;
+
+
+BEGIN
+   Init
+END Chance.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/Geometry.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/Geometry.def
new file mode 100644
index 00000000000..8e2ed7638de
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/Geometry.def
@@ -0,0 +1,100 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+DEFINITION MODULE Geometry ;
+
+(*
+   Title      : Geometry
+   Author     : Gaius Mulley
+   Date       : 20/8/88
+   LastEdit   : 20/8/88
+   System     : LOGITECH MODULA-2/86
+   Description: Defines some commonly used geometrical functions.
+*)
+
+EXPORT QUALIFIED IsSubLine, IsSubRange, IsIntersectingRange,
+                 IntersectionLength, IsPointOnLine,
+                 Abs, Min, Max, Swap ;
+
+
+(*
+   IsSubLine - returns true if the range i1..i2 or j1..j2 are ranges
+               of each other.
+*)
+
+PROCEDURE IsSubLine (i1, i2, j1, j2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsSubRange - returns true if i lies inbetween High and Low.
+*)
+
+PROCEDURE IsSubRange (Low, High, i: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IsIntersectingRange - returns true if the ranges i1..i2  j1..j2
+                         overlap.
+*)
+
+PROCEDURE IsIntersectingRange (i1, i2, j1, j2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   IntersectionLength - returns the intersection length
+                        of the overlapping ranges i1..i2  j1..j2.
+*)
+
+PROCEDURE IntersectionLength (i1, i2, j1, j2: CARDINAL) : CARDINAL ;
+
+
+(*
+   IsPointOnLine - returns true if point x, y is on line (x1, y1) , (x2, y2)
+*)
+
+PROCEDURE IsPointOnLine (x, y: CARDINAL; x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Max - returns the largest cardinal number from i and j.
+*)
+
+PROCEDURE Max (i, j: CARDINAL) : CARDINAL ;
+
+
+(*
+   Min - returns the smallest cardinal number from i and j.
+*)
+
+PROCEDURE Min (i, j: CARDINAL) : CARDINAL ;
+
+
+(*
+   Abs - returns the difference between i and j.
+*)
+
+PROCEDURE Abs (i, j: CARDINAL) : CARDINAL ;
+
+
+(*
+   Swap - swaps two cardinal numbers i and j.
+*)
+
+PROCEDURE Swap (VAR i, j: CARDINAL) ;
+
+
+END Geometry.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/Geometry.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/Geometry.mod
new file mode 100644
index 00000000000..9062f9bdde7
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/Geometry.mod
@@ -0,0 +1,155 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+IMPLEMENTATION MODULE Geometry ;
+
+
+FROM Assertion IMPORT Assert ;
+
+
+(*
+   IsSubLine - returns true if the range i1..i2 or j1..j2 are ranges
+               of each other.
+*)
+
+PROCEDURE IsSubLine (i1, i2, j1, j2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( ((i1<=j1) AND (i2>=j2)) OR ((j1<=i1) AND (j2>=i2)) )
+END IsSubLine ;
+
+
+(*
+   IsIntersectingRange - returns true if the ranges i1..i2  j1..j2
+                         overlap.
+*)
+
+PROCEDURE IsIntersectingRange (i1, i2, j1, j2: CARDINAL) : BOOLEAN ;
+BEGIN
+   (* Easier to prove NOT outside limits!! *)
+   RETURN( NOT ((i1>j2) OR (i2<j1)) )
+END IsIntersectingRange ;
+
+
+(*
+   IntersectionLength - returns the intersection length
+                        of the overlapping ranges i1..i2  j1..j2.
+*)
+
+PROCEDURE IntersectionLength (i1, i2, j1, j2: CARDINAL) : CARDINAL ;
+BEGIN
+   IF IsSubRange(i1, i2, j1)
+   THEN
+      RETURN( Abs(j1, Min(i2, j2)) )
+   ELSIF IsSubRange(i1, i2, j2)
+   THEN
+      RETURN( Abs(Max(i1, j1), j2) )
+   ELSE
+      RETURN( 0 )
+   END
+END IntersectionLength ;
+
+
+(*
+   IsPointOnLine - returns true if point x, y is on line (x1, y1) , (x2, y2)
+*)
+
+PROCEDURE IsPointOnLine (x, y: CARDINAL; x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF (x1=x2) AND (x=x1)
+   THEN
+      RETURN( IsSubRange(y1, y2, y) )
+   ELSIF (y1=y2) AND (y=y1)
+   THEN
+      RETURN( IsSubRange(x1, x2, x) )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsPointOnLine ;
+
+
+(*
+   IsSubRange - returns true if i lies inbetween High and Low.
+*)
+
+PROCEDURE IsSubRange (Low, High, i: CARDINAL) : BOOLEAN ;
+BEGIN
+   Assert(High>=Low) ;
+   RETURN( (i>=Low) AND (i<=High) )
+END IsSubRange ;
+
+
+(*
+   Max - returns the largest cardinal number from i and j.
+*)
+
+PROCEDURE Max (i, j: CARDINAL) : CARDINAL ;
+BEGIN
+   IF i>j
+   THEN
+      RETURN( i )
+   ELSE
+      RETURN( j )
+   END
+END Max ;
+
+
+(*
+   Min - returns the smallest cardinal number from i and j.
+*)
+
+PROCEDURE Min (i, j: CARDINAL) : CARDINAL ;
+BEGIN
+   IF i<j
+   THEN
+      RETURN( i )
+   ELSE
+      RETURN( j )
+   END
+END Min ;
+
+
+(*
+   Abs - returns the difference between i and j.
+*)
+
+PROCEDURE Abs (i, j: CARDINAL) : CARDINAL ;
+BEGIN
+   IF i>j
+   THEN
+      RETURN( i-j )
+   ELSE
+      RETURN( j-i )
+   END
+END Abs ;
+
+
+(*
+   Swap - swaps two cardinal numbers i and j.
+*)
+
+PROCEDURE Swap (VAR i, j: CARDINAL) ;
+VAR
+   t: CARDINAL ;
+BEGIN
+   t := i ;
+   i := j ;
+   j := t
+END Swap ;
+
+
+END Geometry.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/MakeBoxes.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/MakeBoxes.def
new file mode 100644
index 00000000000..f68a3b1706a
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/MakeBoxes.def
@@ -0,0 +1,67 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+DEFINITION MODULE MakeBoxes ;
+
+(*
+   Title      : MakeBoxes
+   Author     : Gaius Mulley
+   Date       : 15/7/88
+   LastEdit   : 15/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Provides a list of all possible box sizes.
+                Any number of unique boxes may be requested and deleted.
+*)
+
+EXPORT QUALIFIED InitBoxes, KillBoxes,
+                 AddBoxes, GetAndDeleteRandomBox ;
+
+
+(*
+   InitBoxes - Initializes a list of boxes.
+               An index to this box list is returned.
+*)
+
+PROCEDURE InitBoxes () : CARDINAL ;
+
+
+(*
+   KillBoxes - Kills a complete box list.
+*)
+
+PROCEDURE KillBoxes (BoxListIndex: CARDINAL) ;
+
+
+(*
+   AddBoxes - Adds a list of boxes MinX..MaxX, MinY..MaxY
+              to a box list BoxListIndex.
+*)
+
+PROCEDURE AddBoxes (BoxListIndex: CARDINAL;
+                    MinX, MinY, MaxX, MaxY: CARDINAL) ;
+
+
+(*
+   GetAndDeleteRandomBox - Returns a random box from the box list and
+                           this box is then deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomBox (BoxListIndex: CARDINAL;
+                                 VAR SizeX, SizeY: CARDINAL) ;
+
+
+END MakeBoxes.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/MakeBoxes.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/MakeBoxes.mod
new file mode 100644
index 00000000000..c841f0ef2d0
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/MakeBoxes.mod
@@ -0,0 +1,238 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+IMPLEMENTATION MODULE MakeBoxes ;
+
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+FROM Chance IMPORT GetRand ;
+
+
+CONST
+   MaxBox   = 15000 ;
+   MaxIndex =   500 ;
+
+TYPE
+   Box    = RECORD
+               LengthX,
+               LengthY: CARDINAL ;
+            END ;
+
+   Index  = RECORD
+               Start,               (* Start of the Box list *)
+               End  : CARDINAL ;    (* End of the Box list   *)
+            END ;
+
+VAR
+   BoxIndex   : ARRAY [0..MaxIndex] OF Index ;
+   Boxes      : ARRAY [1..MaxBox] OF Box ;
+   NoOfBoxes  : CARDINAL ;   (* Number of boxes in array Boxes *)
+   NoOfIndices: CARDINAL ;   (* Number of indices in BoxIndex  *)
+
+
+(*
+   InitBoxes - Initializes a list of boxes.
+               An index to this box list is returned.
+*)
+
+PROCEDURE InitBoxes () : CARDINAL ;
+BEGIN
+   IF NoOfIndices=MaxIndex
+   THEN
+      WriteString('Too many box list indices in Module MakeBoxes') ;
+      WriteLn ;
+      WriteString('Increase MaxIndex') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfIndices) ;
+      WITH BoxIndex[NoOfIndices] DO
+         Start := NoOfBoxes+1 ;
+         End := NoOfBoxes
+      END ;
+      RETURN(NoOfIndices)
+   END
+END InitBoxes ;
+
+
+(*
+   AddBoxes - Adds a list of boxes MinX..MaxX, MinY..MaxY
+              to a box list BoxListIndex.
+*)
+
+PROCEDURE AddBoxes (BoxListIndex: CARDINAL;
+                    MinX, MinY, MaxX, MaxY: CARDINAL) ;
+BEGIN
+   WITH BoxIndex[BoxListIndex] DO
+      Expand(BoxListIndex, MinX, MinY, MaxX, MaxY) ;
+      End := NoOfBoxes
+   END
+END AddBoxes ;
+
+
+(*
+   Expand - expands the box limitations MinX..MaxX, MinY..MaxY for all
+            possibilities of boxes.
+*)
+
+PROCEDURE Expand (BoxListIndex: CARDINAL;
+                  MinX, MinY, MaxX, MaxY: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := MinX ;
+   WHILE i<=MaxX DO
+      j := MinY ;
+      WHILE j<=MaxY DO
+         AddBox(BoxListIndex, i, j) ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END Expand ;
+
+
+(*
+   AddBox - adds a box of Width, Height to a list of boxes specified by
+            BoxListIndex.
+*)
+
+PROCEDURE AddBox (BoxListIndex: CARDINAL;
+                  Width, Height: CARDINAL) ;
+BEGIN
+   IF NoOfBoxes=MaxBox
+   THEN
+      WriteString('Too many boxes in a list in Module MakeBoxes') ;
+      WriteLn ;
+      WriteString('Increase MaxBox') ;
+      WriteLn ;
+      HALT
+   ELSIF UniqueBox(BoxListIndex, Width, Height)
+   THEN
+      INC(NoOfBoxes) ;
+      WITH Boxes[NoOfBoxes] DO
+         LengthX := Width ;
+         LengthY := Height
+      END
+   END
+END AddBox ;
+
+
+(*
+   UniqueBox - returns true if a box Width, Height is unique in the
+               box list BoxListIndex.
+*)
+
+PROCEDURE UniqueBox (BoxListIndex: CARDINAL;
+                     Width, Height: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   WITH BoxIndex[BoxListIndex] DO
+      i := Start ;
+      Found := FALSE ;
+      WHILE (NOT Found) AND (i<=End) DO
+         WITH Boxes[i] DO
+            Found := (LengthX=Width) AND (LengthY=Height)
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END UniqueBox ;
+
+
+(*
+   KillBoxes - Kills a complete box list.
+*)
+
+PROCEDURE KillBoxes (BoxListIndex: CARDINAL) ;
+BEGIN
+   IF NoOfIndices>0
+   THEN
+      (* Destroy index to box list *)
+      WITH BoxIndex[BoxListIndex] DO
+         Start := 0 ;
+         End := 0
+      END ;
+      (*
+         If killed last box list see if we can garbage collect
+         previously killed middle indices.
+      *)
+      IF NoOfIndices=BoxListIndex
+      THEN
+         REPEAT
+            DEC(NoOfIndices)
+         UNTIL (NoOfIndices=0) OR (BoxIndex[NoOfIndices].Start#0)
+      END ;
+      NoOfBoxes := BoxIndex[NoOfIndices].End
+   ELSE
+      WriteString('All boxes have been killed - Module MakeBoxes') ;
+      WriteLn ;
+      HALT
+   END
+END KillBoxes ;
+
+
+(*
+   GetAndDeleteRandomBox - Returns a random box from the box list and
+                           this box is then deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomBox (BoxListIndex: CARDINAL;
+                                 VAR SizeX, SizeY: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH BoxIndex[BoxListIndex] DO
+      i := Start+GetRand(End-Start+1) ;  (* +1 for GetRand *)
+      j := i ;
+      REPEAT
+         IF Boxes[j].LengthX=0
+         THEN
+            INC(j) ;
+            IF j>End
+            THEN
+               j := Start
+            END
+         END
+      UNTIL (j=i) OR (Boxes[j].LengthX#0) ;
+      WITH Boxes[j] DO
+         SizeX := LengthX ;
+         SizeY := LengthY ;
+         LengthX := 0 ;      (* Now delete this box *)
+         LengthY := 0
+      END
+   END
+END GetAndDeleteRandomBox ;
+
+
+PROCEDURE Init ;
+BEGIN
+   NoOfBoxes := 0 ;
+   NoOfIndices := 0 ;
+   WITH BoxIndex[NoOfIndices] DO
+      End := 0
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END MakeBoxes.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/Map.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/Map.mod
new file mode 100644
index 00000000000..819940ed808
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/Map.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+MODULE Map ;
+
+FROM RoomMap IMPORT CreateRoomMap ;
+FROM WriteMap IMPORT WriteMapText ;
+FROM Options IMPORT HandleOptions ;
+
+
+BEGIN
+   HandleOptions ;
+   CreateRoomMap ;
+   WriteMapText
+END Map.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/MapOptions.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/MapOptions.def
new file mode 100644
index 00000000000..823aee19612
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/MapOptions.def
@@ -0,0 +1,51 @@
+(* Copyright (C) 2015 Free Software Foundation, Inc.  *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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.  *)
+
+DEFINITION MODULE MapOptions ;  (*!m2pim+gm2*)
+
+(*
+    Title      : RoomOptions
+    Author     : Gaius Mulley
+    System     : Chisel
+    Date       : Thu Aug 17 13:25:51 2017
+    Revision   : $Version$
+    Description: provides a placeholder for the options to map.
+*)
+
+(*
+   isVerbose - return TRUE if -v was used.
+*)
+
+PROCEDURE isVerbose () : BOOLEAN ;
+
+
+(*
+   isDebugging - return TRUE if -d was used.
+*)
+
+PROCEDURE isDebugging () : BOOLEAN ;
+
+
+(*
+   isStatistics - return TRUE if -s was used.
+*)
+
+PROCEDURE isStatistics () : BOOLEAN ;
+
+
+END MapOptions.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/MapOptions.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/MapOptions.mod
new file mode 100644
index 00000000000..d1fdca6b6d8
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/MapOptions.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2015 Free Software Foundation, Inc.  *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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.  *)
+
+IMPLEMENTATION MODULE MapOptions ;  (*!m2pim*)
+
+(*
+   isVerbose - return TRUE if -v was used.
+*)
+
+PROCEDURE isVerbose () : BOOLEAN ;
+BEGIN
+   RETURN FALSE
+END isVerbose ;
+
+
+(*
+   isDebugging - return TRUE if -d was used.
+*)
+
+PROCEDURE isDebugging () : BOOLEAN ;
+BEGIN
+   RETURN FALSE
+END isDebugging ;
+
+
+(*
+   isStatistics - return TRUE if -s was used.
+*)
+
+PROCEDURE isStatistics () : BOOLEAN ;
+BEGIN
+   RETURN FALSE
+END isStatistics ;
+
+
+END MapOptions.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/Options.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/Options.def
new file mode 100644
index 00000000000..0187e535876
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/Options.def
@@ -0,0 +1,47 @@
+(* Copyright (C) 2017 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.  *)
+
+DEFINITION MODULE Options ;  (*!m2pim+gm2*)
+
+(*
+    Title      : Options
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Fri Sep 29 13:51:36 2017
+    Revision   : $Version$
+    Description: provides a convenient module to collect and handle
+                 all user configurable defaults and options.
+*)
+
+VAR
+   userTotalCorridorLength,     (* user specified total amount of corridors.  *)
+   userMinCorridorLength,
+   userMaxCorridorLength,           (* user specified max/min corridor size.  *)
+   userMinRoomLength,
+   userMaxRoomLength,                   (* user specified max/min room size.  *)
+   userX, userY           :  CARDINAL ;    (* user defined maximum map size.  *)
+
+
+(*
+   HandleOptions -
+*)
+
+PROCEDURE HandleOptions ;
+
+
+END Options.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/Options.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/Options.mod
new file mode 100644
index 00000000000..9b0b56407bc
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/Options.mod
@@ -0,0 +1,171 @@
+(* Copyright (C) 2015 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.  *)
+
+IMPLEMENTATION MODULE Options ;  (*!m2pim+gm2*)
+
+FROM DynamicStrings IMPORT String, InitString, KillString ;
+FROM StringConvert IMPORT stoc ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StdIO IMPORT Write ;
+FROM ASCII IMPORT nul ;
+FROM GetOpt IMPORT GetOpt ;
+FROM libc IMPORT printf, exit ;
+FROM Chance IMPORT GetSeed, SetSeed ;
+FROM WriteMap IMPORT SetOutputFile ;
+
+FROM BoxMap IMPORT MaxX, MaxY,
+                   MinRoomLength, MaxRoomLength,
+		   MinCorridorLength, MaxCorridorLength, TotalCorridorLength ;
+
+IMPORT UnixArgs ;
+
+
+CONST
+   programName = "rndpen" ;
+
+
+(*
+   Max -
+*)
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a > b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Max ;
+
+
+(*
+   Min -
+*)
+
+PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a < b
+   THEN
+      RETURN a
+   ELSE
+      RETURN b
+   END
+END Min ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   userX := MaxX ;
+   userY := MaxY ;
+   userMinRoomLength := MinRoomLength ;
+   userMaxRoomLength := MaxRoomLength ;
+   userMinCorridorLength := MinCorridorLength ;
+   userMaxCorridorLength := MaxCorridorLength ;
+   userTotalCorridorLength := TotalCorridorLength
+END Init ;
+
+
+(*
+   CheckLimits -
+*)
+
+PROCEDURE CheckLimits ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := Min (userX, userY) ;
+   userMaxRoomLength := Min (l, userMaxRoomLength) ;
+   userMinRoomLength := Min (userMinRoomLength, userMaxRoomLength) ;
+   userMaxCorridorLength := Min (l, userMaxCorridorLength) ;
+   userMinCorridorLength := Min (userMinCorridorLength, userMaxCorridorLength)
+END CheckLimits ;
+
+
+(*
+   help -
+*)
+
+PROCEDURE help (code: INTEGER) ;
+BEGIN
+   printf ("Usage %s [-a minroomsize] [-b maxroomsize] [-c mincorridorlength] [-d maxcorridorlength] [-e totalcorridorlength] [-h] [-o outputfile] [-s seed] [-x maxx] [-y maxy]\n", programName) ;
+   printf ("  -a minroomsize            (default is %d)\n", MinRoomLength) ;
+   printf ("  -b maxroomsize            (default is %d)\n", MaxRoomLength) ;
+   printf ("  -c mincorridorsize        (default is %d)\n", MinCorridorLength) ;
+   printf ("  -d maxcorridorsize        (default is %d)\n", MaxCorridorLength) ;
+   printf ("  -e totalcorridorlength    (default is %d)\n", TotalCorridorLength) ;
+   printf ("  -o outputfile             (default is stdout)\n") ;
+   printf ("  -s seed                   (default is %d)\n", GetSeed ()) ;
+   printf ("  -x minx for whole map     (default is %d)\n", MaxX) ;
+   printf ("  -y maxy for whole map     (default is %d)\n", MaxY) ;
+   exit (code)
+END help ;
+
+
+(*
+   HandleOptions -
+*)
+
+PROCEDURE HandleOptions ;
+VAR
+   optind,
+   opterr,
+   optopt: INTEGER ;
+   arg,
+   s, l  : String ;
+   ch    : CHAR ;
+BEGIN
+   l := InitString (':a:b:c:d:e:o:s:hx:y:') ;
+   s := NIL ;
+   arg := NIL ;
+   ch := GetOpt (UnixArgs.GetArgC (), UnixArgs.GetArgV (), l,
+                 arg, optind, opterr, optopt) ;
+   WHILE ch # nul DO
+      CASE ch OF
+
+      'a':  userMinRoomLength := stoc (arg) |
+      'b':  userMaxRoomLength := stoc (arg) |
+      'c':  userMinCorridorLength := stoc (arg) |
+      'd':  userMaxCorridorLength := stoc (arg) |
+      'e':  userTotalCorridorLength := stoc (arg) |
+      'h':  help (0) |
+      'o':  SetOutputFile(arg) |
+      's':  SetSeed (stoc (arg)) |
+      'x':  userX := stoc (arg) |
+      'y':  userY := stoc (arg) |
+      '?':  printf ("illegal option\n") ; help (1)
+
+      ELSE
+         WriteString ("unrecognised option '-") ; Write (ch) ; WriteString ('"') ; WriteLn ;
+         exit (1)
+      END ;
+      arg := KillString (arg) ;
+      ch := GetOpt (UnixArgs.GetArgC (), UnixArgs.GetArgV (), l,
+                    arg, optind, opterr, optopt)
+   END ;
+   CheckLimits
+END HandleOptions ;
+
+
+BEGIN
+   Init
+END Options.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/RoomMap.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/RoomMap.def
new file mode 100644
index 00000000000..ac7092294a0
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/RoomMap.def
@@ -0,0 +1,91 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+DEFINITION MODULE RoomMap ;
+
+(*
+   Title      : RoomMap
+   Author     : Gaius Mulley
+   Date       : 20/8/88
+   LastEdit   : 20/8/88
+   System     : LOGITECH MODULA-2/86
+   Description: Generates rooms from a list of boxes.
+*)
+
+EXPORT QUALIFIED MaxNoOfRooms,
+                 MaxNoOfTreasures,
+                 GenNoOfRooms,
+                 Rooms,
+                 DoorStatus,
+                 Treasure, TreasureInfo, Door, Line,
+                 CreateRoomMap ;
+
+CONST
+   MaxNoOfRooms           = 350 ;
+   MaxWallsPerRoom        =   8 ;
+   MaxDoorsPerRoom        =   6 ;
+   MaxNoOfTreasures       =  15 ;
+
+TYPE
+   Line         = RECORD
+                     X1 : CARDINAL ;
+                     Y1 : CARDINAL ;
+                     X2 : CARDINAL ;
+                     Y2 : CARDINAL
+                  END ;
+
+   DoorStatus   = (Open, Closed, Secret) ;
+
+   Door         = RECORD
+                     Position    : Line ;
+                     StateOfDoor : DoorStatus ;
+                     LeadsTo     : CARDINAL
+                  END ;
+
+   Room         = RECORD
+                     RoomNo      : CARDINAL ;
+                     NoOfWalls   : CARDINAL ;
+                     NoOfDoors   : CARDINAL ;
+                     Walls       : ARRAY [1..MaxWallsPerRoom] OF Line ;
+                     Doors       : ARRAY [1..MaxDoorsPerRoom] OF Door ;
+                     (* Treasures   : BITSET ; *)
+                  END ;
+
+   TreasureInfo = RECORD
+                     Xpos         : CARDINAL ;
+                     Ypos         : CARDINAL ;
+                     Rm           : CARDINAL ;
+                     Tweight      : CARDINAL ;
+                     TreasureName : ARRAY [0..12] OF CHAR
+                  END ;
+
+
+VAR
+   GenNoOfRooms    : CARDINAL ;
+   Rooms           : ARRAY [1..MaxNoOfRooms] OF Room ;
+   Treasure        : ARRAY [1..MaxNoOfTreasures] OF TreasureInfo ;
+
+
+(*
+   CreateRoomMap - creates rooms from a list of boxes in BoxMap.
+*)
+
+PROCEDURE CreateRoomMap ;
+
+
+END RoomMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/RoomMap.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/RoomMap.mod
new file mode 100644
index 00000000000..b7438fbe817
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/RoomMap.mod
@@ -0,0 +1,1497 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+IMPLEMENTATION MODULE RoomMap ;
+
+
+FROM MapOptions IMPORT isVerbose, isDebugging, isStatistics ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn, WriteString ;
+FROM Assertion IMPORT Assert ;
+
+FROM Geometry IMPORT IsSubLine, IsSubRange, Swap, IntersectionLength,
+                     Abs, Max, Min, IsPointOnLine, IsIntersectingRange ;
+
+FROM Chance IMPORT GetRand, InitRandom, KillRandom, GetAndDeleteRandom,
+                   AddRandom ;
+
+FROM StoreCoords IMPORT InitCoords, KillCoords, GetAndDeleteRandomCoord,
+                        AddCoord ;
+
+FROM BoxMap IMPORT Boxes, NoOfBoxes, NoOfCorridorBoxes, CreateBoxMap,
+                   MinDoorLength, MaxDoorLength ;
+
+CONST
+   MaxLineStack = 20 ;
+   CorridorDoorLength = 2 ;
+
+VAR
+   NoOfCorridors: CARDINAL ;
+   NoOfLines    : CARDINAL ;
+   Lines        : ARRAY [1..MaxLineStack] OF Line ;
+
+
+(*
+   CreateRoomMap - copy boxes into rooms and amalgamate boxes into rooms.
+*)
+
+PROCEDURE CreateRoomMap ;
+BEGIN
+   RETURN ;  (* Remove this line if you really want to generate a map.  *)
+   (* WriteString('Creating Boxes') ; WriteLn ; *)
+   CreateBoxMap ;
+   (* WriteString('Creating Rooms') ; WriteLn ; *)
+   InitRooms ;
+   CreateCorridors ;
+   CreateRooms ;
+END CreateRoomMap ;
+
+
+(*
+   InitRooms - copies the box array from Module BoxMap into the Room array.
+*)
+
+PROCEDURE InitRooms ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=NoOfBoxes DO
+      WITH Rooms[i] DO
+         RoomNo := i ;
+         NoOfDoors := 0 ;
+         NoOfWalls := 4 ;
+         (* Treasures := {} ; *)
+         Walls[1].X1 := Boxes[i].x1 ;   (* Lower y=c *)
+         Walls[1].Y1 := Boxes[i].y1 ;
+         Walls[1].X2 := Boxes[i].x2 ;
+         Walls[1].Y2 := Boxes[i].y1 ;
+
+         Walls[2].X1 := Boxes[i].x2 ;   (* Right x=c *)
+         Walls[2].Y1 := Boxes[i].y1 ;
+         Walls[2].X2 := Boxes[i].x2 ;
+         Walls[2].Y2 := Boxes[i].y2 ;
+
+         Walls[3].X1 := Boxes[i].x1 ;   (* Top y=c   *)
+         Walls[3].Y1 := Boxes[i].y2 ;
+         Walls[3].X2 := Boxes[i].x2 ;
+         Walls[3].Y2 := Boxes[i].y2 ;
+
+         Walls[4].X1 := Boxes[i].x1 ;   (* Left x=c  *)
+         Walls[4].Y1 := Boxes[i].y1 ;
+         Walls[4].X2 := Boxes[i].x1 ;
+         Walls[4].Y2 := Boxes[i].y2
+      END ;
+      INC(i)
+   END ;
+   GenNoOfRooms := NoOfBoxes ;
+   NoOfCorridors := NoOfCorridorBoxes ;
+   (* Now set all other rooms to void *)
+   i := GenNoOfRooms+1 ;
+   WHILE i<=MaxNoOfRooms DO
+      Rooms[i].RoomNo := 0 ;
+      INC(i)
+   END ;
+   IF isStatistics ()
+   THEN
+      WriteString('Corridors') ; WriteCard(NoOfCorridors, 4) ; WriteLn ;
+      WriteString('Rooms    ') ; WriteCard(GenNoOfRooms, 4) ; WriteLn
+   END
+END InitRooms ;
+
+
+(*
+   CreateCorridors - creates corridors from the corridor boxes.
+*)
+
+PROCEDURE CreateCorridors ;
+BEGIN
+   AmalgamateCorridors ;
+   CreateCorridorDoors
+END CreateCorridors ;
+
+
+(*
+   CreateRooms - creates rooms from the room boxes.
+*)
+
+PROCEDURE CreateRooms ;
+BEGIN
+   AmalgamateRooms ;
+   IF isVerbose ()
+   THEN
+      WriteString('Creating RoomDoors') ; WriteLn
+   END ;
+   CreateMinRoomDoors ;
+   CreateRoomDoors
+END CreateRooms ;
+
+
+(*
+   CreateCorridorDoors - places corridors doors along the corridors.
+*)
+
+PROCEDURE CreateCorridorDoors ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=NoOfCorridors DO
+      j := 1 ;
+      WHILE j<=NoOfCorridors DO
+         IF (i#j) AND RoomExists(i) AND RoomExists(j)
+         THEN
+            MakeCorridorDoors(i, j)
+         END ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END CreateCorridorDoors ;
+
+
+(*
+   CreateMinRoomDoors - create minimum doors arround map. Thus allowing
+                        an entrance into every room.
+*)
+
+PROCEDURE CreateMinRoomDoors ;
+VAR
+   Done: BOOLEAN ;
+   i   : CARDINAL ;
+BEGIN
+   REPEAT
+      Done := FALSE ;
+      i := 1 ;
+      WHILE (NOT Done) AND (i<=GenNoOfRooms) DO
+         IF RoomExists(i)
+         THEN
+            IF Rooms[i].NoOfDoors=0
+            THEN
+               IF MakeDoorInRoomToSafty(i)
+               THEN
+               END ;
+               Done := (Rooms[i].NoOfDoors#0)
+            END
+         END ;
+         INC(i)
+      END
+   UNTIL NOT Done ;
+   (* Now remove all rooms that have no doors *)
+   IF isStatistics ()
+   THEN
+      WriteString('Number of rooms') ; WriteCard(GenNoOfRooms, 4) ; WriteLn ;
+   END ;
+   i := 1 ;
+   WHILE i<=GenNoOfRooms DO
+      IF RoomExists(i) AND (Rooms[i].NoOfDoors=0)
+      THEN
+         RemoveRoom(i) ;
+	 IF isStatistics ()
+         THEN
+            WriteString('Removing room') ; WriteCard(i, 4) ; WriteLn
+         END
+      END ;
+      INC(i)
+   END
+END CreateMinRoomDoors ;
+
+
+(*
+   CreateRoomDoors - places room doors in rooms.
+*)
+
+PROCEDURE CreateRoomDoors ;
+VAR
+   i, n: CARDINAL ;
+BEGIN
+   i := NoOfCorridors+1 ;
+   WHILE i<=GenNoOfRooms DO
+      IF RoomExists(i)
+      THEN
+         n := GetRand(MaxDoorsPerRoom-1 DIV 2)+1 ;
+         WHILE (Rooms[i].NoOfDoors<MaxDoorsPerRoom) AND (n>0) DO
+            IF MakeDoorInRoom(i)
+            THEN
+            END ;
+            DEC(n)
+         END
+      END ;
+      INC(i)
+   END
+END CreateRoomDoors ;
+
+
+(*
+   MakeCorridorDoors - checks for corridor doors thoughout the corridor rooms.
+*)
+
+PROCEDURE MakeCorridorDoors (r1, r2: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=Rooms[r1].NoOfWalls DO
+      j := 1 ;
+      WHILE j<=Rooms[r2].NoOfWalls DO
+         IF IsIntersection( Rooms[r1].Walls[i].X1, Rooms[r1].Walls[i].Y1,
+                            Rooms[r1].Walls[i].X2, Rooms[r1].Walls[i].Y2,
+                            Rooms[r2].Walls[j].X1, Rooms[r2].Walls[j].Y1,
+                            Rooms[r2].Walls[j].X2, Rooms[r2].Walls[j].Y2 )
+         THEN
+            CheckForCorridorDoor(r1, i, r2, j)
+         END ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END MakeCorridorDoors ;
+
+
+(*
+   MakeDoorInRoomToSafty - true is returned if a door is made in room r
+                           to a room which already has a door.
+                           Thus room, r, is reachable by the whole map.
+*)
+
+PROCEDURE MakeDoorInRoomToSafty (r: CARDINAL) : BOOLEAN ;
+VAR
+   RoomList,
+   Neighbour: CARDINAL ;
+   Done     : BOOLEAN ;
+BEGIN
+   Done := FALSE ;
+   RoomList := InitRandom() ;
+   AddRandom(RoomList, GenNoOfRooms) ;  (* 1..GenNoOfRooms *)
+   Neighbour := GetAndDeleteRandom(RoomList) ;
+   WHILE (Neighbour#0) AND (NOT Done) DO
+      IF RoomExists(Neighbour) AND (r#Neighbour) AND
+         IsTouching(r, Neighbour) AND (Rooms[Neighbour].NoOfDoors#0)
+      THEN
+         Done := MakeDoorBetweenRooms(r, Neighbour)
+      END ;
+      Neighbour := GetAndDeleteRandom(RoomList)
+   END ;
+   KillRandom(RoomList) ;
+   RETURN( Done )
+END MakeDoorInRoomToSafty ;
+
+
+(*
+   MakeDoorInRoom - true is returned if a door is made in room r.
+*)
+
+PROCEDURE MakeDoorInRoom (r: CARDINAL) : BOOLEAN ;
+VAR
+   RoomList,
+   Neighbour: CARDINAL ;
+   Done     : BOOLEAN ;
+BEGIN
+   Done := FALSE ;
+   RoomList := InitRandom() ;
+   AddRandom(RoomList, GenNoOfRooms) ;  (* 1..GenNoOfRooms *)
+   Neighbour := GetAndDeleteRandom(RoomList) ;
+   WHILE (Neighbour#0) AND (NOT Done) DO
+      IF RoomExists(Neighbour) AND (r#Neighbour) AND IsTouching(r, Neighbour)
+      THEN
+         Done := MakeDoorBetweenRooms(r, Neighbour)
+      END ;
+      Neighbour := GetAndDeleteRandom(RoomList)
+   END ;
+   KillRandom(RoomList) ;
+   RETURN( Done )
+END MakeDoorInRoom ;
+
+
+(*
+   MakeDoorBetweenRooms - returns true if it makes a door between
+                          rooms r1 and r2.
+*)
+
+PROCEDURE MakeDoorBetweenRooms (r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   CoordList: CARDINAL ;
+   Success  : BOOLEAN ;
+BEGIN
+   Success := FALSE ;
+   CoordList := InitCoords() ;
+   PushPossibleDoorCoords(CoordList, r1, r2) ;
+   Success := ChooseDoor(CoordList, r1, r2) ;
+   KillCoords(CoordList) ;
+   RETURN( Success )
+END MakeDoorBetweenRooms ;
+
+
+(*
+   PushPossibleDoorCoords - pushes the possible door coordinates on the
+                            coordinate stack CoordList.
+                            The door links rooms r1 and r2 together.
+*)
+
+PROCEDURE PushPossibleDoorCoords (CoordList: CARDINAL; r1, r2: CARDINAL) ;
+VAR
+   i, j     : CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i<=Rooms[r1].NoOfWalls DO
+      j := 1 ;
+      WHILE j<=Rooms[r2].NoOfWalls DO
+         IF IsIntersection( Rooms[r1].Walls[i].X1, Rooms[r1].Walls[i].Y1,
+                            Rooms[r1].Walls[i].X2, Rooms[r1].Walls[i].Y2,
+                            Rooms[r2].Walls[j].X1, Rooms[r2].Walls[j].Y1,
+                            Rooms[r2].Walls[j].X2, Rooms[r2].Walls[j].Y2 )
+         THEN
+            IF PossibleDoorLength(r1, i, r2, j)>=MinDoorLength
+            THEN
+               PushPossibleDoorCoordsOnWall(CoordList, r1, i, r2, j)
+            END
+         END ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END PushPossibleDoorCoords ;
+
+
+(*
+   PushPossibleDoorCoordsOnWall - pushes the coordinates which can take a door
+                                  between rooms r1 and r2 on walls w1 and w2
+                                  onto the coordinate stack CoordList.
+*)
+
+PROCEDURE PushPossibleDoorCoordsOnWall (CoordList: CARDINAL ;
+                                        r1, w1, r2, w2: CARDINAL) ;
+VAR
+   s, e,
+   x1, y1, x2, y2,
+   x3, y3, x4, y4: CARDINAL ;
+BEGIN
+   IF isVerbose ()
+   THEN
+      WriteString('Pushing walls') ; WriteCard(w1, 4) ; WriteCard(w2, 4) ; WriteLn
+   END ;
+   WITH Rooms[r1].Walls[w1] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Rooms[r2].Walls[w2] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      Assert(x1=x3) ; Assert(x2=x4) ;
+      IF IsSubRange(y1, y2, y3)
+      THEN
+         s := y3
+      ELSE
+         Assert(IsSubRange(y3, y4, y1)) ;
+         s := y1
+      END ;
+      e := Min(y2, y4) ;
+      INC(s) ;
+      DEC(e) ;
+      WHILE s<=e DO
+         IF IsDoorAllowed(r1, r2, x1, s, x1, e) AND
+            IsDoorAllowed(r2, r1, x1, s, x1, e)
+         THEN
+            AddCoord(CoordList, x1, s) ;
+	    IF isDebugging ()
+            THEN
+               WriteString('Point') ; WriteCard(x1, 4) ; WriteCard(s, 4) ; WriteLn
+            END
+         END ;
+         INC(s)
+      END
+   ELSE
+      Assert(IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)) ;
+      Assert(y1=y3) ; Assert(y2=y4) ;
+      IF IsSubRange(x1, x2, x3)
+      THEN
+         s := x3
+      ELSE
+         Assert(IsSubRange(x3, x4, x1)) ;
+         s := x1
+      END ;
+      e := Min(x2, x4) ;
+      INC(s) ;
+      DEC(e) ;
+      WHILE s<=e DO
+         IF IsDoorAllowed(r1, r2, s, y1, e, y1) AND
+            IsDoorAllowed(r2, r1, s, y1, e, y1)
+         THEN
+            AddCoord(CoordList, s, y1) ;
+	    IF isDebugging ()
+            THEN
+               WriteString('Point') ; WriteCard(s, 4) ; WriteCard(y1, 4) ; WriteLn
+            END
+         END ;
+         INC(s)
+      END
+   END
+END PushPossibleDoorCoordsOnWall ;
+
+
+(*
+   ChooseDoor - chooses a door from the CoordList which connects rooms
+                r1 and r2.
+*)
+
+PROCEDURE ChooseDoor (CoordList: CARDINAL; r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   x, y  : CARDINAL ;
+   w1, w2: CARDINAL ;
+   ok    : BOOLEAN ;
+BEGIN
+   GetAndDeleteRandomCoord(CoordList, x, y) ;
+   ok := (x#0) AND (y#0) ;
+   IF ok
+   THEN
+      w1 := FindWall(r1, x, y) ;
+      w2 := FindWall(r2, x, y) ;
+      MakeRoomDoor(r1, w1, r2, w2, x, y)
+   END ;
+   RETURN( ok )
+END ChooseDoor ;
+
+
+(*
+   FindWall - returns the wall number of a room r1 which has the point x, y
+              on it. A corner point will return a wall of zero.
+*)
+
+PROCEDURE FindWall (r: CARDINAL; x, y: CARDINAL) : CARDINAL ;
+VAR
+   Found: BOOLEAN ;
+   i    : CARDINAL ;
+BEGIN
+   i := 1 ;
+   Found := FALSE ;
+   WITH Rooms[r] DO
+      WHILE (i<=NoOfWalls) AND (NOT Found) DO
+         WITH Walls[i] DO
+            IF ((x=X1) AND (y=Y1)) OR ((x=X2) AND (y=Y2))
+            THEN
+               (* Corner has been found *)
+               Found := TRUE ;
+               i := 0
+            ELSIF IsPointOnLine(x, y, X1, Y1, X2, Y2)
+            THEN
+               Found := TRUE
+            ELSE
+               INC(i)
+            END
+         END
+      END
+   END ;
+   IF Found
+   THEN
+      RETURN( i )
+   ELSE
+      RETURN( 0 )
+   END
+END FindWall ;
+
+
+(*
+   MakeRoomDoor - makes a door between rooms r1 and r2 on walls w1 and w2
+                  at position x, y.
+*)
+
+PROCEDURE MakeRoomDoor (r1: CARDINAL; w1: CARDINAL; r2: CARDINAL; w2: CARDINAL;
+                        x, y: CARDINAL) ;
+VAR
+   l, h, List,
+   x1, y1, x2, y2,
+   x3, y3, x4, y4: CARDINAL ;
+   Done          : BOOLEAN ;
+BEGIN
+   IF isVerbose ()
+   THEN
+      WriteString('Making walls') ; WriteCard(w1, 4) ; WriteCard(w2, 4) ; WriteLn
+   END ;
+   WITH Rooms[r1].Walls[w1] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Rooms[r2].Walls[w2] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      Assert(x1=x3) ; Assert(x2=x4) ;
+      Done := FALSE ;
+      List := InitRandom() ;
+      AddRandom(List, MaxDoorLength) ;
+      REPEAT
+         l := GetAndDeleteRandom(List) ;
+         IF l>=MinDoorLength
+         THEN
+            h := Min(y+l-1, Min(y2, y4)-1) ;
+            Done := IsDoorAllowed(r1, r2, x, y, x, h) AND
+                    IsDoorAllowed(r2, r1, x, y, x, h)
+         END
+      UNTIL (l=0) OR Done ;
+      KillRandom(List) ;
+      Assert(l#0) ;
+      FixRoomDoor(r2, r1, x, y, x, h)
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)
+   THEN
+      Assert(y1=y3) ; Assert(y2=y4) ;
+      Done := FALSE ;
+      List := InitRandom() ;
+      AddRandom(List, MaxDoorLength) ;
+      REPEAT
+         l := GetAndDeleteRandom(List) ;
+         IF l>=MinDoorLength
+         THEN
+            h := Min(x+l-1, Min(x2, x4)-1) ;
+            Done := IsDoorAllowed(r1, r2, x, y, h, y) AND
+                    IsDoorAllowed(r2, r1, x, y, h, y)
+         END
+      UNTIL (l=0) OR Done ;
+      KillRandom(List) ;
+      Assert(l#0) ;
+      FixRoomDoor(r2, r1, x, y, h, y)
+   ELSE
+      HALT
+   END
+END MakeRoomDoor ;
+
+
+(*
+   IsDoorAllowed - checks whether a door can be built in r1 leading to r2
+                   the coordinates of the door are x1, y1, x2, y2.
+*)
+
+PROCEDURE IsDoorAllowed (r1, r2: CARDINAL; x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   ok  : BOOLEAN ;
+   i, w: CARDINAL ;
+BEGIN
+   ok := (NOT DoorsClash(r1, x1, y1, x2, y2)) AND
+         (Rooms[r1].NoOfDoors<MaxDoorsPerRoom) AND
+         (Max(Abs(x1, x2)+1, Abs(y1, y2)+1)>=MinDoorLength) ;
+   IF ok
+   THEN
+      w := FindWall(r1, x1, y1) ;
+      IF IsVertical(x1, y1, x2, y2)
+      THEN
+         i := y1 ;
+         WHILE (i<=y2) AND ok DO
+            ok := (w=FindWall(r1, x1, i)) ;
+            INC(i)
+         END
+      ELSIF IsHorizontal(x1, y1, x2, y2)
+      THEN
+         i := x1 ;
+         WHILE (i<=x2) AND ok DO
+            ok := (w=FindWall(r1, i, y1)) ;
+            INC(i)
+         END
+      END
+   END ;
+   RETURN( ok )
+END IsDoorAllowed ;
+
+
+(*
+   FixRoomDoor - places a door between rooms r1 and r2 with coordinates
+                 x1, y1, x2, y2.
+*)
+
+PROCEDURE FixRoomDoor (r1, r2: CARDINAL; x1, y1, x2, y2: CARDINAL) ;
+BEGIN
+   IF IsConnectionSecret(r1, r2)
+   THEN
+      AddDoor(r1, r2, x1, y1, x2, y2, Secret) ;
+      AddDoor(r2, r1, x1, y1, x2, y2, Secret)
+   ELSIF (NOT Adjacent(r1, r2)) AND (GetRand(100)>49)
+   THEN
+      AddDoor(r1, r2, x1, y1, x2, y2, Secret) ;
+      AddDoor(r2, r1, x1, y1, x2, y2, Secret)
+   ELSE
+      AddDoor(r1, r2, x1, y1, x2, y2, Closed) ;
+      AddDoor(r2, r1, x1, y1, x2, y2, Closed)
+   END
+END FixRoomDoor ;
+
+
+(*
+   IsConnectionSecret - returns true if the rooms, r1 and r2, are
+                        connected via a secret door.
+*)
+
+PROCEDURE IsConnectionSecret (r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WITH Rooms[r1] DO
+      WHILE i<=NoOfDoors DO
+         WITH Doors[i] DO
+            IF (LeadsTo=r1) AND (StateOfDoor=Secret)
+            THEN
+               RETURN( TRUE )
+            ELSE
+               INC(i)
+            END
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END IsConnectionSecret ;
+
+
+(*
+   CheckForCorridorDoor - checks whether a door can be built on walls
+                          w1 and w2 of rooms r1 and r2.
+*)
+
+PROCEDURE CheckForCorridorDoor (r1: CARDINAL; w1: CARDINAL;
+                                r2: CARDINAL; w2: CARDINAL) ;
+VAR
+   l: CARDINAL ;
+BEGIN
+   l := PossibleDoorLength(r1, w1, r2, w2) ;
+   (* WriteString('Intersection length') ; WriteCard(l, 4) ; WriteLn ; *)
+   IF l>=CorridorDoorLength
+   THEN
+      BuildCorridorDoor(r1, w1, r2, w2)
+   END
+END CheckForCorridorDoor ;
+
+
+(*
+   BuildCorridorDoor - will build a door on walls w1 and w2.
+                       BuildCorridorDoor works out the coordinates
+                       for the corridor doors.
+*)
+
+PROCEDURE BuildCorridorDoor (r1: CARDINAL; w1: CARDINAL;
+                             r2: CARDINAL; w2: CARDINAL) ;
+VAR
+   x1, y1, x2, y2,
+   x3, y3, x4, y4: CARDINAL ;
+BEGIN
+   WITH Rooms[r1].Walls[w1] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Rooms[r2].Walls[w2] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      Assert(x1=x3) ; Assert(x2=x4) ;
+      IF Abs(y1, y2)<Abs(y3, y4)
+      THEN
+         AttemptBuildCorridorDoor(r1, r2, x1, y1+1, x2, y2-1)
+      ELSE
+         AttemptBuildCorridorDoor(r1, r2, x1, y3+1, x2, y4-1)
+      END
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)
+   THEN
+      Assert(y1=y3) ; Assert(y2=y4) ;
+      IF Abs(x1, x2)<Abs(x3, x4)
+      THEN
+         AttemptBuildCorridorDoor(r1, r2, x1+1, y1, x2-1, y2)
+      ELSE
+         AttemptBuildCorridorDoor(r1, r2, x3+1, y1, x4-1, y4)
+      END
+   END
+END BuildCorridorDoor ;
+
+
+(*
+   AttemptBuildCorridorDoor - attempts to make a corridor door
+                              between rooms r1 and r2 with
+                              coordinates x1, y1, x2, y2.
+*)
+
+PROCEDURE AttemptBuildCorridorDoor (r1, r2: CARDINAL ;
+                                    x1, y1, x2, y2: CARDINAL) ;
+BEGIN
+   IF IsDoorAllowed(r1, r2, x1, y1, x2, y2) AND
+      IsDoorAllowed(r2, r1, x1, y1, x2, y2)
+   THEN
+      IF IsConnectionSecret(r1, r2)
+      THEN
+         AddDoor(r1, r2, x1, y1, x2, y2, Secret) ;
+         AddDoor(r2, r1, x1, y1, x2, y2, Secret)
+      ELSIF (NOT Adjacent(r1, r2)) AND (GetRand(100)>65)
+      THEN
+         AddDoor(r1, r2, x1, y1, x2, y2, Secret) ;
+         AddDoor(r2, r1, x1, y1, x2, y2, Secret)
+      ELSE
+         AddDoor(r1, r2, x1, y1, x2, y2, Open) ;
+         AddDoor(r2, r1, x1, y1, x2, y2, Open)
+      END
+   ELSE
+      IF isVerbose ()
+      THEN
+         WriteString('Not allowing corridor door!') ; WriteLn
+      END
+   END
+END AttemptBuildCorridorDoor ;
+
+
+(*
+   DoorsClash - returns true if there does exist a door which clashes with
+                x1, y1, x2, y2 in room r1.
+*)
+
+PROCEDURE DoorsClash (r: CARDINAL; x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Clash: BOOLEAN ;
+   i    : CARDINAL ;
+BEGIN
+   IF IsVertical(x1, y1, x2, y2)
+   THEN
+      INC(y2) ;
+      IF y1>1
+      THEN
+         DEC(y1)
+      END
+   ELSE
+      INC(x2) ;
+      IF x1>1
+      THEN
+         DEC(x1)
+      END
+   END ;
+   Clash := FALSE ;
+   WITH Rooms[r] DO
+      i := 1 ;
+      WHILE (i<=NoOfDoors) AND (NOT Clash) DO
+         WITH Doors[i].Position DO
+            IF IsIntersection(x1, y1, x2, y2, X1, Y1, X2, Y2)
+            THEN
+               Clash := TRUE
+            END
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( Clash )
+END DoorsClash ;
+
+
+(*
+   AddDoor - adds a door in room r1 that leads to a door in r2.
+             The coordinates of the door are x1, y1, x2, y2 and the
+             door type is in Status.
+*)
+
+PROCEDURE AddDoor (r1, r2: CARDINAL;
+                   x1, y1, x2, y2: CARDINAL; Status: DoorStatus) ;
+BEGIN
+  ; Assert(IsTouching(r1, r2))
+  ; Assert(IsDoorAllowed(r1, r2, x1, y1, x2, y2)) ;
+  ; Assert(r1#r2) ;
+  ; Assert(RoomExists(r1) AND RoomExists(r2)) ;
+   WITH Rooms[r1] DO
+      Assert(NoOfDoors<MaxDoorsPerRoom) ;
+      INC(NoOfDoors) ;
+      WITH Doors[NoOfDoors] DO
+         Position.X1 := x1 ;
+         Position.Y1 := y1 ;
+         Position.X2 := x2 ;
+         Position.Y2 := y2 ;
+         StateOfDoor := Status ;
+         LeadsTo := r2
+      END
+   END
+END AddDoor ;
+
+
+(*
+   PossibleDoorLength - returns the possible door length between rooms
+                        r1 and r2 on wall w1 and w2.
+*)
+
+PROCEDURE PossibleDoorLength (r1: CARDINAL; w1: CARDINAL;
+                              r2: CARDINAL; w2: CARDINAL) : CARDINAL ;
+VAR
+   l,
+   x1, x2, x3, x4,
+   y1, y2, y3, y4: CARDINAL ;
+BEGIN
+   WITH Rooms[r1].Walls[w1] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Rooms[r2].Walls[w2] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      l := IntersectionLength(y1, y2, y3, y4)+1 ;
+      IF (IsSubRange(y1, y2, y3) OR IsSubRange(y3, y4, y1)) AND (l>0)
+      THEN
+         DEC(l)
+      END ;
+      IF (IsSubRange(y1, y2, y4) OR IsSubRange(y3, y4, y2)) AND (l>0)
+      THEN
+         DEC(l)
+      END
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)
+   THEN
+      l := IntersectionLength(x1, x2, x3, x4)+1 ;
+      IF (IsSubRange(x1, x2, x3) OR IsSubRange(x3, x4, x1)) AND (l>0)
+      THEN
+         DEC(l)
+      END ;
+      IF (IsSubRange(x1, x2, x4) OR IsSubRange(x3, x4, x2)) AND (l>0)
+      THEN
+         DEC(l)
+      END
+   ELSE
+      l := 0
+   END ;
+   RETURN( l )
+END PossibleDoorLength ;
+
+
+(*
+   AmalgamateCorridors - joins corridors together.
+*)
+
+PROCEDURE AmalgamateCorridors ;
+VAR
+   i, j: CARDINAL ;
+   Done: BOOLEAN ;
+BEGIN
+   REPEAT
+      Done := FALSE ;
+      i := 1 ;
+      WHILE (NOT Done) AND (i<=NoOfCorridors) DO
+         j := 1 ;
+         WHILE (NOT Done) AND (j<=NoOfCorridors) DO
+            IF (i#j) AND RoomExists(i) AND RoomExists(j)
+            THEN
+               IF Amalgamate(i, j)
+               THEN
+                  Done := TRUE
+               END
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   UNTIL NOT Done
+END AmalgamateCorridors ;
+
+
+(*
+   AmalgamateRooms - joins rooms together.
+*)
+
+PROCEDURE AmalgamateRooms ;
+VAR
+   i, j: CARDINAL ;
+   Done: BOOLEAN ;
+BEGIN
+   REPEAT
+      Done := FALSE ;
+      i := NoOfCorridors+1 ;
+      WHILE (NOT Done) AND (i<=GenNoOfRooms) DO
+         j := NoOfCorridors+1 ;
+         WHILE (NOT Done) AND (j<=GenNoOfRooms) DO
+            IF (i#j) AND RoomExists(i) AND RoomExists(j)
+            THEN
+               IF Amalgamate(i, j)
+               THEN
+                  Done := TRUE
+               END
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   UNTIL NOT Done
+END AmalgamateRooms ;
+
+
+(*
+   Amalgamate - returns true if it can join two rooms r1 and r2 together.
+*)
+
+PROCEDURE Amalgamate (r1, r2: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsTouching(r1, r2)
+   THEN
+      NoOfLines := 0 ;
+      CopyWallsToLines(r1) ;
+      CopyWallsToLines(r2) ;
+      RemoveRoom(r1) ;
+      RemoveRoom(r2) ;
+      IF CompactLines() AND IsLineRoomSatisfied()
+      THEN
+         CopyLinesToWalls(r1) ;
+         InsertRoom(r1) ;
+         RETURN( TRUE )
+      ELSE
+         InsertRoom(r1) ;
+         InsertRoom(r2) ;
+         RETURN( FALSE )
+      END
+   ELSE
+      RETURN( FALSE )
+   END
+END Amalgamate ;
+
+
+(*
+   CompactLines - returns true if the lines in the line buffer are
+                  reduced by forming a bigger room.
+*)
+
+PROCEDURE CompactLines () : BOOLEAN ;
+VAR
+   Done,
+   Compacted: BOOLEAN ;
+   i, j     : CARDINAL ;
+BEGIN
+   Compacted := FALSE ;
+   REPEAT
+      Done := FALSE ;
+      i := 1 ;
+      WHILE (i<=NoOfLines) AND (NOT Done) DO
+         j := 1 ;
+         WHILE (j<=NoOfLines) AND (NOT Done) DO
+            IF (i#j) AND (NOT IsNulLine(i)) AND (NOT IsNulLine(j))
+            THEN
+               IF IsIntersectionLine(i, j)
+               THEN
+                  DeleteIntersectionLine(i, j) ;
+                  LinkUpLines ;
+                  Done := TRUE ;
+                  Compacted := TRUE
+               END
+            END ;
+            INC(j)
+         END ;
+         INC(i)
+      END
+   UNTIL NOT Done ;
+   RETURN( Compacted )
+END CompactLines ;
+
+
+(*
+   LinkUpLines - attempts to join lines that naturally run in to each other.
+*)
+
+PROCEDURE LinkUpLines ;
+VAR
+   Joined: BOOLEAN ;
+   i, j  : CARDINAL ;
+BEGIN
+   Joined := FALSE ;
+   i := 1 ;
+   WHILE (i<=NoOfLines) AND (NOT Joined) DO
+      j := 1 ;
+      WHILE (j<=NoOfLines) AND (NOT Joined) DO
+         Joined := JoinedLines(i, j) ;
+         INC(j)
+      END ;
+      INC(i)
+   END
+END LinkUpLines ;
+
+
+(*
+   JoinedLines - returns true if it can join lines i and j.
+*)
+
+PROCEDURE JoinedLines (i, j: CARDINAL) : BOOLEAN ;
+VAR
+   Joined        : BOOLEAN ;
+   x1, x2, x3, x4,
+   y1, y2, y3, y4: CARDINAL ;
+BEGIN
+   WITH Lines[i] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Lines[j] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   Joined := FALSE ;
+   (* X1 <= X2  - always *)
+   WITH Lines[i] DO
+      IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4) AND (x1=x3)
+      THEN
+         IF y4=y1
+         THEN
+            AddLine(x3, y3, x2, y2) ;
+            DeleteLine(i) ;
+            DeleteLine(j) ;
+            Joined := TRUE
+         ELSIF y2=y3
+         THEN
+            AddLine(x1, y1, x4, y4) ;
+            DeleteLine(i) ;
+            DeleteLine(j) ;
+            Joined := TRUE
+         END
+      ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4) AND
+            (y1=y3)
+      THEN
+         IF x4=x1
+         THEN
+            AddLine(x3, y3, x2, y2) ;
+            DeleteLine(i) ;
+            DeleteLine(j) ;
+            Joined := TRUE
+         ELSIF x2=x3
+         THEN
+            AddLine(x1, y1, x4, y4) ;
+            DeleteLine(i) ;
+            DeleteLine(j) ;
+            Joined := TRUE
+         END
+      END
+   END ;
+   RETURN( Joined )
+END JoinedLines ;
+
+
+(*
+   IsIntersectionLine - returns true if lines i and j intersect.
+*)
+
+PROCEDURE IsIntersectionLine (i, j: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN(
+            IsIntersection(
+               Lines[i].X1, Lines[i].Y1, Lines[i].X2, Lines[i].Y2,
+               Lines[j].X1, Lines[j].Y1, Lines[j].X2, Lines[j].Y2)
+            )
+END IsIntersectionLine ;
+
+
+(*
+   DeleteIntersectionLine - joins two lines together, i and j, and
+                            removes the intersection.
+*)
+
+PROCEDURE DeleteIntersectionLine (i, j: CARDINAL) ;
+VAR
+   x1, x2, x3, x4,
+   y1, y2, y3, y4: CARDINAL ;
+BEGIN
+   WITH Lines[i] DO
+      x1 := X1 ;
+      y1 := Y1 ;
+      x2 := X2 ;
+      y2 := Y2
+   END ;
+   WITH Lines[j] DO
+      x3 := X1 ;
+      y3 := Y1 ;
+      x4 := X2 ;
+      y4 := Y2
+   END ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(x3, y3, x4, y4)
+   THEN
+      DeleteLine(i) ;
+      DeleteLine(j) ;
+      SubtractIntersection(y1, y2, y3, y4) ;
+      AddLine(x1, y1, x2, y2) ;
+      AddLine(x3, y3, x4, y4)
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(x3, y3, x4, y4)
+   THEN
+      DeleteLine(i) ;
+      DeleteLine(j) ;
+      SubtractIntersection(x1, x2, x3, x4) ;
+      AddLine(x1, y1, x2, y2) ;
+      AddLine(x3, y3, x4, y4)
+   END
+END DeleteIntersectionLine ;
+
+
+(*
+   SubtractIntersection - deletes the intersecting entities of the range
+                          i1..i2  j1..j2.
+*)
+
+PROCEDURE SubtractIntersection (VAR i1, i2, j1, j2: CARDINAL) ;
+VAR
+   k1, k2,
+   l1, l2: CARDINAL ;
+BEGIN
+   Assert(i1<=i2) ;
+   Assert(j1<=j2) ;
+   IF IsSubRange(i1, i2, j1)
+   THEN
+      k1 := i1 ;
+      k2 := j1
+   ELSIF IsSubRange(j1, j2, i1)
+   THEN
+      k1 := j1 ;
+      k2 := i1
+   END ;
+   IF IsSubRange(i1, i2, j2)
+   THEN
+      l1 := j2 ;
+      l2 := i2
+   ELSIF IsSubRange(j1, j2, i2)
+   THEN
+      l1 := i2 ;
+      l2 := j2
+   END ;
+   i1 := k1 ;
+   i2 := k2 ;
+   j1 := l1 ;
+   j2 := l2
+END SubtractIntersection ;
+
+
+(*
+   AddLine - adds a line to the lines buffer.
+*)
+
+PROCEDURE AddLine (x1, y1, x2, y2: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   IF (x1>x2) OR (y1>y2)
+   THEN
+      Swap(x1, x2) ;
+      Swap(y1, y2)
+   ELSIF (x1#x2) OR (y1#y2)
+   THEN
+      (* Do not store points *)
+      IF NOT InsertLine(x1, y1, x2, y2)
+      THEN
+         INC(NoOfLines) ;
+         WITH Lines[NoOfLines] DO
+            X1 := x1 ;
+            Y1 := y1 ;
+            X2 := x2 ;
+            Y2 := y2
+         END
+      END
+    (* ; DisplayLines *)
+   END
+END AddLine ;
+
+
+(*
+   InsertLine - attempts to insert a line in a free slot,
+                true is returned if successfull.
+*)
+
+PROCEDURE InsertLine (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+VAR
+   Success: BOOLEAN ;
+   i      : CARDINAL ;
+BEGIN
+   i := 1 ;
+   Success := FALSE ;
+   WHILE (NOT Success) AND (i<=NoOfLines) DO
+      IF IsNulLine(i)
+      THEN
+         WITH Lines[i] DO
+            X1 := x1 ;
+            Y1 := y1 ;
+            X2 := x2 ;
+            Y2 := y2
+         END ;
+         Success := TRUE
+      ELSE
+         INC(i)
+      END
+   END ;
+   RETURN( Success )
+END InsertLine ;
+
+
+(*
+   DeleteLine - deletes a line from the lines buffer.
+*)
+
+PROCEDURE DeleteLine (l: CARDINAL) ;
+BEGIN
+   WITH Lines[l] DO
+      X1 := 0 ;
+      Y1 := 0 ;
+      X2 := 0 ;
+      Y2 := 0
+   END
+ (* ; DisplayLines *)
+END DeleteLine ;
+
+
+PROCEDURE DisplayLines ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WriteString('Lines') ; WriteLn ;
+   i := 1 ;
+   WHILE i<=NoOfLines DO
+      WITH Lines[i] DO
+         WriteCard(X1, 4) ; WriteCard(Y1, 4) ;
+         WriteCard(X2, 4) ; WriteCard(Y2, 4) ; WriteLn
+      END ;
+      INC(i)
+   END
+END DisplayLines ;
+
+
+(*
+   IsNulLine - returns true if line l is a nul line.
+*)
+
+PROCEDURE IsNulLine (l: CARDINAL) : BOOLEAN ;
+BEGIN
+   WITH Lines[l] DO
+      RETURN( (X1=0) AND (Y1=0) AND (X2=0) AND (Y2=0) )
+   END
+END IsNulLine ;
+
+
+(*
+   RemoveRoom - removes a room, r, from the room list.
+*)
+
+PROCEDURE RemoveRoom (r: CARDINAL) ;
+BEGIN
+   Rooms[r].RoomNo := 0   (* No longer exists *)
+END RemoveRoom ;
+
+
+(*
+   InsertRoom - inserts a room, r, back into the room list.
+*)
+
+PROCEDURE InsertRoom (r: CARDINAL) ;
+BEGIN
+   Rooms[r].RoomNo := r
+END InsertRoom ;
+
+
+(*
+   RoomExist - returns true if a room, r, exists.
+*)
+
+PROCEDURE RoomExists (r: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( Rooms[r].RoomNo#0 )
+END RoomExists ;
+
+
+(*
+   IsLineRoomSatisfied - returns true if the line room meets the requirements
+                         of a room.
+*)
+
+PROCEDURE IsLineRoomSatisfied () : BOOLEAN ;
+VAR
+   Count, i: CARDINAL ;
+BEGIN
+   Count := 0 ;
+   i := 1 ;
+   WHILE i<=NoOfLines DO
+      IF NOT IsNulLine(i)
+      THEN
+         INC(Count)
+      END ;
+      INC(i)
+   END ;
+   RETURN( Count<=MaxWallsPerRoom )
+   (* Must also check for a door into another room *)
+END IsLineRoomSatisfied ;
+
+
+(*
+   CopyWallsToLines - copies walls from room r into the lines buffer.
+*)
+
+PROCEDURE CopyWallsToLines (r: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   WITH Rooms[r] DO
+      WHILE i<=NoOfWalls DO
+         INC(NoOfLines) ;
+         WITH Lines[NoOfLines] DO
+            X1 := Walls[i].X1 ;
+            Y1 := Walls[i].Y1 ;
+            X2 := Walls[i].X2 ;
+            Y2 := Walls[i].Y2
+         END ;
+         INC(i)
+      END
+   END
+END CopyWallsToLines ;
+
+
+(*
+   CopyLinesToWalls - copies the lines buffer into the walls of room r.
+*)
+
+PROCEDURE CopyLinesToWalls (r: CARDINAL) ;
+BEGIN
+   WITH Rooms[r] DO
+      NoOfWalls := 0 ;
+      WHILE NoOfLines>0 DO
+         IF NOT IsNulLine(NoOfLines)
+         THEN
+            INC(NoOfWalls) ;
+            WITH Lines[NoOfLines] DO
+               Walls[NoOfWalls].X1 := X1 ;
+               Walls[NoOfWalls].Y1 := Y1 ;
+               Walls[NoOfWalls].X2 := X2 ;
+               Walls[NoOfWalls].Y2 := Y2
+            END
+         END ;
+         DEC(NoOfLines)
+      END
+   END
+END CopyLinesToWalls ;
+
+
+(*
+   IsTouching - returns true if room r1 and r2 touch each other.
+*)
+
+PROCEDURE IsTouching (r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   i, j: CARDINAL ;
+   ok  : BOOLEAN ;
+BEGIN
+   ok := FALSE ;
+   i := 1 ;
+   WHILE (NOT ok) AND (i<=Rooms[r1].NoOfWalls) DO
+      j := 1 ;
+      WHILE (NOT ok) AND (j<=Rooms[r2].NoOfWalls) DO
+         ok := IsIntersection(Rooms[r1].Walls[i].X1, Rooms[r1].Walls[i].Y1,
+                              Rooms[r1].Walls[i].X2, Rooms[r1].Walls[i].Y2,
+                              Rooms[r2].Walls[j].X1, Rooms[r2].Walls[j].Y1,
+                              Rooms[r2].Walls[j].X2, Rooms[r2].Walls[j].Y2) ;
+         INC(j)
+      END ;
+      INC(i)
+   END ;
+   RETURN( ok )
+END IsTouching ;
+
+
+(*
+   IsIntersection - returns true if the line x1, y1, x2, y2 touches
+                    line X1, Y1, X2, Y2.
+                    This routine does not consider perpendicular
+                    intersections.
+*)
+
+PROCEDURE IsIntersection (x1, y1, x2, y2, X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   Assert(x1#0) ;
+   Assert(X1#0) ;
+   IF IsVertical(x1, y1, x2, y2) AND IsVertical(X1, Y1, X2, Y2) AND
+      (x1=X1)
+   THEN
+      RETURN( IsIntersectingRange(y1, y2, Y1, Y2) )
+   ELSIF IsHorizontal(x1, y1, x2, y2) AND IsHorizontal(X1, Y1, X2, Y2) AND
+         (y1=Y1)
+   THEN
+      RETURN( IsIntersectingRange(x1, x2, X1, X2) )
+   ELSE
+      RETURN( FALSE )
+   END
+END IsIntersection ;
+
+
+(*
+   IsVertical - returns true if line x1, y1, x2, y2 is vertical.
+*)
+
+PROCEDURE IsVertical (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (x1=x2) AND (y1#y2) )
+END IsVertical ;
+
+
+(*
+   IsHorizontal - returns true if line x1, y1, x2, y2 is horizontal.
+*)
+
+PROCEDURE IsHorizontal (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( (y1=y2) AND (x1#x2) )
+END IsHorizontal ;
+
+
+(*
+   Adjacent - tests whether two rooms r1 & r2 are adjacent.
+*)
+
+PROCEDURE Adjacent (r1, r2: CARDINAL) : BOOLEAN ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WITH Rooms[r1] DO
+      i := NoOfDoors ;
+      WHILE i>0 DO
+         IF Doors[i].LeadsTo=r2
+         THEN
+            RETURN( TRUE )
+         ELSE
+            DEC(i)
+         END
+      END
+   END ;
+   RETURN( FALSE )
+END Adjacent ;
+
+
+PROCEDURE Stop ;
+BEGIN
+   HALT
+END Stop ;
+
+
+END RoomMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/StoreCoords.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/StoreCoords.def
new file mode 100644
index 00000000000..1a7f55b5ff7
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/StoreCoords.def
@@ -0,0 +1,72 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+DEFINITION MODULE StoreCoords ;
+
+(*
+   Title      : StoreCoords
+   Author     : Gaius Mulley
+   Date       : 15/7/88
+   LastEdit   : 15/7/88
+   System     : LOGITECH MODULA-2/86
+   Description: Provides a list of unique coordinates.
+                These coordinates maybe randomly requested.
+*)
+
+EXPORT QUALIFIED InitCoords, KillCoords,
+                 GetAndDeleteRandomCoord, AddCoord, CoordsExist ;
+
+(*
+   InitCoords - Initializes a potential list of coordinates.
+                An index to this potential coordinate list is returned.
+*)
+
+PROCEDURE InitCoords () : CARDINAL ;
+
+
+(*
+   KillCoords - Kills a complete coordinate list.
+*)
+
+PROCEDURE KillCoords (CoordListIndex: CARDINAL) ;
+
+
+(*
+   GetAndDeleteRandomCoord - Returns a random coordinate from the coordinate
+                             list and then it is deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomCoord (CoordListIndex: CARDINAL;
+                                   VAR x, y: CARDINAL) ;
+
+
+(*
+   AddCoord - places a coordinate into the specified list.
+*)
+
+PROCEDURE AddCoord (CoordListIndex: CARDINAL; x, y: CARDINAL) ;
+
+
+(*
+   CoordsExist - returns true if a coordinate exists
+                 within the CoordListIndex.
+*)
+
+PROCEDURE CoordsExist (CoordListIndex: CARDINAL) : BOOLEAN ;
+
+
+END StoreCoords.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/StoreCoords.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/StoreCoords.mod
new file mode 100644
index 00000000000..6edeb8180f8
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/StoreCoords.mod
@@ -0,0 +1,235 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+IMPLEMENTATION MODULE StoreCoords ;
+
+
+FROM MapOptions IMPORT isVerbose ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM Chance IMPORT GetRand ;
+
+
+CONST
+   MaxCoord = 150000 ;
+   MaxIndex =   5000 ;
+
+TYPE
+   Coord  = RECORD
+               X,
+               Y: CARDINAL ;
+            END ;
+
+   Index  = RECORD
+               Start,               (* Start of the Coord list *)
+               End  : CARDINAL ;    (* End of the Coord list   *)
+            END ;
+
+VAR
+   CoordIndex : ARRAY [0..MaxIndex] OF Index ;
+   Coords     : ARRAY [1..MaxCoord] OF Coord ;
+   NoOfCoords : CARDINAL ;   (* Number of coordinates in array Coords *)
+   NoOfIndices: CARDINAL ;   (* Number of indices in CoordIndex       *)
+
+
+(*
+   InitCoords - Initializes a potential list of coordinates.
+                An index to this potential coordinate list is returned.
+*)
+
+PROCEDURE InitCoords () : CARDINAL ;
+BEGIN
+   IF NoOfIndices=MaxIndex
+   THEN
+      WriteString('too many coordinate list indices in Module StoreCoords') ;
+      WriteLn ;
+      WriteString('increase MaxIndex') ;
+      WriteLn ;
+      HALT
+   ELSE
+      INC(NoOfIndices) ;
+      WITH CoordIndex[NoOfIndices] DO
+         Start := NoOfCoords+1 ;
+         End := 0
+      END ;
+      AddCoord(NoOfIndices, 0, 0) ;  (* Dummy coordinate that we keep *)
+      RETURN(NoOfIndices)            (* for the life of this list.    *)
+   END
+END InitCoords ;
+
+
+(*
+   KillCoords - Kills a complete coordinate list.
+*)
+
+PROCEDURE KillCoords (CoordListIndex: CARDINAL) ;
+BEGIN
+   IF NoOfIndices>0
+   THEN
+      (* Destroy index to Coord list *)
+      WITH CoordIndex[CoordListIndex] DO
+         IF isVerbose ()
+         THEN
+            WriteString('No of coords') ; WriteCard(End-Start+1, 4) ; WriteLn
+         END ;
+         Start := 0 ;
+         End := 0
+      END ;
+      (*
+         If killed last Coord list see if we can garbage collect
+         previously killed middle indices.
+      *)
+      IF NoOfIndices=CoordListIndex
+      THEN
+         REPEAT
+            DEC(NoOfIndices)
+         UNTIL (NoOfIndices=0) OR (CoordIndex[NoOfIndices].Start#0)
+      END ;
+      NoOfCoords := CoordIndex[NoOfIndices].End
+   ELSE
+      WriteString('all Coordinate lists have been killed - Module StoreCoords') ;
+      WriteLn ;
+      HALT
+   END
+END KillCoords ;
+
+
+
+(*
+   AddCoord - places a coordinate into the specified list.
+*)
+
+PROCEDURE AddCoord (CoordListIndex: CARDINAL; x, y: CARDINAL) ;
+BEGIN
+   IF NoOfCoords=MaxCoord
+   THEN
+      WriteString('too many coordinates in a list in Module StoreCoords') ;
+      WriteLn ;
+      WriteString('increase MaxCoord') ;
+      WriteLn ;
+      HALT
+   ELSIF UniqueCoord(CoordListIndex, x, y)
+   THEN
+      INC(NoOfCoords) ;
+      WITH Coords[NoOfCoords] DO
+         X := x ;
+         Y := y
+      END ;
+      WITH CoordIndex[CoordListIndex] DO
+         End := NoOfCoords
+      END
+   END
+END AddCoord ;
+
+
+(*
+   UniqueCoord - returns true if x and y are unique in the coord list.
+*)
+
+PROCEDURE UniqueCoord (CoordListIndex: CARDINAL;
+                       x, y: CARDINAL) : BOOLEAN ;
+VAR
+   i    : CARDINAL ;
+   Found: BOOLEAN ;
+BEGIN
+   WITH CoordIndex[CoordListIndex] DO
+      i := Start ;
+      Found := FALSE ;
+      WHILE (NOT Found) AND (i<=End) DO
+         WITH Coords[i] DO
+            Found := (X=x) AND (Y=y)
+         END ;
+         INC(i)
+      END
+   END ;
+   RETURN( NOT Found )
+END UniqueCoord ;
+
+
+(*
+   GetAndDeleteRandomCoord - Returns a random coordinate from the coordinate
+                             list and then it is deleted from the list.
+*)
+
+PROCEDURE GetAndDeleteRandomCoord (CoordListIndex: CARDINAL;
+                                   VAR x, y: CARDINAL) ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   WITH CoordIndex[CoordListIndex] DO
+      i := Start+GetRand(End-Start+1) ;  (* +1 for GetRand *)
+      j := i ;
+      REPEAT
+         IF Coords[j].X=0
+         THEN
+            INC(j) ;
+            IF j>End
+            THEN
+               j := Start
+            END
+         END
+      UNTIL (j=i) OR (Coords[j].X#0) ;
+      WITH Coords[j] DO
+         x := X ;
+         y := Y ;
+         X := 0 ;      (* Now delete this box *)
+         Y := 0
+      END
+   END
+END GetAndDeleteRandomCoord ;
+
+
+(*
+   CoordsExist - returns true if a coordinate exists
+                 within the CoordListIndex.
+*)
+
+PROCEDURE CoordsExist (CoordListIndex: CARDINAL) : BOOLEAN ;
+VAR
+   i : CARDINAL ;
+   ok: BOOLEAN ;
+BEGIN
+   ok := FALSE ;
+   WITH CoordIndex[CoordListIndex] DO
+      IF End>0
+      THEN
+         (* Was at least one coordinate *)
+         i := Start ;
+         WHILE (NOT ok) AND (i<=End) DO
+            ok := (Coords[i].X#0) ;   (* #0 means coordinate still exists *)
+            INC(i)
+         END
+      END
+   END ;
+   RETURN( ok )
+END CoordsExist ;
+
+
+PROCEDURE Init ;
+BEGIN
+   NoOfCoords := 0 ;
+   NoOfIndices := 0 ;
+   WITH CoordIndex[NoOfIndices] DO
+      End := 0
+   END
+END Init ;
+
+
+BEGIN
+   Init
+END StoreCoords.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/WriteMap.def b/gcc/testsuite/gm2/projects/pim/run/pass/random/WriteMap.def
new file mode 100644
index 00000000000..283f77f8b27
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/WriteMap.def
@@ -0,0 +1,48 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+DEFINITION MODULE WriteMap ;
+
+(*
+   Title      : WriteMap
+   Author     : Gaius Mulley
+   Date       : 22/8/88
+   System     : LOGITECH MODULA-2/86
+   Description: Writes an ASCII description of the map.
+*)
+
+FROM DynamicStrings IMPORT String ;
+
+EXPORT QUALIFIED WriteMapText, SetOutputFile ;
+
+
+(*
+   WriteMapText - writes out the map in textual form.
+*)
+
+PROCEDURE WriteMapText ;
+
+
+(*
+   SetOutputFile - set the output file to, name.
+*)
+
+PROCEDURE SetOutputFile (name: String) ;
+
+
+END WriteMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/WriteMap.mod b/gcc/testsuite/gm2/projects/pim/run/pass/random/WriteMap.mod
new file mode 100644
index 00000000000..b8df6fae601
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/WriteMap.mod
@@ -0,0 +1,185 @@
+(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+                 Free Software Foundation, Inc. *)
+(* This file is part of Chisel.
+
+Chisel 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.
+
+Chisel 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. *)
+
+IMPLEMENTATION MODULE WriteMap ;
+
+
+FROM DynamicStrings IMPORT String, EqualArray ;
+FROM RoomMap IMPORT MaxNoOfRooms, Rooms, DoorStatus ;
+FROM NumberIO IMPORT CardToStr ;
+
+IMPORT FIO ;
+IMPORT SFIO ;
+
+
+VAR
+   outfile: FIO.File ;
+
+
+(*
+   SetOutputFile - set the output file to, name.
+*)
+
+PROCEDURE SetOutputFile (name: String) ;
+BEGIN
+   IF EqualArray (name, '-')
+   THEN
+      outfile := FIO.StdOut
+   ELSE
+      outfile := SFIO.OpenToWrite(name)
+   END
+END SetOutputFile ;
+
+
+(*
+   WriteCard -
+*)
+
+PROCEDURE WriteCard (c, n: CARDINAL) ;
+VAR
+   a: ARRAY [0..50] OF CHAR ;
+BEGIN
+   CardToStr(c, n, a) ;
+   WriteString(a)
+END WriteCard ;
+
+
+(*
+   WriteString -
+*)
+
+PROCEDURE WriteString (a: ARRAY OF CHAR) ;
+BEGIN
+   FIO.WriteString(outfile, a)
+END WriteString ;
+
+
+(*
+   WriteLn -
+*)
+
+PROCEDURE WriteLn ;
+BEGIN
+   FIO.WriteLine(outfile)
+END WriteLn ;
+
+
+(*
+   WriteMapText - writes out the map in textual form.
+*)
+
+PROCEDURE WriteMapText ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   MakeRoomNumbers ;
+   FOR i := 1 TO MaxNoOfRooms DO
+      IF RoomExists(i)
+      THEN
+         WriteRoom(i)
+      END
+   END ;
+   WriteString('END.') ; WriteLn ; FIO.Close(outfile)
+END WriteMapText ;
+
+
+(*
+   MakeRoomNumbers - makes room numbers for the rooms that exist.
+*)
+
+PROCEDURE MakeRoomNumbers ;
+VAR
+   i, j: CARDINAL ;
+BEGIN
+   j := 1 ;
+   FOR i := 1 TO MaxNoOfRooms DO
+      IF RoomExists(i)
+      THEN
+         Rooms[i].RoomNo := j ;
+         INC(j)
+      END
+   END
+END MakeRoomNumbers ;
+
+
+(*
+   WriteRoom - writes out the room coordinates.
+*)
+
+PROCEDURE WriteRoom (r: CARDINAL) ;
+VAR
+   i: CARDINAL ;
+BEGIN
+   WITH Rooms[r] DO
+      WriteString('ROOM') ; WriteCard(RoomNo, 4) ; WriteLn ;
+      WriteString('WALL') ; WriteLn ;
+      FOR i := 1 TO NoOfWalls DO
+         WITH Walls[i] DO
+            WriteCard(X1, 8) ; WriteCard(Y1, 4) ;
+            WriteCard(X2, 4) ; WriteCard(Y2, 4) ; WriteLn
+         END
+      END ;
+      FOR i := 1 TO NoOfDoors DO
+         WriteString('DOOR') ;
+         WITH Doors[i] DO
+            WITH Position DO
+               WriteCard(X1, 4) ; WriteCard(Y1, 4) ;
+               WriteCard(X2, 4) ; WriteCard(Y2, 4)
+            END ;
+            WriteString('  STATUS ') ;
+            WriteStatus(StateOfDoor) ;
+            WriteString(' LEADS TO') ;
+            WriteCard(Rooms[LeadsTo].RoomNo, 4) ; WriteLn
+         END
+      END ;
+      WriteString('END') ; WriteLn
+   END
+END WriteRoom ;
+
+
+(*
+   WriteStatus - writes the status of a door.
+*)
+
+PROCEDURE WriteStatus (s: DoorStatus) ;
+BEGIN
+   CASE s OF
+
+   Open   : WriteString('OPEN  ') |
+   Closed : WriteString('CLOSED') |
+   Secret : WriteString('SECRET')
+
+   ELSE
+      HALT
+   END
+END WriteStatus ;
+
+
+(*
+   RoomExists - returns true if a room exists.
+*)
+
+PROCEDURE RoomExists (r: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN( Rooms[r].RoomNo#0 )
+END RoomExists ;
+
+
+BEGIN
+   outfile := FIO.StdOut
+END WriteMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp b/gcc/testsuite/gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp
new file mode 100644
index 00000000000..d12777e8a48
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp
@@ -0,0 +1,51 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2pim m2log m2iso"
+gm2_init_pim "-g -I$srcdir/$subdir"
+gm2_link_obj "WriteMap.o AdvMap.o BoxMap.o Chance.o Geometry.o MakeBoxes.o MapOptions.o Options.o RoomMap.o StoreCoords.o"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/Map.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2_target_compile $srcdir/$subdir/AdvMap.mod AdvMap.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/BoxMap.mod BoxMap.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/Chance.mod Chance.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/Geometry.mod Geometry.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/MakeBoxes.mod MakeBoxes.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/MapOptions.mod MapOptions.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/Options.mod Options.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/RoomMap.mod RoomMap.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/StoreCoords.mod StoreCoords.o object "-g -I$srcdir/$subdir/"
+    gm2_target_compile $srcdir/$subdir/WriteMap.mod WriteMap.o object "-g -I$srcdir/$subdir/"
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/quads/run/pass/becomes.mod b/gcc/testsuite/gm2/quads/run/pass/becomes.mod
new file mode 100644
index 00000000000..d558f140985
--- /dev/null
+++ b/gcc/testsuite/gm2/quads/run/pass/becomes.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE becomes ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   i := 1
+END becomes.
diff --git a/gcc/testsuite/gm2/quads/run/pass/param.mod b/gcc/testsuite/gm2/quads/run/pass/param.mod
new file mode 100644
index 00000000000..df787b83380
--- /dev/null
+++ b/gcc/testsuite/gm2/quads/run/pass/param.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE param ;
+
+PROCEDURE foo (i: INTEGER; c: CHAR; s: ARRAY OF CHAR) ;
+BEGIN
+
+END foo ;
+
+BEGIN
+   foo(1, 'c', 'hello world')
+END param.
diff --git a/gcc/testsuite/gm2/quads/run/pass/quads-run-pass.exp b/gcc/testsuite/gm2/quads/run/pass/quads-run-pass.exp
new file mode 100644
index 00000000000..01d40d29d9f
--- /dev/null
+++ b/gcc/testsuite/gm2/quads/run/pass/quads-run-pass.exp
@@ -0,0 +1,39 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${gm2src}/gm2-compiler"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/quads/run/pass/return.mod b/gcc/testsuite/gm2/quads/run/pass/return.mod
new file mode 100644
index 00000000000..8aa438dfe08
--- /dev/null
+++ b/gcc/testsuite/gm2/quads/run/pass/return.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE return ;
+
+PROCEDURE foo () : INTEGER ;
+BEGIN
+   RETURN 1
+END foo ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   i := foo()
+END return.
diff --git a/gcc/testsuite/gm2/recover/pass/cannot-solve/begin.mod b/gcc/testsuite/gm2/recover/pass/cannot-solve/begin.mod
new file mode 100644
index 00000000000..a0e756d8327
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/cannot-solve/begin.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2001-2021 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 2, 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. *)
+
+MODULE begin ;
+
+
+(*
+   foo -
+*)
+
+PROCEDURE foo (a, b: CARDINAL) ;
+a := a + b
+
+END foo ;
+
+
+
+BEGIN
+   foo(1, 2)
+END begin.
diff --git a/gcc/testsuite/gm2/recover/pass/cannot-solve/statementsemi.mod b/gcc/testsuite/gm2/recover/pass/cannot-solve/statementsemi.mod
new file mode 100644
index 00000000000..6e33f2367a6
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/cannot-solve/statementsemi.mod
@@ -0,0 +1,12 @@
+MODULE statementsemi ;
+
+VAR
+   x, y: CARDINAL ;
+BEGIN
+   x := 0 ;
+   y := 10 ;
+   WHILE x < y DO
+      INC (x)  (* missing semicolon  *)
+      INC (x)
+   END
+END statementsemi.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/recover/pass/end2.mod b/gcc/testsuite/gm2/recover/pass/end2.mod
new file mode 100644
index 00000000000..401d464be78
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/end2.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001-2021 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 2, 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. *)
+
+MODULE end2 ;
+
+BEGIN
+   IF TRUE
+   THEN
+      IF FALSE
+      THEN
+   END
+END end2.
diff --git a/gcc/testsuite/gm2/recover/pass/of.mod b/gcc/testsuite/gm2/recover/pass/of.mod
new file mode 100644
index 00000000000..11581bf9c38
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/of.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001-2021 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 2, 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. *)
+
+MODULE of ;
+
+VAR
+   a: ARRAY [0..10] CARDINAL ;
+BEGIN
+END of.
diff --git a/gcc/testsuite/gm2/recover/pass/procsemi.mod b/gcc/testsuite/gm2/recover/pass/procsemi.mod
new file mode 100644
index 00000000000..1d944d921f1
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/procsemi.mod
@@ -0,0 +1,10 @@
+MODULE procsemi ;
+
+PROCEDURE foo  (* missing semicolon here.  *)
+BEGIN
+
+END foo ;
+
+BEGIN
+   foo
+END procsemi.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/recover/pass/recover-pass.exp b/gcc/testsuite/gm2/recover/pass/recover-pass.exp
new file mode 100644
index 00000000000..da54520c03d
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/recover-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2004-2021 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_log
+
+foreach testcase [lsort [glob -nocomplain $srcdir/../gm2/gm2-libs-pim/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/recover/pass/rrbra.mod b/gcc/testsuite/gm2/recover/pass/rrbra.mod
new file mode 100644
index 00000000000..7aac91acee5
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/rrbra.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2021 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 2, 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. *)
+
+MODULE rrbra ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := ((2 + 4) DIV 2      (* missing ) *)
+END rrbra.
diff --git a/gcc/testsuite/gm2/recover/pass/rsbra.mod b/gcc/testsuite/gm2/recover/pass/rsbra.mod
new file mode 100644
index 00000000000..16813bcbd38
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/rsbra.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2001-2021 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 2, 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. *)
+
+MODULE rsbra ;
+
+VAR
+   a: ARRAY [0..10 OF CARDINAL ;
+BEGIN
+END rsbra.
diff --git a/gcc/testsuite/gm2/recover/pass/semi.mod b/gcc/testsuite/gm2/recover/pass/semi.mod
new file mode 100644
index 00000000000..4ae8b639944
--- /dev/null
+++ b/gcc/testsuite/gm2/recover/pass/semi.mod
@@ -0,0 +1,21 @@
+(* Copyright (C) 2001-2021 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 2, 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. *)
+
+MODULE semi
+
+BEGIN
+END semi.
diff --git a/gcc/testsuite/gm2/run/fail/list.mod b/gcc/testsuite/gm2/run/fail/list.mod
new file mode 100644
index 00000000000..54b79d3b0ee
--- /dev/null
+++ b/gcc/testsuite/gm2/run/fail/list.mod
@@ -0,0 +1,105 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE list ;
+
+
+FROM FIO IMPORT OpenToRead, OpenToWrite, Close, EOF, WriteLine,
+                ReadString, WriteString, File, WriteChar;
+FROM NumberIO IMPORT WriteInt,ReadInt,StrToInt,IntToStr;
+FROM FpuIO IMPORT ReadReal,WriteReal,StrToReal,RealToStr;
+FROM StdIO IMPORT Write;
+IMPORT StrIO; (* WriteString,WriteLn,ReadString; *)
+FROM StrLib IMPORT StrLen,StrLess,StrEqual;
+
+TYPE
+    string4  = ARRAY[0..3] OF CHAR;
+    string8 = ARRAY[0..7] OF CHAR;
+    string10 = ARRAY[0..9] OF CHAR;
+    string20 = ARRAY[0..19] OF CHAR;
+    string40 = ARRAY[0..39] OF CHAR;
+
+   employeeRecordType = RECORD
+          Forename : string20;
+          Surname  : string40;
+          EmpNumber: string10;
+          Address1 : string20;
+          Address2 : string20;
+          Address3 : string20;
+          Address4 : string20;
+          END;(*record*)
+
+VAR
+   filehandle: File ;
+   crlf      : ARRAY[0..1] OF CHAR;
+
+
+PROCEDURE getRecord(VAR employeeRec: employeeRecordType);
+BEGIN
+   WITH employeeRec DO
+      (*Read in each field in turn.*)
+      ReadString(filehandle,Surname);
+      ReadString(filehandle,Forename);
+      ReadString(filehandle,EmpNumber);
+      ReadString(filehandle,Address1);
+      ReadString(filehandle,Address2);
+      ReadString(filehandle,Address3);
+      ReadString(filehandle,Address4);
+      ReadString(filehandle,crlf);
+   END
+END getRecord; 
+
+
+PROCEDURE getFile (nameOfFile : ARRAY OF CHAR) ;
+VAR
+    inRec : employeeRecordType;
+BEGIN
+    (*Reset the file to read it all in.*)
+    filehandle := OpenToRead(nameOfFile) ;
+
+    (*Process all the lines in the file.*)
+    WHILE NOT EOF(filehandle ) DO 
+    getRecord(inRec); 
+        printEntry(inRec);
+    END ; (* WHILE NOT EOF() *)
+    Close(filehandle);
+END getFile ; 
+
+PROCEDURE printEntry(which : employeeRecordType) ;
+BEGIN
+    WITH which DO
+        (*print each field in turn.*)
+        StrIO.WriteString(Forename);
+    StrIO.WriteString(" ");
+    StrIO.WriteString(Surname);
+    StrIO.WriteString(" ");
+    StrIO.WriteString(EmpNumber);
+    StrIO.WriteLn;
+    StrIO.WriteString(Address1);
+    StrIO.WriteLn;
+    StrIO.WriteString(Address2);
+    StrIO.WriteLn;
+    StrIO.WriteString(Address3);
+    StrIO.WriteLn;
+    StrIO.WriteString(Address4);
+    END ; (*with*)
+StrIO.WriteLn;
+END printEntry; (*printEntry*)
+
+
+BEGIN
+   getFile('employee.txt')
+END list.
diff --git a/gcc/testsuite/gm2/run/fail/options b/gcc/testsuite/gm2/run/fail/options
new file mode 100644
index 00000000000..713b1ee07d9
--- /dev/null
+++ b/gcc/testsuite/gm2/run/fail/options
@@ -0,0 +1 @@
+-return -bounds
diff --git a/gcc/testsuite/gm2/run/fail/testdec.mod b/gcc/testsuite/gm2/run/fail/testdec.mod
new file mode 100644
index 00000000000..beed36244ca
--- /dev/null
+++ b/gcc/testsuite/gm2/run/fail/testdec.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testdec ;
+
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 0 ;  (* test bounds *)
+   DEC(c)
+END testdec.
diff --git a/gcc/testsuite/gm2/run/fail/testfunc.mod b/gcc/testsuite/gm2/run/fail/testfunc.mod
new file mode 100644
index 00000000000..47cdb6e73e7
--- /dev/null
+++ b/gcc/testsuite/gm2/run/fail/testfunc.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfunc ;
+
+
+(*
+   func - 
+*)
+
+PROCEDURE func (a: CARDINAL) : CARDINAL ;
+BEGIN
+   IF a>10
+   THEN
+      RETURN( a )
+   END
+END func ;
+
+
+VAR
+   e: CARDINAL ;
+BEGIN
+   e := func(9)
+END testfunc.
diff --git a/gcc/testsuite/gm2/run/pass/cycles.mod b/gcc/testsuite/gm2/run/pass/cycles.mod
new file mode 100644
index 00000000000..ad5a8c690e7
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/cycles.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE cycles ;
+
+
+FROM FpuIO IMPORT StrToLongReal, WriteLongReal ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM libc IMPORT exit ;
+
+
+CONST
+   DefaultClockFreq = 133.0 * 1000000.0 ;
+   MaxString        = 100 ;
+VAR
+   ClockFreq,
+   Period   : LONGREAL ;
+BEGIN
+   StrToLongReal('350', ClockFreq) ;
+   Period := 1.0/(ClockFreq * 1000000.0) ;
+   IF Period>1.0
+   THEN
+      WriteString('floating point code generator failed') ; WriteLn ;
+      exit(1)
+   ELSE
+      WriteString('simple fpu code generator test passed') ; WriteLn
+   END
+END cycles.
diff --git a/gcc/testsuite/gm2/run/pass/line.mod b/gcc/testsuite/gm2/run/pass/line.mod
new file mode 100644
index 00000000000..56d4782190e
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/line.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+(* line 1 *)
+(* line 2 *)
+(* line 3
+
+   line 5 *)
+MODULE line ;
+(* line 7 *)
+
+(* line 9 *)
+BEGIN
+   IF __LINE__#11
+   THEN
+      HALT
+   END
+END line.
diff --git a/gcc/testsuite/gm2/run/pass/nestedproc.mod b/gcc/testsuite/gm2/run/pass/nestedproc.mod
new file mode 100644
index 00000000000..4c34e014045
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/nestedproc.mod
@@ -0,0 +1,56 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+VAR
+   j: CARDINAL ;
+
+
+PROCEDURE middle ;
+VAR
+   j: CARDINAL ;
+
+   PROCEDURE displayit ;
+   BEGIN
+      WriteCard(j, 0) ; WriteLn
+   END displayit ;
+
+   PROCEDURE inner ;
+   VAR
+      j: CARDINAL ;
+   BEGIN
+      j := 999
+   END inner ;
+
+BEGIN
+   j := 222 ;
+   inner ;
+   displayit
+END middle ;
+
+
+
+BEGIN
+   j := 111 ;
+   WriteString('the answers on the next two lines should be 111 and 222') ; WriteLn ;
+   WriteCard(j, 0) ; WriteLn ;
+   middle
+   (* should yield   222 *)
+END nestedproc.
diff --git a/gcc/testsuite/gm2/run/pass/nestedproc2.mod b/gcc/testsuite/gm2/run/pass/nestedproc2.mod
new file mode 100644
index 00000000000..3671e07f52a
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/nestedproc2.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc2 ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   j: CARDINAL ;
+
+PROCEDURE ReadIt (VAR c: CARDINAL) ;
+BEGIN
+   c := 222
+END ReadIt ;
+
+
+PROCEDURE middle ;
+VAR
+   j: CARDINAL ;
+
+   PROCEDURE displayit ;
+   BEGIN
+      INC(j) ;
+      WriteCard(j, 0) ; WriteLn
+   END displayit ;
+
+   PROCEDURE inner ;
+   BEGIN
+      ReadIt(j)
+   END inner ;
+
+BEGIN
+   j := 999 ;
+   inner ;
+   displayit
+END middle ;
+
+
+
+BEGIN
+   j := 111 ;
+   middle
+   (* should yield   223 *)
+END nestedproc2.
diff --git a/gcc/testsuite/gm2/run/pass/nestedproc3.mod b/gcc/testsuite/gm2/run/pass/nestedproc3.mod
new file mode 100644
index 00000000000..20708d6bb0d
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/nestedproc3.mod
@@ -0,0 +1,67 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc3 ;
+
+FROM StdIO IMPORT Write ;
+FROM StrIO IMPORT WriteLn ;
+
+PROCEDURE a ;
+VAR
+   s: CHAR ;
+
+PROCEDURE b ;
+
+PROCEDURE c ;
+VAR
+   s: CHAR ;
+
+PROCEDURE d ;
+
+PROCEDURE e ;
+BEGIN
+   s := 'a' ;
+   b2
+END e ;
+
+BEGIN
+   e
+END d ;
+
+BEGIN
+   d
+END c ;
+
+BEGIN
+   c
+END b ;
+
+PROCEDURE b2 ;
+BEGIN
+   s := 'g' ;
+END b2 ;
+
+
+BEGIN
+   s := 'z' ;
+   b ;
+   Write(s) ; WriteLn
+   (* output should be 'g' *)
+END a ;
+
+BEGIN
+   a
+END nestedproc3.
diff --git a/gcc/testsuite/gm2/run/pass/nestedproc5.mod b/gcc/testsuite/gm2/run/pass/nestedproc5.mod
new file mode 100644
index 00000000000..1d6cdd7abeb
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/nestedproc5.mod
@@ -0,0 +1,57 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc5 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrCopy, StrLen ;
+
+PROCEDURE outer ;
+VAR
+   a: ARRAY [0..80] OF CHAR ;
+
+   PROCEDURE flip (i, j: CARDINAL) ;
+   VAR
+      t: CHAR ;
+   BEGIN
+      t := a[i] ;
+      a[i] := a[j] ;
+      a[j] := t
+   END flip ;
+
+   PROCEDURE inner ;
+   VAR
+      h, l, k: CARDINAL ;
+   BEGIN
+      h := HIGH(a) ;  (* test it.. *)
+      IF h#80
+      THEN
+         HALT
+      END ;
+      k := 0 ;
+      l := StrLen(a)-1 ;
+      flip(3, 8)
+   END inner ;
+BEGIN
+   StrCopy('0128456739', a) ;
+   inner ;
+   WriteString(a) ; WriteLn
+END outer ;
+
+
+BEGIN
+   outer
+END nestedproc5.
diff --git a/gcc/testsuite/gm2/run/pass/nestedset.mod b/gcc/testsuite/gm2/run/pass/nestedset.mod
new file mode 100644
index 00000000000..c146d1e78c4
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/nestedset.mod
@@ -0,0 +1,22 @@
+MODULE nestedset ;
+
+TYPE
+   someset = SET OF [0..15] ;
+
+PROCEDURE a (s : someset) ;
+BEGIN
+END a ;
+
+PROCEDURE b (s : someset) ;
+
+   PROCEDURE c ;
+   BEGIN
+      a(s);
+   END c ;
+
+BEGIN
+END b;
+
+BEGIN
+END nestedset.
+
diff --git a/gcc/testsuite/gm2/run/pass/nothing.mod b/gcc/testsuite/gm2/run/pass/nothing.mod
new file mode 100644
index 00000000000..5e58cda07fc
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/nothing.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nothing ;
+
+IMPORT ASCII ;
+IMPORT StdIO ;
+IMPORT StrIO ;
+IMPORT SYSTEM ;
+IMPORT NumberIO ;
+IMPORT FIO ;
+
+BEGIN
+END nothing.
diff --git a/gcc/testsuite/gm2/run/pass/options b/gcc/testsuite/gm2/run/pass/options
new file mode 100644
index 00000000000..20143efd772
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/options
@@ -0,0 +1 @@
+-g
diff --git a/gcc/testsuite/gm2/run/pass/prog31ex.mod b/gcc/testsuite/gm2/run/pass/prog31ex.mod
new file mode 100644
index 00000000000..37b064909c6
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/prog31ex.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE prog31ex;
+FROM StrIO IMPORT WriteLn,WriteString;
+FROM FpuIO IMPORT ReadReal, WriteReal;
+
+VAR
+   fahrenheit      : REAL;
+   celsius         : REAL;
+BEGIN
+   celsius := -10.0;
+   fahrenheit := 0.0;
+   WHILE celsius <= 100.0 DO
+      WriteReal(celsius,6,2);
+      fahrenheit := ((celsius * 9.0) / 5.0) + 32.0;
+      WriteString(" degrees Celsius goes to ") ;
+      WriteReal(fahrenheit,6,2);
+      WriteString(" degrees Fahrenheit");
+      WriteLn;
+      celsius := celsius + 5.0;
+   END
+END prog31ex.
diff --git a/gcc/testsuite/gm2/run/pass/rts.mod b/gcc/testsuite/gm2/run/pass/rts.mod
new file mode 100644
index 00000000000..befbbcd98c2
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/rts.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE rts;
+
+FROM FpuIO IMPORT ReadReal,WriteReal,StrToReal,RealToStr, ReadLongReal;
+IMPORT StrIO; (* WriteString,WriteLn,ReadString; *)
+
+VAR
+   s  : ARRAY[0..9] OF CHAR;
+   r  : REAL;
+   l  : LONGREAL ;
+   t,f: CARDINAL;
+   a,b: CARDINAL ;
+BEGIN
+   a := 123 ;
+   b := 45 ;
+   r := FLOAT(a) + (FLOAT(b) / 100.0) ;
+(*
+   l := FLOAT(a) + (FLOAT(b) / 100.0) ;
+   ReadReal(r);
+*)
+   t := 7;
+   f := 2;
+   RealToStr(r,t,f,s);
+   StrIO.WriteString(s);
+   StrIO.WriteLn;
+END rts.
diff --git a/gcc/testsuite/gm2/run/pass/stripped.mod b/gcc/testsuite/gm2/run/pass/stripped.mod
new file mode 100644
index 00000000000..f7dcbc0731b
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/stripped.mod
@@ -0,0 +1,22 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE stripped ;
+FROM StrIO IMPORT WriteLn,WriteString;
+FROM FpuIO IMPORT ReadReal, WriteReal;
+
+BEGIN
+END stripped .
diff --git a/gcc/testsuite/gm2/run/pass/testavail.mod b/gcc/testsuite/gm2/run/pass/testavail.mod
new file mode 100644
index 00000000000..0240d58ced4
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/testavail.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testavail ;
+
+
+FROM Storage IMPORT Available ;
+FROM libc IMPORT exit ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+
+BEGIN
+   IF Available(100)
+   THEN
+      WriteString('works') ; WriteLn
+   ELSE
+      exit(1)
+   END
+END testavail.
diff --git a/gcc/testsuite/gm2/run/pass/testfpufunc.mod b/gcc/testsuite/gm2/run/pass/testfpufunc.mod
new file mode 100644
index 00000000000..125ac3d802a
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/testfpufunc.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfpufunc ;
+
+
+PROCEDURE func () : REAL ;
+VAR
+   a: REAL ;
+BEGIN
+   a := 4.5 ;
+   RETURN( a )
+END func ;
+
+
+VAR
+   t: REAL ;
+   n: CARDINAL ;
+BEGIN
+   n := 0 ;
+   WHILE n<10000 DO
+      t := func() ;
+      INC(n)
+   END
+END testfpufunc.
diff --git a/gcc/testsuite/gm2/run/pass/testfpufunc2.mod b/gcc/testsuite/gm2/run/pass/testfpufunc2.mod
new file mode 100644
index 00000000000..9c34a43262c
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/testfpufunc2.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfpufunc2 ;
+
+
+PROCEDURE func () : REAL ;
+VAR
+   t: RECORD
+         a: REAL ;
+      END ;
+BEGIN
+   t.a := 4.5 ;
+   WITH t DO
+      RETURN( a )
+   END
+END func ;
+
+
+VAR
+   t: REAL ;
+   n: CARDINAL ;
+BEGIN
+   n := 0 ;
+   WHILE n<10000 DO
+      t := func() ;
+      INC(n)
+   END
+END testfpufunc2.
diff --git a/gcc/testsuite/gm2/run/pass/testnextproc.mod b/gcc/testsuite/gm2/run/pass/testnextproc.mod
new file mode 100644
index 00000000000..cfc824b0859
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/testnextproc.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testnextproc ;
+
+
+(*
+   nested procedures are not implemented in the compiler yet.
+*)
+
+PROCEDURE foo ;
+   PROCEDURE bar ;
+   BEGIN
+   END bar ;
+BEGIN bar
+END foo ;
+
+BEGIN
+   foo
+END testnextproc.
diff --git a/gcc/testsuite/gm2/run/pass/testparam.mod b/gcc/testsuite/gm2/run/pass/testparam.mod
new file mode 100644
index 00000000000..b06310926ce
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/testparam.mod
@@ -0,0 +1,70 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testparam ;
+
+
+FROM SYSTEM IMPORT SIZE ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteLn ;
+
+TYPE
+   r = RECORD
+          b: CHAR ;
+          c: CARDINAL ;
+       END ;
+
+   typeArray = ARRAY [1..20] OF r ;
+
+
+PROCEDURE arrayUb (a: ARRAY OF r) ;
+BEGIN
+   IF HIGH(a)#20
+   THEN
+      HALT
+   END
+END arrayUb ;
+
+
+PROCEDURE array (a: typeArray) ;
+BEGIN
+   IF a[5].b#'g'
+   THEN
+      HALT
+   END
+END array ;
+
+
+PROCEDURE char (ch: CHAR) ;
+BEGIN
+   IF ch#'g'
+   THEN
+      HALT
+   END
+END char ;
+
+VAR
+   ch    : CHAR ;
+   global: typeArray ;
+BEGIN
+   global[5].b := 'g' ;
+   WriteCard(SIZE(global[5]), 6) ; WriteLn ;
+   ch := 'g' ;
+   char(ch) ;
+   char('g') ;
+   arrayUb(global) ;
+   array(global)
+END testparam.
diff --git a/gcc/testsuite/gm2/run/pass/testsize.mod b/gcc/testsuite/gm2/run/pass/testsize.mod
new file mode 100644
index 00000000000..8eb9f6d40d6
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/testsize.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testsize ;
+
+FROM SYSTEM IMPORT SIZE ;
+
+VAR
+   p: POINTER TO CHAR ;
+   c: CARDINAL ;
+BEGIN
+   p := NIL ;
+   c := SIZE(p^)   (* should not sigsegv! *)
+END testsize.
diff --git a/gcc/testsuite/gm2/run/pass/testsize2.mod b/gcc/testsuite/gm2/run/pass/testsize2.mod
new file mode 100644
index 00000000000..40034bad559
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/testsize2.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testsize2 ;
+
+FROM SYSTEM IMPORT SIZE ;
+
+TYPE
+   FRAGMENT = POINTER TO RECORD
+                            Left, Right: FRAGMENT ;
+                            Size       : CARDINAL ;
+                         END ;
+
+VAR
+   n: CARDINAL ;
+   f: FRAGMENT ;
+BEGIN
+   n := 0 ;
+   INC(n, SIZE(f^)) ;
+   f := NIL ;
+   IF f=f
+   THEN
+   END
+END testsize2.
diff --git a/gcc/testsuite/gm2/run/pass/testsize3.mod b/gcc/testsuite/gm2/run/pass/testsize3.mod
new file mode 100644
index 00000000000..166a42da0b7
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/testsize3.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testsize3 ;
+
+FROM SYSTEM IMPORT BYTE, SIZE ;
+
+VAR
+   i: INTEGER ;
+   p: CHAR ;
+   c: CARDINAL ;
+   b: BYTE ;
+BEGIN
+   c := (SIZE(i) + SIZE(p)) DIV SIZE(b)
+END testsize3.
diff --git a/gcc/testsuite/gm2/run/pass/wr.mod b/gcc/testsuite/gm2/run/pass/wr.mod
new file mode 100644
index 00000000000..da0cc851a6d
--- /dev/null
+++ b/gcc/testsuite/gm2/run/pass/wr.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE wr;
+
+IMPORT FIO;
+
+FROM StrIO IMPORT WriteString, WriteLn, ReadString;
+FROM StrLib IMPORT StrEqual;
+FROM NumberIO IMPORT WriteInt,WriteCard;
+
+
+PROCEDURE Overall;
+VAR
+   in,out : CARDINAL;
+   fnum1 : FIO.File;
+BEGIN
+   fnum1 := FIO.OpenToWrite('results.dat');
+   FOR out :=1 TO 9 DO
+      FIO.WriteCardinal(fnum1,out);
+      FIO.WriteLine(fnum1);
+   END ; (* outer for *)
+   FIO.Close(fnum1)
+END Overall;
+
+
+BEGIN (*main program*)
+   Overall
+END wr.
diff --git a/gcc/testsuite/gm2/scripts/addit b/gcc/testsuite/gm2/scripts/addit
new file mode 100644
index 00000000000..295250826ea
--- /dev/null
+++ b/gcc/testsuite/gm2/scripts/addit
@@ -0,0 +1,29 @@
+#!/bin/sh
+
+# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+# 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 2, 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, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA. 
+#
+
+for i in * ; do
+   cvs add $i
+   if [ -d $i ] ; then
+      ( cd $i ; ../$0 ; cd .. )
+   fi
+done
+
diff --git a/gcc/testsuite/gm2/scripts/comp b/gcc/testsuite/gm2/scripts/comp
new file mode 100644
index 00000000000..a3f7906a369
--- /dev/null
+++ b/gcc/testsuite/gm2/scripts/comp
@@ -0,0 +1,40 @@
+#!/bin/sh
+
+# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+# 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 2, 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, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA. 
+#
+
+BFLAGS=-B../../../../../../../build-isode/gcc/stage1/gm2
+LIBS=-I.:/usr/local/lib/gcc-lib/i686-pc-linux-gnu/3.2/gm2
+DRIVER=../../../../../../../build-isode/gcc/xgm2
+
+if [ ! -x $DRIVER ] ; then
+   echo "cannot find $DRIVER"
+   exit 1
+fi
+if ! $DRIVER $BFLAGS -v $LIBS -Wcpp -gstabs -c $1 ; then
+    exit $?
+fi
+if ! $DRIVER $BFLAGS $LIBS -Wcpp -S -gstabs -c $1 ; then
+    exit $?
+fi
+if ! $DRIVER $BFLAGS $LIBS -Wcpp -gstabs -I. $1 ; then
+    exit $?
+fi
+
diff --git a/gcc/testsuite/gm2/scripts/compile b/gcc/testsuite/gm2/scripts/compile
new file mode 100644
index 00000000000..1e127ae6d11
--- /dev/null
+++ b/gcc/testsuite/gm2/scripts/compile
@@ -0,0 +1,53 @@
+#!/bin/sh
+
+# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+# 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 2, 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, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA. 
+#
+
+GCC_VERSION=3.3.1
+BFLAGS=-B../../../../../../../build-$GCC_VERSION/gcc/stage1/gm2
+LIBS=-I.:/usr/local/lib/gcc-lib/i686-pc-linux-gnu/$GCC_VERSION/gm2
+DRIVER=../../../../../../../build-$GCC_VERSION/gcc/xgm2
+OPTS=$2
+CPP=
+
+if [ ! -x $DRIVER ] ; then
+   echo "cannot find $DRIVER"
+   exit 1
+fi
+if ! $DRIVER $OPTS $BFLAGS $LIBS -gstabs -c $1 ; then
+    exit $?
+fi
+if ! $DRIVER $OPTS $BFLAGS $LIBS -S -gstabs -c $1 ; then
+    exit $?
+fi
+if ! $DRIVER $OPTS $BFLAGS $LIBS -gstabs -I. $1 -lm ; then
+    exit $?
+fi
+cat << EOFEOF > .gdbinit
+# set language modula-2
+# set language pascal
+break _M2_`basename $1 .mod`_init
+run
+#next
+#print r
+#ptype r
+EOFEOF
+emacs .gdbinit
+
diff --git a/gcc/testsuite/gm2/scripts/compileiso b/gcc/testsuite/gm2/scripts/compileiso
new file mode 100644
index 00000000000..99838d4e08b
--- /dev/null
+++ b/gcc/testsuite/gm2/scripts/compileiso
@@ -0,0 +1,53 @@
+#!/bin/sh
+
+# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+# 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 2, 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, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA. 
+#
+
+BFLAGS=-B../../../../../../../build/gcc/stage1/gm2
+CLIBS=-I../../../../gm2-iso:.:/usr/local/lib/gcc-lib/i686-pc-linux-gnu/3.2/gm2/iso:/usr/local/lib/gcc-lib/i686-pc-linux-gnu/3.2/gm2/pim
+LLIBS=-I.:/usr/local/lib/gcc-lib/i686-pc-linux-gnu/3.2/gm2/iso:/usr/local/lib/gcc-lib/i686-pc-linux-gnu/3.2/gm2/pim
+DRIVER=../../../../../../../build/gcc/xgm2
+OPTS=-Wiso $2
+CPP=
+
+if [ ! -x $DRIVER ] ; then
+   echo "cannot find $DRIVER"
+   exit 1
+fi
+if ! $DRIVER $OPTS $BFLAGS $CLIBS -gstabs -c $1 ; then
+    exit $?
+fi
+if ! $DRIVER $OPTS $BFLAGS $CLIBS -S -gstabs -c $1 ; then
+    exit $?
+fi
+if ! $DRIVER $OPTS $BFLAGS $LLIBS -gstabs -I. $1 -lm ; then
+    exit $?
+fi
+cat << EOFEOF > .gdbinit
+# set language modula-2
+# set language pascal
+break _M2_`basename $1 .mod`_init
+run
+#next
+#print r
+#ptype r
+EOFEOF
+emacs .gdbinit
+
diff --git a/gcc/testsuite/gm2/scripts/link b/gcc/testsuite/gm2/scripts/link
new file mode 100644
index 00000000000..5845c2486f5
--- /dev/null
+++ b/gcc/testsuite/gm2/scripts/link
@@ -0,0 +1,45 @@
+#!/bin/sh
+
+# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+# 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 2, 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, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA. 
+#
+
+BFLAGS=-B../../../../../../../build/gcc/stage1/gm2
+LIBS=-I.:/usr/local/lib/gcc-lib/i686-pc-linux-gnu/3.2/gm2
+DRIVER=../../../../../../../build/gcc/xgm2
+
+as -o `basename $1 .mod`.o `basename $1 .mod`.s
+if [ ! -x $DRIVER ] ; then
+   echo "cannot find $DRIVER"
+   exit 1
+fi
+if ! $DRIVER -Wcpp $BFLAGS -I$LIBS -g -I. $1 ; then
+    exit $?
+fi
+cat << EOFEOF > .gdbinit
+# set language modula-2
+# set language pascal
+break _M2_`basename $1 .mod`_init
+run
+# next
+# print s
+# print ch
+EOFEOF
+emacs .gdbinit
+
diff --git a/gcc/testsuite/gm2/scripts/regression b/gcc/testsuite/gm2/scripts/regression
new file mode 100644
index 00000000000..96fdc3aa85e
--- /dev/null
+++ b/gcc/testsuite/gm2/scripts/regression
@@ -0,0 +1,147 @@
+#!/bin/sh
+
+# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+# 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 2, 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, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA. 
+#
+
+GCC_VERSION=3.3.6
+BFLAGS=-B../../../../../../../build-$GCC_VERSION/gcc/stage1/gm2
+LIBS=-I.:/usr/local/lib/gcc-lib/i686-pc-linux-gnu/$GCC_VERSION/gm2/pim
+DRIVER=../../../../../../../build-$GCC_VERSION/gcc/xgm2
+OPTFLAGS=-O
+LIBRARIES=-lm
+
+if [ ! -x $DRIVER ] ; then
+   echo "cannot find $DRIVER"
+   exit 1
+fi
+
+function compile () {
+    rm -f a.out
+    if ! $DRIVER $BFLAGS -v $OPTFLAGS $LIBS -Wcpp -gstabs -c $1 >& /dev/null  ; then
+        echo "failed to compile $1: compilation command: exit code" $?
+        $DRIVER $BFLAGS $OPTFLAGS $LIBS -gstabs -c $1
+        $DRIVER -v $BFLAGS $OPTFLAGS $LIBS -gstabs -c $1
+        return
+    fi
+    if ! $DRIVER $BFLAGS $OPTFLAGS $LIBS -Wcpp -S -gstabs -c $1 >& /dev/null ; then
+        echo "failed to compile $1"
+        return
+    fi
+    if ! $DRIVER $BFLAGS $LIBS -Wcpp -gstabs -I. $1 $LIBRARIES >& /dev/null ; then
+        echo "failed to link $1"
+    fi
+}
+
+function doFile () {
+    compile $1
+    if [ -x a.out ] ; then
+        echo -n "$1 : "
+        if ./a.out >& /dev/null ; then
+            echo "passed"
+        else
+            echo "compiled ok, but executable, a.out, failed with exit code $?"
+        fi
+    fi
+}
+
+
+doFile smallset1.mod
+doFile smallset2.mod
+doFile smallset3.mod
+doFile smallset4.mod
+doFile smallset5.mod
+doFile smallset6.mod
+doFile smallset7.mod
+
+doFile largeset1.mod
+doFile largeset2.mod
+doFile largeset3.mod
+doFile largeset4.mod
+doFile largeset5.mod
+doFile largeset6.mod
+
+doFile setchar10.mod
+doFile parambool.mod
+doFile arraybool.mod
+doFile procindirect.mod
+doFile localvar.mod
+doFile proctype.mod
+doFile setchar11.mod
+doFile ptrarray.mod
+doFile ptrarray2.mod
+doFile record1.mod
+doFile record2.mod
+doFile ConvTypes.mod
+doFile ChanConsts.mod
+doFile testrecursive.mod
+doFile test2recursive.mod
+doFile testbuiltin2.mod
+doFile testcase.mod
+doFile testcase2.mod
+doFile testcase3.mod
+doFile testcase4.mod
+doFile trunc.mod
+doFile longreal.mod
+doFile realneg.mod
+doFile realneg2.mod
+doFile sizetype.mod
+doFile defset.mod
+doFile constset.mod
+doFile constset2.mod
+doFile constset3.mod
+doFile bitset2.mod
+doFile bitset3.mod
+
+doFile testabs.mod
+doFile testcap.mod
+doFile testodd.mod
+doFile testord.mod
+doFile bits32.mod
+doFile bits32i.mod
+doFile loopexit.mod
+doFile constsize.mod
+doFile constsize2.mod
+doFile impc.mod
+doFile impb.mod
+doFile impa.mod
+doFile impd.mod
+doFile impe.mod
+# doFile impf.mod should fail
+doFile impg.mod
+doFile imph.mod
+doFile impi.mod
+doFile impj.mod
+# doFile realbitscast.mod an ISO test
+doFile tinyimp.mod
+doFile impm.mod
+doFile impn.mod
+doFile impo.mod
+doFile testset.mod
+doFile convert.mod
+doFile longcard2.mod
+doFile arraydim.mod
+doFile multtypes.mod
+doFile testcard.mod
+doFile testcard2.mod
+doFile testcard3.mod
+doFile testcard4.mod
+doFile opaquetype.mod
+doFile testopaque3.mod
+doFile testchar.mod
diff --git a/gcc/testsuite/gm2/scripts/subit b/gcc/testsuite/gm2/scripts/subit
new file mode 100644
index 00000000000..530792831f0
--- /dev/null
+++ b/gcc/testsuite/gm2/scripts/subit
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+# 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 2, 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, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA. 
+#
+
+for i in * ; do
+   if [ "`basename $i .o`.o" = "$i" ] ; then
+      rm $i
+      cvs remove $i
+   fi
+   if [ -d $i ] ; then
+      ( cd $i ; ../$0 ; cd .. )
+   fi
+done
+
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetarith.mod b/gcc/testsuite/gm2/sets/run/pass/multisetarith.mod
new file mode 100644
index 00000000000..5eeaef2b401
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetarith.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetarith ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   one, two: multi ;
+BEGIN
+   one := multi {1} ;
+   two := multi {2} ;
+   IF one * two = multi {}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisetarith.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetarith2.mod b/gcc/testsuite/gm2/sets/run/pass/multisetarith2.mod
new file mode 100644
index 00000000000..490346c32d1
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetarith2.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetarith2 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   one, two: multi ;
+BEGIN
+   one := multi {1} ;
+   two := multi {2} ;
+   IF one + two = multi {1, 2}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisetarith2.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetarith3.mod b/gcc/testsuite/gm2/sets/run/pass/multisetarith3.mod
new file mode 100644
index 00000000000..23e2a1ed55c
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetarith3.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetarith3 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   onetwo: multi ;
+BEGIN
+   onetwo := multi {1, 2} ;
+   IF onetwo - multi {1} = multi {2}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisetarith3.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetarith4.mod b/gcc/testsuite/gm2/sets/run/pass/multisetarith4.mod
new file mode 100644
index 00000000000..34ff58518da
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetarith4.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetarith4 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   three: multi ;
+BEGIN
+   three := multi {1, 2, 3} ;
+   IF three - multi {1} = multi {2, 3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisetarith4.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetrotate.mod b/gcc/testsuite/gm2/sets/run/pass/multisetrotate.mod
new file mode 100644
index 00000000000..d6cbbc12541
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetrotate.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetrotate ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE, WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   set: multi ;
+BEGIN
+   set := multi {1} ;
+   IF ROTATE (set, 1) = multi {2}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisetrotate.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetrotate2.mod b/gcc/testsuite/gm2/sets/run/pass/multisetrotate2.mod
new file mode 100644
index 00000000000..e6480c5e206
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetrotate2.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetrotate2 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE, WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   set: multi ;
+BEGIN
+   set := multi {1} ;
+   IF ROTATE (set, -1) = multi {0}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisetrotate2.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetrotate3.mod b/gcc/testsuite/gm2/sets/run/pass/multisetrotate3.mod
new file mode 100644
index 00000000000..842da5a2685
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetrotate3.mod
@@ -0,0 +1,76 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetrotate3 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE, WORD, BITSPERLOC;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+
+
+(*
+   dump -
+*)
+
+PROCEDURE dump (s: multi) ;
+VAR
+   bits, i: CARDINAL ;
+BEGIN
+   bits := SIZE (multi) * BITSPERLOC -1;
+   FOR i := 0 TO bits DO
+      printf (" %2d", i)
+   END ;
+   printf ("\n") ;
+   FOR i := 0 TO bits DO
+      IF i IN s
+      THEN
+         printf ("  X")
+      ELSE
+         printf ("   ")
+      END
+   END ;
+   printf ("\n")
+END dump ;
+
+
+VAR
+   set : multi ;
+   bits: INTEGER ;
+BEGIN
+   dump (multi {1}) ;
+   dump (multi {2}) ;
+   dump (multi {63}) ;
+   dump (multi {48}) ;
+   dump (multi {32}) ;
+   dump (multi {31}) ;
+   set := multi {1} ;
+   dump (set) ;
+   bits := SIZE (multi) * BITSPERLOC ;
+   printf ("bits in multi = %d, bytes in multi = %d\n", bits, SIZE (multi)) ;
+   dump (ROTATE (set, bits)) ;
+   IF ROTATE (set, bits) # multi {1}
+   THEN
+      exit (1)
+   END ;
+   IF ROTATE (set, -bits) # multi {1}
+   THEN
+      exit (2)
+   END ;
+   exit (0)
+END multisetrotate3.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetrotate4.mod b/gcc/testsuite/gm2/sets/run/pass/multisetrotate4.mod
new file mode 100644
index 00000000000..f7524eb9444
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetrotate4.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetrotate4 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE, WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+
+VAR
+   set : multi ;
+   bits: INTEGER ;
+BEGIN
+   set := multi {1} ;
+   bits := SIZE (multi) * BITSPERLOC ;
+   IF ROTATE (set, bits-1) # multi {0}
+   THEN
+      exit (1)
+   END ;
+   IF ROTATE (set, -(bits - 1)) # multi {2}
+   THEN
+      exit (2)
+   END ;
+   exit (0)
+END multisetrotate4.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetshift.mod b/gcc/testsuite/gm2/sets/run/pass/multisetshift.mod
new file mode 100644
index 00000000000..e2c9bb7d6e4
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetshift.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetshift ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT SHIFT, WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   set: multi ;
+BEGIN
+   set := multi {1} ;
+   IF SHIFT (set, 1) = multi {2}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisetshift.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetshift2.mod b/gcc/testsuite/gm2/sets/run/pass/multisetshift2.mod
new file mode 100644
index 00000000000..abf3a2b98b2
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetshift2.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisetshift2 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT SHIFT, WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   set: multi ;
+BEGIN
+   set := multi {2} ;
+   IF SHIFT (set, -1) = multi {1}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisetshift2.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisimple.mod b/gcc/testsuite/gm2/sets/run/pass/multisimple.mod
new file mode 100644
index 00000000000..9b7d66b070b
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisimple.mod
@@ -0,0 +1,34 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisimple ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   empty: multi ;
+BEGIN
+   empty := multi {} ;
+   IF empty = multi {}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisimple.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisimple2.mod b/gcc/testsuite/gm2/sets/run/pass/multisimple2.mod
new file mode 100644
index 00000000000..a503fabca34
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisimple2.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisimple2 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   test: multi ;
+BEGIN
+   test := multi {1} ;
+   EXCL (test, 1) ;
+   IF test = multi {}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisimple2.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisimple3.mod b/gcc/testsuite/gm2/sets/run/pass/multisimple3.mod
new file mode 100644
index 00000000000..260a84ca5b6
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisimple3.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisimple3 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   test: multi ;
+BEGIN
+   test := multi {} ;
+   INCL (test, 1) ;
+   IF test = multi {1}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisimple3.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisimple4.mod b/gcc/testsuite/gm2/sets/run/pass/multisimple4.mod
new file mode 100644
index 00000000000..026b8a8a4ae
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisimple4.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisimple4 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   test: multi ;
+BEGIN
+   test := multi {2,3} ;
+   INCL (test, 1) ;
+   IF test = multi {1,2,3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisimple4.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisimple5.mod b/gcc/testsuite/gm2/sets/run/pass/multisimple5.mod
new file mode 100644
index 00000000000..112e752bfd1
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisimple5.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisimple5 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   test: multi ;
+BEGIN
+   test := multi {1,2,3} ;
+   EXCL (test, 1) ;
+   IF test = multi {2,3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisimple5.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisimple6.mod b/gcc/testsuite/gm2/sets/run/pass/multisimple6.mod
new file mode 100644
index 00000000000..99f3a19c71e
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisimple6.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisimple6 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   test: multi ;
+BEGIN
+   test := multi {2,3} ;
+   EXCL (test, 1) ;
+   IF test = multi {2,3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisimple6.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisimple7.mod b/gcc/testsuite/gm2/sets/run/pass/multisimple7.mod
new file mode 100644
index 00000000000..bf0e86b567a
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisimple7.mod
@@ -0,0 +1,35 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE multisimple7 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+VAR
+   test: multi ;
+BEGIN
+   test := multi {1,2,3} ;
+   INCL (test, 1) ;
+   IF test = multi {1,2,3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END multisimple7.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setarith.mod b/gcc/testsuite/gm2/sets/run/pass/setarith.mod
new file mode 100644
index 00000000000..db81ebc71ec
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setarith.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setarith ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   one, two: BITSET ;
+BEGIN
+   one := BITSET {1} ;
+   two := BITSET {2} ;
+   IF one * two = BITSET {}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END setarith.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setarith2.mod b/gcc/testsuite/gm2/sets/run/pass/setarith2.mod
new file mode 100644
index 00000000000..98de129654c
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setarith2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setarith2 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   one, two: BITSET ;
+BEGIN
+   one := BITSET {1} ;
+   two := BITSET {2} ;
+   IF one + two = BITSET {1, 2}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END setarith2.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setarith3.mod b/gcc/testsuite/gm2/sets/run/pass/setarith3.mod
new file mode 100644
index 00000000000..9b92bd06806
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setarith3.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setarith3 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   onetwo: BITSET ;
+BEGIN
+   onetwo := BITSET {1, 2} ;
+   IF onetwo - BITSET {1} = BITSET {2}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END setarith3.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setarith4.mod b/gcc/testsuite/gm2/sets/run/pass/setarith4.mod
new file mode 100644
index 00000000000..360f880763f
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setarith4.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setarith4 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   three: BITSET ;
+BEGIN
+   three := BITSET {1, 2, 3} ;
+   IF three - BITSET {1} = BITSET {2, 3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END setarith4.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setrotate.mod b/gcc/testsuite/gm2/sets/run/pass/setrotate.mod
new file mode 100644
index 00000000000..e7b43673636
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setrotate.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setrotate ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE ;
+
+VAR
+   set: BITSET ;
+BEGIN
+   set := BITSET {1} ;
+   IF ROTATE (set, 1) = BITSET {2}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END setrotate.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setrotate2.mod b/gcc/testsuite/gm2/sets/run/pass/setrotate2.mod
new file mode 100644
index 00000000000..a7759055355
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setrotate2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setrotate2 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE ;
+
+VAR
+   set: BITSET ;
+BEGIN
+   set := BITSET {1} ;
+   IF ROTATE (set, -1) = BITSET {0}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END setrotate2.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setrotate3.mod b/gcc/testsuite/gm2/sets/run/pass/setrotate3.mod
new file mode 100644
index 00000000000..774cb16d42b
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setrotate3.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setrotate3 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE, BITSPERLOC ;
+
+VAR
+   set : BITSET ;
+   bits: INTEGER ;
+BEGIN
+   set := BITSET {1} ;
+   bits := SIZE (BITSET) * BITSPERLOC ;
+   IF ROTATE (set, bits) # BITSET {1}
+   THEN
+      exit (1)
+   END ;
+   IF ROTATE (set, -bits) # BITSET {1}
+   THEN
+      exit (2)
+   END ;
+   exit (0)
+END setrotate3.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setrotate4.mod b/gcc/testsuite/gm2/sets/run/pass/setrotate4.mod
new file mode 100644
index 00000000000..3a769977b3f
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setrotate4.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setrotate4 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE, BITSPERLOC ;
+
+VAR
+   set : BITSET ;
+   bits: INTEGER ;
+BEGIN
+   set := BITSET {1} ;
+   bits := SIZE (BITSET) * BITSPERLOC ;
+   IF ROTATE (set, bits-1) # BITSET {0}
+   THEN
+      exit (1)
+   END ;
+   IF ROTATE (set, -(bits - 1)) # BITSET {2}
+   THEN
+      exit (2)
+   END ;
+   exit (0)
+END setrotate4.
diff --git a/gcc/testsuite/gm2/sets/run/pass/sets-run-pass.exp b/gcc/testsuite/gm2/sets/run/pass/sets-run-pass.exp
new file mode 100644
index 00000000000..d952ac8fb5d
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/sets-run-pass.exp
@@ -0,0 +1,40 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2iso m2pim"
+gm2_init_iso "${srcdir}/gm2/sets/run/pass/"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/sets/run/pass/setshift.mod b/gcc/testsuite/gm2/sets/run/pass/setshift.mod
new file mode 100644
index 00000000000..5189db38759
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setshift.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setshift ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT SHIFT ;
+
+VAR
+   set: BITSET ;
+BEGIN
+   set := BITSET {1} ;
+   IF SHIFT (set, 1) = BITSET {2}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END setshift.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setshift2.mod b/gcc/testsuite/gm2/sets/run/pass/setshift2.mod
new file mode 100644
index 00000000000..f30ca5a4e03
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setshift2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE setshift2 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT SHIFT ;
+
+VAR
+   set: BITSET ;
+BEGIN
+   set := BITSET {2} ;
+   IF SHIFT (set, -1) = BITSET {1}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END setshift2.
diff --git a/gcc/testsuite/gm2/sets/run/pass/simple.mod b/gcc/testsuite/gm2/sets/run/pass/simple.mod
new file mode 100644
index 00000000000..6ec6c9a82d3
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/simple.mod
@@ -0,0 +1,31 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE simple ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   empty: BITSET ;
+BEGIN
+   empty := BITSET {} ;
+   IF empty = BITSET {}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END simple.
diff --git a/gcc/testsuite/gm2/sets/run/pass/simple2.mod b/gcc/testsuite/gm2/sets/run/pass/simple2.mod
new file mode 100644
index 00000000000..1a065016a37
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/simple2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE simple2 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   test: BITSET ;
+BEGIN
+   test := BITSET {1} ;
+   EXCL (test, 1) ;
+   IF test = BITSET {}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END simple2.
diff --git a/gcc/testsuite/gm2/sets/run/pass/simple3.mod b/gcc/testsuite/gm2/sets/run/pass/simple3.mod
new file mode 100644
index 00000000000..2fa0e512496
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/simple3.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE simple3 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   test: BITSET ;
+BEGIN
+   test := BITSET {} ;
+   INCL (test, 1) ;
+   IF test = BITSET {1}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END simple3.
diff --git a/gcc/testsuite/gm2/sets/run/pass/simple4.mod b/gcc/testsuite/gm2/sets/run/pass/simple4.mod
new file mode 100644
index 00000000000..114c5e4ec09
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/simple4.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE simple4 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   test: BITSET ;
+BEGIN
+   test := BITSET {2,3} ;
+   INCL (test, 1) ;
+   IF test = BITSET {1,2,3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END simple4.
diff --git a/gcc/testsuite/gm2/sets/run/pass/simple5.mod b/gcc/testsuite/gm2/sets/run/pass/simple5.mod
new file mode 100644
index 00000000000..e7082bf9949
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/simple5.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE simple5 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   test: BITSET ;
+BEGIN
+   test := BITSET {1,2,3} ;
+   EXCL (test, 1) ;
+   IF test = BITSET {2,3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END simple5.
diff --git a/gcc/testsuite/gm2/sets/run/pass/simple6.mod b/gcc/testsuite/gm2/sets/run/pass/simple6.mod
new file mode 100644
index 00000000000..562ad2a84ef
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/simple6.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE simple6 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   test: BITSET ;
+BEGIN
+   test := BITSET {2,3} ;
+   EXCL (test, 1) ;
+   IF test = BITSET {2,3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END simple6.
diff --git a/gcc/testsuite/gm2/sets/run/pass/simple7.mod b/gcc/testsuite/gm2/sets/run/pass/simple7.mod
new file mode 100644
index 00000000000..815ef99b82d
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/simple7.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2019 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 2, 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. *)
+
+MODULE simple7 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+   test: BITSET ;
+BEGIN
+   test := BITSET {1,2,3} ;
+   INCL (test, 1) ;
+   IF test = BITSET {1,2,3}
+   THEN
+      exit (0)
+   END ;
+   exit (1)
+END simple7.
diff --git a/gcc/testsuite/gm2/switches/auto-init/fail/switches-auto-init-fail.exp b/gcc/testsuite/gm2/switches/auto-init/fail/switches-auto-init-fail.exp
new file mode 100644
index 00000000000..c60027ff751
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/auto-init/fail/switches-auto-init-fail.exp
@@ -0,0 +1,48 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+load_lib target-supports.exp
+
+global TESTING_IN_BUILD_TREE
+global ENABLE_PLUGIN
+
+# The plugin testcases currently only work when the build tree is available.
+# Also check whether the host supports plugins.
+if { ![info exists TESTING_IN_BUILD_TREE] || ![info exists ENABLE_PLUGIN] } {
+    return
+}
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim2 "${srcdir}/gm2/switches/auto-init/fail" -fsoft-check-all -O2 -fauto-init
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/auto-init/fail/uninitptr.mod b/gcc/testsuite/gm2/switches/auto-init/fail/uninitptr.mod
new file mode 100644
index 00000000000..9be1953fa63
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/auto-init/fail/uninitptr.mod
@@ -0,0 +1,7 @@
+MODULE uninitptr ;
+
+VAR
+   p: POINTER TO CHAR ;
+BEGIN
+   p^ := 'a'
+END uninitptr.
diff --git a/gcc/testsuite/gm2/switches/auto-init/fail/uninitptr2.mod b/gcc/testsuite/gm2/switches/auto-init/fail/uninitptr2.mod
new file mode 100644
index 00000000000..1259c73669d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/auto-init/fail/uninitptr2.mod
@@ -0,0 +1,12 @@
+MODULE uninitptr2 ;
+
+PROCEDURE foo ;
+VAR
+   p: POINTER TO CHAR ;
+BEGIN
+   p^ := 'a'
+END foo ;
+
+BEGIN
+   foo
+END uninitptr2.
diff --git a/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflow.mod b/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflow.mod
new file mode 100644
index 00000000000..a8f2c70321d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflow.mod
@@ -0,0 +1,44 @@
+(* overflow.mod test division overflow detection.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE overflow ;
+
+FROM libc IMPORT printf ;
+
+
+PROCEDURE func (x, y: CARDINAL) ;
+VAR
+   res: CARDINAL ;
+BEGIN
+   res := x DIV y ;
+   printf ("res = %ud\n", res);
+END func ;
+
+VAR
+   x, y: INTEGER ;
+   u   : CARDINAL ;
+BEGIN
+   x := 1 ;
+   y := -1 ;
+   u := x DIV y ;
+   printf ("u = %ud\n", u);
+   func (x, y)
+END overflow.
diff --git a/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflow2.mod b/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflow2.mod
new file mode 100644
index 00000000000..ef96605f85f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflow2.mod
@@ -0,0 +1,42 @@
+(* overflow2.mod test parameter passing overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE overflow2 ;
+
+FROM libc IMPORT printf ;
+
+
+PROCEDURE func (x, y: CARDINAL) ;
+VAR
+   res: CARDINAL ;
+BEGIN
+   res := x DIV y ;
+   printf ("res = %ud\n", res);
+END func ;
+
+VAR
+   x, y: INTEGER ;
+   u   : CARDINAL ;
+BEGIN
+   x := 1 ;
+   y := -1 ;
+   func (x, y) ;
+END overflow2.
diff --git a/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflowdiv1.mod b/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflowdiv1.mod
new file mode 100644
index 00000000000..076d2649109
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/pim2/fail/overflowdiv1.mod
@@ -0,0 +1,34 @@
+(* overflowdiv1.mod test division overflow detection with subranges.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE overflowdiv1 ;
+
+FROM libc IMPORT printf ;
+
+
+VAR
+   u, x, y: [-1..4] ;
+BEGIN
+   x := 3 ;
+   y := -1 ;
+   u := x DIV y ;  (* compiler should detect DIV causes overflow rather than assignment.  *)
+   printf ("value of u = %d\n", VAL (INTEGER, u))
+END overflowdiv1.
diff --git a/gcc/testsuite/gm2/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp b/gcc/testsuite/gm2/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp
new file mode 100644
index 00000000000..3c654ad0b73
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp
@@ -0,0 +1,48 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+load_lib target-supports.exp
+
+global TESTING_IN_BUILD_TREE
+global ENABLE_PLUGIN
+
+# The plugin testcases currently only work when the build tree is available.
+# Also check whether the host supports plugins.
+if { ![info exists TESTING_IN_BUILD_TREE] || ![info exists ENABLE_PLUGIN] } {
+    return
+}
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim2 "${srcdir}/gm2/switches/check-all/pim2/fail" -fsoft-check-all -O2
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposneg.mod b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposneg.mod
new file mode 100644
index 00000000000..41508b583fd
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposneg.mod
@@ -0,0 +1,32 @@
+(* divceil.mod test for compiletime detection of ceil div overflow.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE divceilposneg ;  (*!m2pim+gm2*)
+
+TYPE
+   foo = [-2..8] ;
+VAR
+   x,
+   bar: foo ;
+BEGIN
+   x := 8 ;
+   bar := x DIV (-2)   (* overflow on ceil division.  *)
+END divceilposneg.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposneg2.mod b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposneg2.mod
new file mode 100644
index 00000000000..26d461bd3dd
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposneg2.mod
@@ -0,0 +1,32 @@
+(* divceil.mod test for compiletime detection of ceil div overflow.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE divceilposneg2 ;  (*!m2pim+gm2*)
+
+TYPE
+   foo = [-8..-6] ;
+VAR
+   x,
+   bar: foo ;
+BEGIN
+   x := -8 ;
+   bar := x DIV 4   (* overflow on ceil division.  *)
+END divceilposneg2.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposnegcall.mod b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposnegcall.mod
new file mode 100644
index 00000000000..36e90cf0f5f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposnegcall.mod
@@ -0,0 +1,39 @@
+(* divceilposnegcall.mod test for compiletime detection.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE divceilposnegcall ;  (*!m2pim+gm2*)
+
+TYPE
+   foo = [-2..8] ;
+
+PROCEDURE func (x: foo) : foo ;
+VAR
+   bar: foo ;
+BEGIN
+   bar := x DIV (-2) ;  (* overflow on ceil division.  *)
+   RETURN bar
+END func ;
+
+VAR
+   y: foo ;
+BEGIN
+   y := func (8)
+END divceilposnegcall.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposnegcall2.mod b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposnegcall2.mod
new file mode 100644
index 00000000000..4524be0694d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divceilposnegcall2.mod
@@ -0,0 +1,36 @@
+(* divceilposnegcall2.mod test for compiletime detection.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE divceilposnegcall2 ;  (*!m2pim+gm2*)
+
+TYPE
+   foo = [-2..8] ;
+
+PROCEDURE func (x: foo) : foo ;
+BEGIN
+   RETURN x DIV (-2) ;  (* overflow on ceil division.  *)
+END func ;
+
+VAR
+   y: foo ;
+BEGIN
+   y := func (8)
+END divceilposnegcall2.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divfloornegpos.mod b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divfloornegpos.mod
new file mode 100644
index 00000000000..f3b9192fcf9
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divfloornegpos.mod
@@ -0,0 +1,32 @@
+(* divceil.mod test for compiletime detection of ceil div overflow.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE divfloornegpos ;
+
+TYPE
+   foo = [-8..6] ;
+VAR
+   x,
+   bar: foo ;
+BEGIN
+   x := -8 ;
+   bar := x DIV 2   (* overflow on floor division.  *)
+END divfloornegpos.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divfloorpospos.mod b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divfloorpospos.mod
new file mode 100644
index 00000000000..b91c20c5ff3
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/divfloorpospos.mod
@@ -0,0 +1,32 @@
+(* divfloorpospos.mod test for compiletime detection of ceil div overflow.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE divfloorpospos ;
+
+TYPE
+   foo = [4..8] ;
+VAR
+   x,
+   bar: foo ;
+BEGIN
+   x := 6 ;
+   bar := x DIV 2   (* overflow on floor division.  *)
+END divfloorpospos.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/lowdiv.mod b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/lowdiv.mod
new file mode 100644
index 00000000000..66aca2f7abc
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/lowdiv.mod
@@ -0,0 +1,47 @@
+(* highdiv.mod test for compiletime detection of div overflow.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE lowdiv ;  (*!m2pim+gm2*)
+
+TYPE
+   foo = [4..12] ;
+
+(*
+   test -
+
+PROCEDURE test () : foo ;
+VAR
+   x: foo ;
+BEGIN
+   x := MIN(foo) * 2 ;
+   RETURN x
+END test ;
+*)
+
+VAR
+   x, y,
+   bar : foo ;
+BEGIN
+   x := 8 ;
+   y := 4 ;
+   bar := x DIV y ;
+   (* bar := test () DIV 4 *)
+END lowdiv.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/switches-check-all-plugin-iso-fail.exp b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/switches-check-all-plugin-iso-fail.exp
new file mode 100644
index 00000000000..84a3f37e2bb
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/iso/fail/switches-check-all-plugin-iso-fail.exp
@@ -0,0 +1,59 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+load_lib target-supports.exp
+
+global TESTING_IN_BUILD_TREE
+global ENABLE_PLUGIN
+
+# The plugin testcases currently only work when the build tree is available.
+# Also check whether the host supports plugins.
+if { ![info exists TESTING_IN_BUILD_TREE] || ![info exists ENABLE_PLUGIN] } {
+    return
+}
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+global TORTURE_OPTIONS
+
+set old_options $TORTURE_OPTIONS
+set TORTURE_OPTIONS [list \
+			 { -O2 -fsoft-check-all } \
+			 { -O2 -g -fsoft-check-all } \
+			 { -O3 -fsoft-check-all } \
+		         { -O3 -g -fsoft-check-all } ]
+
+gm2_init_iso "${srcdir}/gm2/switches/check-all/plugin/iso/fail/"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
+
+set TORTURE_OPTIONS $old_options
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/divceil.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/divceil.mod
new file mode 100644
index 00000000000..98f4f3c427b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/divceil.mod
@@ -0,0 +1,32 @@
+(* divceil.mod test for compiletime detection of ceil div overflow.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE divceil ; (*!m2pim+gm2*)
+
+TYPE
+   foo = [-4..1] ;
+VAR
+   x,
+   bar: foo ;
+BEGIN
+   x := -4 ;
+   bar := x DIV (-2)   (* overflow on ceil division.  *)
+END divceil.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/highdiv.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/highdiv.mod
new file mode 100644
index 00000000000..f473105a610
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/highdiv.mod
@@ -0,0 +1,34 @@
+(* highdiv.mod test for compiletime detection of div overflow.
+
+Copyright (C) 2019 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/>.  *)
+
+MODULE highdiv ;  (*!m2pim+gm2*)
+
+TYPE
+   foo = [MAX(INTEGER) DIV 4..MAX(INTEGER)] ;
+
+VAR
+   x, y, z,
+   bar    : foo ;
+BEGIN
+   x := MIN(foo) ;
+   bar := x + x ;
+   bar := bar DIV x
+END highdiv.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/modulus.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/modulus.mod
new file mode 100644
index 00000000000..2c718f0925b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/modulus.mod
@@ -0,0 +1,42 @@
+(* modulus.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE modulus ;  (*!m2pim+gm2*)
+
+FROM libc IMPORT printf ;
+
+
+PROCEDURE foo ;
+TYPE
+   tiny = [10..100] ;
+VAR
+   a, b, c: tiny ;
+BEGIN
+   c := 80 ;
+   b := 85 ;
+   a := b MOD c ;
+   printf ("a = %d, b = %d, c = %d\n", a, b, c)
+END foo ;
+
+
+BEGIN
+   foo
+END modulus.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin1.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin1.mod
new file mode 100644
index 00000000000..c1eb0c5b365
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin1.mod
@@ -0,0 +1,42 @@
+(* plugin1.mod simple overflow detection test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE plugin1 ;
+
+PROCEDURE foo ;
+BEGIN
+
+END foo ;
+
+
+PROCEDURE bar ;
+BEGIN
+   x := i
+END bar ;
+
+VAR
+   x: CARDINAL ;
+   i: INTEGER ;
+BEGIN
+   i := -1 ;
+   foo ;
+   bar
+END plugin1.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin3.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin3.mod
new file mode 100644
index 00000000000..e52f0537f9f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin3.mod
@@ -0,0 +1,49 @@
+(* plugin3.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+MODULE plugin3 ;
+
+PROCEDURE foo ;
+BEGIN
+
+END foo ;
+
+
+PROCEDURE bar ;
+BEGIN
+   x := i ;
+END bar ;
+
+PROCEDURE mumble ;
+BEGIN
+   y := i
+END mumble ;
+
+VAR
+   y,
+   x: CARDINAL ;
+   i: INTEGER ;
+BEGIN
+   i := -1 ;
+   foo ;
+   bar ;
+   mumble
+END plugin3.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin4.def b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin4.def
new file mode 100644
index 00000000000..a717bd9210b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin4.def
@@ -0,0 +1,26 @@
+(* plugin4.def export function and overflow test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+DEFINITION MODULE plugin4 ;  (*!m2pim+gm2*)
+
+PROCEDURE bar ;
+
+END plugin4.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin4.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin4.mod
new file mode 100644
index 00000000000..7dd659fd746
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin4.mod
@@ -0,0 +1,40 @@
+(* plugin4.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+IMPLEMENTATION MODULE plugin4 ;  (*!m2pim+gm2*)
+
+PROCEDURE foo ;
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+BEGIN
+   i := -1 ;
+   c := i
+END foo ;
+
+
+PROCEDURE bar ;
+BEGIN
+   foo
+END bar ;
+
+
+END plugin4.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin5.def b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin5.def
new file mode 100644
index 00000000000..f18ecbcde03
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin5.def
@@ -0,0 +1,26 @@
+(* plugin5.def export function and overflow test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+DEFINITION MODULE plugin5 ;  (*!m2pim+gm2*)
+
+PROCEDURE foo ;
+
+END plugin5.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin5.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin5.mod
new file mode 100644
index 00000000000..cf372b0e468
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin5.mod
@@ -0,0 +1,33 @@
+(* plugin5.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+IMPLEMENTATION MODULE plugin5 ;  (*!m2pim+gm2*)
+
+PROCEDURE foo ;
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+BEGIN
+   i := -1 ;
+   c := i
+END foo ;
+
+END plugin5.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin6.def b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin6.def
new file mode 100644
index 00000000000..b886ac7b4fe
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin6.def
@@ -0,0 +1,26 @@
+(* plugin6.def export function and overflow test.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+DEFINITION MODULE plugin6 ;  (*!m2pim+gm2*)
+
+PROCEDURE foo ;
+
+END plugin6.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin6.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin6.mod
new file mode 100644
index 00000000000..d446117ed7d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin6.mod
@@ -0,0 +1,35 @@
+(* plugin6.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+IMPLEMENTATION MODULE plugin6 ;  (*!m2pim+gm2*)
+
+PROCEDURE foo ;
+VAR
+   i: INTEGER ;
+   c: CARDINAL ;
+BEGIN
+   i := -1 ;
+   c := i
+END foo ;
+
+BEGIN
+   foo
+END plugin6.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin7.def b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin7.def
new file mode 100644
index 00000000000..8d235b5c80d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin7.def
@@ -0,0 +1,26 @@
+(* plugin7.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+DEFINITION MODULE plugin7 ;  (*!m2pim+gm2*)
+
+PROCEDURE foo ;
+
+END plugin7.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin7.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin7.mod
new file mode 100644
index 00000000000..3cc1eb9d40c
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin7.mod
@@ -0,0 +1,46 @@
+(* plugin7.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+IMPLEMENTATION MODULE plugin7 ;  (*!m2pim+gm2*)
+
+
+PROCEDURE fred ;
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := 0 ;
+   c := c - 1
+END fred ;
+
+
+PROCEDURE bar ;
+BEGIN
+   fred
+END bar ;
+
+
+PROCEDURE foo ;
+BEGIN
+   bar
+END foo ;
+
+
+END plugin7.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin8.def b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin8.def
new file mode 100644
index 00000000000..67ea3abb798
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin8.def
@@ -0,0 +1,26 @@
+(* plugin8.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+DEFINITION MODULE plugin8 ;  (*!m2pim+gm2*)
+
+PROCEDURE foo ;
+
+END plugin8.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin8.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin8.mod
new file mode 100644
index 00000000000..52a50d6da9a
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin8.mod
@@ -0,0 +1,43 @@
+(* plugin8.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+IMPLEMENTATION MODULE plugin8 ;  (*!m2pim+gm2*)
+
+
+PROCEDURE fred (value: CARDINAL) ;
+BEGIN
+   value := value - 1
+END fred ;
+
+
+PROCEDURE bar ;
+BEGIN
+   fred (0)
+END bar ;
+
+
+PROCEDURE foo ;
+BEGIN
+   bar
+END foo ;
+
+
+END plugin8.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin9.mod b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin9.mod
new file mode 100644
index 00000000000..949b3f8e9e9
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/plugin9.mod
@@ -0,0 +1,53 @@
+(* plugin9.mod test for compiletime detection of overflow.
+
+Copyright (C) 2001-2019 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/>.  *)
+
+IMPLEMENTATION MODULE plugin9 ;  (*!m2pim+gm2*)
+
+
+PROCEDURE bill (value: CARDINAL) ;
+BEGIN
+   value := value-1
+END bill ;
+
+
+PROCEDURE fred (value: CARDINAL) ;
+BEGIN
+   bill (value) ;
+   IF value > 0
+   THEN
+
+   END
+END fred ;
+
+
+PROCEDURE bar ;
+BEGIN
+   fred (0)
+END bar ;
+
+
+PROCEDURE foo ;
+BEGIN
+   bar
+END foo ;
+
+
+END plugin9.
diff --git a/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/switches-check-all-plugin-pim2-fail.exp b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/switches-check-all-plugin-pim2-fail.exp
new file mode 100644
index 00000000000..238e5c8af90
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/plugin/pim2/fail/switches-check-all-plugin-pim2-fail.exp
@@ -0,0 +1,59 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+load_lib target-supports.exp
+
+global TESTING_IN_BUILD_TREE
+global ENABLE_PLUGIN
+
+# The plugin testcases currently only work when the build tree is available.
+# Also check whether the host supports plugins.
+if { ![info exists TESTING_IN_BUILD_TREE] || ![info exists ENABLE_PLUGIN] } {
+    return
+}
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+global TORTURE_OPTIONS
+
+set old_options $TORTURE_OPTIONS
+set TORTURE_OPTIONS [list \
+			 { -O2 -fsoft-check-all } \
+			 { -O2 -g -fsoft-check-all } \
+			 { -O3 -fsoft-check-all } \
+		         { -O3 -g -fsoft-check-all } ]
+
+gm2_init_pim2 "${srcdir}/gm2/switches/check-all/plugin/pim2/fail/"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
+
+set TORTURE_OPTIONS $old_options
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange.mod
new file mode 100644
index 00000000000..05d36ccc23c
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE cardrange ;
+
+FROM rangesupport IMPORT maxcard ;
+FROM libc IMPORT exit ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := maxcard () ;
+   i := i+1 ;
+   exit(0)    (* should not get here if -fsoft-check-all is used *)
+END cardrange.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange2.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange2.mod
new file mode 100644
index 00000000000..9f753473467
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE cardrange2 ;
+
+FROM rangesupport IMPORT maxcard ;
+FROM libc IMPORT exit ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   i := i - 1 ;
+   exit(0)    (* should not get here if -fsoft-check-all is used *)
+END cardrange2.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange3.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange3.mod
new file mode 100644
index 00000000000..8c58ab849da
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/cardrange3.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE cardrange3 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 1 ;
+   i := -i ;
+   exit(0)    (* should not get here if -fsoft-check-all is used *)
+END cardrange3.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/intrange.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange.mod
new file mode 100644
index 00000000000..f110c279696
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2011 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. *)
+
+MODULE intrange ;
+
+FROM rangesupport IMPORT maxint ;
+FROM libc IMPORT exit ;
+
+VAR
+   i, j: INTEGER ;
+BEGIN
+   i := maxint() ;
+   i := i+1 ;
+   exit(0)    (* should not get here if -fsoft-check-all is used *)
+END intrange.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/intrange2.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange2.mod
new file mode 100644
index 00000000000..dc31147ee99
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE intrange2 ;
+
+FROM rangesupport IMPORT minint ;
+FROM libc IMPORT exit ;
+
+VAR
+   i, j: INTEGER ;
+BEGIN
+   i := minint () ;
+   i := i-1 ;
+   exit(0)    (* should not get here if -fsoft-check-all is used *)
+END intrange2.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/intrange3.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange3.mod
new file mode 100644
index 00000000000..437da2bf128
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange3.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE intrange3 ;
+
+FROM rangesupport IMPORT minint ;
+FROM libc IMPORT exit ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   i := minint () ;
+   i := -i ;
+   exit(0)    (* should not get here if -fsoft-check-all is used *)
+END intrange3.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/intrange4.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange4.mod
new file mode 100644
index 00000000000..c7a40e06288
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange4.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE intrange4 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: [-1..2] ;
+BEGIN
+   i := 2 ;
+   i := -i ;
+   exit(0)    (* should not get here if -fsoft-check-all is used *)
+END intrange4.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/intrange5.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange5.mod
new file mode 100644
index 00000000000..053b5df5251
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/intrange5.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE intrange5 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: [-1..0] ;
+BEGIN
+   i := -1 ;
+   i := -i ;
+   exit (0)    (* should not get here if -fsoft-check-all is used *)
+END intrange5.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/multint1.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/multint1.mod
new file mode 100644
index 00000000000..671d2f08c77
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/multint1.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE multint1 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i, j, k: [-8..7] ;
+BEGIN
+   i := 3 ;
+   j := 3 ;
+   k := i * j ;
+   exit (0)    (* should not get here if -fsoft-check-all is used *)
+END multint1.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/multint2.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/multint2.mod
new file mode 100644
index 00000000000..ac659240681
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/multint2.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE multint2 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i, j, k: [-8..7] ;
+BEGIN
+   i := 3 ;
+   j := -3 ;
+   k := i * j ;
+   exit (0)    (* should not get here if -fsoft-check-all is used *)
+END multint2.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/multint3.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/multint3.mod
new file mode 100644
index 00000000000..a8add1a8f62
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/multint3.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE multint3 ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i, j, k: [-8..7] ;
+BEGIN
+   i := -3 ;
+   j := -3 ;
+   k := i * j ;
+   exit (0)    (* should not get here if -fsoft-check-all is used *)
+END multint3.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/rangesupport.def b/gcc/testsuite/gm2/switches/check-all/run/fail/rangesupport.def
new file mode 100644
index 00000000000..d24b5dc181d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/rangesupport.def
@@ -0,0 +1,26 @@
+(* Copyright (C) 2011 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. *)
+
+DEFINITION MODULE rangesupport ;
+
+PROCEDURE maxint () : INTEGER ;
+PROCEDURE minint () : INTEGER ;
+PROCEDURE maxcard () : CARDINAL ;
+PROCEDURE mincard () : CARDINAL ;
+
+END rangesupport.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/rangesupport.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/rangesupport.mod
new file mode 100644
index 00000000000..933c3baba28
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/rangesupport.mod
@@ -0,0 +1,46 @@
+(* Copyright (C) 2011 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. *)
+
+IMPLEMENTATION MODULE rangesupport ;
+
+
+PROCEDURE maxint () : INTEGER ;
+BEGIN
+   RETURN MAX(INTEGER)
+END maxint ;
+
+
+PROCEDURE minint () : INTEGER ;
+BEGIN
+   RETURN MIN(INTEGER)
+END minint ;
+
+
+PROCEDURE maxcard () : CARDINAL ;
+BEGIN
+   RETURN MAX(CARDINAL)
+END maxcard ;
+
+
+PROCEDURE mincard () : CARDINAL ;
+BEGIN
+   RETURN MIN(CARDINAL)
+END mincard ;
+
+
+END rangesupport.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/realrange.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/realrange.mod
new file mode 100644
index 00000000000..0302c3a3c2c
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/realrange.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2015 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.  *)
+
+MODULE realrange ;
+
+VAR
+   a, b, c: REAL ;
+BEGIN
+   a := 1.0 ;
+   b := 0.0 ;
+   c := a / b
+END realrange.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/subrange.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/subrange.mod
new file mode 100644
index 00000000000..08ec92595ae
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/subrange.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE subrange ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: [-4..3] ;
+BEGIN
+   i := -4 ;
+   i := -i ;
+   exit(0)    (* should not get here if -fsoft-check-all is used *)
+END subrange.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/switches-check-all-run-fail.exp b/gcc/testsuite/gm2/switches/check-all/run/fail/switches-check-all-run-fail.exp
new file mode 100644
index 00000000000..05e5708c09f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/switches-check-all-run-fail.exp
@@ -0,0 +1,51 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2013-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/switches/check-all/run/fail" -fsoft-check-all -fno-m2-plugin
+
+#
+#  compile the support module
+#
+
+gm2_target_compile $srcdir/$subdir/rangesupport.mod rangesupport.o object "-g -I$srcdir/$subdir/"
+gm2_link_obj rangesupport.o
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    # do not recompile the support module - and do not test it either!
+    if { $testcase == "$srcdir/$subdir/rangesupport.mod" } {
+        continue
+    }
+
+    gm2-torture-execute $testcase "" "fail"
+}
diff --git a/gcc/testsuite/gm2/switches/check-all/run/fail/tinyrange.mod b/gcc/testsuite/gm2/switches/check-all/run/fail/tinyrange.mod
new file mode 100644
index 00000000000..bc25483597a
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/fail/tinyrange.mod
@@ -0,0 +1,17 @@
+MODULE tinyrange ;
+
+(* This test is useful to check that the runtime system starts the
+   application after the runtime.  The import list here is minimal
+   (and only from a definition for "C") thus the compiler will not
+   see the application in the rest of the modula2 import graph.
+   M2Dependent.mod will have to force the application module to the
+   end of the initialization ordered list.  *)
+
+FROM libc IMPORT printf ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   i := MIN (INTEGER) ;
+   DEC (i)
+END tinyrange.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/pass/cardrange.mod b/gcc/testsuite/gm2/switches/check-all/run/pass/cardrange.mod
new file mode 100644
index 00000000000..e717f801876
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/pass/cardrange.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE cardrange ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := 0 ;
+   i := -i ;  (* should succeed  *)
+END cardrange.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/pass/forcheck.mod b/gcc/testsuite/gm2/switches/check-all/run/pass/forcheck.mod
new file mode 100644
index 00000000000..55808e751e6
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/pass/forcheck.mod
@@ -0,0 +1,59 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE forcheck ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+
+
+PROCEDURE foo (init: CARDINAL);
+VAR
+   j: CARDINAL;
+(*
+   T21 : (* <!g> *) INTEGER ;
+   T24 : (* <!g> *) INTEGER ;
+   T25 : (* <!g> *) INTEGER ;
+   T26 : (* <!g> *) INTEGER ;
+   T27 : (* <!g> *) LONGINT ;
+ *)
+BEGIN
+(*
+   T21 := init - 1 ;
+   j := T21 ;
+   T24 := VAL ((* <!g> *) INTEGER, 1 - T21) ;
+   T25 := -T24 ;
+   T26 := -T25 ;
+   T27 := VAL ((* <!g> *) LONGINT, T21 + T26) ;
+   IF T27 < 0
+   THEN
+      WriteString("ForLoopToException\n") ; WriteLn
+   END ;
+   IF T27 > 4294967295
+   THEN
+      WriteString("ForLoopToException\n") ; WriteLn
+   END ;
+*)
+   FOR j:= init-1 TO 1 BY -1 DO
+      WriteString('value of j ') ; WriteCard(j, 0) ; WriteLn
+   END
+END foo ;
+
+
+BEGIN
+   foo(3)
+END forcheck.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/pass/subrange.mod b/gcc/testsuite/gm2/switches/check-all/run/pass/subrange.mod
new file mode 100644
index 00000000000..97beafd6846
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/pass/subrange.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2018 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. *)
+
+MODULE subrange ;
+
+FROM libc IMPORT exit ;
+
+VAR
+   i: [-4..3] ;
+BEGIN
+   i := 3 ;
+   i := -i
+END subrange.
diff --git a/gcc/testsuite/gm2/switches/check-all/run/pass/switches-check-all-run-pass.exp b/gcc/testsuite/gm2/switches/check-all/run/pass/switches-check-all-run-pass.exp
new file mode 100644
index 00000000000..a6eb4669615
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/check-all/run/pass/switches-check-all-run-pass.exp
@@ -0,0 +1,39 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_iso "${srcdir}/gm2/switches/check-all/run/pass" -fsoft-check-all
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/switches/extended-opaque/fail/a.def b/gcc/testsuite/gm2/switches/extended-opaque/fail/a.def
new file mode 100644
index 00000000000..6cb07b404a2
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/extended-opaque/fail/a.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE a ;
+
+EXPORT QUALIFIED foo ;
+
+TYPE
+   foo ;
+
+END a.
diff --git a/gcc/testsuite/gm2/switches/extended-opaque/fail/a.mod b/gcc/testsuite/gm2/switches/extended-opaque/fail/a.mod
new file mode 100644
index 00000000000..a5acfdb909f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/extended-opaque/fail/a.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE a ;
+
+TYPE
+   foo = RECORD
+            f1, f2: CARDINAL ;
+         END ;
+
+END a.
diff --git a/gcc/testsuite/gm2/switches/extended-opaque/fail/switches-extended-opaque-fail.exp b/gcc/testsuite/gm2/switches/extended-opaque/fail/switches-extended-opaque-fail.exp
new file mode 100644
index 00000000000..702876e272d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/extended-opaque/fail/switches-extended-opaque-fail.exp
@@ -0,0 +1,42 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+#
+#  here we test to ensure that gm2 fail because the user has not supplied
+#  the -fextended-opaque parameter but is using a non pointer opaque type.
+#
+
+gm2_init_pim "${srcdir}/gm2/switches/extended-opaque/fail"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/extended-opaque/pass/a.def b/gcc/testsuite/gm2/switches/extended-opaque/pass/a.def
new file mode 100644
index 00000000000..6cb07b404a2
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/extended-opaque/pass/a.def
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE a ;
+
+EXPORT QUALIFIED foo ;
+
+TYPE
+   foo ;
+
+END a.
diff --git a/gcc/testsuite/gm2/switches/extended-opaque/pass/a.mod b/gcc/testsuite/gm2/switches/extended-opaque/pass/a.mod
new file mode 100644
index 00000000000..a5acfdb909f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/extended-opaque/pass/a.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+IMPLEMENTATION MODULE a ;
+
+TYPE
+   foo = RECORD
+            f1, f2: CARDINAL ;
+         END ;
+
+END a.
diff --git a/gcc/testsuite/gm2/switches/extended-opaque/pass/b.mod b/gcc/testsuite/gm2/switches/extended-opaque/pass/b.mod
new file mode 100644
index 00000000000..98c85ba3eb3
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/extended-opaque/pass/b.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE b ;
+
+FROM a IMPORT foo ;
+
+VAR
+   bar: foo ;
+BEGIN
+END b.
diff --git a/gcc/testsuite/gm2/switches/extended-opaque/pass/switches-extended-opaque-pass.exp b/gcc/testsuite/gm2/switches/extended-opaque/pass/switches-extended-opaque-pass.exp
new file mode 100644
index 00000000000..1e688e45dfd
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/extended-opaque/pass/switches-extended-opaque-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/switches/extended-opaque/pass" -fextended-opaque
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/iso/run/pass/modulus.mod b/gcc/testsuite/gm2/switches/iso/run/pass/modulus.mod
new file mode 100644
index 00000000000..6a8314dff76
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/iso/run/pass/modulus.mod
@@ -0,0 +1,76 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE modulus ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+
+PROCEDURE Assert (r: INTEGER; v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   c: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      c := printf("successfully evaluated %s as %d\n", ADR(e), r)
+   ELSE
+      c := printf("%s:%d assertion failed when evaluating %s as %d\n", ADR(f), l, ADR(e), r) ;
+      res := 1
+   END
+END Assert ;
+
+
+VAR
+   i: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   (* example from ISO Standard 6-7 *)
+   i := 31 MOD 10 ;
+   Assert(i, i=1, __FILE__, __LINE__, "31 MOD 10") ;
+
+   (* example from PIM 4th edition *)
+   i := (-15) MOD 4 ;
+   Assert(i, i=1, __FILE__, __LINE__, "(-15) DIV 4") ;
+
+   (* example from ISO Standard 6-7 *)
+   i := (-31) MOD 10 ;
+   Assert(i, i=9, __FILE__, __LINE__, "(-31) MOD 9") ;
+
+   (* example from ISO Standard 6-7 *)
+   i := (-31) DIV 10 ;
+   Assert(i, i=-4, __FILE__, __LINE__, "(-31) DIV 10") ;
+
+   (* example from ISO Standard 6-7 *)
+   i := 31 REM 10 ;
+   Assert(i, i=1, __FILE__, __LINE__, "31 REM 10") ;
+   i := 31 REM (-10) ;
+   Assert(i, i=1, __FILE__, __LINE__, "31 REM (-10)") ;
+   i := (-31) REM 10 ;
+   Assert(i, i=-1, __FILE__, __LINE__, "(-31) REM 10") ;
+   i := (-31) REM (-10) ;
+   Assert(i, i=-1, __FILE__, __LINE__, "(-31) REM (-10)") ;
+
+   (* example from ISO Standard 6-7 *)
+   i := (-31) / 10 ;
+   Assert(i, i=-3, __FILE__, __LINE__, "(-31) / 10") ;
+   exit(res)
+END modulus.
diff --git a/gcc/testsuite/gm2/switches/iso/run/pass/modulus4.mod b/gcc/testsuite/gm2/switches/iso/run/pass/modulus4.mod
new file mode 100644
index 00000000000..1d07af5e39b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/iso/run/pass/modulus4.mod
@@ -0,0 +1,76 @@
+(* Copyright (C) 2017 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 2, 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. *)
+
+MODULE modulus4 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+
+PROCEDURE Assert (r: INTEGER; v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   c: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      c := printf("successfully evaluated %s as %d\n", ADR(e), r)
+   ELSE
+      c := printf("%s:%d assertion failed when evaluating %s as %d\n", ADR(f), l, ADR(e), r) ;
+      res := 1
+   END
+END Assert ;
+
+
+VAR
+   i: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   (* example from ISO Standard 6-7 *)
+   i := 31 MOD 10 ;
+   Assert(i, i=1, __FILE__, __LINE__, "31 MOD 10") ;
+
+   (* example from PIM 4th edition *)
+   i := (-15) MOD 4 ;
+   Assert(i, i=1, __FILE__, __LINE__, "(-15) DIV 4") ;
+
+   (* example from ISO Standard 6-7 *)
+   i := (-31) MOD 10 ;
+   Assert(i, i=9, __FILE__, __LINE__, "(-31) MOD 9") ;
+
+   (* example from ISO Standard 6-7 *)
+   i := (-31) DIV 10 ;
+   Assert(i, i=-4, __FILE__, __LINE__, "(-31) DIV 10") ;
+
+   (* example from ISO Standard 6-7 *)
+   i := 31 REM 10 ;
+   Assert(i, i=1, __FILE__, __LINE__, "31 REM 10") ;
+   i := 31 REM (-10) ;
+   Assert(i, i=1, __FILE__, __LINE__, "31 REM (-10)") ;
+   i := (-31) REM 10 ;
+   Assert(i, i=-1, __FILE__, __LINE__, "(-31) REM 10") ;
+   i := (-31) REM (-10) ;
+   Assert(i, i=-1, __FILE__, __LINE__, "(-31) REM (-10)") ;
+
+   (* example from ISO Standard 6-7 *)
+   i := (-31) / 10 ;
+   Assert(i, i=-3, __FILE__, __LINE__, "(-31) / 10") ;
+   exit(res)
+END modulus4.
diff --git a/gcc/testsuite/gm2/switches/iso/run/pass/switches-iso-run-pass.exp b/gcc/testsuite/gm2/switches/iso/run/pass/switches-iso-run-pass.exp
new file mode 100644
index 00000000000..114f5f8a92b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/iso/run/pass/switches-iso-run-pass.exp
@@ -0,0 +1,38 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_iso "${srcdir}/gm2/switches/iso/run/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/switches/makeall/fail/switches-makeall-fail.exp b/gcc/testsuite/gm2/switches/makeall/fail/switches-makeall-fail.exp
new file mode 100644
index 00000000000..2bd22c1983e
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/makeall/fail/switches-makeall-fail.exp
@@ -0,0 +1,42 @@
+# Copyright (C) 2014-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+#
+#  here we test to ensure that gm2 fail during compilation when the user
+#  attempts to use gm2 -fmakeall to build a syntactally incorrect program.
+#
+
+gm2_init "-I$srcdir/../gm2/gm2-libs:$srcdir/gm2/switches/makeall/fail -fmakeall"
+
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/makeall/fail/test.def b/gcc/testsuite/gm2/switches/makeall/fail/test.def
new file mode 100644
index 00000000000..dc0c0149005
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/makeall/fail/test.def
@@ -0,0 +1,5 @@
+DEFINITION MODULE test ;
+
+PROCEDURE IsSomeThing (a) : BOOLEAN;
+
+END test.
diff --git a/gcc/testsuite/gm2/switches/makeall/fail/test.mod b/gcc/testsuite/gm2/switches/makeall/fail/test.mod
new file mode 100644
index 00000000000..167d18e91a1
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/makeall/fail/test.mod
@@ -0,0 +1,8 @@
+IMPLEMENTATION MODULE test ;
+
+PROCEDURE IsSomeThing (a) : BOOLEAN;
+BEGIN
+   RETURN TRUE
+END IsSomeThing ;
+
+END test.
diff --git a/gcc/testsuite/gm2/switches/makeall/pass/switches-makeall-pass.exp b/gcc/testsuite/gm2/switches/makeall/pass/switches-makeall-pass.exp
new file mode 100644
index 00000000000..82d057430c5
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/makeall/pass/switches-makeall-pass.exp
@@ -0,0 +1,37 @@
+# Copyright (C) 2014-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init "-I${srcdir}/gm2/switches/makeall/pass" -fmakeall
+gm2_init_pim4 "${srcdir}/gm2/switches/makeall/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/makeall/pass/test.def b/gcc/testsuite/gm2/switches/makeall/pass/test.def
new file mode 100644
index 00000000000..9b4680aec7d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/makeall/pass/test.def
@@ -0,0 +1,5 @@
+DEFINITION MODULE test ;
+
+PROCEDURE IsSomeThing (a: ARRAY OF CHAR) : BOOLEAN;
+
+END test.
diff --git a/gcc/testsuite/gm2/switches/makeall/pass/test.mod b/gcc/testsuite/gm2/switches/makeall/pass/test.mod
new file mode 100644
index 00000000000..52119e5197a
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/makeall/pass/test.mod
@@ -0,0 +1,8 @@
+IMPLEMENTATION MODULE test ;
+
+PROCEDURE IsSomeThing (a: ARRAY OF CHAR) : BOOLEAN;
+BEGIN
+   RETURN TRUE
+END IsSomeThing ;
+
+END test.
diff --git a/gcc/testsuite/gm2/switches/none/run/pass/gm2-none.exp b/gcc/testsuite/gm2/switches/none/run/pass/gm2-none.exp
new file mode 100644
index 00000000000..f16709b35ea
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/none/run/pass/gm2-none.exp
@@ -0,0 +1,39 @@
+# Copyright (C) 2010-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-simple.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2pim m2iso"
+gm2_init_pim
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-simple-execute $testcase "" ""
+}
diff --git a/gcc/testsuite/gm2/switches/none/run/pass/hello.mod b/gcc/testsuite/gm2/switches/none/run/pass/hello.mod
new file mode 100644
index 00000000000..2d1f2b8bf08
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/none/run/pass/hello.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2010 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. *)
+
+MODULE hello ;
+
+FROM libc IMPORT printf ;
+
+BEGIN
+   printf("hello world\n")
+END hello.
diff --git a/gcc/testsuite/gm2/switches/optimization/run/pass/fact.mod b/gcc/testsuite/gm2/switches/optimization/run/pass/fact.mod
new file mode 100644
index 00000000000..93da14f2b0b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/optimization/run/pass/fact.mod
@@ -0,0 +1,38 @@
+(* Copyright (C) 2009 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 2, 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. *)
+
+MODULE fact ;
+
+FROM libc IMPORT printf ;
+
+PROCEDURE factorial (n: CARDINAL) : CARDINAL ;
+BEGIN
+   IF n>1
+   THEN
+      RETURN n*factorial(n-1)
+   ELSE
+      RETURN 1
+   END
+END factorial ;
+
+
+VAR
+   i: CARDINAL ;
+BEGIN
+   i := factorial(7) ;
+   printf("factorial of 7 is %d\n", i)
+END fact.
diff --git a/gcc/testsuite/gm2/switches/optimization/run/pass/switches-optimization-run-pass.exp b/gcc/testsuite/gm2/switches/optimization/run/pass/switches-optimization-run-pass.exp
new file mode 100644
index 00000000000..d5c132f178f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/optimization/run/pass/switches-optimization-run-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/switches/optimization/run/pass" -O3
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+    gm2_target_compile $srcdir/$subdir/mystrlib.mod mystrlib.o object "-g -O3 -I$srcdir/$subdir/"
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/pedantic-params/fail/a.def b/gcc/testsuite/gm2/switches/pedantic-params/fail/a.def
new file mode 100644
index 00000000000..1c92727908d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic-params/fail/a.def
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE a ;
+
+EXPORT QUALIFIED foo ;
+
+PROCEDURE foo (x, y, z: CARDINAL; i, j: INTEGER) ;
+
+END a.
diff --git a/gcc/testsuite/gm2/switches/pedantic-params/fail/a.mod b/gcc/testsuite/gm2/switches/pedantic-params/fail/a.mod
new file mode 100644
index 00000000000..c3e63df1b9e
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic-params/fail/a.mod
@@ -0,0 +1,23 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+IMPLEMENTATION MODULE a ;
+
+PROCEDURE foo (z, y, x: CARDINAL; j, i: INTEGER) ;
+BEGIN
+END foo ;
+
+END a.
diff --git a/gcc/testsuite/gm2/switches/pedantic-params/fail/switches-pedantic-params-fail.exp b/gcc/testsuite/gm2/switches/pedantic-params/fail/switches-pedantic-params-fail.exp
new file mode 100644
index 00000000000..a1ce49621f7
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic-params/fail/switches-pedantic-params-fail.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_iso "${srcdir}/gm2/switches/pedantic-params/fail" -Wpedantic-param-names
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings.def b/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings.def
new file mode 100644
index 00000000000..a3c8d75f05c
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings.def
@@ -0,0 +1,166 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE Strings;
+
+  (* Facilities for manipulating strings *)
+
+TYPE
+  String1 = ARRAY [0..0] OF CHAR;
+ (* String1 is provided for constructing a value of a single-character string
+    type from a single character value in order to pass CHAR values to 
+    ARRAY OF CHAR parameters.
+  *)
+
+PROCEDURE Length (stringVal: ARRAY OF CHAR): CARDINAL;
+  (* Returns the length of stringVal (the same value as would be returned by the
+     pervasive function LENGTH).
+  *)
+
+
+(* The following seven procedures construct a string value, and attempt to
+   assign it to a variable parameter.  They all have the property that if
+   the length of the constructed string value exceeds the capacity of the
+   variable parameter, a truncated value is assigned, while if the length
+   of the constructed string value is less than the capacity of the variable
+   parameter, a string terminator is appended before assignment is performed.
+*)
+
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Copies source to destination *)
+
+PROCEDURE Extract (source: ARRAY OF CHAR; startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  (* Copies at most numberToExtract characters from source to destination,
+     starting at position startIndex in source.
+  *)
+
+PROCEDURE Delete (VAR string: ARRAY OF CHAR; startIndex, numberToDelete: CARDINAL);
+  (* Deletes at most numberToDelete characters from stringVar, starting at position
+     startIndex.
+  *)
+
+PROCEDURE Insert (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                  VAR destination: ARRAY OF CHAR);
+  (* Inserts source into destination at position startIndex *)
+
+PROCEDURE Replace (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  (* Copies source into destination, starting at position startIndex.
+     Copying stops when all of source has been copied, or when the last
+     character of the string value in destination has been replaced.
+  *)
+
+PROCEDURE Append (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Appends source to destination. *)
+
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Concatenates source2 onto source1 and copies the result into destination. *)
+
+
+(* The following predicates provide for pre-testing of the operation-completion
+   conditions for the procedures above.
+*)
+
+PROCEDURE CanAssignAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if a number of characters, indicated by sourceLength, will fit
+     into destination; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanExtractAll (sourceLength, startIndex, numberToExtract: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there are numberToExtract characters starting at startIndex
+     and within the sourceLength of some string, and if the capacity of destination
+     is sufficient to hold numberToExtract characters; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanDeleteAll (stringLength, startIndex, numberToDelete: CARDINAL): BOOLEAN;
+  (* Returns TRUE if there are numberToDelete characters starting at startIndex
+     and within the stringLength of some string; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanInsertAll (sourceLength, startIndex: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is room for the insertion of sourceLength characters from
+     some string into destination starting at startIndex; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanReplaceAll (sourceLength, startIndex: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is room for the replacement of sourceLength characters in
+     destination starting at startIndex; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanAppendAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination to append a string of
+     length sourceLength to the string in destination; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanConcatAll (source1Length, source2Length: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination for a two strings of
+     lengths source1Length and source2Length; otherwise returns FALSE.
+  *)
+
+
+(* The following type and procedures provide for the comparison of string values,
+   and for the location of substrings within strings.
+*)
+
+TYPE
+  CompareResults = (less, equal, greater);
+
+
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): CompareResults;
+  (* Returns less, equal, or greater, according as stringVal1 is lexically
+     less than, equal to, or greater than stringVal2.
+  *)
+
+PROCEDURE Equal (stringVal1, stringVal2: ARRAY OF CHAR): BOOLEAN;
+  (* Returns Strings.Compare(stringVal1, stringVal2) = Strings.equal *)
+
+PROCEDURE FindNext (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks forward for next occurrence of pattern in stringToSearch, starting
+     the search at position startIndex. If startIndex < LENGTH(stringToSearch)
+     and pattern is found, patternFound is returned as TRUE, and posOfPattern
+     contains the start position in stringToSearch of pattern. Otherwise
+     patternFound is returned as FALSE, and posOfPattern is unchanged.
+  *)
+
+PROCEDURE FindPrev (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks backward for the previous occurrence of pattern in stringToSearch and
+     returns the position of the first character of the pattern if found.
+     The search for the pattern begins at startIndex. If pattern is found,
+     patternFound is returned as TRUE, and posOfPattern contains the start
+     position in stringToSearch of pattern in the range [0..startIndex].
+     Otherwise patternFound is returned as FALSE, and posOfPattern is unchanged.
+  *)
+
+PROCEDURE FindDiff (stringVal1, stringVal2: ARRAY OF CHAR;
+                    VAR differenceFound: BOOLEAN; VAR posOfDifference: CARDINAL);
+  (* Compares the string values in stringVal1 and stringVal2 for differences.
+     If they are equal, differenceFound is returned as FALSE, and TRUE otherwise.
+     If differenceFound is TRUE, posOfDifference is set to the position of the
+     first difference; otherwise posOfDifference is unchanged.
+  *)
+
+PROCEDURE Capitalize (VAR stringVar: ARRAY OF CHAR);
+  (* Applies the function CAP to each character of the string value in stringVar *)
+
+END Strings.
diff --git a/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings.mod b/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings.mod
new file mode 100644
index 00000000000..2a72e703b4b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings.mod
@@ -0,0 +1,515 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+(* ---------------------------------------------------------------------
+ * This program is copyright (c) 1996 Faculty of Information Technology,
+ *  Queensland University of Technology, Brisbane, Australia.
+ *  The program may be freely distributed in source or compiled form,
+ *  provided this copyright notice remains intact in the sources.
+ * --------------------------------------------------------------------- *)
+
+(****************************************************************
+$Log: Strings.mod,v $
+Revision 1.3  2006/01/11 00:12:52  gaius
+added 2006 to all Copyright dates
+
+Revision 1.2  2005/11/18 21:54:50  gaius
+fixed Copyright dates and added GPL notices to all files.
+
+Revision 1.1  2004/10/26 14:40:19  gaius
+added switch pass and fail tests
+
+Revision 1.1  2003/11/04 21:34:13  iztokk
+added library sources and some document stuff
+
+Revision 1.1  1996/09/06 07:51:32  lederman
+Initial revision
+
+*)
+
+IMPLEMENTATION MODULE Strings;
+(*
+ * Purpose:
+ *   Facilities for manipulating strings
+ *
+ * Log:
+ *   25/08/96  JL  Initial Release
+ *
+ * Acknowledgments:
+ *   All procedures are substantially based on the existing
+ *   GPM module StdStrings
+ *
+ * Notes:
+ *   Complies with ISO/IEC 10514-1:1996
+ *
+ *)
+
+IMPORT ASCII;
+
+
+PROCEDURE Length (str : ARRAY OF CHAR) : CARDINAL;
+BEGIN
+  RETURN LENGTH(str);
+END Length;
+
+
+PROCEDURE CanAssignAll (sourceLength: CARDINAL; 
+			VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN sourceLength <= HIGH(destination) + 1;
+END CanAssignAll;
+
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  VAR ix, smaller : CARDINAL;
+      ch : CHAR;
+BEGIN
+  IF HIGH(source) < HIGH(destination) THEN
+    smaller := HIGH(source);
+  ELSE
+    smaller := HIGH(destination);
+  END;
+  FOR ix := 0 TO smaller DO
+    ch := source[ix];
+    destination[ix] := ch;
+    IF ch = ASCII.nul THEN RETURN END;
+  END;
+  IF smaller < HIGH(destination) THEN
+    destination[smaller + 1] := ASCII.nul;
+  END;
+END Assign;
+
+
+PROCEDURE CanExtractAll (sourceLength, startIndex, numberToExtract: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN (startIndex + numberToExtract <= sourceLength) AND
+	 (numberToExtract <= HIGH(destination) + 1);
+END CanExtractAll;
+
+
+PROCEDURE Extract (source: ARRAY OF CHAR; startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  VAR dIx, lim : CARDINAL;
+BEGIN
+  dIx := 0;
+  IF numberToExtract > 0 THEN (* else special case *)
+    DEC(numberToExtract);
+    IF numberToExtract > HIGH(destination) THEN
+      numberToExtract := HIGH(destination);
+    END;
+    lim := LENGTH(source);
+    IF startIndex + numberToExtract >= lim THEN DEC(lim);
+    ELSE lim := startIndex + numberToExtract;
+    END;
+    (* lim is last index to copy *)
+    WHILE startIndex <= lim DO
+      destination[dIx] := source[startIndex]; INC(startIndex); INC(dIx);
+    END;
+  END;
+  IF dIx <= HIGH(destination) THEN destination[dIx] := ASCII.nul END;
+END Extract;
+
+
+PROCEDURE CanDeleteAll (stringLength, startIndex, numberToDelete: CARDINAL): BOOLEAN;
+BEGIN
+  RETURN startIndex + numberToDelete <= stringLength;
+END CanDeleteAll;
+
+
+PROCEDURE Delete (VAR string: ARRAY OF CHAR; startIndex, numberToDelete: CARDINAL);
+  VAR lim, mIx : CARDINAL;
+BEGIN
+  lim := LENGTH(string);
+  IF startIndex < lim THEN (* else do nothing *)
+    IF startIndex + numberToDelete <= lim THEN (* else startIndex is unchanged *)
+      mIx := startIndex + numberToDelete;
+      WHILE mIx < lim DO
+        string[startIndex] := string[mIx]; INC(startIndex); INC(mIx);
+      END;
+    END;
+    IF startIndex <= HIGH(string) THEN string[startIndex] := ASCII.nul END;
+  END;
+END Delete;
+
+
+PROCEDURE CanInsertAll (sourceLength, startIndex: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  VAR dLen : CARDINAL;
+BEGIN
+  dLen := LENGTH(destination);
+  RETURN (startIndex <= dLen) AND (sourceLength + dLen <= HIGH(destination) +1);
+END CanInsertAll;
+
+
+PROCEDURE Insert (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                  VAR destination: ARRAY OF CHAR);
+  VAR dLen, sLen, rIx, ix : CARDINAL; 
+BEGIN
+  sLen := LENGTH(source);
+  dLen := LENGTH(destination);
+  IF (sLen = 0) OR (dLen <= startIndex) THEN RETURN END; (* trivial cases *)
+
+  (* copy excess characters up *)
+  rIx := dLen + sLen;
+  IF rIx > HIGH(destination) THEN
+    rIx := HIGH(destination); 
+    IF rIx >= (sLen + startIndex) THEN
+      FOR ix := rIx - sLen TO startIndex BY -1 DO
+        destination[rIx] := destination[ix]; DEC(rIx);
+      END;
+    END;
+  ELSE 
+    destination[rIx] := ASCII.nul; DEC(rIx);
+    FOR ix := dLen - 1 TO startIndex BY -1 DO
+      destination[rIx] := destination[ix]; DEC(rIx);
+    END;
+  END;
+
+  (* now copy in source string *)
+  DEC(sLen); (* assert : was not zero previously *)
+  IF sLen + startIndex > HIGH(destination) THEN
+    sLen := HIGH(destination) - startIndex;
+  END;
+  FOR ix := 0 TO sLen DO
+    destination[startIndex] := source[ix]; INC(startIndex);
+  END;
+END Insert;
+
+
+PROCEDURE CanReplaceAll (sourceLength, startIndex: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN sourceLength + startIndex <= LENGTH(destination);
+END CanReplaceAll;
+
+
+PROCEDURE Replace (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  VAR dLen, ix : CARDINAL;
+BEGIN
+  dLen := LENGTH(destination);
+  ix := 0;
+  WHILE (startIndex < dLen)  AND
+	(ix <= HIGH(source)) AND (source[ix] <> ASCII.nul) DO
+    destination[startIndex] := source[ix]; INC(ix); INC(startIndex);
+  END;
+END Replace;
+
+
+PROCEDURE CanAppendAll (sourceLength: CARDINAL; 
+		    VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN LENGTH(destination) + sourceLength <= HIGH(destination) + 1;
+END CanAppendAll;
+
+
+PROCEDURE Append (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  VAR sIx, dIx, lim : CARDINAL;
+BEGIN
+  dIx := LENGTH(destination);
+  IF HIGH(source) + dIx < HIGH(destination) THEN
+    lim := HIGH(source) + dIx;
+  ELSE
+    lim := HIGH(destination);
+  END;
+  sIx := 0;
+  WHILE dIx <= lim DO
+    destination[dIx] := source[sIx];
+    IF source[sIx] = ASCII.nul THEN RETURN END;
+    INC(sIx); INC(dIx);
+  END;
+  IF dIx <= HIGH(destination) THEN destination[dIx] := ASCII.nul END;
+END Append;
+
+
+PROCEDURE CanConcatAll (source1Length, source2Length: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN source1Length + source2Length <= HIGH(destination) + 1;
+END CanConcatAll;
+
+
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  VAR dIx, sIx, lim : CARDINAL;
+BEGIN
+  IF HIGH(source1) < HIGH(destination) THEN
+    lim := HIGH(source1);
+  ELSE
+    lim := HIGH(destination);
+  END;
+  dIx := 0;
+  WHILE (dIx <= lim) AND (source1[dIx] <> ASCII.nul) DO
+    destination[dIx] := source1[dIx]; INC(dIx);
+  END;
+  
+  IF HIGH(source2) + lim < HIGH(destination) THEN
+    lim := HIGH(source2) + lim;
+  ELSE
+    lim := HIGH(destination);
+  END;
+  sIx := 0;
+  WHILE dIx <= lim DO
+    destination[dIx] := source2[sIx];
+    IF source2[sIx] = ASCII.nul THEN RETURN END;
+    INC(sIx); INC(dIx);
+  END;
+  IF dIx <= HIGH(destination) THEN destination[dIx] := ASCII.nul END;
+END Concat;
+
+
+PROCEDURE Capitalize(VAR str : ARRAY OF CHAR);
+  VAR ix : CARDINAL;
+BEGIN
+  ix := 0;
+  WHILE (ix <= HIGH(str)) AND (str[ix] <> ASCII.nul) DO
+    str[ix] := CAP(str[ix]);
+    INC(ix);
+  END;
+END Capitalize;
+
+
+(*
+ *   There are two different versions of Compare here.
+ *   They use different algorithms which have been
+ *   tuned for statistically good behaviour. The first
+ *   one is usually faster, but neither is as good
+ *   as the libc's strncmp.
+ *
+ * Is it worthwhile to define an interface module to strncmp?
+ *
+ *)
+PROCEDURE Compare      (str1 : ARRAY OF CHAR;
+			str2 : ARRAY OF CHAR) : CompareResults;
+  VAR s1, s2  : CHAR;
+      ix, lim : CARDINAL;
+BEGIN
+  s1 := str1[0]; s2 := str2[0];
+  IF    s1 < s2 THEN RETURN less;
+  ELSIF s1 > s2 THEN RETURN greater;
+  ELSE
+    lim := HIGH(str1);
+    IF lim > HIGH(str2) THEN lim := HIGH(str2) END;
+    ix := 0;
+    IF str1[lim] <> str2[lim] THEN  (* loop terminates before smaller high *)
+      LOOP
+        IF s1 = s2 THEN
+	  IF s2 = ASCII.nul THEN RETURN equal END;
+	  INC(ix); s1:= str1[ix]; s2 := str2[ix];
+        ELSIF s1 < s2 THEN RETURN less;
+        ELSE RETURN greater;
+        END;
+      END;
+    END;
+    WHILE ix < lim DO
+      IF s1 = s2 THEN
+	IF s2 = ASCII.nul THEN RETURN equal END;
+	INC(ix); s1:= str1[ix]; s2 := str2[ix];
+      ELSIF s1 < s2 THEN RETURN less;
+      ELSE RETURN greater;
+      END;
+    END;
+    (* Assert((s1 = s2) AND (ix = lim)); *)
+    IF    s2 = ASCII.nul   THEN RETURN equal;
+    ELSIF HIGH(str2) > lim THEN
+      IF str2[lim + 1] = ASCII.nul THEN RETURN equal ELSE RETURN less END;
+    ELSIF HIGH(str1) > lim THEN
+      IF str1[lim + 1] = ASCII.nul THEN RETURN equal ELSE RETURN greater END;
+    END;
+    RETURN equal;
+  END;
+END Compare;
+
+(* --------------------------------------------------------
+PROCEDURE Compare      (str1 : ARRAY OF CHAR;
+			str2 : ARRAY OF CHAR) : CompareResults;
+  VAR s1, s2 : CHAR; ix, lim, lim1, lim2 : CARDINAL;
+BEGIN
+  IF str1[0] <> str2[0] THEN 
+    IF str1[0] > str2[0] THEN RETURN less;
+    ELSE RETURN greater;
+    END;
+  ELSE 
+    IF str1[0] = ASCII.nul THEN RETURN equal END;
+    lim1 := HIGH(str1) + 1;
+    lim2 := HIGH(str2) + 1;
+    s1 := str1[1]; s2 := str2[1]; ix := 1;
+    IF str2[lim2] = ASCII.nul THEN (* simple is safe *)
+      WHILE s1 = s2 DO
+	IF s1 = ASCII.nul THEN RETURN equal END;
+	INC(ix); s1 := str1[ix]; s2 := str2[ix];
+      END;
+      (* chars are different *)
+      IF ix >= lim1 THEN
+	IF s2 = ASCII.nul THEN RETURN equal;
+        ELSE RETURN less;
+	END;
+      ELSIF s1 < s2 THEN RETURN less;
+      ELSE RETURN greater;
+      END;
+    ELSIF str1[lim1] = ASCII.nul THEN (* simple is safe *)
+      WHILE s1 = s2 DO
+	IF s1 = ASCII.nul THEN RETURN equal END;
+	INC(ix); s1 := str1[ix]; s2 := str2[ix];
+      END;
+      (* chars are different *)
+      IF ix >= lim2 THEN
+	IF s1 = ASCII.nul THEN RETURN equal;
+        ELSE RETURN greater;
+	END;
+      ELSIF s1 < s2 THEN RETURN less;
+      ELSE RETURN greater;
+      END;
+    ELSE (* must do full test *)
+      IF lim1 <= lim2 THEN lim := lim1 ELSE lim := lim2 END;
+      WHILE ix < lim DO
+	IF s1 = s2 THEN
+	  IF s2 = ASCII.nul THEN RETURN equal;
+	  ELSE INC(ix); s1 := str1[ix]; s2 := str2[ix];
+	  END;
+        ELSIF s1 < s2 THEN RETURN less;
+        ELSE RETURN greater;
+        END;
+      END;
+      IF lim2 > lim THEN (* only lim1 is known to be ended *)
+        IF s2 <> ASCII.nul THEN RETURN less;
+        ELSE RETURN equal;
+        END;
+      ELSIF lim1 > lim THEN
+        IF s1 <> ASCII.nul THEN RETURN greater;
+        ELSE RETURN equal;
+        END;
+      ELSE RETURN equal;
+      END;
+    END;
+  END;
+END Compare;
+-------------------------------------------------------- *)
+
+
+PROCEDURE Equal (string1, string2: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN Compare(string1, string2) = equal;
+END Equal;
+
+
+PROCEDURE FindNext (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  VAR sLen, pLen, px, sx : CARDINAL;
+BEGIN
+  sLen := LENGTH(stringToSearch);
+  pLen := LENGTH(pattern);
+  IF pLen > sLen THEN patternFound := FALSE; RETURN END;
+
+  IF pLen = 0 THEN 		(* What are the semantics here? *)
+    patternFound := startIndex < sLen;
+    posOfPattern := startIndex;	(* Martin says "" matches any character *)
+    RETURN;
+  END;
+
+  WHILE startIndex <= sLen - pLen DO	(* find potential starting points *)
+    IF stringToSearch[startIndex] = pattern[0] THEN
+      px := 0; sx := startIndex;	(* now compare strings *)
+      LOOP
+	INC(px); INC(sx);
+	IF px = pLen THEN
+	  patternFound := TRUE;
+	  posOfPattern := startIndex;
+	  RETURN;
+	ELSIF pattern[px] <> stringToSearch[sx] THEN
+	  EXIT;
+	END;
+      END; (* loop *)
+    END;
+    INC(startIndex);
+  END;
+  patternFound := FALSE;
+END FindNext;
+
+
+PROCEDURE FindPrev (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  VAR sLen, pLen, sx, px : CARDINAL;
+BEGIN
+  sLen := LENGTH(stringToSearch);
+  pLen := LENGTH(pattern);
+  IF pLen > sLen THEN patternFound := FALSE; RETURN END;
+
+  IF pLen = 0 THEN 		(* What are the semantics here? *)
+    patternFound := TRUE;
+    IF startIndex >= sLen THEN
+      posOfPattern := sLen - 1;
+    ELSE
+      posOfPattern := startIndex;
+    END;
+    RETURN;
+  END;
+
+ (* if startIndex > sLen - pLen the whole string is searched *)
+  IF startIndex > sLen - pLen THEN startIndex := sLen - pLen END;
+
+  (* now find potential starting points *)
+  INC(startIndex);  (* so it doesn't go negative *)
+  WHILE startIndex > 0 DO
+    DEC(startIndex);
+    IF stringToSearch[startIndex] = pattern[0] THEN
+      px := 0; sx := startIndex;	(* now compare strings *)
+      LOOP
+	INC(px); INC(sx);
+	IF px = pLen THEN
+	  patternFound := TRUE;
+	  posOfPattern := startIndex;
+	  RETURN;
+	ELSIF pattern[px] <> stringToSearch[sx] THEN
+	  EXIT;
+	END;
+      END; (* loop *)
+    END;
+  END;
+  patternFound := FALSE;
+END FindPrev;
+
+
+PROCEDURE FindDiff (string1, string2: ARRAY OF CHAR;
+                    VAR differenceFound: BOOLEAN; VAR posOfDifference: CARDINAL);
+  VAR ix : CARDINAL;
+BEGIN
+  ix := 0;
+  IF string1[0] = string2[0] THEN 
+    IF string1[0] = ASCII.nul THEN (* both strings empty *)
+      differenceFound := FALSE; RETURN;
+    END;
+    LOOP
+      INC(ix);
+      IF (ix > HIGH(string1)) OR (string1[ix] = ASCII.nul) THEN  (* 1 ended *)
+        IF (ix > HIGH(string2)) OR (string2[ix] = ASCII.nul) THEN (* 2 also *)
+	  differenceFound := FALSE; RETURN;	   (* both ended, and equal *)
+	ELSE
+	  EXIT;	(* only 1 ended *)
+	END;
+      ELSIF (ix > HIGH(string2)) OR (string2[ix] = ASCII.nul) THEN
+	EXIT;	(* only 2 ended *)
+      ELSIF string1[ix] <> string2[ix] THEN
+	EXIT;	(* strings differ *)
+      (* else go around the loop once more *)
+      END;
+    END; (* loop *)
+  END;
+  differenceFound := TRUE;
+  posOfDifference := ix;
+END FindDiff;
+
+END Strings.
diff --git a/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings2.def b/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings2.def
new file mode 100644
index 00000000000..c47a60423c1
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings2.def
@@ -0,0 +1,166 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+DEFINITION MODULE Strings2;
+
+  (* Facilities for manipulating strings *)
+
+TYPE
+  String1 = ARRAY [0..0] OF CHAR;
+ (* String1 is provided for constructing a value of a single-character string
+    type from a single character value in order to pass CHAR values to 
+    ARRAY OF CHAR parameters.
+  *)
+
+PROCEDURE Length (stringVal: ARRAY OF CHAR): CARDINAL;
+  (* Returns the length of stringVal (the same value as would be returned by the
+     pervasive function LENGTH).
+  *)
+
+
+(* The following seven procedures construct a string value, and attempt to
+   assign it to a variable parameter.  They all have the property that if
+   the length of the constructed string value exceeds the capacity of the
+   variable parameter, a truncated value is assigned, while if the length
+   of the constructed string value is less than the capacity of the variable
+   parameter, a string terminator is appended before assignment is performed.
+*)
+
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Copies source to destination *)
+
+PROCEDURE Extract (source: ARRAY OF CHAR; startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  (* Copies at most numberToExtract characters from source to destination,
+     starting at position startIndex in source.
+  *)
+
+PROCEDURE Delete (VAR string: ARRAY OF CHAR; startIndex, numberToDelete: CARDINAL);
+  (* Deletes at most numberToDelete characters from stringVar, starting at position
+     startIndex.
+  *)
+
+PROCEDURE Insert (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                  VAR destination: ARRAY OF CHAR);
+  (* Inserts source into destination at position startIndex *)
+
+PROCEDURE Replace (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  (* Copies source into destination, starting at position startIndex.
+     Copying stops when all of source has been copied, or when the last
+     character of the string value in destination has been replaced.
+  *)
+
+PROCEDURE Append (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Appends source to destination. *)
+
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  (* Concatenates source2 onto source1 and copies the result into destination. *)
+
+
+(* The following predicates provide for pre-testing of the operation-completion
+   conditions for the procedures above.
+*)
+
+PROCEDURE CanAssignAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if a number of characters, indicated by sourceLength, will fit
+     into destination; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanExtractAll (sourceLength, startIndex, numberToExtract: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there are numberToExtract characters starting at startIndex
+     and within the sourceLength of some string, and if the capacity of destination
+     is sufficient to hold numberToExtract characters; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanDeleteAll (stringLength, startIndex, numberToDelete: CARDINAL): BOOLEAN;
+  (* Returns TRUE if there are numberToDelete characters starting at startIndex
+     and within the stringLength of some string; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanInsertAll (sourceLength, startIndex: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is room for the insertion of sourceLength characters from
+     some string into destination starting at startIndex; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanReplaceAll (sourceLength, startIndex: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is room for the replacement of sourceLength characters in
+     destination starting at startIndex; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanAppendAll (sourceLength: CARDINAL; VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination to append a string of
+     length sourceLength to the string in destination; otherwise returns FALSE.
+  *)
+
+PROCEDURE CanConcatAll (source1Length, source2Length: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  (* Returns TRUE if there is sufficient room in destination for a two strings of
+     lengths source1Length and source2Length; otherwise returns FALSE.
+  *)
+
+
+(* The following type and procedures provide for the comparison of string values,
+   and for the location of substrings within strings.
+*)
+
+TYPE
+  CompareResults = (less, equal, greater);
+
+
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): CompareResults;
+  (* Returns less, equal, or greater, according as stringVal1 is lexically
+     less than, equal to, or greater than stringVal2.
+  *)
+
+PROCEDURE Equal (stringVal1, stringVal2: ARRAY OF CHAR): BOOLEAN;
+  (* Returns Strings.Compare(stringVal1, stringVal2) = Strings.equal *)
+
+PROCEDURE FindNext (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks forward for next occurrence of pattern in stringToSearch, starting
+     the search at position startIndex. If startIndex < LENGTH(stringToSearch)
+     and pattern is found, patternFound is returned as TRUE, and posOfPattern
+     contains the start position in stringToSearch of pattern. Otherwise
+     patternFound is returned as FALSE, and posOfPattern is unchanged.
+  *)
+
+PROCEDURE FindPrev (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  (* Looks backward for the previous occurrence of pattern in stringToSearch and
+     returns the position of the first character of the pattern if found.
+     The search for the pattern begins at startIndex. If pattern is found,
+     patternFound is returned as TRUE, and posOfPattern contains the start
+     position in stringToSearch of pattern in the range [0..startIndex].
+     Otherwise patternFound is returned as FALSE, and posOfPattern is unchanged.
+  *)
+
+PROCEDURE FindDiff (stringVal1, stringVal2: ARRAY OF CHAR;
+                    VAR differenceFound: BOOLEAN; VAR posOfDifference: CARDINAL);
+  (* Compares the string values in stringVal1 and stringVal2 for differences.
+     If they are equal, differenceFound is returned as FALSE, and TRUE otherwise.
+     If differenceFound is TRUE, posOfDifference is set to the position of the
+     first difference; otherwise posOfDifference is unchanged.
+  *)
+
+PROCEDURE Capitalize (VAR stringVar: ARRAY OF CHAR);
+  (* Applies the function CAP to each character of the string value in stringVar *)
+
+END Strings2.
diff --git a/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings2.mod b/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings2.mod
new file mode 100644
index 00000000000..298ef46b6c3
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic-params/pass/Strings2.mod
@@ -0,0 +1,521 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+(* ---------------------------------------------------------------------
+ * This program is copyright (c) 1996 Faculty of Information Technology,
+ *  Queensland University of Technology, Brisbane, Australia.
+ *  The program may be freely distributed in source or compiled form,
+ *  provided this copyright notice remains intact in the sources.
+ * --------------------------------------------------------------------- *)
+
+(****************************************************************
+$Log: Strings2.mod,v $
+Revision 1.3  2006/01/11 00:12:52  gaius
+added 2006 to all Copyright dates
+
+Revision 1.2  2005/11/18 21:54:50  gaius
+fixed Copyright dates and added GPL notices to all files.
+
+Revision 1.1  2004/10/26 14:40:19  gaius
+added switch pass and fail tests
+
+Revision 1.2  2004/10/17 11:46:06  iztok
+*** empty log message ***
+
+Revision 1.1.1.1  2004/10/06 05:46:24  iztok
+Gardens Point Modula-2 ISO libs directory
+
+Revision 1.1  2003/11/04 21:34:13  iztokk
+added library sources and some document stuff
+
+Revision 1.1  1996/09/06 07:51:32  lederman
+Initial revision
+
+*)
+
+IMPLEMENTATION MODULE Strings2;
+(*
+ * Purpose:
+ *   Facilities for manipulating strings
+ *
+ * Log:
+ *   25/08/96  JL  Initial Release
+ *
+ * Acknowledgments:
+ *   All procedures are substantially based on the existing
+ *   GPM module StdStrings
+ *
+ * Notes:
+ *   Complies with ISO/IEC 10514-1:1996
+ *
+ *)
+
+IMPORT ASCII;
+
+
+PROCEDURE Length (stringVal : ARRAY OF CHAR) : CARDINAL;
+BEGIN
+  RETURN LENGTH(stringVal);
+END Length;
+
+
+PROCEDURE CanAssignAll (sourceLength: CARDINAL; 
+			VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN sourceLength <= HIGH(destination) + 1;
+END CanAssignAll;
+
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  VAR ix, smaller : CARDINAL;
+      ch : CHAR;
+BEGIN
+  IF HIGH(source) < HIGH(destination) THEN
+    smaller := HIGH(source);
+  ELSE
+    smaller := HIGH(destination);
+  END;
+  FOR ix := 0 TO smaller DO
+    ch := source[ix];
+    destination[ix] := ch;
+    IF ch = ASCII.nul THEN RETURN END;
+  END;
+  IF smaller < HIGH(destination) THEN
+    destination[smaller + 1] := ASCII.nul;
+  END;
+END Assign;
+
+
+PROCEDURE CanExtractAll (sourceLength, startIndex, numberToExtract: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN (startIndex + numberToExtract <= sourceLength) AND
+	 (numberToExtract <= HIGH(destination) + 1);
+END CanExtractAll;
+
+
+PROCEDURE Extract (source: ARRAY OF CHAR; startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  VAR dIx, lim : CARDINAL;
+BEGIN
+  dIx := 0;
+  IF numberToExtract > 0 THEN (* else special case *)
+    DEC(numberToExtract);
+    IF numberToExtract > HIGH(destination) THEN
+      numberToExtract := HIGH(destination);
+    END;
+    lim := LENGTH(source);
+    IF startIndex + numberToExtract >= lim THEN DEC(lim);
+    ELSE lim := startIndex + numberToExtract;
+    END;
+    (* lim is last index to copy *)
+    WHILE startIndex <= lim DO
+      destination[dIx] := source[startIndex]; INC(startIndex); INC(dIx);
+    END;
+  END;
+  IF dIx <= HIGH(destination) THEN destination[dIx] := ASCII.nul END;
+END Extract;
+
+
+PROCEDURE CanDeleteAll (stringLength, startIndex, numberToDelete: CARDINAL): BOOLEAN;
+BEGIN
+  RETURN startIndex + numberToDelete <= stringLength;
+END CanDeleteAll;
+
+
+PROCEDURE Delete (VAR string: ARRAY OF CHAR; startIndex, numberToDelete: CARDINAL);
+  VAR lim, mIx : CARDINAL;
+BEGIN
+  lim := LENGTH(string);
+  IF startIndex < lim THEN (* else do nothing *)
+    IF startIndex + numberToDelete <= lim THEN (* else startIndex is unchanged *)
+      mIx := startIndex + numberToDelete;
+      WHILE mIx < lim DO
+        string[startIndex] := string[mIx]; INC(startIndex); INC(mIx);
+      END;
+    END;
+    IF startIndex <= HIGH(string) THEN string[startIndex] := ASCII.nul END;
+  END;
+END Delete;
+
+
+PROCEDURE CanInsertAll (sourceLength, startIndex: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+  VAR dLen : CARDINAL;
+BEGIN
+  dLen := LENGTH(destination);
+  RETURN (startIndex <= dLen) AND (sourceLength + dLen <= HIGH(destination) +1);
+END CanInsertAll;
+
+
+PROCEDURE Insert (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                  VAR destination: ARRAY OF CHAR);
+  VAR dLen, sLen, rIx, ix : CARDINAL; 
+BEGIN
+  sLen := LENGTH(source);
+  dLen := LENGTH(destination);
+  IF (sLen = 0) OR (dLen <= startIndex) THEN RETURN END; (* trivial cases *)
+
+  (* copy excess characters up *)
+  rIx := dLen + sLen;
+  IF rIx > HIGH(destination) THEN
+    rIx := HIGH(destination); 
+    IF rIx >= (sLen + startIndex) THEN
+      FOR ix := rIx - sLen TO startIndex BY -1 DO
+        destination[rIx] := destination[ix]; DEC(rIx);
+      END;
+    END;
+  ELSE 
+    destination[rIx] := ASCII.nul; DEC(rIx);
+    FOR ix := dLen - 1 TO startIndex BY -1 DO
+      destination[rIx] := destination[ix]; DEC(rIx);
+    END;
+  END;
+
+  (* now copy in source string *)
+  DEC(sLen); (* assert : was not zero previously *)
+  IF sLen + startIndex > HIGH(destination) THEN
+    sLen := HIGH(destination) - startIndex;
+  END;
+  FOR ix := 0 TO sLen DO
+    destination[startIndex] := source[ix]; INC(startIndex);
+  END;
+END Insert;
+
+
+PROCEDURE CanReplaceAll (sourceLength, startIndex: CARDINAL;
+                         VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN sourceLength + startIndex <= LENGTH(destination);
+END CanReplaceAll;
+
+
+PROCEDURE Replace (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+  VAR dLen, ix : CARDINAL;
+BEGIN
+  dLen := LENGTH(destination);
+  ix := 0;
+  WHILE (startIndex < dLen)  AND
+	(ix <= HIGH(source)) AND (source[ix] <> ASCII.nul) DO
+    destination[startIndex] := source[ix]; INC(ix); INC(startIndex);
+  END;
+END Replace;
+
+
+PROCEDURE CanAppendAll (sourceLength: CARDINAL; 
+		    VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN LENGTH(destination) + sourceLength <= HIGH(destination) + 1;
+END CanAppendAll;
+
+
+PROCEDURE Append (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  VAR sIx, dIx, lim : CARDINAL;
+BEGIN
+  dIx := LENGTH(destination);
+  IF HIGH(source) + dIx < HIGH(destination) THEN
+    lim := HIGH(source) + dIx;
+  ELSE
+    lim := HIGH(destination);
+  END;
+  sIx := 0;
+  WHILE dIx <= lim DO
+    destination[dIx] := source[sIx];
+    IF source[sIx] = ASCII.nul THEN RETURN END;
+    INC(sIx); INC(dIx);
+  END;
+  IF dIx <= HIGH(destination) THEN destination[dIx] := ASCII.nul END;
+END Append;
+
+
+PROCEDURE CanConcatAll (source1Length, source2Length: CARDINAL;
+                        VAR destination: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN source1Length + source2Length <= HIGH(destination) + 1;
+END CanConcatAll;
+
+
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  VAR dIx, sIx, lim : CARDINAL;
+BEGIN
+  IF HIGH(source1) < HIGH(destination) THEN
+    lim := HIGH(source1);
+  ELSE
+    lim := HIGH(destination);
+  END;
+  dIx := 0;
+  WHILE (dIx <= lim) AND (source1[dIx] <> ASCII.nul) DO
+    destination[dIx] := source1[dIx]; INC(dIx);
+  END;
+  
+  IF HIGH(source2) + lim < HIGH(destination) THEN
+    lim := HIGH(source2) + lim;
+  ELSE
+    lim := HIGH(destination);
+  END;
+  sIx := 0;
+  WHILE dIx <= lim DO
+    destination[dIx] := source2[sIx];
+    IF source2[sIx] = ASCII.nul THEN RETURN END;
+    INC(sIx); INC(dIx);
+  END;
+  IF dIx <= HIGH(destination) THEN destination[dIx] := ASCII.nul END;
+END Concat;
+
+
+PROCEDURE Capitalize(VAR stringVar : ARRAY OF CHAR);
+  VAR ix : CARDINAL;
+BEGIN
+  ix := 0;
+  WHILE (ix <= HIGH(stringVar)) AND (stringVar[ix] <> ASCII.nul) DO
+    stringVar[ix] := CAP(stringVar[ix]);
+    INC(ix);
+  END;
+END Capitalize;
+
+
+(*
+ *   There are two different versions of Compare here.
+ *   They use different algorithms which have been
+ *   tuned for statistically good behaviour. The first
+ *   one is usually faster, but neither is as good
+ *   as the libc's strncmp.
+ *
+ * Is it worthwhile to define an interface module to strncmp?
+ *
+ *)
+PROCEDURE Compare      (stringVal1 : ARRAY OF CHAR;
+			stringVal2 : ARRAY OF CHAR) : CompareResults;
+  VAR s1, s2  : CHAR;
+      ix, lim : CARDINAL;
+BEGIN
+  s1 := stringVal1[0]; s2 := stringVal2[0];
+  IF    s1 < s2 THEN RETURN less;
+  ELSIF s1 > s2 THEN RETURN greater;
+  ELSE
+    lim := HIGH(stringVal1);
+    IF lim > HIGH(stringVal2) THEN lim := HIGH(stringVal2) END;
+    ix := 0;
+    IF stringVal1[lim] <> stringVal2[lim] THEN  (* loop terminates before smaller high *)
+      LOOP
+        IF s1 = s2 THEN
+	  IF s2 = ASCII.nul THEN RETURN equal END;
+	  INC(ix); s1:= stringVal1[ix]; s2 := stringVal2[ix];
+        ELSIF s1 < s2 THEN RETURN less;
+        ELSE RETURN greater;
+        END;
+      END;
+    END;
+    WHILE ix < lim DO
+      IF s1 = s2 THEN
+	IF s2 = ASCII.nul THEN RETURN equal END;
+	INC(ix); s1:= stringVal1[ix]; s2 := stringVal2[ix];
+      ELSIF s1 < s2 THEN RETURN less;
+      ELSE RETURN greater;
+      END;
+    END;
+    (* Assert((s1 = s2) AND (ix = lim)); *)
+    IF    s2 = ASCII.nul   THEN RETURN equal;
+    ELSIF HIGH(stringVal2) > lim THEN
+      IF stringVal2[lim + 1] = ASCII.nul THEN RETURN equal ELSE RETURN less END;
+    ELSIF HIGH(stringVal1) > lim THEN
+      IF stringVal1[lim + 1] = ASCII.nul THEN RETURN equal ELSE RETURN greater END;
+    END;
+    RETURN equal;
+  END;
+END Compare;
+
+(* --------------------------------------------------------
+PROCEDURE Compare      (str1 : ARRAY OF CHAR;
+			str2 : ARRAY OF CHAR) : CompareResults;
+  VAR s1, s2 : CHAR; ix, lim, lim1, lim2 : CARDINAL;
+BEGIN
+  IF str1[0] <> str2[0] THEN 
+    IF str1[0] > str2[0] THEN RETURN less;
+    ELSE RETURN greater;
+    END;
+  ELSE 
+    IF str1[0] = ASCII.nul THEN RETURN equal END;
+    lim1 := HIGH(str1) + 1;
+    lim2 := HIGH(str2) + 1;
+    s1 := str1[1]; s2 := str2[1]; ix := 1;
+    IF str2[lim2] = ASCII.nul THEN (* simple is safe *)
+      WHILE s1 = s2 DO
+	IF s1 = ASCII.nul THEN RETURN equal END;
+	INC(ix); s1 := str1[ix]; s2 := str2[ix];
+      END;
+      (* chars are different *)
+      IF ix >= lim1 THEN
+	IF s2 = ASCII.nul THEN RETURN equal;
+        ELSE RETURN less;
+	END;
+      ELSIF s1 < s2 THEN RETURN less;
+      ELSE RETURN greater;
+      END;
+    ELSIF str1[lim1] = ASCII.nul THEN (* simple is safe *)
+      WHILE s1 = s2 DO
+	IF s1 = ASCII.nul THEN RETURN equal END;
+	INC(ix); s1 := str1[ix]; s2 := str2[ix];
+      END;
+      (* chars are different *)
+      IF ix >= lim2 THEN
+	IF s1 = ASCII.nul THEN RETURN equal;
+        ELSE RETURN greater;
+	END;
+      ELSIF s1 < s2 THEN RETURN less;
+      ELSE RETURN greater;
+      END;
+    ELSE (* must do full test *)
+      IF lim1 <= lim2 THEN lim := lim1 ELSE lim := lim2 END;
+      WHILE ix < lim DO
+	IF s1 = s2 THEN
+	  IF s2 = ASCII.nul THEN RETURN equal;
+	  ELSE INC(ix); s1 := str1[ix]; s2 := str2[ix];
+	  END;
+        ELSIF s1 < s2 THEN RETURN less;
+        ELSE RETURN greater;
+        END;
+      END;
+      IF lim2 > lim THEN (* only lim1 is known to be ended *)
+        IF s2 <> ASCII.nul THEN RETURN less;
+        ELSE RETURN equal;
+        END;
+      ELSIF lim1 > lim THEN
+        IF s1 <> ASCII.nul THEN RETURN greater;
+        ELSE RETURN equal;
+        END;
+      ELSE RETURN equal;
+      END;
+    END;
+  END;
+END Compare;
+-------------------------------------------------------- *)
+
+
+PROCEDURE Equal (stringVal1, stringVal2: ARRAY OF CHAR): BOOLEAN;
+BEGIN
+  RETURN Compare(stringVal1, stringVal2) = equal;
+END Equal;
+
+
+PROCEDURE FindNext (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  VAR sLen, pLen, px, sx : CARDINAL;
+BEGIN
+  sLen := LENGTH(stringToSearch);
+  pLen := LENGTH(pattern);
+  IF pLen > sLen THEN patternFound := FALSE; RETURN END;
+
+  IF pLen = 0 THEN 		(* What are the semantics here? *)
+    patternFound := startIndex < sLen;
+    posOfPattern := startIndex;	(* Martin says "" matches any character *)
+    RETURN;
+  END;
+
+  WHILE startIndex <= sLen - pLen DO	(* find potential starting points *)
+    IF stringToSearch[startIndex] = pattern[0] THEN
+      px := 0; sx := startIndex;	(* now compare strings *)
+      LOOP
+	INC(px); INC(sx);
+	IF px = pLen THEN
+	  patternFound := TRUE;
+	  posOfPattern := startIndex;
+	  RETURN;
+	ELSIF pattern[px] <> stringToSearch[sx] THEN
+	  EXIT;
+	END;
+      END; (* loop *)
+    END;
+    INC(startIndex);
+  END;
+  patternFound := FALSE;
+END FindNext;
+
+
+PROCEDURE FindPrev (pattern, stringToSearch: ARRAY OF CHAR; startIndex: CARDINAL;
+                    VAR patternFound: BOOLEAN; VAR posOfPattern: CARDINAL);
+  VAR sLen, pLen, sx, px : CARDINAL;
+BEGIN
+  sLen := LENGTH(stringToSearch);
+  pLen := LENGTH(pattern);
+  IF pLen > sLen THEN patternFound := FALSE; RETURN END;
+
+  IF pLen = 0 THEN 		(* What are the semantics here? *)
+    patternFound := TRUE;
+    IF startIndex >= sLen THEN
+      posOfPattern := sLen - 1;
+    ELSE
+      posOfPattern := startIndex;
+    END;
+    RETURN;
+  END;
+
+ (* if startIndex > sLen - pLen the whole string is searched *)
+  IF startIndex > sLen - pLen THEN startIndex := sLen - pLen END;
+
+  (* now find potential starting points *)
+  INC(startIndex);  (* so it doesn't go negative *)
+  WHILE startIndex > 0 DO
+    DEC(startIndex);
+    IF stringToSearch[startIndex] = pattern[0] THEN
+      px := 0; sx := startIndex;	(* now compare strings *)
+      LOOP
+	INC(px); INC(sx);
+	IF px = pLen THEN
+	  patternFound := TRUE;
+	  posOfPattern := startIndex;
+	  RETURN;
+	ELSIF pattern[px] <> stringToSearch[sx] THEN
+	  EXIT;
+	END;
+      END; (* loop *)
+    END;
+  END;
+  patternFound := FALSE;
+END FindPrev;
+
+
+PROCEDURE FindDiff (stringVal1, stringVal2: ARRAY OF CHAR;
+                    VAR differenceFound: BOOLEAN; VAR posOfDifference: CARDINAL);
+  VAR ix : CARDINAL;
+BEGIN
+  ix := 0;
+  IF stringVal1[0] = stringVal2[0] THEN
+    IF stringVal1[0] = ASCII.nul THEN (* both strings empty *)
+      differenceFound := FALSE; RETURN;
+    END;
+    LOOP
+      INC(ix);
+      IF (ix > HIGH(stringVal1)) OR (stringVal1[ix] = ASCII.nul) THEN  (* 1 ended *)
+        IF (ix > HIGH(stringVal2)) OR (stringVal2[ix] = ASCII.nul) THEN (* 2 also *)
+	  differenceFound := FALSE; RETURN;	   (* both ended, and equal *)
+	ELSE
+	  EXIT;	(* only 1 ended *)
+	END;
+      ELSIF (ix > HIGH(stringVal2)) OR (stringVal2[ix] = ASCII.nul) THEN
+	EXIT;	(* only 2 ended *)
+      ELSIF stringVal1[ix] <> stringVal2[ix] THEN
+	EXIT;	(* strings differ *)
+      (* else go around the loop once more *)
+      END;
+    END; (* loop *)
+  END;
+  differenceFound := TRUE;
+  posOfDifference := ix;
+END FindDiff;
+
+END Strings2.
diff --git a/gcc/testsuite/gm2/switches/pedantic-params/pass/switches-pedantic-params-pass.exp b/gcc/testsuite/gm2/switches/pedantic-params/pass/switches-pedantic-params-pass.exp
new file mode 100644
index 00000000000..73dfad56dd4
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic-params/pass/switches-pedantic-params-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_iso "${srcdir}/gm2/switches/pedantic-params/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/pedantic/fail/onlywrite.mod b/gcc/testsuite/gm2/switches/pedantic/fail/onlywrite.mod
new file mode 100644
index 00000000000..59906526d5e
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic/fail/onlywrite.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2009
+   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 2, 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. *)
+
+MODULE onlywrite ;
+
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   a := b+1
+END onlywrite.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/switches/pedantic/fail/readb4.mod b/gcc/testsuite/gm2/switches/pedantic/fail/readb4.mod
new file mode 100644
index 00000000000..0599ec2f075
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pedantic/fail/readb4.mod
@@ -0,0 +1,28 @@
+(* Copyright (C) 2009
+   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 2, 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. *)
+
+MODULE readb4 ;
+
+VAR
+   a, b: CARDINAL ;
+BEGIN
+   a := b+1 ;
+   IF a=2
+   THEN
+   END
+END readb4.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/switches/pic/run/pass/func.c b/gcc/testsuite/gm2/switches/pic/run/pass/func.c
new file mode 100644
index 00000000000..708b07a09d4
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pic/run/pass/func.c
@@ -0,0 +1,12 @@
+
+static void test (void)
+{
+}
+
+static void (*p)(void);
+
+static void foo (void)
+{
+  p = test;
+  p();
+}
diff --git a/gcc/testsuite/gm2/switches/pic/run/pass/func.mod b/gcc/testsuite/gm2/switches/pic/run/pass/func.mod
new file mode 100644
index 00000000000..78ec1031a6b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pic/run/pass/func.mod
@@ -0,0 +1,30 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE func ;
+
+PROCEDURE test ;
+BEGIN
+END test ;
+
+VAR
+   p: PROCEDURE ;
+BEGIN
+   p := test ;
+   p()
+END func.
diff --git a/gcc/testsuite/gm2/switches/pic/run/pass/func2.c b/gcc/testsuite/gm2/switches/pic/run/pass/func2.c
new file mode 100644
index 00000000000..0be28bc873b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pic/run/pass/func2.c
@@ -0,0 +1,24 @@
+extern void myexternfunc (void);
+
+static void mystaticfunc (void)
+{
+}
+
+void mypublicfunc (void)
+{
+  void mynestedfunc (void)
+  {
+  }
+}
+
+static void (*p)(void);
+
+static void foo (void)
+{
+  p = mystaticfunc;
+  p();
+  p = mypublicfunc;
+  p();
+  p = myexternfunc;
+  p();
+}
diff --git a/gcc/testsuite/gm2/switches/pic/run/pass/func2.mod b/gcc/testsuite/gm2/switches/pic/run/pass/func2.mod
new file mode 100644
index 00000000000..4ecf9db9d6b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pic/run/pass/func2.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2010 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 2, 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. *)
+
+MODULE func2 ;
+
+TYPE
+   foo = PROCEDURE (INTEGER) ;
+
+PROCEDURE test (i: INTEGER) ;
+BEGIN
+END test ;
+
+VAR
+   p: foo ;
+BEGIN
+   p := test ;
+   p(1)
+END func2.
diff --git a/gcc/testsuite/gm2/switches/pic/run/pass/switches-pic-run-pass.exp b/gcc/testsuite/gm2/switches/pic/run/pass/switches-pic-run-pass.exp
new file mode 100644
index 00000000000..70ecbfd0bf0
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pic/run/pass/switches-pic-run-pass.exp
@@ -0,0 +1,40 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_link_lib "m2pim m2iso"
+gm2_init_pim "${srcdir}/gm2/switches/pic/run/pass" -fPIC
+
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/switches/pim2/run/pass/modulus.mod b/gcc/testsuite/gm2/switches/pim2/run/pass/modulus.mod
new file mode 100644
index 00000000000..8a00abbd357
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim2/run/pass/modulus.mod
@@ -0,0 +1,62 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE modulus ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+
+PROCEDURE Assert (a, s: INTEGER; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF a=s
+   THEN
+      r := printf("successfully evaluated %s\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s the result should be %d but was actually calculated %d\n", ADR(f), l, ADR(e), s, a) ;
+      res := 1
+   END
+END Assert ;
+
+
+VAR
+   i: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   i := 31 MOD 10 ;
+   Assert(i, 1, __FILE__, __LINE__, "31 MOD 10") ;
+
+   i := (-15) MOD 4 ;
+   Assert(i, -3, __FILE__, __LINE__, "(-15) DIV 4") ;
+
+   i := (-31) MOD 10 ;
+   Assert(i, -1, __FILE__, __LINE__, "(-31) MOD 9") ;
+
+   i := (-31) DIV 10 ;
+   Assert(i, -3, __FILE__, __LINE__, "(-31) DIV 10") ;
+
+   (* compatible with ISO *)
+   i := (-31) / 10 ;
+   Assert(i, -3, __FILE__, __LINE__, "(-31) / 10") ;
+   exit(res)
+END modulus.
diff --git a/gcc/testsuite/gm2/switches/pim2/run/pass/switches-pim2-run-pass.exp b/gcc/testsuite/gm2/switches/pim2/run/pass/switches-pim2-run-pass.exp
new file mode 100644
index 00000000000..9444780b5ee
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim2/run/pass/switches-pim2-run-pass.exp
@@ -0,0 +1,39 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim2
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/switches/pim3/run/pass/modulus.mod b/gcc/testsuite/gm2/switches/pim3/run/pass/modulus.mod
new file mode 100644
index 00000000000..3f5bd822c38
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim3/run/pass/modulus.mod
@@ -0,0 +1,62 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE modulus ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated %s\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+VAR
+   i: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   i := 31 MOD 10 ;
+   Assert(i=1, __FILE__, __LINE__, "31 MOD 10") ;
+
+   i := (-15) MOD 4 ;
+   Assert(i=-3, __FILE__, __LINE__, "(-15) DIV 4") ;
+
+   i := (-31) MOD 10 ;
+   Assert(i=-1, __FILE__, __LINE__, "(-31) MOD 9") ;
+
+   i := (-31) DIV 10 ;
+   Assert(i=-3, __FILE__, __LINE__, "(-31) DIV 10") ;
+
+   (* compatible with ISO *)
+   i := (-31) / 10 ;
+   Assert(i=-3, __FILE__, __LINE__, "(-31) / 10") ;
+   exit(res)
+END modulus.
diff --git a/gcc/testsuite/gm2/switches/pim3/run/pass/switches-pim3-run-pass.exp b/gcc/testsuite/gm2/switches/pim3/run/pass/switches-pim3-run-pass.exp
new file mode 100644
index 00000000000..7bece9ec6b6
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim3/run/pass/switches-pim3-run-pass.exp
@@ -0,0 +1,38 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim3 "${srcdir}/gm2/switches/pim3/run/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/switches/pim4/run/pass/FpuIOBug.mod b/gcc/testsuite/gm2/switches/pim4/run/pass/FpuIOBug.mod
new file mode 100644
index 00000000000..be63910aed1
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim4/run/pass/FpuIOBug.mod
@@ -0,0 +1,97 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE FpuIOBug;
+
+(*
+ *  This module tests the implementation of InOut by stress testing
+ *  StringConvert (and checks to see that the -Wpim4 flag does cause
+ *  any unexpected DIV and MOD results).
+ *)
+
+FROM StringConvert IMPORT LongIntegerToString ;
+FROM DynamicStrings IMPORT String, InitString, EqualArray, KillString, string ;
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR, TSIZE ;
+
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated %s\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+PROCEDURE WriteLongInt (x: LONGINT; n: CARDINAL) : String ;
+BEGIN
+   RETURN LongIntegerToString(x, n, ' ', FALSE, 10, TRUE)
+END WriteLongInt ;
+
+
+VAR
+   s     : String ;
+   r, res: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   s := WriteLongInt(MAX(LONGINT), 0) ;
+   r := printf('result of MAX(LONGINT) = %s\n', string(s)) ;
+   IF TSIZE(LONGINT)=4
+   THEN
+      Assert(EqualArray(s, '2147483647'), __FILE__, __LINE__,
+             'MAX(LONGINT) in LongIntegerToString')
+   ELSE
+      Assert(EqualArray(s, '9223372036854775807'), __FILE__, __LINE__,
+             'MAX(LONGINT) in LongIntegerToString')
+   END ;
+
+   s := KillString(s) ;
+
+   s := WriteLongInt(MIN(LONGINT), 0) ;
+   r := printf('result of MIN(LONGINT) = %s\n', string(s)) ;
+   IF TSIZE(LONGINT)=4
+   THEN
+      Assert(EqualArray(s, '-2147483648'), __FILE__, __LINE__,
+             'MIN(LONGINT) in LongIntegerToString')
+   ELSE
+      Assert(EqualArray(s, '-9223372036854775808'), __FILE__, __LINE__,
+             'MIN(LONGINT) in LongIntegerToString')
+   END ;
+
+   s := KillString(s) ;
+
+   s := WriteLongInt(MIN(LONGINT)+1, 0) ;
+   r := printf('result of MIN(LONGINT)+1 = %s\n', string(s)) ;
+   IF TSIZE(LONGINT)=4
+   THEN
+      Assert(EqualArray(s, '-2147483647'), __FILE__, __LINE__,
+             'MIN(LONGINT)+1 in itos')
+   ELSE
+      Assert(EqualArray(s, '-9223372036854775807'), __FILE__, __LINE__,
+             'MIN(LONGINT)+1 in itos')
+   END ;
+
+   s := KillString(s) ;
+   exit(res)
+END FpuIOBug.
diff --git a/gcc/testsuite/gm2/switches/pim4/run/pass/InOutBug.mod b/gcc/testsuite/gm2/switches/pim4/run/pass/InOutBug.mod
new file mode 100644
index 00000000000..5aee76798b6
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim4/run/pass/InOutBug.mod
@@ -0,0 +1,73 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE InOutBug;
+
+(*
+ *  This module tests the implementation of InOut by stress testing
+ *  StringConvert (and checks to see that the -Wpim4 flag does cause
+ *  any unexpected DIV and MOD results).
+ *)
+
+FROM StringConvert IMPORT itos ;
+FROM DynamicStrings IMPORT String, InitString, EqualArray, KillString, string ;
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated %s\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+PROCEDURE WriteInt (x: INTEGER; n: CARDINAL) : String ;
+BEGIN
+   RETURN itos(x, n, ' ', FALSE)
+END WriteInt ;
+
+
+VAR
+   s     : String ;
+   r, res: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   s := WriteInt(MAX(INTEGER), 0) ;
+   r := printf('result of MAX(INTEGER) = %s\n', string(s)) ;
+   Assert(EqualArray(s, '2147483647'), __FILE__, __LINE__, 'MAX(INTEGER) in itos') ;
+   s := KillString(s) ;
+
+   s := WriteInt(MIN(INTEGER), 0) ;
+   r := printf('result of MIN(INTEGER) = %s\n', string(s)) ;
+   Assert(EqualArray(s, '-2147483648'), __FILE__, __LINE__, 'MIN(INTEGER) in itos') ;
+   s := KillString(s) ;
+
+   s := WriteInt(MIN(INTEGER)+1, 0) ;
+   r := printf('result of MIN(INTEGER)+1 = %s\n', string(s)) ;
+   Assert(EqualArray(s, '-2147483647'), __FILE__, __LINE__, 'MIN(INTEGER)+1 in itos') ;
+   s := KillString(s) ;
+   exit(res)
+END InOutBug.
diff --git a/gcc/testsuite/gm2/switches/pim4/run/pass/NumberIOBug.mod b/gcc/testsuite/gm2/switches/pim4/run/pass/NumberIOBug.mod
new file mode 100644
index 00000000000..9d69456e44f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim4/run/pass/NumberIOBug.mod
@@ -0,0 +1,58 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE NumberIOBug ;
+
+FROM NumberIO IMPORT IntToStr ;
+FROM StrLib IMPORT StrEqual ;
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated %s\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+VAR
+   a     : ARRAY [0..100] OF CHAR ;
+   r, res: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   IntToStr(MAX(INTEGER), 0, a) ;
+   r := printf('result of MAX(INTEGER) = %s\n', ADR(a)) ;
+   Assert(StrEqual(a, '2147483647'), __FILE__, __LINE__, 'MAX(INTEGER) in IntToStr') ;
+
+   IntToStr(MIN(INTEGER), 0, a) ;
+   r := printf('result of MIN(INTEGER) = %s\n', ADR(a)) ;
+   Assert(StrEqual(a, '-2147483648'), __FILE__, __LINE__, 'MIN(INTEGER) in IntToStr') ;
+
+   IntToStr(MIN(INTEGER)+1, 0, a) ;
+   r := printf('result of MIN(INTEGER)+1 = %s\n', ADR(a)) ;
+   Assert(StrEqual(a, '-2147483647'), __FILE__, __LINE__, 'MIN(INTEGER)+1 in IntToStr') ;
+   exit(res)
+END NumberIOBug.
diff --git a/gcc/testsuite/gm2/switches/pim4/run/pass/modulus.mod b/gcc/testsuite/gm2/switches/pim4/run/pass/modulus.mod
new file mode 100644
index 00000000000..8ab5c686ad4
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim4/run/pass/modulus.mod
@@ -0,0 +1,64 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE modulus ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+
+PROCEDURE Assert (v: BOOLEAN; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF v
+   THEN
+      r := printf("successfully evaluated %s\n", ADR(e))
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s\n", ADR(f), l, ADR(e)) ;
+      res := 1
+   END
+END Assert ;
+
+
+VAR
+   i: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   (* see P29 of PIM4 *)
+   i := 31 MOD 10 ;
+   Assert(i=1, __FILE__, __LINE__, "31 MOD 10") ;
+
+   (* example from PIM 4th edition *)
+   i := (-15) MOD 4 ;
+   Assert(i=1, __FILE__, __LINE__, "(-15) DIV 4") ;
+
+   i := (-31) MOD 10 ;
+   Assert(i=9, __FILE__, __LINE__, "(-31) MOD 9") ;
+
+   i := (-31) DIV 10 ;
+   Assert(i=-4, __FILE__, __LINE__, "(-31) DIV 10") ;
+
+   (* and we allow ISO compatability *)
+   i := (-31) / 10 ;
+   Assert(i=-3, __FILE__, __LINE__, "(-31) / 10") ;
+   exit(res)
+END modulus.
diff --git a/gcc/testsuite/gm2/switches/pim4/run/pass/modulus2.mod b/gcc/testsuite/gm2/switches/pim4/run/pass/modulus2.mod
new file mode 100644
index 00000000000..c8d464b7359
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim4/run/pass/modulus2.mod
@@ -0,0 +1,108 @@
+(* Copyright (C) 2016, 2017
+   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 2, 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. *)
+
+MODULE modulus2 ;
+
+FROM libc IMPORT exit, printf ;
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+   res: INTEGER ;
+
+
+PROCEDURE Assert (i, v: INTEGER; f: ARRAY OF CHAR; l: CARDINAL; e: ARRAY OF CHAR) ;
+VAR
+   r: INTEGER ;
+BEGIN
+   IF i=v
+   THEN
+      r := printf("successfully evaluated %s = %d\n", ADR(e), i)
+   ELSE
+      r := printf("%s:%d assertion failed when evaluating %s as %d whereas it should be %d\n", ADR(f), l, ADR(e), i, v) ;
+      res := 1
+   END
+END Assert ;
+
+
+(*
+   Consistency - run the PIM4 P28 consistency test for DIV and MOD.
+*)
+
+PROCEDURE Consistency (t, q, r, left, right: INTEGER) ;
+BEGIN
+   printf ("Test %d\n", t) ;
+   printf ("======\n") ;
+   IF (left = q * right + r) AND (r >= 0)
+   THEN
+      printf (" satisfies PIM4 consistency test\n")
+   ELSE
+      printf (" fails PIM4 consistency test") ;
+      IF r<0
+      THEN
+         printf ("  (the remainder must be >= 0)  (not %d)", r)
+      END ;
+      printf ("\n") ;
+
+      printf ("   q = %d,   r = %d,  left = %d,  right = %d\n", q, r, left, right) ;
+      res := 1
+   END
+END Consistency ;
+
+
+VAR
+   q, r: INTEGER ;
+BEGIN
+   res := 0 ;
+
+   (* see P29 of PIM4 and using the examples in ISO M2 P201
+      and the GM2 documentation.  *)
+
+   (* test 1:   31 and 10 *)
+
+   q := 31 DIV 10 ;
+   Assert (q, 3, __FILE__, __LINE__, "31 DIV 10") ;
+   r := 31 MOD 10 ;
+   Assert (r, 1, __FILE__, __LINE__, "31 MOD 10") ;
+   Consistency (1, q, r, 31, 10) ;
+
+   (* test 2:  -31 and 10 *)
+
+   q := (-31) DIV 10 ;
+   Assert (q, -4, __FILE__, __LINE__, "(-31) DIV 10") ;
+   r := (-31) MOD 10 ;
+   Assert (r, 9, __FILE__, __LINE__, "(-31) MOD 10") ;
+   Consistency (2, q, r, -31, 10) ;
+
+   (* test 3:   31 and -10 *)
+
+   q := 31 DIV (-10) ;
+   Assert (q, -3, __FILE__, __LINE__, "31 DIV (-10)") ;
+   r := 31 MOD (-10) ;
+   Assert (r, 1, __FILE__, __LINE__, "31 MOD (-10)") ;
+   Consistency (3, q, r, 31, -10) ;
+
+   (* test 4:  -31 and -10 *)
+
+   q := (-31) DIV (-10) ;
+   Assert (q, 4, __FILE__, __LINE__, "(-31) DIV (-10)") ;
+   r := (-31) MOD (-10) ;
+   Assert (r, 9, __FILE__, __LINE__, "(-31) MOD (-10)") ;
+   Consistency (4, q, r, -31, -10) ;
+
+   exit(res)
+END modulus2.
diff --git a/gcc/testsuite/gm2/switches/pim4/run/pass/switches-pim4-run-pass.exp b/gcc/testsuite/gm2/switches/pim4/run/pass/switches-pim4-run-pass.exp
new file mode 100644
index 00000000000..43ed368a95a
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/pim4/run/pass/switches-pim4-run-pass.exp
@@ -0,0 +1,38 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim4 "${srcdir}/gm2/switches/pim4/run/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/switches/whole-program/pass/run/hello.mod b/gcc/testsuite/gm2/switches/whole-program/pass/run/hello.mod
new file mode 100644
index 00000000000..75d0f651c39
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/whole-program/pass/run/hello.mod
@@ -0,0 +1,7 @@
+MODULE hello ;
+
+FROM libc IMPORT printf ;
+
+BEGIN
+   printf ("hello world\n")
+END hello.
diff --git a/gcc/testsuite/gm2/switches/whole-program/pass/run/hello2.mod b/gcc/testsuite/gm2/switches/whole-program/pass/run/hello2.mod
new file mode 100644
index 00000000000..642752ef2a4
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/whole-program/pass/run/hello2.mod
@@ -0,0 +1,7 @@
+MODULE hello2 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+BEGIN
+   WriteString ("hello world") ; WriteLn
+END hello2.
diff --git a/gcc/testsuite/gm2/switches/whole-program/pass/run/switches-whole-program-pass-run.exp b/gcc/testsuite/gm2/switches/whole-program/pass/run/switches-whole-program-pass-run.exp
new file mode 100644
index 00000000000..4622103a1b7
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/whole-program/pass/run/switches-whole-program-pass-run.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/switches/whole-program/run/pass" -fm2-whole-program
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+    gm2_target_compile $srcdir/$subdir/mystrlib.mod mystrlib.o object "-g -O3 -I$srcdir/$subdir/"
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/whole-program/pass/run/tiny.mod b/gcc/testsuite/gm2/switches/whole-program/pass/run/tiny.mod
new file mode 100644
index 00000000000..a08e7a54d6d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/whole-program/pass/run/tiny.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE tiny ;   (*!m2pim*)
+
+FROM FIO IMPORT FlushBuffer, StdOut ;
+
+BEGIN
+
+END tiny.
diff --git a/gcc/testsuite/gm2/switches/whole-program/pass/run/tiny2.mod b/gcc/testsuite/gm2/switches/whole-program/pass/run/tiny2.mod
new file mode 100644
index 00000000000..b5f9496f006
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/whole-program/pass/run/tiny2.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2017 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.  *)
+
+MODULE tiny2 ;   (*!m2pim*)
+
+FROM FIO IMPORT FlushBuffer ;
+
+BEGIN
+
+END tiny2.
diff --git a/gcc/testsuite/gm2/types/bitset.mod b/gcc/testsuite/gm2/types/bitset.mod
new file mode 100644
index 00000000000..46e097aa0ee
--- /dev/null
+++ b/gcc/testsuite/gm2/types/bitset.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE bitset ;
+
+VAR
+   x: BITSET ;
+BEGIN
+   x := x / {}
+END bitset.
+
diff --git a/gcc/testsuite/gm2/types/bitset2.mod b/gcc/testsuite/gm2/types/bitset2.mod
new file mode 100644
index 00000000000..2a857c76b68
--- /dev/null
+++ b/gcc/testsuite/gm2/types/bitset2.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE bitset2 ;
+
+CONST
+   A = {0} ;
+   B = {1} ;
+VAR
+   X : BITSET;
+BEGIN
+   X := A + B
+END bitset2.
diff --git a/gcc/testsuite/gm2/types/bitset3.mod b/gcc/testsuite/gm2/types/bitset3.mod
new file mode 100644
index 00000000000..ec22d396681
--- /dev/null
+++ b/gcc/testsuite/gm2/types/bitset3.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE bitset3 ;
+
+
+PROCEDURE myproc ;
+BEGIN
+   b := E
+END myproc ;
+
+VAR
+   b: BITSET ;
+
+CONST
+   E = D + C ;
+   D = C + C ;
+   C = B + {6,7} ;
+   B = A + {0,2,4} ;
+   A = {1,3,5} ;
+BEGIN
+   myproc
+END bitset3.
diff --git a/gcc/testsuite/gm2/types/charset.mod b/gcc/testsuite/gm2/types/charset.mod
new file mode 100644
index 00000000000..c2cd53927a6
--- /dev/null
+++ b/gcc/testsuite/gm2/types/charset.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE charset ;
+
+TYPE
+   CharSet = SET OF ["0".."9"] ;
+
+VAR
+   s: CharSet ;
+BEGIN
+   INCL(s, "0")
+END charset.
diff --git a/gcc/testsuite/gm2/types/const.mod b/gcc/testsuite/gm2/types/const.mod
new file mode 100644
index 00000000000..5226c201dff
--- /dev/null
+++ b/gcc/testsuite/gm2/types/const.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE const ;
+
+
+PROCEDURE make (VAR c: INTEGER) ;
+BEGIN
+   c := Yellow
+END make ;
+
+
+MODULE inner ;
+EXPORT Yellow, v ;
+
+   MODULE two ;
+   END two ;
+
+VAR
+   v: INTEGER ;
+CONST
+   Yellow = 3 + Black + 5 ;
+   Black  = 0 ;
+END inner ;
+
+BEGIN
+   make(v)
+END const.
diff --git a/gcc/testsuite/gm2/types/prog35.mod b/gcc/testsuite/gm2/types/prog35.mod
new file mode 100644
index 00000000000..d9ee8b3b0e6
--- /dev/null
+++ b/gcc/testsuite/gm2/types/prog35.mod
@@ -0,0 +1,44 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE prog35;
+
+
+FROM SYSTEM IMPORT WORD ;
+
+TYPE
+   ProcType = PROCEDURE (CARDINAL, WORD) ;
+
+
+PROCEDURE sort (p: ProcType) ;
+BEGIN
+END sort ;
+
+
+PROCEDURE Sorting_Time;
+BEGIN
+   sort(Swap);
+END Sorting_Time;
+
+
+PROCEDURE Swap (Val_1: CARDINAL; Val_2 : CARDINAL);
+BEGIN
+END Swap;
+
+
+BEGIN
+   Sorting_Time
+END prog35.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/types/real.mod b/gcc/testsuite/gm2/types/real.mod
new file mode 100644
index 00000000000..99fa4d2d48d
--- /dev/null
+++ b/gcc/testsuite/gm2/types/real.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE real ;
+
+FROM FpuIO IMPORT WriteReal ;
+FROM StrIO IMPORT WriteLn ;
+
+VAR
+   x: REAL ;
+BEGIN
+   x := -1.5 ;
+   WriteReal(x, 20, 10) ; WriteLn
+END real.
diff --git a/gcc/testsuite/gm2/types/run/pass/d.c b/gcc/testsuite/gm2/types/run/pass/d.c
new file mode 100644
index 00000000000..17b91253547
--- /dev/null
+++ b/gcc/testsuite/gm2/types/run/pass/d.c
@@ -0,0 +1,55 @@
+/* Copyright (C) 2005, 2006 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 2, 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. */
+
+void exit (int);
+
+typedef struct {
+  int tag;
+  union {
+    struct {
+      int foo;
+      int bar;
+      union {
+	int bt;
+	int bf;
+      } inner;
+    } first;
+    int an;
+  } that;
+  int final;
+} this;
+
+void assert (int v)
+{
+  if (! v)
+    exit(1);
+}
+
+void d_test (this *s, int n, int v)
+{
+  switch (n) {
+
+  case 1: assert(s->tag == v); break;
+  case 2: assert(s->that.first.foo == v); break;
+  case 3: assert(s->that.first.bar == v); break;
+  case 4: assert(s->that.first.inner.bt == v); break;
+  case 5: assert(s->that.first.inner.bf == v); break;
+  case 6: assert(s->that.an == v); break;
+  case 7: assert(s->final == v); break;
+  }
+}
+
diff --git a/gcc/testsuite/gm2/types/run/pass/d.def b/gcc/testsuite/gm2/types/run/pass/d.def
new file mode 100644
index 00000000000..95c84460866
--- /dev/null
+++ b/gcc/testsuite/gm2/types/run/pass/d.def
@@ -0,0 +1,39 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+DEFINITION MODULE FOR "C" d ;
+
+EXPORT QUALIFIED test, this ;
+
+TYPE
+   this = RECORD
+             CASE tag: CARDINAL OF
+             1: foo: CARDINAL ;
+                  CASE bar: BOOLEAN OF
+                  TRUE : bt: INTEGER |
+                  FALSE: bf: CARDINAL
+                  END |
+             2: an: CARDINAL |
+             ELSE
+             END ;
+             final: CARDINAL ;
+          END ;
+
+PROCEDURE test (VAR s: this; n: CARDINAL; v: INTEGER) ;
+
+
+END d.
diff --git a/gcc/testsuite/gm2/types/run/pass/types-run-pass.exp b/gcc/testsuite/gm2/types/run/pass/types-run-pass.exp
new file mode 100644
index 00000000000..48b2aa11f06
--- /dev/null
+++ b/gcc/testsuite/gm2/types/run/pass/types-run-pass.exp
@@ -0,0 +1,42 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+set gm2src ${srcdir}/../m2
+
+gm2_init_pim "${srcdir}/gm2/types/run/pass"
+gm2_link_obj "d.o"
+
+set output [target_compile $srcdir/$subdir/d.c d.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/types/run/pass/varient4.mod b/gcc/testsuite/gm2/types/run/pass/varient4.mod
new file mode 100644
index 00000000000..55afb9183d3
--- /dev/null
+++ b/gcc/testsuite/gm2/types/run/pass/varient4.mod
@@ -0,0 +1,41 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient4 ;
+
+FROM d IMPORT this, test ;
+FROM libc IMPORT memset ;
+FROM SYSTEM IMPORT ADDRESS, TSIZE, ADR ;
+
+PROCEDURE zero ;
+BEGIN
+   IF memset(ADR(hmm), 0, TSIZE(this))=NIL
+   THEN
+   END
+END zero ;
+
+VAR
+   hmm: this ;
+BEGIN
+   zero ; hmm.tag   := 99   ; test(hmm, 1, 99) ;
+   zero ; hmm.foo   := 77   ; test(hmm, 2, 77) ;
+   zero ; hmm.bar   := TRUE ; test(hmm, 3, 1) ;
+   zero ; hmm.bt    := 66 ; test(hmm, 4, 66) ;
+   zero ; hmm.bf    := 55 ; test(hmm, 5, 55) ;
+   zero ; hmm.an    := 44 ; test(hmm, 6, 44) ;
+   zero ; hmm.final := 33 ; test(hmm, 7, 33)
+END varient4.
diff --git a/gcc/testsuite/gm2/types/run/pass/varient5.mod b/gcc/testsuite/gm2/types/run/pass/varient5.mod
new file mode 100644
index 00000000000..a2aadcb68cc
--- /dev/null
+++ b/gcc/testsuite/gm2/types/run/pass/varient5.mod
@@ -0,0 +1,62 @@
+(* Copyright (C) 2003, 2004, 2005, 2006 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 2, 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. *)
+
+MODULE varient5 ;
+
+FROM SYSTEM IMPORT BYTE, SIZE, ADR ;
+FROM libc IMPORT exit ;
+
+TYPE
+   union = RECORD
+              CASE :BOOLEAN OF
+
+              TRUE: b1, b2, b3, b4: BYTE |
+              FALSE: c: CARDINAL
+
+              END
+           END ;
+
+PROCEDURE Assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      exit(1)
+   END
+END Assert ;
+
+
+VAR
+   p: POINTER TO BYTE ;
+   t: CARDINAL ;
+   x: union ;
+BEGIN
+   IF SIZE(CARDINAL)=4
+   THEN
+      t := 0FEEDBEEFH ;
+      p := ADR(t) ;
+      IF p^=BYTE(0EFH)
+      THEN
+         x.c := 0FEEDBEEFH
+      ELSE
+         x.c := 0EFBEEDFEH
+      END ;
+      Assert(x.b4=BYTE(0FEH)) ;
+      Assert(x.b3=BYTE(0EDH)) ;
+      Assert(x.b2=BYTE(0BEH)) ;
+      Assert(x.b1=BYTE(0EFH))
+   END
+END varient5.
diff --git a/gcc/testsuite/gm2/types/string.mod b/gcc/testsuite/gm2/types/string.mod
new file mode 100644
index 00000000000..a912e63c8eb
--- /dev/null
+++ b/gcc/testsuite/gm2/types/string.mod
@@ -0,0 +1,45 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+
+MODULE string ;
+
+
+(* string, tests whether the compiler can declare strings after their use *)
+
+(*
+   length - 
+*)
+
+PROCEDURE length () : CARDINAL ;
+CONST
+   both = pre + post ;
+   pre = 'my ' ;
+   post = mystr ;
+BEGIN
+   RETURN( HIGH(both) )
+END length ;
+
+
+
+CONST
+   mystr = 'hello world' ;
+
+BEGIN
+   IF length()=5
+   THEN
+   END
+END string.
diff --git a/gcc/testsuite/gm2/types/type1.mod b/gcc/testsuite/gm2/types/type1.mod
new file mode 100644
index 00000000000..d85fb44059f
--- /dev/null
+++ b/gcc/testsuite/gm2/types/type1.mod
@@ -0,0 +1,25 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE type1 ;
+
+FROM SYSTEM IMPORT TSIZE, ADDRESS, WORD ;
+
+VAR
+   from: ADDRESS ;
+BEGIN
+   INC(from  , TSIZE(WORD))
+END type1.
diff --git a/gcc/testsuite/gm2/types/type2.mod b/gcc/testsuite/gm2/types/type2.mod
new file mode 100644
index 00000000000..7645ad9f3e2
--- /dev/null
+++ b/gcc/testsuite/gm2/types/type2.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE type2 ;
+
+
+VAR
+   p: POINTER TO CHAR ;
+BEGIN
+   DEC(p)
+END type2.
diff --git a/gcc/testsuite/gm2/types/type3.mod b/gcc/testsuite/gm2/types/type3.mod
new file mode 100644
index 00000000000..d41847874e4
--- /dev/null
+++ b/gcc/testsuite/gm2/types/type3.mod
@@ -0,0 +1,37 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE type3 ;
+
+
+PROCEDURE make (VAR c: colours) ;
+BEGIN
+   c := yellow
+END make ;
+
+
+MODULE inner ;
+EXPORT colours ;
+
+   MODULE two ;
+   END two ;
+
+TYPE
+   colours = (red, blue, yellow, white) ;
+END inner ;
+
+BEGIN
+END type3.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/types/type4.mod b/gcc/testsuite/gm2/types/type4.mod
new file mode 100644
index 00000000000..81036ea8850
--- /dev/null
+++ b/gcc/testsuite/gm2/types/type4.mod
@@ -0,0 +1,48 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE type4 ;
+
+
+PROCEDURE make (VAR c: colours) ;
+BEGIN
+   c := green
+END make ;
+
+
+MODULE inner ;
+EXPORT colours ;
+VAR
+   i: INTEGER;
+
+   MODULE two ;
+   VAR
+      i: INTEGER;
+   BEGIN
+      i := 3
+   END two ;
+
+TYPE
+   colours = (red, blue, yellow, white, green) ;
+END inner ;
+
+VAR
+   i: INTEGER ;
+   c: colours ;
+BEGIN
+   i := 2 ;
+   make(c)
+END type4.
diff --git a/gcc/testsuite/gm2/types/varient.mod b/gcc/testsuite/gm2/types/varient.mod
new file mode 100644
index 00000000000..96fbab80dc3
--- /dev/null
+++ b/gcc/testsuite/gm2/types/varient.mod
@@ -0,0 +1,76 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE varient ;
+
+
+
+TYPE
+   Operator = (add, mult, sub) ;
+
+   One  = RECORD
+             First,
+             Second,
+             Third: CHAR ;
+          END ;
+
+   Two  = RECORD
+             ch: CHAR ;
+             CASE ch OF
+
+             'a': First: CARDINAL |
+             'b': Second,
+                  Third : CHAR
+
+             END
+          END ;
+
+   Three = RECORD
+              First,
+              Second,
+              Third : CARDINAL ;
+           END ;
+
+   Node = RECORD
+             Op             : Operator ;
+             CASE Op OF
+
+             add        : Add    : One |
+             mult       : Mult   : Two |
+             sub        : Sub    : Three
+
+             END
+          END ;
+
+
+VAR
+   t: Node ;
+   i: INTEGER ;
+BEGIN
+(*
+   t.Op := add ;
+   t.Add.First := 'a' ;
+*)
+   t.Add.Third := 'b' ;
+
+(*
+   t.Op := mult ;
+
+   t.Mult.ch := 'b' ;
+   t.Mult.First  := 1234
+*)
+   i := 9
+END varient.
diff --git a/gcc/testsuite/gm2/types/word.mod b/gcc/testsuite/gm2/types/word.mod
new file mode 100644
index 00000000000..71ff5e2c360
--- /dev/null
+++ b/gcc/testsuite/gm2/types/word.mod
@@ -0,0 +1,29 @@
+(* Copyright (C) 2005, 2006 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 2, 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. *)
+MODULE word ;
+
+FROM SYSTEM IMPORT WORD ;
+
+PROCEDURE generic (w: WORD) ;
+BEGIN
+END generic ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   generic(c)
+END word.
diff --git a/gcc/testsuite/gm2/ulmlib/pass/ulmlib-pass.exp b/gcc/testsuite/gm2/ulmlib/pass/ulmlib-pass.exp
new file mode 100644
index 00000000000..543b5eaec3c
--- /dev/null
+++ b/gcc/testsuite/gm2/ulmlib/pass/ulmlib-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_ulm
+
+foreach testcase [lsort [glob -nocomplain $srcdir/../gm2/ulm-lib-gm2/sys/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/ulmlib/std/pass/ulmlib-std-pass.exp b/gcc/testsuite/gm2/ulmlib/std/pass/ulmlib-std-pass.exp
new file mode 100644
index 00000000000..62de14a821c
--- /dev/null
+++ b/gcc/testsuite/gm2/ulmlib/std/pass/ulmlib-std-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_ulm
+
+foreach testcase [lsort [glob -nocomplain $srcdir/../gm2/ulm-lib-gm2/std/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/ulmlib/sys/pass/ulmlib-sys-pass.exp b/gcc/testsuite/gm2/ulmlib/sys/pass/ulmlib-sys-pass.exp
new file mode 100644
index 00000000000..543b5eaec3c
--- /dev/null
+++ b/gcc/testsuite/gm2/ulmlib/sys/pass/ulmlib-sys-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_ulm
+
+foreach testcase [lsort [glob -nocomplain $srcdir/../gm2/ulm-lib-gm2/sys/*.mod]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+
+    gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/warnings/todo/nestedproc6.mod b/gcc/testsuite/gm2/warnings/todo/nestedproc6.mod
new file mode 100644
index 00000000000..89f0cc88f87
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/nestedproc6.mod
@@ -0,0 +1,57 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE nestedproc6 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM StrLib IMPORT StrCopy, StrLen ;
+
+
+(* --fixme-- actually the test should work without the global variable t: INTEGER
+             (but it fails)
+*)
+
+VAR
+   t: INTEGER ;
+
+PROCEDURE outer ;
+VAR
+   t: CARDINAL ;
+
+   PROCEDURE flip ;
+   VAR
+      t: CHAR ;
+   BEGIN
+      t := 'a' ;
+      IF t='a'
+      THEN
+      END
+   END flip ;
+
+BEGIN
+   t := 3 ;
+   flip ;
+   INC(t)
+END outer ;
+
+
+BEGIN
+   t := 99 ;
+   outer ;
+   IF t#99
+   THEN
+   END
+END nestedproc6.
diff --git a/gcc/testsuite/gm2/warnings/todo/options b/gcc/testsuite/gm2/warnings/todo/options
new file mode 100644
index 00000000000..78c69642fef
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/options
@@ -0,0 +1 @@
+-pedantic -O -students
diff --git a/gcc/testsuite/gm2/warnings/todo/testfor.mod b/gcc/testsuite/gm2/warnings/todo/testfor.mod
new file mode 100644
index 00000000000..e1683fff13f
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/testfor.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfor ;
+
+
+FROM NumberIO IMPORT WriteCard;
+FROM StrIO IMPORT WriteLn;
+
+CONST
+   a = 15;
+
+VAR
+   i: INTEGER;
+BEGIN
+   FOR i := 1 TO 10 DO
+      i := i+1
+   END
+END testfor.
diff --git a/gcc/testsuite/gm2/warnings/todo/testfor2.mod b/gcc/testsuite/gm2/warnings/todo/testfor2.mod
new file mode 100644
index 00000000000..1b4b460d1bd
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/testfor2.mod
@@ -0,0 +1,33 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testfor2 ;
+
+
+FROM NumberIO IMPORT WriteCard;
+FROM StrIO IMPORT WriteLn;
+
+CONST
+   a = 15;
+
+VAR
+   j,
+   i: INTEGER;
+BEGIN
+   FOR i := 1 TO 10 DO
+   END ;
+   j := i
+END testfor2.
diff --git a/gcc/testsuite/gm2/warnings/todo/testfor3.mod b/gcc/testsuite/gm2/warnings/todo/testfor3.mod
new file mode 100644
index 00000000000..0fcceece911
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/testfor3.mod
@@ -0,0 +1,26 @@
+(* Copyright (C) 2008 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 2, 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. *)
+
+MODULE testfor3 ;
+
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   FOR c := -1 TO 1 DO
+   END
+END testfor3.
diff --git a/gcc/testsuite/gm2/warnings/todo/testkeywords.mod b/gcc/testsuite/gm2/warnings/todo/testkeywords.mod
new file mode 100644
index 00000000000..bd95c10c66f
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/testkeywords.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testkeywords ;
+
+VAR
+   begin: CARDINAL ;
+BEGIN
+   begin := 0 ;
+   INC(begin)
+END testkeywords.
diff --git a/gcc/testsuite/gm2/warnings/todo/testloop.mod b/gcc/testsuite/gm2/warnings/todo/testloop.mod
new file mode 100644
index 00000000000..d856e59cdb7
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/testloop.mod
@@ -0,0 +1,24 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testloop ;
+
+
+BEGIN
+   LOOP
+
+   END
+END testloop.
diff --git a/gcc/testsuite/gm2/warnings/todo/testscope.mod b/gcc/testsuite/gm2/warnings/todo/testscope.mod
new file mode 100644
index 00000000000..945863d0598
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/testscope.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testscope ;
+
+
+PROCEDURE ToThePower (i, n: CARDINAL) : CARDINAL ;
+VAR
+   bar: CARDINAL ;
+BEGIN
+   IF n=0
+   THEN
+      RETURN( 1 )
+   ELSE
+      bar := n ;
+      WHILE bar>1 DO
+         i := i*i ;
+         DEC(bar)
+      END ;
+      RETURN( bar )
+   END
+END ToThePower ;
+
+
+VAR
+   bar: CARDINAL ;
+BEGIN
+   bar := ToThePower(2, 3)
+END testscope.
diff --git a/gcc/testsuite/gm2/warnings/todo/testscope2.mod b/gcc/testsuite/gm2/warnings/todo/testscope2.mod
new file mode 100644
index 00000000000..2fad037bf3f
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/todo/testscope2.mod
@@ -0,0 +1,32 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE testscope2 ;
+
+
+PROCEDURE foo ;
+VAR
+   MyArray: ARRAY [0..10] OF CARDINAL ;
+BEGIN
+   
+END foo ;
+
+
+VAR
+   myarray: ARRAY [0..10] OF CARDINAL ;
+BEGIN
+
+END testscope2.
diff --git a/gcc/testsuite/gm2/x86-asm/asm.mod b/gcc/testsuite/gm2/x86-asm/asm.mod
new file mode 100644
index 00000000000..f4ec1179b87
--- /dev/null
+++ b/gcc/testsuite/gm2/x86-asm/asm.mod
@@ -0,0 +1,27 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE asm ;
+
+
+VAR
+   foo, bar, myout: CARDINAL ;
+BEGIN
+   ASM VOLATILE ("movl %1,%%eax; addl %2,%%eax; movl %%eax,%0"
+      : "=g" (myout) (* outputs *)
+      : "g" (foo), "g" (bar)
+      : (* we trash *) "eax")
+END asm.
diff --git a/gcc/testsuite/gm2/x86-asm/asm2.mod b/gcc/testsuite/gm2/x86-asm/asm2.mod
new file mode 100644
index 00000000000..241a8648398
--- /dev/null
+++ b/gcc/testsuite/gm2/x86-asm/asm2.mod
@@ -0,0 +1,36 @@
+(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 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 2, 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. *)
+MODULE asm2 ;
+
+
+PROCEDURE Example (foo, bar: CARDINAL) : CARDINAL ;
+VAR
+   myout: CARDINAL ;
+BEGIN
+   ASM VOLATILE ("movl %1,%%eax; addl %2,%%eax; movl %%eax,%0"
+      : "=g" (myout)           (* outputs *)
+      : "g" (foo), "g" (bar)   (* inputs  *)
+      : "eax") ;               (* we trash *)
+   RETURN( myout )
+END Example ;
+
+
+VAR
+   result: CARDINAL ;
+BEGIN
+   result := Example(1, 2)
+END asm2.
diff --git a/gcc/testsuite/lib/gm2-dg.exp b/gcc/testsuite/lib/gm2-dg.exp
new file mode 100644
index 00000000000..1093a8e3da4
--- /dev/null
+++ b/gcc/testsuite/lib/gm2-dg.exp
@@ -0,0 +1,77 @@
+#   Copyright (C) 2021 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+load_lib gcc-dg.exp
+
+# Define gm2 callbacks for dg.exp.
+
+proc gm2-dg-test { prog do_what extra_tool_flags } {
+    verbose "begin:gm2-dg-test" 1
+    upvar dg-do-what dg-do-what
+
+    # For now demote link and run tests to compile-only.
+    switch $do_what {
+	link -
+	run {
+	    set do_what compile
+	    set dg-do-what compile
+	}
+    }
+
+    set result \
+	[gcc-dg-test-1 gm2_target_compile $prog $do_what $extra_tool_flags]
+
+    set comp_output [lindex $result 0]
+    set output_file [lindex $result 1]
+    verbose "end:gm2-dg-test" 1
+    return [list $comp_output $output_file]
+}
+
+proc gm2-dg-prune { system text } {
+    return [gcc-dg-prune $system $text]
+}
+
+# Utility routines.
+
+# Modified dg-runtest that can cycle through a list of optimization options
+# as c-torture does.
+proc gm2-dg-runtest { testcases flags default-extra-flags } {
+    global runtests
+    global TORTURE_OPTIONS
+
+    foreach test $testcases {
+	# If we're only testing specific files and this isn't one of
+	# them, skip it.
+	if ![runtest_file_p $runtests $test] {
+	    continue
+        }
+
+	# look if this is dg-do-run test, in which case
+	# we cycle through the option list, otherwise we don't
+	if [expr [search_for $test "dg-do run"]] {
+	    set option_list $TORTURE_OPTIONS
+	} else {
+	    set option_list [list { -O } ]
+	}
+
+	set nshort [file tail [file dirname $test]]/[file tail $test]
+
+	foreach flags_t $option_list {
+	    verbose "Testing $nshort, $flags $flags_t" 1
+	    dg-test $test "$flags $flags_t" ${default-extra-flags}
+	}
+    }
+}
diff --git a/gcc/testsuite/lib/gm2-simple.exp b/gcc/testsuite/lib/gm2-simple.exp
new file mode 100644
index 00000000000..3ba1ae50c00
--- /dev/null
+++ b/gcc/testsuite/lib/gm2-simple.exp
@@ -0,0 +1,137 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2
+
+load_lib file-format.exp
+load_lib gm2.exp
+
+#
+# gm2-simple-compile -- runs the compiler
+#
+# SRC is the full pathname of the testcase.
+# OPTION is the specific compiler flag we're testing (eg: -O2).
+#
+proc gm2-simple-compile { src option } {
+    global output
+    global srcdir tmpdir
+    global host_triplet
+
+    set output "$tmpdir/[file tail [file rootname $src]].o"
+
+    regsub "^$srcdir/?" $src "" testcase
+    # If we couldn't rip $srcdir out of `src' then just do the best we can.
+    # The point is to reduce the unnecessary noise in the logs.  Don't strip
+    # out too much because different testcases with the same name can confuse
+    # `test-tool'.
+    if [string match "/*" $testcase] {
+	set testcase "[file tail [file dirname $src]]/[file tail $src]"
+    }
+
+    verbose "Testing $testcase, $option" 1
+
+    # Run the compiler and analyze the results.
+    set options ""
+    lappend options "additional_flags=$option"
+
+    set comp_output [gm2_target_compile "$src" "$output" object $options];
+    gm2_check_compile $testcase $option $output $comp_output
+    remote_file build delete $output
+    verbose "$comp_output" 1
+}
+
+
+#
+# gm2-simple-execute -- utility to compile and execute a testcase
+#
+# SOURCES is a list of full pathnames to the test source files.
+# The first filename in this list forms the "testcase".
+#
+# If the testcase has an associated .x file, we source that to run the
+# test instead.  We use .x so that we don't lengthen the existing filename
+# to more than 14 chars.
+#
+proc gm2-simple-execute { sources args option } {
+    global tmpdir tool srcdir output compiler_conditional_xfail_data;
+    global gm2_link_libraries;
+    global gm2_link_path;
+    global gm2_link_objects;
+
+    # Use the first source filename given as the filename under test.
+    set src [lindex $sources 0];
+
+    if { [llength $args] > 0 } {
+	set additional_flags [lindex $args 0];
+    } else {
+	set additional_flags "";
+    }
+    # Check for alternate driver.
+    if [file exists [file rootname $src].x] {
+	verbose "Using alternate driver [file rootname [file tail $src]].x" 2
+	set done_p 0;
+	catch "set done_p \[source [file rootname $src].x\]"
+	if { $done_p } {
+	    return
+	}
+    }
+
+    set executable $tmpdir/[file tail [file rootname $src].x];
+    set objectfile $tmpdir/[file tail [file rootname $src].o];
+
+    regsub "^$srcdir/?" $src "" testcase
+    # If we couldn't rip $srcdir out of `src' then just do the best we can.
+    # The point is to reduce the unnecessary noise in the logs.  Don't strip
+    # out too much because different testcases with the same name can confuse
+    # `test-tool'.
+    if [string match "/*" $testcase] {
+	set testcase "[file tail [file dirname $src]]/[file tail $src]"
+    }
+
+    set execname "${executable}";
+
+    remote_file build delete $execname;
+    verbose "Testing $testcase, $option" 1
+
+    # start by setting options with option
+    set options [concat "{additional_flags=$gm2_link_objects} " $option]
+    # now append path -fno-libs=- and objects
+    set options [concat "{additional_flags=$gm2_link_path} " $options]
+    set options [concat "{additional_flags=-fno-libs=-} " $options]
+    set options [concat "{additional_flags=$gm2_link_objects} " $options]
+
+    set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}];
+
+    if ![gm2_check_compile "${testcase} compilation" ${option} ${execname} $comp_output] {
+	unresolved "${testcase} execution, ${option}"
+	remote_file build delete $objectfile
+	return 0
+    }
+
+    set result [gm2_load "$execname" "" ""]
+
+    set status [lindex $result 0];
+    set output [lindex $result 1];
+    if { $status == "fail" } {
+	${tool}_fail $testcase $option
+	send_log "executed $execname with result $status"
+    }
+    if { $status == "pass" } {
+	${tool}_pass $testcase $option
+	remote_file build delete $execname;
+    }
+    return 1
+}
diff --git a/gcc/testsuite/lib/gm2-torture.exp b/gcc/testsuite/lib/gm2-torture.exp
new file mode 100644
index 00000000000..1783260270f
--- /dev/null
+++ b/gcc/testsuite/lib/gm2-torture.exp
@@ -0,0 +1,538 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Rob Savoye. (rob@cygnus.com)
+# and modified by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2
+
+load_lib file-format.exp
+load_lib target-libpath.exp
+
+# The default option list can be overridden by
+# TORTURE_OPTIONS="{ { list1 } ... { listN } }"
+
+if ![info exists TORTURE_OPTIONS] {
+    # It is theoretically beneficial to group all of the O2/O3 options together,
+    # as in many cases the compiler will generate identical executables for
+    # all of them--and the c-torture testsuite will skip testing identical
+    # executables multiple times.
+    # Also note that -finline-functions is explicitly included in one of the
+    # items below, even though -O3 is also specified, because some ports may
+    # choose to disable inlining functions by default, even when optimizing.
+    set TORTURE_OPTIONS [list \
+			     { -g } \
+                             { -O } \
+			     { -O -g } \
+			     { -Os } \
+			     { -O3 -fomit-frame-pointer } \
+			     { -O3 -fomit-frame-pointer -finline-functions } ]
+}
+
+
+#
+#  very costly options follow
+#
+#     set TORTURE_OPTIONS [list \
+\#			     { -g } \
+\#                             { -O } \
+\#			     { -O -g } \
+\#			     { -Os } \
+\#			     { -Os -g } \
+\#			     { -O0 } \
+\#			     { -O0 -g } \
+\#			     { -O1 } \
+\#			     { -O1 -g } \
+\#			     { -O2 } \
+\#			     { -O2 -g } \
+\#			     { -O3 } \
+\#			     { -O3 -g } \
+\#			     { -O3 -fomit-frame-pointer } \
+\#			     { -O3 -fomit-frame-pointer -finline-functions } ]
+#
+#
+#
+
+
+
+#
+# gm2-torture-compile -- runs the gm2-torture test
+#
+# SRC is the full pathname of the testcase.
+# OPTION is the specific compiler flag we're testing (eg: -O2).
+#
+proc gm2-torture-compile { src option } {
+    global output
+    global srcdir tmpdir
+    global host_triplet
+
+    set output "$tmpdir/[file tail [file rootname $src]].o"
+
+    regsub "^$srcdir/?" $src "" testcase
+    # If we couldn't rip $srcdir out of `src' then just do the best we can.
+    # The point is to reduce the unnecessary noise in the logs.  Don't strip
+    # out too much because different testcases with the same name can confuse
+    # `test-tool'.
+    if [string match "/*" $testcase] {
+	set testcase "[file tail [file dirname $src]]/[file tail $src]"
+    }
+
+    # puts stderr "gm2-torture-compiler src = $src, option = $option\n"
+
+    # Run the compiler and analyze the results.
+    set options ""
+    lappend options "additional_flags=${option}"
+
+    set comp_output [gm2_target_compile "$src" "$output" object $options];
+    # puts stderr "*** gm2 torture compile: $comp_output ${options} "
+    gm2_check_compile $testcase "$option" $output $comp_output
+    remote_file build delete $output
+    verbose "$comp_output" 1
+}
+
+
+#
+# gm2_check_compile_fail -- Reports and returns pass/fail for a compilation
+#
+
+proc gm2_check_compile_fail {testcase option objname gcc_output} {
+    global tool
+    set fatal_signal "*cc: Internal compiler error: program*got fatal signal"
+
+    if [string match "$fatal_signal 6" $gcc_output] then {
+	${tool}_fail $testcase "Got Signal 6, $option"
+	return 0
+    }
+
+    if [string match "$fatal_signal 11" $gcc_output] then {
+	${tool}_fail $testcase "Got Signal 11, $option"
+	return 0
+    }
+
+#    # We shouldn't get these because of -w, but just in case.
+#   if [string match "*cc:*warning:*" $gcc_output] then {
+#	warning "$testcase: (with warnings) $option"
+#	send_log "$gcc_output\n"
+#	unresolved "$testcase, $option"
+#	return 0
+#    }
+
+    set gcc_output [prune_warnings $gcc_output]
+
+    set unsupported_message [${tool}_check_unsupported_p $gcc_output]
+    if { $unsupported_message != "" } {
+	unsupported "$testcase: $unsupported_message"
+	return 0
+    }
+
+    # remove any leftover LF/CR to make sure any output is legit
+    regsub -all -- "\[\r\n\]*" $gcc_output "" gcc_output
+
+    # check for any internal error
+    if { [string match "internal error" $gcc_output] ||
+	 [string match "internal compiler error" $gcc_output] } then {
+	${tool}_fail $testcase $option
+	return 0
+    }
+
+    # If any message remains, we pass, as it will be the error message
+    if ![string match "" $gcc_output] then {
+	${tool}_pass $testcase $option
+	return 1
+    }
+
+    # a clean compilation means this test has failed
+    ${tool}_fail $testcase $option
+    return 1
+}
+
+#
+# gm2-torture-compile-fail -- runs the gm2-torture test
+#
+# SRC is the full pathname of the testcase.
+# OPTION is the specific compiler flag we're testing (eg: -O2).
+#
+proc gm2-torture-compile-fail { src option } {
+    global output
+    global srcdir tmpdir
+    global host_triplet
+
+    # puts stderr "gm2-torture-compile-fail:  ${option}\n"
+    set output "$tmpdir/[file tail [file rootname $src]].o"
+
+    regsub "^$srcdir/?" $src "" testcase
+    # If we couldn't rip $srcdir out of `src' then just do the best we can.
+    # The point is to reduce the unnecessary noise in the logs.  Don't strip
+    # out too much because different testcases with the same name can confuse
+    # `test-tool'.
+    if [string match "/*" $testcase] {
+	set testcase "[file tail [file dirname $src]]/[file tail $src]"
+    }
+
+    verbose "Testing expected failure $testcase, $option" 1
+
+    # Run the compiler and analyze the results.
+    set options ""
+    set additional_flags ""
+    lappend options "additional_flags=$option"  # do not use -w for gm2
+    if { $additional_flags != "" } {
+	lappend options "additional_flags=$additional_flags"
+    }
+
+    set comp_output [gm2_target_compile "$src" "$output" object $options];
+    gm2_check_compile_fail $testcase $option $output $comp_output
+    remote_file build delete $output
+    verbose "$comp_output" 1
+}
+
+#
+# gm2-torture-execute -- utility to compile and execute a testcase
+#
+# SOURCES is a list of full pathnames to the test source files.
+# The first filename in this list forms the "testcase".
+#
+# If the testcase has an associated .x file, we source that to run the
+# test instead.  We use .x so that we don't lengthen the existing filename
+# to more than 14 chars.
+#
+proc gm2-torture-execute { sources args success } {
+    global tmpdir tool srcdir output compiler_conditional_xfail_data;
+    global TORTURE_OPTIONS;
+    global gm2_link_libraries;
+    global gm2_link_objects;
+    global gm2_link_path;
+
+    # Use the first source filename given as the filename under test.
+    set src [lindex $sources 0];
+
+    if { [llength $args] > 0 } {
+	set additional_flags [lindex $args 0];
+    } else {
+	set additional_flags "";
+    }
+    # Check for alternate driver.
+    if [file exists [file rootname $src].x] {
+	verbose "Using alternate driver [file rootname [file tail $src]].x" 2
+	set done_p 0;
+	catch "set done_p \[source [file rootname $src].x\]"
+	if { $done_p } {
+	    return
+	}
+    }
+
+    set executable $tmpdir/[file tail [file rootname $src].x];
+    set objectfile $tmpdir/[file tail [file rootname $src].o];
+
+    regsub "^$srcdir/?" $src "" testcase
+    # If we couldn't rip $srcdir out of `src' then just do the best we can.
+    # The point is to reduce the unnecessary noise in the logs.  Don't strip
+    # out too much because different testcases with the same name can confuse
+    # `test-tool'.
+    if [string match "/*" $testcase] {
+	set testcase "[file tail [file dirname $src]]/[file tail $src]"
+    }
+
+    set option_list $TORTURE_OPTIONS;
+
+    set count 0;
+    set oldstatus "foo";
+    foreach option $option_list {
+	if { $count > 0 } {
+	    set oldexec $execname;
+	}
+	set execname "${executable}${count}";
+	incr count;
+
+	# torture_{compile,execute}_xfail are set by the .x script
+	# (if present)
+	if [info exists torture_compile_xfail] {
+	    setup_xfail $torture_compile_xfail
+	}
+
+	# torture_execute_before_{compile,execute} can be set by the .x script
+	# (if present)
+	if [info exists torture_eval_before_compile] {
+            set ignore_me [eval $torture_eval_before_compile]
+	}
+
+	remote_file build delete $execname;
+	verbose "Testing $testcase, $option" 1
+
+	set options ""
+	lappend options "additional_flags=$option"
+	if { $additional_flags != "" } {
+	    lappend options "additional_flags=$additional_flags"
+	}
+	set comp_output [gm2_target_compile "$sources" "${objectfile}" object "$options"];
+
+	# puts stderr "torture gm2 case: $comp_output ${options} "
+
+	if ![gm2_check_compile "$testcase compilation" ${options} $objectfile $comp_output] {
+	    unresolved "$testcase execution, ${options}"
+	    send_log "compile failed not attempting link\n"
+	    remote_file build delete $objectfile
+	    continue
+	}
+
+	send_log "finished compile now attempting link\n"
+	# now link the test
+	set options ${option};
+
+	if { [llength ${args}] > 0 } {
+	    lappend options "additional_flags=[lindex ${args} 0]"
+	}
+
+	lappend options " additional_flags=${gm2_link_path}"
+
+	if {$gm2_link_path != ""} {
+	    lappend options " ldflags=$gm2_link_path"
+	}
+
+	if {$gm2_link_libraries != ""} {
+	    lappend options " ldflags=$gm2_link_libraries"
+	}
+
+#	lappend options "ldflags=/home/gaius/GM2/graft-combine/build-devel-modula2-enabled/x86_64-pc-linux-gnu/libgm2/libm2pim/.libs/libm2pim.a"
+#	lappend options "ldflags=/home/gaius/GM2/graft-combine/build-devel-modula2-enabled/x86_64-pc-linux-gnu/libgm2/libm2iso/.libs/libm2iso.a"
+#	lappend options "ldflags=-lm2pim -lm2iso"
+#
+	if {$gm2_link_objects != ""} {
+	    lappend options " additional_flags=${gm2_link_objects}"
+	}
+	if {$gm2_link_path != ""} {
+	    lappend options " additional_flags=${gm2_link_path}"
+	}
+
+	# lappend options " additional_flags=${gm2_link_objects}"
+	# lappend options " additional_flags=${gm2_link_path}"
+	# lappend options " additional_flags=${gm2_link_libraries}"
+	set options [concat "{additional_flags=$gm2_link_path} " $options]
+	set options [concat "{additional_flags=-fno-libs=-} " $options]
+	set options [concat "{additional_flags=$gm2_link_objects} " $options]
+	# set options [concat "{additional_flags=$gm2_link_libraries} " $options]
+
+	send_log "gm2_link_path = $gm2_link_path\n"
+	send_log "attempting link\n"
+	set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}];
+	# puts "Link libraries are: ${gm2_link_libraries}"
+	# puts "Link path is      : ${gm2_link_path}"
+
+	if ![gm2_check_compile "${testcase} compilation" ${option} ${execname} ${comp_output}] {
+	    send_log "unsuccessful link\n"
+	    unresolved "${testcase} execution, ${option} (link failed)"
+            verbose "tried to link ${testcase} ${sources} ${execname} executable ${options}" 1
+	    verbose "Link libraries are: ${gm2_link_libraries}" 1
+	    verbose "Link path is      : ${gm2_link_path}" 1
+	    verbose "$comp_output" 1
+	    lappend options "additional_flags=-fsources"
+	    lappend options "additional_flags=-v"
+	    verbose "******  s t a r t *********" 1
+	    set comp_output [gm2_target_compile "$sources" "${objectfile}" object ${options}];
+	    verbose "$comp_output" 1
+	    set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}];
+	    verbose "$comp_output" 1
+	    verbose "******    e n d   *********" 1
+	    remote_file build delete $execname
+	    remote_file build delete $objectfile
+	    continue
+	}
+
+	send_log "successful link\n"
+	# See if this source file uses "long long" types, if it does, and
+	# no_long_long is set, skip execution of the test.
+	if [target_info exists no_long_long] then {
+	    if [expr [search_for $src "long long"]] then {
+		unsupported "$testcase execution, $option"
+		continue
+	    }
+	}
+
+	if [info exists torture_execute_xfail] {
+	    setup_xfail $torture_execute_xfail
+	}
+
+	if [info exists torture_eval_before_execute] {
+            set ignore_me [eval $torture_eval_before_execute]
+	}
+
+	# Sometimes we end up creating identical executables for two
+	# consecutive sets of different of compiler options.
+	#
+	# In such cases we know the result of this test will be identical
+	# to the result of the last test.
+	#
+	# So in cases where the time to load and run/simulate the test
+	# is relatively high, compare the two binaries and avoid rerunning
+	# tests if the executables are identical.
+	#
+	# Do not do this for native testing since the cost to load/execute
+	# the test is fairly small and the comparison step actually slows
+	# the entire process down because it usually does not "hit".
+	set skip 0;
+	if { ![isnative] && [info exists oldexec] } {
+	    if { [remote_file build cmp $oldexec $execname] == 0 } {
+		set skip 1;
+	    }
+	}
+	if { $skip == 0 } {
+	    set result [gm2_load "$execname" "" ""]
+	    set status [lindex $result 0];
+	    set output [lindex $result 1];
+	    if { $success == "fail" } {
+		# invert the result
+		if { $status == "pass" } {
+		    set status "fail"
+		} else {
+		    set status "pass"
+		}
+	    }
+	    send_log "executed $execname with result $status"
+	}
+        if { $oldstatus == "pass" } {
+	    remote_file build delete $oldexec;
+        }
+	$status "$testcase execution, $option"
+	set oldstatus $status;
+    }
+    if [info exists status] {
+	if { $status == "pass" } {
+	    remote_file build delete $execname;
+	    remote_file build delete $objectfile;
+	}
+    }
+}
+
+#
+# search_for -- looks for a string match in a file
+#
+proc search_for { file pattern } {
+    set fd [open $file r]
+    while { [gets $fd cur_line]>=0 } {
+	if [string match "*$pattern*" $cur_line] then {
+	    close $fd
+	    return 1
+	}
+    }
+    close $fd
+    return 0
+}
+
+#
+# gm2-torture -- the gm2-torture testcase source file processor
+#
+# This runs compilation only tests (no execute tests).
+# SRC is the full pathname of the testcase, or just a file name in which case
+# we prepend $srcdir/$subdir.
+#
+# If the testcase has an associated .x file, we source that to run the
+# test instead.  We use .x so that we don't lengthen the existing filename
+# to more than 14 chars.
+#
+proc gm2-torture { args } {
+    global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS
+
+    set src [lindex $args 0];
+    if { [llength $args] > 1 } {
+	set options [lindex $args 1];
+    } else {
+	set options ""
+    }
+
+    # Prepend $srdir/$subdir if missing.
+    if ![string match "*/*" $src] {
+	set src "$srcdir/$subdir/$src"
+    }
+
+    # Check for alternate driver.
+    if [file exists [file rootname $src].x] {
+	verbose "Using alternate driver [file rootname [file tail $src]].x" 2
+	set done_p 0
+	catch "set done_p \[source [file rootname $src].x\]"
+	if { $done_p } {
+	    return
+	}
+    }
+
+    set option_list $TORTURE_OPTIONS
+
+    # loop through all the options
+    foreach option $option_list {
+	# torture_compile_xfail is set by the .x script (if present)
+	if [info exists torture_compile_xfail] {
+	    setup_xfail $torture_compile_xfail
+	}
+
+	# torture_execute_before_compile is set by the .x script (if present)
+	if [info exists torture_eval_before_compile] {
+            set ignore_me [eval $torture_eval_before_compile]
+	}
+
+	gm2-torture-compile $src "$option $options"
+    }
+}
+
+#
+# gm2-torture -- the gm2-torture testcase source file processor
+#
+# This runs compilation only tests (no execute tests).
+# SRC is the full pathname of the testcase, or just a file name in which case
+# we prepend $srcdir/$subdir.
+#
+# If the testcase has an associated .x file, we source that to run the
+# test instead.  We use .x so that we don't lengthen the existing filename
+# to more than 14 chars.
+#
+proc gm2-torture-fail { args } {
+    global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS
+
+    set src [lindex $args 0];
+    if { [llength $args] > 1 } {
+	set options [lindex $args 1];
+    } else {
+	set options ""
+    }
+
+    # Prepend $srdir/$subdir if missing.
+    if ![string match "*/*" $src] {
+	set src "$srcdir/$subdir/$src"
+    }
+
+    # Check for alternate driver.
+    if [file exists [file rootname $src].x] {
+	verbose "Using alternate driver [file rootname [file tail $src]].x" 2
+	set done_p 0
+	catch "set done_p \[source [file rootname $src].x\]"
+	if { $done_p } {
+	    return
+	}
+    }
+
+    set option_list $TORTURE_OPTIONS
+
+    # loop through all the options
+    foreach option $option_list {
+	# torture_compile_xfail is set by the .x script (if present)
+	if [info exists torture_compile_xfail] {
+	    setup_xfail $torture_compile_xfail
+	}
+
+	# torture_execute_before_compile is set by the .x script (if present)
+	if [info exists torture_eval_before_compile] {
+            set ignore_me [eval $torture_eval_before_compile]
+	}
+
+	gm2-torture-compile-fail $src "$option $options"
+    }
+}
diff --git a/gcc/testsuite/lib/gm2.exp b/gcc/testsuite/lib/gm2.exp
new file mode 100644
index 00000000000..450cb4c2d35
--- /dev/null
+++ b/gcc/testsuite/lib/gm2.exp
@@ -0,0 +1,498 @@
+# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+# we want to use libgloss so we can get find_gcc.
+load_lib libgloss.exp
+load_lib prune.exp
+load_lib gcc-defs.exp
+load_lib target-libpath.exp
+
+
+#
+# GCC_UNDER_TEST is the compiler under test.
+#
+
+#
+# default_gcc_version -- extract and print the version number of the compiler
+#
+
+proc default_gcc_version { } {
+    global GCC_UNDER_TEST
+
+    gm2_init;
+
+    # ignore any arguments after the command
+    set compiler [lindex $GCC_UNDER_TEST 0]
+
+    if ![is_remote host] {
+	set compiler_name [which $compiler];
+    } else {
+	set compiler_name $compiler;
+    }
+
+    # verify that the compiler exists
+    if { $compiler_name != 0 } then {
+	set tmp [remote_exec host "$compiler --version"]
+	set status [lindex $tmp 0];
+	set output [lindex $tmp 1];
+	regexp "version.*$" $output version
+	if { $status == 0 && [info exists version] } then {
+	    clone_output "$compiler_name $version\n"
+	} else {
+	    clone_output "Couldn't determine version of $compiler_name: $output\n"
+	}
+    } else {
+	# compiler does not exist (this should have already been detected)
+	warning "$compiler does not exist"
+    }
+}
+
+#
+# gcc_version -- Call default_gcc_version, so we can override it if needed.
+#
+
+proc gcc_version { } {
+    default_gcc_version;
+}
+
+#
+# gm2_init -- called at the start of each .exp script.
+#
+# There currently isn't much to do, but always using it allows us to
+# make some enhancements without having to go back and rewrite the scripts.
+#
+
+set gm2_initialized 0;
+set gm2_compile_method "default";
+set gm2_link_path "";
+set gm2_link_libraries "m2pim m2iso";
+set gm2_link_objects "";
+
+proc gm2_set_compile_method { arg } {
+    global gm2_compile_method;
+
+    send_log "********************************************\n"
+    send_log "**** setting gm2_compile_method to $arg ****\n"
+    send_log "********************************************\n"
+    set gm2_compile_method $arg;
+}
+
+
+proc gm2_init { args } {
+    global tmpdir;
+    global objdir;
+    global rootme;
+    global base_dir;
+    global tool_root_dir;
+    global gluefile wrap_flags;
+    global gm2_initialized;
+    global GCC_UNDER_TEST;
+    global TOOL_EXECUTABLE;
+    global gm2_link_libraries;
+    global gm2_link_objects;
+    global gm2_link_path;
+    global HAVE_LIBSTDCXX_V3;
+
+    if { $gm2_initialized == 1 } { return; }
+
+    set gm2_link_objects "";
+    set GCC_UNDER_TEST [lookfor_file $rootme gm2];
+    append GCC_UNDER_TEST " " -B[file dirname $rootme]/gcc " " ${args};
+    append GCC_UNDER_TEST " " -fno-diagnostics-show-caret
+    append GCC_UNDER_TEST " " -fno-diagnostics-show-line-numbers
+    append GCC_UNDER_TEST " " -fdiagnostics-color=never
+    send_log "GCC_UNDER_TEST is ${GCC_UNDER_TEST}\n"
+
+    if ![info exists tmpdir] then {
+	set tmpdir /tmp;
+    }
+    if {[target_info needs_status_wrapper] != "" && \
+	    [target_info needs_status_wrapper] != "0" && \
+	    ![info exists gluefile]} {
+	set gluefile ${tmpdir}/gcc-testglue.o;
+	set result [build_wrapper $gluefile];
+	if { $result != "" } {
+	    set gluefile [lindex $result 0];
+	    set wrap_flags [lindex $result 1];
+	} else {
+	    unset gluefile
+	}
+    }
+
+    set gm2_link_path "[gm2_link_flags [get_multilibs]]";
+    verbose $gm2_link_path 1
+}
+
+#
+# gm2_target_compile_default -- compile a source file
+#
+
+proc gm2_target_compile_default { source dest type options } {
+    global gluefile wrap_flags
+    global GCC_UNDER_TEST
+    global TOOL_OPTIONS
+    global TEST_ALWAYS_FLAGS
+    global gm2_link_objects
+    global gm2_link_libraries
+    global gm2_link_path
+
+    if {[target_info needs_status_wrapper] != "" && \
+	    [target_info needs_status_wrapper] != "0" && \
+	    [info exists gluefile] } {
+	lappend options "libs=${gluefile}"
+	lappend options "ldflags=$wrap_flags"
+    }
+
+    # TEST_ALWAYS_FLAGS are flags that should be passed to every
+    # compilation.  They are passed first to allow individual
+    # tests to override them.
+    if [info exists TEST_ALWAYS_FLAGS] {
+	set options [concat "{additional_flags=$TEST_ALWAYS_FLAGS}" $options]
+    }
+
+    global TEST_EXTRA_LIBS
+    if [info exists TEST_EXTRA_LIBS] {
+	lappend options "ldflags=$TEST_EXTRA_LIBS"
+    }
+
+    if [target_info exists gcc,stack_size] {
+	lappend options "additional_flags=-DSTACK_SIZE=[target_info gcc,stack_size]"
+    }
+    if [target_info exists gcc,no_trampolines] {
+	lappend options "additional_flags=-DNO_TRAMPOLINES"
+    }
+    if [target_info exists gcc,no_label_values] {
+	lappend options "additional_flags=-DNO_LABEL_VALUES"
+    }
+    if [info exists TOOL_OPTIONS] {
+	lappend options "additional_flags=$TOOL_OPTIONS"
+    }
+    if [target_info exists gcc,timeout] {
+	lappend options "timeout=[target_info gcc,timeout]"
+    }
+    lappend options "compiler=$GCC_UNDER_TEST"
+    # puts stderr "options = $options\n"
+    # puts stderr "***** target_compile: $source $dest $type $options\n"
+    return [target_compile $source $dest $type $options]
+}
+
+
+#
+# gm2_target_compile -- compile a source file
+#
+
+proc gm2_target_compile { source dest type options } {
+    global gm2_compile_method;
+
+    return [gm2_target_compile_${gm2_compile_method} $source $dest $type $options]
+}
+
+#
+#  gm2_link_lib - allows tests to specify link libraries.
+#                  This _must_ be called before gm2_init.
+#
+
+proc gm2_link_lib { libraries } {
+    global gm2_link_libraries;
+
+    set gm2_link_libraries $libraries;
+}
+
+
+#
+#  gm2_link_obj - allows tests to specify link with objects.
+#
+
+proc gm2_link_obj { objects } {
+    global gm2_link_objects;
+
+    set gm2_link_objects $objects;
+}
+
+
+#
+#  gm2_link_flags - detects the whereabouts of libraries (-lstdc++).
+#
+
+proc gm2_link_flags { paths } {
+    global srcdir;
+    global ld_library_path;
+    global gccpath;
+    global gm2_link_libraries;
+
+    set gccpath ${paths}
+    set libio_dir ""
+    set flags ""
+    set ld_library_path "."
+
+    set shlib_ext [get_shlib_extension]
+    verbose "shared lib extension: $shlib_ext"
+
+    if { $gccpath == "" } {
+      global tool_root_dir
+
+      set libstdcpp [lookfor_file ${tool_root_dir} libstdc++]
+      if { $libstdcpp != "" } {
+          append flags "-L${libstdcpp} "
+          append ld_library_path ":${libstdcpp}"
+      }
+    } else {
+	if [file exists "${gccpath}/lib/libstdc++.a"] {
+	    append ld_library_path ":${gccpath}/lib"
+	}
+	if [file exists "${gccpath}/libstdc++/libstdc++.a"] {
+	    append flags "-L${gccpath}/libstdc++ "
+	    append ld_library_path ":${gccpath}/libstdc++"
+	}
+	if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.a"] {
+	    append flags " -L${gccpath}/libstdc++-v3/src/.libs "
+	    append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs"
+	}
+	# Look for libstdc++.${shlib_ext}.
+	if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.${shlib_ext}"] {
+	    append flags " -L${gccpath}/libstdc++-v3/src/.libs "
+	    append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs"
+	}
+
+	# puts stderr "${gm2_link_libraries}  before foreach"
+	foreach d [list {*}${gm2_link_libraries}] {
+	    # puts stderr "${d}  XXXX"
+	    send_log "ld_library_path was ${ld_library_path}\n"
+	    send_log "looking for ${gccpath}/lib${d}/.libs/lib${d}.a\n"
+	    if [file exists "${gccpath}/libgm2/lib${d}/.libs/lib${d}.a"] {
+		send_log "good found ${gccpath}/libgm2/lib${d}/.libs/lib${d}.a\n"
+		# append flags " -L${gccpath}/libgm2/lib${d}/.libs -l${d}"
+		append flags " ${gccpath}/libgm2/lib${d}/.libs/lib${d}.a"
+		append ld_library_path ":${gccpath}/libgm2/lib${d}/.libs"
+	    }
+	    send_log "ld_library_path is ${ld_library_path}\n"
+	}
+    }
+
+    set_ld_library_path_env_vars
+    return "$flags"
+}
+
+
+#
+#  gm2_init_pimx - set the default libraries to choose PIM and then ISO.
+#                  choose Modula-2, dialect.
+#
+#
+
+proc gm2_init_pimx { dialect {path ""} args } {
+    global srcdir;
+    global gccpath;
+
+    set gm2src ${srcdir}/../m2;
+
+    send_log "srcdir is $srcdir\n"
+    send_log "gccpath is $gccpath\n"
+    send_log "gm2src is $gm2src\n"
+
+    set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
+    set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
+
+    set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso";
+    set isoLpath "${gccpath}/libgm2/libm2iso/.libs";
+
+    set theIpath "-I${pimIpath} -I${isoIpath}";
+    set theLpath "-L${pimLpath} -L${isoLpath}";
+
+    if { $path != "" } then {
+	append theIpath " -I"
+	append theIpath ${path}
+    }
+    gm2_init {*}${theIpath} {*}${dialect} {*}${theLpath} {*}${args};
+}
+
+#
+#  gm2_init_pim - set the default libraries to choose PIM and then ISO.
+#
+#
+
+proc gm2_init_pim { {path ""} args } {
+    gm2_init_pimx -fpim {*}${path} {*}${args};
+}
+
+
+#
+#  gm2_init_pim2 - set the default libraries to choose PIM and then ISO.
+#                  It uses the PIM2 dialect.
+#
+
+proc gm2_init_pim2 { {path ""} args } {
+    gm2_init_pimx -fpim2 {*}${path} {*}${args};
+}
+
+
+#
+#  gm2_init_pim3 - set the default libraries to choose PIM and then ISO.
+#                  It uses the PIM3 dialect.
+#
+
+proc gm2_init_pim3 { {path ""} args } {
+    gm2_init_pimx -fpim3 {*}${path} {*}${args};
+}
+
+
+#
+#  gm2_init_pim4 - set the default libraries to choose PIM and then ISO.
+#                  It uses the PIM4 dialect.
+#
+
+proc gm2_init_pim4 { {path ""} args } {
+    gm2_init_pimx -fpim4 {*}${path} {*}${args};
+}
+
+
+#
+#  gm2_init_iso - set the default libraries to choose ISO and then PIM.
+#
+
+proc gm2_init_iso { {path ""} args } {
+    global srcdir;
+    global gccpath;
+
+    set gm2src ${srcdir}/../m2;
+
+    set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso";
+    set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
+
+    set isoLpath "${gccpath}/libgm2/libm2iso/.libs";
+    set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
+
+    set corIpath "${gccpath}/libgm2/libm2cor:${gm2src}/gm2-libs-coroutines";
+    set corLpath "${gccpath}/libgm2/libm2cor/.libs";
+
+    set theIpath "-I${isoIpath} -I${corIpath} -I${pimIpath}";
+    set theLpath "-L${isoLpath} -L${corLpath} -L${pimLpath}";
+
+    if { $path != "" } then {
+	append theIpath " -I"
+	append theIpath ${path}
+    }
+
+    gm2_init {*}${theIpath} -fiso {*}${theLpath} {*}${args};
+}
+
+
+#
+#  gm2_init_ulm - set the default libraries to choose the ULM and PIM libraries.
+#
+
+proc gm2_init_ulm { {path ""} args } {
+    global srcdir;
+    global gccpath;
+
+    set gm2src ${srcdir}/../m2;
+
+    set ulmIpath "${gccpath}/libgm2/libm2ulm:${gm2src}/ulm-lib-gm2/std:${gm2src}/ulm-lib-gm2/sys";
+    set ulmLpath "${gccpath}/libgm2/libm2ulm/.libs";
+
+    set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
+    set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
+
+    set theIpath "-I${ulmIpath} -I${pimIpath}";
+    set theLpath "-L${ulmLpath} -L${pimLpath}";
+
+    if { $path != "" } then {
+	append theIpath " -I"
+	append theIpath ${path}
+    }
+
+    gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args};
+}
+
+
+#
+#  gm2_init_log - set the default libraries to choose LOG and then PIM.
+#
+#
+
+proc gm2_init_log { {path ""} args } {
+    global srcdir;
+    global gccpath;
+
+    set gm2src ${srcdir}/../m2;
+
+    send_log "srcdir is $srcdir\n"
+    send_log "gccpath is $gccpath\n"
+    send_log "gm2src is $gm2src\n"
+
+    set logIpath "${gccpath}/libgm2/libm2log:${gm2src}/gm2-libs-pim";
+    set logLpath "${gccpath}/libgm2/libm2log/.libs";
+
+    set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
+    set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
+
+    set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso";
+    set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
+
+    set theIpath "-I${logIpath} -I${pimIpath} -I${isoIpath}";
+    set theLpath "-L${logLpath} -L${pimLpath}";
+
+    if { $path != "" } then {
+	append theIpath " -I"
+	append theIpath ${path}
+    }
+
+    gm2_link_lib "m2log m2pim m2iso"
+    gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args};
+}
+
+#
+#  gm2_init_cor - set the default libraries to choose COR and then PIM.
+#
+#
+
+proc gm2_init_cor { {path ""} args } {
+    global srcdir;
+    global gccpath;
+    global gm2_link_libraries;
+
+    set gm2src ${srcdir}/../m2;
+
+    send_log "srcdir is $srcdir\n"
+    send_log "gccpath is $gccpath\n"
+    send_log "gm2src is $gm2src\n"
+
+    set corIpath "${gccpath}/libgm2/libm2cor:${gm2src}/gm2-libs-coroutines";
+    set corLpath "${gccpath}/libgm2/libm2cor/.libs";
+
+    set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
+    set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
+
+    set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso";
+    set isoLpath "${gccpath}/libgm2/libm2iso/.libs";
+
+    set logIpath "${gccpath}/libgm2/libm2log:${gm2src}/gm2-libs-pim";
+    set logLpath "${gccpath}/libgm2/libm2log/.libs";
+
+    set theIpath "-I${corIpath} -I${pimIpath} -I${logIpath} -I${isoIpath}";
+    set theLpath "-L${corLpath} -L${pimLpath} -L${logLpath} -L${isoLpath}";
+
+    if { $path != "" } then {
+	append theIpath " -I"
+	append theIpath ${path}
+    }
+
+    gm2_link_lib "m2cor m2pim m2iso"
+    gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args};
+}
diff --git a/libgm2/ChangeLog b/libgm2/ChangeLog
deleted file mode 100644
index d1f979eaeab..00000000000
--- a/libgm2/ChangeLog
+++ /dev/null
@@ -1,5 +0,0 @@
-Copyright (C) 2022 Free Software Foundation, Inc.
-
-Copying and distribution of this file, with or without modification,
-are permitted in any medium without royalty provided the copyright
-notice and this notice are preserved.
diff --git a/libgm2/Makefile.am b/libgm2/Makefile.am
new file mode 100644
index 00000000000..88d12ee325e
--- /dev/null
+++ b/libgm2/Makefile.am
@@ -0,0 +1,103 @@
+# Makefile for libgm2.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+#
+#
+# if this file is changed then you need to run
+#
+# autoreconf2.64
+#
+# Modula-2 support.
+AUTOMAKE_OPTIONS = 1.8 foreign
+
+SUFFIXES = .c .mod .def .o .obj .lo .a
+
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+# Multilib support.
+MAKEOVERRIDES=
+
+AM_CFLAGS = -I $(srcdir)/../libgcc -I $(MULTIBUILDTOP)../../gcc/include
+
+gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER)
+TOP_GCCDIR := $(shell cd $(top_srcdir) && cd .. && pwd)
+
+GCC_DIR = $(TOP_GCCDIR)/gcc
+GM2_SRC = $(GCC_DIR)/m2
+
+toolexeclibdir=@toolexeclibdir@
+toolexecdir=@toolexecdir@
+GM2_FOR_TARGET=@GM2_FOR_TARGET@
+
+SUBDIRS = libm2min libm2log libm2cor libm2iso libm2pim
+GM2_BUILDDIR := $(shell pwd)
+gm2_cdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIDIR)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH=$(TARGET_LIB_PATH)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)" \
+	"LIBTOOL=$(GM2_BUILDDIR)/libtool"
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+
+include $(top_srcdir)/../multilib.am
diff --git a/libgm2/Makefile.in b/libgm2/Makefile.in
new file mode 100644
index 00000000000..ec9094b345d
--- /dev/null
+++ b/libgm2/Makefile.in
@@ -0,0 +1,732 @@
+# Makefile.in generated by automake 1.15.1 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994-2017 Free Software Foundation, Inc.
+
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+VPATH = @srcdir@
+am__is_gnu_make = { \
+  if test -z '$(MAKELEVEL)'; then \
+    false; \
+  elif test -n '$(MAKE_HOST)'; then \
+    true; \
+  elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
+    true; \
+  else \
+    false; \
+  fi; \
+}
+am__make_running_with_option = \
+  case $${target_option-} in \
+      ?) ;; \
+      *) echo "am__make_running_with_option: internal error: invalid" \
+              "target option '$${target_option-}' specified" >&2; \
+         exit 1;; \
+  esac; \
+  has_opt=no; \
+  sane_makeflags=$$MAKEFLAGS; \
+  if $(am__is_gnu_make); then \
+    sane_makeflags=$$MFLAGS; \
+  else \
+    case $$MAKEFLAGS in \
+      *\\[\ \	]*) \
+        bs=\\; \
+        sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
+          | sed "s/$$bs$$bs[$$bs $$bs	]*//g"`;; \
+    esac; \
+  fi; \
+  skip_next=no; \
+  strip_trailopt () \
+  { \
+    flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
+  }; \
+  for flg in $$sane_makeflags; do \
+    test $$skip_next = yes && { skip_next=no; continue; }; \
+    case $$flg in \
+      *=*|--*) continue;; \
+        -*I) strip_trailopt 'I'; skip_next=yes;; \
+      -*I?*) strip_trailopt 'I';; \
+        -*O) strip_trailopt 'O'; skip_next=yes;; \
+      -*O?*) strip_trailopt 'O';; \
+        -*l) strip_trailopt 'l'; skip_next=yes;; \
+      -*l?*) strip_trailopt 'l';; \
+      -[dEDm]) skip_next=yes;; \
+      -[JT]) skip_next=yes;; \
+    esac; \
+    case $$flg in \
+      *$$target_option*) has_opt=yes; break;; \
+    esac; \
+  done; \
+  test $$has_opt = yes
+am__make_dryrun = (target_option=n; $(am__make_running_with_option))
+am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
+pkgdatadir = $(datadir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkglibexecdir = $(libexecdir)/@PACKAGE@
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = $(program_transform_name)
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+build_triplet = @build@
+host_triplet = @host@
+target_triplet = @target@
+subdir = .
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(top_srcdir)/../libtool.m4 \
+	$(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \
+	$(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \
+	$(top_srcdir)/../config/acx.m4 \
+	$(top_srcdir)/../config/depstand.m4 \
+	$(top_srcdir)/../config/lead-dot.m4 \
+	$(top_srcdir)/../config/multi.m4 \
+	$(top_srcdir)/../config/no-executables.m4 \
+	$(top_srcdir)/../config/override.m4 $(top_srcdir)/configure.ac
+am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
+	$(ACLOCAL_M4)
+DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \
+	$(am__configure_deps)
+am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
+ configure.lineno config.status.lineno
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = config.h
+CONFIG_CLEAN_FILES =
+CONFIG_CLEAN_VPATH_FILES =
+AM_V_P = $(am__v_P_@AM_V@)
+am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
+am__v_P_0 = false
+am__v_P_1 = :
+AM_V_GEN = $(am__v_GEN_@AM_V@)
+am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
+am__v_GEN_0 = @echo "  GEN     " $@;
+am__v_GEN_1 = 
+AM_V_at = $(am__v_at_@AM_V@)
+am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
+am__v_at_0 = @
+am__v_at_1 = 
+SOURCES =
+RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \
+	ctags-recursive dvi-recursive html-recursive info-recursive \
+	install-data-recursive install-dvi-recursive \
+	install-exec-recursive install-html-recursive \
+	install-info-recursive install-pdf-recursive \
+	install-ps-recursive install-recursive installcheck-recursive \
+	installdirs-recursive pdf-recursive ps-recursive \
+	tags-recursive uninstall-recursive
+am__can_run_installinfo = \
+  case $$AM_UPDATE_INFO_DIR in \
+    n|no|NO) false;; \
+    *) (install-info --version) >/dev/null 2>&1;; \
+  esac
+RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive	\
+  distclean-recursive maintainer-clean-recursive
+am__recursive_targets = \
+  $(RECURSIVE_TARGETS) \
+  $(RECURSIVE_CLEAN_TARGETS) \
+  $(am__extra_recursive_targets)
+AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \
+	cscope
+am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \
+	$(LISP)config.h.in
+# Read a list of newline-separated strings from the standard input,
+# and print each of them once, without duplicates.  Input order is
+# *not* preserved.
+am__uniquify_input = $(AWK) '\
+  BEGIN { nonempty = 0; } \
+  { items[$$0] = 1; nonempty = 1; } \
+  END { if (nonempty) { for (i in items) print i; }; } \
+'
+# Make sure the list of sources is unique.  This is necessary because,
+# e.g., the same source file might be shared among _SOURCES variables
+# for different programs/libraries.
+am__define_uniq_tagged_files = \
+  list='$(am__tagged_files)'; \
+  unique=`for i in $$list; do \
+    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+  done | $(am__uniquify_input)`
+ETAGS = etags
+CTAGS = ctags
+CSCOPE = cscope
+DIST_SUBDIRS = $(SUBDIRS)
+ACLOCAL = @ACLOCAL@
+AMTAR = @AMTAR@
+AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+AR = @AR@
+AUTOCONF = @AUTOCONF@
+AUTOHEADER = @AUTOHEADER@
+AUTOMAKE = @AUTOMAKE@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+CCASDEPMODE = @CCASDEPMODE@
+CCASFLAGS = @CCASFLAGS@
+CCDEPMODE = @CCDEPMODE@
+CC_FOR_BUILD = @CC_FOR_BUILD@
+CFLAGS = @CFLAGS@
+CPP = @CPP@
+CPPFLAGS = @CPPFLAGS@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+CXXDEPMODE = @CXXDEPMODE@
+CXXFLAGS = @CXXFLAGS@
+CYGPATH_W = @CYGPATH_W@
+DEFS = @DEFS@
+DEPDIR = @DEPDIR@
+DSYMUTIL = @DSYMUTIL@
+DUMPBIN = @DUMPBIN@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+EGREP = @EGREP@
+EXEEXT = @EXEEXT@
+FGREP = @FGREP@
+GM2_FOR_TARGET = @GM2_FOR_TARGET@
+GREP = @GREP@
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LD = @LD@
+LDFLAGS = @LDFLAGS@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LIBTOOL = @LIBTOOL@
+LIPO = @LIPO@
+LN_S = @LN_S@
+LTLIBOBJS = @LTLIBOBJS@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+MKDIR_P = @MKDIR_P@
+NM = @NM@
+NMEDIT = @NMEDIT@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+OTOOL = @OTOOL@
+OTOOL64 = @OTOOL64@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_URL = @PACKAGE_URL@
+PACKAGE_VERSION = @PACKAGE_VERSION@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+PERL = @PERL@
+RANLIB = @RANLIB@
+SED = @SED@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+STRIP = @STRIP@
+VERSION = @VERSION@
+abs_builddir = @abs_builddir@
+abs_srcdir = @abs_srcdir@
+abs_top_builddir = @abs_top_builddir@
+abs_top_srcdir = @abs_top_srcdir@
+ac_ct_CC = @ac_ct_CC@
+ac_ct_CXX = @ac_ct_CXX@
+ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
+am__include = @am__include@
+am__leading_dot = @am__leading_dot@
+am__quote = @am__quote@
+am__tar = @am__tar@
+am__untar = @am__untar@
+bindir = @bindir@
+build = @build@
+build_alias = @build_alias@
+build_cpu = @build_cpu@
+build_libsubdir = @build_libsubdir@
+build_os = @build_os@
+build_subdir = @build_subdir@
+build_vendor = @build_vendor@
+builddir = @builddir@
+datadir = @datadir@
+datarootdir = @datarootdir@
+docdir = @docdir@
+dvidir = @dvidir@
+enable_shared = @enable_shared@
+enable_static = @enable_static@
+exec_prefix = @exec_prefix@
+host = @host@
+host_alias = @host_alias@
+host_cpu = @host_cpu@
+host_noncanonical = @host_noncanonical@
+host_os = @host_os@
+host_subdir = @host_subdir@
+host_vendor = @host_vendor@
+htmldir = @htmldir@
+includedir = @includedir@
+infodir = @infodir@
+install_sh = @install_sh@
+libdir = @libdir@
+libexecdir = @libexecdir@
+libtool_VERSION = @libtool_VERSION@
+localedir = @localedir@
+localstatedir = @localstatedir@
+mandir = @mandir@
+mkdir_p = @mkdir_p@
+multi_basedir = @multi_basedir@
+oldincludedir = @oldincludedir@
+pdfdir = @pdfdir@
+prefix = @prefix@
+program_transform_name = @program_transform_name@
+psdir = @psdir@
+sbindir = @sbindir@
+sharedstatedir = @sharedstatedir@
+slibdir = @slibdir@
+srcdir = @srcdir@
+sysconfdir = @sysconfdir@
+target = @target@
+target_alias = @target_alias@
+target_cpu = @target_cpu@
+target_noncanonical = @target_noncanonical@
+target_os = @target_os@
+target_subdir = @target_subdir@
+target_vendor = @target_vendor@
+toolexecdir = @toolexecdir@
+toolexeclibdir = @toolexeclibdir@
+top_build_prefix = @top_build_prefix@
+top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
+
+# Makefile for libgm2.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+#
+#
+# if this file is changed then you need to run
+#
+# autoreconf2.64
+#
+# Modula-2 support.
+AUTOMAKE_OPTIONS = 1.8 foreign
+SUFFIXES = .c .mod .def .o .obj .lo .a
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+# Multilib support.
+MAKEOVERRIDES = 
+AM_CFLAGS = -I $(srcdir)/../libgcc -I $(MULTIBUILDTOP)../../gcc/include
+gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER)
+TOP_GCCDIR := $(shell cd $(top_srcdir) && cd .. && pwd)
+GCC_DIR = $(TOP_GCCDIR)/gcc
+GM2_SRC = $(GCC_DIR)/m2
+SUBDIRS = libm2min libm2log libm2cor libm2iso libm2pim
+GM2_BUILDDIR := $(shell pwd)
+gm2_cdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIDIR)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH=$(TARGET_LIB_PATH)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)" \
+	"LIBTOOL=$(GM2_BUILDDIR)/libtool"
+
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+MULTISRCTOP = 
+MULTIBUILDTOP = 
+MULTIDIRS = 
+MULTISUBDIR = 
+MULTIDO = true
+MULTICLEAN = true
+all: config.h
+	$(MAKE) $(AM_MAKEFLAGS) all-recursive
+
+.SUFFIXES:
+.SUFFIXES: .c .mod .def .o .obj .lo .a
+am--refresh: Makefile
+	@:
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(top_srcdir)/../multilib.am $(am__configure_deps)
+	@for dep in $?; do \
+	  case '$(am__configure_deps)' in \
+	    *$$dep*) \
+	      echo ' cd $(srcdir) && $(AUTOMAKE) --foreign'; \
+	      $(am__cd) $(srcdir) && $(AUTOMAKE) --foreign \
+		&& exit 0; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign Makefile'; \
+	$(am__cd) $(top_srcdir) && \
+	  $(AUTOMAKE) --foreign Makefile
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+	@case '$?' in \
+	  *config.status*) \
+	    echo ' $(SHELL) ./config.status'; \
+	    $(SHELL) ./config.status;; \
+	  *) \
+	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \
+	    cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \
+	esac;
+$(top_srcdir)/../multilib.am $(am__empty):
+
+$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	$(SHELL) ./config.status --recheck
+
+$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
+	$(am__cd) $(srcdir) && $(AUTOCONF)
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
+	$(am__cd) $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS)
+$(am__aclocal_m4_deps):
+
+config.h: stamp-h1
+	@test -f $@ || rm -f stamp-h1
+	@test -f $@ || $(MAKE) $(AM_MAKEFLAGS) stamp-h1
+
+stamp-h1: $(srcdir)/config.h.in $(top_builddir)/config.status
+	@rm -f stamp-h1
+	cd $(top_builddir) && $(SHELL) ./config.status config.h
+$(srcdir)/config.h.in: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) 
+	($(am__cd) $(top_srcdir) && $(AUTOHEADER))
+	rm -f stamp-h1
+	touch $@
+
+distclean-hdr:
+	-rm -f config.h stamp-h1
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+	-rm -f libtool config.lt
+
+# This directory's subdirectories are mostly independent; you can cd
+# into them and run 'make' without going through this Makefile.
+# To change the values of 'make' variables: instead of editing Makefiles,
+# (1) if the variable is set in 'config.status', edit 'config.status'
+#     (which will cause the Makefiles to be regenerated when you run 'make');
+# (2) otherwise, pass the desired values on the 'make' command line.
+$(am__recursive_targets):
+	@fail=; \
+	if $(am__make_keepgoing); then \
+	  failcom='fail=yes'; \
+	else \
+	  failcom='exit 1'; \
+	fi; \
+	dot_seen=no; \
+	target=`echo $@ | sed s/-recursive//`; \
+	case "$@" in \
+	  distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
+	  *) list='$(SUBDIRS)' ;; \
+	esac; \
+	for subdir in $$list; do \
+	  echo "Making $$target in $$subdir"; \
+	  if test "$$subdir" = "."; then \
+	    dot_seen=yes; \
+	    local_target="$$target-am"; \
+	  else \
+	    local_target="$$target"; \
+	  fi; \
+	  ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+	  || eval $$failcom; \
+	done; \
+	if test "$$dot_seen" = "no"; then \
+	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+	fi; test -z "$$fail"
+
+ID: $(am__tagged_files)
+	$(am__define_uniq_tagged_files); mkid -fID $$unique
+tags: tags-recursive
+TAGS: tags
+
+tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	set x; \
+	here=`pwd`; \
+	if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
+	  include_option=--etags-include; \
+	  empty_fix=.; \
+	else \
+	  include_option=--include; \
+	  empty_fix=; \
+	fi; \
+	list='$(SUBDIRS)'; for subdir in $$list; do \
+	  if test "$$subdir" = .; then :; else \
+	    test ! -f $$subdir/TAGS || \
+	      set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \
+	  fi; \
+	done; \
+	$(am__define_uniq_tagged_files); \
+	shift; \
+	if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
+	  test -n "$$unique" || unique=$$empty_fix; \
+	  if test $$# -gt 0; then \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      "$$@" $$unique; \
+	  else \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      $$unique; \
+	  fi; \
+	fi
+ctags: ctags-recursive
+
+CTAGS: ctags
+ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	$(am__define_uniq_tagged_files); \
+	test -z "$(CTAGS_ARGS)$$unique" \
+	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
+	     $$unique
+
+GTAGS:
+	here=`$(am__cd) $(top_builddir) && pwd` \
+	  && $(am__cd) $(top_srcdir) \
+	  && gtags -i $(GTAGS_ARGS) "$$here"
+cscope: cscope.files
+	test ! -s cscope.files \
+	  || $(CSCOPE) -b -q $(AM_CSCOPEFLAGS) $(CSCOPEFLAGS) -i cscope.files $(CSCOPE_ARGS)
+clean-cscope:
+	-rm -f cscope.files
+cscope.files: clean-cscope cscopelist
+cscopelist: cscopelist-recursive
+
+cscopelist-am: $(am__tagged_files)
+	list='$(am__tagged_files)'; \
+	case "$(srcdir)" in \
+	  [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
+	  *) sdir=$(subdir)/$(srcdir) ;; \
+	esac; \
+	for i in $$list; do \
+	  if test -f "$$i"; then \
+	    echo "$(subdir)/$$i"; \
+	  else \
+	    echo "$$sdir/$$i"; \
+	  fi; \
+	done >> $(top_builddir)/cscope.files
+
+distclean-tags:
+	-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
+	-rm -f cscope.out cscope.in.out cscope.po.out cscope.files
+check-am: all-am
+check: check-recursive
+all-am: Makefile config.h all-local
+installdirs: installdirs-recursive
+installdirs-am:
+install: install-recursive
+install-exec: install-exec-recursive
+install-data: install-data-recursive
+uninstall: uninstall-recursive
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-recursive
+install-strip:
+	if test -z '$(STRIP)'; then \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	      install; \
+	else \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	    "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
+	fi
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
+	-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
+
+maintainer-clean-generic:
+	@echo "This command is intended for maintainers to use"
+	@echo "it deletes files that may require special tools to rebuild."
+clean: clean-recursive
+
+clean-am: clean-generic clean-libtool clean-local mostlyclean-am
+
+distclean: distclean-recursive
+	-rm -f $(am__CONFIG_DISTCLEAN_FILES)
+	-rm -f Makefile
+distclean-am: clean-am distclean-generic distclean-hdr \
+	distclean-libtool distclean-local distclean-tags
+
+dvi: dvi-recursive
+
+dvi-am:
+
+html: html-recursive
+
+html-am:
+
+info: info-recursive
+
+info-am:
+
+install-data-am:
+
+install-dvi: install-dvi-recursive
+
+install-dvi-am:
+
+install-exec-am: install-exec-local
+
+install-html: install-html-recursive
+
+install-html-am:
+
+install-info: install-info-recursive
+
+install-info-am:
+
+install-man:
+
+install-pdf: install-pdf-recursive
+
+install-pdf-am:
+
+install-ps: install-ps-recursive
+
+install-ps-am:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-recursive
+	-rm -f $(am__CONFIG_DISTCLEAN_FILES)
+	-rm -rf $(top_srcdir)/autom4te.cache
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic \
+	maintainer-clean-local
+
+mostlyclean: mostlyclean-recursive
+
+mostlyclean-am: mostlyclean-generic mostlyclean-libtool \
+	mostlyclean-local
+
+pdf: pdf-recursive
+
+pdf-am:
+
+ps: ps-recursive
+
+ps-am:
+
+uninstall-am:
+
+.MAKE: $(am__recursive_targets) all install-am install-strip
+
+.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am all-local \
+	am--refresh check check-am clean clean-cscope clean-generic \
+	clean-libtool clean-local cscope cscopelist-am ctags ctags-am \
+	distclean distclean-generic distclean-hdr distclean-libtool \
+	distclean-local distclean-tags dvi dvi-am html html-am info \
+	info-am install install-am install-data install-data-am \
+	install-dvi install-dvi-am install-exec install-exec-am \
+	install-exec-local install-html install-html-am install-info \
+	install-info-am install-man install-pdf install-pdf-am \
+	install-ps install-ps-am install-strip installcheck \
+	installcheck-am installdirs installdirs-am maintainer-clean \
+	maintainer-clean-generic maintainer-clean-local mostlyclean \
+	mostlyclean-generic mostlyclean-libtool mostlyclean-local pdf \
+	pdf-am ps ps-am tags tags-am uninstall uninstall-am
+
+.PRECIOUS: Makefile
+
+
+# GNU Make needs to see an explicit $(MAKE) variable in the command it
+# runs to enable its job server during parallel builds.  Hence the
+# comments below.
+all-multi:
+	$(MULTIDO) $(AM_MAKEFLAGS) DO=all multi-do # $(MAKE)
+install-multi:
+	$(MULTIDO) $(AM_MAKEFLAGS) DO=install multi-do # $(MAKE)
+mostlyclean-multi:
+	$(MULTICLEAN) $(AM_MAKEFLAGS) DO=mostlyclean multi-clean # $(MAKE)
+clean-multi:
+	$(MULTICLEAN) $(AM_MAKEFLAGS) DO=clean multi-clean # $(MAKE)
+distclean-multi:
+	$(MULTICLEAN) $(AM_MAKEFLAGS) DO=distclean multi-clean # $(MAKE)
+maintainer-clean-multi:
+	$(MULTICLEAN) $(AM_MAKEFLAGS) DO=maintainer-clean multi-clean # $(MAKE)
+
+.MAKE .PHONY: all-multi clean-multi distclean-multi install-am \
+	      install-multi maintainer-clean-multi mostlyclean-multi
+
+install-exec-local: install-multi
+
+all-local: all-multi
+mostlyclean-local: mostlyclean-multi
+clean-local: clean-multi
+distclean-local: distclean-multi
+maintainer-clean-local: maintainer-clean-multi
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgm2/aclocal.m4 b/libgm2/aclocal.m4
new file mode 100644
index 00000000000..c352303012d
--- /dev/null
+++ b/libgm2/aclocal.m4
@@ -0,0 +1,1200 @@
+# generated automatically by aclocal 1.15.1 -*- Autoconf -*-
+
+# Copyright (C) 1996-2017 Free Software Foundation, Inc.
+
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])])
+m4_ifndef([AC_AUTOCONF_VERSION],
+  [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
+m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.69],,
+[m4_warning([this file was generated for autoconf 2.69.
+You have another version of autoconf.  It may work, but is not guaranteed to.
+If you have problems, you may need to regenerate the build system entirely.
+To do so, use the procedure documented by the package, typically 'autoreconf'.])])
+
+# Copyright (C) 2002-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_AUTOMAKE_VERSION(VERSION)
+# ----------------------------
+# Automake X.Y traces this macro to ensure aclocal.m4 has been
+# generated from the m4 files accompanying Automake X.Y.
+# (This private macro should not be called outside this file.)
+AC_DEFUN([AM_AUTOMAKE_VERSION],
+[am__api_version='1.15'
+dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to
+dnl require some minimum version.  Point them to the right macro.
+m4_if([$1], [1.15.1], [],
+      [AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl
+])
+
+# _AM_AUTOCONF_VERSION(VERSION)
+# -----------------------------
+# aclocal traces this macro to find the Autoconf version.
+# This is a private macro too.  Using m4_define simplifies
+# the logic in aclocal, which can simply ignore this definition.
+m4_define([_AM_AUTOCONF_VERSION], [])
+
+# AM_SET_CURRENT_AUTOMAKE_VERSION
+# -------------------------------
+# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced.
+# This function is AC_REQUIREd by AM_INIT_AUTOMAKE.
+AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
+[AM_AUTOMAKE_VERSION([1.15.1])dnl
+m4_ifndef([AC_AUTOCONF_VERSION],
+  [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
+_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))])
+
+# Figure out how to run the assembler.                      -*- Autoconf -*-
+
+# Copyright (C) 2001-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_PROG_AS
+# ----------
+AC_DEFUN([AM_PROG_AS],
+[# By default we simply use the C compiler to build assembly code.
+AC_REQUIRE([AC_PROG_CC])
+test "${CCAS+set}" = set || CCAS=$CC
+test "${CCASFLAGS+set}" = set || CCASFLAGS=$CFLAGS
+AC_ARG_VAR([CCAS],      [assembler compiler command (defaults to CC)])
+AC_ARG_VAR([CCASFLAGS], [assembler compiler flags (defaults to CFLAGS)])
+_AM_IF_OPTION([no-dependencies],, [_AM_DEPENDENCIES([CCAS])])dnl
+])
+
+# AM_AUX_DIR_EXPAND                                         -*- Autoconf -*-
+
+# Copyright (C) 2001-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets
+# $ac_aux_dir to '$srcdir/foo'.  In other projects, it is set to
+# '$srcdir', '$srcdir/..', or '$srcdir/../..'.
+#
+# Of course, Automake must honor this variable whenever it calls a
+# tool from the auxiliary directory.  The problem is that $srcdir (and
+# therefore $ac_aux_dir as well) can be either absolute or relative,
+# depending on how configure is run.  This is pretty annoying, since
+# it makes $ac_aux_dir quite unusable in subdirectories: in the top
+# source directory, any form will work fine, but in subdirectories a
+# relative path needs to be adjusted first.
+#
+# $ac_aux_dir/missing
+#    fails when called from a subdirectory if $ac_aux_dir is relative
+# $top_srcdir/$ac_aux_dir/missing
+#    fails if $ac_aux_dir is absolute,
+#    fails when called from a subdirectory in a VPATH build with
+#          a relative $ac_aux_dir
+#
+# The reason of the latter failure is that $top_srcdir and $ac_aux_dir
+# are both prefixed by $srcdir.  In an in-source build this is usually
+# harmless because $srcdir is '.', but things will broke when you
+# start a VPATH build or use an absolute $srcdir.
+#
+# So we could use something similar to $top_srcdir/$ac_aux_dir/missing,
+# iff we strip the leading $srcdir from $ac_aux_dir.  That would be:
+#   am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"`
+# and then we would define $MISSING as
+#   MISSING="\${SHELL} $am_aux_dir/missing"
+# This will work as long as MISSING is not called from configure, because
+# unfortunately $(top_srcdir) has no meaning in configure.
+# However there are other variables, like CC, which are often used in
+# configure, and could therefore not use this "fixed" $ac_aux_dir.
+#
+# Another solution, used here, is to always expand $ac_aux_dir to an
+# absolute PATH.  The drawback is that using absolute paths prevent a
+# configured tree to be moved without reconfiguration.
+
+AC_DEFUN([AM_AUX_DIR_EXPAND],
+[AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT])dnl
+# Expand $ac_aux_dir to an absolute path.
+am_aux_dir=`cd "$ac_aux_dir" && pwd`
+])
+
+# AM_CONDITIONAL                                            -*- Autoconf -*-
+
+# Copyright (C) 1997-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_CONDITIONAL(NAME, SHELL-CONDITION)
+# -------------------------------------
+# Define a conditional.
+AC_DEFUN([AM_CONDITIONAL],
+[AC_PREREQ([2.52])dnl
+ m4_if([$1], [TRUE],  [AC_FATAL([$0: invalid condition: $1])],
+       [$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl
+AC_SUBST([$1_TRUE])dnl
+AC_SUBST([$1_FALSE])dnl
+_AM_SUBST_NOTMAKE([$1_TRUE])dnl
+_AM_SUBST_NOTMAKE([$1_FALSE])dnl
+m4_define([_AM_COND_VALUE_$1], [$2])dnl
+if $2; then
+  $1_TRUE=
+  $1_FALSE='#'
+else
+  $1_TRUE='#'
+  $1_FALSE=
+fi
+AC_CONFIG_COMMANDS_PRE(
+[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then
+  AC_MSG_ERROR([[conditional "$1" was never defined.
+Usually this means the macro was only invoked conditionally.]])
+fi])])
+
+# Copyright (C) 1999-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+
+# There are a few dirty hacks below to avoid letting 'AC_PROG_CC' be
+# written in clear, in which case automake, when reading aclocal.m4,
+# will think it sees a *use*, and therefore will trigger all it's
+# C support machinery.  Also note that it means that autoscan, seeing
+# CC etc. in the Makefile, will ask for an AC_PROG_CC use...
+
+
+# _AM_DEPENDENCIES(NAME)
+# ----------------------
+# See how the compiler implements dependency checking.
+# NAME is "CC", "CXX", "OBJC", "OBJCXX", "UPC", or "GJC".
+# We try a few techniques and use that to set a single cache variable.
+#
+# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was
+# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular
+# dependency, and given that the user is not expected to run this macro,
+# just rely on AC_PROG_CC.
+AC_DEFUN([_AM_DEPENDENCIES],
+[AC_REQUIRE([AM_SET_DEPDIR])dnl
+AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl
+AC_REQUIRE([AM_MAKE_INCLUDE])dnl
+AC_REQUIRE([AM_DEP_TRACK])dnl
+
+m4_if([$1], [CC],   [depcc="$CC"   am_compiler_list=],
+      [$1], [CXX],  [depcc="$CXX"  am_compiler_list=],
+      [$1], [OBJC], [depcc="$OBJC" am_compiler_list='gcc3 gcc'],
+      [$1], [OBJCXX], [depcc="$OBJCXX" am_compiler_list='gcc3 gcc'],
+      [$1], [UPC],  [depcc="$UPC"  am_compiler_list=],
+      [$1], [GCJ],  [depcc="$GCJ"  am_compiler_list='gcc3 gcc'],
+                    [depcc="$$1"   am_compiler_list=])
+
+AC_CACHE_CHECK([dependency style of $depcc],
+               [am_cv_$1_dependencies_compiler_type],
+[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
+  # We make a subdir and do the tests there.  Otherwise we can end up
+  # making bogus files that we don't know about and never remove.  For
+  # instance it was reported that on HP-UX the gcc test will end up
+  # making a dummy file named 'D' -- because '-MD' means "put the output
+  # in D".
+  rm -rf conftest.dir
+  mkdir conftest.dir
+  # Copy depcomp to subdir because otherwise we won't find it if we're
+  # using a relative directory.
+  cp "$am_depcomp" conftest.dir
+  cd conftest.dir
+  # We will build objects and dependencies in a subdirectory because
+  # it helps to detect inapplicable dependency modes.  For instance
+  # both Tru64's cc and ICC support -MD to output dependencies as a
+  # side effect of compilation, but ICC will put the dependencies in
+  # the current directory while Tru64 will put them in the object
+  # directory.
+  mkdir sub
+
+  am_cv_$1_dependencies_compiler_type=none
+  if test "$am_compiler_list" = ""; then
+     am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp`
+  fi
+  am__universal=false
+  m4_case([$1], [CC],
+    [case " $depcc " in #(
+     *\ -arch\ *\ -arch\ *) am__universal=true ;;
+     esac],
+    [CXX],
+    [case " $depcc " in #(
+     *\ -arch\ *\ -arch\ *) am__universal=true ;;
+     esac])
+
+  for depmode in $am_compiler_list; do
+    # Setup a source with many dependencies, because some compilers
+    # like to wrap large dependency lists on column 80 (with \), and
+    # we should not choose a depcomp mode which is confused by this.
+    #
+    # We need to recreate these files for each test, as the compiler may
+    # overwrite some of them when testing with obscure command lines.
+    # This happens at least with the AIX C compiler.
+    : > sub/conftest.c
+    for i in 1 2 3 4 5 6; do
+      echo '#include "conftst'$i'.h"' >> sub/conftest.c
+      # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with
+      # Solaris 10 /bin/sh.
+      echo '/* dummy */' > sub/conftst$i.h
+    done
+    echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf
+
+    # We check with '-c' and '-o' for the sake of the "dashmstdout"
+    # mode.  It turns out that the SunPro C++ compiler does not properly
+    # handle '-M -o', and we need to detect this.  Also, some Intel
+    # versions had trouble with output in subdirs.
+    am__obj=sub/conftest.${OBJEXT-o}
+    am__minus_obj="-o $am__obj"
+    case $depmode in
+    gcc)
+      # This depmode causes a compiler race in universal mode.
+      test "$am__universal" = false || continue
+      ;;
+    nosideeffect)
+      # After this tag, mechanisms are not by side-effect, so they'll
+      # only be used when explicitly requested.
+      if test "x$enable_dependency_tracking" = xyes; then
+	continue
+      else
+	break
+      fi
+      ;;
+    msvc7 | msvc7msys | msvisualcpp | msvcmsys)
+      # This compiler won't grok '-c -o', but also, the minuso test has
+      # not run yet.  These depmodes are late enough in the game, and
+      # so weak that their functioning should not be impacted.
+      am__obj=conftest.${OBJEXT-o}
+      am__minus_obj=
+      ;;
+    none) break ;;
+    esac
+    if depmode=$depmode \
+       source=sub/conftest.c object=$am__obj \
+       depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \
+       $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \
+         >/dev/null 2>conftest.err &&
+       grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 &&
+       grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 &&
+       grep $am__obj sub/conftest.Po > /dev/null 2>&1 &&
+       ${MAKE-make} -s -f confmf > /dev/null 2>&1; then
+      # icc doesn't choke on unknown options, it will just issue warnings
+      # or remarks (even with -Werror).  So we grep stderr for any message
+      # that says an option was ignored or not supported.
+      # When given -MP, icc 7.0 and 7.1 complain thusly:
+      #   icc: Command line warning: ignoring option '-M'; no argument required
+      # The diagnosis changed in icc 8.0:
+      #   icc: Command line remark: option '-MP' not supported
+      if (grep 'ignoring option' conftest.err ||
+          grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else
+        am_cv_$1_dependencies_compiler_type=$depmode
+        break
+      fi
+    fi
+  done
+
+  cd ..
+  rm -rf conftest.dir
+else
+  am_cv_$1_dependencies_compiler_type=none
+fi
+])
+AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type])
+AM_CONDITIONAL([am__fastdep$1], [
+  test "x$enable_dependency_tracking" != xno \
+  && test "$am_cv_$1_dependencies_compiler_type" = gcc3])
+])
+
+
+# AM_SET_DEPDIR
+# -------------
+# Choose a directory name for dependency files.
+# This macro is AC_REQUIREd in _AM_DEPENDENCIES.
+AC_DEFUN([AM_SET_DEPDIR],
+[AC_REQUIRE([AM_SET_LEADING_DOT])dnl
+AC_SUBST([DEPDIR], ["${am__leading_dot}deps"])dnl
+])
+
+
+# AM_DEP_TRACK
+# ------------
+AC_DEFUN([AM_DEP_TRACK],
+[AC_ARG_ENABLE([dependency-tracking], [dnl
+AS_HELP_STRING(
+  [--enable-dependency-tracking],
+  [do not reject slow dependency extractors])
+AS_HELP_STRING(
+  [--disable-dependency-tracking],
+  [speeds up one-time build])])
+if test "x$enable_dependency_tracking" != xno; then
+  am_depcomp="$ac_aux_dir/depcomp"
+  AMDEPBACKSLASH='\'
+  am__nodep='_no'
+fi
+AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno])
+AC_SUBST([AMDEPBACKSLASH])dnl
+_AM_SUBST_NOTMAKE([AMDEPBACKSLASH])dnl
+AC_SUBST([am__nodep])dnl
+_AM_SUBST_NOTMAKE([am__nodep])dnl
+])
+
+# Generate code to set up dependency tracking.              -*- Autoconf -*-
+
+# Copyright (C) 1999-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+
+# _AM_OUTPUT_DEPENDENCY_COMMANDS
+# ------------------------------
+AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS],
+[{
+  # Older Autoconf quotes --file arguments for eval, but not when files
+  # are listed without --file.  Let's play safe and only enable the eval
+  # if we detect the quoting.
+  case $CONFIG_FILES in
+  *\'*) eval set x "$CONFIG_FILES" ;;
+  *)   set x $CONFIG_FILES ;;
+  esac
+  shift
+  for mf
+  do
+    # Strip MF so we end up with the name of the file.
+    mf=`echo "$mf" | sed -e 's/:.*$//'`
+    # Check whether this is an Automake generated Makefile or not.
+    # We used to match only the files named 'Makefile.in', but
+    # some people rename them; so instead we look at the file content.
+    # Grep'ing the first line is not enough: some people post-process
+    # each Makefile.in and add a new line on top of each file to say so.
+    # Grep'ing the whole file is not good either: AIX grep has a line
+    # limit of 2048, but all sed's we know have understand at least 4000.
+    if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then
+      dirpart=`AS_DIRNAME("$mf")`
+    else
+      continue
+    fi
+    # Extract the definition of DEPDIR, am__include, and am__quote
+    # from the Makefile without running 'make'.
+    DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"`
+    test -z "$DEPDIR" && continue
+    am__include=`sed -n 's/^am__include = //p' < "$mf"`
+    test -z "$am__include" && continue
+    am__quote=`sed -n 's/^am__quote = //p' < "$mf"`
+    # Find all dependency output files, they are included files with
+    # $(DEPDIR) in their names.  We invoke sed twice because it is the
+    # simplest approach to changing $(DEPDIR) to its actual value in the
+    # expansion.
+    for file in `sed -n "
+      s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \
+	 sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do
+      # Make sure the directory exists.
+      test -f "$dirpart/$file" && continue
+      fdir=`AS_DIRNAME(["$file"])`
+      AS_MKDIR_P([$dirpart/$fdir])
+      # echo "creating $dirpart/$file"
+      echo '# dummy' > "$dirpart/$file"
+    done
+  done
+}
+])# _AM_OUTPUT_DEPENDENCY_COMMANDS
+
+
+# AM_OUTPUT_DEPENDENCY_COMMANDS
+# -----------------------------
+# This macro should only be invoked once -- use via AC_REQUIRE.
+#
+# This code is only required when automatic dependency tracking
+# is enabled.  FIXME.  This creates each '.P' file that we will
+# need in order to bootstrap the dependency handling code.
+AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS],
+[AC_CONFIG_COMMANDS([depfiles],
+     [test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS],
+     [AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"])
+])
+
+# Do all the work for Automake.                             -*- Autoconf -*-
+
+# Copyright (C) 1996-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This macro actually does too much.  Some checks are only needed if
+# your package does certain things.  But this isn't really a big deal.
+
+dnl Redefine AC_PROG_CC to automatically invoke _AM_PROG_CC_C_O.
+m4_define([AC_PROG_CC],
+m4_defn([AC_PROG_CC])
+[_AM_PROG_CC_C_O
+])
+
+# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE])
+# AM_INIT_AUTOMAKE([OPTIONS])
+# -----------------------------------------------
+# The call with PACKAGE and VERSION arguments is the old style
+# call (pre autoconf-2.50), which is being phased out.  PACKAGE
+# and VERSION should now be passed to AC_INIT and removed from
+# the call to AM_INIT_AUTOMAKE.
+# We support both call styles for the transition.  After
+# the next Automake release, Autoconf can make the AC_INIT
+# arguments mandatory, and then we can depend on a new Autoconf
+# release and drop the old call support.
+AC_DEFUN([AM_INIT_AUTOMAKE],
+[AC_PREREQ([2.65])dnl
+dnl Autoconf wants to disallow AM_ names.  We explicitly allow
+dnl the ones we care about.
+m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl
+AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl
+AC_REQUIRE([AC_PROG_INSTALL])dnl
+if test "`cd $srcdir && pwd`" != "`pwd`"; then
+  # Use -I$(srcdir) only when $(srcdir) != ., so that make's output
+  # is not polluted with repeated "-I."
+  AC_SUBST([am__isrc], [' -I$(srcdir)'])_AM_SUBST_NOTMAKE([am__isrc])dnl
+  # test to see if srcdir already configured
+  if test -f $srcdir/config.status; then
+    AC_MSG_ERROR([source directory already configured; run "make distclean" there first])
+  fi
+fi
+
+# test whether we have cygpath
+if test -z "$CYGPATH_W"; then
+  if (cygpath --version) >/dev/null 2>/dev/null; then
+    CYGPATH_W='cygpath -w'
+  else
+    CYGPATH_W=echo
+  fi
+fi
+AC_SUBST([CYGPATH_W])
+
+# Define the identity of the package.
+dnl Distinguish between old-style and new-style calls.
+m4_ifval([$2],
+[AC_DIAGNOSE([obsolete],
+             [$0: two- and three-arguments forms are deprecated.])
+m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl
+ AC_SUBST([PACKAGE], [$1])dnl
+ AC_SUBST([VERSION], [$2])],
+[_AM_SET_OPTIONS([$1])dnl
+dnl Diagnose old-style AC_INIT with new-style AM_AUTOMAKE_INIT.
+m4_if(
+  m4_ifdef([AC_PACKAGE_NAME], [ok]):m4_ifdef([AC_PACKAGE_VERSION], [ok]),
+  [ok:ok],,
+  [m4_fatal([AC_INIT should be called with package and version arguments])])dnl
+ AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl
+ AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl
+
+_AM_IF_OPTION([no-define],,
+[AC_DEFINE_UNQUOTED([PACKAGE], ["$PACKAGE"], [Name of package])
+ AC_DEFINE_UNQUOTED([VERSION], ["$VERSION"], [Version number of package])])dnl
+
+# Some tools Automake needs.
+AC_REQUIRE([AM_SANITY_CHECK])dnl
+AC_REQUIRE([AC_ARG_PROGRAM])dnl
+AM_MISSING_PROG([ACLOCAL], [aclocal-${am__api_version}])
+AM_MISSING_PROG([AUTOCONF], [autoconf])
+AM_MISSING_PROG([AUTOMAKE], [automake-${am__api_version}])
+AM_MISSING_PROG([AUTOHEADER], [autoheader])
+AM_MISSING_PROG([MAKEINFO], [makeinfo])
+AC_REQUIRE([AM_PROG_INSTALL_SH])dnl
+AC_REQUIRE([AM_PROG_INSTALL_STRIP])dnl
+AC_REQUIRE([AC_PROG_MKDIR_P])dnl
+# For better backward compatibility.  To be removed once Automake 1.9.x
+# dies out for good.  For more background, see:
+# <http://lists.gnu.org/archive/html/automake/2012-07/msg00001.html>
+# <http://lists.gnu.org/archive/html/automake/2012-07/msg00014.html>
+AC_SUBST([mkdir_p], ['$(MKDIR_P)'])
+# We need awk for the "check" target (and possibly the TAP driver).  The
+# system "awk" is bad on some platforms.
+AC_REQUIRE([AC_PROG_AWK])dnl
+AC_REQUIRE([AC_PROG_MAKE_SET])dnl
+AC_REQUIRE([AM_SET_LEADING_DOT])dnl
+_AM_IF_OPTION([tar-ustar], [_AM_PROG_TAR([ustar])],
+	      [_AM_IF_OPTION([tar-pax], [_AM_PROG_TAR([pax])],
+			     [_AM_PROG_TAR([v7])])])
+_AM_IF_OPTION([no-dependencies],,
+[AC_PROVIDE_IFELSE([AC_PROG_CC],
+		  [_AM_DEPENDENCIES([CC])],
+		  [m4_define([AC_PROG_CC],
+			     m4_defn([AC_PROG_CC])[_AM_DEPENDENCIES([CC])])])dnl
+AC_PROVIDE_IFELSE([AC_PROG_CXX],
+		  [_AM_DEPENDENCIES([CXX])],
+		  [m4_define([AC_PROG_CXX],
+			     m4_defn([AC_PROG_CXX])[_AM_DEPENDENCIES([CXX])])])dnl
+AC_PROVIDE_IFELSE([AC_PROG_OBJC],
+		  [_AM_DEPENDENCIES([OBJC])],
+		  [m4_define([AC_PROG_OBJC],
+			     m4_defn([AC_PROG_OBJC])[_AM_DEPENDENCIES([OBJC])])])dnl
+AC_PROVIDE_IFELSE([AC_PROG_OBJCXX],
+		  [_AM_DEPENDENCIES([OBJCXX])],
+		  [m4_define([AC_PROG_OBJCXX],
+			     m4_defn([AC_PROG_OBJCXX])[_AM_DEPENDENCIES([OBJCXX])])])dnl
+])
+AC_REQUIRE([AM_SILENT_RULES])dnl
+dnl The testsuite driver may need to know about EXEEXT, so add the
+dnl 'am__EXEEXT' conditional if _AM_COMPILER_EXEEXT was seen.  This
+dnl macro is hooked onto _AC_COMPILER_EXEEXT early, see below.
+AC_CONFIG_COMMANDS_PRE(dnl
+[m4_provide_if([_AM_COMPILER_EXEEXT],
+  [AM_CONDITIONAL([am__EXEEXT], [test -n "$EXEEXT"])])])dnl
+
+# POSIX will say in a future version that running "rm -f" with no argument
+# is OK; and we want to be able to make that assumption in our Makefile
+# recipes.  So use an aggressive probe to check that the usage we want is
+# actually supported "in the wild" to an acceptable degree.
+# See automake bug#10828.
+# To make any issue more visible, cause the running configure to be aborted
+# by default if the 'rm' program in use doesn't match our expectations; the
+# user can still override this though.
+if rm -f && rm -fr && rm -rf; then : OK; else
+  cat >&2 <<'END'
+Oops!
+
+Your 'rm' program seems unable to run without file operands specified
+on the command line, even when the '-f' option is present.  This is contrary
+to the behaviour of most rm programs out there, and not conforming with
+the upcoming POSIX standard: <http://austingroupbugs.net/view.php?id=542>
+
+Please tell bug-automake@gnu.org about your system, including the value
+of your $PATH and any error possibly output before this message.  This
+can help us improve future automake versions.
+
+END
+  if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then
+    echo 'Configuration will proceed anyway, since you have set the' >&2
+    echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2
+    echo >&2
+  else
+    cat >&2 <<'END'
+Aborting the configuration process, to ensure you take notice of the issue.
+
+You can download and install GNU coreutils to get an 'rm' implementation
+that behaves properly: <http://www.gnu.org/software/coreutils/>.
+
+If you want to complete the configuration process using your problematic
+'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM
+to "yes", and re-run configure.
+
+END
+    AC_MSG_ERROR([Your 'rm' program is bad, sorry.])
+  fi
+fi
+dnl The trailing newline in this macro's definition is deliberate, for
+dnl backward compatibility and to allow trailing 'dnl'-style comments
+dnl after the AM_INIT_AUTOMAKE invocation. See automake bug#16841.
+])
+
+dnl Hook into '_AC_COMPILER_EXEEXT' early to learn its expansion.  Do not
+dnl add the conditional right here, as _AC_COMPILER_EXEEXT may be further
+dnl mangled by Autoconf and run in a shell conditional statement.
+m4_define([_AC_COMPILER_EXEEXT],
+m4_defn([_AC_COMPILER_EXEEXT])[m4_provide([_AM_COMPILER_EXEEXT])])
+
+# When config.status generates a header, we must update the stamp-h file.
+# This file resides in the same directory as the config header
+# that is generated.  The stamp files are numbered to have different names.
+
+# Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the
+# loop where config.status creates the headers, so we can generate
+# our stamp files there.
+AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK],
+[# Compute $1's index in $config_headers.
+_am_arg=$1
+_am_stamp_count=1
+for _am_header in $config_headers :; do
+  case $_am_header in
+    $_am_arg | $_am_arg:* )
+      break ;;
+    * )
+      _am_stamp_count=`expr $_am_stamp_count + 1` ;;
+  esac
+done
+echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count])
+
+# Copyright (C) 2001-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_PROG_INSTALL_SH
+# ------------------
+# Define $install_sh.
+AC_DEFUN([AM_PROG_INSTALL_SH],
+[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
+if test x"${install_sh+set}" != xset; then
+  case $am_aux_dir in
+  *\ * | *\	*)
+    install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;;
+  *)
+    install_sh="\${SHELL} $am_aux_dir/install-sh"
+  esac
+fi
+AC_SUBST([install_sh])])
+
+# Add --enable-maintainer-mode option to configure.         -*- Autoconf -*-
+# From Jim Meyering
+
+# Copyright (C) 1996-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_MAINTAINER_MODE([DEFAULT-MODE])
+# ----------------------------------
+# Control maintainer-specific portions of Makefiles.
+# Default is to disable them, unless 'enable' is passed literally.
+# For symmetry, 'disable' may be passed as well.  Anyway, the user
+# can override the default with the --enable/--disable switch.
+AC_DEFUN([AM_MAINTAINER_MODE],
+[m4_case(m4_default([$1], [disable]),
+       [enable], [m4_define([am_maintainer_other], [disable])],
+       [disable], [m4_define([am_maintainer_other], [enable])],
+       [m4_define([am_maintainer_other], [enable])
+        m4_warn([syntax], [unexpected argument to AM@&t@_MAINTAINER_MODE: $1])])
+AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
+  dnl maintainer-mode's default is 'disable' unless 'enable' is passed
+  AC_ARG_ENABLE([maintainer-mode],
+    [AS_HELP_STRING([--]am_maintainer_other[-maintainer-mode],
+      am_maintainer_other[ make rules and dependencies not useful
+      (and sometimes confusing) to the casual installer])],
+    [USE_MAINTAINER_MODE=$enableval],
+    [USE_MAINTAINER_MODE=]m4_if(am_maintainer_other, [enable], [no], [yes]))
+  AC_MSG_RESULT([$USE_MAINTAINER_MODE])
+  AM_CONDITIONAL([MAINTAINER_MODE], [test $USE_MAINTAINER_MODE = yes])
+  MAINT=$MAINTAINER_MODE_TRUE
+  AC_SUBST([MAINT])dnl
+]
+)
+
+# Check to see how 'make' treats includes.	            -*- Autoconf -*-
+
+# Copyright (C) 2001-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_MAKE_INCLUDE()
+# -----------------
+# Check to see how make treats includes.
+AC_DEFUN([AM_MAKE_INCLUDE],
+[am_make=${MAKE-make}
+cat > confinc << 'END'
+am__doit:
+	@echo this is the am__doit target
+.PHONY: am__doit
+END
+# If we don't find an include directive, just comment out the code.
+AC_MSG_CHECKING([for style of include used by $am_make])
+am__include="#"
+am__quote=
+_am_result=none
+# First try GNU make style include.
+echo "include confinc" > confmf
+# Ignore all kinds of additional output from 'make'.
+case `$am_make -s -f confmf 2> /dev/null` in #(
+*the\ am__doit\ target*)
+  am__include=include
+  am__quote=
+  _am_result=GNU
+  ;;
+esac
+# Now try BSD make style include.
+if test "$am__include" = "#"; then
+   echo '.include "confinc"' > confmf
+   case `$am_make -s -f confmf 2> /dev/null` in #(
+   *the\ am__doit\ target*)
+     am__include=.include
+     am__quote="\""
+     _am_result=BSD
+     ;;
+   esac
+fi
+AC_SUBST([am__include])
+AC_SUBST([am__quote])
+AC_MSG_RESULT([$_am_result])
+rm -f confinc confmf
+])
+
+# Fake the existence of programs that GNU maintainers use.  -*- Autoconf -*-
+
+# Copyright (C) 1997-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_MISSING_PROG(NAME, PROGRAM)
+# ------------------------------
+AC_DEFUN([AM_MISSING_PROG],
+[AC_REQUIRE([AM_MISSING_HAS_RUN])
+$1=${$1-"${am_missing_run}$2"}
+AC_SUBST($1)])
+
+# AM_MISSING_HAS_RUN
+# ------------------
+# Define MISSING if not defined so far and test if it is modern enough.
+# If it is, set am_missing_run to use it, otherwise, to nothing.
+AC_DEFUN([AM_MISSING_HAS_RUN],
+[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
+AC_REQUIRE_AUX_FILE([missing])dnl
+if test x"${MISSING+set}" != xset; then
+  case $am_aux_dir in
+  *\ * | *\	*)
+    MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;;
+  *)
+    MISSING="\${SHELL} $am_aux_dir/missing" ;;
+  esac
+fi
+# Use eval to expand $SHELL
+if eval "$MISSING --is-lightweight"; then
+  am_missing_run="$MISSING "
+else
+  am_missing_run=
+  AC_MSG_WARN(['missing' script is too old or missing])
+fi
+])
+
+# Helper functions for option handling.                     -*- Autoconf -*-
+
+# Copyright (C) 2001-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# _AM_MANGLE_OPTION(NAME)
+# -----------------------
+AC_DEFUN([_AM_MANGLE_OPTION],
+[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])])
+
+# _AM_SET_OPTION(NAME)
+# --------------------
+# Set option NAME.  Presently that only means defining a flag for this option.
+AC_DEFUN([_AM_SET_OPTION],
+[m4_define(_AM_MANGLE_OPTION([$1]), [1])])
+
+# _AM_SET_OPTIONS(OPTIONS)
+# ------------------------
+# OPTIONS is a space-separated list of Automake options.
+AC_DEFUN([_AM_SET_OPTIONS],
+[m4_foreach_w([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])])
+
+# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET])
+# -------------------------------------------
+# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise.
+AC_DEFUN([_AM_IF_OPTION],
+[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])])
+
+# Copyright (C) 1999-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# _AM_PROG_CC_C_O
+# ---------------
+# Like AC_PROG_CC_C_O, but changed for automake.  We rewrite AC_PROG_CC
+# to automatically call this.
+AC_DEFUN([_AM_PROG_CC_C_O],
+[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
+AC_REQUIRE_AUX_FILE([compile])dnl
+AC_LANG_PUSH([C])dnl
+AC_CACHE_CHECK(
+  [whether $CC understands -c and -o together],
+  [am_cv_prog_cc_c_o],
+  [AC_LANG_CONFTEST([AC_LANG_PROGRAM([])])
+  # Make sure it works both with $CC and with simple cc.
+  # Following AC_PROG_CC_C_O, we do the test twice because some
+  # compilers refuse to overwrite an existing .o file with -o,
+  # though they will create one.
+  am_cv_prog_cc_c_o=yes
+  for am_i in 1 2; do
+    if AM_RUN_LOG([$CC -c conftest.$ac_ext -o conftest2.$ac_objext]) \
+         && test -f conftest2.$ac_objext; then
+      : OK
+    else
+      am_cv_prog_cc_c_o=no
+      break
+    fi
+  done
+  rm -f core conftest*
+  unset am_i])
+if test "$am_cv_prog_cc_c_o" != yes; then
+   # Losing compiler, so override with the script.
+   # FIXME: It is wrong to rewrite CC.
+   # But if we don't then we get into trouble of one sort or another.
+   # A longer-term fix would be to have automake use am__CC in this case,
+   # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)"
+   CC="$am_aux_dir/compile $CC"
+fi
+AC_LANG_POP([C])])
+
+# For backward compatibility.
+AC_DEFUN_ONCE([AM_PROG_CC_C_O], [AC_REQUIRE([AC_PROG_CC])])
+
+# Copyright (C) 2001-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_RUN_LOG(COMMAND)
+# -------------------
+# Run COMMAND, save the exit status in ac_status, and log it.
+# (This has been adapted from Autoconf's _AC_RUN_LOG macro.)
+AC_DEFUN([AM_RUN_LOG],
+[{ echo "$as_me:$LINENO: $1" >&AS_MESSAGE_LOG_FD
+   ($1) >&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD
+   ac_status=$?
+   echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
+   (exit $ac_status); }])
+
+# Check to make sure that the build environment is sane.    -*- Autoconf -*-
+
+# Copyright (C) 1996-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_SANITY_CHECK
+# ---------------
+AC_DEFUN([AM_SANITY_CHECK],
+[AC_MSG_CHECKING([whether build environment is sane])
+# Reject unsafe characters in $srcdir or the absolute working directory
+# name.  Accept space and tab only in the latter.
+am_lf='
+'
+case `pwd` in
+  *[[\\\"\#\$\&\'\`$am_lf]]*)
+    AC_MSG_ERROR([unsafe absolute working directory name]);;
+esac
+case $srcdir in
+  *[[\\\"\#\$\&\'\`$am_lf\ \	]]*)
+    AC_MSG_ERROR([unsafe srcdir value: '$srcdir']);;
+esac
+
+# Do 'set' in a subshell so we don't clobber the current shell's
+# arguments.  Must try -L first in case configure is actually a
+# symlink; some systems play weird games with the mod time of symlinks
+# (eg FreeBSD returns the mod time of the symlink's containing
+# directory).
+if (
+   am_has_slept=no
+   for am_try in 1 2; do
+     echo "timestamp, slept: $am_has_slept" > conftest.file
+     set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null`
+     if test "$[*]" = "X"; then
+	# -L didn't work.
+	set X `ls -t "$srcdir/configure" conftest.file`
+     fi
+     if test "$[*]" != "X $srcdir/configure conftest.file" \
+	&& test "$[*]" != "X conftest.file $srcdir/configure"; then
+
+	# If neither matched, then we have a broken ls.  This can happen
+	# if, for instance, CONFIG_SHELL is bash and it inherits a
+	# broken ls alias from the environment.  This has actually
+	# happened.  Such a system could not be considered "sane".
+	AC_MSG_ERROR([ls -t appears to fail.  Make sure there is not a broken
+  alias in your environment])
+     fi
+     if test "$[2]" = conftest.file || test $am_try -eq 2; then
+       break
+     fi
+     # Just in case.
+     sleep 1
+     am_has_slept=yes
+   done
+   test "$[2]" = conftest.file
+   )
+then
+   # Ok.
+   :
+else
+   AC_MSG_ERROR([newly created file is older than distributed files!
+Check your system clock])
+fi
+AC_MSG_RESULT([yes])
+# If we didn't sleep, we still need to ensure time stamps of config.status and
+# generated files are strictly newer.
+am_sleep_pid=
+if grep 'slept: no' conftest.file >/dev/null 2>&1; then
+  ( sleep 1 ) &
+  am_sleep_pid=$!
+fi
+AC_CONFIG_COMMANDS_PRE(
+  [AC_MSG_CHECKING([that generated files are newer than configure])
+   if test -n "$am_sleep_pid"; then
+     # Hide warnings about reused PIDs.
+     wait $am_sleep_pid 2>/dev/null
+   fi
+   AC_MSG_RESULT([done])])
+rm -f conftest.file
+])
+
+# Copyright (C) 2009-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_SILENT_RULES([DEFAULT])
+# --------------------------
+# Enable less verbose build rules; with the default set to DEFAULT
+# ("yes" being less verbose, "no" or empty being verbose).
+AC_DEFUN([AM_SILENT_RULES],
+[AC_ARG_ENABLE([silent-rules], [dnl
+AS_HELP_STRING(
+  [--enable-silent-rules],
+  [less verbose build output (undo: "make V=1")])
+AS_HELP_STRING(
+  [--disable-silent-rules],
+  [verbose build output (undo: "make V=0")])dnl
+])
+case $enable_silent_rules in @%:@ (((
+  yes) AM_DEFAULT_VERBOSITY=0;;
+   no) AM_DEFAULT_VERBOSITY=1;;
+    *) AM_DEFAULT_VERBOSITY=m4_if([$1], [yes], [0], [1]);;
+esac
+dnl
+dnl A few 'make' implementations (e.g., NonStop OS and NextStep)
+dnl do not support nested variable expansions.
+dnl See automake bug#9928 and bug#10237.
+am_make=${MAKE-make}
+AC_CACHE_CHECK([whether $am_make supports nested variables],
+   [am_cv_make_support_nested_variables],
+   [if AS_ECHO([['TRUE=$(BAR$(V))
+BAR0=false
+BAR1=true
+V=1
+am__doit:
+	@$(TRUE)
+.PHONY: am__doit']]) | $am_make -f - >/dev/null 2>&1; then
+  am_cv_make_support_nested_variables=yes
+else
+  am_cv_make_support_nested_variables=no
+fi])
+if test $am_cv_make_support_nested_variables = yes; then
+  dnl Using '$V' instead of '$(V)' breaks IRIX make.
+  AM_V='$(V)'
+  AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)'
+else
+  AM_V=$AM_DEFAULT_VERBOSITY
+  AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY
+fi
+AC_SUBST([AM_V])dnl
+AM_SUBST_NOTMAKE([AM_V])dnl
+AC_SUBST([AM_DEFAULT_V])dnl
+AM_SUBST_NOTMAKE([AM_DEFAULT_V])dnl
+AC_SUBST([AM_DEFAULT_VERBOSITY])dnl
+AM_BACKSLASH='\'
+AC_SUBST([AM_BACKSLASH])dnl
+_AM_SUBST_NOTMAKE([AM_BACKSLASH])dnl
+])
+
+# Copyright (C) 2001-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# AM_PROG_INSTALL_STRIP
+# ---------------------
+# One issue with vendor 'install' (even GNU) is that you can't
+# specify the program used to strip binaries.  This is especially
+# annoying in cross-compiling environments, where the build's strip
+# is unlikely to handle the host's binaries.
+# Fortunately install-sh will honor a STRIPPROG variable, so we
+# always use install-sh in "make install-strip", and initialize
+# STRIPPROG with the value of the STRIP variable (set by the user).
+AC_DEFUN([AM_PROG_INSTALL_STRIP],
+[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl
+# Installed binaries are usually stripped using 'strip' when the user
+# run "make install-strip".  However 'strip' might not be the right
+# tool to use in cross-compilation environments, therefore Automake
+# will honor the 'STRIP' environment variable to overrule this program.
+dnl Don't test for $cross_compiling = yes, because it might be 'maybe'.
+if test "$cross_compiling" != no; then
+  AC_CHECK_TOOL([STRIP], [strip], :)
+fi
+INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s"
+AC_SUBST([INSTALL_STRIP_PROGRAM])])
+
+# Copyright (C) 2006-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# _AM_SUBST_NOTMAKE(VARIABLE)
+# ---------------------------
+# Prevent Automake from outputting VARIABLE = @VARIABLE@ in Makefile.in.
+# This macro is traced by Automake.
+AC_DEFUN([_AM_SUBST_NOTMAKE])
+
+# AM_SUBST_NOTMAKE(VARIABLE)
+# --------------------------
+# Public sister of _AM_SUBST_NOTMAKE.
+AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)])
+
+# Check how to create a tarball.                            -*- Autoconf -*-
+
+# Copyright (C) 2004-2017 Free Software Foundation, Inc.
+#
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# _AM_PROG_TAR(FORMAT)
+# --------------------
+# Check how to create a tarball in format FORMAT.
+# FORMAT should be one of 'v7', 'ustar', or 'pax'.
+#
+# Substitute a variable $(am__tar) that is a command
+# writing to stdout a FORMAT-tarball containing the directory
+# $tardir.
+#     tardir=directory && $(am__tar) > result.tar
+#
+# Substitute a variable $(am__untar) that extract such
+# a tarball read from stdin.
+#     $(am__untar) < result.tar
+#
+AC_DEFUN([_AM_PROG_TAR],
+[# Always define AMTAR for backward compatibility.  Yes, it's still used
+# in the wild :-(  We should find a proper way to deprecate it ...
+AC_SUBST([AMTAR], ['$${TAR-tar}'])
+
+# We'll loop over all known methods to create a tar archive until one works.
+_am_tools='gnutar m4_if([$1], [ustar], [plaintar]) pax cpio none'
+
+m4_if([$1], [v7],
+  [am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'],
+
+  [m4_case([$1],
+    [ustar],
+     [# The POSIX 1988 'ustar' format is defined with fixed-size fields.
+      # There is notably a 21 bits limit for the UID and the GID.  In fact,
+      # the 'pax' utility can hang on bigger UID/GID (see automake bug#8343
+      # and bug#13588).
+      am_max_uid=2097151 # 2^21 - 1
+      am_max_gid=$am_max_uid
+      # The $UID and $GID variables are not portable, so we need to resort
+      # to the POSIX-mandated id(1) utility.  Errors in the 'id' calls
+      # below are definitely unexpected, so allow the users to see them
+      # (that is, avoid stderr redirection).
+      am_uid=`id -u || echo unknown`
+      am_gid=`id -g || echo unknown`
+      AC_MSG_CHECKING([whether UID '$am_uid' is supported by ustar format])
+      if test $am_uid -le $am_max_uid; then
+         AC_MSG_RESULT([yes])
+      else
+         AC_MSG_RESULT([no])
+         _am_tools=none
+      fi
+      AC_MSG_CHECKING([whether GID '$am_gid' is supported by ustar format])
+      if test $am_gid -le $am_max_gid; then
+         AC_MSG_RESULT([yes])
+      else
+        AC_MSG_RESULT([no])
+        _am_tools=none
+      fi],
+
+  [pax],
+    [],
+
+  [m4_fatal([Unknown tar format])])
+
+  AC_MSG_CHECKING([how to create a $1 tar archive])
+
+  # Go ahead even if we have the value already cached.  We do so because we
+  # need to set the values for the 'am__tar' and 'am__untar' variables.
+  _am_tools=${am_cv_prog_tar_$1-$_am_tools}
+
+  for _am_tool in $_am_tools; do
+    case $_am_tool in
+    gnutar)
+      for _am_tar in tar gnutar gtar; do
+        AM_RUN_LOG([$_am_tar --version]) && break
+      done
+      am__tar="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$$tardir"'
+      am__tar_="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$tardir"'
+      am__untar="$_am_tar -xf -"
+      ;;
+    plaintar)
+      # Must skip GNU tar: if it does not support --format= it doesn't create
+      # ustar tarball either.
+      (tar --version) >/dev/null 2>&1 && continue
+      am__tar='tar chf - "$$tardir"'
+      am__tar_='tar chf - "$tardir"'
+      am__untar='tar xf -'
+      ;;
+    pax)
+      am__tar='pax -L -x $1 -w "$$tardir"'
+      am__tar_='pax -L -x $1 -w "$tardir"'
+      am__untar='pax -r'
+      ;;
+    cpio)
+      am__tar='find "$$tardir" -print | cpio -o -H $1 -L'
+      am__tar_='find "$tardir" -print | cpio -o -H $1 -L'
+      am__untar='cpio -i -H $1 -d'
+      ;;
+    none)
+      am__tar=false
+      am__tar_=false
+      am__untar=false
+      ;;
+    esac
+
+    # If the value was cached, stop now.  We just wanted to have am__tar
+    # and am__untar set.
+    test -n "${am_cv_prog_tar_$1}" && break
+
+    # tar/untar a dummy directory, and stop if the command works.
+    rm -rf conftest.dir
+    mkdir conftest.dir
+    echo GrepMe > conftest.dir/file
+    AM_RUN_LOG([tardir=conftest.dir && eval $am__tar_ >conftest.tar])
+    rm -rf conftest.dir
+    if test -s conftest.tar; then
+      AM_RUN_LOG([$am__untar <conftest.tar])
+      AM_RUN_LOG([cat conftest.dir/file])
+      grep GrepMe conftest.dir/file >/dev/null 2>&1 && break
+    fi
+  done
+  rm -rf conftest.dir
+
+  AC_CACHE_VAL([am_cv_prog_tar_$1], [am_cv_prog_tar_$1=$_am_tool])
+  AC_MSG_RESULT([$am_cv_prog_tar_$1])])
+
+AC_SUBST([am__tar])
+AC_SUBST([am__untar])
+]) # _AM_PROG_TAR
+
+m4_include([../libtool.m4])
+m4_include([../ltoptions.m4])
+m4_include([../ltsugar.m4])
+m4_include([../ltversion.m4])
+m4_include([../lt~obsolete.m4])
+m4_include([../config/acx.m4])
+m4_include([../config/depstand.m4])
+m4_include([../config/lead-dot.m4])
+m4_include([../config/multi.m4])
+m4_include([../config/no-executables.m4])
+m4_include([../config/override.m4])
diff --git a/libgm2/autogen.sh b/libgm2/autogen.sh
new file mode 100755
index 00000000000..ea0ef766098
--- /dev/null
+++ b/libgm2/autogen.sh
@@ -0,0 +1,31 @@
+#!/bin/sh
+
+# autogen.sh regenerate the autoconf files.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+rm -rf autom4te.cache
+
+# libtoolize
+rm -f aclocal.m4
+# aclocal -I . -I config -I ../config
+aclocal -I . -I ../config
+autoreconf -I . -I ../config
+automake --include-deps
+
+rm -rf autom4te.cache
+
+exit 0
diff --git a/libgm2/config.h.in b/libgm2/config.h.in
new file mode 100644
index 00000000000..443008ebe75
--- /dev/null
+++ b/libgm2/config.h.in
@@ -0,0 +1,313 @@
+/* config.h.in.  Generated from configure.ac by autoheader.  */
+
+/* function access exists */
+#undef HAVE_ACCESS
+
+/* function brk exists */
+#undef HAVE_BRK
+
+/* function cfmakeraw exists */
+#undef HAVE_CFMAKERAW
+
+/* function close exists */
+#undef HAVE_CLOSE
+
+/* function creat exists */
+#undef HAVE_CREAT
+
+/* function ctime exists */
+#undef HAVE_CTIME
+
+/* Define to 1 if you have the <direct.h> header file. */
+#undef HAVE_DIRECT_H
+
+/* Define to 1 if you have the <dirent.h> header file. */
+#undef HAVE_DIRENT_H
+
+/* Define to 1 if you have the <dlfcn.h> header file. */
+#undef HAVE_DLFCN_H
+
+/* function dup exists */
+#undef HAVE_DUP
+
+/* Define to 1 if you have the <errno.h> header file. */
+#undef HAVE_ERRNO_H
+
+/* function execve exists */
+#undef HAVE_EXECVE
+
+/* function exit exists */
+#undef HAVE_EXIT
+
+/* function fcntl exists */
+#undef HAVE_FCNTL
+
+/* Define to 1 if you have the <fcntl.h> header file. */
+#undef HAVE_FCNTL_H
+
+/* function fstat exists */
+#undef HAVE_FSTAT
+
+/* function getdents exists */
+#undef HAVE_GETDENTS
+
+/* function getgid exists */
+#undef HAVE_GETGID
+
+/* function getpid exists */
+#undef HAVE_GETPID
+
+/* function gettimeofday exists */
+#undef HAVE_GETTIMEOFD
+
+/* function getuid exists */
+#undef HAVE_GETUID
+
+/* Define to 1 if you have the <inttypes.h> header file. */
+#undef HAVE_INTTYPES_H
+
+/* function ioctl exists */
+#undef HAVE_IOCTL
+
+/* function kill exists */
+#undef HAVE_KILL
+
+/* Define to 1 if you have the <langinfo.h> header file. */
+#undef HAVE_LANGINFO_H
+
+/* Define to 1 if you have the <limits.h> header file. */
+#undef HAVE_LIMITS_H
+
+/* function link exists */
+#undef HAVE_LINK
+
+/* function lseek exists */
+#undef HAVE_LSEEK
+
+/* Define to 1 if you have the <malloc.h> header file. */
+#undef HAVE_MALLOC_H
+
+/* have math.h */
+#undef HAVE_MATH_H
+
+/* Define to 1 if you have the <memory.h> header file. */
+#undef HAVE_MEMORY_H
+
+/* Define to 1 if you have the <netdb.h> header file. */
+#undef HAVE_NETDB_H
+
+/* Define to 1 if you have the <netinet/in.h> header file. */
+#undef HAVE_NETINET_IN_H
+
+/* function open exists */
+#undef HAVE_OPEN
+
+/* function pause exists */
+#undef HAVE_PAUSE
+
+/* function pipe exists */
+#undef HAVE_PIPE
+
+/* Define to 1 if you have the <pthread.h> header file. */
+#undef HAVE_PTHREAD_H
+
+/* Define to 1 if you have the <pwd.h> header file. */
+#undef HAVE_PWD_H
+
+/* function rand exists */
+#undef HAVE_RAND
+
+/* function read exists */
+#undef HAVE_READ
+
+/* function select exists */
+#undef HAVE_SELECT
+
+/* function setgid exists */
+#undef HAVE_SETGID
+
+/* function setitimer exists */
+#undef HAVE_SETITIMER
+
+/* function setuid exists */
+#undef HAVE_SETUID
+
+/* Define to 1 if you have the <signal.h> header file. */
+#undef HAVE_SIGNAL_H
+
+/* function signbit exists */
+#undef HAVE_SIGNBIT
+
+/* function signbitf exists */
+#undef HAVE_SIGNBITF
+
+/* function signbitl exists */
+#undef HAVE_SIGNBITL
+
+/* function stat exists */
+#undef HAVE_STAT
+
+/* Define to 1 if you have the <stdarg.h> header file. */
+#undef HAVE_STDARG_H
+
+/* Define to 1 if you have the <stddef.h> header file. */
+#undef HAVE_STDDEF_H
+
+/* Define to 1 if you have the <stdint.h> header file. */
+#undef HAVE_STDINT_H
+
+/* Define to 1 if you have the <stdio.h> header file. */
+#undef HAVE_STDIO_H
+
+/* Define to 1 if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define to 1 if you have the <strings.h> header file. */
+#undef HAVE_STRINGS_H
+
+/* Define to 1 if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* function strsignal exists */
+#undef HAVE_STRSIGNAL
+
+/* function strtod exists */
+#undef HAVE_STRTOD
+
+/* function strtold exists */
+#undef HAVE_STRTOLD
+
+/* Define to 1 if the system has the type `struct stat'. */
+#undef HAVE_STRUCT_STAT
+
+/* Define to 1 if the system has the type `struct timeval'. */
+#undef HAVE_STRUCT_TIMEVAL
+
+/* Define to 1 if the system has the type `struct timezone'. */
+#undef HAVE_STRUCT_TIMEZONE
+
+/* Define to 1 if you have the <sys/errno.h> header file. */
+#undef HAVE_SYS_ERRNO_H
+
+/* Define to 1 if you have the <sys/file.h> header file. */
+#undef HAVE_SYS_FILE_H
+
+/* Define to 1 if you have the <sys/ioctl.h> header file. */
+#undef HAVE_SYS_IOCTL_H
+
+/* Define to 1 if you have the <sys/mman.h> header file. */
+#undef HAVE_SYS_MMAN_H
+
+/* Define to 1 if you have the <sys/param.h> header file. */
+#undef HAVE_SYS_PARAM_H
+
+/* Define to 1 if you have the <sys/resource.h> header file. */
+#undef HAVE_SYS_RESOURCE_H
+
+/* Define to 1 if you have the <sys/socket.h> header file. */
+#undef HAVE_SYS_SOCKET_H
+
+/* Define to 1 if you have the <sys/stat.h> header file. */
+#undef HAVE_SYS_STAT_H
+
+/* Define to 1 if you have the <sys/times.h> header file. */
+#undef HAVE_SYS_TIMES_H
+
+/* Define to 1 if you have the <sys/time.h> header file. */
+#undef HAVE_SYS_TIME_H
+
+/* Define to 1 if you have the <sys/types.h> header file. */
+#undef HAVE_SYS_TYPES_H
+
+/* Define to 1 if you have the <sys/uio.h> header file. */
+#undef HAVE_SYS_UIO_H
+
+/* Define to 1 if you have the <sys/wait.h> header file. */
+#undef HAVE_SYS_WAIT_H
+
+/* Define to 1 if you have the <termios.h> header file. */
+#undef HAVE_TERMIOS_H
+
+/* function times exists */
+#undef HAVE_TIMES
+
+/* Define to 1 if you have the <time.h> header file. */
+#undef HAVE_TIME_H
+
+/* Define to 1 if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
+
+/* function unlink exists */
+#undef HAVE_UNLINK
+
+/* function wait exists */
+#undef HAVE_WAIT
+
+/* Define to 1 if you have the <wchar.h> header file. */
+#undef HAVE_WCHAR_H
+
+/* function write exists */
+#undef HAVE_WRITE
+
+/* Define to the sub-directory in which libtool stores uninstalled libraries.
+   */
+#undef LT_OBJDIR
+
+/* Name of package */
+#undef PACKAGE
+
+/* Define to the address where bug reports for this package should be sent. */
+#undef PACKAGE_BUGREPORT
+
+/* Define to the full name of this package. */
+#undef PACKAGE_NAME
+
+/* Define to the full name and version of this package. */
+#undef PACKAGE_STRING
+
+/* Define to the one symbol short name of this package. */
+#undef PACKAGE_TARNAME
+
+/* Define to the home page for this package. */
+#undef PACKAGE_URL
+
+/* Define to the version of this package. */
+#undef PACKAGE_VERSION
+
+/* Define to 1 if you have the ANSI C header files. */
+#undef STDC_HEADERS
+
+/* Enable extensions on AIX 3, Interix.  */
+#ifndef _ALL_SOURCE
+# undef _ALL_SOURCE
+#endif
+/* Enable GNU extensions on systems that have them.  */
+#ifndef _GNU_SOURCE
+# undef _GNU_SOURCE
+#endif
+/* Enable threading extensions on Solaris.  */
+#ifndef _POSIX_PTHREAD_SEMANTICS
+# undef _POSIX_PTHREAD_SEMANTICS
+#endif
+/* Enable extensions on HP NonStop.  */
+#ifndef _TANDEM_SOURCE
+# undef _TANDEM_SOURCE
+#endif
+/* Enable general extensions on Solaris.  */
+#ifndef __EXTENSIONS__
+# undef __EXTENSIONS__
+#endif
+
+
+/* Version number of package */
+#undef VERSION
+
+/* Define to 1 if on MINIX. */
+#undef _MINIX
+
+/* Define to 2 if the system does not provide POSIX.1 features except with
+   this defined. */
+#undef _POSIX_1_SOURCE
+
+/* Define to 1 if you need to in order for `stat' and other things to work. */
+#undef _POSIX_SOURCE
diff --git a/libgm2/configure b/libgm2/configure
new file mode 100755
index 00000000000..889c0926a15
--- /dev/null
+++ b/libgm2/configure
@@ -0,0 +1,22363 @@
+#! /bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.69 for package-unused version-unused.
+#
+#
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
+#
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+# Use a proper internal environment variable to ensure we don't fall
+  # into an infinite loop, continuously re-executing ourselves.
+  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+    _as_can_reexec=no; export _as_can_reexec;
+    # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+  *v*x* | *x*v* ) as_opts=-vx ;;
+  *v* ) as_opts=-v ;;
+  *x* ) as_opts=-x ;;
+  * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+  fi
+  # We don't want this to propagate to other subprocesses.
+          { _as_can_reexec=; unset _as_can_reexec;}
+if test "x$CONFIG_SHELL" = x; then
+  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '\${1+\"\$@\"}'='\"\$@\"'
+  setopt NO_GLOB_SUBST
+else
+  case \`(set -o) 2>/dev/null\` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+"
+  as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
+
+exitcode=0
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
+
+else
+  exitcode=1; echo positional parameters were not saved.
+fi
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
+test \$(( 1 + 1 )) = 2 || exit 1
+
+  test -n \"\${ZSH_VERSION+set}\${BASH_VERSION+set}\" || (
+    ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+    ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO
+    ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO
+    PATH=/empty FPATH=/empty; export PATH FPATH
+    test \"X\`printf %s \$ECHO\`\" = \"X\$ECHO\" \\
+      || test \"X\`print -r -- \$ECHO\`\" = \"X\$ECHO\" ) || exit 1"
+  if (eval "$as_required") 2>/dev/null; then :
+  as_have_required=yes
+else
+  as_have_required=no
+fi
+  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
+
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  as_found=:
+  case $as_dir in #(
+	 /*)
+	   for as_base in sh bash ksh sh5; do
+	     # Try only shells that exist, to save several forks.
+	     as_shell=$as_dir/$as_base
+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  CONFIG_SHELL=$as_shell as_have_required=yes
+		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  break 2
+fi
+fi
+	   done;;
+       esac
+  as_found=false
+done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+  CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
+IFS=$as_save_IFS
+
+
+      if test "x$CONFIG_SHELL" != x; then :
+  export CONFIG_SHELL
+             # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+  *v*x* | *x*v* ) as_opts=-vx ;;
+  *v* ) as_opts=-v ;;
+  *x* ) as_opts=-x ;;
+  * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
+fi
+
+    if test x$as_have_required = xno; then :
+  $as_echo "$0: This script requires a shell more modern than all"
+  $as_echo "$0: the shells that I found on your system."
+  if test x${ZSH_VERSION+set} = xset ; then
+    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
+  else
+    $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
+$0: including any error possibly output before this
+$0: message. Then install a modern shell, or manually run
+$0: the script under such a shell if you do have one."
+  fi
+  exit 1
+fi
+fi
+fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
+
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+  test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$1; test $as_status -eq 0 && as_status=1
+  if test "$4"; then
+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+  fi
+  $as_echo "$as_me: error: $2" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+
+  as_lineno_1=$LINENO as_lineno_1a=$LINENO
+  as_lineno_2=$LINENO as_lineno_2a=$LINENO
+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
+  sed -n '
+    p
+    /[$]LINENO/=
+  ' <$as_myself |
+    sed '
+      s/[$]LINENO.*/&-/
+      t lineno
+      b
+      :lineno
+      N
+      :loop
+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
+      t loop
+      s/-\n.*//
+    ' >$as_me.lineno &&
+  chmod +x "$as_me.lineno" ||
+    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+
+  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+  # already done that, so ensure we don't try to do so again and fall
+  # in an infinite loop.  This has already happened in practice.
+  _as_can_reexec=no; export _as_can_reexec
+  # Don't try to exec as it changes $[0], causing all sort of problems
+  # (the dirname of $[0] is not the place where we might find the
+  # original and so on.  Autoconf is especially sensitive to this).
+  . "./$as_me.lineno"
+  # Exit status is that of the last command.
+  exit
+}
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -pR'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -pR'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -pR'
+  fi
+else
+  as_ln_s='cp -pR'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+
+test -n "$DJDIR" || exec 7<&0 </dev/null
+exec 6>&1
+
+# Name of the host.
+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_clean_files=
+ac_config_libobj_dir=.
+LIBOBJS=
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+
+# Identity of this package.
+PACKAGE_NAME='package-unused'
+PACKAGE_TARNAME='libgm2'
+PACKAGE_VERSION='version-unused'
+PACKAGE_STRING='package-unused version-unused'
+PACKAGE_BUGREPORT=''
+PACKAGE_URL=''
+
+ac_unique_file="Makefile.am"
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#ifdef HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#ifdef HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+#  include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
+#  include <memory.h>
+# endif
+# include <string.h>
+#endif
+#ifdef HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#ifdef HAVE_INTTYPES_H
+# include <inttypes.h>
+#endif
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
+ac_unique_file="Makefile.am"
+ac_subst_vars='am__EXEEXT_FALSE
+am__EXEEXT_TRUE
+LTLIBOBJS
+LIBOBJS
+BUILD_LOGLIB_FALSE
+BUILD_LOGLIB_TRUE
+BUILD_CORLIB_FALSE
+BUILD_CORLIB_TRUE
+BUILD_ISOLIB_FALSE
+BUILD_ISOLIB_TRUE
+BUILD_PIMLIB_FALSE
+BUILD_PIMLIB_TRUE
+GM2_FOR_TARGET
+CC_FOR_BUILD
+enable_static
+enable_shared
+CXXCPP
+OTOOL64
+OTOOL
+LIPO
+NMEDIT
+DSYMUTIL
+OBJDUMP
+LN_S
+ac_ct_DUMPBIN
+DUMPBIN
+LD
+FGREP
+SED
+LIBTOOL
+PERL
+RANLIB
+NM
+AR
+am__fastdepCCAS_FALSE
+am__fastdepCCAS_TRUE
+CCASDEPMODE
+CCASFLAGS
+CCAS
+am__fastdepCXX_FALSE
+am__fastdepCXX_TRUE
+CXXDEPMODE
+ac_ct_CXX
+CXXFLAGS
+CXX
+MAINTAINER_MODE_FALSE
+MAINTAINER_MODE_TRUE
+toolexeclibdir
+toolexecdir
+MAINT
+slibdir
+target_subdir
+host_subdir
+build_subdir
+build_libsubdir
+target_noncanonical
+host_noncanonical
+AM_BACKSLASH
+AM_DEFAULT_VERBOSITY
+AM_DEFAULT_V
+AM_V
+am__fastdepCC_FALSE
+am__fastdepCC_TRUE
+CCDEPMODE
+am__nodep
+AMDEPBACKSLASH
+AMDEP_FALSE
+AMDEP_TRUE
+am__quote
+am__include
+DEPDIR
+am__untar
+am__tar
+AMTAR
+am__leading_dot
+SET_MAKE
+AWK
+mkdir_p
+MKDIR_P
+INSTALL_STRIP_PROGRAM
+STRIP
+install_sh
+MAKEINFO
+AUTOHEADER
+AUTOMAKE
+AUTOCONF
+ACLOCAL
+VERSION
+PACKAGE
+CYGPATH_W
+am__isrc
+INSTALL_DATA
+INSTALL_SCRIPT
+INSTALL_PROGRAM
+target_os
+target_vendor
+target_cpu
+target
+host_os
+host_vendor
+host_cpu
+host
+build_os
+build_vendor
+build_cpu
+build
+EGREP
+GREP
+CPP
+OBJEXT
+EXEEXT
+ac_ct_CC
+CPPFLAGS
+LDFLAGS
+CFLAGS
+CC
+multi_basedir
+libtool_VERSION
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL'
+ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+enable_multilib
+enable_dependency_tracking
+enable_silent_rules
+with_cross_host
+with_build_libsubdir
+enable_version_specific_runtime_libs
+with_slibdir
+enable_maintainer_mode
+enable_shared
+enable_static
+with_pic
+enable_fast_install
+with_gnu_ld
+enable_libtool_lock
+'
+      ac_precious_vars='build_alias
+host_alias
+target_alias
+CC
+CFLAGS
+LDFLAGS
+LIBS
+CPPFLAGS
+CPP
+CXXCPP'
+
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
+
+ac_prev=
+ac_dashdash=
+for ac_option
+do
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval $ac_prev=\$ac_option
+    ac_prev=
+    continue
+  fi
+
+  case $ac_option in
+  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+  *=)   ac_optarg= ;;
+  *)    ac_optarg=yes ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case $ac_dashdash$ac_option in
+  --)
+    ac_dashdash=yes ;;
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir=$ac_optarg ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build_alias ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build_alias=$ac_optarg ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file=$ac_optarg ;;
+
+  --config-cache | -C)
+    cache_file=config.cache ;;
+
+  -datadir | --datadir | --datadi | --datad)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=*)
+    datadir=$ac_optarg ;;
+
+  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+  | --dataroo | --dataro | --datar)
+    ac_prev=datarootdir ;;
+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+    datarootdir=$ac_optarg ;;
+
+  -disable-* | --disable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=no ;;
+
+  -docdir | --docdir | --docdi | --doc | --do)
+    ac_prev=docdir ;;
+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+    docdir=$ac_optarg ;;
+
+  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+    ac_prev=dvidir ;;
+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+    dvidir=$ac_optarg ;;
+
+  -enable-* | --enable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=\$ac_optarg ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix=$ac_optarg ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he | -h)
+    ac_init_help=long ;;
+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+    ac_init_help=recursive ;;
+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+    ac_init_help=short ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host_alias ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host_alias=$ac_optarg ;;
+
+  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+    ac_prev=htmldir ;;
+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+  | --ht=*)
+    htmldir=$ac_optarg ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir=$ac_optarg ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir=$ac_optarg ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir=$ac_optarg ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir=$ac_optarg ;;
+
+  -localedir | --localedir | --localedi | --localed | --locale)
+    ac_prev=localedir ;;
+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+    localedir=$ac_optarg ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst | --locals)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
+    localstatedir=$ac_optarg ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir=$ac_optarg ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c | -n)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir=$ac_optarg ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix=$ac_optarg ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix=$ac_optarg ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix=$ac_optarg ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name=$ac_optarg ;;
+
+  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+    ac_prev=pdfdir ;;
+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+    pdfdir=$ac_optarg ;;
+
+  -psdir | --psdir | --psdi | --psd | --ps)
+    ac_prev=psdir ;;
+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+    psdir=$ac_optarg ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir=$ac_optarg ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir=$ac_optarg ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site=$ac_optarg ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir=$ac_optarg ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir=$ac_optarg ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target_alias ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target_alias=$ac_optarg ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers | -V)
+    ac_init_version=: ;;
+
+  -with-* | --with-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=\$ac_optarg ;;
+
+  -without-* | --without-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error $? "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=no ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes=$ac_optarg ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries=$ac_optarg ;;
+
+  -*) as_fn_error $? "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information"
+    ;;
+
+  *=*)
+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+    # Reject names that are not valid shell variable names.
+    case $ac_envvar in #(
+      '' | [0-9]* | *[!_$as_cr_alnum]* )
+      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
+    esac
+    eval $ac_envvar=\$ac_optarg
+    export $ac_envvar ;;
+
+  *)
+    # FIXME: should be removed in autoconf 3.0.
+    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+  as_fn_error $? "missing argument to $ac_option"
+fi
+
+if test -n "$ac_unrecognized_opts"; then
+  case $enable_option_checking in
+    no) ;;
+    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
+    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
+  esac
+fi
+
+# Check all directory arguments for consistency.
+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
+		datadir sysconfdir sharedstatedir localstatedir includedir \
+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+		libdir localedir mandir
+do
+  eval ac_val=\$$ac_var
+  # Remove trailing slashes.
+  case $ac_val in
+    */ )
+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+      eval $ac_var=\$ac_val;;
+  esac
+  # Be sure to have absolute directory names.
+  case $ac_val in
+    [\\/$]* | ?:[\\/]* )  continue;;
+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
+  esac
+  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+  if test "x$build_alias" = x; then
+    cross_compiling=maybe
+  elif test "x$build_alias" != "x$host_alias"; then
+    cross_compiling=yes
+  fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+  as_fn_error $? "working directory cannot be determined"
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+  as_fn_error $? "pwd does not report name of working directory"
+
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then the parent directory.
+  ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_myself" : 'X\(//\)[^/]' \| \
+	 X"$as_myself" : 'X\(//\)$' \| \
+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  srcdir=$ac_confdir
+  if test ! -r "$srcdir/$ac_unique_file"; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r "$srcdir/$ac_unique_file"; then
+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
+	pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+  srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+  eval ac_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_env_${ac_var}_value=\$${ac_var}
+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+  # Omit some internal or obsolete options to make the list less imposing.
+  # This message is too long to be a string in the A/UX 3.1 sh.
+  cat <<_ACEOF
+\`configure' configures package-unused version-unused to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE.  See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+  -h, --help              display this help and exit
+      --help=short        display options specific to this package
+      --help=recursive    display the short help of all the included packages
+  -V, --version           display version information and exit
+  -q, --quiet, --silent   do not print \`checking ...' messages
+      --cache-file=FILE   cache test results in FILE [disabled]
+  -C, --config-cache      alias for \`--cache-file=config.cache'
+  -n, --no-create         do not create output files
+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']
+
+Installation directories:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+  --bindir=DIR            user executables [EPREFIX/bin]
+  --sbindir=DIR           system admin executables [EPREFIX/sbin]
+  --libexecdir=DIR        program executables [EPREFIX/libexec]
+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
+  --libdir=DIR            object code libraries [EPREFIX/lib]
+  --includedir=DIR        C header files [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
+  --infodir=DIR           info documentation [DATAROOTDIR/info]
+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]
+  --mandir=DIR            man documentation [DATAROOTDIR/man]
+  --docdir=DIR            documentation root [DATAROOTDIR/doc/libgm2]
+  --htmldir=DIR           html documentation [DOCDIR]
+  --dvidir=DIR            dvi documentation [DOCDIR]
+  --pdfdir=DIR            pdf documentation [DOCDIR]
+  --psdir=DIR             ps documentation [DOCDIR]
+_ACEOF
+
+  cat <<\_ACEOF
+
+Program names:
+  --program-prefix=PREFIX            prepend PREFIX to installed program names
+  --program-suffix=SUFFIX            append SUFFIX to installed program names
+  --program-transform-name=PROGRAM   run sed PROGRAM on installed program names
+
+System types:
+  --build=BUILD     configure for building on BUILD [guessed]
+  --host=HOST       cross-compile to build programs to run on HOST [BUILD]
+  --target=TARGET   configure for building compilers for TARGET [HOST]
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+  case $ac_init_help in
+     short | recursive ) echo "Configuration of package-unused version-unused:";;
+   esac
+  cat <<\_ACEOF
+
+Optional Features:
+  --disable-option-checking  ignore unrecognized --enable/--with options
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --enable-multilib       build many library versions (default)
+  --enable-dependency-tracking
+                          do not reject slow dependency extractors
+  --disable-dependency-tracking
+                          speeds up one-time build
+  --enable-silent-rules   less verbose build output (undo: "make V=1")
+  --disable-silent-rules  verbose build output (undo: "make V=0")
+  --enable-version-specific-runtime-libs    Specify that runtime libraries should be installed in a compiler-specific directory
+  --enable-maintainer-mode
+                          enable make rules and dependencies not useful (and
+                          sometimes confusing) to the casual installer
+  --enable-maintainer-mode
+                          enable make rules and dependencies not useful (and
+                          sometimes confusing) to the casual installer
+  --enable-shared[=PKGS]  build shared libraries [default=yes]
+  --enable-static[=PKGS]  build static libraries [default=yes]
+  --enable-fast-install[=PKGS]
+                          optimize for fast installation [default=yes]
+  --disable-libtool-lock  avoid locking (might break parallel builds)
+
+Optional Packages:
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --with-cross-host=HOST           Configuring with a cross compiler
+  --with-build-libsubdir=DIR  Directory where to find libraries for build system
+  --with-slibdir=DIR      shared libraries in DIR LIBDIR
+  --with-pic              try to use only PIC/non-PIC objects [default=use
+                          both]
+  --with-gnu-ld           assume the C compiler uses GNU ld [default=no]
+
+Some influential environment variables:
+  CC          C compiler command
+  CFLAGS      C compiler flags
+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+              nonstandard directory <lib dir>
+  LIBS        libraries to pass to the linker, e.g. -l<library>
+  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if
+              you have headers in a nonstandard directory <include dir>
+  CPP         C preprocessor
+  CXX         C++ compiler command
+  CXXFLAGS    C++ compiler flags
+  CCAS        assembler compiler command (defaults to CC)
+  CCASFLAGS   assembler compiler flags (defaults to CFLAGS)
+  CXXCPP      C++ preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to the package provider.
+_ACEOF
+ac_status=$?
+fi
+
+if test "$ac_init_help" = "recursive"; then
+  # If there are subdirs, report their specific --help.
+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+    test -d "$ac_dir" ||
+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+      continue
+    ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+    cd "$ac_dir" || { ac_status=$?; continue; }
+    # Check for guested configure.
+    if test -f "$ac_srcdir/configure.gnu"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+    elif test -f "$ac_srcdir/configure"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure" --help=recursive
+    else
+      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+    fi || ac_status=$?
+    cd "$ac_pwd" || { ac_status=$?; break; }
+  done
+fi
+
+test -n "$ac_init_help" && exit $ac_status
+if $ac_init_version; then
+  cat <<\_ACEOF
+package-unused configure version-unused
+generated by GNU Autoconf 2.69
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+  exit
+fi
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+
+# ac_fn_c_try_compile LINENO
+# --------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext
+  if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_compile
+
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } > conftest.i && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+    ac_retval=1
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_cpp
+
+# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists, giving a warning if it cannot be compiled using
+# the include files in INCLUDES and setting the cache variable VAR
+# accordingly.
+ac_fn_c_check_header_mongrel ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if eval \${$3+:} false; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+else
+  # Is the header compilable?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
+$as_echo_n "checking $2 usability... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_header_compiler=yes
+else
+  ac_header_compiler=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
+$as_echo "$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
+$as_echo_n "checking $2 presence... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <$2>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  ac_header_preproc=yes
+else
+  ac_header_preproc=no
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
+$as_echo "$ac_header_preproc" >&6; }
+
+# So?  What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
+  yes:no: )
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
+$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+    ;;
+  no:yes:* )
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
+$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5
+$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
+$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5
+$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+    ;;
+esac
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  eval "$3=\$ac_header_compiler"
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_mongrel
+
+# ac_fn_c_try_run LINENO
+# ----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
+# that executables *can* be run.
+ac_fn_c_try_run ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: program exited with status $ac_status" >&5
+       $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+       ac_retval=$ac_status
+fi
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_run
+
+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_c_check_header_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_compile
+
+# ac_fn_cxx_try_compile LINENO
+# ----------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_cxx_try_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext
+  if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_cxx_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_cxx_try_compile
+
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext conftest$ac_exeext
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext && {
+	 test "$cross_compiling" = yes ||
+	 test -x conftest$ac_exeext
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+  # interfere with the next link command; also delete a directory that is
+  # left behind by Apple's compiler.  We do this before executing the actions.
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_link
+
+# ac_fn_c_check_func LINENO FUNC VAR
+# ----------------------------------
+# Tests whether FUNC exists, setting the cache variable VAR accordingly
+ac_fn_c_check_func ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+/* Define $2 to an innocuous variant, in case <limits.h> declares $2.
+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
+#define $2 innocuous_$2
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $2 (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $2
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $2 ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined __stub_$2 || defined __stub___$2
+choke me
+#endif
+
+int
+main ()
+{
+return $2 ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_func
+
+# ac_fn_cxx_try_cpp LINENO
+# ------------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_cxx_try_cpp ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } > conftest.i && {
+	 test -z "$ac_cxx_preproc_warn_flag$ac_cxx_werror_flag" ||
+	 test ! -s conftest.err
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+    ac_retval=1
+fi
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_cxx_try_cpp
+
+# ac_fn_cxx_try_link LINENO
+# -------------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_cxx_try_link ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext conftest$ac_exeext
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_cxx_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext && {
+	 test "$cross_compiling" = yes ||
+	 test -x conftest$ac_exeext
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+  # interfere with the next link command; also delete a directory that is
+  # left behind by Apple's compiler.  We do this before executing the actions.
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+  as_fn_set_status $ac_retval
+
+} # ac_fn_cxx_try_link
+
+# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
+# -------------------------------------------
+# Tests whether TYPE exists after having included INCLUDES, setting cache
+# variable VAR accordingly.
+ac_fn_c_check_type ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  eval "$3=no"
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+if (sizeof ($2))
+	 return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+int
+main ()
+{
+if (sizeof (($2)))
+	    return 0;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  eval "$3=yes"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_type
+cat >config.log <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by package-unused $as_me version-unused, which was
+generated by GNU Autoconf 2.69.  Invocation command line was
+
+  $ $0 $@
+
+_ACEOF
+exec 5>>config.log
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`
+
+/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    $as_echo "PATH: $as_dir"
+  done
+IFS=$as_save_IFS
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+  for ac_arg
+  do
+    case $ac_arg in
+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+    | -silent | --silent | --silen | --sile | --sil)
+      continue ;;
+    *\'*)
+      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    case $ac_pass in
+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
+    2)
+      as_fn_append ac_configure_args1 " '$ac_arg'"
+      if test $ac_must_keep_next = true; then
+	ac_must_keep_next=false # Got value, back to normal.
+      else
+	case $ac_arg in
+	  *=* | --config-cache | -C | -disable-* | --disable-* \
+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+	  | -with-* | --with-* | -without-* | --without-* | --x)
+	    case "$ac_configure_args0 " in
+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+	    esac
+	    ;;
+	  -* ) ac_must_keep_next=true ;;
+	esac
+      fi
+      as_fn_append ac_configure_args " '$ac_arg'"
+      ;;
+    esac
+  done
+done
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log.  We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
+trap 'exit_status=$?
+  # Save into config.log some information that might help in debugging.
+  {
+    echo
+
+    $as_echo "## ---------------- ##
+## Cache variables. ##
+## ---------------- ##"
+    echo
+    # The following way of writing the cache mishandles newlines in values,
+(
+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+  (set) 2>&1 |
+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      sed -n \
+	"s/'\''/'\''\\\\'\'''\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+      ;; #(
+    *)
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+)
+    echo
+
+    $as_echo "## ----------------- ##
+## Output variables. ##
+## ----------------- ##"
+    echo
+    for ac_var in $ac_subst_vars
+    do
+      eval ac_val=\$$ac_var
+      case $ac_val in
+      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+      esac
+      $as_echo "$ac_var='\''$ac_val'\''"
+    done | sort
+    echo
+
+    if test -n "$ac_subst_files"; then
+      $as_echo "## ------------------- ##
+## File substitutions. ##
+## ------------------- ##"
+      echo
+      for ac_var in $ac_subst_files
+      do
+	eval ac_val=\$$ac_var
+	case $ac_val in
+	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+	esac
+	$as_echo "$ac_var='\''$ac_val'\''"
+      done | sort
+      echo
+    fi
+
+    if test -s confdefs.h; then
+      $as_echo "## ----------- ##
+## confdefs.h. ##
+## ----------- ##"
+      echo
+      cat confdefs.h
+      echo
+    fi
+    test "$ac_signal" != 0 &&
+      $as_echo "$as_me: caught signal $ac_signal"
+    $as_echo "$as_me: exit $exit_status"
+  } >&5
+  rm -f core *.core core.conftest.* &&
+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
+    exit $exit_status
+' 0
+for ac_signal in 1 2 13 15; do
+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -f -r conftest* confdefs.h
+
+$as_echo "/* confdefs.h */" > confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
+if test -n "$CONFIG_SITE"; then
+  # We do not want a PATH search for config.site.
+  case $CONFIG_SITE in #((
+    -*)  ac_site_file1=./$CONFIG_SITE;;
+    */*) ac_site_file1=$CONFIG_SITE;;
+    *)   ac_site_file1=./$CONFIG_SITE;;
+  esac
+elif test "x$prefix" != xNONE; then
+  ac_site_file1=$prefix/share/config.site
+  ac_site_file2=$prefix/etc/config.site
+else
+  ac_site_file1=$ac_default_prefix/share/config.site
+  ac_site_file2=$ac_default_prefix/etc/config.site
+fi
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
+do
+  test "x$ac_site_file" = xNONE && continue
+  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
+    sed 's/^/| /' "$ac_site_file" >&5
+    . "$ac_site_file" \
+      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "failed to load site script $ac_site_file
+See \`config.log' for more details" "$LINENO" 5; }
+  fi
+done
+
+if test -r "$cache_file"; then
+  # Some versions of bash will fail to source /dev/null (special files
+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.
+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
+    case $cache_file in
+      [\\/]* | ?:[\\/]* ) . "$cache_file";;
+      *)                      . "./$cache_file";;
+    esac
+  fi
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
+  >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in $ac_precious_vars; do
+  eval ac_old_set=\$ac_cv_env_${ac_var}_set
+  eval ac_new_set=\$ac_env_${ac_var}_set
+  eval ac_old_val=\$ac_cv_env_${ac_var}_value
+  eval ac_new_val=\$ac_env_${ac_var}_value
+  case $ac_old_set,$ac_new_set in
+    set,)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,set)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,);;
+    *)
+      if test "x$ac_old_val" != "x$ac_new_val"; then
+	# differences in whitespace do not lead to failure.
+	ac_old_val_w=`echo x $ac_old_val`
+	ac_new_val_w=`echo x $ac_new_val`
+	if test "$ac_old_val_w" != "$ac_new_val_w"; then
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+	  ac_cache_corrupted=:
+	else
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+	  eval $ac_var=\$ac_old_val
+	fi
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
+$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}
+      fi;;
+  esac
+  # Pass precious variables to config.status.
+  if test "$ac_new_set" = set; then
+    case $ac_new_val in
+    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+    *) ac_arg=$ac_var=$ac_new_val ;;
+    esac
+    case " $ac_configure_args " in
+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;
+    esac
+  fi
+done
+if $ac_cache_corrupted; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
+fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+
+
+# AC_CONFIG_MACRO_DIR([config])
+ac_config_headers="$ac_config_headers config.h"
+
+
+libtool_VERSION=17:0:0
+
+
+# Default to --enable-multilib
+# Check whether --enable-multilib was given.
+if test "${enable_multilib+set}" = set; then :
+  enableval=$enable_multilib; case "$enableval" in
+  yes) multilib=yes ;;
+  no)  multilib=no ;;
+  *)   as_fn_error $? "bad value $enableval for multilib option" "$LINENO" 5 ;;
+ esac
+else
+  multilib=yes
+fi
+
+
+# We may get other options which we leave undocumented:
+# --with-target-subdir, --with-multisrctop, --with-multisubdir
+# See config-ml.in if you want the gory details.
+
+if test "$srcdir" = "."; then
+  if test "$with_target_subdir" != "."; then
+    multi_basedir="$srcdir/$with_multisrctop../.."
+  else
+    multi_basedir="$srcdir/$with_multisrctop.."
+  fi
+else
+  multi_basedir="$srcdir/.."
+fi
+
+
+# Even if the default multilib is not a cross compilation,
+# it may be that some of the other multilibs are.
+if test $cross_compiling = no && test $multilib = yes \
+   && test "x${with_multisubdir}" != x ; then
+   cross_compiling=maybe
+fi
+
+ac_config_commands="$ac_config_commands default-1"
+
+
+
+
+ac_aux_dir=
+for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do
+  if test -f "$ac_dir/install-sh"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install-sh -c"
+    break
+  elif test -f "$ac_dir/install.sh"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install.sh -c"
+    break
+  elif test -f "$ac_dir/shtool"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/shtool install -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5
+fi
+
+# These three variables are undocumented and unsupported,
+# and are intended to be withdrawn in a future Autoconf release.
+# They can cause serious problems if a builder's source tree is in a directory
+# whose full name contains unusual characters.
+ac_config_guess="$SHELL $ac_aux_dir/config.guess"  # Please don't use this var.
+ac_config_sub="$SHELL $ac_aux_dir/config.sub"  # Please don't use this var.
+ac_configure="$SHELL $ac_aux_dir/configure"  # Please don't use this var.
+
+
+# Expand $ac_aux_dir to an absolute path.
+am_aux_dir=`cd "$ac_aux_dir" && pwd`
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+  ac_ct_CC=$CC
+  # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+else
+  CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+          if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  fi
+fi
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+       ac_prog_rejected=yes
+       continue
+     fi
+    ac_cv_prog_CC="cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# != 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+  fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$CC"; then
+  if test -n "$ac_tool_prefix"; then
+  for ac_prog in cl.exe
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$CC" && break
+  done
+fi
+if test -z "$CC"; then
+  ac_ct_CC=$CC
+  for ac_prog in cl.exe
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CC" && break
+done
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+fi
+
+fi
+
+
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "no acceptable C compiler found in \$PATH
+See \`config.log' for more details" "$LINENO" 5; }
+
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+  fi
+  rm -f conftest.er1 conftest.err
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdio.h>
+int
+main ()
+{
+printf ("hello world\n");
+  ;
+  return 0;
+}
+_ACEOF
+# FIXME: Cleanup?
+if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  gcc_no_link=no
+else
+  gcc_no_link=yes
+fi
+if test x$gcc_no_link = xyes; then
+  # Setting cross_compile will disable run tests; it will
+  # also disable AC_CHECK_FILE but that's generally
+  # correct if we can't link.
+  cross_compiling=yes
+  EXEEXT=
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
+$as_echo_n "checking whether the C compiler works... " >&6; }
+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+
+# The possible output files:
+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
+
+ac_rmfiles=
+for ac_file in $ac_files
+do
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+  esac
+done
+rm -f $ac_rmfiles
+
+if { { ac_try="$ac_link_default"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link_default") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile.  We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
+do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
+	;;
+    [ab].out )
+	# We found the default executable, but exeext='' is most
+	# certainly right.
+	break;;
+    *.* )
+	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+	then :; else
+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	fi
+	# We set ac_cv_exeext here because the later test for it is not
+	# safe: cross compilers may not add the suffix if given an `-o'
+	# argument, so we may need to know it at that point already.
+	# Even if this section looks crufty: it has the advantage of
+	# actually working.
+	break;;
+    * )
+	break;;
+  esac
+done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
+else
+  ac_file=''
+fi
+if test -z "$ac_file"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+$as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "C compiler cannot create executables
+See \`config.log' for more details" "$LINENO" 5; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
+$as_echo_n "checking for C compiler default output file name... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
+$as_echo "$ac_file" >&6; }
+ac_exeext=$ac_cv_exeext
+
+rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
+$as_echo_n "checking for suffix of executables... " >&6; }
+if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	  break;;
+    * ) break;;
+  esac
+done
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+rm -f conftest conftest$ac_cv_exeext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
+$as_echo "$ac_cv_exeext" >&6; }
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdio.h>
+int
+main ()
+{
+FILE *f = fopen ("conftest.out", "w");
+ return ferror (f) || fclose (f) != 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files="$ac_clean_files conftest.out"
+# Check that the compiler produces executables we can run.  If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
+$as_echo_n "checking whether we are cross compiling... " >&6; }
+if test "$cross_compiling" != yes; then
+  { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+  if { ac_try='./conftest$ac_cv_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then
+    cross_compiling=no
+  else
+    if test "$cross_compiling" = maybe; then
+	cross_compiling=yes
+    else
+	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details" "$LINENO" 5; }
+    fi
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
+$as_echo "$cross_compiling" >&6; }
+
+rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
+ac_clean_files=$ac_clean_files_save
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
+$as_echo_n "checking for suffix of object files... " >&6; }
+if ${ac_cv_objext+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  for ac_file in conftest.o conftest.obj conftest.*; do
+  test -f "$ac_file" || continue;
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+       break;;
+  esac
+done
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of object files: cannot compile
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
+$as_echo "$ac_cv_objext" >&6; }
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if ${ac_cv_c_compiler_gnu+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if ${ac_cv_prog_cc_g+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_save_c_werror_flag=$ac_c_werror_flag
+   ac_c_werror_flag=yes
+   ac_cv_prog_cc_g=no
+   CFLAGS="-g"
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+else
+  CFLAGS=""
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  ac_c_werror_flag=$ac_save_c_werror_flag
+	 CFLAGS="-g"
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if ${ac_cv_prog_cc_c89+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdarg.h>
+#include <stdio.h>
+struct stat;
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
+   function prototypes and stuff, but not '\xHH' hex character constants.
+   These don't provoke an error unfortunately, instead are silently treated
+   as 'x'.  The following induces an error, until -std is added to get
+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
+   array size at least.  It's necessary to write '\x00'==0 to get something
+   that's true only with -std.  */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+   inside strings and character constants.  */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+  ;
+  return 0;
+}
+_ACEOF
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_c89=$ac_arg
+fi
+rm -f core conftest.err conftest.$ac_objext
+  test "x$ac_cv_prog_cc_c89" != "xno" && break
+done
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
+fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+  x)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+  xno)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
+  *)
+    CC="$CC $ac_cv_prog_cc_c89"
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
+esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC understands -c and -o together" >&5
+$as_echo_n "checking whether $CC understands -c and -o together... " >&6; }
+if ${am_cv_prog_cc_c_o+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+  # Make sure it works both with $CC and with simple cc.
+  # Following AC_PROG_CC_C_O, we do the test twice because some
+  # compilers refuse to overwrite an existing .o file with -o,
+  # though they will create one.
+  am_cv_prog_cc_c_o=yes
+  for am_i in 1 2; do
+    if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5
+   ($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5
+   ac_status=$?
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   (exit $ac_status); } \
+         && test -f conftest2.$ac_objext; then
+      : OK
+    else
+      am_cv_prog_cc_c_o=no
+      break
+    fi
+  done
+  rm -f core conftest*
+  unset am_i
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5
+$as_echo "$am_cv_prog_cc_c_o" >&6; }
+if test "$am_cv_prog_cc_c_o" != yes; then
+   # Losing compiler, so override with the script.
+   # FIXME: It is wrong to rewrite CC.
+   # But if we don't then we get into trouble of one sort or another.
+   # A longer-term fix would be to have automake use am__CC in this case,
+   # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)"
+   CC="$am_aux_dir/compile $CC"
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+  if ${ac_cv_prog_CPP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+      # Double quotes because CPP needs to be expanded
+    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+    do
+      ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+  break
+fi
+
+    done
+    ac_cv_prog_CPP=$CPP
+
+fi
+  CPP=$ac_cv_prog_CPP
+else
+  ac_cv_prog_CPP=$CPP
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if ${ac_cv_path_GREP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$GREP"; then
+  ac_path_GREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in grep ggrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_GREP" || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+  # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'GREP' >> "conftest.nl"
+    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_GREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_GREP="$ac_path_GREP"
+      ac_path_GREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_GREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_GREP"; then
+    as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_GREP=$GREP
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if ${ac_cv_path_EGREP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+   then ac_cv_path_EGREP="$GREP -E"
+   else
+     if test -z "$EGREP"; then
+  ac_path_EGREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in egrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_EGREP" || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+  # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'EGREP' >> "conftest.nl"
+    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_EGREP="$ac_path_EGREP"
+      ac_path_EGREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_EGREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_EGREP"; then
+    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_EGREP=$EGREP
+fi
+
+   fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if ${ac_cv_header_stdc+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_stdc=yes
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "memchr" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "free" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+  if test "$cross_compiling" = yes; then :
+  :
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ctype.h>
+#include <stdlib.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+		   (('a' <= (c) && (c) <= 'i') \
+		     || ('j' <= (c) && (c) <= 'r') \
+		     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+  int i;
+  for (i = 0; i < 256; i++)
+    if (XOR (islower (i), ISLOWER (i))
+	|| toupper (i) != TOUPPER (i))
+      return 2;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+		  inttypes.h stdint.h unistd.h
+do :
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+
+  ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default"
+if test "x$ac_cv_header_minix_config_h" = xyes; then :
+  MINIX=yes
+else
+  MINIX=
+fi
+
+
+  if test "$MINIX" = yes; then
+
+$as_echo "#define _POSIX_SOURCE 1" >>confdefs.h
+
+
+$as_echo "#define _POSIX_1_SOURCE 2" >>confdefs.h
+
+
+$as_echo "#define _MINIX 1" >>confdefs.h
+
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5
+$as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; }
+if ${ac_cv_safe_to_define___extensions__+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+#         define __EXTENSIONS__ 1
+          $ac_includes_default
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_safe_to_define___extensions__=yes
+else
+  ac_cv_safe_to_define___extensions__=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_safe_to_define___extensions__" >&5
+$as_echo "$ac_cv_safe_to_define___extensions__" >&6; }
+  test $ac_cv_safe_to_define___extensions__ = yes &&
+    $as_echo "#define __EXTENSIONS__ 1" >>confdefs.h
+
+  $as_echo "#define _ALL_SOURCE 1" >>confdefs.h
+
+  $as_echo "#define _GNU_SOURCE 1" >>confdefs.h
+
+  $as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h
+
+  $as_echo "#define _TANDEM_SOURCE 1" >>confdefs.h
+
+
+
+# Do not delete or change the following two lines.  For why, see
+# http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html
+# Make sure we can run config.sub.
+$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 ||
+  as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5
+$as_echo_n "checking build system type... " >&6; }
+if ${ac_cv_build+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_build_alias=$build_alias
+test "x$ac_build_alias" = x &&
+  ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"`
+test "x$ac_build_alias" = x &&
+  as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5
+ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` ||
+  as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5
+$as_echo "$ac_cv_build" >&6; }
+case $ac_cv_build in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;;
+esac
+build=$ac_cv_build
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_build
+shift
+build_cpu=$1
+build_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+build_os=$*
+IFS=$ac_save_IFS
+case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5
+$as_echo_n "checking host system type... " >&6; }
+if ${ac_cv_host+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test "x$host_alias" = x; then
+  ac_cv_host=$ac_cv_build
+else
+  ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` ||
+    as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5
+$as_echo "$ac_cv_host" >&6; }
+case $ac_cv_host in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;;
+esac
+host=$ac_cv_host
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_host
+shift
+host_cpu=$1
+host_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+host_os=$*
+IFS=$ac_save_IFS
+case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking target system type" >&5
+$as_echo_n "checking target system type... " >&6; }
+if ${ac_cv_target+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test "x$target_alias" = x; then
+  ac_cv_target=$ac_cv_host
+else
+  ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` ||
+    as_fn_error $? "$SHELL $ac_aux_dir/config.sub $target_alias failed" "$LINENO" 5
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_target" >&5
+$as_echo "$ac_cv_target" >&6; }
+case $ac_cv_target in
+*-*-*) ;;
+*) as_fn_error $? "invalid value of canonical target" "$LINENO" 5;;
+esac
+target=$ac_cv_target
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_target
+shift
+target_cpu=$1
+target_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+target_os=$*
+IFS=$ac_save_IFS
+case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac
+
+
+# The aliases save the names the user supplied, while $host etc.
+# will get canonicalized.
+test -n "$target_alias" &&
+  test "$program_prefix$program_suffix$program_transform_name" = \
+    NONENONEs,x,x, &&
+  program_prefix=${target_alias}-
+
+target_alias=${target_alias-$host_alias}
+
+
+am__api_version='1.15'
+
+# Find a good install program.  We prefer a C program (faster),
+# so one script is as good as another.  But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AmigaOS /C/install, which installs bootblocks on floppy discs
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# OS/2's system install, which has a completely different semantic
+# ./install, which can be erroneously created by make from ./install.sh.
+# Reject install programs that cannot install multiple files.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5
+$as_echo_n "checking for a BSD-compatible install... " >&6; }
+if test -z "$INSTALL"; then
+if ${ac_cv_path_install+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    # Account for people who put trailing slashes in PATH elements.
+case $as_dir/ in #((
+  ./ | .// | /[cC]/* | \
+  /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+  ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \
+  /usr/ucb/* ) ;;
+  *)
+    # OSF1 and SCO ODT 3.0 have their own names for install.
+    # Don't use installbsd from OSF since it installs stuff as root
+    # by default.
+    for ac_prog in ginstall scoinst install; do
+      for ac_exec_ext in '' $ac_executable_extensions; do
+	if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
+	  if test $ac_prog = install &&
+	    grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+	    # AIX install.  It has an incompatible calling convention.
+	    :
+	  elif test $ac_prog = install &&
+	    grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+	    # program-specific install script used by HP pwplus--don't use.
+	    :
+	  else
+	    rm -rf conftest.one conftest.two conftest.dir
+	    echo one > conftest.one
+	    echo two > conftest.two
+	    mkdir conftest.dir
+	    if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" &&
+	      test -s conftest.one && test -s conftest.two &&
+	      test -s conftest.dir/conftest.one &&
+	      test -s conftest.dir/conftest.two
+	    then
+	      ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+	      break 3
+	    fi
+	  fi
+	fi
+      done
+    done
+    ;;
+esac
+
+  done
+IFS=$as_save_IFS
+
+rm -rf conftest.one conftest.two conftest.dir
+
+fi
+  if test "${ac_cv_path_install+set}" = set; then
+    INSTALL=$ac_cv_path_install
+  else
+    # As a last resort, use the slow shell script.  Don't cache a
+    # value for INSTALL within a source directory, because that will
+    # break other packages using the cache if that directory is
+    # removed, or if the value is a relative name.
+    INSTALL=$ac_install_sh
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5
+$as_echo "$INSTALL" >&6; }
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5
+$as_echo_n "checking whether build environment is sane... " >&6; }
+# Reject unsafe characters in $srcdir or the absolute working directory
+# name.  Accept space and tab only in the latter.
+am_lf='
+'
+case `pwd` in
+  *[\\\"\#\$\&\'\`$am_lf]*)
+    as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;;
+esac
+case $srcdir in
+  *[\\\"\#\$\&\'\`$am_lf\ \	]*)
+    as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;;
+esac
+
+# Do 'set' in a subshell so we don't clobber the current shell's
+# arguments.  Must try -L first in case configure is actually a
+# symlink; some systems play weird games with the mod time of symlinks
+# (eg FreeBSD returns the mod time of the symlink's containing
+# directory).
+if (
+   am_has_slept=no
+   for am_try in 1 2; do
+     echo "timestamp, slept: $am_has_slept" > conftest.file
+     set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null`
+     if test "$*" = "X"; then
+	# -L didn't work.
+	set X `ls -t "$srcdir/configure" conftest.file`
+     fi
+     if test "$*" != "X $srcdir/configure conftest.file" \
+	&& test "$*" != "X conftest.file $srcdir/configure"; then
+
+	# If neither matched, then we have a broken ls.  This can happen
+	# if, for instance, CONFIG_SHELL is bash and it inherits a
+	# broken ls alias from the environment.  This has actually
+	# happened.  Such a system could not be considered "sane".
+	as_fn_error $? "ls -t appears to fail.  Make sure there is not a broken
+  alias in your environment" "$LINENO" 5
+     fi
+     if test "$2" = conftest.file || test $am_try -eq 2; then
+       break
+     fi
+     # Just in case.
+     sleep 1
+     am_has_slept=yes
+   done
+   test "$2" = conftest.file
+   )
+then
+   # Ok.
+   :
+else
+   as_fn_error $? "newly created file is older than distributed files!
+Check your system clock" "$LINENO" 5
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+# If we didn't sleep, we still need to ensure time stamps of config.status and
+# generated files are strictly newer.
+am_sleep_pid=
+if grep 'slept: no' conftest.file >/dev/null 2>&1; then
+  ( sleep 1 ) &
+  am_sleep_pid=$!
+fi
+
+rm -f conftest.file
+
+test "$program_prefix" != NONE &&
+  program_transform_name="s&^&$program_prefix&;$program_transform_name"
+# Use a double $ so make ignores it.
+test "$program_suffix" != NONE &&
+  program_transform_name="s&\$&$program_suffix&;$program_transform_name"
+# Double any \ or $.
+# By default was `s,x,x', remove it if useless.
+ac_script='s/[\\$]/&&/g;s/;s,x,x,$//'
+program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"`
+
+if test x"${MISSING+set}" != xset; then
+  case $am_aux_dir in
+  *\ * | *\	*)
+    MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;;
+  *)
+    MISSING="\${SHELL} $am_aux_dir/missing" ;;
+  esac
+fi
+# Use eval to expand $SHELL
+if eval "$MISSING --is-lightweight"; then
+  am_missing_run="$MISSING "
+else
+  am_missing_run=
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 'missing' script is too old or missing" >&5
+$as_echo "$as_me: WARNING: 'missing' script is too old or missing" >&2;}
+fi
+
+if test x"${install_sh+set}" != xset; then
+  case $am_aux_dir in
+  *\ * | *\	*)
+    install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;;
+  *)
+    install_sh="\${SHELL} $am_aux_dir/install-sh"
+  esac
+fi
+
+# Installed binaries are usually stripped using 'strip' when the user
+# run "make install-strip".  However 'strip' might not be the right
+# tool to use in cross-compilation environments, therefore Automake
+# will honor the 'STRIP' environment variable to overrule this program.
+if test "$cross_compiling" != no; then
+  if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
+set dummy ${ac_tool_prefix}strip; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_STRIP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$STRIP"; then
+  ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_STRIP="${ac_tool_prefix}strip"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+STRIP=$ac_cv_prog_STRIP
+if test -n "$STRIP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5
+$as_echo "$STRIP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_STRIP"; then
+  ac_ct_STRIP=$STRIP
+  # Extract the first word of "strip", so it can be a program name with args.
+set dummy strip; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_STRIP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_STRIP"; then
+  ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_STRIP="strip"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP
+if test -n "$ac_ct_STRIP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5
+$as_echo "$ac_ct_STRIP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_STRIP" = x; then
+    STRIP=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    STRIP=$ac_ct_STRIP
+  fi
+else
+  STRIP="$ac_cv_prog_STRIP"
+fi
+
+fi
+INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s"
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5
+$as_echo_n "checking for a thread-safe mkdir -p... " >&6; }
+if test -z "$MKDIR_P"; then
+  if ${ac_cv_path_mkdir+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in mkdir gmkdir; do
+	 for ac_exec_ext in '' $ac_executable_extensions; do
+	   as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext" || continue
+	   case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #(
+	     'mkdir (GNU coreutils) '* | \
+	     'mkdir (coreutils) '* | \
+	     'mkdir (fileutils) '4.1*)
+	       ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext
+	       break 3;;
+	   esac
+	 done
+       done
+  done
+IFS=$as_save_IFS
+
+fi
+
+  test -d ./--version && rmdir ./--version
+  if test "${ac_cv_path_mkdir+set}" = set; then
+    MKDIR_P="$ac_cv_path_mkdir -p"
+  else
+    # As a last resort, use the slow shell script.  Don't cache a
+    # value for MKDIR_P within a source directory, because that will
+    # break other packages using the cache if that directory is
+    # removed, or if the value is a relative name.
+    MKDIR_P="$ac_install_sh -d"
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5
+$as_echo "$MKDIR_P" >&6; }
+
+for ac_prog in gawk mawk nawk awk
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_AWK+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$AWK"; then
+  ac_cv_prog_AWK="$AWK" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_AWK="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+AWK=$ac_cv_prog_AWK
+if test -n "$AWK"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5
+$as_echo "$AWK" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$AWK" && break
+done
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
+$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
+set x ${MAKE-make}
+ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
+if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat >conftest.make <<\_ACEOF
+SHELL = /bin/sh
+all:
+	@echo '@@@%%%=$(MAKE)=@@@%%%'
+_ACEOF
+# GNU make sometimes prints "make[1]: Entering ...", which would confuse us.
+case `${MAKE-make} -f conftest.make 2>/dev/null` in
+  *@@@%%%=?*=@@@%%%*)
+    eval ac_cv_prog_make_${ac_make}_set=yes;;
+  *)
+    eval ac_cv_prog_make_${ac_make}_set=no;;
+esac
+rm -f conftest.make
+fi
+if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+  SET_MAKE=
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+  SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+rm -rf .tst 2>/dev/null
+mkdir .tst 2>/dev/null
+if test -d .tst; then
+  am__leading_dot=.
+else
+  am__leading_dot=_
+fi
+rmdir .tst 2>/dev/null
+
+DEPDIR="${am__leading_dot}deps"
+
+ac_config_commands="$ac_config_commands depfiles"
+
+
+am_make=${MAKE-make}
+cat > confinc << 'END'
+am__doit:
+	@echo this is the am__doit target
+.PHONY: am__doit
+END
+# If we don't find an include directive, just comment out the code.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of include used by $am_make" >&5
+$as_echo_n "checking for style of include used by $am_make... " >&6; }
+am__include="#"
+am__quote=
+_am_result=none
+# First try GNU make style include.
+echo "include confinc" > confmf
+# Ignore all kinds of additional output from 'make'.
+case `$am_make -s -f confmf 2> /dev/null` in #(
+*the\ am__doit\ target*)
+  am__include=include
+  am__quote=
+  _am_result=GNU
+  ;;
+esac
+# Now try BSD make style include.
+if test "$am__include" = "#"; then
+   echo '.include "confinc"' > confmf
+   case `$am_make -s -f confmf 2> /dev/null` in #(
+   *the\ am__doit\ target*)
+     am__include=.include
+     am__quote="\""
+     _am_result=BSD
+     ;;
+   esac
+fi
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $_am_result" >&5
+$as_echo "$_am_result" >&6; }
+rm -f confinc confmf
+
+# Check whether --enable-dependency-tracking was given.
+if test "${enable_dependency_tracking+set}" = set; then :
+  enableval=$enable_dependency_tracking;
+fi
+
+if test "x$enable_dependency_tracking" != xno; then
+  am_depcomp="$ac_aux_dir/depcomp"
+  AMDEPBACKSLASH='\'
+  am__nodep='_no'
+fi
+ if test "x$enable_dependency_tracking" != xno; then
+  AMDEP_TRUE=
+  AMDEP_FALSE='#'
+else
+  AMDEP_TRUE='#'
+  AMDEP_FALSE=
+fi
+
+
+# Check whether --enable-silent-rules was given.
+if test "${enable_silent_rules+set}" = set; then :
+  enableval=$enable_silent_rules;
+fi
+
+case $enable_silent_rules in # (((
+  yes) AM_DEFAULT_VERBOSITY=0;;
+   no) AM_DEFAULT_VERBOSITY=1;;
+    *) AM_DEFAULT_VERBOSITY=1;;
+esac
+am_make=${MAKE-make}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $am_make supports nested variables" >&5
+$as_echo_n "checking whether $am_make supports nested variables... " >&6; }
+if ${am_cv_make_support_nested_variables+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if $as_echo 'TRUE=$(BAR$(V))
+BAR0=false
+BAR1=true
+V=1
+am__doit:
+	@$(TRUE)
+.PHONY: am__doit' | $am_make -f - >/dev/null 2>&1; then
+  am_cv_make_support_nested_variables=yes
+else
+  am_cv_make_support_nested_variables=no
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_make_support_nested_variables" >&5
+$as_echo "$am_cv_make_support_nested_variables" >&6; }
+if test $am_cv_make_support_nested_variables = yes; then
+    AM_V='$(V)'
+  AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)'
+else
+  AM_V=$AM_DEFAULT_VERBOSITY
+  AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY
+fi
+AM_BACKSLASH='\'
+
+if test "`cd $srcdir && pwd`" != "`pwd`"; then
+  # Use -I$(srcdir) only when $(srcdir) != ., so that make's output
+  # is not polluted with repeated "-I."
+  am__isrc=' -I$(srcdir)'
+  # test to see if srcdir already configured
+  if test -f $srcdir/config.status; then
+    as_fn_error $? "source directory already configured; run \"make distclean\" there first" "$LINENO" 5
+  fi
+fi
+
+# test whether we have cygpath
+if test -z "$CYGPATH_W"; then
+  if (cygpath --version) >/dev/null 2>/dev/null; then
+    CYGPATH_W='cygpath -w'
+  else
+    CYGPATH_W=echo
+  fi
+fi
+
+
+# Define the identity of the package.
+ PACKAGE='libgm2'
+ VERSION='version-unused'
+
+
+# Some tools Automake needs.
+
+ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"}
+
+
+AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"}
+
+
+AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"}
+
+
+AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"}
+
+
+MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"}
+
+# For better backward compatibility.  To be removed once Automake 1.9.x
+# dies out for good.  For more background, see:
+# <http://lists.gnu.org/archive/html/automake/2012-07/msg00001.html>
+# <http://lists.gnu.org/archive/html/automake/2012-07/msg00014.html>
+mkdir_p='$(MKDIR_P)'
+
+# We need awk for the "check" target (and possibly the TAP driver).  The
+# system "awk" is bad on some platforms.
+# Always define AMTAR for backward compatibility.  Yes, it's still used
+# in the wild :-(  We should find a proper way to deprecate it ...
+AMTAR='$${TAR-tar}'
+
+
+# We'll loop over all known methods to create a tar archive until one works.
+_am_tools='gnutar  pax cpio none'
+
+am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'
+
+
+
+
+
+depcc="$CC"   am_compiler_list=
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5
+$as_echo_n "checking dependency style of $depcc... " >&6; }
+if ${am_cv_CC_dependencies_compiler_type+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
+  # We make a subdir and do the tests there.  Otherwise we can end up
+  # making bogus files that we don't know about and never remove.  For
+  # instance it was reported that on HP-UX the gcc test will end up
+  # making a dummy file named 'D' -- because '-MD' means "put the output
+  # in D".
+  rm -rf conftest.dir
+  mkdir conftest.dir
+  # Copy depcomp to subdir because otherwise we won't find it if we're
+  # using a relative directory.
+  cp "$am_depcomp" conftest.dir
+  cd conftest.dir
+  # We will build objects and dependencies in a subdirectory because
+  # it helps to detect inapplicable dependency modes.  For instance
+  # both Tru64's cc and ICC support -MD to output dependencies as a
+  # side effect of compilation, but ICC will put the dependencies in
+  # the current directory while Tru64 will put them in the object
+  # directory.
+  mkdir sub
+
+  am_cv_CC_dependencies_compiler_type=none
+  if test "$am_compiler_list" = ""; then
+     am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp`
+  fi
+  am__universal=false
+  case " $depcc " in #(
+     *\ -arch\ *\ -arch\ *) am__universal=true ;;
+     esac
+
+  for depmode in $am_compiler_list; do
+    # Setup a source with many dependencies, because some compilers
+    # like to wrap large dependency lists on column 80 (with \), and
+    # we should not choose a depcomp mode which is confused by this.
+    #
+    # We need to recreate these files for each test, as the compiler may
+    # overwrite some of them when testing with obscure command lines.
+    # This happens at least with the AIX C compiler.
+    : > sub/conftest.c
+    for i in 1 2 3 4 5 6; do
+      echo '#include "conftst'$i'.h"' >> sub/conftest.c
+      # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with
+      # Solaris 10 /bin/sh.
+      echo '/* dummy */' > sub/conftst$i.h
+    done
+    echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf
+
+    # We check with '-c' and '-o' for the sake of the "dashmstdout"
+    # mode.  It turns out that the SunPro C++ compiler does not properly
+    # handle '-M -o', and we need to detect this.  Also, some Intel
+    # versions had trouble with output in subdirs.
+    am__obj=sub/conftest.${OBJEXT-o}
+    am__minus_obj="-o $am__obj"
+    case $depmode in
+    gcc)
+      # This depmode causes a compiler race in universal mode.
+      test "$am__universal" = false || continue
+      ;;
+    nosideeffect)
+      # After this tag, mechanisms are not by side-effect, so they'll
+      # only be used when explicitly requested.
+      if test "x$enable_dependency_tracking" = xyes; then
+	continue
+      else
+	break
+      fi
+      ;;
+    msvc7 | msvc7msys | msvisualcpp | msvcmsys)
+      # This compiler won't grok '-c -o', but also, the minuso test has
+      # not run yet.  These depmodes are late enough in the game, and
+      # so weak that their functioning should not be impacted.
+      am__obj=conftest.${OBJEXT-o}
+      am__minus_obj=
+      ;;
+    none) break ;;
+    esac
+    if depmode=$depmode \
+       source=sub/conftest.c object=$am__obj \
+       depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \
+       $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \
+         >/dev/null 2>conftest.err &&
+       grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 &&
+       grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 &&
+       grep $am__obj sub/conftest.Po > /dev/null 2>&1 &&
+       ${MAKE-make} -s -f confmf > /dev/null 2>&1; then
+      # icc doesn't choke on unknown options, it will just issue warnings
+      # or remarks (even with -Werror).  So we grep stderr for any message
+      # that says an option was ignored or not supported.
+      # When given -MP, icc 7.0 and 7.1 complain thusly:
+      #   icc: Command line warning: ignoring option '-M'; no argument required
+      # The diagnosis changed in icc 8.0:
+      #   icc: Command line remark: option '-MP' not supported
+      if (grep 'ignoring option' conftest.err ||
+          grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else
+        am_cv_CC_dependencies_compiler_type=$depmode
+        break
+      fi
+    fi
+  done
+
+  cd ..
+  rm -rf conftest.dir
+else
+  am_cv_CC_dependencies_compiler_type=none
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5
+$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; }
+CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type
+
+ if
+  test "x$enable_dependency_tracking" != xno \
+  && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then
+  am__fastdepCC_TRUE=
+  am__fastdepCC_FALSE='#'
+else
+  am__fastdepCC_TRUE='#'
+  am__fastdepCC_FALSE=
+fi
+
+
+
+# POSIX will say in a future version that running "rm -f" with no argument
+# is OK; and we want to be able to make that assumption in our Makefile
+# recipes.  So use an aggressive probe to check that the usage we want is
+# actually supported "in the wild" to an acceptable degree.
+# See automake bug#10828.
+# To make any issue more visible, cause the running configure to be aborted
+# by default if the 'rm' program in use doesn't match our expectations; the
+# user can still override this though.
+if rm -f && rm -fr && rm -rf; then : OK; else
+  cat >&2 <<'END'
+Oops!
+
+Your 'rm' program seems unable to run without file operands specified
+on the command line, even when the '-f' option is present.  This is contrary
+to the behaviour of most rm programs out there, and not conforming with
+the upcoming POSIX standard: <http://austingroupbugs.net/view.php?id=542>
+
+Please tell bug-automake@gnu.org about your system, including the value
+of your $PATH and any error possibly output before this message.  This
+can help us improve future automake versions.
+
+END
+  if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then
+    echo 'Configuration will proceed anyway, since you have set the' >&2
+    echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2
+    echo >&2
+  else
+    cat >&2 <<'END'
+Aborting the configuration process, to ensure you take notice of the issue.
+
+You can download and install GNU coreutils to get an 'rm' implementation
+that behaves properly: <http://www.gnu.org/software/coreutils/>.
+
+If you want to complete the configuration process using your problematic
+'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM
+to "yes", and re-run configure.
+
+END
+    as_fn_error $? "Your 'rm' program is bad, sorry." "$LINENO" 5
+  fi
+fi
+
+
+
+
+
+
+# Check whether --with-cross-host was given.
+if test "${with_cross_host+set}" = set; then :
+  withval=$with_cross_host;
+fi
+
+
+# Checks for header files.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if ${ac_cv_header_stdc+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_stdc=yes
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "memchr" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "free" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+  if test "$cross_compiling" = yes; then :
+  :
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ctype.h>
+#include <stdlib.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+		   (('a' <= (c) && (c) <= 'i') \
+		     || ('j' <= (c) && (c) <= 'r') \
+		     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+  int i;
+  for (i = 0; i < 256; i++)
+    if (XOR (islower (i), ISLOWER (i))
+	|| toupper (i) != TOUPPER (i))
+      return 2;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sys/wait.h that is POSIX.1 compatible" >&5
+$as_echo_n "checking for sys/wait.h that is POSIX.1 compatible... " >&6; }
+if ${ac_cv_header_sys_wait_h+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <sys/types.h>
+#include <sys/wait.h>
+#ifndef WEXITSTATUS
+# define WEXITSTATUS(stat_val) ((unsigned int) (stat_val) >> 8)
+#endif
+#ifndef WIFEXITED
+# define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
+#endif
+
+int
+main ()
+{
+  int s;
+  wait (&s);
+  s = WIFEXITED (s) ? WEXITSTATUS (s) : 1;
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_sys_wait_h=yes
+else
+  ac_cv_header_sys_wait_h=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_sys_wait_h" >&5
+$as_echo "$ac_cv_header_sys_wait_h" >&6; }
+if test $ac_cv_header_sys_wait_h = yes; then
+
+$as_echo "#define HAVE_SYS_WAIT_H 1" >>confdefs.h
+
+fi
+
+ac_fn_c_check_header_mongrel "$LINENO" "math.h" "ac_cv_header_math_h" "$ac_includes_default"
+if test "x$ac_cv_header_math_h" = xyes; then :
+
+$as_echo "#define HAVE_MATH_H 1" >>confdefs.h
+
+fi
+
+
+
+for ac_header in limits.h stddef.h string.h strings.h stdlib.h \
+                 time.h \
+		 fcntl.h unistd.h sys/file.h sys/time.h sys/mman.h \
+		 sys/resource.h sys/param.h sys/times.h sys/stat.h \
+                 sys/socket.h \
+                 sys/wait.h sys/ioctl.h errno.h sys/errno.h \
+		 pwd.h direct.h dirent.h signal.h malloc.h langinfo.h \
+                 pthread.h stdarg.h stdio.h sys/types.h termios.h \
+                 netinet/in.h netdb.h sys/uio.h sys/stat.h wchar.h
+do :
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+
+
+ case ${build_alias} in
+  "") build_noncanonical=${build} ;;
+  *) build_noncanonical=${build_alias} ;;
+esac
+
+ case ${host_alias} in
+  "") host_noncanonical=${build_noncanonical} ;;
+  *) host_noncanonical=${host_alias} ;;
+esac
+
+
+
+ case ${target_alias} in
+  "") target_noncanonical=${host_noncanonical} ;;
+  *) target_noncanonical=${target_alias} ;;
+esac
+
+
+
+
+# post-stage1 host modules use a different CC_FOR_BUILD so, in order to
+# have matching libraries, they should use host libraries: Makefile.tpl
+# arranges to pass --with-build-libsubdir=$(HOST_SUBDIR).
+# However, they still use the build modules, because the corresponding
+# host modules (e.g. bison) are only built for the host when bootstrap
+# finishes. So:
+# - build_subdir is where we find build modules, and never changes.
+# - build_libsubdir is where we find build libraries, and can be overridden.
+
+# Prefix 'build-' so this never conflicts with target_subdir.
+build_subdir="build-${build_noncanonical}"
+
+# Check whether --with-build-libsubdir was given.
+if test "${with_build_libsubdir+set}" = set; then :
+  withval=$with_build_libsubdir; build_libsubdir="$withval"
+else
+  build_libsubdir="$build_subdir"
+fi
+
+# --srcdir=. covers the toplevel, while "test -d" covers the subdirectories
+if ( test $srcdir = . && test -d gcc ) \
+   || test -d $srcdir/../host-${host_noncanonical}; then
+  host_subdir="host-${host_noncanonical}"
+else
+  host_subdir=.
+fi
+# No prefix.
+target_subdir=${target_noncanonical}
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for --enable-version-specific-runtime-libs" >&5
+$as_echo_n "checking for --enable-version-specific-runtime-libs... " >&6; }
+# Check whether --enable-version-specific-runtime-libs was given.
+if test "${enable_version_specific_runtime_libs+set}" = set; then :
+  enableval=$enable_version_specific_runtime_libs; case "$enableval" in
+ yes) version_specific_libs=yes ;;
+ no)  version_specific_libs=no ;;
+ *)   as_fn_error $? "Unknown argument to enable/disable version-specific libs" "$LINENO" 5;;
+ esac
+else
+  version_specific_libs=no
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $version_specific_libs" >&5
+$as_echo "$version_specific_libs" >&6; }
+
+
+# Check whether --with-slibdir was given.
+if test "${with_slibdir+set}" = set; then :
+  withval=$with_slibdir; slibdir="$with_slibdir"
+else
+  if test "${version_specific_libs}" = yes; then
+  slibdir='$(libsubdir)'
+elif test -n "$with_cross_host" && test x"$with_cross_host" != x"no"; then
+  slibdir='$(exec_prefix)/$(host_noncanonical)/lib'
+else
+  slibdir='$(libdir)'
+fi
+fi
+
+
+
+# Command-line options.
+# Very limited version of AC_MAINTAINER_MODE.
+# Check whether --enable-maintainer-mode was given.
+if test "${enable_maintainer_mode+set}" = set; then :
+  enableval=$enable_maintainer_mode; case ${enable_maintainer_mode} in
+     yes) MAINT='' ;;
+     no) MAINT='#' ;;
+     *) as_fn_error $? "--enable-maintainer-mode must be yes or no" "$LINENO" 5 ;;
+   esac
+   maintainer_mode=${enableval}
+else
+  MAINT='#'
+fi
+
+
+toolexecdir=no
+toolexeclibdir=no
+
+# Calculate toolexeclibdir
+# Also toolexecdir, though it's only used in toolexeclibdir
+case ${version_specific_libs} in
+  yes)
+    # Need the gcc compiler version to know where to install libraries
+    # and header files if --enable-version-specific-runtime-libs option
+    # is selected.
+    toolexecdir='$(libdir)/gcc/$(target_noncanonical)'
+    toolexeclibdir='$(toolexecdir)/$(gcc_version)$(MULTISUBDIR)'
+    ;;
+  no)
+    if test -n "$with_cross_host" &&
+       test x"$with_cross_host" != x"no"; then
+      # Install a library built with a cross compiler in tooldir, not libdir.
+      toolexecdir='$(exec_prefix)/$(target_noncanonical)'
+      toolexeclibdir='$(toolexecdir)/lib'
+    else
+      toolexecdir='$(libdir)/gcc-lib/$(target_noncanonical)'
+      toolexeclibdir='$(libdir)'
+    fi
+    multi_os_directory=`$CC -print-multi-os-directory`
+    case $multi_os_directory in
+      .) ;; # Avoid trailing /.
+      *) toolexeclibdir=$toolexeclibdir/$multi_os_directory ;;
+    esac
+    ;;
+esac
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable maintainer-specific portions of Makefiles" >&5
+$as_echo_n "checking whether to enable maintainer-specific portions of Makefiles... " >&6; }
+    # Check whether --enable-maintainer-mode was given.
+if test "${enable_maintainer_mode+set}" = set; then :
+  enableval=$enable_maintainer_mode; USE_MAINTAINER_MODE=$enableval
+else
+  USE_MAINTAINER_MODE=no
+fi
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_MAINTAINER_MODE" >&5
+$as_echo "$USE_MAINTAINER_MODE" >&6; }
+   if test $USE_MAINTAINER_MODE = yes; then
+  MAINTAINER_MODE_TRUE=
+  MAINTAINER_MODE_FALSE='#'
+else
+  MAINTAINER_MODE_TRUE='#'
+  MAINTAINER_MODE_FALSE=
+fi
+
+  MAINT=$MAINTAINER_MODE_TRUE
+
+
+
+# Check the compiler.
+# The same as in boehm-gc and libstdc++. Have to borrow it from there.
+# We must force CC to /not/ be precious variables; otherwise
+# the wrong, non-multilib-adjusted value will be used in multilibs.
+# As a side effect, we have to subst CFLAGS ourselves.
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+  ac_ct_CC=$CC
+  # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+else
+  CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+          if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  fi
+fi
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+       ac_prog_rejected=yes
+       continue
+     fi
+    ac_cv_prog_CC="cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# != 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+  fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$CC"; then
+  if test -n "$ac_tool_prefix"; then
+  for ac_prog in cl.exe
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$CC" && break
+  done
+fi
+if test -z "$CC"; then
+  ac_ct_CC=$CC
+  for ac_prog in cl.exe
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CC" && break
+done
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+fi
+
+fi
+
+
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "no acceptable C compiler found in \$PATH
+See \`config.log' for more details" "$LINENO" 5; }
+
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+  fi
+  rm -f conftest.er1 conftest.err
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if ${ac_cv_c_compiler_gnu+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if ${ac_cv_prog_cc_g+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_save_c_werror_flag=$ac_c_werror_flag
+   ac_c_werror_flag=yes
+   ac_cv_prog_cc_g=no
+   CFLAGS="-g"
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+else
+  CFLAGS=""
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  ac_c_werror_flag=$ac_save_c_werror_flag
+	 CFLAGS="-g"
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if ${ac_cv_prog_cc_c89+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdarg.h>
+#include <stdio.h>
+struct stat;
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
+   function prototypes and stuff, but not '\xHH' hex character constants.
+   These don't provoke an error unfortunately, instead are silently treated
+   as 'x'.  The following induces an error, until -std is added to get
+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
+   array size at least.  It's necessary to write '\x00'==0 to get something
+   that's true only with -std.  */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+   inside strings and character constants.  */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+  ;
+  return 0;
+}
+_ACEOF
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_c89=$ac_arg
+fi
+rm -f core conftest.err conftest.$ac_objext
+  test "x$ac_cv_prog_cc_c89" != "xno" && break
+done
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
+fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+  x)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+  xno)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
+  *)
+    CC="$CC $ac_cv_prog_cc_c89"
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
+esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC understands -c and -o together" >&5
+$as_echo_n "checking whether $CC understands -c and -o together... " >&6; }
+if ${am_cv_prog_cc_c_o+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+  # Make sure it works both with $CC and with simple cc.
+  # Following AC_PROG_CC_C_O, we do the test twice because some
+  # compilers refuse to overwrite an existing .o file with -o,
+  # though they will create one.
+  am_cv_prog_cc_c_o=yes
+  for am_i in 1 2; do
+    if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5
+   ($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5
+   ac_status=$?
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   (exit $ac_status); } \
+         && test -f conftest2.$ac_objext; then
+      : OK
+    else
+      am_cv_prog_cc_c_o=no
+      break
+    fi
+  done
+  rm -f core conftest*
+  unset am_i
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5
+$as_echo "$am_cv_prog_cc_c_o" >&6; }
+if test "$am_cv_prog_cc_c_o" != yes; then
+   # Losing compiler, so override with the script.
+   # FIXME: It is wrong to rewrite CC.
+   # But if we don't then we get into trouble of one sort or another.
+   # A longer-term fix would be to have automake use am__CC in this case,
+   # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)"
+   CC="$am_aux_dir/compile $CC"
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+ac_ext=cpp
+ac_cpp='$CXXCPP $CPPFLAGS'
+ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_cxx_compiler_gnu
+if test -z "$CXX"; then
+  if test -n "$CCC"; then
+    CXX=$CCC
+  else
+    if test -n "$ac_tool_prefix"; then
+  for ac_prog in g++ c++ gpp aCC CC cxx cc++ cl.exe FCC KCC RCC xlC_r xlC
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CXX+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CXX"; then
+  ac_cv_prog_CXX="$CXX" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CXX="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CXX=$ac_cv_prog_CXX
+if test -n "$CXX"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXX" >&5
+$as_echo "$CXX" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$CXX" && break
+  done
+fi
+if test -z "$CXX"; then
+  ac_ct_CXX=$CXX
+  for ac_prog in g++ c++ gpp aCC CC cxx cc++ cl.exe FCC KCC RCC xlC_r xlC
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CXX+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CXX"; then
+  ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CXX="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CXX=$ac_cv_prog_ac_ct_CXX
+if test -n "$ac_ct_CXX"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CXX" >&5
+$as_echo "$ac_ct_CXX" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CXX" && break
+done
+
+  if test "x$ac_ct_CXX" = x; then
+    CXX="g++"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CXX=$ac_ct_CXX
+  fi
+fi
+
+  fi
+fi
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C++ compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+  fi
+  rm -f conftest.er1 conftest.err
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C++ compiler" >&5
+$as_echo_n "checking whether we are using the GNU C++ compiler... " >&6; }
+if ${ac_cv_cxx_compiler_gnu+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_cxx_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cxx_compiler_gnu" >&5
+$as_echo "$ac_cv_cxx_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+  GXX=yes
+else
+  GXX=
+fi
+ac_test_CXXFLAGS=${CXXFLAGS+set}
+ac_save_CXXFLAGS=$CXXFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX accepts -g" >&5
+$as_echo_n "checking whether $CXX accepts -g... " >&6; }
+if ${ac_cv_prog_cxx_g+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_save_cxx_werror_flag=$ac_cxx_werror_flag
+   ac_cxx_werror_flag=yes
+   ac_cv_prog_cxx_g=no
+   CXXFLAGS="-g"
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_compile "$LINENO"; then :
+  ac_cv_prog_cxx_g=yes
+else
+  CXXFLAGS=""
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_compile "$LINENO"; then :
+
+else
+  ac_cxx_werror_flag=$ac_save_cxx_werror_flag
+	 CXXFLAGS="-g"
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_compile "$LINENO"; then :
+  ac_cv_prog_cxx_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_cxx_werror_flag=$ac_save_cxx_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cxx_g" >&5
+$as_echo "$ac_cv_prog_cxx_g" >&6; }
+if test "$ac_test_CXXFLAGS" = set; then
+  CXXFLAGS=$ac_save_CXXFLAGS
+elif test $ac_cv_prog_cxx_g = yes; then
+  if test "$GXX" = yes; then
+    CXXFLAGS="-g -O2"
+  else
+    CXXFLAGS="-g"
+  fi
+else
+  if test "$GXX" = yes; then
+    CXXFLAGS="-O2"
+  else
+    CXXFLAGS=
+  fi
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+depcc="$CXX"  am_compiler_list=
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5
+$as_echo_n "checking dependency style of $depcc... " >&6; }
+if ${am_cv_CXX_dependencies_compiler_type+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
+  # We make a subdir and do the tests there.  Otherwise we can end up
+  # making bogus files that we don't know about and never remove.  For
+  # instance it was reported that on HP-UX the gcc test will end up
+  # making a dummy file named 'D' -- because '-MD' means "put the output
+  # in D".
+  rm -rf conftest.dir
+  mkdir conftest.dir
+  # Copy depcomp to subdir because otherwise we won't find it if we're
+  # using a relative directory.
+  cp "$am_depcomp" conftest.dir
+  cd conftest.dir
+  # We will build objects and dependencies in a subdirectory because
+  # it helps to detect inapplicable dependency modes.  For instance
+  # both Tru64's cc and ICC support -MD to output dependencies as a
+  # side effect of compilation, but ICC will put the dependencies in
+  # the current directory while Tru64 will put them in the object
+  # directory.
+  mkdir sub
+
+  am_cv_CXX_dependencies_compiler_type=none
+  if test "$am_compiler_list" = ""; then
+     am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp`
+  fi
+  am__universal=false
+  case " $depcc " in #(
+     *\ -arch\ *\ -arch\ *) am__universal=true ;;
+     esac
+
+  for depmode in $am_compiler_list; do
+    # Setup a source with many dependencies, because some compilers
+    # like to wrap large dependency lists on column 80 (with \), and
+    # we should not choose a depcomp mode which is confused by this.
+    #
+    # We need to recreate these files for each test, as the compiler may
+    # overwrite some of them when testing with obscure command lines.
+    # This happens at least with the AIX C compiler.
+    : > sub/conftest.c
+    for i in 1 2 3 4 5 6; do
+      echo '#include "conftst'$i'.h"' >> sub/conftest.c
+      # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with
+      # Solaris 10 /bin/sh.
+      echo '/* dummy */' > sub/conftst$i.h
+    done
+    echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf
+
+    # We check with '-c' and '-o' for the sake of the "dashmstdout"
+    # mode.  It turns out that the SunPro C++ compiler does not properly
+    # handle '-M -o', and we need to detect this.  Also, some Intel
+    # versions had trouble with output in subdirs.
+    am__obj=sub/conftest.${OBJEXT-o}
+    am__minus_obj="-o $am__obj"
+    case $depmode in
+    gcc)
+      # This depmode causes a compiler race in universal mode.
+      test "$am__universal" = false || continue
+      ;;
+    nosideeffect)
+      # After this tag, mechanisms are not by side-effect, so they'll
+      # only be used when explicitly requested.
+      if test "x$enable_dependency_tracking" = xyes; then
+	continue
+      else
+	break
+      fi
+      ;;
+    msvc7 | msvc7msys | msvisualcpp | msvcmsys)
+      # This compiler won't grok '-c -o', but also, the minuso test has
+      # not run yet.  These depmodes are late enough in the game, and
+      # so weak that their functioning should not be impacted.
+      am__obj=conftest.${OBJEXT-o}
+      am__minus_obj=
+      ;;
+    none) break ;;
+    esac
+    if depmode=$depmode \
+       source=sub/conftest.c object=$am__obj \
+       depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \
+       $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \
+         >/dev/null 2>conftest.err &&
+       grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 &&
+       grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 &&
+       grep $am__obj sub/conftest.Po > /dev/null 2>&1 &&
+       ${MAKE-make} -s -f confmf > /dev/null 2>&1; then
+      # icc doesn't choke on unknown options, it will just issue warnings
+      # or remarks (even with -Werror).  So we grep stderr for any message
+      # that says an option was ignored or not supported.
+      # When given -MP, icc 7.0 and 7.1 complain thusly:
+      #   icc: Command line warning: ignoring option '-M'; no argument required
+      # The diagnosis changed in icc 8.0:
+      #   icc: Command line remark: option '-MP' not supported
+      if (grep 'ignoring option' conftest.err ||
+          grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else
+        am_cv_CXX_dependencies_compiler_type=$depmode
+        break
+      fi
+    fi
+  done
+
+  cd ..
+  rm -rf conftest.dir
+else
+  am_cv_CXX_dependencies_compiler_type=none
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CXX_dependencies_compiler_type" >&5
+$as_echo "$am_cv_CXX_dependencies_compiler_type" >&6; }
+CXXDEPMODE=depmode=$am_cv_CXX_dependencies_compiler_type
+
+ if
+  test "x$enable_dependency_tracking" != xno \
+  && test "$am_cv_CXX_dependencies_compiler_type" = gcc3; then
+  am__fastdepCXX_TRUE=
+  am__fastdepCXX_FALSE='#'
+else
+  am__fastdepCXX_TRUE='#'
+  am__fastdepCXX_FALSE=
+fi
+
+
+# By default we simply use the C compiler to build assembly code.
+
+test "${CCAS+set}" = set || CCAS=$CC
+test "${CCASFLAGS+set}" = set || CCASFLAGS=$CFLAGS
+
+
+
+depcc="$CCAS"   am_compiler_list=
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5
+$as_echo_n "checking dependency style of $depcc... " >&6; }
+if ${am_cv_CCAS_dependencies_compiler_type+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
+  # We make a subdir and do the tests there.  Otherwise we can end up
+  # making bogus files that we don't know about and never remove.  For
+  # instance it was reported that on HP-UX the gcc test will end up
+  # making a dummy file named 'D' -- because '-MD' means "put the output
+  # in D".
+  rm -rf conftest.dir
+  mkdir conftest.dir
+  # Copy depcomp to subdir because otherwise we won't find it if we're
+  # using a relative directory.
+  cp "$am_depcomp" conftest.dir
+  cd conftest.dir
+  # We will build objects and dependencies in a subdirectory because
+  # it helps to detect inapplicable dependency modes.  For instance
+  # both Tru64's cc and ICC support -MD to output dependencies as a
+  # side effect of compilation, but ICC will put the dependencies in
+  # the current directory while Tru64 will put them in the object
+  # directory.
+  mkdir sub
+
+  am_cv_CCAS_dependencies_compiler_type=none
+  if test "$am_compiler_list" = ""; then
+     am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp`
+  fi
+  am__universal=false
+
+
+  for depmode in $am_compiler_list; do
+    # Setup a source with many dependencies, because some compilers
+    # like to wrap large dependency lists on column 80 (with \), and
+    # we should not choose a depcomp mode which is confused by this.
+    #
+    # We need to recreate these files for each test, as the compiler may
+    # overwrite some of them when testing with obscure command lines.
+    # This happens at least with the AIX C compiler.
+    : > sub/conftest.c
+    for i in 1 2 3 4 5 6; do
+      echo '#include "conftst'$i'.h"' >> sub/conftest.c
+      # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with
+      # Solaris 10 /bin/sh.
+      echo '/* dummy */' > sub/conftst$i.h
+    done
+    echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf
+
+    # We check with '-c' and '-o' for the sake of the "dashmstdout"
+    # mode.  It turns out that the SunPro C++ compiler does not properly
+    # handle '-M -o', and we need to detect this.  Also, some Intel
+    # versions had trouble with output in subdirs.
+    am__obj=sub/conftest.${OBJEXT-o}
+    am__minus_obj="-o $am__obj"
+    case $depmode in
+    gcc)
+      # This depmode causes a compiler race in universal mode.
+      test "$am__universal" = false || continue
+      ;;
+    nosideeffect)
+      # After this tag, mechanisms are not by side-effect, so they'll
+      # only be used when explicitly requested.
+      if test "x$enable_dependency_tracking" = xyes; then
+	continue
+      else
+	break
+      fi
+      ;;
+    msvc7 | msvc7msys | msvisualcpp | msvcmsys)
+      # This compiler won't grok '-c -o', but also, the minuso test has
+      # not run yet.  These depmodes are late enough in the game, and
+      # so weak that their functioning should not be impacted.
+      am__obj=conftest.${OBJEXT-o}
+      am__minus_obj=
+      ;;
+    none) break ;;
+    esac
+    if depmode=$depmode \
+       source=sub/conftest.c object=$am__obj \
+       depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \
+       $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \
+         >/dev/null 2>conftest.err &&
+       grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 &&
+       grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 &&
+       grep $am__obj sub/conftest.Po > /dev/null 2>&1 &&
+       ${MAKE-make} -s -f confmf > /dev/null 2>&1; then
+      # icc doesn't choke on unknown options, it will just issue warnings
+      # or remarks (even with -Werror).  So we grep stderr for any message
+      # that says an option was ignored or not supported.
+      # When given -MP, icc 7.0 and 7.1 complain thusly:
+      #   icc: Command line warning: ignoring option '-M'; no argument required
+      # The diagnosis changed in icc 8.0:
+      #   icc: Command line remark: option '-MP' not supported
+      if (grep 'ignoring option' conftest.err ||
+          grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else
+        am_cv_CCAS_dependencies_compiler_type=$depmode
+        break
+      fi
+    fi
+  done
+
+  cd ..
+  rm -rf conftest.dir
+else
+  am_cv_CCAS_dependencies_compiler_type=none
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CCAS_dependencies_compiler_type" >&5
+$as_echo "$am_cv_CCAS_dependencies_compiler_type" >&6; }
+CCASDEPMODE=depmode=$am_cv_CCAS_dependencies_compiler_type
+
+ if
+  test "x$enable_dependency_tracking" != xno \
+  && test "$am_cv_CCAS_dependencies_compiler_type" = gcc3; then
+  am__fastdepCCAS_TRUE=
+  am__fastdepCCAS_FALSE='#'
+else
+  am__fastdepCCAS_TRUE='#'
+  am__fastdepCCAS_FALSE=
+fi
+
+
+
+
+
+
+# In order to override CFLAGS_FOR_TARGET, all of our special flags go
+# in XCFLAGS.  But we need them in CFLAGS during configury.  So put them
+# in both places for now and restore CFLAGS at the end of config.
+save_CFLAGS="$CFLAGS"
+
+# Find other programs we need.
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_AR+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$AR"; then
+  ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_AR="${ac_tool_prefix}ar"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+AR=$ac_cv_prog_AR
+if test -n "$AR"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
+$as_echo "$AR" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_AR"; then
+  ac_ct_AR=$AR
+  # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_AR+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_AR"; then
+  ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_AR="ar"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_AR=$ac_cv_prog_ac_ct_AR
+if test -n "$ac_ct_AR"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
+$as_echo "$ac_ct_AR" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_AR" = x; then
+    AR=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    AR=$ac_ct_AR
+  fi
+else
+  AR="$ac_cv_prog_AR"
+fi
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}nm", so it can be a program name with args.
+set dummy ${ac_tool_prefix}nm; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_NM+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$NM"; then
+  ac_cv_prog_NM="$NM" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_NM="${ac_tool_prefix}nm"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+NM=$ac_cv_prog_NM
+if test -n "$NM"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NM" >&5
+$as_echo "$NM" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_NM"; then
+  ac_ct_NM=$NM
+  # Extract the first word of "nm", so it can be a program name with args.
+set dummy nm; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_NM+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_NM"; then
+  ac_cv_prog_ac_ct_NM="$ac_ct_NM" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_NM="nm"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_NM=$ac_cv_prog_ac_ct_NM
+if test -n "$ac_ct_NM"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NM" >&5
+$as_echo "$ac_ct_NM" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_NM" = x; then
+    NM=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    NM=$ac_ct_NM
+  fi
+else
+  NM="$ac_cv_prog_NM"
+fi
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_RANLIB+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
+$as_echo "$RANLIB" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+  ac_ct_RANLIB=$RANLIB
+  # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_RANLIB"; then
+  ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_RANLIB="ranlib"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
+$as_echo "$ac_ct_RANLIB" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_RANLIB" = x; then
+    RANLIB="ranlib-not-found-in-path-error"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    RANLIB=$ac_ct_RANLIB
+  fi
+else
+  RANLIB="$ac_cv_prog_RANLIB"
+fi
+
+# Extract the first word of "perl", so it can be a program name with args.
+set dummy perl; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_path_PERL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  case $PERL in
+  [\\/]* | ?:[\\/]*)
+  ac_cv_path_PERL="$PERL" # Let the user override the test with a path.
+  ;;
+  *)
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_path_PERL="$as_dir/$ac_word$ac_exec_ext"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+  test -z "$ac_cv_path_PERL" && ac_cv_path_PERL="perl-not-found-in-path-error"
+  ;;
+esac
+fi
+PERL=$ac_cv_path_PERL
+if test -n "$PERL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PERL" >&5
+$as_echo "$PERL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
+$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
+set x ${MAKE-make}
+ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
+if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat >conftest.make <<\_ACEOF
+SHELL = /bin/sh
+all:
+	@echo '@@@%%%=$(MAKE)=@@@%%%'
+_ACEOF
+# GNU make sometimes prints "make[1]: Entering ...", which would confuse us.
+case `${MAKE-make} -f conftest.make 2>/dev/null` in
+  *@@@%%%=?*=@@@%%%*)
+    eval ac_cv_prog_make_${ac_make}_set=yes;;
+  *)
+    eval ac_cv_prog_make_${ac_make}_set=no;;
+esac
+rm -f conftest.make
+fi
+if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+  SET_MAKE=
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+  SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+
+case `pwd` in
+  *\ * | *\	*)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5
+$as_echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;;
+esac
+
+
+
+macro_version='2.2.7a'
+macro_revision='1.3134'
+
+
+
+
+
+
+
+
+
+
+
+
+
+ltmain="$ac_aux_dir/ltmain.sh"
+
+# Backslashify metacharacters that are still active within
+# double-quoted strings.
+sed_quote_subst='s/\(["`$\\]\)/\\\1/g'
+
+# Same as above, but do not quote variable references.
+double_quote_subst='s/\(["`\\]\)/\\\1/g'
+
+# Sed substitution to delay expansion of an escaped shell variable in a
+# double_quote_subst'ed string.
+delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
+
+# Sed substitution to delay expansion of an escaped single quote.
+delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g'
+
+# Sed substitution to avoid accidental globbing in evaled expressions
+no_glob_subst='s/\*/\\\*/g'
+
+ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO
+ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to print strings" >&5
+$as_echo_n "checking how to print strings... " >&6; }
+# Test print first, because it will be a builtin if present.
+if test "X`print -r -- -n 2>/dev/null`" = X-n && \
+   test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then
+  ECHO='print -r --'
+elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then
+  ECHO='printf %s\n'
+else
+  # Use this function as a fallback that always works.
+  func_fallback_echo ()
+  {
+    eval 'cat <<_LTECHO_EOF
+$1
+_LTECHO_EOF'
+  }
+  ECHO='func_fallback_echo'
+fi
+
+# func_echo_all arg...
+# Invoke $ECHO with all args, space-separated.
+func_echo_all ()
+{
+    $ECHO ""
+}
+
+case "$ECHO" in
+  printf*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: printf" >&5
+$as_echo "printf" >&6; } ;;
+  print*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: print -r" >&5
+$as_echo "print -r" >&6; } ;;
+  *) { $as_echo "$as_me:${as_lineno-$LINENO}: result: cat" >&5
+$as_echo "cat" >&6; } ;;
+esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a sed that does not truncate output" >&5
+$as_echo_n "checking for a sed that does not truncate output... " >&6; }
+if ${ac_cv_path_SED+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+            ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/
+     for ac_i in 1 2 3 4 5 6 7; do
+       ac_script="$ac_script$as_nl$ac_script"
+     done
+     echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed
+     { ac_script=; unset ac_script;}
+     if test -z "$SED"; then
+  ac_path_SED_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in sed gsed; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_SED="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_SED" || continue
+# Check for GNU ac_path_SED and select it if it is found.
+  # Check for GNU $ac_path_SED
+case `"$ac_path_SED" --version 2>&1` in
+*GNU*)
+  ac_cv_path_SED="$ac_path_SED" ac_path_SED_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo '' >> "conftest.nl"
+    "$ac_path_SED" -f conftest.sed < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_SED_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_SED="$ac_path_SED"
+      ac_path_SED_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_SED_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_SED"; then
+    as_fn_error $? "no acceptable sed could be found in \$PATH" "$LINENO" 5
+  fi
+else
+  ac_cv_path_SED=$SED
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_SED" >&5
+$as_echo "$ac_cv_path_SED" >&6; }
+ SED="$ac_cv_path_SED"
+  rm -f conftest.sed
+
+test -z "$SED" && SED=sed
+Xsed="$SED -e 1s/^X//"
+
+
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5
+$as_echo_n "checking for fgrep... " >&6; }
+if ${ac_cv_path_FGREP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1
+   then ac_cv_path_FGREP="$GREP -F"
+   else
+     if test -z "$FGREP"; then
+  ac_path_FGREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in fgrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext"
+      as_fn_executable_p "$ac_path_FGREP" || continue
+# Check for GNU ac_path_FGREP and select it if it is found.
+  # Check for GNU $ac_path_FGREP
+case `"$ac_path_FGREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'FGREP' >> "conftest.nl"
+    "$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_FGREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_FGREP="$ac_path_FGREP"
+      ac_path_FGREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_FGREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_FGREP"; then
+    as_fn_error $? "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_FGREP=$FGREP
+fi
+
+   fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5
+$as_echo "$ac_cv_path_FGREP" >&6; }
+ FGREP="$ac_cv_path_FGREP"
+
+
+test -z "$GREP" && GREP=grep
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# Check whether --with-gnu-ld was given.
+if test "${with_gnu_ld+set}" = set; then :
+  withval=$with_gnu_ld; test "$withval" = no || with_gnu_ld=yes
+else
+  with_gnu_ld=no
+fi
+
+ac_prog=ld
+if test "$GCC" = yes; then
+  # Check if gcc -print-prog-name=ld gives a path.
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5
+$as_echo_n "checking for ld used by $CC... " >&6; }
+  case $host in
+  *-*-mingw*)
+    # gcc leaves a trailing carriage return which upsets mingw
+    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+  *)
+    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+  esac
+  case $ac_prog in
+    # Accept absolute paths.
+    [\\/]* | ?:[\\/]*)
+      re_direlt='/[^/][^/]*/\.\./'
+      # Canonicalize the pathname of ld
+      ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'`
+      while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do
+	ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"`
+      done
+      test -z "$LD" && LD="$ac_prog"
+      ;;
+  "")
+    # If it fails, then pretend we aren't using GCC.
+    ac_prog=ld
+    ;;
+  *)
+    # If it is relative, then search for the first ld in PATH.
+    with_gnu_ld=unknown
+    ;;
+  esac
+elif test "$with_gnu_ld" = yes; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5
+$as_echo_n "checking for GNU ld... " >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5
+$as_echo_n "checking for non-GNU ld... " >&6; }
+fi
+if ${lt_cv_path_LD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$LD"; then
+  lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+  for ac_dir in $PATH; do
+    IFS="$lt_save_ifs"
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+      lt_cv_path_LD="$ac_dir/$ac_prog"
+      # Check to see if the program is GNU ld.  I'd rather use --version,
+      # but apparently some variants of GNU ld only accept -v.
+      # Break only if it was the GNU/non-GNU ld that we prefer.
+      case `"$lt_cv_path_LD" -v 2>&1 </dev/null` in
+      *GNU* | *'with BFD'*)
+	test "$with_gnu_ld" != no && break
+	;;
+      *)
+	test "$with_gnu_ld" != yes && break
+	;;
+      esac
+    fi
+  done
+  IFS="$lt_save_ifs"
+else
+  lt_cv_path_LD="$LD" # Let the user override the test with a path.
+fi
+fi
+
+LD="$lt_cv_path_LD"
+if test -n "$LD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LD" >&5
+$as_echo "$LD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5
+$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; }
+if ${lt_cv_prog_gnu_ld+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  # I'd rather use --version here, but apparently some GNU lds only accept -v.
+case `$LD -v 2>&1 </dev/null` in
+*GNU* | *'with BFD'*)
+  lt_cv_prog_gnu_ld=yes
+  ;;
+*)
+  lt_cv_prog_gnu_ld=no
+  ;;
+esac
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_gnu_ld" >&5
+$as_echo "$lt_cv_prog_gnu_ld" >&6; }
+with_gnu_ld=$lt_cv_prog_gnu_ld
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD- or MS-compatible name lister (nm)" >&5
+$as_echo_n "checking for BSD- or MS-compatible name lister (nm)... " >&6; }
+if ${lt_cv_path_NM+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$NM"; then
+  # Let the user override the test.
+  lt_cv_path_NM="$NM"
+else
+  lt_nm_to_check="${ac_tool_prefix}nm"
+  if test -n "$ac_tool_prefix" && test "$build" = "$host"; then
+    lt_nm_to_check="$lt_nm_to_check nm"
+  fi
+  for lt_tmp_nm in $lt_nm_to_check; do
+    lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+    for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do
+      IFS="$lt_save_ifs"
+      test -z "$ac_dir" && ac_dir=.
+      tmp_nm="$ac_dir/$lt_tmp_nm"
+      if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext" ; then
+	# Check to see if the nm accepts a BSD-compat flag.
+	# Adding the `sed 1q' prevents false positives on HP-UX, which says:
+	#   nm: unknown option "B" ignored
+	# Tru64's nm complains that /dev/null is an invalid object file
+	case `"$tmp_nm" -B /dev/null 2>&1 | sed '1q'` in
+	*/dev/null* | *'Invalid file or object type'*)
+	  lt_cv_path_NM="$tmp_nm -B"
+	  break
+	  ;;
+	*)
+	  case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in
+	  */dev/null*)
+	    lt_cv_path_NM="$tmp_nm -p"
+	    break
+	    ;;
+	  *)
+	    lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
+	    continue # so that we can try to find one that supports BSD flags
+	    ;;
+	  esac
+	  ;;
+	esac
+      fi
+    done
+    IFS="$lt_save_ifs"
+  done
+  : ${lt_cv_path_NM=no}
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_NM" >&5
+$as_echo "$lt_cv_path_NM" >&6; }
+if test "$lt_cv_path_NM" != "no"; then
+  NM="$lt_cv_path_NM"
+else
+  # Didn't find any BSD compatible name lister, look for dumpbin.
+  if test -n "$DUMPBIN"; then :
+    # Let the user override the test.
+  else
+    if test -n "$ac_tool_prefix"; then
+  for ac_prog in dumpbin "link -dump"
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_DUMPBIN+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$DUMPBIN"; then
+  ac_cv_prog_DUMPBIN="$DUMPBIN" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_DUMPBIN="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+DUMPBIN=$ac_cv_prog_DUMPBIN
+if test -n "$DUMPBIN"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DUMPBIN" >&5
+$as_echo "$DUMPBIN" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$DUMPBIN" && break
+  done
+fi
+if test -z "$DUMPBIN"; then
+  ac_ct_DUMPBIN=$DUMPBIN
+  for ac_prog in dumpbin "link -dump"
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_DUMPBIN+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_DUMPBIN"; then
+  ac_cv_prog_ac_ct_DUMPBIN="$ac_ct_DUMPBIN" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_DUMPBIN="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_DUMPBIN=$ac_cv_prog_ac_ct_DUMPBIN
+if test -n "$ac_ct_DUMPBIN"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DUMPBIN" >&5
+$as_echo "$ac_ct_DUMPBIN" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_DUMPBIN" && break
+done
+
+  if test "x$ac_ct_DUMPBIN" = x; then
+    DUMPBIN=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    DUMPBIN=$ac_ct_DUMPBIN
+  fi
+fi
+
+    case `$DUMPBIN -symbols /dev/null 2>&1 | sed '1q'` in
+    *COFF*)
+      DUMPBIN="$DUMPBIN -symbols"
+      ;;
+    *)
+      DUMPBIN=:
+      ;;
+    esac
+  fi
+
+  if test "$DUMPBIN" != ":"; then
+    NM="$DUMPBIN"
+  fi
+fi
+test -z "$NM" && NM=nm
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the name lister ($NM) interface" >&5
+$as_echo_n "checking the name lister ($NM) interface... " >&6; }
+if ${lt_cv_nm_interface+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_nm_interface="BSD nm"
+  echo "int some_variable = 0;" > conftest.$ac_ext
+  (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&5)
+  (eval "$ac_compile" 2>conftest.err)
+  cat conftest.err >&5
+  (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&5)
+  (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
+  cat conftest.err >&5
+  (eval echo "\"\$as_me:$LINENO: output\"" >&5)
+  cat conftest.out >&5
+  if $GREP 'External.*some_variable' conftest.out > /dev/null; then
+    lt_cv_nm_interface="MS dumpbin"
+  fi
+  rm -f conftest*
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_nm_interface" >&5
+$as_echo "$lt_cv_nm_interface" >&6; }
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5
+$as_echo_n "checking whether ln -s works... " >&6; }
+LN_S=$as_ln_s
+if test "$LN_S" = "ln -s"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5
+$as_echo "no, using $LN_S" >&6; }
+fi
+
+# find the maximum length of command line arguments
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the maximum length of command line arguments" >&5
+$as_echo_n "checking the maximum length of command line arguments... " >&6; }
+if ${lt_cv_sys_max_cmd_len+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+    i=0
+  teststring="ABCD"
+
+  case $build_os in
+  msdosdjgpp*)
+    # On DJGPP, this test can blow up pretty badly due to problems in libc
+    # (any single argument exceeding 2000 bytes causes a buffer overrun
+    # during glob expansion).  Even if it were fixed, the result of this
+    # check would be larger than it should be.
+    lt_cv_sys_max_cmd_len=12288;    # 12K is about right
+    ;;
+
+  gnu*)
+    # Under GNU Hurd, this test is not required because there is
+    # no limit to the length of command line arguments.
+    # Libtool will interpret -1 as no limit whatsoever
+    lt_cv_sys_max_cmd_len=-1;
+    ;;
+
+  cygwin* | mingw* | cegcc*)
+    # On Win9x/ME, this test blows up -- it succeeds, but takes
+    # about 5 minutes as the teststring grows exponentially.
+    # Worse, since 9x/ME are not pre-emptively multitasking,
+    # you end up with a "frozen" computer, even though with patience
+    # the test eventually succeeds (with a max line length of 256k).
+    # Instead, let's just punt: use the minimum linelength reported by
+    # all of the supported platforms: 8192 (on NT/2K/XP).
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  mint*)
+    # On MiNT this can take a long time and run out of memory.
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  amigaos*)
+    # On AmigaOS with pdksh, this test takes hours, literally.
+    # So we just punt and use a minimum line length of 8192.
+    lt_cv_sys_max_cmd_len=8192;
+    ;;
+
+  netbsd* | freebsd* | openbsd* | darwin* | dragonfly*)
+    # This has been around since 386BSD, at least.  Likely further.
+    if test -x /sbin/sysctl; then
+      lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax`
+    elif test -x /usr/sbin/sysctl; then
+      lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax`
+    else
+      lt_cv_sys_max_cmd_len=65536	# usable default for all BSDs
+    fi
+    # And add a safety zone
+    lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
+    lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
+    ;;
+
+  interix*)
+    # We know the value 262144 and hardcode it with a safety zone (like BSD)
+    lt_cv_sys_max_cmd_len=196608
+    ;;
+
+  osf*)
+    # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure
+    # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not
+    # nice to cause kernel panics so lets avoid the loop below.
+    # First set a reasonable default.
+    lt_cv_sys_max_cmd_len=16384
+    #
+    if test -x /sbin/sysconfig; then
+      case `/sbin/sysconfig -q proc exec_disable_arg_limit` in
+        *1*) lt_cv_sys_max_cmd_len=-1 ;;
+      esac
+    fi
+    ;;
+  sco3.2v5*)
+    lt_cv_sys_max_cmd_len=102400
+    ;;
+  sysv5* | sco5v6* | sysv4.2uw2*)
+    kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null`
+    if test -n "$kargmax"; then
+      lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[	 ]//'`
+    else
+      lt_cv_sys_max_cmd_len=32768
+    fi
+    ;;
+  *)
+    lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null`
+    if test -n "$lt_cv_sys_max_cmd_len"; then
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
+    else
+      # Make teststring a little bigger before we do anything with it.
+      # a 1K string should be a reasonable start.
+      for i in 1 2 3 4 5 6 7 8 ; do
+        teststring=$teststring$teststring
+      done
+      SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}}
+      # If test is not a shell built-in, we'll probably end up computing a
+      # maximum length that is only half of the actual maximum length, but
+      # we can't tell.
+      while { test "X"`func_fallback_echo "$teststring$teststring" 2>/dev/null` \
+	         = "X$teststring$teststring"; } >/dev/null 2>&1 &&
+	      test $i != 17 # 1/2 MB should be enough
+      do
+        i=`expr $i + 1`
+        teststring=$teststring$teststring
+      done
+      # Only check the string length outside the loop.
+      lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1`
+      teststring=
+      # Add a significant safety factor because C++ compilers can tack on
+      # massive amounts of additional arguments before passing them to the
+      # linker.  It appears as though 1/2 is a usable value.
+      lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2`
+    fi
+    ;;
+  esac
+
+fi
+
+if test -n $lt_cv_sys_max_cmd_len ; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sys_max_cmd_len" >&5
+$as_echo "$lt_cv_sys_max_cmd_len" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
+$as_echo "none" >&6; }
+fi
+max_cmd_len=$lt_cv_sys_max_cmd_len
+
+
+
+
+
+
+: ${CP="cp -f"}
+: ${MV="mv -f"}
+: ${RM="rm -f"}
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the shell understands some XSI constructs" >&5
+$as_echo_n "checking whether the shell understands some XSI constructs... " >&6; }
+# Try some XSI features
+xsi_shell=no
+( _lt_dummy="a/b/c"
+  test "${_lt_dummy##*/},${_lt_dummy%/*},"${_lt_dummy%"$_lt_dummy"}, \
+      = c,a/b,, \
+    && eval 'test $(( 1 + 1 )) -eq 2 \
+    && test "${#_lt_dummy}" -eq 5' ) >/dev/null 2>&1 \
+  && xsi_shell=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $xsi_shell" >&5
+$as_echo "$xsi_shell" >&6; }
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the shell understands \"+=\"" >&5
+$as_echo_n "checking whether the shell understands \"+=\"... " >&6; }
+lt_shell_append=no
+( foo=bar; set foo baz; eval "$1+=\$2" && test "$foo" = barbaz ) \
+    >/dev/null 2>&1 \
+  && lt_shell_append=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_shell_append" >&5
+$as_echo "$lt_shell_append" >&6; }
+
+
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+  lt_unset=unset
+else
+  lt_unset=false
+fi
+
+
+
+
+
+# test EBCDIC or ASCII
+case `echo X|tr X '\101'` in
+ A) # ASCII based system
+    # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr
+  lt_SP2NL='tr \040 \012'
+  lt_NL2SP='tr \015\012 \040\040'
+  ;;
+ *) # EBCDIC based system
+  lt_SP2NL='tr \100 \n'
+  lt_NL2SP='tr \r\n \100\100'
+  ;;
+esac
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $LD option to reload object files" >&5
+$as_echo_n "checking for $LD option to reload object files... " >&6; }
+if ${lt_cv_ld_reload_flag+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_ld_reload_flag='-r'
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_reload_flag" >&5
+$as_echo "$lt_cv_ld_reload_flag" >&6; }
+reload_flag=$lt_cv_ld_reload_flag
+case $reload_flag in
+"" | " "*) ;;
+*) reload_flag=" $reload_flag" ;;
+esac
+reload_cmds='$LD$reload_flag -o $output$reload_objs'
+case $host_os in
+  darwin*)
+    if test "$GCC" = yes; then
+      reload_cmds='$LTCC $LTCFLAGS -nostdlib ${wl}-r -o $output$reload_objs'
+    else
+      reload_cmds='$LD$reload_flag -o $output$reload_objs'
+    fi
+    ;;
+esac
+
+
+
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args.
+set dummy ${ac_tool_prefix}objdump; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_OBJDUMP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$OBJDUMP"; then
+  ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+OBJDUMP=$ac_cv_prog_OBJDUMP
+if test -n "$OBJDUMP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5
+$as_echo "$OBJDUMP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_OBJDUMP"; then
+  ac_ct_OBJDUMP=$OBJDUMP
+  # Extract the first word of "objdump", so it can be a program name with args.
+set dummy objdump; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_OBJDUMP"; then
+  ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_OBJDUMP="objdump"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP
+if test -n "$ac_ct_OBJDUMP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5
+$as_echo "$ac_ct_OBJDUMP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_OBJDUMP" = x; then
+    OBJDUMP="false"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    OBJDUMP=$ac_ct_OBJDUMP
+  fi
+else
+  OBJDUMP="$ac_cv_prog_OBJDUMP"
+fi
+
+test -z "$OBJDUMP" && OBJDUMP=objdump
+
+
+
+
+
+
+
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to recognize dependent libraries" >&5
+$as_echo_n "checking how to recognize dependent libraries... " >&6; }
+if ${lt_cv_deplibs_check_method+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_file_magic_cmd='$MAGIC_CMD'
+lt_cv_file_magic_test_file=
+lt_cv_deplibs_check_method='unknown'
+# Need to set the preceding variable on all platforms that support
+# interlibrary dependencies.
+# 'none' -- dependencies not supported.
+# `unknown' -- same as none, but documents that we really don't know.
+# 'pass_all' -- all dependencies passed with no checks.
+# 'test_compile' -- check by making test program.
+# 'file_magic [[regex]]' -- check by looking for files in library path
+# which responds to the $file_magic_cmd with a given extended regex.
+# If you have `file' or equivalent on your system and you're not sure
+# whether `pass_all' will *always* work, you probably want this one.
+
+case $host_os in
+aix[4-9]*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+beos*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+bsdi[45]*)
+  lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)'
+  lt_cv_file_magic_cmd='/usr/bin/file -L'
+  lt_cv_file_magic_test_file=/shlib/libc.so
+  ;;
+
+cygwin*)
+  # func_win32_libid is a shell function defined in ltmain.sh
+  lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
+  lt_cv_file_magic_cmd='func_win32_libid'
+  ;;
+
+mingw* | pw32*)
+  # Base MSYS/MinGW do not provide the 'file' command needed by
+  # func_win32_libid shell function, so use a weaker test based on 'objdump',
+  # unless we find 'file', for example because we are cross-compiling.
+  # func_win32_libid assumes BSD nm, so disallow it if using MS dumpbin.
+  if ( test "$lt_cv_nm_interface" = "BSD nm" && file / ) >/dev/null 2>&1; then
+    lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
+    lt_cv_file_magic_cmd='func_win32_libid'
+  else
+    lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?'
+    lt_cv_file_magic_cmd='$OBJDUMP -f'
+  fi
+  ;;
+
+cegcc*)
+  # use the weaker test based on 'objdump'. See mingw*.
+  lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?'
+  lt_cv_file_magic_cmd='$OBJDUMP -f'
+  ;;
+
+darwin* | rhapsody*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+freebsd* | dragonfly*)
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
+    case $host_cpu in
+    i*86 )
+      # Not sure whether the presence of OpenBSD here was a mistake.
+      # Let's accept both of them until this is cleared up.
+      lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library'
+      lt_cv_file_magic_cmd=/usr/bin/file
+      lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+      ;;
+    esac
+  else
+    lt_cv_deplibs_check_method=pass_all
+  fi
+  ;;
+
+gnu*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+haiku*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+hpux10.20* | hpux11*)
+  lt_cv_file_magic_cmd=/usr/bin/file
+  case $host_cpu in
+  ia64*)
+    lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64'
+    lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so
+    ;;
+  hppa*64*)
+    lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]'
+    lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl
+    ;;
+  *)
+    lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9]\.[0-9]) shared library'
+    lt_cv_file_magic_test_file=/usr/lib/libc.sl
+    ;;
+  esac
+  ;;
+
+interix[3-9]*)
+  # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here
+  lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$'
+  ;;
+
+irix5* | irix6* | nonstopux*)
+  case $LD in
+  *-32|*"-32 ") libmagic=32-bit;;
+  *-n32|*"-n32 ") libmagic=N32;;
+  *-64|*"-64 ") libmagic=64-bit;;
+  *) libmagic=never-match;;
+  esac
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+# This must be Linux ELF.
+linux* | k*bsd*-gnu | kopensolaris*-gnu | uclinuxfdpiceabi)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+netbsd*)
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
+    lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$'
+  else
+    lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$'
+  fi
+  ;;
+
+newos6*)
+  lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)'
+  lt_cv_file_magic_cmd=/usr/bin/file
+  lt_cv_file_magic_test_file=/usr/lib/libnls.so
+  ;;
+
+*nto* | *qnx*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+openbsd*)
+  if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+    lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$'
+  else
+    lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$'
+  fi
+  ;;
+
+osf3* | osf4* | osf5*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+rdos*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+solaris*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+
+sysv4 | sysv4.3*)
+  case $host_vendor in
+  motorola)
+    lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]'
+    lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
+    ;;
+  ncr)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  sequent)
+    lt_cv_file_magic_cmd='/bin/file'
+    lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )'
+    ;;
+  sni)
+    lt_cv_file_magic_cmd='/bin/file'
+    lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib"
+    lt_cv_file_magic_test_file=/lib/libc.so
+    ;;
+  siemens)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  pc)
+    lt_cv_deplibs_check_method=pass_all
+    ;;
+  esac
+  ;;
+
+tpf*)
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+vxworks*)
+  # Assume VxWorks cross toolchains are built on Linux, possibly
+  # as canadian for Windows hosts.
+  lt_cv_deplibs_check_method=pass_all
+  ;;
+esac
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_deplibs_check_method" >&5
+$as_echo "$lt_cv_deplibs_check_method" >&6; }
+file_magic_cmd=$lt_cv_file_magic_cmd
+deplibs_check_method=$lt_cv_deplibs_check_method
+test -z "$deplibs_check_method" && deplibs_check_method=unknown
+
+
+
+
+
+
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_AR+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$AR"; then
+  ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_AR="${ac_tool_prefix}ar"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+AR=$ac_cv_prog_AR
+if test -n "$AR"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
+$as_echo "$AR" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_AR"; then
+  ac_ct_AR=$AR
+  # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_AR+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_AR"; then
+  ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_AR="ar"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_AR=$ac_cv_prog_ac_ct_AR
+if test -n "$ac_ct_AR"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
+$as_echo "$ac_ct_AR" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_AR" = x; then
+    AR="false"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    AR=$ac_ct_AR
+  fi
+else
+  AR="$ac_cv_prog_AR"
+fi
+
+test -z "$AR" && AR=ar
+test -z "$AR_FLAGS" && AR_FLAGS=cru
+
+
+
+
+
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
+set dummy ${ac_tool_prefix}strip; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_STRIP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$STRIP"; then
+  ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_STRIP="${ac_tool_prefix}strip"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+STRIP=$ac_cv_prog_STRIP
+if test -n "$STRIP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5
+$as_echo "$STRIP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_STRIP"; then
+  ac_ct_STRIP=$STRIP
+  # Extract the first word of "strip", so it can be a program name with args.
+set dummy strip; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_STRIP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_STRIP"; then
+  ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_STRIP="strip"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP
+if test -n "$ac_ct_STRIP"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5
+$as_echo "$ac_ct_STRIP" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_STRIP" = x; then
+    STRIP=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    STRIP=$ac_ct_STRIP
+  fi
+else
+  STRIP="$ac_cv_prog_STRIP"
+fi
+
+test -z "$STRIP" && STRIP=:
+
+
+
+
+
+
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_RANLIB+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$RANLIB"; then
+  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
+$as_echo "$RANLIB" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+  ac_ct_RANLIB=$RANLIB
+  # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_RANLIB"; then
+  ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_RANLIB="ranlib"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
+$as_echo "$ac_ct_RANLIB" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_RANLIB" = x; then
+    RANLIB=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    RANLIB=$ac_ct_RANLIB
+  fi
+else
+  RANLIB="$ac_cv_prog_RANLIB"
+fi
+
+test -z "$RANLIB" && RANLIB=:
+
+
+
+
+
+
+# Determine commands to create old-style static archives.
+old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs'
+old_postinstall_cmds='chmod 644 $oldlib'
+old_postuninstall_cmds=
+
+if test -n "$RANLIB"; then
+  case $host_os in
+  openbsd*)
+    old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$oldlib"
+    ;;
+  *)
+    old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$oldlib"
+    ;;
+  esac
+  old_archive_cmds="$old_archive_cmds~\$RANLIB \$oldlib"
+fi
+
+case $host_os in
+  darwin*)
+    lock_old_archive_extraction=yes ;;
+  *)
+    lock_old_archive_extraction=no ;;
+esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# If no C compiler was specified, use CC.
+LTCC=${LTCC-"$CC"}
+
+# If no C compiler flags were specified, use CFLAGS.
+LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
+
+# Allow CC to be a program name with arguments.
+compiler=$CC
+
+
+# Check for command to grab the raw symbol name followed by C symbol from nm.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking command to parse $NM output from $compiler object" >&5
+$as_echo_n "checking command to parse $NM output from $compiler object... " >&6; }
+if ${lt_cv_sys_global_symbol_pipe+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+# These are sane defaults that work on at least a few old systems.
+# [They come from Ultrix.  What could be older than Ultrix?!! ;)]
+
+# Character class describing NM global symbol codes.
+symcode='[BCDEGRST]'
+
+# Regexp to match symbols that can be accessed directly from C.
+sympat='\([_A-Za-z][_A-Za-z0-9]*\)'
+
+# Define system-specific variables.
+case $host_os in
+aix*)
+  symcode='[BCDT]'
+  ;;
+cygwin* | mingw* | pw32* | cegcc*)
+  symcode='[ABCDGISTW]'
+  ;;
+hpux*)
+  if test "$host_cpu" = ia64; then
+    symcode='[ABCDEGRST]'
+  fi
+  ;;
+irix* | nonstopux*)
+  symcode='[BCDEGRST]'
+  ;;
+osf*)
+  symcode='[BCDEGQRST]'
+  ;;
+solaris*)
+  symcode='[BDRT]'
+  ;;
+sco3.2v5*)
+  symcode='[DT]'
+  ;;
+sysv4.2uw2*)
+  symcode='[DT]'
+  ;;
+sysv5* | sco5v6* | unixware* | OpenUNIX*)
+  symcode='[ABDT]'
+  ;;
+sysv4)
+  symcode='[DFNSTU]'
+  ;;
+esac
+
+# If we're using GNU nm, then use its standard symbol codes.
+case `$NM -V 2>&1` in
+*GNU* | *'with BFD'*)
+  symcode='[ABCDGIRSTW]' ;;
+esac
+
+# Transform an extracted symbol line into a proper C declaration.
+# Some systems (esp. on ia64) link data and code symbols differently,
+# so use this general approach.
+lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern int \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'"
+
+# Transform an extracted symbol line into symbol name and symbol address
+lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/  {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/  {\"\2\", (void *) \&\2},/p'"
+lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n -e 's/^: \([^ ]*\) $/  {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \(lib[^ ]*\)$/  {\"\2\", (void *) \&\2},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/  {\"lib\2\", (void *) \&\2},/p'"
+
+# Handle CRLF in mingw tool chain
+opt_cr=
+case $build_os in
+mingw*)
+  opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp
+  ;;
+esac
+
+# Try without a prefix underscore, then with it.
+for ac_symprfx in "" "_"; do
+
+  # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol.
+  symxfrm="\\1 $ac_symprfx\\2 \\2"
+
+  # Write the raw and C identifiers.
+  if test "$lt_cv_nm_interface" = "MS dumpbin"; then
+    # Fake it for dumpbin and say T for any non-static function
+    # and D for any global variable.
+    # Also find C++ and __fastcall symbols from MSVC++,
+    # which start with @ or ?.
+    lt_cv_sys_global_symbol_pipe="$AWK '"\
+"     {last_section=section; section=\$ 3};"\
+"     /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\
+"     \$ 0!~/External *\|/{next};"\
+"     / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\
+"     {if(hide[section]) next};"\
+"     {f=0}; \$ 0~/\(\).*\|/{f=1}; {printf f ? \"T \" : \"D \"};"\
+"     {split(\$ 0, a, /\||\r/); split(a[2], s)};"\
+"     s[1]~/^[@?]/{print s[1], s[1]; next};"\
+"     s[1]~prfx {split(s[1],t,\"@\"); print t[1], substr(t[1],length(prfx))}"\
+"     ' prfx=^$ac_symprfx"
+  else
+    lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[	 ]\($symcode$symcode*\)[	 ][	 ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'"
+  fi
+
+  # Check to see that the pipe works correctly.
+  pipe_works=no
+
+  rm -f conftest*
+  cat > conftest.$ac_ext <<_LT_EOF
+#ifdef __cplusplus
+extern "C" {
+#endif
+char nm_test_var;
+void nm_test_func(void);
+void nm_test_func(void){}
+#ifdef __cplusplus
+}
+#endif
+int main(){nm_test_var='a';nm_test_func();return(0);}
+_LT_EOF
+
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    # Now try to grab the symbols.
+    nlist=conftest.nm
+    if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist\""; } >&5
+  (eval $NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && test -s "$nlist"; then
+      # Try sorting and uniquifying the output.
+      if sort "$nlist" | uniq > "$nlist"T; then
+	mv -f "$nlist"T "$nlist"
+      else
+	rm -f "$nlist"T
+      fi
+
+      # Make sure that we snagged all the symbols we need.
+      if $GREP ' nm_test_var$' "$nlist" >/dev/null; then
+	if $GREP ' nm_test_func$' "$nlist" >/dev/null; then
+	  cat <<_LT_EOF > conftest.$ac_ext
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+_LT_EOF
+	  # Now generate the symbol file.
+	  eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext'
+
+	  cat <<_LT_EOF >> conftest.$ac_ext
+
+/* The mapping between symbol names and symbols.  */
+const struct {
+  const char *name;
+  void       *address;
+}
+lt__PROGRAM__LTX_preloaded_symbols[] =
+{
+  { "@PROGRAM@", (void *) 0 },
+_LT_EOF
+	  $SED "s/^$symcode$symcode* \(.*\) \(.*\)$/  {\"\2\", (void *) \&\2},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext
+	  cat <<\_LT_EOF >> conftest.$ac_ext
+  {0, (void *) 0}
+};
+
+/* This works around a problem in FreeBSD linker */
+#ifdef FREEBSD_WORKAROUND
+static const void *lt_preloaded_setup() {
+  return lt__PROGRAM__LTX_preloaded_symbols;
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+_LT_EOF
+	  # Now try linking the two files.
+	  mv conftest.$ac_objext conftstm.$ac_objext
+	  lt_save_LIBS="$LIBS"
+	  lt_save_CFLAGS="$CFLAGS"
+	  LIBS="conftstm.$ac_objext"
+	  CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag"
+	  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && test -s conftest${ac_exeext}; then
+	    pipe_works=yes
+	  fi
+	  LIBS="$lt_save_LIBS"
+	  CFLAGS="$lt_save_CFLAGS"
+	else
+	  echo "cannot find nm_test_func in $nlist" >&5
+	fi
+      else
+	echo "cannot find nm_test_var in $nlist" >&5
+      fi
+    else
+      echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5
+    fi
+  else
+    echo "$progname: failed program was:" >&5
+    cat conftest.$ac_ext >&5
+  fi
+  rm -rf conftest* conftst*
+
+  # Do not use the global_symbol_pipe unless it works.
+  if test "$pipe_works" = yes; then
+    break
+  else
+    lt_cv_sys_global_symbol_pipe=
+  fi
+done
+
+fi
+
+if test -z "$lt_cv_sys_global_symbol_pipe"; then
+  lt_cv_sys_global_symbol_to_cdecl=
+fi
+if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5
+$as_echo "failed" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5
+$as_echo "ok" >&6; }
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# Check whether --enable-libtool-lock was given.
+if test "${enable_libtool_lock+set}" = set; then :
+  enableval=$enable_libtool_lock;
+fi
+
+test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes
+
+# Some flags need to be propagated to the compiler or linker for good
+# libtool support.
+case $host in
+ia64-*-hpux*)
+  # Find out which ABI we are using.
+  echo 'int i;' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    case `/usr/bin/file conftest.$ac_objext` in
+      *ELF-32*)
+	HPUX_IA64_MODE="32"
+	;;
+      *ELF-64*)
+	HPUX_IA64_MODE="64"
+	;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+*-*-irix6*)
+  # Find out which ABI we are using.
+  echo '#line '$LINENO' "configure"' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    if test "$lt_cv_prog_gnu_ld" = yes; then
+      case `/usr/bin/file conftest.$ac_objext` in
+	*32-bit*)
+	  LD="${LD-ld} -melf32bsmip"
+	  ;;
+	*N32*)
+	  LD="${LD-ld} -melf32bmipn32"
+	  ;;
+	*64-bit*)
+	  LD="${LD-ld} -melf64bmip"
+	;;
+      esac
+    else
+      case `/usr/bin/file conftest.$ac_objext` in
+	*32-bit*)
+	  LD="${LD-ld} -32"
+	  ;;
+	*N32*)
+	  LD="${LD-ld} -n32"
+	  ;;
+	*64-bit*)
+	  LD="${LD-ld} -64"
+	  ;;
+      esac
+    fi
+  fi
+  rm -rf conftest*
+  ;;
+
+x86_64-*kfreebsd*-gnu|x86_64-*linux*|powerpc*-*linux*| \
+s390*-*linux*|s390*-*tpf*|sparc*-*linux*)
+  # Find out which ABI we are using.
+  echo 'int i;' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    case `/usr/bin/file conftest.o` in
+      *32-bit*)
+	case $host in
+	  x86_64-*kfreebsd*-gnu)
+	    LD="${LD-ld} -m elf_i386_fbsd"
+	    ;;
+	  x86_64-*linux*)
+	    case `/usr/bin/file conftest.o` in
+	      *x86-64*)
+		LD="${LD-ld} -m elf32_x86_64"
+		;;
+	      *)
+		LD="${LD-ld} -m elf_i386"
+		;;
+	    esac
+	    ;;
+	  powerpc64le-*linux*)
+	    LD="${LD-ld} -m elf32lppclinux"
+	    ;;
+	  powerpc64-*linux*)
+	    LD="${LD-ld} -m elf32ppclinux"
+	    ;;
+	  s390x-*linux*)
+	    LD="${LD-ld} -m elf_s390"
+	    ;;
+	  sparc64-*linux*)
+	    LD="${LD-ld} -m elf32_sparc"
+	    ;;
+	esac
+	;;
+      *64-bit*)
+	case $host in
+	  x86_64-*kfreebsd*-gnu)
+	    LD="${LD-ld} -m elf_x86_64_fbsd"
+	    ;;
+	  x86_64-*linux*)
+	    LD="${LD-ld} -m elf_x86_64"
+	    ;;
+	  powerpcle-*linux*)
+	    LD="${LD-ld} -m elf64lppc"
+	    ;;
+	  powerpc-*linux*)
+	    LD="${LD-ld} -m elf64ppc"
+	    ;;
+	  s390*-*linux*|s390*-*tpf*)
+	    LD="${LD-ld} -m elf64_s390"
+	    ;;
+	  sparc*-*linux*)
+	    LD="${LD-ld} -m elf64_sparc"
+	    ;;
+	esac
+	;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+
+*-*-sco3.2v5*)
+  # On SCO OpenServer 5, we need -belf to get full-featured binaries.
+  SAVE_CFLAGS="$CFLAGS"
+  CFLAGS="$CFLAGS -belf"
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler needs -belf" >&5
+$as_echo_n "checking whether the C compiler needs -belf... " >&6; }
+if ${lt_cv_cc_needs_belf+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+     if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  lt_cv_cc_needs_belf=yes
+else
+  lt_cv_cc_needs_belf=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+     ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_cc_needs_belf" >&5
+$as_echo "$lt_cv_cc_needs_belf" >&6; }
+  if test x"$lt_cv_cc_needs_belf" != x"yes"; then
+    # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
+    CFLAGS="$SAVE_CFLAGS"
+  fi
+  ;;
+sparc*-*solaris*)
+  # Find out which ABI we are using.
+  echo 'int i;' > conftest.$ac_ext
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+    case `/usr/bin/file conftest.o` in
+    *64-bit*)
+      case $lt_cv_prog_gnu_ld in
+      yes*) LD="${LD-ld} -m elf64_sparc" ;;
+      *)
+	if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then
+	  LD="${LD-ld} -64"
+	fi
+	;;
+      esac
+      ;;
+    esac
+  fi
+  rm -rf conftest*
+  ;;
+esac
+
+need_locks="$enable_libtool_lock"
+
+
+  case $host_os in
+    rhapsody* | darwin*)
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args.
+set dummy ${ac_tool_prefix}dsymutil; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_DSYMUTIL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$DSYMUTIL"; then
+  ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+DSYMUTIL=$ac_cv_prog_DSYMUTIL
+if test -n "$DSYMUTIL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DSYMUTIL" >&5
+$as_echo "$DSYMUTIL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_DSYMUTIL"; then
+  ac_ct_DSYMUTIL=$DSYMUTIL
+  # Extract the first word of "dsymutil", so it can be a program name with args.
+set dummy dsymutil; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_DSYMUTIL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_DSYMUTIL"; then
+  ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_DSYMUTIL="dsymutil"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL
+if test -n "$ac_ct_DSYMUTIL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DSYMUTIL" >&5
+$as_echo "$ac_ct_DSYMUTIL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_DSYMUTIL" = x; then
+    DSYMUTIL=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    DSYMUTIL=$ac_ct_DSYMUTIL
+  fi
+else
+  DSYMUTIL="$ac_cv_prog_DSYMUTIL"
+fi
+
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args.
+set dummy ${ac_tool_prefix}nmedit; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_NMEDIT+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$NMEDIT"; then
+  ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+NMEDIT=$ac_cv_prog_NMEDIT
+if test -n "$NMEDIT"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NMEDIT" >&5
+$as_echo "$NMEDIT" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_NMEDIT"; then
+  ac_ct_NMEDIT=$NMEDIT
+  # Extract the first word of "nmedit", so it can be a program name with args.
+set dummy nmedit; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_NMEDIT+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_NMEDIT"; then
+  ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_NMEDIT="nmedit"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT
+if test -n "$ac_ct_NMEDIT"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NMEDIT" >&5
+$as_echo "$ac_ct_NMEDIT" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_NMEDIT" = x; then
+    NMEDIT=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    NMEDIT=$ac_ct_NMEDIT
+  fi
+else
+  NMEDIT="$ac_cv_prog_NMEDIT"
+fi
+
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args.
+set dummy ${ac_tool_prefix}lipo; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_LIPO+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$LIPO"; then
+  ac_cv_prog_LIPO="$LIPO" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_LIPO="${ac_tool_prefix}lipo"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+LIPO=$ac_cv_prog_LIPO
+if test -n "$LIPO"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIPO" >&5
+$as_echo "$LIPO" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_LIPO"; then
+  ac_ct_LIPO=$LIPO
+  # Extract the first word of "lipo", so it can be a program name with args.
+set dummy lipo; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_LIPO+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_LIPO"; then
+  ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_LIPO="lipo"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO
+if test -n "$ac_ct_LIPO"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LIPO" >&5
+$as_echo "$ac_ct_LIPO" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_LIPO" = x; then
+    LIPO=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    LIPO=$ac_ct_LIPO
+  fi
+else
+  LIPO="$ac_cv_prog_LIPO"
+fi
+
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args.
+set dummy ${ac_tool_prefix}otool; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_OTOOL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$OTOOL"; then
+  ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_OTOOL="${ac_tool_prefix}otool"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+OTOOL=$ac_cv_prog_OTOOL
+if test -n "$OTOOL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL" >&5
+$as_echo "$OTOOL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_OTOOL"; then
+  ac_ct_OTOOL=$OTOOL
+  # Extract the first word of "otool", so it can be a program name with args.
+set dummy otool; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_OTOOL+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_OTOOL"; then
+  ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_OTOOL="otool"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL
+if test -n "$ac_ct_OTOOL"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL" >&5
+$as_echo "$ac_ct_OTOOL" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_OTOOL" = x; then
+    OTOOL=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    OTOOL=$ac_ct_OTOOL
+  fi
+else
+  OTOOL="$ac_cv_prog_OTOOL"
+fi
+
+    if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args.
+set dummy ${ac_tool_prefix}otool64; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_OTOOL64+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$OTOOL64"; then
+  ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+OTOOL64=$ac_cv_prog_OTOOL64
+if test -n "$OTOOL64"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL64" >&5
+$as_echo "$OTOOL64" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_OTOOL64"; then
+  ac_ct_OTOOL64=$OTOOL64
+  # Extract the first word of "otool64", so it can be a program name with args.
+set dummy otool64; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_OTOOL64+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_OTOOL64"; then
+  ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_OTOOL64="otool64"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64
+if test -n "$ac_ct_OTOOL64"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL64" >&5
+$as_echo "$ac_ct_OTOOL64" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_OTOOL64" = x; then
+    OTOOL64=":"
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    OTOOL64=$ac_ct_OTOOL64
+  fi
+else
+  OTOOL64="$ac_cv_prog_OTOOL64"
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -single_module linker flag" >&5
+$as_echo_n "checking for -single_module linker flag... " >&6; }
+if ${lt_cv_apple_cc_single_mod+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_apple_cc_single_mod=no
+      if test -z "${LT_MULTI_MODULE}"; then
+	# By default we will add the -single_module flag. You can override
+	# by either setting the environment variable LT_MULTI_MODULE
+	# non-empty at configure time, or by adding -multi_module to the
+	# link flags.
+	rm -rf libconftest.dylib*
+	echo "int foo(void){return 1;}" > conftest.c
+	echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
+-dynamiclib -Wl,-single_module conftest.c" >&5
+	$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
+	  -dynamiclib -Wl,-single_module conftest.c 2>conftest.err
+        _lt_result=$?
+	if test -f libconftest.dylib && test ! -s conftest.err && test $_lt_result = 0; then
+	  lt_cv_apple_cc_single_mod=yes
+	else
+	  cat conftest.err >&5
+	fi
+	rm -rf libconftest.dylib*
+	rm -f conftest.*
+      fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_apple_cc_single_mod" >&5
+$as_echo "$lt_cv_apple_cc_single_mod" >&6; }
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -exported_symbols_list linker flag" >&5
+$as_echo_n "checking for -exported_symbols_list linker flag... " >&6; }
+if ${lt_cv_ld_exported_symbols_list+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_ld_exported_symbols_list=no
+      save_LDFLAGS=$LDFLAGS
+      echo "_main" > conftest.sym
+      LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym"
+      if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  lt_cv_ld_exported_symbols_list=yes
+else
+  lt_cv_ld_exported_symbols_list=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+	LDFLAGS="$save_LDFLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_exported_symbols_list" >&5
+$as_echo "$lt_cv_ld_exported_symbols_list" >&6; }
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -force_load linker flag" >&5
+$as_echo_n "checking for -force_load linker flag... " >&6; }
+if ${lt_cv_ld_force_load+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_ld_force_load=no
+      cat > conftest.c << _LT_EOF
+int forced_loaded() { return 2;}
+_LT_EOF
+      echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&5
+      $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&5
+      echo "$AR cru libconftest.a conftest.o" >&5
+      $AR cru libconftest.a conftest.o 2>&5
+      cat > conftest.c << _LT_EOF
+int main() { return 0;}
+_LT_EOF
+      echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&5
+      $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err
+      _lt_result=$?
+      if test -f conftest && test ! -s conftest.err && test $_lt_result = 0 && $GREP forced_load conftest 2>&1 >/dev/null; then
+	lt_cv_ld_force_load=yes
+      else
+	cat conftest.err >&5
+      fi
+        rm -f conftest.err libconftest.a conftest conftest.c
+        rm -rf conftest.dSYM
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_force_load" >&5
+$as_echo "$lt_cv_ld_force_load" >&6; }
+    # Allow for Darwin 4-7 (macOS 10.0-10.3) although these are not expect to
+    # build without first building modern cctools / linker.
+    case $host_cpu-$host_os in
+    *-rhapsody* | *-darwin1.[012])
+      _lt_dar_allow_undefined='${wl}-undefined ${wl}suppress' ;;
+    *-darwin1.*)
+      _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;;
+    *-darwin*)
+      # darwin 5.x (macOS 10.1) onwards we only need to adjust when the
+      # deployment target is forced to an earlier version.
+      case ${MACOSX_DEPLOYMENT_TARGET-UNSET},$host in
+	UNSET,*-darwin[89]*|UNSET,*-darwin[12][0123456789]*)
+	  ;;
+	10.[012][,.]*)
+	  _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress'
+	  ;;
+	*)
+	  ;;
+     esac
+    ;;
+  esac
+    if test "$lt_cv_apple_cc_single_mod" = "yes"; then
+      _lt_dar_single_mod='$single_module'
+    fi
+    if test "$lt_cv_ld_exported_symbols_list" = "yes"; then
+      _lt_dar_export_syms=' ${wl}-exported_symbols_list,$output_objdir/${libname}-symbols.expsym'
+    else
+      _lt_dar_export_syms='~$NMEDIT -s $output_objdir/${libname}-symbols.expsym ${lib}'
+    fi
+    if test "$DSYMUTIL" != ":" && test "$lt_cv_ld_force_load" = "no"; then
+      _lt_dsymutil='~$DSYMUTIL $lib || :'
+    else
+      _lt_dsymutil=
+    fi
+    ;;
+  esac
+
+for ac_header in dlfcn.h
+do :
+  ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default
+"
+if test "x$ac_cv_header_dlfcn_h" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_DLFCN_H 1
+_ACEOF
+
+fi
+
+done
+
+
+
+
+
+
+# Set options
+
+
+
+        enable_dlopen=no
+
+
+  enable_win32_dll=no
+
+
+            # Check whether --enable-shared was given.
+if test "${enable_shared+set}" = set; then :
+  enableval=$enable_shared; p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_shared=yes ;;
+    no) enable_shared=no ;;
+    *)
+      enable_shared=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
+      for pkg in $enableval; do
+	IFS="$lt_save_ifs"
+	if test "X$pkg" = "X$p"; then
+	  enable_shared=yes
+	fi
+      done
+      IFS="$lt_save_ifs"
+      ;;
+    esac
+else
+  enable_shared=yes
+fi
+
+
+
+
+
+
+
+
+
+  # Check whether --enable-static was given.
+if test "${enable_static+set}" = set; then :
+  enableval=$enable_static; p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_static=yes ;;
+    no) enable_static=no ;;
+    *)
+     enable_static=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
+      for pkg in $enableval; do
+	IFS="$lt_save_ifs"
+	if test "X$pkg" = "X$p"; then
+	  enable_static=yes
+	fi
+      done
+      IFS="$lt_save_ifs"
+      ;;
+    esac
+else
+  enable_static=yes
+fi
+
+
+
+
+
+
+
+
+
+
+# Check whether --with-pic was given.
+if test "${with_pic+set}" = set; then :
+  withval=$with_pic; pic_mode="$withval"
+else
+  pic_mode=default
+fi
+
+
+test -z "$pic_mode" && pic_mode=default
+
+
+
+
+
+
+
+  # Check whether --enable-fast-install was given.
+if test "${enable_fast_install+set}" = set; then :
+  enableval=$enable_fast_install; p=${PACKAGE-default}
+    case $enableval in
+    yes) enable_fast_install=yes ;;
+    no) enable_fast_install=no ;;
+    *)
+      enable_fast_install=no
+      # Look at the argument we got.  We use all the common list separators.
+      lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
+      for pkg in $enableval; do
+	IFS="$lt_save_ifs"
+	if test "X$pkg" = "X$p"; then
+	  enable_fast_install=yes
+	fi
+      done
+      IFS="$lt_save_ifs"
+      ;;
+    esac
+else
+  enable_fast_install=yes
+fi
+
+
+
+
+
+
+
+
+
+
+
+# This can be used to rebuild libtool when needed
+LIBTOOL_DEPS="$ltmain"
+
+# Always use our own libtool.
+LIBTOOL='$(SHELL) $(top_builddir)/libtool'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+test -z "$LN_S" && LN_S="ln -s"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+if test -n "${ZSH_VERSION+set}" ; then
+   setopt NO_GLOB_SUBST
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for objdir" >&5
+$as_echo_n "checking for objdir... " >&6; }
+if ${lt_cv_objdir+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  rm -f .libs 2>/dev/null
+mkdir .libs 2>/dev/null
+if test -d .libs; then
+  lt_cv_objdir=.libs
+else
+  # MS-DOS does not allow filenames that begin with a dot.
+  lt_cv_objdir=_libs
+fi
+rmdir .libs 2>/dev/null
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_objdir" >&5
+$as_echo "$lt_cv_objdir" >&6; }
+objdir=$lt_cv_objdir
+
+
+
+
+
+cat >>confdefs.h <<_ACEOF
+#define LT_OBJDIR "$lt_cv_objdir/"
+_ACEOF
+
+
+
+
+case $host_os in
+aix3*)
+  # AIX sometimes has problems with the GCC collect2 program.  For some
+  # reason, if we set the COLLECT_NAMES environment variable, the problems
+  # vanish in a puff of smoke.
+  if test "X${COLLECT_NAMES+set}" != Xset; then
+    COLLECT_NAMES=
+    export COLLECT_NAMES
+  fi
+  ;;
+esac
+
+# Global variables:
+ofile=libtool
+can_build_shared=yes
+
+# All known linkers require a `.a' archive for static linking (except MSVC,
+# which needs '.lib').
+libext=a
+
+with_gnu_ld="$lt_cv_prog_gnu_ld"
+
+old_CC="$CC"
+old_CFLAGS="$CFLAGS"
+
+# Set sane defaults for various variables
+test -z "$CC" && CC=cc
+test -z "$LTCC" && LTCC=$CC
+test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS
+test -z "$LD" && LD=ld
+test -z "$ac_objext" && ac_objext=o
+
+for cc_temp in $compiler""; do
+  case $cc_temp in
+    compile | *[\\/]compile | ccache | *[\\/]ccache ) ;;
+    distcc | *[\\/]distcc | purify | *[\\/]purify ) ;;
+    \-*) ;;
+    *) break;;
+  esac
+done
+cc_basename=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"`
+
+
+# Only perform the check for file, if the check method requires it
+test -z "$MAGIC_CMD" && MAGIC_CMD=file
+case $deplibs_check_method in
+file_magic*)
+  if test "$file_magic_cmd" = '$MAGIC_CMD'; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ac_tool_prefix}file" >&5
+$as_echo_n "checking for ${ac_tool_prefix}file... " >&6; }
+if ${lt_cv_path_MAGIC_CMD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  case $MAGIC_CMD in
+[\\/*] |  ?:[\\/]*)
+  lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
+  ;;
+*)
+  lt_save_MAGIC_CMD="$MAGIC_CMD"
+  lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+  ac_dummy="/usr/bin$PATH_SEPARATOR$PATH"
+  for ac_dir in $ac_dummy; do
+    IFS="$lt_save_ifs"
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/${ac_tool_prefix}file; then
+      lt_cv_path_MAGIC_CMD="$ac_dir/${ac_tool_prefix}file"
+      if test -n "$file_magic_test_file"; then
+	case $deplibs_check_method in
+	"file_magic "*)
+	  file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
+	  MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+	    $EGREP "$file_magic_regex" > /dev/null; then
+	    :
+	  else
+	    cat <<_LT_EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such.  This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem.  Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+_LT_EOF
+	  fi ;;
+	esac
+      fi
+      break
+    fi
+  done
+  IFS="$lt_save_ifs"
+  MAGIC_CMD="$lt_save_MAGIC_CMD"
+  ;;
+esac
+fi
+
+MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+if test -n "$MAGIC_CMD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5
+$as_echo "$MAGIC_CMD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+
+
+
+if test -z "$lt_cv_path_MAGIC_CMD"; then
+  if test -n "$ac_tool_prefix"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for file" >&5
+$as_echo_n "checking for file... " >&6; }
+if ${lt_cv_path_MAGIC_CMD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  case $MAGIC_CMD in
+[\\/*] |  ?:[\\/]*)
+  lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
+  ;;
+*)
+  lt_save_MAGIC_CMD="$MAGIC_CMD"
+  lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+  ac_dummy="/usr/bin$PATH_SEPARATOR$PATH"
+  for ac_dir in $ac_dummy; do
+    IFS="$lt_save_ifs"
+    test -z "$ac_dir" && ac_dir=.
+    if test -f $ac_dir/file; then
+      lt_cv_path_MAGIC_CMD="$ac_dir/file"
+      if test -n "$file_magic_test_file"; then
+	case $deplibs_check_method in
+	"file_magic "*)
+	  file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
+	  MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+	    $EGREP "$file_magic_regex" > /dev/null; then
+	    :
+	  else
+	    cat <<_LT_EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such.  This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem.  Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+_LT_EOF
+	  fi ;;
+	esac
+      fi
+      break
+    fi
+  done
+  IFS="$lt_save_ifs"
+  MAGIC_CMD="$lt_save_MAGIC_CMD"
+  ;;
+esac
+fi
+
+MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+if test -n "$MAGIC_CMD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5
+$as_echo "$MAGIC_CMD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  else
+    MAGIC_CMD=:
+  fi
+fi
+
+  fi
+  ;;
+esac
+
+# Use C for the default configuration in the libtool script
+
+lt_save_CC="$CC"
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+# Source file extension for C test sources.
+ac_ext=c
+
+# Object file extension for compiled C test sources.
+objext=o
+objext=$objext
+
+# Code to be used in simple compile tests
+lt_simple_compile_test_code="int some_variable = 0;"
+
+# Code to be used in simple link tests
+lt_simple_link_test_code='int main(){return(0);}'
+
+
+
+
+
+
+
+# If no C compiler was specified, use CC.
+LTCC=${LTCC-"$CC"}
+
+# If no C compiler flags were specified, use CFLAGS.
+LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
+
+# Allow CC to be a program name with arguments.
+compiler=$CC
+
+# Save the default compiler, since it gets overwritten when the other
+# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP.
+compiler_DEFAULT=$CC
+
+# save warnings/boilerplate of simple test code
+ac_outfile=conftest.$ac_objext
+echo "$lt_simple_compile_test_code" >conftest.$ac_ext
+eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
+_lt_compiler_boilerplate=`cat conftest.err`
+$RM conftest*
+
+ac_outfile=conftest.$ac_objext
+echo "$lt_simple_link_test_code" >conftest.$ac_ext
+eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
+_lt_linker_boilerplate=`cat conftest.err`
+$RM -r conftest*
+
+
+## CAVEAT EMPTOR:
+## There is no encapsulation within the following macros, do not change
+## the running order or otherwise move them around unless you know exactly
+## what you are doing...
+if test -n "$compiler"; then
+
+lt_prog_compiler_no_builtin_flag=
+
+if test "$GCC" = yes; then
+  case $cc_basename in
+  nvcc*)
+    lt_prog_compiler_no_builtin_flag=' -Xcompiler -fno-builtin' ;;
+  *)
+    lt_prog_compiler_no_builtin_flag=' -fno-builtin' ;;
+  esac
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -fno-rtti -fno-exceptions" >&5
+$as_echo_n "checking if $compiler supports -fno-rtti -fno-exceptions... " >&6; }
+if ${lt_cv_prog_compiler_rtti_exceptions+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_rtti_exceptions=no
+   ac_outfile=conftest.$ac_objext
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+   lt_compiler_flag="-fno-rtti -fno-exceptions"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   # The option is referenced via a variable to avoid confusing sed.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>conftest.err)
+   ac_status=$?
+   cat conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s "$ac_outfile"; then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings other than the usual output.
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
+     $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+     if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_rtti_exceptions=yes
+     fi
+   fi
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_rtti_exceptions" >&5
+$as_echo "$lt_cv_prog_compiler_rtti_exceptions" >&6; }
+
+if test x"$lt_cv_prog_compiler_rtti_exceptions" = xyes; then
+    lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions"
+else
+    :
+fi
+
+fi
+
+
+
+
+
+
+  lt_prog_compiler_wl=
+lt_prog_compiler_pic=
+lt_prog_compiler_static=
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5
+$as_echo_n "checking for $compiler option to produce PIC... " >&6; }
+
+  if test "$GCC" = yes; then
+    lt_prog_compiler_wl='-Wl,'
+    lt_prog_compiler_static='-static'
+
+    case $host_os in
+      aix*)
+      # All AIX code is PIC.
+      if test "$host_cpu" = ia64; then
+	# AIX 5 now supports IA64 processor
+	lt_prog_compiler_static='-Bstatic'
+      fi
+      lt_prog_compiler_pic='-fPIC'
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            lt_prog_compiler_pic='-fPIC'
+        ;;
+      m68k)
+            # FIXME: we need at least 68020 code to build shared libraries, but
+            # adding the `-m68020' flag to GCC prevents building anything better,
+            # like `-m68040'.
+            lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4'
+        ;;
+      esac
+      ;;
+
+    beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
+      # PIC is the default for these OSes.
+      ;;
+
+    mingw* | cygwin* | pw32* | os2* | cegcc*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      # Although the cygwin gcc ignores -fPIC, still need this for old-style
+      # (--disable-auto-import) libraries
+      lt_prog_compiler_pic='-DDLL_EXPORT'
+      ;;
+
+    darwin* | rhapsody*)
+      # PIC is the default on this platform
+      # Common symbols not allowed in MH_DYLIB files
+      lt_prog_compiler_pic='-fno-common'
+      ;;
+
+    haiku*)
+      # PIC is the default for Haiku.
+      # The "-static" flag exists, but is broken.
+      lt_prog_compiler_static=
+      ;;
+
+    hpux*)
+      # PIC is the default for 64-bit PA HP-UX, but not for 32-bit
+      # PA HP-UX.  On IA64 HP-UX, PIC is the default but the pic flag
+      # sets the default TLS model and affects inlining.
+      case $host_cpu in
+      hppa*64*)
+	# +Z the default
+	;;
+      *)
+	lt_prog_compiler_pic='-fPIC'
+	;;
+      esac
+      ;;
+
+    interix[3-9]*)
+      # Interix 3.x gcc -fpic/-fPIC options generate broken code.
+      # Instead, we relocate shared libraries at runtime.
+      ;;
+
+    msdosdjgpp*)
+      # Just because we use GCC doesn't mean we suddenly get shared libraries
+      # on systems that don't support them.
+      lt_prog_compiler_can_build_shared=no
+      enable_shared=no
+      ;;
+
+    *nto* | *qnx*)
+      # QNX uses GNU C++, but need to define -shared option too, otherwise
+      # it will coredump.
+      lt_prog_compiler_pic='-fPIC -shared'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	lt_prog_compiler_pic=-Kconform_pic
+      fi
+      ;;
+
+    *)
+      lt_prog_compiler_pic='-fPIC'
+      ;;
+    esac
+
+    case $cc_basename in
+    nvcc*) # Cuda Compiler Driver 2.2
+      lt_prog_compiler_wl='-Xlinker '
+      lt_prog_compiler_pic='-Xcompiler -fPIC'
+      ;;
+    esac
+  else
+    # PORTME Check for flag to pass linker flags through the system compiler.
+    case $host_os in
+    aix*)
+      lt_prog_compiler_wl='-Wl,'
+      if test "$host_cpu" = ia64; then
+	# AIX 5 now supports IA64 processor
+	lt_prog_compiler_static='-Bstatic'
+      else
+	lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp'
+      fi
+      ;;
+
+    mingw* | cygwin* | pw32* | os2* | cegcc*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      lt_prog_compiler_pic='-DDLL_EXPORT'
+      ;;
+
+    hpux9* | hpux10* | hpux11*)
+      lt_prog_compiler_wl='-Wl,'
+      # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but
+      # not for PA HP-UX.
+      case $host_cpu in
+      hppa*64*|ia64*)
+	# +Z the default
+	;;
+      *)
+	lt_prog_compiler_pic='+Z'
+	;;
+      esac
+      # Is there a better lt_prog_compiler_static that works with the bundled CC?
+      lt_prog_compiler_static='${wl}-a ${wl}archive'
+      ;;
+
+    irix5* | irix6* | nonstopux*)
+      lt_prog_compiler_wl='-Wl,'
+      # PIC (with -KPIC) is the default.
+      lt_prog_compiler_static='-non_shared'
+      ;;
+
+    linux* | k*bsd*-gnu | kopensolaris*-gnu)
+      case $cc_basename in
+      # old Intel for x86_64 which still supported -KPIC.
+      ecc*)
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-KPIC'
+	lt_prog_compiler_static='-static'
+        ;;
+      # icc used to be incompatible with GCC.
+      # ICC 10 doesn't accept -KPIC any more.
+      icc* | ifort*)
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-fPIC'
+	lt_prog_compiler_static='-static'
+        ;;
+      # Lahey Fortran 8.1.
+      lf95*)
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='--shared'
+	lt_prog_compiler_static='--static'
+	;;
+      pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*)
+        # Portland Group compilers (*not* the Pentium gcc compiler,
+	# which looks to be a dead project)
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-fpic'
+	lt_prog_compiler_static='-Bstatic'
+        ;;
+      ccc*)
+        lt_prog_compiler_wl='-Wl,'
+        # All Alpha code is PIC.
+        lt_prog_compiler_static='-non_shared'
+        ;;
+      xl* | bgxl* | bgf* | mpixl*)
+	# IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene
+	lt_prog_compiler_wl='-Wl,'
+	lt_prog_compiler_pic='-qpic'
+	lt_prog_compiler_static='-qstaticlink'
+	;;
+      *)
+	case `$CC -V 2>&1 | sed 5q` in
+	*Sun\ F* | *Sun*Fortran*)
+	  # Sun Fortran 8.3 passes all unrecognized flags to the linker
+	  lt_prog_compiler_pic='-KPIC'
+	  lt_prog_compiler_static='-Bstatic'
+	  lt_prog_compiler_wl=''
+	  ;;
+	*Sun\ C*)
+	  # Sun C 5.9
+	  lt_prog_compiler_pic='-KPIC'
+	  lt_prog_compiler_static='-Bstatic'
+	  lt_prog_compiler_wl='-Wl,'
+	  ;;
+	esac
+	;;
+      esac
+      ;;
+
+    newsos6)
+      lt_prog_compiler_pic='-KPIC'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    *nto* | *qnx*)
+      # QNX uses GNU C++, but need to define -shared option too, otherwise
+      # it will coredump.
+      lt_prog_compiler_pic='-fPIC -shared'
+      ;;
+
+    osf3* | osf4* | osf5*)
+      lt_prog_compiler_wl='-Wl,'
+      # All OSF/1 code is PIC.
+      lt_prog_compiler_static='-non_shared'
+      ;;
+
+    rdos*)
+      lt_prog_compiler_static='-non_shared'
+      ;;
+
+    solaris*)
+      lt_prog_compiler_pic='-KPIC'
+      lt_prog_compiler_static='-Bstatic'
+      case $cc_basename in
+      f77* | f90* | f95*)
+	lt_prog_compiler_wl='-Qoption ld ';;
+      *)
+	lt_prog_compiler_wl='-Wl,';;
+      esac
+      ;;
+
+    sunos4*)
+      lt_prog_compiler_wl='-Qoption ld '
+      lt_prog_compiler_pic='-PIC'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    sysv4 | sysv4.2uw2* | sysv4.3*)
+      lt_prog_compiler_wl='-Wl,'
+      lt_prog_compiler_pic='-KPIC'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec ;then
+	lt_prog_compiler_pic='-Kconform_pic'
+	lt_prog_compiler_static='-Bstatic'
+      fi
+      ;;
+
+    sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
+      lt_prog_compiler_wl='-Wl,'
+      lt_prog_compiler_pic='-KPIC'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    unicos*)
+      lt_prog_compiler_wl='-Wl,'
+      lt_prog_compiler_can_build_shared=no
+      ;;
+
+    uts4*)
+      lt_prog_compiler_pic='-pic'
+      lt_prog_compiler_static='-Bstatic'
+      ;;
+
+    *)
+      lt_prog_compiler_can_build_shared=no
+      ;;
+    esac
+  fi
+
+case $host_os in
+  # For platforms which do not support PIC, -DPIC is meaningless:
+  *djgpp*)
+    lt_prog_compiler_pic=
+    ;;
+  *)
+    lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC"
+    ;;
+esac
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_prog_compiler_pic" >&5
+$as_echo "$lt_prog_compiler_pic" >&6; }
+
+
+
+
+
+
+#
+# Check to make sure the PIC flag actually works.
+#
+if test -n "$lt_prog_compiler_pic"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5
+$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic works... " >&6; }
+if ${lt_cv_prog_compiler_pic_works+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_pic_works=no
+   ac_outfile=conftest.$ac_objext
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+   lt_compiler_flag="$lt_prog_compiler_pic -DPIC"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   # The option is referenced via a variable to avoid confusing sed.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>conftest.err)
+   ac_status=$?
+   cat conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s "$ac_outfile"; then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings other than the usual output.
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
+     $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+     if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_pic_works=yes
+     fi
+   fi
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works" >&5
+$as_echo "$lt_cv_prog_compiler_pic_works" >&6; }
+
+if test x"$lt_cv_prog_compiler_pic_works" = xyes; then
+    case $lt_prog_compiler_pic in
+     "" | " "*) ;;
+     *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;;
+     esac
+else
+    lt_prog_compiler_pic=
+     lt_prog_compiler_can_build_shared=no
+fi
+
+fi
+
+
+
+
+
+
+#
+# Check to make sure the static flag actually works.
+#
+wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5
+$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; }
+if ${lt_cv_prog_compiler_static_works+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_static_works=no
+   save_LDFLAGS="$LDFLAGS"
+   LDFLAGS="$LDFLAGS $lt_tmp_static_flag"
+   echo "$lt_simple_link_test_code" > conftest.$ac_ext
+   if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
+     # The linker can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     if test -s conftest.err; then
+       # Append any errors to the config.log.
+       cat conftest.err 1>&5
+       $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
+       $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+       if diff conftest.exp conftest.er2 >/dev/null; then
+         lt_cv_prog_compiler_static_works=yes
+       fi
+     else
+       lt_cv_prog_compiler_static_works=yes
+     fi
+   fi
+   $RM -r conftest*
+   LDFLAGS="$save_LDFLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works" >&5
+$as_echo "$lt_cv_prog_compiler_static_works" >&6; }
+
+if test x"$lt_cv_prog_compiler_static_works" = xyes; then
+    :
+else
+    lt_prog_compiler_static=
+fi
+
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
+$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
+if ${lt_cv_prog_compiler_c_o+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_c_o=no
+   $RM -r conftest 2>/dev/null
+   mkdir conftest
+   cd conftest
+   mkdir out
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+   lt_compiler_flag="-o out/conftest2.$ac_objext"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>out/conftest.err)
+   ac_status=$?
+   cat out/conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s out/conftest2.$ac_objext
+   then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
+     $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
+     if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_c_o=yes
+     fi
+   fi
+   chmod u+w . 2>&5
+   $RM conftest*
+   # SGI C++ compiler will create directory out/ii_files/ for
+   # template instantiation
+   test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
+   $RM out/* && rmdir out
+   cd ..
+   $RM -r conftest
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5
+$as_echo "$lt_cv_prog_compiler_c_o" >&6; }
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
+$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
+if ${lt_cv_prog_compiler_c_o+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_c_o=no
+   $RM -r conftest 2>/dev/null
+   mkdir conftest
+   cd conftest
+   mkdir out
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+   lt_compiler_flag="-o out/conftest2.$ac_objext"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>out/conftest.err)
+   ac_status=$?
+   cat out/conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s out/conftest2.$ac_objext
+   then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
+     $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
+     if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_c_o=yes
+     fi
+   fi
+   chmod u+w . 2>&5
+   $RM conftest*
+   # SGI C++ compiler will create directory out/ii_files/ for
+   # template instantiation
+   test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
+   $RM out/* && rmdir out
+   cd ..
+   $RM -r conftest
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5
+$as_echo "$lt_cv_prog_compiler_c_o" >&6; }
+
+
+
+
+hard_links="nottested"
+if test "$lt_cv_prog_compiler_c_o" = no && test "$need_locks" != no; then
+  # do not overwrite the value of need_locks provided by the user
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5
+$as_echo_n "checking if we can lock with hard links... " >&6; }
+  hard_links=yes
+  $RM conftest*
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  touch conftest.a
+  ln conftest.a conftest.b 2>&5 || hard_links=no
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5
+$as_echo "$hard_links" >&6; }
+  if test "$hard_links" = no; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5
+$as_echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;}
+    need_locks=warn
+  fi
+else
+  need_locks=no
+fi
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5
+$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; }
+
+  runpath_var=
+  allow_undefined_flag=
+  always_export_symbols=no
+  archive_cmds=
+  archive_expsym_cmds=
+  compiler_needs_object=no
+  enable_shared_with_static_runtimes=no
+  export_dynamic_flag_spec=
+  export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
+  hardcode_automatic=no
+  hardcode_direct=no
+  hardcode_direct_absolute=no
+  hardcode_libdir_flag_spec=
+  hardcode_libdir_flag_spec_ld=
+  hardcode_libdir_separator=
+  hardcode_minus_L=no
+  hardcode_shlibpath_var=unsupported
+  inherit_rpath=no
+  link_all_deplibs=unknown
+  module_cmds=
+  module_expsym_cmds=
+  old_archive_from_new_cmds=
+  old_archive_from_expsyms_cmds=
+  thread_safe_flag_spec=
+  whole_archive_flag_spec=
+  # include_expsyms should be a list of space-separated symbols to be *always*
+  # included in the symbol list
+  include_expsyms=
+  # exclude_expsyms can be an extended regexp of symbols to exclude
+  # it will be wrapped by ` (' and `)$', so one must not match beginning or
+  # end of line.  Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
+  # as well as any symbol that contains `d'.
+  exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*'
+  # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
+  # platforms (ab)use it in PIC code, but their linkers get confused if
+  # the symbol is explicitly referenced.  Since portable code cannot
+  # rely on this symbol name, it's probably fine to never include it in
+  # preloaded symbol tables.
+  # Exclude shared library initialization/finalization symbols.
+  extract_expsyms_cmds=
+
+  case $host_os in
+  cygwin* | mingw* | pw32* | cegcc*)
+    # FIXME: the MSVC++ port hasn't been tested in a loooong time
+    # When not using gcc, we currently assume that we are using
+    # Microsoft Visual C++.
+    if test "$GCC" != yes; then
+      with_gnu_ld=no
+    fi
+    ;;
+  interix*)
+    # we just hope/assume this is gcc and not c89 (= MSVC++)
+    with_gnu_ld=yes
+    ;;
+  openbsd*)
+    with_gnu_ld=no
+    ;;
+  esac
+
+  ld_shlibs=yes
+
+  # On some targets, GNU ld is compatible enough with the native linker
+  # that we're better off using the native interface for both.
+  lt_use_gnu_ld_interface=no
+  if test "$with_gnu_ld" = yes; then
+    case $host_os in
+      aix*)
+	# The AIX port of GNU ld has always aspired to compatibility
+	# with the native linker.  However, as the warning in the GNU ld
+	# block says, versions before 2.19.5* couldn't really create working
+	# shared libraries, regardless of the interface used.
+	case `$LD -v 2>&1` in
+	  *\ \(GNU\ Binutils\)\ 2.19.5*) ;;
+	  *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;;
+	  *\ \(GNU\ Binutils\)\ [3-9]*) ;;
+	  *)
+	    lt_use_gnu_ld_interface=yes
+	    ;;
+	esac
+	;;
+      *)
+	lt_use_gnu_ld_interface=yes
+	;;
+    esac
+  fi
+
+  if test "$lt_use_gnu_ld_interface" = yes; then
+    # If archive_cmds runs LD, not CC, wlarc should be empty
+    wlarc='${wl}'
+
+    # Set some defaults for GNU ld with shared library support. These
+    # are reset later if shared libraries are not supported. Putting them
+    # here allows them to be overridden if necessary.
+    runpath_var=LD_RUN_PATH
+    hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+    export_dynamic_flag_spec='${wl}--export-dynamic'
+    # ancient GNU ld didn't support --whole-archive et. al.
+    if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then
+      whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
+    else
+      whole_archive_flag_spec=
+    fi
+    supports_anon_versioning=no
+    case `$LD -v 2>&1` in
+      *GNU\ gold*) supports_anon_versioning=yes ;;
+      *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11
+      *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
+      *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
+      *\ 2.11.*) ;; # other 2.11 versions
+      *) supports_anon_versioning=yes ;;
+    esac
+
+    # See if GNU ld supports shared libraries.
+    case $host_os in
+    aix[3-9]*)
+      # On AIX/PPC, the GNU linker is very broken
+      if test "$host_cpu" != ia64; then
+	ld_shlibs=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: the GNU linker, at least up to release 2.19, is reported
+*** to be unable to reliably create shared libraries on AIX.
+*** Therefore, libtool is disabling shared libraries support.  If you
+*** really care for shared libraries, you may want to install binutils
+*** 2.20 or above, or modify your PATH so that a non-GNU linker is found.
+*** You will then need to restart the configuration process.
+
+_LT_EOF
+      fi
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+            archive_expsym_cmds=''
+        ;;
+      m68k)
+            archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+            hardcode_libdir_flag_spec='-L$libdir'
+            hardcode_minus_L=yes
+        ;;
+      esac
+      ;;
+
+    beos*)
+      if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	allow_undefined_flag=unsupported
+	# Joseph Beckenbach <jrb3@best.com> says some releases of gcc
+	# support --undefined.  This deserves some investigation.  FIXME
+	archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+      else
+	ld_shlibs=no
+      fi
+      ;;
+
+    cygwin* | mingw* | pw32* | cegcc*)
+      # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless,
+      # as there is no search path for DLLs.
+      hardcode_libdir_flag_spec='-L$libdir'
+      export_dynamic_flag_spec='${wl}--export-all-symbols'
+      allow_undefined_flag=unsupported
+      always_export_symbols=no
+      enable_shared_with_static_runtimes=yes
+      export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols'
+
+      if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
+        archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+	# If the export-symbols file already is a .def file (1st line
+	# is EXPORTS), use it as is; otherwise, prepend...
+	archive_expsym_cmds='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
+	  cp $export_symbols $output_objdir/$soname.def;
+	else
+	  echo EXPORTS > $output_objdir/$soname.def;
+	  cat $export_symbols >> $output_objdir/$soname.def;
+	fi~
+	$CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+      else
+	ld_shlibs=no
+      fi
+      ;;
+
+    haiku*)
+      archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+      link_all_deplibs=yes
+      ;;
+
+    interix[3-9]*)
+      hardcode_direct=no
+      hardcode_shlibpath_var=no
+      hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+      export_dynamic_flag_spec='${wl}-E'
+      # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
+      # Instead, shared libraries are loaded at an image base (0x10000000 by
+      # default) and relocated if they conflict, which is a slow very memory
+      # consuming and fragmenting process.  To avoid this, we pick a random,
+      # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
+      # time.  Moving up from 0x10000000 also allows more sbrk(2) space.
+      archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+      archive_expsym_cmds='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+      ;;
+
+    gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu | uclinuxfdpiceabi)
+      tmp_diet=no
+      if test "$host_os" = linux-dietlibc; then
+	case $cc_basename in
+	  diet\ *) tmp_diet=yes;;	# linux-dietlibc with static linking (!diet-dyn)
+	esac
+      fi
+      if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \
+	 && test "$tmp_diet" = no
+      then
+	tmp_addflag=' $pic_flag'
+	tmp_sharedflag='-shared'
+	case $cc_basename,$host_cpu in
+        pgcc*)				# Portland Group C compiler
+	  whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
+	  tmp_addflag=' $pic_flag'
+	  ;;
+	pgf77* | pgf90* | pgf95* | pgfortran*)
+					# Portland Group f77 and f90 compilers
+	  whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
+	  tmp_addflag=' $pic_flag -Mnomain' ;;
+	ecc*,ia64* | icc*,ia64*)	# Intel C compiler on ia64
+	  tmp_addflag=' -i_dynamic' ;;
+	efc*,ia64* | ifort*,ia64*)	# Intel Fortran compiler on ia64
+	  tmp_addflag=' -i_dynamic -nofor_main' ;;
+	ifc* | ifort*)			# Intel Fortran compiler
+	  tmp_addflag=' -nofor_main' ;;
+	lf95*)				# Lahey Fortran 8.1
+	  whole_archive_flag_spec=
+	  tmp_sharedflag='--shared' ;;
+	xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below)
+	  tmp_sharedflag='-qmkshrobj'
+	  tmp_addflag= ;;
+	nvcc*)	# Cuda Compiler Driver 2.2
+	  whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
+	  compiler_needs_object=yes
+	  ;;
+	esac
+	case `$CC -V 2>&1 | sed 5q` in
+	*Sun\ C*)			# Sun C 5.9
+	  whole_archive_flag_spec='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
+	  compiler_needs_object=yes
+	  tmp_sharedflag='-G' ;;
+	*Sun\ F*)			# Sun Fortran 8.3
+	  tmp_sharedflag='-G' ;;
+	esac
+	archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+
+        if test "x$supports_anon_versioning" = xyes; then
+          archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~
+	    cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
+	    echo "local: *; };" >> $output_objdir/$libname.ver~
+	    $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib'
+        fi
+
+	case $cc_basename in
+	xlf* | bgf* | bgxlf* | mpixlf*)
+	  # IBM XL Fortran 10.1 on PPC cannot create shared libs itself
+	  whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive'
+	  hardcode_libdir_flag_spec=
+	  hardcode_libdir_flag_spec_ld='-rpath $libdir'
+	  archive_cmds='$LD -shared $libobjs $deplibs $compiler_flags -soname $soname -o $lib'
+	  if test "x$supports_anon_versioning" = xyes; then
+	    archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~
+	      cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
+	      echo "local: *; };" >> $output_objdir/$libname.ver~
+	      $LD -shared $libobjs $deplibs $compiler_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib'
+	  fi
+	  ;;
+	esac
+      else
+        ld_shlibs=no
+      fi
+      ;;
+
+    netbsd*)
+      if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+	archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
+	wlarc=
+      else
+	archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+	archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+      fi
+      ;;
+
+    solaris*)
+      if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then
+	ld_shlibs=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: The releases 2.8.* of the GNU linker cannot reliably
+*** create shared libraries on Solaris systems.  Therefore, libtool
+*** is disabling shared libraries support.  We urge you to upgrade GNU
+*** binutils to release 2.9.1 or newer.  Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+_LT_EOF
+      elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+	archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+      else
+	ld_shlibs=no
+      fi
+      ;;
+
+    sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*)
+      case `$LD -v 2>&1` in
+        *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*)
+	ld_shlibs=no
+	cat <<_LT_EOF 1>&2
+
+*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not
+*** reliably create shared libraries on SCO systems.  Therefore, libtool
+*** is disabling shared libraries support.  We urge you to upgrade GNU
+*** binutils to release 2.16.91.0.3 or newer.  Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+_LT_EOF
+	;;
+	*)
+	  # For security reasons, it is highly recommended that you always
+	  # use absolute paths for naming shared libraries, and exclude the
+	  # DT_RUNPATH tag from executables and libraries.  But doing so
+	  # requires that you compile everything twice, which is a pain.
+	  if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	    hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+	    archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+	    archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+	  else
+	    ld_shlibs=no
+	  fi
+	;;
+      esac
+      ;;
+
+    sunos4*)
+      archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+      wlarc=
+      hardcode_direct=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    *)
+      if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+	archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+      else
+	ld_shlibs=no
+      fi
+      ;;
+    esac
+
+    if test "$ld_shlibs" = no; then
+      runpath_var=
+      hardcode_libdir_flag_spec=
+      export_dynamic_flag_spec=
+      whole_archive_flag_spec=
+    fi
+  else
+    # PORTME fill in a description of your system's linker (not GNU ld)
+    case $host_os in
+    aix3*)
+      allow_undefined_flag=unsupported
+      always_export_symbols=yes
+      archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
+      # Note: this linker hardcodes the directories in LIBPATH if there
+      # are no directories specified by -L.
+      hardcode_minus_L=yes
+      if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then
+	# Neither direct hardcoding nor static linking is supported with a
+	# broken collect2.
+	hardcode_direct=unsupported
+      fi
+      ;;
+
+    aix[4-9]*)
+      if test "$host_cpu" = ia64; then
+	# On IA64, the linker does run time linking by default, so we don't
+	# have to do anything special.
+	aix_use_runtimelinking=no
+	exp_sym_flag='-Bexport'
+	no_entry_flag=""
+      else
+	# If we're using GNU nm, then we don't want the "-C" option.
+	# -C means demangle to AIX nm, but means don't demangle with GNU nm
+	# Also, AIX nm treats weak defined symbols like other global
+	# defined symbols, whereas GNU nm marks them as "W".
+	if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
+	  export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
+	else
+	  export_symbols_cmds='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "L")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
+	fi
+	aix_use_runtimelinking=no
+
+	# Test if we are trying to use run time linking or normal
+	# AIX style linking. If -brtl is somewhere in LDFLAGS, we
+	# need to do runtime linking.
+	case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*)
+	  for ld_flag in $LDFLAGS; do
+	  if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
+	    aix_use_runtimelinking=yes
+	    break
+	  fi
+	  done
+	  ;;
+	esac
+
+	exp_sym_flag='-bexport'
+	no_entry_flag='-bnoentry'
+      fi
+
+      # When large executables or shared objects are built, AIX ld can
+      # have problems creating the table of contents.  If linking a library
+      # or program results in "error TOC overflow" add -mminimal-toc to
+      # CXXFLAGS/CFLAGS for g++/gcc.  In the cases where that is not
+      # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
+
+      archive_cmds=''
+      hardcode_direct=yes
+      hardcode_direct_absolute=yes
+      hardcode_libdir_separator=':'
+      link_all_deplibs=yes
+      file_list_spec='${wl}-f,'
+
+      if test "$GCC" = yes; then
+	case $host_os in aix4.[012]|aix4.[012].*)
+	# We only want to do this on AIX 4.2 and lower, the check
+	# below for broken collect2 doesn't work under 4.3+
+	  collect2name=`${CC} -print-prog-name=collect2`
+	  if test -f "$collect2name" &&
+	   strings "$collect2name" | $GREP resolve_lib_name >/dev/null
+	  then
+	  # We have reworked collect2
+	  :
+	  else
+	  # We have old collect2
+	  hardcode_direct=unsupported
+	  # It fails to find uninstalled libraries when the uninstalled
+	  # path is not listed in the libpath.  Setting hardcode_minus_L
+	  # to unsupported forces relinking
+	  hardcode_minus_L=yes
+	  hardcode_libdir_flag_spec='-L$libdir'
+	  hardcode_libdir_separator=
+	  fi
+	  ;;
+	esac
+	shared_flag='-shared'
+	if test "$aix_use_runtimelinking" = yes; then
+	  shared_flag="$shared_flag "'${wl}-G'
+	fi
+      else
+	# not using gcc
+	if test "$host_cpu" = ia64; then
+	# VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
+	# chokes on -Wl,-G. The following line is correct:
+	  shared_flag='-G'
+	else
+	  if test "$aix_use_runtimelinking" = yes; then
+	    shared_flag='${wl}-G'
+	  else
+	    shared_flag='${wl}-bM:SRE'
+	  fi
+	fi
+      fi
+
+      export_dynamic_flag_spec='${wl}-bexpall'
+      # It seems that -bexpall does not export symbols beginning with
+      # underscore (_), so it is better to generate a list of symbols to export.
+      always_export_symbols=yes
+      if test "$aix_use_runtimelinking" = yes; then
+	# Warning - without using the other runtime loading flags (-brtl),
+	# -berok will link without error, but may produce a broken library.
+	allow_undefined_flag='-berok'
+        # Determine the default libpath from the value encoded in an
+        # empty executable.
+        if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+lt_aix_libpath_sed='
+    /Import File Strings/,/^$/ {
+	/^0/ {
+	    s/^0  *\(.*\)$/\1/
+	    p
+	}
+    }'
+aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+# Check for a 64-bit object if we didn't find anything.
+if test -z "$aix_libpath"; then
+  aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi
+
+        hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath"
+        archive_expsym_cmds='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag"
+      else
+	if test "$host_cpu" = ia64; then
+	  hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib'
+	  allow_undefined_flag="-z nodefs"
+	  archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols"
+	else
+	 # Determine the default libpath from the value encoded in an
+	 # empty executable.
+	 if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+lt_aix_libpath_sed='
+    /Import File Strings/,/^$/ {
+	/^0/ {
+	    s/^0  *\(.*\)$/\1/
+	    p
+	}
+    }'
+aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+# Check for a 64-bit object if we didn't find anything.
+if test -z "$aix_libpath"; then
+  aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi
+
+	 hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath"
+	  # Warning - without using the other run time loading flags,
+	  # -berok will link without error, but may produce a broken library.
+	  no_undefined_flag=' ${wl}-bernotok'
+	  allow_undefined_flag=' ${wl}-berok'
+	  if test "$with_gnu_ld" = yes; then
+	    # We only use this code for GNU lds that support --whole-archive.
+	    whole_archive_flag_spec='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
+	  else
+	    # Exported symbols can be pulled into shared objects from archives
+	    whole_archive_flag_spec='$convenience'
+	  fi
+	  archive_cmds_need_lc=yes
+	  # This is similar to how AIX traditionally builds its shared libraries.
+	  archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname'
+	fi
+      fi
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+            archive_expsym_cmds=''
+        ;;
+      m68k)
+            archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+            hardcode_libdir_flag_spec='-L$libdir'
+            hardcode_minus_L=yes
+        ;;
+      esac
+      ;;
+
+    bsdi[45]*)
+      export_dynamic_flag_spec=-rdynamic
+      ;;
+
+    cygwin* | mingw* | pw32* | cegcc*)
+      # When not using gcc, we currently assume that we are using
+      # Microsoft Visual C++.
+      # hardcode_libdir_flag_spec is actually meaningless, as there is
+      # no search path for DLLs.
+      hardcode_libdir_flag_spec=' '
+      allow_undefined_flag=unsupported
+      # Tell ltmain to make .lib files, not .a files.
+      libext=lib
+      # Tell ltmain to make .dll files, not .so files.
+      shrext_cmds=".dll"
+      # FIXME: Setting linknames here is a bad hack.
+      archive_cmds='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames='
+      # The linker will automatically build a .lib file if we build a DLL.
+      old_archive_from_new_cmds='true'
+      # FIXME: Should let the user specify the lib program.
+      old_archive_cmds='lib -OUT:$oldlib$oldobjs$old_deplibs'
+      fix_srcfile_path='`cygpath -w "$srcfile"`'
+      enable_shared_with_static_runtimes=yes
+      ;;
+
+    darwin* | rhapsody*)
+
+
+  archive_cmds_need_lc=no
+  hardcode_direct=no
+  hardcode_automatic=yes
+  hardcode_shlibpath_var=unsupported
+  if test "$lt_cv_ld_force_load" = "yes"; then
+    whole_archive_flag_spec='`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience ${wl}-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`'
+  else
+    whole_archive_flag_spec=''
+  fi
+  link_all_deplibs=yes
+  allow_undefined_flag="$_lt_dar_allow_undefined"
+  case $cc_basename in
+     ifort*) _lt_dar_can_shared=yes ;;
+     *) _lt_dar_can_shared=$GCC ;;
+  esac
+  if test "$_lt_dar_can_shared" = "yes"; then
+    output_verbose_link_cmd=func_echo_all
+    archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}"
+    module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}"
+    archive_expsym_cmds="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}"
+    module_expsym_cmds="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}"
+
+  else
+  ld_shlibs=no
+  fi
+
+      ;;
+
+    dgux*)
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_shlibpath_var=no
+      ;;
+
+    # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
+    # support.  Future versions do this automatically, but an explicit c++rt0.o
+    # does not break anything, and helps significantly (at the cost of a little
+    # extra space).
+    freebsd2.2*)
+      archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
+      hardcode_libdir_flag_spec='-R$libdir'
+      hardcode_direct=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    # Unfortunately, older versions of FreeBSD 2 do not have this feature.
+    freebsd2.*)
+      archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_direct=yes
+      hardcode_minus_L=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
+    freebsd* | dragonfly*)
+      archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags'
+      hardcode_libdir_flag_spec='-R$libdir'
+      hardcode_direct=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    hpux9*)
+      if test "$GCC" = yes; then
+	archive_cmds='$RM $output_objdir/$soname~$CC -shared -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
+      else
+	archive_cmds='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
+      fi
+      hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+      hardcode_libdir_separator=:
+      hardcode_direct=yes
+
+      # hardcode_minus_L: Not really in the search PATH,
+      # but as the default location of the library.
+      hardcode_minus_L=yes
+      export_dynamic_flag_spec='${wl}-E'
+      ;;
+
+    hpux10*)
+      if test "$GCC" = yes && test "$with_gnu_ld" = no; then
+	archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
+      fi
+      if test "$with_gnu_ld" = no; then
+	hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+	hardcode_libdir_flag_spec_ld='+b $libdir'
+	hardcode_libdir_separator=:
+	hardcode_direct=yes
+	hardcode_direct_absolute=yes
+	export_dynamic_flag_spec='${wl}-E'
+	# hardcode_minus_L: Not really in the search PATH,
+	# but as the default location of the library.
+	hardcode_minus_L=yes
+      fi
+      ;;
+
+    hpux11*)
+      if test "$GCC" = yes && test "$with_gnu_ld" = no; then
+	case $host_cpu in
+	hppa*64*)
+	  archive_cmds='$CC -shared ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	ia64*)
+	  archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	*)
+	  archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	esac
+      else
+	case $host_cpu in
+	hppa*64*)
+	  archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	ia64*)
+	  archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	*)
+
+	  # Older versions of the 11.00 compiler do not understand -b yet
+	  # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does)
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $CC understands -b" >&5
+$as_echo_n "checking if $CC understands -b... " >&6; }
+if ${lt_cv_prog_compiler__b+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler__b=no
+   save_LDFLAGS="$LDFLAGS"
+   LDFLAGS="$LDFLAGS -b"
+   echo "$lt_simple_link_test_code" > conftest.$ac_ext
+   if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
+     # The linker can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     if test -s conftest.err; then
+       # Append any errors to the config.log.
+       cat conftest.err 1>&5
+       $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
+       $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+       if diff conftest.exp conftest.er2 >/dev/null; then
+         lt_cv_prog_compiler__b=yes
+       fi
+     else
+       lt_cv_prog_compiler__b=yes
+     fi
+   fi
+   $RM -r conftest*
+   LDFLAGS="$save_LDFLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler__b" >&5
+$as_echo "$lt_cv_prog_compiler__b" >&6; }
+
+if test x"$lt_cv_prog_compiler__b" = xyes; then
+    archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
+else
+    archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
+fi
+
+	  ;;
+	esac
+      fi
+      if test "$with_gnu_ld" = no; then
+	hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+	hardcode_libdir_separator=:
+
+	case $host_cpu in
+	hppa*64*|ia64*)
+	  hardcode_direct=no
+	  hardcode_shlibpath_var=no
+	  ;;
+	*)
+	  hardcode_direct=yes
+	  hardcode_direct_absolute=yes
+	  export_dynamic_flag_spec='${wl}-E'
+
+	  # hardcode_minus_L: Not really in the search PATH,
+	  # but as the default location of the library.
+	  hardcode_minus_L=yes
+	  ;;
+	esac
+      fi
+      ;;
+
+    irix5* | irix6* | nonstopux*)
+      if test "$GCC" = yes; then
+	archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+	# Try to use the -exported_symbol ld option, if it does not
+	# work, assume that -exports_file does not work either and
+	# implicitly export all symbols.
+        save_LDFLAGS="$LDFLAGS"
+        LDFLAGS="$LDFLAGS -shared ${wl}-exported_symbol ${wl}foo ${wl}-update_registry ${wl}/dev/null"
+        if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+int foo(void) {}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations ${wl}-exports_file ${wl}$export_symbols -o $lib'
+
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+        LDFLAGS="$save_LDFLAGS"
+      else
+	archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
+	archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -exports_file $export_symbols -o $lib'
+      fi
+      archive_cmds_need_lc='no'
+      hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+      hardcode_libdir_separator=:
+      inherit_rpath=yes
+      link_all_deplibs=yes
+      ;;
+
+    netbsd*)
+      if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+	archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'  # a.out
+      else
+	archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags'      # ELF
+      fi
+      hardcode_libdir_flag_spec='-R$libdir'
+      hardcode_direct=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    newsos6)
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_direct=yes
+      hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+      hardcode_libdir_separator=:
+      hardcode_shlibpath_var=no
+      ;;
+
+    *nto* | *qnx*)
+      ;;
+
+    openbsd*)
+      if test -f /usr/libexec/ld.so; then
+	hardcode_direct=yes
+	hardcode_shlibpath_var=no
+	hardcode_direct_absolute=yes
+	if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+	  archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+	  archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols'
+	  hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+	  export_dynamic_flag_spec='${wl}-E'
+	else
+	  case $host_os in
+	   openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*)
+	     archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+	     hardcode_libdir_flag_spec='-R$libdir'
+	     ;;
+	   *)
+	     archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
+	     hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+	     ;;
+	  esac
+	fi
+      else
+	ld_shlibs=no
+      fi
+      ;;
+
+    os2*)
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_minus_L=yes
+      allow_undefined_flag=unsupported
+      archive_cmds='$ECHO "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~echo DATA >> $output_objdir/$libname.def~echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
+      old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
+      ;;
+
+    osf3*)
+      if test "$GCC" = yes; then
+	allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+	archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+      else
+	allow_undefined_flag=' -expect_unresolved \*'
+	archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
+      fi
+      archive_cmds_need_lc='no'
+      hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+      hardcode_libdir_separator=:
+      ;;
+
+    osf4* | osf5*)	# as osf3* with the addition of -msym flag
+      if test "$GCC" = yes; then
+	allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+	archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+	hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+      else
+	allow_undefined_flag=' -expect_unresolved \*'
+	archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
+	archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~
+	$CC -shared${allow_undefined_flag} ${wl}-input ${wl}$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~$RM $lib.exp'
+
+	# Both c and cxx compiler support -rpath directly
+	hardcode_libdir_flag_spec='-rpath $libdir'
+      fi
+      archive_cmds_need_lc='no'
+      hardcode_libdir_separator=:
+      ;;
+
+    solaris*)
+      no_undefined_flag=' -z defs'
+      if test "$GCC" = yes; then
+	wlarc='${wl}'
+	archive_cmds='$CC -shared ${wl}-z ${wl}text ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+	  $CC -shared ${wl}-z ${wl}text ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
+      else
+	case `$CC -V 2>&1` in
+	*"Compilers 5.0"*)
+	  wlarc=''
+	  archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+	  $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp'
+	  ;;
+	*)
+	  wlarc='${wl}'
+	  archive_cmds='$CC -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $compiler_flags'
+	  archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+	  $CC -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
+	  ;;
+	esac
+      fi
+      hardcode_libdir_flag_spec='-R$libdir'
+      hardcode_shlibpath_var=no
+      case $host_os in
+      solaris2.[0-5] | solaris2.[0-5].*) ;;
+      *)
+	# The compiler driver will combine and reorder linker options,
+	# but understands `-z linker_flag'.  GCC discards it without `$wl',
+	# but is careful enough not to reorder.
+	# Supported since Solaris 2.6 (maybe 2.5.1?)
+	if test "$GCC" = yes; then
+	  whole_archive_flag_spec='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract'
+	else
+	  whole_archive_flag_spec='-z allextract$convenience -z defaultextract'
+	fi
+	;;
+      esac
+      link_all_deplibs=yes
+      ;;
+
+    sunos4*)
+      if test "x$host_vendor" = xsequent; then
+	# Use $CC to link under sequent, because it throws in some extra .o
+	# files that make .init and .fini sections work.
+	archive_cmds='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
+      fi
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_direct=yes
+      hardcode_minus_L=yes
+      hardcode_shlibpath_var=no
+      ;;
+
+    sysv4)
+      case $host_vendor in
+	sni)
+	  archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  hardcode_direct=yes # is this really true???
+	;;
+	siemens)
+	  ## LD is ld it makes a PLAMLIB
+	  ## CC just makes a GrossModule.
+	  archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags'
+	  reload_cmds='$CC -r -o $output$reload_objs'
+	  hardcode_direct=no
+        ;;
+	motorola)
+	  archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	  hardcode_direct=no #Motorola manual says yes, but my tests say they lie
+	;;
+      esac
+      runpath_var='LD_RUN_PATH'
+      hardcode_shlibpath_var=no
+      ;;
+
+    sysv4.3*)
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_shlibpath_var=no
+      export_dynamic_flag_spec='-Bexport'
+      ;;
+
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+	hardcode_shlibpath_var=no
+	runpath_var=LD_RUN_PATH
+	hardcode_runpath_var=yes
+	ld_shlibs=yes
+      fi
+      ;;
+
+    sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*)
+      no_undefined_flag='${wl}-z,text'
+      archive_cmds_need_lc=no
+      hardcode_shlibpath_var=no
+      runpath_var='LD_RUN_PATH'
+
+      if test "$GCC" = yes; then
+	archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      fi
+      ;;
+
+    sysv5* | sco3.2v5* | sco5v6*)
+      # Note: We can NOT use -z defs as we might desire, because we do not
+      # link with -lc, and that would cause any symbols used from libc to
+      # always be unresolved, which means just about no library would
+      # ever link correctly.  If we're not using GNU ld we use -z text
+      # though, which does catch some bad symbols but isn't as heavy-handed
+      # as -z defs.
+      no_undefined_flag='${wl}-z,text'
+      allow_undefined_flag='${wl}-z,nodefs'
+      archive_cmds_need_lc=no
+      hardcode_shlibpath_var=no
+      hardcode_libdir_flag_spec='${wl}-R,$libdir'
+      hardcode_libdir_separator=':'
+      link_all_deplibs=yes
+      export_dynamic_flag_spec='${wl}-Bexport'
+      runpath_var='LD_RUN_PATH'
+
+      if test "$GCC" = yes; then
+	archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      else
+	archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+      fi
+      ;;
+
+    uts4*)
+      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+      hardcode_libdir_flag_spec='-L$libdir'
+      hardcode_shlibpath_var=no
+      ;;
+
+    *)
+      ld_shlibs=no
+      ;;
+    esac
+
+    if test x$host_vendor = xsni; then
+      case $host in
+      sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+	export_dynamic_flag_spec='${wl}-Blargedynsym'
+	;;
+      esac
+    fi
+  fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs" >&5
+$as_echo "$ld_shlibs" >&6; }
+test "$ld_shlibs" = no && can_build_shared=no
+
+with_gnu_ld=$with_gnu_ld
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#
+# Do we need to explicitly link libc?
+#
+case "x$archive_cmds_need_lc" in
+x|xyes)
+  # Assume -lc should be added
+  archive_cmds_need_lc=yes
+
+  if test "$enable_shared" = yes && test "$GCC" = yes; then
+    case $archive_cmds in
+    *'~'*)
+      # FIXME: we may have to deal with multi-command sequences.
+      ;;
+    '$CC '*)
+      # Test whether the compiler implicitly links with -lc since on some
+      # systems, -lgcc has to come before -lc. If gcc already passes -lc
+      # to ld, don't add -lc before -lgcc.
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5
+$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; }
+if ${lt_cv_archive_cmds_need_lc+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  $RM conftest*
+	echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+	if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } 2>conftest.err; then
+	  soname=conftest
+	  lib=conftest
+	  libobjs=conftest.$ac_objext
+	  deplibs=
+	  wl=$lt_prog_compiler_wl
+	  pic_flag=$lt_prog_compiler_pic
+	  compiler_flags=-v
+	  linker_flags=-v
+	  verstring=
+	  output_objdir=.
+	  libname=conftest
+	  lt_save_allow_undefined_flag=$allow_undefined_flag
+	  allow_undefined_flag=
+	  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5
+  (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+	  then
+	    lt_cv_archive_cmds_need_lc=no
+	  else
+	    lt_cv_archive_cmds_need_lc=yes
+	  fi
+	  allow_undefined_flag=$lt_save_allow_undefined_flag
+	else
+	  cat conftest.err 1>&5
+	fi
+	$RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc" >&5
+$as_echo "$lt_cv_archive_cmds_need_lc" >&6; }
+      archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc
+      ;;
+    esac
+  fi
+  ;;
+esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5
+$as_echo_n "checking dynamic linker characteristics... " >&6; }
+
+if test "$GCC" = yes; then
+  case $host_os in
+    darwin*) lt_awk_arg="/^libraries:/,/LR/" ;;
+    *) lt_awk_arg="/^libraries:/" ;;
+  esac
+  case $host_os in
+    mingw* | cegcc*) lt_sed_strip_eq="s,=\([A-Za-z]:\),\1,g" ;;
+    *) lt_sed_strip_eq="s,=/,/,g" ;;
+  esac
+  lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq`
+  case $lt_search_path_spec in
+  *\;*)
+    # if the path contains ";" then we assume it to be the separator
+    # otherwise default to the standard path separator (i.e. ":") - it is
+    # assumed that no part of a normal pathname contains ";" but that should
+    # okay in the real world where ";" in dirpaths is itself problematic.
+    lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'`
+    ;;
+  *)
+    lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"`
+    ;;
+  esac
+  # Ok, now we have the path, separated by spaces, we can step through it
+  # and add multilib dir if necessary.
+  lt_tmp_lt_search_path_spec=
+  lt_multi_os_dir=`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null`
+  for lt_sys_path in $lt_search_path_spec; do
+    if test -d "$lt_sys_path/$lt_multi_os_dir"; then
+      lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path/$lt_multi_os_dir"
+    else
+      test -d "$lt_sys_path" && \
+	lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path"
+    fi
+  done
+  lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk '
+BEGIN {RS=" "; FS="/|\n";} {
+  lt_foo="";
+  lt_count=0;
+  for (lt_i = NF; lt_i > 0; lt_i--) {
+    if ($lt_i != "" && $lt_i != ".") {
+      if ($lt_i == "..") {
+        lt_count++;
+      } else {
+        if (lt_count == 0) {
+          lt_foo="/" $lt_i lt_foo;
+        } else {
+          lt_count--;
+        }
+      }
+    }
+  }
+  if (lt_foo != "") { lt_freq[lt_foo]++; }
+  if (lt_freq[lt_foo] == 1) { print lt_foo; }
+}'`
+  # AWK program above erroneously prepends '/' to C:/dos/paths
+  # for these hosts.
+  case $host_os in
+    mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\
+      $SED 's,/\([A-Za-z]:\),\1,g'` ;;
+  esac
+  sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP`
+else
+  sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+fi
+library_names_spec=
+libname_spec='lib$name'
+soname_spec=
+shrext_cmds=".so"
+postinstall_cmds=
+postuninstall_cmds=
+finish_cmds=
+finish_eval=
+shlibpath_var=
+shlibpath_overrides_runpath=unknown
+version_type=none
+dynamic_linker="$host_os ld.so"
+sys_lib_dlsearch_path_spec="/lib /usr/lib"
+need_lib_prefix=unknown
+hardcode_into_libs=no
+
+# when you set need_version to no, make sure it does not cause -set_version
+# flags to be left without arguments
+need_version=unknown
+
+case $host_os in
+aix3*)
+  version_type=linux
+  library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a'
+  shlibpath_var=LIBPATH
+
+  # AIX 3 has no versioning support, so we append a major version to the name.
+  soname_spec='${libname}${release}${shared_ext}$major'
+  ;;
+
+aix[4-9]*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  hardcode_into_libs=yes
+  if test "$host_cpu" = ia64; then
+    # AIX 5 supports IA64
+    library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}'
+    shlibpath_var=LD_LIBRARY_PATH
+  else
+    # With GCC up to 2.95.x, collect2 would create an import file
+    # for dependence libraries.  The import file would start with
+    # the line `#! .'.  This would cause the generated library to
+    # depend on `.', always an invalid library.  This was fixed in
+    # development snapshots of GCC prior to 3.0.
+    case $host_os in
+      aix4 | aix4.[01] | aix4.[01].*)
+      if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
+	   echo ' yes '
+	   echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then
+	:
+      else
+	can_build_shared=no
+      fi
+      ;;
+    esac
+    # AIX (on Power*) has no versioning support, so currently we can not hardcode correct
+    # soname into executable. Probably we can add versioning support to
+    # collect2, so additional links can be useful in future.
+    if test "$aix_use_runtimelinking" = yes; then
+      # If using run time linking (on AIX 4.2 or later) use lib<name>.so
+      # instead of lib<name>.a to let people know that these are not
+      # typical AIX shared libraries.
+      library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    else
+      # We preserve .a as extension for shared libraries through AIX4.2
+      # and later when we are not doing run time linking.
+      library_names_spec='${libname}${release}.a $libname.a'
+      soname_spec='${libname}${release}${shared_ext}$major'
+    fi
+    shlibpath_var=LIBPATH
+  fi
+  ;;
+
+amigaos*)
+  case $host_cpu in
+  powerpc)
+    # Since July 2007 AmigaOS4 officially supports .so libraries.
+    # When compiling the executable, add -use-dynld -Lsobjs: to the compileline.
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    ;;
+  m68k)
+    library_names_spec='$libname.ixlibrary $libname.a'
+    # Create ${libname}_ixlibrary.a entries in /sys/libs.
+    finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done'
+    ;;
+  esac
+  ;;
+
+beos*)
+  library_names_spec='${libname}${shared_ext}'
+  dynamic_linker="$host_os ld.so"
+  shlibpath_var=LIBRARY_PATH
+  ;;
+
+bsdi[45]*)
+  version_type=linux
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
+  sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
+  # the default ld.so.conf also contains /usr/contrib/lib and
+  # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
+  # libtool to hard-code these into programs
+  ;;
+
+cygwin* | mingw* | pw32* | cegcc*)
+  version_type=windows
+  shrext_cmds=".dll"
+  need_version=no
+  need_lib_prefix=no
+
+  case $GCC,$host_os in
+  yes,cygwin* | yes,mingw* | yes,pw32* | yes,cegcc*)
+    library_names_spec='$libname.dll.a'
+    # DLL is installed to $(libdir)/../bin by postinstall_cmds
+    postinstall_cmds='base_file=`basename \${file}`~
+      dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
+      dldir=$destdir/`dirname \$dlpath`~
+      test -d \$dldir || mkdir -p \$dldir~
+      $install_prog $dir/$dlname \$dldir/$dlname~
+      chmod a+x \$dldir/$dlname~
+      if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
+        eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
+      fi'
+    postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
+      dlpath=$dir/\$dldll~
+       $RM \$dlpath'
+    shlibpath_overrides_runpath=yes
+
+    case $host_os in
+    cygwin*)
+      # Cygwin DLLs use 'cyg' prefix rather than 'lib'
+      soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
+
+      sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api"
+      ;;
+    mingw* | cegcc*)
+      # MinGW DLLs use traditional 'lib' prefix
+      soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
+      ;;
+    pw32*)
+      # pw32 DLLs use 'pw' prefix rather than 'lib'
+      library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
+      ;;
+    esac
+    ;;
+
+  *)
+    library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib'
+    ;;
+  esac
+  dynamic_linker='Win32 ld.exe'
+  # FIXME: first we should search . and the directory the executable is in
+  shlibpath_var=PATH
+  ;;
+
+darwin* | rhapsody*)
+  dynamic_linker="$host_os dyld"
+  version_type=darwin
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext'
+  soname_spec='${libname}${release}${major}$shared_ext'
+  shlibpath_overrides_runpath=yes
+  shlibpath_var=DYLD_LIBRARY_PATH
+  shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`'
+
+  sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib"
+  sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib'
+  ;;
+
+dgux*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+freebsd* | dragonfly*)
+  # DragonFly does not have aout.  When/if they implement a new
+  # versioning mechanism, adjust this.
+  if test -x /usr/bin/objformat; then
+    objformat=`/usr/bin/objformat`
+  else
+    case $host_os in
+    freebsd[23].*) objformat=aout ;;
+    *) objformat=elf ;;
+    esac
+  fi
+  version_type=freebsd-$objformat
+  case $version_type in
+    freebsd-elf*)
+      library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
+      need_version=no
+      need_lib_prefix=no
+      ;;
+    freebsd-*)
+      library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix'
+      need_version=yes
+      ;;
+  esac
+  shlibpath_var=LD_LIBRARY_PATH
+  case $host_os in
+  freebsd2.*)
+    shlibpath_overrides_runpath=yes
+    ;;
+  freebsd3.[01]* | freebsdelf3.[01]*)
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  freebsd3.[2-9]* | freebsdelf3.[2-9]* | \
+  freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1)
+    shlibpath_overrides_runpath=no
+    hardcode_into_libs=yes
+    ;;
+  *) # from 4.6 on, and DragonFly
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  esac
+  ;;
+
+haiku*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  dynamic_linker="$host_os runtime_loader"
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/beos/system/lib'
+  hardcode_into_libs=yes
+  ;;
+
+hpux9* | hpux10* | hpux11*)
+  # Give a soname corresponding to the major version so that dld.sl refuses to
+  # link against other versions.
+  version_type=sunos
+  need_lib_prefix=no
+  need_version=no
+  case $host_cpu in
+  ia64*)
+    shrext_cmds='.so'
+    hardcode_into_libs=yes
+    dynamic_linker="$host_os dld.so"
+    shlibpath_var=LD_LIBRARY_PATH
+    shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    soname_spec='${libname}${release}${shared_ext}$major'
+    if test "X$HPUX_IA64_MODE" = X32; then
+      sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib"
+    else
+      sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64"
+    fi
+    sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+    ;;
+  hppa*64*)
+    shrext_cmds='.sl'
+    hardcode_into_libs=yes
+    dynamic_linker="$host_os dld.sl"
+    shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH
+    shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    soname_spec='${libname}${release}${shared_ext}$major'
+    sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64"
+    sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+    ;;
+  *)
+    shrext_cmds='.sl'
+    dynamic_linker="$host_os dld.sl"
+    shlibpath_var=SHLIB_PATH
+    shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    soname_spec='${libname}${release}${shared_ext}$major'
+    ;;
+  esac
+  # HP-UX runs *really* slowly unless shared libraries are mode 555, ...
+  postinstall_cmds='chmod 555 $lib'
+  # or fails outright, so override atomically:
+  install_override_mode=555
+  ;;
+
+interix[3-9]*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  ;;
+
+irix5* | irix6* | nonstopux*)
+  case $host_os in
+    nonstopux*) version_type=nonstopux ;;
+    *)
+	if test "$lt_cv_prog_gnu_ld" = yes; then
+		version_type=linux
+	else
+		version_type=irix
+	fi ;;
+  esac
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='${libname}${release}${shared_ext}$major'
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}'
+  case $host_os in
+  irix5* | nonstopux*)
+    libsuff= shlibsuff=
+    ;;
+  *)
+    case $LD in # libtool.m4 will add one of these switches to LD
+    *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ")
+      libsuff= shlibsuff= libmagic=32-bit;;
+    *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ")
+      libsuff=32 shlibsuff=N32 libmagic=N32;;
+    *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ")
+      libsuff=64 shlibsuff=64 libmagic=64-bit;;
+    *) libsuff= shlibsuff= libmagic=never-match;;
+    esac
+    ;;
+  esac
+  shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
+  shlibpath_overrides_runpath=no
+  sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
+  sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
+  hardcode_into_libs=yes
+  ;;
+
+# No shared lib support for Linux oldld, aout, or coff.
+linux*oldld* | linux*aout* | linux*coff*)
+  dynamic_linker=no
+  ;;
+
+# This must be Linux ELF.
+
+# uclinux* changes (here and below) have been submitted to the libtool
+# project, but have not yet been accepted: they are GCC-local changes
+# for the time being.  (See
+# https://lists.gnu.org/archive/html/libtool-patches/2018-05/msg00000.html)
+linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu* | uclinuxfdpiceabi)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+
+  # Some binutils ld are patched to set DT_RUNPATH
+  if ${lt_cv_shlibpath_overrides_runpath+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_shlibpath_overrides_runpath=no
+    save_LDFLAGS=$LDFLAGS
+    save_libdir=$libdir
+    eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \
+	 LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\""
+    if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  if  ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then :
+  lt_cv_shlibpath_overrides_runpath=yes
+fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    LDFLAGS=$save_LDFLAGS
+    libdir=$save_libdir
+
+fi
+
+  shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath
+
+  # This implies no fast_install, which is unacceptable.
+  # Some rework will be needed to allow for fast_install
+  # before this can be enabled.
+  hardcode_into_libs=yes
+
+  # Append ld.so.conf contents to the search path
+  if test -f /etc/ld.so.conf; then
+    lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[	 ]*hwcap[	 ]/d;s/[:,	]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '`
+    sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra"
+  fi
+
+  # We used to test for /lib/ld.so.1 and disable shared libraries on
+  # powerpc, because MkLinux only supported shared libraries with the
+  # GNU dynamic linker.  Since this was broken with cross compilers,
+  # most powerpc-linux boxes support dynamic linking these days and
+  # people can always --disable-shared, the test was removed, and we
+  # assume the GNU/Linux dynamic linker is in use.
+  dynamic_linker='GNU/Linux ld.so'
+  ;;
+
+netbsd*)
+  version_type=sunos
+  need_lib_prefix=no
+  need_version=no
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
+    finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+    dynamic_linker='NetBSD (a.out) ld.so'
+  else
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
+    soname_spec='${libname}${release}${shared_ext}$major'
+    dynamic_linker='NetBSD ld.elf_so'
+  fi
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  ;;
+
+newsos6)
+  version_type=linux
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  ;;
+
+*nto* | *qnx*)
+  version_type=qnx
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  dynamic_linker='ldqnx.so'
+  ;;
+
+openbsd*)
+  version_type=sunos
+  sys_lib_dlsearch_path_spec="/usr/lib"
+  need_lib_prefix=no
+  # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs.
+  case $host_os in
+    openbsd3.3 | openbsd3.3.*)	need_version=yes ;;
+    *)				need_version=no  ;;
+  esac
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+    case $host_os in
+      openbsd2.[89] | openbsd2.[89].*)
+	shlibpath_overrides_runpath=no
+	;;
+      *)
+	shlibpath_overrides_runpath=yes
+	;;
+      esac
+  else
+    shlibpath_overrides_runpath=yes
+  fi
+  ;;
+
+os2*)
+  libname_spec='$name'
+  shrext_cmds=".dll"
+  need_lib_prefix=no
+  library_names_spec='$libname${shared_ext} $libname.a'
+  dynamic_linker='OS/2 ld.exe'
+  shlibpath_var=LIBPATH
+  ;;
+
+osf3* | osf4* | osf5*)
+  version_type=osf
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='${libname}${release}${shared_ext}$major'
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
+  sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
+  ;;
+
+rdos*)
+  dynamic_linker=no
+  ;;
+
+solaris*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  # ldd complains unless libraries are executable
+  postinstall_cmds='chmod +x $lib'
+  ;;
+
+sunos4*)
+  version_type=sunos
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
+  finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  if test "$with_gnu_ld" = yes; then
+    need_lib_prefix=no
+  fi
+  need_version=yes
+  ;;
+
+sysv4 | sysv4.3*)
+  version_type=linux
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  case $host_vendor in
+    sni)
+      shlibpath_overrides_runpath=no
+      need_lib_prefix=no
+      runpath_var=LD_RUN_PATH
+      ;;
+    siemens)
+      need_lib_prefix=no
+      ;;
+    motorola)
+      need_lib_prefix=no
+      need_version=no
+      shlibpath_overrides_runpath=no
+      sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
+      ;;
+  esac
+  ;;
+
+sysv4*MP*)
+  if test -d /usr/nec ;then
+    version_type=linux
+    library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}'
+    soname_spec='$libname${shared_ext}.$major'
+    shlibpath_var=LD_LIBRARY_PATH
+  fi
+  ;;
+
+sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
+  version_type=freebsd-elf
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  if test "$with_gnu_ld" = yes; then
+    sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib'
+  else
+    sys_lib_search_path_spec='/usr/ccs/lib /usr/lib'
+    case $host_os in
+      sco3.2v5*)
+        sys_lib_search_path_spec="$sys_lib_search_path_spec /lib"
+	;;
+    esac
+  fi
+  sys_lib_dlsearch_path_spec='/usr/lib'
+  ;;
+
+tpf*)
+  # TPF is a cross-target only.  Preferred cross-host = GNU/Linux.
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  ;;
+
+uts4*)
+  version_type=linux
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+# Shared libraries for VwWorks, >= 7 only at this stage
+# and (fpic) still incompatible with "large" code models
+# in a few configurations. Only for RTP mode in any case,
+# and upon explicit request at configure time.
+vxworks7*)
+  dynamic_linker=no
+  case ${with_multisubdir}-${enable_shared} in
+    *large*)
+      ;;
+    *mrtp*-yes)
+      version_type=linux
+      need_lib_prefix=no
+      need_version=no
+      library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+      soname_spec='${libname}${release}${shared_ext}$major'
+      dynamic_linker="$host_os module_loader"
+      ;;
+  esac
+  ;;
+*)
+  dynamic_linker=no
+  ;;
+esac
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5
+$as_echo "$dynamic_linker" >&6; }
+test "$dynamic_linker" = no && can_build_shared=no
+
+variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
+if test "$GCC" = yes; then
+  variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
+fi
+
+if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then
+  sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec"
+fi
+if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then
+  sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec"
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5
+$as_echo_n "checking how to hardcode library paths into programs... " >&6; }
+hardcode_action=
+if test -n "$hardcode_libdir_flag_spec" ||
+   test -n "$runpath_var" ||
+   test "X$hardcode_automatic" = "Xyes" ; then
+
+  # We can hardcode non-existent directories.
+  if test "$hardcode_direct" != no &&
+     # If the only mechanism to avoid hardcoding is shlibpath_var, we
+     # have to relink, otherwise we might link with an installed library
+     # when we should be linking with a yet-to-be-installed one
+     ## test "$_LT_TAGVAR(hardcode_shlibpath_var, )" != no &&
+     test "$hardcode_minus_L" != no; then
+    # Linking always hardcodes the temporary library directory.
+    hardcode_action=relink
+  else
+    # We can link without hardcoding, and we can hardcode nonexisting dirs.
+    hardcode_action=immediate
+  fi
+else
+  # We cannot hardcode anything, or else we can only hardcode existing
+  # directories.
+  hardcode_action=unsupported
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action" >&5
+$as_echo "$hardcode_action" >&6; }
+
+if test "$hardcode_action" = relink ||
+   test "$inherit_rpath" = yes; then
+  # Fast installation is not supported
+  enable_fast_install=no
+elif test "$shlibpath_overrides_runpath" = yes ||
+     test "$enable_shared" = no; then
+  # Fast installation is not necessary
+  enable_fast_install=needless
+fi
+
+
+
+
+
+
+  if test "x$enable_dlopen" != xyes; then
+  enable_dlopen=unknown
+  enable_dlopen_self=unknown
+  enable_dlopen_self_static=unknown
+else
+  lt_cv_dlopen=no
+  lt_cv_dlopen_libs=
+
+  case $host_os in
+  beos*)
+    lt_cv_dlopen="load_add_on"
+    lt_cv_dlopen_libs=
+    lt_cv_dlopen_self=yes
+    ;;
+
+  mingw* | pw32* | cegcc*)
+    lt_cv_dlopen="LoadLibrary"
+    lt_cv_dlopen_libs=
+    ;;
+
+  cygwin*)
+    lt_cv_dlopen="dlopen"
+    lt_cv_dlopen_libs=
+    ;;
+
+  darwin*)
+  # if libdl is installed we need to link against it
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
+$as_echo_n "checking for dlopen in -ldl... " >&6; }
+if ${ac_cv_lib_dl_dlopen+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldl  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen ();
+int
+main ()
+{
+return dlopen ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dl_dlopen=yes
+else
+  ac_cv_lib_dl_dlopen=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
+$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
+if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
+  lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"
+else
+
+    lt_cv_dlopen="dyld"
+    lt_cv_dlopen_libs=
+    lt_cv_dlopen_self=yes
+
+fi
+
+    ;;
+
+  *)
+    ac_fn_c_check_func "$LINENO" "shl_load" "ac_cv_func_shl_load"
+if test "x$ac_cv_func_shl_load" = xyes; then :
+  lt_cv_dlopen="shl_load"
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5
+$as_echo_n "checking for shl_load in -ldld... " >&6; }
+if ${ac_cv_lib_dld_shl_load+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldld  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char shl_load ();
+int
+main ()
+{
+return shl_load ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dld_shl_load=yes
+else
+  ac_cv_lib_dld_shl_load=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5
+$as_echo "$ac_cv_lib_dld_shl_load" >&6; }
+if test "x$ac_cv_lib_dld_shl_load" = xyes; then :
+  lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld"
+else
+  ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen"
+if test "x$ac_cv_func_dlopen" = xyes; then :
+  lt_cv_dlopen="dlopen"
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
+$as_echo_n "checking for dlopen in -ldl... " >&6; }
+if ${ac_cv_lib_dl_dlopen+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldl  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen ();
+int
+main ()
+{
+return dlopen ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dl_dlopen=yes
+else
+  ac_cv_lib_dl_dlopen=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
+$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
+if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
+  lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lsvld" >&5
+$as_echo_n "checking for dlopen in -lsvld... " >&6; }
+if ${ac_cv_lib_svld_dlopen+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lsvld  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dlopen ();
+int
+main ()
+{
+return dlopen ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_svld_dlopen=yes
+else
+  ac_cv_lib_svld_dlopen=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_svld_dlopen" >&5
+$as_echo "$ac_cv_lib_svld_dlopen" >&6; }
+if test "x$ac_cv_lib_svld_dlopen" = xyes; then :
+  lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld"
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dld_link in -ldld" >&5
+$as_echo_n "checking for dld_link in -ldld... " >&6; }
+if ${ac_cv_lib_dld_dld_link+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldld  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dld_link ();
+int
+main ()
+{
+return dld_link ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_dld_dld_link=yes
+else
+  ac_cv_lib_dld_dld_link=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dld_link" >&5
+$as_echo "$ac_cv_lib_dld_dld_link" >&6; }
+if test "x$ac_cv_lib_dld_dld_link" = xyes; then :
+  lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld"
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+    ;;
+  esac
+
+  if test "x$lt_cv_dlopen" != xno; then
+    enable_dlopen=yes
+  else
+    enable_dlopen=no
+  fi
+
+  case $lt_cv_dlopen in
+  dlopen)
+    save_CPPFLAGS="$CPPFLAGS"
+    test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
+
+    save_LDFLAGS="$LDFLAGS"
+    wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
+
+    save_LIBS="$LIBS"
+    LIBS="$lt_cv_dlopen_libs $LIBS"
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a program can dlopen itself" >&5
+$as_echo_n "checking whether a program can dlopen itself... " >&6; }
+if ${lt_cv_dlopen_self+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  	  if test "$cross_compiling" = yes; then :
+  lt_cv_dlopen_self=cross
+else
+  lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+  lt_status=$lt_dlunknown
+  cat > conftest.$ac_ext <<_LT_EOF
+#line 12701 "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include <dlfcn.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef RTLD_GLOBAL
+#  define LT_DLGLOBAL		RTLD_GLOBAL
+#else
+#  ifdef DL_GLOBAL
+#    define LT_DLGLOBAL		DL_GLOBAL
+#  else
+#    define LT_DLGLOBAL		0
+#  endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+   find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+#  ifdef RTLD_LAZY
+#    define LT_DLLAZY_OR_NOW		RTLD_LAZY
+#  else
+#    ifdef DL_LAZY
+#      define LT_DLLAZY_OR_NOW		DL_LAZY
+#    else
+#      ifdef RTLD_NOW
+#        define LT_DLLAZY_OR_NOW	RTLD_NOW
+#      else
+#        ifdef DL_NOW
+#          define LT_DLLAZY_OR_NOW	DL_NOW
+#        else
+#          define LT_DLLAZY_OR_NOW	0
+#        endif
+#      endif
+#    endif
+#  endif
+#endif
+
+/* When -fvisbility=hidden is used, assume the code has been annotated
+   correspondingly for the symbols needed.  */
+#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3))
+void fnord () __attribute__((visibility("default")));
+#endif
+
+void fnord () { int i=42; }
+int main ()
+{
+  void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+  int status = $lt_dlunknown;
+
+  if (self)
+    {
+      if (dlsym (self,"fnord"))       status = $lt_dlno_uscore;
+      else
+        {
+	  if (dlsym( self,"_fnord"))  status = $lt_dlneed_uscore;
+          else puts (dlerror ());
+	}
+      /* dlclose (self); */
+    }
+  else
+    puts (dlerror ());
+
+  return status;
+}
+_LT_EOF
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && test -s conftest${ac_exeext} 2>/dev/null; then
+    (./conftest; exit; ) >&5 2>/dev/null
+    lt_status=$?
+    case x$lt_status in
+      x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;;
+      x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;;
+      x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;;
+    esac
+  else :
+    # compilation failed
+    lt_cv_dlopen_self=no
+  fi
+fi
+rm -fr conftest*
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self" >&5
+$as_echo "$lt_cv_dlopen_self" >&6; }
+
+    if test "x$lt_cv_dlopen_self" = xyes; then
+      wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a statically linked program can dlopen itself" >&5
+$as_echo_n "checking whether a statically linked program can dlopen itself... " >&6; }
+if ${lt_cv_dlopen_self_static+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  	  if test "$cross_compiling" = yes; then :
+  lt_cv_dlopen_self_static=cross
+else
+  lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+  lt_status=$lt_dlunknown
+  cat > conftest.$ac_ext <<_LT_EOF
+#line 12807 "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include <dlfcn.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef RTLD_GLOBAL
+#  define LT_DLGLOBAL		RTLD_GLOBAL
+#else
+#  ifdef DL_GLOBAL
+#    define LT_DLGLOBAL		DL_GLOBAL
+#  else
+#    define LT_DLGLOBAL		0
+#  endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+   find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+#  ifdef RTLD_LAZY
+#    define LT_DLLAZY_OR_NOW		RTLD_LAZY
+#  else
+#    ifdef DL_LAZY
+#      define LT_DLLAZY_OR_NOW		DL_LAZY
+#    else
+#      ifdef RTLD_NOW
+#        define LT_DLLAZY_OR_NOW	RTLD_NOW
+#      else
+#        ifdef DL_NOW
+#          define LT_DLLAZY_OR_NOW	DL_NOW
+#        else
+#          define LT_DLLAZY_OR_NOW	0
+#        endif
+#      endif
+#    endif
+#  endif
+#endif
+
+/* When -fvisbility=hidden is used, assume the code has been annotated
+   correspondingly for the symbols needed.  */
+#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3))
+void fnord () __attribute__((visibility("default")));
+#endif
+
+void fnord () { int i=42; }
+int main ()
+{
+  void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+  int status = $lt_dlunknown;
+
+  if (self)
+    {
+      if (dlsym (self,"fnord"))       status = $lt_dlno_uscore;
+      else
+        {
+	  if (dlsym( self,"_fnord"))  status = $lt_dlneed_uscore;
+          else puts (dlerror ());
+	}
+      /* dlclose (self); */
+    }
+  else
+    puts (dlerror ());
+
+  return status;
+}
+_LT_EOF
+  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
+  (eval $ac_link) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && test -s conftest${ac_exeext} 2>/dev/null; then
+    (./conftest; exit; ) >&5 2>/dev/null
+    lt_status=$?
+    case x$lt_status in
+      x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;;
+      x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;;
+      x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;;
+    esac
+  else :
+    # compilation failed
+    lt_cv_dlopen_self_static=no
+  fi
+fi
+rm -fr conftest*
+
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self_static" >&5
+$as_echo "$lt_cv_dlopen_self_static" >&6; }
+    fi
+
+    CPPFLAGS="$save_CPPFLAGS"
+    LDFLAGS="$save_LDFLAGS"
+    LIBS="$save_LIBS"
+    ;;
+  esac
+
+  case $lt_cv_dlopen_self in
+  yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
+  *) enable_dlopen_self=unknown ;;
+  esac
+
+  case $lt_cv_dlopen_self_static in
+  yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
+  *) enable_dlopen_self_static=unknown ;;
+  esac
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+striplib=
+old_striplib=
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stripping libraries is possible" >&5
+$as_echo_n "checking whether stripping libraries is possible... " >&6; }
+if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then
+  test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
+  test -z "$striplib" && striplib="$STRIP --strip-unneeded"
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+# FIXME - insert some real tests, host_os isn't really good enough
+  case $host_os in
+  darwin*)
+    if test -n "$STRIP" ; then
+      striplib="$STRIP -x"
+      old_striplib="$STRIP -S"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+    else
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+    fi
+    ;;
+  *)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+    ;;
+  esac
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+  # Report which library types will actually be built
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5
+$as_echo_n "checking if libtool supports shared libraries... " >&6; }
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5
+$as_echo "$can_build_shared" >&6; }
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5
+$as_echo_n "checking whether to build shared libraries... " >&6; }
+  test "$can_build_shared" = "no" && enable_shared=no
+
+  # On AIX, shared libraries and static libraries use the same namespace, and
+  # are all built from PIC.
+  case $host_os in
+  aix3*)
+    test "$enable_shared" = yes && enable_static=no
+    if test -n "$RANLIB"; then
+      archive_cmds="$archive_cmds~\$RANLIB \$lib"
+      postinstall_cmds='$RANLIB $lib'
+    fi
+    ;;
+
+  aix[4-9]*)
+    if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
+      test "$enable_shared" = yes && enable_static=no
+    fi
+    ;;
+  esac
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5
+$as_echo "$enable_shared" >&6; }
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5
+$as_echo_n "checking whether to build static libraries... " >&6; }
+  # Make sure either enable_shared or enable_static is yes.
+  test "$enable_shared" = yes || enable_static=yes
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5
+$as_echo "$enable_static" >&6; }
+
+
+
+
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+CC="$lt_save_CC"
+
+      if test -n "$CXX" && ( test "X$CXX" != "Xno" &&
+    ( (test "X$CXX" = "Xg++" && `g++ -v >/dev/null 2>&1` ) ||
+    (test "X$CXX" != "Xg++"))) ; then
+  ac_ext=cpp
+ac_cpp='$CXXCPP $CPPFLAGS'
+ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_cxx_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C++ preprocessor" >&5
+$as_echo_n "checking how to run the C++ preprocessor... " >&6; }
+if test -z "$CXXCPP"; then
+  if ${ac_cv_prog_CXXCPP+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+      # Double quotes because CXXCPP needs to be expanded
+    for CXXCPP in "$CXX -E" "/lib/cpp"
+    do
+      ac_preproc_ok=false
+for ac_cxx_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_cxx_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_cxx_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+  break
+fi
+
+    done
+    ac_cv_prog_CXXCPP=$CXXCPP
+
+fi
+  CXXCPP=$ac_cv_prog_CXXCPP
+else
+  ac_cv_prog_CXXCPP=$CXXCPP
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXXCPP" >&5
+$as_echo "$CXXCPP" >&6; }
+ac_preproc_ok=false
+for ac_cxx_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_cxx_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_cxx_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "C++ preprocessor \"$CXXCPP\" fails sanity check
+See \`config.log' for more details" "$LINENO" 5; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+else
+  _lt_caught_CXX_error=yes
+fi
+
+ac_ext=cpp
+ac_cpp='$CXXCPP $CPPFLAGS'
+ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_cxx_compiler_gnu
+
+archive_cmds_need_lc_CXX=no
+allow_undefined_flag_CXX=
+always_export_symbols_CXX=no
+archive_expsym_cmds_CXX=
+compiler_needs_object_CXX=no
+export_dynamic_flag_spec_CXX=
+hardcode_direct_CXX=no
+hardcode_direct_absolute_CXX=no
+hardcode_libdir_flag_spec_CXX=
+hardcode_libdir_flag_spec_ld_CXX=
+hardcode_libdir_separator_CXX=
+hardcode_minus_L_CXX=no
+hardcode_shlibpath_var_CXX=unsupported
+hardcode_automatic_CXX=no
+inherit_rpath_CXX=no
+module_cmds_CXX=
+module_expsym_cmds_CXX=
+link_all_deplibs_CXX=unknown
+old_archive_cmds_CXX=$old_archive_cmds
+reload_flag_CXX=$reload_flag
+reload_cmds_CXX=$reload_cmds
+no_undefined_flag_CXX=
+whole_archive_flag_spec_CXX=
+enable_shared_with_static_runtimes_CXX=no
+
+# Source file extension for C++ test sources.
+ac_ext=cpp
+
+# Object file extension for compiled C++ test sources.
+objext=o
+objext_CXX=$objext
+
+# No sense in running all these tests if we already determined that
+# the CXX compiler isn't working.  Some variables (like enable_shared)
+# are currently assumed to apply to all compilers on this platform,
+# and will be corrupted by setting them based on a non-working compiler.
+if test "$_lt_caught_CXX_error" != yes; then
+  # Code to be used in simple compile tests
+  lt_simple_compile_test_code="int some_variable = 0;"
+
+  # Code to be used in simple link tests
+  lt_simple_link_test_code='int main(int, char *[]) { return(0); }'
+
+  # ltmain only uses $CC for tagged configurations so make sure $CC is set.
+
+
+
+
+
+
+# If no C compiler was specified, use CC.
+LTCC=${LTCC-"$CC"}
+
+# If no C compiler flags were specified, use CFLAGS.
+LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
+
+# Allow CC to be a program name with arguments.
+compiler=$CC
+
+
+  # save warnings/boilerplate of simple test code
+  ac_outfile=conftest.$ac_objext
+echo "$lt_simple_compile_test_code" >conftest.$ac_ext
+eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
+_lt_compiler_boilerplate=`cat conftest.err`
+$RM conftest*
+
+  ac_outfile=conftest.$ac_objext
+echo "$lt_simple_link_test_code" >conftest.$ac_ext
+eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
+_lt_linker_boilerplate=`cat conftest.err`
+$RM -r conftest*
+
+
+  # Allow CC to be a program name with arguments.
+  lt_save_CC=$CC
+  lt_save_LD=$LD
+  lt_save_GCC=$GCC
+  GCC=$GXX
+  lt_save_with_gnu_ld=$with_gnu_ld
+  lt_save_path_LD=$lt_cv_path_LD
+  if test -n "${lt_cv_prog_gnu_ldcxx+set}"; then
+    lt_cv_prog_gnu_ld=$lt_cv_prog_gnu_ldcxx
+  else
+    $as_unset lt_cv_prog_gnu_ld
+  fi
+  if test -n "${lt_cv_path_LDCXX+set}"; then
+    lt_cv_path_LD=$lt_cv_path_LDCXX
+  else
+    $as_unset lt_cv_path_LD
+  fi
+  test -z "${LDCXX+set}" || LD=$LDCXX
+  CC=${CXX-"c++"}
+  compiler=$CC
+  compiler_CXX=$CC
+  for cc_temp in $compiler""; do
+  case $cc_temp in
+    compile | *[\\/]compile | ccache | *[\\/]ccache ) ;;
+    distcc | *[\\/]distcc | purify | *[\\/]purify ) ;;
+    \-*) ;;
+    *) break;;
+  esac
+done
+cc_basename=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"`
+
+
+  if test -n "$compiler"; then
+    # We don't want -fno-exception when compiling C++ code, so set the
+    # no_builtin_flag separately
+    if test "$GXX" = yes; then
+      lt_prog_compiler_no_builtin_flag_CXX=' -fno-builtin'
+    else
+      lt_prog_compiler_no_builtin_flag_CXX=
+    fi
+
+    if test "$GXX" = yes; then
+      # Set up default GNU C++ configuration
+
+
+
+# Check whether --with-gnu-ld was given.
+if test "${with_gnu_ld+set}" = set; then :
+  withval=$with_gnu_ld; test "$withval" = no || with_gnu_ld=yes
+else
+  with_gnu_ld=no
+fi
+
+ac_prog=ld
+if test "$GCC" = yes; then
+  # Check if gcc -print-prog-name=ld gives a path.
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5
+$as_echo_n "checking for ld used by $CC... " >&6; }
+  case $host in
+  *-*-mingw*)
+    # gcc leaves a trailing carriage return which upsets mingw
+    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+  *)
+    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+  esac
+  case $ac_prog in
+    # Accept absolute paths.
+    [\\/]* | ?:[\\/]*)
+      re_direlt='/[^/][^/]*/\.\./'
+      # Canonicalize the pathname of ld
+      ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'`
+      while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do
+	ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"`
+      done
+      test -z "$LD" && LD="$ac_prog"
+      ;;
+  "")
+    # If it fails, then pretend we aren't using GCC.
+    ac_prog=ld
+    ;;
+  *)
+    # If it is relative, then search for the first ld in PATH.
+    with_gnu_ld=unknown
+    ;;
+  esac
+elif test "$with_gnu_ld" = yes; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5
+$as_echo_n "checking for GNU ld... " >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5
+$as_echo_n "checking for non-GNU ld... " >&6; }
+fi
+if ${lt_cv_path_LD+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$LD"; then
+  lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+  for ac_dir in $PATH; do
+    IFS="$lt_save_ifs"
+    test -z "$ac_dir" && ac_dir=.
+    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+      lt_cv_path_LD="$ac_dir/$ac_prog"
+      # Check to see if the program is GNU ld.  I'd rather use --version,
+      # but apparently some variants of GNU ld only accept -v.
+      # Break only if it was the GNU/non-GNU ld that we prefer.
+      case `"$lt_cv_path_LD" -v 2>&1 </dev/null` in
+      *GNU* | *'with BFD'*)
+	test "$with_gnu_ld" != no && break
+	;;
+      *)
+	test "$with_gnu_ld" != yes && break
+	;;
+      esac
+    fi
+  done
+  IFS="$lt_save_ifs"
+else
+  lt_cv_path_LD="$LD" # Let the user override the test with a path.
+fi
+fi
+
+LD="$lt_cv_path_LD"
+if test -n "$LD"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LD" >&5
+$as_echo "$LD" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5
+$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; }
+if ${lt_cv_prog_gnu_ld+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  # I'd rather use --version here, but apparently some GNU lds only accept -v.
+case `$LD -v 2>&1 </dev/null` in
+*GNU* | *'with BFD'*)
+  lt_cv_prog_gnu_ld=yes
+  ;;
+*)
+  lt_cv_prog_gnu_ld=no
+  ;;
+esac
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_gnu_ld" >&5
+$as_echo "$lt_cv_prog_gnu_ld" >&6; }
+with_gnu_ld=$lt_cv_prog_gnu_ld
+
+
+
+
+
+
+
+      # Check if GNU C++ uses GNU ld as the underlying linker, since the
+      # archiving commands below assume that GNU ld is being used.
+      if test "$with_gnu_ld" = yes; then
+        archive_cmds_CXX='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
+        archive_expsym_cmds_CXX='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+
+        hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir'
+        export_dynamic_flag_spec_CXX='${wl}--export-dynamic'
+
+        # If archive_cmds runs LD, not CC, wlarc should be empty
+        # XXX I think wlarc can be eliminated in ltcf-cxx, but I need to
+        #     investigate it a little bit more. (MM)
+        wlarc='${wl}'
+
+        # ancient GNU ld didn't support --whole-archive et. al.
+        if eval "`$CC -print-prog-name=ld` --help 2>&1" |
+	  $GREP 'no-whole-archive' > /dev/null; then
+          whole_archive_flag_spec_CXX="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
+        else
+          whole_archive_flag_spec_CXX=
+        fi
+      else
+        with_gnu_ld=no
+        wlarc=
+
+        # A generic and very simple default shared library creation
+        # command for GNU C++ for the case where it uses the native
+        # linker, instead of GNU ld.  If possible, this setting should
+        # overridden to take advantage of the native linker features on
+        # the platform it is being used on.
+        archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib'
+      fi
+
+      # Commands to make compiler produce verbose output that lists
+      # what "hidden" libraries, object files and flags are used when
+      # linking a shared library.
+      output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
+
+    else
+      GXX=no
+      with_gnu_ld=no
+      wlarc=
+    fi
+
+    # PORTME: fill in a description of your system's C++ link characteristics
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5
+$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; }
+    ld_shlibs_CXX=yes
+    case $host_os in
+      aix3*)
+        # FIXME: insert proper C++ library support
+        ld_shlibs_CXX=no
+        ;;
+      aix[4-9]*)
+        if test "$host_cpu" = ia64; then
+          # On IA64, the linker does run time linking by default, so we don't
+          # have to do anything special.
+          aix_use_runtimelinking=no
+          exp_sym_flag='-Bexport'
+          no_entry_flag=""
+        else
+          aix_use_runtimelinking=no
+
+          # Test if we are trying to use run time linking or normal
+          # AIX style linking. If -brtl is somewhere in LDFLAGS, we
+          # need to do runtime linking.
+          case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*)
+	    for ld_flag in $LDFLAGS; do
+	      case $ld_flag in
+	      *-brtl*)
+	        aix_use_runtimelinking=yes
+	        break
+	        ;;
+	      esac
+	    done
+	    ;;
+          esac
+
+          exp_sym_flag='-bexport'
+          no_entry_flag='-bnoentry'
+        fi
+
+        # When large executables or shared objects are built, AIX ld can
+        # have problems creating the table of contents.  If linking a library
+        # or program results in "error TOC overflow" add -mminimal-toc to
+        # CXXFLAGS/CFLAGS for g++/gcc.  In the cases where that is not
+        # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
+
+        archive_cmds_CXX=''
+        hardcode_direct_CXX=yes
+        hardcode_direct_absolute_CXX=yes
+        hardcode_libdir_separator_CXX=':'
+        link_all_deplibs_CXX=yes
+        file_list_spec_CXX='${wl}-f,'
+
+        if test "$GXX" = yes; then
+          case $host_os in aix4.[012]|aix4.[012].*)
+          # We only want to do this on AIX 4.2 and lower, the check
+          # below for broken collect2 doesn't work under 4.3+
+	  collect2name=`${CC} -print-prog-name=collect2`
+	  if test -f "$collect2name" &&
+	     strings "$collect2name" | $GREP resolve_lib_name >/dev/null
+	  then
+	    # We have reworked collect2
+	    :
+	  else
+	    # We have old collect2
+	    hardcode_direct_CXX=unsupported
+	    # It fails to find uninstalled libraries when the uninstalled
+	    # path is not listed in the libpath.  Setting hardcode_minus_L
+	    # to unsupported forces relinking
+	    hardcode_minus_L_CXX=yes
+	    hardcode_libdir_flag_spec_CXX='-L$libdir'
+	    hardcode_libdir_separator_CXX=
+	  fi
+          esac
+          shared_flag='-shared'
+	  if test "$aix_use_runtimelinking" = yes; then
+	    shared_flag="$shared_flag "'${wl}-G'
+	  fi
+        else
+          # not using gcc
+          if test "$host_cpu" = ia64; then
+	  # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
+	  # chokes on -Wl,-G. The following line is correct:
+	  shared_flag='-G'
+          else
+	    if test "$aix_use_runtimelinking" = yes; then
+	      shared_flag='${wl}-G'
+	    else
+	      shared_flag='${wl}-bM:SRE'
+	    fi
+          fi
+        fi
+
+        export_dynamic_flag_spec_CXX='${wl}-bexpall'
+        # It seems that -bexpall does not export symbols beginning with
+        # underscore (_), so it is better to generate a list of symbols to
+	# export.
+        always_export_symbols_CXX=yes
+        if test "$aix_use_runtimelinking" = yes; then
+          # Warning - without using the other runtime loading flags (-brtl),
+          # -berok will link without error, but may produce a broken library.
+          allow_undefined_flag_CXX='-berok'
+          # Determine the default libpath from the value encoded in an empty
+          # executable.
+          if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_link "$LINENO"; then :
+
+lt_aix_libpath_sed='
+    /Import File Strings/,/^$/ {
+	/^0/ {
+	    s/^0  *\(.*\)$/\1/
+	    p
+	}
+    }'
+aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+# Check for a 64-bit object if we didn't find anything.
+if test -z "$aix_libpath"; then
+  aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi
+
+          hardcode_libdir_flag_spec_CXX='${wl}-blibpath:$libdir:'"$aix_libpath"
+
+          archive_expsym_cmds_CXX='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag"
+        else
+          if test "$host_cpu" = ia64; then
+	    hardcode_libdir_flag_spec_CXX='${wl}-R $libdir:/usr/lib:/lib'
+	    allow_undefined_flag_CXX="-z nodefs"
+	    archive_expsym_cmds_CXX="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols"
+          else
+	    # Determine the default libpath from the value encoded in an
+	    # empty executable.
+	    if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_link "$LINENO"; then :
+
+lt_aix_libpath_sed='
+    /Import File Strings/,/^$/ {
+	/^0/ {
+	    s/^0  *\(.*\)$/\1/
+	    p
+	}
+    }'
+aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+# Check for a 64-bit object if we didn't find anything.
+if test -z "$aix_libpath"; then
+  aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
+fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi
+
+	    hardcode_libdir_flag_spec_CXX='${wl}-blibpath:$libdir:'"$aix_libpath"
+	    # Warning - without using the other run time loading flags,
+	    # -berok will link without error, but may produce a broken library.
+	    no_undefined_flag_CXX=' ${wl}-bernotok'
+	    allow_undefined_flag_CXX=' ${wl}-berok'
+	    if test "$with_gnu_ld" = yes; then
+	      # We only use this code for GNU lds that support --whole-archive.
+	      whole_archive_flag_spec_CXX='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
+	    else
+	      # Exported symbols can be pulled into shared objects from archives
+	      whole_archive_flag_spec_CXX='$convenience'
+	    fi
+	    archive_cmds_need_lc_CXX=yes
+	    # This is similar to how AIX traditionally builds its shared
+	    # libraries.
+	    archive_expsym_cmds_CXX="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname'
+          fi
+        fi
+        ;;
+
+      beos*)
+	if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
+	  allow_undefined_flag_CXX=unsupported
+	  # Joseph Beckenbach <jrb3@best.com> says some releases of gcc
+	  # support --undefined.  This deserves some investigation.  FIXME
+	  archive_cmds_CXX='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+	else
+	  ld_shlibs_CXX=no
+	fi
+	;;
+
+      chorus*)
+        case $cc_basename in
+          *)
+	  # FIXME: insert proper C++ library support
+	  ld_shlibs_CXX=no
+	  ;;
+        esac
+        ;;
+
+      cygwin* | mingw* | pw32* | cegcc*)
+        # _LT_TAGVAR(hardcode_libdir_flag_spec, CXX) is actually meaningless,
+        # as there is no search path for DLLs.
+        hardcode_libdir_flag_spec_CXX='-L$libdir'
+        export_dynamic_flag_spec_CXX='${wl}--export-all-symbols'
+        allow_undefined_flag_CXX=unsupported
+        always_export_symbols_CXX=no
+        enable_shared_with_static_runtimes_CXX=yes
+
+        if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
+          archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+          # If the export-symbols file already is a .def file (1st line
+          # is EXPORTS), use it as is; otherwise, prepend...
+          archive_expsym_cmds_CXX='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
+	    cp $export_symbols $output_objdir/$soname.def;
+          else
+	    echo EXPORTS > $output_objdir/$soname.def;
+	    cat $export_symbols >> $output_objdir/$soname.def;
+          fi~
+          $CC -shared -nostdlib $output_objdir/$soname.def $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
+        else
+          ld_shlibs_CXX=no
+        fi
+        ;;
+      darwin* | rhapsody*)
+
+
+  archive_cmds_need_lc_CXX=no
+  hardcode_direct_CXX=no
+  hardcode_automatic_CXX=yes
+  hardcode_shlibpath_var_CXX=unsupported
+  if test "$lt_cv_ld_force_load" = "yes"; then
+    whole_archive_flag_spec_CXX='`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience ${wl}-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`'
+  else
+    whole_archive_flag_spec_CXX=''
+  fi
+  link_all_deplibs_CXX=yes
+  allow_undefined_flag_CXX="$_lt_dar_allow_undefined"
+  case $cc_basename in
+     ifort*) _lt_dar_can_shared=yes ;;
+     *) _lt_dar_can_shared=$GCC ;;
+  esac
+  if test "$_lt_dar_can_shared" = "yes"; then
+    output_verbose_link_cmd=func_echo_all
+    archive_cmds_CXX="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}"
+    module_cmds_CXX="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}"
+    archive_expsym_cmds_CXX="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}"
+    module_expsym_cmds_CXX="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}"
+       if test "$lt_cv_apple_cc_single_mod" != "yes"; then
+      archive_cmds_CXX="\$CC -r -keep_private_externs -nostdlib -o \${lib}-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \${lib}-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring${_lt_dsymutil}"
+      archive_expsym_cmds_CXX="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -r -keep_private_externs -nostdlib -o \${lib}-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \${lib}-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring${_lt_dar_export_syms}${_lt_dsymutil}"
+    fi
+
+  else
+  ld_shlibs_CXX=no
+  fi
+
+	;;
+
+      dgux*)
+        case $cc_basename in
+          ec++*)
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+          ghcx*)
+	    # Green Hills C++ Compiler
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+          *)
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+        esac
+        ;;
+
+      freebsd2.*)
+        # C++ shared libraries reported to be fairly broken before
+	# switch to ELF
+        ld_shlibs_CXX=no
+        ;;
+
+      freebsd-elf*)
+        archive_cmds_need_lc_CXX=no
+        ;;
+
+      freebsd* | dragonfly*)
+        # FreeBSD 3 and later use GNU C++ and GNU ld with standard ELF
+        # conventions
+        ld_shlibs_CXX=yes
+        ;;
+
+      gnu*)
+        ;;
+
+      haiku*)
+        archive_cmds_CXX='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+        link_all_deplibs_CXX=yes
+        ;;
+
+      hpux9*)
+        hardcode_libdir_flag_spec_CXX='${wl}+b ${wl}$libdir'
+        hardcode_libdir_separator_CXX=:
+        export_dynamic_flag_spec_CXX='${wl}-E'
+        hardcode_direct_CXX=yes
+        hardcode_minus_L_CXX=yes # Not in the search PATH,
+				             # but as the default
+				             # location of the library.
+
+        case $cc_basename in
+          CC*)
+            # FIXME: insert proper C++ library support
+            ld_shlibs_CXX=no
+            ;;
+          aCC*)
+            archive_cmds_CXX='$RM $output_objdir/$soname~$CC -b ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
+            # Commands to make compiler produce verbose output that lists
+            # what "hidden" libraries, object files and flags are used when
+            # linking a shared library.
+            #
+            # There doesn't appear to be a way to prevent this compiler from
+            # explicitly linking system object files so we need to strip them
+            # from the output so that they don't get included in the library
+            # dependencies.
+            output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $EGREP "\-L"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
+            ;;
+          *)
+            if test "$GXX" = yes; then
+              archive_cmds_CXX='$RM $output_objdir/$soname~$CC -shared -nostdlib -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
+            else
+              # FIXME: insert proper C++ library support
+              ld_shlibs_CXX=no
+            fi
+            ;;
+        esac
+        ;;
+
+      hpux10*|hpux11*)
+        if test $with_gnu_ld = no; then
+	  hardcode_libdir_flag_spec_CXX='${wl}+b ${wl}$libdir'
+	  hardcode_libdir_separator_CXX=:
+
+          case $host_cpu in
+            hppa*64*|ia64*)
+              ;;
+            *)
+	      export_dynamic_flag_spec_CXX='${wl}-E'
+              ;;
+          esac
+        fi
+        case $host_cpu in
+          hppa*64*|ia64*)
+            hardcode_direct_CXX=no
+            hardcode_shlibpath_var_CXX=no
+            ;;
+          *)
+            hardcode_direct_CXX=yes
+            hardcode_direct_absolute_CXX=yes
+            hardcode_minus_L_CXX=yes # Not in the search PATH,
+					         # but as the default
+					         # location of the library.
+            ;;
+        esac
+
+        case $cc_basename in
+          CC*)
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+          aCC*)
+	    case $host_cpu in
+	      hppa*64*)
+	        archive_cmds_CXX='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	        ;;
+	      ia64*)
+	        archive_cmds_CXX='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	        ;;
+	      *)
+	        archive_cmds_CXX='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	        ;;
+	    esac
+	    # Commands to make compiler produce verbose output that lists
+	    # what "hidden" libraries, object files and flags are used when
+	    # linking a shared library.
+	    #
+	    # There doesn't appear to be a way to prevent this compiler from
+	    # explicitly linking system object files so we need to strip them
+	    # from the output so that they don't get included in the library
+	    # dependencies.
+	    output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $GREP "\-L"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
+	    ;;
+          *)
+	    if test "$GXX" = yes; then
+	      if test $with_gnu_ld = no; then
+	        case $host_cpu in
+	          hppa*64*)
+	            archive_cmds_CXX='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	            ;;
+	          ia64*)
+	            archive_cmds_CXX='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	            ;;
+	          *)
+	            archive_cmds_CXX='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	            ;;
+	        esac
+	      fi
+	    else
+	      # FIXME: insert proper C++ library support
+	      ld_shlibs_CXX=no
+	    fi
+	    ;;
+        esac
+        ;;
+
+      interix[3-9]*)
+	hardcode_direct_CXX=no
+	hardcode_shlibpath_var_CXX=no
+	hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir'
+	export_dynamic_flag_spec_CXX='${wl}-E'
+	# Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
+	# Instead, shared libraries are loaded at an image base (0x10000000 by
+	# default) and relocated if they conflict, which is a slow very memory
+	# consuming and fragmenting process.  To avoid this, we pick a random,
+	# 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
+	# time.  Moving up from 0x10000000 also allows more sbrk(2) space.
+	archive_cmds_CXX='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+	archive_expsym_cmds_CXX='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
+	;;
+      irix5* | irix6*)
+        case $cc_basename in
+          CC*)
+	    # SGI C++
+	    archive_cmds_CXX='$CC -shared -all -multigot $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
+
+	    # Archives containing C++ object files must be created using
+	    # "CC -ar", where "CC" is the IRIX C++ compiler.  This is
+	    # necessary to make sure instantiated templates are included
+	    # in the archive.
+	    old_archive_cmds_CXX='$CC -ar -WR,-u -o $oldlib $oldobjs'
+	    ;;
+          *)
+	    if test "$GXX" = yes; then
+	      if test "$with_gnu_ld" = no; then
+	        archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+	      else
+	        archive_cmds_CXX='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` -o $lib'
+	      fi
+	    fi
+	    link_all_deplibs_CXX=yes
+	    ;;
+        esac
+        hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir'
+        hardcode_libdir_separator_CXX=:
+        inherit_rpath_CXX=yes
+        ;;
+
+      linux* | k*bsd*-gnu | kopensolaris*-gnu)
+        case $cc_basename in
+          KCC*)
+	    # Kuck and Associates, Inc. (KAI) C++ Compiler
+
+	    # KCC will only create a shared library if the output file
+	    # ends with ".so" (or ".sl" for HP-UX), so rename the library
+	    # to its proper name (with version) after linking.
+	    archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib'
+	    archive_expsym_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib ${wl}-retain-symbols-file,$export_symbols; mv \$templib $lib'
+	    # Commands to make compiler produce verbose output that lists
+	    # what "hidden" libraries, object files and flags are used when
+	    # linking a shared library.
+	    #
+	    # There doesn't appear to be a way to prevent this compiler from
+	    # explicitly linking system object files so we need to strip them
+	    # from the output so that they don't get included in the library
+	    # dependencies.
+	    output_verbose_link_cmd='templist=`$CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 | $GREP "ld"`; rm -f libconftest$shared_ext; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
+
+	    hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir'
+	    export_dynamic_flag_spec_CXX='${wl}--export-dynamic'
+
+	    # Archives containing C++ object files must be created using
+	    # "CC -Bstatic", where "CC" is the KAI C++ compiler.
+	    old_archive_cmds_CXX='$CC -Bstatic -o $oldlib $oldobjs'
+	    ;;
+	  icpc* | ecpc* )
+	    # Intel C++
+	    with_gnu_ld=yes
+	    # version 8.0 and above of icpc choke on multiply defined symbols
+	    # if we add $predep_objects and $postdep_objects, however 7.1 and
+	    # earlier do not add the objects themselves.
+	    case `$CC -V 2>&1` in
+	      *"Version 7."*)
+	        archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
+		archive_expsym_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+		;;
+	      *)  # Version 8.0 or newer
+	        tmp_idyn=
+	        case $host_cpu in
+		  ia64*) tmp_idyn=' -i_dynamic';;
+		esac
+	        archive_cmds_CXX='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+		archive_expsym_cmds_CXX='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+		;;
+	    esac
+	    archive_cmds_need_lc_CXX=no
+	    hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir'
+	    export_dynamic_flag_spec_CXX='${wl}--export-dynamic'
+	    whole_archive_flag_spec_CXX='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
+	    ;;
+          pgCC* | pgcpp*)
+            # Portland Group C++ compiler
+	    case `$CC -V` in
+	    *pgCC\ [1-5].* | *pgcpp\ [1-5].*)
+	      prelink_cmds_CXX='tpldir=Template.dir~
+		rm -rf $tpldir~
+		$CC --prelink_objects --instantiation_dir $tpldir $objs $libobjs $compile_deplibs~
+		compile_command="$compile_command `find $tpldir -name \*.o | sort | $NL2SP`"'
+	      old_archive_cmds_CXX='tpldir=Template.dir~
+		rm -rf $tpldir~
+		$CC --prelink_objects --instantiation_dir $tpldir $oldobjs$old_deplibs~
+		$AR $AR_FLAGS $oldlib$oldobjs$old_deplibs `find $tpldir -name \*.o | sort | $NL2SP`~
+		$RANLIB $oldlib'
+	      archive_cmds_CXX='tpldir=Template.dir~
+		rm -rf $tpldir~
+		$CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~
+		$CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname -o $lib'
+	      archive_expsym_cmds_CXX='tpldir=Template.dir~
+		rm -rf $tpldir~
+		$CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~
+		$CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname ${wl}-retain-symbols-file ${wl}$export_symbols -o $lib'
+	      ;;
+	    *) # Version 6 and above use weak symbols
+	      archive_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname -o $lib'
+	      archive_expsym_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname ${wl}-retain-symbols-file ${wl}$export_symbols -o $lib'
+	      ;;
+	    esac
+
+	    hardcode_libdir_flag_spec_CXX='${wl}--rpath ${wl}$libdir'
+	    export_dynamic_flag_spec_CXX='${wl}--export-dynamic'
+	    whole_archive_flag_spec_CXX='${wl}--whole-archive`for conv in $convenience\"\"; do test  -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
+            ;;
+	  cxx*)
+	    # Compaq C++
+	    archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
+	    archive_expsym_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname  -o $lib ${wl}-retain-symbols-file $wl$export_symbols'
+
+	    runpath_var=LD_RUN_PATH
+	    hardcode_libdir_flag_spec_CXX='-rpath $libdir'
+	    hardcode_libdir_separator_CXX=:
+
+	    # Commands to make compiler produce verbose output that lists
+	    # what "hidden" libraries, object files and flags are used when
+	    # linking a shared library.
+	    #
+	    # There doesn't appear to be a way to prevent this compiler from
+	    # explicitly linking system object files so we need to strip them
+	    # from the output so that they don't get included in the library
+	    # dependencies.
+	    output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld .*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "X$list" | $Xsed'
+	    ;;
+	  xl* | mpixl* | bgxl*)
+	    # IBM XL 8.0 on PPC, with GNU ld
+	    hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir'
+	    export_dynamic_flag_spec_CXX='${wl}--export-dynamic'
+	    archive_cmds_CXX='$CC -qmkshrobj $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+	    if test "x$supports_anon_versioning" = xyes; then
+	      archive_expsym_cmds_CXX='echo "{ global:" > $output_objdir/$libname.ver~
+		cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
+		echo "local: *; };" >> $output_objdir/$libname.ver~
+		$CC -qmkshrobj $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib'
+	    fi
+	    ;;
+	  *)
+	    case `$CC -V 2>&1 | sed 5q` in
+	    *Sun\ C*)
+	      # Sun C++ 5.9
+	      no_undefined_flag_CXX=' -zdefs'
+	      archive_cmds_CXX='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	      archive_expsym_cmds_CXX='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-retain-symbols-file ${wl}$export_symbols'
+	      hardcode_libdir_flag_spec_CXX='-R$libdir'
+	      whole_archive_flag_spec_CXX='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
+	      compiler_needs_object_CXX=yes
+
+	      # Not sure whether something based on
+	      # $CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1
+	      # would be better.
+	      output_verbose_link_cmd='func_echo_all'
+
+	      # Archives containing C++ object files must be created using
+	      # "CC -xar", where "CC" is the Sun C++ compiler.  This is
+	      # necessary to make sure instantiated templates are included
+	      # in the archive.
+	      old_archive_cmds_CXX='$CC -xar -o $oldlib $oldobjs'
+	      ;;
+	    esac
+	    ;;
+	esac
+	;;
+
+      lynxos*)
+        # FIXME: insert proper C++ library support
+	ld_shlibs_CXX=no
+	;;
+
+      m88k*)
+        # FIXME: insert proper C++ library support
+        ld_shlibs_CXX=no
+	;;
+
+      mvs*)
+        case $cc_basename in
+          cxx*)
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+	  *)
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+	esac
+	;;
+
+      netbsd*)
+        if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+	  archive_cmds_CXX='$LD -Bshareable  -o $lib $predep_objects $libobjs $deplibs $postdep_objects $linker_flags'
+	  wlarc=
+	  hardcode_libdir_flag_spec_CXX='-R$libdir'
+	  hardcode_direct_CXX=yes
+	  hardcode_shlibpath_var_CXX=no
+	fi
+	# Workaround some broken pre-1.5 toolchains
+	output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP conftest.$objext | $SED -e "s:-lgcc -lc -lgcc::"'
+	;;
+
+      *nto* | *qnx*)
+        ld_shlibs_CXX=yes
+	;;
+
+      openbsd2*)
+        # C++ shared libraries are fairly broken
+	ld_shlibs_CXX=no
+	;;
+
+      openbsd*)
+	if test -f /usr/libexec/ld.so; then
+	  hardcode_direct_CXX=yes
+	  hardcode_shlibpath_var_CXX=no
+	  hardcode_direct_absolute_CXX=yes
+	  archive_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib'
+	  hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir'
+	  if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+	    archive_expsym_cmds_CXX='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-retain-symbols-file,$export_symbols -o $lib'
+	    export_dynamic_flag_spec_CXX='${wl}-E'
+	    whole_archive_flag_spec_CXX="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
+	  fi
+	  output_verbose_link_cmd=func_echo_all
+	else
+	  ld_shlibs_CXX=no
+	fi
+	;;
+
+      osf3* | osf4* | osf5*)
+        case $cc_basename in
+          KCC*)
+	    # Kuck and Associates, Inc. (KAI) C++ Compiler
+
+	    # KCC will only create a shared library if the output file
+	    # ends with ".so" (or ".sl" for HP-UX), so rename the library
+	    # to its proper name (with version) after linking.
+	    archive_cmds_CXX='tempext=`echo $shared_ext | $SED -e '\''s/\([^()0-9A-Za-z{}]\)/\\\\\1/g'\''`; templib=`echo "$lib" | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib'
+
+	    hardcode_libdir_flag_spec_CXX='${wl}-rpath,$libdir'
+	    hardcode_libdir_separator_CXX=:
+
+	    # Archives containing C++ object files must be created using
+	    # the KAI C++ compiler.
+	    case $host in
+	      osf3*) old_archive_cmds_CXX='$CC -Bstatic -o $oldlib $oldobjs' ;;
+	      *) old_archive_cmds_CXX='$CC -o $oldlib $oldobjs' ;;
+	    esac
+	    ;;
+          RCC*)
+	    # Rational C++ 2.4.1
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+          cxx*)
+	    case $host in
+	      osf3*)
+	        allow_undefined_flag_CXX=' ${wl}-expect_unresolved ${wl}\*'
+	        archive_cmds_CXX='$CC -shared${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $soname `test -n "$verstring" && func_echo_all "${wl}-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
+	        hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir'
+		;;
+	      *)
+	        allow_undefined_flag_CXX=' -expect_unresolved \*'
+	        archive_cmds_CXX='$CC -shared${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
+	        archive_expsym_cmds_CXX='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done~
+	          echo "-hidden">> $lib.exp~
+	          $CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname ${wl}-input ${wl}$lib.exp  `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~
+	          $RM $lib.exp'
+	        hardcode_libdir_flag_spec_CXX='-rpath $libdir'
+		;;
+	    esac
+
+	    hardcode_libdir_separator_CXX=:
+
+	    # Commands to make compiler produce verbose output that lists
+	    # what "hidden" libraries, object files and flags are used when
+	    # linking a shared library.
+	    #
+	    # There doesn't appear to be a way to prevent this compiler from
+	    # explicitly linking system object files so we need to strip them
+	    # from the output so that they don't get included in the library
+	    # dependencies.
+	    output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld" | $GREP -v "ld:"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
+	    ;;
+	  *)
+	    if test "$GXX" = yes && test "$with_gnu_ld" = no; then
+	      allow_undefined_flag_CXX=' ${wl}-expect_unresolved ${wl}\*'
+	      case $host in
+	        osf3*)
+	          archive_cmds_CXX='$CC -shared -nostdlib ${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+		  ;;
+	        *)
+	          archive_cmds_CXX='$CC -shared -nostdlib ${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+		  ;;
+	      esac
+
+	      hardcode_libdir_flag_spec_CXX='${wl}-rpath ${wl}$libdir'
+	      hardcode_libdir_separator_CXX=:
+
+	      # Commands to make compiler produce verbose output that lists
+	      # what "hidden" libraries, object files and flags are used when
+	      # linking a shared library.
+	      output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
+
+	    else
+	      # FIXME: insert proper C++ library support
+	      ld_shlibs_CXX=no
+	    fi
+	    ;;
+        esac
+        ;;
+
+      psos*)
+        # FIXME: insert proper C++ library support
+        ld_shlibs_CXX=no
+        ;;
+
+      sunos4*)
+        case $cc_basename in
+          CC*)
+	    # Sun C++ 4.x
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+          lcc*)
+	    # Lucid
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+          *)
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+        esac
+        ;;
+
+      solaris*)
+        case $cc_basename in
+          CC*)
+	    # Sun C++ 4.2, 5.x and Centerline C++
+            archive_cmds_need_lc_CXX=yes
+	    no_undefined_flag_CXX=' -zdefs'
+	    archive_cmds_CXX='$CC -G${allow_undefined_flag}  -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
+	    archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+	      $CC -G${allow_undefined_flag} ${wl}-M ${wl}$lib.exp -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
+
+	    hardcode_libdir_flag_spec_CXX='-R$libdir'
+	    hardcode_shlibpath_var_CXX=no
+	    case $host_os in
+	      solaris2.[0-5] | solaris2.[0-5].*) ;;
+	      *)
+		# The compiler driver will combine and reorder linker options,
+		# but understands `-z linker_flag'.
+	        # Supported since Solaris 2.6 (maybe 2.5.1?)
+		whole_archive_flag_spec_CXX='-z allextract$convenience -z defaultextract'
+	        ;;
+	    esac
+	    link_all_deplibs_CXX=yes
+
+	    output_verbose_link_cmd='func_echo_all'
+
+	    # Archives containing C++ object files must be created using
+	    # "CC -xar", where "CC" is the Sun C++ compiler.  This is
+	    # necessary to make sure instantiated templates are included
+	    # in the archive.
+	    old_archive_cmds_CXX='$CC -xar -o $oldlib $oldobjs'
+	    ;;
+          gcx*)
+	    # Green Hills C++ Compiler
+	    archive_cmds_CXX='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
+
+	    # The C++ compiler must be used to create the archive.
+	    old_archive_cmds_CXX='$CC $LDFLAGS -archive -o $oldlib $oldobjs'
+	    ;;
+          *)
+	    # GNU C++ compiler with Solaris linker
+	    if test "$GXX" = yes && test "$with_gnu_ld" = no; then
+	      no_undefined_flag_CXX=' ${wl}-z ${wl}defs'
+	      if $CC --version | $GREP -v '^2\.7' > /dev/null; then
+	        archive_cmds_CXX='$CC -shared -nostdlib $LDFLAGS $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
+	        archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+		  $CC -shared -nostdlib ${wl}-M $wl$lib.exp -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
+
+	        # Commands to make compiler produce verbose output that lists
+	        # what "hidden" libraries, object files and flags are used when
+	        # linking a shared library.
+	        output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
+	      else
+	        # g++ 2.7 appears to require `-G' NOT `-shared' on this
+	        # platform.
+	        archive_cmds_CXX='$CC -G -nostdlib $LDFLAGS $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
+	        archive_expsym_cmds_CXX='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
+		  $CC -G -nostdlib ${wl}-M $wl$lib.exp -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
+
+	        # Commands to make compiler produce verbose output that lists
+	        # what "hidden" libraries, object files and flags are used when
+	        # linking a shared library.
+	        output_verbose_link_cmd='$CC -G $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
+	      fi
+
+	      hardcode_libdir_flag_spec_CXX='${wl}-R $wl$libdir'
+	      case $host_os in
+		solaris2.[0-5] | solaris2.[0-5].*) ;;
+		*)
+		  whole_archive_flag_spec_CXX='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract'
+		  ;;
+	      esac
+	    fi
+	    ;;
+        esac
+        ;;
+
+    sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*)
+      no_undefined_flag_CXX='${wl}-z,text'
+      archive_cmds_need_lc_CXX=no
+      hardcode_shlibpath_var_CXX=no
+      runpath_var='LD_RUN_PATH'
+
+      case $cc_basename in
+        CC*)
+	  archive_cmds_CXX='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  archive_expsym_cmds_CXX='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+	*)
+	  archive_cmds_CXX='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  archive_expsym_cmds_CXX='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	  ;;
+      esac
+      ;;
+
+      sysv5* | sco3.2v5* | sco5v6*)
+	# Note: We can NOT use -z defs as we might desire, because we do not
+	# link with -lc, and that would cause any symbols used from libc to
+	# always be unresolved, which means just about no library would
+	# ever link correctly.  If we're not using GNU ld we use -z text
+	# though, which does catch some bad symbols but isn't as heavy-handed
+	# as -z defs.
+	no_undefined_flag_CXX='${wl}-z,text'
+	allow_undefined_flag_CXX='${wl}-z,nodefs'
+	archive_cmds_need_lc_CXX=no
+	hardcode_shlibpath_var_CXX=no
+	hardcode_libdir_flag_spec_CXX='${wl}-R,$libdir'
+	hardcode_libdir_separator_CXX=':'
+	link_all_deplibs_CXX=yes
+	export_dynamic_flag_spec_CXX='${wl}-Bexport'
+	runpath_var='LD_RUN_PATH'
+
+	case $cc_basename in
+          CC*)
+	    archive_cmds_CXX='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	    archive_expsym_cmds_CXX='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	    old_archive_cmds_CXX='$CC -Tprelink_objects $oldobjs~
+	      '"$old_archive_cmds_CXX"
+	    reload_cmds_CXX='$CC -Tprelink_objects $reload_objs~
+	      '"$reload_cmds_CXX"
+	    ;;
+	  *)
+	    archive_cmds_CXX='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	    archive_expsym_cmds_CXX='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
+	    ;;
+	esac
+      ;;
+
+      tandem*)
+        case $cc_basename in
+          NCC*)
+	    # NonStop-UX NCC 3.20
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+          *)
+	    # FIXME: insert proper C++ library support
+	    ld_shlibs_CXX=no
+	    ;;
+        esac
+        ;;
+
+      vxworks*)
+        # For VxWorks ports, we assume the use of a GNU linker with
+        # standard elf conventions.
+        ld_shlibs_CXX=yes
+        ;;
+
+      *)
+        # FIXME: insert proper C++ library support
+        ld_shlibs_CXX=no
+        ;;
+    esac
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_CXX" >&5
+$as_echo "$ld_shlibs_CXX" >&6; }
+    test "$ld_shlibs_CXX" = no && can_build_shared=no
+
+    GCC_CXX="$GXX"
+    LD_CXX="$LD"
+
+    ## CAVEAT EMPTOR:
+    ## There is no encapsulation within the following macros, do not change
+    ## the running order or otherwise move them around unless you know exactly
+    ## what you are doing...
+    # Dependencies to place before and after the object being linked:
+predep_objects_CXX=
+postdep_objects_CXX=
+predeps_CXX=
+postdeps_CXX=
+compiler_lib_search_path_CXX=
+
+cat > conftest.$ac_ext <<_LT_EOF
+class Foo
+{
+public:
+  Foo (void) { a = 0; }
+private:
+  int a;
+};
+_LT_EOF
+
+if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then
+  # Parse the compiler output and extract the necessary
+  # objects, libraries and library flags.
+
+  # Sentinel used to keep track of whether or not we are before
+  # the conftest object file.
+  pre_test_object_deps_done=no
+
+  for p in `eval "$output_verbose_link_cmd"`; do
+    case $p in
+
+    -L* | -R* | -l*)
+       # Some compilers place space between "-{L,R}" and the path.
+       # Remove the space.
+       if test $p = "-L" ||
+          test $p = "-R"; then
+	 prev=$p
+	 continue
+       else
+	 prev=
+       fi
+
+       if test "$pre_test_object_deps_done" = no; then
+	 case $p in
+	 -L* | -R*)
+	   # Internal compiler library paths should come after those
+	   # provided the user.  The postdeps already come after the
+	   # user supplied libs so there is no need to process them.
+	   if test -z "$compiler_lib_search_path_CXX"; then
+	     compiler_lib_search_path_CXX="${prev}${p}"
+	   else
+	     compiler_lib_search_path_CXX="${compiler_lib_search_path_CXX} ${prev}${p}"
+	   fi
+	   ;;
+	 # The "-l" case would never come before the object being
+	 # linked, so don't bother handling this case.
+	 esac
+       else
+	 if test -z "$postdeps_CXX"; then
+	   postdeps_CXX="${prev}${p}"
+	 else
+	   postdeps_CXX="${postdeps_CXX} ${prev}${p}"
+	 fi
+       fi
+       ;;
+
+    *.$objext)
+       # This assumes that the test object file only shows up
+       # once in the compiler output.
+       if test "$p" = "conftest.$objext"; then
+	 pre_test_object_deps_done=yes
+	 continue
+       fi
+
+       if test "$pre_test_object_deps_done" = no; then
+	 if test -z "$predep_objects_CXX"; then
+	   predep_objects_CXX="$p"
+	 else
+	   predep_objects_CXX="$predep_objects_CXX $p"
+	 fi
+       else
+	 if test -z "$postdep_objects_CXX"; then
+	   postdep_objects_CXX="$p"
+	 else
+	   postdep_objects_CXX="$postdep_objects_CXX $p"
+	 fi
+       fi
+       ;;
+
+    *) ;; # Ignore the rest.
+
+    esac
+  done
+
+  # Clean up.
+  rm -f a.out a.exe
+else
+  echo "libtool.m4: error: problem compiling CXX test program"
+fi
+
+$RM -f confest.$objext
+
+# PORTME: override above test on systems where it is broken
+case $host_os in
+interix[3-9]*)
+  # Interix 3.5 installs completely hosed .la files for C++, so rather than
+  # hack all around it, let's just trust "g++" to DTRT.
+  predep_objects_CXX=
+  postdep_objects_CXX=
+  postdeps_CXX=
+  ;;
+
+linux*)
+  case `$CC -V 2>&1 | sed 5q` in
+  *Sun\ C*)
+    # Sun C++ 5.9
+
+    # The more standards-conforming stlport4 library is
+    # incompatible with the Cstd library. Avoid specifying
+    # it if it's in CXXFLAGS. Ignore libCrun as
+    # -library=stlport4 depends on it.
+    case " $CXX $CXXFLAGS " in
+    *" -library=stlport4 "*)
+      solaris_use_stlport4=yes
+      ;;
+    esac
+
+    if test "$solaris_use_stlport4" != yes; then
+      postdeps_CXX='-library=Cstd -library=Crun'
+    fi
+    ;;
+  esac
+  ;;
+
+solaris*)
+  case $cc_basename in
+  CC*)
+    # The more standards-conforming stlport4 library is
+    # incompatible with the Cstd library. Avoid specifying
+    # it if it's in CXXFLAGS. Ignore libCrun as
+    # -library=stlport4 depends on it.
+    case " $CXX $CXXFLAGS " in
+    *" -library=stlport4 "*)
+      solaris_use_stlport4=yes
+      ;;
+    esac
+
+    # Adding this requires a known-good setup of shared libraries for
+    # Sun compiler versions before 5.6, else PIC objects from an old
+    # archive will be linked into the output, leading to subtle bugs.
+    if test "$solaris_use_stlport4" != yes; then
+      postdeps_CXX='-library=Cstd -library=Crun'
+    fi
+    ;;
+  esac
+  ;;
+esac
+
+
+case " $postdeps_CXX " in
+*" -lc "*) archive_cmds_need_lc_CXX=no ;;
+esac
+ compiler_lib_search_dirs_CXX=
+if test -n "${compiler_lib_search_path_CXX}"; then
+ compiler_lib_search_dirs_CXX=`echo " ${compiler_lib_search_path_CXX}" | ${SED} -e 's! -L! !g' -e 's!^ !!'`
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+    lt_prog_compiler_wl_CXX=
+lt_prog_compiler_pic_CXX=
+lt_prog_compiler_static_CXX=
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5
+$as_echo_n "checking for $compiler option to produce PIC... " >&6; }
+
+  # C++ specific cases for pic, static, wl, etc.
+  if test "$GXX" = yes; then
+    lt_prog_compiler_wl_CXX='-Wl,'
+    lt_prog_compiler_static_CXX='-static'
+
+    case $host_os in
+    aix*)
+      # All AIX code is PIC.
+      if test "$host_cpu" = ia64; then
+	# AIX 5 now supports IA64 processor
+	lt_prog_compiler_static_CXX='-Bstatic'
+      fi
+      lt_prog_compiler_pic_CXX='-fPIC'
+      ;;
+
+    amigaos*)
+      case $host_cpu in
+      powerpc)
+            # see comment about AmigaOS4 .so support
+            lt_prog_compiler_pic_CXX='-fPIC'
+        ;;
+      m68k)
+            # FIXME: we need at least 68020 code to build shared libraries, but
+            # adding the `-m68020' flag to GCC prevents building anything better,
+            # like `-m68040'.
+            lt_prog_compiler_pic_CXX='-m68020 -resident32 -malways-restore-a4'
+        ;;
+      esac
+      ;;
+
+    beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
+      # PIC is the default for these OSes.
+      ;;
+    mingw* | cygwin* | os2* | pw32* | cegcc*)
+      # This hack is so that the source file can tell whether it is being
+      # built for inclusion in a dll (and should export symbols for example).
+      # Although the cygwin gcc ignores -fPIC, still need this for old-style
+      # (--disable-auto-import) libraries
+      lt_prog_compiler_pic_CXX='-DDLL_EXPORT'
+      ;;
+    darwin* | rhapsody*)
+      # PIC is the default on this platform
+      # Common symbols not allowed in MH_DYLIB files
+      lt_prog_compiler_pic_CXX='-fno-common'
+      ;;
+    *djgpp*)
+      # DJGPP does not support shared libraries at all
+      lt_prog_compiler_pic_CXX=
+      ;;
+    haiku*)
+      # PIC is the default for Haiku.
+      # The "-static" flag exists, but is broken.
+      lt_prog_compiler_static_CXX=
+      ;;
+    interix[3-9]*)
+      # Interix 3.x gcc -fpic/-fPIC options generate broken code.
+      # Instead, we relocate shared libraries at runtime.
+      ;;
+    sysv4*MP*)
+      if test -d /usr/nec; then
+	lt_prog_compiler_pic_CXX=-Kconform_pic
+      fi
+      ;;
+    hpux*)
+      # PIC is the default for 64-bit PA HP-UX, but not for 32-bit
+      # PA HP-UX.  On IA64 HP-UX, PIC is the default but the pic flag
+      # sets the default TLS model and affects inlining.
+      case $host_cpu in
+      hppa*64*)
+	;;
+      *)
+	lt_prog_compiler_pic_CXX='-fPIC'
+	;;
+      esac
+      ;;
+    *qnx* | *nto*)
+      # QNX uses GNU C++, but need to define -shared option too, otherwise
+      # it will coredump.
+      lt_prog_compiler_pic_CXX='-fPIC -shared'
+      ;;
+    *)
+      lt_prog_compiler_pic_CXX='-fPIC'
+      ;;
+    esac
+  else
+    case $host_os in
+      aix[4-9]*)
+	# All AIX code is PIC.
+	if test "$host_cpu" = ia64; then
+	  # AIX 5 now supports IA64 processor
+	  lt_prog_compiler_static_CXX='-Bstatic'
+	else
+	  lt_prog_compiler_static_CXX='-bnso -bI:/lib/syscalls.exp'
+	fi
+	;;
+      chorus*)
+	case $cc_basename in
+	cxch68*)
+	  # Green Hills C++ Compiler
+	  # _LT_TAGVAR(lt_prog_compiler_static, CXX)="--no_auto_instantiation -u __main -u __premain -u _abort -r $COOL_DIR/lib/libOrb.a $MVME_DIR/lib/CC/libC.a $MVME_DIR/lib/classix/libcx.s.a"
+	  ;;
+	esac
+	;;
+      dgux*)
+	case $cc_basename in
+	  ec++*)
+	    lt_prog_compiler_pic_CXX='-KPIC'
+	    ;;
+	  ghcx*)
+	    # Green Hills C++ Compiler
+	    lt_prog_compiler_pic_CXX='-pic'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      freebsd* | dragonfly*)
+	# FreeBSD uses GNU C++
+	;;
+      hpux9* | hpux10* | hpux11*)
+	case $cc_basename in
+	  CC*)
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    lt_prog_compiler_static_CXX='${wl}-a ${wl}archive'
+	    if test "$host_cpu" != ia64; then
+	      lt_prog_compiler_pic_CXX='+Z'
+	    fi
+	    ;;
+	  aCC*)
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    lt_prog_compiler_static_CXX='${wl}-a ${wl}archive'
+	    case $host_cpu in
+	    hppa*64*|ia64*)
+	      # +Z the default
+	      ;;
+	    *)
+	      lt_prog_compiler_pic_CXX='+Z'
+	      ;;
+	    esac
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      interix*)
+	# This is c89, which is MS Visual C++ (no shared libs)
+	# Anyone wants to do a port?
+	;;
+      irix5* | irix6* | nonstopux*)
+	case $cc_basename in
+	  CC*)
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    lt_prog_compiler_static_CXX='-non_shared'
+	    # CC pic flag -KPIC is the default.
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      linux* | k*bsd*-gnu | kopensolaris*-gnu)
+	case $cc_basename in
+	  KCC*)
+	    # KAI C++ Compiler
+	    lt_prog_compiler_wl_CXX='--backend -Wl,'
+	    lt_prog_compiler_pic_CXX='-fPIC'
+	    ;;
+	  ecpc* )
+	    # old Intel C++ for x86_64 which still supported -KPIC.
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    lt_prog_compiler_pic_CXX='-KPIC'
+	    lt_prog_compiler_static_CXX='-static'
+	    ;;
+	  icpc* )
+	    # Intel C++, used to be incompatible with GCC.
+	    # ICC 10 doesn't accept -KPIC any more.
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    lt_prog_compiler_pic_CXX='-fPIC'
+	    lt_prog_compiler_static_CXX='-static'
+	    ;;
+	  pgCC* | pgcpp*)
+	    # Portland Group C++ compiler
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    lt_prog_compiler_pic_CXX='-fpic'
+	    lt_prog_compiler_static_CXX='-Bstatic'
+	    ;;
+	  cxx*)
+	    # Compaq C++
+	    # Make sure the PIC flag is empty.  It appears that all Alpha
+	    # Linux and Compaq Tru64 Unix objects are PIC.
+	    lt_prog_compiler_pic_CXX=
+	    lt_prog_compiler_static_CXX='-non_shared'
+	    ;;
+	  xlc* | xlC* | bgxl[cC]* | mpixl[cC]*)
+	    # IBM XL 8.0, 9.0 on PPC and BlueGene
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    lt_prog_compiler_pic_CXX='-qpic'
+	    lt_prog_compiler_static_CXX='-qstaticlink'
+	    ;;
+	  *)
+	    case `$CC -V 2>&1 | sed 5q` in
+	    *Sun\ C*)
+	      # Sun C++ 5.9
+	      lt_prog_compiler_pic_CXX='-KPIC'
+	      lt_prog_compiler_static_CXX='-Bstatic'
+	      lt_prog_compiler_wl_CXX='-Qoption ld '
+	      ;;
+	    esac
+	    ;;
+	esac
+	;;
+      lynxos*)
+	;;
+      m88k*)
+	;;
+      mvs*)
+	case $cc_basename in
+	  cxx*)
+	    lt_prog_compiler_pic_CXX='-W c,exportall'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      netbsd*)
+	;;
+      *qnx* | *nto*)
+        # QNX uses GNU C++, but need to define -shared option too, otherwise
+        # it will coredump.
+        lt_prog_compiler_pic_CXX='-fPIC -shared'
+        ;;
+      osf3* | osf4* | osf5*)
+	case $cc_basename in
+	  KCC*)
+	    lt_prog_compiler_wl_CXX='--backend -Wl,'
+	    ;;
+	  RCC*)
+	    # Rational C++ 2.4.1
+	    lt_prog_compiler_pic_CXX='-pic'
+	    ;;
+	  cxx*)
+	    # Digital/Compaq C++
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    # Make sure the PIC flag is empty.  It appears that all Alpha
+	    # Linux and Compaq Tru64 Unix objects are PIC.
+	    lt_prog_compiler_pic_CXX=
+	    lt_prog_compiler_static_CXX='-non_shared'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      psos*)
+	;;
+      solaris*)
+	case $cc_basename in
+	  CC*)
+	    # Sun C++ 4.2, 5.x and Centerline C++
+	    lt_prog_compiler_pic_CXX='-KPIC'
+	    lt_prog_compiler_static_CXX='-Bstatic'
+	    lt_prog_compiler_wl_CXX='-Qoption ld '
+	    ;;
+	  gcx*)
+	    # Green Hills C++ Compiler
+	    lt_prog_compiler_pic_CXX='-PIC'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      sunos4*)
+	case $cc_basename in
+	  CC*)
+	    # Sun C++ 4.x
+	    lt_prog_compiler_pic_CXX='-pic'
+	    lt_prog_compiler_static_CXX='-Bstatic'
+	    ;;
+	  lcc*)
+	    # Lucid
+	    lt_prog_compiler_pic_CXX='-pic'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
+	case $cc_basename in
+	  CC*)
+	    lt_prog_compiler_wl_CXX='-Wl,'
+	    lt_prog_compiler_pic_CXX='-KPIC'
+	    lt_prog_compiler_static_CXX='-Bstatic'
+	    ;;
+	esac
+	;;
+      tandem*)
+	case $cc_basename in
+	  NCC*)
+	    # NonStop-UX NCC 3.20
+	    lt_prog_compiler_pic_CXX='-KPIC'
+	    ;;
+	  *)
+	    ;;
+	esac
+	;;
+      vxworks*)
+	;;
+      *)
+	lt_prog_compiler_can_build_shared_CXX=no
+	;;
+    esac
+  fi
+
+case $host_os in
+  # For platforms which do not support PIC, -DPIC is meaningless:
+  *djgpp*)
+    lt_prog_compiler_pic_CXX=
+    ;;
+  *)
+    lt_prog_compiler_pic_CXX="$lt_prog_compiler_pic_CXX -DPIC"
+    ;;
+esac
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_prog_compiler_pic_CXX" >&5
+$as_echo "$lt_prog_compiler_pic_CXX" >&6; }
+
+
+
+#
+# Check to make sure the PIC flag actually works.
+#
+if test -n "$lt_prog_compiler_pic_CXX"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic_CXX works" >&5
+$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic_CXX works... " >&6; }
+if ${lt_cv_prog_compiler_pic_works_CXX+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_pic_works_CXX=no
+   ac_outfile=conftest.$ac_objext
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+   lt_compiler_flag="$lt_prog_compiler_pic_CXX -DPIC"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   # The option is referenced via a variable to avoid confusing sed.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>conftest.err)
+   ac_status=$?
+   cat conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s "$ac_outfile"; then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings other than the usual output.
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
+     $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+     if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_pic_works_CXX=yes
+     fi
+   fi
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works_CXX" >&5
+$as_echo "$lt_cv_prog_compiler_pic_works_CXX" >&6; }
+
+if test x"$lt_cv_prog_compiler_pic_works_CXX" = xyes; then
+    case $lt_prog_compiler_pic_CXX in
+     "" | " "*) ;;
+     *) lt_prog_compiler_pic_CXX=" $lt_prog_compiler_pic_CXX" ;;
+     esac
+else
+    lt_prog_compiler_pic_CXX=
+     lt_prog_compiler_can_build_shared_CXX=no
+fi
+
+fi
+
+
+
+#
+# Check to make sure the static flag actually works.
+#
+wl=$lt_prog_compiler_wl_CXX eval lt_tmp_static_flag=\"$lt_prog_compiler_static_CXX\"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5
+$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; }
+if ${lt_cv_prog_compiler_static_works_CXX+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_static_works_CXX=no
+   save_LDFLAGS="$LDFLAGS"
+   LDFLAGS="$LDFLAGS $lt_tmp_static_flag"
+   echo "$lt_simple_link_test_code" > conftest.$ac_ext
+   if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
+     # The linker can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     if test -s conftest.err; then
+       # Append any errors to the config.log.
+       cat conftest.err 1>&5
+       $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
+       $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
+       if diff conftest.exp conftest.er2 >/dev/null; then
+         lt_cv_prog_compiler_static_works_CXX=yes
+       fi
+     else
+       lt_cv_prog_compiler_static_works_CXX=yes
+     fi
+   fi
+   $RM -r conftest*
+   LDFLAGS="$save_LDFLAGS"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works_CXX" >&5
+$as_echo "$lt_cv_prog_compiler_static_works_CXX" >&6; }
+
+if test x"$lt_cv_prog_compiler_static_works_CXX" = xyes; then
+    :
+else
+    lt_prog_compiler_static_CXX=
+fi
+
+
+
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
+$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
+if ${lt_cv_prog_compiler_c_o_CXX+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_c_o_CXX=no
+   $RM -r conftest 2>/dev/null
+   mkdir conftest
+   cd conftest
+   mkdir out
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+   lt_compiler_flag="-o out/conftest2.$ac_objext"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>out/conftest.err)
+   ac_status=$?
+   cat out/conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s out/conftest2.$ac_objext
+   then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
+     $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
+     if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_c_o_CXX=yes
+     fi
+   fi
+   chmod u+w . 2>&5
+   $RM conftest*
+   # SGI C++ compiler will create directory out/ii_files/ for
+   # template instantiation
+   test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
+   $RM out/* && rmdir out
+   cd ..
+   $RM -r conftest
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_CXX" >&5
+$as_echo "$lt_cv_prog_compiler_c_o_CXX" >&6; }
+
+
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
+$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
+if ${lt_cv_prog_compiler_c_o_CXX+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_prog_compiler_c_o_CXX=no
+   $RM -r conftest 2>/dev/null
+   mkdir conftest
+   cd conftest
+   mkdir out
+   echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+   lt_compiler_flag="-o out/conftest2.$ac_objext"
+   # Insert the option either (1) after the last *FLAGS variable, or
+   # (2) before a word containing "conftest.", or (3) at the end.
+   # Note that $ac_compile itself does not contain backslashes and begins
+   # with a dollar sign (not a hyphen), so the echo should work correctly.
+   lt_compile=`echo "$ac_compile" | $SED \
+   -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
+   -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
+   -e 's:$: $lt_compiler_flag:'`
+   (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
+   (eval "$lt_compile" 2>out/conftest.err)
+   ac_status=$?
+   cat out/conftest.err >&5
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   if (exit $ac_status) && test -s out/conftest2.$ac_objext
+   then
+     # The compiler can only warn and ignore the option if not recognized
+     # So say no if there are warnings
+     $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
+     $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
+     if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
+       lt_cv_prog_compiler_c_o_CXX=yes
+     fi
+   fi
+   chmod u+w . 2>&5
+   $RM conftest*
+   # SGI C++ compiler will create directory out/ii_files/ for
+   # template instantiation
+   test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
+   $RM out/* && rmdir out
+   cd ..
+   $RM -r conftest
+   $RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_CXX" >&5
+$as_echo "$lt_cv_prog_compiler_c_o_CXX" >&6; }
+
+
+
+
+hard_links="nottested"
+if test "$lt_cv_prog_compiler_c_o_CXX" = no && test "$need_locks" != no; then
+  # do not overwrite the value of need_locks provided by the user
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5
+$as_echo_n "checking if we can lock with hard links... " >&6; }
+  hard_links=yes
+  $RM conftest*
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  touch conftest.a
+  ln conftest.a conftest.b 2>&5 || hard_links=no
+  ln conftest.a conftest.b 2>/dev/null && hard_links=no
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5
+$as_echo "$hard_links" >&6; }
+  if test "$hard_links" = no; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5
+$as_echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;}
+    need_locks=warn
+  fi
+else
+  need_locks=no
+fi
+
+
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5
+$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; }
+
+  export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
+  case $host_os in
+  aix[4-9]*)
+    # If we're using GNU nm, then we don't want the "-C" option.
+    # -C means demangle to AIX nm, but means don't demangle with GNU nm
+    # Also, AIX nm treats weak defined symbols like other global defined
+    # symbols, whereas GNU nm marks them as "W".
+    if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
+      export_symbols_cmds_CXX='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
+    else
+      export_symbols_cmds_CXX='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "L")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
+    fi
+    ;;
+  pw32*)
+    export_symbols_cmds_CXX="$ltdll_cmds"
+  ;;
+  cygwin* | mingw* | cegcc*)
+    export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;/^.*[ ]__nm__/s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols'
+  ;;
+  *)
+    export_symbols_cmds_CXX='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
+  ;;
+  esac
+  exclude_expsyms_CXX='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*'
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_CXX" >&5
+$as_echo "$ld_shlibs_CXX" >&6; }
+test "$ld_shlibs_CXX" = no && can_build_shared=no
+
+with_gnu_ld_CXX=$with_gnu_ld
+
+
+
+
+
+
+#
+# Do we need to explicitly link libc?
+#
+case "x$archive_cmds_need_lc_CXX" in
+x|xyes)
+  # Assume -lc should be added
+  archive_cmds_need_lc_CXX=yes
+
+  if test "$enable_shared" = yes && test "$GCC" = yes; then
+    case $archive_cmds_CXX in
+    *'~'*)
+      # FIXME: we may have to deal with multi-command sequences.
+      ;;
+    '$CC '*)
+      # Test whether the compiler implicitly links with -lc since on some
+      # systems, -lgcc has to come before -lc. If gcc already passes -lc
+      # to ld, don't add -lc before -lgcc.
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5
+$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; }
+if ${lt_cv_archive_cmds_need_lc_CXX+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  $RM conftest*
+	echo "$lt_simple_compile_test_code" > conftest.$ac_ext
+
+	if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
+  (eval $ac_compile) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } 2>conftest.err; then
+	  soname=conftest
+	  lib=conftest
+	  libobjs=conftest.$ac_objext
+	  deplibs=
+	  wl=$lt_prog_compiler_wl_CXX
+	  pic_flag=$lt_prog_compiler_pic_CXX
+	  compiler_flags=-v
+	  linker_flags=-v
+	  verstring=
+	  output_objdir=.
+	  libname=conftest
+	  lt_save_allow_undefined_flag=$allow_undefined_flag_CXX
+	  allow_undefined_flag_CXX=
+	  if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds_CXX 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5
+  (eval $archive_cmds_CXX 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+	  then
+	    lt_cv_archive_cmds_need_lc_CXX=no
+	  else
+	    lt_cv_archive_cmds_need_lc_CXX=yes
+	  fi
+	  allow_undefined_flag_CXX=$lt_save_allow_undefined_flag
+	else
+	  cat conftest.err 1>&5
+	fi
+	$RM conftest*
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc_CXX" >&5
+$as_echo "$lt_cv_archive_cmds_need_lc_CXX" >&6; }
+      archive_cmds_need_lc_CXX=$lt_cv_archive_cmds_need_lc_CXX
+      ;;
+    esac
+  fi
+  ;;
+esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5
+$as_echo_n "checking dynamic linker characteristics... " >&6; }
+
+library_names_spec=
+libname_spec='lib$name'
+soname_spec=
+shrext_cmds=".so"
+postinstall_cmds=
+postuninstall_cmds=
+finish_cmds=
+finish_eval=
+shlibpath_var=
+shlibpath_overrides_runpath=unknown
+version_type=none
+dynamic_linker="$host_os ld.so"
+sys_lib_dlsearch_path_spec="/lib /usr/lib"
+need_lib_prefix=unknown
+hardcode_into_libs=no
+
+# when you set need_version to no, make sure it does not cause -set_version
+# flags to be left without arguments
+need_version=unknown
+
+case $host_os in
+aix3*)
+  version_type=linux
+  library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a'
+  shlibpath_var=LIBPATH
+
+  # AIX 3 has no versioning support, so we append a major version to the name.
+  soname_spec='${libname}${release}${shared_ext}$major'
+  ;;
+
+aix[4-9]*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  hardcode_into_libs=yes
+  if test "$host_cpu" = ia64; then
+    # AIX 5 supports IA64
+    library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}'
+    shlibpath_var=LD_LIBRARY_PATH
+  else
+    # With GCC up to 2.95.x, collect2 would create an import file
+    # for dependence libraries.  The import file would start with
+    # the line `#! .'.  This would cause the generated library to
+    # depend on `.', always an invalid library.  This was fixed in
+    # development snapshots of GCC prior to 3.0.
+    case $host_os in
+      aix4 | aix4.[01] | aix4.[01].*)
+      if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
+	   echo ' yes '
+	   echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then
+	:
+      else
+	can_build_shared=no
+      fi
+      ;;
+    esac
+    # AIX (on Power*) has no versioning support, so currently we can not hardcode correct
+    # soname into executable. Probably we can add versioning support to
+    # collect2, so additional links can be useful in future.
+    if test "$aix_use_runtimelinking" = yes; then
+      # If using run time linking (on AIX 4.2 or later) use lib<name>.so
+      # instead of lib<name>.a to let people know that these are not
+      # typical AIX shared libraries.
+      library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    else
+      # We preserve .a as extension for shared libraries through AIX4.2
+      # and later when we are not doing run time linking.
+      library_names_spec='${libname}${release}.a $libname.a'
+      soname_spec='${libname}${release}${shared_ext}$major'
+    fi
+    shlibpath_var=LIBPATH
+  fi
+  ;;
+
+amigaos*)
+  case $host_cpu in
+  powerpc)
+    # Since July 2007 AmigaOS4 officially supports .so libraries.
+    # When compiling the executable, add -use-dynld -Lsobjs: to the compileline.
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    ;;
+  m68k)
+    library_names_spec='$libname.ixlibrary $libname.a'
+    # Create ${libname}_ixlibrary.a entries in /sys/libs.
+    finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done'
+    ;;
+  esac
+  ;;
+
+beos*)
+  library_names_spec='${libname}${shared_ext}'
+  dynamic_linker="$host_os ld.so"
+  shlibpath_var=LIBRARY_PATH
+  ;;
+
+bsdi[45]*)
+  version_type=linux
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
+  sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
+  # the default ld.so.conf also contains /usr/contrib/lib and
+  # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
+  # libtool to hard-code these into programs
+  ;;
+
+cygwin* | mingw* | pw32* | cegcc*)
+  version_type=windows
+  shrext_cmds=".dll"
+  need_version=no
+  need_lib_prefix=no
+
+  case $GCC,$host_os in
+  yes,cygwin* | yes,mingw* | yes,pw32* | yes,cegcc*)
+    library_names_spec='$libname.dll.a'
+    # DLL is installed to $(libdir)/../bin by postinstall_cmds
+    postinstall_cmds='base_file=`basename \${file}`~
+      dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
+      dldir=$destdir/`dirname \$dlpath`~
+      test -d \$dldir || mkdir -p \$dldir~
+      $install_prog $dir/$dlname \$dldir/$dlname~
+      chmod a+x \$dldir/$dlname~
+      if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
+        eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
+      fi'
+    postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
+      dlpath=$dir/\$dldll~
+       $RM \$dlpath'
+    shlibpath_overrides_runpath=yes
+
+    case $host_os in
+    cygwin*)
+      # Cygwin DLLs use 'cyg' prefix rather than 'lib'
+      soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
+
+      ;;
+    mingw* | cegcc*)
+      # MinGW DLLs use traditional 'lib' prefix
+      soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
+      ;;
+    pw32*)
+      # pw32 DLLs use 'pw' prefix rather than 'lib'
+      library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
+      ;;
+    esac
+    ;;
+
+  *)
+    library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib'
+    ;;
+  esac
+  dynamic_linker='Win32 ld.exe'
+  # FIXME: first we should search . and the directory the executable is in
+  shlibpath_var=PATH
+  ;;
+
+darwin* | rhapsody*)
+  dynamic_linker="$host_os dyld"
+  version_type=darwin
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext'
+  soname_spec='${libname}${release}${major}$shared_ext'
+  shlibpath_overrides_runpath=yes
+  shlibpath_var=DYLD_LIBRARY_PATH
+  shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`'
+
+  sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib'
+  ;;
+
+dgux*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+freebsd* | dragonfly*)
+  # DragonFly does not have aout.  When/if they implement a new
+  # versioning mechanism, adjust this.
+  if test -x /usr/bin/objformat; then
+    objformat=`/usr/bin/objformat`
+  else
+    case $host_os in
+    freebsd[23].*) objformat=aout ;;
+    *) objformat=elf ;;
+    esac
+  fi
+  version_type=freebsd-$objformat
+  case $version_type in
+    freebsd-elf*)
+      library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
+      need_version=no
+      need_lib_prefix=no
+      ;;
+    freebsd-*)
+      library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix'
+      need_version=yes
+      ;;
+  esac
+  shlibpath_var=LD_LIBRARY_PATH
+  case $host_os in
+  freebsd2.*)
+    shlibpath_overrides_runpath=yes
+    ;;
+  freebsd3.[01]* | freebsdelf3.[01]*)
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  freebsd3.[2-9]* | freebsdelf3.[2-9]* | \
+  freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1)
+    shlibpath_overrides_runpath=no
+    hardcode_into_libs=yes
+    ;;
+  *) # from 4.6 on, and DragonFly
+    shlibpath_overrides_runpath=yes
+    hardcode_into_libs=yes
+    ;;
+  esac
+  ;;
+
+haiku*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  dynamic_linker="$host_os runtime_loader"
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/beos/system/lib'
+  hardcode_into_libs=yes
+  ;;
+
+hpux9* | hpux10* | hpux11*)
+  # Give a soname corresponding to the major version so that dld.sl refuses to
+  # link against other versions.
+  version_type=sunos
+  need_lib_prefix=no
+  need_version=no
+  case $host_cpu in
+  ia64*)
+    shrext_cmds='.so'
+    hardcode_into_libs=yes
+    dynamic_linker="$host_os dld.so"
+    shlibpath_var=LD_LIBRARY_PATH
+    shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    soname_spec='${libname}${release}${shared_ext}$major'
+    if test "X$HPUX_IA64_MODE" = X32; then
+      sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib"
+    else
+      sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64"
+    fi
+    sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+    ;;
+  hppa*64*)
+    shrext_cmds='.sl'
+    hardcode_into_libs=yes
+    dynamic_linker="$host_os dld.sl"
+    shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH
+    shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    soname_spec='${libname}${release}${shared_ext}$major'
+    sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64"
+    sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
+    ;;
+  *)
+    shrext_cmds='.sl'
+    dynamic_linker="$host_os dld.sl"
+    shlibpath_var=SHLIB_PATH
+    shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+    soname_spec='${libname}${release}${shared_ext}$major'
+    ;;
+  esac
+  # HP-UX runs *really* slowly unless shared libraries are mode 555, ...
+  postinstall_cmds='chmod 555 $lib'
+  # or fails outright, so override atomically:
+  install_override_mode=555
+  ;;
+
+interix[3-9]*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  ;;
+
+irix5* | irix6* | nonstopux*)
+  case $host_os in
+    nonstopux*) version_type=nonstopux ;;
+    *)
+	if test "$lt_cv_prog_gnu_ld" = yes; then
+		version_type=linux
+	else
+		version_type=irix
+	fi ;;
+  esac
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='${libname}${release}${shared_ext}$major'
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}'
+  case $host_os in
+  irix5* | nonstopux*)
+    libsuff= shlibsuff=
+    ;;
+  *)
+    case $LD in # libtool.m4 will add one of these switches to LD
+    *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ")
+      libsuff= shlibsuff= libmagic=32-bit;;
+    *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ")
+      libsuff=32 shlibsuff=N32 libmagic=N32;;
+    *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ")
+      libsuff=64 shlibsuff=64 libmagic=64-bit;;
+    *) libsuff= shlibsuff= libmagic=never-match;;
+    esac
+    ;;
+  esac
+  shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
+  shlibpath_overrides_runpath=no
+  sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
+  sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
+  hardcode_into_libs=yes
+  ;;
+
+# No shared lib support for Linux oldld, aout, or coff.
+linux*oldld* | linux*aout* | linux*coff*)
+  dynamic_linker=no
+  ;;
+
+# This must be Linux ELF.
+
+# uclinux* changes (here and below) have been submitted to the libtool
+# project, but have not yet been accepted: they are GCC-local changes
+# for the time being.  (See
+# https://lists.gnu.org/archive/html/libtool-patches/2018-05/msg00000.html)
+linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu* | uclinuxfdpiceabi)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+
+  # Some binutils ld are patched to set DT_RUNPATH
+  if ${lt_cv_shlibpath_overrides_runpath+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  lt_cv_shlibpath_overrides_runpath=no
+    save_LDFLAGS=$LDFLAGS
+    save_libdir=$libdir
+    eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_CXX\"; \
+	 LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_CXX\""
+    if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_link "$LINENO"; then :
+  if  ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then :
+  lt_cv_shlibpath_overrides_runpath=yes
+fi
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    LDFLAGS=$save_LDFLAGS
+    libdir=$save_libdir
+
+fi
+
+  shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath
+
+  # This implies no fast_install, which is unacceptable.
+  # Some rework will be needed to allow for fast_install
+  # before this can be enabled.
+  hardcode_into_libs=yes
+
+  # Append ld.so.conf contents to the search path
+  if test -f /etc/ld.so.conf; then
+    lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[	 ]*hwcap[	 ]/d;s/[:,	]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '`
+    sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra"
+  fi
+
+  # We used to test for /lib/ld.so.1 and disable shared libraries on
+  # powerpc, because MkLinux only supported shared libraries with the
+  # GNU dynamic linker.  Since this was broken with cross compilers,
+  # most powerpc-linux boxes support dynamic linking these days and
+  # people can always --disable-shared, the test was removed, and we
+  # assume the GNU/Linux dynamic linker is in use.
+  dynamic_linker='GNU/Linux ld.so'
+  ;;
+
+netbsd*)
+  version_type=sunos
+  need_lib_prefix=no
+  need_version=no
+  if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
+    finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+    dynamic_linker='NetBSD (a.out) ld.so'
+  else
+    library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
+    soname_spec='${libname}${release}${shared_ext}$major'
+    dynamic_linker='NetBSD ld.elf_so'
+  fi
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  ;;
+
+newsos6)
+  version_type=linux
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  ;;
+
+*nto* | *qnx*)
+  version_type=qnx
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  dynamic_linker='ldqnx.so'
+  ;;
+
+openbsd*)
+  version_type=sunos
+  sys_lib_dlsearch_path_spec="/usr/lib"
+  need_lib_prefix=no
+  # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs.
+  case $host_os in
+    openbsd3.3 | openbsd3.3.*)	need_version=yes ;;
+    *)				need_version=no  ;;
+  esac
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
+  finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+    case $host_os in
+      openbsd2.[89] | openbsd2.[89].*)
+	shlibpath_overrides_runpath=no
+	;;
+      *)
+	shlibpath_overrides_runpath=yes
+	;;
+      esac
+  else
+    shlibpath_overrides_runpath=yes
+  fi
+  ;;
+
+os2*)
+  libname_spec='$name'
+  shrext_cmds=".dll"
+  need_lib_prefix=no
+  library_names_spec='$libname${shared_ext} $libname.a'
+  dynamic_linker='OS/2 ld.exe'
+  shlibpath_var=LIBPATH
+  ;;
+
+osf3* | osf4* | osf5*)
+  version_type=osf
+  need_lib_prefix=no
+  need_version=no
+  soname_spec='${libname}${release}${shared_ext}$major'
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  shlibpath_var=LD_LIBRARY_PATH
+  sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
+  sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
+  ;;
+
+rdos*)
+  dynamic_linker=no
+  ;;
+
+solaris*)
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  # ldd complains unless libraries are executable
+  postinstall_cmds='chmod +x $lib'
+  ;;
+
+sunos4*)
+  version_type=sunos
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
+  finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  if test "$with_gnu_ld" = yes; then
+    need_lib_prefix=no
+  fi
+  need_version=yes
+  ;;
+
+sysv4 | sysv4.3*)
+  version_type=linux
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  case $host_vendor in
+    sni)
+      shlibpath_overrides_runpath=no
+      need_lib_prefix=no
+      runpath_var=LD_RUN_PATH
+      ;;
+    siemens)
+      need_lib_prefix=no
+      ;;
+    motorola)
+      need_lib_prefix=no
+      need_version=no
+      shlibpath_overrides_runpath=no
+      sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
+      ;;
+  esac
+  ;;
+
+sysv4*MP*)
+  if test -d /usr/nec ;then
+    version_type=linux
+    library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}'
+    soname_spec='$libname${shared_ext}.$major'
+    shlibpath_var=LD_LIBRARY_PATH
+  fi
+  ;;
+
+sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
+  version_type=freebsd-elf
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=yes
+  hardcode_into_libs=yes
+  if test "$with_gnu_ld" = yes; then
+    sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib'
+  else
+    sys_lib_search_path_spec='/usr/ccs/lib /usr/lib'
+    case $host_os in
+      sco3.2v5*)
+        sys_lib_search_path_spec="$sys_lib_search_path_spec /lib"
+	;;
+    esac
+  fi
+  sys_lib_dlsearch_path_spec='/usr/lib'
+  ;;
+
+tpf*)
+  # TPF is a cross-target only.  Preferred cross-host = GNU/Linux.
+  version_type=linux
+  need_lib_prefix=no
+  need_version=no
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  shlibpath_var=LD_LIBRARY_PATH
+  shlibpath_overrides_runpath=no
+  hardcode_into_libs=yes
+  ;;
+
+uts4*)
+  version_type=linux
+  library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+  soname_spec='${libname}${release}${shared_ext}$major'
+  shlibpath_var=LD_LIBRARY_PATH
+  ;;
+
+# Shared libraries for VwWorks, >= 7 only at this stage
+# and (fpic) still incompatible with "large" code models
+# in a few configurations. Only for RTP mode in any case,
+# and upon explicit request at configure time.
+vxworks7*)
+  dynamic_linker=no
+  case ${with_multisubdir}-${enable_shared} in
+    *large*)
+      ;;
+    *mrtp*-yes)
+      version_type=linux
+      need_lib_prefix=no
+      need_version=no
+      library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
+      soname_spec='${libname}${release}${shared_ext}$major'
+      dynamic_linker="$host_os module_loader"
+      ;;
+  esac
+  ;;
+*)
+  dynamic_linker=no
+  ;;
+esac
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5
+$as_echo "$dynamic_linker" >&6; }
+test "$dynamic_linker" = no && can_build_shared=no
+
+variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
+if test "$GCC" = yes; then
+  variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
+fi
+
+if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then
+  sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec"
+fi
+if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then
+  sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec"
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5
+$as_echo_n "checking how to hardcode library paths into programs... " >&6; }
+hardcode_action_CXX=
+if test -n "$hardcode_libdir_flag_spec_CXX" ||
+   test -n "$runpath_var_CXX" ||
+   test "X$hardcode_automatic_CXX" = "Xyes" ; then
+
+  # We can hardcode non-existent directories.
+  if test "$hardcode_direct_CXX" != no &&
+     # If the only mechanism to avoid hardcoding is shlibpath_var, we
+     # have to relink, otherwise we might link with an installed library
+     # when we should be linking with a yet-to-be-installed one
+     ## test "$_LT_TAGVAR(hardcode_shlibpath_var, CXX)" != no &&
+     test "$hardcode_minus_L_CXX" != no; then
+    # Linking always hardcodes the temporary library directory.
+    hardcode_action_CXX=relink
+  else
+    # We can link without hardcoding, and we can hardcode nonexisting dirs.
+    hardcode_action_CXX=immediate
+  fi
+else
+  # We cannot hardcode anything, or else we can only hardcode existing
+  # directories.
+  hardcode_action_CXX=unsupported
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action_CXX" >&5
+$as_echo "$hardcode_action_CXX" >&6; }
+
+if test "$hardcode_action_CXX" = relink ||
+   test "$inherit_rpath_CXX" = yes; then
+  # Fast installation is not supported
+  enable_fast_install=no
+elif test "$shlibpath_overrides_runpath" = yes ||
+     test "$enable_shared" = no; then
+  # Fast installation is not necessary
+  enable_fast_install=needless
+fi
+
+
+
+
+
+
+
+  fi # test -n "$compiler"
+
+  CC=$lt_save_CC
+  LDCXX=$LD
+  LD=$lt_save_LD
+  GCC=$lt_save_GCC
+  with_gnu_ld=$lt_save_with_gnu_ld
+  lt_cv_path_LDCXX=$lt_cv_path_LD
+  lt_cv_path_LD=$lt_save_path_LD
+  lt_cv_prog_gnu_ldcxx=$lt_cv_prog_gnu_ld
+  lt_cv_prog_gnu_ld=$lt_save_with_gnu_ld
+fi # test "$_lt_caught_CXX_error" != yes
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+
+
+
+
+
+
+
+
+
+        ac_config_commands="$ac_config_commands libtool"
+
+
+
+
+# Only expand once:
+
+
+enable_dlopen=yes
+
+
+
+# AM_PROG_LIBTOOL
+
+
+
+ac_fn_c_check_type "$LINENO" "struct timezone" "ac_cv_type_struct_timezone" "$ac_includes_default"
+if test "x$ac_cv_type_struct_timezone" = xyes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_TIMEZONE 1
+_ACEOF
+
+
+fi
+ac_fn_c_check_type "$LINENO" "struct stat" "ac_cv_type_struct_stat" "$ac_includes_default"
+if test "x$ac_cv_type_struct_stat" = xyes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_STAT 1
+_ACEOF
+
+
+fi
+ac_fn_c_check_type "$LINENO" "struct timeval" "ac_cv_type_struct_timeval" "$ac_includes_default"
+if test "x$ac_cv_type_struct_timeval" = xyes; then :
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_TIMEVAL 1
+_ACEOF
+
+
+fi
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+# Check the compiler.
+# The same as in boehm-gc and libstdc++. Have to borrow it from there.
+# We must force CC to /not/ be precious variables; otherwise
+# the wrong, non-multilib-adjusted value will be used in multilibs.
+# As a side effect, we have to subst CFLAGS ourselves.
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+  ac_ct_CC=$CC
+  # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="gcc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+else
+  CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+          if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="${ac_tool_prefix}cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  fi
+fi
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+       ac_prog_rejected=yes
+       continue
+     fi
+    ac_cv_prog_CC="cc"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# != 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+  fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$CC"; then
+  if test -n "$ac_tool_prefix"; then
+  for ac_prog in cl.exe
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$CC" && break
+  done
+fi
+if test -z "$CC"; then
+  ac_ct_CC=$CC
+  for ac_prog in cl.exe
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+    ac_cv_prog_ac_ct_CC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CC" && break
+done
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+fi
+
+fi
+
+
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "no acceptable C compiler found in \$PATH
+See \`config.log' for more details" "$LINENO" 5; }
+
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+  fi
+  rm -f conftest.er1 conftest.err
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if ${ac_cv_c_compiler_gnu+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if ${ac_cv_prog_cc_g+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_save_c_werror_flag=$ac_c_werror_flag
+   ac_c_werror_flag=yes
+   ac_cv_prog_cc_g=no
+   CFLAGS="-g"
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+else
+  CFLAGS=""
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  ac_c_werror_flag=$ac_save_c_werror_flag
+	 CFLAGS="-g"
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if ${ac_cv_prog_cc_c89+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdarg.h>
+#include <stdio.h>
+struct stat;
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
+   function prototypes and stuff, but not '\xHH' hex character constants.
+   These don't provoke an error unfortunately, instead are silently treated
+   as 'x'.  The following induces an error, until -std is added to get
+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
+   array size at least.  It's necessary to write '\x00'==0 to get something
+   that's true only with -std.  */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+   inside strings and character constants.  */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+  ;
+  return 0;
+}
+_ACEOF
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_c89=$ac_arg
+fi
+rm -f core conftest.err conftest.$ac_objext
+  test "x$ac_cv_prog_cc_c89" != "xno" && break
+done
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
+fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+  x)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+  xno)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
+  *)
+    CC="$CC $ac_cv_prog_cc_c89"
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
+esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC understands -c and -o together" >&5
+$as_echo_n "checking whether $CC understands -c and -o together... " >&6; }
+if ${am_cv_prog_cc_c_o+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+  # Make sure it works both with $CC and with simple cc.
+  # Following AC_PROG_CC_C_O, we do the test twice because some
+  # compilers refuse to overwrite an existing .o file with -o,
+  # though they will create one.
+  am_cv_prog_cc_c_o=yes
+  for am_i in 1 2; do
+    if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5
+   ($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5
+   ac_status=$?
+   echo "$as_me:$LINENO: \$? = $ac_status" >&5
+   (exit $ac_status); } \
+         && test -f conftest2.$ac_objext; then
+      : OK
+    else
+      am_cv_prog_cc_c_o=no
+      break
+    fi
+  done
+  rm -f core conftest*
+  unset am_i
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5
+$as_echo "$am_cv_prog_cc_c_o" >&6; }
+if test "$am_cv_prog_cc_c_o" != yes; then
+   # Losing compiler, so override with the script.
+   # FIXME: It is wrong to rewrite CC.
+   # But if we don't then we get into trouble of one sort or another.
+   # A longer-term fix would be to have automake use am__CC in this case,
+   # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)"
+   CC="$am_aux_dir/compile $CC"
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+
+
+
+
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for access" >&5
+$as_echo_n "checking m2 front end checking c library for access... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for access in -lc" >&5
+$as_echo_n "checking for access in -lc... " >&6; }
+if ${ac_cv_lib_c_access+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char access ();
+int
+main ()
+{
+return access ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_access=yes
+else
+  ac_cv_lib_c_access=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_access" >&5
+$as_echo "$ac_cv_lib_c_access" >&6; }
+if test "x$ac_cv_lib_c_access" = xyes; then :
+
+$as_echo "#define HAVE_ACCESS 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_ACCESS" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_access" = xyes; then
+
+$as_echo "#define HAVE_ACCESS 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_access" = xyes; then
+
+$as_echo "#define HAVE_ACCESS 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_ACCESS" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for brk" >&5
+$as_echo_n "checking m2 front end checking c library for brk... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for brk in -lc" >&5
+$as_echo_n "checking for brk in -lc... " >&6; }
+if ${ac_cv_lib_c_brk+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char brk ();
+int
+main ()
+{
+return brk ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_brk=yes
+else
+  ac_cv_lib_c_brk=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_brk" >&5
+$as_echo "$ac_cv_lib_c_brk" >&6; }
+if test "x$ac_cv_lib_c_brk" = xyes; then :
+
+$as_echo "#define HAVE_BRK 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_BRK" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_brk" = xyes; then
+
+$as_echo "#define HAVE_BRK 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_brk" = xyes; then
+
+$as_echo "#define HAVE_BRK 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_BRK" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for cfmakeraw" >&5
+$as_echo_n "checking m2 front end checking c library for cfmakeraw... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cfmakeraw in -lc" >&5
+$as_echo_n "checking for cfmakeraw in -lc... " >&6; }
+if ${ac_cv_lib_c_cfmakeraw+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char cfmakeraw ();
+int
+main ()
+{
+return cfmakeraw ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_cfmakeraw=yes
+else
+  ac_cv_lib_c_cfmakeraw=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_cfmakeraw" >&5
+$as_echo "$ac_cv_lib_c_cfmakeraw" >&6; }
+if test "x$ac_cv_lib_c_cfmakeraw" = xyes; then :
+
+$as_echo "#define HAVE_CFMAKERAW 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_CFMAKERAW" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_cfmakeraw" = xyes; then
+
+$as_echo "#define HAVE_CFMAKERAW 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_cfmakeraw" = xyes; then
+
+$as_echo "#define HAVE_CFMAKERAW 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_CFMAKERAW" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for close" >&5
+$as_echo_n "checking m2 front end checking c library for close... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for close in -lc" >&5
+$as_echo_n "checking for close in -lc... " >&6; }
+if ${ac_cv_lib_c_close+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char close ();
+int
+main ()
+{
+return close ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_close=yes
+else
+  ac_cv_lib_c_close=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_close" >&5
+$as_echo "$ac_cv_lib_c_close" >&6; }
+if test "x$ac_cv_lib_c_close" = xyes; then :
+
+$as_echo "#define HAVE_CLOSE 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_CLOSE" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_close" = xyes; then
+
+$as_echo "#define HAVE_CLOSE 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_close" = xyes; then
+
+$as_echo "#define HAVE_CLOSE 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_CLOSE" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for ctime" >&5
+$as_echo_n "checking m2 front end checking c library for ctime... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ctime in -lc" >&5
+$as_echo_n "checking for ctime in -lc... " >&6; }
+if ${ac_cv_lib_c_ctime+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char ctime ();
+int
+main ()
+{
+return ctime ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_ctime=yes
+else
+  ac_cv_lib_c_ctime=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_ctime" >&5
+$as_echo "$ac_cv_lib_c_ctime" >&6; }
+if test "x$ac_cv_lib_c_ctime" = xyes; then :
+
+$as_echo "#define HAVE_CTIME 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_CTIME" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_ctime" = xyes; then
+
+$as_echo "#define HAVE_CTIME 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_ctime" = xyes; then
+
+$as_echo "#define HAVE_CTIME 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_CTIME" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for creat" >&5
+$as_echo_n "checking m2 front end checking c library for creat... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for creat in -lc" >&5
+$as_echo_n "checking for creat in -lc... " >&6; }
+if ${ac_cv_lib_c_creat+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char creat ();
+int
+main ()
+{
+return creat ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_creat=yes
+else
+  ac_cv_lib_c_creat=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_creat" >&5
+$as_echo "$ac_cv_lib_c_creat" >&6; }
+if test "x$ac_cv_lib_c_creat" = xyes; then :
+
+$as_echo "#define HAVE_CREAT 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_CREAT" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_creat" = xyes; then
+
+$as_echo "#define HAVE_CREAT 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_creat" = xyes; then
+
+$as_echo "#define HAVE_CREAT 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_CREAT" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for dup" >&5
+$as_echo_n "checking m2 front end checking c library for dup... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dup in -lc" >&5
+$as_echo_n "checking for dup in -lc... " >&6; }
+if ${ac_cv_lib_c_dup+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char dup ();
+int
+main ()
+{
+return dup ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_dup=yes
+else
+  ac_cv_lib_c_dup=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_dup" >&5
+$as_echo "$ac_cv_lib_c_dup" >&6; }
+if test "x$ac_cv_lib_c_dup" = xyes; then :
+
+$as_echo "#define HAVE_DUP 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_DUP" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_dup" = xyes; then
+
+$as_echo "#define HAVE_DUP 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_dup" = xyes; then
+
+$as_echo "#define HAVE_DUP 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_DUP" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for execve" >&5
+$as_echo_n "checking m2 front end checking c library for execve... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for execve in -lc" >&5
+$as_echo_n "checking for execve in -lc... " >&6; }
+if ${ac_cv_lib_c_execve+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char execve ();
+int
+main ()
+{
+return execve ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_execve=yes
+else
+  ac_cv_lib_c_execve=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_execve" >&5
+$as_echo "$ac_cv_lib_c_execve" >&6; }
+if test "x$ac_cv_lib_c_execve" = xyes; then :
+
+$as_echo "#define HAVE_EXECVE 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_EXECVE" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_execve" = xyes; then
+
+$as_echo "#define HAVE_EXECVE 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_execve" = xyes; then
+
+$as_echo "#define HAVE_EXECVE 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_EXECVE" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for exit" >&5
+$as_echo_n "checking m2 front end checking c library for exit... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for exit in -lc" >&5
+$as_echo_n "checking for exit in -lc... " >&6; }
+if ${ac_cv_lib_c_exit+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char exit ();
+int
+main ()
+{
+return exit ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_exit=yes
+else
+  ac_cv_lib_c_exit=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_exit" >&5
+$as_echo "$ac_cv_lib_c_exit" >&6; }
+if test "x$ac_cv_lib_c_exit" = xyes; then :
+
+$as_echo "#define HAVE_EXIT 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_EXIT" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_exit" = xyes; then
+
+$as_echo "#define HAVE_EXIT 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_exit" = xyes; then
+
+$as_echo "#define HAVE_EXIT 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_EXIT" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for fcntl" >&5
+$as_echo_n "checking m2 front end checking c library for fcntl... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fcntl in -lc" >&5
+$as_echo_n "checking for fcntl in -lc... " >&6; }
+if ${ac_cv_lib_c_fcntl+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char fcntl ();
+int
+main ()
+{
+return fcntl ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_fcntl=yes
+else
+  ac_cv_lib_c_fcntl=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_fcntl" >&5
+$as_echo "$ac_cv_lib_c_fcntl" >&6; }
+if test "x$ac_cv_lib_c_fcntl" = xyes; then :
+
+$as_echo "#define HAVE_FCNTL 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_FCNTL" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_fcntl" = xyes; then
+
+$as_echo "#define HAVE_FCNTL 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_fcntl" = xyes; then
+
+$as_echo "#define HAVE_FCNTL 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_FCNTL" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for fstat" >&5
+$as_echo_n "checking m2 front end checking c library for fstat... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fstat in -lc" >&5
+$as_echo_n "checking for fstat in -lc... " >&6; }
+if ${ac_cv_lib_c_fstat+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char fstat ();
+int
+main ()
+{
+return fstat ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_fstat=yes
+else
+  ac_cv_lib_c_fstat=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_fstat" >&5
+$as_echo "$ac_cv_lib_c_fstat" >&6; }
+if test "x$ac_cv_lib_c_fstat" = xyes; then :
+
+$as_echo "#define HAVE_FSTAT 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_FSTAT" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_fstat" = xyes; then
+
+$as_echo "#define HAVE_FSTAT 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_fstat" = xyes; then
+
+$as_echo "#define HAVE_FSTAT 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_FSTAT" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for getdents" >&5
+$as_echo_n "checking m2 front end checking c library for getdents... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getdents in -lc" >&5
+$as_echo_n "checking for getdents in -lc... " >&6; }
+if ${ac_cv_lib_c_getdents+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char getdents ();
+int
+main ()
+{
+return getdents ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_getdents=yes
+else
+  ac_cv_lib_c_getdents=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_getdents" >&5
+$as_echo "$ac_cv_lib_c_getdents" >&6; }
+if test "x$ac_cv_lib_c_getdents" = xyes; then :
+
+$as_echo "#define HAVE_GETDENTS 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_GETDENTS" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_getdents" = xyes; then
+
+$as_echo "#define HAVE_GETDENTS 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_getdents" = xyes; then
+
+$as_echo "#define HAVE_GETDENTS 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_GETDENTS" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for getgid" >&5
+$as_echo_n "checking m2 front end checking c library for getgid... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgid in -lc" >&5
+$as_echo_n "checking for getgid in -lc... " >&6; }
+if ${ac_cv_lib_c_getgid+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char getgid ();
+int
+main ()
+{
+return getgid ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_getgid=yes
+else
+  ac_cv_lib_c_getgid=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_getgid" >&5
+$as_echo "$ac_cv_lib_c_getgid" >&6; }
+if test "x$ac_cv_lib_c_getgid" = xyes; then :
+
+$as_echo "#define HAVE_GETGID 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_GETGID" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_getgid" = xyes; then
+
+$as_echo "#define HAVE_GETGID 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_getgid" = xyes; then
+
+$as_echo "#define HAVE_GETGID 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_GETGID" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for getpid" >&5
+$as_echo_n "checking m2 front end checking c library for getpid... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpid in -lc" >&5
+$as_echo_n "checking for getpid in -lc... " >&6; }
+if ${ac_cv_lib_c_getpid+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char getpid ();
+int
+main ()
+{
+return getpid ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_getpid=yes
+else
+  ac_cv_lib_c_getpid=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_getpid" >&5
+$as_echo "$ac_cv_lib_c_getpid" >&6; }
+if test "x$ac_cv_lib_c_getpid" = xyes; then :
+
+$as_echo "#define HAVE_GETPID 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_GETPID" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_getpid" = xyes; then
+
+$as_echo "#define HAVE_GETPID 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_getpid" = xyes; then
+
+$as_echo "#define HAVE_GETPID 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_GETPID" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for gettimeofday" >&5
+$as_echo_n "checking m2 front end checking c library for gettimeofday... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday in -lc" >&5
+$as_echo_n "checking for gettimeofday in -lc... " >&6; }
+if ${ac_cv_lib_c_gettimeofday+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char gettimeofday ();
+int
+main ()
+{
+return gettimeofday ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_gettimeofday=yes
+else
+  ac_cv_lib_c_gettimeofday=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_gettimeofday" >&5
+$as_echo "$ac_cv_lib_c_gettimeofday" >&6; }
+if test "x$ac_cv_lib_c_gettimeofday" = xyes; then :
+
+$as_echo "#define HAVE_GETTIMEOFD 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_GETTIMEOFD" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_gettimeofday" = xyes; then
+
+$as_echo "#define HAVE_GETTIMEOFD 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_gettimeofday" = xyes; then
+
+$as_echo "#define HAVE_GETTIMEOFD 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_GETTIMEOFD" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for getuid" >&5
+$as_echo_n "checking m2 front end checking c library for getuid... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getuid in -lc" >&5
+$as_echo_n "checking for getuid in -lc... " >&6; }
+if ${ac_cv_lib_c_getuid+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char getuid ();
+int
+main ()
+{
+return getuid ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_getuid=yes
+else
+  ac_cv_lib_c_getuid=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_getuid" >&5
+$as_echo "$ac_cv_lib_c_getuid" >&6; }
+if test "x$ac_cv_lib_c_getuid" = xyes; then :
+
+$as_echo "#define HAVE_GETUID 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_GETUID" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_getuid" = xyes; then
+
+$as_echo "#define HAVE_GETUID 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_getuid" = xyes; then
+
+$as_echo "#define HAVE_GETUID 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_GETUID" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for ioctl" >&5
+$as_echo_n "checking m2 front end checking c library for ioctl... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ioctl in -lc" >&5
+$as_echo_n "checking for ioctl in -lc... " >&6; }
+if ${ac_cv_lib_c_ioctl+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char ioctl ();
+int
+main ()
+{
+return ioctl ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_ioctl=yes
+else
+  ac_cv_lib_c_ioctl=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_ioctl" >&5
+$as_echo "$ac_cv_lib_c_ioctl" >&6; }
+if test "x$ac_cv_lib_c_ioctl" = xyes; then :
+
+$as_echo "#define HAVE_IOCTL 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_IOCTL" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_ioctl" = xyes; then
+
+$as_echo "#define HAVE_IOCTL 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_ioctl" = xyes; then
+
+$as_echo "#define HAVE_IOCTL 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_IOCTL" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for kill" >&5
+$as_echo_n "checking m2 front end checking c library for kill... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kill in -lc" >&5
+$as_echo_n "checking for kill in -lc... " >&6; }
+if ${ac_cv_lib_c_kill+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char kill ();
+int
+main ()
+{
+return kill ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_kill=yes
+else
+  ac_cv_lib_c_kill=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_kill" >&5
+$as_echo "$ac_cv_lib_c_kill" >&6; }
+if test "x$ac_cv_lib_c_kill" = xyes; then :
+
+$as_echo "#define HAVE_KILL 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_KILL" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_kill" = xyes; then
+
+$as_echo "#define HAVE_KILL 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_kill" = xyes; then
+
+$as_echo "#define HAVE_KILL 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_KILL" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for link" >&5
+$as_echo_n "checking m2 front end checking c library for link... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for link in -lc" >&5
+$as_echo_n "checking for link in -lc... " >&6; }
+if ${ac_cv_lib_c_link+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char link ();
+int
+main ()
+{
+return link ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_link=yes
+else
+  ac_cv_lib_c_link=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_link" >&5
+$as_echo "$ac_cv_lib_c_link" >&6; }
+if test "x$ac_cv_lib_c_link" = xyes; then :
+
+$as_echo "#define HAVE_LINK 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_LINK" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_link" = xyes; then
+
+$as_echo "#define HAVE_LINK 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_link" = xyes; then
+
+$as_echo "#define HAVE_LINK 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_LINK" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for lseek" >&5
+$as_echo_n "checking m2 front end checking c library for lseek... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lseek in -lc" >&5
+$as_echo_n "checking for lseek in -lc... " >&6; }
+if ${ac_cv_lib_c_lseek+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char lseek ();
+int
+main ()
+{
+return lseek ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_lseek=yes
+else
+  ac_cv_lib_c_lseek=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_lseek" >&5
+$as_echo "$ac_cv_lib_c_lseek" >&6; }
+if test "x$ac_cv_lib_c_lseek" = xyes; then :
+
+$as_echo "#define HAVE_LSEEK 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_LSEEK" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_lseek" = xyes; then
+
+$as_echo "#define HAVE_LSEEK 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_lseek" = xyes; then
+
+$as_echo "#define HAVE_LSEEK 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_LSEEK" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for open" >&5
+$as_echo_n "checking m2 front end checking c library for open... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for open in -lc" >&5
+$as_echo_n "checking for open in -lc... " >&6; }
+if ${ac_cv_lib_c_open+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char open ();
+int
+main ()
+{
+return open ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_open=yes
+else
+  ac_cv_lib_c_open=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_open" >&5
+$as_echo "$ac_cv_lib_c_open" >&6; }
+if test "x$ac_cv_lib_c_open" = xyes; then :
+
+$as_echo "#define HAVE_OPEN 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_OPEN" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_open" = xyes; then
+
+$as_echo "#define HAVE_OPEN 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_open" = xyes; then
+
+$as_echo "#define HAVE_OPEN 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_OPEN" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for pause" >&5
+$as_echo_n "checking m2 front end checking c library for pause... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pause in -lc" >&5
+$as_echo_n "checking for pause in -lc... " >&6; }
+if ${ac_cv_lib_c_pause+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char pause ();
+int
+main ()
+{
+return pause ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_pause=yes
+else
+  ac_cv_lib_c_pause=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pause" >&5
+$as_echo "$ac_cv_lib_c_pause" >&6; }
+if test "x$ac_cv_lib_c_pause" = xyes; then :
+
+$as_echo "#define HAVE_PAUSE 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_PAUSE" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_pause" = xyes; then
+
+$as_echo "#define HAVE_PAUSE 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_pause" = xyes; then
+
+$as_echo "#define HAVE_PAUSE 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_PAUSE" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for pipe" >&5
+$as_echo_n "checking m2 front end checking c library for pipe... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pipe in -lc" >&5
+$as_echo_n "checking for pipe in -lc... " >&6; }
+if ${ac_cv_lib_c_pipe+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char pipe ();
+int
+main ()
+{
+return pipe ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_pipe=yes
+else
+  ac_cv_lib_c_pipe=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pipe" >&5
+$as_echo "$ac_cv_lib_c_pipe" >&6; }
+if test "x$ac_cv_lib_c_pipe" = xyes; then :
+
+$as_echo "#define HAVE_PIPE 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_PIPE" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_pipe" = xyes; then
+
+$as_echo "#define HAVE_PIPE 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_pipe" = xyes; then
+
+$as_echo "#define HAVE_PIPE 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_PIPE" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for rand" >&5
+$as_echo_n "checking m2 front end checking c library for rand... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rand in -lc" >&5
+$as_echo_n "checking for rand in -lc... " >&6; }
+if ${ac_cv_lib_c_rand+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char rand ();
+int
+main ()
+{
+return rand ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_rand=yes
+else
+  ac_cv_lib_c_rand=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_rand" >&5
+$as_echo "$ac_cv_lib_c_rand" >&6; }
+if test "x$ac_cv_lib_c_rand" = xyes; then :
+
+$as_echo "#define HAVE_RAND 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_RAND" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_rand" = xyes; then
+
+$as_echo "#define HAVE_RAND 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_rand" = xyes; then
+
+$as_echo "#define HAVE_RAND 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_RAND" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for read" >&5
+$as_echo_n "checking m2 front end checking c library for read... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for read in -lc" >&5
+$as_echo_n "checking for read in -lc... " >&6; }
+if ${ac_cv_lib_c_read+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char read ();
+int
+main ()
+{
+return read ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_read=yes
+else
+  ac_cv_lib_c_read=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_read" >&5
+$as_echo "$ac_cv_lib_c_read" >&6; }
+if test "x$ac_cv_lib_c_read" = xyes; then :
+
+$as_echo "#define HAVE_READ 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_READ" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_read" = xyes; then
+
+$as_echo "#define HAVE_READ 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_read" = xyes; then
+
+$as_echo "#define HAVE_READ 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_READ" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for select" >&5
+$as_echo_n "checking m2 front end checking c library for select... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for select in -lc" >&5
+$as_echo_n "checking for select in -lc... " >&6; }
+if ${ac_cv_lib_c_select+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char select ();
+int
+main ()
+{
+return select ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_select=yes
+else
+  ac_cv_lib_c_select=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_select" >&5
+$as_echo "$ac_cv_lib_c_select" >&6; }
+if test "x$ac_cv_lib_c_select" = xyes; then :
+
+$as_echo "#define HAVE_SELECT 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_SELECT" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_select" = xyes; then
+
+$as_echo "#define HAVE_SELECT 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_select" = xyes; then
+
+$as_echo "#define HAVE_SELECT 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_SELECT" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for setitimer" >&5
+$as_echo_n "checking m2 front end checking c library for setitimer... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for setitimer in -lc" >&5
+$as_echo_n "checking for setitimer in -lc... " >&6; }
+if ${ac_cv_lib_c_setitimer+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char setitimer ();
+int
+main ()
+{
+return setitimer ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_setitimer=yes
+else
+  ac_cv_lib_c_setitimer=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_setitimer" >&5
+$as_echo "$ac_cv_lib_c_setitimer" >&6; }
+if test "x$ac_cv_lib_c_setitimer" = xyes; then :
+
+$as_echo "#define HAVE_SETITIMER 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_SETITIMER" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_setitimer" = xyes; then
+
+$as_echo "#define HAVE_SETITIMER 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_setitimer" = xyes; then
+
+$as_echo "#define HAVE_SETITIMER 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_SETITIMER" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for setgid" >&5
+$as_echo_n "checking m2 front end checking c library for setgid... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for setgid in -lc" >&5
+$as_echo_n "checking for setgid in -lc... " >&6; }
+if ${ac_cv_lib_c_setgid+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char setgid ();
+int
+main ()
+{
+return setgid ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_setgid=yes
+else
+  ac_cv_lib_c_setgid=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_setgid" >&5
+$as_echo "$ac_cv_lib_c_setgid" >&6; }
+if test "x$ac_cv_lib_c_setgid" = xyes; then :
+
+$as_echo "#define HAVE_SETGID 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_SETGID" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_setgid" = xyes; then
+
+$as_echo "#define HAVE_SETGID 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_setgid" = xyes; then
+
+$as_echo "#define HAVE_SETGID 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_SETGID" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for setuid" >&5
+$as_echo_n "checking m2 front end checking c library for setuid... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for setuid in -lc" >&5
+$as_echo_n "checking for setuid in -lc... " >&6; }
+if ${ac_cv_lib_c_setuid+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char setuid ();
+int
+main ()
+{
+return setuid ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_setuid=yes
+else
+  ac_cv_lib_c_setuid=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_setuid" >&5
+$as_echo "$ac_cv_lib_c_setuid" >&6; }
+if test "x$ac_cv_lib_c_setuid" = xyes; then :
+
+$as_echo "#define HAVE_SETUID 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_SETUID" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_setuid" = xyes; then
+
+$as_echo "#define HAVE_SETUID 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_setuid" = xyes; then
+
+$as_echo "#define HAVE_SETUID 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_SETUID" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for stat" >&5
+$as_echo_n "checking m2 front end checking c library for stat... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for stat in -lc" >&5
+$as_echo_n "checking for stat in -lc... " >&6; }
+if ${ac_cv_lib_c_stat+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char stat ();
+int
+main ()
+{
+return stat ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_stat=yes
+else
+  ac_cv_lib_c_stat=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_stat" >&5
+$as_echo "$ac_cv_lib_c_stat" >&6; }
+if test "x$ac_cv_lib_c_stat" = xyes; then :
+
+$as_echo "#define HAVE_STAT 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_STAT" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_stat" = xyes; then
+
+$as_echo "#define HAVE_STAT 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_stat" = xyes; then
+
+$as_echo "#define HAVE_STAT 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_STAT" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for strsignal" >&5
+$as_echo_n "checking m2 front end checking c library for strsignal... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strsignal in -lc" >&5
+$as_echo_n "checking for strsignal in -lc... " >&6; }
+if ${ac_cv_lib_c_strsignal+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char strsignal ();
+int
+main ()
+{
+return strsignal ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_strsignal=yes
+else
+  ac_cv_lib_c_strsignal=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_strsignal" >&5
+$as_echo "$ac_cv_lib_c_strsignal" >&6; }
+if test "x$ac_cv_lib_c_strsignal" = xyes; then :
+
+$as_echo "#define HAVE_STRSIGNAL 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_STRSIGNAL" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_strsignal" = xyes; then
+
+$as_echo "#define HAVE_STRSIGNAL 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_strsignal" = xyes; then
+
+$as_echo "#define HAVE_STRSIGNAL 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_STRSIGNAL" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for strtod" >&5
+$as_echo_n "checking m2 front end checking c library for strtod... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strtod in -lc" >&5
+$as_echo_n "checking for strtod in -lc... " >&6; }
+if ${ac_cv_lib_c_strtod+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char strtod ();
+int
+main ()
+{
+return strtod ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_strtod=yes
+else
+  ac_cv_lib_c_strtod=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_strtod" >&5
+$as_echo "$ac_cv_lib_c_strtod" >&6; }
+if test "x$ac_cv_lib_c_strtod" = xyes; then :
+
+$as_echo "#define HAVE_STRTOD 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_STRTOD" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_strtod" = xyes; then
+
+$as_echo "#define HAVE_STRTOD 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_strtod" = xyes; then
+
+$as_echo "#define HAVE_STRTOD 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_STRTOD" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for strtold" >&5
+$as_echo_n "checking m2 front end checking c library for strtold... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strtold in -lc" >&5
+$as_echo_n "checking for strtold in -lc... " >&6; }
+if ${ac_cv_lib_c_strtold+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char strtold ();
+int
+main ()
+{
+return strtold ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_strtold=yes
+else
+  ac_cv_lib_c_strtold=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_strtold" >&5
+$as_echo "$ac_cv_lib_c_strtold" >&6; }
+if test "x$ac_cv_lib_c_strtold" = xyes; then :
+
+$as_echo "#define HAVE_STRTOLD 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_STRTOLD" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_strtold" = xyes; then
+
+$as_echo "#define HAVE_STRTOLD 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_strtold" = xyes; then
+
+$as_echo "#define HAVE_STRTOLD 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_STRTOLD" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for times" >&5
+$as_echo_n "checking m2 front end checking c library for times... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for times in -lc" >&5
+$as_echo_n "checking for times in -lc... " >&6; }
+if ${ac_cv_lib_c_times+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char times ();
+int
+main ()
+{
+return times ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_times=yes
+else
+  ac_cv_lib_c_times=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_times" >&5
+$as_echo "$ac_cv_lib_c_times" >&6; }
+if test "x$ac_cv_lib_c_times" = xyes; then :
+
+$as_echo "#define HAVE_TIMES 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_TIMES" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_times" = xyes; then
+
+$as_echo "#define HAVE_TIMES 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_times" = xyes; then
+
+$as_echo "#define HAVE_TIMES 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_TIMES" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for unlink" >&5
+$as_echo_n "checking m2 front end checking c library for unlink... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for unlink in -lc" >&5
+$as_echo_n "checking for unlink in -lc... " >&6; }
+if ${ac_cv_lib_c_unlink+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char unlink ();
+int
+main ()
+{
+return unlink ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_unlink=yes
+else
+  ac_cv_lib_c_unlink=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_unlink" >&5
+$as_echo "$ac_cv_lib_c_unlink" >&6; }
+if test "x$ac_cv_lib_c_unlink" = xyes; then :
+
+$as_echo "#define HAVE_UNLINK 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_UNLINK" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_unlink" = xyes; then
+
+$as_echo "#define HAVE_UNLINK 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_unlink" = xyes; then
+
+$as_echo "#define HAVE_UNLINK 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_UNLINK" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for wait" >&5
+$as_echo_n "checking m2 front end checking c library for wait... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for wait in -lc" >&5
+$as_echo_n "checking for wait in -lc... " >&6; }
+if ${ac_cv_lib_c_wait+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char wait ();
+int
+main ()
+{
+return wait ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_wait=yes
+else
+  ac_cv_lib_c_wait=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_wait" >&5
+$as_echo "$ac_cv_lib_c_wait" >&6; }
+if test "x$ac_cv_lib_c_wait" = xyes; then :
+
+$as_echo "#define HAVE_WAIT 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_WAIT" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_wait" = xyes; then
+
+$as_echo "#define HAVE_WAIT 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_wait" = xyes; then
+
+$as_echo "#define HAVE_WAIT 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_WAIT" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking c library for write" >&5
+$as_echo_n "checking m2 front end checking c library for write... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for write in -lc" >&5
+$as_echo_n "checking for write in -lc... " >&6; }
+if ${ac_cv_lib_c_write+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char write ();
+int
+main ()
+{
+return write ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_c_write=yes
+else
+  ac_cv_lib_c_write=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_write" >&5
+$as_echo "$ac_cv_lib_c_write" >&6; }
+if test "x$ac_cv_lib_c_write" = xyes; then :
+
+$as_echo "#define HAVE_WRITE 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_WRITE" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_c_write" = xyes; then
+
+$as_echo "#define HAVE_WRITE 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_write" = xyes; then
+
+$as_echo "#define HAVE_WRITE 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_WRITE" >>confdefs.h
+
+    fi
+  fi
+
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking m library for signbit" >&5
+$as_echo_n "checking m2 front end checking m library for signbit... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for signbit in -lm" >&5
+$as_echo_n "checking for signbit in -lm... " >&6; }
+if ${ac_cv_lib_m_signbit+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char signbit ();
+int
+main ()
+{
+return signbit ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_signbit=yes
+else
+  ac_cv_lib_m_signbit=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_signbit" >&5
+$as_echo "$ac_cv_lib_m_signbit" >&6; }
+if test "x$ac_cv_lib_m_signbit" = xyes; then :
+
+$as_echo "#define HAVE_SIGNBIT 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_SIGNBIT" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_m_signbit" = xyes; then
+
+$as_echo "#define HAVE_SIGNBIT 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_signbit" = xyes; then
+
+$as_echo "#define HAVE_SIGNBIT 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_SIGNBIT" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking m library for signbitf" >&5
+$as_echo_n "checking m2 front end checking m library for signbitf... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for signbitf in -lm" >&5
+$as_echo_n "checking for signbitf in -lm... " >&6; }
+if ${ac_cv_lib_m_signbitf+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char signbitf ();
+int
+main ()
+{
+return signbitf ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_signbitf=yes
+else
+  ac_cv_lib_m_signbitf=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_signbitf" >&5
+$as_echo "$ac_cv_lib_m_signbitf" >&6; }
+if test "x$ac_cv_lib_m_signbitf" = xyes; then :
+
+$as_echo "#define HAVE_SIGNBITF 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_SIGNBITF" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_m_signbitf" = xyes; then
+
+$as_echo "#define HAVE_SIGNBITF 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_signbitf" = xyes; then
+
+$as_echo "#define HAVE_SIGNBITF 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_SIGNBITF" >>confdefs.h
+
+    fi
+  fi
+
+
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end checking m library for signbitl" >&5
+$as_echo_n "checking m2 front end checking m library for signbitl... " >&6; }
+  if test x$gcc_no_link != xyes; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for signbitl in -lm" >&5
+$as_echo_n "checking for signbitl in -lm... " >&6; }
+if ${ac_cv_lib_m_signbitl+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm  $LIBS"
+if test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char signbitl ();
+int
+main ()
+{
+return signbitl ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_lib_m_signbitl=yes
+else
+  ac_cv_lib_m_signbitl=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_signbitl" >&5
+$as_echo "$ac_cv_lib_m_signbitl" >&6; }
+if test "x$ac_cv_lib_m_signbitl" = xyes; then :
+
+$as_echo "#define HAVE_SIGNBITL 1" >>confdefs.h
+
+else
+
+  $as_echo "#undef HAVE_SIGNBITL" >>confdefs.h
+
+fi
+
+  else
+    if test "x$ac_cv_lib_m_signbitl" = xyes; then
+
+$as_echo "#define HAVE_SIGNBITL 1" >>confdefs.h
+
+    elif test "x$ac_cv_func_signbitl" = xyes; then
+
+$as_echo "#define HAVE_SIGNBITL 1" >>confdefs.h
+
+    else
+
+  $as_echo "#undef HAVE_SIGNBITL" >>confdefs.h
+
+    fi
+  fi
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: libgm2 has finished checking target libc and libm contents." >&5
+$as_echo "$as_me: libgm2 has finished checking target libc and libm contents." >&6;}
+
+# We test the host here and later on check the target.
+
+# All known M2_HOST_OS values.  This is the union of all host operating systems
+# supported by gm2.
+
+M2_SUPPORTED_HOST_OS="aix freebsd hurd linux netbsd openbsd solaris windows"
+
+M2_HOST_OS=unknown
+
+case ${host} in
+  *-*-darwin*)   M2_HOST_OS=darwin ;;
+  *-*-freebsd*)  M2_HOST_OS=freebsd ;;
+  *-*-linux*)    M2_HOST_OS=linux ;;
+  *-*-netbsd*)	 M2_HOST_OS=netbsd ;;
+  *-*-openbsd*)  M2_HOST_OS=openbsd ;;
+  *-*-solaris2*) M2_HOST_OS=solaris ;;
+  *-*-aix*)      M2_HOST_OS=aix ;;
+  *-*-gnu*)      M2_HOST_OS=hurd ;;
+esac
+
+# M2_HOST_OS=unknown
+if test x${M2_HOST_OS} = xunknown; then
+   { $as_echo "$as_me:${as_lineno-$LINENO}: unsupported host, will build a minimal m2 library" >&5
+$as_echo "$as_me: unsupported host, will build a minimal m2 library" >&6;}
+   BUILD_PIMLIB=false
+   BUILD_ISOLIB=false
+   BUILD_CORLIB=false
+   BUILD_LOGLIB=false
+else
+   { $as_echo "$as_me:${as_lineno-$LINENO}: m2 library will be built on ${M2_HOST_OS}" >&5
+$as_echo "$as_me: m2 library will be built on ${M2_HOST_OS}" >&6;}
+   BUILD_PIMLIB=true
+   BUILD_ISOLIB=true
+   BUILD_CORLIB=true
+   BUILD_LOGLIB=true
+fi
+
+CC_FOR_BUILD=${CC_FOR_BUILD:-gcc}
+
+
+# Propagate GM2_FOR_TARGET into Makefiles
+GM2_FOR_TARGET=${GM2_FOR_TARGET:-gcc}
+
+
+# Now we check the target as long as it is a supported host.
+# For some embedded targets we choose minimal runtime system which is
+# just enough to satisfy the linker targetting raw metal.
+if test x${M2_HOST_OS} != xunknown; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: m2 library building for target ${target}" >&5
+$as_echo "$as_me: m2 library building for target ${target}" >&6;}
+case "$target" in
+
+  avr25*-*-* | avr31*-*-* | avr35*-*-* | avr4*-*-* | avr5*-*-* | avr51*-*-* | avr6*-*-*)
+  BUILD_PIMLIB=false
+  BUILD_ISOLIB=false
+  BUILD_CORLIB=false
+  BUILD_LOGLIB=false
+  ;;
+
+  avrxmega2*-*-* | avrxmega4*-*-* | avrxmega5*-*-* | avrxmega6*-*-* | avrxmega7*-*-*)
+  BUILD_PIMLIB=false
+  BUILD_ISOLIB=false
+  BUILD_CORLIB=false
+  BUILD_LOGLIB=false
+  ;;
+
+  avr3-*-*)
+  BUILD_PIMLIB=true
+  BUILD_ISOLIB=true
+  BUILD_CORLIB=true
+  BUILD_LOGLIB=true
+  ;;
+  esp32-*-*)
+  BUILD_PIMLIB=false
+  BUILD_ISOLIB=false
+  BUILD_CORLIB=false
+  BUILD_LOGLIB=false
+  ;;
+
+esac
+fi
+
+# GM2_MSG_RESULT issue a query message from the first parameter and a boolean result
+# in the second parameter is printed as a "yes" or "no".
+
+
+
+if test x${M2_HOST_OS} = xunknown; then
+   { $as_echo "$as_me:${as_lineno-$LINENO}: m2 front end will only build minimal Modula-2 runtime library on this host" >&5
+$as_echo "$as_me: m2 front end will only build minimal Modula-2 runtime library on this host" >&6;}
+else
+
+   { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end will build PIM libraries:" >&5
+$as_echo_n "checking m2 front end will build PIM libraries:... " >&6; }
+   if test x${BUILD_PIMLIB} = xtrue; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+   else
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+   fi
+
+
+   { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end will build ISO libraries:" >&5
+$as_echo_n "checking m2 front end will build ISO libraries:... " >&6; }
+   if test x${BUILD_ISOLIB} = xtrue; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+   else
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+   fi
+
+
+   { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end will build coroutine libraries:" >&5
+$as_echo_n "checking m2 front end will build coroutine libraries:... " >&6; }
+   if test x${BUILD_CORLIB} = xtrue; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+   else
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+   fi
+
+
+   { $as_echo "$as_me:${as_lineno-$LINENO}: checking m2 front end will build Logitech compatability libraries:" >&5
+$as_echo_n "checking m2 front end will build Logitech compatability libraries:... " >&6; }
+   if test x${BUILD_LOGLIB} = xtrue; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+   else
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+   fi
+
+fi
+
+ if test x$BUILD_PIMLIB = xtrue; then
+  BUILD_PIMLIB_TRUE=
+  BUILD_PIMLIB_FALSE='#'
+else
+  BUILD_PIMLIB_TRUE='#'
+  BUILD_PIMLIB_FALSE=
+fi
+
+ if test x$BUILD_ISOLIB = xtrue; then
+  BUILD_ISOLIB_TRUE=
+  BUILD_ISOLIB_FALSE='#'
+else
+  BUILD_ISOLIB_TRUE='#'
+  BUILD_ISOLIB_FALSE=
+fi
+
+ if test x$BUILD_CORLIB = xtrue; then
+  BUILD_CORLIB_TRUE=
+  BUILD_CORLIB_FALSE='#'
+else
+  BUILD_CORLIB_TRUE='#'
+  BUILD_CORLIB_FALSE=
+fi
+
+ if test x$BUILD_LOGLIB = xtrue; then
+  BUILD_LOGLIB_TRUE=
+  BUILD_LOGLIB_FALSE='#'
+else
+  BUILD_LOGLIB_TRUE='#'
+  BUILD_LOGLIB_FALSE=
+fi
+
+
+
+ac_config_files="$ac_config_files Makefile libm2min/Makefile libm2pim/Makefile libm2iso/Makefile libm2cor/Makefile libm2log/Makefile"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: libgm2 has been configured." >&5
+$as_echo "$as_me: libgm2 has been configured." >&6;}
+
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems.  If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, we kill variables containing newlines.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(
+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+
+  (set) 2>&1 |
+    case $as_nl`(ac_space=' '; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      # `set' does not quote correctly, so add quotes: double-quote
+      # substitution turns \\\\ into \\, and sed turns \\ into \.
+      sed -n \
+	"s/'/'\\\\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+      ;; #(
+    *)
+      # `set' quotes correctly as required by POSIX, so do not add quotes.
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+) |
+  sed '
+     /^ac_cv_env_/b end
+     t clear
+     :clear
+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+     t end
+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+     :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+  if test -w "$cache_file"; then
+    if test "x$cache_file" != "x/dev/null"; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
+      if test ! -f "$cache_file" || test -h "$cache_file"; then
+	cat confcache >"$cache_file"
+      else
+        case $cache_file in #(
+        */* | ?:*)
+	  mv -f confcache "$cache_file"$$ &&
+	  mv -f "$cache_file"$$ "$cache_file" ;; #(
+        *)
+	  mv -f confcache "$cache_file" ;;
+	esac
+      fi
+    fi
+  else
+    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
+  fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+DEFS=-DHAVE_CONFIG_H
+
+ac_libobjs=
+ac_ltlibobjs=
+U=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+  # 1. Remove the extension, and $U if already installed.
+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
+  #    will be set to the directory where LIBOBJS objects are built.
+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking that generated files are newer than configure" >&5
+$as_echo_n "checking that generated files are newer than configure... " >&6; }
+   if test -n "$am_sleep_pid"; then
+     # Hide warnings about reused PIDs.
+     wait $am_sleep_pid 2>/dev/null
+   fi
+   { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5
+$as_echo "done" >&6; }
+if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then
+  as_fn_error $? "conditional \"AMDEP\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then
+  as_fn_error $? "conditional \"am__fastdepCC\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+ if test -n "$EXEEXT"; then
+  am__EXEEXT_TRUE=
+  am__EXEEXT_FALSE='#'
+else
+  am__EXEEXT_TRUE='#'
+  am__EXEEXT_FALSE=
+fi
+
+if test -z "${MAINTAINER_MODE_TRUE}" && test -z "${MAINTAINER_MODE_FALSE}"; then
+  as_fn_error $? "conditional \"MAINTAINER_MODE\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${am__fastdepCXX_TRUE}" && test -z "${am__fastdepCXX_FALSE}"; then
+  as_fn_error $? "conditional \"am__fastdepCXX\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${am__fastdepCCAS_TRUE}" && test -z "${am__fastdepCCAS_FALSE}"; then
+  as_fn_error $? "conditional \"am__fastdepCCAS\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${BUILD_PIMLIB_TRUE}" && test -z "${BUILD_PIMLIB_FALSE}"; then
+  as_fn_error $? "conditional \"BUILD_PIMLIB\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${BUILD_ISOLIB_TRUE}" && test -z "${BUILD_ISOLIB_FALSE}"; then
+  as_fn_error $? "conditional \"BUILD_ISOLIB\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${BUILD_CORLIB_TRUE}" && test -z "${BUILD_CORLIB_FALSE}"; then
+  as_fn_error $? "conditional \"BUILD_CORLIB\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+if test -z "${BUILD_LOGLIB_TRUE}" && test -z "${BUILD_LOGLIB_FALSE}"; then
+  as_fn_error $? "conditional \"BUILD_LOGLIB\" was never defined.
+Usually this means the macro was only invoked conditionally." "$LINENO" 5
+fi
+
+: "${CONFIG_STATUS=./config.status}"
+ac_write_fail=0
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$1; test $as_status -eq 0 && as_status=1
+  if test "$4"; then
+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+  fi
+  $as_echo "$as_me: error: $2" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -pR'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -pR'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -pR'
+  fi
+else
+  as_ln_s='cp -pR'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+  test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+exec 6>&1
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling.
+ac_log="
+This file was extended by package-unused $as_me version-unused, which was
+generated by GNU Autoconf 2.69.  Invocation command line was
+
+  CONFIG_FILES    = $CONFIG_FILES
+  CONFIG_HEADERS  = $CONFIG_HEADERS
+  CONFIG_LINKS    = $CONFIG_LINKS
+  CONFIG_COMMANDS = $CONFIG_COMMANDS
+  $ $0 $@
+
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
+_ACEOF
+
+case $ac_config_files in *"
+"*) set x $ac_config_files; shift; ac_config_files=$*;;
+esac
+
+case $ac_config_headers in *"
+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;
+esac
+
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+# Files that config.status was made for.
+config_files="$ac_config_files"
+config_headers="$ac_config_headers"
+config_commands="$ac_config_commands"
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+ac_cs_usage="\
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration.  Unless the files
+and actions are specified as TAGs, all are instantiated by default.
+
+Usage: $0 [OPTION]... [TAG]...
+
+  -h, --help       print this help, then exit
+  -V, --version    print version number and configuration settings, then exit
+      --config     print configuration, then exit
+  -q, --quiet, --silent
+                   do not print progress messages
+  -d, --debug      don't remove temporary files
+      --recheck    update $as_me by reconfiguring in the same conditions
+      --file=FILE[:TEMPLATE]
+                   instantiate the configuration file FILE
+      --header=FILE[:TEMPLATE]
+                   instantiate the configuration header FILE
+
+Configuration files:
+$config_files
+
+Configuration headers:
+$config_headers
+
+Configuration commands:
+$config_commands
+
+Report bugs to the package provider."
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
+ac_cs_version="\\
+package-unused config.status version-unused
+configured by $0, generated by GNU Autoconf 2.69,
+  with options \\"\$ac_cs_config\\"
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+INSTALL='$INSTALL'
+MKDIR_P='$MKDIR_P'
+AWK='$AWK'
+test -n "\$AWK" || AWK=awk
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
+ac_need_defaults=:
+while test $# != 0
+do
+  case $1 in
+  --*=?*)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
+    ac_shift=:
+    ;;
+  --*=)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=
+    ac_shift=:
+    ;;
+  *)
+    ac_option=$1
+    ac_optarg=$2
+    ac_shift=shift
+    ;;
+  esac
+
+  case $ac_option in
+  # Handling of the options.
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    ac_cs_recheck=: ;;
+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+    $as_echo "$ac_cs_version"; exit ;;
+  --config | --confi | --conf | --con | --co | --c )
+    $as_echo "$ac_cs_config"; exit ;;
+  --debug | --debu | --deb | --de | --d | -d )
+    debug=: ;;
+  --file | --fil | --fi | --f )
+    $ac_shift
+    case $ac_optarg in
+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    '') as_fn_error $? "missing file argument" ;;
+    esac
+    as_fn_append CONFIG_FILES " '$ac_optarg'"
+    ac_need_defaults=false;;
+  --header | --heade | --head | --hea )
+    $ac_shift
+    case $ac_optarg in
+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"
+    ac_need_defaults=false;;
+  --he | --h)
+    # Conflict between --help and --header
+    as_fn_error $? "ambiguous option: \`$1'
+Try \`$0 --help' for more information.";;
+  --help | --hel | -h )
+    $as_echo "$ac_cs_usage"; exit ;;
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil | --si | --s)
+    ac_cs_silent=: ;;
+
+  # This is an error.
+  -*) as_fn_error $? "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
+
+  *) as_fn_append ac_config_targets " $1"
+     ac_need_defaults=false ;;
+
+  esac
+  shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+  exec 6>/dev/null
+  ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+if \$ac_cs_recheck; then
+  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+  shift
+  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+  CONFIG_SHELL='$SHELL'
+  export CONFIG_SHELL
+  exec "\$@"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+exec 5>>config.log
+{
+  echo
+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+  $as_echo "$ac_log"
+} >&5
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+#
+# INIT-COMMANDS
+#
+
+srcdir="$srcdir"
+host="$host"
+target="$target"
+with_multisubdir="$with_multisubdir"
+with_multisrctop="$with_multisrctop"
+with_target_subdir="$with_target_subdir"
+ac_configure_args="${multilib_arg} ${ac_configure_args}"
+multi_basedir="$multi_basedir"
+CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
+CC="$CC"
+CXX="$CXX"
+GFORTRAN="$GFORTRAN"
+GDC="$GDC"
+AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"
+
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+sed_quote_subst='$sed_quote_subst'
+double_quote_subst='$double_quote_subst'
+delay_variable_subst='$delay_variable_subst'
+macro_version='`$ECHO "$macro_version" | $SED "$delay_single_quote_subst"`'
+macro_revision='`$ECHO "$macro_revision" | $SED "$delay_single_quote_subst"`'
+enable_shared='`$ECHO "$enable_shared" | $SED "$delay_single_quote_subst"`'
+enable_static='`$ECHO "$enable_static" | $SED "$delay_single_quote_subst"`'
+pic_mode='`$ECHO "$pic_mode" | $SED "$delay_single_quote_subst"`'
+enable_fast_install='`$ECHO "$enable_fast_install" | $SED "$delay_single_quote_subst"`'
+SHELL='`$ECHO "$SHELL" | $SED "$delay_single_quote_subst"`'
+ECHO='`$ECHO "$ECHO" | $SED "$delay_single_quote_subst"`'
+host_alias='`$ECHO "$host_alias" | $SED "$delay_single_quote_subst"`'
+host='`$ECHO "$host" | $SED "$delay_single_quote_subst"`'
+host_os='`$ECHO "$host_os" | $SED "$delay_single_quote_subst"`'
+build_alias='`$ECHO "$build_alias" | $SED "$delay_single_quote_subst"`'
+build='`$ECHO "$build" | $SED "$delay_single_quote_subst"`'
+build_os='`$ECHO "$build_os" | $SED "$delay_single_quote_subst"`'
+SED='`$ECHO "$SED" | $SED "$delay_single_quote_subst"`'
+Xsed='`$ECHO "$Xsed" | $SED "$delay_single_quote_subst"`'
+GREP='`$ECHO "$GREP" | $SED "$delay_single_quote_subst"`'
+EGREP='`$ECHO "$EGREP" | $SED "$delay_single_quote_subst"`'
+FGREP='`$ECHO "$FGREP" | $SED "$delay_single_quote_subst"`'
+LD='`$ECHO "$LD" | $SED "$delay_single_quote_subst"`'
+NM='`$ECHO "$NM" | $SED "$delay_single_quote_subst"`'
+LN_S='`$ECHO "$LN_S" | $SED "$delay_single_quote_subst"`'
+max_cmd_len='`$ECHO "$max_cmd_len" | $SED "$delay_single_quote_subst"`'
+ac_objext='`$ECHO "$ac_objext" | $SED "$delay_single_quote_subst"`'
+exeext='`$ECHO "$exeext" | $SED "$delay_single_quote_subst"`'
+lt_unset='`$ECHO "$lt_unset" | $SED "$delay_single_quote_subst"`'
+lt_SP2NL='`$ECHO "$lt_SP2NL" | $SED "$delay_single_quote_subst"`'
+lt_NL2SP='`$ECHO "$lt_NL2SP" | $SED "$delay_single_quote_subst"`'
+reload_flag='`$ECHO "$reload_flag" | $SED "$delay_single_quote_subst"`'
+reload_cmds='`$ECHO "$reload_cmds" | $SED "$delay_single_quote_subst"`'
+OBJDUMP='`$ECHO "$OBJDUMP" | $SED "$delay_single_quote_subst"`'
+deplibs_check_method='`$ECHO "$deplibs_check_method" | $SED "$delay_single_quote_subst"`'
+file_magic_cmd='`$ECHO "$file_magic_cmd" | $SED "$delay_single_quote_subst"`'
+AR='`$ECHO "$AR" | $SED "$delay_single_quote_subst"`'
+AR_FLAGS='`$ECHO "$AR_FLAGS" | $SED "$delay_single_quote_subst"`'
+STRIP='`$ECHO "$STRIP" | $SED "$delay_single_quote_subst"`'
+RANLIB='`$ECHO "$RANLIB" | $SED "$delay_single_quote_subst"`'
+old_postinstall_cmds='`$ECHO "$old_postinstall_cmds" | $SED "$delay_single_quote_subst"`'
+old_postuninstall_cmds='`$ECHO "$old_postuninstall_cmds" | $SED "$delay_single_quote_subst"`'
+old_archive_cmds='`$ECHO "$old_archive_cmds" | $SED "$delay_single_quote_subst"`'
+lock_old_archive_extraction='`$ECHO "$lock_old_archive_extraction" | $SED "$delay_single_quote_subst"`'
+CC='`$ECHO "$CC" | $SED "$delay_single_quote_subst"`'
+CFLAGS='`$ECHO "$CFLAGS" | $SED "$delay_single_quote_subst"`'
+compiler='`$ECHO "$compiler" | $SED "$delay_single_quote_subst"`'
+GCC='`$ECHO "$GCC" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_pipe='`$ECHO "$lt_cv_sys_global_symbol_pipe" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_to_cdecl='`$ECHO "$lt_cv_sys_global_symbol_to_cdecl" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address" | $SED "$delay_single_quote_subst"`'
+lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $SED "$delay_single_quote_subst"`'
+objdir='`$ECHO "$objdir" | $SED "$delay_single_quote_subst"`'
+MAGIC_CMD='`$ECHO "$MAGIC_CMD" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_no_builtin_flag='`$ECHO "$lt_prog_compiler_no_builtin_flag" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_wl='`$ECHO "$lt_prog_compiler_wl" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_pic='`$ECHO "$lt_prog_compiler_pic" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_static='`$ECHO "$lt_prog_compiler_static" | $SED "$delay_single_quote_subst"`'
+lt_cv_prog_compiler_c_o='`$ECHO "$lt_cv_prog_compiler_c_o" | $SED "$delay_single_quote_subst"`'
+need_locks='`$ECHO "$need_locks" | $SED "$delay_single_quote_subst"`'
+DSYMUTIL='`$ECHO "$DSYMUTIL" | $SED "$delay_single_quote_subst"`'
+NMEDIT='`$ECHO "$NMEDIT" | $SED "$delay_single_quote_subst"`'
+LIPO='`$ECHO "$LIPO" | $SED "$delay_single_quote_subst"`'
+OTOOL='`$ECHO "$OTOOL" | $SED "$delay_single_quote_subst"`'
+OTOOL64='`$ECHO "$OTOOL64" | $SED "$delay_single_quote_subst"`'
+libext='`$ECHO "$libext" | $SED "$delay_single_quote_subst"`'
+shrext_cmds='`$ECHO "$shrext_cmds" | $SED "$delay_single_quote_subst"`'
+extract_expsyms_cmds='`$ECHO "$extract_expsyms_cmds" | $SED "$delay_single_quote_subst"`'
+archive_cmds_need_lc='`$ECHO "$archive_cmds_need_lc" | $SED "$delay_single_quote_subst"`'
+enable_shared_with_static_runtimes='`$ECHO "$enable_shared_with_static_runtimes" | $SED "$delay_single_quote_subst"`'
+export_dynamic_flag_spec='`$ECHO "$export_dynamic_flag_spec" | $SED "$delay_single_quote_subst"`'
+whole_archive_flag_spec='`$ECHO "$whole_archive_flag_spec" | $SED "$delay_single_quote_subst"`'
+compiler_needs_object='`$ECHO "$compiler_needs_object" | $SED "$delay_single_quote_subst"`'
+old_archive_from_new_cmds='`$ECHO "$old_archive_from_new_cmds" | $SED "$delay_single_quote_subst"`'
+old_archive_from_expsyms_cmds='`$ECHO "$old_archive_from_expsyms_cmds" | $SED "$delay_single_quote_subst"`'
+archive_cmds='`$ECHO "$archive_cmds" | $SED "$delay_single_quote_subst"`'
+archive_expsym_cmds='`$ECHO "$archive_expsym_cmds" | $SED "$delay_single_quote_subst"`'
+module_cmds='`$ECHO "$module_cmds" | $SED "$delay_single_quote_subst"`'
+module_expsym_cmds='`$ECHO "$module_expsym_cmds" | $SED "$delay_single_quote_subst"`'
+with_gnu_ld='`$ECHO "$with_gnu_ld" | $SED "$delay_single_quote_subst"`'
+allow_undefined_flag='`$ECHO "$allow_undefined_flag" | $SED "$delay_single_quote_subst"`'
+no_undefined_flag='`$ECHO "$no_undefined_flag" | $SED "$delay_single_quote_subst"`'
+hardcode_libdir_flag_spec='`$ECHO "$hardcode_libdir_flag_spec" | $SED "$delay_single_quote_subst"`'
+hardcode_libdir_flag_spec_ld='`$ECHO "$hardcode_libdir_flag_spec_ld" | $SED "$delay_single_quote_subst"`'
+hardcode_libdir_separator='`$ECHO "$hardcode_libdir_separator" | $SED "$delay_single_quote_subst"`'
+hardcode_direct='`$ECHO "$hardcode_direct" | $SED "$delay_single_quote_subst"`'
+hardcode_direct_absolute='`$ECHO "$hardcode_direct_absolute" | $SED "$delay_single_quote_subst"`'
+hardcode_minus_L='`$ECHO "$hardcode_minus_L" | $SED "$delay_single_quote_subst"`'
+hardcode_shlibpath_var='`$ECHO "$hardcode_shlibpath_var" | $SED "$delay_single_quote_subst"`'
+hardcode_automatic='`$ECHO "$hardcode_automatic" | $SED "$delay_single_quote_subst"`'
+inherit_rpath='`$ECHO "$inherit_rpath" | $SED "$delay_single_quote_subst"`'
+link_all_deplibs='`$ECHO "$link_all_deplibs" | $SED "$delay_single_quote_subst"`'
+fix_srcfile_path='`$ECHO "$fix_srcfile_path" | $SED "$delay_single_quote_subst"`'
+always_export_symbols='`$ECHO "$always_export_symbols" | $SED "$delay_single_quote_subst"`'
+export_symbols_cmds='`$ECHO "$export_symbols_cmds" | $SED "$delay_single_quote_subst"`'
+exclude_expsyms='`$ECHO "$exclude_expsyms" | $SED "$delay_single_quote_subst"`'
+include_expsyms='`$ECHO "$include_expsyms" | $SED "$delay_single_quote_subst"`'
+prelink_cmds='`$ECHO "$prelink_cmds" | $SED "$delay_single_quote_subst"`'
+file_list_spec='`$ECHO "$file_list_spec" | $SED "$delay_single_quote_subst"`'
+variables_saved_for_relink='`$ECHO "$variables_saved_for_relink" | $SED "$delay_single_quote_subst"`'
+need_lib_prefix='`$ECHO "$need_lib_prefix" | $SED "$delay_single_quote_subst"`'
+need_version='`$ECHO "$need_version" | $SED "$delay_single_quote_subst"`'
+version_type='`$ECHO "$version_type" | $SED "$delay_single_quote_subst"`'
+runpath_var='`$ECHO "$runpath_var" | $SED "$delay_single_quote_subst"`'
+shlibpath_var='`$ECHO "$shlibpath_var" | $SED "$delay_single_quote_subst"`'
+shlibpath_overrides_runpath='`$ECHO "$shlibpath_overrides_runpath" | $SED "$delay_single_quote_subst"`'
+libname_spec='`$ECHO "$libname_spec" | $SED "$delay_single_quote_subst"`'
+library_names_spec='`$ECHO "$library_names_spec" | $SED "$delay_single_quote_subst"`'
+soname_spec='`$ECHO "$soname_spec" | $SED "$delay_single_quote_subst"`'
+install_override_mode='`$ECHO "$install_override_mode" | $SED "$delay_single_quote_subst"`'
+postinstall_cmds='`$ECHO "$postinstall_cmds" | $SED "$delay_single_quote_subst"`'
+postuninstall_cmds='`$ECHO "$postuninstall_cmds" | $SED "$delay_single_quote_subst"`'
+finish_cmds='`$ECHO "$finish_cmds" | $SED "$delay_single_quote_subst"`'
+finish_eval='`$ECHO "$finish_eval" | $SED "$delay_single_quote_subst"`'
+hardcode_into_libs='`$ECHO "$hardcode_into_libs" | $SED "$delay_single_quote_subst"`'
+sys_lib_search_path_spec='`$ECHO "$sys_lib_search_path_spec" | $SED "$delay_single_quote_subst"`'
+sys_lib_dlsearch_path_spec='`$ECHO "$sys_lib_dlsearch_path_spec" | $SED "$delay_single_quote_subst"`'
+hardcode_action='`$ECHO "$hardcode_action" | $SED "$delay_single_quote_subst"`'
+enable_dlopen='`$ECHO "$enable_dlopen" | $SED "$delay_single_quote_subst"`'
+enable_dlopen_self='`$ECHO "$enable_dlopen_self" | $SED "$delay_single_quote_subst"`'
+enable_dlopen_self_static='`$ECHO "$enable_dlopen_self_static" | $SED "$delay_single_quote_subst"`'
+old_striplib='`$ECHO "$old_striplib" | $SED "$delay_single_quote_subst"`'
+striplib='`$ECHO "$striplib" | $SED "$delay_single_quote_subst"`'
+compiler_lib_search_dirs='`$ECHO "$compiler_lib_search_dirs" | $SED "$delay_single_quote_subst"`'
+predep_objects='`$ECHO "$predep_objects" | $SED "$delay_single_quote_subst"`'
+postdep_objects='`$ECHO "$postdep_objects" | $SED "$delay_single_quote_subst"`'
+predeps='`$ECHO "$predeps" | $SED "$delay_single_quote_subst"`'
+postdeps='`$ECHO "$postdeps" | $SED "$delay_single_quote_subst"`'
+compiler_lib_search_path='`$ECHO "$compiler_lib_search_path" | $SED "$delay_single_quote_subst"`'
+LD_CXX='`$ECHO "$LD_CXX" | $SED "$delay_single_quote_subst"`'
+reload_flag_CXX='`$ECHO "$reload_flag_CXX" | $SED "$delay_single_quote_subst"`'
+reload_cmds_CXX='`$ECHO "$reload_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+old_archive_cmds_CXX='`$ECHO "$old_archive_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+compiler_CXX='`$ECHO "$compiler_CXX" | $SED "$delay_single_quote_subst"`'
+GCC_CXX='`$ECHO "$GCC_CXX" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_no_builtin_flag_CXX='`$ECHO "$lt_prog_compiler_no_builtin_flag_CXX" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_wl_CXX='`$ECHO "$lt_prog_compiler_wl_CXX" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_pic_CXX='`$ECHO "$lt_prog_compiler_pic_CXX" | $SED "$delay_single_quote_subst"`'
+lt_prog_compiler_static_CXX='`$ECHO "$lt_prog_compiler_static_CXX" | $SED "$delay_single_quote_subst"`'
+lt_cv_prog_compiler_c_o_CXX='`$ECHO "$lt_cv_prog_compiler_c_o_CXX" | $SED "$delay_single_quote_subst"`'
+archive_cmds_need_lc_CXX='`$ECHO "$archive_cmds_need_lc_CXX" | $SED "$delay_single_quote_subst"`'
+enable_shared_with_static_runtimes_CXX='`$ECHO "$enable_shared_with_static_runtimes_CXX" | $SED "$delay_single_quote_subst"`'
+export_dynamic_flag_spec_CXX='`$ECHO "$export_dynamic_flag_spec_CXX" | $SED "$delay_single_quote_subst"`'
+whole_archive_flag_spec_CXX='`$ECHO "$whole_archive_flag_spec_CXX" | $SED "$delay_single_quote_subst"`'
+compiler_needs_object_CXX='`$ECHO "$compiler_needs_object_CXX" | $SED "$delay_single_quote_subst"`'
+old_archive_from_new_cmds_CXX='`$ECHO "$old_archive_from_new_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+old_archive_from_expsyms_cmds_CXX='`$ECHO "$old_archive_from_expsyms_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+archive_cmds_CXX='`$ECHO "$archive_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+archive_expsym_cmds_CXX='`$ECHO "$archive_expsym_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+module_cmds_CXX='`$ECHO "$module_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+module_expsym_cmds_CXX='`$ECHO "$module_expsym_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+with_gnu_ld_CXX='`$ECHO "$with_gnu_ld_CXX" | $SED "$delay_single_quote_subst"`'
+allow_undefined_flag_CXX='`$ECHO "$allow_undefined_flag_CXX" | $SED "$delay_single_quote_subst"`'
+no_undefined_flag_CXX='`$ECHO "$no_undefined_flag_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_libdir_flag_spec_CXX='`$ECHO "$hardcode_libdir_flag_spec_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_libdir_flag_spec_ld_CXX='`$ECHO "$hardcode_libdir_flag_spec_ld_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_libdir_separator_CXX='`$ECHO "$hardcode_libdir_separator_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_direct_CXX='`$ECHO "$hardcode_direct_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_direct_absolute_CXX='`$ECHO "$hardcode_direct_absolute_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_minus_L_CXX='`$ECHO "$hardcode_minus_L_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_shlibpath_var_CXX='`$ECHO "$hardcode_shlibpath_var_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_automatic_CXX='`$ECHO "$hardcode_automatic_CXX" | $SED "$delay_single_quote_subst"`'
+inherit_rpath_CXX='`$ECHO "$inherit_rpath_CXX" | $SED "$delay_single_quote_subst"`'
+link_all_deplibs_CXX='`$ECHO "$link_all_deplibs_CXX" | $SED "$delay_single_quote_subst"`'
+fix_srcfile_path_CXX='`$ECHO "$fix_srcfile_path_CXX" | $SED "$delay_single_quote_subst"`'
+always_export_symbols_CXX='`$ECHO "$always_export_symbols_CXX" | $SED "$delay_single_quote_subst"`'
+export_symbols_cmds_CXX='`$ECHO "$export_symbols_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+exclude_expsyms_CXX='`$ECHO "$exclude_expsyms_CXX" | $SED "$delay_single_quote_subst"`'
+include_expsyms_CXX='`$ECHO "$include_expsyms_CXX" | $SED "$delay_single_quote_subst"`'
+prelink_cmds_CXX='`$ECHO "$prelink_cmds_CXX" | $SED "$delay_single_quote_subst"`'
+file_list_spec_CXX='`$ECHO "$file_list_spec_CXX" | $SED "$delay_single_quote_subst"`'
+hardcode_action_CXX='`$ECHO "$hardcode_action_CXX" | $SED "$delay_single_quote_subst"`'
+compiler_lib_search_dirs_CXX='`$ECHO "$compiler_lib_search_dirs_CXX" | $SED "$delay_single_quote_subst"`'
+predep_objects_CXX='`$ECHO "$predep_objects_CXX" | $SED "$delay_single_quote_subst"`'
+postdep_objects_CXX='`$ECHO "$postdep_objects_CXX" | $SED "$delay_single_quote_subst"`'
+predeps_CXX='`$ECHO "$predeps_CXX" | $SED "$delay_single_quote_subst"`'
+postdeps_CXX='`$ECHO "$postdeps_CXX" | $SED "$delay_single_quote_subst"`'
+compiler_lib_search_path_CXX='`$ECHO "$compiler_lib_search_path_CXX" | $SED "$delay_single_quote_subst"`'
+
+LTCC='$LTCC'
+LTCFLAGS='$LTCFLAGS'
+compiler='$compiler_DEFAULT'
+
+# A function that is used when there is no print builtin or printf.
+func_fallback_echo ()
+{
+  eval 'cat <<_LTECHO_EOF
+\$1
+_LTECHO_EOF'
+}
+
+# Quote evaled strings.
+for var in SHELL \
+ECHO \
+SED \
+GREP \
+EGREP \
+FGREP \
+LD \
+NM \
+LN_S \
+lt_SP2NL \
+lt_NL2SP \
+reload_flag \
+OBJDUMP \
+deplibs_check_method \
+file_magic_cmd \
+AR \
+AR_FLAGS \
+STRIP \
+RANLIB \
+CC \
+CFLAGS \
+compiler \
+lt_cv_sys_global_symbol_pipe \
+lt_cv_sys_global_symbol_to_cdecl \
+lt_cv_sys_global_symbol_to_c_name_address \
+lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \
+lt_prog_compiler_no_builtin_flag \
+lt_prog_compiler_wl \
+lt_prog_compiler_pic \
+lt_prog_compiler_static \
+lt_cv_prog_compiler_c_o \
+need_locks \
+DSYMUTIL \
+NMEDIT \
+LIPO \
+OTOOL \
+OTOOL64 \
+shrext_cmds \
+export_dynamic_flag_spec \
+whole_archive_flag_spec \
+compiler_needs_object \
+with_gnu_ld \
+allow_undefined_flag \
+no_undefined_flag \
+hardcode_libdir_flag_spec \
+hardcode_libdir_flag_spec_ld \
+hardcode_libdir_separator \
+fix_srcfile_path \
+exclude_expsyms \
+include_expsyms \
+file_list_spec \
+variables_saved_for_relink \
+libname_spec \
+library_names_spec \
+soname_spec \
+install_override_mode \
+finish_eval \
+old_striplib \
+striplib \
+compiler_lib_search_dirs \
+predep_objects \
+postdep_objects \
+predeps \
+postdeps \
+compiler_lib_search_path \
+LD_CXX \
+reload_flag_CXX \
+compiler_CXX \
+lt_prog_compiler_no_builtin_flag_CXX \
+lt_prog_compiler_wl_CXX \
+lt_prog_compiler_pic_CXX \
+lt_prog_compiler_static_CXX \
+lt_cv_prog_compiler_c_o_CXX \
+export_dynamic_flag_spec_CXX \
+whole_archive_flag_spec_CXX \
+compiler_needs_object_CXX \
+with_gnu_ld_CXX \
+allow_undefined_flag_CXX \
+no_undefined_flag_CXX \
+hardcode_libdir_flag_spec_CXX \
+hardcode_libdir_flag_spec_ld_CXX \
+hardcode_libdir_separator_CXX \
+fix_srcfile_path_CXX \
+exclude_expsyms_CXX \
+include_expsyms_CXX \
+file_list_spec_CXX \
+compiler_lib_search_dirs_CXX \
+predep_objects_CXX \
+postdep_objects_CXX \
+predeps_CXX \
+postdeps_CXX \
+compiler_lib_search_path_CXX; do
+    case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
+    *[\\\\\\\`\\"\\\$]*)
+      eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\""
+      ;;
+    *)
+      eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
+      ;;
+    esac
+done
+
+# Double-quote double-evaled strings.
+for var in reload_cmds \
+old_postinstall_cmds \
+old_postuninstall_cmds \
+old_archive_cmds \
+extract_expsyms_cmds \
+old_archive_from_new_cmds \
+old_archive_from_expsyms_cmds \
+archive_cmds \
+archive_expsym_cmds \
+module_cmds \
+module_expsym_cmds \
+export_symbols_cmds \
+prelink_cmds \
+postinstall_cmds \
+postuninstall_cmds \
+finish_cmds \
+sys_lib_search_path_spec \
+sys_lib_dlsearch_path_spec \
+reload_cmds_CXX \
+old_archive_cmds_CXX \
+old_archive_from_new_cmds_CXX \
+old_archive_from_expsyms_cmds_CXX \
+archive_cmds_CXX \
+archive_expsym_cmds_CXX \
+module_cmds_CXX \
+module_expsym_cmds_CXX \
+export_symbols_cmds_CXX \
+prelink_cmds_CXX; do
+    case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
+    *[\\\\\\\`\\"\\\$]*)
+      eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\""
+      ;;
+    *)
+      eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
+      ;;
+    esac
+done
+
+ac_aux_dir='$ac_aux_dir'
+xsi_shell='$xsi_shell'
+lt_shell_append='$lt_shell_append'
+
+# See if we are running on zsh, and set the options which allow our
+# commands through without removal of \ escapes INIT.
+if test -n "\${ZSH_VERSION+set}" ; then
+   setopt NO_GLOB_SUBST
+fi
+
+
+    PACKAGE='$PACKAGE'
+    VERSION='$VERSION'
+    TIMESTAMP='$TIMESTAMP'
+    RM='$RM'
+    ofile='$ofile'
+
+
+
+
+
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+
+# Handling of arguments.
+for ac_config_target in $ac_config_targets
+do
+  case $ac_config_target in
+    "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;
+    "default-1") CONFIG_COMMANDS="$CONFIG_COMMANDS default-1" ;;
+    "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;;
+    "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;;
+    "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+    "libm2min/Makefile") CONFIG_FILES="$CONFIG_FILES libm2min/Makefile" ;;
+    "libm2pim/Makefile") CONFIG_FILES="$CONFIG_FILES libm2pim/Makefile" ;;
+    "libm2iso/Makefile") CONFIG_FILES="$CONFIG_FILES libm2iso/Makefile" ;;
+    "libm2cor/Makefile") CONFIG_FILES="$CONFIG_FILES libm2cor/Makefile" ;;
+    "libm2log/Makefile") CONFIG_FILES="$CONFIG_FILES libm2log/Makefile" ;;
+
+  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
+  esac
+done
+
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used.  Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
+  test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands
+fi
+
+# Have a temporary directory for convenience.  Make it in the build tree
+# simply because there is no reason against having it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
+$debug ||
+{
+  tmp= ac_tmp=
+  trap 'exit_status=$?
+  : "${ac_tmp:=$tmp}"
+  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
+' 0
+  trap 'as_fn_exit 1' 1 2 13 15
+}
+# Create a (secure) tmp directory for tmp files.
+
+{
+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+  test -d "$tmp"
+}  ||
+{
+  tmp=./conf$$-$RANDOM
+  (umask 077 && mkdir "$tmp")
+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
+ac_tmp=$tmp
+
+# Set up the scripts for CONFIG_FILES section.
+# No need to generate them if there are no CONFIG_FILES.
+# This happens for instance with `./config.status config.h'.
+if test -n "$CONFIG_FILES"; then
+
+
+ac_cr=`echo X | tr X '\015'`
+# On cygwin, bash can eat \r inside `` if the user requested igncr.
+# But we know of no other shell where ac_cr would be empty at this
+# point, so we can use a bashism as a fallback.
+if test "x$ac_cr" = x; then
+  eval ac_cr=\$\'\\r\'
+fi
+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
+  ac_cs_awk_cr='\\r'
+else
+  ac_cs_awk_cr=$ac_cr
+fi
+
+echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
+_ACEOF
+
+
+{
+  echo "cat >conf$$subs.awk <<_ACEOF" &&
+  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
+  echo "_ACEOF"
+} >conf$$subs.sh ||
+  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
+ac_delim='%!_!# '
+for ac_last_try in false false false false false :; do
+  . ./conf$$subs.sh ||
+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+
+  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
+  if test $ac_delim_n = $ac_delim_num; then
+    break
+  elif $ac_last_try; then
+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+rm -f conf$$subs.sh
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
+_ACEOF
+sed -n '
+h
+s/^/S["/; s/!.*/"]=/
+p
+g
+s/^[^!]*!//
+:repl
+t repl
+s/'"$ac_delim"'$//
+t delim
+:nl
+h
+s/\(.\{148\}\)..*/\1/
+t more1
+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
+p
+n
+b repl
+:more1
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t nl
+:delim
+h
+s/\(.\{148\}\)..*/\1/
+t more2
+s/["\\]/\\&/g; s/^/"/; s/$/"/
+p
+b
+:more2
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t delim
+' <conf$$subs.awk | sed '
+/^[^""]/{
+  N
+  s/\n//
+}
+' >>$CONFIG_STATUS || ac_write_fail=1
+rm -f conf$$subs.awk
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACAWK
+cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
+  for (key in S) S_is_set[key] = 1
+  FS = ""
+
+}
+{
+  line = $ 0
+  nfields = split(line, field, "@")
+  substed = 0
+  len = length(field[1])
+  for (i = 2; i < nfields; i++) {
+    key = field[i]
+    keylen = length(key)
+    if (S_is_set[key]) {
+      value = S[key]
+      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
+      len += length(value) + length(field[++i])
+      substed = 1
+    } else
+      len += 1 + keylen
+  }
+
+  print line
+}
+
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
+  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
+else
+  cat
+fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
+  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
+_ACEOF
+
+# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{
+h
+s///
+s/^/:/
+s/[	 ]*$/:/
+s/:\$(srcdir):/:/g
+s/:\${srcdir}:/:/g
+s/:@srcdir@:/:/g
+s/^:*//
+s/:*$//
+x
+s/\(=[	 ]*\).*/\1/
+G
+s/\n//
+s/^[^=]*=[	 ]*$//
+}'
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+fi # test -n "$CONFIG_FILES"
+
+# Set up the scripts for CONFIG_HEADERS section.
+# No need to generate them if there are no CONFIG_HEADERS.
+# This happens for instance with `./config.status Makefile'.
+if test -n "$CONFIG_HEADERS"; then
+cat >"$ac_tmp/defines.awk" <<\_ACAWK ||
+BEGIN {
+_ACEOF
+
+# Transform confdefs.h into an awk script `defines.awk', embedded as
+# here-document in config.status, that substitutes the proper values into
+# config.h.in to produce config.h.
+
+# Create a delimiter string that does not exist in confdefs.h, to ease
+# handling of long lines.
+ac_delim='%!_!# '
+for ac_last_try in false false :; do
+  ac_tt=`sed -n "/$ac_delim/p" confdefs.h`
+  if test -z "$ac_tt"; then
+    break
+  elif $ac_last_try; then
+    as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+
+# For the awk script, D is an array of macro values keyed by name,
+# likewise P contains macro parameters if any.  Preserve backslash
+# newline sequences.
+
+ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*
+sed -n '
+s/.\{148\}/&'"$ac_delim"'/g
+t rset
+:rset
+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /
+t def
+d
+:def
+s/\\$//
+t bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3"/p
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p
+d
+:bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3\\\\\\n"\\/p
+t cont
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p
+t cont
+d
+:cont
+n
+s/.\{148\}/&'"$ac_delim"'/g
+t clear
+:clear
+s/\\$//
+t bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/"/p
+d
+:bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p
+b cont
+' <confdefs.h | sed '
+s/'"$ac_delim"'/"\\\
+"/g' >>$CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+  for (key in D) D_is_set[key] = 1
+  FS = ""
+}
+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {
+  line = \$ 0
+  split(line, arg, " ")
+  if (arg[1] == "#") {
+    defundef = arg[2]
+    mac1 = arg[3]
+  } else {
+    defundef = substr(arg[1], 2)
+    mac1 = arg[2]
+  }
+  split(mac1, mac2, "(") #)
+  macro = mac2[1]
+  prefix = substr(line, 1, index(line, defundef) - 1)
+  if (D_is_set[macro]) {
+    # Preserve the white space surrounding the "#".
+    print prefix "define", macro P[macro] D[macro]
+    next
+  } else {
+    # Replace #undef with comments.  This is necessary, for example,
+    # in the case of _POSIX_SOURCE, which is predefined and required
+    # on some systems where configure will not decide to define it.
+    if (defundef == "undef") {
+      print "/*", prefix defundef, macro, "*/"
+      next
+    }
+  }
+}
+{ print }
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+  as_fn_error $? "could not setup config headers machinery" "$LINENO" 5
+fi # test -n "$CONFIG_HEADERS"
+
+
+eval set X "  :F $CONFIG_FILES  :H $CONFIG_HEADERS    :C $CONFIG_COMMANDS"
+shift
+for ac_tag
+do
+  case $ac_tag in
+  :[FHLC]) ac_mode=$ac_tag; continue;;
+  esac
+  case $ac_mode$ac_tag in
+  :[FHL]*:*);;
+  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
+  :[FH]-) ac_tag=-:-;;
+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+  esac
+  ac_save_IFS=$IFS
+  IFS=:
+  set x $ac_tag
+  IFS=$ac_save_IFS
+  shift
+  ac_file=$1
+  shift
+
+  case $ac_mode in
+  :L) ac_source=$1;;
+  :[FH])
+    ac_file_inputs=
+    for ac_f
+    do
+      case $ac_f in
+      -) ac_f="$ac_tmp/stdin";;
+      *) # Look for the file first in the build tree, then in the source tree
+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
+	 # because $ac_f cannot contain `:'.
+	 test -f "$ac_f" ||
+	   case $ac_f in
+	   [\\/$]*) false;;
+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+	   esac ||
+	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
+      esac
+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+      as_fn_append ac_file_inputs " '$ac_f'"
+    done
+
+    # Let's still pretend it is `configure' which instantiates (i.e., don't
+    # use $as_me), people would be surprised to read:
+    #    /* config.h.  Generated by config.status.  */
+    configure_input='Generated from '`
+	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+	`' by configure.'
+    if test x"$ac_file" != x-; then
+      configure_input="$ac_file.  $configure_input"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
+    fi
+    # Neutralize special characters interpreted by sed in replacement strings.
+    case $configure_input in #(
+    *\&* | *\|* | *\\* )
+       ac_sed_conf_input=`$as_echo "$configure_input" |
+       sed 's/[\\\\&|]/\\\\&/g'`;; #(
+    *) ac_sed_conf_input=$configure_input;;
+    esac
+
+    case $ac_tag in
+    *:-:* | *:-) cat >"$ac_tmp/stdin" \
+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
+    esac
+    ;;
+  esac
+
+  ac_dir=`$as_dirname -- "$ac_file" ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$ac_file" : 'X\(//\)[^/]' \| \
+	 X"$ac_file" : 'X\(//\)$' \| \
+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$ac_file" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  as_dir="$ac_dir"; as_fn_mkdir_p
+  ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+
+  case $ac_mode in
+  :F)
+  #
+  # CONFIG_FILE
+  #
+
+  case $INSTALL in
+  [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
+  *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;;
+  esac
+  ac_MKDIR_P=$MKDIR_P
+  case $MKDIR_P in
+  [\\/$]* | ?:[\\/]* ) ;;
+  */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;;
+  esac
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# If the template does not know about datarootdir, expand it.
+# FIXME: This hack should be removed a few years after 2.60.
+ac_datarootdir_hack=; ac_datarootdir_seen=
+ac_sed_dataroot='
+/datarootdir/ {
+  p
+  q
+}
+/@datadir@/p
+/@docdir@/p
+/@infodir@/p
+/@localedir@/p
+/@mandir@/p'
+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
+*datarootdir*) ac_datarootdir_seen=yes;;
+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+  ac_datarootdir_hack='
+  s&@datadir@&$datadir&g
+  s&@docdir@&$docdir&g
+  s&@infodir@&$infodir&g
+  s&@localedir@&$localedir&g
+  s&@mandir@&$mandir&g
+  s&\\\${datarootdir}&$datarootdir&g' ;;
+esac
+_ACEOF
+
+# Neutralize VPATH when `$srcdir' = `.'.
+# Shell code in configure.ac might set extrasub.
+# FIXME: do we really want to maintain this feature?
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_sed_extra="$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s|@configure_input@|$ac_sed_conf_input|;t t
+s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@top_build_prefix@&$ac_top_build_prefix&;t t
+s&@srcdir@&$ac_srcdir&;t t
+s&@abs_srcdir@&$ac_abs_srcdir&;t t
+s&@top_srcdir@&$ac_top_srcdir&;t t
+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
+s&@builddir@&$ac_builddir&;t t
+s&@abs_builddir@&$ac_abs_builddir&;t t
+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
+s&@INSTALL@&$ac_INSTALL&;t t
+s&@MKDIR_P@&$ac_MKDIR_P&;t t
+$ac_datarootdir_hack
+"
+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
+  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+
+test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
+  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
+  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \
+      "$ac_tmp/out"`; test -z "$ac_out"; } &&
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined.  Please make sure it is defined" >&5
+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined.  Please make sure it is defined" >&2;}
+
+  rm -f "$ac_tmp/stdin"
+  case $ac_file in
+  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
+  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
+  esac \
+  || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+ ;;
+  :H)
+  #
+  # CONFIG_HEADER
+  #
+  if test x"$ac_file" != x-; then
+    {
+      $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"
+    } >"$ac_tmp/config.h" \
+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+    if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5
+$as_echo "$as_me: $ac_file is unchanged" >&6;}
+    else
+      rm -f "$ac_file"
+      mv "$ac_tmp/config.h" "$ac_file" \
+	|| as_fn_error $? "could not create $ac_file" "$LINENO" 5
+    fi
+  else
+    $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \
+      || as_fn_error $? "could not create -" "$LINENO" 5
+  fi
+# Compute "$ac_file"'s index in $config_headers.
+_am_arg="$ac_file"
+_am_stamp_count=1
+for _am_header in $config_headers :; do
+  case $_am_header in
+    $_am_arg | $_am_arg:* )
+      break ;;
+    * )
+      _am_stamp_count=`expr $_am_stamp_count + 1` ;;
+  esac
+done
+echo "timestamp for $_am_arg" >`$as_dirname -- "$_am_arg" ||
+$as_expr X"$_am_arg" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$_am_arg" : 'X\(//\)[^/]' \| \
+	 X"$_am_arg" : 'X\(//\)$' \| \
+	 X"$_am_arg" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$_am_arg" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`/stamp-h$_am_stamp_count
+ ;;
+
+  :C)  { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5
+$as_echo "$as_me: executing $ac_file commands" >&6;}
+ ;;
+  esac
+
+
+  case $ac_file$ac_mode in
+    "default-1":C)
+# Only add multilib support code if we just rebuilt the top-level
+# Makefile.
+case " $CONFIG_FILES " in
+ *" Makefile "*)
+   ac_file=Makefile . ${multi_basedir}/config-ml.in
+   ;;
+esac ;;
+    "depfiles":C) test x"$AMDEP_TRUE" != x"" || {
+  # Older Autoconf quotes --file arguments for eval, but not when files
+  # are listed without --file.  Let's play safe and only enable the eval
+  # if we detect the quoting.
+  case $CONFIG_FILES in
+  *\'*) eval set x "$CONFIG_FILES" ;;
+  *)   set x $CONFIG_FILES ;;
+  esac
+  shift
+  for mf
+  do
+    # Strip MF so we end up with the name of the file.
+    mf=`echo "$mf" | sed -e 's/:.*$//'`
+    # Check whether this is an Automake generated Makefile or not.
+    # We used to match only the files named 'Makefile.in', but
+    # some people rename them; so instead we look at the file content.
+    # Grep'ing the first line is not enough: some people post-process
+    # each Makefile.in and add a new line on top of each file to say so.
+    # Grep'ing the whole file is not good either: AIX grep has a line
+    # limit of 2048, but all sed's we know have understand at least 4000.
+    if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then
+      dirpart=`$as_dirname -- "$mf" ||
+$as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$mf" : 'X\(//\)[^/]' \| \
+	 X"$mf" : 'X\(//\)$' \| \
+	 X"$mf" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$mf" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+    else
+      continue
+    fi
+    # Extract the definition of DEPDIR, am__include, and am__quote
+    # from the Makefile without running 'make'.
+    DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"`
+    test -z "$DEPDIR" && continue
+    am__include=`sed -n 's/^am__include = //p' < "$mf"`
+    test -z "$am__include" && continue
+    am__quote=`sed -n 's/^am__quote = //p' < "$mf"`
+    # Find all dependency output files, they are included files with
+    # $(DEPDIR) in their names.  We invoke sed twice because it is the
+    # simplest approach to changing $(DEPDIR) to its actual value in the
+    # expansion.
+    for file in `sed -n "
+      s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \
+	 sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do
+      # Make sure the directory exists.
+      test -f "$dirpart/$file" && continue
+      fdir=`$as_dirname -- "$file" ||
+$as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$file" : 'X\(//\)[^/]' \| \
+	 X"$file" : 'X\(//\)$' \| \
+	 X"$file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$file" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      as_dir=$dirpart/$fdir; as_fn_mkdir_p
+      # echo "creating $dirpart/$file"
+      echo '# dummy' > "$dirpart/$file"
+    done
+  done
+}
+ ;;
+    "libtool":C)
+
+    # See if we are running on zsh, and set the options which allow our
+    # commands through without removal of \ escapes.
+    if test -n "${ZSH_VERSION+set}" ; then
+      setopt NO_GLOB_SUBST
+    fi
+
+    cfgfile="${ofile}T"
+    trap "$RM \"$cfgfile\"; exit 1" 1 2 15
+    $RM "$cfgfile"
+
+    cat <<_LT_EOF >> "$cfgfile"
+#! $SHELL
+
+# `$ECHO "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
+# Generated automatically by $as_me ($PACKAGE$TIMESTAMP) $VERSION
+# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+# NOTE: Changes made to this file will be lost: look at ltmain.sh.
+#
+#   Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005,
+#                 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+#   Written by Gordon Matzigkeit, 1996
+#
+#   This file is part of GNU Libtool.
+#
+# GNU Libtool 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 2 of
+# the License, or (at your option) any later version.
+#
+# As a special exception to the GNU General Public License,
+# if you distribute this file as part of a program or library that
+# is built using GNU Libtool, you may include this file under the
+# same distribution terms that you use for the rest of that program.
+#
+# GNU Libtool 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 Libtool; see the file COPYING.  If not, a copy
+# can be downloaded from http://www.gnu.org/licenses/gpl.html, or
+# obtained by writing to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+
+
+# The names of the tagged configurations supported by this script.
+available_tags="CXX "
+
+# ### BEGIN LIBTOOL CONFIG
+
+# Which release of libtool.m4 was used?
+macro_version=$macro_version
+macro_revision=$macro_revision
+
+# Whether or not to build shared libraries.
+build_libtool_libs=$enable_shared
+
+# Whether or not to build static libraries.
+build_old_libs=$enable_static
+
+# What type of objects to build.
+pic_mode=$pic_mode
+
+# Whether or not to optimize for fast installation.
+fast_install=$enable_fast_install
+
+# Shell to use when invoking shell scripts.
+SHELL=$lt_SHELL
+
+# An echo program that protects backslashes.
+ECHO=$lt_ECHO
+
+# The host system.
+host_alias=$host_alias
+host=$host
+host_os=$host_os
+
+# The build system.
+build_alias=$build_alias
+build=$build
+build_os=$build_os
+
+# A sed program that does not truncate output.
+SED=$lt_SED
+
+# Sed that helps us avoid accidentally triggering echo(1) options like -n.
+Xsed="\$SED -e 1s/^X//"
+
+# A grep program that handles long lines.
+GREP=$lt_GREP
+
+# An ERE matcher.
+EGREP=$lt_EGREP
+
+# A literal string matcher.
+FGREP=$lt_FGREP
+
+# A BSD- or MS-compatible name lister.
+NM=$lt_NM
+
+# Whether we need soft or hard links.
+LN_S=$lt_LN_S
+
+# What is the maximum length of a command?
+max_cmd_len=$max_cmd_len
+
+# Object file suffix (normally "o").
+objext=$ac_objext
+
+# Executable file suffix (normally "").
+exeext=$exeext
+
+# whether the shell understands "unset".
+lt_unset=$lt_unset
+
+# turn spaces into newlines.
+SP2NL=$lt_lt_SP2NL
+
+# turn newlines into spaces.
+NL2SP=$lt_lt_NL2SP
+
+# An object symbol dumper.
+OBJDUMP=$lt_OBJDUMP
+
+# Method to check whether dependent libraries are shared objects.
+deplibs_check_method=$lt_deplibs_check_method
+
+# Command to use when deplibs_check_method == "file_magic".
+file_magic_cmd=$lt_file_magic_cmd
+
+# The archiver.
+AR=$lt_AR
+AR_FLAGS=$lt_AR_FLAGS
+
+# A symbol stripping program.
+STRIP=$lt_STRIP
+
+# Commands used to install an old-style archive.
+RANLIB=$lt_RANLIB
+old_postinstall_cmds=$lt_old_postinstall_cmds
+old_postuninstall_cmds=$lt_old_postuninstall_cmds
+
+# Whether to use a lock for old archive extraction.
+lock_old_archive_extraction=$lock_old_archive_extraction
+
+# A C compiler.
+LTCC=$lt_CC
+
+# LTCC compiler flags.
+LTCFLAGS=$lt_CFLAGS
+
+# Take the output of nm and produce a listing of raw symbols and C names.
+global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe
+
+# Transform the output of nm in a proper C declaration.
+global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl
+
+# Transform the output of nm in a C name address pair.
+global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address
+
+# Transform the output of nm in a C name address pair when lib prefix is needed.
+global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix
+
+# The name of the directory that contains temporary libtool files.
+objdir=$objdir
+
+# Used to examine libraries when file_magic_cmd begins with "file".
+MAGIC_CMD=$MAGIC_CMD
+
+# Must we lock files when doing compilation?
+need_locks=$lt_need_locks
+
+# Tool to manipulate archived DWARF debug symbol files on Mac OS X.
+DSYMUTIL=$lt_DSYMUTIL
+
+# Tool to change global to local symbols on Mac OS X.
+NMEDIT=$lt_NMEDIT
+
+# Tool to manipulate fat objects and archives on Mac OS X.
+LIPO=$lt_LIPO
+
+# ldd/readelf like tool for Mach-O binaries on Mac OS X.
+OTOOL=$lt_OTOOL
+
+# ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4.
+OTOOL64=$lt_OTOOL64
+
+# Old archive suffix (normally "a").
+libext=$libext
+
+# Shared library suffix (normally ".so").
+shrext_cmds=$lt_shrext_cmds
+
+# The commands to extract the exported symbol list from a shared archive.
+extract_expsyms_cmds=$lt_extract_expsyms_cmds
+
+# Variables whose values should be saved in libtool wrapper scripts and
+# restored at link time.
+variables_saved_for_relink=$lt_variables_saved_for_relink
+
+# Do we need the "lib" prefix for modules?
+need_lib_prefix=$need_lib_prefix
+
+# Do we need a version for libraries?
+need_version=$need_version
+
+# Library versioning type.
+version_type=$version_type
+
+# Shared library runtime path variable.
+runpath_var=$runpath_var
+
+# Shared library path variable.
+shlibpath_var=$shlibpath_var
+
+# Is shlibpath searched before the hard-coded library search path?
+shlibpath_overrides_runpath=$shlibpath_overrides_runpath
+
+# Format of library name prefix.
+libname_spec=$lt_libname_spec
+
+# List of archive names.  First name is the real one, the rest are links.
+# The last name is the one that the linker finds with -lNAME
+library_names_spec=$lt_library_names_spec
+
+# The coded name of the library, if different from the real name.
+soname_spec=$lt_soname_spec
+
+# Permission mode override for installation of shared libraries.
+install_override_mode=$lt_install_override_mode
+
+# Command to use after installation of a shared archive.
+postinstall_cmds=$lt_postinstall_cmds
+
+# Command to use after uninstallation of a shared archive.
+postuninstall_cmds=$lt_postuninstall_cmds
+
+# Commands used to finish a libtool library installation in a directory.
+finish_cmds=$lt_finish_cmds
+
+# As "finish_cmds", except a single script fragment to be evaled but
+# not shown.
+finish_eval=$lt_finish_eval
+
+# Whether we should hardcode library paths into libraries.
+hardcode_into_libs=$hardcode_into_libs
+
+# Compile-time system search path for libraries.
+sys_lib_search_path_spec=$lt_sys_lib_search_path_spec
+
+# Run-time system search path for libraries.
+sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec
+
+# Whether dlopen is supported.
+dlopen_support=$enable_dlopen
+
+# Whether dlopen of programs is supported.
+dlopen_self=$enable_dlopen_self
+
+# Whether dlopen of statically linked programs is supported.
+dlopen_self_static=$enable_dlopen_self_static
+
+# Commands to strip libraries.
+old_striplib=$lt_old_striplib
+striplib=$lt_striplib
+
+
+# The linker used to build libraries.
+LD=$lt_LD
+
+# How to create reloadable object files.
+reload_flag=$lt_reload_flag
+reload_cmds=$lt_reload_cmds
+
+# Commands used to build an old-style archive.
+old_archive_cmds=$lt_old_archive_cmds
+
+# A language specific compiler.
+CC=$lt_compiler
+
+# Is the compiler the GNU compiler?
+with_gcc=$GCC
+
+# Compiler flag to turn off builtin functions.
+no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag
+
+# How to pass a linker flag through the compiler.
+wl=$lt_lt_prog_compiler_wl
+
+# Additional compiler flags for building library objects.
+pic_flag=$lt_lt_prog_compiler_pic
+
+# Compiler flag to prevent dynamic linking.
+link_static_flag=$lt_lt_prog_compiler_static
+
+# Does compiler simultaneously support -c and -o options?
+compiler_c_o=$lt_lt_cv_prog_compiler_c_o
+
+# Whether or not to add -lc for building shared libraries.
+build_libtool_need_lc=$archive_cmds_need_lc
+
+# Whether or not to disallow shared libs when runtime libs are static.
+allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes
+
+# Compiler flag to allow reflexive dlopens.
+export_dynamic_flag_spec=$lt_export_dynamic_flag_spec
+
+# Compiler flag to generate shared objects directly from archives.
+whole_archive_flag_spec=$lt_whole_archive_flag_spec
+
+# Whether the compiler copes with passing no objects directly.
+compiler_needs_object=$lt_compiler_needs_object
+
+# Create an old-style archive from a shared archive.
+old_archive_from_new_cmds=$lt_old_archive_from_new_cmds
+
+# Create a temporary old-style archive to link instead of a shared archive.
+old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds
+
+# Commands used to build a shared archive.
+archive_cmds=$lt_archive_cmds
+archive_expsym_cmds=$lt_archive_expsym_cmds
+
+# Commands used to build a loadable module if different from building
+# a shared archive.
+module_cmds=$lt_module_cmds
+module_expsym_cmds=$lt_module_expsym_cmds
+
+# Whether we are building with GNU ld or not.
+with_gnu_ld=$lt_with_gnu_ld
+
+# Flag that allows shared libraries with undefined symbols to be built.
+allow_undefined_flag=$lt_allow_undefined_flag
+
+# Flag that enforces no undefined symbols.
+no_undefined_flag=$lt_no_undefined_flag
+
+# Flag to hardcode \$libdir into a binary during linking.
+# This must work even if \$libdir does not exist
+hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec
+
+# If ld is used when linking, flag to hardcode \$libdir into a binary
+# during linking.  This must work even if \$libdir does not exist.
+hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld
+
+# Whether we need a single "-rpath" flag with a separated argument.
+hardcode_libdir_separator=$lt_hardcode_libdir_separator
+
+# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes
+# DIR into the resulting binary.
+hardcode_direct=$hardcode_direct
+
+# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes
+# DIR into the resulting binary and the resulting library dependency is
+# "absolute",i.e impossible to change by setting \${shlibpath_var} if the
+# library is relocated.
+hardcode_direct_absolute=$hardcode_direct_absolute
+
+# Set to "yes" if using the -LDIR flag during linking hardcodes DIR
+# into the resulting binary.
+hardcode_minus_L=$hardcode_minus_L
+
+# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR
+# into the resulting binary.
+hardcode_shlibpath_var=$hardcode_shlibpath_var
+
+# Set to "yes" if building a shared library automatically hardcodes DIR
+# into the library and all subsequent libraries and executables linked
+# against it.
+hardcode_automatic=$hardcode_automatic
+
+# Set to yes if linker adds runtime paths of dependent libraries
+# to runtime path list.
+inherit_rpath=$inherit_rpath
+
+# Whether libtool must link a program against all its dependency libraries.
+link_all_deplibs=$link_all_deplibs
+
+# Fix the shell variable \$srcfile for the compiler.
+fix_srcfile_path=$lt_fix_srcfile_path
+
+# Set to "yes" if exported symbols are required.
+always_export_symbols=$always_export_symbols
+
+# The commands to list exported symbols.
+export_symbols_cmds=$lt_export_symbols_cmds
+
+# Symbols that should not be listed in the preloaded symbols.
+exclude_expsyms=$lt_exclude_expsyms
+
+# Symbols that must always be exported.
+include_expsyms=$lt_include_expsyms
+
+# Commands necessary for linking programs (against libraries) with templates.
+prelink_cmds=$lt_prelink_cmds
+
+# Specify filename containing input files.
+file_list_spec=$lt_file_list_spec
+
+# How to hardcode a shared library path into an executable.
+hardcode_action=$hardcode_action
+
+# The directories searched by this compiler when creating a shared library.
+compiler_lib_search_dirs=$lt_compiler_lib_search_dirs
+
+# Dependencies to place before and after the objects being linked to
+# create a shared library.
+predep_objects=$lt_predep_objects
+postdep_objects=$lt_postdep_objects
+predeps=$lt_predeps
+postdeps=$lt_postdeps
+
+# The library search path used internally by the compiler when linking
+# a shared library.
+compiler_lib_search_path=$lt_compiler_lib_search_path
+
+# ### END LIBTOOL CONFIG
+
+_LT_EOF
+
+  case $host_os in
+  aix3*)
+    cat <<\_LT_EOF >> "$cfgfile"
+# AIX sometimes has problems with the GCC collect2 program.  For some
+# reason, if we set the COLLECT_NAMES environment variable, the problems
+# vanish in a puff of smoke.
+if test "X${COLLECT_NAMES+set}" != Xset; then
+  COLLECT_NAMES=
+  export COLLECT_NAMES
+fi
+_LT_EOF
+    ;;
+  esac
+
+
+ltmain="$ac_aux_dir/ltmain.sh"
+
+
+  # We use sed instead of cat because bash on DJGPP gets confused if
+  # if finds mixed CR/LF and LF-only lines.  Since sed operates in
+  # text mode, it properly converts lines to CR/LF.  This bash problem
+  # is reportedly fixed, but why not run on old versions too?
+  sed '/^# Generated shell functions inserted here/q' "$ltmain" >> "$cfgfile" \
+    || (rm -f "$cfgfile"; exit 1)
+
+  case $xsi_shell in
+  yes)
+    cat << \_LT_EOF >> "$cfgfile"
+
+# func_dirname file append nondir_replacement
+# Compute the dirname of FILE.  If nonempty, add APPEND to the result,
+# otherwise set result to NONDIR_REPLACEMENT.
+func_dirname ()
+{
+  case ${1} in
+    */*) func_dirname_result="${1%/*}${2}" ;;
+    *  ) func_dirname_result="${3}" ;;
+  esac
+}
+
+# func_basename file
+func_basename ()
+{
+  func_basename_result="${1##*/}"
+}
+
+# func_dirname_and_basename file append nondir_replacement
+# perform func_basename and func_dirname in a single function
+# call:
+#   dirname:  Compute the dirname of FILE.  If nonempty,
+#             add APPEND to the result, otherwise set result
+#             to NONDIR_REPLACEMENT.
+#             value returned in "$func_dirname_result"
+#   basename: Compute filename of FILE.
+#             value retuned in "$func_basename_result"
+# Implementation must be kept synchronized with func_dirname
+# and func_basename. For efficiency, we do not delegate to
+# those functions but instead duplicate the functionality here.
+func_dirname_and_basename ()
+{
+  case ${1} in
+    */*) func_dirname_result="${1%/*}${2}" ;;
+    *  ) func_dirname_result="${3}" ;;
+  esac
+  func_basename_result="${1##*/}"
+}
+
+# func_stripname prefix suffix name
+# strip PREFIX and SUFFIX off of NAME.
+# PREFIX and SUFFIX must not contain globbing or regex special
+# characters, hashes, percent signs, but SUFFIX may contain a leading
+# dot (in which case that matches only a dot).
+func_stripname ()
+{
+  # pdksh 5.2.14 does not do ${X%$Y} correctly if both X and Y are
+  # positional parameters, so assign one to ordinary parameter first.
+  func_stripname_result=${3}
+  func_stripname_result=${func_stripname_result#"${1}"}
+  func_stripname_result=${func_stripname_result%"${2}"}
+}
+
+# func_opt_split
+func_opt_split ()
+{
+  func_opt_split_opt=${1%%=*}
+  func_opt_split_arg=${1#*=}
+}
+
+# func_lo2o object
+func_lo2o ()
+{
+  case ${1} in
+    *.lo) func_lo2o_result=${1%.lo}.${objext} ;;
+    *)    func_lo2o_result=${1} ;;
+  esac
+}
+
+# func_xform libobj-or-source
+func_xform ()
+{
+  func_xform_result=${1%.*}.lo
+}
+
+# func_arith arithmetic-term...
+func_arith ()
+{
+  func_arith_result=$(( $* ))
+}
+
+# func_len string
+# STRING may not start with a hyphen.
+func_len ()
+{
+  func_len_result=${#1}
+}
+
+_LT_EOF
+    ;;
+  *) # Bourne compatible functions.
+    cat << \_LT_EOF >> "$cfgfile"
+
+# func_dirname file append nondir_replacement
+# Compute the dirname of FILE.  If nonempty, add APPEND to the result,
+# otherwise set result to NONDIR_REPLACEMENT.
+func_dirname ()
+{
+  # Extract subdirectory from the argument.
+  func_dirname_result=`$ECHO "${1}" | $SED "$dirname"`
+  if test "X$func_dirname_result" = "X${1}"; then
+    func_dirname_result="${3}"
+  else
+    func_dirname_result="$func_dirname_result${2}"
+  fi
+}
+
+# func_basename file
+func_basename ()
+{
+  func_basename_result=`$ECHO "${1}" | $SED "$basename"`
+}
+
+
+# func_stripname prefix suffix name
+# strip PREFIX and SUFFIX off of NAME.
+# PREFIX and SUFFIX must not contain globbing or regex special
+# characters, hashes, percent signs, but SUFFIX may contain a leading
+# dot (in which case that matches only a dot).
+# func_strip_suffix prefix name
+func_stripname ()
+{
+  case ${2} in
+    .*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%\\\\${2}\$%%"`;;
+    *)  func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%${2}\$%%"`;;
+  esac
+}
+
+# sed scripts:
+my_sed_long_opt='1s/^\(-[^=]*\)=.*/\1/;q'
+my_sed_long_arg='1s/^-[^=]*=//'
+
+# func_opt_split
+func_opt_split ()
+{
+  func_opt_split_opt=`$ECHO "${1}" | $SED "$my_sed_long_opt"`
+  func_opt_split_arg=`$ECHO "${1}" | $SED "$my_sed_long_arg"`
+}
+
+# func_lo2o object
+func_lo2o ()
+{
+  func_lo2o_result=`$ECHO "${1}" | $SED "$lo2o"`
+}
+
+# func_xform libobj-or-source
+func_xform ()
+{
+  func_xform_result=`$ECHO "${1}" | $SED 's/\.[^.]*$/.lo/'`
+}
+
+# func_arith arithmetic-term...
+func_arith ()
+{
+  func_arith_result=`expr "$@"`
+}
+
+# func_len string
+# STRING may not start with a hyphen.
+func_len ()
+{
+  func_len_result=`expr "$1" : ".*" 2>/dev/null || echo $max_cmd_len`
+}
+
+_LT_EOF
+esac
+
+case $lt_shell_append in
+  yes)
+    cat << \_LT_EOF >> "$cfgfile"
+
+# func_append var value
+# Append VALUE to the end of shell variable VAR.
+func_append ()
+{
+  eval "$1+=\$2"
+}
+_LT_EOF
+    ;;
+  *)
+    cat << \_LT_EOF >> "$cfgfile"
+
+# func_append var value
+# Append VALUE to the end of shell variable VAR.
+func_append ()
+{
+  eval "$1=\$$1\$2"
+}
+
+_LT_EOF
+    ;;
+  esac
+
+
+  sed -n '/^# Generated shell functions inserted here/,$p' "$ltmain" >> "$cfgfile" \
+    || (rm -f "$cfgfile"; exit 1)
+
+  mv -f "$cfgfile" "$ofile" ||
+    (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile")
+  chmod +x "$ofile"
+
+
+    cat <<_LT_EOF >> "$ofile"
+
+# ### BEGIN LIBTOOL TAG CONFIG: CXX
+
+# The linker used to build libraries.
+LD=$lt_LD_CXX
+
+# How to create reloadable object files.
+reload_flag=$lt_reload_flag_CXX
+reload_cmds=$lt_reload_cmds_CXX
+
+# Commands used to build an old-style archive.
+old_archive_cmds=$lt_old_archive_cmds_CXX
+
+# A language specific compiler.
+CC=$lt_compiler_CXX
+
+# Is the compiler the GNU compiler?
+with_gcc=$GCC_CXX
+
+# Compiler flag to turn off builtin functions.
+no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_CXX
+
+# How to pass a linker flag through the compiler.
+wl=$lt_lt_prog_compiler_wl_CXX
+
+# Additional compiler flags for building library objects.
+pic_flag=$lt_lt_prog_compiler_pic_CXX
+
+# Compiler flag to prevent dynamic linking.
+link_static_flag=$lt_lt_prog_compiler_static_CXX
+
+# Does compiler simultaneously support -c and -o options?
+compiler_c_o=$lt_lt_cv_prog_compiler_c_o_CXX
+
+# Whether or not to add -lc for building shared libraries.
+build_libtool_need_lc=$archive_cmds_need_lc_CXX
+
+# Whether or not to disallow shared libs when runtime libs are static.
+allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_CXX
+
+# Compiler flag to allow reflexive dlopens.
+export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_CXX
+
+# Compiler flag to generate shared objects directly from archives.
+whole_archive_flag_spec=$lt_whole_archive_flag_spec_CXX
+
+# Whether the compiler copes with passing no objects directly.
+compiler_needs_object=$lt_compiler_needs_object_CXX
+
+# Create an old-style archive from a shared archive.
+old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_CXX
+
+# Create a temporary old-style archive to link instead of a shared archive.
+old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_CXX
+
+# Commands used to build a shared archive.
+archive_cmds=$lt_archive_cmds_CXX
+archive_expsym_cmds=$lt_archive_expsym_cmds_CXX
+
+# Commands used to build a loadable module if different from building
+# a shared archive.
+module_cmds=$lt_module_cmds_CXX
+module_expsym_cmds=$lt_module_expsym_cmds_CXX
+
+# Whether we are building with GNU ld or not.
+with_gnu_ld=$lt_with_gnu_ld_CXX
+
+# Flag that allows shared libraries with undefined symbols to be built.
+allow_undefined_flag=$lt_allow_undefined_flag_CXX
+
+# Flag that enforces no undefined symbols.
+no_undefined_flag=$lt_no_undefined_flag_CXX
+
+# Flag to hardcode \$libdir into a binary during linking.
+# This must work even if \$libdir does not exist
+hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_CXX
+
+# If ld is used when linking, flag to hardcode \$libdir into a binary
+# during linking.  This must work even if \$libdir does not exist.
+hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld_CXX
+
+# Whether we need a single "-rpath" flag with a separated argument.
+hardcode_libdir_separator=$lt_hardcode_libdir_separator_CXX
+
+# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes
+# DIR into the resulting binary.
+hardcode_direct=$hardcode_direct_CXX
+
+# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes
+# DIR into the resulting binary and the resulting library dependency is
+# "absolute",i.e impossible to change by setting \${shlibpath_var} if the
+# library is relocated.
+hardcode_direct_absolute=$hardcode_direct_absolute_CXX
+
+# Set to "yes" if using the -LDIR flag during linking hardcodes DIR
+# into the resulting binary.
+hardcode_minus_L=$hardcode_minus_L_CXX
+
+# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR
+# into the resulting binary.
+hardcode_shlibpath_var=$hardcode_shlibpath_var_CXX
+
+# Set to "yes" if building a shared library automatically hardcodes DIR
+# into the library and all subsequent libraries and executables linked
+# against it.
+hardcode_automatic=$hardcode_automatic_CXX
+
+# Set to yes if linker adds runtime paths of dependent libraries
+# to runtime path list.
+inherit_rpath=$inherit_rpath_CXX
+
+# Whether libtool must link a program against all its dependency libraries.
+link_all_deplibs=$link_all_deplibs_CXX
+
+# Fix the shell variable \$srcfile for the compiler.
+fix_srcfile_path=$lt_fix_srcfile_path_CXX
+
+# Set to "yes" if exported symbols are required.
+always_export_symbols=$always_export_symbols_CXX
+
+# The commands to list exported symbols.
+export_symbols_cmds=$lt_export_symbols_cmds_CXX
+
+# Symbols that should not be listed in the preloaded symbols.
+exclude_expsyms=$lt_exclude_expsyms_CXX
+
+# Symbols that must always be exported.
+include_expsyms=$lt_include_expsyms_CXX
+
+# Commands necessary for linking programs (against libraries) with templates.
+prelink_cmds=$lt_prelink_cmds_CXX
+
+# Specify filename containing input files.
+file_list_spec=$lt_file_list_spec_CXX
+
+# How to hardcode a shared library path into an executable.
+hardcode_action=$hardcode_action_CXX
+
+# The directories searched by this compiler when creating a shared library.
+compiler_lib_search_dirs=$lt_compiler_lib_search_dirs_CXX
+
+# Dependencies to place before and after the objects being linked to
+# create a shared library.
+predep_objects=$lt_predep_objects_CXX
+postdep_objects=$lt_postdep_objects_CXX
+predeps=$lt_predeps_CXX
+postdeps=$lt_postdeps_CXX
+
+# The library search path used internally by the compiler when linking
+# a shared library.
+compiler_lib_search_path=$lt_compiler_lib_search_path_CXX
+
+# ### END LIBTOOL TAG CONFIG: CXX
+_LT_EOF
+
+ ;;
+
+  esac
+done # for ac_tag
+
+
+as_fn_exit 0
+_ACEOF
+ac_clean_files=$ac_clean_files_save
+
+test $ac_write_fail = 0 ||
+  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded.  So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status.  When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+  ac_cs_success=:
+  ac_config_status_args=
+  test "$silent" = yes &&
+    ac_config_status_args="$ac_config_status_args --quiet"
+  exec 5>/dev/null
+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+  exec 5>>config.log
+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+  # would make configure fail if this is the last instruction.
+  $ac_cs_success || as_fn_exit 1
+fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
+fi
+
diff --git a/libgm2/configure.ac b/libgm2/configure.ac
new file mode 100644
index 00000000000..8f069adb29e
--- /dev/null
+++ b/libgm2/configure.ac
@@ -0,0 +1,376 @@
+# Configure script for libgm2.
+# Copyright (C) 2013-2022 Free Software Foundation, Inc.
+
+# This file is part of GCC.
+
+# GCC 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.
+
+# GCC 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 GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+
+# Process this file with autoreconf to produce a configure script.
+
+AC_INIT(package-unused, version-unused,,libgm2)
+AC_CONFIG_SRCDIR(Makefile.am)
+# AC_CONFIG_MACRO_DIR([config])
+AC_CONFIG_HEADER(config.h)
+
+libtool_VERSION=17:0:0
+AC_SUBST(libtool_VERSION)
+
+AM_ENABLE_MULTILIB(, ..)
+
+GCC_NO_EXECUTABLES
+
+AC_USE_SYSTEM_EXTENSIONS
+
+# Do not delete or change the following two lines.  For why, see
+# http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html
+AC_CANONICAL_SYSTEM
+target_alias=${target_alias-$host_alias}
+AC_SUBST(target_alias)
+
+AM_INIT_AUTOMAKE([1.9.3 no-define foreign no-dist -Wall -Wno-portability])
+
+AH_TEMPLATE(PACKAGE, [Name of package])
+AH_TEMPLATE(VERSION, [Version number of package])
+
+AC_ARG_WITH(cross-host,
+[  --with-cross-host=HOST           Configuring with a cross compiler])
+
+# Checks for header files.
+AC_HEADER_STDC
+AC_HEADER_SYS_WAIT
+AC_CHECK_HEADER([math.h],
+	       [AC_DEFINE([HAVE_MATH_H], [1], [have math.h])])
+
+AC_CHECK_HEADERS(limits.h stddef.h string.h strings.h stdlib.h \
+                 time.h \
+		 fcntl.h unistd.h sys/file.h sys/time.h sys/mman.h \
+		 sys/resource.h sys/param.h sys/times.h sys/stat.h \
+                 sys/socket.h \
+                 sys/wait.h sys/ioctl.h errno.h sys/errno.h \
+		 pwd.h direct.h dirent.h signal.h malloc.h langinfo.h \
+                 pthread.h stdarg.h stdio.h sys/types.h termios.h \
+                 netinet/in.h netdb.h sys/uio.h sys/stat.h wchar.h)
+
+
+AC_CANONICAL_HOST
+ACX_NONCANONICAL_HOST
+ACX_NONCANONICAL_TARGET
+GCC_TOPLEV_SUBDIRS
+
+AC_MSG_CHECKING([for --enable-version-specific-runtime-libs])
+AC_ARG_ENABLE(version-specific-runtime-libs,
+[  --enable-version-specific-runtime-libs    Specify that runtime libraries should be installed in a compiler-specific directory ],
+[case "$enableval" in
+ yes) version_specific_libs=yes ;;
+ no)  version_specific_libs=no ;;
+ *)   AC_MSG_ERROR([Unknown argument to enable/disable version-specific libs]);;
+ esac],
+[version_specific_libs=no])
+AC_MSG_RESULT($version_specific_libs)
+
+AC_ARG_WITH(slibdir,
+[  --with-slibdir=DIR      shared libraries in DIR [LIBDIR]],
+slibdir="$with_slibdir",
+if test "${version_specific_libs}" = yes; then
+  slibdir='$(libsubdir)'
+elif test -n "$with_cross_host" && test x"$with_cross_host" != x"no"; then
+  slibdir='$(exec_prefix)/$(host_noncanonical)/lib'
+else
+  slibdir='$(libdir)'
+fi)
+AC_SUBST(slibdir)
+
+# Command-line options.
+# Very limited version of AC_MAINTAINER_MODE.
+AC_ARG_ENABLE([maintainer-mode],
+  [AC_HELP_STRING([--enable-maintainer-mode],
+                 [enable make rules and dependencies not useful (and
+                  sometimes confusing) to the casual installer])],
+  [case ${enable_maintainer_mode} in
+     yes) MAINT='' ;;
+     no) MAINT='#' ;;
+     *) AC_MSG_ERROR([--enable-maintainer-mode must be yes or no]) ;;
+   esac
+   maintainer_mode=${enableval}],
+  [MAINT='#'])
+AC_SUBST([MAINT])dnl
+
+toolexecdir=no
+toolexeclibdir=no
+
+# Calculate toolexeclibdir
+# Also toolexecdir, though it's only used in toolexeclibdir
+case ${version_specific_libs} in
+  yes)
+    # Need the gcc compiler version to know where to install libraries
+    # and header files if --enable-version-specific-runtime-libs option
+    # is selected.
+    toolexecdir='$(libdir)/gcc/$(target_noncanonical)'
+    toolexeclibdir='$(toolexecdir)/$(gcc_version)$(MULTISUBDIR)'
+    ;;
+  no)
+    if test -n "$with_cross_host" &&
+       test x"$with_cross_host" != x"no"; then
+      # Install a library built with a cross compiler in tooldir, not libdir.
+      toolexecdir='$(exec_prefix)/$(target_noncanonical)'
+      toolexeclibdir='$(toolexecdir)/lib'
+    else
+      toolexecdir='$(libdir)/gcc-lib/$(target_noncanonical)'
+      toolexeclibdir='$(libdir)'
+    fi
+    multi_os_directory=`$CC -print-multi-os-directory`
+    case $multi_os_directory in
+      .) ;; # Avoid trailing /.
+      *) toolexeclibdir=$toolexeclibdir/$multi_os_directory ;;
+    esac
+    ;;
+esac
+
+AC_SUBST(toolexecdir)
+AC_SUBST(toolexeclibdir)
+
+AH_TEMPLATE(PACKAGE, [Name of package])
+AH_TEMPLATE(VERSION, [Version number of package])
+
+AM_MAINTAINER_MODE
+
+# Check the compiler.
+# The same as in boehm-gc and libstdc++. Have to borrow it from there.
+# We must force CC to /not/ be precious variables; otherwise
+# the wrong, non-multilib-adjusted value will be used in multilibs.
+# As a side effect, we have to subst CFLAGS ourselves.
+
+m4_rename([_AC_ARG_VAR_PRECIOUS],[real_PRECIOUS])
+m4_define([_AC_ARG_VAR_PRECIOUS],[])
+AC_PROG_CC
+AC_PROG_CXX
+AM_PROG_AS
+m4_rename_force([real_PRECIOUS],[_AC_ARG_VAR_PRECIOUS])
+
+AC_SUBST(CFLAGS)
+
+# In order to override CFLAGS_FOR_TARGET, all of our special flags go
+# in XCFLAGS.  But we need them in CFLAGS during configury.  So put them
+# in both places for now and restore CFLAGS at the end of config.
+save_CFLAGS="$CFLAGS"
+
+# Find other programs we need.
+AC_CHECK_TOOL(AR, ar)
+AC_CHECK_TOOL(NM, nm)
+AC_CHECK_TOOL(RANLIB, ranlib, ranlib-not-found-in-path-error)
+AC_PATH_PROG(PERL, perl, perl-not-found-in-path-error)
+AC_PROG_MAKE_SET
+AC_PROG_INSTALL
+
+LT_INIT
+AC_LIBTOOL_DLOPEN
+# AM_PROG_LIBTOOL
+AC_SUBST(enable_shared)
+AC_SUBST(enable_static)
+
+AC_CHECK_TYPES([struct timezone, struct stat, struct timeval])
+
+AC_LANG_C
+# Check the compiler.
+# The same as in boehm-gc and libstdc++. Have to borrow it from there.
+# We must force CC to /not/ be precious variables; otherwise
+# the wrong, non-multilib-adjusted value will be used in multilibs.
+# As a side effect, we have to subst CFLAGS ourselves.
+
+m4_rename([_AC_ARG_VAR_PRECIOUS],[real_PRECIOUS])
+m4_define([_AC_ARG_VAR_PRECIOUS],[])
+AC_PROG_CC
+m4_rename_force([real_PRECIOUS],[_AC_ARG_VAR_PRECIOUS])
+
+AC_SUBST(CFLAGS)
+
+AC_DEFUN([GM2_UNDEF],[
+  $as_echo "#undef HAVE_$1" >>confdefs.h
+])
+
+AC_DEFUN([GM2_CHECK_LIB],[
+  AC_MSG_CHECKING([m2 front end checking $1 library for $2])
+  if test x$gcc_no_link != xyes; then
+    AC_CHECK_LIB([$1],[$2],[AC_DEFINE([HAVE_$3],[1],[found $2])],[GM2_UNDEF([$3],[$2])])
+  else
+    if test "x$[ac_cv_lib_$1_$2]" = xyes; then
+      AC_DEFINE([HAVE_$3],[1],[lib$1 includes $2])
+    elif test "x$[ac_cv_func_$2]" = xyes; then
+      AC_DEFINE([HAVE_$3],[1],[function $2 exists])
+    else
+      GM2_UNDEF([$3],[$2])
+    fi
+  fi
+])
+
+GM2_CHECK_LIB([c],[access],[ACCESS])
+GM2_CHECK_LIB([c],[brk],[BRK])
+GM2_CHECK_LIB([c],[cfmakeraw],[CFMAKERAW])
+GM2_CHECK_LIB([c],[close],[CLOSE])
+GM2_CHECK_LIB([c],[ctime],[CTIME])
+GM2_CHECK_LIB([c],[creat],[CREAT])
+GM2_CHECK_LIB([c],[dup],[DUP])
+GM2_CHECK_LIB([c],[execve],[EXECVE])
+GM2_CHECK_LIB([c],[exit],[EXIT])
+GM2_CHECK_LIB([c],[fcntl],[FCNTL])
+GM2_CHECK_LIB([c],[fstat],[FSTAT])
+GM2_CHECK_LIB([c],[getdents],[GETDENTS])
+GM2_CHECK_LIB([c],[getgid],[GETGID])
+GM2_CHECK_LIB([c],[getpid],[GETPID])
+GM2_CHECK_LIB([c],[gettimeofday],[GETTIMEOFD])
+GM2_CHECK_LIB([c],[getuid],[GETUID])
+GM2_CHECK_LIB([c],[ioctl],[IOCTL])
+GM2_CHECK_LIB([c],[kill],[KILL])
+GM2_CHECK_LIB([c],[link],[LINK])
+GM2_CHECK_LIB([c],[lseek],[LSEEK])
+GM2_CHECK_LIB([c],[open],[OPEN])
+GM2_CHECK_LIB([c],[pause],[PAUSE])
+GM2_CHECK_LIB([c],[pipe],[PIPE])
+GM2_CHECK_LIB([c],[rand],[RAND])
+GM2_CHECK_LIB([c],[read],[READ])
+GM2_CHECK_LIB([c],[select],[SELECT])
+GM2_CHECK_LIB([c],[setitimer],[SETITIMER])
+GM2_CHECK_LIB([c],[setgid],[SETGID])
+GM2_CHECK_LIB([c],[setuid],[SETUID])
+GM2_CHECK_LIB([c],[stat],[STAT])
+GM2_CHECK_LIB([c],[strsignal],[STRSIGNAL])
+GM2_CHECK_LIB([c],[strtod],[STRTOD])
+GM2_CHECK_LIB([c],[strtold],[STRTOLD])
+GM2_CHECK_LIB([c],[times],[TIMES])
+GM2_CHECK_LIB([c],[unlink],[UNLINK])
+GM2_CHECK_LIB([c],[wait],[WAIT])
+GM2_CHECK_LIB([c],[write],[WRITE])
+
+GM2_CHECK_LIB([m],[signbit],[SIGNBIT])
+GM2_CHECK_LIB([m],[signbitf],[SIGNBITF])
+GM2_CHECK_LIB([m],[signbitl],[SIGNBITL])
+
+AC_MSG_NOTICE([libgm2 has finished checking target libc and libm contents.])
+
+# We test the host here and later on check the target.
+
+# All known M2_HOST_OS values.  This is the union of all host operating systems
+# supported by gm2.
+
+M2_SUPPORTED_HOST_OS="aix freebsd hurd linux netbsd openbsd solaris windows"
+
+M2_HOST_OS=unknown
+
+case ${host} in
+  *-*-darwin*)   M2_HOST_OS=darwin ;;
+  *-*-freebsd*)  M2_HOST_OS=freebsd ;;
+  *-*-linux*)    M2_HOST_OS=linux ;;
+  *-*-netbsd*)	 M2_HOST_OS=netbsd ;;
+  *-*-openbsd*)  M2_HOST_OS=openbsd ;;
+  *-*-solaris2*) M2_HOST_OS=solaris ;;
+  *-*-aix*)      M2_HOST_OS=aix ;;
+  *-*-gnu*)      M2_HOST_OS=hurd ;;
+esac
+
+# M2_HOST_OS=unknown
+if test x${M2_HOST_OS} = xunknown; then
+   AC_MSG_NOTICE([unsupported host, will build a minimal m2 library])
+   BUILD_PIMLIB=false
+   BUILD_ISOLIB=false
+   BUILD_CORLIB=false
+   BUILD_LOGLIB=false
+else
+   AC_MSG_NOTICE([m2 library will be built on ${M2_HOST_OS}])
+   BUILD_PIMLIB=true
+   BUILD_ISOLIB=true
+   BUILD_CORLIB=true
+   BUILD_LOGLIB=true
+fi
+
+CC_FOR_BUILD=${CC_FOR_BUILD:-gcc}
+AC_SUBST(CC_FOR_BUILD)
+
+# Propagate GM2_FOR_TARGET into Makefiles
+GM2_FOR_TARGET=${GM2_FOR_TARGET:-gcc}
+AC_SUBST(GM2_FOR_TARGET)
+
+# Now we check the target as long as it is a supported host.
+# For some embedded targets we choose minimal runtime system which is
+# just enough to satisfy the linker targetting raw metal.
+if test x${M2_HOST_OS} != xunknown; then
+AC_MSG_NOTICE([m2 library building for target ${target}])
+case "$target" in
+
+  avr25*-*-* | avr31*-*-* | avr35*-*-* | avr4*-*-* | avr5*-*-* | avr51*-*-* | avr6*-*-*)
+  BUILD_PIMLIB=false
+  BUILD_ISOLIB=false
+  BUILD_CORLIB=false
+  BUILD_LOGLIB=false
+  ;;
+
+  avrxmega2*-*-* | avrxmega4*-*-* | avrxmega5*-*-* | avrxmega6*-*-* | avrxmega7*-*-*)
+  BUILD_PIMLIB=false
+  BUILD_ISOLIB=false
+  BUILD_CORLIB=false
+  BUILD_LOGLIB=false
+  ;;
+
+  avr3-*-*)
+  BUILD_PIMLIB=true
+  BUILD_ISOLIB=true
+  BUILD_CORLIB=true
+  BUILD_LOGLIB=true
+  ;;
+  esp32-*-*)
+  BUILD_PIMLIB=false
+  BUILD_ISOLIB=false
+  BUILD_CORLIB=false
+  BUILD_LOGLIB=false
+  ;;
+
+esac
+fi
+
+# GM2_MSG_RESULT issue a query message from the first parameter and a boolean result
+# in the second parameter is printed as a "yes" or "no".
+
+AC_DEFUN([GM2_MSG_RESULT],[
+   AC_MSG_CHECKING([$1])
+   if test x${$2} = xtrue; then
+      AC_MSG_RESULT([yes])
+   else
+      AC_MSG_RESULT([no])
+   fi
+])
+
+if test x${M2_HOST_OS} = xunknown; then
+   AC_MSG_NOTICE([m2 front end will only build minimal Modula-2 runtime library on this host])
+else
+   GM2_MSG_RESULT([m2 front end will build PIM libraries:],[BUILD_PIMLIB])
+   GM2_MSG_RESULT([m2 front end will build ISO libraries:],[BUILD_ISOLIB])
+   GM2_MSG_RESULT([m2 front end will build coroutine libraries:],[BUILD_CORLIB])
+   GM2_MSG_RESULT([m2 front end will build Logitech compatability libraries:],[BUILD_LOGLIB])
+fi
+
+AM_CONDITIONAL([BUILD_PIMLIB], [test x$BUILD_PIMLIB = xtrue])
+AM_CONDITIONAL([BUILD_ISOLIB], [test x$BUILD_ISOLIB = xtrue])
+AM_CONDITIONAL([BUILD_CORLIB], [test x$BUILD_CORLIB = xtrue])
+AM_CONDITIONAL([BUILD_LOGLIB], [test x$BUILD_LOGLIB = xtrue])
+
+AC_CONFIG_SRCDIR([Makefile.am])
+AC_CONFIG_FILES([Makefile libm2min/Makefile libm2pim/Makefile libm2iso/Makefile
+                 libm2cor/Makefile libm2log/Makefile])
+
+AC_MSG_NOTICE([libgm2 has been configured.])
+
+AC_OUTPUT
diff --git a/libgm2/libm2cor/KeyBoardLEDs.cc b/libgm2/libm2cor/KeyBoardLEDs.cc
new file mode 100644
index 00000000000..b640df67adc
--- /dev/null
+++ b/libgm2/libm2cor/KeyBoardLEDs.cc
@@ -0,0 +1,157 @@
+/* KeyBoardLEDs.c provide access to the keyboard LEDs.
+
+Copyright (C) 2005-2022 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 <m2rts.h>
+
+#if defined(linux)
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <linux/kd.h>
+#include <sys/ioctl.h>
+#include <stdio.h>
+
+#if !defined(TRUE)
+#   define TRUE (1==1)
+#endif
+#if !defined(FALSE)
+#   define FALSE (1==0)
+#endif
+
+#include <stdlib.h>
+
+static int fd;
+static int initialized = FALSE;
+
+
+extern "C" void
+KeyBoardLEDs_SwitchScroll (int scrolllock)
+{
+  unsigned char leds;
+  int r = ioctl (fd, KDGETLED, &leds);
+  if (scrolllock)
+    leds = leds | LED_SCR;
+  else
+    leds = leds & (~ LED_SCR);
+  r = ioctl (fd, KDSETLED, leds);
+}
+
+extern "C" void
+KeyBoardLEDs_SwitchNum (int numlock)
+{
+  unsigned char leds;
+  int r = ioctl (fd, KDGETLED, &leds);
+  if (numlock)
+    leds = leds | LED_NUM;
+  else
+    leds = leds & (~ LED_NUM);
+  r = ioctl (fd, KDSETLED, leds);
+}
+
+extern "C" void
+KeyBoardLEDs_SwitchCaps (int capslock)
+{
+  unsigned char leds;
+  int r = ioctl (fd, KDGETLED, &leds);
+  if (capslock)
+    leds = leds | LED_CAP;
+  else
+    leds = leds & (~ LED_CAP);
+  r = ioctl (fd, KDSETLED, leds);
+}
+
+extern "C" void
+KeyBoardLEDs_SwitchLeds (int numlock, int capslock, int scrolllock)
+{
+  KeyBoardLEDs_SwitchScroll (scrolllock);
+  KeyBoardLEDs_SwitchNum (numlock);
+  KeyBoardLEDs_SwitchCaps (capslock);
+}
+
+extern "C" void
+_M2_KeyBoardLEDs_init (int, char **, char **)
+{
+  if (! initialized)
+    {
+      initialized = TRUE;
+      fd = open ("/dev/tty", O_RDONLY);
+      if (fd == -1)
+	{
+	  perror ("unable to open /dev/tty");
+	  exit (1);
+	}
+    }
+}
+
+#else
+extern "C" void
+KeyBoardLEDs_SwitchLeds (int numlock, int capslock, int scrolllock)
+{
+}
+
+extern "C" void
+KeyBoardLEDs_SwitchScroll (int scrolllock)
+{
+}
+
+extern "C" void
+KeyBoardLEDs_SwitchNum (int numlock)
+{
+}
+
+extern "C" void
+KeyBoardLEDs_SwitchCaps (int capslock)
+{
+}
+
+extern "C" void
+_M2_KeyBoardLEDs_init (int, char **, char **)
+{
+}
+
+#endif
+
+/* GNU Modula-2 linking hooks.  */
+
+extern "C" void
+_M2_KeyBoardLEDs_finish (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_KeyBoardLEDs_dep (void)
+{
+}
+
+struct _M2_KeyBoardLEDs_ctor { _M2_KeyBoardLEDs_ctor (); } _M2_KeyBoardLEDs_ctor;
+
+_M2_KeyBoardLEDs_ctor::_M2_KeyBoardLEDs_ctor (void)
+{
+  M2RTS_RegisterModule ("KeyBoardLEDs", _M2_KeyBoardLEDs_init, _M2_KeyBoardLEDs_finish,
+			_M2_KeyBoardLEDs_dep);
+}
diff --git a/libgm2/libm2cor/Makefile.am b/libgm2/libm2cor/Makefile.am
new file mode 100644
index 00000000000..781955bffc8
--- /dev/null
+++ b/libgm2/libm2cor/Makefile.am
@@ -0,0 +1,156 @@
+# Makefile for libm2cor.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+SUFFIXES = .c .cc .mod .def .o .obj .lo .a .la
+
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-coroutines
+
+# Multilib support.
+MAKEOVERRIDES=
+
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+# Used to install the shared libgcc.
+slibdir = @slibdir@
+
+toolexeclibdir=@toolexeclibdir@
+toolexecdir=@toolexecdir@
+GM2_FOR_TARGET=@GM2_FOR_TARGET@
+
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+
+
+if BUILD_CORLIB
+M2DEFS = Debug.def  Executive.def \
+         KeyBoardLEDs.def  SYSTEM.def \
+         TimerHandler.def
+
+M2MODS = Debug.mod  Executive.mod \
+         SYSTEM.mod  TimerHandler.mod
+
+toolexeclib_LTLIBRARIES = libm2cor.la
+
+libm2cor_la_SOURCES = $(M2MODS) KeyBoardLEDs.cc
+
+nodist_EXTRA_libm2cor_la_SOURCES = dummy.c  ## forces automake to generate the LINK definition
+
+libm2cordir = libm2cor
+libm2cor_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2cor_la_SOURCES)))
+libm2cor_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../  -I@srcdir@/../libm2iso
+libm2cor_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-coroutines -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g
+libm2cor_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+BUILT_SOURCES = SYSTEM.def
+CLEANFILES = SYSTEM.def
+
+M2LIBDIR = /m2/m2cor/
+
+SYSTEM.def: Makefile
+	bash $(GM2_SRC)/tools-src/makeSystem -fpim \
+             $(GM2_SRC)/gm2-libs-coroutines/SYSTEM.def \
+             $(GM2_SRC)/gm2-libs-coroutines/SYSTEM.mod \
+             -I$(GM2_SRC)/gm2-libs-coroutines:$(GM2_SRC)/gm2-libs:$(GM2_SRC)/gm2-libs-iso \
+             "$(GM2_FOR_TARGET)" $@
+
+.mod.lo:
+	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2cor_la_M2FLAGS) $< -o $@
+
+.cc.lo:
+	$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2cor_la_CFLAGS) $< -o $@
+
+install-data-local: force
+	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	$(INSTALL_DATA) .libs/libm2cor.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.la
+	$(INSTALL_DATA) .libs/libm2cor.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.a
+	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.a
+	for i in $(M2DEFS) $(M2MODS) ; do \
+           if [ -f $$i ] ; then \
+              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-coroutines/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-coroutines/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+
+force:
+
+endif
diff --git a/libgm2/libm2cor/Makefile.in b/libgm2/libm2cor/Makefile.in
new file mode 100644
index 00000000000..6d921cd329d
--- /dev/null
+++ b/libgm2/libm2cor/Makefile.in
@@ -0,0 +1,826 @@
+# Makefile.in generated by automake 1.15.1 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994-2017 Free Software Foundation, Inc.
+
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+# Makefile for libm2cor.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+am__is_gnu_make = { \
+  if test -z '$(MAKELEVEL)'; then \
+    false; \
+  elif test -n '$(MAKE_HOST)'; then \
+    true; \
+  elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
+    true; \
+  else \
+    false; \
+  fi; \
+}
+am__make_running_with_option = \
+  case $${target_option-} in \
+      ?) ;; \
+      *) echo "am__make_running_with_option: internal error: invalid" \
+              "target option '$${target_option-}' specified" >&2; \
+         exit 1;; \
+  esac; \
+  has_opt=no; \
+  sane_makeflags=$$MAKEFLAGS; \
+  if $(am__is_gnu_make); then \
+    sane_makeflags=$$MFLAGS; \
+  else \
+    case $$MAKEFLAGS in \
+      *\\[\ \	]*) \
+        bs=\\; \
+        sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
+          | sed "s/$$bs$$bs[$$bs $$bs	]*//g"`;; \
+    esac; \
+  fi; \
+  skip_next=no; \
+  strip_trailopt () \
+  { \
+    flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
+  }; \
+  for flg in $$sane_makeflags; do \
+    test $$skip_next = yes && { skip_next=no; continue; }; \
+    case $$flg in \
+      *=*|--*) continue;; \
+        -*I) strip_trailopt 'I'; skip_next=yes;; \
+      -*I?*) strip_trailopt 'I';; \
+        -*O) strip_trailopt 'O'; skip_next=yes;; \
+      -*O?*) strip_trailopt 'O';; \
+        -*l) strip_trailopt 'l'; skip_next=yes;; \
+      -*l?*) strip_trailopt 'l';; \
+      -[dEDm]) skip_next=yes;; \
+      -[JT]) skip_next=yes;; \
+    esac; \
+    case $$flg in \
+      *$$target_option*) has_opt=yes; break;; \
+    esac; \
+  done; \
+  test $$has_opt = yes
+am__make_dryrun = (target_option=n; $(am__make_running_with_option))
+am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
+pkgdatadir = $(datadir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkglibexecdir = $(libexecdir)/@PACKAGE@
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = $(program_transform_name)
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+build_triplet = @build@
+host_triplet = @host@
+target_triplet = @target@
+subdir = libm2cor
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(top_srcdir)/../libtool.m4 \
+	$(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \
+	$(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \
+	$(top_srcdir)/../config/acx.m4 \
+	$(top_srcdir)/../config/depstand.m4 \
+	$(top_srcdir)/../config/lead-dot.m4 \
+	$(top_srcdir)/../config/multi.m4 \
+	$(top_srcdir)/../config/no-executables.m4 \
+	$(top_srcdir)/../config/override.m4 $(top_srcdir)/configure.ac
+am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
+	$(ACLOCAL_M4)
+DIST_COMMON = $(srcdir)/Makefile.am
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = $(top_builddir)/config.h
+CONFIG_CLEAN_FILES =
+CONFIG_CLEAN_VPATH_FILES =
+am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
+am__vpath_adj = case $$p in \
+    $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
+    *) f=$$p;; \
+  esac;
+am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
+am__install_max = 40
+am__nobase_strip_setup = \
+  srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
+am__nobase_strip = \
+  for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
+am__nobase_list = $(am__nobase_strip_setup); \
+  for p in $$list; do echo "$$p $$p"; done | \
+  sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
+  $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
+    if (++n[$$2] == $(am__install_max)) \
+      { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
+    END { for (dir in files) print dir, files[dir] }'
+am__base_list = \
+  sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
+  sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
+am__uninstall_files_from_dir = { \
+  test -z "$$files" \
+    || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
+    || { echo " ( cd '$$dir' && rm -f" $$files ")"; \
+         $(am__cd) "$$dir" && rm -f $$files; }; \
+  }
+am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
+LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
+libm2cor_la_LIBADD =
+@BUILD_CORLIB_TRUE@am__objects_1 = Debug.lo Executive.lo SYSTEM.lo \
+@BUILD_CORLIB_TRUE@	TimerHandler.lo
+@BUILD_CORLIB_TRUE@am_libm2cor_la_OBJECTS = $(am__objects_1) \
+@BUILD_CORLIB_TRUE@	KeyBoardLEDs.lo
+libm2cor_la_OBJECTS = $(am_libm2cor_la_OBJECTS)
+@BUILD_CORLIB_TRUE@am_libm2cor_la_rpath = -rpath $(toolexeclibdir)
+AM_V_P = $(am__v_P_@AM_V@)
+am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
+am__v_P_0 = false
+am__v_P_1 = :
+AM_V_GEN = $(am__v_GEN_@AM_V@)
+am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
+am__v_GEN_0 = @echo "  GEN     " $@;
+am__v_GEN_1 = 
+AM_V_at = $(am__v_at_@AM_V@)
+am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
+am__v_at_0 = @
+am__v_at_1 = 
+DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
+depcomp = $(SHELL) $(top_srcdir)/../depcomp
+am__depfiles_maybe = depfiles
+am__mv = mv -f
+AM_V_lt = $(am__v_lt_@AM_V@)
+am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
+am__v_lt_0 = --silent
+am__v_lt_1 = 
+COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
+	$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
+	$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	$(AM_CFLAGS) $(CFLAGS)
+AM_V_CC = $(am__v_CC_@AM_V@)
+am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
+am__v_CC_0 = @echo "  CC      " $@;
+am__v_CC_1 = 
+CCLD = $(CC)
+LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
+	$(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_CCLD = $(am__v_CCLD_@AM_V@)
+am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
+am__v_CCLD_0 = @echo "  CCLD    " $@;
+am__v_CCLD_1 = 
+CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
+	$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS)
+LTCXXCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) \
+	$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	$(AM_CXXFLAGS) $(CXXFLAGS)
+AM_V_CXX = $(am__v_CXX_@AM_V@)
+am__v_CXX_ = $(am__v_CXX_@AM_DEFAULT_V@)
+am__v_CXX_0 = @echo "  CXX     " $@;
+am__v_CXX_1 = 
+CXXLD = $(CXX)
+CXXLINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \
+	$(CXXFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_CXXLD = $(am__v_CXXLD_@AM_V@)
+am__v_CXXLD_ = $(am__v_CXXLD_@AM_DEFAULT_V@)
+am__v_CXXLD_0 = @echo "  CXXLD   " $@;
+am__v_CXXLD_1 = 
+SOURCES = $(libm2cor_la_SOURCES) $(nodist_EXTRA_libm2cor_la_SOURCES)
+am__can_run_installinfo = \
+  case $$AM_UPDATE_INFO_DIR in \
+    n|no|NO) false;; \
+    *) (install-info --version) >/dev/null 2>&1;; \
+  esac
+am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
+# Read a list of newline-separated strings from the standard input,
+# and print each of them once, without duplicates.  Input order is
+# *not* preserved.
+am__uniquify_input = $(AWK) '\
+  BEGIN { nonempty = 0; } \
+  { items[$$0] = 1; nonempty = 1; } \
+  END { if (nonempty) { for (i in items) print i; }; } \
+'
+# Make sure the list of sources is unique.  This is necessary because,
+# e.g., the same source file might be shared among _SOURCES variables
+# for different programs/libraries.
+am__define_uniq_tagged_files = \
+  list='$(am__tagged_files)'; \
+  unique=`for i in $$list; do \
+    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+  done | $(am__uniquify_input)`
+ETAGS = etags
+CTAGS = ctags
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-coroutines
+ACLOCAL = @ACLOCAL@
+AMTAR = @AMTAR@
+AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+AR = @AR@
+AUTOCONF = @AUTOCONF@
+AUTOHEADER = @AUTOHEADER@
+AUTOMAKE = @AUTOMAKE@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+CCASDEPMODE = @CCASDEPMODE@
+CCASFLAGS = @CCASFLAGS@
+CCDEPMODE = @CCDEPMODE@
+CC_FOR_BUILD = @CC_FOR_BUILD@
+CFLAGS = @CFLAGS@
+CPP = @CPP@
+CPPFLAGS = @CPPFLAGS@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+CXXDEPMODE = @CXXDEPMODE@
+CXXFLAGS = @CXXFLAGS@
+CYGPATH_W = @CYGPATH_W@
+DEFS = @DEFS@
+DEPDIR = @DEPDIR@
+DSYMUTIL = @DSYMUTIL@
+DUMPBIN = @DUMPBIN@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+EGREP = @EGREP@
+EXEEXT = @EXEEXT@
+FGREP = @FGREP@
+GM2_FOR_TARGET = @GM2_FOR_TARGET@
+GREP = @GREP@
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LD = @LD@
+LDFLAGS = @LDFLAGS@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LIBTOOL = @LIBTOOL@
+LIPO = @LIPO@
+LN_S = @LN_S@
+LTLIBOBJS = @LTLIBOBJS@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+MKDIR_P = @MKDIR_P@
+NM = @NM@
+NMEDIT = @NMEDIT@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+OTOOL = @OTOOL@
+OTOOL64 = @OTOOL64@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_URL = @PACKAGE_URL@
+PACKAGE_VERSION = @PACKAGE_VERSION@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+PERL = @PERL@
+RANLIB = @RANLIB@
+SED = @SED@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+STRIP = @STRIP@
+VERSION = @VERSION@
+abs_builddir = @abs_builddir@
+abs_srcdir = @abs_srcdir@
+abs_top_builddir = @abs_top_builddir@
+abs_top_srcdir = @abs_top_srcdir@
+ac_ct_CC = @ac_ct_CC@
+ac_ct_CXX = @ac_ct_CXX@
+ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
+am__include = @am__include@
+am__leading_dot = @am__leading_dot@
+am__quote = @am__quote@
+am__tar = @am__tar@
+am__untar = @am__untar@
+bindir = @bindir@
+build = @build@
+build_alias = @build_alias@
+build_cpu = @build_cpu@
+build_libsubdir = @build_libsubdir@
+build_os = @build_os@
+build_subdir = @build_subdir@
+build_vendor = @build_vendor@
+builddir = @builddir@
+datadir = @datadir@
+datarootdir = @datarootdir@
+docdir = @docdir@
+dvidir = @dvidir@
+enable_shared = @enable_shared@
+enable_static = @enable_static@
+exec_prefix = @exec_prefix@
+host = @host@
+host_alias = @host_alias@
+host_cpu = @host_cpu@
+host_noncanonical = @host_noncanonical@
+host_os = @host_os@
+host_subdir = @host_subdir@
+host_vendor = @host_vendor@
+htmldir = @htmldir@
+includedir = @includedir@
+infodir = @infodir@
+install_sh = @install_sh@
+libdir = @libdir@
+libexecdir = @libexecdir@
+libtool_VERSION = @libtool_VERSION@
+localedir = @localedir@
+localstatedir = @localstatedir@
+mandir = @mandir@
+mkdir_p = @mkdir_p@
+multi_basedir = @multi_basedir@
+oldincludedir = @oldincludedir@
+pdfdir = @pdfdir@
+prefix = @prefix@
+program_transform_name = @program_transform_name@
+psdir = @psdir@
+sbindir = @sbindir@
+sharedstatedir = @sharedstatedir@
+# Used to install the shared libgcc.
+slibdir = @slibdir@
+srcdir = @srcdir@
+sysconfdir = @sysconfdir@
+target = @target@
+target_alias = @target_alias@
+target_cpu = @target_cpu@
+target_noncanonical = @target_noncanonical@
+target_os = @target_os@
+target_subdir = @target_subdir@
+target_vendor = @target_vendor@
+toolexecdir = @toolexecdir@
+toolexeclibdir = @toolexeclibdir@
+top_build_prefix = @top_build_prefix@
+top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
+SUFFIXES = .c .cc .mod .def .o .obj .lo .a .la
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+# Multilib support.
+MAKEOVERRIDES = 
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+@BUILD_CORLIB_TRUE@M2DEFS = Debug.def  Executive.def \
+@BUILD_CORLIB_TRUE@         KeyBoardLEDs.def  SYSTEM.def \
+@BUILD_CORLIB_TRUE@         TimerHandler.def
+
+@BUILD_CORLIB_TRUE@M2MODS = Debug.mod  Executive.mod \
+@BUILD_CORLIB_TRUE@         SYSTEM.mod  TimerHandler.mod
+
+@BUILD_CORLIB_TRUE@toolexeclib_LTLIBRARIES = libm2cor.la
+@BUILD_CORLIB_TRUE@libm2cor_la_SOURCES = $(M2MODS) KeyBoardLEDs.cc
+@BUILD_CORLIB_TRUE@nodist_EXTRA_libm2cor_la_SOURCES = dummy.c  ## forces automake to generate the LINK definition
+@BUILD_CORLIB_TRUE@libm2cordir = libm2cor
+@BUILD_CORLIB_TRUE@libm2cor_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2cor_la_SOURCES)))
+@BUILD_CORLIB_TRUE@libm2cor_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../  -I@srcdir@/../libm2iso
+@BUILD_CORLIB_TRUE@libm2cor_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-coroutines -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g
+@BUILD_CORLIB_TRUE@libm2cor_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+@BUILD_CORLIB_TRUE@BUILT_SOURCES = SYSTEM.def
+@BUILD_CORLIB_TRUE@CLEANFILES = SYSTEM.def
+@BUILD_CORLIB_TRUE@M2LIBDIR = /m2/m2cor/
+all: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) all-am
+
+.SUFFIXES:
+.SUFFIXES: .c .cc .mod .def .o .obj .lo .a .la
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am  $(am__configure_deps)
+	@for dep in $?; do \
+	  case '$(am__configure_deps)' in \
+	    *$$dep*) \
+	      ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
+	        && { if test -f $@; then exit 0; else break; fi; }; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign libm2cor/Makefile'; \
+	$(am__cd) $(top_srcdir) && \
+	  $(AUTOMAKE) --foreign libm2cor/Makefile
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+	@case '$?' in \
+	  *config.status*) \
+	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
+	  *) \
+	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
+	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
+	esac;
+
+$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+
+$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(am__aclocal_m4_deps):
+
+install-toolexeclibLTLIBRARIES: $(toolexeclib_LTLIBRARIES)
+	@$(NORMAL_INSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	list2=; for p in $$list; do \
+	  if test -f $$p; then \
+	    list2="$$list2 $$p"; \
+	  else :; fi; \
+	done; \
+	test -z "$$list2" || { \
+	  echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(toolexeclibdir)"; \
+	}
+
+uninstall-toolexeclibLTLIBRARIES:
+	@$(NORMAL_UNINSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	for p in $$list; do \
+	  $(am__strip_dir) \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(toolexeclibdir)/$$f'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(toolexeclibdir)/$$f"; \
+	done
+
+clean-toolexeclibLTLIBRARIES:
+	-test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES)
+	@list='$(toolexeclib_LTLIBRARIES)'; \
+	locs=`for p in $$list; do echo $$p; done | \
+	      sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
+	      sort -u`; \
+	test -z "$$locs" || { \
+	  echo rm -f $${locs}; \
+	  rm -f $${locs}; \
+	}
+
+libm2cor.la: $(libm2cor_la_OBJECTS) $(libm2cor_la_DEPENDENCIES) $(EXTRA_libm2cor_la_DEPENDENCIES) 
+	$(AM_V_GEN)$(libm2cor_la_LINK) $(am_libm2cor_la_rpath) $(libm2cor_la_OBJECTS) $(libm2cor_la_LIBADD) $(LIBS)
+
+mostlyclean-compile:
+	-rm -f *.$(OBJEXT)
+
+distclean-compile:
+	-rm -f *.tab.c
+
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/KeyBoardLEDs.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2cor_la-dummy.Plo@am__quote@
+
+.c.o:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $<
+
+.c.obj:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+.c.lo:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $<
+
+libm2cor_la-dummy.lo: dummy.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2cor_la_CFLAGS) $(CFLAGS) -MT libm2cor_la-dummy.lo -MD -MP -MF $(DEPDIR)/libm2cor_la-dummy.Tpo -c -o libm2cor_la-dummy.lo `test -f 'dummy.c' || echo '$(srcdir)/'`dummy.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libm2cor_la-dummy.Tpo $(DEPDIR)/libm2cor_la-dummy.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='dummy.c' object='libm2cor_la-dummy.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2cor_la_CFLAGS) $(CFLAGS) -c -o libm2cor_la-dummy.lo `test -f 'dummy.c' || echo '$(srcdir)/'`dummy.c
+
+.cc.o:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ $<
+
+.cc.obj:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+@BUILD_CORLIB_FALSE@.cc.lo:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(LTCXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(LTCXXCOMPILE) -c -o $@ $<
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+ID: $(am__tagged_files)
+	$(am__define_uniq_tagged_files); mkid -fID $$unique
+tags: tags-am
+TAGS: tags
+
+tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	set x; \
+	here=`pwd`; \
+	$(am__define_uniq_tagged_files); \
+	shift; \
+	if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
+	  test -n "$$unique" || unique=$$empty_fix; \
+	  if test $$# -gt 0; then \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      "$$@" $$unique; \
+	  else \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      $$unique; \
+	  fi; \
+	fi
+ctags: ctags-am
+
+CTAGS: ctags
+ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	$(am__define_uniq_tagged_files); \
+	test -z "$(CTAGS_ARGS)$$unique" \
+	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
+	     $$unique
+
+GTAGS:
+	here=`$(am__cd) $(top_builddir) && pwd` \
+	  && $(am__cd) $(top_srcdir) \
+	  && gtags -i $(GTAGS_ARGS) "$$here"
+cscopelist: cscopelist-am
+
+cscopelist-am: $(am__tagged_files)
+	list='$(am__tagged_files)'; \
+	case "$(srcdir)" in \
+	  [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
+	  *) sdir=$(subdir)/$(srcdir) ;; \
+	esac; \
+	for i in $$list; do \
+	  if test -f "$$i"; then \
+	    echo "$(subdir)/$$i"; \
+	  else \
+	    echo "$$sdir/$$i"; \
+	  fi; \
+	done >> $(top_builddir)/cscope.files
+
+distclean-tags:
+	-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
+check-am: all-am
+check: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) check-am
+all-am: Makefile $(LTLIBRARIES)
+installdirs:
+	for dir in "$(DESTDIR)$(toolexeclibdir)"; do \
+	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
+	done
+install: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+	if test -z '$(STRIP)'; then \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	      install; \
+	else \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	    "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
+	fi
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
+	-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
+
+maintainer-clean-generic:
+	@echo "This command is intended for maintainers to use"
+	@echo "it deletes files that may require special tools to rebuild."
+	-test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES)
+@BUILD_CORLIB_FALSE@install-data-local:
+clean: clean-am
+
+clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \
+	mostlyclean-am
+
+distclean: distclean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+distclean-am: clean-am distclean-compile distclean-generic \
+	distclean-tags
+
+dvi: dvi-am
+
+dvi-am:
+
+html: html-am
+
+html-am:
+
+info: info-am
+
+info-am:
+
+install-data-am: install-data-local
+
+install-dvi: install-dvi-am
+
+install-dvi-am:
+
+install-exec-am: install-toolexeclibLTLIBRARIES
+
+install-html: install-html-am
+
+install-html-am:
+
+install-info: install-info-am
+
+install-info-am:
+
+install-man:
+
+install-pdf: install-pdf-am
+
+install-pdf-am:
+
+install-ps: install-ps-am
+
+install-ps-am:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool
+
+pdf: pdf-am
+
+pdf-am:
+
+ps: ps-am
+
+ps-am:
+
+uninstall-am: uninstall-toolexeclibLTLIBRARIES
+
+.MAKE: all check install install-am install-strip
+
+.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
+	clean-libtool clean-toolexeclibLTLIBRARIES cscopelist-am ctags \
+	ctags-am distclean distclean-compile distclean-generic \
+	distclean-libtool distclean-tags dvi dvi-am html html-am info \
+	info-am install install-am install-data install-data-am \
+	install-data-local install-dvi install-dvi-am install-exec \
+	install-exec-am install-html install-html-am install-info \
+	install-info-am install-man install-pdf install-pdf-am \
+	install-ps install-ps-am install-strip \
+	install-toolexeclibLTLIBRARIES installcheck installcheck-am \
+	installdirs maintainer-clean maintainer-clean-generic \
+	mostlyclean mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \
+	uninstall-am uninstall-toolexeclibLTLIBRARIES
+
+.PRECIOUS: Makefile
+
+
+@BUILD_CORLIB_TRUE@SYSTEM.def: Makefile
+@BUILD_CORLIB_TRUE@	bash $(GM2_SRC)/tools-src/makeSystem -fpim \
+@BUILD_CORLIB_TRUE@             $(GM2_SRC)/gm2-libs-coroutines/SYSTEM.def \
+@BUILD_CORLIB_TRUE@             $(GM2_SRC)/gm2-libs-coroutines/SYSTEM.mod \
+@BUILD_CORLIB_TRUE@             -I$(GM2_SRC)/gm2-libs-coroutines:$(GM2_SRC)/gm2-libs:$(GM2_SRC)/gm2-libs-iso \
+@BUILD_CORLIB_TRUE@             "$(GM2_FOR_TARGET)" $@
+
+@BUILD_CORLIB_TRUE@.mod.lo:
+@BUILD_CORLIB_TRUE@	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2cor_la_M2FLAGS) $< -o $@
+
+@BUILD_CORLIB_TRUE@.cc.lo:
+@BUILD_CORLIB_TRUE@	$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2cor_la_CFLAGS) $< -o $@
+
+@BUILD_CORLIB_TRUE@install-data-local: force
+@BUILD_CORLIB_TRUE@	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_CORLIB_TRUE@	$(INSTALL_DATA) .libs/libm2cor.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_CORLIB_TRUE@	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.la
+@BUILD_CORLIB_TRUE@	$(INSTALL_DATA) .libs/libm2cor.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_CORLIB_TRUE@	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.a
+@BUILD_CORLIB_TRUE@	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.a
+@BUILD_CORLIB_TRUE@	for i in $(M2DEFS) $(M2MODS) ; do \
+@BUILD_CORLIB_TRUE@           if [ -f $$i ] ; then \
+@BUILD_CORLIB_TRUE@              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_CORLIB_TRUE@           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-coroutines/$$i ] ; then \
+@BUILD_CORLIB_TRUE@              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-coroutines/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_CORLIB_TRUE@           else \
+@BUILD_CORLIB_TRUE@              echo "cannot find $$i" ; exit 1 ; \
+@BUILD_CORLIB_TRUE@           fi ; \
+@BUILD_CORLIB_TRUE@           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+@BUILD_CORLIB_TRUE@	done
+
+@BUILD_CORLIB_TRUE@force:
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgm2/libm2iso/ChanConsts.h b/libgm2/libm2iso/ChanConsts.h
new file mode 100644
index 00000000000..78a53213d43
--- /dev/null
+++ b/libgm2/libm2iso/ChanConsts.h
@@ -0,0 +1,57 @@
+/* ChanConsts.h provides a C header file for ISO ChanConst.def.
+
+Copyright (C) 2009-2022 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/>.  */
+
+/* taken from ChanConsts.def */
+
+typedef enum openResults {
+  opened,          /* the open succeeded as requested.  */
+  wrongNameFormat, /* given name is in the wrong format for the implementation.
+                      */
+  wrongFlags, /* given flags include a value that does not apply to the device.
+                 */
+  tooManyOpen,      /* this device cannot support any more open channels.  */
+  outOfChans,       /* no more channels can be allocated.  */
+  wrongPermissions, /* file or directory permissions do not allow request.  */
+  noRoomOnDevice,   /* storage limits on the device prevent the open.  */
+  noSuchFile,       /* a needed file does not exist.  */
+  fileExists,    /* a file of the given name already exists when a new one is
+                    required.  */
+  wrongFileType, /* the file is of the wrong type to support the required
+                    operations.  */
+  noTextOperations, /* text operations have been requested, but are not
+                       supported.  */
+  noRawOperations,  /* raw operations have been requested, but are not
+                       supported.  */
+  noMixedOperations,
+
+  /* text and raw operations have been requested, but they are not
+  supported in combination */
+  alreadyOpen,
+
+  /* the source/destination is already open for operations not
+  supported in combination with the requested operations */
+  otherProblem /* open failed for some other reason.  */
+} openResults;
diff --git a/libgm2/libm2iso/ErrnoCategory.cc b/libgm2/libm2iso/ErrnoCategory.cc
new file mode 100644
index 00000000000..70e840d352b
--- /dev/null
+++ b/libgm2/libm2iso/ErrnoCategory.cc
@@ -0,0 +1,180 @@
+/* ErrnoCatogory.cc categorizes values of errno maps onto ChanConsts.h.
+
+Copyright (C) 2008-2022 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 "ChanConsts.h"
+
+#if defined(HAVE_ERRNO_H)
+#include "errno.h"
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include "sys/errno.h"
+#endif
+
+#include "m2rts.h"
+
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+
+/* IsErrnoHard - returns TRUE if the value of errno is associated
+   with a hard device error.  */
+
+extern "C" int
+ErrnoCategory_IsErrnoHard (int e)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+  return ((e == EPERM) || (e == ENOENT) || (e == EIO) || (e == ENXIO)
+          || (e == EACCES) || (e == ENOTBLK) || (e == ENODEV) || (e == EINVAL)
+          || (e == ENFILE) || (e == EROFS) || (e == EMLINK));
+#else
+  return FALSE;
+#endif
+}
+
+/* IsErrnoSoft - returns TRUE if the value of errno is associated
+   with a soft device error.  */
+
+extern "C" int
+ErrnoCategory_IsErrnoSoft (int e)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+  return ((e == ESRCH) || (e == EINTR) || (e == E2BIG) || (e == ENOEXEC)
+          || (e == EBADF) || (e == ECHILD) || (e == EAGAIN) || (e == ENOMEM)
+          || (e == EFAULT) || (e == EBUSY) || (e == EEXIST) || (e == EXDEV)
+          || (e == ENOTDIR) || (e == EISDIR) || (e == EMFILE) || (e == ENOTTY)
+          || (e == ETXTBSY) || (e == EFBIG) || (e == ENOSPC) || (e == EPIPE));
+#else
+  return FALSE;
+#endif
+}
+
+extern "C" int
+ErrnoCategory_UnAvailable (int e)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+  return ((e == ENOENT) || (e == ESRCH) || (e == ENXIO) || (e == ECHILD)
+          || (e == ENOTBLK) || (e == ENODEV) || (e == ENOTDIR));
+#else
+  return FALSE;
+#endif
+}
+
+/* GetOpenResults - maps errno onto the ISO Modula-2 enumerated type,
+   OpenResults.  */
+
+extern "C" openResults
+ErrnoCategory_GetOpenResults (int e)
+{
+  if (e == 0)
+    return opened;
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+  switch (e)
+    {
+    case EPERM:
+      return wrongPermissions;
+      break;
+    case ENOENT:
+      return noSuchFile;
+      break;
+    case ENXIO:
+      return noSuchFile;
+      break;
+    case EACCES:
+      return wrongPermissions;
+      break;
+    case ENOTBLK:
+      return wrongFileType;
+      break;
+    case EEXIST:
+      return fileExists;
+      break;
+    case ENODEV:
+      return noSuchFile;
+      break;
+    case ENOTDIR:
+      return wrongFileType;
+      break;
+    case EISDIR:
+      return wrongFileType;
+      break;
+    case EINVAL:
+      return wrongFlags;
+      break;
+    case ENFILE:
+      return tooManyOpen;
+      break;
+    case EMFILE:
+      return tooManyOpen;
+      break;
+    case ENOTTY:
+      return wrongFileType;
+      break;
+    case ENOSPC:
+      return noRoomOnDevice;
+      break;
+    case EROFS:
+      return wrongPermissions;
+      break;
+
+    default:
+      return otherProblem;
+    }
+#else
+  return otherProblem;
+#endif
+}
+
+/* GNU Modula-2 linking fodder.  */
+
+extern "C" void
+_M2_ErrnoCategory_init (int, char *argv[], char *env[])
+{
+}
+
+extern "C" void
+_M2_ErrnoCategory_fini (int, char *argv[], char *env[])
+{
+}
+
+extern "C" void
+_M2_ErrnoCategory_dep (void)
+{
+}
+
+struct _M2_ErrnoCategory_ctor { _M2_ErrnoCategory_ctor (); } _M2_ErrnoCategory_ctor;
+
+_M2_ErrnoCategory_ctor::_M2_ErrnoCategory_ctor (void)
+{
+  M2RTS_RegisterModule ("ErrnoCategory", _M2_ErrnoCategory_init, _M2_ErrnoCategory_fini,
+			_M2_ErrnoCategory_dep);
+}
diff --git a/libgm2/libm2iso/Makefile.am b/libgm2/libm2iso/Makefile.am
new file mode 100644
index 00000000000..dc547207e79
--- /dev/null
+++ b/libgm2/libm2iso/Makefile.am
@@ -0,0 +1,244 @@
+# Makefile for libm2iso.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-iso
+
+# Multilib support.
+MAKEOVERRIDES=
+
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+# Used to install the shared libgcc.
+# was slibdir = @slibdir@
+slibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)
+
+toolexeclibdir=@toolexeclibdir@
+toolexecdir=@toolexecdir@
+GM2_FOR_TARGET=@GM2_FOR_TARGET@
+
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+
+
+if BUILD_ISOLIB
+M2DEFS = ChanConsts.def  CharClass.def \
+         ClientSocket.def  ComplexMath.def \
+         ConvStringLong.def  ConvStringReal.def \
+         ConvTypes.def  COROUTINES.def \
+         ErrnoCategory.def  EXCEPTIONS.def \
+         GeneralUserExceptions.def  IOChan.def \
+         IOConsts.def  IOLink.def \
+         IOResult.def  LongComplexMath.def \
+         LongConv.def  LongIO.def \
+         LongMath.def  LongStr.def \
+         LongWholeIO.def  LowLong.def \
+         LowReal.def  LowShort.def \
+         M2EXCEPTION.def  M2RTS.def \
+         MemStream.def \
+         Preemptive.def \
+         Processes.def  ProgramArgs.def \
+         RandomNumber.def \
+         RawIO.def  RealConv.def \
+         RealIO.def  RealMath.def \
+         RealStr.def  RndFile.def \
+         RTco.def \
+         RTdata.def  RTentity.def \
+         RTfio.def  RTgen.def \
+         RTgenif.def  RTio.def \
+         Semaphores.def  SeqFile.def \
+         ShortComplexMath.def \
+         ShortIO.def  ShortWholeIO.def \
+         SimpleCipher.def  SIOResult.def \
+         SLongIO.def  SLongWholeIO.def \
+         SRawIO.def  SRealIO.def \
+         SShortIO.def  SShortWholeIO.def \
+         StdChans.def  STextIO.def \
+         Storage.def  StreamFile.def \
+         StringChan.def  Strings.def \
+         SWholeIO.def  SysClock.def \
+         SYSTEM.def  TermFile.def \
+         TERMINATION.def  TextIO.def \
+         WholeConv.def  WholeIO.def \
+         WholeStr.def  wrapsock.def \
+         wraptime.def
+
+M2MODS = ChanConsts.mod  CharClass.mod \
+         ClientSocket.mod  ComplexMath.mod \
+         ConvStringLong.mod  ConvStringReal.mod \
+         ConvTypes.mod  COROUTINES.mod \
+         EXCEPTIONS.mod  GeneralUserExceptions.mod \
+         IOChan.mod  IOConsts.mod \
+         IOLink.mod  IOResult.mod \
+         LongComplexMath.mod  LongConv.mod \
+         LongIO.mod  LongMath.mod \
+         LongStr.mod  LongWholeIO.mod \
+         LowLong.mod  LowReal.mod \
+         LowShort.mod  M2EXCEPTION.mod \
+         M2RTS.mod  MemStream.mod \
+         Preemptive.mod \
+         Processes.mod \
+         ProgramArgs.mod  RandomNumber.mod \
+         RawIO.mod  RealConv.mod \
+         RealIO.mod  RealMath.mod \
+         RealStr.mod  RndFile.mod \
+         RTdata.mod  RTentity.mod \
+         RTfio.mod  RTgenif.mod \
+         RTgen.mod  RTio.mod \
+         Semaphores.mod  SeqFile.mod \
+         ShortComplexMath.mod \
+         ShortIO.mod  ShortWholeIO.mod \
+         SimpleCipher.mod  SIOResult.mod \
+         SLongIO.mod  SLongWholeIO.mod \
+         SRawIO.mod  SRealIO.mod \
+         SShortIO.mod  SShortWholeIO.mod \
+         StdChans.mod  STextIO.mod \
+         Storage.mod  StreamFile.mod \
+         StringChan.mod  Strings.mod \
+         SWholeIO.mod  SysClock.mod \
+         SYSTEM.mod  TermFile.mod \
+         TERMINATION.mod  TextIO.mod \
+         WholeConv.mod  WholeIO.mod \
+         WholeStr.mod
+
+toolexeclib_LTLIBRARIES = libm2iso.la
+libm2iso_la_SOURCES =  $(M2MODS) \
+                     ErrnoCategory.cc  wrapsock.c \
+                     wraptime.c RTco.cc
+
+C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include
+
+libm2isodir = libm2iso
+libm2iso_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2iso_la_SOURCES)))
+libm2iso_la_CFLAGS = $(C_INCLUDES) -I. -I.. -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -DBUILD_GM2_LIBS -I@srcdir@/../ -I../../../gcc -I$(GCC_DIR) -I$(GCC_DIR)/../include -I../../libgcc -I$(GCC_DIR)/../libgcc -I$(MULTIBUILDTOP)../../gcc/include
+libm2iso_la_M2FLAGS = -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -fiso -fextended-opaque -fm2-g -g
+libm2iso_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+CLEANFILES = SYSTEM.def
+BUILT_SOURCES = SYSTEM.def
+
+M2LIBDIR = /m2/m2iso/
+
+M2HEADER_FILES = m2rts.h
+
+SYSTEM.def: Makefile
+	bash $(GM2_SRC)/tools-src/makeSystem -fiso \
+             $(GM2_SRC)/gm2-libs-iso/SYSTEM.def \
+             $(GM2_SRC)/gm2-libs-iso/SYSTEM.mod \
+             -I$(GM2_SRC)/gm2-libs-iso:$(GM2_SRC)/gm2-libs \
+             "$(GM2_FOR_TARGET)" $@
+
+## add these to the .mod.o rule when optimization is fixed $(CFLAGS_FOR_TARGET) $(LIBCFLAGS)
+
+.mod.lo:
+	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2iso_la_M2FLAGS) $< -o $@
+
+.c.lo:
+	$(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
+.cc.lo:
+	$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
+install-data-local: force
+	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	$(INSTALL_DATA) .libs/libm2iso.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2iso.la
+	$(INSTALL_DATA) .libs/libm2iso.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)/libm2iso.a
+	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)/libm2iso.a
+	for i in $(M2DEFS) $(M2MODS) ; do \
+           if [ -f $$i ] ; then \
+              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-iso/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-iso/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+	for i in $(M2HEADER_FILES) ; do \
+           if [ -f @srcdir@/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+
+force:
+
+endif
diff --git a/libgm2/libm2iso/Makefile.in b/libgm2/libm2iso/Makefile.in
new file mode 100644
index 00000000000..04aba0f032b
--- /dev/null
+++ b/libgm2/libm2iso/Makefile.in
@@ -0,0 +1,947 @@
+# Makefile.in generated by automake 1.15.1 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994-2017 Free Software Foundation, Inc.
+
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+# Makefile for libm2iso.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+am__is_gnu_make = { \
+  if test -z '$(MAKELEVEL)'; then \
+    false; \
+  elif test -n '$(MAKE_HOST)'; then \
+    true; \
+  elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
+    true; \
+  else \
+    false; \
+  fi; \
+}
+am__make_running_with_option = \
+  case $${target_option-} in \
+      ?) ;; \
+      *) echo "am__make_running_with_option: internal error: invalid" \
+              "target option '$${target_option-}' specified" >&2; \
+         exit 1;; \
+  esac; \
+  has_opt=no; \
+  sane_makeflags=$$MAKEFLAGS; \
+  if $(am__is_gnu_make); then \
+    sane_makeflags=$$MFLAGS; \
+  else \
+    case $$MAKEFLAGS in \
+      *\\[\ \	]*) \
+        bs=\\; \
+        sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
+          | sed "s/$$bs$$bs[$$bs $$bs	]*//g"`;; \
+    esac; \
+  fi; \
+  skip_next=no; \
+  strip_trailopt () \
+  { \
+    flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
+  }; \
+  for flg in $$sane_makeflags; do \
+    test $$skip_next = yes && { skip_next=no; continue; }; \
+    case $$flg in \
+      *=*|--*) continue;; \
+        -*I) strip_trailopt 'I'; skip_next=yes;; \
+      -*I?*) strip_trailopt 'I';; \
+        -*O) strip_trailopt 'O'; skip_next=yes;; \
+      -*O?*) strip_trailopt 'O';; \
+        -*l) strip_trailopt 'l'; skip_next=yes;; \
+      -*l?*) strip_trailopt 'l';; \
+      -[dEDm]) skip_next=yes;; \
+      -[JT]) skip_next=yes;; \
+    esac; \
+    case $$flg in \
+      *$$target_option*) has_opt=yes; break;; \
+    esac; \
+  done; \
+  test $$has_opt = yes
+am__make_dryrun = (target_option=n; $(am__make_running_with_option))
+am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
+pkgdatadir = $(datadir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkglibexecdir = $(libexecdir)/@PACKAGE@
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = $(program_transform_name)
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+build_triplet = @build@
+host_triplet = @host@
+target_triplet = @target@
+subdir = libm2iso
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(top_srcdir)/../libtool.m4 \
+	$(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \
+	$(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \
+	$(top_srcdir)/../config/acx.m4 \
+	$(top_srcdir)/../config/depstand.m4 \
+	$(top_srcdir)/../config/lead-dot.m4 \
+	$(top_srcdir)/../config/multi.m4 \
+	$(top_srcdir)/../config/no-executables.m4 \
+	$(top_srcdir)/../config/override.m4 $(top_srcdir)/configure.ac
+am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
+	$(ACLOCAL_M4)
+DIST_COMMON = $(srcdir)/Makefile.am
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = $(top_builddir)/config.h
+CONFIG_CLEAN_FILES =
+CONFIG_CLEAN_VPATH_FILES =
+am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
+am__vpath_adj = case $$p in \
+    $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
+    *) f=$$p;; \
+  esac;
+am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
+am__install_max = 40
+am__nobase_strip_setup = \
+  srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
+am__nobase_strip = \
+  for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
+am__nobase_list = $(am__nobase_strip_setup); \
+  for p in $$list; do echo "$$p $$p"; done | \
+  sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
+  $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
+    if (++n[$$2] == $(am__install_max)) \
+      { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
+    END { for (dir in files) print dir, files[dir] }'
+am__base_list = \
+  sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
+  sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
+am__uninstall_files_from_dir = { \
+  test -z "$$files" \
+    || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
+    || { echo " ( cd '$$dir' && rm -f" $$files ")"; \
+         $(am__cd) "$$dir" && rm -f $$files; }; \
+  }
+am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
+LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
+libm2iso_la_LIBADD =
+@BUILD_ISOLIB_TRUE@am__objects_1 = ChanConsts.lo CharClass.lo \
+@BUILD_ISOLIB_TRUE@	ClientSocket.lo ComplexMath.lo \
+@BUILD_ISOLIB_TRUE@	ConvStringLong.lo ConvStringReal.lo \
+@BUILD_ISOLIB_TRUE@	ConvTypes.lo COROUTINES.lo EXCEPTIONS.lo \
+@BUILD_ISOLIB_TRUE@	GeneralUserExceptions.lo IOChan.lo \
+@BUILD_ISOLIB_TRUE@	IOConsts.lo IOLink.lo IOResult.lo \
+@BUILD_ISOLIB_TRUE@	LongComplexMath.lo LongConv.lo LongIO.lo \
+@BUILD_ISOLIB_TRUE@	LongMath.lo LongStr.lo LongWholeIO.lo \
+@BUILD_ISOLIB_TRUE@	LowLong.lo LowReal.lo LowShort.lo \
+@BUILD_ISOLIB_TRUE@	M2EXCEPTION.lo M2RTS.lo MemStream.lo \
+@BUILD_ISOLIB_TRUE@	Preemptive.lo Processes.lo ProgramArgs.lo \
+@BUILD_ISOLIB_TRUE@	RandomNumber.lo RawIO.lo RealConv.lo \
+@BUILD_ISOLIB_TRUE@	RealIO.lo RealMath.lo RealStr.lo RndFile.lo \
+@BUILD_ISOLIB_TRUE@	RTdata.lo RTentity.lo RTfio.lo RTgenif.lo \
+@BUILD_ISOLIB_TRUE@	RTgen.lo RTio.lo Semaphores.lo SeqFile.lo \
+@BUILD_ISOLIB_TRUE@	ShortComplexMath.lo ShortIO.lo \
+@BUILD_ISOLIB_TRUE@	ShortWholeIO.lo SimpleCipher.lo \
+@BUILD_ISOLIB_TRUE@	SIOResult.lo SLongIO.lo SLongWholeIO.lo \
+@BUILD_ISOLIB_TRUE@	SRawIO.lo SRealIO.lo SShortIO.lo \
+@BUILD_ISOLIB_TRUE@	SShortWholeIO.lo StdChans.lo STextIO.lo \
+@BUILD_ISOLIB_TRUE@	Storage.lo StreamFile.lo StringChan.lo \
+@BUILD_ISOLIB_TRUE@	Strings.lo SWholeIO.lo SysClock.lo \
+@BUILD_ISOLIB_TRUE@	SYSTEM.lo TermFile.lo TERMINATION.lo \
+@BUILD_ISOLIB_TRUE@	TextIO.lo WholeConv.lo WholeIO.lo \
+@BUILD_ISOLIB_TRUE@	WholeStr.lo
+@BUILD_ISOLIB_TRUE@am_libm2iso_la_OBJECTS = $(am__objects_1) \
+@BUILD_ISOLIB_TRUE@	ErrnoCategory.lo libm2iso_la-wrapsock.lo \
+@BUILD_ISOLIB_TRUE@	libm2iso_la-wraptime.lo RTco.lo
+libm2iso_la_OBJECTS = $(am_libm2iso_la_OBJECTS)
+@BUILD_ISOLIB_TRUE@am_libm2iso_la_rpath = -rpath $(toolexeclibdir)
+AM_V_P = $(am__v_P_@AM_V@)
+am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
+am__v_P_0 = false
+am__v_P_1 = :
+AM_V_GEN = $(am__v_GEN_@AM_V@)
+am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
+am__v_GEN_0 = @echo "  GEN     " $@;
+am__v_GEN_1 = 
+AM_V_at = $(am__v_at_@AM_V@)
+am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
+am__v_at_0 = @
+am__v_at_1 = 
+DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
+depcomp = $(SHELL) $(top_srcdir)/../depcomp
+am__depfiles_maybe = depfiles
+am__mv = mv -f
+AM_V_lt = $(am__v_lt_@AM_V@)
+am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
+am__v_lt_0 = --silent
+am__v_lt_1 = 
+COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
+	$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
+	$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	$(AM_CFLAGS) $(CFLAGS)
+AM_V_CC = $(am__v_CC_@AM_V@)
+am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
+am__v_CC_0 = @echo "  CC      " $@;
+am__v_CC_1 = 
+CCLD = $(CC)
+LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
+	$(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_CCLD = $(am__v_CCLD_@AM_V@)
+am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
+am__v_CCLD_0 = @echo "  CCLD    " $@;
+am__v_CCLD_1 = 
+CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
+	$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS)
+LTCXXCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) \
+	$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	$(AM_CXXFLAGS) $(CXXFLAGS)
+AM_V_CXX = $(am__v_CXX_@AM_V@)
+am__v_CXX_ = $(am__v_CXX_@AM_DEFAULT_V@)
+am__v_CXX_0 = @echo "  CXX     " $@;
+am__v_CXX_1 = 
+CXXLD = $(CXX)
+CXXLINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \
+	$(CXXFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_CXXLD = $(am__v_CXXLD_@AM_V@)
+am__v_CXXLD_ = $(am__v_CXXLD_@AM_DEFAULT_V@)
+am__v_CXXLD_0 = @echo "  CXXLD   " $@;
+am__v_CXXLD_1 = 
+SOURCES = $(libm2iso_la_SOURCES)
+am__can_run_installinfo = \
+  case $$AM_UPDATE_INFO_DIR in \
+    n|no|NO) false;; \
+    *) (install-info --version) >/dev/null 2>&1;; \
+  esac
+am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
+# Read a list of newline-separated strings from the standard input,
+# and print each of them once, without duplicates.  Input order is
+# *not* preserved.
+am__uniquify_input = $(AWK) '\
+  BEGIN { nonempty = 0; } \
+  { items[$$0] = 1; nonempty = 1; } \
+  END { if (nonempty) { for (i in items) print i; }; } \
+'
+# Make sure the list of sources is unique.  This is necessary because,
+# e.g., the same source file might be shared among _SOURCES variables
+# for different programs/libraries.
+am__define_uniq_tagged_files = \
+  list='$(am__tagged_files)'; \
+  unique=`for i in $$list; do \
+    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+  done | $(am__uniquify_input)`
+ETAGS = etags
+CTAGS = ctags
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-iso
+ACLOCAL = @ACLOCAL@
+AMTAR = @AMTAR@
+AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+AR = @AR@
+AUTOCONF = @AUTOCONF@
+AUTOHEADER = @AUTOHEADER@
+AUTOMAKE = @AUTOMAKE@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+CCASDEPMODE = @CCASDEPMODE@
+CCASFLAGS = @CCASFLAGS@
+CCDEPMODE = @CCDEPMODE@
+CC_FOR_BUILD = @CC_FOR_BUILD@
+CFLAGS = @CFLAGS@
+CPP = @CPP@
+CPPFLAGS = @CPPFLAGS@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+CXXDEPMODE = @CXXDEPMODE@
+CXXFLAGS = @CXXFLAGS@
+CYGPATH_W = @CYGPATH_W@
+DEFS = @DEFS@
+DEPDIR = @DEPDIR@
+DSYMUTIL = @DSYMUTIL@
+DUMPBIN = @DUMPBIN@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+EGREP = @EGREP@
+EXEEXT = @EXEEXT@
+FGREP = @FGREP@
+GM2_FOR_TARGET = @GM2_FOR_TARGET@
+GREP = @GREP@
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LD = @LD@
+LDFLAGS = @LDFLAGS@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LIBTOOL = @LIBTOOL@
+LIPO = @LIPO@
+LN_S = @LN_S@
+LTLIBOBJS = @LTLIBOBJS@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+MKDIR_P = @MKDIR_P@
+NM = @NM@
+NMEDIT = @NMEDIT@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+OTOOL = @OTOOL@
+OTOOL64 = @OTOOL64@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_URL = @PACKAGE_URL@
+PACKAGE_VERSION = @PACKAGE_VERSION@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+PERL = @PERL@
+RANLIB = @RANLIB@
+SED = @SED@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+STRIP = @STRIP@
+VERSION = @VERSION@
+abs_builddir = @abs_builddir@
+abs_srcdir = @abs_srcdir@
+abs_top_builddir = @abs_top_builddir@
+abs_top_srcdir = @abs_top_srcdir@
+ac_ct_CC = @ac_ct_CC@
+ac_ct_CXX = @ac_ct_CXX@
+ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
+am__include = @am__include@
+am__leading_dot = @am__leading_dot@
+am__quote = @am__quote@
+am__tar = @am__tar@
+am__untar = @am__untar@
+bindir = @bindir@
+build = @build@
+build_alias = @build_alias@
+build_cpu = @build_cpu@
+build_libsubdir = @build_libsubdir@
+build_os = @build_os@
+build_subdir = @build_subdir@
+build_vendor = @build_vendor@
+builddir = @builddir@
+datadir = @datadir@
+datarootdir = @datarootdir@
+docdir = @docdir@
+dvidir = @dvidir@
+enable_shared = @enable_shared@
+enable_static = @enable_static@
+exec_prefix = @exec_prefix@
+host = @host@
+host_alias = @host_alias@
+host_cpu = @host_cpu@
+host_noncanonical = @host_noncanonical@
+host_os = @host_os@
+host_subdir = @host_subdir@
+host_vendor = @host_vendor@
+htmldir = @htmldir@
+includedir = @includedir@
+infodir = @infodir@
+install_sh = @install_sh@
+libdir = @libdir@
+libexecdir = @libexecdir@
+libtool_VERSION = @libtool_VERSION@
+localedir = @localedir@
+localstatedir = @localstatedir@
+mandir = @mandir@
+mkdir_p = @mkdir_p@
+multi_basedir = @multi_basedir@
+oldincludedir = @oldincludedir@
+pdfdir = @pdfdir@
+prefix = @prefix@
+program_transform_name = @program_transform_name@
+psdir = @psdir@
+sbindir = @sbindir@
+sharedstatedir = @sharedstatedir@
+# Used to install the shared libgcc.
+# was slibdir = @slibdir@
+slibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)
+srcdir = @srcdir@
+sysconfdir = @sysconfdir@
+target = @target@
+target_alias = @target_alias@
+target_cpu = @target_cpu@
+target_noncanonical = @target_noncanonical@
+target_os = @target_os@
+target_subdir = @target_subdir@
+target_vendor = @target_vendor@
+toolexecdir = @toolexecdir@
+toolexeclibdir = @toolexeclibdir@
+top_build_prefix = @top_build_prefix@
+top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+# Multilib support.
+MAKEOVERRIDES = 
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+@BUILD_ISOLIB_TRUE@M2DEFS = ChanConsts.def  CharClass.def \
+@BUILD_ISOLIB_TRUE@         ClientSocket.def  ComplexMath.def \
+@BUILD_ISOLIB_TRUE@         ConvStringLong.def  ConvStringReal.def \
+@BUILD_ISOLIB_TRUE@         ConvTypes.def  COROUTINES.def \
+@BUILD_ISOLIB_TRUE@         ErrnoCategory.def  EXCEPTIONS.def \
+@BUILD_ISOLIB_TRUE@         GeneralUserExceptions.def  IOChan.def \
+@BUILD_ISOLIB_TRUE@         IOConsts.def  IOLink.def \
+@BUILD_ISOLIB_TRUE@         IOResult.def  LongComplexMath.def \
+@BUILD_ISOLIB_TRUE@         LongConv.def  LongIO.def \
+@BUILD_ISOLIB_TRUE@         LongMath.def  LongStr.def \
+@BUILD_ISOLIB_TRUE@         LongWholeIO.def  LowLong.def \
+@BUILD_ISOLIB_TRUE@         LowReal.def  LowShort.def \
+@BUILD_ISOLIB_TRUE@         M2EXCEPTION.def  M2RTS.def \
+@BUILD_ISOLIB_TRUE@         MemStream.def \
+@BUILD_ISOLIB_TRUE@         Preemptive.def \
+@BUILD_ISOLIB_TRUE@         Processes.def  ProgramArgs.def \
+@BUILD_ISOLIB_TRUE@         RandomNumber.def \
+@BUILD_ISOLIB_TRUE@         RawIO.def  RealConv.def \
+@BUILD_ISOLIB_TRUE@         RealIO.def  RealMath.def \
+@BUILD_ISOLIB_TRUE@         RealStr.def  RndFile.def \
+@BUILD_ISOLIB_TRUE@         RTco.def \
+@BUILD_ISOLIB_TRUE@         RTdata.def  RTentity.def \
+@BUILD_ISOLIB_TRUE@         RTfio.def  RTgen.def \
+@BUILD_ISOLIB_TRUE@         RTgenif.def  RTio.def \
+@BUILD_ISOLIB_TRUE@         Semaphores.def  SeqFile.def \
+@BUILD_ISOLIB_TRUE@         ShortComplexMath.def \
+@BUILD_ISOLIB_TRUE@         ShortIO.def  ShortWholeIO.def \
+@BUILD_ISOLIB_TRUE@         SimpleCipher.def  SIOResult.def \
+@BUILD_ISOLIB_TRUE@         SLongIO.def  SLongWholeIO.def \
+@BUILD_ISOLIB_TRUE@         SRawIO.def  SRealIO.def \
+@BUILD_ISOLIB_TRUE@         SShortIO.def  SShortWholeIO.def \
+@BUILD_ISOLIB_TRUE@         StdChans.def  STextIO.def \
+@BUILD_ISOLIB_TRUE@         Storage.def  StreamFile.def \
+@BUILD_ISOLIB_TRUE@         StringChan.def  Strings.def \
+@BUILD_ISOLIB_TRUE@         SWholeIO.def  SysClock.def \
+@BUILD_ISOLIB_TRUE@         SYSTEM.def  TermFile.def \
+@BUILD_ISOLIB_TRUE@         TERMINATION.def  TextIO.def \
+@BUILD_ISOLIB_TRUE@         WholeConv.def  WholeIO.def \
+@BUILD_ISOLIB_TRUE@         WholeStr.def  wrapsock.def \
+@BUILD_ISOLIB_TRUE@         wraptime.def
+
+@BUILD_ISOLIB_TRUE@M2MODS = ChanConsts.mod  CharClass.mod \
+@BUILD_ISOLIB_TRUE@         ClientSocket.mod  ComplexMath.mod \
+@BUILD_ISOLIB_TRUE@         ConvStringLong.mod  ConvStringReal.mod \
+@BUILD_ISOLIB_TRUE@         ConvTypes.mod  COROUTINES.mod \
+@BUILD_ISOLIB_TRUE@         EXCEPTIONS.mod  GeneralUserExceptions.mod \
+@BUILD_ISOLIB_TRUE@         IOChan.mod  IOConsts.mod \
+@BUILD_ISOLIB_TRUE@         IOLink.mod  IOResult.mod \
+@BUILD_ISOLIB_TRUE@         LongComplexMath.mod  LongConv.mod \
+@BUILD_ISOLIB_TRUE@         LongIO.mod  LongMath.mod \
+@BUILD_ISOLIB_TRUE@         LongStr.mod  LongWholeIO.mod \
+@BUILD_ISOLIB_TRUE@         LowLong.mod  LowReal.mod \
+@BUILD_ISOLIB_TRUE@         LowShort.mod  M2EXCEPTION.mod \
+@BUILD_ISOLIB_TRUE@         M2RTS.mod  MemStream.mod \
+@BUILD_ISOLIB_TRUE@         Preemptive.mod \
+@BUILD_ISOLIB_TRUE@         Processes.mod \
+@BUILD_ISOLIB_TRUE@         ProgramArgs.mod  RandomNumber.mod \
+@BUILD_ISOLIB_TRUE@         RawIO.mod  RealConv.mod \
+@BUILD_ISOLIB_TRUE@         RealIO.mod  RealMath.mod \
+@BUILD_ISOLIB_TRUE@         RealStr.mod  RndFile.mod \
+@BUILD_ISOLIB_TRUE@         RTdata.mod  RTentity.mod \
+@BUILD_ISOLIB_TRUE@         RTfio.mod  RTgenif.mod \
+@BUILD_ISOLIB_TRUE@         RTgen.mod  RTio.mod \
+@BUILD_ISOLIB_TRUE@         Semaphores.mod  SeqFile.mod \
+@BUILD_ISOLIB_TRUE@         ShortComplexMath.mod \
+@BUILD_ISOLIB_TRUE@         ShortIO.mod  ShortWholeIO.mod \
+@BUILD_ISOLIB_TRUE@         SimpleCipher.mod  SIOResult.mod \
+@BUILD_ISOLIB_TRUE@         SLongIO.mod  SLongWholeIO.mod \
+@BUILD_ISOLIB_TRUE@         SRawIO.mod  SRealIO.mod \
+@BUILD_ISOLIB_TRUE@         SShortIO.mod  SShortWholeIO.mod \
+@BUILD_ISOLIB_TRUE@         StdChans.mod  STextIO.mod \
+@BUILD_ISOLIB_TRUE@         Storage.mod  StreamFile.mod \
+@BUILD_ISOLIB_TRUE@         StringChan.mod  Strings.mod \
+@BUILD_ISOLIB_TRUE@         SWholeIO.mod  SysClock.mod \
+@BUILD_ISOLIB_TRUE@         SYSTEM.mod  TermFile.mod \
+@BUILD_ISOLIB_TRUE@         TERMINATION.mod  TextIO.mod \
+@BUILD_ISOLIB_TRUE@         WholeConv.mod  WholeIO.mod \
+@BUILD_ISOLIB_TRUE@         WholeStr.mod
+
+@BUILD_ISOLIB_TRUE@toolexeclib_LTLIBRARIES = libm2iso.la
+@BUILD_ISOLIB_TRUE@libm2iso_la_SOURCES = $(M2MODS) \
+@BUILD_ISOLIB_TRUE@                     ErrnoCategory.cc  wrapsock.c \
+@BUILD_ISOLIB_TRUE@                     wraptime.c RTco.cc
+
+@BUILD_ISOLIB_TRUE@C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include
+@BUILD_ISOLIB_TRUE@libm2isodir = libm2iso
+@BUILD_ISOLIB_TRUE@libm2iso_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2iso_la_SOURCES)))
+@BUILD_ISOLIB_TRUE@libm2iso_la_CFLAGS = $(C_INCLUDES) -I. -I.. -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -DBUILD_GM2_LIBS -I@srcdir@/../ -I../../../gcc -I$(GCC_DIR) -I$(GCC_DIR)/../include -I../../libgcc -I$(GCC_DIR)/../libgcc -I$(MULTIBUILDTOP)../../gcc/include
+@BUILD_ISOLIB_TRUE@libm2iso_la_M2FLAGS = -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -fiso -fextended-opaque -fm2-g -g
+@BUILD_ISOLIB_TRUE@libm2iso_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+@BUILD_ISOLIB_TRUE@CLEANFILES = SYSTEM.def
+@BUILD_ISOLIB_TRUE@BUILT_SOURCES = SYSTEM.def
+@BUILD_ISOLIB_TRUE@M2LIBDIR = /m2/m2iso/
+@BUILD_ISOLIB_TRUE@M2HEADER_FILES = m2rts.h
+all: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) all-am
+
+.SUFFIXES:
+.SUFFIXES: .c .mod .def .o .obj .lo .a .la .cc
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am  $(am__configure_deps)
+	@for dep in $?; do \
+	  case '$(am__configure_deps)' in \
+	    *$$dep*) \
+	      ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
+	        && { if test -f $@; then exit 0; else break; fi; }; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign libm2iso/Makefile'; \
+	$(am__cd) $(top_srcdir) && \
+	  $(AUTOMAKE) --foreign libm2iso/Makefile
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+	@case '$?' in \
+	  *config.status*) \
+	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
+	  *) \
+	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
+	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
+	esac;
+
+$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+
+$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(am__aclocal_m4_deps):
+
+install-toolexeclibLTLIBRARIES: $(toolexeclib_LTLIBRARIES)
+	@$(NORMAL_INSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	list2=; for p in $$list; do \
+	  if test -f $$p; then \
+	    list2="$$list2 $$p"; \
+	  else :; fi; \
+	done; \
+	test -z "$$list2" || { \
+	  echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(toolexeclibdir)"; \
+	}
+
+uninstall-toolexeclibLTLIBRARIES:
+	@$(NORMAL_UNINSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	for p in $$list; do \
+	  $(am__strip_dir) \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(toolexeclibdir)/$$f'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(toolexeclibdir)/$$f"; \
+	done
+
+clean-toolexeclibLTLIBRARIES:
+	-test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES)
+	@list='$(toolexeclib_LTLIBRARIES)'; \
+	locs=`for p in $$list; do echo $$p; done | \
+	      sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
+	      sort -u`; \
+	test -z "$$locs" || { \
+	  echo rm -f $${locs}; \
+	  rm -f $${locs}; \
+	}
+
+libm2iso.la: $(libm2iso_la_OBJECTS) $(libm2iso_la_DEPENDENCIES) $(EXTRA_libm2iso_la_DEPENDENCIES) 
+	$(AM_V_GEN)$(libm2iso_la_LINK) $(am_libm2iso_la_rpath) $(libm2iso_la_OBJECTS) $(libm2iso_la_LIBADD) $(LIBS)
+
+mostlyclean-compile:
+	-rm -f *.$(OBJEXT)
+
+distclean-compile:
+	-rm -f *.tab.c
+
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ErrnoCategory.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/RTco.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2iso_la-wrapsock.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2iso_la-wraptime.Plo@am__quote@
+
+.c.o:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $<
+
+.c.obj:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+@BUILD_ISOLIB_FALSE@.c.lo:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $<
+
+libm2iso_la-wrapsock.lo: wrapsock.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -MT libm2iso_la-wrapsock.lo -MD -MP -MF $(DEPDIR)/libm2iso_la-wrapsock.Tpo -c -o libm2iso_la-wrapsock.lo `test -f 'wrapsock.c' || echo '$(srcdir)/'`wrapsock.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libm2iso_la-wrapsock.Tpo $(DEPDIR)/libm2iso_la-wrapsock.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='wrapsock.c' object='libm2iso_la-wrapsock.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -c -o libm2iso_la-wrapsock.lo `test -f 'wrapsock.c' || echo '$(srcdir)/'`wrapsock.c
+
+libm2iso_la-wraptime.lo: wraptime.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -MT libm2iso_la-wraptime.lo -MD -MP -MF $(DEPDIR)/libm2iso_la-wraptime.Tpo -c -o libm2iso_la-wraptime.lo `test -f 'wraptime.c' || echo '$(srcdir)/'`wraptime.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libm2iso_la-wraptime.Tpo $(DEPDIR)/libm2iso_la-wraptime.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='wraptime.c' object='libm2iso_la-wraptime.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -c -o libm2iso_la-wraptime.lo `test -f 'wraptime.c' || echo '$(srcdir)/'`wraptime.c
+
+.cc.o:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ $<
+
+.cc.obj:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+@BUILD_ISOLIB_FALSE@.cc.lo:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(LTCXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(LTCXXCOMPILE) -c -o $@ $<
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+ID: $(am__tagged_files)
+	$(am__define_uniq_tagged_files); mkid -fID $$unique
+tags: tags-am
+TAGS: tags
+
+tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	set x; \
+	here=`pwd`; \
+	$(am__define_uniq_tagged_files); \
+	shift; \
+	if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
+	  test -n "$$unique" || unique=$$empty_fix; \
+	  if test $$# -gt 0; then \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      "$$@" $$unique; \
+	  else \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      $$unique; \
+	  fi; \
+	fi
+ctags: ctags-am
+
+CTAGS: ctags
+ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	$(am__define_uniq_tagged_files); \
+	test -z "$(CTAGS_ARGS)$$unique" \
+	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
+	     $$unique
+
+GTAGS:
+	here=`$(am__cd) $(top_builddir) && pwd` \
+	  && $(am__cd) $(top_srcdir) \
+	  && gtags -i $(GTAGS_ARGS) "$$here"
+cscopelist: cscopelist-am
+
+cscopelist-am: $(am__tagged_files)
+	list='$(am__tagged_files)'; \
+	case "$(srcdir)" in \
+	  [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
+	  *) sdir=$(subdir)/$(srcdir) ;; \
+	esac; \
+	for i in $$list; do \
+	  if test -f "$$i"; then \
+	    echo "$(subdir)/$$i"; \
+	  else \
+	    echo "$$sdir/$$i"; \
+	  fi; \
+	done >> $(top_builddir)/cscope.files
+
+distclean-tags:
+	-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
+check-am: all-am
+check: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) check-am
+all-am: Makefile $(LTLIBRARIES)
+installdirs:
+	for dir in "$(DESTDIR)$(toolexeclibdir)"; do \
+	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
+	done
+install: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+	if test -z '$(STRIP)'; then \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	      install; \
+	else \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	    "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
+	fi
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
+	-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
+
+maintainer-clean-generic:
+	@echo "This command is intended for maintainers to use"
+	@echo "it deletes files that may require special tools to rebuild."
+	-test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES)
+@BUILD_ISOLIB_FALSE@install-data-local:
+clean: clean-am
+
+clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \
+	mostlyclean-am
+
+distclean: distclean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+distclean-am: clean-am distclean-compile distclean-generic \
+	distclean-tags
+
+dvi: dvi-am
+
+dvi-am:
+
+html: html-am
+
+html-am:
+
+info: info-am
+
+info-am:
+
+install-data-am: install-data-local
+
+install-dvi: install-dvi-am
+
+install-dvi-am:
+
+install-exec-am: install-toolexeclibLTLIBRARIES
+
+install-html: install-html-am
+
+install-html-am:
+
+install-info: install-info-am
+
+install-info-am:
+
+install-man:
+
+install-pdf: install-pdf-am
+
+install-pdf-am:
+
+install-ps: install-ps-am
+
+install-ps-am:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool
+
+pdf: pdf-am
+
+pdf-am:
+
+ps: ps-am
+
+ps-am:
+
+uninstall-am: uninstall-toolexeclibLTLIBRARIES
+
+.MAKE: all check install install-am install-strip
+
+.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
+	clean-libtool clean-toolexeclibLTLIBRARIES cscopelist-am ctags \
+	ctags-am distclean distclean-compile distclean-generic \
+	distclean-libtool distclean-tags dvi dvi-am html html-am info \
+	info-am install install-am install-data install-data-am \
+	install-data-local install-dvi install-dvi-am install-exec \
+	install-exec-am install-html install-html-am install-info \
+	install-info-am install-man install-pdf install-pdf-am \
+	install-ps install-ps-am install-strip \
+	install-toolexeclibLTLIBRARIES installcheck installcheck-am \
+	installdirs maintainer-clean maintainer-clean-generic \
+	mostlyclean mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \
+	uninstall-am uninstall-toolexeclibLTLIBRARIES
+
+.PRECIOUS: Makefile
+
+
+@BUILD_ISOLIB_TRUE@SYSTEM.def: Makefile
+@BUILD_ISOLIB_TRUE@	bash $(GM2_SRC)/tools-src/makeSystem -fiso \
+@BUILD_ISOLIB_TRUE@             $(GM2_SRC)/gm2-libs-iso/SYSTEM.def \
+@BUILD_ISOLIB_TRUE@             $(GM2_SRC)/gm2-libs-iso/SYSTEM.mod \
+@BUILD_ISOLIB_TRUE@             -I$(GM2_SRC)/gm2-libs-iso:$(GM2_SRC)/gm2-libs \
+@BUILD_ISOLIB_TRUE@             "$(GM2_FOR_TARGET)" $@
+
+@BUILD_ISOLIB_TRUE@.mod.lo:
+@BUILD_ISOLIB_TRUE@	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2iso_la_M2FLAGS) $< -o $@
+
+@BUILD_ISOLIB_TRUE@.c.lo:
+@BUILD_ISOLIB_TRUE@	$(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
+@BUILD_ISOLIB_TRUE@.cc.lo:
+@BUILD_ISOLIB_TRUE@	$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
+@BUILD_ISOLIB_TRUE@install-data-local: force
+@BUILD_ISOLIB_TRUE@	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_ISOLIB_TRUE@	$(INSTALL_DATA) .libs/libm2iso.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_ISOLIB_TRUE@	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2iso.la
+@BUILD_ISOLIB_TRUE@	$(INSTALL_DATA) .libs/libm2iso.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_ISOLIB_TRUE@	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)/libm2iso.a
+@BUILD_ISOLIB_TRUE@	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)/libm2iso.a
+@BUILD_ISOLIB_TRUE@	for i in $(M2DEFS) $(M2MODS) ; do \
+@BUILD_ISOLIB_TRUE@           if [ -f $$i ] ; then \
+@BUILD_ISOLIB_TRUE@              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_ISOLIB_TRUE@           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-iso/$$i ] ; then \
+@BUILD_ISOLIB_TRUE@              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-iso/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_ISOLIB_TRUE@           else \
+@BUILD_ISOLIB_TRUE@              echo "cannot find $$i" ; exit 1 ; \
+@BUILD_ISOLIB_TRUE@           fi ; \
+@BUILD_ISOLIB_TRUE@           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+@BUILD_ISOLIB_TRUE@	done
+@BUILD_ISOLIB_TRUE@	for i in $(M2HEADER_FILES) ; do \
+@BUILD_ISOLIB_TRUE@           if [ -f @srcdir@/$$i ] ; then \
+@BUILD_ISOLIB_TRUE@              $(INSTALL_DATA) @srcdir@/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_ISOLIB_TRUE@           else \
+@BUILD_ISOLIB_TRUE@              echo "cannot find $$i" ; exit 1 ; \
+@BUILD_ISOLIB_TRUE@           fi ; \
+@BUILD_ISOLIB_TRUE@           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+@BUILD_ISOLIB_TRUE@	done
+
+@BUILD_ISOLIB_TRUE@force:
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgm2/libm2iso/RTco.cc b/libgm2/libm2iso/RTco.cc
new file mode 100644
index 00000000000..54c5078f03f
--- /dev/null
+++ b/libgm2/libm2iso/RTco.cc
@@ -0,0 +1,468 @@
+/* RTco.c provides minimal access to thread primitives.
+
+Copyright (C) 2019-2022 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 <unistd.h>
+#include <pthread.h>
+#include <sys/select.h>
+#include <stdlib.h>
+#include <m2rts.h>
+
+// #define TRACEON
+
+#define POOL
+#define SEM_POOL 10000
+#define THREAD_POOL 10000
+
+#define _GTHREAD_USE_COND_INIT_FUNC
+#include "gthr.h"
+
+/* Ensure that ANSI conform stdio is used.  This needs to be set
+   before any system header file is included.  */
+#if defined __MINGW32__
+#define _POSIX 1
+#define gm2_printf gnu_printf
+#else
+#define gm2_printf __printf__
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if defined(TRACEON)
+#define tprintf printf
+#else
+/* sizeof is not evaluated.  */
+#define tprintf (void)sizeof
+#endif
+
+typedef struct threadCB_s
+{
+  void (*proc) (void);
+  int execution;
+  pthread_t p;
+  int tid;
+  unsigned int interruptLevel;
+} threadCB;
+
+
+typedef struct threadSem_s
+{
+  __gthread_mutex_t mutex;
+  __gthread_cond_t counter;
+  int waiting;
+  int sem_value;
+} threadSem;
+
+static unsigned int nThreads = 0;
+static threadCB *threadArray = NULL;
+static unsigned int nSemaphores = 0;
+static threadSem **semArray = NULL;
+
+/* These are used to lock the above module data structures.  */
+static threadSem lock;
+static int initialized = FALSE;
+
+
+extern "C" int RTco_init (void);
+
+
+extern "C" void
+_M2_RTco_dep (void)
+{
+}
+
+extern "C" void
+_M2_RTco_init (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_RTco_fini (int argc, char *argv[], char *envp[])
+{
+}
+
+static void
+initSem (threadSem *sem, int value)
+{
+  __GTHREAD_COND_INIT_FUNCTION (&sem->counter);
+  __GTHREAD_MUTEX_INIT_FUNCTION (&sem->mutex);
+  sem->waiting = FALSE;
+  sem->sem_value = value;
+}
+
+static void
+waitSem (threadSem *sem)
+{
+  __gthread_mutex_lock (&sem->mutex);
+  if (sem->sem_value == 0)
+    {
+      sem->waiting = TRUE;
+      __gthread_cond_wait (&sem->counter, &sem->mutex);
+      sem->waiting = FALSE;
+    }
+  else
+    sem->sem_value--;
+  __gthread_mutex_unlock (&sem->mutex);
+}
+
+static void
+signalSem (threadSem *sem)
+{
+  __gthread_mutex_unlock (&sem->mutex);
+  if (sem->waiting)
+    __gthread_cond_signal (&sem->counter);
+  else
+    sem->sem_value++;
+  __gthread_mutex_unlock (&sem->mutex);
+}
+
+void stop (void) {}
+
+extern "C" void
+RTco_wait (int sid)
+{
+  RTco_init ();
+  tprintf ("wait %d\n", sid);
+  waitSem (semArray[sid]);
+}
+
+extern "C" void
+RTco_signal (int sid)
+{
+  RTco_init ();
+  tprintf ("signal %d\n", sid);
+  signalSem (semArray[sid]);
+}
+
+static int
+newSem (void)
+{
+#if defined(POOL)
+  semArray[nSemaphores]
+      = (threadSem *)malloc (sizeof (threadSem));
+  nSemaphores += 1;
+  if (nSemaphores == SEM_POOL)
+    M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+                "too many semaphores created");
+#else
+  threadSem *sem
+      = (threadSem *)malloc (sizeof (threadSem));
+
+  /* We need to be careful when using realloc as the lock (semaphore)
+     operators use the semaphore address.  So we keep an array of pointer
+     to semaphores.  */
+  if (nSemaphores == 0)
+    {
+      semArray = (threadSem **)malloc (sizeof (sem));
+      nSemaphores = 1;
+    }
+  else
+    {
+      nSemaphores += 1;
+      semArray = (threadSem **)realloc (semArray,
+					sizeof (sem) * nSemaphores);
+    }
+  semArray[nSemaphores - 1] = sem;
+#endif
+  return nSemaphores - 1;
+}
+
+static int
+initSemaphore (int value)
+{
+  int sid = newSem ();
+
+  initSem (semArray[sid], value);
+  tprintf ("%d = initSemaphore (%d)\n", sid, value);
+  return sid;
+}
+
+extern "C" int
+RTco_initSemaphore (int value)
+{
+  int sid;
+
+  RTco_init ();
+  waitSem (&lock);
+  sid = initSemaphore (value);
+  signalSem (&lock);
+  return sid;
+}
+
+/* signalThread signal the semaphore associated with thread tid.  */
+
+extern "C" void
+RTco_signalThread (int tid)
+{
+  int sem;
+  RTco_init ();
+  tprintf ("signalThread %d\n", tid);
+  waitSem (&lock);
+  sem = threadArray[tid].execution;
+  signalSem (&lock);
+  RTco_signal (sem);
+}
+
+/* waitThread wait on the semaphore associated with thread tid.  */
+
+extern "C" void
+RTco_waitThread (int tid)
+{
+  RTco_init ();
+  tprintf ("waitThread %d\n", tid);
+  RTco_wait (threadArray[tid].execution);
+}
+
+extern "C" int
+currentThread (void)
+{
+  int tid;
+
+  for (tid = 0; tid < nThreads; tid++)
+    if (pthread_self () == threadArray[tid].p)
+      return tid;
+  M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+              "failed to find currentThread");
+}
+
+extern "C" int
+RTco_currentThread (void)
+{
+  int tid;
+
+  RTco_init ();
+  waitSem (&lock);
+  tid = currentThread ();
+  tprintf ("currentThread %d\n", tid);
+  signalSem (&lock);
+  return tid;
+}
+
+/* currentInterruptLevel returns the interrupt level of the current thread.  */
+
+extern "C" unsigned int
+RTco_currentInterruptLevel (void)
+{
+  RTco_init ();
+  tprintf ("currentInterruptLevel %d\n",
+           threadArray[RTco_currentThread ()].interruptLevel);
+  return threadArray[RTco_currentThread ()].interruptLevel;
+}
+
+/* turninterrupts returns the old interrupt level and assigns the
+   interrupt level to newLevel.  */
+
+extern "C" unsigned int
+RTco_turnInterrupts (unsigned int newLevel)
+{
+  int tid = RTco_currentThread ();
+  unsigned int old = RTco_currentInterruptLevel ();
+
+  tprintf ("turnInterrupts from %d to %d\n", old, newLevel);
+  waitSem (&lock);
+  threadArray[tid].interruptLevel = newLevel;
+  signalSem (&lock);
+  return old;
+}
+
+static void
+never (void)
+{
+  M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+              "the main thread should never call here");
+}
+
+static void *
+execThread (void *t)
+{
+  threadCB *tp = (threadCB *)t;
+
+  tprintf ("exec thread tid = %d  function = 0x%p  arg = 0x%p\n", tp->tid,
+           tp->proc, t);
+  RTco_waitThread (
+      tp->tid); /* Forcing this thread to block, waiting to be scheduled.  */
+  tprintf ("  exec thread [%d]  function = 0x%p  arg = 0x%p\n", tp->tid,
+           tp->proc, t);
+  tp->proc (); /* Now execute user procedure.  */
+#if 0
+  M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing");
+#endif
+  M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "execThread should never finish");
+  return NULL;
+}
+
+static int
+newThread (void)
+{
+#if defined(POOL)
+  nThreads += 1;
+  if (nThreads == THREAD_POOL)
+    M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "too many threads created");
+  return nThreads - 1;
+#else
+  if (nThreads == 0)
+    {
+      threadArray = (threadCB *)malloc (sizeof (threadCB));
+      nThreads = 1;
+    }
+  else
+    {
+      nThreads += 1;
+      threadArray
+          = (threadCB *)realloc (threadArray, sizeof (threadCB) * nThreads);
+    }
+  return nThreads - 1;
+#endif
+}
+
+static int
+initThread (void (*proc) (void), unsigned int stackSize,
+            unsigned int interrupt)
+{
+  int tid = newThread ();
+  pthread_attr_t attr;
+  int result;
+
+  threadArray[tid].proc = proc;
+  threadArray[tid].tid = tid;
+  threadArray[tid].execution = initSemaphore (0);
+  threadArray[tid].interruptLevel = interrupt;
+
+  /* set thread creation attributes.  */
+  result = pthread_attr_init (&attr);
+  if (result != 0)
+    M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+                "failed to create thread attribute");
+
+  if (stackSize > 0)
+    {
+      result = pthread_attr_setstacksize (&attr, stackSize);
+      if (result != 0)
+        M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+                    "failed to set stack size attribute");
+    }
+
+  tprintf ("initThread [%d]  function = 0x%p  (arg = 0x%p)\n", tid, proc,
+           (void *)&threadArray[tid]);
+  result = pthread_create (&threadArray[tid].p, &attr, execThread,
+                           (void *)&threadArray[tid]);
+  if (result != 0)
+    M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "thread_create failed");
+  tprintf ("  created thread [%d]  function = 0x%p  0x%p\n", tid, proc,
+           (void *)&threadArray[tid]);
+  return tid;
+}
+
+extern "C" int
+RTco_initThread (void (*proc) (void), unsigned int stackSize,
+                 unsigned int interrupt)
+{
+  int tid;
+
+  RTco_init ();
+  waitSem (&lock);
+  tid = initThread (proc, stackSize, interrupt);
+  signalSem (&lock);
+  return tid;
+}
+
+/* transfer unlocks thread p2 and locks the current thread.  p1 is
+   updated with the current thread id.  */
+
+extern "C" void
+RTco_transfer (int *p1, int p2)
+{
+  int tid = currentThread ();
+
+  if (!initialized)
+    M2RTS_Halt (
+        __FILE__, __LINE__, __FUNCTION__,
+        "cannot transfer to a process before the process has been created");
+  if (tid == p2)
+    {
+      /* error.  */
+      M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+	      "attempting to transfer to ourself");
+    }
+  else
+    {
+      *p1 = tid;
+      tprintf ("start, context switching from: %d to %d\n", tid, p2);
+      RTco_signalThread (p2);
+      RTco_waitThread (tid);
+      tprintf ("end, context back to %d\n", tid);
+    }
+}
+
+extern "C" int
+RTco_select (int p1, fd_set *p2, fd_set *p3, fd_set *p4, const timespec *p5)
+{
+  RTco_init ();
+  tprintf ("[%x]  RTco.select (...)\n", pthread_self ());
+  return pselect (p1, p2, p3, p4, p5, NULL);
+}
+
+extern "C" int
+RTco_init (void)
+{
+  if (! initialized)
+    {
+      int tid;
+
+      tprintf ("RTco initialized\n");
+      initSem (&lock, 0);
+      /* Create initial thread container.  */
+#if defined(POOL)
+      threadArray = (threadCB *)malloc (sizeof (threadCB) * THREAD_POOL);
+      semArray = (threadSem **)malloc (sizeof (threadSem *) * SEM_POOL);
+#endif
+      tid = newThread ();  /* For the current initial thread.  */
+      threadArray[tid].tid = tid;
+      threadArray[tid].execution = initSemaphore (0);
+      threadArray[tid].p = pthread_self ();
+      threadArray[tid].interruptLevel = 0;
+      threadArray[tid].proc
+          = never;  /* This shouldn't happen as we are already running.  */
+      initialized = TRUE;
+      tprintf ("RTco initialized completed\n");
+      signalSem (&lock);
+    }
+  return 0;
+}
+
+struct _M2_RTco_ctor { _M2_RTco_ctor (); } _M2_RTco_ctor;
+
+_M2_RTco_ctor::_M2_RTco_ctor (void)
+{
+  M2RTS_RegisterModule ("RTco", _M2_RTco_init, _M2_RTco_fini,
+			_M2_RTco_dep);
+}
diff --git a/libgm2/libm2iso/m2rts.h b/libgm2/libm2iso/m2rts.h
new file mode 100644
index 00000000000..57e6e90d94d
--- /dev/null
+++ b/libgm2/libm2iso/m2rts.h
@@ -0,0 +1,41 @@
+/* m2rts.h provides a C interface to M2RTS.mod.
+
+Copyright (C) 2019-2022 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/>.  */
+
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
+extern "C" void M2RTS_RegisterModule (const char *modulename,
+				      proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void _M2_M2RTS_init (void);
+
+extern "C" void M2RTS_ConstructModules (const char *,
+					int argc, char *argv[], char *envp[]);
+extern "C" void M2RTS_Terminate (void);
+extern "C" void M2RTS_DeconstructModules (void);
+
+extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn));
diff --git a/libgm2/libm2iso/wrapsock.c b/libgm2/libm2iso/wrapsock.c
new file mode 100644
index 00000000000..79c2d89ddd3
--- /dev/null
+++ b/libgm2/libm2iso/wrapsock.c
@@ -0,0 +1,250 @@
+/* wrapsock.c provides access to socket related system calls.
+
+Copyright (C) 2008-2022 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"
+
+#if defined(HAVE_SYS_TYPES_H)
+#include "sys/types.h"
+#endif
+
+#if defined(HAVE_SYS_SOCKET_H)
+#include "sys/socket.h"
+#endif
+
+#if defined(HAVE_NETINET_IN_H)
+#include "netinet/in.h"
+#endif
+
+#if defined(HAVE_NETDB_H)
+#include "netdb.h"
+#endif
+
+#if defined(HAVE_UNISTD_H)
+#include "unistd.h"
+#endif
+
+#if defined(HAVE_SIGNAL_H)
+#include "signal.h"
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include "sys/errno.h"
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include "errno.h"
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#include "malloc.h"
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#include "signal.h"
+#endif
+
+#if defined(HAVE_STRING_H)
+#include "string.h"
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#include "stdlib.h"
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#include "ChanConsts.h"
+
+#define MAXHOSTNAME 1024
+#define MAXPBBUF 1024
+
+#if defined(HAVE_NETINET_IN_H)
+
+typedef struct
+{
+  char hostname[MAXHOSTNAME];
+  struct hostent *hp;
+  struct sockaddr_in sa;
+  int sockFd;
+  int portNo;
+  int hasChar;
+  char pbChar[MAXPBBUF];
+} clientInfo;
+
+static openResults clientConnect (clientInfo *c);
+
+/* clientOpen - returns an ISO Modula-2 OpenResult.  It attempts to
+   connect to: hostname:portNo.  If successful then the data
+   structure, c, will have its fields initialized.  */
+
+openResults
+wrapsock_clientOpen (clientInfo *c, char *hostname, unsigned int length,
+                     int portNo)
+{
+  /* remove SIGPIPE which is raised on the server if the client is killed.  */
+  signal (SIGPIPE, SIG_IGN);
+
+  c->hp = gethostbyname (hostname);
+  if (c->hp == NULL)
+    return noSuchFile;
+
+  memset ((void *)&c->sa, 0, sizeof (c->sa));
+  c->sa.sin_family = AF_INET;
+  memcpy ((void *)&c->sa.sin_addr, (void *)c->hp->h_addr, c->hp->h_length);
+  c->portNo = portNo;
+  c->sa.sin_port = htons (portNo);
+  c->hasChar = 0;
+  /* Open a TCP socket (an Internet stream socket) */
+
+  c->sockFd = socket (c->hp->h_addrtype, SOCK_STREAM, 0);
+  return clientConnect (c);
+}
+
+/* clientOpenIP - returns an ISO Modula-2 OpenResult.  It attempts to
+   connect to: ipaddress:portNo.  If successful then the data
+   structure, c, will have its fields initialized.  */
+
+openResults
+wrapsock_clientOpenIP (clientInfo *c, unsigned int ip, int portNo)
+{
+  /* remove SIGPIPE which is raised on the server if the client is killed.  */
+  signal (SIGPIPE, SIG_IGN);
+
+  memset ((void *)&c->sa, 0, sizeof (c->sa));
+  c->sa.sin_family = AF_INET;
+  memcpy ((void *)&c->sa.sin_addr, (void *)&ip, sizeof (ip));
+  c->portNo = portNo;
+  c->sa.sin_port = htons (portNo);
+
+  /* Open a TCP socket (an Internet stream socket) */
+
+  c->sockFd = socket (PF_INET, SOCK_STREAM, 0);
+  return clientConnect (c);
+}
+
+/* clientConnect - returns an ISO Modula-2 OpenResult once a connect
+   has been performed.  If successful the clientInfo will include the
+   file descriptor ready for read/write operations.  */
+
+static openResults
+clientConnect (clientInfo *c)
+{
+  if (connect (c->sockFd, (struct sockaddr *)&c->sa, sizeof (c->sa)) < 0)
+    return noSuchFile;
+
+  return opened;
+}
+
+/* getClientPortNo - returns the portNo from structure, c.  */
+
+int
+wrapsock_getClientPortNo (clientInfo *c)
+{
+  return c->portNo;
+}
+
+/* getClientHostname - fills in the hostname of the server the to
+   which the client is connecting.  */
+
+void
+wrapsock_getClientHostname (clientInfo *c, char *hostname, unsigned int high)
+{
+  strncpy (hostname, c->hostname, high + 1);
+}
+
+/* getClientSocketFd - returns the sockFd from structure, c.  */
+
+int
+wrapsock_getClientSocketFd (clientInfo *c)
+{
+  return c->sockFd;
+}
+
+/* getClientIP - returns the sockFd from structure, s.  */
+
+unsigned int
+wrapsock_getClientIP (clientInfo *c)
+{
+#if 0
+  printf("client ip = %s\n", inet_ntoa (c->sa.sin_addr.s_addr));
+#endif
+  return c->sa.sin_addr.s_addr;
+}
+
+/* getPushBackChar - returns TRUE if a pushed back character is
+   available.  */
+
+unsigned int
+wrapsock_getPushBackChar (clientInfo *c, char *ch)
+{
+  if (c->hasChar > 0)
+    {
+      c->hasChar--;
+      *ch = c->pbChar[c->hasChar];
+      return TRUE;
+    }
+  return FALSE;
+}
+
+/* setPushBackChar - returns TRUE if it is able to push back a
+   character.  */
+
+unsigned int
+wrapsock_setPushBackChar (clientInfo *c, char ch)
+{
+  if (c->hasChar == MAXPBBUF)
+    return FALSE;
+  c->pbChar[c->hasChar] = ch;
+  c->hasChar++;
+  return TRUE;
+}
+
+/* getSizeOfClientInfo - returns the sizeof (opaque data type).  */
+
+unsigned int
+wrapsock_getSizeOfClientInfo (void)
+{
+  return sizeof (clientInfo);
+}
+
+#endif
+
+/* GNU Modula-2 link fodder.  */
+
+void
+_M2_wrapsock_init (void)
+{
+}
+
+void
+_M2_wrapsock_fini (void)
+{
+}
diff --git a/libgm2/libm2iso/wraptime.c b/libgm2/libm2iso/wraptime.c
new file mode 100644
index 00000000000..6d6929b3c89
--- /dev/null
+++ b/libgm2/libm2iso/wraptime.c
@@ -0,0 +1,408 @@
+/* wraptime.c provides access to time related system calls.
+
+Copyright (C) 2009-2022 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"
+
+#if defined(HAVE_SYS_TYPES_H)
+#include "sys/types.h"
+#endif
+
+#if defined(HAVE_SYS_TIME_H)
+#include "sys/time.h"
+#endif
+
+#if defined(HAVE_TIME_H)
+#include "time.h"
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#include "malloc.h"
+#endif
+
+#if defined(HAVE_LIMITS_H)
+#include "limits.h"
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if !defined(NULL)
+#define NULL (void *)0
+#endif
+
+/* InitTimeval returns a newly created opaque type.  */
+
+#if defined(HAVE_TIMEVAL) && defined(HAVE_MALLOC_H)
+struct timeval *
+wraptime_InitTimeval (void)
+{
+  return (struct timeval *)malloc (sizeof (struct timeval));
+}
+#else
+void *
+wraptime_InitTimeval (void)
+{
+  return NULL;
+}
+#endif
+
+/* KillTimeval deallocates the memory associated with an opaque type.  */
+
+struct timeval *
+wraptime_KillTimeval (void *tv)
+{
+#if defined(HAVE_MALLOC_H)
+  free (tv);
+#endif
+  return NULL;
+}
+
+/* InitTimezone returns a newly created opaque type.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_MALLOC_H)
+struct timezone *
+wraptime_InitTimezone (void)
+{
+  return (struct timezone *)malloc (sizeof (struct timezone));
+}
+#else
+void *
+wraptime_InitTimezone (void)
+{
+  return NULL;
+}
+#endif
+
+/* KillTimezone - deallocates the memory associated with an opaque
+   type.  */
+
+struct timezone *
+wraptime_KillTimezone (struct timezone *tv)
+{
+#if defined(HAVE_MALLOC_H)
+  free (tv);
+#endif
+  return NULL;
+}
+
+/* InitTM - returns a newly created opaque type.  */
+
+#if defined(HAVE_STRUCT_TM) && defined(HAVE_MALLOC_H)
+struct tm *
+wraptime_InitTM (void)
+{
+  return (struct tm *)malloc (sizeof (struct tm));
+}
+#else
+void *
+wraptime_InitTM (void)
+{
+  return NULL;
+}
+#endif
+
+/* KillTM - deallocates the memory associated with an opaque type.  */
+
+struct tm *
+wraptime_KillTM (struct tm *tv)
+{
+#if defined(HAVE_MALLOC_H)
+  free (tv);
+#endif
+  return NULL;
+}
+
+/* gettimeofday - calls gettimeofday(2) with the same parameters, tv,
+   and, tz.  It returns 0 on success.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_GETTIMEOFDAY)
+int
+wraptime_gettimeofday (void *tv, struct timezone *tz)
+{
+  return gettimeofday (tv, tz);
+}
+#else
+int
+wraptime_gettimeofday (void *tv, void *tz)
+{
+  return -1;
+}
+#endif
+
+/* settimeofday - calls settimeofday(2) with the same parameters, tv,
+   and, tz.  It returns 0 on success.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_SETTIMEOFDAY)
+int
+wraptime_settimeofday (void *tv, struct timezone *tz)
+{
+  return settimeofday (tv, tz);
+}
+#else
+int
+wraptime_settimeofday (void *tv, void *tz)
+{
+  return -1;
+}
+#endif
+
+/* wraptime_GetFractions - returns the tv_usec field inside the
+   timeval structure.  */
+
+#if defined(HAVE_TIMEVAL)
+unsigned int
+wraptime_GetFractions (struct timeval *tv)
+{
+  return (unsigned int)tv->tv_usec;
+}
+#else
+unsigned int
+wraptime_GetFractions (void *tv)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* localtime_r - returns the tm parameter, m, after it has been
+   assigned with appropriate contents determined by, tv.  Notice that
+   this procedure function expects, timeval, as its first parameter
+   and not a time_t (as expected by the posix equivalent).  */
+
+#if defined(HAVE_TIMEVAL)
+struct tm *
+wraptime_localtime_r (struct timeval *tv, struct tm *m)
+{
+  return localtime_r (&tv->tv_sec, m);
+}
+#else
+struct tm *
+wraptime_localtime_r (void *tv, struct tm *m)
+{
+  return m;
+}
+#endif
+
+/* wraptime_GetYear - returns the year from the structure, m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetYear (struct tm *m)
+{
+  return m->tm_year;
+}
+#else
+unsigned int
+wraptime_GetYear (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetMonth - returns the month from the structure, m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetMonth (struct tm *m)
+{
+  return m->tm_mon;
+}
+#else
+unsigned int
+wraptime_GetMonth (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetDay - returns the day of the month from the structure,
+   m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetDay (struct tm *m)
+{
+  return m->tm_mday;
+}
+#else
+unsigned int
+wraptime_GetDay (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetHour - returns the hour of the day from the structure,
+   m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetHour (struct tm *m)
+{
+  return m->tm_hour;
+}
+#else
+unsigned int
+wraptime_GetHour (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetMinute - returns the minute within the hour from the
+   structure, m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetMinute (struct tm *m)
+{
+  return m->tm_min;
+}
+#else
+unsigned int
+wraptime_GetMinute (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetSecond - returns the seconds in the minute from the
+   structure, m.  The return value will always be in the range 0..59.
+   A leap minute of value 60 will be truncated to 59.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetSecond (struct tm *m)
+{
+  if (m->tm_sec == 60)
+    return 59;
+  else
+    return m->tm_sec;
+}
+#else
+unsigned int
+wraptime_GetSecond (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetSummerTime - returns true if summer time is in effect.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE)
+unsigned int
+wraptime_GetSummerTime (struct timezone *tz)
+{
+  return tz->tz_dsttime != 0;
+}
+#else
+unsigned int
+wraptime_GetSummerTime (void *tz)
+{
+  return FALSE;
+}
+#endif
+
+/* wraptime_GetDST - returns the number of minutes west of GMT.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE)
+int
+wraptime_GetDST (struct timezone *tz)
+{
+  return tz->tz_minuteswest;
+}
+#else
+int
+wraptime_GetDST (void *tz)
+{
+#if defined(INT_MIN)
+  return INT_MIN;
+#else
+  return (int)((unsigned int)-1);
+#endif
+}
+#endif
+
+/* SetTimezone - set the timezone field inside timeval, tv.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE)
+void
+wraptime_SetTimezone (struct timezone *tz, int zone, int minuteswest)
+{
+  tz->tz_dsttime = zone;
+  tz->tz_minuteswest = minuteswest;
+}
+#else
+void
+wraptime_SetTimezone (void *tz, int zone, int minuteswest)
+{
+}
+#endif
+
+/* SetTimeval - sets the fields in tm, t, with: second, minute, hour,
+   day, month, year, fractions.  */
+
+#if defined(HAVE_TIMEVAL)
+void
+wraptime_SetTimeval (struct tm *t, unsigned int second, unsigned int minute,
+                     unsigned int hour, unsigned int day, unsigned int month,
+                     unsigned int year, unsigned int yday, unsigned int wday,
+                     unsigned int isdst)
+{
+  t->tm_sec = second;
+  t->tm_min = minute;
+  t->tm_hour = hour;
+  t->tm_mday = day;
+  t->tm_mon = month;
+  t->tm_year = year;
+  t->tm_yday = yday;
+  t->tm_wday = wday;
+  t->tm_isdst = isdst;
+}
+#else
+void
+wraptime_SetTimeval (void *t, unsigned int second, unsigned int minute,
+                     unsigned int hour, unsigned int day, unsigned int month,
+                     unsigned int year, unsigned int yday, unsigned int wday,
+                     unsigned int isdst)
+{
+}
+#endif
+
+/* init - init/finish functions for the module */
+
+void
+_M2_wraptime_init ()
+{
+}
+void
+_M2_wraptime_fini ()
+{
+}
diff --git a/libgm2/libm2log/Break.c b/libgm2/libm2log/Break.c
new file mode 100644
index 00000000000..0b878d8c27e
--- /dev/null
+++ b/libgm2/libm2log/Break.c
@@ -0,0 +1,134 @@
+/* Break.c implements an interrupt handler for SIGINT.
+
+Copyright (C) 2004-2022 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>
+
+#if defined(HAVE_STDIO_H)
+#include <stdio.h>
+#endif
+
+#if defined(HAVE_STDARG_H)
+#include <stdarg.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#include <malloc.h>
+#endif
+
+typedef void (*PROC) (void);
+
+#if defined(HAVE_SIGNAL_H)
+#include <signal.h>
+
+struct plist
+{
+  PROC proc;
+  struct plist *next;
+};
+
+static struct plist *head = NULL;
+
+/* localHandler - dismisses the parameter, p, and invokes the GNU
+   Modula-2 handler.  */
+
+static void
+localHandler (int p)
+{
+  if (head != NULL)
+    head->proc ();
+}
+
+/* EnableBreak - enable the current break handler.  */
+
+void
+Break_EnableBreak (void)
+{
+  signal (SIGINT, localHandler);
+}
+
+/* DisableBreak - disable the current break handler (and all
+   installed handlers).  */
+
+void
+Break_DisableBreak (void)
+{
+  signal (SIGINT, SIG_IGN);
+}
+
+/* InstallBreak - installs a procedure, p, to be invoked when a
+   ctrl-c is caught.  Any number of these procedures may be stacked.
+   Only the top procedure is run when ctrl-c is caught.  */
+
+void
+Break_InstallBreak (PROC p)
+{
+  struct plist *q = (struct plist *)malloc (sizeof (struct plist));
+
+  if (q == NULL)
+    {
+      perror ("out of memory error in module Break");
+      exit (1);
+    }
+  q->next = head;
+  head = q;
+  head->proc = p;
+}
+
+/* UnInstallBreak - pops the break handler stack.  */
+
+void
+Break_UnInstallBreak (void)
+{
+  struct plist *q = head;
+
+  if (head != NULL)
+    {
+      head = head->next;
+      free (q);
+    }
+}
+#else
+void
+Break_EnableBreak (void)
+{
+}
+void
+Break_DisableBreak (void)
+{
+}
+void
+Break_InstallBreak (PROC *p)
+{
+}
+void
+Break_UnInstallBreak (void)
+{
+}
+#endif
diff --git a/libgm2/libm2log/Makefile.am b/libgm2/libm2log/Makefile.am
new file mode 100644
index 00000000000..728a179a5fd
--- /dev/null
+++ b/libgm2/libm2log/Makefile.am
@@ -0,0 +1,166 @@
+# Makefile for libm2log.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-pim
+
+# Multilib support.
+MAKEOVERRIDES=
+
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+# Used to install the shared libgcc.
+slibdir = @slibdir@
+
+toolexeclibdir=@toolexeclibdir@
+toolexecdir=@toolexecdir@
+GM2_FOR_TARGET=@GM2_FOR_TARGET@
+
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+
+
+if BUILD_LOGLIB
+M2DEFS = BitBlockOps.def  BitByteOps.def \
+         BitWordOps.def  BlockOps.def \
+         Break.def  CardinalIO.def \
+         Conversions.def  DebugPMD.def \
+         DebugTrace.def  Delay.def \
+         Display.def  ErrorCode.def \
+         FileSystem.def  FloatingUtilities.def \
+         InOut.def  Keyboard.def \
+         LongIO.def  NumberConversion.def \
+         Random.def  RealConversions.def \
+         RealInOut.def  Strings.def \
+         Termbase.def  Terminal.def \
+         TimeDate.def
+
+M2MODS = BitBlockOps.mod  BitByteOps.mod \
+         BitWordOps.mod  BlockOps.mod \
+         CardinalIO.mod  Conversions.mod \
+         DebugPMD.mod  DebugTrace.mod \
+         Delay.mod  Display.mod \
+         ErrorCode.mod  FileSystem.mod \
+         FloatingUtilities.mod  InOut.mod \
+         Keyboard.mod  LongIO.mod \
+         NumberConversion.mod  Random.mod \
+         RealConversions.mod  RealInOut.mod \
+         Strings.mod  Termbase.mod \
+         Terminal.mod  TimeDate.mod
+
+
+libm2logdir = libm2log
+toolexeclib_LTLIBRARIES = libm2log.la
+libm2log_la_SOURCES = $(M2MODS) Break.c
+
+libm2log_la_DEPENDENCIES = ../libm2pim/SYSTEM.def $(addsuffix .lo, $(basename $(libm2log_la_SOURCES)))
+libm2log_la_CFLAGS = -I. -DBUILD_GM2_LIBS -I@srcdir@/../
+libm2log_la_M2FLAGS = -I../libm2pim -I$(GM2_SRC)/gm2-libs-pim -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso
+libm2log_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+BUILT_SOURCES = ../libm2pim/SYSTEM.def
+
+M2LIBDIR = /m2/m2log/
+
+../libm2pim/SYSTEM.def: ../libm2pim/Makefile
+	cd ../libm2pim ; $(MAKE) $(AM_MAKEFLAGS) SYSTEM.def
+
+.mod.lo:
+	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2log_la_M2FLAGS) $< -o $@
+
+install-data-local: force
+	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	$(INSTALL_DATA) .libs/libm2log.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.la
+	$(INSTALL_DATA) .libs/libm2log.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.a
+	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.a
+	for i in $(M2DEFS) $(M2MODS) ; do \
+           if [ -f $$i ] ; then \
+              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-pim/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-pim/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+
+force:
+
+endif
diff --git a/libgm2/libm2log/Makefile.in b/libgm2/libm2log/Makefile.in
new file mode 100644
index 00000000000..be8a59d2a56
--- /dev/null
+++ b/libgm2/libm2log/Makefile.in
@@ -0,0 +1,803 @@
+# Makefile.in generated by automake 1.15.1 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994-2017 Free Software Foundation, Inc.
+
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+# Makefile for libm2log.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+am__is_gnu_make = { \
+  if test -z '$(MAKELEVEL)'; then \
+    false; \
+  elif test -n '$(MAKE_HOST)'; then \
+    true; \
+  elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
+    true; \
+  else \
+    false; \
+  fi; \
+}
+am__make_running_with_option = \
+  case $${target_option-} in \
+      ?) ;; \
+      *) echo "am__make_running_with_option: internal error: invalid" \
+              "target option '$${target_option-}' specified" >&2; \
+         exit 1;; \
+  esac; \
+  has_opt=no; \
+  sane_makeflags=$$MAKEFLAGS; \
+  if $(am__is_gnu_make); then \
+    sane_makeflags=$$MFLAGS; \
+  else \
+    case $$MAKEFLAGS in \
+      *\\[\ \	]*) \
+        bs=\\; \
+        sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
+          | sed "s/$$bs$$bs[$$bs $$bs	]*//g"`;; \
+    esac; \
+  fi; \
+  skip_next=no; \
+  strip_trailopt () \
+  { \
+    flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
+  }; \
+  for flg in $$sane_makeflags; do \
+    test $$skip_next = yes && { skip_next=no; continue; }; \
+    case $$flg in \
+      *=*|--*) continue;; \
+        -*I) strip_trailopt 'I'; skip_next=yes;; \
+      -*I?*) strip_trailopt 'I';; \
+        -*O) strip_trailopt 'O'; skip_next=yes;; \
+      -*O?*) strip_trailopt 'O';; \
+        -*l) strip_trailopt 'l'; skip_next=yes;; \
+      -*l?*) strip_trailopt 'l';; \
+      -[dEDm]) skip_next=yes;; \
+      -[JT]) skip_next=yes;; \
+    esac; \
+    case $$flg in \
+      *$$target_option*) has_opt=yes; break;; \
+    esac; \
+  done; \
+  test $$has_opt = yes
+am__make_dryrun = (target_option=n; $(am__make_running_with_option))
+am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
+pkgdatadir = $(datadir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkglibexecdir = $(libexecdir)/@PACKAGE@
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = $(program_transform_name)
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+build_triplet = @build@
+host_triplet = @host@
+target_triplet = @target@
+subdir = libm2log
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(top_srcdir)/../libtool.m4 \
+	$(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \
+	$(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \
+	$(top_srcdir)/../config/acx.m4 \
+	$(top_srcdir)/../config/depstand.m4 \
+	$(top_srcdir)/../config/lead-dot.m4 \
+	$(top_srcdir)/../config/multi.m4 \
+	$(top_srcdir)/../config/no-executables.m4 \
+	$(top_srcdir)/../config/override.m4 $(top_srcdir)/configure.ac
+am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
+	$(ACLOCAL_M4)
+DIST_COMMON = $(srcdir)/Makefile.am
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = $(top_builddir)/config.h
+CONFIG_CLEAN_FILES =
+CONFIG_CLEAN_VPATH_FILES =
+am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
+am__vpath_adj = case $$p in \
+    $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
+    *) f=$$p;; \
+  esac;
+am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
+am__install_max = 40
+am__nobase_strip_setup = \
+  srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
+am__nobase_strip = \
+  for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
+am__nobase_list = $(am__nobase_strip_setup); \
+  for p in $$list; do echo "$$p $$p"; done | \
+  sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
+  $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
+    if (++n[$$2] == $(am__install_max)) \
+      { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
+    END { for (dir in files) print dir, files[dir] }'
+am__base_list = \
+  sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
+  sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
+am__uninstall_files_from_dir = { \
+  test -z "$$files" \
+    || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
+    || { echo " ( cd '$$dir' && rm -f" $$files ")"; \
+         $(am__cd) "$$dir" && rm -f $$files; }; \
+  }
+am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
+LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
+libm2log_la_LIBADD =
+@BUILD_LOGLIB_TRUE@am__objects_1 = BitBlockOps.lo BitByteOps.lo \
+@BUILD_LOGLIB_TRUE@	BitWordOps.lo BlockOps.lo CardinalIO.lo \
+@BUILD_LOGLIB_TRUE@	Conversions.lo DebugPMD.lo DebugTrace.lo \
+@BUILD_LOGLIB_TRUE@	Delay.lo Display.lo ErrorCode.lo \
+@BUILD_LOGLIB_TRUE@	FileSystem.lo FloatingUtilities.lo InOut.lo \
+@BUILD_LOGLIB_TRUE@	Keyboard.lo LongIO.lo NumberConversion.lo \
+@BUILD_LOGLIB_TRUE@	Random.lo RealConversions.lo RealInOut.lo \
+@BUILD_LOGLIB_TRUE@	Strings.lo Termbase.lo Terminal.lo \
+@BUILD_LOGLIB_TRUE@	TimeDate.lo
+@BUILD_LOGLIB_TRUE@am_libm2log_la_OBJECTS = $(am__objects_1) \
+@BUILD_LOGLIB_TRUE@	libm2log_la-Break.lo
+libm2log_la_OBJECTS = $(am_libm2log_la_OBJECTS)
+@BUILD_LOGLIB_TRUE@am_libm2log_la_rpath = -rpath $(toolexeclibdir)
+AM_V_P = $(am__v_P_@AM_V@)
+am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
+am__v_P_0 = false
+am__v_P_1 = :
+AM_V_GEN = $(am__v_GEN_@AM_V@)
+am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
+am__v_GEN_0 = @echo "  GEN     " $@;
+am__v_GEN_1 = 
+AM_V_at = $(am__v_at_@AM_V@)
+am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
+am__v_at_0 = @
+am__v_at_1 = 
+DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
+depcomp = $(SHELL) $(top_srcdir)/../depcomp
+am__depfiles_maybe = depfiles
+am__mv = mv -f
+AM_V_lt = $(am__v_lt_@AM_V@)
+am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
+am__v_lt_0 = --silent
+am__v_lt_1 = 
+COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
+	$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
+	$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	$(AM_CFLAGS) $(CFLAGS)
+AM_V_CC = $(am__v_CC_@AM_V@)
+am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
+am__v_CC_0 = @echo "  CC      " $@;
+am__v_CC_1 = 
+CCLD = $(CC)
+LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
+	$(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_CCLD = $(am__v_CCLD_@AM_V@)
+am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
+am__v_CCLD_0 = @echo "  CCLD    " $@;
+am__v_CCLD_1 = 
+SOURCES = $(libm2log_la_SOURCES)
+am__can_run_installinfo = \
+  case $$AM_UPDATE_INFO_DIR in \
+    n|no|NO) false;; \
+    *) (install-info --version) >/dev/null 2>&1;; \
+  esac
+am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
+# Read a list of newline-separated strings from the standard input,
+# and print each of them once, without duplicates.  Input order is
+# *not* preserved.
+am__uniquify_input = $(AWK) '\
+  BEGIN { nonempty = 0; } \
+  { items[$$0] = 1; nonempty = 1; } \
+  END { if (nonempty) { for (i in items) print i; }; } \
+'
+# Make sure the list of sources is unique.  This is necessary because,
+# e.g., the same source file might be shared among _SOURCES variables
+# for different programs/libraries.
+am__define_uniq_tagged_files = \
+  list='$(am__tagged_files)'; \
+  unique=`for i in $$list; do \
+    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+  done | $(am__uniquify_input)`
+ETAGS = etags
+CTAGS = ctags
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-pim
+ACLOCAL = @ACLOCAL@
+AMTAR = @AMTAR@
+AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+AR = @AR@
+AUTOCONF = @AUTOCONF@
+AUTOHEADER = @AUTOHEADER@
+AUTOMAKE = @AUTOMAKE@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+CCASDEPMODE = @CCASDEPMODE@
+CCASFLAGS = @CCASFLAGS@
+CCDEPMODE = @CCDEPMODE@
+CC_FOR_BUILD = @CC_FOR_BUILD@
+CFLAGS = @CFLAGS@
+CPP = @CPP@
+CPPFLAGS = @CPPFLAGS@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+CXXDEPMODE = @CXXDEPMODE@
+CXXFLAGS = @CXXFLAGS@
+CYGPATH_W = @CYGPATH_W@
+DEFS = @DEFS@
+DEPDIR = @DEPDIR@
+DSYMUTIL = @DSYMUTIL@
+DUMPBIN = @DUMPBIN@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+EGREP = @EGREP@
+EXEEXT = @EXEEXT@
+FGREP = @FGREP@
+GM2_FOR_TARGET = @GM2_FOR_TARGET@
+GREP = @GREP@
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LD = @LD@
+LDFLAGS = @LDFLAGS@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LIBTOOL = @LIBTOOL@
+LIPO = @LIPO@
+LN_S = @LN_S@
+LTLIBOBJS = @LTLIBOBJS@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+MKDIR_P = @MKDIR_P@
+NM = @NM@
+NMEDIT = @NMEDIT@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+OTOOL = @OTOOL@
+OTOOL64 = @OTOOL64@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_URL = @PACKAGE_URL@
+PACKAGE_VERSION = @PACKAGE_VERSION@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+PERL = @PERL@
+RANLIB = @RANLIB@
+SED = @SED@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+STRIP = @STRIP@
+VERSION = @VERSION@
+abs_builddir = @abs_builddir@
+abs_srcdir = @abs_srcdir@
+abs_top_builddir = @abs_top_builddir@
+abs_top_srcdir = @abs_top_srcdir@
+ac_ct_CC = @ac_ct_CC@
+ac_ct_CXX = @ac_ct_CXX@
+ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
+am__include = @am__include@
+am__leading_dot = @am__leading_dot@
+am__quote = @am__quote@
+am__tar = @am__tar@
+am__untar = @am__untar@
+bindir = @bindir@
+build = @build@
+build_alias = @build_alias@
+build_cpu = @build_cpu@
+build_libsubdir = @build_libsubdir@
+build_os = @build_os@
+build_subdir = @build_subdir@
+build_vendor = @build_vendor@
+builddir = @builddir@
+datadir = @datadir@
+datarootdir = @datarootdir@
+docdir = @docdir@
+dvidir = @dvidir@
+enable_shared = @enable_shared@
+enable_static = @enable_static@
+exec_prefix = @exec_prefix@
+host = @host@
+host_alias = @host_alias@
+host_cpu = @host_cpu@
+host_noncanonical = @host_noncanonical@
+host_os = @host_os@
+host_subdir = @host_subdir@
+host_vendor = @host_vendor@
+htmldir = @htmldir@
+includedir = @includedir@
+infodir = @infodir@
+install_sh = @install_sh@
+libdir = @libdir@
+libexecdir = @libexecdir@
+libtool_VERSION = @libtool_VERSION@
+localedir = @localedir@
+localstatedir = @localstatedir@
+mandir = @mandir@
+mkdir_p = @mkdir_p@
+multi_basedir = @multi_basedir@
+oldincludedir = @oldincludedir@
+pdfdir = @pdfdir@
+prefix = @prefix@
+program_transform_name = @program_transform_name@
+psdir = @psdir@
+sbindir = @sbindir@
+sharedstatedir = @sharedstatedir@
+# Used to install the shared libgcc.
+slibdir = @slibdir@
+srcdir = @srcdir@
+sysconfdir = @sysconfdir@
+target = @target@
+target_alias = @target_alias@
+target_cpu = @target_cpu@
+target_noncanonical = @target_noncanonical@
+target_os = @target_os@
+target_subdir = @target_subdir@
+target_vendor = @target_vendor@
+toolexecdir = @toolexecdir@
+toolexeclibdir = @toolexeclibdir@
+top_build_prefix = @top_build_prefix@
+top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+# Multilib support.
+MAKEOVERRIDES = 
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+@BUILD_LOGLIB_TRUE@M2DEFS = BitBlockOps.def  BitByteOps.def \
+@BUILD_LOGLIB_TRUE@         BitWordOps.def  BlockOps.def \
+@BUILD_LOGLIB_TRUE@         Break.def  CardinalIO.def \
+@BUILD_LOGLIB_TRUE@         Conversions.def  DebugPMD.def \
+@BUILD_LOGLIB_TRUE@         DebugTrace.def  Delay.def \
+@BUILD_LOGLIB_TRUE@         Display.def  ErrorCode.def \
+@BUILD_LOGLIB_TRUE@         FileSystem.def  FloatingUtilities.def \
+@BUILD_LOGLIB_TRUE@         InOut.def  Keyboard.def \
+@BUILD_LOGLIB_TRUE@         LongIO.def  NumberConversion.def \
+@BUILD_LOGLIB_TRUE@         Random.def  RealConversions.def \
+@BUILD_LOGLIB_TRUE@         RealInOut.def  Strings.def \
+@BUILD_LOGLIB_TRUE@         Termbase.def  Terminal.def \
+@BUILD_LOGLIB_TRUE@         TimeDate.def
+
+@BUILD_LOGLIB_TRUE@M2MODS = BitBlockOps.mod  BitByteOps.mod \
+@BUILD_LOGLIB_TRUE@         BitWordOps.mod  BlockOps.mod \
+@BUILD_LOGLIB_TRUE@         CardinalIO.mod  Conversions.mod \
+@BUILD_LOGLIB_TRUE@         DebugPMD.mod  DebugTrace.mod \
+@BUILD_LOGLIB_TRUE@         Delay.mod  Display.mod \
+@BUILD_LOGLIB_TRUE@         ErrorCode.mod  FileSystem.mod \
+@BUILD_LOGLIB_TRUE@         FloatingUtilities.mod  InOut.mod \
+@BUILD_LOGLIB_TRUE@         Keyboard.mod  LongIO.mod \
+@BUILD_LOGLIB_TRUE@         NumberConversion.mod  Random.mod \
+@BUILD_LOGLIB_TRUE@         RealConversions.mod  RealInOut.mod \
+@BUILD_LOGLIB_TRUE@         Strings.mod  Termbase.mod \
+@BUILD_LOGLIB_TRUE@         Terminal.mod  TimeDate.mod
+
+@BUILD_LOGLIB_TRUE@libm2logdir = libm2log
+@BUILD_LOGLIB_TRUE@toolexeclib_LTLIBRARIES = libm2log.la
+@BUILD_LOGLIB_TRUE@libm2log_la_SOURCES = $(M2MODS) Break.c
+@BUILD_LOGLIB_TRUE@libm2log_la_DEPENDENCIES = ../libm2pim/SYSTEM.def $(addsuffix .lo, $(basename $(libm2log_la_SOURCES)))
+@BUILD_LOGLIB_TRUE@libm2log_la_CFLAGS = -I. -DBUILD_GM2_LIBS -I@srcdir@/../
+@BUILD_LOGLIB_TRUE@libm2log_la_M2FLAGS = -I../libm2pim -I$(GM2_SRC)/gm2-libs-pim -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso
+@BUILD_LOGLIB_TRUE@libm2log_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+@BUILD_LOGLIB_TRUE@BUILT_SOURCES = ../libm2pim/SYSTEM.def
+@BUILD_LOGLIB_TRUE@M2LIBDIR = /m2/m2log/
+all: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) all-am
+
+.SUFFIXES:
+.SUFFIXES: .c .mod .def .o .obj .lo .a .la
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am  $(am__configure_deps)
+	@for dep in $?; do \
+	  case '$(am__configure_deps)' in \
+	    *$$dep*) \
+	      ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
+	        && { if test -f $@; then exit 0; else break; fi; }; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign libm2log/Makefile'; \
+	$(am__cd) $(top_srcdir) && \
+	  $(AUTOMAKE) --foreign libm2log/Makefile
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+	@case '$?' in \
+	  *config.status*) \
+	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
+	  *) \
+	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
+	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
+	esac;
+
+$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+
+$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(am__aclocal_m4_deps):
+
+install-toolexeclibLTLIBRARIES: $(toolexeclib_LTLIBRARIES)
+	@$(NORMAL_INSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	list2=; for p in $$list; do \
+	  if test -f $$p; then \
+	    list2="$$list2 $$p"; \
+	  else :; fi; \
+	done; \
+	test -z "$$list2" || { \
+	  echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(toolexeclibdir)"; \
+	}
+
+uninstall-toolexeclibLTLIBRARIES:
+	@$(NORMAL_UNINSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	for p in $$list; do \
+	  $(am__strip_dir) \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(toolexeclibdir)/$$f'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(toolexeclibdir)/$$f"; \
+	done
+
+clean-toolexeclibLTLIBRARIES:
+	-test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES)
+	@list='$(toolexeclib_LTLIBRARIES)'; \
+	locs=`for p in $$list; do echo $$p; done | \
+	      sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
+	      sort -u`; \
+	test -z "$$locs" || { \
+	  echo rm -f $${locs}; \
+	  rm -f $${locs}; \
+	}
+
+libm2log.la: $(libm2log_la_OBJECTS) $(libm2log_la_DEPENDENCIES) $(EXTRA_libm2log_la_DEPENDENCIES) 
+	$(AM_V_GEN)$(libm2log_la_LINK) $(am_libm2log_la_rpath) $(libm2log_la_OBJECTS) $(libm2log_la_LIBADD) $(LIBS)
+
+mostlyclean-compile:
+	-rm -f *.$(OBJEXT)
+
+distclean-compile:
+	-rm -f *.tab.c
+
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2log_la-Break.Plo@am__quote@
+
+.c.o:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $<
+
+.c.obj:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+.c.lo:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $<
+
+libm2log_la-Break.lo: Break.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2log_la_CFLAGS) $(CFLAGS) -MT libm2log_la-Break.lo -MD -MP -MF $(DEPDIR)/libm2log_la-Break.Tpo -c -o libm2log_la-Break.lo `test -f 'Break.c' || echo '$(srcdir)/'`Break.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libm2log_la-Break.Tpo $(DEPDIR)/libm2log_la-Break.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='Break.c' object='libm2log_la-Break.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2log_la_CFLAGS) $(CFLAGS) -c -o libm2log_la-Break.lo `test -f 'Break.c' || echo '$(srcdir)/'`Break.c
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+ID: $(am__tagged_files)
+	$(am__define_uniq_tagged_files); mkid -fID $$unique
+tags: tags-am
+TAGS: tags
+
+tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	set x; \
+	here=`pwd`; \
+	$(am__define_uniq_tagged_files); \
+	shift; \
+	if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
+	  test -n "$$unique" || unique=$$empty_fix; \
+	  if test $$# -gt 0; then \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      "$$@" $$unique; \
+	  else \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      $$unique; \
+	  fi; \
+	fi
+ctags: ctags-am
+
+CTAGS: ctags
+ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	$(am__define_uniq_tagged_files); \
+	test -z "$(CTAGS_ARGS)$$unique" \
+	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
+	     $$unique
+
+GTAGS:
+	here=`$(am__cd) $(top_builddir) && pwd` \
+	  && $(am__cd) $(top_srcdir) \
+	  && gtags -i $(GTAGS_ARGS) "$$here"
+cscopelist: cscopelist-am
+
+cscopelist-am: $(am__tagged_files)
+	list='$(am__tagged_files)'; \
+	case "$(srcdir)" in \
+	  [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
+	  *) sdir=$(subdir)/$(srcdir) ;; \
+	esac; \
+	for i in $$list; do \
+	  if test -f "$$i"; then \
+	    echo "$(subdir)/$$i"; \
+	  else \
+	    echo "$$sdir/$$i"; \
+	  fi; \
+	done >> $(top_builddir)/cscope.files
+
+distclean-tags:
+	-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
+check-am: all-am
+check: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) check-am
+all-am: Makefile $(LTLIBRARIES)
+installdirs:
+	for dir in "$(DESTDIR)$(toolexeclibdir)"; do \
+	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
+	done
+install: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+	if test -z '$(STRIP)'; then \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	      install; \
+	else \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	    "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
+	fi
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
+	-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
+
+maintainer-clean-generic:
+	@echo "This command is intended for maintainers to use"
+	@echo "it deletes files that may require special tools to rebuild."
+	-test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES)
+@BUILD_LOGLIB_FALSE@install-data-local:
+clean: clean-am
+
+clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \
+	mostlyclean-am
+
+distclean: distclean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+distclean-am: clean-am distclean-compile distclean-generic \
+	distclean-tags
+
+dvi: dvi-am
+
+dvi-am:
+
+html: html-am
+
+html-am:
+
+info: info-am
+
+info-am:
+
+install-data-am: install-data-local
+
+install-dvi: install-dvi-am
+
+install-dvi-am:
+
+install-exec-am: install-toolexeclibLTLIBRARIES
+
+install-html: install-html-am
+
+install-html-am:
+
+install-info: install-info-am
+
+install-info-am:
+
+install-man:
+
+install-pdf: install-pdf-am
+
+install-pdf-am:
+
+install-ps: install-ps-am
+
+install-ps-am:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool
+
+pdf: pdf-am
+
+pdf-am:
+
+ps: ps-am
+
+ps-am:
+
+uninstall-am: uninstall-toolexeclibLTLIBRARIES
+
+.MAKE: all check install install-am install-strip
+
+.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
+	clean-libtool clean-toolexeclibLTLIBRARIES cscopelist-am ctags \
+	ctags-am distclean distclean-compile distclean-generic \
+	distclean-libtool distclean-tags dvi dvi-am html html-am info \
+	info-am install install-am install-data install-data-am \
+	install-data-local install-dvi install-dvi-am install-exec \
+	install-exec-am install-html install-html-am install-info \
+	install-info-am install-man install-pdf install-pdf-am \
+	install-ps install-ps-am install-strip \
+	install-toolexeclibLTLIBRARIES installcheck installcheck-am \
+	installdirs maintainer-clean maintainer-clean-generic \
+	mostlyclean mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \
+	uninstall-am uninstall-toolexeclibLTLIBRARIES
+
+.PRECIOUS: Makefile
+
+
+@BUILD_LOGLIB_TRUE@../libm2pim/SYSTEM.def: ../libm2pim/Makefile
+@BUILD_LOGLIB_TRUE@	cd ../libm2pim ; $(MAKE) $(AM_MAKEFLAGS) SYSTEM.def
+
+@BUILD_LOGLIB_TRUE@.mod.lo:
+@BUILD_LOGLIB_TRUE@	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2log_la_M2FLAGS) $< -o $@
+
+@BUILD_LOGLIB_TRUE@install-data-local: force
+@BUILD_LOGLIB_TRUE@	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_LOGLIB_TRUE@	$(INSTALL_DATA) .libs/libm2log.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_LOGLIB_TRUE@	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.la
+@BUILD_LOGLIB_TRUE@	$(INSTALL_DATA) .libs/libm2log.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_LOGLIB_TRUE@	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.a
+@BUILD_LOGLIB_TRUE@	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.a
+@BUILD_LOGLIB_TRUE@	for i in $(M2DEFS) $(M2MODS) ; do \
+@BUILD_LOGLIB_TRUE@           if [ -f $$i ] ; then \
+@BUILD_LOGLIB_TRUE@              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_LOGLIB_TRUE@           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-pim/$$i ] ; then \
+@BUILD_LOGLIB_TRUE@              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-pim/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_LOGLIB_TRUE@           else \
+@BUILD_LOGLIB_TRUE@              echo "cannot find $$i" ; exit 1 ; \
+@BUILD_LOGLIB_TRUE@           fi ; \
+@BUILD_LOGLIB_TRUE@           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+@BUILD_LOGLIB_TRUE@	done
+
+@BUILD_LOGLIB_TRUE@force:
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgm2/libm2min/Makefile.am b/libgm2/libm2min/Makefile.am
new file mode 100644
index 00000000000..667cca6f0aa
--- /dev/null
+++ b/libgm2/libm2min/Makefile.am
@@ -0,0 +1,147 @@
+# Makefile for libm2min.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+VPATH = . @srcdir@/../../gcc/m2/gm2-libs-min
+
+# Multilib support.
+MAKEOVERRIDES=
+
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+# Used to install the shared libgcc.
+slibdir = @slibdir@
+
+toolexeclibdir=@toolexeclibdir@
+toolexecdir=@toolexecdir@
+GM2_FOR_TARGET=@GM2_FOR_TARGET@
+
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+
+M2DEFS = libc.def  M2RTS.def \
+         SYSTEM.def
+
+M2MODS = M2RTS.mod  SYSTEM.mod
+
+libm2mindir = libm2min
+toolexeclib_LTLIBRARIES = libm2min.la
+libm2min_la_SOURCES = $(M2MODS) libc.c
+libm2min_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2min_la_SOURCES)))
+libm2min_la_CFLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs
+libm2min_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+   -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main
+libm2min_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+BUILT_SOURCES = SYSTEM.def
+CLEANFILES = SYSTEM.def
+
+M2LIBDIR = /m2/m2min/
+
+.mod.lo:
+	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2min_la_M2FLAGS) $< -o $@
+
+libc.o: $(GM2_SRC)/gm2-libs-min/libc.c
+
+
+SYSTEM.def: Makefile
+	echo "CC = $(CC_FOR_BUILD)  CC_FOR_TARGET = $(CC_FOR_TARGET)  GM2 = $(GM2)  GM2_FOR_TARGET = $(GM2_FOR_TARGET) GM2_FOR_BUILD = $(GM2_FOR_BUILD)"
+	bash $(GM2_SRC)/tools-src/makeSystem -fpim \
+             $(GM2_SRC)/gm2-libs-min/SYSTEM.def \
+             $(GM2_SRC)/gm2-libs-min/SYSTEM.mod \
+             -I$(GM2_SRC)/gm2-libs-min:$(GM2_SRC)/gm2-libs \
+             "$(GM2_FOR_TARGET) -fno-exceptions" $@
+
+install-data-local: force
+	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	$(INSTALL_DATA) .libs/libm2min.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.la
+	$(INSTALL_DATA) .libs/libm2min.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.a
+	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.a
+	for i in $(M2DEFS) $(M2MODS) ; do \
+           if [ -f $$i ] ; then \
+              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-min/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-min/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+
+force:
diff --git a/libgm2/libm2min/Makefile.in b/libgm2/libm2min/Makefile.in
new file mode 100644
index 00000000000..8210c2e2fa9
--- /dev/null
+++ b/libgm2/libm2min/Makefile.in
@@ -0,0 +1,779 @@
+# Makefile.in generated by automake 1.15.1 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994-2017 Free Software Foundation, Inc.
+
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+# Makefile for libm2min.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+am__is_gnu_make = { \
+  if test -z '$(MAKELEVEL)'; then \
+    false; \
+  elif test -n '$(MAKE_HOST)'; then \
+    true; \
+  elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
+    true; \
+  else \
+    false; \
+  fi; \
+}
+am__make_running_with_option = \
+  case $${target_option-} in \
+      ?) ;; \
+      *) echo "am__make_running_with_option: internal error: invalid" \
+              "target option '$${target_option-}' specified" >&2; \
+         exit 1;; \
+  esac; \
+  has_opt=no; \
+  sane_makeflags=$$MAKEFLAGS; \
+  if $(am__is_gnu_make); then \
+    sane_makeflags=$$MFLAGS; \
+  else \
+    case $$MAKEFLAGS in \
+      *\\[\ \	]*) \
+        bs=\\; \
+        sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
+          | sed "s/$$bs$$bs[$$bs $$bs	]*//g"`;; \
+    esac; \
+  fi; \
+  skip_next=no; \
+  strip_trailopt () \
+  { \
+    flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
+  }; \
+  for flg in $$sane_makeflags; do \
+    test $$skip_next = yes && { skip_next=no; continue; }; \
+    case $$flg in \
+      *=*|--*) continue;; \
+        -*I) strip_trailopt 'I'; skip_next=yes;; \
+      -*I?*) strip_trailopt 'I';; \
+        -*O) strip_trailopt 'O'; skip_next=yes;; \
+      -*O?*) strip_trailopt 'O';; \
+        -*l) strip_trailopt 'l'; skip_next=yes;; \
+      -*l?*) strip_trailopt 'l';; \
+      -[dEDm]) skip_next=yes;; \
+      -[JT]) skip_next=yes;; \
+    esac; \
+    case $$flg in \
+      *$$target_option*) has_opt=yes; break;; \
+    esac; \
+  done; \
+  test $$has_opt = yes
+am__make_dryrun = (target_option=n; $(am__make_running_with_option))
+am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
+pkgdatadir = $(datadir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkglibexecdir = $(libexecdir)/@PACKAGE@
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = $(program_transform_name)
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+build_triplet = @build@
+host_triplet = @host@
+target_triplet = @target@
+subdir = libm2min
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(top_srcdir)/../libtool.m4 \
+	$(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \
+	$(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \
+	$(top_srcdir)/../config/acx.m4 \
+	$(top_srcdir)/../config/depstand.m4 \
+	$(top_srcdir)/../config/lead-dot.m4 \
+	$(top_srcdir)/../config/multi.m4 \
+	$(top_srcdir)/../config/no-executables.m4 \
+	$(top_srcdir)/../config/override.m4 $(top_srcdir)/configure.ac
+am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
+	$(ACLOCAL_M4)
+DIST_COMMON = $(srcdir)/Makefile.am
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = $(top_builddir)/config.h
+CONFIG_CLEAN_FILES =
+CONFIG_CLEAN_VPATH_FILES =
+am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
+am__vpath_adj = case $$p in \
+    $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
+    *) f=$$p;; \
+  esac;
+am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
+am__install_max = 40
+am__nobase_strip_setup = \
+  srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
+am__nobase_strip = \
+  for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
+am__nobase_list = $(am__nobase_strip_setup); \
+  for p in $$list; do echo "$$p $$p"; done | \
+  sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
+  $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
+    if (++n[$$2] == $(am__install_max)) \
+      { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
+    END { for (dir in files) print dir, files[dir] }'
+am__base_list = \
+  sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
+  sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
+am__uninstall_files_from_dir = { \
+  test -z "$$files" \
+    || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
+    || { echo " ( cd '$$dir' && rm -f" $$files ")"; \
+         $(am__cd) "$$dir" && rm -f $$files; }; \
+  }
+am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
+LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
+libm2min_la_LIBADD =
+am__objects_1 = M2RTS.lo SYSTEM.lo
+am_libm2min_la_OBJECTS = $(am__objects_1) libm2min_la-libc.lo
+libm2min_la_OBJECTS = $(am_libm2min_la_OBJECTS)
+AM_V_P = $(am__v_P_@AM_V@)
+am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
+am__v_P_0 = false
+am__v_P_1 = :
+AM_V_GEN = $(am__v_GEN_@AM_V@)
+am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
+am__v_GEN_0 = @echo "  GEN     " $@;
+am__v_GEN_1 = 
+AM_V_at = $(am__v_at_@AM_V@)
+am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
+am__v_at_0 = @
+am__v_at_1 = 
+DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
+depcomp = $(SHELL) $(top_srcdir)/../depcomp
+am__depfiles_maybe = depfiles
+am__mv = mv -f
+AM_V_lt = $(am__v_lt_@AM_V@)
+am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
+am__v_lt_0 = --silent
+am__v_lt_1 = 
+COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
+	$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
+	$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	$(AM_CFLAGS) $(CFLAGS)
+AM_V_CC = $(am__v_CC_@AM_V@)
+am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
+am__v_CC_0 = @echo "  CC      " $@;
+am__v_CC_1 = 
+CCLD = $(CC)
+LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
+	$(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_CCLD = $(am__v_CCLD_@AM_V@)
+am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
+am__v_CCLD_0 = @echo "  CCLD    " $@;
+am__v_CCLD_1 = 
+SOURCES = $(libm2min_la_SOURCES)
+am__can_run_installinfo = \
+  case $$AM_UPDATE_INFO_DIR in \
+    n|no|NO) false;; \
+    *) (install-info --version) >/dev/null 2>&1;; \
+  esac
+am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
+# Read a list of newline-separated strings from the standard input,
+# and print each of them once, without duplicates.  Input order is
+# *not* preserved.
+am__uniquify_input = $(AWK) '\
+  BEGIN { nonempty = 0; } \
+  { items[$$0] = 1; nonempty = 1; } \
+  END { if (nonempty) { for (i in items) print i; }; } \
+'
+# Make sure the list of sources is unique.  This is necessary because,
+# e.g., the same source file might be shared among _SOURCES variables
+# for different programs/libraries.
+am__define_uniq_tagged_files = \
+  list='$(am__tagged_files)'; \
+  unique=`for i in $$list; do \
+    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+  done | $(am__uniquify_input)`
+ETAGS = etags
+CTAGS = ctags
+VPATH = . @srcdir@/../../gcc/m2/gm2-libs-min
+ACLOCAL = @ACLOCAL@
+AMTAR = @AMTAR@
+AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+AR = @AR@
+AUTOCONF = @AUTOCONF@
+AUTOHEADER = @AUTOHEADER@
+AUTOMAKE = @AUTOMAKE@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+CCASDEPMODE = @CCASDEPMODE@
+CCASFLAGS = @CCASFLAGS@
+CCDEPMODE = @CCDEPMODE@
+CC_FOR_BUILD = @CC_FOR_BUILD@
+CFLAGS = @CFLAGS@
+CPP = @CPP@
+CPPFLAGS = @CPPFLAGS@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+CXXDEPMODE = @CXXDEPMODE@
+CXXFLAGS = @CXXFLAGS@
+CYGPATH_W = @CYGPATH_W@
+DEFS = @DEFS@
+DEPDIR = @DEPDIR@
+DSYMUTIL = @DSYMUTIL@
+DUMPBIN = @DUMPBIN@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+EGREP = @EGREP@
+EXEEXT = @EXEEXT@
+FGREP = @FGREP@
+GM2_FOR_TARGET = @GM2_FOR_TARGET@
+GREP = @GREP@
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LD = @LD@
+LDFLAGS = @LDFLAGS@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LIBTOOL = @LIBTOOL@
+LIPO = @LIPO@
+LN_S = @LN_S@
+LTLIBOBJS = @LTLIBOBJS@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+MKDIR_P = @MKDIR_P@
+NM = @NM@
+NMEDIT = @NMEDIT@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+OTOOL = @OTOOL@
+OTOOL64 = @OTOOL64@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_URL = @PACKAGE_URL@
+PACKAGE_VERSION = @PACKAGE_VERSION@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+PERL = @PERL@
+RANLIB = @RANLIB@
+SED = @SED@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+STRIP = @STRIP@
+VERSION = @VERSION@
+abs_builddir = @abs_builddir@
+abs_srcdir = @abs_srcdir@
+abs_top_builddir = @abs_top_builddir@
+abs_top_srcdir = @abs_top_srcdir@
+ac_ct_CC = @ac_ct_CC@
+ac_ct_CXX = @ac_ct_CXX@
+ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
+am__include = @am__include@
+am__leading_dot = @am__leading_dot@
+am__quote = @am__quote@
+am__tar = @am__tar@
+am__untar = @am__untar@
+bindir = @bindir@
+build = @build@
+build_alias = @build_alias@
+build_cpu = @build_cpu@
+build_libsubdir = @build_libsubdir@
+build_os = @build_os@
+build_subdir = @build_subdir@
+build_vendor = @build_vendor@
+builddir = @builddir@
+datadir = @datadir@
+datarootdir = @datarootdir@
+docdir = @docdir@
+dvidir = @dvidir@
+enable_shared = @enable_shared@
+enable_static = @enable_static@
+exec_prefix = @exec_prefix@
+host = @host@
+host_alias = @host_alias@
+host_cpu = @host_cpu@
+host_noncanonical = @host_noncanonical@
+host_os = @host_os@
+host_subdir = @host_subdir@
+host_vendor = @host_vendor@
+htmldir = @htmldir@
+includedir = @includedir@
+infodir = @infodir@
+install_sh = @install_sh@
+libdir = @libdir@
+libexecdir = @libexecdir@
+libtool_VERSION = @libtool_VERSION@
+localedir = @localedir@
+localstatedir = @localstatedir@
+mandir = @mandir@
+mkdir_p = @mkdir_p@
+multi_basedir = @multi_basedir@
+oldincludedir = @oldincludedir@
+pdfdir = @pdfdir@
+prefix = @prefix@
+program_transform_name = @program_transform_name@
+psdir = @psdir@
+sbindir = @sbindir@
+sharedstatedir = @sharedstatedir@
+# Used to install the shared libgcc.
+slibdir = @slibdir@
+srcdir = @srcdir@
+sysconfdir = @sysconfdir@
+target = @target@
+target_alias = @target_alias@
+target_cpu = @target_cpu@
+target_noncanonical = @target_noncanonical@
+target_os = @target_os@
+target_subdir = @target_subdir@
+target_vendor = @target_vendor@
+toolexecdir = @toolexecdir@
+toolexeclibdir = @toolexeclibdir@
+top_build_prefix = @top_build_prefix@
+top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+# Multilib support.
+MAKEOVERRIDES = 
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+M2DEFS = libc.def  M2RTS.def \
+         SYSTEM.def
+
+M2MODS = M2RTS.mod  SYSTEM.mod
+libm2mindir = libm2min
+toolexeclib_LTLIBRARIES = libm2min.la
+libm2min_la_SOURCES = $(M2MODS) libc.c
+libm2min_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2min_la_SOURCES)))
+libm2min_la_CFLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs
+libm2min_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+   -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main
+
+libm2min_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+BUILT_SOURCES = SYSTEM.def
+CLEANFILES = SYSTEM.def
+M2LIBDIR = /m2/m2min/
+all: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) all-am
+
+.SUFFIXES:
+.SUFFIXES: .c .mod .def .o .obj .lo .a .la
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am  $(am__configure_deps)
+	@for dep in $?; do \
+	  case '$(am__configure_deps)' in \
+	    *$$dep*) \
+	      ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
+	        && { if test -f $@; then exit 0; else break; fi; }; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign libm2min/Makefile'; \
+	$(am__cd) $(top_srcdir) && \
+	  $(AUTOMAKE) --foreign libm2min/Makefile
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+	@case '$?' in \
+	  *config.status*) \
+	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
+	  *) \
+	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
+	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
+	esac;
+
+$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+
+$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(am__aclocal_m4_deps):
+
+install-toolexeclibLTLIBRARIES: $(toolexeclib_LTLIBRARIES)
+	@$(NORMAL_INSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	list2=; for p in $$list; do \
+	  if test -f $$p; then \
+	    list2="$$list2 $$p"; \
+	  else :; fi; \
+	done; \
+	test -z "$$list2" || { \
+	  echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(toolexeclibdir)"; \
+	}
+
+uninstall-toolexeclibLTLIBRARIES:
+	@$(NORMAL_UNINSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	for p in $$list; do \
+	  $(am__strip_dir) \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(toolexeclibdir)/$$f'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(toolexeclibdir)/$$f"; \
+	done
+
+clean-toolexeclibLTLIBRARIES:
+	-test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES)
+	@list='$(toolexeclib_LTLIBRARIES)'; \
+	locs=`for p in $$list; do echo $$p; done | \
+	      sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
+	      sort -u`; \
+	test -z "$$locs" || { \
+	  echo rm -f $${locs}; \
+	  rm -f $${locs}; \
+	}
+
+libm2min.la: $(libm2min_la_OBJECTS) $(libm2min_la_DEPENDENCIES) $(EXTRA_libm2min_la_DEPENDENCIES) 
+	$(AM_V_GEN)$(libm2min_la_LINK) -rpath $(toolexeclibdir) $(libm2min_la_OBJECTS) $(libm2min_la_LIBADD) $(LIBS)
+
+mostlyclean-compile:
+	-rm -f *.$(OBJEXT)
+
+distclean-compile:
+	-rm -f *.tab.c
+
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2min_la-libc.Plo@am__quote@
+
+.c.o:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $<
+
+.c.obj:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+.c.lo:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $<
+
+libm2min_la-libc.lo: libc.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2min_la_CFLAGS) $(CFLAGS) -MT libm2min_la-libc.lo -MD -MP -MF $(DEPDIR)/libm2min_la-libc.Tpo -c -o libm2min_la-libc.lo `test -f 'libc.c' || echo '$(srcdir)/'`libc.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libm2min_la-libc.Tpo $(DEPDIR)/libm2min_la-libc.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='libc.c' object='libm2min_la-libc.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2min_la_CFLAGS) $(CFLAGS) -c -o libm2min_la-libc.lo `test -f 'libc.c' || echo '$(srcdir)/'`libc.c
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+ID: $(am__tagged_files)
+	$(am__define_uniq_tagged_files); mkid -fID $$unique
+tags: tags-am
+TAGS: tags
+
+tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	set x; \
+	here=`pwd`; \
+	$(am__define_uniq_tagged_files); \
+	shift; \
+	if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
+	  test -n "$$unique" || unique=$$empty_fix; \
+	  if test $$# -gt 0; then \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      "$$@" $$unique; \
+	  else \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      $$unique; \
+	  fi; \
+	fi
+ctags: ctags-am
+
+CTAGS: ctags
+ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	$(am__define_uniq_tagged_files); \
+	test -z "$(CTAGS_ARGS)$$unique" \
+	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
+	     $$unique
+
+GTAGS:
+	here=`$(am__cd) $(top_builddir) && pwd` \
+	  && $(am__cd) $(top_srcdir) \
+	  && gtags -i $(GTAGS_ARGS) "$$here"
+cscopelist: cscopelist-am
+
+cscopelist-am: $(am__tagged_files)
+	list='$(am__tagged_files)'; \
+	case "$(srcdir)" in \
+	  [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
+	  *) sdir=$(subdir)/$(srcdir) ;; \
+	esac; \
+	for i in $$list; do \
+	  if test -f "$$i"; then \
+	    echo "$(subdir)/$$i"; \
+	  else \
+	    echo "$$sdir/$$i"; \
+	  fi; \
+	done >> $(top_builddir)/cscope.files
+
+distclean-tags:
+	-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
+check-am: all-am
+check: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) check-am
+all-am: Makefile $(LTLIBRARIES)
+installdirs:
+	for dir in "$(DESTDIR)$(toolexeclibdir)"; do \
+	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
+	done
+install: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+	if test -z '$(STRIP)'; then \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	      install; \
+	else \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	    "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
+	fi
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
+	-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
+
+maintainer-clean-generic:
+	@echo "This command is intended for maintainers to use"
+	@echo "it deletes files that may require special tools to rebuild."
+	-test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES)
+clean: clean-am
+
+clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \
+	mostlyclean-am
+
+distclean: distclean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+distclean-am: clean-am distclean-compile distclean-generic \
+	distclean-tags
+
+dvi: dvi-am
+
+dvi-am:
+
+html: html-am
+
+html-am:
+
+info: info-am
+
+info-am:
+
+install-data-am: install-data-local
+
+install-dvi: install-dvi-am
+
+install-dvi-am:
+
+install-exec-am: install-toolexeclibLTLIBRARIES
+
+install-html: install-html-am
+
+install-html-am:
+
+install-info: install-info-am
+
+install-info-am:
+
+install-man:
+
+install-pdf: install-pdf-am
+
+install-pdf-am:
+
+install-ps: install-ps-am
+
+install-ps-am:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool
+
+pdf: pdf-am
+
+pdf-am:
+
+ps: ps-am
+
+ps-am:
+
+uninstall-am: uninstall-toolexeclibLTLIBRARIES
+
+.MAKE: all check install install-am install-strip
+
+.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
+	clean-libtool clean-toolexeclibLTLIBRARIES cscopelist-am ctags \
+	ctags-am distclean distclean-compile distclean-generic \
+	distclean-libtool distclean-tags dvi dvi-am html html-am info \
+	info-am install install-am install-data install-data-am \
+	install-data-local install-dvi install-dvi-am install-exec \
+	install-exec-am install-html install-html-am install-info \
+	install-info-am install-man install-pdf install-pdf-am \
+	install-ps install-ps-am install-strip \
+	install-toolexeclibLTLIBRARIES installcheck installcheck-am \
+	installdirs maintainer-clean maintainer-clean-generic \
+	mostlyclean mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \
+	uninstall-am uninstall-toolexeclibLTLIBRARIES
+
+.PRECIOUS: Makefile
+
+
+.mod.lo:
+	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2min_la_M2FLAGS) $< -o $@
+
+libc.o: $(GM2_SRC)/gm2-libs-min/libc.c
+
+SYSTEM.def: Makefile
+	echo "CC = $(CC_FOR_BUILD)  CC_FOR_TARGET = $(CC_FOR_TARGET)  GM2 = $(GM2)  GM2_FOR_TARGET = $(GM2_FOR_TARGET) GM2_FOR_BUILD = $(GM2_FOR_BUILD)"
+	bash $(GM2_SRC)/tools-src/makeSystem -fpim \
+             $(GM2_SRC)/gm2-libs-min/SYSTEM.def \
+             $(GM2_SRC)/gm2-libs-min/SYSTEM.mod \
+             -I$(GM2_SRC)/gm2-libs-min:$(GM2_SRC)/gm2-libs \
+             "$(GM2_FOR_TARGET) -fno-exceptions" $@
+
+install-data-local: force
+	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	$(INSTALL_DATA) .libs/libm2min.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.la
+	$(INSTALL_DATA) .libs/libm2min.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.a
+	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.a
+	for i in $(M2DEFS) $(M2MODS) ; do \
+           if [ -f $$i ] ; then \
+              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-min/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-min/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+
+force:
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgm2/libm2min/libc.c b/libgm2/libm2min/libc.c
new file mode 100644
index 00000000000..2e4f8d3ebab
--- /dev/null
+++ b/libgm2/libm2min/libc.c
@@ -0,0 +1,43 @@
+/* libc.c provides minimal stubs for expected symbols used by the rts.
+
+Copyright (C) 2010-2022 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>
+
+#if defined(HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+
+void abort (void)
+{
+  /* you should add your system dependant code here.  */
+  __builtin_unreachable ();
+}
+
+void exit (int i)
+{
+  /* you should add your system dependant code here.  */
+  __builtin_unreachable ();
+}
diff --git a/libgm2/libm2pim/Makefile.am b/libgm2/libm2pim/Makefile.am
new file mode 100644
index 00000000000..aa5904bb04e
--- /dev/null
+++ b/libgm2/libm2pim/Makefile.am
@@ -0,0 +1,209 @@
+# Makefile for libm2pim.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs
+
+# Multilib support.
+MAKEOVERRIDES=
+
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+# Used to install the shared libgcc.
+slibdir = @slibdir@
+
+toolexeclibdir=@toolexeclibdir@
+toolexecdir=@toolexecdir@
+GM2_FOR_TARGET=@GM2_FOR_TARGET@
+
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+
+if BUILD_PIMLIB
+toolexeclib_LTLIBRARIES = libm2pim.la
+
+M2MODS = ASCII.mod IO.mod \
+       Args.mod M2RTS.mod \
+       M2Dependent.mod \
+       Assertion.mod NumberIO.mod \
+       Break.mod SYSTEM.mod \
+       CmdArgs.mod Scan.mod \
+       StrCase.mod FIO.mod \
+       StrIO.mod StrLib.mod \
+       TimeString.mod Environment.mod \
+       FpuIO.mod Debug.mod \
+       SysStorage.mod Storage.mod \
+       StdIO.mod SEnvironment.mod \
+       DynamicStrings.mod SFIO.mod \
+       SArgs.mod SCmdArgs.mod \
+       PushBackInput.mod \
+       StringConvert.mod FormatStrings.mod \
+       Builtins.mod MathLib0.mod \
+       M2EXCEPTION.mod RTExceptions.mod \
+       SMathLib0.mod RTint.mod \
+       Indexing.mod \
+       LMathLib0.mod LegacyReal.mod \
+       MemUtils.mod gdbif.mod \
+       GetOpt.mod OptLib.mod
+
+# COROUTINES.mod has been removed as it is implemented in ../libm2iso.
+
+M2DEFS = Args.def   ASCII.def \
+         Assertion.def  Break.def \
+         Builtins.def  cbuiltin.def \
+         CmdArgs.def COROUTINES.def \
+         cxxabi.def  Debug.def \
+         dtoa.def  DynamicStrings.def \
+         Environment.def  errno.def \
+         FIO.def  FormatStrings.def \
+         FpuIO.def  gdbif.def \
+         Indexing.def \
+         IO.def  ldtoa.def \
+         LegacyReal.def  libc.def \
+         libm.def  LMathLib0.def \
+         M2Dependent.def \
+         M2EXCEPTION.def  M2LINK.def \
+         M2RTS.def \
+         MathLib0.def  MemUtils.def \
+         NumberIO.def  PushBackInput.def \
+         RTExceptions.def  RTint.def \
+         SArgs.def  SCmdArgs.def \
+         Scan.def \
+         sckt.def  Selective.def \
+         SEnvironment.def  SFIO.def \
+         SMathLib0.def  StdIO.def \
+         Storage.def  StrCase.def \
+         StringConvert.def  StrIO.def \
+         StrLib.def  SysExceptions.def \
+         SysStorage.def  SYSTEM.def \
+         termios.def  TimeString.def \
+         UnixArgs.def  wrapc.def  \
+         GetOpt.def OptLib.def \
+         cgetopt.def
+
+libm2pim_la_SOURCES = $(M2MODS) \
+                      UnixArgs.cc \
+                      Selective.cc sckt.cc \
+                      errno.cc dtoa.cc \
+                      ldtoa.cc termios.cc \
+                      SysExceptions.cc target.c \
+                      wrapc.c cgetopt.cc
+
+libm2pimdir = libm2pim
+libm2pim_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2pim_la_SOURCES)))
+libm2pim_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../  -I@srcdir@/../libm2iso
+libm2pim_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g
+libm2pim_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+BUILT_SOURCES = SYSTEM.def
+CLEANFILES = SYSTEM.def
+
+M2LIBDIR = /m2/m2pim/
+
+SYSTEM.def: Makefile
+	bash $(GM2_SRC)/tools-src/makeSystem -fpim \
+             $(GM2_SRC)/gm2-libs/SYSTEM.def \
+             $(GM2_SRC)/gm2-libs/SYSTEM.mod \
+             -I$(GM2_SRC)/gm2-libs \
+             "$(GM2_FOR_TARGET)" $@
+
+.mod.lo: SYSTEM.def
+	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2pim_la_M2FLAGS) $< -o $@
+
+.cc.lo:
+	$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2pim_la_CFLAGS) $< -o $@
+
+install-data-local: force
+	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	$(INSTALL_DATA) .libs/libm2pim.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2pim.la
+	$(INSTALL_DATA) .libs/libm2pim.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2pim.a
+	for i in $(M2DEFS) $(M2MODS) ; do \
+           if [ -f $$i ] ; then \
+              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           elif [ -f @srcdir@/../../gcc/m2/gm2-libs/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+
+force:
+
+endif
diff --git a/libgm2/libm2pim/Makefile.in b/libgm2/libm2pim/Makefile.in
new file mode 100644
index 00000000000..ed14837c0a4
--- /dev/null
+++ b/libgm2/libm2pim/Makefile.in
@@ -0,0 +1,912 @@
+# Makefile.in generated by automake 1.15.1 from Makefile.am.
+# @configure_input@
+
+# Copyright (C) 1994-2017 Free Software Foundation, Inc.
+
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+# Makefile for libm2pim.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+am__is_gnu_make = { \
+  if test -z '$(MAKELEVEL)'; then \
+    false; \
+  elif test -n '$(MAKE_HOST)'; then \
+    true; \
+  elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
+    true; \
+  else \
+    false; \
+  fi; \
+}
+am__make_running_with_option = \
+  case $${target_option-} in \
+      ?) ;; \
+      *) echo "am__make_running_with_option: internal error: invalid" \
+              "target option '$${target_option-}' specified" >&2; \
+         exit 1;; \
+  esac; \
+  has_opt=no; \
+  sane_makeflags=$$MAKEFLAGS; \
+  if $(am__is_gnu_make); then \
+    sane_makeflags=$$MFLAGS; \
+  else \
+    case $$MAKEFLAGS in \
+      *\\[\ \	]*) \
+        bs=\\; \
+        sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
+          | sed "s/$$bs$$bs[$$bs $$bs	]*//g"`;; \
+    esac; \
+  fi; \
+  skip_next=no; \
+  strip_trailopt () \
+  { \
+    flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
+  }; \
+  for flg in $$sane_makeflags; do \
+    test $$skip_next = yes && { skip_next=no; continue; }; \
+    case $$flg in \
+      *=*|--*) continue;; \
+        -*I) strip_trailopt 'I'; skip_next=yes;; \
+      -*I?*) strip_trailopt 'I';; \
+        -*O) strip_trailopt 'O'; skip_next=yes;; \
+      -*O?*) strip_trailopt 'O';; \
+        -*l) strip_trailopt 'l'; skip_next=yes;; \
+      -*l?*) strip_trailopt 'l';; \
+      -[dEDm]) skip_next=yes;; \
+      -[JT]) skip_next=yes;; \
+    esac; \
+    case $$flg in \
+      *$$target_option*) has_opt=yes; break;; \
+    esac; \
+  done; \
+  test $$has_opt = yes
+am__make_dryrun = (target_option=n; $(am__make_running_with_option))
+am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
+pkgdatadir = $(datadir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkglibexecdir = $(libexecdir)/@PACKAGE@
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = $(program_transform_name)
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+build_triplet = @build@
+host_triplet = @host@
+target_triplet = @target@
+subdir = libm2pim
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(top_srcdir)/../libtool.m4 \
+	$(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \
+	$(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \
+	$(top_srcdir)/../config/acx.m4 \
+	$(top_srcdir)/../config/depstand.m4 \
+	$(top_srcdir)/../config/lead-dot.m4 \
+	$(top_srcdir)/../config/multi.m4 \
+	$(top_srcdir)/../config/no-executables.m4 \
+	$(top_srcdir)/../config/override.m4 $(top_srcdir)/configure.ac
+am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
+	$(ACLOCAL_M4)
+DIST_COMMON = $(srcdir)/Makefile.am
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = $(top_builddir)/config.h
+CONFIG_CLEAN_FILES =
+CONFIG_CLEAN_VPATH_FILES =
+am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
+am__vpath_adj = case $$p in \
+    $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
+    *) f=$$p;; \
+  esac;
+am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
+am__install_max = 40
+am__nobase_strip_setup = \
+  srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
+am__nobase_strip = \
+  for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
+am__nobase_list = $(am__nobase_strip_setup); \
+  for p in $$list; do echo "$$p $$p"; done | \
+  sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
+  $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
+    if (++n[$$2] == $(am__install_max)) \
+      { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
+    END { for (dir in files) print dir, files[dir] }'
+am__base_list = \
+  sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
+  sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
+am__uninstall_files_from_dir = { \
+  test -z "$$files" \
+    || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
+    || { echo " ( cd '$$dir' && rm -f" $$files ")"; \
+         $(am__cd) "$$dir" && rm -f $$files; }; \
+  }
+am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
+LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
+libm2pim_la_LIBADD =
+@BUILD_PIMLIB_TRUE@am__objects_1 = ASCII.lo IO.lo Args.lo M2RTS.lo \
+@BUILD_PIMLIB_TRUE@	M2Dependent.lo Assertion.lo NumberIO.lo \
+@BUILD_PIMLIB_TRUE@	Break.lo SYSTEM.lo CmdArgs.lo Scan.lo \
+@BUILD_PIMLIB_TRUE@	StrCase.lo FIO.lo StrIO.lo StrLib.lo \
+@BUILD_PIMLIB_TRUE@	TimeString.lo Environment.lo FpuIO.lo \
+@BUILD_PIMLIB_TRUE@	Debug.lo SysStorage.lo Storage.lo StdIO.lo \
+@BUILD_PIMLIB_TRUE@	SEnvironment.lo DynamicStrings.lo SFIO.lo \
+@BUILD_PIMLIB_TRUE@	SArgs.lo SCmdArgs.lo PushBackInput.lo \
+@BUILD_PIMLIB_TRUE@	StringConvert.lo FormatStrings.lo \
+@BUILD_PIMLIB_TRUE@	Builtins.lo MathLib0.lo M2EXCEPTION.lo \
+@BUILD_PIMLIB_TRUE@	RTExceptions.lo SMathLib0.lo RTint.lo \
+@BUILD_PIMLIB_TRUE@	Indexing.lo LMathLib0.lo LegacyReal.lo \
+@BUILD_PIMLIB_TRUE@	MemUtils.lo gdbif.lo GetOpt.lo OptLib.lo
+@BUILD_PIMLIB_TRUE@am_libm2pim_la_OBJECTS = $(am__objects_1) \
+@BUILD_PIMLIB_TRUE@	UnixArgs.lo Selective.lo sckt.lo errno.lo \
+@BUILD_PIMLIB_TRUE@	dtoa.lo ldtoa.lo termios.lo \
+@BUILD_PIMLIB_TRUE@	SysExceptions.lo libm2pim_la-target.lo \
+@BUILD_PIMLIB_TRUE@	libm2pim_la-wrapc.lo cgetopt.lo
+libm2pim_la_OBJECTS = $(am_libm2pim_la_OBJECTS)
+@BUILD_PIMLIB_TRUE@am_libm2pim_la_rpath = -rpath $(toolexeclibdir)
+AM_V_P = $(am__v_P_@AM_V@)
+am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
+am__v_P_0 = false
+am__v_P_1 = :
+AM_V_GEN = $(am__v_GEN_@AM_V@)
+am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
+am__v_GEN_0 = @echo "  GEN     " $@;
+am__v_GEN_1 = 
+AM_V_at = $(am__v_at_@AM_V@)
+am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
+am__v_at_0 = @
+am__v_at_1 = 
+DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
+depcomp = $(SHELL) $(top_srcdir)/../depcomp
+am__depfiles_maybe = depfiles
+am__mv = mv -f
+AM_V_lt = $(am__v_lt_@AM_V@)
+am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
+am__v_lt_0 = --silent
+am__v_lt_1 = 
+COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
+	$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
+	$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	$(AM_CFLAGS) $(CFLAGS)
+AM_V_CC = $(am__v_CC_@AM_V@)
+am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
+am__v_CC_0 = @echo "  CC      " $@;
+am__v_CC_1 = 
+CCLD = $(CC)
+LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
+	$(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_CCLD = $(am__v_CCLD_@AM_V@)
+am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
+am__v_CCLD_0 = @echo "  CCLD    " $@;
+am__v_CCLD_1 = 
+CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
+	$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS)
+LTCXXCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) \
+	$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+	$(AM_CXXFLAGS) $(CXXFLAGS)
+AM_V_CXX = $(am__v_CXX_@AM_V@)
+am__v_CXX_ = $(am__v_CXX_@AM_DEFAULT_V@)
+am__v_CXX_0 = @echo "  CXX     " $@;
+am__v_CXX_1 = 
+CXXLD = $(CXX)
+CXXLINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
+	$(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \
+	$(CXXFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
+AM_V_CXXLD = $(am__v_CXXLD_@AM_V@)
+am__v_CXXLD_ = $(am__v_CXXLD_@AM_DEFAULT_V@)
+am__v_CXXLD_0 = @echo "  CXXLD   " $@;
+am__v_CXXLD_1 = 
+SOURCES = $(libm2pim_la_SOURCES)
+am__can_run_installinfo = \
+  case $$AM_UPDATE_INFO_DIR in \
+    n|no|NO) false;; \
+    *) (install-info --version) >/dev/null 2>&1;; \
+  esac
+am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
+# Read a list of newline-separated strings from the standard input,
+# and print each of them once, without duplicates.  Input order is
+# *not* preserved.
+am__uniquify_input = $(AWK) '\
+  BEGIN { nonempty = 0; } \
+  { items[$$0] = 1; nonempty = 1; } \
+  END { if (nonempty) { for (i in items) print i; }; } \
+'
+# Make sure the list of sources is unique.  This is necessary because,
+# e.g., the same source file might be shared among _SOURCES variables
+# for different programs/libraries.
+am__define_uniq_tagged_files = \
+  list='$(am__tagged_files)'; \
+  unique=`for i in $$list; do \
+    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+  done | $(am__uniquify_input)`
+ETAGS = etags
+CTAGS = ctags
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs
+ACLOCAL = @ACLOCAL@
+AMTAR = @AMTAR@
+AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+AR = @AR@
+AUTOCONF = @AUTOCONF@
+AUTOHEADER = @AUTOHEADER@
+AUTOMAKE = @AUTOMAKE@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+CCASDEPMODE = @CCASDEPMODE@
+CCASFLAGS = @CCASFLAGS@
+CCDEPMODE = @CCDEPMODE@
+CC_FOR_BUILD = @CC_FOR_BUILD@
+CFLAGS = @CFLAGS@
+CPP = @CPP@
+CPPFLAGS = @CPPFLAGS@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+CXXDEPMODE = @CXXDEPMODE@
+CXXFLAGS = @CXXFLAGS@
+CYGPATH_W = @CYGPATH_W@
+DEFS = @DEFS@
+DEPDIR = @DEPDIR@
+DSYMUTIL = @DSYMUTIL@
+DUMPBIN = @DUMPBIN@
+ECHO_C = @ECHO_C@
+ECHO_N = @ECHO_N@
+ECHO_T = @ECHO_T@
+EGREP = @EGREP@
+EXEEXT = @EXEEXT@
+FGREP = @FGREP@
+GM2_FOR_TARGET = @GM2_FOR_TARGET@
+GREP = @GREP@
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LD = @LD@
+LDFLAGS = @LDFLAGS@
+LIBOBJS = @LIBOBJS@
+LIBS = @LIBS@
+LIBTOOL = @LIBTOOL@
+LIPO = @LIPO@
+LN_S = @LN_S@
+LTLIBOBJS = @LTLIBOBJS@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+MKDIR_P = @MKDIR_P@
+NM = @NM@
+NMEDIT = @NMEDIT@
+OBJDUMP = @OBJDUMP@
+OBJEXT = @OBJEXT@
+OTOOL = @OTOOL@
+OTOOL64 = @OTOOL64@
+PACKAGE = @PACKAGE@
+PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
+PACKAGE_NAME = @PACKAGE_NAME@
+PACKAGE_STRING = @PACKAGE_STRING@
+PACKAGE_TARNAME = @PACKAGE_TARNAME@
+PACKAGE_URL = @PACKAGE_URL@
+PACKAGE_VERSION = @PACKAGE_VERSION@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+PERL = @PERL@
+RANLIB = @RANLIB@
+SED = @SED@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+STRIP = @STRIP@
+VERSION = @VERSION@
+abs_builddir = @abs_builddir@
+abs_srcdir = @abs_srcdir@
+abs_top_builddir = @abs_top_builddir@
+abs_top_srcdir = @abs_top_srcdir@
+ac_ct_CC = @ac_ct_CC@
+ac_ct_CXX = @ac_ct_CXX@
+ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
+am__include = @am__include@
+am__leading_dot = @am__leading_dot@
+am__quote = @am__quote@
+am__tar = @am__tar@
+am__untar = @am__untar@
+bindir = @bindir@
+build = @build@
+build_alias = @build_alias@
+build_cpu = @build_cpu@
+build_libsubdir = @build_libsubdir@
+build_os = @build_os@
+build_subdir = @build_subdir@
+build_vendor = @build_vendor@
+builddir = @builddir@
+datadir = @datadir@
+datarootdir = @datarootdir@
+docdir = @docdir@
+dvidir = @dvidir@
+enable_shared = @enable_shared@
+enable_static = @enable_static@
+exec_prefix = @exec_prefix@
+host = @host@
+host_alias = @host_alias@
+host_cpu = @host_cpu@
+host_noncanonical = @host_noncanonical@
+host_os = @host_os@
+host_subdir = @host_subdir@
+host_vendor = @host_vendor@
+htmldir = @htmldir@
+includedir = @includedir@
+infodir = @infodir@
+install_sh = @install_sh@
+libdir = @libdir@
+libexecdir = @libexecdir@
+libtool_VERSION = @libtool_VERSION@
+localedir = @localedir@
+localstatedir = @localstatedir@
+mandir = @mandir@
+mkdir_p = @mkdir_p@
+multi_basedir = @multi_basedir@
+oldincludedir = @oldincludedir@
+pdfdir = @pdfdir@
+prefix = @prefix@
+program_transform_name = @program_transform_name@
+psdir = @psdir@
+sbindir = @sbindir@
+sharedstatedir = @sharedstatedir@
+# Used to install the shared libgcc.
+slibdir = @slibdir@
+srcdir = @srcdir@
+sysconfdir = @sysconfdir@
+target = @target@
+target_alias = @target_alias@
+target_cpu = @target_cpu@
+target_noncanonical = @target_noncanonical@
+target_os = @target_os@
+target_subdir = @target_subdir@
+target_vendor = @target_vendor@
+toolexecdir = @toolexecdir@
+toolexeclibdir = @toolexeclibdir@
+top_build_prefix = @top_build_prefix@
+top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+# Multilib support.
+MAKEOVERRIDES = 
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+@BUILD_PIMLIB_TRUE@toolexeclib_LTLIBRARIES = libm2pim.la
+@BUILD_PIMLIB_TRUE@M2MODS = ASCII.mod IO.mod \
+@BUILD_PIMLIB_TRUE@       Args.mod M2RTS.mod \
+@BUILD_PIMLIB_TRUE@       M2Dependent.mod \
+@BUILD_PIMLIB_TRUE@       Assertion.mod NumberIO.mod \
+@BUILD_PIMLIB_TRUE@       Break.mod SYSTEM.mod \
+@BUILD_PIMLIB_TRUE@       CmdArgs.mod Scan.mod \
+@BUILD_PIMLIB_TRUE@       StrCase.mod FIO.mod \
+@BUILD_PIMLIB_TRUE@       StrIO.mod StrLib.mod \
+@BUILD_PIMLIB_TRUE@       TimeString.mod Environment.mod \
+@BUILD_PIMLIB_TRUE@       FpuIO.mod Debug.mod \
+@BUILD_PIMLIB_TRUE@       SysStorage.mod Storage.mod \
+@BUILD_PIMLIB_TRUE@       StdIO.mod SEnvironment.mod \
+@BUILD_PIMLIB_TRUE@       DynamicStrings.mod SFIO.mod \
+@BUILD_PIMLIB_TRUE@       SArgs.mod SCmdArgs.mod \
+@BUILD_PIMLIB_TRUE@       PushBackInput.mod \
+@BUILD_PIMLIB_TRUE@       StringConvert.mod FormatStrings.mod \
+@BUILD_PIMLIB_TRUE@       Builtins.mod MathLib0.mod \
+@BUILD_PIMLIB_TRUE@       M2EXCEPTION.mod RTExceptions.mod \
+@BUILD_PIMLIB_TRUE@       SMathLib0.mod RTint.mod \
+@BUILD_PIMLIB_TRUE@       Indexing.mod \
+@BUILD_PIMLIB_TRUE@       LMathLib0.mod LegacyReal.mod \
+@BUILD_PIMLIB_TRUE@       MemUtils.mod gdbif.mod \
+@BUILD_PIMLIB_TRUE@       GetOpt.mod OptLib.mod
+
+
+# COROUTINES.mod has been removed as it is implemented in ../libm2iso.
+@BUILD_PIMLIB_TRUE@M2DEFS = Args.def   ASCII.def \
+@BUILD_PIMLIB_TRUE@         Assertion.def  Break.def \
+@BUILD_PIMLIB_TRUE@         Builtins.def  cbuiltin.def \
+@BUILD_PIMLIB_TRUE@         CmdArgs.def COROUTINES.def \
+@BUILD_PIMLIB_TRUE@         cxxabi.def  Debug.def \
+@BUILD_PIMLIB_TRUE@         dtoa.def  DynamicStrings.def \
+@BUILD_PIMLIB_TRUE@         Environment.def  errno.def \
+@BUILD_PIMLIB_TRUE@         FIO.def  FormatStrings.def \
+@BUILD_PIMLIB_TRUE@         FpuIO.def  gdbif.def \
+@BUILD_PIMLIB_TRUE@         Indexing.def \
+@BUILD_PIMLIB_TRUE@         IO.def  ldtoa.def \
+@BUILD_PIMLIB_TRUE@         LegacyReal.def  libc.def \
+@BUILD_PIMLIB_TRUE@         libm.def  LMathLib0.def \
+@BUILD_PIMLIB_TRUE@         M2Dependent.def \
+@BUILD_PIMLIB_TRUE@         M2EXCEPTION.def  M2LINK.def \
+@BUILD_PIMLIB_TRUE@         M2RTS.def \
+@BUILD_PIMLIB_TRUE@         MathLib0.def  MemUtils.def \
+@BUILD_PIMLIB_TRUE@         NumberIO.def  PushBackInput.def \
+@BUILD_PIMLIB_TRUE@         RTExceptions.def  RTint.def \
+@BUILD_PIMLIB_TRUE@         SArgs.def  SCmdArgs.def \
+@BUILD_PIMLIB_TRUE@         Scan.def \
+@BUILD_PIMLIB_TRUE@         sckt.def  Selective.def \
+@BUILD_PIMLIB_TRUE@         SEnvironment.def  SFIO.def \
+@BUILD_PIMLIB_TRUE@         SMathLib0.def  StdIO.def \
+@BUILD_PIMLIB_TRUE@         Storage.def  StrCase.def \
+@BUILD_PIMLIB_TRUE@         StringConvert.def  StrIO.def \
+@BUILD_PIMLIB_TRUE@         StrLib.def  SysExceptions.def \
+@BUILD_PIMLIB_TRUE@         SysStorage.def  SYSTEM.def \
+@BUILD_PIMLIB_TRUE@         termios.def  TimeString.def \
+@BUILD_PIMLIB_TRUE@         UnixArgs.def  wrapc.def  \
+@BUILD_PIMLIB_TRUE@         GetOpt.def OptLib.def \
+@BUILD_PIMLIB_TRUE@         cgetopt.def
+
+@BUILD_PIMLIB_TRUE@libm2pim_la_SOURCES = $(M2MODS) \
+@BUILD_PIMLIB_TRUE@                      UnixArgs.cc \
+@BUILD_PIMLIB_TRUE@                      Selective.cc sckt.cc \
+@BUILD_PIMLIB_TRUE@                      errno.cc dtoa.cc \
+@BUILD_PIMLIB_TRUE@                      ldtoa.cc termios.cc \
+@BUILD_PIMLIB_TRUE@                      SysExceptions.cc target.c \
+@BUILD_PIMLIB_TRUE@                      wrapc.c cgetopt.cc
+
+@BUILD_PIMLIB_TRUE@libm2pimdir = libm2pim
+@BUILD_PIMLIB_TRUE@libm2pim_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2pim_la_SOURCES)))
+@BUILD_PIMLIB_TRUE@libm2pim_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../  -I@srcdir@/../libm2iso
+@BUILD_PIMLIB_TRUE@libm2pim_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g
+@BUILD_PIMLIB_TRUE@libm2pim_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+@BUILD_PIMLIB_TRUE@BUILT_SOURCES = SYSTEM.def
+@BUILD_PIMLIB_TRUE@CLEANFILES = SYSTEM.def
+@BUILD_PIMLIB_TRUE@M2LIBDIR = /m2/m2pim/
+all: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) all-am
+
+.SUFFIXES:
+.SUFFIXES: .c .mod .def .o .obj .lo .a .la .cc
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am  $(am__configure_deps)
+	@for dep in $?; do \
+	  case '$(am__configure_deps)' in \
+	    *$$dep*) \
+	      ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
+	        && { if test -f $@; then exit 0; else break; fi; }; \
+	      exit 1;; \
+	  esac; \
+	done; \
+	echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign libm2pim/Makefile'; \
+	$(am__cd) $(top_srcdir) && \
+	  $(AUTOMAKE) --foreign libm2pim/Makefile
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+	@case '$?' in \
+	  *config.status*) \
+	    cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
+	  *) \
+	    echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
+	    cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
+	esac;
+
+$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+
+$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
+	cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
+$(am__aclocal_m4_deps):
+
+install-toolexeclibLTLIBRARIES: $(toolexeclib_LTLIBRARIES)
+	@$(NORMAL_INSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	list2=; for p in $$list; do \
+	  if test -f $$p; then \
+	    list2="$$list2 $$p"; \
+	  else :; fi; \
+	done; \
+	test -z "$$list2" || { \
+	  echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(toolexeclibdir)"; \
+	}
+
+uninstall-toolexeclibLTLIBRARIES:
+	@$(NORMAL_UNINSTALL)
+	@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
+	for p in $$list; do \
+	  $(am__strip_dir) \
+	  echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(toolexeclibdir)/$$f'"; \
+	  $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(toolexeclibdir)/$$f"; \
+	done
+
+clean-toolexeclibLTLIBRARIES:
+	-test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES)
+	@list='$(toolexeclib_LTLIBRARIES)'; \
+	locs=`for p in $$list; do echo $$p; done | \
+	      sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
+	      sort -u`; \
+	test -z "$$locs" || { \
+	  echo rm -f $${locs}; \
+	  rm -f $${locs}; \
+	}
+
+libm2pim.la: $(libm2pim_la_OBJECTS) $(libm2pim_la_DEPENDENCIES) $(EXTRA_libm2pim_la_DEPENDENCIES) 
+	$(AM_V_GEN)$(libm2pim_la_LINK) $(am_libm2pim_la_rpath) $(libm2pim_la_OBJECTS) $(libm2pim_la_LIBADD) $(LIBS)
+
+mostlyclean-compile:
+	-rm -f *.$(OBJEXT)
+
+distclean-compile:
+	-rm -f *.tab.c
+
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/Selective.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/SysExceptions.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/UnixArgs.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cgetopt.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoa.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/errno.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ldtoa.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2pim_la-target.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2pim_la-wrapc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sckt.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/termios.Plo@am__quote@
+
+.c.o:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $<
+
+.c.obj:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+.c.lo:
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $<
+
+libm2pim_la-target.lo: target.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -MT libm2pim_la-target.lo -MD -MP -MF $(DEPDIR)/libm2pim_la-target.Tpo -c -o libm2pim_la-target.lo `test -f 'target.c' || echo '$(srcdir)/'`target.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libm2pim_la-target.Tpo $(DEPDIR)/libm2pim_la-target.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='target.c' object='libm2pim_la-target.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -c -o libm2pim_la-target.lo `test -f 'target.c' || echo '$(srcdir)/'`target.c
+
+libm2pim_la-wrapc.lo: wrapc.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -MT libm2pim_la-wrapc.lo -MD -MP -MF $(DEPDIR)/libm2pim_la-wrapc.Tpo -c -o libm2pim_la-wrapc.lo `test -f 'wrapc.c' || echo '$(srcdir)/'`wrapc.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libm2pim_la-wrapc.Tpo $(DEPDIR)/libm2pim_la-wrapc.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='wrapc.c' object='libm2pim_la-wrapc.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@	$(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -c -o libm2pim_la-wrapc.lo `test -f 'wrapc.c' || echo '$(srcdir)/'`wrapc.c
+
+.cc.o:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ $<
+
+.cc.obj:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
+
+@BUILD_PIMLIB_FALSE@.cc.lo:
+@am__fastdepCXX_TRUE@	$(AM_V_CXX)$(LTCXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
+@am__fastdepCXX_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	$(AM_V_CXX)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@	DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@	$(AM_V_CXX@am__nodep@)$(LTCXXCOMPILE) -c -o $@ $<
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+ID: $(am__tagged_files)
+	$(am__define_uniq_tagged_files); mkid -fID $$unique
+tags: tags-am
+TAGS: tags
+
+tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	set x; \
+	here=`pwd`; \
+	$(am__define_uniq_tagged_files); \
+	shift; \
+	if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
+	  test -n "$$unique" || unique=$$empty_fix; \
+	  if test $$# -gt 0; then \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      "$$@" $$unique; \
+	  else \
+	    $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+	      $$unique; \
+	  fi; \
+	fi
+ctags: ctags-am
+
+CTAGS: ctags
+ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
+	$(am__define_uniq_tagged_files); \
+	test -z "$(CTAGS_ARGS)$$unique" \
+	  || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
+	     $$unique
+
+GTAGS:
+	here=`$(am__cd) $(top_builddir) && pwd` \
+	  && $(am__cd) $(top_srcdir) \
+	  && gtags -i $(GTAGS_ARGS) "$$here"
+cscopelist: cscopelist-am
+
+cscopelist-am: $(am__tagged_files)
+	list='$(am__tagged_files)'; \
+	case "$(srcdir)" in \
+	  [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
+	  *) sdir=$(subdir)/$(srcdir) ;; \
+	esac; \
+	for i in $$list; do \
+	  if test -f "$$i"; then \
+	    echo "$(subdir)/$$i"; \
+	  else \
+	    echo "$$sdir/$$i"; \
+	  fi; \
+	done >> $(top_builddir)/cscope.files
+
+distclean-tags:
+	-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
+check-am: all-am
+check: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) check-am
+all-am: Makefile $(LTLIBRARIES)
+installdirs:
+	for dir in "$(DESTDIR)$(toolexeclibdir)"; do \
+	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
+	done
+install: $(BUILT_SOURCES)
+	$(MAKE) $(AM_MAKEFLAGS) install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+	if test -z '$(STRIP)'; then \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	      install; \
+	else \
+	  $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+	    install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
+	    "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
+	fi
+mostlyclean-generic:
+
+clean-generic:
+	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
+
+distclean-generic:
+	-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
+	-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
+
+maintainer-clean-generic:
+	@echo "This command is intended for maintainers to use"
+	@echo "it deletes files that may require special tools to rebuild."
+	-test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES)
+@BUILD_PIMLIB_FALSE@install-data-local:
+clean: clean-am
+
+clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \
+	mostlyclean-am
+
+distclean: distclean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+distclean-am: clean-am distclean-compile distclean-generic \
+	distclean-tags
+
+dvi: dvi-am
+
+dvi-am:
+
+html: html-am
+
+html-am:
+
+info: info-am
+
+info-am:
+
+install-data-am: install-data-local
+
+install-dvi: install-dvi-am
+
+install-dvi-am:
+
+install-exec-am: install-toolexeclibLTLIBRARIES
+
+install-html: install-html-am
+
+install-html-am:
+
+install-info: install-info-am
+
+install-info-am:
+
+install-man:
+
+install-pdf: install-pdf-am
+
+install-pdf-am:
+
+install-ps: install-ps-am
+
+install-ps-am:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool
+
+pdf: pdf-am
+
+pdf-am:
+
+ps: ps-am
+
+ps-am:
+
+uninstall-am: uninstall-toolexeclibLTLIBRARIES
+
+.MAKE: all check install install-am install-strip
+
+.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
+	clean-libtool clean-toolexeclibLTLIBRARIES cscopelist-am ctags \
+	ctags-am distclean distclean-compile distclean-generic \
+	distclean-libtool distclean-tags dvi dvi-am html html-am info \
+	info-am install install-am install-data install-data-am \
+	install-data-local install-dvi install-dvi-am install-exec \
+	install-exec-am install-html install-html-am install-info \
+	install-info-am install-man install-pdf install-pdf-am \
+	install-ps install-ps-am install-strip \
+	install-toolexeclibLTLIBRARIES installcheck installcheck-am \
+	installdirs maintainer-clean maintainer-clean-generic \
+	mostlyclean mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \
+	uninstall-am uninstall-toolexeclibLTLIBRARIES
+
+.PRECIOUS: Makefile
+
+
+@BUILD_PIMLIB_TRUE@SYSTEM.def: Makefile
+@BUILD_PIMLIB_TRUE@	bash $(GM2_SRC)/tools-src/makeSystem -fpim \
+@BUILD_PIMLIB_TRUE@             $(GM2_SRC)/gm2-libs/SYSTEM.def \
+@BUILD_PIMLIB_TRUE@             $(GM2_SRC)/gm2-libs/SYSTEM.mod \
+@BUILD_PIMLIB_TRUE@             -I$(GM2_SRC)/gm2-libs \
+@BUILD_PIMLIB_TRUE@             "$(GM2_FOR_TARGET)" $@
+
+@BUILD_PIMLIB_TRUE@.mod.lo: SYSTEM.def
+@BUILD_PIMLIB_TRUE@	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2pim_la_M2FLAGS) $< -o $@
+
+@BUILD_PIMLIB_TRUE@.cc.lo:
+@BUILD_PIMLIB_TRUE@	$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2pim_la_CFLAGS) $< -o $@
+
+@BUILD_PIMLIB_TRUE@install-data-local: force
+@BUILD_PIMLIB_TRUE@	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_PIMLIB_TRUE@	$(INSTALL_DATA) .libs/libm2pim.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_PIMLIB_TRUE@	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2pim.la
+@BUILD_PIMLIB_TRUE@	$(INSTALL_DATA) .libs/libm2pim.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+@BUILD_PIMLIB_TRUE@	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2pim.a
+@BUILD_PIMLIB_TRUE@	for i in $(M2DEFS) $(M2MODS) ; do \
+@BUILD_PIMLIB_TRUE@           if [ -f $$i ] ; then \
+@BUILD_PIMLIB_TRUE@              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_PIMLIB_TRUE@           elif [ -f @srcdir@/../../gcc/m2/gm2-libs/$$i ] ; then \
+@BUILD_PIMLIB_TRUE@              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+@BUILD_PIMLIB_TRUE@           else \
+@BUILD_PIMLIB_TRUE@              echo "cannot find $$i" ; exit 1 ; \
+@BUILD_PIMLIB_TRUE@           fi ; \
+@BUILD_PIMLIB_TRUE@           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+@BUILD_PIMLIB_TRUE@	done
+
+@BUILD_PIMLIB_TRUE@force:
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgm2/libm2pim/Selective.cc b/libgm2/libm2pim/Selective.cc
new file mode 100644
index 00000000000..a71c6577946
--- /dev/null
+++ b/libgm2/libm2pim/Selective.cc
@@ -0,0 +1,319 @@
+/* Selective.c provide access to timeval and select.
+
+Copyright (C) 2009-2022 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 <m2rts.h>
+
+#if defined(HAVE_STDDEF_H)
+/* Obtain a definition for NULL.  */
+#include <stddef.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+/* Obtain a definition for NULL.  */
+#include <stdio.h>
+#endif
+
+#if defined(HAVE_SYS_TIME_H)
+#include <sys/time.h>
+#endif
+
+#if defined(HAVE_TIME_H)
+/* Obtain a definition for NULL.  */
+#include <time.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+/* Obtain a definition for NULL.  */
+#include <string.h>
+#endif
+
+#if defined(HAVE_WCHAR_H)
+/* Obtain a definition for NULL.  */
+#include <wchar.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+/* Obtain a prototype for free and malloc.  */
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_SYS_TYPES_H)
+#include <sys/types.h>
+#endif
+
+#if defined(HAVE_UNISTD_H)
+#include <unistd.h>
+#endif
+
+#if !defined(NULL)
+#define NULL (void *)0
+#endif
+
+#if defined(HAVE_SELECT)
+#define FDSET_T fd_set
+#else
+#define FDSET_T void
+#endif
+
+/* Select wrap a call to the C select.  */
+
+#if defined(HAVE_STRUCT_TIMEVAL)
+extern "C" 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 "C" int
+Selective_Select (int nooffds, void *readfds, void *writefds, void *exceptfds,
+                  void *timeout)
+{
+  return 0;
+}
+#endif
+
+/* InitTime initializes a timeval structure and returns a pointer to it.  */
+
+#if defined(HAVE_STRUCT_TIMEVAL)
+extern "C" 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 "C" 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 "C" void
+Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec)
+{
+  t->tv_sec = sec;
+  t->tv_usec = usec;
+}
+
+/* KillTime frees the timeval structure and returns NULL.  */
+
+extern "C" struct timeval *
+Selective_KillTime (struct timeval *t)
+{
+#if defined(HAVE_STDLIB_H)
+  free (t);
+#endif
+  return NULL;
+}
+
+/* InitSet returns a pointer to a FD_SET.  */
+
+extern "C" FDSET_T *
+Selective_InitSet (void)
+{
+#if defined(HAVE_STDLIB_H)
+  FDSET_T *s = (FDSET_T *)malloc (sizeof (FDSET_T));
+
+  return s;
+#else
+  return NULL
+#endif
+}
+
+/* KillSet frees the FD_SET and returns NULL.  */
+
+extern "C" FDSET_T *
+Selective_KillSet (FDSET_T *s)
+{
+#if defined(HAVE_STDLIB_H)
+  free (s);
+#endif
+  return NULL;
+}
+
+/* FdZero generate an empty set.  */
+
+extern "C" void
+Selective_FdZero (FDSET_T *s)
+{
+  FD_ZERO (s);
+}
+
+/* FS_Set include an element, fd, into set, s.  */
+
+extern "C" void
+Selective_FdSet (int fd, FDSET_T *s)
+{
+  FD_SET (fd, s);
+}
+
+/* FdClr exclude an element, fd, from the set, s.  */
+
+extern "C" void
+Selective_FdClr (int fd, FDSET_T *s)
+{
+  FD_CLR (fd, s);
+}
+
+/* FdIsSet return TRUE if, fd, is present in set, s.  */
+
+extern "C" int
+Selective_FdIsSet (int fd, FDSET_T *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 "C" int
+Selective_GetTimeOfDay (struct timeval *t)
+{
+  return gettimeofday (t, NULL);
+}
+#else
+
+extern "C" void *
+Selective_InitTime (unsigned int sec, unsigned int usec)
+{
+  return NULL;
+}
+
+extern "C" void *
+Selective_KillTime (void *t)
+{
+  return NULL;
+}
+
+extern "C" void
+Selective_GetTime (void *t, unsigned int *sec, unsigned int *usec)
+{
+}
+
+extern "C" void
+Selective_SetTime (void *t, unsigned int sec, unsigned int usec)
+{
+}
+
+extern "C" FDSET_T *
+Selective_InitSet (void)
+{
+  return NULL;
+}
+
+extern "C" FDSET_T *
+Selective_KillSet (void)
+{
+  return NULL;
+}
+
+extern "C" void
+Selective_FdZero (void *s)
+{
+}
+
+extern "C" void
+Selective_FdSet (int fd, void *s)
+{
+}
+
+extern "C" void
+Selective_FdClr (int fd, void *s)
+{
+}
+
+extern "C" int
+Selective_FdIsSet (int fd, void *s)
+{
+  return 0;
+}
+
+extern "C" int
+Selective_GetTimeOfDay (void *t)
+{
+  return -1;
+}
+#endif
+
+/* MaxFdsPlusOne returns max (a + 1, b + 1).  */
+
+extern "C" int
+Selective_MaxFdsPlusOne (int a, int b)
+{
+  if (a > b)
+    return a + 1;
+  else
+    return b + 1;
+}
+
+/* WriteCharRaw writes a single character to the file descriptor.  */
+
+extern "C" void
+Selective_WriteCharRaw (int fd, char ch)
+{
+  write (fd, &ch, 1);
+}
+
+/* ReadCharRaw read and return a single char from file descriptor, fd.  */
+
+extern "C" char
+Selective_ReadCharRaw (int fd)
+{
+  char ch;
+
+  read (fd, &ch, 1);
+  return ch;
+}
+
+extern "C" void
+_M2_Selective_init (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_Selective_fini (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_Selective_dep (void)
+{
+}
+
+struct _M2_Selective_ctor { _M2_Selective_ctor (); } _M2_Selective_ctor;
+
+_M2_Selective_ctor::_M2_Selective_ctor (void)
+{
+  M2RTS_RegisterModule ("Selective", _M2_Selective_init, _M2_Selective_fini,
+			_M2_Selective_dep);
+}
diff --git a/libgm2/libm2pim/SysExceptions.cc b/libgm2/libm2pim/SysExceptions.cc
new file mode 100644
index 00000000000..780b097aaa6
--- /dev/null
+++ b/libgm2/libm2pim/SysExceptions.cc
@@ -0,0 +1,259 @@
+/* SysExceptions.c configure the signals to create m2 exceptions.
+
+Copyright (C) 2009-2022 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>
+
+#if defined(HAVE_SIGNAL_H)
+#include <signal.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+#include <stdio.h>
+#endif
+
+#include "m2rts.h"
+
+#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
+
+/* The list of Modula-2 exceptions is shown below */
+
+    (indexException,     rangeException,         caseSelectException,  invalidLocation,
+     functionException,  wholeValueException,    wholeDivException,    realValueException,
+     realDivException,   complexValueException,  complexDivException,  protException,
+     sysException,       coException,            exException
+    );
+
+#endif
+
+/* Note: 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 "C" 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 "C" 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
+
+
+extern "C" void
+_M2_SysExceptions_init (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_SysExceptions_fini (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_SysExceptions_dep (void)
+{
+}
+
+struct _M2_SysExceptions_ctor { _M2_SysExceptions_ctor (); } _M2_SysExceptions_ctor;
+
+_M2_SysExceptions_ctor::_M2_SysExceptions_ctor (void)
+{
+  M2RTS_RegisterModule ("SysExceptions", _M2_SysExceptions_init, _M2_SysExceptions_fini,
+			_M2_SysExceptions_dep);
+}
diff --git a/libgm2/libm2pim/UnixArgs.cc b/libgm2/libm2pim/UnixArgs.cc
new file mode 100644
index 00000000000..419ad8388e7
--- /dev/null
+++ b/libgm2/libm2pim/UnixArgs.cc
@@ -0,0 +1,91 @@
+/* UnixArgs.cc record argc, argv as global variables.
+
+Copyright (C) 2009-2022 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 <m2rts.h>
+
+
+extern "C" int UnixArgs_GetArgC (void);
+extern "C" char **UnixArgs_GetArgV (void);
+extern "C" char **UnixArgs_GetEnvV (void);
+
+static int UnixArgs_ArgC;
+static char **UnixArgs_ArgV;
+static char **UnixArgs_EnvV;
+
+
+/* GetArgC returns argc.  */
+
+extern "C" int
+UnixArgs_GetArgC (void)
+{
+  return UnixArgs_ArgC;
+}
+
+
+/* GetArgV returns argv.  */
+
+extern "C" char **
+UnixArgs_GetArgV (void)
+{
+  return UnixArgs_ArgV;
+}
+
+
+/* GetEnvV returns envv.  */
+
+extern "C" char **
+UnixArgs_GetEnvV (void)
+{
+  return UnixArgs_EnvV;
+}
+
+
+extern "C" void
+_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+{
+  UnixArgs_ArgC = argc;
+  UnixArgs_ArgV = argv;
+  UnixArgs_EnvV = envp;
+}
+
+extern "C" void
+_M2_UnixArgs_fini (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_UnixArgs_dep (void)
+{
+}
+
+struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
+
+_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
+{
+  M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_fini,
+			_M2_UnixArgs_dep);
+}
diff --git a/libgm2/libm2pim/cgetopt.cc b/libgm2/libm2pim/cgetopt.cc
new file mode 100644
index 00000000000..fba20fccd22
--- /dev/null
+++ b/libgm2/libm2pim/cgetopt.cc
@@ -0,0 +1,158 @@
+/* cgetopt.cc provide access to the C getopt library.
+
+Copyright (C) 2009-2022 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 <unistd.h>
+#include <stdlib.h>
+#include <getopt.h>
+#include <m2rts.h>
+
+extern "C" {char *cgetopt_optarg;}
+extern "C" {int cgetopt_optind;}
+extern "C" {int cgetopt_opterr;}
+extern "C" {int cgetopt_optopt;}
+
+extern "C" char
+cgetopt_getopt (int argc, char *argv[], char *optstring)
+{
+  char r = getopt (argc, argv, optstring);
+
+  cgetopt_optarg = optarg;
+  cgetopt_optind = optind;
+  cgetopt_opterr = opterr;
+  cgetopt_optopt = optopt;
+
+  if (r == (char)-1)
+    return (char)0;
+  return r;
+}
+
+extern "C" int
+cgetopt_getopt_long (int argc, char *argv[], char *optstring,
+                    const struct option *longopts, int *longindex)
+{
+  int r = getopt_long (argc, argv, optstring, longopts, longindex);
+
+  cgetopt_optarg = optarg;
+  cgetopt_optind = optind;
+  cgetopt_opterr = opterr;
+  cgetopt_optopt = optopt;
+
+  return r;
+}
+
+extern "C" int
+cgetopt_getopt_long_only (int argc, char *argv[], char *optstring,
+                         const struct option *longopts, int *longindex)
+{
+  int r = getopt_long_only (argc, argv, optstring, longopts, longindex);
+
+  cgetopt_optarg = optarg;
+  cgetopt_optind = optind;
+  cgetopt_opterr = opterr;
+  cgetopt_optopt = optopt;
+
+  return r;
+}
+
+typedef struct cgetopt_Options_s
+{
+  struct option *cinfo;
+  unsigned int high;
+} cgetopt_Options;
+
+/* InitOptions a constructor for Options.  */
+
+extern "C" cgetopt_Options *
+cgetopt_InitOptions (void)
+{
+  cgetopt_Options *o = (cgetopt_Options *)malloc (sizeof (cgetopt_Options));
+  o->cinfo = (struct option *)malloc (sizeof (struct option));
+  o->high = 0;
+  return o;
+}
+
+/* KillOptions a deconstructor for Options.  Returns NULL after freeing
+   up all allocated memory associated with o.  */
+
+extern "C" cgetopt_Options *
+cgetopt_KillOptions (cgetopt_Options *o)
+{
+  free (o->cinfo);
+  free (o);
+  return NULL;
+}
+
+/* SetOption set option[index] with {name, has_arg, flag, val}.  */
+
+extern "C" void
+cgetopt_SetOption (cgetopt_Options *o, unsigned int index, char *name,
+ 		   unsigned int has_arg, int *flag, int val)
+{
+  if (index > o->high)
+    {
+      o->cinfo
+          = (struct option *)malloc (sizeof (struct option) * (index + 1));
+      o->high = index + 1;
+    }
+  o->cinfo[index].name = name;
+  o->cinfo[index].has_arg = has_arg;
+  o->cinfo[index].flag = flag;
+  o->cinfo[index].val = val;
+}
+
+/* GetLongOptionArray returns a pointer to the C array containing all
+   long options.  */
+
+extern "C" struct option *
+cgetopt_GetLongOptionArray (cgetopt_Options *o)
+{
+  return o->cinfo;
+}
+
+/* GNU Modula-2 linking fodder.  */
+
+extern "C" void
+_M2_cgetopt_init (int, char *argv[], char *env[])
+{
+}
+
+extern "C" void
+_M2_cgetopt_fini (int, char *argv[], char *env[])
+{
+}
+
+extern "C" void
+_M2_cgetopt_dep (void)
+{
+}
+
+struct _M2_cgetopt_ctor { _M2_cgetopt_ctor (); } _M2_cgetopt_ctor;
+
+_M2_cgetopt_ctor::_M2_cgetopt_ctor (void)
+{
+  M2RTS_RegisterModule ("cgetopt", _M2_cgetopt_init, _M2_cgetopt_fini,
+			_M2_cgetopt_dep);
+}
diff --git a/libgm2/libm2pim/dtoa.cc b/libgm2/libm2pim/dtoa.cc
new file mode 100644
index 00000000000..7b8dff97813
--- /dev/null
+++ b/libgm2/libm2pim/dtoa.cc
@@ -0,0 +1,265 @@
+/* dtoa.cc convert double to ascii and visa versa.
+
+Copyright (C) 2009-2022 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/>.  */
+
+#define GM2
+
+#include <config.h>
+#include <m2rts.h>
+
+#if defined(HAVE_STRINGS)
+#include <strings.h>
+#endif
+
+#if defined(HAVE_STRING)
+#include <string.h>
+#endif
+
+#if defined(HAVE_STDDEF_H)
+/* Obtain a definition for NULL.  */
+#include <stddef.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+/* Obtain a definition for NULL.  */
+#include <stdio.h>
+#endif
+
+#if defined(HAVE_TIME_H)
+/* Obtain a definition for NULL.  */
+#include <time.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+/* Obtain a definition for NULL.  */
+#include <string.h>
+#endif
+
+#if defined(HAVE_WCHAR_H)
+/* Obtain a definition for NULL.  */
+#include <wchar.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+/* Obtain a prototype for free and malloc.  */
+#include <stdlib.h>
+#endif
+
+#if !defined(NULL)
+#define NULL (void *)0
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#if !defined(_ISOC99_SOURCE)
+#define _ISOC99_SOURCE
+#endif
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+
+#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).  */
+
+extern "C" double
+dtoa_strtod (const char *s, int *error)
+{
+  char *endp;
+  double d;
+
+#if defined(HAVE_ERRNO_H)
+  errno = 0;
+#endif
+  d = strtod (s, &endp);
+  if (endp != NULL && (*endp == '\0'))
+#if defined(HAVE_ERRNO_H)
+    *error = (errno != 0);
+#else
+    *error = FALSE;
+#endif
+  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.  */
+
+extern "C" int
+dtoa_calcmaxsig (char *p, int ndigits)
+{
+  char *e;
+  char *o;
+  int x;
+
+  e = strchr (p, 'E');
+  if (e == NULL)
+    x = 0;
+  else
+    {
+      *e = (char)0;
+      x = atoi (e + 1);
+    }
+
+  o = strchr (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 '.'.  */
+
+extern "C" int
+dtoa_calcdecimal (char *p, int str_size, int ndigits)
+{
+  char *e;
+  char *o;
+  int x;
+  int l;
+
+  e = strchr (p, 'E');
+  if (e == NULL)
+    x = 0;
+  else
+    {
+      *e = (char)0;
+      x = atoi (e + 1);
+    }
+
+  l = strlen (p);
+  o = strchr (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;
+}
+
+extern "C" int
+dtoa_calcsign (char *p, int str_size)
+{
+  if (p[0] == '-')
+    {
+      memmove (p, p + 1, str_size - 1);
+      return TRUE;
+    }
+  else
+    return FALSE;
+}
+
+extern "C" 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 ();
+    }
+}
+
+#endif
+
+#if defined(GM2)
+/* GNU Modula-2 linking hooks.  */
+
+extern "C" void
+_M2_dtoa_init (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_dtoa_fini (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_dtoa_dep (void)
+{
+}
+
+struct _M2_dtoa_ctor { _M2_dtoa_ctor (); } _M2_dtoa_ctor;
+
+_M2_dtoa_ctor::_M2_dtoa_ctor (void)
+{
+  M2RTS_RegisterModule ("dtoa", _M2_dtoa_init, _M2_dtoa_fini,
+			_M2_dtoa_dep);
+}
+#endif
diff --git a/libgm2/libm2pim/errno.cc b/libgm2/libm2pim/errno.cc
new file mode 100644
index 00000000000..d47b7b75253
--- /dev/null
+++ b/libgm2/libm2pim/errno.cc
@@ -0,0 +1,70 @@
+/* errno.c provide access to the errno value.
+
+Copyright (C) 2009-2022 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>
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#include "m2rts.h"
+
+extern "C" int
+errno_geterrno (void)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+  return errno;
+#else
+  return -1;
+#endif
+}
+
+extern "C" void
+_M2_errno_init (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_errno_fini (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_errno_dep (void)
+{
+}
+
+struct _M2_errno_ctor { _M2_errno_ctor (); } _M2_errno_ctor;
+
+_M2_errno_ctor::_M2_errno_ctor (void)
+{
+  M2RTS_RegisterModule ("errno", _M2_errno_init, _M2_errno_fini,
+			_M2_errno_dep);
+}
diff --git a/libgm2/libm2pim/ldtoa.cc b/libgm2/libm2pim/ldtoa.cc
new file mode 100644
index 00000000000..8f0ae68c8d0
--- /dev/null
+++ b/libgm2/libm2pim/ldtoa.cc
@@ -0,0 +1,190 @@
+/* ldtoa.c convert long double to ascii and visa versa.
+
+Copyright (C) 2009-2022 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/>.  */
+
+#define GM2
+
+#include <config.h>
+#include <m2rts.h>
+
+#if defined(HAVE_STRINGS)
+#include <strings.h>
+#endif
+
+#if defined(HAVE_STRING)
+#include <string.h>
+#endif
+
+#if defined(HAVE_STDDEF_H)
+/* Obtain a definition for NULL.  */
+#include <stddef.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+/* Obtain a definition for NULL.  */
+#include <stdio.h>
+#endif
+
+#if defined(HAVE_TIME_H)
+/* Obtain a definition for NULL.  */
+#include <time.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+/* Obtain a definition for NULL.  */
+#include <string.h>
+#endif
+
+#if defined(HAVE_WCHAR_H)
+/* Obtain a definition for NULL.  */
+#include <wchar.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#if !defined(_ISOC99_SOURCE)
+#define _ISOC99_SOURCE
+#endif
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+/* Obtain a prototype for free and malloc.  */
+#include <stdlib.h>
+#endif
+
+#if !defined(NULL)
+#define NULL (void *)0
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+extern "C" int dtoa_calcmaxsig (char *p, int ndigits);
+extern "C" int dtoa_calcdecimal (char *p, int str_size, int ndigits);
+extern "C" 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).  */
+
+extern "C" long double
+ldtoa_strtold (const char *s, int *error)
+{
+  char *endp;
+  long double d;
+
+#if defined(HAVE_ERRNO_H)
+  errno = 0;
+#endif
+#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'))
+#if defined(HAVE_ERRNO_H)
+    *error = (errno != 0);
+#else
+    *error = FALSE;
+#endif
+  else
+    *error = TRUE;
+  return d;
+}
+
+extern "C" 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 ();
+    }
+}
+
+#if defined(GM2)
+/* GNU Modula-2 linking hooks.  */
+
+extern "C" void
+_M2_ldtoa_init (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_ldtoa_fini (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_ldtoa_dep (void)
+{
+}
+
+struct _M2_ldtoa_ctor { _M2_ldtoa_ctor (); } _M2_ldtoa_ctor;
+
+_M2_ldtoa_ctor::_M2_ldtoa_ctor (void)
+{
+  M2RTS_RegisterModule ("ldtoa", _M2_ldtoa_init, _M2_ldtoa_fini,
+			_M2_ldtoa_dep);
+}
+#endif
diff --git a/libgm2/libm2pim/sckt.cc b/libgm2/libm2pim/sckt.cc
new file mode 100644
index 00000000000..6c68525acb0
--- /dev/null
+++ b/libgm2/libm2pim/sckt.cc
@@ -0,0 +1,430 @@
+/* sckt.c provide access to the socket layer.
+
+Copyright (C) 2005-2022 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 <m2rts.h>
+
+#if defined(HAVE_SYS_TYPES_H)
+#include <sys/types.h>
+#endif
+
+#if defined(HAVE_SYS_SOCKET_H)
+#include <sys/socket.h>
+#endif
+
+#if defined(HAVE_NETINET_IN_H)
+#include <netinet/in.h>
+#endif
+
+#if defined(HAVE_NETDB_H)
+#include <netdb.h>
+#endif
+
+#if defined(HAVE_UNISTD_H)
+#include <unistd.h>
+#endif
+
+#if defined(HAVE_SIGNAL_H)
+#include <signal.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#include <malloc.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+#include <string.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+#include <stdio.h>
+#endif
+
+#define PORTSTART 7000
+#define NOOFTRIES 100
+#define MAXHOSTNAME 256
+
+#undef DEBUGGING
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if defined(HAVE_SYS_SOCKET_H)
+
+#define ERROR(X)                                                              \
+  {                                                                           \
+    printf ("%s:%d:%s\n", __FILE__, __LINE__, X);                             \
+    localExit (1);                                                            \
+  }
+
+#define ASSERT(X)                                                             \
+  {                                                                           \
+    if (!(X))                                                                 \
+      {                                                                       \
+        printf ("%s:%d: assert(%s) failed\n", __FILE__, __LINE__, #X);        \
+        exit (1);                                                             \
+      }                                                                       \
+  }
+
+typedef struct
+{
+  char hostname[MAXHOSTNAME];
+  struct hostent *hp;
+  struct sockaddr_in sa, isa;
+  int sockFd;
+  int portNo;
+} tcpServerState;
+
+int
+localExit (int i)
+{
+  exit (1);
+}
+
+/* tcpServerEstablishPort returns a tcpState containing the relevant
+   information about a socket declared to receive tcp connections.
+   This method attempts to use the port specified by the parameter.  */
+
+extern "C" tcpServerState *
+tcpServerEstablishPort (int portNo)
+{
+  tcpServerState *s = (tcpServerState *)malloc (sizeof (tcpServerState));
+  int b, p, n;
+
+  if (s == NULL)
+    ERROR ("no more memory");
+
+  /* Remove SIGPIPE which is raised on the server if the client is killed.  */
+  signal (SIGPIPE, SIG_IGN);
+
+  if (gethostname (s->hostname, MAXHOSTNAME) < 0)
+    ERROR ("cannot find our hostname");
+
+  s->hp = gethostbyname (s->hostname);
+  if (s->hp == NULL)
+    ERROR ("cannot get host name");
+
+  p = -1;
+  n = 0;
+  do
+    {
+      p++;
+       /* Open a TCP socket (an Internet stream socket).  */
+
+      s->sockFd = socket (s->hp->h_addrtype, SOCK_STREAM, 0);
+      if (s->sockFd < 0)
+        ERROR ("socket");
+
+      memset ((void *)&s->sa, 0, sizeof (s->sa));
+      ASSERT ((s->hp->h_addrtype == AF_INET));
+      s->sa.sin_family = s->hp->h_addrtype;
+      s->sa.sin_addr.s_addr = htonl (INADDR_ANY);
+      s->sa.sin_port = htons (portNo + p);
+
+      b = bind (s->sockFd, (struct sockaddr *)&s->sa, sizeof (s->sa));
+    }
+  while ((b < 0) && (n < NOOFTRIES));
+
+  if (b < 0)
+    ERROR ("bind");
+
+  s->portNo = portNo + p;
+#if defined(DEBUGGING)
+  printf ("the receiving host is: %s, the port is %d\n", s->hostname,
+          s->portNo);
+#endif
+  listen (s->sockFd, 1);
+  return s;
+}
+
+/* tcpServerEstablish returns a tcpServerState containing the relevant
+   information about a socket declared to receive tcp connections.  */
+
+extern "C" tcpServerState *
+tcpServerEstablish (void)
+{
+  return tcpServerEstablishPort (PORTSTART);
+}
+
+/* tcpServerAccept returns a file descriptor once a client has connected and
+   been accepted.  */
+
+extern "C" int
+tcpServerAccept (tcpServerState *s)
+{
+  socklen_t i = sizeof (s->isa);
+  int t;
+
+#if defined(DEBUGGING)
+  printf ("before accept %d\n", s->sockFd);
+#endif
+  t = accept (s->sockFd, (struct sockaddr *)&s->isa, &i);
+  return t;
+}
+
+/* tcpServerPortNo returns the portNo from structure, s.  */
+
+extern "C" int
+tcpServerPortNo (tcpServerState *s)
+{
+  return s->portNo;
+}
+
+/* tcpServerSocketFd returns the sockFd from structure, s.  */
+
+extern "C" int
+tcpServerSocketFd (tcpServerState *s)
+{
+  return s->sockFd;
+}
+
+/* getLocalIP returns the IP address of this machine.  */
+
+extern "C" unsigned int
+getLocalIP (tcpServerState *s)
+{
+  char hostname[1024];
+  struct hostent *hp;
+  struct sockaddr_in sa;
+  unsigned int ip;
+  int ret = gethostname (hostname, sizeof (hostname));
+
+  if (ret == -1)
+    {
+      ERROR ("gethostname");
+      return 0;
+    }
+
+  hp = gethostbyname (hostname);
+  if (hp == NULL)
+    {
+      ERROR ("gethostbyname");
+      return 0;
+    }
+
+  if (sizeof (unsigned int) != sizeof (in_addr_t))
+    {
+      ERROR ("bad ip length");
+      return 0;
+    }
+
+  memset (&sa, sizeof (struct sockaddr_in), 0);
+  sa.sin_family = AF_INET;
+  sa.sin_port = htons (80);
+  if (hp->h_length == sizeof (unsigned int))
+    {
+      memcpy (&ip, hp->h_addr_list[0], hp->h_length);
+      return ip;
+    }
+
+  return 0;
+}
+
+/* tcpServerIP returns the IP address from structure s.  */
+
+extern "C" int
+tcpServerIP (tcpServerState *s)
+{
+  return *((int *)s->hp->h_addr_list[0]);
+}
+
+/* tcpServerClientIP returns the IP address of the client who
+   has connected to server s.  */
+
+extern "C" unsigned int
+tcpServerClientIP (tcpServerState *s)
+{
+  unsigned int ip;
+
+  ASSERT (s->isa.sin_family == AF_INET);
+  ASSERT (sizeof (ip) == 4);
+  memcpy (&ip, &s->isa.sin_addr, sizeof (ip));
+  return ip;
+}
+
+/* tcpServerClientPortNo returns the port number of the client who
+   has connected to server s.  */
+
+extern "C" unsigned int
+tcpServerClientPortNo (tcpServerState *s)
+{
+  return s->isa.sin_port;
+}
+
+/*
+****************************************************************
+***             C L I E N T     R O U T I N E S
+****************************************************************
+ */
+
+typedef struct
+{
+  char hostname[MAXHOSTNAME];
+  struct hostent *hp;
+  struct sockaddr_in sa;
+  int sockFd;
+  int portNo;
+} tcpClientState;
+
+/* tcpClientSocket returns a file descriptor (socket) which has
+   connected to, serverName:portNo.  */
+
+extern "C" tcpClientState *
+tcpClientSocket (char *serverName, int portNo)
+{
+  tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState));
+
+  if (s == NULL)
+    ERROR ("no more memory");
+
+  /* Remove SIGPIPE which is raised on the server if the client is killed.  */
+  signal (SIGPIPE, SIG_IGN);
+
+  s->hp = gethostbyname (serverName);
+  if (s->hp == NULL)
+    {
+      fprintf (stderr, "cannot find host: %s\n", serverName);
+      exit (1);
+    }
+
+  memset ((void *)&s->sa, 0, sizeof (s->sa));
+  s->sa.sin_family = AF_INET;
+  memcpy ((void *)&s->sa.sin_addr, (void *)s->hp->h_addr, s->hp->h_length);
+  s->portNo = portNo;
+  s->sa.sin_port = htons (portNo);
+
+  /* Open a TCP socket (an Internet stream socket).  */
+
+  s->sockFd = socket (s->hp->h_addrtype, SOCK_STREAM, 0);
+  return s;
+}
+
+/* tcpClientSocketIP returns a file descriptor (socket) which has
+   connected to, ip:portNo.  */
+
+extern "C" tcpClientState *
+tcpClientSocketIP (unsigned int ip, int portNo)
+{
+  tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState));
+
+  if (s == NULL)
+    ERROR ("no more memory");
+
+  /* Remove SIGPIPE which is raised on the server if the client is killed.  */
+  signal (SIGPIPE, SIG_IGN);
+
+  memset ((void *)&s->sa, 0, sizeof (s->sa));
+  s->sa.sin_family = AF_INET;
+  memcpy ((void *)&s->sa.sin_addr, (void *)&ip, sizeof (ip));
+  s->portNo = portNo;
+  s->sa.sin_port = htons (portNo);
+
+  /* Open a TCP socket (an Internet stream socket).  */
+
+  s->sockFd = socket (PF_INET, SOCK_STREAM, 0);
+  return s;
+}
+
+/* tcpClientConnect returns the file descriptor associated with s,
+   once a connect has been performed.  */
+
+extern "C" int
+tcpClientConnect (tcpClientState *s)
+{
+  if (connect (s->sockFd, (struct sockaddr *)&s->sa, sizeof (s->sa)) < 0)
+    ERROR ("failed to connect to the TCP server");
+
+  return s->sockFd;
+}
+
+/* tcpClientPortNo returns the portNo from structure s.  */
+
+extern "C" int
+tcpClientPortNo (tcpClientState *s)
+{
+  return s->portNo;
+}
+
+/* tcpClientSocketFd returns the sockFd from structure s.  */
+
+extern "C" int
+tcpClientSocketFd (tcpClientState *s)
+{
+  return s->sockFd;
+}
+
+/* tcpClientIP returns the sockFd from structure s.  */
+
+extern "C" int
+tcpClientIP (tcpClientState *s)
+{
+#if defined(DEBUGGING)
+  printf ("client ip = %s\n", inet_ntoa (s->sa.sin_addr.s_addr));
+#endif
+  return s->sa.sin_addr.s_addr;
+}
+#endif
+
+/* GNU Modula-2 link fodder.  */
+
+extern "C" void
+_M2_sckt_init (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_sckt_finish (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_sckt_dep (void)
+{
+}
+
+struct _M2_sckt_ctor { _M2_sckt_ctor (); } _M2_sckt_ctor;
+
+_M2_sckt_ctor::_M2_sckt_ctor (void)
+{
+  M2RTS_RegisterModule ("sckt", _M2_sckt_init, _M2_sckt_finish,
+			_M2_sckt_dep);
+}
diff --git a/libgm2/libm2pim/target.c b/libgm2/libm2pim/target.c
new file mode 100644
index 00000000000..0e66391972d
--- /dev/null
+++ b/libgm2/libm2pim/target.c
@@ -0,0 +1,61 @@
+/* target.c provide access to miscellaneous math functions.
+
+Copyright (C) 2005-2022 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>
+
+#if defined(HAVE_MATH_H)
+#include <math.h>
+#endif
+
+#if !defined(HAVE_EXP10)
+#if defined(M_LN10)
+double
+exp10 (double x)
+{
+  return exp (x * M_LN10);
+}
+#endif
+#endif
+
+#if !defined(HAVE_EXP10F)
+#if defined(M_LN10)
+float
+exp10f (float x)
+{
+  return expf (x * M_LN10);
+}
+#endif
+#endif
+
+#if !defined(HAVE_EXP10L)
+#if defined(M_LN10)
+long double
+exp10l (long double x)
+{
+  return expl (x * M_LN10);
+}
+#endif
+#endif
diff --git a/libgm2/libm2pim/termios.cc b/libgm2/libm2pim/termios.cc
new file mode 100644
index 00000000000..b446bb80cf3
--- /dev/null
+++ b/libgm2/libm2pim/termios.cc
@@ -0,0 +1,1987 @@
+/* termios.cc provide access to the terminal.
+
+Copyright (C) 2010-2022 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 <m2rts.h>
+
+#if defined(HAVE_STDIO_H)
+#include <stdio.h>
+#endif
+#if defined(HAVE_STDARG_H)
+#include <stdarg.h>
+#endif
+#if defined(HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+#if defined(HAVE_STRING_H)
+#include <string.h>
+#endif
+#if defined(HAVE_STRINGS_H)
+#include <strings.h>
+#endif
+
+#ifdef TERMIOS_NEEDS_XOPEN_SOURCE
+#define _XOPEN_SOURCE
+#endif
+
+#if defined(HAVE_SYS_TYPES_H)
+#include <sys/types.h>
+#endif
+
+#if defined(HAVE_TERMIOS_H)
+#include <termios.h>
+#endif
+
+void _M2_termios_init (void);
+void _M2_termios_finish (void);
+
+#if defined(HAVE_TERMIOS_H)
+
+#define EXPORT(X) termios##_##X
+
+typedef enum {
+  vintr,
+  vquit,
+  verase,
+  vkill,
+  veof,
+  vtime,
+  vmin,
+  vswtc,
+  vstart,
+  vstop,
+  vsusp,
+  veol,
+  vreprint,
+  vdiscard,
+  vwerase,
+  vlnext,
+  veol2
+} ControlChar;
+
+typedef enum {
+  /* Input flag bits.  */
+  ignbrk,
+  ibrkint,
+  ignpar,
+  iparmrk,
+  inpck,
+  istrip,
+  inlcr,
+  igncr,
+  icrnl,
+  iuclc,
+  ixon,
+  ixany,
+  ixoff,
+  imaxbel,
+  /* Output flag bits.  */
+  opost,
+  olcuc,
+  onlcr,
+  ocrnl,
+  onocr,
+  onlret,
+  ofill,
+  ofdel,
+  onl0,
+  onl1,
+  ocr0,
+  ocr1,
+  ocr2,
+  ocr3,
+  otab0,
+  otab1,
+  otab2,
+  otab3,
+  obs0,
+  obs1,
+  off0,
+  off1,
+  ovt0,
+  ovt1,
+  /* Baud rate.  */
+  b0,
+  b50,
+  b75,
+  b110,
+  b135,
+  b150,
+  b200,
+  b300,
+  b600,
+  b1200,
+  b1800,
+  b2400,
+  b4800,
+  b9600,
+  b19200,
+  b38400,
+  b57600,
+  b115200,
+  b240400,
+  b460800,
+  b500000,
+  b576000,
+  b921600,
+  b1000000,
+  b1152000,
+  b1500000,
+  b2000000,
+  b2500000,
+  b3000000,
+  b3500000,
+  b4000000,
+  maxbaud,
+  crtscts,
+  /* Character size.  */
+  cs5,
+  cs6,
+  cs7,
+  cs8,
+  cstopb,
+  cread,
+  parenb,
+  parodd,
+  hupcl,
+  clocal,
+  /* Local flags.  */
+  lisig,
+  licanon,
+  lxcase,
+  lecho,
+  lechoe,
+  lechok,
+  lechonl,
+  lnoflsh,
+  ltopstop,
+  lechoctl,
+  lechoprt,
+  lechoke,
+  lflusho,
+  lpendin,
+  liexten
+} Flag;
+
+/* Prototypes.  */
+extern "C" void *EXPORT (InitTermios) (void);
+extern "C" void *EXPORT (KillTermios) (struct termios *p);
+extern "C" int EXPORT (cfgetospeed) (struct termios *t);
+extern "C" int EXPORT (cfgetispeed) (struct termios *t);
+extern "C" int EXPORT (cfsetospeed) (struct termios *t, unsigned int b);
+extern "C" int EXPORT (cfsetispeed) (struct termios *t, unsigned int b);
+extern "C" int EXPORT (cfsetspeed) (struct termios *t, unsigned int b);
+extern "C" int EXPORT (tcgetattr) (int fd, struct termios *t);
+extern "C" int EXPORT (tcsetattr) (int fd, int option, struct termios *t);
+extern "C" void EXPORT (cfmakeraw) (struct termios *t);
+extern "C" int EXPORT (tcsendbreak) (int fd, int duration);
+extern "C" int EXPORT (tcdrain) (int fd);
+extern "C" int EXPORT (tcflushi) (int fd);
+extern "C" int EXPORT (tcflusho) (int fd);
+extern "C" int EXPORT (tcflushio) (int fd);
+extern "C" int EXPORT (tcflowoni) (int fd);
+extern "C" int EXPORT (tcflowoffi) (int fd);
+extern "C" int EXPORT (tcflowono) (int fd);
+extern "C" int EXPORT (tcflowoffo) (int fd);
+extern "C" int EXPORT (GetFlag) (struct termios *t, Flag f, int *b);
+extern "C" int EXPORT (SetFlag) (struct termios *t, Flag f, int b);
+extern "C" int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch);
+extern "C" int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch);
+extern "C" int EXPORT (tcsnow) (void);
+extern "C" int EXPORT (tcsflush) (void);
+extern "C" int EXPORT (tcsdrain) (void);
+extern "C" int doSetUnset (tcflag_t *bitset, unsigned int mask, int value);
+
+/* InitTermios new data structure.   */
+
+extern "C" void
+*EXPORT (InitTermios) (void)
+{
+  struct termios *p = (struct termios *)malloc (sizeof (struct termios));
+
+  memset (p, 0, sizeof (struct termios));
+  return p;
+}
+
+/* KillTermios delete data structure.  */
+
+extern "C" void*
+EXPORT (KillTermios) (struct termios *p)
+{
+  free (p);
+  return NULL;
+}
+
+/* tcsnow return the value of TCSANOW.  */
+
+extern "C" int
+EXPORT (tcsnow) (void) { return TCSANOW; }
+
+/* tcsdrain return the value of TCSADRAIN.  */
+
+extern "C" int
+EXPORT (tcsdrain) (void) { return TCSADRAIN; }
+
+/* tcsflush return the value of TCSAFLUSH.  */
+
+extern "C" int
+EXPORT (tcsflush) (void) { return TCSAFLUSH; }
+
+/* cfgetospeed return output baud rate.  */
+
+extern "C" int
+EXPORT (cfgetospeed) (struct termios *t) { return cfgetospeed (t); }
+
+/* cfgetispeed return input baud rate.  */
+
+extern "C" int
+EXPORT (cfgetispeed) (struct termios *t) { return cfgetispeed (t); }
+
+/* cfsetospeed set output baud rate.  */
+
+extern "C" int
+EXPORT (cfsetospeed) (struct termios *t, unsigned int b)
+{
+  return cfsetospeed (t, b);
+}
+
+/* cfsetispeed set input baud rate.  */
+
+extern "C" int
+EXPORT (cfsetispeed) (struct termios *t, unsigned int b)
+{
+  return cfsetispeed (t, b);
+}
+
+/* cfsetspeed set input and output baud rate.  */
+
+extern "C" int
+EXPORT (cfsetspeed) (struct termios *t, unsigned int b)
+{
+  int val = cfsetispeed (t, b);
+  if (val == 0)
+    return cfsetospeed (t, b);
+  cfsetospeed (t, b);
+  return val;
+}
+
+/* tcgetattr get state of, fd, into, t.  */
+
+extern "C" int
+EXPORT (tcgetattr) (int fd, struct termios *t)
+{
+  return tcgetattr (fd, t);
+}
+
+/* tcsetattr set state of, fd, to, t, using option.  */
+
+int EXPORT (tcsetattr) (int fd, int option, struct termios *t)
+{
+  return tcsetattr (fd, option, t);
+}
+
+/* cfmakeraw sets the terminal to raw mode.  */
+
+extern "C" void
+EXPORT (cfmakeraw) (struct termios *t)
+{
+#if defined(HAVE_CFMAKERAW)
+  return cfmakeraw (t);
+#endif
+}
+
+/* tcsendbreak send zero bits for duration.  */
+
+extern "C" int
+EXPORT (tcsendbreak) (int fd, int duration)
+{
+  return tcsendbreak (fd, duration);
+}
+
+/* tcdrain waits for pending output to be written on, fd.  */
+
+extern "C" int
+EXPORT (tcdrain) (int fd) { return tcdrain (fd); }
+
+/* tcflushi flush input.  */
+
+extern "C" int
+EXPORT (tcflushi) (int fd)
+{
+#if defined(TCIFLUSH)
+  return tcflush (fd, TCIFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflusho flush output.  */
+
+extern "C" int
+EXPORT (tcflusho) (int fd)
+{
+#if defined(TCOFLUSH)
+  return tcflush (fd, TCOFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflushio flush input and output.  */
+
+extern "C" int
+EXPORT (tcflushio) (int fd)
+{
+#if defined(TCIOFLUSH)
+  return tcflush (fd, TCIOFLUSH);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoni restart input on, fd.  */
+
+extern "C" int
+EXPORT (tcflowoni) (int fd)
+{
+#if defined(TCION)
+  return tcflow (fd, TCION);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoffi stop input on, fd.  */
+
+extern "C" int
+EXPORT (tcflowoffi) (int fd)
+{
+#if defined(TCIOFF)
+  return tcflow (fd, TCIOFF);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowono restart output on, fd.  */
+
+extern "C" int
+EXPORT (tcflowono) (int fd)
+{
+#if defined(TCOON)
+  return tcflow (fd, TCOON);
+#else
+  return 1;
+#endif
+}
+
+/* tcflowoffo stop output on, fd.  */
+
+extern "C" int
+EXPORT (tcflowoffo) (int fd)
+{
+#if defined(TCOOFF)
+  return tcflow (fd, TCOOFF);
+#else
+  return 1;
+#endif
+}
+
+/* doSetUnset applies mask or undoes mask depending upon value.  */
+
+extern "C" int
+doSetUnset (tcflag_t *bitset, unsigned int mask, int value)
+{
+  if (value)
+    (*bitset) |= mask;
+  else
+    (*bitset) &= (~mask);
+  return 1;
+}
+
+/* GetFlag sets a flag value from, t, in, b, and returns TRUE
+   if, t, supports, f.  */
+
+extern "C" int
+EXPORT (GetFlag) (struct termios *t, Flag f, int *b)
+{
+  switch (f)
+    {
+
+    case ignbrk:
+#if defined(IGNBRK)
+      *b = ((t->c_iflag & IGNBRK) == IGNBRK);
+      return 1;
+#else
+      return 0;
+#endif
+    case ibrkint:
+#if defined(BRKINT)
+      *b = ((t->c_iflag & BRKINT) == BRKINT);
+      return 1;
+#else
+      return 0;
+#endif
+    case ignpar:
+#if defined(IGNPAR)
+      *b = ((t->c_iflag & IGNPAR) == IGNPAR);
+      return 1;
+#else
+      return 0;
+#endif
+    case iparmrk:
+#if defined(PARMRK)
+      *b = ((t->c_iflag & PARMRK) == PARMRK);
+      return 1;
+#else
+      return 0;
+#endif
+    case inpck:
+#if defined(INPCK)
+      *b = ((t->c_iflag & INPCK) == INPCK);
+      return 1;
+#else
+      return 0;
+#endif
+    case istrip:
+#if defined(ISTRIP)
+      *b = ((t->c_iflag & ISTRIP) == ISTRIP);
+      return 1;
+#else
+      return 0;
+#endif
+    case inlcr:
+#if defined(INLCR)
+      *b = ((t->c_iflag & INLCR) == INLCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case igncr:
+#if defined(IGNCR)
+      *b = ((t->c_iflag & IGNCR) == IGNCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case icrnl:
+#if defined(ICRNL)
+      *b = ((t->c_iflag & ICRNL) == ICRNL);
+      return 1;
+#else
+      return 0;
+#endif
+    case iuclc:
+#if defined(IUCLC)
+      *b = ((t->c_iflag & IUCLC) == IUCLC);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixon:
+#if defined(IXON)
+      *b = ((t->c_iflag & IXON) == IXON);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixany:
+#if defined(IXANY)
+      *b = ((t->c_iflag & IXANY) == IXANY);
+      return 1;
+#else
+      return 0;
+#endif
+    case ixoff:
+#if defined(IXOFF)
+      *b = ((t->c_iflag & IXOFF) == IXOFF);
+      return 1;
+#else
+      return 0;
+#endif
+    case imaxbel:
+#if defined(IMAXBEL)
+      *b = ((t->c_iflag & IMAXBEL) == IMAXBEL);
+      return 1;
+#else
+      return 0;
+#endif
+    case opost:
+#if defined(OPOST)
+      *b = ((t->c_oflag & OPOST) == OPOST);
+      return 1;
+#else
+      return 0;
+#endif
+    case olcuc:
+#if defined(OLCUC)
+      *b = ((t->c_oflag & OLCUC) == OLCUC);
+      return 1;
+#else
+      return 0;
+#endif
+    case onlcr:
+#if defined(ONLCR)
+      *b = ((t->c_oflag & ONLCR) == ONLCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocrnl:
+#if defined(OCRNL)
+      *b = ((t->c_oflag & OCRNL) == OCRNL);
+      return 1;
+#else
+      return 0;
+#endif
+    case onocr:
+#if defined(ONOCR)
+      *b = ((t->c_oflag & ONOCR) == ONOCR);
+      return 1;
+#else
+      return 0;
+#endif
+    case onlret:
+#if defined(ONLRET)
+      *b = ((t->c_oflag & ONLRET) == ONLRET);
+      return 1;
+#else
+      return 0;
+#endif
+    case ofill:
+#if defined(OFILL)
+      *b = ((t->c_oflag & OFILL) == OFILL);
+      return 1;
+#else
+      return 0;
+#endif
+    case ofdel:
+#if defined(OFDEL)
+      *b = ((t->c_oflag & OFDEL) == OFDEL);
+      return 1;
+#else
+      return 0;
+#endif
+    case onl0:
+#if defined(NL0)
+      *b = ((t->c_oflag & NL0) == NL0);
+      return 1;
+#else
+      return 0;
+#endif
+    case onl1:
+#if defined(NL1)
+      *b = ((t->c_oflag & NL1) == NL1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr0:
+#if defined(CR0)
+      *b = ((t->c_oflag & CR0) == CR0);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr1:
+#if defined(CR1)
+      *b = ((t->c_oflag & CR1) == CR1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr2:
+#if defined(CR2)
+      *b = ((t->c_oflag & CR2) == CR2);
+      return 1;
+#else
+      return 0;
+#endif
+    case ocr3:
+#if defined(CR3)
+      *b = ((t->c_oflag & CR3) == CR3);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab0:
+#if defined(TAB0)
+      *b = ((t->c_oflag & TAB0) == TAB0);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab1:
+#if defined(TAB1)
+      *b = ((t->c_oflag & TAB1) == TAB1);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab2:
+#if defined(TAB2)
+      *b = ((t->c_oflag & TAB2) == TAB2);
+      return 1;
+#else
+      return 0;
+#endif
+    case otab3:
+#if defined(TAB3)
+      *b = ((t->c_oflag & TAB3) == TAB3);
+      return 1;
+#else
+      return 0;
+#endif
+    case obs0:
+#if defined(BS0)
+      *b = ((t->c_oflag & BS0) == BS0);
+      return 1;
+#else
+      return 0;
+#endif
+    case obs1:
+#if defined(BS1)
+      *b = ((t->c_oflag & BS1) == BS1);
+      return 1;
+#else
+      return 0;
+#endif
+    case off0:
+#if defined(FF0)
+      *b = ((t->c_oflag & FF0) == FF0);
+      return 1;
+#else
+      return 0;
+#endif
+    case off1:
+#if defined(FF1)
+      *b = ((t->c_oflag & FF1) == FF1);
+      return 1;
+#else
+      return 0;
+#endif
+    case ovt0:
+#if defined(VT0)
+      *b = ((t->c_oflag & VT0) == VT0);
+      return 1;
+#else
+      return 0;
+#endif
+    case ovt1:
+#if defined(VT1)
+      *b = ((t->c_oflag & VT1) == VT1);
+      return 1;
+#else
+      return 0;
+#endif
+    case b0:
+#if defined(B0)
+      *b = ((t->c_cflag & B0) == B0);
+      return 1;
+#else
+      return 0;
+#endif
+    case b50:
+#if defined(B50)
+      *b = ((t->c_cflag & B50) == B50);
+      return 1;
+#else
+      return 0;
+#endif
+    case b75:
+#if defined(B75)
+      *b = ((t->c_cflag & B75) == B75);
+      return 1;
+#else
+      return 0;
+#endif
+    case b110:
+#if defined(B110)
+      *b = ((t->c_cflag & B110) == B110);
+      return 1;
+#else
+      return 0;
+#endif
+    case b135:
+#if defined(B134)
+      *b = ((t->c_cflag & B134) == B134);
+      return 1;
+#else
+      return 0;
+#endif
+    case b150:
+#if defined(B150)
+      *b = ((t->c_cflag & B150) == B150);
+      return 1;
+#else
+      return 0;
+#endif
+    case b200:
+#if defined(B200)
+      *b = ((t->c_cflag & B200) == B200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b300:
+#if defined(B300)
+      *b = ((t->c_cflag & B300) == B300);
+      return 1;
+#else
+      return 0;
+#endif
+    case b600:
+#if defined(B600)
+      *b = ((t->c_cflag & B600) == B600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1200:
+#if defined(B1200)
+      *b = ((t->c_cflag & B1200) == B1200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1800:
+#if defined(B1800)
+      *b = ((t->c_cflag & B1800) == B1800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2400:
+#if defined(B2400)
+      *b = ((t->c_cflag & B2400) == B2400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b4800:
+#if defined(B4800)
+      *b = ((t->c_cflag & B4800) == B4800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b9600:
+#if defined(B9600)
+      *b = ((t->c_cflag & B9600) == B9600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b19200:
+#if defined(B19200)
+      *b = ((t->c_cflag & B19200) == B19200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b38400:
+#if defined(B38400)
+      *b = ((t->c_cflag & B38400) == B38400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b57600:
+#if defined(B57600)
+      *b = ((t->c_cflag & B57600) == B57600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b115200:
+#if defined(B115200)
+      *b = ((t->c_cflag & B115200) == B115200);
+      return 1;
+#else
+      return 0;
+#endif
+    case b240400:
+#if defined(B230400)
+      *b = ((t->c_cflag & B230400) == B230400);
+      return 1;
+#else
+      return 0;
+#endif
+    case b460800:
+#if defined(B460800)
+      *b = ((t->c_cflag & B460800) == B460800);
+      return 1;
+#else
+      return 0;
+#endif
+    case b500000:
+#if defined(B500000)
+      *b = ((t->c_cflag & B500000) == B500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b576000:
+#if defined(B576000)
+      *b = ((t->c_cflag & B576000) == B576000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b921600:
+#if defined(B921600)
+      *b = ((t->c_cflag & B921600) == B921600);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1000000:
+#if defined(B1000000)
+      *b = ((t->c_cflag & B1000000) == B1000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1152000:
+#if defined(B1152000)
+      *b = ((t->c_cflag & B1152000) == B1152000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b1500000:
+#if defined(B1500000)
+      *b = ((t->c_cflag & B1500000) == B1500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2000000:
+#if defined(B2000000)
+      *b = ((t->c_cflag & B2000000) == B2000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b2500000:
+#if defined(B2500000)
+      *b = ((t->c_cflag & B2500000) == B2500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b3000000:
+#if defined(B3000000)
+      *b = ((t->c_cflag & B3000000) == B3000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b3500000:
+#if defined(B3500000)
+      *b = ((t->c_cflag & B3500000) == B3500000);
+      return 1;
+#else
+      return 0;
+#endif
+    case b4000000:
+#if defined(B4000000)
+      *b = ((t->c_cflag & B4000000) == B4000000);
+      return 1;
+#else
+      return 0;
+#endif
+    case maxbaud:
+#if defined(MAX)
+      *b = ((t->c_cflag & __MAX_BAUD) == __MAX_BAUD);
+      return 1;
+#else
+      return 0;
+#endif
+    case crtscts:
+#if defined(CRTSCTS)
+      *b = ((t->c_cflag & CRTSCTS) == CRTSCTS);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs5:
+#if defined(CS5)
+      *b = ((t->c_cflag & CS5) == CS5);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs6:
+#if defined(CS6)
+      *b = ((t->c_cflag & CS6) == CS6);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs7:
+#if defined(CS7)
+      *b = ((t->c_cflag & CS7) == CS7);
+      return 1;
+#else
+      return 0;
+#endif
+    case cs8:
+#if defined(CS8)
+      *b = ((t->c_cflag & CS8) == CS8);
+      return 1;
+#else
+      return 0;
+#endif
+    case cstopb:
+#if defined(CSTOPB)
+      *b = ((t->c_cflag & CSTOPB) == CSTOPB);
+      return 1;
+#else
+      return 0;
+#endif
+    case cread:
+#if defined(CREAD)
+      *b = ((t->c_cflag & CREAD) == CREAD);
+      return 1;
+#else
+      return 0;
+#endif
+    case parenb:
+#if defined(PARENB)
+      *b = ((t->c_cflag & PARENB) == PARENB);
+      return 1;
+#else
+      return 0;
+#endif
+    case parodd:
+#if defined(PARODD)
+      *b = ((t->c_cflag & PARODD) == PARODD);
+      return 1;
+#else
+      return 0;
+#endif
+    case hupcl:
+#if defined(HUPCL)
+      *b = ((t->c_cflag & HUPCL) == HUPCL);
+      return 1;
+#else
+      return 0;
+#endif
+    case clocal:
+#if defined(CLOCAL)
+      *b = ((t->c_cflag & CLOCAL) == CLOCAL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lisig:
+#if defined(ISIG)
+      *b = ((t->c_lflag & ISIG) == ISIG);
+      return 1;
+#else
+      return 0;
+#endif
+    case licanon:
+#if defined(ICANON)
+      *b = ((t->c_lflag & ICANON) == ICANON);
+      return 1;
+#else
+      return 0;
+#endif
+    case lxcase:
+#if defined(XCASE)
+      *b = ((t->c_lflag & XCASE) == XCASE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lecho:
+#if defined(ECHO)
+      *b = ((t->c_lflag & ECHO) == ECHO);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoe:
+#if defined(ECHOE)
+      *b = ((t->c_lflag & ECHOE) == ECHOE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechok:
+#if defined(ECHOK)
+      *b = ((t->c_lflag & ECHOK) == ECHOK);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechonl:
+#if defined(ECHONL)
+      *b = ((t->c_lflag & ECHONL) == ECHONL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lnoflsh:
+#if defined(NOFLSH)
+      *b = ((t->c_lflag & NOFLSH) == NOFLSH);
+      return 1;
+#else
+      return 0;
+#endif
+    case ltopstop:
+#if defined(TOSTOP)
+      *b = ((t->c_lflag & TOSTOP) == TOSTOP);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoctl:
+#if defined(ECHOCTL)
+      *b = ((t->c_lflag & ECHOCTL) == ECHOCTL);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoprt:
+#if defined(ECHOPRT)
+      *b = ((t->c_lflag & ECHOPRT) == ECHOPRT);
+      return 1;
+#else
+      return 0;
+#endif
+    case lechoke:
+#if defined(ECHOKE)
+      *b = ((t->c_lflag & ECHOKE) == ECHOKE);
+      return 1;
+#else
+      return 0;
+#endif
+    case lflusho:
+#if defined(FLUSHO)
+      *b = ((t->c_lflag & FLUSHO) == FLUSHO);
+      return 1;
+#else
+      return 0;
+#endif
+    case lpendin:
+#if defined(PENDIN)
+      *b = ((t->c_lflag & PENDIN) == PENDIN);
+      return 1;
+#else
+      return 0;
+#endif
+    case liexten:
+#if defined(IEXTEN)
+      *b = ((t->c_lflag & IEXTEN) == IEXTEN);
+      return 1;
+#else
+      return 0;
+#endif
+    }
+  return 0;
+}
+
+/* SetFlag sets a flag value in, t, to, b, and returns TRUE if
+   this flag value is supported.  */
+
+extern "C" int
+EXPORT (SetFlag) (struct termios *t, Flag f, int b)
+{
+  switch (f)
+    {
+
+    case ignbrk:
+#if defined(IGNBRK)
+      return doSetUnset (&t->c_iflag, IGNBRK, b);
+#else
+      return 0;
+#endif
+    case ibrkint:
+#if defined(BRKINT)
+      return doSetUnset (&t->c_iflag, BRKINT, b);
+#else
+      return 0;
+#endif
+    case ignpar:
+#if defined(IGNPAR)
+      return doSetUnset (&t->c_iflag, IGNPAR, b);
+#else
+      return 0;
+#endif
+    case iparmrk:
+#if defined(PARMRK)
+      return doSetUnset (&t->c_iflag, PARMRK, b);
+#else
+      return 0;
+#endif
+    case inpck:
+#if defined(INPCK)
+      return doSetUnset (&t->c_iflag, INPCK, b);
+#else
+      return 0;
+#endif
+    case istrip:
+#if defined(ISTRIP)
+      return doSetUnset (&t->c_iflag, ISTRIP, b);
+#else
+      return 0;
+#endif
+    case inlcr:
+#if defined(INLCR)
+      return doSetUnset (&t->c_iflag, INLCR, b);
+#else
+      return 0;
+#endif
+    case igncr:
+#if defined(IGNCR)
+      return doSetUnset (&t->c_iflag, IGNCR, b);
+#else
+      return 0;
+#endif
+    case icrnl:
+#if defined(ICRNL)
+      return doSetUnset (&t->c_iflag, ICRNL, b);
+#else
+      return 0;
+#endif
+    case iuclc:
+#if defined(IUCLC)
+      return doSetUnset (&t->c_iflag, IUCLC, b);
+#else
+      return 0;
+#endif
+    case ixon:
+#if defined(IXON)
+      return doSetUnset (&t->c_iflag, IXON, b);
+#else
+      return 0;
+#endif
+    case ixany:
+#if defined(IXANY)
+      return doSetUnset (&t->c_iflag, IXANY, b);
+#else
+      return 0;
+#endif
+    case ixoff:
+#if defined(IXOFF)
+      return doSetUnset (&t->c_iflag, IXOFF, b);
+#else
+      return 0;
+#endif
+    case imaxbel:
+#if defined(IMAXBEL)
+      return doSetUnset (&t->c_iflag, IMAXBEL, b);
+#else
+      return 0;
+#endif
+    case opost:
+#if defined(OPOST)
+      return doSetUnset (&t->c_oflag, OPOST, b);
+#else
+      return 0;
+#endif
+    case olcuc:
+#if defined(OLCUC)
+      return doSetUnset (&t->c_oflag, OLCUC, b);
+#else
+      return 0;
+#endif
+    case onlcr:
+#if defined(ONLCR)
+      return doSetUnset (&t->c_oflag, ONLCR, b);
+#else
+      return 0;
+#endif
+    case ocrnl:
+#if defined(OCRNL)
+      return doSetUnset (&t->c_oflag, OCRNL, b);
+#else
+      return 0;
+#endif
+    case onocr:
+#if defined(ONOCR)
+      return doSetUnset (&t->c_oflag, ONOCR, b);
+#else
+      return 0;
+#endif
+    case onlret:
+#if defined(ONLRET)
+      return doSetUnset (&t->c_oflag, ONLRET, b);
+#else
+      return 0;
+#endif
+    case ofill:
+#if defined(OFILL)
+      return doSetUnset (&t->c_oflag, OFILL, b);
+#else
+      return 0;
+#endif
+    case ofdel:
+#if defined(OFDEL)
+      return doSetUnset (&t->c_oflag, OFDEL, b);
+#else
+      return 0;
+#endif
+    case onl0:
+#if defined(NL0)
+      return doSetUnset (&t->c_oflag, NL0, b);
+#else
+      return 0;
+#endif
+    case onl1:
+#if defined(NL1)
+      return doSetUnset (&t->c_oflag, NL1, b);
+#else
+      return 0;
+#endif
+    case ocr0:
+#if defined(CR0)
+      return doSetUnset (&t->c_oflag, CR0, b);
+#else
+      return 0;
+#endif
+    case ocr1:
+#if defined(CR1)
+      return doSetUnset (&t->c_oflag, CR1, b);
+#else
+      return 0;
+#endif
+    case ocr2:
+#if defined(CR2)
+      return doSetUnset (&t->c_oflag, CR2, b);
+#else
+      return 0;
+#endif
+    case ocr3:
+#if defined(CR3)
+      return doSetUnset (&t->c_oflag, CR3, b);
+#else
+      return 0;
+#endif
+    case otab0:
+#if defined(TAB0)
+      return doSetUnset (&t->c_oflag, TAB0, b);
+#else
+      return 0;
+#endif
+    case otab1:
+#if defined(TAB1)
+      return doSetUnset (&t->c_oflag, TAB1, b);
+#else
+      return 0;
+#endif
+    case otab2:
+#if defined(TAB2)
+      return doSetUnset (&t->c_oflag, TAB2, b);
+#else
+      return 0;
+#endif
+    case otab3:
+#if defined(TAB3)
+      return doSetUnset (&t->c_oflag, TAB3, b);
+#else
+      return 0;
+#endif
+    case obs0:
+#if defined(BS0)
+      return doSetUnset (&t->c_oflag, BS0, b);
+#else
+      return 0;
+#endif
+    case obs1:
+#if defined(BS1)
+      return doSetUnset (&t->c_oflag, BS1, b);
+#else
+      return 0;
+#endif
+    case off0:
+#if defined(FF0)
+      return doSetUnset (&t->c_oflag, FF0, b);
+#else
+      return 0;
+#endif
+    case off1:
+#if defined(FF1)
+      return doSetUnset (&t->c_oflag, FF1, b);
+#else
+      return 0;
+#endif
+    case ovt0:
+#if defined(VT0)
+      return doSetUnset (&t->c_oflag, VT0, b);
+#else
+      return 0;
+#endif
+    case ovt1:
+#if defined(VT1)
+      return doSetUnset (&t->c_oflag, VT1, b);
+#else
+      return 0;
+#endif
+    case b0:
+#if defined(B0)
+      return doSetUnset (&t->c_cflag, B0, b);
+#else
+      return 0;
+#endif
+    case b50:
+#if defined(B50)
+      return doSetUnset (&t->c_cflag, B50, b);
+#else
+      return 0;
+#endif
+    case b75:
+#if defined(B75)
+      return doSetUnset (&t->c_cflag, B75, b);
+#else
+      return 0;
+#endif
+    case b110:
+#if defined(B110)
+      return doSetUnset (&t->c_cflag, B110, b);
+#else
+      return 0;
+#endif
+    case b135:
+#if defined(B134)
+      return doSetUnset (&t->c_cflag, B134, b);
+#else
+      return 0;
+#endif
+    case b150:
+#if defined(B150)
+      return doSetUnset (&t->c_cflag, B150, b);
+#else
+      return 0;
+#endif
+    case b200:
+#if defined(B200)
+      return doSetUnset (&t->c_cflag, B200, b);
+#else
+      return 0;
+#endif
+    case b300:
+#if defined(B300)
+      return doSetUnset (&t->c_cflag, B300, b);
+#else
+      return 0;
+#endif
+    case b600:
+#if defined(B600)
+      return doSetUnset (&t->c_cflag, B600, b);
+#else
+      return 0;
+#endif
+    case b1200:
+#if defined(B1200)
+      return doSetUnset (&t->c_cflag, B1200, b);
+#else
+      return 0;
+#endif
+    case b1800:
+#if defined(B1800)
+      return doSetUnset (&t->c_cflag, B1800, b);
+#else
+      return 0;
+#endif
+    case b2400:
+#if defined(B2400)
+      return doSetUnset (&t->c_cflag, B2400, b);
+#else
+      return 0;
+#endif
+    case b4800:
+#if defined(B4800)
+      return doSetUnset (&t->c_cflag, B4800, b);
+#else
+      return 0;
+#endif
+    case b9600:
+#if defined(B9600)
+      return doSetUnset (&t->c_cflag, B9600, b);
+#else
+      return 0;
+#endif
+    case b19200:
+#if defined(B19200)
+      return doSetUnset (&t->c_cflag, B19200, b);
+#else
+      return 0;
+#endif
+    case b38400:
+#if defined(B38400)
+      return doSetUnset (&t->c_cflag, B38400, b);
+#else
+      return 0;
+#endif
+    case b57600:
+#if defined(B57600)
+      return doSetUnset (&t->c_cflag, B57600, b);
+#else
+      return 0;
+#endif
+    case b115200:
+#if defined(B115200)
+      return doSetUnset (&t->c_cflag, B115200, b);
+#else
+      return 0;
+#endif
+    case b240400:
+#if defined(B230400)
+      return doSetUnset (&t->c_cflag, B230400, b);
+#else
+      return 0;
+#endif
+    case b460800:
+#if defined(B460800)
+      return doSetUnset (&t->c_cflag, B460800, b);
+#else
+      return 0;
+#endif
+    case b500000:
+#if defined(B500000)
+      return doSetUnset (&t->c_cflag, B500000, b);
+#else
+      return 0;
+#endif
+    case b576000:
+#if defined(B576000)
+      return doSetUnset (&t->c_cflag, B576000, b);
+#else
+      return 0;
+#endif
+    case b921600:
+#if defined(B921600)
+      return doSetUnset (&t->c_cflag, B921600, b);
+#else
+      return 0;
+#endif
+    case b1000000:
+#if defined(B1000000)
+      return doSetUnset (&t->c_cflag, B1000000, b);
+#else
+      return 0;
+#endif
+    case b1152000:
+#if defined(B1152000)
+      return doSetUnset (&t->c_cflag, B1152000, b);
+#else
+      return 0;
+#endif
+    case b1500000:
+#if defined(B1500000)
+      return doSetUnset (&t->c_cflag, B1500000, b);
+#else
+      return 0;
+#endif
+    case b2000000:
+#if defined(B2000000)
+      return doSetUnset (&t->c_cflag, B2000000, b);
+#else
+      return 0;
+#endif
+    case b2500000:
+#if defined(B2500000)
+      return doSetUnset (&t->c_cflag, B2500000, b);
+#else
+      return 0;
+#endif
+    case b3000000:
+#if defined(B3000000)
+      return doSetUnset (&t->c_cflag, B3000000, b);
+#else
+      return 0;
+#endif
+    case b3500000:
+#if defined(B3500000)
+      return doSetUnset (&t->c_cflag, B3500000, b);
+#else
+      return 0;
+#endif
+    case b4000000:
+#if defined(B4000000)
+      return doSetUnset (&t->c_cflag, B4000000, b);
+#else
+      return 0;
+#endif
+    case maxbaud:
+#if defined(__MAX_BAUD)
+      return doSetUnset (&t->c_cflag, __MAX_BAUD, b);
+#else
+      return 0;
+#endif
+    case crtscts:
+#if defined(CRTSCTS)
+      return doSetUnset (&t->c_cflag, CRTSCTS, b);
+#else
+      return 0;
+#endif
+    case cs5:
+#if defined(CS5)
+      return doSetUnset (&t->c_cflag, CS5, b);
+#else
+      return 0;
+#endif
+    case cs6:
+#if defined(CS6)
+      return doSetUnset (&t->c_cflag, CS6, b);
+#else
+      return 0;
+#endif
+    case cs7:
+#if defined(CS7)
+      return doSetUnset (&t->c_cflag, CS7, b);
+#else
+      return 0;
+#endif
+    case cs8:
+#if defined(CS8)
+      return doSetUnset (&t->c_cflag, CS8, b);
+#else
+      return 0;
+#endif
+    case cstopb:
+#if defined(CSTOPB)
+      return doSetUnset (&t->c_cflag, CSTOPB, b);
+#else
+      return 0;
+#endif
+    case cread:
+#if defined(CREAD)
+      return doSetUnset (&t->c_cflag, CREAD, b);
+#else
+      return 0;
+#endif
+    case parenb:
+#if defined(PARENB)
+      return doSetUnset (&t->c_cflag, PARENB, b);
+#else
+      return 0;
+#endif
+    case parodd:
+#if defined(PARODD)
+      return doSetUnset (&t->c_cflag, PARODD, b);
+#else
+      return 0;
+#endif
+    case hupcl:
+#if defined(HUPCL)
+      return doSetUnset (&t->c_cflag, HUPCL, b);
+#else
+      return 0;
+#endif
+    case clocal:
+#if defined(CLOCAL)
+      return doSetUnset (&t->c_cflag, CLOCAL, b);
+#else
+      return 0;
+#endif
+    case lisig:
+#if defined(ISIG)
+      return doSetUnset (&t->c_lflag, ISIG, b);
+#else
+      return 0;
+#endif
+    case licanon:
+#if defined(ICANON)
+      return doSetUnset (&t->c_lflag, ICANON, b);
+#else
+      return 0;
+#endif
+    case lxcase:
+#if defined(XCASE)
+      return doSetUnset (&t->c_lflag, XCASE, b);
+#else
+      return 0;
+#endif
+    case lecho:
+#if defined(ECHO)
+      return doSetUnset (&t->c_lflag, ECHO, b);
+#else
+      return 0;
+#endif
+    case lechoe:
+#if defined(ECHOE)
+      return doSetUnset (&t->c_lflag, ECHOE, b);
+#else
+      return 0;
+#endif
+    case lechok:
+#if defined(ECHOK)
+      return doSetUnset (&t->c_lflag, ECHOK, b);
+#else
+      return 0;
+#endif
+    case lechonl:
+#if defined(ECHONL)
+      return doSetUnset (&t->c_lflag, ECHONL, b);
+#else
+      return 0;
+#endif
+    case lnoflsh:
+#if defined(NOFLSH)
+      return doSetUnset (&t->c_lflag, NOFLSH, b);
+#else
+      return 0;
+#endif
+    case ltopstop:
+#if defined(TOSTOP)
+      return doSetUnset (&t->c_lflag, TOSTOP, b);
+#else
+      return 0;
+#endif
+    case lechoctl:
+#if defined(ECHOCTL)
+      return doSetUnset (&t->c_lflag, ECHOCTL, b);
+#else
+      return 0;
+#endif
+    case lechoprt:
+#if defined(ECHOPRT)
+      return doSetUnset (&t->c_lflag, ECHOPRT, b);
+#else
+      return 0;
+#endif
+    case lechoke:
+#if defined(ECHOKE)
+      return doSetUnset (&t->c_lflag, ECHOKE, b);
+#else
+      return 0;
+#endif
+    case lflusho:
+#if defined(FLUSHO)
+      return doSetUnset (&t->c_lflag, FLUSHO, b);
+#else
+      return 0;
+#endif
+    case lpendin:
+#if defined(PENDIN)
+      return doSetUnset (&t->c_lflag, PENDIN, b);
+#else
+      return 0;
+#endif
+    case liexten:
+#if defined(IEXTEN)
+      return doSetUnset (&t->c_lflag, IEXTEN, b);
+#else
+      return 0;
+#endif
+    }
+  return 0;
+}
+
+/* GetChar sets a CHAR, ch, value from, t, and returns TRUE if
+   this value is supported.  */
+
+extern "C" int
+EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch)
+{
+  switch (c)
+    {
+
+    case vintr:
+#if defined(VINTR)
+      *ch = t->c_cc[VINTR];
+      return 1;
+#else
+      return 0;
+#endif
+    case vquit:
+#if defined(VQUIT)
+      *ch = t->c_cc[VQUIT];
+      return 1;
+#else
+      return 0;
+#endif
+    case verase:
+#if defined(VERASE)
+      *ch = t->c_cc[VERASE];
+      return 1;
+#else
+      return 0;
+#endif
+    case vkill:
+#if defined(VKILL)
+      *ch = t->c_cc[VKILL];
+      return 1;
+#else
+      return 0;
+#endif
+    case veof:
+#if defined(VEOF)
+      *ch = t->c_cc[VEOF];
+      return 1;
+#else
+      return 0;
+#endif
+    case vtime:
+#if defined(VTIME)
+      *ch = t->c_cc[VTIME];
+      return 1;
+#else
+      return 0;
+#endif
+    case vmin:
+#if defined(VMIN)
+      *ch = t->c_cc[VMIN];
+      return 1;
+#else
+      return 0;
+#endif
+    case vswtc:
+#if defined(VSWTC)
+      *ch = t->c_cc[VSWTC];
+      return 1;
+#else
+      return 0;
+#endif
+    case vstart:
+#if defined(VSTART)
+      *ch = t->c_cc[VSTART];
+      return 1;
+#else
+      return 0;
+#endif
+    case vstop:
+#if defined(VSTOP)
+      *ch = t->c_cc[VSTOP];
+      return 1;
+#else
+      return 0;
+#endif
+    case vsusp:
+#if defined(VSUSP)
+      *ch = t->c_cc[VSUSP];
+      return 1;
+#else
+      return 0;
+#endif
+    case veol:
+#if defined(VEOL)
+      *ch = t->c_cc[VEOL];
+      return 1;
+#else
+      return 0;
+#endif
+    case vreprint:
+#if defined(VREPRINT)
+      *ch = t->c_cc[VREPRINT];
+      return 1;
+#else
+      return 0;
+#endif
+    case vdiscard:
+#if defined(VDISCARD)
+      *ch = t->c_cc[VDISCARD];
+      return 1;
+#else
+      return 0;
+#endif
+    case vwerase:
+#if defined(VWERASE)
+      *ch = t->c_cc[VWERASE];
+      return 1;
+#else
+      return 0;
+#endif
+    case vlnext:
+#if defined(VLNEXT)
+      *ch = t->c_cc[VLNEXT];
+      return 1;
+#else
+      return 0;
+#endif
+    case veol2:
+#if defined(VEOL2)
+      *ch = t->c_cc[VEOL2];
+      return 1;
+#else
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+
+/* SetChar sets a CHAR value in, t, and returns TRUE if, c,
+   is supported.  */
+
+extern "C" int
+EXPORT (SetChar) (struct termios *t, ControlChar c, char ch)
+{
+  switch (c)
+    {
+
+    case vintr:
+#if defined(VINTR)
+      t->c_cc[VINTR] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vquit:
+#if defined(VQUIT)
+      t->c_cc[VQUIT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case verase:
+#if defined(VERASE)
+      t->c_cc[VERASE] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vkill:
+#if defined(VKILL)
+      t->c_cc[VKILL] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veof:
+#if defined(VEOF)
+      t->c_cc[VEOF] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vtime:
+#if defined(VTIME)
+      t->c_cc[VTIME] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vmin:
+#if defined(VMIN)
+      t->c_cc[VMIN] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vswtc:
+#if defined(VSWTC)
+      t->c_cc[VSWTC] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vstart:
+#if defined(VSTART)
+      t->c_cc[VSTART] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vstop:
+#if defined(VSTOP)
+      t->c_cc[VSTOP] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vsusp:
+#if defined(VSUSP)
+      t->c_cc[VSUSP] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veol:
+#if defined(VEOL)
+      t->c_cc[VEOL] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vreprint:
+#if defined(VREPRINT)
+      t->c_cc[VREPRINT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vdiscard:
+#if defined(VDISCARD)
+      t->c_cc[VDISCARD] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vwerase:
+#if defined(VWERASE)
+      t->c_cc[VWERASE] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case vlnext:
+#if defined(VLNEXT)
+      t->c_cc[VLNEXT] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    case veol2:
+#if defined(VEOL2)
+      t->c_cc[VEOL2] = ch;
+      return 1;
+#else
+      return 0;
+#endif
+    default:
+      return 0;
+    }
+}
+#endif
+
+extern "C" void
+_M2_termios_init (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_termios_fini (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_termios_dep (void)
+{
+}
+
+struct _M2_termios_ctor { _M2_termios_ctor (); } _M2_termios_ctor;
+
+_M2_termios_ctor::_M2_termios_ctor (void)
+{
+  M2RTS_RegisterModule ("termios", _M2_termios_init, _M2_termios_fini,
+			_M2_termios_dep);
+}
diff --git a/libgm2/libm2pim/wrapc.c b/libgm2/libm2pim/wrapc.c
new file mode 100644
index 00000000000..5aa491219c4
--- /dev/null
+++ b/libgm2/libm2pim/wrapc.c
@@ -0,0 +1,296 @@
+/* wrapc.c provide access to miscellaneous C library functions.
+
+Copyright (C) 2005-2022 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>
+
+#if defined(HAVE_MATH_H)
+#include <math.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_UNISTD_H)
+#include <unistd.h>
+#endif
+
+#if defined(HAVE_SYS_STAT_H)
+#include <sys/stat.h>
+#endif
+
+#ifdef HAVE_STDIO_H
+#include <stdio.h>
+#endif
+
+#if defined(HAVE_SYS_TYPES_H)
+#include <sys/types.h>
+#endif
+
+#if defined(HAVE_TIME_H)
+#include <time.h>
+#endif
+
+/* Define FALSE if one hasn't already been defined.  */
+
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+/* Define a generic NULL if one hasn't already been defined.  */
+
+#if !defined(NULL)
+#define NULL 0
+#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 ((void *)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)
+{
+#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
+  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;
+#else
+  return -1;
+#endif
+}
+
+/* filemtime returns the mtime of a file, f.  */
+
+int
+wrapc_filemtime (int f)
+{
+#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
+  struct stat s;
+
+  if (fstat (f, (struct stat *)&s) == 0)
+    return s.st_mtime;
+  else
+    return -1;
+#else
+  return -1;
+#endif
+}
+
+/* fileinode returns the inode associated with a file, f.  */
+
+#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
+ino_t
+wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
+{
+  struct stat s;
+
+  if (fstat (f, (struct stat *)&s) == 0)
+    {
+      *low = (unsigned int)s.st_ino;
+      if ((sizeof (s.st_ino) == (sizeof (unsigned int))))
+	*high = 0;
+      else
+	*high = (unsigned int)(s.st_ino >> (sizeof (unsigned int) * 8));
+      return 0;
+    }
+  else
+    return -1;
+}
+#else
+int
+wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
+{
+  *low = 0;
+  *high = 0;
+  return -1;
+}
+#endif
+
+/* 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 FALSE;
+#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 FALSE;
+#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 FALSE;
+#endif
+}
+
+/* isfinite provide non builtin alternative to the gcc builtin
+   isfinite.  Returns 1 if x is finite and 0 if it is not.  */
+
+int
+wrapc_isfinite (double x)
+{
+#if defined(FP_NAN) && defined(FP_INFINITE)
+  return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
+#else
+  return FALSE;
+#endif
+}
+
+/* isfinitel provide non builtin alternative to the gcc builtin
+   isfinite.  Returns 1 if x is finite and 0 if it is not.  */
+
+int
+wrapc_isfinitel (long double x)
+{
+#if defined(FP_NAN) && defined(FP_INFINITE)
+  return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
+#else
+  return FALSE;
+#endif
+}
+
+/* isfinitef provide non builtin alternative to the gcc builtin
+   isfinite.  Returns 1 if x is finite and 0 if it is not.  */
+
+int
+wrapc_isfinitef (float x)
+{
+#if defined(FP_NAN) && defined(FP_INFINITE)
+  return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
+#else
+  return FALSE;
+#endif
+}
+
+/* init/finish are GNU Modula-2 linking fodder.  */
+
+void
+_M2_wrapc_init ()
+{
+}
+
+void
+_M2_wrapc_fini ()
+{
+}
+
+void
+_M2_wrapc_ctor ()
+{
+}